mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-04-30 03:40:34 +02:00
Code Activity

refactoring for toplevel-ref, toplevel-set, link-now

Browse source 
* 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:
Andy Wingo 2009-06-05 11:47:19 +02:00
parent 42193dac58
commit b7393ea123
4 changed files with 40 additions and 98 deletions
Download patch file Download diff file Expand all files Collapse all files

4
libguile/vm-engine.c
View file

@ -212,10 +212,6 @@ VM_NAME (struct scm_vm *vp, SCM program, SCM *argv, int nargs)
finish_args = SCM_EOL; finish_args = SCM_EOL;
goto vm_error; 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 #if VM_CHECK_IP
vm_error_invalid_address: vm_error_invalid_address:
err_msg = scm_from_locale_string ("VM: Invalid program address"); err_msg = scm_from_locale_string ("VM: Invalid program address");

24
libguile/vm-i-loader.c
View file

@ -124,29 +124,7 @@ VM_DEFINE_INSTRUCTION (66, link_now, "link-now", 0, 1, 1)
SCM what; SCM what;
POP (what); POP (what);
SYNC_REGISTER (); SYNC_REGISTER ();
if (SCM_LIKELY (SCM_SYMBOLP (what))) PUSH (resolve_variable (what, scm_current_module ()));
{
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)));
}
NEXT; NEXT;
} }

73
libguile/vm-i-system.c
View file

@ -278,47 +278,12 @@ VM_DEFINE_INSTRUCTION (25, toplevel_ref, "toplevel-ref", 1, 0, 1)
if (!SCM_VARIABLEP (what)) if (!SCM_VARIABLEP (what))
{ {
SYNC_REGISTER (); SYNC_REGISTER ();
if (SCM_LIKELY (SCM_SYMBOLP (what))) what = resolve_variable (what, scm_program_module (program));
{
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));
}
if (!VARIABLE_BOUNDP (what)) if (!VARIABLE_BOUNDP (what))
{ {
finish_args = scm_list_1 (what); finish_args = scm_list_1 (what);
goto vm_error_unbound; goto vm_error_unbound;
} }
OBJECT_SET (objnum, what); OBJECT_SET (objnum, what);
} }
@ -367,41 +332,7 @@ VM_DEFINE_INSTRUCTION (29, toplevel_set, "toplevel-set", 1, 1, 0)
if (!SCM_VARIABLEP (what)) if (!SCM_VARIABLEP (what))
{ {
SYNC_BEFORE_GC (); SYNC_BEFORE_GC ();
if (SCM_LIKELY (SCM_SYMBOLP (what))) what = resolve_variable (what, scm_program_module (program));
{
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));
}
OBJECT_SET (objnum, what); OBJECT_SET (objnum, what);
} }

37
libguile/vm.c
View file

@ -267,6 +267,43 @@ vm_make_boot_program (long nargs)
* VM * 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_DEFAULT_STACK_SIZE (16 * 1024)
#define VM_NAME vm_regular_engine #define VM_NAME vm_regular_engine