fix problem visiting available modules; improve backtrace in JIT mode to include module visits; fix use-before-def error to show correct phase (when it's not 0)

svn: r18375

src/mzscheme/src/error.c

@@ -1928,8 +1928,8 @@ void scheme_unbound_global(Scheme_Bucket *b)
     else
       errmsg = "reference to an identifier before its definition: %S%_%s";
 
-    if (SCHEME_INT_VAL(((Scheme_Bucket_With_Home *)b)->home->phase)) {
-      sprintf(phase_buf, " phase: %ld", SCHEME_INT_VAL(((Scheme_Bucket_With_Home *)b)->home->phase));
+    if (((Scheme_Bucket_With_Home *)b)->home->phase) {
+      sprintf(phase_buf, " phase: %ld", ((Scheme_Bucket_With_Home *)b)->home->phase);
       phase = phase_buf;
     } else
       phase = "";

src/mzscheme/src/fun.c

@@ -7399,6 +7399,8 @@ scheme_get_stack_trace(Scheme_Object *mark_set)
 
       if (SCHEME_FALSEP(SCHEME_CDR(name)))
         what = "[traversing imports]";
+      else if (SCHEME_VOIDP(SCHEME_CDR(name)))
+        what = "[running expand-time body]";
       else
         what = "[running body]";
 

src/mzscheme/src/jit.c

@@ -166,7 +166,7 @@ SHARED_OK static void *struct_proc_extract_code;
 SHARED_OK static void *bad_app_vals_target;
 SHARED_OK static void *app_values_slow_code, *app_values_multi_slow_code, *app_values_tail_slow_code;
 SHARED_OK static void *finish_tail_call_code, *finish_tail_call_fixup_code;
-SHARED_OK static void *module_run_start_code, *module_start_start_code;
+SHARED_OK static void *module_run_start_code, *module_exprun_start_code, *module_start_start_code;
 SHARED_OK static void *box_flonum_from_stack_code;
 SHARED_OK static void *fl1_fail_code, *fl2rr_fail_code[2], *fl2fr_fail_code[2], *fl2rf_fail_code[2];
 
@@ -11555,6 +11555,37 @@ static int do_generate_more_common(mz_jit_state *jitter, void *_data)
     register_sub_func(jitter, module_run_start_code, scheme_eof);
   }
 
+  /* *** module_exprun_start_code *** */
+  /* Pushes a module name onto the stack for stack traces. */
+  {
+    int in;
+    
+    module_exprun_start_code = jit_get_ip().ptr;
+    jit_prolog(3);
+    in = jit_arg_p();
+    jit_getarg_p(JIT_R0, in); /* menv */
+    in = jit_arg_p();
+    jit_getarg_i(JIT_R1, in); /* set_ns */
+    in = jit_arg_p();
+    jit_getarg_p(JIT_R2, in); /* &name */
+    CHECK_LIMIT();
+
+    /* Store the name where we can find it */
+    mz_push_locals();
+    mz_set_local_p(JIT_R2, JIT_LOCAL2);
+
+    jit_prepare(2);
+    jit_pusharg_i(JIT_R1);
+    jit_pusharg_p(JIT_R0);
+    (void)mz_finish(scheme_module_exprun_finish);
+    CHECK_LIMIT();
+    mz_pop_locals();
+    jit_ret();
+    CHECK_LIMIT();
+
+    register_sub_func(jitter, module_exprun_start_code, scheme_eof);
+  }
+
   /* *** module_start_start_code *** */
   /* Pushes a module name onto the stack for stack traces. */
   {
@@ -12822,6 +12853,7 @@ static void release_native_code(void *fnlized, void *p)
 #endif
 
 typedef void *(*Module_Run_Proc)(Scheme_Env *menv, Scheme_Env *env, Scheme_Object **name);
+typedef void *(*Module_Exprun_Proc)(Scheme_Env *menv, int set_ns, Scheme_Object **name);
 typedef void *(*Module_Start_Proc)(struct Start_Module_Args *a, Scheme_Object **name);
 
 void *scheme_module_run_start(Scheme_Env *menv, Scheme_Env *env, Scheme_Object *name)
@@ -12833,6 +12865,15 @@ void *scheme_module_run_start(Scheme_Env *menv, Scheme_Env *env, Scheme_Object *
     return scheme_module_run_finish(menv, env);
 }
 
+void *scheme_module_exprun_start(Scheme_Env *menv, int set_ns, Scheme_Object *name)
+{
+  Module_Exprun_Proc proc = (Module_Exprun_Proc)module_exprun_start_code;
+  if (proc)
+    return proc(menv, set_ns, &name);
+  else
+    return scheme_module_exprun_finish(menv, set_ns);
+}
+
 void *scheme_module_start_start(struct Start_Module_Args *a, Scheme_Object *name)
 {
   Module_Start_Proc proc = (Module_Start_Proc)module_start_start_code;

src/mzscheme/src/module.c

@@ -4164,6 +4164,15 @@ static void expstart_module(Scheme_Env *menv, Scheme_Env *env, int restart)
 }
 
 static void run_module_exptime(Scheme_Env *menv, int set_ns)
+{
+#ifdef MZ_USE_JIT
+  (void)scheme_module_exprun_start(menv, set_ns, scheme_make_pair(menv->module->modname, scheme_void));
+#else
+  (void)scheme_module_exprun_finish(menv, set_ns);
+#endif
+}
+
+void *scheme_module_exprun_finish(Scheme_Env *menv, int set_ns)
 {
   int let_depth, for_stx;
   Scheme_Object *names, *e;
@@ -4176,17 +4185,17 @@ static void run_module_exptime(Scheme_Env *menv, int set_ns)
   Scheme_Config *config;
   
   if (menv->module->primitive)
-    return;
+    return NULL;
 
   if (!SCHEME_VEC_SIZE(menv->module->et_body))
-    return;
+    return NULL;
 
   syntax = menv->syntax;
 
   exp_env = menv->exp_env;
 
   if (!exp_env)
-    return;
+    return NULL;
 
   for_stx_globals = exp_env->toplevel;
 
@@ -4222,6 +4231,8 @@ static void run_module_exptime(Scheme_Env *menv, int set_ns)
   if (set_ns) {
     scheme_pop_continuation_frame(&cframe);
   }
+
+  return NULL;
 }
 
 static void do_start_module(Scheme_Module *m, Scheme_Env *menv, Scheme_Env *env, int restart)
@@ -4350,12 +4361,25 @@ static void start_module(Scheme_Module *m, Scheme_Env *env, int restart,
 
 static void do_prepare_compile_env(Scheme_Env *env, int base_phase, int pos)
 {
-  Scheme_Object *v;
+  Scheme_Object *v, *prev;
   Scheme_Env *menv;
 
   v = MODCHAIN_AVAIL(env->modchain, pos);
   if (!SCHEME_FALSEP(v)) {
     MODCHAIN_AVAIL(env->modchain, pos) = scheme_false;
+
+    /* Reverse order of the list; if X requires Y, Y
+       has been pushed onto the front of the list 
+       before X. */
+    prev = scheme_false;
+    while (SCHEME_NAMESPACEP(v)) {
+      menv = (Scheme_Env *)v;
+      v = menv->available_next[pos];
+      menv->available_next[pos] = prev;
+      prev = (Scheme_Object *)menv;
+    }
+    v = prev;
+
     while (SCHEME_NAMESPACEP(v)) {
       menv = (Scheme_Env *)v;
       v = menv->available_next[pos];

src/mzscheme/src/schpriv.h

@@ -2475,9 +2475,11 @@ struct Start_Module_Args;
 
 #ifdef MZ_USE_JIT
 void *scheme_module_run_start(Scheme_Env *menv, Scheme_Env *env, Scheme_Object *name);
+void *scheme_module_exprun_start(Scheme_Env *menv, int set_ns, Scheme_Object *name);
 void *scheme_module_start_start(struct Start_Module_Args *a, Scheme_Object *name);
 #endif
 void *scheme_module_run_finish(Scheme_Env *menv, Scheme_Env *env);
+void *scheme_module_exprun_finish(Scheme_Env *menv, int set_ns);
 void *scheme_module_start_finish(struct Start_Module_Args *a);
 
 Scheme_Object *scheme_build_closure_name(Scheme_Object *code, Scheme_Compile_Info *rec, int drec);