rework late binding resolution to be simpler and more efficient

* libguile/programs.h (struct scm_program):
* libguile/programs.c (scm_c_make_program): Record the current module
  when making a program. This replaces the per-late binding recorded
  module in the generated code, which should be more efficient, both in
  terms of garbage, and in not calling resolve-module.
  (program-module): New accessor.

* module/system/vm/program.scm: Add program-module to exports.

* libguile/vm-i-loader.c (link-later): Remove this instruction, since now
  the entry in the object table is just a symbol, and can be loaded with
  load-symbol.

* libguile/vm-i-system.c (late-variable-ref, late-variable-set): Rework
  so as to look up in the module of the current program. The logic could
  be condensed quite a bit if scm_module_lookup () knew what to do with
  mod==#f.

* module/system/vm/assemble.scm (dump-object!): Dump <vlink-later> just
  as load-symbol, as mentioned in the note on link-later.

* module/system/il/ghil.scm: Update comment to reflect the new reality.

diff --git a/libguile/programs.c b/libguile/programs.c
index 436e2b8..1b3895b 100644 (file)
--- a/libguile/programs.c
+++ b/libguile/programs.c
@@ -46,6 +46,7 @@
 #include <string.h>
 #include "vm-bootstrap.h"
 #include "instructions.h"
+#include "modules.h"
 #include "programs.h"
 #include "vm.h"
 
@@ -69,6 +70,7 @@ scm_c_make_program (void *addr, size_t size, SCM holder)
   p->objs     = zero_vector;
   p->external = SCM_EOL;
   p->holder   = holder;
+  p->module   = scm_current_module ();
 
   /* If nobody holds bytecode's address, then allocate a new memory */
   if (SCM_FALSEP (holder)) 
@@ -99,6 +101,7 @@ program_mark (SCM obj)
   scm_gc_mark (p->meta);
   scm_gc_mark (p->objs);
   scm_gc_mark (p->external);
+  scm_gc_mark (p->module);
   return p->holder;
 }
 
@@ -184,6 +187,16 @@ SCM_DEFINE (scm_program_objects, "program-objects", 1, 0, 0,
 }
 #undef FUNC_NAME
 
+SCM_DEFINE (scm_program_module, "program-module", 1, 0, 0,
+           (SCM program),
+           "")
+#define FUNC_NAME s_scm_program_module
+{
+  SCM_VALIDATE_PROGRAM (1, program);
+  return SCM_PROGRAM_DATA (program)->module;
+}
+#undef FUNC_NAME
+
 SCM_DEFINE (scm_program_external, "program-external", 1, 0, 0,
            (SCM program),
            "")

diff --git a/libguile/programs.h b/libguile/programs.h
index 04f2d45..0f1b57d 100644 (file)
--- a/libguile/programs.h
+++ b/libguile/programs.h
@@ -57,6 +57,7 @@ struct scm_program {
   unsigned char nlocs;         /* the number of local variables */
   unsigned char nexts;         /* the number of external variables */
   scm_byte_t *base;            /* program base address */
+  SCM module;                  /* resolve bindings with respect to this module */
   SCM meta;                    /* meta data */
   SCM objs;                    /* constant objects */
   SCM external;                        /* external environment */
@@ -77,6 +78,7 @@ extern SCM scm_program_base (SCM program);
 extern SCM scm_program_arity (SCM program);
 extern SCM scm_program_meta (SCM program);
 extern SCM scm_program_objects (SCM program);
+extern SCM scm_program_module (SCM program);
 extern SCM scm_program_external (SCM program);
 extern SCM scm_program_external_set_x (SCM program, SCM external);
 extern SCM scm_program_bytecode (SCM program);

diff --git a/libguile/vm-i-loader.c b/libguile/vm-i-loader.c
index 2816d33..34d1cec 100644 (file)
--- a/libguile/vm-i-loader.c
+++ b/libguile/vm-i-loader.c
@@ -172,16 +172,6 @@ VM_DEFINE_INSTRUCTION (link_now, "link-now", 0, 1, 1)
   NEXT;
 }
 
