Concatenative topics
Concatenative meta
Other languages
Meta
helloworld how are you today?
a
b
c
# 234234
# asdfjoij
- hello
- haeafs
# asdf
In a previous lifetime, I added environment variable primitives into the VM. Well, it turns out that a better place for them is in the Factor basis vocabulary root, so this post is about moving them again.
Factor's high-level environment variable words let you get a single variable or all of them, set a single variable or all of them, and unset a variable. On Windows you cannot set all of the variables at once, and on Windows CE the whole concept of environment variables does not exist.
Here is the code for the main vocabulary. Notice that there are hooks on the os
word, which will be a value like macosx or winnt or linux. The boilerplate at the bottom is for loading the platform-specific code.
USING: assocs combinators kernel sequences splitting system vocabs.loader ; IN: environment HOOK: os-env os ( key -- value ) HOOK: set-os-env os ( value key -- ) HOOK: unset-os-env os ( key -- ) HOOK: (os-envs) os ( -- seq ) HOOK: (set-os-envs) os ( seq -- ) : os-envs ( -- assoc ) (os-envs) [ "=" split1 ] H{ } map>assoc ; : set-os-envs ( assoc -- ) [ "=" swap 3append ] { } assoc>map (set-os-envs) ; { { [ os unix? ] [ "environment.unix" require ] } { [ os winnt? ] [ "environment.winnt" require ] } { [ os wince? ] [ ] } } cond
DEFINE_PRIMITIVE(os_env) { char *name = unbox_char_string(); char *value = getenv(name); if(value == NULL) dpush(F); else box_char_string(value); } DEFINE_PRIMITIVE(os_envs) { GROWABLE_ARRAY(result); REGISTER_ROOT(result); char **env = environ; while(*env) { CELL string = tag_object(from_char_string(*env)); GROWABLE_ARRAY_ADD(result,string); env++; } UNREGISTER_ROOT(result); GROWABLE_ARRAY_TRIM(result); dpush(result); } DEFINE_PRIMITIVE(set_os_env) { char *key = unbox_char_string(); REGISTER_C_STRING(key); char *value = unbox_char_string(); UNREGISTER_C_STRING(key); setenv(key, value, 1); } DEFINE_PRIMITIVE(unset_os_env) { char *key = unbox_char_string(); unsetenv(key); } DEFINE_PRIMITIVE(set_os_envs) { F_ARRAY *array = untag_array(dpop()); CELL size = array_capacity(array); /* Memory leak */ char **env = calloc(size + 1,sizeof(CELL)); CELL i; for(i = 0; i < size; i++) { F_STRING *string = untag_string(array_nth(array,i)); CELL length = to_fixnum(string->length); char *chars = malloc(length + 1); char_string_to_memory(string,chars); chars[length] = '\0'; env[i] = chars; } environ = env; }
USING: alien alien.c-types alien.strings alien.syntax kernel layouts sequences system unix environment io.encodings.utf8 unix.utilities vocabs.loader combinators alien.accessors ; IN: environment.unix HOOK: environ os ( -- void* ) M: unix environ ( -- void* ) "environ" f dlsym ; M: unix os-env ( key -- value ) getenv ; M: unix set-os-env ( value key -- ) swap 1 setenv io-error ; M: unix unset-os-env ( key -- ) unsetenv io-error ; M: unix (os-envs) ( -- seq ) environ *void* utf8 alien>strings ; : set-void* ( value alien -- ) 0 set-alien-cell ; M: unix (set-os-envs) ( seq -- ) utf8 strings>alien malloc-byte-array environ set-void* ; os { { macosx [ "environment.unix.macosx" require ] } [ drop ] } case
DEFINE_PRIMITIVE(os_env) { F_CHAR *key = unbox_u16_string(); F_CHAR *value = safe_malloc(MAX_UNICODE_PATH * 2); int ret; ret = GetEnvironmentVariable(key, value, MAX_UNICODE_PATH * 2); if(ret == 0) dpush(F); else dpush(tag_object(from_u16_string(value))); free(value); } DEFINE_PRIMITIVE(set_os_env) { F_CHAR *key = unbox_u16_string(); REGISTER_C_STRING(key); F_CHAR *value = unbox_u16_string(); UNREGISTER_C_STRING(key); if(!SetEnvironmentVariable(key, value)) general_error(ERROR_IO, tag_object(get_error_message()), F, NULL); } DEFINE_PRIMITIVE(unset_os_env) { if(!SetEnvironmentVariable(unbox_u16_string(), NULL) && GetLastError() != ERROR_ENVVAR_NOT_FOUND) general_error(ERROR_IO, tag_object(get_error_message()), F, NULL); } DEFINE_PRIMITIVE(set_os_envs) { not_implemented_error(); }
USING: alien.strings fry io.encodings.utf16 kernel splitting windows windows.kernel32 ; IN: environment.winnt M: winnt os-env ( key -- value ) MAX_UNICODE_PATH "TCHAR" <c-array> [ GetEnvironmentVariable ] keep over 0 = [ 2drop f ] [ nip utf16 alien>string ] if ; M: winnt set-os-env ( value key -- ) swap SetEnvironmentVariable win32-error=0/f ; M: winnt unset-os-env ( key -- ) f SetEnvironmentVariable 0 = [ GetLastError ERROR_ENVVAR_NOT_FOUND = [ win32-error ] unless ] when ; M: winnt (os-envs) ( -- seq ) GetEnvironmentStrings [ "\0" split ] [ FreeEnvironmentStrings ] bi ;
The Factor version wins. Factor is a better C than C.
This revision created on Sun, 19 Oct 2008 02:56:26 by erg