tc7 tags for vm-related data

* 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.

libguile/evalext.c

@@ -81,6 +81,10 @@ SCM_DEFINE (scm_self_evaluating_p, "self-evaluating?", 1, 0, 0,
 	case scm_tc7_hashtable:
 	case scm_tc7_fluid:
 	case scm_tc7_dynamic_state:
+        case scm_tc7_frame:
+        case scm_tc7_objcode:
+        case scm_tc7_vm:
+        case scm_tc7_vm_cont:
 	case scm_tc7_number:
 	case scm_tc7_string:
 	case scm_tc7_smob:

libguile/frames.c

@@ -26,8 +26,6 @@
 #include "frames.h"
 
 
-scm_t_bits scm_tc16_frame;
-
 #define RELOC(frame, val) (val + SCM_VM_FRAME_OFFSET (frame))
 
 SCM
@@ -41,11 +39,11 @@ scm_c_make_frame (SCM stack_holder, SCM *fp, SCM *sp,
   p->sp = sp;
   p->ip = ip;
   p->offset = offset;
-  SCM_RETURN_NEWSMOB (scm_tc16_frame, p);
+  return scm_cell (scm_tc7_frame, (scm_t_bits)p);
 }
 
-static int
+void
-frame_print (SCM frame, SCM port, scm_print_state *pstate)
+scm_i_frame_print (SCM frame, SCM port, scm_print_state *pstate)
 {
   scm_puts ("#<frame ", port);
   scm_uintprint (SCM_UNPACK (frame), 16, port);
@@ -53,8 +51,6 @@ frame_print (SCM frame, SCM port, scm_print_state *pstate)
   scm_write (scm_frame_procedure (frame), port);
   /* don't write args, they can get us into trouble. */
   scm_puts (">", port);
-
-  return 1;
 }
 
 
@@ -291,13 +287,6 @@ SCM_DEFINE (scm_frame_previous, "frame-previous", 1, 0, 0,
 #undef FUNC_NAME
 
 
-void
-scm_bootstrap_frames (void)
-{
-  scm_tc16_frame = scm_make_smob_type ("frame", 0);
-  scm_set_smob_print (scm_tc16_frame, frame_print);
-}
-
 void
 scm_init_frames (void)
 {

libguile/frames.h

@@ -1,4 +1,4 @@
-/* Copyright (C) 2001, 2009 Free Software Foundation, Inc.
+/* Copyright (C) 2001, 2009, 2010 Free Software Foundation, Inc.
  * * 
  * This library is free software; you can redistribute it and/or
  * modify it under the terms of the GNU Lesser General Public License
@@ -87,8 +87,6 @@
  * Heap frames
  */
 
-SCM_API scm_t_bits scm_tc16_frame;
-
 struct scm_frame 
 {
   SCM stack_holder;
@@ -98,8 +96,8 @@ struct scm_frame
   scm_t_ptrdiff offset;
 };
 
-#define SCM_VM_FRAME_P(x)	SCM_SMOB_PREDICATE (scm_tc16_frame, x)
+#define SCM_VM_FRAME_P(x)	(SCM_NIMP (x) && SCM_TYP7 (x) == scm_tc7_frame)
-#define SCM_VM_FRAME_DATA(x)	((struct scm_frame*)SCM_SMOB_DATA (x))
+#define SCM_VM_FRAME_DATA(x)	((struct scm_frame*)SCM_CELL_WORD_1 (x))
 #define SCM_VM_FRAME_STACK_HOLDER(f)	SCM_VM_FRAME_DATA(f)->stack_holder
 #define SCM_VM_FRAME_FP(f)	SCM_VM_FRAME_DATA(f)->fp
 #define SCM_VM_FRAME_SP(f)	SCM_VM_FRAME_DATA(f)->sp
@@ -122,7 +120,8 @@ SCM_API SCM scm_frame_mv_return_address (SCM frame);
 SCM_API SCM scm_frame_dynamic_link (SCM frame);
 SCM_API SCM scm_frame_previous (SCM frame);
 
-SCM_INTERNAL void scm_bootstrap_frames (void);
+SCM_INTERNAL void scm_i_frame_print (SCM frame, SCM port,
+                                     scm_print_state *pstate);
 SCM_INTERNAL void scm_init_frames (void);
 
 #endif /* _SCM_FRAMES_H_ */

libguile/gc.c

@@ -756,6 +756,14 @@ scm_i_tag_name (scm_t_bits tag)
       return "fluid";
     case scm_tc7_dynamic_state:
       return "dynamic state";
+    case scm_tc7_frame:
+      return "frame";
+    case scm_tc7_objcode:
+      return "objcode";
+    case scm_tc7_vm:
+      return "vm";
+    case scm_tc7_vm_cont:
+      return "vm continuation";
     case scm_tc7_wvect:
       return "weak vector";
     case scm_tc7_vector:

libguile/goops.c

@@ -162,6 +162,10 @@ static SCM class_foreign;
 static SCM class_hashtable;
 static SCM class_fluid;
 static SCM class_dynamic_state;
+static SCM class_frame;
+static SCM class_objcode;
+static SCM class_vm;
+static SCM class_vm_cont;
 
 /* Port classes.  Allocate 3 times the maximum number of port types so that
    input ports, output ports, and in/out ports can be stored at different
@@ -223,6 +227,14 @@ SCM_DEFINE (scm_class_of, "class-of", 1, 0, 0,
 	  return class_fluid;
 	case scm_tc7_dynamic_state:
 	  return class_dynamic_state;
+        case scm_tc7_frame:
+	  return class_frame;
+        case scm_tc7_objcode:
+	  return class_objcode;
+        case scm_tc7_vm:
+	  return class_vm;
+        case scm_tc7_vm_cont:
+	  return class_vm_cont;
 	case scm_tc7_string:
 	  return scm_class_string;
         case scm_tc7_number:
@@ -2402,6 +2414,14 @@ create_standard_classes (void)
 	       scm_class_class, scm_class_top,		   SCM_EOL);
   make_stdcls (&class_dynamic_state,	   "<dynamic-state>",
 	       scm_class_class, scm_class_top,		   SCM_EOL);
+  make_stdcls (&class_frame,		   "<frame>",
+	       scm_class_class, scm_class_top,		   SCM_EOL);
+  make_stdcls (&class_objcode,		   "<objcode>",
+	       scm_class_class, scm_class_top,		   SCM_EOL);
+  make_stdcls (&class_vm,		   "<vm>",
+	       scm_class_class, scm_class_top,		   SCM_EOL);
+  make_stdcls (&class_vm_cont,		   "<vm-continuation>",
+	       scm_class_class, scm_class_top,		   SCM_EOL);
   make_stdcls (&scm_class_number,	   "<number>",
 	       scm_class_class, scm_class_top,		   SCM_EOL);
   make_stdcls (&scm_class_complex,	   "<complex>",

libguile/init.c

@@ -522,11 +522,10 @@ scm_i_init_guile (SCM_STACKITEM *base)
   scm_init_arrays ();    /* Requires smob_prehistory, array-handle */
   scm_init_array_map ();
 
-  scm_bootstrap_frames (); /* requires smob_prehistory */
   scm_bootstrap_instructions ();
-  scm_bootstrap_objcodes (); /* requires smob_prehistory */
+  scm_bootstrap_objcodes ();
   scm_bootstrap_programs ();
-  scm_bootstrap_vm ();  /* requires smob_prehistory */
+  scm_bootstrap_vm ();
 
   scm_init_frames ();   /* Requires smob_prehistory */
   scm_init_stacks ();   /* Requires strings, struct, frames */

libguile/objcodes.c

@@ -42,8 +42,6 @@ verify (((sizeof (SCM_OBJCODE_COOKIE) - 1) & 7) == 0);
  * Objcode type
  */
 
-scm_t_bits scm_tc16_objcode;
-
 static SCM
 make_objcode_by_mmap (int fd)
 #define FUNC_NAME "make_objcode_by_mmap"
@@ -90,9 +88,10 @@ make_objcode_by_mmap (int fd)
 						   + data->metalen)));
     }
 
-  SCM_NEWSMOB3 (sret, scm_tc16_objcode, addr + strlen (SCM_OBJCODE_COOKIE),
+  sret = scm_double_cell (scm_tc7_objcode | (SCM_F_OBJCODE_IS_MMAP<<8),
-                SCM_PACK (SCM_BOOL_F), fd);
+                          (scm_t_bits)(addr + strlen (SCM_OBJCODE_COOKIE)),
-  SCM_SET_SMOB_FLAGS (sret, SCM_F_OBJCODE_IS_MMAP);
+                          SCM_UNPACK (SCM_BOOL_F),
+                          (scm_t_bits)fd);
 
   /* FIXME: we leak ourselves and the file descriptor. but then again so does
      dlopen(). */
@@ -106,7 +105,6 @@ scm_c_make_objcode_slice (SCM parent, const scm_t_uint8 *ptr)
 {
   const struct scm_objcode *data, *parent_data;
   const scm_t_uint8 *parent_base;
-  SCM ret;
 
   SCM_VALIDATE_OBJCODE (1, parent);
   parent_data = SCM_OBJCODE_DATA (parent);
@@ -130,9 +128,8 @@ scm_c_make_objcode_slice (SCM parent, const scm_t_uint8 *ptr)
   assert (SCM_C_OBJCODE_BASE (data) + data->len + data->metalen
 	  <= parent_base + parent_data->len + parent_data->metalen);
 
-  SCM_NEWSMOB2 (ret, scm_tc16_objcode, data, parent);
+  return scm_double_cell (scm_tc7_objcode | (SCM_F_OBJCODE_IS_SLICE<<8),
-  SCM_SET_SMOB_FLAGS (ret, SCM_F_OBJCODE_IS_SLICE);
+                          (scm_t_bits)data, SCM_UNPACK (parent), 0);
-  return ret;
 }
 #undef FUNC_NAME
 
@@ -173,7 +170,6 @@ SCM_DEFINE (scm_bytecode_to_objcode, "bytecode->objcode", 1, 0, 0,
   size_t size;
   const scm_t_uint8 *c_bytecode;
   struct scm_objcode *data;
-  SCM objcode;
 
   if (!scm_is_bytevector (bytecode))
     scm_wrong_type_arg (FUNC_NAME, 1, bytecode);
@@ -189,13 +185,10 @@ SCM_DEFINE (scm_bytecode_to_objcode, "bytecode->objcode", 1, 0, 0,
 		    scm_list_2 (scm_from_size_t (size),
 				scm_from_uint32 (sizeof (*data) + data->len + data->metalen)));
 
-  SCM_NEWSMOB2 (objcode, scm_tc16_objcode, data, bytecode);
-  SCM_SET_SMOB_FLAGS (objcode, SCM_F_OBJCODE_IS_BYTEVECTOR);
-  
   /* foolishly, we assume that as long as bytecode is around, that c_bytecode
      will be of the same length; perhaps a bad assumption? */
-
+  return scm_double_cell (scm_tc7_objcode | (SCM_F_OBJCODE_IS_BYTEVECTOR<<8),
-  return objcode;
+                          (scm_t_bits)data, SCM_UNPACK (bytecode), 0);
 }
 #undef FUNC_NAME
 
@@ -253,11 +246,18 @@ SCM_DEFINE (scm_write_objcode, "write-objcode", 2, 0, 0,
 }
 #undef FUNC_NAME
 
+void
+scm_i_objcode_print (SCM objcode, SCM port, scm_print_state *pstate)
+{
+  scm_puts ("#<objcode ", port);
+  scm_uintprint ((scm_t_bits)SCM_OBJCODE_BASE (objcode), 16, port);
+  scm_puts (">", port);
+}
+
 
 void
 scm_bootstrap_objcodes (void)
 {
-  scm_tc16_objcode = scm_make_smob_type ("objcode", 0);
   scm_c_register_extension ("libguile", "scm_init_objcodes",
                             (scm_t_extension_init_func)scm_init_objcodes, NULL);
 }

libguile/objcodes.h

@@ -39,10 +39,8 @@ struct scm_objcode
 #define SCM_F_OBJCODE_IS_BYTEVECTOR (1<<1)
 #define SCM_F_OBJCODE_IS_SLICE      (1<<2)
 
-SCM_API scm_t_bits scm_tc16_objcode;
+#define SCM_OBJCODE_P(x)	(SCM_NIMP (x) && SCM_TYP7 (x) == scm_tc7_objcode)
-
+#define SCM_OBJCODE_DATA(x)	((struct scm_objcode *) SCM_CELL_WORD_1 (x))
-#define SCM_OBJCODE_P(x)	(SCM_SMOB_PREDICATE (scm_tc16_objcode, x))
-#define SCM_OBJCODE_DATA(x)	((struct scm_objcode *) SCM_SMOB_DATA (x))
 #define SCM_VALIDATE_OBJCODE(p,x) SCM_MAKE_VALIDATE (p, x, OBJCODE_P)
 
 #define SCM_OBJCODE_LEN(x)	(SCM_OBJCODE_DATA (x)->len)
