From a9f76e95d6023a2096c26e47d0408a07474242f1 Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Fri, 18 Jan 2008 15:32:44 +0000 Subject: [PATCH] fix constant-time 'list?' test svn: r8363 --- src/mzscheme/src/eval.c | 4 +- src/mzscheme/src/fun.c | 6 --- src/mzscheme/src/list.c | 5 +- src/mzscheme/src/read.c | 101 ++-------------------------------------- 4 files changed, 10 insertions(+), 106 deletions(-) diff --git a/src/mzscheme/src/eval.c b/src/mzscheme/src/eval.c index 6d9942bffc..87fee130fe 100644 --- a/src/mzscheme/src/eval.c +++ b/src/mzscheme/src/eval.c @@ -3858,7 +3858,7 @@ static void *compile_k(void) find one, break it up to eval first expression before the rest. */ while (1) { - scheme_frame_captures_lifts(cenv, scheme_make_lifted_defn, scheme_sys_wraps(cenv), scheme_false, scheme_true); + scheme_frame_captures_lifts(cenv, scheme_make_lifted_defn, scheme_sys_wraps(cenv), scheme_false, scheme_false); form = scheme_check_immediate_macro(form, cenv, &rec, 0, 0, &gval, NULL, NULL); @@ -3895,7 +3895,7 @@ static void *compile_k(void) Scheme_Object *l, *prev_o = NULL; while (1) { - scheme_frame_captures_lifts(cenv, scheme_make_lifted_defn, scheme_sys_wraps(cenv), scheme_false, scheme_true); + scheme_frame_captures_lifts(cenv, scheme_make_lifted_defn, scheme_sys_wraps(cenv), scheme_false, scheme_false); scheme_init_compile_recs(&rec, 0, &rec2, 1); diff --git a/src/mzscheme/src/fun.c b/src/mzscheme/src/fun.c index d28b2db85c..ada5325a3b 100644 --- a/src/mzscheme/src/fun.c +++ b/src/mzscheme/src/fun.c @@ -1833,13 +1833,11 @@ void *top_level_do(void *(*k)(void), int eb, void *sj_start) { void *v; Scheme_Prompt * volatile prompt; - volatile long save_list_stack_pos; mz_jmp_buf *save, newbuf; Scheme_Stack_State envss; Scheme_Comp_Env * volatile save_current_local_env; Scheme_Object * volatile save_mark, * volatile save_name, * volatile save_certs, * volatile save_modidx; Scheme_Env * volatile save_menv; - Scheme_Simple_Object * volatile save_list_stack; Scheme_Thread * volatile p = scheme_current_thread; int thread_cc = top_next_use_thread_cc_ok; volatile int old_pcc = scheme_prompt_capture_count; @@ -1890,8 +1888,6 @@ void *top_level_do(void *(*k)(void), int eb, void *sj_start) save_certs = p->current_local_certs; save_modidx = p->current_local_modidx; save_menv = p->current_local_menv; - save_list_stack = p->list_stack; - save_list_stack_pos = p->list_stack_pos; if (top_next_env) { p->current_local_env = top_next_env; @@ -1939,8 +1935,6 @@ void *top_level_do(void *(*k)(void), int eb, void *sj_start) p->current_local_certs = save_certs; p->current_local_modidx = save_modidx; p->current_local_menv = save_menv; - p->list_stack = save_list_stack; - p->list_stack_pos = save_list_stack_pos; } scheme_longjmp(*save, 1); } diff --git a/src/mzscheme/src/list.c b/src/mzscheme/src/list.c index 5d83b068d7..5e948b37b6 100644 --- a/src/mzscheme/src/list.c +++ b/src/mzscheme/src/list.c @@ -875,8 +875,9 @@ int scheme_is_list(Scheme_Object *obj1) else return 0; + obj2 = obj1; + while (1) { - obj2 = obj1; obj1 = SCHEME_CDR(obj1); if (SCHEME_NULLP(obj1)){ @@ -908,6 +909,8 @@ int scheme_is_list(Scheme_Object *obj1) flags = SCHEME_PAIR_FLAGS(obj1); if (flags & PAIR_FLAG_MASK) break; + + obj2 = SCHEME_CDR(obj2); } /* Propagate info further up the chain. */ diff --git a/src/mzscheme/src/read.c b/src/mzscheme/src/read.c index 5c3da3423c..923770c5d6 100644 --- a/src/mzscheme/src/read.c +++ b/src/mzscheme/src/read.c @@ -267,23 +267,6 @@ static Scheme_Object *current_reader_guard(int argc, Scheme_Object **argv); #define NUM_CELLS_PER_STACK 500 -typedef struct { - int pos; - Scheme_Simple_Object *stack; -} ListStackRec; - -#define STACK_START(r) (r.pos = local_list_stack_pos, r.stack = local_list_stack) -#define STACK_END(r) (local_list_stack_pos = r.pos, local_list_stack = r.stack) - -#ifdef MZ_PRECISE_GC -/* Although list stacks should work with precise GC as implemented - below, there's much less to be gained with a generational GC, so - we keep it simple. */ -# define USE_LISTSTACK(x) 0 -#else -# define USE_LISTSTACK(x) 0 /* REMOVEME */ -#endif - #ifdef MZ_PRECISE_GC static void register_traversers(void); #endif @@ -2283,10 +2266,6 @@ scheme_internal_read(Scheme_Object *port, Scheme_Object *stxsrc, int crc, int ca if (crc < 0) crc = SCHEME_TRUEP(scheme_get_param(scheme_current_config(), MZCONFIG_CAN_READ_COMPILED)); - /* Need this before top_level_do: */ - if (USE_LISTSTACK(!p->list_stack)) - scheme_alloc_list_stack(p); - if (cantfail) { return _scheme_internal_read(port, stxsrc, crc, cantfail, honu_mode, recur, expose_comment, -1, NULL, magic_sym, magic_val, delay_load_info); @@ -2628,22 +2607,7 @@ read_list(Scheme_Object *port, /* can't be eof, due to check above */ } - if (USE_LISTSTACK(use_stack)) { - if (local_list_stack_pos >= NUM_CELLS_PER_STACK) { - /* Overflow */ - Scheme_Simple_Object *sa; - sa = malloc_list_stack(); - local_list_stack = sa; - local_list_stack_pos = 0; - } - - pair = (Scheme_Object *)(local_list_stack + (local_list_stack_pos++)); - pair->type = scheme_pair_type; - SCHEME_CAR(pair) = car; - SCHEME_CDR(pair) = scheme_null; - } else { - pair = scheme_make_pair(car, scheme_null); - } + pair = scheme_make_pair(car, scheme_null); retry_before_dot: @@ -3237,13 +3201,10 @@ read_vector (Scheme_Object *port, { Scheme_Object *lresult, *obj, *vec, **els; int len, i; - ListStackRec r; - STACK_START(r); lresult = read_list(port, stxsrc, line, col, pos, closer, mz_shape_vec, 1, ht, indentation, params); if (requestLength == -2) { - STACK_END(r); scheme_raise_out_of_memory("read", "making vector of size %5", reqBuffer); return NULL; } @@ -3256,7 +3217,6 @@ read_vector (Scheme_Object *port, len = scheme_list_length(obj); if (requestLength >= 0 && len > requestLength) { char buffer[20]; - STACK_END(r); sprintf(buffer, "%ld", requestLength); scheme_read_err(port, stxsrc, line, col, pos, SPAN(port, pos), 0, indentation, "read: vector length %ld is too small, " @@ -3273,7 +3233,6 @@ read_vector (Scheme_Object *port, obj = SCHEME_CDR(obj); } els = NULL; - STACK_END(r); if (i < requestLength) { if (len) obj = SCHEME_VEC_ELS(vec)[len - 1]; @@ -4931,21 +4890,7 @@ static Scheme_Object *read_compact(CPort *port, int use_stack) if (need_car) { Scheme_Object *pair; - if (USE_LISTSTACK(use_stack)) { - if (local_list_stack_pos >= NUM_CELLS_PER_STACK) { - /* Overflow */ - Scheme_Simple_Object *sa; - sa = malloc_list_stack(); - local_list_stack = sa; - local_list_stack_pos = 0; - } - - pair = (Scheme_Object *)(local_list_stack + (local_list_stack_pos++)); - pair->type = scheme_pair_type; - SCHEME_CAR(pair) = v; - SCHEME_CDR(pair) = scheme_null; - } else - pair = scheme_make_pair(v, scheme_null); + pair = scheme_make_pair(v, scheme_null); if (last) SCHEME_CDR(last) = pair; @@ -4970,42 +4915,14 @@ static Scheme_Object *read_compact_list(int c, int proper, int use_stack, CPort Scheme_Object *v, *first, *last, *pair; v = read_compact(port, 0); - if (USE_LISTSTACK(use_stack)) { - if (local_list_stack_pos >= NUM_CELLS_PER_STACK) { - /* Overflow */ - Scheme_Simple_Object *sa; - sa = malloc_list_stack(); - local_list_stack = sa; - local_list_stack_pos = 0; - } - - last = (Scheme_Object *)(local_list_stack + (local_list_stack_pos++)); - last->type = scheme_pair_type; - SCHEME_CAR(last) = v; - SCHEME_CDR(last) = scheme_null; - } else - last = scheme_make_pair(v, scheme_null); + last = scheme_make_pair(v, scheme_null); first = last; while (--c) { v = read_compact(port, 0); - if (USE_LISTSTACK(use_stack)) { - if (local_list_stack_pos >= NUM_CELLS_PER_STACK) { - /* Overflow */ - Scheme_Simple_Object *sa; - sa = malloc_list_stack(); - local_list_stack = sa; - local_list_stack_pos = 0; - } - - pair = (Scheme_Object *)(local_list_stack + (local_list_stack_pos++)); - pair->type = scheme_pair_type; - SCHEME_CAR(pair) = v; - SCHEME_CDR(pair) = scheme_null; - } else - pair = scheme_make_pair(v, scheme_null); + pair = scheme_make_pair(v, scheme_null); SCHEME_CDR(last) = pair; last = pair; @@ -5048,28 +4965,22 @@ static Scheme_Object *read_compact_quote(CPort *port, int embedded) static Scheme_Object *read_marshalled(int type, CPort *port) { Scheme_Object *l; - ListStackRec r; Scheme_Type_Reader reader; - STACK_START(r); l = read_compact(port, 1); if ((type < 0) || (type >= _scheme_last_type_)) { - STACK_END(r); scheme_ill_formed_code(port); } reader = scheme_type_readers[type]; if (!reader) { - STACK_END(r); scheme_ill_formed_code(port); } l = reader(l); - STACK_END(r); - if (!l) scheme_ill_formed_code(port); @@ -5098,7 +5009,6 @@ static Scheme_Object *read_compiled(Scheme_Object *port, Scheme_Hash_Table **ht, ReadParams *params) { - Scheme_Thread *p = scheme_current_thread; Scheme_Object *result, *insp; long size, shared_size, got, offset = 0; CPort *rp; @@ -5112,9 +5022,6 @@ static Scheme_Object *read_compiled(Scheme_Object *port, Scheme_Object *dir; Scheme_Config *config; - if (USE_LISTSTACK(!p->list_stack)) - scheme_alloc_list_stack(p); - if (!cpt_branch[1]) { int i;