inline vm-engine.h into vm-engine.c

* libguile/vm-engine.h:
* libguile/vm-engine.c: Fold vm-engine.h into vm-engine.c.

* libguile/Makefile.am: Adapt.

diff --git a/libguile/Makefile.am b/libguile/Makefile.am
index 6c9d795..7c7a34b 100644 (file)
--- a/libguile/Makefile.am
+++ b/libguile/Makefile.am
@@ -630,7 +630,6 @@ modinclude_HEADERS =                                \
        values.h                                \
        variable.h                              \
        vectors.h                               \
-       vm-engine.h                             \
        vm-expand.h                             \
        vm.h                                    \
        vports.h                                \

diff --git a/libguile/vm-engine.h b/libguile/vm-engine.c
similarity index 71%
rename from libguile/vm-engine.h
rename to libguile/vm-engine.c
index 5a4bf40..d950f12 100644 (file)
--- a/libguile/vm-engine.h
+++ b/libguile/vm-engine.c
@@ -16,7 +16,22 @@
  * 02110-1301 USA
  */
 
-/* This file is included in vm_engine.c */
+/* This file is included in vm.c multiple times */
+
+#if (VM_ENGINE == SCM_VM_REGULAR_ENGINE)
+#define VM_USE_HOOKS           0       /* Various hooks */
+#define VM_CHECK_OBJECT         0       /* Check object table */
+#define VM_CHECK_FREE_VARIABLES 0       /* Check free variable access */
+#define VM_CHECK_UNDERFLOW      0       /* Check underflow when popping values */
+#elif (VM_ENGINE == SCM_VM_DEBUG_ENGINE)
+#define VM_USE_HOOKS           1
+#define VM_CHECK_OBJECT         0
+#define VM_CHECK_FREE_VARIABLES 0
+#define VM_CHECK_UNDERFLOW      0       /* Check underflow when popping values */
+#else
+#error unknown debug engine VM_ENGINE
+#endif
+
 
 \f
 /*
@@ -396,6 +411,161 @@ do {                                              \
   }
     
 
+static SCM
+VM_NAME (SCM vm, SCM program, SCM *argv, int nargs)
+{
+  /* VM registers */
+  register scm_t_uint8 *ip IP_REG;     /* instruction pointer */
+  register SCM *sp SP_REG;             /* stack pointer */
+  register SCM *fp FP_REG;             /* frame pointer */
+  struct scm_vm *vp = SCM_VM_DATA (vm);
+
+  /* Cache variables */
+  struct scm_objcode *bp = NULL;       /* program base pointer */
+  SCM *objects = NULL;                 /* constant objects */
+#if VM_CHECK_OBJECT
+  size_t object_count = 0;              /* length of OBJECTS */
+#endif
+  SCM *stack_limit = vp->stack_limit;  /* stack limit address */
+
+  scm_i_thread *current_thread = SCM_I_CURRENT_THREAD;
+
+  /* Internal variables */
+  int nvalues = 0;
+  scm_i_jmp_buf registers;              /* used for prompts */
+
+#ifdef HAVE_LABELS_AS_VALUES
+  static const void **jump_table_pointer = NULL;
+#endif
+
+#ifdef HAVE_LABELS_AS_VALUES
+  register const void **jump_table JT_REG;
+
+  if (SCM_UNLIKELY (!jump_table_pointer))
+    {
+      int i;
+      jump_table_pointer = malloc (SCM_VM_NUM_INSTRUCTIONS * sizeof (void*));
+      for (i = 0; i < SCM_VM_NUM_INSTRUCTIONS; i++)
+        jump_table_pointer[i] = &&vm_error_bad_instruction;
+#define VM_INSTRUCTION_TO_LABEL 1
+#define jump_table jump_table_pointer
+#include <libguile/vm-expand.h>
+#include <libguile/vm-i-system.i>
+#include <libguile/vm-i-scheme.i>
+#include <libguile/vm-i-loader.i>
+#undef jump_table
+#undef VM_INSTRUCTION_TO_LABEL
+    }
+
+  /* Attempt to keep JUMP_TABLE_POINTER in a register.  This saves one
+     load instruction at each instruction dispatch.  */
+  jump_table = jump_table_pointer;
+#endif
+
+  if (SCM_I_SETJMP (registers))
+    {
+      /* Non-local return.  Cache the VM registers back from the vp, and
+         go to the handler.
+
+         Note, at this point, we must assume that any variable local to
+         vm_engine that can be assigned *has* been assigned. So we need to pull
+         all our state back from the ip/fp/sp.
+      */
+      CACHE_REGISTER ();
+      program = SCM_FRAME_PROGRAM (fp);
+      CACHE_PROGRAM ();
+      /* The stack contains the values returned to this continuation,
+         along with a number-of-values marker -- like an MV return. */
+      ABORT_CONTINUATION_HOOK ();
+      NEXT;
+    }
+
+  /* Initial frame */
+  CACHE_REGISTER ();
+  PUSH (SCM_PACK (fp)); /* dynamic link */
+  PUSH (SCM_PACK (0)); /* mvra */
+  PUSH (SCM_PACK (ip)); /* ra */
+  PUSH (boot_continuation);
+  fp = sp + 1;
+  ip = SCM_C_OBJCODE_BASE (SCM_PROGRAM_DATA (boot_continuation));
+
+  /* MV-call frame, function & arguments */
+  PUSH (SCM_PACK (fp)); /* dynamic link */
+  PUSH (SCM_PACK (ip + 1)); /* mvra */
+  PUSH (SCM_PACK (ip)); /* ra */
+  PUSH (program);
+  fp = sp + 1;
+  VM_ASSERT (sp + nargs < stack_limit, vm_error_too_many_args (nargs));
+  while (nargs--)
+    PUSH (*argv++);
+
+  PUSH_CONTINUATION_HOOK ();
+
+ apply:
+  program = fp[-1];
+  if (!SCM_PROGRAM_P (program))
+    {
+      if (SCM_STRUCTP (program) && SCM_STRUCT_APPLICABLE_P (program))
+        fp[-1] = SCM_STRUCT_PROCEDURE (program);
+      else if (SCM_HAS_TYP7 (program, scm_tc7_smob)
+               && SCM_SMOB_APPLICABLE_P (program))
+        {
+          /* (smob arg0 ... argN) => (apply-smob smob arg0 ... argN) */
+          int i;
+          PUSH (SCM_BOOL_F);
+          for (i = sp - fp; i >= 0; i--)
+            fp[i] = fp[i - 1];
+          fp[-1] = SCM_SMOB_DESCRIPTOR (program).apply_trampoline;
+        }
+      else
+        {
+          SYNC_ALL();
+          vm_error_wrong_type_apply (program);
+        }
+      goto apply;
+    }
+
+  CACHE_PROGRAM ();
+  ip = SCM_C_OBJCODE_BASE (bp);
+
+  APPLY_HOOK ();
+
+  /* Let's go! */
+  NEXT;
+
+#ifndef HAVE_LABELS_AS_VALUES
+ vm_start:
+  switch ((*ip++) & SCM_VM_INSTRUCTION_MASK) {
+#endif
+
+#include "vm-expand.h"
+#include "vm-i-system.c"
+#include "vm-i-scheme.c"
+#include "vm-i-loader.c"
+
+#ifndef HAVE_LABELS_AS_VALUES
+  default:
+    goto vm_error_bad_instruction;
+  }
+#endif
+
+  abort (); /* never reached */
+
+ vm_error_bad_instruction:
+  vm_error_bad_instruction (ip[-1]);
+  abort (); /* never reached */
+
+ handle_overflow:
+  SYNC_ALL ();
+  vm_error_stack_overflow (vp);
+  abort (); /* never reached */
+}
+
+#undef VM_USE_HOOKS
+#undef VM_CHECK_OBJECT
+#undef VM_CHECK_FREE_VARIABLE
+#undef VM_CHECK_UNDERFLOW
+
 /*
   Local Variables:
   c-file-style: "gnu"