some procedures are moved to contrib/

system related procedures are moved to contrib/

file related procedures are moved to contrib/

load related procedures are moved to conrib/

extlib/benz/file.c

@@ -1,117 +0,0 @@
-/**
- * See Copyright Notice in picrin.h
- */
-
-#include "picrin.h"
-#include "picrin/port.h"
-#include "picrin/error.h"
-
-pic_noreturn static void
-file_error(pic_state *pic, const char *msg)
-{
-  pic_throw(pic, pic->sFILE, msg, pic_nil_value());
-}
-
-static pic_value
-generic_open_file(pic_state *pic, const char *fname, char *mode, short flags)
-{
-  struct pic_port *port;
-  xFILE *file;
-
-  file = xfopen(fname, mode);
-  if (! file) {
-    file_error(pic, "could not open file");
-  }
-
-  port = (struct pic_port *)pic_obj_alloc(pic, sizeof(struct pic_port), PIC_TT_PORT);
-  port->file = file;
-  port->flags = flags;
-  port->status = PIC_PORT_OPEN;
-
-  return pic_obj_value(port);
-}
-
-pic_value
-pic_file_open_input_file(pic_state *pic)
-{
-  static const short flags = PIC_PORT_IN | PIC_PORT_TEXT;
-  char *fname;
-
-  pic_get_args(pic, "z", &fname);
-
-  return generic_open_file(pic, fname, "r", flags);
-}
-
-pic_value
-pic_file_open_binary_input_file(pic_state *pic)
-{
-  static const short flags = PIC_PORT_IN | PIC_PORT_BINARY;
-  char *fname;
-
-  pic_get_args(pic, "z", &fname);
-
-  return generic_open_file(pic, fname, "rb", flags);
-}
-
-pic_value
-pic_file_open_output_file(pic_state *pic)
-{
-  static const short flags = PIC_PORT_OUT | PIC_PORT_TEXT;
-  char *fname;
-
-  pic_get_args(pic, "z", &fname);
-
-  return generic_open_file(pic, fname, "w", flags);
-}
-
-pic_value
-pic_file_open_binary_output_file(pic_state *pic)
-{
-  static const short flags = PIC_PORT_OUT | PIC_PORT_BINARY;
-  char *fname;
-
-  pic_get_args(pic, "z", &fname);
-
-  return generic_open_file(pic, fname, "wb", flags);
-}
-
-pic_value
-pic_file_exists_p(pic_state *pic)
-{
-  char *fname;
-  FILE *fp;
-
-  pic_get_args(pic, "z", &fname);
-
-  fp = fopen(fname, "r");
-  if (fp) {
-    fclose(fp);
-    return pic_true_value();
-  } else {
-    return pic_false_value();
-  }
-}
-
-pic_value
-pic_file_delete(pic_state *pic)
-{
-  char *fname;
-
-  pic_get_args(pic, "z", &fname);
-
-  if (remove(fname) != 0) {
-    file_error(pic, "file cannot be deleted");
-  }
-  return pic_none_value();
-}
-
-void
-pic_init_file(pic_state *pic)
-{
-  pic_defun(pic, "open-input-file", pic_file_open_input_file);
-  pic_defun(pic, "open-binary-input-file", pic_file_open_binary_input_file);
-  pic_defun(pic, "open-output-file", pic_file_open_output_file);
-  pic_defun(pic, "open-binary-output-file", pic_file_open_binary_output_file);
-  pic_defun(pic, "file-exists?", pic_file_exists_p);
-  pic_defun(pic, "delete-file", pic_file_delete);
-}

extlib/benz/include/picrin.h

@@ -186,7 +186,7 @@ bool pic_interned_p(pic_state *, pic_sym);
 pic_value pic_read(pic_state *, struct pic_port *);
 pic_value pic_read_cstr(pic_state *, const char *);
 
-void pic_load(pic_state *, const char *);
+void pic_load_port(pic_state *, struct pic_port *);
 void pic_load_cstr(pic_state *, const char *);
 
 pic_value pic_funcall(pic_state *pic, struct pic_lib *, const char *, pic_list);

