mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-04-30 20:00:19 +02:00
enable multiple vm engines (regular, debug, ...)
* libguile/vm-engine.c (VM_USE_HOOKS, VM_USE_CLOCK, VM_CHECK_EXTERNAL) (VM_CHECK_OBJECT): Update to define these here, before including vm-engine.h. (vm_run): Change so that we can make different engines. Also, we take an array of arguments, and the struct scm_vm directly, so as to avoid any need to cons. * libguile/vm-engine.h (CHECK_EXTERNAL, CHECK_OBJECT): Add some UNLIKELY bits; don't seem to help. * libguile/vm.c (vm_dispatch_hook): Change to not pass the VP. This needs some love, and perhaps we revert to the old way. (VM_ENGINE): Actually make two engines, vm_regular_engine and vm_debug_engine. Probably there is room for improvement here. Actually their speeds are the same at the moment. (make_vm): Choose which engine to run; currently the debug engine by default. (scm_c_vm_run): A thin wrapper to invoke a VM without consing. (scm_vm_apply): Use scm_c_vm_run. (scm_load_compiled_with_vm): Use scm_c_vm_run.
This commit is contained in:
Andy Wingo
parent
bef9591104
commit
6d14383e86
4 changed files with 84 additions and 37 deletions
|
|
@ -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:
|
||||
|
|
|
|||
|
|
@ -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 (); \
|
||||
} \
|
||||
}
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
|
|
@ -374,12 +377,34 @@ vm_free (SCM obj)
|
|||
return 0;
|
||||
}
|
||||
|
||||
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
|
||||
|
|
|
|||
|
|
@ -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);
|
||||
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue