mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-18 17:50:29 +02:00
Code Activity

tc7 tags for vm-related data

Browse source 
* libguile/tags.h (scm_tc7_frame, scm_tc7_objcode, scm_tc7_vm)
  (scm_tc7_vm_cont): Take more tc7s for VM-related data structures.

* libguile/evalext.c (scm_self_evaluating_p):
* libguile/gc.c (scm_i_tag_name):
* libguile/goops.c (scm_class_of, create_standard_classes):
* libguile/print.c (iprin1): Add cases for the new tc7s.

* libguile/frames.c:
* libguile/frames.h:
* libguile/objcodes.c:
* libguile/objcodes.h:
* libguile/vm.c:
* libguile/vm.h: Desmobify.

* libguile/vm.c (scm_vm_apply): Export to Scheme, because VM objects are
  no longer applicable.

* module/system/repl/command.scm (profile):
* module/system/vm/trace.scm (vm-trace):
* module/system/vm/vm.scm (vm-load): Call vm-apply to run a program in a
  VM instead of treating the VM as applicable.
This commit is contained in:
Andy Wingo 2010-01-05 19:45:56 +01:00
parent a6029b97ea
commit 6f3b0cc29e
15 changed files with 119 additions and 78 deletions
Download patch file Download diff file Expand all files Collapse all files

37
libguile/vm.c
View file

@ -71,7 +71,13 @@
* VM Continuation
*/
scm_t_bits scm_tc16_vm_cont;
void
scm_i_vm_cont_print (SCM x, SCM port, scm_print_state *pstate)
{
scm_puts ("#<vm-continuation ", port);
scm_uintprint (SCM_UNPACK (x), 16, port);
scm_puts (">", port);
}
static SCM
capture_vm_cont (struct scm_vm *vp)
@ -91,7 +97,7 @@ capture_vm_cont (struct scm_vm *vp)
p->fp = vp->fp;
memcpy (p->stack_base, vp->stack_base, p->stack_size * sizeof (SCM));
p->reloc = p->stack_base - vp->stack_base;
SCM_RETURN_NEWSMOB (scm_tc16_vm_cont, p);
return scm_cell (scm_tc7_vm_cont, (scm_t_bits)p);
}
static void
@ -173,6 +179,14 @@ SCM_SYMBOL (sym_vm_error, "vm-error");
SCM_SYMBOL (sym_keyword_argument_error, "keyword-argument-error");
SCM_SYMBOL (sym_debug, "debug");
void
scm_i_vm_print (SCM x, SCM port, scm_print_state *pstate)
{
scm_puts ("#<vm ", port);
scm_uintprint (SCM_UNPACK (x), 16, port);
scm_puts (">", port);
}
static SCM
really_make_boot_program (long nargs)
{
@ -315,8 +329,6 @@ apply_foreign (SCM proc, SCM *args, int nargs, int headroom)
static const scm_t_vm_engine vm_engines[] =
{ vm_regular_engine, vm_debug_engine };
scm_t_bits scm_tc16_vm;
#ifdef VM_ENABLE_PRECISE_STACK_GC_SCAN
/* The GC "kind" for the VM stack. */
@ -331,9 +343,6 @@ make_vm (void)
int i;
struct scm_vm *vp;
if (!scm_tc16_vm)
return SCM_BOOL_F; /* not booted yet */
vp = scm_gc_malloc (sizeof (struct scm_vm), "vm");
vp->stack_size = VM_DEFAULT_STACK_SIZE;
@ -364,7 +373,7 @@ make_vm (void)
vp->trace_level = 0;
for (i = 0; i < SCM_VM_NUM_HOOKS; i++)
vp->hooks[i] = SCM_BOOL_F;
SCM_RETURN_NEWSMOB (scm_tc16_vm, vp);
return scm_cell (scm_tc7_vm, (scm_t_bits)vp);
}
#undef FUNC_NAME
@ -407,9 +416,10 @@ scm_c_vm_run (SCM vm, SCM program, SCM *argv, int nargs)
return vm_engines[vp->engine](vm, program, argv, nargs);
}
SCM
scm_vm_apply (SCM vm, SCM program, SCM args)
#define FUNC_NAME "scm_vm_apply"
SCM_DEFINE (scm_vm_apply, "vm-apply", 3, 0, 0,
(SCM vm, SCM program, SCM args),
"")
#define FUNC_NAME s_scm_vm_apply
{
SCM *argv;
int i, nargs;
@ -653,11 +663,6 @@ SCM scm_load_compiled_with_vm (SCM file)
void
scm_bootstrap_vm (void)
{
scm_tc16_vm_cont = scm_make_smob_type ("vm-cont", 0);
scm_tc16_vm = scm_make_smob_type ("vm", 0);
scm_set_smob_apply (scm_tc16_vm, scm_vm_apply, 1, 0, 1);
scm_c_register_extension ("libguile", "scm_init_vm",
(scm_t_extension_init_func)scm_init_vm, NULL);