new environment-variable API

The `current-environment-variables' parameter determines the current
mutable "environment variable set". If that set is the initial one for
a Racket process, then using the set corresponds to working with OS
environment variables.  Otherwise, it's really just a hash table that
is packaged up as OS environment variables if a subprocess is created.

The new environment-variable interface works in terms of bytes, instead
of assuming that environment variable names and values fit in a string
encoding.

The string-based `getenv' and `putenv' are still available as
convenience wrappers. The checking on environment-variable names
for those wrappers is a little tighter, preventing any attempt to use a
name that contains "=".

collects/racket/private/misc.rkt

@@ -185,6 +185,42 @@
 
   ;; -------------------------------------------------------------------------
 
+  (define (string-no-nuls? s)
+    (and (string? s)
+         (not (regexp-match? #rx"\0" s))))
+
+  (define (bytes-environment-variable-name? s)
+    (and (bytes? s)
+         (if (eq? 'windows (system-type))
+             (regexp-match? #rx#"^[^\0=]+$" s)
+             (regexp-match? #rx#"^[^\0=]*$" s))))
+
+  (define (string-environment-variable-name? s)
+    (and (string? s)
+         (bytes-environment-variable-name?
+          (string->bytes/locale s (char->integer #\?)))))
+
+  (define (getenv s)
+    (unless (string-environment-variable-name? s)
+      (raise-argument-error 'getenv "string-environment-variable-name?" s))
+    (let ([v (environment-variables-get (string->bytes/locale s (char->integer #\?)))])
+      (and v
+           (bytes->string/locale v #\?))))
+
+  (define (putenv s t)
+    (unless (string-no-nuls? s)
+      (raise-argument-error 'putenv "string-environment-variable-name?" 0 s t))
+    (unless (string-no-nuls? t)
+      (raise-argument-error 'putenv "string-no-nuls?" 1 s t))
+    (and
+     (environment-variables-set! (string->bytes/locale s (char->integer #\?))
+                                 (string->bytes/locale t (char->integer #\?))
+                                 (current-environment-variables)
+                                 (lambda () #f))
+     #t))
+
+  ;; -------------------------------------------------------------------------
+
   (#%provide define-syntax-rule
              rationalize 
              path-string? path-replace-suffix path-add-suffix 
@@ -196,4 +232,7 @@
              collection-path collection-file-path load/use-compiled
              guard-evt channel-get channel-try-get channel-put
              port? displayln
-             find-library-collection-paths))
+             find-library-collection-paths
+             bytes-environment-variable-name?
+             string-environment-variable-name?
+             getenv putenv))

collects/scribblings/reference/envvars.scrbl

@@ -0,0 +1,119 @@
+#lang scribble/doc
+@(require "mz.rkt")
+
+@title[#:tag "envvars"]{Environment Variables}
+
+A @deftech{environment variable set} encapsulates a partial mapping
+from byte strings to bytes strings. A Racket process's initial
+@tech{environment variable set} is connected to the operating system's
+environment variables: accesses or changes to the set read or change
+operating-system environment variables for the Racket process.
+
+The current @tech{environment variable set}, which is determined by
+the @racket[current-environment-variables] parameter, is propagated to
+a @tech{subprocess} when the @tech{subprocess} is created.
+
+
+@defproc[(environment-variables? [v any/c]) boolean?]{
+
+Returns @racket[#t] if @racket[v] is an @tech{environment variable
+set}, @racket[#f] otherwise.}
+
+
+@defparam[current-environment-variables env environment-variables?]{
+
+A @tech{parameter} that determines the @tech{environment variable set}
+that is propagated to a @tech{subprocess} and that is used as the
+default set for functions such as @racket[environment-variables-get] or
+@racket[getenv].}
+
+
+@defproc[(bytes-environment-variable-name? [v any/c]) boolean?]{
+
+Returns @racket[#t] if @racket[v] is a byte string and if it is valid
+for an environment variable name. An environment variable name must
+contain no bytes the with value @racket[0] or @racket[61], where
+@racket[61] is @racket[(char->integer #\=)]. On Windows, an
+environment variable name also must have a non-zero length.}
+
+
+@defproc[(environment-variables-get [name bytes-environment-variable-name?]
+                                    [env environment-variables?
+                                         (current-environment-variables)])
+         (or/c #f (and/c bytes-no-nul? immutable?))]{
+
+Returns the mapping for @racket[name] in @racket[env], returning
+@racket[#f] if @racket[name] has no mapping.
+
+Normally, @racket[name] should be a byte-string encoding of a string
+using the default encoding of the current @tech{locale}. On Windows,
+@racket[name] is coerced to a UTF-8 encoding if @racket[env] is the
+initial @tech{environment variable set} of the Racket process.}
+
+
+@defproc[(environment-variables-set! [name bytes-environment-variable-name?]
+                                     [maybe-bstr (or/c bytes-no-nul? #f)]
+                                     [env environment-variables?
+                                          (current-environment-variables)]
+                                     [fail (-> any)
+                                           (lambda ()
+                                             (raise (make-exn:fail ....)))])
+         any]{
+
+Changes the mapping for @racket[name] in @racket[env] to
+@racket[maybe-bstr].  If @racket[maybe-bstr] is @racket[#f] and
+@racket[env] is the initial @tech{environment variable set} of the
+Racket process, then the operating system environment-variable mapping
+for @racket[name] is removed.
+
+Normally, @racket[name] and @racket[maybe-bstr] should be a
+byte-string encoding of a string using the default encoding of the
+current @tech{locale}. On Windows, @racket[name] and
+@racket[maybe-bstr] are coerced to a UTF-8 encoding if @racket[env] is
+the initial @tech{environment variable set} of the Racket process.
+
+On success, the result of @racket[environment-variables-set!] is
+@|void-const|. If @racket[env] is the initial @tech{environment
+variable set} of the Racket process, then attempting to adjust the
+operating system environment-variable mapping might fail for some reason,
+in which case @racket[fail] is called in tail position with respect to the
+@racket[environment-variables-set!]. The default @racket[fail] raises
+an exception.}
+
+
+@defproc[(environment-variables-keys [env environment-variables?])
+         (listof (and/c bytes-environment-variable-name? immutable?))]{
+
+Returns a list of byte strings that corresponds to names mapped by
+@racket[env].}
+
+
+@defproc[(environment-variables-copy [env environment-variables?])
+         environment-variables?]{
+
+Returns an @tech{environment variable set} that is initialized with
+the same mappings as @racket[env].}
+
+
+@deftogether[(
+@defproc[(getenv [name string-environment-variable-name?]) 
+                 (or/c string-no-nuls? #f)]
+@defproc[(putenv [name string-environment-variable-name?]
+                 [value string-no-nuls?]) boolean?]
+)]{
+
+Convenience wrappers for @racket[environment-variables-get] and
+@racket[environment-variables-set!] that convert between strings and
+byte strings using the current @tech{locale}'s default encoding (using
+@racket[#\?] as the replacement character for encoding errors) and
+always using the current @tech{environment variable set} from
+@racket[current-environment-variables]. The @racket[putenv] function
+returns @racket[#t] for success and @racket[#f] for failure.}
+
+
+@defproc[(string-environment-variable-name? [v any/c]) boolean?]{
+
+Returns @racket[#t] if @racket[v] is a string and if its encoding
+using the current @tech{locale}'s encoding is valid for an environment
+variable name according to @racket[bytes-environment-variable-name?].}
+

collects/scribblings/reference/os.scrbl

@@ -11,5 +11,6 @@
 @include-section["subprocess.scrbl"]
 @include-section["logging.scrbl"]
 @include-section["time.scrbl"]
+@include-section["envvars.scrbl"]
 @include-section["runtime.scrbl"]
 @include-section["cmdline.scrbl"]

collects/scribblings/reference/runtime.scrbl

@@ -3,21 +3,6 @@
 
 @title[#:tag "runtime"]{Environment and Runtime Information}
 
-@defproc[(getenv [name string?]) (or/c string? #f)]{
-
-Gets the value of an operating system environment variable. The
-@racket[name] argument cannot contain a null character; if an
-environment variable named by @racket[name] exists, its value is
-returned (as a string); otherwise, @racket[#f] is returned.}
-
-@defproc[(putenv [name string?] [value string?]) boolean?]{
-
-Sets the value of an operating system environment variable. The
-@racket[name] and @racket[value] arguments are strings that cannot
-contain a null character; the environment variable named by
-@racket[name] is set to @racket[value]. The return value is
-@racket[#t] if the assignment succeeds, @racket[#f] otherwise.}
-
 @defproc[(system-type [mode (or/c 'os 'word 'gc 'link 'so-suffix 'so-mode 'machine)
                             'os])
          (or/c symbol? string? bytes? exact-positive-integer?)]{

collects/scribblings/reference/subprocess.scrbl

@@ -24,8 +24,10 @@
                     (or/c (and/c input-port? file-stream-port?) #f))])]{
 
 Creates a new process in the underlying operating system to execute
-@racket[command] asynchronously. See also @racket[system] and
+@racket[command] asynchronously, providing the new process with
-@racket[process] from @racketmodname[racket/system].
+environment variables @racket[current-environment-variables]. See also
+@racket[system] and @racket[process] from
+@racketmodname[racket/system].
 
 The @racket[command] argument is a path to a program executable, and
 the @racket[arg]s are command-line arguments for the program. See

collects/tests/racket/file.rktl

@@ -1258,20 +1258,57 @@
 (arity-test printf 1 -1)
 (arity-test fprintf 2 -1)
 
-(define success-1? (putenv "APPLE" "AnApple"))
+(test #t environment-variables? (current-environment-variables))
-(define success-2? (putenv "BANANA" "AnotherApple"))
+(test #f environment-variables? 10)
-(err/rt-test (getenv 7))
+(test #t environment-variables? (environment-variables-copy (current-environment-variables)))
-(err/rt-test (getenv (string #\a #\nul #\b)))
+(test #t list? (environment-variables-keys (current-environment-variables)))
-(err/rt-test (putenv 7 "hi"))
+(test #t andmap bytes? (environment-variables-keys (current-environment-variables)))
-(err/rt-test (putenv "hi" 7))
+(test #t = 
-(err/rt-test (putenv (string #\a #\nul #\b) "hi"))
+      (length (environment-variables-keys (current-environment-variables)))
-(err/rt-test (putenv "hi" (string #\a #\nul #\b)))
+      (length (environment-variables-keys (environment-variables-copy (current-environment-variables)))))
-(collect-garbage)
+(test #f bytes-environment-variable-name? #"x=")
-(test #t 'success-1 success-1?)
+(test #f bytes-environment-variable-name? #"x\0")
-(test #t 'success-2 success-2?)
+(test (not (eq? 'windows (system-type))) bytes-environment-variable-name? #"")
-(test "AnApple" getenv "APPLE")
+
-(test "AnotherApple" getenv "BANANA")
+(test #f string-environment-variable-name? "x=")
-(test #f getenv "AnUndefinedEnvironmentVariable")
+(test #f string-environment-variable-name? "x\0")
+(test (not (eq? 'windows (system-type))) string-environment-variable-name? "")
+
+(define (env-var-tests)
+  (define success-1? (putenv "APPLE" "AnApple"))
+  (define success-2? (putenv "BANANA" "AnotherApple"))
+  (err/rt-test (getenv 7))
+  (err/rt-test (getenv (string #\a #\nul #\b)))
+  (err/rt-test (putenv 7 "hi"))
+  (err/rt-test (putenv "hi" 7))
+  (err/rt-test (putenv (string #\a #\nul #\b) "hi"))
+  (err/rt-test (putenv "hi" (string #\a #\nul #\b)))
+  (collect-garbage)
+  (test #t 'success-1 success-1?)
+  (test #t 'success-2 success-2?)
+  (test "AnApple" getenv "APPLE")
+  (test "AnotherApple" getenv "BANANA")
+  (test #f getenv "AnUndefinedEnvironmentVariable")
+
+  (test #"AnApple" environment-variables-get #"APPLE")
+  (err/rt-test (environment-variables-get #"=AP=PLE="))
+  (test (void) environment-variables-set! #"APPLE" #"=x=")
+  (test #"=x=" environment-variables-get #"APPLE")
+  (test #"AnotherApple" environment-variables-get #"BANANA")
+  (test (void) environment-variables-set! #"BANANA" #f)
+  (test #f environment-variables-get #"BANANA")
+  (test #f getenv "BANANA")
+
+  (test #"APPLE" car (member #"APPLE" (environment-variables-keys
+                                       (current-environment-variables))))
+  (test #f member #"BANANA" (environment-variables-keys
+                             (current-environment-variables))))
+
+(parameterize ([current-environment-variables
+                (environment-variables-copy
+                 (current-environment-variables))])
+  (env-var-tests))
+(env-var-tests)
 
 (arity-test getenv 1 1)
 (arity-test putenv 2 2)

collects/tests/racket/subprocess.rktl

@@ -460,6 +460,20 @@
   (parameterize ([current-input-port (open-input-string "")])
     (test 3 system/exit-code "exit 3")))
 
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Environment variables:
+
+(let ([out (open-output-bytes)])
+  (parameterize ([current-input-port (open-input-string "Hi\n")]
+                 [current-output-port out]
+                 [current-environment-variables
+                  (environment-variables-copy
+                   (current-environment-variables))])
+    (environment-variables-set! #"Hola" #"hi, there")
+    (system* self "-e" "(getenv \"Hola\")"))
+  (test "\"hi, there\"\n" get-output-string out))
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 (for ([f (list tmpfile tmpfile2)] #:when (file-exists? f)) (delete-file f))

doc/release-notes/racket/HISTORY.txt

@@ -1,3 +1,9 @@
+Version 5.3.4.2
+Added current-environment-variables, environment-variables-get,
+ environment-variables-set!, environment-variables-keys,
+ environment-variables-copy, bytes-environment-variables-name?,
+ string-environment-variables-name?, and environment-variables?
+
 Version 5.3.4.1
 Changed JIT to support ARM
 

src/get-libs.rkt

@@ -104,7 +104,7 @@
          ["libpangocairo-1.0-0.dll" 94625]
          ["libpangowin32-1.0-0.dll" 143647]
          ["libpangoft2-1.0-0.dll" 679322]]
-       (if (getenv "PLT_WIN_GTK")
+       (if (environment-variables-get #"PLT_WIN_GTK")
            '(["libatk-1.0-0.dll" 153763]
              ["libgtk-win32-2.0-0.dll" 4740156]
              ["libgdk-win32-2.0-0.dll" 827670]
@@ -195,7 +195,7 @@
   (define-values (path-size/show)
     (lambda (path)
       (let-values ([(sz) (path-size path)])
-        (if (getenv "PLT_SHOW_PATH_SIZES")
+        (if (environment-variables-get #"PLT_SHOW_PATH_SIZES")
             (printf "~s ~s\n" path sz)
             (void))
         sz)))

src/racket/include/scheme.h

@@ -1365,6 +1365,7 @@ enum {
   MZCONFIG_LOAD_EXTENSION_HANDLER,
 
   MZCONFIG_CURRENT_DIRECTORY,
+  MZCONFIG_CURRENT_ENV_VARS,
 
   MZCONFIG_RANDOM_STATE,
 

src/racket/src/port.c

@@ -9011,7 +9011,8 @@ static char *cmdline_protect(char *s)
 
 static intptr_t mz_spawnv(char *command, const char * const *argv,
 			  int exact_cmdline, intptr_t sin, intptr_t sout, intptr_t serr, int *pid,
-			  int new_process_group)
+			  int new_process_group,
+                          void *env)
 {
   int i, l, len = 0;
   intptr_t cr_flag;
@@ -9056,10 +9057,11 @@ static intptr_t mz_spawnv(char *command, const char * const *argv,
     cr_flag = 0;
   if (new_process_group)
     cr_flag |= CREATE_NEW_PROCESS_GROUP;
+  cr_flag |= CREATE_UNICODE_ENVIRONMENT;
 
   if (CreateProcessW(WIDE_PATH_COPY(command), WIDE_PATH_COPY(cmdline), 
 		     NULL, NULL, 1 /*inherit*/,
-		     cr_flag, NULL, NULL,
+		     cr_flag, env, NULL,
 		     &startup, &info)) {
     CloseHandle(info.hThread);
     *pid = info.dwProcessId;
@@ -9129,6 +9131,8 @@ static Scheme_Object *subprocess(int c, Scheme_Object *args[])
   System_Child *sc;
 # endif
   int fork_errno = 0;
+  char *env;
+  int need_free;
 #else
   void *sc = 0;
 #endif
@@ -9351,7 +9355,10 @@ static Scheme_Object *subprocess(int c, Scheme_Object *args[])
   fflush(stderr);
 
   {
-    Scheme_Object *tcd;
+    Scheme_Object *tcd, *envvar;
+    Scheme_Config *config;
+    char *env;
+    int need_free;
 
     if (!exact_cmdline) {
       /* protect spaces, etc. in the arguments: */
@@ -9362,20 +9369,29 @@ static Scheme_Object *subprocess(int c, Scheme_Object *args[])
       }
     }
 
+    config = scheme_current_config();
+        
     /* Set real CWD before spawn: */
-    tcd = scheme_get_param(scheme_current_config(), MZCONFIG_CURRENT_DIRECTORY);
+    tcd = scheme_get_param(config, MZCONFIG_CURRENT_DIRECTORY);
     scheme_os_setcwd(SCHEME_BYTE_STR_VAL(tcd), 0);
 
+    envvar = scheme_get_param(config, MZCONFIG_CURRENT_ENV_VARS);
+
+    env = scheme_environment_variables_to_block(envvar, &need_free);
+    
     spawn_status = mz_spawnv(command, (const char * const *)argv,
 			     exact_cmdline,
 			     to_subprocess[0],
 			     from_subprocess[1],
 			     err_subprocess[1],
 			     &pid,
-                             new_process_group);
+                             new_process_group,
+                             env);
 
     if (spawn_status != -1)
       sc = (void *)spawn_status;
+
+    if (need_free) free(env);
   }
 
 #else
@@ -9539,10 +9555,17 @@ static Scheme_Object *subprocess(int c, Scheme_Object *args[])
 #endif
       }
 
-      /* Set real CWD */
+      /* Set real CWD and get envrionment variables */
       {
-	Scheme_Object *dir;
+	Scheme_Object *dir, *envvar;
-	dir = scheme_get_param(scheme_current_config(), MZCONFIG_CURRENT_DIRECTORY);
+        Scheme_Config *config;
+
+        config = scheme_current_config();
+        
+	envvar = scheme_get_param(config, MZCONFIG_CURRENT_ENV_VARS);
+        env = scheme_environment_variables_to_block(envvar, &need_free);
+
+	dir = scheme_get_param(config, MZCONFIG_CURRENT_DIRECTORY);
 	if (!scheme_os_setcwd(SCHEME_PATH_VAL(dir), 1)) {
           scheme_console_printf("racket: chdir failed to: %s\n", SCHEME_BYTE_STR_VAL(dir));
           _exit(1);
@@ -9564,10 +9587,13 @@ static Scheme_Object *subprocess(int c, Scheme_Object *args[])
 #endif
 	END_XFORM_SKIP;
 
-	err = MSC_IZE(execv)(command, argv);
+	err = MSC_IZE(execve)(command, argv, (char **)env);
         if (err)
           err = errno;
         
+        if (need_free)
+          free(env);
+
 	/* If we get here it failed; give up */
 
         /* using scheme_signal_error will leave us in the forked process,

src/racket/src/schminc.h

@@ -14,7 +14,7 @@
 
 #define USE_COMPILED_STARTUP 1
 
-#define EXPECTED_PRIM_COUNT 1088
+#define EXPECTED_PRIM_COUNT 1092
 #define EXPECTED_UNSAFE_COUNT 100
 #define EXPECTED_FLFXNUM_COUNT 69
 #define EXPECTED_EXTFL_COUNT 45

src/racket/src/schpriv.h

@@ -4000,6 +4000,10 @@ void scheme_unused_intptr(intptr_t);
 
 intptr_t scheme_check_overflow(intptr_t n, intptr_t m, intptr_t a);
 
+Scheme_Object *scheme_make_environment_variables(Scheme_Hash_Table *ht);
+# define SCHEME_ENVVARS_TABLE(ev) ((Scheme_Hash_Table *)SCHEME_PTR_VAL(ev))
+void *scheme_environment_variables_to_block(Scheme_Object *env, int *_need_free);
+
 /*========================================================================*/
 /*                           places                                       */
 /*========================================================================*/

src/racket/src/schvers.h

@@ -13,12 +13,12 @@
    consistently.)
 */
 
-#define MZSCHEME_VERSION "5.3.4.1"
+#define MZSCHEME_VERSION "5.3.4.2"
 
 #define MZSCHEME_VERSION_X 5
 #define MZSCHEME_VERSION_Y 3
 #define MZSCHEME_VERSION_Z 4
-#define MZSCHEME_VERSION_W 1
+#define MZSCHEME_VERSION_W 2
 
 #define MZSCHEME_VERSION_MAJOR ((MZSCHEME_VERSION_X * 100) + MZSCHEME_VERSION_Y)
 #define MZSCHEME_VERSION_MINOR ((MZSCHEME_VERSION_Z * 1000) + MZSCHEME_VERSION_W)

src/racket/src/startup.inc

@@ -261,13 +261,14 @@
 "(if(and(relative-path? program)"
 "(let-values(((base name dir?)(split-path program)))"
 "(eq? base 'relative)))"
-" (let ((paths-str (getenv \"PATH\"))"
+" (let ((paths-str (environment-variables-get #\"PATH\"))"
 "(win-add(lambda(s)(if(eq?(system-type) 'windows) "
 " (cons (bytes->path #\".\") s) "
 " s))))"
 "(let loop((paths(win-add "
-"(if paths-str "
+"(if paths-str"
-"(path-list-string->path-list paths-str null)"
+"(path-list-string->path-list(bytes->string/locale paths-str #\\?)"
+" null)"
 " null))))"
 "(if(null? paths)"
 " #f"
@@ -634,7 +635,10 @@
 "(cons-if(lambda(f r)(if f(cons f r) r))))"
 "(path-list-string->path-list"
 "(if user-too?"
-" (or (getenv \"PLTCOLLECTS\") \"\")"
+" (let ((c (environment-variables-get #\"PLTCOLLECTS\")))"
+"(if c"
+"(bytes->string/locale c #\\?)"
+" \"\"))"
 " \"\")"
 "(cons-if"
 "(and user-too?"

src/racket/src/startup.rktl

@@ -316,13 +316,14 @@
 	(if (and (relative-path? program)
 		 (let-values ([(base name dir?) (split-path program)])
 		   (eq? base 'relative)))
-	    (let ([paths-str (getenv "PATH")]
+	    (let ([paths-str (environment-variables-get #"PATH")]
 		  [win-add (lambda (s) (if (eq? (system-type) 'windows) 
 					   (cons (bytes->path #".") s) 
 					   s))])
 	      (let loop ([paths (win-add 
                                  (if paths-str
-                                     (path-list-string->path-list paths-str null)
+                                     (path-list-string->path-list (bytes->string/locale paths-str #\?)
+                                                                  null)
                                      null))])
 		(if (null? paths)
 		    #f
@@ -730,7 +731,10 @@
 	    [cons-if (lambda (f r) (if f (cons f r) r))])
 	(path-list-string->path-list
 	 (if user-too?
-	     (or (getenv "PLTCOLLECTS") "")
+             (let ([c (environment-variables-get #"PLTCOLLECTS")])
+               (if c
+                   (bytes->string/locale c #\?)
+                   ""))
 	     "")
 	 (cons-if
 	  (and user-too?

src/racket/src/string.c

@@ -301,8 +301,12 @@ static Scheme_Object *sch_printf(int argc, Scheme_Object *argv[]);
 static Scheme_Object *sch_eprintf(int argc, Scheme_Object *argv[]);
 static Scheme_Object *sch_fprintf(int argc, Scheme_Object *argv[]);
 static Scheme_Object *banner(int argc, Scheme_Object *argv[]);
+static Scheme_Object *env_p(int argc, Scheme_Object *argv[]);
 static Scheme_Object *sch_getenv(int argc, Scheme_Object *argv[]);
+static Scheme_Object *sch_getenv_names(int argc, Scheme_Object *argv[]);
 static Scheme_Object *sch_putenv(int argc, Scheme_Object *argv[]);
+static Scheme_Object *env_copy(int argc, Scheme_Object *argv[]);
+static Scheme_Object *current_environment_variables(int argc, Scheme_Object *argv[]);
 static Scheme_Object *system_type(int argc, Scheme_Object *argv[]);
 static Scheme_Object *system_library_subpath(int argc, Scheme_Object *argv[]);
 static Scheme_Object *cmdline_args(int argc, Scheme_Object *argv[]);
@@ -849,15 +853,42 @@ scheme_init_string (Scheme_Env *env)
 						    0, 0),
 			     env);
 
-  scheme_add_global_constant("getenv",
+  /* Environment variables */
+
+  scheme_add_global_constant("environment-variables?",
+			     scheme_make_folding_prim(env_p,
+                                                      "environment-variables?",
+                                                      1, 1, 1),
+			     env);
+
+  scheme_add_global_constant("current-environment-variables",
+			     scheme_register_parameter(current_environment_variables,
+						       "current-environment-variables",
+						       MZCONFIG_CURRENT_ENV_VARS),
+			     env);  
+
+  scheme_add_global_constant("environment-variables-get",
 			     scheme_make_immed_prim(sch_getenv,
-						    "getenv",
+						    "environment-variables-get",
+						    1, 2),
+			     env);
+
+  scheme_add_global_constant("environment-variables-set!",
+			     scheme_make_prim_w_arity(sch_putenv,
+                                                      "environment-variables-set!",
+                                                      2, 4),
+			     env);
+
+  scheme_add_global_constant("environment-variables-keys",
+			     scheme_make_immed_prim(sch_getenv_names,
+						    "environment-variables-keys",
 						    1, 1),
 			     env);
-  scheme_add_global_constant("putenv",
+
-			     scheme_make_immed_prim(sch_putenv,
+  scheme_add_global_constant("environment-variables-copy",
-						    "putenv",
+			     scheme_make_immed_prim(env_copy,
-						    2, 2),
+						    "environment-variables-copy",
+						    1, 1),
 			     env);
 
   /* Don't make these folding, since they're platform-specific: */
@@ -2052,6 +2083,46 @@ int scheme_any_string_has_null(Scheme_Object *o)
 /* Environment Variables                                               */
 /***********************************************************************/
 
+#ifdef OS_X
+# include <crt_externs.h>
+# define GET_ENVIRON_ARRAY *_NSGetEnviron()
+#endif
+
+#if !defined(DOS_FILE_SYSTEM) && !defined(GET_ENVIRON_ARRAY)
+extern char **environ;
+# define GET_ENVIRON_ARRAY environ
+#endif
+
+Scheme_Object *scheme_make_environment_variables(Scheme_Hash_Table *ht)
+{
+  Scheme_Object *ev;
+
+  ev = scheme_alloc_small_object();
+  ev->type = scheme_environment_variables_type;
+  SCHEME_PTR_VAL(ev) = (Scheme_Object *)ht;
+
+  return ev;
+}
+
+static Scheme_Object *env_p(int argc, Scheme_Object *argv[])
+{
+  return (SAME_TYPE(SCHEME_TYPE(argv[0]), scheme_environment_variables_type)
+          ? scheme_true
+          : scheme_false);
+}
+
+static Scheme_Object *current_environment_variables(int argc, Scheme_Object *argv[])
+{
+  Scheme_Object *v;
+
+  v = scheme_param_config("current-environment-variables",
+			  scheme_make_integer(MZCONFIG_CURRENT_ENV_VARS),
+			  argc, argv,
+			  -1, env_p, "environment-variables?", 0);
+
+  return v;
+}
+
 #if defined(MZ_USE_PLACES) && defined(MZ_PRECISE_GC)
 static char* clone_str_with_gc(const char* buffer) {
   int length;
@@ -2070,51 +2141,28 @@ static void create_putenv_str_table_if_needed() {
 }
 
 #ifndef DOS_FILE_SYSTEM
-static void putenv_str_table_put_name(Scheme_Object *name, Scheme_Object *value) {
+static void putenv_str_table_put_name(const char *name, char *value) {
 #if defined(MZ_USE_PLACES) && defined(MZ_PRECISE_GC)
   void *original_gc;
-  Scheme_Object *name_copy;
+  const char *name_copy;
   original_gc = GC_switch_to_master_gc();
   scheme_start_atomic();
 
-  name_copy = (Scheme_Object *) clone_str_with_gc((const char *) name);
+  name_copy = clone_str_with_gc(name);
   create_putenv_str_table_if_needed();
-  scheme_hash_set(putenv_str_table, name_copy, value);
+  scheme_hash_set(putenv_str_table, (Scheme_Object *)name_copy, (Scheme_Object *)value);
 
   scheme_end_atomic_no_swap();
   GC_switch_back_from_master(original_gc);
 #else
   create_putenv_str_table_if_needed();
-  scheme_hash_set(putenv_str_table, name, value);
+  scheme_hash_set(putenv_str_table, (Scheme_Object *)name, (Scheme_Object *)value);
 #endif
 }
 #endif
 
-#ifndef GETENV_FUNCTION
+#if defined(MZ_PRECISE_GC)
-static void putenv_str_table_put_name_value(Scheme_Object *name, Scheme_Object *value) {
+static Scheme_Object *putenv_str_table_get(const char *name) {
-#if defined(MZ_USE_PLACES) && defined(MZ_PRECISE_GC)
-  void *original_gc;
-  Scheme_Object *name_copy;
-  Scheme_Object *value_copy;
-  original_gc = GC_switch_to_master_gc();
-  scheme_start_atomic();
-
-  name_copy = (Scheme_Object *) clone_str_with_gc((const char *) name);
-  value_copy = (Scheme_Object *) clone_str_with_gc((const char *) value);
-  create_putenv_str_table_if_needed();
-  scheme_hash_set(putenv_str_table, name_copy, value_copy);
-
-  scheme_end_atomic_no_swap();
-  GC_switch_back_from_master(original_gc);
-#else
-  create_putenv_str_table_if_needed();
-  scheme_hash_set(putenv_str_table, name, value);
-#endif
-}
-#endif
-
-#if !defined(GETENV_FUNCTION) || defined(MZ_PRECISE_GC)
-static Scheme_Object *putenv_str_table_get(Scheme_Object *name) {
 #if defined(MZ_USE_PLACES) && defined(MZ_PRECISE_GC)
   void *original_gc;
   Scheme_Object *value; 
@@ -2122,14 +2170,14 @@ static Scheme_Object *putenv_str_table_get(Scheme_Object *name) {
   scheme_start_atomic();
 
   create_putenv_str_table_if_needed();
-  value = scheme_hash_get(putenv_str_table, name);
+  value = scheme_hash_get(putenv_str_table, (Scheme_Object *)name);
 
   scheme_end_atomic_no_swap();
   GC_switch_back_from_master(original_gc);
   return value;
 #else
   create_putenv_str_table_if_needed();
-  return scheme_hash_get(putenv_str_table, name);
+  return scheme_hash_get(putenv_str_table, (Scheme_Object *)name);
 #endif
 }
 #endif
@@ -2140,40 +2188,6 @@ static int sch_bool_getenv(const char* name);
 void
 scheme_init_getenv(void)
 {
-#ifndef GETENV_FUNCTION
-  FILE *f = fopen("Environment", "r");
-  if (f) {
-    Scheme_Object *p = scheme_make_file_input_port(f);
-    mz_jmp_buf *savebuf, newbuf;
-    savebuf = scheme_current_thread->error_buf;
-    scheme_current_thread->error_buf = &newbuf;
-    if (!scheme_setjmp(newbuf)) {
-      while (1) {
-        Scheme_Object *v = scheme_read(p);
-        if (SCHEME_EOFP(v))
-          break;
-
-        if (SCHEME_PAIRP(v) && SCHEME_PAIRP(SCHEME_CDR(v))
-            && SCHEME_NULLP(SCHEME_CDR(SCHEME_CDR(v)))) {
-          Scheme_Object *key = SCHEME_CAR(v);
-          Scheme_Object *val = SCHEME_CADR(v);
-          if (SCHEME_STRINGP(key) && SCHEME_STRINGP(val)) {
-            Scheme_Object *a[2];
-            a[0] = key;
-            a[1] = val;
-            sch_putenv(2, a);
-            v = NULL;
-          }
-        }
-
-        if (v)
-          scheme_signal_error("bad environment specification: %V", v);
-      }
-    }
-    scheme_current_thread->error_buf = savebuf;
-    scheme_close_input_port(p);
-  }
-#endif
   if (sch_bool_getenv("PLTNOMZJIT")) {
       scheme_set_startup_use_jit(0);
   }
@@ -2183,61 +2197,82 @@ scheme_init_getenv(void)
 # include <windows.h>
 static char *dos_win_getenv(const char *name) {
   int value_size;
-  value_size = GetEnvironmentVariable(name, NULL, 0);
+  value_size = GetEnvironmentVariableW(WIDE_PATH(name), NULL, 0);
   if (value_size) {
-    char *value;
+    wchar_t *value;
     int got;
-    value = scheme_malloc_atomic(value_size);
+    value = scheme_malloc_atomic(sizeof(wchar_t) * value_size);
-    got = GetEnvironmentVariable(name, value, value_size);
+    got = GetEnvironmentVariableW(WIDE_PATH(name), value, value_size);
     if (got < value_size)
       value[got] = 0;
-    return value;
+    return NARROW_PATH(value);
   }
   return NULL;
 }
 #endif
 
-static int sch_bool_getenv(const char* name) {
+static int sch_bool_getenv(const char* name)
+{
   int rc = 0;
-#ifdef GETENV_FUNCTION
+
-# ifdef DOS_FILE_SYSTEM
+#ifdef DOS_FILE_SYSTEM
   if (GetEnvironmentVariable(name, NULL, 0)) rc = 1;
-# else
-  if (getenv(name)) rc = 1;
-# endif
 #else
-  if (putenv_str_table_get(name))  rc = 1;
+  if (getenv(name)) rc = 1;
 #endif
+
   return rc;
 }
 
+int byte_string_ok_name(Scheme_Object *o)
+{
+  const char *s = SCHEME_BYTE_STR_VAL(o);
+  int i = SCHEME_BYTE_STRTAG_VAL(o);
+#ifdef DOS_FILE_SYSTEM
+  if (!i) return 0;
+#endif  
+  while (i--) {
+    if (!s[i] || s[i] == '=')
+      return 0;
+  }
+  return 1;
+}
+
 static Scheme_Object *sch_getenv(int argc, Scheme_Object *argv[])
 {
   char *name;
   char *value;
-  Scheme_Object *bs;
+  Scheme_Object *bs, *ev, *val;
+  Scheme_Hash_Table *ht;
 
-  if (!SCHEME_CHAR_STRINGP(argv[0]) || scheme_any_string_has_null(argv[0]))
+  bs = argv[0];
-    scheme_wrong_contract("getenv", CHAR_STRING_W_NO_NULLS, 0, argc, argv);
+  if (!SCHEME_BYTE_STRINGP(bs)
+      || !byte_string_ok_name(bs))
+    scheme_wrong_contract("environment-variables-get", "bytes-environment-variable-name?", 0, argc, argv);
+  if ((argc > 1)
+      && !SAME_TYPE(SCHEME_TYPE(argv[1]), scheme_environment_variables_type))
+    scheme_wrong_contract("environment-variables-get", "environment-variables?", 1, argc, argv);
 
-  bs = scheme_char_string_to_byte_string_locale(argv[0]);
+  if (argc > 1)
-  name = SCHEME_BYTE_STR_VAL(bs);
+    ev = argv[1];
+  else
+    ev = scheme_get_param(scheme_current_config(), MZCONFIG_CURRENT_ENV_VARS);
+  ht = SCHEME_ENVVARS_TABLE(ev);
 
-#ifdef GETENV_FUNCTION
+  if (!ht) {
-# ifdef DOS_FILE_SYSTEM
+    name = SCHEME_BYTE_STR_VAL(bs);
-  value = dos_win_getenv(name);
+
-# else
+#ifdef DOS_FILE_SYSTEM
-  value = getenv(name);
+    value = dos_win_getenv(name);
-# endif
 #else
-  {
+    value = getenv(name);
-    Scheme_Object *hash_value;
-    hash_value = putenv_str_table_get(name); 
-    return hash_value ? hash_value : scheme_false;
-  }
 #endif
 
-  return value ? scheme_make_locale_string(value) : scheme_false;
+    return value ? scheme_make_byte_string(value) : scheme_false;
+  } else {
+    val = scheme_hash_get_atomic(ht, bs);
+    return val ? val : scheme_false;
+  }
 }
 
 #ifndef DOS_FILE_SYSTEM
@@ -2246,21 +2281,26 @@ static int sch_unix_putenv(const char *var, const char *val, const intptr_t varl
   intptr_t total_length;
   total_length = varlen + vallen + 2;
 
+  if (val) {
 #ifdef MZ_PRECISE_GC
-  /* Can't put moveable string into array. */
+    /* Can't put moveable string into array. */
-  buffer = malloc(total_length);
+    buffer = malloc(total_length);
 #else
-  buffer = (char *)scheme_malloc_atomic(total_length);
+    buffer = (char *)scheme_malloc_atomic(total_length);
 #endif
-  memcpy(buffer, var, varlen);
+
-  buffer[varlen] = '=';
+    memcpy(buffer, var, varlen);
-  memcpy(buffer + varlen + 1, val, vallen + 1);
+    buffer[varlen] = '=';
+    memcpy(buffer + varlen + 1, val, vallen + 1);
+  } else {
+    buffer = NULL;
+  }
 
 #ifdef MZ_PRECISE_GC
   {
     /* Free old, if in table: */
     char *oldbuffer;
-    oldbuffer = (char *)putenv_str_table_get((Scheme_Object *)var);
+    oldbuffer = (char *)putenv_str_table_get(var);
     if (oldbuffer)
       free(oldbuffer);
   }
@@ -2268,40 +2308,270 @@ static int sch_unix_putenv(const char *var, const char *val, const intptr_t varl
 
   /* if precise the buffer needs to be remembered so it can be freed */
   /* if not precise the buffer needs to be rooted so it doesn't get collected prematurely */
-  putenv_str_table_put_name((Scheme_Object *)var, (Scheme_Object *)buffer);
+  putenv_str_table_put_name(var, buffer);
-  return putenv(buffer);
+
+  if (buffer)
+    return putenv(buffer);
+  else
+    return unsetenv(var);
 } 
 #endif
 
 static Scheme_Object *sch_putenv(int argc, Scheme_Object *argv[])
 {
-  Scheme_Object *varbs;
+  Scheme_Object *varbs, *valbs, *ev;
-  Scheme_Object *valbs;
+  Scheme_Hash_Table *ht;
   char *var;
   char *val;
-  int rc = 0;
+  int rc = 0, errid = 0;
 
-  if (!SCHEME_CHAR_STRINGP(argv[0]) || scheme_any_string_has_null(argv[0]))
+  varbs = argv[0];
-    scheme_wrong_contract("putenv", CHAR_STRING_W_NO_NULLS, 0, argc, argv);
+  if (!SCHEME_BYTE_STRINGP(varbs)
-  if (!SCHEME_CHAR_STRINGP(argv[1]) || scheme_any_string_has_null(argv[1]))
+      || !byte_string_ok_name(varbs))
-    scheme_wrong_contract("putenv", CHAR_STRING_W_NO_NULLS, 1, argc, argv);
+    scheme_wrong_contract("environment-variables-set!", "bytes-environment-variable-name?", 0, argc, argv);
+  valbs = argv[1];
+  if (!SCHEME_FALSEP(valbs)
+      && (!SCHEME_BYTE_STRINGP(valbs)
+          || scheme_byte_string_has_null(valbs)))
+    scheme_wrong_contract("environment-variables-set!", "(or/c bytes-no-nuls? #f)", 1, argc, argv);
+  if ((argc > 2)
+      && !SAME_TYPE(SCHEME_TYPE(argv[2]), scheme_environment_variables_type))
+    scheme_wrong_contract("environment-variables-set!", "environment-variables?", 1, argc, argv);
+  if (argc > 3)
+    scheme_check_proc_arity("environment-variables-set!", 0, 3, argc, argv);
 
-  varbs = scheme_char_string_to_byte_string_locale(argv[0]);
+  if (argc > 2)
-  var = SCHEME_BYTE_STR_VAL(varbs);
+    ev = argv[2];
+  else
+    ev = scheme_get_param(scheme_current_config(), MZCONFIG_CURRENT_ENV_VARS);
+  ht = SCHEME_ENVVARS_TABLE(ev);
 
-  valbs = scheme_char_string_to_byte_string_locale(argv[1]);
+  if (ht) {
-  val = SCHEME_BYTE_STR_VAL(valbs);
+    if (SCHEME_FALSEP(valbs)) {
+      scheme_hash_set_atomic(ht, varbs, NULL);
+    } else {
+      varbs = byte_string_to_immutable(1, &varbs);
+      valbs = byte_string_to_immutable(1, &valbs);
+      scheme_hash_set_atomic(ht, varbs, valbs);
+    }
 
-#ifdef GETENV_FUNCTION
+    return scheme_void;
-# ifdef DOS_FILE_SYSTEM
+  } else {
-  rc = !SetEnvironmentVariable(var, val);
+    var = SCHEME_BYTE_STR_VAL(varbs);
-# else
+
-  rc = sch_unix_putenv(var, val, SCHEME_BYTE_STRLEN_VAL(varbs), SCHEME_BYTE_STRLEN_VAL(valbs));
+    if (SCHEME_FALSEP(valbs)) {
-# endif
+      val = NULL;
+    } else {
+      val = SCHEME_BYTE_STR_VAL(valbs);
+    }
+
+#ifdef DOS_FILE_SYSTEM
+    rc = !SetEnvironmentVariable(var, val);
+    if (rc)
+      errid = GetLastError();
 #else
-  putenv_str_table_put_name_value(argv[0], argv[1]);
+    rc = sch_unix_putenv(var, val, SCHEME_BYTE_STRLEN_VAL(varbs), (val ? SCHEME_BYTE_STRLEN_VAL(valbs) : 0));
+    errid = errno;
+#endif
+
+    if (rc) {
+      if (argc > 3)
+        return _scheme_tail_apply(argv[3], 0, NULL);
+      else {
+        scheme_raise_exn(MZEXN_FAIL,
+                         "environment-variables-set!: change failed\n"
+                         "  system error: %e",
+                         errid);
+      }
+    }
+
+    return scheme_void;
+  }
+}
+
+static Scheme_Object *env_copy(int argc, Scheme_Object *argv[])
+{
+  Scheme_Hash_Table *ht;
+
+  if (!SAME_TYPE(SCHEME_TYPE(argv[0]), scheme_environment_variables_type))
+    scheme_wrong_contract("environment-variables-copy", "environment-variables?", 0, argc, argv);
+
+  ht = SCHEME_ENVVARS_TABLE(argv[0]);
+  if (ht)
+    return scheme_make_environment_variables(scheme_clone_hash_table(ht));
+  
+  /* copy system environment variables into a hash table: */
+  ht = scheme_make_hash_table_equal();
+
+#ifdef DOS_FILE_SYSTEM
+  {
+    char *p;
+    wchar_t *e;
+    int i, start, j;
+    Scheme_Object *var, *val;
+
+    e = GetEnvironmentStringsW();
+
+    for (i = 0; e[i]; ) {
+      start = i;
+      while (e[i]) {
+        i++;
+      }
+      p = NARROW_PATH(e XFORM_OK_PLUS start);
+      for (j = 0; p[j] && p[j] != '='; j++) {
+      }
+      if (p[j]) {
+        var = scheme_make_immutable_sized_byte_string(p, j, 1);
+        val = scheme_make_immutable_sized_byte_string(p XFORM_OK_PLUS j + 1, -1, 1);
+        scheme_hash_set(ht, var, val);
+      }
+      i++;
+    }
+
+    FreeEnvironmentStringsW(e);
+  }
+#else
+  {
+    int i, j;
+    char **ea, *p;
+    Scheme_Object *var, *val;
+
+    ea = GET_ENVIRON_ARRAY;
+
+    for (i = 0; ea[i]; i++) {
+      p = ea[i];
+      for (j = 0; p[j] && p[j] != '='; j++) {
+      }
+      if (p[j]) {
+        var = scheme_make_immutable_sized_byte_string(p, j, 1);
+        val = scheme_make_immutable_sized_byte_string(p XFORM_OK_PLUS j + 1, -1, 1);
+        scheme_hash_set(ht, var, val);
+      }
+    }
+  }
+#endif
+
+  return scheme_make_environment_variables(ht);
+}
+
+static Scheme_Object *sch_getenv_names(int argc, Scheme_Object *argv[])
+{
+  Scheme_Object *ev, *r = scheme_null;
+  Scheme_Hash_Table *ht;
+  int i;
+
+  ev = argv[0];
+  if (!SAME_TYPE(SCHEME_TYPE(ev), scheme_environment_variables_type))
+    scheme_wrong_contract("environment-variables-keys", "environment-variables?", 0, argc, argv);
+
+  ht = SCHEME_ENVVARS_TABLE(ev);
+  if (!ht) {
+    ev = env_copy(1, argv);
+    ht = SCHEME_ENVVARS_TABLE(ev);
+  }
+
+  for (i = ht->size; i--; ) {
+    if (ht->vals[i]) {
+      r = scheme_make_pair(ht->keys[i], r);
+    }
+  }
+
+  return r;
+}
+
+#ifdef DOS_FILE_SYSTEM
+static int wc_strlen(const wchar_t *ws)
+{
+  int l;
+  for (l =0; ws[l]; l++) { }
+  return l;
+}
+#endif
+
+void *scheme_environment_variables_to_block(Scheme_Object *ev, int *_need_free)
+{
+  Scheme_Hash_Table *ht;
+  
+  ht = SCHEME_ENVVARS_TABLE(ev);
+  if (!ht) {
+    *_need_free = 0;
+#ifdef DOS_FILE_SYSTEM
+    return NULL;
+#else
+    return GET_ENVIRON_ARRAY;
+#endif
+  }
+
+  *_need_free = 1;
+
+#ifdef DOS_FILE_SYSTEM
+  {
+    int i;
+    int len = 0, slen;
+    GC_CAN_IGNORE wchar_t *r, *s;
+
+    for (i = ht->size; i--; ) {
+      if (ht->vals[i]) {
+        len += wc_strlen(WIDE_PATH(SCHEME_BYTE_STR_VAL(ht->keys[i])));
+        len += wc_strlen(WIDE_PATH(SCHEME_BYTE_STR_VAL(ht->vals[i])));
+        len += 2;
+      }
+    }
+
+    r = (wchar_t *)malloc((len + 1) * sizeof(wchar_t));
+
+    len = 0;
+
+    for (i = ht->size; i--; ) {
+      if (ht->vals[i]) {
+        s = WIDE_PATH(SCHEME_BYTE_STR_VAL(ht->keys[i]));
+        slen = wc_strlen(s);
+        memcpy(r XFORM_OK_PLUS len, s, slen * sizeof(wchar_t));
+        len += slen;
+        r[len++] = '=';
+        s = WIDE_PATH(SCHEME_BYTE_STR_VAL(ht->vals[i]));
+        slen = wc_strlen(s);
+        memcpy(r XFORM_OK_PLUS len, s, slen * sizeof(wchar_t));
+        len += slen;
+        r[len++] = 0;
+      }
+    }
+    r[len] = 0;
+
+    return r;
+  }
+#else
+  {
+    GC_CAN_IGNORE char **r, *s;
+    intptr_t i, len = 0, slen, c;
+
+    for (i = ht->size; i--; ) {
+      if (ht->vals[i]) {
+        len += SCHEME_BYTE_STRLEN_VAL(ht->keys[i]);
+        len += SCHEME_BYTE_STRLEN_VAL(ht->vals[i]);
+        len += 2;
+      }
+    }
+
+    r = (char **)malloc((ht->count+1) * sizeof(char*) + len);
+    s = (char *)(r + (ht->count+1));
+    for (i = ht->size, c = 0; i--; ) {
+      if (ht->vals[i]) {
+        r[c++] = s;
+        slen = SCHEME_BYTE_STRLEN_VAL(ht->keys[i]);
+        memcpy(s, SCHEME_BYTE_STR_VAL(ht->keys[i]), slen);
+        s[slen] = '=';
+        s = s XFORM_OK_PLUS (slen + 1);
+        slen = SCHEME_BYTE_STRLEN_VAL(ht->vals[i]);
+        memcpy(s, SCHEME_BYTE_STR_VAL(ht->vals[i]), slen);
+        s[slen] = 0;
+        s = s XFORM_OK_PLUS (slen + 1);
+      }
+    }
+
+    return r;
+  }
 #endif
-  return rc ? scheme_false : scheme_true;
 }
 
 /***********************************************************************/

src/racket/src/stypes.h

@@ -207,83 +207,84 @@ enum {
   scheme_proc_shape_type,               /* 183 */
   scheme_struct_proc_shape_type,        /* 184 */
   scheme_phantom_bytes_type,            /* 185 */
+  scheme_environment_variables_type,    /* 186 */
                                         
 #ifdef MZTAG_REQUIRED                            
-  _scheme_last_normal_type_,            /* 186 */
+  _scheme_last_normal_type_,            /* 187 */
                                                  
-  scheme_rt_weak_array,                 /* 187 */
+  scheme_rt_weak_array,                 /* 188 */
                                         
-  scheme_rt_comp_env,                   /* 188 */
+  scheme_rt_comp_env,                   /* 189 */
-  scheme_rt_constant_binding,           /* 189 */
+  scheme_rt_constant_binding,           /* 190 */
-  scheme_rt_resolve_info,               /* 190 */
+  scheme_rt_resolve_info,               /* 191 */
-  scheme_rt_unresolve_info,             /* 191 */
+  scheme_rt_unresolve_info,             /* 192 */
-  scheme_rt_optimize_info,              /* 192 */
+  scheme_rt_optimize_info,              /* 193 */
-  scheme_rt_compile_info,               /* 193 */
+  scheme_rt_compile_info,               /* 194 */
-  scheme_rt_cont_mark,                  /* 194 */
+  scheme_rt_cont_mark,                  /* 195 */
-  scheme_rt_saved_stack,                /* 195 */
+  scheme_rt_saved_stack,                /* 196 */
-  scheme_rt_reply_item,                 /* 196 */
+  scheme_rt_reply_item,                 /* 197 */
-  scheme_rt_closure_info,               /* 197 */
+  scheme_rt_closure_info,               /* 198 */
-  scheme_rt_overflow,                   /* 198 */
+  scheme_rt_overflow,                   /* 199 */
-  scheme_rt_overflow_jmp,               /* 199 */
+  scheme_rt_overflow_jmp,               /* 200 */
-  scheme_rt_meta_cont,                  /* 200 */
+  scheme_rt_meta_cont,                  /* 201 */
-  scheme_rt_dyn_wind_cell,              /* 201 */
+  scheme_rt_dyn_wind_cell,              /* 202 */
-  scheme_rt_dyn_wind_info,              /* 202 */
+  scheme_rt_dyn_wind_info,              /* 203 */
-  scheme_rt_dyn_wind,                   /* 203 */
+  scheme_rt_dyn_wind,                   /* 204 */
-  scheme_rt_dup_check,                  /* 204 */
+  scheme_rt_dup_check,                  /* 205 */
-  scheme_rt_thread_memory,              /* 205 */
+  scheme_rt_thread_memory,              /* 206 */
-  scheme_rt_input_file,                 /* 206 */
+  scheme_rt_input_file,                 /* 207 */
-  scheme_rt_input_fd,                   /* 207 */
+  scheme_rt_input_fd,                   /* 208 */
-  scheme_rt_oskit_console_input,        /* 208 */
+  scheme_rt_oskit_console_input,        /* 209 */
-  scheme_rt_tested_input_file,          /* 209 */
+  scheme_rt_tested_input_file,          /* 210 */
-  scheme_rt_tested_output_file,         /* 210 */
+  scheme_rt_tested_output_file,         /* 211 */
-  scheme_rt_indexed_string,             /* 211 */
+  scheme_rt_indexed_string,             /* 212 */
-  scheme_rt_output_file,                /* 212 */
+  scheme_rt_output_file,                /* 213 */
-  scheme_rt_load_handler_data,          /* 213 */
+  scheme_rt_load_handler_data,          /* 214 */
-  scheme_rt_pipe,                       /* 214 */
+  scheme_rt_pipe,                       /* 215 */
-  scheme_rt_beos_process,               /* 215 */
+  scheme_rt_beos_process,               /* 216 */
-  scheme_rt_system_child,               /* 216 */
+  scheme_rt_system_child,               /* 217 */
-  scheme_rt_tcp,                        /* 217 */
+  scheme_rt_tcp,                        /* 218 */
-  scheme_rt_write_data,                 /* 218 */
+  scheme_rt_write_data,                 /* 219 */
-  scheme_rt_tcp_select_info,            /* 219 */
+  scheme_rt_tcp_select_info,            /* 220 */
-  scheme_rt_param_data,                 /* 220 */
+  scheme_rt_param_data,                 /* 221 */
-  scheme_rt_will,                       /* 221 */
+  scheme_rt_will,                       /* 222 */
-  scheme_rt_linker_name,                /* 222 */
+  scheme_rt_linker_name,                /* 223 */
-  scheme_rt_param_map,                  /* 223 */
+  scheme_rt_param_map,                  /* 224 */
-  scheme_rt_finalization,               /* 224 */
+  scheme_rt_finalization,               /* 225 */
-  scheme_rt_finalizations,              /* 225 */
+  scheme_rt_finalizations,              /* 226 */
-  scheme_rt_cpp_object,                 /* 226 */
+  scheme_rt_cpp_object,                 /* 227 */
-  scheme_rt_cpp_array_object,           /* 227 */
+  scheme_rt_cpp_array_object,           /* 228 */
-  scheme_rt_stack_object,               /* 228 */
+  scheme_rt_stack_object,               /* 229 */
-  scheme_rt_preallocated_object,        /* 229 */
+  scheme_rt_preallocated_object,        /* 230 */
-  scheme_thread_hop_type,               /* 230 */
+  scheme_thread_hop_type,               /* 231 */
-  scheme_rt_srcloc,                     /* 231 */
+  scheme_rt_srcloc,                     /* 232 */
-  scheme_rt_evt,                        /* 232 */
+  scheme_rt_evt,                        /* 233 */
-  scheme_rt_syncing,                    /* 233 */
+  scheme_rt_syncing,                    /* 234 */
-  scheme_rt_comp_prefix,                /* 234 */
+  scheme_rt_comp_prefix,                /* 235 */
-  scheme_rt_user_input,                 /* 235 */
+  scheme_rt_user_input,                 /* 236 */
-  scheme_rt_user_output,                /* 236 */
+  scheme_rt_user_output,                /* 237 */
-  scheme_rt_compact_port,               /* 237 */
+  scheme_rt_compact_port,               /* 238 */
-  scheme_rt_read_special_dw,            /* 238 */
+  scheme_rt_read_special_dw,            /* 239 */
-  scheme_rt_regwork,                    /* 239 */
+  scheme_rt_regwork,                    /* 240 */
-  scheme_rt_rx_lazy_string,             /* 240 */
+  scheme_rt_rx_lazy_string,             /* 241 */
-  scheme_rt_buf_holder,                 /* 241 */
+  scheme_rt_buf_holder,                 /* 242 */
-  scheme_rt_parameterization,           /* 242 */
+  scheme_rt_parameterization,           /* 243 */
-  scheme_rt_print_params,               /* 243 */
+  scheme_rt_print_params,               /* 244 */
-  scheme_rt_read_params,                /* 244 */
+  scheme_rt_read_params,                /* 245 */
-  scheme_rt_native_code,                /* 245 */
+  scheme_rt_native_code,                /* 246 */
-  scheme_rt_native_code_plus_case,      /* 246 */
+  scheme_rt_native_code_plus_case,      /* 247 */
-  scheme_rt_jitter_data,                /* 247 */
+  scheme_rt_jitter_data,                /* 248 */
-  scheme_rt_module_exports,             /* 248 */
+  scheme_rt_module_exports,             /* 249 */
-  scheme_rt_delay_load_info,            /* 249 */
+  scheme_rt_delay_load_info,            /* 250 */
-  scheme_rt_marshal_info,               /* 250 */
+  scheme_rt_marshal_info,               /* 251 */
-  scheme_rt_unmarshal_info,             /* 251 */
+  scheme_rt_unmarshal_info,             /* 252 */
-  scheme_rt_runstack,                   /* 252 */
+  scheme_rt_runstack,                   /* 253 */
-  scheme_rt_sfs_info,                   /* 253 */
+  scheme_rt_sfs_info,                   /* 254 */
-  scheme_rt_validate_clearing,          /* 254 */
+  scheme_rt_validate_clearing,          /* 255 */
-  scheme_rt_avl_node,                   /* 255 */
+  scheme_rt_avl_node,                   /* 256 */
-  scheme_rt_lightweight_cont,           /* 256 */
+  scheme_rt_lightweight_cont,           /* 257 */
-  scheme_rt_export_info,                /* 257 */
+  scheme_rt_export_info,                /* 258 */
-  scheme_rt_cont_jmp,                   /* 258 */
+  scheme_rt_cont_jmp,                   /* 259 */
 #endif
 
   _scheme_last_type_

src/racket/src/thread.c

@@ -4414,7 +4414,7 @@ void scheme_break_kind_thread(Scheme_Thread *p, int kind)
 
 void scheme_break_thread(Scheme_Thread *p)
 {
-  return scheme_break_kind_thread(p, MZEXN_BREAK);
+  scheme_break_kind_thread(p, MZEXN_BREAK);
 }
 
 static void call_on_atomic_timeout(int must)
@@ -7404,6 +7404,12 @@ static void make_initial_config(Scheme_Thread *p)
     scheme_set_original_dir(s);
   }
 
+  {
+    Scheme_Object *ev;
+    ev = scheme_make_environment_variables(NULL);
+    init_param(cells, paramz, MZCONFIG_CURRENT_ENV_VARS, ev);
+  }
+
   {
     Scheme_Object *rs;
     rs = scheme_make_random_state(scheme_get_milliseconds());

src/racket/src/type.c

@@ -311,6 +311,8 @@ scheme_init_type ()
 
   set_name(scheme_phantom_bytes_type, "<phantom-bytes>");
 
+  set_name(scheme_environment_variables_type, "<environment-variables>");
+
 #ifdef MZ_GC_BACKTRACE
   set_name(scheme_rt_meta_cont, "<meta-continuation>");
 #endif
@@ -720,6 +722,8 @@ void scheme_register_traversers(void)
 
   GC_REG_TRAV(scheme_proc_shape_type, small_object);
   GC_REG_TRAV(scheme_struct_proc_shape_type, small_atomic_obj);
+
+  GC_REG_TRAV(scheme_environment_variables_type, small_object);
 }
 
 END_XFORM_SKIP;