@@ -50,9 +48,10 @@ SCM_API scm_t_bits scm_tc16_objcode;
 #define SCM_OBJCODE_TOTAL_LEN(x) (SCM_OBJCODE_LEN (x) + SCM_OBJCODE_META_LEN (x))
 #define SCM_OBJCODE_BASE(x)	(SCM_C_OBJCODE_BASE (SCM_OBJCODE_DATA (x)))
 
-#define SCM_OBJCODE_IS_MMAP(x)	(SCM_SMOB_FLAGS (x) & SCM_F_OBJCODE_IS_MMAP)
+#define SCM_OBJCODE_FLAGS(x)	(SCM_CELL_WORD_0 (x) >> 8)
-#define SCM_OBJCODE_IS_BYTEVECTOR(x) (SCM_SMOB_FLAGS (x) & SCM_F_OBJCODE_IS_BYTEVECTOR)
+#define SCM_OBJCODE_IS_MMAP(x)	(SCM_OBJCODE_FLAGS (x) & SCM_F_OBJCODE_IS_MMAP)
-#define SCM_OBJCODE_IS_SLICE(x) (SCM_SMOB_FLAGS (x) & SCM_F_OBJCODE_IS_SLICE)
+#define SCM_OBJCODE_IS_BYTEVECTOR(x) (SCM_OBJCODE_FLAGS (x) & SCM_F_OBJCODE_IS_BYTEVECTOR)
+#define SCM_OBJCODE_IS_SLICE(x) (SCM_OBJCODE_FLAGS (x) & SCM_F_OBJCODE_IS_SLICE)
 
 SCM scm_c_make_objcode_slice (SCM parent, const scm_t_uint8 *ptr);
 SCM_API SCM scm_load_objcode (SCM file);
@@ -62,6 +61,8 @@ SCM_API SCM scm_bytecode_to_objcode (SCM bytecode);
 SCM_API SCM scm_objcode_to_bytecode (SCM objcode);
 SCM_API SCM scm_write_objcode (SCM objcode, SCM port);
 
+SCM_INTERNAL void scm_i_objcode_print (SCM objcode, SCM port,
+                                       scm_print_state *pstate);
 SCM_INTERNAL void scm_bootstrap_objcodes (void);
 SCM_INTERNAL void scm_init_objcodes (void);
 

libguile/print.c

@@ -45,6 +45,7 @@
 #include "libguile/vectors.h"
 #include "libguile/lang.h"
 #include "libguile/numbers.h"
+#include "libguile/vm.h"
 
 #include "libguile/validate.h"
 #include "libguile/print.h"
@@ -720,6 +721,18 @@ iprin1 (SCM exp, SCM port, scm_print_state *pstate)
 	case scm_tc7_dynamic_state:
 	  scm_i_dynamic_state_print (exp, port, pstate);
 	  break;
+	case scm_tc7_frame:
+	  scm_i_frame_print (exp, port, pstate);
+	  break;
+	case scm_tc7_objcode:
+	  scm_i_objcode_print (exp, port, pstate);
+	  break;
+	case scm_tc7_vm:
+	  scm_i_vm_print (exp, port, pstate);
+	  break;
+	case scm_tc7_vm_cont:
+	  scm_i_vm_cont_print (exp, port, pstate);
+	  break;
 	case scm_tc7_wvect:
 	  ENTER_NESTED_DATA (pstate, exp, circref);
 	  if (SCM_IS_WHVEC (exp))

libguile/tags.h

@@ -416,10 +416,10 @@ typedef scm_t_uintptr scm_t_bits;
 #define scm_tc7_fluid		37
 #define scm_tc7_dynamic_state	45
 
-#define scm_tc7_unused_4	47
+#define scm_tc7_frame		47
-#define scm_tc7_unused_5	53
+#define scm_tc7_objcode		53
-#define scm_tc7_unused_6	55
+#define scm_tc7_vm		55
-#define scm_tc7_unused_7	71
+#define scm_tc7_vm_cont		71
 
 #define scm_tc7_unused_17	61
 #define scm_tc7_gsubr		63

libguile/vm.c

@@ -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_DEFINE (scm_vm_apply, "vm-apply", 3, 0, 0,
-scm_vm_apply (SCM vm, SCM program, SCM args)
+            (SCM vm, SCM program, SCM args),
-#define FUNC_NAME "scm_vm_apply"
+            "")
+#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);
 

libguile/vm.h

