mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-04-30 03:40:34 +02:00
refactoring for toplevel-ref, toplevel-set, link-now
* libguile/vm-i-system.c (toplevel-ref, toplevel-set) * libguile/vm-i-loader.c (link-now): * libguile/vm.c (resolve_variable): Factor out common code to a static method. The compiler can still inline it, so it shouldn't have a significant performance effect. * libguile/vm-engine.c (vm_error_no_such_module): Remove now-unused label.
This commit is contained in:
parent
42193dac58
commit
b7393ea123
4 changed files with 40 additions and 98 deletions
|
@ -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");
|
||||
|
|
|
@ -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;
|
||||
}
|
||||
|
||||
|
|
|
@ -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);
|
||||
}
|
||||
|
||||
|
|
|
@ -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
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue