fix constant-time 'list?' test

svn: r8363

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

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

src/mzscheme/src/list.c

@@ -875,8 +875,9 @@ int scheme_is_list(Scheme_Object *obj1)
   else
     return 0;
 
-  while (1) {
   obj2 = obj1;
+
+  while (1) {
     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. */

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);
-    }
 
   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,20 +4890,6 @@ 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);
 
       if (last)
@@ -4970,20 +4915,6 @@ 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);
 
   first = last;
@@ -4991,20 +4922,6 @@ static Scheme_Object *read_compact_list(int c, int proper, int use_stack, CPort
   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);
 
     SCHEME_CDR(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;