fix some compilation warnings, in anticipation of moving to libguile/

[bpt/guile.git] / src / vm_system.c

diff --git a/src/vm_system.c b/src/vm_system.c
index dc71896..353b3b8 100644 (file)
--- a/src/vm_system.c
+++ b/src/vm_system.c
@@ -60,6 +60,8 @@ VM_DEFINE_INSTRUCTION (halt, "halt", 0, 0, 0)
   POP (ret);
   FREE_FRAME ();
   SYNC_ALL ();
+  vp->ip = NULL;
+  scm_dynwind_end ();
   return ret;
 }
 
@@ -149,17 +151,21 @@ VM_DEFINE_INSTRUCTION (make_char8, "make-char8", 1, 0, 1)
   NEXT;
 }
 
-VM_DEFINE_INSTRUCTION (list, "list", 1, -1, 1)
+VM_DEFINE_INSTRUCTION (list, "list", 2, -1, 1)
 {
-  int n = FETCH ();
-  POP_LIST (n);
+  unsigned h = FETCH ();
+  unsigned l = FETCH ();
+  unsigned len = ((h << 8) + l);
+  POP_LIST (len);
   NEXT;
 }
 
-VM_DEFINE_INSTRUCTION (vector, "vector", 1, -1, 1)
+VM_DEFINE_INSTRUCTION (vector, "vector", 2, -1, 1)
 {
-  int n = FETCH ();
-  POP_LIST (n);
+  unsigned h = FETCH ();
+  unsigned l = FETCH ();
+  unsigned len = ((h << 8) + l);
+  POP_LIST (len);
   *sp = scm_vector (*sp);
   NEXT;
 }
@@ -208,7 +214,9 @@ VM_DEFINE_INSTRUCTION (list_break, "list-break", 0, 0, 0)
 
 VM_DEFINE_INSTRUCTION (object_ref, "object-ref", 1, 0, 1)
 {
-  PUSH (OBJECT_REF (FETCH ()));
+  register unsigned objnum = FETCH ();
+  CHECK_OBJECT (objnum);
+  PUSH (OBJECT_REF (objnum));
   NEXT;
 }
 
@@ -251,6 +259,31 @@ VM_DEFINE_INSTRUCTION (variable_ref, "variable-ref", 0, 0, 1)
   NEXT;
 }
 
+VM_DEFINE_INSTRUCTION (late_variable_ref, "late-variable-ref", 1, 0, 1)
+{
+  unsigned objnum = FETCH ();
+  SCM pair_or_var;
+  CHECK_OBJECT (objnum);
+  pair_or_var = OBJECT_REF (objnum);
+
+  if (!SCM_VARIABLEP (pair_or_var)) 
+    {
+      SYNC_REGISTER ();
+      /* either one of these calls might longjmp */
+      SCM mod = scm_resolve_module (SCM_CAR (pair_or_var));
+      pair_or_var = scm_module_lookup (mod, SCM_CDR (pair_or_var));
+      OBJECT_SET (objnum, pair_or_var);
+      if (!VARIABLE_BOUNDP (pair_or_var))
+        {
+          err_args = SCM_LIST1 (pair_or_var);
+          goto vm_error_unbound;
+        }
+    }
+
+  PUSH (VARIABLE_REF (pair_or_var));
+  NEXT;
+}
+
 /* set */
 
 VM_DEFINE_INSTRUCTION (local_set, "local-set", 1, 1, 0)
@@ -278,11 +311,31 @@ VM_DEFINE_INSTRUCTION (external_set, "external-set", 1, 1, 0)
 VM_DEFINE_INSTRUCTION (variable_set, "variable-set", 0, 1, 0)
 {
   VARIABLE_SET (sp[0], sp[-1]);
-  scm_set_object_property_x (sp[-1], scm_sym_name, SCM_CAR (sp[0]));
   sp -= 2;
   NEXT;
 }
 
