diff --git a/init.c b/init.c index 73dd8caf..5ff2231e 100644 --- a/init.c +++ b/init.c @@ -12,6 +12,8 @@ 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 *); @@ -51,6 +53,8 @@ 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; diff --git a/system.c b/system.c new file mode 100644 index 00000000..20203d27 --- /dev/null +++ b/system.c @@ -0,0 +1,136 @@ +/** + * See Copyright Notice in picrin.h + */ + +#include + +#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_str_new_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_str_new_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; + int i; + + for (i = 0; (*envp)[i] != '='; ++i) + ; + + key = pic_str_new(pic, *envp, i); + val = pic_str_new_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_deflibrary (pic, "(scheme process-context)") { + 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); + } +} diff --git a/time.c b/time.c new file mode 100644 index 00000000..8e42dc8e --- /dev/null +++ b/time.c @@ -0,0 +1,49 @@ +/** + * See Copyright Notice in picrin.h + */ + +#include + +#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(c); +} + +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_deflibrary (pic, "(scheme time)") { + 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); + } +}