-/* Copyright (C) 2001, 2009 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
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
-
-/* 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 1 /* Check object table */
-#define VM_CHECK_FREE_VARIABLES 1 /* Check free variable access */
-#elif (VM_ENGINE == SCM_VM_DEBUG_ENGINE)
-#define VM_USE_HOOKS 1
-#define VM_CHECK_OBJECT 1
-#define VM_CHECK_FREE_VARIABLES 1
-#else
-#error unknown debug engine VM_ENGINE
-#endif
-
-#include "vm-engine.h"
-
-
-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 *free_vars = NULL; /* free variables */
- size_t free_vars_count = 0; /* length of FREE_VARS */
- SCM *objects = NULL; /* constant objects */
- size_t object_count = 0; /* length of OBJECTS */
- SCM *stack_limit = vp->stack_limit; /* stack limit address */
-
- /* Internal variables */
- int nvalues = 0;
- SCM finish_args; /* used both for returns: both in error
- and normal situations */
-#ifdef HAVE_LABELS_AS_VALUES
- static void **jump_table = NULL;
-#endif
-
-#ifdef HAVE_LABELS_AS_VALUES
- if (SCM_UNLIKELY (!jump_table))
- {
- int i;
- jump_table = malloc (SCM_VM_NUM_INSTRUCTIONS * sizeof(void*));
- for (i = 0; i < SCM_VM_NUM_INSTRUCTIONS; i++)
- jump_table[i] = &&vm_error_bad_instruction;
-#define VM_INSTRUCTION_TO_LABEL 1
-#include <libguile/vm-expand.h>
-#include <libguile/vm-i-system.i>
-#include <libguile/vm-i-scheme.i>
-#include <libguile/vm-i-loader.i>
-#undef VM_INSTRUCTION_TO_LABEL
- }
-#endif
-
- /* Initialization */
- {
- SCM prog = program;
-
- /* Boot program */
- program = vm_make_boot_program (nargs);
-
- /* Initial frame */
- CACHE_REGISTER ();
- PUSH ((SCM)fp); /* dynamic link */
- PUSH (0); /* mvra */
- PUSH ((SCM)ip); /* ra */
- CACHE_PROGRAM ();
- PUSH (program);
- fp = sp + 1;
- ip = SCM_C_OBJCODE_BASE (bp);
- /* MV-call frame, function & arguments */
- PUSH ((SCM)fp); /* dynamic link */
- PUSH (0); /* mvra */
- PUSH (0); /* ra */
- PUSH (prog);
- if (SCM_UNLIKELY (sp + nargs >= stack_limit))
- goto vm_error_too_many_args;
- while (nargs--)
- PUSH (*argv++);
- }
-
- /* Let's go! */
- BOOT_HOOK ();
- 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
-
-
- vm_done:
- SYNC_ALL ();
- return finish_args;
-
- /* Errors */
- {
- SCM err_msg;
-
- vm_error_bad_instruction:
- err_msg = scm_from_locale_string ("VM: Bad instruction: ~s");
- finish_args = scm_list_1 (scm_from_uchar (ip[-1]));
- goto vm_error;
-
- vm_error_unbound:
- err_msg = scm_from_locale_string ("VM: Unbound variable: ~s");
- goto vm_error;
-
- vm_error_wrong_type_arg:
- err_msg = scm_from_locale_string ("VM: Wrong type argument");
- finish_args = SCM_EOL;
- goto vm_error;
-
- vm_error_kwargs_length_not_even:
- err_msg = scm_from_locale_string ("Bad keyword argument list: odd length");
- finish_args = SCM_EOL;
- goto vm_error;
-
- vm_error_kwargs_invalid_keyword:
- err_msg = scm_from_locale_string ("Bad keyword argument list: expected keyword");
- finish_args = SCM_EOL;
- goto vm_error;
-
- vm_error_kwargs_unrecognized_keyword:
- err_msg = scm_from_locale_string ("Bad keyword argument list: unrecognized keyword");
- finish_args = SCM_EOL;
- goto vm_error;
-
- vm_error_too_many_args:
- err_msg = scm_from_locale_string ("VM: Too many arguments");
- finish_args = scm_list_1 (scm_from_int (nargs));
- goto vm_error;
-
- vm_error_wrong_num_args:
- /* nargs and program are valid */
- SYNC_ALL ();
- scm_wrong_num_args (program);
- /* shouldn't get here */
- goto vm_error;
-
- vm_error_wrong_type_apply:
- SYNC_ALL ();
- scm_error (scm_arg_type_key, FUNC_NAME, "Wrong type to apply: ~S",
- scm_list_1 (program), scm_list_1 (program));
- goto vm_error;
-
- vm_error_stack_overflow:
- err_msg = scm_from_locale_string ("VM: Stack overflow");
- finish_args = SCM_EOL;
- goto vm_error;
-
- vm_error_stack_underflow:
- err_msg = scm_from_locale_string ("VM: Stack underflow");
- finish_args = SCM_EOL;
- goto vm_error;
-
- vm_error_improper_list:
- err_msg = scm_from_locale_string ("Expected a proper list, but got object with tail ~s");
- goto vm_error;
-
- vm_error_not_a_pair:
- SYNC_ALL ();
- scm_wrong_type_arg_msg (FUNC_NAME, 1, finish_args, "pair");
- /* shouldn't get here */
- goto vm_error;
-
- vm_error_not_a_bytevector:
- SYNC_ALL ();
- scm_wrong_type_arg_msg (FUNC_NAME, 1, finish_args, "bytevector");
- /* shouldn't get here */
- goto vm_error;
-
- vm_error_not_a_struct:
- SYNC_ALL ();
- scm_wrong_type_arg_msg (FUNC_NAME, 1, finish_args, "struct");
- /* shouldn't get here */
- goto vm_error;
-
- vm_error_no_values:
- err_msg = scm_from_locale_string ("Zero values returned to single-valued continuation");
- finish_args = SCM_EOL;
- goto vm_error;
-
- vm_error_not_enough_values:
- err_msg = scm_from_locale_string ("Too few values returned to continuation");
- finish_args = SCM_EOL;
- goto vm_error;
-
- vm_error_bad_wide_string_length:
- err_msg = scm_from_locale_string ("VM: Bad wide string length: ~S");
- goto vm_error;
-
-#ifdef VM_CHECK_IP
- vm_error_invalid_address:
- err_msg = scm_from_locale_string ("VM: Invalid program address");
- finish_args = SCM_EOL;
- goto vm_error;
-#endif
-
-#if VM_CHECK_OBJECT
- vm_error_object:
- err_msg = scm_from_locale_string ("VM: Invalid object table access");
- finish_args = SCM_EOL;
- goto vm_error;
-#endif
-
-#if VM_CHECK_FREE_VARIABLES
- vm_error_free_variable:
- err_msg = scm_from_locale_string ("VM: Invalid free variable access");
- finish_args = SCM_EOL;
- goto vm_error;
-#endif
-
- vm_error:
- SYNC_ALL ();
-
- scm_ithrow (sym_vm_error, scm_list_3 (sym_vm_run, err_msg, finish_args),
- 1);
- }
-
- abort (); /* never reached */
-}
-
-#undef VM_USE_HOOKS
-#undef VM_CHECK_OBJECT
-#undef VM_CHECK_FREE_VARIABLE
-
-/*
- Local Variables:
- c-file-style: "gnu"
- End:
-*/
+/* Copyright (C) 2001, 2009, 2010, 2011, 2012, 2013 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
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
+ *
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ * Lesser General Public License for more details.
+ *
+ * You should have received a copy of the GNU Lesser General Public
+ * License along with this library; if not, write to the Free Software
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
+ */
+
+/* This file is included in vm.c multiple times */
+
+#if (VM_ENGINE == SCM_VM_REGULAR_ENGINE)
+# define VM_USE_HOOKS 0 /* Various hooks */
+#elif (VM_ENGINE == SCM_VM_DEBUG_ENGINE)
+# define VM_USE_HOOKS 1
+#else
+# error unknown debug engine VM_ENGINE
+#endif
+
+/* Assign some registers by hand. There used to be a bigger list here,
+ but it was never tested, and in the case of x86-32, was a source of
+ compilation failures. It can be revived if it's useful, but my naive
+ hope is that simply annotating the locals with "register" will be a
+ sufficient hint to the compiler. */
+#ifdef __GNUC__
+# if defined __x86_64__
+/* GCC 4.6 chooses %rbp for IP_REG and %rbx for SP_REG, which works
+ well. Tell it to keep the jump table in a r12, which is
+ callee-saved. */
+# define JT_REG asm ("r12")
+# endif
+#endif
+
+#ifndef IP_REG
+# define IP_REG
+#endif
+#ifndef SP_REG
+# define SP_REG
+#endif
+#ifndef FP_REG
+# define FP_REG
+#endif
+#ifndef JT_REG
+# define JT_REG
+#endif
+
+#define VM_ASSERT(condition, handler) \
+ do { \
+ if (SCM_UNLIKELY (!(condition))) \
+ { \
+ SYNC_ALL(); \
+ handler; \
+ } \
+ } while (0)
+
+#ifdef VM_ENABLE_ASSERTIONS
+# define ASSERT(condition) VM_ASSERT (condition, abort())
+#else
+# define ASSERT(condition)
+#endif
+
+#if VM_USE_HOOKS
+#define RUN_HOOK(h, args, n) \
+ do { \
+ if (SCM_UNLIKELY (vp->trace_level > 0)) \
+ { \
+ SYNC_REGISTER (); \
+ vm_dispatch_hook (vm, h, args, n); \
+ } \
+ } while (0)
+#else
+#define RUN_HOOK(h, args, n)
+#endif
+#define RUN_HOOK0(h) RUN_HOOK(h, NULL, 0)
+
+#define APPLY_HOOK() \
+ RUN_HOOK0 (SCM_VM_APPLY_HOOK)
+#define PUSH_CONTINUATION_HOOK() \
+ RUN_HOOK0 (SCM_VM_PUSH_CONTINUATION_HOOK)
+#define POP_CONTINUATION_HOOK(vals, n) \
+ RUN_HOOK (SCM_VM_POP_CONTINUATION_HOOK, vals, n)
+#define NEXT_HOOK() \
+ RUN_HOOK0 (SCM_VM_NEXT_HOOK)
+#define ABORT_CONTINUATION_HOOK(vals, n) \
+ RUN_HOOK (SCM_VM_ABORT_CONTINUATION_HOOK, vals, n)
+#define RESTORE_CONTINUATION_HOOK() \
+ RUN_HOOK0 (SCM_VM_RESTORE_CONTINUATION_HOOK)
+
+#define VM_HANDLE_INTERRUPTS \
+ SCM_ASYNC_TICK_WITH_CODE (current_thread, SYNC_REGISTER ())
+
+
+\f
+
+/* Cache the VM's instruction, stack, and frame pointer in local variables. */
+#define CACHE_REGISTER() \
+{ \
+ ip = vp->ip; \
+ sp = vp->sp; \
+ fp = vp->fp; \
+}
+
+/* Update the registers in VP, a pointer to the current VM. This must be done
+ at least before any GC invocation so that `vp->sp' is up-to-date and the
+ whole stack gets marked. */
+#define SYNC_REGISTER() \
+{ \
+ vp->ip = ip; \
+ vp->sp = sp; \
+ vp->fp = fp; \
+}
+
+/* FIXME */
+#define ASSERT_VARIABLE(x) \
+ VM_ASSERT (SCM_VARIABLEP (x), abort())
+#define ASSERT_BOUND_VARIABLE(x) \
+ VM_ASSERT (SCM_VARIABLEP (x) \
+ && !scm_is_eq (SCM_VARIABLE_REF (x), SCM_UNDEFINED), \
+ abort())
+
+#ifdef VM_ENABLE_PARANOID_ASSERTIONS
+#define CHECK_IP() \
+ do { if (ip < bp->base || ip - bp->base > bp->len) abort (); } while (0)
+#define ASSERT_ALIGNED_PROCEDURE() \
+ do { if ((scm_t_bits)bp % 8) abort (); } while (0)
+#define ASSERT_BOUND(x) \
+ VM_ASSERT (!scm_is_eq ((x), SCM_UNDEFINED), abort())
+#else
+#define CHECK_IP()
+#define ASSERT_ALIGNED_PROCEDURE()
+#define ASSERT_BOUND(x)
+#endif
+
+/* Cache the object table and free variables. */
+#define CACHE_PROGRAM() \
+{ \
+ if (bp != SCM_PROGRAM_DATA (program)) { \
+ bp = SCM_PROGRAM_DATA (program); \
+ ASSERT_ALIGNED_PROCEDURE (); \
+ if (SCM_I_IS_VECTOR (SCM_PROGRAM_OBJTABLE (program))) { \
+ objects = SCM_I_VECTOR_WELTS (SCM_PROGRAM_OBJTABLE (program)); \
+ } else { \
+ objects = NULL; \
+ } \
+ } \
+}
+
+#define SYNC_BEFORE_GC() \
+{ \
+ SYNC_REGISTER (); \
+}
+
+#define SYNC_ALL() \
+{ \
+ SYNC_REGISTER (); \
+}
+
+\f
+/*
+ * Error check
+ */
+
+/* Accesses to a program's object table. */
+#define CHECK_OBJECT(_num)
+#define CHECK_FREE_VARIABLE(_num)
+
+\f
+/*
+ * Stack operation
+ */
+
+#ifdef VM_ENABLE_STACK_NULLING
+# define CHECK_STACK_LEAKN(_n) ASSERT (!sp[_n]);
+# define CHECK_STACK_LEAK() CHECK_STACK_LEAKN(1)
+# define NULLSTACK(_n) { int __x = _n; CHECK_STACK_LEAKN (_n+1); while (__x > 0) sp[__x--] = NULL; }
+/* If you have a nonlocal exit in a pre-wind proc while invoking a continuation
+ inside a dynwind (phew!), the stack is fully rewound but vm_reset_stack for
+ that continuation doesn't have a chance to run. It's not important on a
+ semantic level, but it does mess up our stack nulling -- so this macro is to
+ fix that. */
+# define NULLSTACK_FOR_NONLOCAL_EXIT() if (vp->sp > sp) NULLSTACK (vp->sp - sp);
+#else
+# define CHECK_STACK_LEAKN(_n)
+# define CHECK_STACK_LEAK()
+# define NULLSTACK(_n)
+# define NULLSTACK_FOR_NONLOCAL_EXIT()
+#endif
+
+/* For this check, we don't use VM_ASSERT, because that leads to a
+ per-site SYNC_ALL, which is too much code growth. The real problem
+ of course is having to check for overflow all the time... */
+#define CHECK_OVERFLOW() \
+ do { if (SCM_UNLIKELY (sp >= stack_limit)) goto handle_overflow; } while (0)
+
+#ifdef VM_CHECK_UNDERFLOW
+#define PRE_CHECK_UNDERFLOW(N) \
+ VM_ASSERT (sp - (N) > SCM_FRAME_UPPER_ADDRESS (fp), vm_error_stack_underflow ())
+#define CHECK_UNDERFLOW() PRE_CHECK_UNDERFLOW (0)
+#else
+#define PRE_CHECK_UNDERFLOW(N) /* nop */
+#define CHECK_UNDERFLOW() /* nop */
+#endif
+
+
+#define PUSH(x) do { sp++; CHECK_OVERFLOW (); *sp = x; } while (0)
+#define DROP() do { sp--; CHECK_UNDERFLOW (); NULLSTACK (1); } while (0)
+#define DROPN(_n) do { sp -= (_n); CHECK_UNDERFLOW (); NULLSTACK (_n); } while (0)
+#define POP(x) do { PRE_CHECK_UNDERFLOW (1); x = *sp--; NULLSTACK (1); } while (0)
+#define POP2(x,y) do { PRE_CHECK_UNDERFLOW (2); x = *sp--; y = *sp--; NULLSTACK (2); } while (0)
+#define POP3(x,y,z) do { PRE_CHECK_UNDERFLOW (3); x = *sp--; y = *sp--; z = *sp--; NULLSTACK (3); } while (0)
+
+/* Pop the N objects on top of the stack and push a list that contains
+ them. */
+#define POP_LIST(n) \
+do \
+{ \
+ int i; \
+ SCM l = SCM_EOL, x; \
+ SYNC_BEFORE_GC (); \
+ for (i = n; i; i--) \
+ { \
+ POP (x); \
+ l = scm_cons (x, l); \
+ } \
+ PUSH (l); \
+} while (0)
+
+/* The opposite: push all of the elements in L onto the list. */
+#define PUSH_LIST(l, NILP) \
+do \
+{ \
+ for (; scm_is_pair (l); l = SCM_CDR (l)) \
+ PUSH (SCM_CAR (l)); \
+ VM_ASSERT (NILP (l), vm_error_improper_list (l)); \
+} while (0)
+
+\f
+/*
+ * Instruction operation
+ */
+
+#define FETCH() (*ip++)
+#define FETCH_LENGTH(len) do { len=*ip++; len<<=8; len+=*ip++; len<<=8; len+=*ip++; } while (0)
+
+#undef NEXT_JUMP
+#ifdef HAVE_LABELS_AS_VALUES
+# define NEXT_JUMP() goto *jump_table[FETCH () & SCM_VM_INSTRUCTION_MASK]
+#else
+# define NEXT_JUMP() goto vm_start
+#endif
+
+#define NEXT \
+{ \
+ NEXT_HOOK (); \
+ CHECK_STACK_LEAK (); \
+ NEXT_JUMP (); \
+}
+
+\f
+/* See frames.h for the layout of stack frames */
+/* When this is called, bp points to the new program data,
+ and the arguments are already on the stack */
+#define DROP_FRAME() \
+ { \
+ sp -= 3; \
+ NULLSTACK (3); \
+ CHECK_UNDERFLOW (); \
+ }
+
+
+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 */
+ 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 (sp - SCM_I_INUM (*sp), SCM_I_INUM (*sp));
+ NEXT;
+ }
+
+ CACHE_REGISTER ();
+
+ /* Since it's possible to receive the arguments on the stack itself,
+ and indeed the RTL VM invokes us that way, shuffle up the
+ arguments first. */
+ VM_ASSERT (sp + 8 + nargs < stack_limit, vm_error_too_many_args (nargs));
+ {
+ int i;
+ for (i = nargs - 1; i >= 0; i--)
+ sp[9 + i] = argv[i];
+ }
+
+ /* Initial frame */
+ 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;
+ sp += nargs;
+
+ 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 RUN_HOOK
+#undef RUN_HOOK1
+#undef VM_USE_HOOKS
+
+/*
+ Local Variables:
+ c-file-style: "gnu"
+ End:
+*/
HCoop / bpt / guile.git / blobdiff