diff --git a/i.c b/i.c index 8b8b40a..428a116 100644 --- a/i.c +++ b/i.c @@ -3874,9 +3874,10 @@ define_instruction(fren) { } define_instruction(argvref) { + extern char *argv_ref(int idx); int i; char *s; ckk(ac); i = get_fixnum(ac); /* todo: range-check */ - s = cxg_argv[i]; + s = argv_ref(i); if (s) ac = string_obj(newstring(s)); else ac = bool_obj(0); gonexti(); @@ -3891,10 +3892,10 @@ define_instruction(getenv) { } define_instruction(envvref) { - extern const char *environ_ref(int idx); + extern char *envv_ref(int idx); int i; char *s; ckk(ac); i = get_fixnum(ac); /* todo: range-check */ - s = (char *)environ_ref(i); + s = envv_ref(i); if (s) ac = string_obj(newstring(s)); else ac = bool_obj(0); gonexti(); diff --git a/s.c b/s.c index be91040..f9f5f9d 100644 --- a/s.c +++ b/s.c @@ -17,21 +17,30 @@ int dirsep = '\\'; int dirsep = '/'; #endif -#if defined(WIN32) -#define sxc_environ _environ -#elif defined(__linux) || defined(__APPLE__) -#define sxc_environ environ -#else /* add more systems? */ -char **sxc_environ = { NULL }; -#endif - -extern const char *environ_ref(int idx) +extern char *argv_ref(int idx) { - const char **pe = sxc_environ; + char **pv = cxg_argv; /* be careful with indexing! */ if (idx < 0) return NULL; - while (idx-- > 0) if (*pe++ == NULL) return NULL; - return *pe; + while (idx-- > 0) if (*pv++ == NULL) return NULL; + return *pv; +} + +#if defined(WIN32) +#define cxg_envv _environ +#elif defined(__linux) || defined(__APPLE__) +#define cxg_envv environ +#else /* add more systems? */ +char **cxg_envv = { NULL }; +#endif + +extern char *envv_ref(int idx) +{ + char **pv = cxg_envv; + /* be careful with indexing! */ + if (idx < 0) return NULL; + while (idx-- > 0) if (*pv++ == NULL) return NULL; + return *pv; } char *s_code[] = { @@ -1040,6 +1049,11 @@ char *s_code[] = { "P", "feature-available?", "%1.0Y0?{${@(y8:features)[00},.1A0]1}f]1", + "C", 0, + "f,#0.0,&1{%0:0^,.0?{.0]1}'0,n,,#0.0,:0,&2{%2.1Z2,.0?{.0,'(c=)S8,.0?{.0" + ",'0,.3S7}{.1},.1?{.2S3,'1,.3I+,.4S7}{'(s0:)},'1,.6I+,.5,.2,.4cc,:1^[62" + "}.1A9:!0:0^]3}.!0.0^_1[12}_1@!(y25:get-environment-variables)", + "P", "emergency-exit", "%!0.0u?{tZ9]1}.0aZ9]1", diff --git a/src/s.scm b/src/s.scm index d99f50d..b002138 100644 --- a/src/s.scm +++ b/src/s.scm @@ -1955,9 +1955,18 @@ (define (feature-available? f) (and (symbol? f) (memq f (features)))) -;TBD: -; -;get-environment-variables +(define get-environment-variables + (let ([evl #f]) + (lambda () + (or evl + (let loop ([r '()] [i 0]) + (let ([kvs (%envv-ref i)]) + (if kvs + (let* ([p (string-position #\= kvs)] ; should be there? + [key (if p (substring kvs 0 p) kvs)] + [val (if p (substring kvs (fx+ p 1) (string-length kvs)) "")]) + (loop (cons (cons key val) r) (fx+ i 1))) + (begin (set! evl (reverse! r)) evl)))))))) (define (emergency-exit . ?obj) (if (null? ?obj) (%exit) (%exit (car ?obj))))