* src/vm_system.c (push_list): New instruction.

* src/vm_engine.c (VM_NAME): Don\'t validate VM and PROGRAM.
* src/vm.c (scm_vm_apply): New procedure.
(apply_program): New function.
(init_program_type): Set the apply function for the program type.

* src/vm.c (lookup_variable): Use scm_eval_closure_lookup.

diff --git a/src/vm.c b/src/vm.c
index 1fd5aa7..53a572e 100644 (file)
--- a/src/vm.c
+++ b/src/vm.c
@@ -339,10 +339,10 @@ init_bytecode_type ()
 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);
+  SCM eclo = scm_standard_eval_closure (scm_selected_module ());
+  SCM var = scm_eval_closure_lookup (eclo, sym, SCM_BOOL_F);
   if (SCM_FALSEP (var))
-    var = scm_apply (closure, SCM_LIST2 (sym, SCM_BOOL_T), SCM_EOL);
+    var = scm_eval_closure_lookup (eclo, sym, SCM_BOOL_T);
   return var;
 }
 
@@ -570,12 +570,22 @@ print_program (SCM obj, SCM port, scm_print_state *pstate)
   return 1;
 }
 
+static SCM scm_vm_apply (SCM vm, SCM program, SCM args);
+static SCM make_vm (int stack_size);
+
+static SCM
+apply_program (SCM program, SCM args)
+{
+  return scm_vm_apply (make_vm (VM_DEFAULT_STACK_SIZE), program, args);
+}
+
 static void
 init_program_type ()
 {
   scm_program_tag = scm_make_smob_type ("program", 0);
   scm_set_smob_mark (scm_program_tag, mark_program);
   scm_set_smob_print (scm_program_tag, print_program);
+  scm_set_smob_apply (scm_program_tag, apply_program, 0, 0, 1);
 }
 
 /* Scheme interface */
@@ -1115,7 +1125,7 @@ SCM_DEFINE (scm_vm_run, "vm-run", 2, 0, 0,
   if (SCM_EQ_P (template[0], SCM_PACK (0)))
     {
       template[0] = VM_CODE ("%loadc");
-      template[1] = SCM_BOOL_F;
+      template[1] = SCM_BOOL_F; /* overwritten */
       template[2] = VM_CODE ("%call");
       template[3] = SCM_MAKINUM (0);
       template[4] = VM_CODE ("%halt");
@@ -1140,6 +1150,51 @@ SCM_DEFINE (scm_vm_run, "vm-run", 2, 0, 0,
 }
 #undef FUNC_NAME
 
+SCM_DEFINE (scm_vm_apply, "vm-apply", 3, 0, 0,
+           (SCM vm, SCM program, SCM args),
+"")
+#define FUNC_NAME s_scm_vm_apply
+{
+  int len;
+  SCM bootcode;
+  static SCM template[7];
+
+  SCM_VALIDATE_VM (1, vm);
+  SCM_VALIDATE_PROGRAM (2, program);
+  SCM_VALIDATE_LIST_COPYLEN (3, args, len);
+
+  if (SCM_EQ_P (template[0], SCM_PACK (0)))
+    {
+      template[0] = VM_CODE ("%push-list");
+      template[1] = SCM_EOL; /* overwritten */
+      template[2] = VM_CODE ("%loadc");
+      template[3] = SCM_BOOL_F; /* overwritten */
+      template[4] = VM_CODE ("%call");
+      template[5] = SCM_MAKINUM (0); /* overwritten */
+      template[6] = VM_CODE ("%halt");
+    }
+
+  /* Create a boot program */
+  bootcode = make_bytecode (7);
+  memcpy (SCM_BYTECODE_BASE (bootcode), template, sizeof (SCM) * 7);
+  SCM_BYTECODE_BASE (bootcode)[1] = args;
+  SCM_BYTECODE_BASE (bootcode)[3] = program;
+  SCM_BYTECODE_BASE (bootcode)[5] = SCM_MAKINUM (len);
+  SCM_BYTECODE_SIZE (bootcode)    = 7;
+  SCM_BYTECODE_EXTS (bootcode)    = NULL;
+  SCM_BYTECODE_NREQS (bootcode)   = 0;
+  SCM_BYTECODE_RESTP (bootcode)   = 0;
+  SCM_BYTECODE_NVARS (bootcode)   = 0;
+  SCM_BYTECODE_NEXTS (bootcode)   = 0;
+  program = SCM_MAKE_PROGRAM (bootcode, SCM_BOOL_F);
+
+  if (SCM_FALSEP (scm_vm_option (vm, sym_debug)))
+    return scm_regular_vm (vm, program);
+  else
+    return scm_debug_vm (vm, program);
+}
+#undef FUNC_NAME
+
 \f
 /*
  * The VM engines

diff --git a/src/vm_engine.c b/src/vm_engine.c
index d3c21d2..dbf68c5 100644 (file)
--- a/src/vm_engine.c
+++ b/src/vm_engine.c
@@ -94,9 +94,6 @@ VM_NAME (SCM vm, SCM program)
       return SCM_UNSPECIFIED;
     }
 
-  SCM_VALIDATE_VM (1, vm);
-  SCM_VALIDATE_PROGRAM (2, program);
-
   /* Initialize the VM */
   vmp     = SCM_VM_DATA (vm);
   vmp->pc = SCM_PROGRAM_BASE (program);

diff --git a/src/vm_system.c b/src/vm_system.c
index f75b7e7..47688fa 100644 (file)
--- a/src/vm_system.c
+++ b/src/vm_system.c
@@ -94,6 +94,14 @@ SCM_DEFINE_INSTRUCTION (push, "%push", INST_NONE)
   NEXT;
 }
 
+SCM_DEFINE_INSTRUCTION (push_list, "%push-list", INST_SCM)
+{
+  SCM list;
+  for (list = FETCH (); SCM_NIMP (list); list = SCM_CDR (list))
+    PUSH (SCM_CAR (list));
+  NEXT;
+}
+
 SCM_DEFINE_INSTRUCTION (pushc, "%pushc", INST_SCM)
 {
   PUSH (FETCH ());