@@ -55,8 +55,8 @@ struct scm_vm {
 
 SCM_API SCM scm_the_vm_fluid;
 
-#define SCM_VM_P(x)		SCM_SMOB_PREDICATE (scm_tc16_vm, x)
+#define SCM_VM_P(x)		(SCM_NIMP (x) && SCM_TYP7 (x) == scm_tc7_vm)
-#define SCM_VM_DATA(vm)		((struct scm_vm *) SCM_SMOB_DATA (vm))
+#define SCM_VM_DATA(vm)		((struct scm_vm *) SCM_CELL_WORD_1 (vm))
 #define SCM_VALIDATE_VM(pos,x)	SCM_MAKE_VALIDATE (pos, x, VM_P)
 
 SCM_API SCM scm_the_vm ();
@@ -95,15 +95,18 @@ struct scm_vm_cont {
   scm_t_ptrdiff reloc;
 };
 
-SCM_API scm_t_bits scm_tc16_vm_cont;
+#define SCM_VM_CONT_P(OBJ)	(SCM_NIMP (OBJ) && SCM_TYP7 (OBJ) == scm_tc7_vm_cont)
-#define SCM_VM_CONT_P(OBJ)	SCM_SMOB_PREDICATE (scm_tc16_vm_cont, OBJ)
+#define SCM_VM_CONT_DATA(CONT)	((struct scm_vm_cont *) SCM_CELL_WORD_1 (CONT))
-#define SCM_VM_CONT_DATA(CONT)	((struct scm_vm_cont *) SCM_SMOB_DATA_1 (CONT))
 
 SCM_API SCM scm_vm_capture_continuations (void);
 SCM_API void scm_vm_reinstate_continuations (SCM conts);
 
 SCM_API SCM scm_load_compiled_with_vm (SCM file);
 
+SCM_INTERNAL void scm_i_vm_print (SCM x, SCM port,
+                                  scm_print_state *pstate);
+SCM_INTERNAL void scm_i_vm_cont_print (SCM x, SCM port,
+                                       scm_print_state *pstate);
 SCM_INTERNAL void scm_bootstrap_vm (void);
 SCM_INTERNAL void scm_init_vm (void);
 

module/system/repl/command.scm

@@ -1,6 +1,6 @@
 ;;; Repl commands
 
-;; Copyright (C) 2001, 2009 Free Software Foundation, Inc.
+;; Copyright (C) 2001, 2009, 2010 Free Software Foundation, Inc.
 
 ;; This library is free software; you can redistribute it and/or
 ;; modify it under the terms of the GNU Lesser General Public
@@ -367,7 +367,7 @@ Profile execution."
   ;; FIXME opts
   (let ((vm (repl-vm repl))
         (proc (make-program (repl-compile repl (repl-parse repl form)))))
-    (with-statprof #:hz 100 (vm proc))))
+    (with-statprof #:hz 100 (vm-apply vm proc '()))))
 
 
 

module/system/vm/trace.scm

@@ -1,6 +1,6 @@
 ;;; Guile VM tracer
 
-;; Copyright (C) 2001, 2009 Free Software Foundation, Inc.
+;; Copyright (C) 2001, 2009, 2010 Free Software Foundation, Inc.
 
 ;;; This library is free software; you can redistribute it and/or
 ;;; modify it under the terms of the GNU Lesser General Public
@@ -28,7 +28,7 @@
 (define (vm-trace vm thunk . opts)
   (dynamic-wind
       (lambda () (apply vm-trace-on! vm opts))
-      (lambda () (vm thunk))
+      (lambda () (vm-apply vm thunk '()))
       (lambda () (apply vm-trace-off! vm opts))))
 
 (define* (vm-trace-on! vm #:key (calls? #t) (instructions? #f))

module/system/vm/vm.scm

@@ -1,6 +1,6 @@
 ;;; Guile VM core
 
-;;; Copyright (C) 2001, 2009 Free Software Foundation, Inc.
+;;; Copyright (C) 2001, 2009, 2010 Free Software Foundation, Inc.
 ;;;
 ;;; This library is free software; you can redistribute it and/or
 ;;; modify it under the terms of the GNU Lesser General Public
@@ -21,7 +21,7 @@
 (define-module (system vm vm)
   #:use-module (system vm frame)
   #:use-module (system vm program)
-  #:export (vm? the-vm make-vm vm-version
+  #:export (vm? the-vm make-vm vm-version vm-apply
             vm:ip vm:sp vm:fp vm:last-ip
 
             vm-load vm-option set-vm-option! vm-version
@@ -37,4 +37,4 @@
 (define (vms:clock stat) (vector-ref stat 1))
 
 (define (vm-load vm objcode)
-  (vm (make-program objcode)))
+  (vm-apply vm (make-program objcode) '()))