summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--libguile/vm-engine.c43
-rw-r--r--libguile/vm-engine.h15
-rw-r--r--libguile/vm.c53
-rw-r--r--libguile/vm.h10
4 files changed, 84 insertions, 37 deletions
diff --git a/libguile/vm-engine.c b/libguile/vm-engine.c
index 2be9b46b3..84f39fe49 100644
--- a/libguile/vm-engine.c
+++ b/libguile/vm-engine.c
@@ -39,14 +39,27 @@
* whether to permit this exception to apply to your modifications.
* If you do not wish that, delete this exception notice. */
-/* This file is included in vm.c twice */
+/* 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_USE_CLOCK 0 /* Bogoclock */
+#define VM_CHECK_EXTERNAL 1 /* Check external link */
+#define VM_CHECK_OBJECT 1 /* Check object table */
+#elif (VM_ENGINE == SCM_VM_DEBUG_ENGINE)
+#define VM_USE_HOOKS 1
+#define VM_USE_CLOCK 1
+#define VM_CHECK_EXTERNAL 1
+#define VM_CHECK_OBJECT 1
+#else
+#error unknown debug engine VM_ENGINE
+#endif
#include "vm-engine.h"
static SCM
-vm_run (SCM vm, SCM program, SCM args)
-#define FUNC_NAME "vm-engine"
+VM_NAME (struct scm_vm *vp, SCM program, SCM *argv, int nargs)
{
/* VM registers */
register scm_byte_t *ip IP_REG; /* instruction pointer */
@@ -54,7 +67,6 @@ vm_run (SCM vm, SCM program, SCM args)
register SCM *fp FP_REG; /* frame pointer */
/* Cache variables */
- struct scm_vm *vp = SCM_VM_DATA (vm); /* VM data pointer */
struct scm_objcode *bp = NULL; /* program base pointer */
SCM external = SCM_EOL; /* external environment */
SCM *objects = NULL; /* constant objects */
@@ -63,14 +75,12 @@ vm_run (SCM vm, SCM program, SCM args)
SCM *stack_limit = vp->stack_limit; /* stack limit address */
/* Internal variables */
- int nargs = 0;
int nvalues = 0;
long start_time = scm_c_get_internal_run_time ();
- // SCM dynwinds = SCM_EOL;
SCM err_msg;
SCM err_args;
#if VM_USE_HOOKS
- SCM hook_args = SCM_LIST1 (vm);
+ SCM hook_args = SCM_EOL;
#endif
#ifdef HAVE_LABELS_AS_VALUES
@@ -96,7 +106,7 @@ vm_run (SCM vm, SCM program, SCM args)
SCM prog = program;
/* Boot program */
- program = vm_make_boot_program (scm_ilength (args));
+ program = vm_make_boot_program (nargs);
/* Initial frame */
CACHE_REGISTER ();
@@ -106,8 +116,10 @@ vm_run (SCM vm, SCM program, SCM args)
/* Initial arguments */
PUSH (prog);
- for (; !SCM_NULLP (args); args = SCM_CDR (args))
- PUSH (SCM_CAR (args));
+ if (SCM_UNLIKELY (sp + nargs >= stack_limit))
+ goto vm_error_too_many_args;
+ while (nargs--)
+ PUSH (*argv++);
}
/* Let's go! */
@@ -146,6 +158,11 @@ vm_run (SCM vm, SCM program, SCM args)
err_args = SCM_EOL;
goto vm_error;
+ vm_error_too_many_args:
+ err_msg = scm_from_locale_string ("VM: Too many arguments");
+ err_args = SCM_LIST1 (scm_from_int (nargs));
+ goto vm_error;
+
vm_error_wrong_num_args:
/* nargs and program are valid */
SYNC_ALL ();
@@ -223,7 +240,11 @@ vm_run (SCM vm, SCM program, SCM args)
abort (); /* never reached */
}
-#undef FUNC_NAME
+
+#undef VM_USE_HOOKS
+#undef VM_USE_CLOCK
+#undef VM_CHECK_EXTERNAL
+#undef VM_CHECK_OBJECT
/*
Local Variables:
diff --git a/libguile/vm-engine.h b/libguile/vm-engine.h
index 221bef064..e14d8eba6 100644
--- a/libguile/vm-engine.h
+++ b/libguile/vm-engine.h
@@ -41,15 +41,6 @@
/* This file is included in vm_engine.c */
-/*
- * Options
- */
-
-#define VM_USE_HOOKS 1 /* Various hooks */
-#define VM_USE_CLOCK 1 /* Bogoclock */
-#define VM_CHECK_EXTERNAL 1 /* Check external link */
-#define VM_CHECK_OBJECT 1 /* Check object table */
-
/*
* Registers
@@ -193,7 +184,7 @@
#undef CHECK_EXTERNAL
#if VM_CHECK_EXTERNAL
#define CHECK_EXTERNAL(e) \
- do { if (!SCM_CONSP (e)) goto vm_error_external; } while (0)
+ do { if (SCM_UNLIKELY (!SCM_CONSP (e))) goto vm_error_external; } while (0)
#else
#define CHECK_EXTERNAL(e)
#endif
@@ -201,7 +192,7 @@
/* Accesses to a program's object table. */
#if VM_CHECK_OBJECT
#define CHECK_OBJECT(_num) \
- do { if ((_num) >= object_count) goto vm_error_object; } while (0)
+ do { if (SCM_UNLIKELY ((_num) >= object_count)) goto vm_error_object; } while (0)
#else
#define CHECK_OBJECT(_num)
#endif
@@ -218,7 +209,7 @@
if (SCM_UNLIKELY (!SCM_FALSEP (vp->hooks[h])))\
{ \
SYNC_REGISTER (); \
- vm_dispatch_hook (vm, vp->hooks[h], hook_args); \
+ vm_dispatch_hook (vp, vp->hooks[h], hook_args); \
CACHE_REGISTER (); \
} \
}
diff --git a/libguile/vm.c b/libguile/vm.c
index 074bec63c..90a1f68c1 100644
--- a/libguile/vm.c
+++ b/libguile/vm.c
@@ -43,6 +43,7 @@
# include <config.h>
#endif
+#include <alloca.h>
#include <string.h>
#include "vm-bootstrap.h"
#include "frames.h"
@@ -216,15 +217,14 @@ static void enfalsen_frame (void *p)
}
static void
-vm_dispatch_hook (SCM vm, SCM hook, SCM hook_args)
+vm_dispatch_hook (struct scm_vm *vp, SCM hook, SCM hook_args)
{
- struct scm_vm *vp = SCM_VM_DATA (vm);
-
if (!SCM_FALSEP (vp->trace_frame))
return;
scm_dynwind_begin (0);
- vp->trace_frame = scm_c_make_vm_frame (vm, vp->fp, vp->sp, vp->ip, 0);
+ // FIXME, stack holder should be the vm
+ vp->trace_frame = scm_c_make_vm_frame (SCM_BOOL_F, vp->fp, vp->sp, vp->ip, 0);
scm_dynwind_unwind_handler (enfalsen_frame, vp, SCM_F_WIND_EXPLICITLY);
scm_c_run_hook (hook, hook_args);
@@ -288,23 +288,25 @@ vm_make_boot_program (long nargs)
#define VM_DEFAULT_STACK_SIZE (16 * 1024)
-#define VM_REGULAR_ENGINE 0
-#define VM_DEBUG_ENGINE 1
-
-#if 0
#define VM_NAME vm_regular_engine
-#define VM_ENGINE VM_REGULAR_ENGINE
+#define FUNC_NAME "vm-regular-engine"
+#define VM_ENGINE SCM_VM_REGULAR_ENGINE
#include "vm-engine.c"
#undef VM_NAME
+#undef FUNC_NAME
#undef VM_ENGINE
-#endif
#define VM_NAME vm_debug_engine
-#define VM_ENGINE VM_DEBUG_ENGINE
+#define FUNC_NAME "vm-debug-engine"
+#define VM_ENGINE SCM_VM_DEBUG_ENGINE
#include "vm-engine.c"
#undef VM_NAME
+#undef FUNC_NAME
#undef VM_ENGINE
+static const scm_t_vm_engine vm_engines[] =
+ { vm_regular_engine, vm_debug_engine };
+
scm_t_bits scm_tc16_vm;
static SCM
@@ -328,6 +330,7 @@ make_vm (void)
vp->ip = NULL;
vp->sp = vp->stack_base - 1;
vp->fp = NULL;
+ vp->engine = SCM_VM_DEBUG_ENGINE;
vp->time = 0;
vp->clock = 0;
vp->options = SCM_EOL;
@@ -375,11 +378,33 @@ vm_free (SCM obj)
}
SCM
+scm_c_vm_run (struct scm_vm *vp, SCM program, SCM *argv, int nargs)
+{
+ return vm_engines[vp->engine](vp, program, argv, nargs);
+}
+
+SCM
scm_vm_apply (SCM vm, SCM program, SCM args)
#define FUNC_NAME "scm_vm_apply"
{
- SCM_VALIDATE_PROGRAM (1, program);
- return vm_run (vm, program, args);
+ SCM *argv;
+ int i, nargs;
+
+ SCM_VALIDATE_VM (1, vm);
+ SCM_VALIDATE_PROGRAM (2, program);
+
+ nargs = scm_ilength (args);
+ if (SCM_UNLIKELY (nargs < 0))
+ scm_wrong_type_arg_msg (FUNC_NAME, 3, args, "list");
+
+ argv = alloca(nargs * sizeof(SCM));
+ for (i = 0; i < nargs; i++)
+ {
+ argv[i] = SCM_CAR (args);
+ args = SCM_CDR (args);
+ }
+
+ return scm_c_vm_run (SCM_VM_DATA (vm), program, argv, nargs);
}
#undef FUNC_NAME
@@ -600,7 +625,7 @@ SCM scm_load_compiled_with_vm (SCM file)
SCM program = scm_make_program (scm_load_objcode (file),
SCM_BOOL_F, SCM_EOL);
- return vm_run (scm_the_vm (), program, SCM_EOL);
+ return scm_c_vm_run (SCM_VM_DATA (scm_the_vm ()), program, NULL, 0);
}
void
diff --git a/libguile/vm.h b/libguile/vm.h
index d8b6ee2ce..218569619 100644
--- a/libguile/vm.h
+++ b/libguile/vm.h
@@ -55,6 +55,14 @@
#define SCM_VM_RETURN_HOOK 7
#define SCM_VM_NUM_HOOKS 8
+struct scm_vm;
+
+typedef SCM (*scm_t_vm_engine) (struct scm_vm *vp, SCM program, SCM *argv, int nargs);
+
+#define SCM_VM_REGULAR_ENGINE 0
+#define SCM_VM_DEBUG_ENGINE 1
+#define SCM_VM_NUM_ENGINES 2
+
struct scm_vm {
scm_byte_t *ip; /* instruction pointer */
SCM *sp; /* stack pointer */
@@ -62,6 +70,7 @@ struct scm_vm {
size_t stack_size; /* stack size */
SCM *stack_base; /* stack base address */
SCM *stack_limit; /* stack limit address */
+ int engine; /* which vm engine we're using */
SCM hooks[SCM_VM_NUM_HOOKS]; /* hooks */
SCM options; /* options */
unsigned long time; /* time spent */
@@ -78,6 +87,7 @@ extern SCM scm_the_vm_fluid;
extern SCM scm_the_vm ();
extern SCM scm_make_vm (void);
extern SCM scm_vm_apply (SCM vm, SCM program, SCM args);
+extern SCM scm_c_vm_run (struct scm_vm *vp, SCM program, SCM *argv, int nargs);
extern SCM scm_vm_option_ref (SCM vm, SCM key);
extern SCM scm_vm_option_set_x (SCM vm, SCM key, SCM val);