suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

fix guard on references to unsafe functions in bytecode

Browse Source 
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.
This commit is contained in:
Matthew Flatt 2014-07-10 06:57:42 +01:00
parent efa9a1e920
commit 7ccac3c054
16 changed files with 1682 additions and 1637 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
pkgs/compiler-pkgs/compiler-lib/compiler/zo-parse.rkt
View File

@ -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?
(make-prefix i (vector->list tv) (vector->list sv))])))
(match v
[`(,i ,tv . ,sv)
;; XXX Why not leave them as vectors and change the contract?
(make-prefix i (vector->list tv) (vector->list sv))]))
(define read-free-id-info
(match-lambda

1
pkgs/racket-pkgs/racket-test/tests/pkg/test-pkgs/.gitignore vendored
View File

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

84
pkgs/racket-pkgs/racket-test/tests/racket/modprot.rktl
View File

@ -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

2
racket/src/racket/include/schthread.h
View File

@ -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_)

32
racket/src/racket/src/compenv.c
View File

@ -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 */
/*========================================================================*/

1
racket/src/racket/src/compile.c
View File

@ -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);

3082
racket/src/racket/src/cstartup.inc
View File

File diff suppressed because it is too large Load Diff

42
racket/src/racket/src/env.c
View File

@ -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
+ EXPECTED_EXTFL_COUNT + EXPECTED_FUTURES_COUNT + EXPECTED_FOREIGN_COUNT)) {
if (builtin_ref_counter != (EXPECTED_PRIM_COUNT + EXPECTED_FLFXNUM_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
- EXPECTED_EXTFL_COUNT - EXPECTED_FUTURES_COUNT,
builtin_ref_counter - EXPECTED_PRIM_COUNT - EXPECTED_FLFXNUM_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;
}

9
racket/src/racket/src/eval.c
View File

@ -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) {

6
racket/src/racket/src/marshal.c
View File

@ -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;

4
racket/src/racket/src/mzmark_type.inc
View File

@ -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));

2
racket/src/racket/src/mzmarksrc.c
View File

@ -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));

30
racket/src/racket/src/read.c
View File

@ -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;

1
racket/src/racket/src/resolve.c
View File

@ -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);

8
racket/src/racket/src/schpriv.h
View File

@ -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,

4
racket/src/racket/src/schvers.h
View File

@ -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)