diff --git a/src/vm.c b/src/vm.c index c614409f7..1fd5aa751 100644 --- a/src/vm.c +++ b/src/vm.c @@ -334,6 +334,18 @@ init_bytecode_type () scm_set_smob_free (scm_bytecode_tag, free_bytecode); } +/* Internal functions */ + +static SCM +lookup_variable (SCM sym) +{ + SCM closure = scm_standard_eval_closure (scm_selected_module ()); + SCM var = scm_apply (closure, SCM_LIST2 (sym, SCM_BOOL_F), SCM_EOL); + if (SCM_FALSEP (var)) + var = scm_apply (closure, SCM_LIST2 (sym, SCM_BOOL_T), SCM_EOL); + return var; +} + /* Scheme interface */ SCM_DEFINE (scm_bytecode_p, "bytecode?", 1, 0, 0, @@ -428,7 +440,7 @@ SCM_DEFINE (scm_make_bytecode, "make-bytecode", 1, 0, 0, case INST_TOP: /* top-level variable */ SCM_VALIDATE_SYMBOL (1, old[i]); - new[i] = scm_intern0 (SCM_CHARS (old[i])); + new[i] = lookup_variable (old[i]); break; case INST_EXT: /* just copy for now */ diff --git a/src/vm_engine.h b/src/vm_engine.h index c19aef588..82699a9c7 100644 --- a/src/vm_engine.h +++ b/src/vm_engine.h @@ -95,17 +95,6 @@ * Type checking */ -#define VM_ASSERT_PROGRAM(OBJ) SCM_VALIDATE_PROGRAM (1, OBJ) - -#undef VM_ASSERT_BOUND -#if VM_CHECK_BINDING -#define VM_ASSERT_BOUND(CELL) \ - if (SCM_UNBNDP (SCM_CDR (CELL))) \ - SCM_MISC_ERROR ("Unbound variable: ~S", SCM_LIST1 (SCM_CAR (CELL))) -#else -#define VM_ASSERT_BOUND(CELL) -#endif - #undef VM_ASSERT_LINK #if VM_CHECK_LINK #define VM_ASSERT_LINK(OBJ) \ @@ -115,6 +104,23 @@ #define VM_ASSERT_LINK(OBJ) #endif + +/* + * Top-level variable + */ + +#define VM_VARIABLE_REF(VAR) SCM_CDDR (VAR) +#define VM_VARIABLE_SET(VAR,VAL) SCM_SETCDR (SCM_CDR (VAR), VAL) + +#undef VM_ASSERT_BOUND +#if VM_CHECK_BINDING +#define VM_ASSERT_BOUND(VAR) \ + if (SCM_UNBNDP (VM_VARIABLE_REF (VAR))) \ + SCM_MISC_ERROR ("Unbound variable: ~S", SCM_LIST1 (SCM_CADR (VAR))) +#else +#define VM_ASSERT_BOUND(CELL) +#endif + /* * Hooks diff --git a/src/vm_system.c b/src/vm_system.c index fe13fcfb6..324c30990 100644 --- a/src/vm_system.c +++ b/src/vm_system.c @@ -65,9 +65,6 @@ #define EXTERNAL_VAR1(OFFSET) SCM_VM_EXTERNAL_VARIABLE (SCM_VM_EXTERNAL_LINK (ext), OFFSET) #define EXTERNAL_VAR2(OFFSET) SCM_VM_EXTERNAL_VARIABLE (SCM_VM_EXTERNAL_LINK (SCM_VM_EXTERNAL_LINK (ext)), OFFSET) -#define TOPLEVEL_VAR(CELL) SCM_CDR (CELL) -#define TOPLEVEL_VAR_SET(CELL,OBJ) SCM_SETCDR (CELL, OBJ) - /* * Basic operations @@ -176,7 +173,7 @@ SCM_DEFINE_INSTRUCTION (pusht, "%pusht", INST_TOP) { ac = FETCH (); VM_ASSERT_BOUND (ac); - PUSH (TOPLEVEL_VAR (ac)); + PUSH (VM_VARIABLE_REF (ac)); NEXT; } @@ -257,7 +254,7 @@ SCM_DEFINE_INSTRUCTION (loadt, "%loadt", INST_TOP) { ac = FETCH (); VM_ASSERT_BOUND (ac); - RETURN (TOPLEVEL_VAR (ac)); + RETURN (VM_VARIABLE_REF (ac)); } @@ -338,7 +335,7 @@ SCM_DEFINE_INSTRUCTION (savet, "%savet", INST_TOP) { SCM cell = FETCH (); scm_set_object_property_x (ac, scm_sym_name, SCM_CAR (cell)); - TOPLEVEL_VAR_SET (cell, ac); + VM_VARIABLE_SET (cell, ac); NEXT; }