-VM_DEFINE_INSTRUCTION (link_later, "link-later", 0, 2, 1)
-{
-  SCM modname, sym;
-  POP (sym);
-  POP (modname);
-  SYNC_REGISTER ();
-  PUSH (scm_cons (modname, sym));
-  NEXT;
-}
-
 VM_DEFINE_LOADER (define, "define")
 {
   SCM sym;

diff --git a/libguile/vm-i-system.c b/libguile/vm-i-system.c
index e8410f7..5468911 100644 (file)
--- a/libguile/vm-i-system.c
+++ b/libguile/vm-i-system.c
@@ -262,34 +262,33 @@ VM_DEFINE_INSTRUCTION (variable_ref, "variable-ref", 0, 0, 1)
 VM_DEFINE_INSTRUCTION (late_variable_ref, "late-variable-ref", 1, 0, 1)
 {
   unsigned objnum = FETCH ();
-  SCM pair_or_var;
+  SCM sym_or_var;
   CHECK_OBJECT (objnum);
-  pair_or_var = OBJECT_REF (objnum);
+  sym_or_var = OBJECT_REF (objnum);
 
-  if (!SCM_VARIABLEP (pair_or_var)) 
+  if (!SCM_VARIABLEP (sym_or_var)) 
     {
       SYNC_REGISTER ();
-      if (SCM_LIKELY (scm_module_system_booted_p)) 
+      if (SCM_LIKELY (scm_module_system_booted_p && SCM_NFALSEP (bp->module))) 
         {
-          /* either one of these calls might longjmp */
-          SCM mod = scm_resolve_module (SCM_CAR (pair_or_var));
-          pair_or_var = scm_module_lookup (mod, SCM_CDR (pair_or_var));
+          /* might longjmp */
+          sym_or_var = scm_module_lookup (bp->module, sym_or_var);
         }
       else
         {
-          pair_or_var = scm_lookup (SCM_CDR (pair_or_var));
+          sym_or_var = scm_sym2var (sym_or_var, SCM_BOOL_F, SCM_BOOL_F);
         }
           
-      if (!VARIABLE_BOUNDP (pair_or_var))
+      if (!VARIABLE_BOUNDP (sym_or_var))
         {
-          err_args = SCM_LIST1 (pair_or_var);
+          err_args = SCM_LIST1 (sym_or_var);
           goto vm_error_unbound;
         }
 
-      OBJECT_SET (objnum, pair_or_var);
+      OBJECT_SET (objnum, sym_or_var);
     }
 
-  PUSH (VARIABLE_REF (pair_or_var));
+  PUSH (VARIABLE_REF (sym_or_var));
   NEXT;
 }
 
@@ -327,28 +326,27 @@ VM_DEFINE_INSTRUCTION (variable_set, "variable-set", 0, 1, 0)
 VM_DEFINE_INSTRUCTION (late_variable_set, "late-variable-set", 1, 1, 0)
 {
   unsigned objnum = FETCH ();
-  SCM pair_or_var;
+  SCM sym_or_var;
   CHECK_OBJECT (objnum);
-  pair_or_var = OBJECT_REF (objnum);
+  sym_or_var = OBJECT_REF (objnum);
 
-  if (!SCM_VARIABLEP (pair_or_var)) 
+  if (!SCM_VARIABLEP (sym_or_var)) 
     {
       SYNC_BEFORE_GC ();
-      if (SCM_LIKELY (scm_module_system_booted_p)) 
+      if (SCM_LIKELY (scm_module_system_booted_p && SCM_NFALSEP (bp->module))) 
         {
-          /* either one of these calls might longjmp */
-          SCM mod = scm_resolve_module (SCM_CAR (pair_or_var));
-          pair_or_var = scm_module_lookup (mod, SCM_CDR (pair_or_var));
+          /* might longjmp */
+          sym_or_var = scm_module_lookup (bp->module, sym_or_var);
         }
       else
         {
-          pair_or_var = scm_lookup (SCM_CDR (pair_or_var));
+          sym_or_var = scm_sym2var (sym_or_var, SCM_BOOL_F, SCM_BOOL_F);
         }
 
-      OBJECT_SET (objnum, pair_or_var);
+      OBJECT_SET (objnum, sym_or_var);
     }
 
-  VARIABLE_SET (pair_or_var, *sp);
+  VARIABLE_SET (sym_or_var, *sp);
   DROP ();
   NEXT;
 }

diff --git a/module/system/il/ghil.scm b/module/system/il/ghil.scm
index dc8be3e..2a03109 100644 (file)
--- a/module/system/il/ghil.scm
+++ b/module/system/il/ghil.scm
@@ -161,21 +161,9 @@
 ;; "external" so that it goes on the heap.
 ;;
 ;; If the variable is not found lexically, it is a toplevel variable,
-;; which will be looked up at runtime with respect to the module that is
-;; current at compile-time. The variable will be resolved when it is
-;; first used.
-;; 
-;; You might think that you want to look up all variables with respect
-;; to the current runtime module, but you would have to associate the
-;; current module with a closure, so that lazy lookup is done with
-;; respect to the proper module. We could do that -- it would probably
-;; cons less at runtime.
-;;
-;; This toplevel lookup strategy can exhibit weird effects in the case
-;; of a call to set-current-module inside a closure -- specifically,
-;; looking up any needed bindings for the rest of the closure in the
-;; compilation module instead of the runtime module -- but such things
-;; are both unspecified in the scheme standard.
+;; which will be looked up at runtime with respect to the module that
+;; was current when the lambda was bound, at runtime. The variable will
+;; be resolved when it is first used.
 (define (ghil-lookup env sym)
   (let loop ((e env))
     (record-case e

diff --git a/module/system/vm/assemble.scm b/module/system/vm/assemble.scm
index 72437db..efb9830 100644 (file)
--- a/module/system/vm/assemble.scm
+++ b/module/system/vm/assemble.scm
@@ -285,9 +285,7 @@
         ;; dump bytecode
         (push-code! `(load-program ,bytes)))
        ((<vlink-later> module name)
-         (dump! module)
-         (dump! name)
-        (push-code! '(link-later)))
+         (dump! name))
        ((<vlink-now> name)
          (dump! name)
         (push-code! '(link-now)))

diff --git a/module/system/vm/program.scm b/module/system/vm/program.scm
index 5c17044..25f403c 100644 (file)
--- a/module/system/vm/program.scm
+++ b/module/system/vm/program.scm
@@ -28,7 +28,7 @@
            
            program-arity program-external-set! program-meta
            program-bytecode program? program-objects
-           program-base program-external))
+           program-module program-base program-external))
 
 (dynamic-call "scm_init_programs" (dynamic-link "libguile"))