diff options
-rw-r--r-- | libguile/vm-engine.c | 43 | ||||
-rw-r--r-- | libguile/vm-engine.h | 15 | ||||
-rw-r--r-- | libguile/vm.c | 53 | ||||
-rw-r--r-- | libguile/vm.h | 10 |
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); |