extlib/benz/init.c

@@ -18,9 +18,6 @@ void pic_init_bool(pic_state *);
 void pic_init_pair(pic_state *);
 void pic_init_port(pic_state *);
 void pic_init_number(pic_state *);
-void pic_init_time(pic_state *);
-void pic_init_system(pic_state *);
-void pic_init_file(pic_state *);
 void pic_init_proc(pic_state *);
 void pic_init_symbol(pic_state *);
 void pic_init_vector(pic_state *);
@@ -31,7 +28,6 @@ void pic_init_error(pic_state *);
 void pic_init_str(pic_state *);
 void pic_init_macro(pic_state *);
 void pic_init_var(pic_state *);
-void pic_init_load(pic_state *);
 void pic_init_write(pic_state *);
 void pic_init_read(pic_state *);
 void pic_init_dict(pic_state *);
@@ -119,9 +115,6 @@ pic_init_core(pic_state *pic)
     pic_init_pair(pic); DONE;
     pic_init_port(pic); DONE;
     pic_init_number(pic); DONE;
-    pic_init_time(pic); DONE;
-    pic_init_system(pic); DONE;
-    pic_init_file(pic); DONE;
     pic_init_proc(pic); DONE;
     pic_init_symbol(pic); DONE;
     pic_init_vector(pic); DONE;
@@ -132,7 +125,6 @@ pic_init_core(pic_state *pic)
     pic_init_str(pic); DONE;
     pic_init_macro(pic); DONE;
     pic_init_var(pic); DONE;
-    pic_init_load(pic); DONE;
     pic_init_write(pic); DONE;
     pic_init_read(pic); DONE;
     pic_init_dict(pic); DONE;

extlib/benz/load.c

@@ -3,11 +3,10 @@
  */
 
 #include "picrin.h"
-#include "picrin/pair.h"
 #include "picrin/port.h"
 #include "picrin/error.h"
 
-static void
+void
 pic_load_port(pic_state *pic, struct pic_port *port)
 {
   pic_value form;
@@ -35,43 +34,3 @@ pic_load_cstr(pic_state *pic, const char *src)
 
   pic_close_port(pic, port);
 }
-
-void
-pic_load(pic_state *pic, const char *filename)
-{
-  struct pic_port *port;
-  xFILE *file;
-
-  file = xfopen(filename, "r");
-  if (file == NULL) {
-    pic_errorf(pic, "could not open file: %s", filename);
-  }
-
-  port = (struct pic_port *)pic_obj_alloc(pic, sizeof(struct pic_port), PIC_TT_PORT);
-  port->file = file;
-  port->flags = PIC_PORT_IN | PIC_PORT_TEXT;
-  port->status = PIC_PORT_OPEN;
-
-  pic_load_port(pic, port);
-
-  pic_close_port(pic, port);
-}
-
-static pic_value
-pic_load_load(pic_state *pic)
-{
-  pic_value envid;
-  char *fn;
-
-  pic_get_args(pic, "z|o", &fn, &envid);
-
-  pic_load(pic, fn);
-
-  return pic_none_value();
-}
-
-void
-pic_init_load(pic_state *pic)
-{
-  pic_defun(pic, "load", pic_load_load);
-}

extlib/benz/system.c

