fix guard on references to unsafe functions in bytecode

The protection against unsafe-function references was designed for
bytecode that referred to unsafe operations indirectly, and that
was broken when the compiler changed to refer to unsafe functions
directly in bytecode (to simplify JIT inlining bytecode optimization).
Actually, the relevant code (now removed) seems to be pointless,
since protected-binding checking should cover it already. Maybe
something else changed, or maybe the code was not properly checked
in the first place.

Now, `read` rejects a bytecode stream if it contains a direct
reference to an unsafe function and the code inspector is not the
original code inspector. It's still possible to synthesize bytecode
that contains an indirect reference, and then protected-binding
checking does its job.

pkgs/compiler-pkgs/compiler-lib/compiler/zo-parse.rkt

@@ -67,13 +67,10 @@
      (make-compilation-top ld prefix code)]))
 
 (define (read-resolve-prefix v)
-  (let-values ([(v unsafe?) (if (integer? (car v))
-                                (values v #f)
-                                (values (cdr v) #t))])
   (match v
     [`(,i ,tv . ,sv)
-       ; XXX Why not leave them as vectors and change the contract?
+     ;; XXX Why not leave them as vectors and change the contract?
-       (make-prefix i (vector->list tv) (vector->list sv))])))
+     (make-prefix i (vector->list tv) (vector->list sv))]))
 
 (define read-free-id-info
   (match-lambda

pkgs/racket-pkgs/racket-test/tests/pkg/test-pkgs/.gitignore

@@ -6,4 +6,5 @@ MANIFEST
 pkg-test1b*
 /src-pkgs/
 /built-pkgs/
+pkg-add-a/doc
 pkg-add-base/doc

pkgs/racket-pkgs/racket-test/tests/racket/modprot.rktl

@@ -207,6 +207,49 @@
 
 ;; - - - - - - - - - - - - - - - - - - - -
 
+(define unsafe
+  '(module unsafe '#%kernel
+     (#%require '#%unsafe)
+     (display unsafe-car)))
+
+(require compiler/zo-structs
+         compiler/zo-marshal)
+
+(define unsafe-synth-zo
+  (let ([bstr
+         (zo-marshal
+          (compilation-top
+           10
+           (prefix 0
+                   (list 'dummy)
+                   null)
+           (mod 'unsafe
+                'unsafe
+                (module-path-index-join #f #f)
+                (prefix 0
+                        (list (module-variable (module-path-index-join ''#%unsafe #f)
+                                               'unsafe-car
+                                               -1
+                                               0
+                                               #f))
+                        null)
+                null
+                null
+                null ; body
+                null
+                null
+                0
+                (toplevel 0 0 #f #f)
+                #f
+                #f
+                null
+                null
+                null)))])
+    (parameterize ([read-accept-compiled #t])
+      (read (open-input-bytes bstr)))))
+
+;; - - - - - - - - - - - - - - - - - - - -
+
 (define (xeval e)
   (eval
    (if (bytes? e)
@@ -256,12 +299,35 @@
     (try two/protect three/snabbed (if (and fail-prot? np-ok?) #rx#"unexported .* stx" #rx#"one .13.") fail-three?)
     (try two/protect three/normal  (if fail-prot? #rx#"protected .* normal" #rx#"two .10.") fail-three?)))
 
+(define (unsafe-try unsafe get-inspector unsafe-fail? unsafe-ref-fail? read-fail?)
+  (let ([ns (make-base-namespace)]
+        [p (open-output-bytes)])
+    (parameterize ([current-namespace ns]
+                   [current-output-port p]
+                   [current-code-inspector (get-inspector)])
+      (with-handlers ([values (lambda (exn)
+                                (printf "~a\n" (exn-message exn)))])
+        (eval unsafe)
+        (unless unsafe-fail?
+          (dynamic-require ''unsafe #f))))
+    (test (or unsafe-fail? unsafe-ref-fail?) regexp-match? #rx"protected" (get-output-bytes p)))
+  (let-values ([(i o) (make-pipe)])
+    (if (bytes? unsafe)
+        (write-bytes unsafe o)
+        (write unsafe o))
+    (close-output-port o)
+    (parameterize ([read-accept-compiled #t]
+                   [current-code-inspector (get-inspector)])
+      (if read-fail?
+          (err/rt-test (void (read i)) exn:fail:read?)
+          (test #t not (not (read i)))))))
+
 ;; - - - - - - - - - - - - - - - - - - - -
 
 (define-values (zero-zo one-zo two/no-protect-zo two/protect-zo 
                         three/nabbed-zo three/pnabbed-zo three/snabbed-zo 
                         three/nfnabbed-zo three/nfpnabbed-zo three/nfsnabbed-zo 
-                        three/normal-zo)
+                        three/normal-zo unsafe-zo-bytes)
   (apply
    values
    (let ([ns (make-base-namespace)])
@@ -275,12 +341,12 @@
             (list zero one two/no-protect two/protect 
                   three/nabbed three/pnabbed three/snabbed 
                   three/nfnabbed three/nfpnabbed three/nfsnabbed 
-                  three/normal))))))
+                  three/normal unsafe))))))
 
 (define-values (zero-c one-c two/no-protect-c two/protect-c 
                         three/nabbed-c three/pnabbed-c three/snabbed-c 
                         three/nfnabbed-c three/nfpnabbed-c three/nfsnabbed-c 
-                        three/normal-c)
+                        three/normal-c unsafe-c)
   (apply
    values
    (let ([ns (make-base-namespace)])
@@ -291,27 +357,33 @@
             (list zero one two/no-protect two/protect 
                   three/nabbed three/pnabbed three/snabbed 
                   three/nfnabbed three/nfpnabbed three/nfsnabbed 
-                  three/normal))))))
+                  three/normal unsafe))))))
 
 ;; - - - - - - - - - - - - - - - - - - - -
 
+(define unsafe-zo (parameterize ([read-accept-compiled #t])
+                    (read (open-input-bytes unsafe-zo-bytes))))
+
 ;; source, no inspector change:
 (mp-try-all zero one two/no-protect two/protect 
             three/nabbed three/pnabbed three/snabbed three/nfnabbed three/nfpnabbed three/nfsnabbed
             three/normal
             current-code-inspector current-code-inspector #f #f #f #f #f)
+(unsafe-try unsafe current-code-inspector #f #f #f)
 
 ;; zo, no inspector change:
 (mp-try-all zero-zo one-zo two/no-protect-zo two/protect-zo 
             three/nabbed-zo three/pnabbed-zo three/snabbed-zo three/nfnabbed-zo three/nfpnabbed-zo three/nfsnabbed-zo 
             three/normal-zo
             current-code-inspector current-code-inspector #f #f #f #f #f)
+(unsafe-try unsafe-zo current-code-inspector #f #f #f)
 
 ;; compiled, no inspector change:
 (mp-try-all zero-c one-c two/no-protect-c two/protect-c 
             three/nabbed-c three/pnabbed-c three/snabbed-c three/nfnabbed-c three/nfpnabbed-c three/nfsnabbed-c 
             three/normal-c
             current-code-inspector current-code-inspector #f #f #f #f #f)
+(unsafe-try unsafe-c current-code-inspector #f #f #f)
 
 ;; compiled; changing inspectors does not affect access:
 (mp-try-all zero one two/no-protect-c two/protect-c 
@@ -322,6 +394,7 @@
             three/nabbed-c three/pnabbed-c three/snabbed-c three/nfnabbed-c three/nfpnabbed-c three/nfsnabbed-c 
             three/normal-c
             current-code-inspector make-inspector #f #f #f #f #f)
+(unsafe-try unsafe-c make-inspector #f #f #t)
 
 ;; zo and source; changing inspector affects access in various ways-----------------
 
@@ -329,11 +402,14 @@
             three/nabbed-zo three/pnabbed-zo three/snabbed-zo three/nfnabbed-zo three/nfpnabbed-zo three/nfsnabbed-zo 
             three/normal-zo
             make-inspector current-code-inspector #t #f #f #f #t)
+(unsafe-try unsafe-zo make-inspector #f #f #t)
+(unsafe-try unsafe-synth-zo make-inspector #f #t #f)
 
 (mp-try-all zero one two/no-protect two/protect 
             three/nabbed three/pnabbed three/snabbed-zo three/nfnabbed three/nfpnabbed three/nfsnabbed-zo 
             three/normal
             make-inspector current-code-inspector #t #f #t #f #t)
+(unsafe-try unsafe make-inspector #t #t #f)
 
 (mp-try-all zero-zo one-zo two/no-protect-zo two/protect-zo 
             three/nabbed-zo three/pnabbed-zo three/snabbed-zo three/nfnabbed-zo three/nfpnabbed-zo three/nfsnabbed-zo 

racket/src/racket/include/schthread.h

@@ -283,7 +283,6 @@ typedef struct Thread_Local_Variables {
   struct Scheme_Logger *scheme_future_logger_;
   struct Scheme_Logger *scheme_place_logger_;
   int intdef_counter_;
-  int builtin_ref_counter_;
   int env_uid_counter_;
   int scheme_overflow_count_;
   struct Scheme_Object *original_pwd_;
@@ -668,7 +667,6 @@ XFORM_GC_VARIABLE_STACK_THROUGH_THREAD_LOCAL;
 #define scheme_future_logger XOA (scheme_get_thread_local_variables()->scheme_future_logger_)
 #define scheme_place_logger XOA (scheme_get_thread_local_variables()->scheme_place_logger_)
 #define intdef_counter XOA (scheme_get_thread_local_variables()->intdef_counter_)
-#define builtin_ref_counter XOA (scheme_get_thread_local_variables()->builtin_ref_counter_)
 #define env_uid_counter XOA (scheme_get_thread_local_variables()->env_uid_counter_)
 #define scheme_overflow_count XOA (scheme_get_thread_local_variables()->scheme_overflow_count_)
 #define original_pwd XOA (scheme_get_thread_local_variables()->original_pwd_)

racket/src/racket/src/compenv.c

@@ -731,38 +731,6 @@ Scheme_Object *scheme_register_stx_in_prefix(Scheme_Object *var, Scheme_Comp_Env
   return o;
 }
 
-void scheme_register_unsafe_in_prefix(Scheme_Comp_Env *env, 
-                                      Scheme_Compile_Info *rec, int drec,
-                                      Scheme_Env *menv)
-{
-  Scheme_Object *v, *insp;
-
-  if (rec && rec[drec].dont_mark_local_use) {
-    return;
-  }
-
-  insp = menv->module->insp;
-
-  v = env->prefix->uses_unsafe;
-  if (!v)
-    v = insp;
-  else if (!SAME_OBJ(v, insp)) {
-    Scheme_Hash_Tree *ht;
-
-    if (SCHEME_HASHTRP(v)) {
-      ht = (Scheme_Hash_Tree *)v;
-    } else {
-      ht = scheme_make_hash_tree(0);
-      ht = scheme_hash_tree_set(ht, v, scheme_true);
-    }
-    
-    if (!scheme_hash_tree_get(ht, insp)) {
-      ht = scheme_hash_tree_set(ht, insp, scheme_true);
-      env->prefix->uses_unsafe = (Scheme_Object *)ht;
-    }
-  }
-}
-
 /*========================================================================*/
 /*                     compile-time env, lookup bindings                  */
 /*========================================================================*/

racket/src/racket/src/compile.c

@@ -4586,7 +4586,6 @@ scheme_compile_expand_expr(Scheme_Object *form, Scheme_Comp_Env *env,
 	  scheme_compile_rec_done_local(rec, drec);
           if (SAME_TYPE(SCHEME_TYPE(var), scheme_variable_type)) {
             if (scheme_extract_unsafe(var)) {
-              scheme_register_unsafe_in_prefix(env, rec, drec, menv);
               return scheme_extract_unsafe(var);
             } else if (scheme_extract_flfxnum(var)) {
               return scheme_extract_flfxnum(var);

racket/src/racket/src/env.c

@@ -54,9 +54,11 @@ READ_ONLY static Scheme_Env    *flfxnum_env;
 READ_ONLY static Scheme_Env    *extfl_env;
 READ_ONLY static Scheme_Env    *futures_env;
 
-THREAD_LOCAL_DECL(static int builtin_ref_counter);
 THREAD_LOCAL_DECL(static int intdef_counter);
 
+static int builtin_ref_counter;
+static int builtin_unsafe_start;
+
 THREAD_LOCAL_DECL(static Scheme_Bucket_Table *literal_string_table);
 THREAD_LOCAL_DECL(static Scheme_Bucket_Table *literal_number_table);
 
@@ -341,9 +343,13 @@ static void init_unsafe(Scheme_Env *env)
   unsafe_env->attached = 1;
 
 #if USE_COMPILED_STARTUP
-  if (builtin_ref_counter != (EXPECTED_PRIM_COUNT + EXPECTED_UNSAFE_COUNT)) {
+  if (builtin_ref_counter != (EXPECTED_PRIM_COUNT + EXPECTED_FLFXNUM_COUNT
+                              + EXPECTED_EXTFL_COUNT + EXPECTED_FUTURES_COUNT
+                              + EXPECTED_UNSAFE_COUNT)) {
     printf("Unsafe count %d doesn't match expected count %d\n",
-	   builtin_ref_counter - EXPECTED_PRIM_COUNT, EXPECTED_UNSAFE_COUNT);
+	   builtin_ref_counter - EXPECTED_PRIM_COUNT
+           - EXPECTED_FLFXNUM_COUNT - EXPECTED_EXTFL_COUNT 
+           - EXPECTED_FUTURES_COUNT, EXPECTED_UNSAFE_COUNT);
     abort();
   }
 #endif
@@ -367,9 +373,9 @@ static void init_flfxnum(Scheme_Env *env)
   flfxnum_env->attached = 1;
 
 #if USE_COMPILED_STARTUP
-  if (builtin_ref_counter != (EXPECTED_PRIM_COUNT + EXPECTED_UNSAFE_COUNT + EXPECTED_FLFXNUM_COUNT)) {
+  if (builtin_ref_counter != (EXPECTED_PRIM_COUNT + EXPECTED_FLFXNUM_COUNT)) {
     printf("Flfxnum count %d doesn't match expected count %d\n",
-	   builtin_ref_counter - EXPECTED_PRIM_COUNT - EXPECTED_UNSAFE_COUNT, 
+	   builtin_ref_counter - EXPECTED_PRIM_COUNT, 
            EXPECTED_FLFXNUM_COUNT);
     abort();
   }
@@ -395,10 +401,10 @@ static void init_extfl(Scheme_Env *env)
   extfl_env->attached = 1;
 
 #if USE_COMPILED_STARTUP
-  if (builtin_ref_counter != (EXPECTED_PRIM_COUNT + EXPECTED_UNSAFE_COUNT + EXPECTED_FLFXNUM_COUNT
+  if (builtin_ref_counter != (EXPECTED_PRIM_COUNT + EXPECTED_FLFXNUM_COUNT
                               + EXPECTED_EXTFL_COUNT)) {
     printf("extfl count %d doesn't match expected count %d\n",
-	   builtin_ref_counter - EXPECTED_PRIM_COUNT - EXPECTED_UNSAFE_COUNT - EXPECTED_FLFXNUM_COUNT, 
+	   builtin_ref_counter - EXPECTED_PRIM_COUNT - EXPECTED_FLFXNUM_COUNT,
            EXPECTED_EXTFL_COUNT);
     abort();
   }
@@ -421,10 +427,10 @@ static void init_futures(Scheme_Env *env)
   futures_env->attached = 1;
 
 #if USE_COMPILED_STARTUP
-  if (builtin_ref_counter != (EXPECTED_PRIM_COUNT + EXPECTED_UNSAFE_COUNT + EXPECTED_FLFXNUM_COUNT
+  if (builtin_ref_counter != (EXPECTED_PRIM_COUNT + EXPECTED_FLFXNUM_COUNT
                               + EXPECTED_EXTFL_COUNT + EXPECTED_FUTURES_COUNT)) {
     printf("Futures count %d doesn't match expected count %d\n",
-	   builtin_ref_counter - EXPECTED_PRIM_COUNT - EXPECTED_UNSAFE_COUNT - EXPECTED_FLFXNUM_COUNT
+	   builtin_ref_counter - EXPECTED_PRIM_COUNT - EXPECTED_FLFXNUM_COUNT
            - EXPECTED_EXTFL_COUNT, 
            EXPECTED_FUTURES_COUNT);
     abort();
@@ -443,11 +449,13 @@ static void init_foreign(Scheme_Env *env)
   ffi_env->attached = 1;
 
 #if USE_COMPILED_STARTUP
-  if (builtin_ref_counter != (EXPECTED_PRIM_COUNT + EXPECTED_UNSAFE_COUNT + EXPECTED_FLFXNUM_COUNT
+  if (builtin_ref_counter != (EXPECTED_PRIM_COUNT + EXPECTED_FLFXNUM_COUNT
-                              + EXPECTED_EXTFL_COUNT + EXPECTED_FUTURES_COUNT + EXPECTED_FOREIGN_COUNT)) {
+                              + EXPECTED_EXTFL_COUNT + EXPECTED_FUTURES_COUNT
+                              + EXPECTED_UNSAFE_COUNT + EXPECTED_FOREIGN_COUNT)) {
     printf("Foreign count %d doesn't match expected count %d\n",
-	   builtin_ref_counter - EXPECTED_PRIM_COUNT - EXPECTED_UNSAFE_COUNT - EXPECTED_FLFXNUM_COUNT
+	   builtin_ref_counter - EXPECTED_PRIM_COUNT - EXPECTED_FLFXNUM_COUNT
-           - EXPECTED_EXTFL_COUNT - EXPECTED_FUTURES_COUNT,
+           - EXPECTED_EXTFL_COUNT - EXPECTED_FUTURES_COUNT
+           - EXPECTED_UNSAFE_COUNT,
            EXPECTED_FOREIGN_COUNT);
     abort();
   }
@@ -809,10 +817,12 @@ static void make_kernel_env(void)
   }
 #endif
 
-  init_unsafe(env);
   init_flfxnum(env);
   init_extfl(env);
   init_futures(env);
+
+  builtin_unsafe_start = builtin_ref_counter;
+  init_unsafe(env);
   init_foreign(env);
   
   scheme_init_print_global_constants();
@@ -1462,7 +1472,7 @@ void scheme_shadow(Scheme_Env *env, Scheme_Object *n, int stxtoo)
 
 /********** Auxilliary tables **********/
 
-Scheme_Object **scheme_make_builtin_references_table(void)
+Scheme_Object **scheme_make_builtin_references_table(int *_unsafe_start)
 {
   Scheme_Bucket_Table *ht;
   Scheme_Object **t;
@@ -1505,6 +1515,8 @@ Scheme_Object **scheme_make_builtin_references_table(void)
     }
   }
 
+  *_unsafe_start = builtin_unsafe_start;
+
   return t;
 }
 

racket/src/racket/src/eval.c

@@ -5637,15 +5637,6 @@ Scheme_Object **scheme_push_prefix(Scheme_Env *genv, Resolve_Prefix *rp,
 
   rs_save = rs = MZ_RUNSTACK;
 
-  if (rp->uses_unsafe) {
-    scheme_check_unsafe_accessible((SCHEME_FALSEP(rp->uses_unsafe)
-                                    ? (insp
-                                       ? insp
-                                       : genv->access_insp)
-                                    : rp->uses_unsafe),
-                                   genv);
-  }
-
   if (rp->num_toplevels || rp->num_stxes || rp->num_lifts) {
     i = rp->num_toplevels;
     if (rp->num_stxes) {

racket/src/racket/src/marshal.c

@@ -1109,9 +1109,6 @@ static Scheme_Object *write_resolve_prefix(Scheme_Object *obj)
   tv = scheme_make_pair(scheme_make_integer(rp->num_lifts), 
                         scheme_make_pair(tv, sv));
 
-  if (rp->uses_unsafe)
-    tv = scheme_make_pair(scheme_true, tv);
-
   return tv;
 }
 
@@ -1146,7 +1143,6 @@ static Scheme_Object *read_resolve_prefix(Scheme_Object *obj)
   rp->num_toplevels = (int)SCHEME_VEC_SIZE(tv);
   rp->num_stxes = (int)SCHEME_VEC_SIZE(sv);
   rp->num_lifts = (int)i;
-  rp->uses_unsafe = scheme_true;
 
   i = rp->num_toplevels;
   a = MALLOC_N(Scheme_Object *, i);
@@ -1154,8 +1150,6 @@ static Scheme_Object *read_resolve_prefix(Scheme_Object *obj)
     tl = SCHEME_VEC_ELS(tv)[i];
     if (!SCHEME_FALSEP(tl)
         && !SCHEME_SYMBOLP(tl)
-        && (!SCHEME_PAIRP(tl)
-            || !SCHEME_SYMBOLP(SCHEME_CAR(tl)))
         && !SAME_TYPE(SCHEME_TYPE(tl), scheme_variable_type)
         && !SAME_TYPE(SCHEME_TYPE(tl), scheme_module_variable_type))
       return NULL;

racket/src/racket/src/mzmark_type.inc

@@ -2485,7 +2485,6 @@ static int resolve_prefix_val_MARK(void *p, struct NewGC *gc) {
   gcMARK2(rp->toplevels, gc);
   gcMARK2(rp->stxes, gc);
   gcMARK2(rp->delay_info_rpair, gc);
-  gcMARK2(rp->uses_unsafe, gc);
 
   return
   gcBYTES_TO_WORDS(sizeof(Resolve_Prefix));
@@ -2496,7 +2495,6 @@ static int resolve_prefix_val_FIXUP(void *p, struct NewGC *gc) {
   gcFIXUP2(rp->toplevels, gc);
   gcFIXUP2(rp->stxes, gc);
   gcFIXUP2(rp->delay_info_rpair, gc);
-  gcFIXUP2(rp->uses_unsafe, gc);
 
   return
   gcBYTES_TO_WORDS(sizeof(Resolve_Prefix));
@@ -2517,7 +2515,6 @@ static int comp_prefix_val_MARK(void *p, struct NewGC *gc) {
   gcMARK2(cp->inline_variants, gc);
   gcMARK2(cp->unbound, gc);
   gcMARK2(cp->stxes, gc);
-  gcMARK2(cp->uses_unsafe, gc);
 
   return
   gcBYTES_TO_WORDS(sizeof(Comp_Prefix));
@@ -2529,7 +2526,6 @@ static int comp_prefix_val_FIXUP(void *p, struct NewGC *gc) {
   gcFIXUP2(cp->inline_variants, gc);
   gcFIXUP2(cp->unbound, gc);
   gcFIXUP2(cp->stxes, gc);
-  gcFIXUP2(cp->uses_unsafe, gc);
 
   return
   gcBYTES_TO_WORDS(sizeof(Comp_Prefix));

racket/src/racket/src/mzmarksrc.c

@@ -997,7 +997,6 @@ resolve_prefix_val {
   gcMARK2(rp->toplevels, gc);
   gcMARK2(rp->stxes, gc);
   gcMARK2(rp->delay_info_rpair, gc);
-  gcMARK2(rp->uses_unsafe, gc);
 
  size:
   gcBYTES_TO_WORDS(sizeof(Resolve_Prefix));
@@ -1010,7 +1009,6 @@ comp_prefix_val {
   gcMARK2(cp->inline_variants, gc);
   gcMARK2(cp->unbound, gc);
   gcMARK2(cp->stxes, gc);
-  gcMARK2(cp->uses_unsafe, gc);
 
  size:
   gcBYTES_TO_WORDS(sizeof(Comp_Prefix));

racket/src/racket/src/read.c

@@ -72,6 +72,7 @@ SHARED_OK static unsigned char cpt_branch[256];
 
 /* Table of built-in variable refs for .zo loading: */
 SHARED_OK static Scheme_Object **variable_references;
+SHARED_OK int unsafe_variable_references_start;
 
 ROSYM static Scheme_Object *quote_symbol;
 ROSYM static Scheme_Object *quasiquote_symbol;
@@ -162,6 +163,7 @@ typedef struct Readtable {
 typedef struct ReadParams {
   MZTAG_IF_REQUIRED
   char can_read_compiled;
+  char can_read_unsafe;
   char can_read_pipe_quote;
   char can_read_box;
   char can_read_graph;
@@ -552,7 +554,7 @@ void scheme_init_read(Scheme_Env *env)
 void scheme_init_variable_references_constants()
 {
   REGISTER_SO(variable_references);
-  variable_references = scheme_make_builtin_references_table();
+  variable_references = scheme_make_builtin_references_table(&unsafe_variable_references_start);
 }
 
 
@@ -2319,11 +2321,18 @@ _internal_read(Scheme_Object *port, Scheme_Object *stxsrc, int crc, int cant_fai
     else
       params.table = NULL;
   }
-  if (crc >= 0)
+  if (crc >= 0) {
     params.can_read_compiled = crc;
-  else {
+    params.can_read_unsafe = 1;
+  } else {
     v = scheme_get_param(scheme_current_config(), MZCONFIG_CAN_READ_COMPILED);
     params.can_read_compiled = SCHEME_TRUEP(v);
+    if (v) {
+      v = scheme_get_param(scheme_current_config(), MZCONFIG_CODE_INSPECTOR);
+      v2 = scheme_get_initial_inspector();
+      params.can_read_unsafe = SAME_OBJ(v, v2);
+    } else
+      params.can_read_unsafe = 0;
   }
   v = scheme_get_param(config, MZCONFIG_CAN_READ_PIPE_QUOTE);
   params.can_read_pipe_quote = SCHEME_TRUEP(v);
@@ -4332,6 +4341,7 @@ typedef struct Scheme_Load_Delay {
   Scheme_Object *cached_port;
   struct Scheme_Load_Delay *clear_bytes_prev;
   struct Scheme_Load_Delay *clear_bytes_next;
+  int unsafe_ok;
 } Scheme_Load_Delay;
 
 #define ZO_CHECK(x) if (!(x)) scheme_ill_formed_code(port);
@@ -4345,6 +4355,7 @@ typedef struct CPort {
   unsigned char *start;
   uintptr_t symtab_size;
   intptr_t base;
+  int unsafe_ok;
   Scheme_Object *orig_port;
   Scheme_Hash_Table **ht;
   Scheme_Unmarshal_Tables *ut;
@@ -4376,6 +4387,13 @@ void scheme_ill_formed(struct CPort *port
 		  );
 }
 
+static void unsafe_disallowed(struct CPort *port)
+{
+  scheme_read_err(port ? port->orig_port : NULL,
+                  NULL, -1, -1, port ? CP_TELL(port) : 0, -1, 0, NULL,
+		  "read (compiled): unsafe values disallowed");
+}
+
 /* Since read_compact_number is called often, we want it to be
    a cheap call in 3m, so avoid anything that allocated --- even
    error reporting, since we can make up a valid number. */
@@ -4809,6 +4827,9 @@ static Scheme_Object *read_compact(CPort *port, int use_stack)
                         + EXPECTED_EXTFL_COUNT
                         + EXPECTED_FUTURES_COUNT
                         + EXPECTED_FOREIGN_COUNT));
+      if ((l >= unsafe_variable_references_start)
+          && !port->unsafe_ok)
+        unsafe_disallowed(port);
       return variable_references[l];
       break;
     case CPT_LOCAL:
@@ -5530,6 +5551,7 @@ static Scheme_Object *read_compiled(Scheme_Object *port,
       rp->symtab_size = symtabsize;
       rp->ht = local_ht;
       rp->symtab = symtab;
+      rp->unsafe_ok = params->can_read_unsafe;
 
       config = scheme_current_config();
 
@@ -5567,6 +5589,7 @@ static Scheme_Object *read_compiled(Scheme_Object *port,
         delay_info->symtab = rp->symtab;
         delay_info->shared_offsets = rp->shared_offsets;
         delay_info->relto = rp->relto;
+        delay_info->unsafe_ok = rp->unsafe_ok;
 
         if (SAME_OBJ(delay_info->path, scheme_true))
           perma_cache = 1;
@@ -5807,6 +5830,7 @@ Scheme_Object *scheme_load_delayed_code(int _which, Scheme_Load_Delay *_delay_in
   rp->orig_port = port;
   rp->size = size;
   rp->ut = delay_info->ut;
+  rp->unsafe_ok = delay_info->unsafe_ok;
   if (delay_info->ut)
     delay_info->ut->rp = rp;
 

racket/src/racket/src/resolve.c

@@ -2514,7 +2514,6 @@ Resolve_Prefix *scheme_resolve_prefix(int phase, Comp_Prefix *cp, int simplify)
   rp->so.type = scheme_resolve_prefix_type;
   rp->num_toplevels = cp->num_toplevels;
   rp->num_stxes = cp->num_stxes;
-  rp->uses_unsafe = cp->uses_unsafe;
   
   if (rp->num_toplevels)
     tls = MALLOC_N(Scheme_Object*, rp->num_toplevels);

racket/src/racket/src/schpriv.h

@@ -415,7 +415,7 @@ Scheme_Object *scheme_get_local_inspector();
 
 extern int scheme_builtin_ref_counter;
 
-Scheme_Object **scheme_make_builtin_references_table(void);
+Scheme_Object **scheme_make_builtin_references_table(int *_unsafe_start);
 Scheme_Object *scheme_make_local(Scheme_Type type, int pos, int flags);
 
 void scheme_add_embedded_builtins(Scheme_Env *env);
@@ -2445,7 +2445,6 @@ typedef struct Comp_Prefix
   Scheme_Hash_Table *inline_variants; /* position -> inline_variant */
   Scheme_Object *unbound; /* identifiers (and lists of phase-1 shifted unbounds) that were unbound at compile */
   Scheme_Hash_Table *stxes;     /* syntax objects */
-  Scheme_Object *uses_unsafe;   /* NULL, inspector, or hashtree of inspectors */
 } Comp_Prefix;
 
 typedef struct Scheme_Comp_Env
@@ -2518,7 +2517,6 @@ typedef struct Resolve_Prefix
   Scheme_Object **toplevels;
   Scheme_Object **stxes; /* simplified */
   Scheme_Object *delay_info_rpair; /* (rcons refcount Scheme_Load_Delay*) */
-  Scheme_Object *uses_unsafe; /* non-NULL => inspector or hashtree of inspectors for accessing #%unsafe bindings */
 } Resolve_Prefix;
 
 typedef struct Resolve_Info Resolve_Info;
@@ -2826,9 +2824,6 @@ Scheme_Object *scheme_register_toplevel_in_comp_prefix(Scheme_Object *var, Comp_
 void scheme_register_unbound_toplevel(Scheme_Comp_Env *env, Scheme_Object *id);
 Scheme_Object *scheme_register_stx_in_prefix(Scheme_Object *var, Scheme_Comp_Env *env,
 					     Scheme_Compile_Info *rec, int drec);
-void scheme_register_unsafe_in_prefix(Scheme_Comp_Env *env,
-                                      Scheme_Compile_Info *rec, int drec,
-                                      Scheme_Env *menv);
 void scheme_merge_undefineds(Scheme_Comp_Env *exp_env, Scheme_Comp_Env *env);
 
 void scheme_bind_syntaxes(const char *where, Scheme_Object *names, Scheme_Object *a, 
@@ -3504,7 +3499,6 @@ Scheme_Object *scheme_check_accessible_in_module(Scheme_Env *env, Scheme_Object
 						 int *_protected, int *_unexported, 
                                                  Scheme_Env *from_env, int *_would_complain,
                                                  Scheme_Object **_is_constant);
-void scheme_check_unsafe_accessible(Scheme_Object *insp, Scheme_Env *from_env);
 Scheme_Object *scheme_module_syntax(Scheme_Object *modname, Scheme_Env *env, Scheme_Object *name, int mod_phase);
 
 Scheme_Object *scheme_modidx_shift(Scheme_Object *modidx,

racket/src/racket/src/schvers.h

@@ -13,12 +13,12 @@
    consistently.)
 */
 
-#define MZSCHEME_VERSION "6.1.0.1"
+#define MZSCHEME_VERSION "6.1.0.2"
 
 #define MZSCHEME_VERSION_X 6
 #define MZSCHEME_VERSION_Y 1
 #define MZSCHEME_VERSION_Z 0
-#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)