summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--libguile/vm-engine.c4
-rw-r--r--libguile/vm-i-loader.c24
-rw-r--r--libguile/vm-i-system.c73
-rw-r--r--libguile/vm.c37
4 files changed, 40 insertions, 98 deletions
diff --git a/libguile/vm-engine.c b/libguile/vm-engine.c
index f43f8c7fe..34764c659 100644
--- a/libguile/vm-engine.c
+++ b/libguile/vm-engine.c
@@ -212,10 +212,6 @@ VM_NAME (struct scm_vm *vp, SCM program, SCM *argv, int nargs)
finish_args = SCM_EOL;
goto vm_error;
- vm_error_no_such_module:
- err_msg = scm_from_locale_string ("VM: No such module: ~A");
- goto vm_error;
-
#if VM_CHECK_IP
vm_error_invalid_address:
err_msg = scm_from_locale_string ("VM: Invalid program address");
diff --git a/libguile/vm-i-loader.c b/libguile/vm-i-loader.c
index 515001d61..b231d392f 100644
--- a/libguile/vm-i-loader.c
+++ b/libguile/vm-i-loader.c
@@ -124,29 +124,7 @@ VM_DEFINE_INSTRUCTION (66, link_now, "link-now", 0, 1, 1)
SCM what;
POP (what);
SYNC_REGISTER ();
- if (SCM_LIKELY (SCM_SYMBOLP (what)))
- {
- PUSH (scm_lookup (what)); /* might longjmp */
- }
- else
- {
- SCM mod;
- /* compilation of @ or @@
- `what' is a three-element list: (MODNAME SYM INTERFACE?)
- INTERFACE? is #t if we compiled @ or #f if we compiled @@
- */
- mod = scm_resolve_module (SCM_CAR (what));
- if (scm_is_true (SCM_CADDR (what)))
- mod = scm_module_public_interface (mod);
- if (SCM_FALSEP (mod))
- {
- finish_args = scm_list_1 (SCM_CAR (what));
- goto vm_error_no_such_module;
- }
- /* might longjmp */
- PUSH (scm_module_lookup (mod, SCM_CADR (what)));
- }
-
+ PUSH (resolve_variable (what, scm_current_module ()));
NEXT;
}
diff --git a/libguile/vm-i-system.c b/libguile/vm-i-system.c
index 42f2b1973..32b772afa 100644
--- a/libguile/vm-i-system.c
+++ b/libguile/vm-i-system.c
@@ -278,47 +278,12 @@ VM_DEFINE_INSTRUCTION (25, toplevel_ref, "toplevel-ref", 1, 0, 1)
if (!SCM_VARIABLEP (what))
{
SYNC_REGISTER ();
- if (SCM_LIKELY (SCM_SYMBOLP (what)))
- {
- SCM mod = SCM_EOL;
- if (SCM_LIKELY (scm_module_system_booted_p
- && scm_is_true ((mod = scm_program_module (program)))))
- /* might longjmp */
- what = scm_module_lookup (mod, what);
- else
- {
- SCM v = scm_sym2var (what, SCM_BOOL_F, SCM_BOOL_F);
- if (scm_is_false (v))
- SCM_MISC_ERROR ("unbound variable: ~S", scm_list_1 (what));
- else
- what = v;
- }
- }
- else
- {
- SCM mod;
- /* compilation of @ or @@
- `what' is a three-element list: (MODNAME SYM INTERFACE?)
- INTERFACE? is #t if we compiled @ or #f if we compiled @@
- */
- mod = scm_resolve_module (SCM_CAR (what));
- if (scm_is_true (SCM_CADDR (what)))
- mod = scm_module_public_interface (mod);
- if (SCM_FALSEP (mod))
- {
- finish_args = scm_list_1 (mod);
- goto vm_error_no_such_module;
- }
- /* might longjmp */
- what = scm_module_lookup (mod, SCM_CADR (what));
- }
-
+ what = resolve_variable (what, scm_program_module (program));
if (!VARIABLE_BOUNDP (what))
{
finish_args = scm_list_1 (what);
goto vm_error_unbound;
}
-
OBJECT_SET (objnum, what);
}
@@ -367,41 +332,7 @@ VM_DEFINE_INSTRUCTION (29, toplevel_set, "toplevel-set", 1, 1, 0)
if (!SCM_VARIABLEP (what))
{
SYNC_BEFORE_GC ();
- if (SCM_LIKELY (SCM_SYMBOLP (what)))
- {
- SCM mod = SCM_EOL;
- if (SCM_LIKELY (scm_module_system_booted_p
- && scm_is_true ((mod = scm_program_module (program)))))
- /* might longjmp */
- what = scm_module_lookup (mod, what);
- else
- {
- SCM v = scm_sym2var (what, SCM_BOOL_F, SCM_BOOL_F);
- if (scm_is_false (v))
- SCM_MISC_ERROR ("unbound variable: ~S", scm_list_1 (what));
- else
- what = v;
- }
- }
- else
- {
- SCM mod;
- /* compilation of @ or @@
- `what' is a three-element list: (MODNAME SYM INTERFACE?)
- INTERFACE? is #t if we compiled @ or #f if we compiled @@
- */
- mod = scm_resolve_module (SCM_CAR (what));
- if (scm_is_true (SCM_CADDR (what)))
- mod = scm_module_public_interface (mod);
- if (SCM_FALSEP (mod))
- {
- finish_args = scm_list_1 (what);
- goto vm_error_no_such_module;
- }
- /* might longjmp */
- what = scm_module_lookup (mod, SCM_CADR (what));
- }
-
+ what = resolve_variable (what, scm_program_module (program));
OBJECT_SET (objnum, what);
}
diff --git a/libguile/vm.c b/libguile/vm.c
index 081a691ff..f708b2108 100644
--- a/libguile/vm.c
+++ b/libguile/vm.c
@@ -267,6 +267,43 @@ vm_make_boot_program (long nargs)
* VM
*/
+static SCM
+resolve_variable (SCM what, SCM program_module)
+{
+ if (SCM_LIKELY (SCM_SYMBOLP (what)))
+ {
+ if (SCM_LIKELY (scm_module_system_booted_p
+ && scm_is_true (program_module)))
+ /* might longjmp */
+ return scm_module_lookup (program_module, what);
+ else
+ {
+ SCM v = scm_sym2var (what, SCM_BOOL_F, SCM_BOOL_F);
+ if (scm_is_false (v))
+ scm_misc_error (NULL, "unbound variable: ~S", scm_list_1 (what));
+ else
+ return v;
+ }
+ }
+ else
+ {
+ SCM mod;
+ /* compilation of @ or @@
+ `what' is a three-element list: (MODNAME SYM INTERFACE?)
+ INTERFACE? is #t if we compiled @ or #f if we compiled @@
+ */
+ mod = scm_resolve_module (SCM_CAR (what));
+ if (scm_is_true (SCM_CADDR (what)))
+ mod = scm_module_public_interface (mod);
+ if (SCM_FALSEP (mod))
+ scm_misc_error (NULL, "no such module: ~S",
+ scm_list_1 (SCM_CAR (what)));
+ /* might longjmp */
+ return scm_module_lookup (mod, SCM_CADR (what));
+ }
+}
+
+
#define VM_DEFAULT_STACK_SIZE (16 * 1024)
#define VM_NAME vm_regular_engine