+VM_DEFINE_INSTRUCTION (late_variable_set, "late-variable-set", 1, 1, 0)
+{
+  unsigned objnum = FETCH ();
+  SCM pair_or_var;
+  CHECK_OBJECT (objnum);
+  pair_or_var = OBJECT_REF (objnum);
+
+  if (!SCM_VARIABLEP (pair_or_var)) 
+    {
+      SYNC_BEFORE_GC ();
+      SCM mod = scm_resolve_module (SCM_CAR (pair_or_var));
+      /* module_lookup might longjmp */
+      pair_or_var = scm_module_lookup (mod, SCM_CDR (pair_or_var));
+      OBJECT_SET (objnum, pair_or_var);
+    }
+
+  VARIABLE_SET (pair_or_var, *sp);
+  DROP ();
+  NEXT;
+}
+
 \f
 /*
  * branch and jump
@@ -371,22 +424,64 @@ VM_DEFINE_INSTRUCTION (call, "call", 1, -1, 1)
       APPLY_HOOK ();
       NEXT;
     }
+#ifdef ENABLE_TRAMPOLINE
+  /* Seems to slow down the fibo test, dunno why */
+  /*
+   * Subr call
+   */
+  switch (nargs) 
+    {
+    case 0:
+      {
+        scm_t_trampoline_0 call = scm_trampoline_0 (x);
+        if (call) 
+          {
+            SYNC_ALL ();
+            *sp = call (x);
+            NEXT;
+          }
+        break;
+      }
+    case 1:
+      {
+        scm_t_trampoline_1 call = scm_trampoline_1 (x);
+        if (call)
+          {
+            SCM arg1;
+            POP (arg1);
+            SYNC_ALL ();
+            *sp = call (x, arg1);
+            NEXT;
+          }
+        break;
+      }
+    case 2:
+      {
+        scm_t_trampoline_2 call = scm_trampoline_2 (x);
+        if (call)
+          {
+            SCM arg1, arg2;
+            POP (arg2);
+            POP (arg1);
+            SYNC_ALL ();
+            *sp = call (x, arg1, arg2);
+            NEXT;
+          }
+        break;
+      }
+    }
+#endif
   /*
-   * Function call
+   * Other interpreted or compiled call
    */
   if (!SCM_FALSEP (scm_procedure_p (x)))
     {
       /* At this point, the stack contains the procedure and each one of its
         arguments.  */
       SCM args;
-
-#if 1
       POP_LIST (nargs);
-#else
-      /* Experimental:  Build the arglist on the VM stack.  XXX  */
-      POP_LIST_ON_STACK (nargs);
-#endif
       POP (args);
+      SYNC_REGISTER ();
       *sp = scm_apply (x, args, SCM_EOL);
       NEXT;
     }
@@ -395,14 +490,15 @@ VM_DEFINE_INSTRUCTION (call, "call", 1, -1, 1)
    */
   if (SCM_VM_CONT_P (x))
     {
+      program = x;
     vm_call_cc:
       /* Check the number of arguments */
       if (nargs != 1)
-       scm_wrong_num_args (x);
+       scm_wrong_num_args (program);
 
       /* Reinstate the continuation */
       EXIT_HOOK ();
-      reinstate_vm_cont (vp, x);
+      reinstate_vm_cont (vp, program);
       CACHE_REGISTER ();
       program = SCM_FRAME_PROGRAM (fp);
       CACHE_PROGRAM ();
@@ -452,24 +548,75 @@ VM_DEFINE_INSTRUCTION (tail_call, "tail-call", 1, -1, 1)
       program = x;
       goto vm_call_program;
     }
+#ifdef ENABLE_TRAMPOLINE
+  /* This seems to actually slow down the fibo test -- dunno why */
+  /*
+   * Subr call
+   */
+  switch (nargs) 
+    {
+    case 0:
+      {
+        scm_t_trampoline_0 call = scm_trampoline_0 (x);
+        if (call) 
+          {
+            SYNC_ALL ();
+            *sp = call (x);
+            goto vm_return;
+          }
+        break;
+      }
+    case 1:
+      {
+        scm_t_trampoline_1 call = scm_trampoline_1 (x);
+        if (call)
+          {
+            SCM arg1;
+            POP (arg1);
+            SYNC_ALL ();
+            *sp = call (x, arg1);
+            goto vm_return;
+          }
+        break;
+      }
+    case 2:
+      {
+        scm_t_trampoline_2 call = scm_trampoline_2 (x);
+        if (call)
+          {
+            SCM arg1, arg2;
+            POP (arg2);
+            POP (arg1);
+            SYNC_ALL ();
+            *sp = call (x, arg1, arg2);
+            goto vm_return;
+          }
+        break;
+      }
+    }
+#endif
+
   /*
-   * Function call
+   * Other interpreted or compiled call
    */
   if (!SCM_FALSEP (scm_procedure_p (x)))
     {
       SCM args;
       POP_LIST (nargs);
       POP (args);
+      SYNC_REGISTER ();
       *sp = scm_apply (x, args, SCM_EOL);
       goto vm_return;
     }
+
+  program = x;
+
   /*
    * Continuation call
    */
-  if (SCM_VM_CONT_P (x))
+  if (SCM_VM_CONT_P (program))
     goto vm_call_cc;
 
-  program = x;
   goto vm_error_wrong_type_apply;
 }
 
@@ -514,6 +661,7 @@ VM_DEFINE_INSTRUCTION (return, "return", 0, 0, 1)
   program = SCM_FRAME_PROGRAM (fp);
   CACHE_PROGRAM ();
   CACHE_EXTERNAL ();
+  CHECK_IP ();
   NEXT;
 }