diff options
author | Andy Wingo <wingo@pobox.com> | 2008-05-19 19:37:39 +0200 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2008-05-19 19:37:39 +0200 |
commit | 6297d22907ef28d6dc059db3bbcd711d9b7c50a1 (patch) | |
tree | 3d23c3f8155b0fce6de1febf2d4dae13e6b589a3 /src | |
parent | 9cc649b880fe81ff4b2dd1929beb45ea313dee42 (diff) | |
download | guile-6297d22907ef28d6dc059db3bbcd711d9b7c50a1.tar.gz |
bind all module-level variables lazily
comments in ghil-lookup are pertinent.
* module/system/il/compile.scm (make-glil-var): Require that ghil vars
have environments. Remove the 'unresolved case -- we'll treat all
module-level variables as late bound.
* module/system/il/ghil.scm (ghil-lookup): Treat all module level vars as
late bound.
* module/system/vm/assemble.scm: Instead of vlink and vlate-bound, have
vlink-now and vlink-later.
(codegen): Add a bunch of crap to get the various cases right.
(object-assoc, dump-object!): Handle the new cases, remove the old
cases.
* src/vm_loader.c (link-now, link-later): Change from link and lazy-bind.
Include the module in which the link is to be done, so that callers
from other modules get the right behavior.
* src/vm_system.c (late-variable-ref, late-variable-set): Instead of a
sym, the unbound representation is a module name / symbol pair.
* testsuite/run-vm-tests.scm (run-vm-tests): Remove some debugging.
Diffstat (limited to 'src')
-rw-r--r-- | src/vm_loader.c | 32 | ||||
-rw-r--r-- | src/vm_system.c | 41 |
2 files changed, 32 insertions, 41 deletions
diff --git a/src/vm_loader.c b/src/vm_loader.c index d8bf554a8..aa9cd356c 100644 --- a/src/vm_loader.c +++ b/src/vm_loader.c @@ -176,29 +176,21 @@ VM_DEFINE_LOADER (load_program, "load-program") NEXT; } -/* this seems to be a bit too much processing for one instruction.. */ -VM_DEFINE_INSTRUCTION (link, "link", 0, 2, 1) +VM_DEFINE_INSTRUCTION (link_now, "link-now", 0, 2, 1) { - SCM modname, mod, sym; + SCM modname, sym; POP (sym); POP (modname); - if (SCM_NFALSEP (modname)) - { - mod = scm_resolve_module (modname); - - if (mod != scm_current_module ()) - { - mod = scm_c_module_lookup (mod, "%module-public-interface"); - if (SCM_FALSEP (mod)) - SCM_MISC_ERROR ("Could not load module", SCM_LIST1 (modname)); - mod = SCM_VARIABLE_REF (mod); - } - - PUSH (scm_module_lookup (mod, sym)); - } - else - PUSH (scm_lookup (sym)); - + PUSH (scm_module_lookup (scm_resolve_module (modname), sym)); /* might longjmp */ + NEXT; +} + +VM_DEFINE_INSTRUCTION (link_later, "link-later", 0, 2, 1) +{ + SCM modname, sym; + POP (sym); + POP (modname); + PUSH (scm_cons (modname, sym)); NEXT; } diff --git a/src/vm_system.c b/src/vm_system.c index 6daa818a7..f227e79fa 100644 --- a/src/vm_system.c +++ b/src/vm_system.c @@ -259,23 +259,25 @@ VM_DEFINE_INSTRUCTION (variable_ref, "variable-ref", 0, 0, 1) VM_DEFINE_INSTRUCTION (late_variable_ref, "late-variable-ref", 1, 0, 1) { - register unsigned objnum = FETCH (); - SCM x; + unsigned objnum = FETCH (); + SCM pair_or_var; CHECK_OBJECT (objnum); - x = OBJECT_REF (objnum); + pair_or_var = OBJECT_REF (objnum); - if (!SCM_VARIABLEP (x)) + if (!SCM_VARIABLEP (pair_or_var)) { - x = scm_lookup (x); /* might longjmp */ - OBJECT_SET (objnum, x); - if (!VARIABLE_BOUNDP (x)) + SCM mod = scm_resolve_module (SCM_CAR (pair_or_var)); + /* module_lookup might longjmp */ + pair_or_var = scm_module_lookup (mod, SCM_CDR (pair_or_var)); + OBJECT_SET (objnum, pair_or_var); + if (!VARIABLE_BOUNDP (pair_or_var)) { - err_args = SCM_LIST1 (x); + err_args = SCM_LIST1 (pair_or_var); goto vm_error_unbound; } } - PUSH (VARIABLE_REF (x)); + PUSH (VARIABLE_REF (pair_or_var)); NEXT; } @@ -313,23 +315,20 @@ VM_DEFINE_INSTRUCTION (variable_set, "variable-set", 0, 1, 0) VM_DEFINE_INSTRUCTION (late_variable_set, "late-variable-set", 1, 1, 0) { - register unsigned objnum = FETCH (); - SCM x; + unsigned objnum = FETCH (); + SCM pair_or_var; CHECK_OBJECT (objnum); - x = OBJECT_REF (objnum); + pair_or_var = OBJECT_REF (objnum); - if (!SCM_VARIABLEP (x)) + if (!SCM_VARIABLEP (pair_or_var)) { - x = scm_lookup (x); /* might longjmp */ - OBJECT_SET (objnum, x); - if (!VARIABLE_BOUNDP (x)) - { - err_args = SCM_LIST1 (x); - goto vm_error_unbound; - } + SCM mod = scm_resolve_module (SCM_CAR (pair_or_var)); + /* module_lookup might longjmp */ + pair_or_var = scm_module_lookup (mod, SCM_CDR (pair_or_var)); + OBJECT_SET (objnum, pair_or_var); } - VARIABLE_SET (x, *sp); + VARIABLE_SET (pair_or_var, *sp); DROP (); NEXT; } |