diff --git a/libguile/programs.c b/libguile/programs.c index 436e2b863..1b3895ba2 100644 --- a/libguile/programs.c +++ b/libguile/programs.c @@ -46,6 +46,7 @@ #include #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 04f2d459d..0f1b57dd3 100644 --- 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 2816d3309..34d1cec92 100644 --- 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 e8410f7da..546891169 100644 --- 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 dc8be3e4d..2a031094c 100644 --- 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 72437dbb8..efb98307e 100644 --- a/module/system/vm/assemble.scm +++ b/module/system/vm/assemble.scm @@ -285,9 +285,7 @@ ;; dump bytecode (push-code! `(load-program ,bytes))) (( module name) - (dump! module) - (dump! name) - (push-code! '(link-later))) + (dump! name)) (( name) (dump! name) (push-code! '(link-now))) diff --git a/module/system/vm/program.scm b/module/system/vm/program.scm index 5c1704490..25f403c2a 100644 --- 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"))