@@ -1,134 +0,0 @@
-/**
- * See Copyright Notice in picrin.h
- */
-
-#include <stdlib.h>
-
-#include "picrin.h"
-#include "picrin/string.h"
-#include "picrin/pair.h"
-#include "picrin/cont.h"
-
-static pic_value
-pic_system_cmdline(pic_state *pic)
-{
-  pic_value v = pic_nil_value();
-  int i;
-
-  pic_get_args(pic, "");
-
-  for (i = 0; i < pic->argc; ++i) {
-    size_t ai = pic_gc_arena_preserve(pic);
-
-    v = pic_cons(pic, pic_obj_value(pic_make_str_cstr(pic, pic->argv[i])), v);
-    pic_gc_arena_restore(pic, ai);
-  }
-
-  return pic_reverse(pic, v);
-}
-
-static pic_value
-pic_system_exit(pic_state *pic)
-{
-  pic_value v;
-  int argc, status = EXIT_SUCCESS;
-
-  argc = pic_get_args(pic, "|o", &v);
-  if (argc == 1) {
-    switch (pic_type(v)) {
-    case PIC_TT_FLOAT:
-      status = (int)pic_float(v);
-      break;
-    case PIC_TT_INT:
-      status = pic_int(v);
-      break;
-    default:
-      break;
-    }
-  }
-
-  pic_close(pic);
-
-  exit(status);
-}
-
-static pic_value
-pic_system_emergency_exit(pic_state *pic)
-{
-  pic_value v;
-  int argc, status = EXIT_FAILURE;
-
-  argc = pic_get_args(pic, "|o", &v);
-  if (argc == 1) {
-    switch (pic_type(v)) {
-    case PIC_TT_FLOAT:
-      status = (int)pic_float(v);
-      break;
-    case PIC_TT_INT:
-      status = pic_int(v);
-      break;
-    default:
-      break;
-    }
-  }
-
-  _Exit(status);
-}
-
-static pic_value
-pic_system_getenv(pic_state *pic)
-{
-  char *str, *val;
-
-  pic_get_args(pic, "z", &str);
-
-  val = getenv(str);
-
-  if (val == NULL)
-    return pic_nil_value();
-  else
-    return pic_obj_value(pic_make_str_cstr(pic, val));
-}
-
-static pic_value
-pic_system_getenvs(pic_state *pic)
-{
-  char **envp;
-  pic_value data = pic_nil_value();
-  size_t ai = pic_gc_arena_preserve(pic);
-
-  pic_get_args(pic, "");
-
-  if (! pic->envp) {
-    return pic_nil_value();
-  }
-
-  for (envp = pic->envp; *envp; ++envp) {
-    pic_str *key, *val;
-    size_t i;
-
-    for (i = 0; (*envp)[i] != '='; ++i)
-      ;
-
-    key = pic_make_str(pic, *envp, i);
-    val = pic_make_str_cstr(pic, getenv(pic_str_cstr(key)));
-
-    /* push */
-    data = pic_acons(pic, pic_obj_value(key), pic_obj_value(val), data);
-
-    pic_gc_arena_restore(pic, ai);
-    pic_gc_protect(pic, data);
-  }
-
-  return data;
-}
-
-void
-pic_init_system(pic_state *pic)
-{
-  pic_defun(pic, "command-line", pic_system_cmdline);
-  pic_defun(pic, "exit", pic_system_exit);
-  pic_defun(pic, "emergency-exit", pic_system_emergency_exit);
-  pic_defun(pic, "get-environment-variable", pic_system_getenv);
-  pic_defun(pic, "get-environment-variables", pic_system_getenvs);
-}

extlib/benz/time.c

@@ -1,47 +0,0 @@
-/**
- * See Copyright Notice in picrin.h
- */
-
-#include <time.h>
-
-#include "picrin.h"
-
-#define UTC_TAI_DIFF 35
-
-static pic_value
-pic_current_second(pic_state *pic)
-{
-  time_t t;
-
-  pic_get_args(pic, "");
-
-  time(&t);
-  return pic_float_value((double)t + UTC_TAI_DIFF);
-}
-
-static pic_value
-pic_current_jiffy(pic_state *pic)
-{
-  clock_t c;
-
-  pic_get_args(pic, "");
-
-  c = clock();
-  return pic_int_value((int)c); /* The year 2038 problem :-| */
-}
-
-static pic_value
-pic_jiffies_per_second(pic_state *pic)
-{
-  pic_get_args(pic, "");
-
-  return pic_int_value(CLOCKS_PER_SEC);
-}
-
-void
-pic_init_time(pic_state *pic)
-{
-  pic_defun(pic, "current-second", pic_current_second);
-  pic_defun(pic, "current-jiffy", pic_current_jiffy);
-  pic_defun(pic, "jiffies-per-second", pic_jiffies_per_second);
-}