mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-05-11 08:10:21 +02:00
remove "externals" from the vm
* libguile/frames.c (scm_frame_external_link): Removed. * libguile/frames.h: No need to have the "external link" in the stack frame -- update macros to take the new situation into account. * libguile/objcodes.h (struct scm_objcode): Rename the nexts field to "unused". In the future we can use it for nlocs, I think. (SCM_OBJCODE_NEXTS): removed. * libguile/programs.h: * libguile/programs.c (scm_make_program): Expect the third argument to be a vector of free variables, not a list of free variables. SCM_BOOL_F indicates no free variables, not SCM_EOL. (program_mark): Adapt. (scm_program_arity): No more nexts. (scm_program_free_vars): Replaces scm_program_externals. * libguile/vm-engine.c (VM_CHECK_EXTERNAL) (vm_engine): No need for the "external" var. * libguile/vm-engine.h (CACHE_PROGRAM): Update for SCM_PROGRAM_FREE_VARS instead of SCM_PROGRAM_EXTERNALS. (NEW_FRAME): Update for new frame size, and no need to cons up externals. Yay :) * libguile/vm-i-loader.c (load-program): Update for scm_make_program. * libguile/vm-i-system.c (external-ref, external-set): No more. (make-closure): No more. (goto/args): No need to re-cons externals here. Update for new stack frame size. (mv-call, return, return/values): Update for new frame size. No need to reinstate externals on return. * libguile/vm.c (really_make_boot_program, scm_load_compiled_with_vm): Update for scm_make_program. * module/language/objcode/spec.scm (objcode-env-externals): Treat '() as #f, for the externals. Need to clean this up later... * module/system/vm/program.scm (arity:nexts): Remove. Rename program-external to program-free-vars.
This commit is contained in:
Andy Wingo
parent
66d3e9a32c
commit
20d47c3915
12 changed files with 59 additions and 183 deletions
|
|
@ -1,4 +1,4 @@
|
|||
/* Copyright (C) 2001 Free Software Foundation, Inc.
|
||||
/* 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
|
||||
|
|
@ -222,16 +222,6 @@ SCM_DEFINE (scm_vm_frame_dynamic_link, "vm-frame-dynamic-link", 1, 0, 0,
|
|||
}
|
||||
#undef FUNC_NAME
|
||||
|
||||
SCM_DEFINE (scm_vm_frame_external_link, "vm-frame-external-link", 1, 0, 0,
|
||||
(SCM frame),
|
||||
"")
|
||||
#define FUNC_NAME s_scm_vm_frame_external_link
|
||||
{
|
||||
SCM_VALIDATE_VM_FRAME (1, frame);
|
||||
return SCM_FRAME_EXTERNAL_LINK (SCM_VM_FRAME_FP (frame));
|
||||
}
|
||||
#undef FUNC_NAME
|
||||
|
||||
SCM_DEFINE (scm_vm_frame_stack, "vm-frame-stack", 1, 0, 0,
|
||||
(SCM frame),
|
||||
"")
|
||||
|
|
|
|||
|
|
@ -1,4 +1,4 @@
|
|||
/* Copyright (C) 2001 Free Software Foundation, Inc.
|
||||
/* 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
|
||||
|
|
@ -30,12 +30,11 @@
|
|||
/* VM Frame Layout
|
||||
---------------
|
||||
|
||||
| | <- fp + bp->nargs + bp->nlocs + 4
|
||||
| | <- fp + bp->nargs + bp->nlocs + 3
|
||||
+------------------+ = SCM_FRAME_UPPER_ADDRESS (fp)
|
||||
| Return address |
|
||||
| MV return address|
|
||||
| Dynamic link |
|
||||
| External link | <- fp + bp->nargs + bp->nlocs
|
||||
| Dynamic link | <- fp + bp->nargs + bp->blocs
|
||||
| Local variable 1 | = SCM_FRAME_DATA_ADDRESS (fp)
|
||||
| Local variable 0 | <- fp + bp->nargs
|
||||
| Argument 1 |
|
||||
|
|
@ -51,21 +50,20 @@
|
|||
#define SCM_FRAME_DATA_ADDRESS(fp) \
|
||||
(fp + SCM_PROGRAM_DATA (SCM_FRAME_PROGRAM (fp))->nargs \
|
||||
+ SCM_PROGRAM_DATA (SCM_FRAME_PROGRAM (fp))->nlocs)
|
||||
#define SCM_FRAME_UPPER_ADDRESS(fp) (SCM_FRAME_DATA_ADDRESS (fp) + 4)
|
||||
#define SCM_FRAME_UPPER_ADDRESS(fp) (SCM_FRAME_DATA_ADDRESS (fp) + 3)
|
||||
#define SCM_FRAME_LOWER_ADDRESS(fp) (fp - 1)
|
||||
|
||||
#define SCM_FRAME_BYTE_CAST(x) ((scm_byte_t *) SCM_UNPACK (x))
|
||||
#define SCM_FRAME_STACK_CAST(x) ((SCM *) SCM_UNPACK (x))
|
||||
|
||||
#define SCM_FRAME_RETURN_ADDRESS(fp) \
|
||||
(SCM_FRAME_BYTE_CAST (SCM_FRAME_DATA_ADDRESS (fp)[3]))
|
||||
#define SCM_FRAME_MV_RETURN_ADDRESS(fp) \
|
||||
(SCM_FRAME_BYTE_CAST (SCM_FRAME_DATA_ADDRESS (fp)[2]))
|
||||
#define SCM_FRAME_MV_RETURN_ADDRESS(fp) \
|
||||
(SCM_FRAME_BYTE_CAST (SCM_FRAME_DATA_ADDRESS (fp)[1]))
|
||||
#define SCM_FRAME_DYNAMIC_LINK(fp) \
|
||||
(SCM_FRAME_STACK_CAST (SCM_FRAME_DATA_ADDRESS (fp)[1]))
|
||||
(SCM_FRAME_STACK_CAST (SCM_FRAME_DATA_ADDRESS (fp)[0]))
|
||||
#define SCM_FRAME_SET_DYNAMIC_LINK(fp, dl) \
|
||||
((SCM_FRAME_DATA_ADDRESS (fp)[1])) = (SCM)(dl);
|
||||
#define SCM_FRAME_EXTERNAL_LINK(fp) (SCM_FRAME_DATA_ADDRESS (fp)[0])
|
||||
#define SCM_FRAME_VARIABLE(fp,i) fp[i]
|
||||
#define SCM_FRAME_PROGRAM(fp) fp[-1]
|
||||
|
||||
|
|
@ -106,7 +104,6 @@ SCM_API SCM scm_vm_frame_local_set_x (SCM frame, SCM index, SCM val);
|
|||
SCM_API SCM scm_vm_frame_return_address (SCM frame);
|
||||
SCM_API SCM scm_vm_frame_mv_return_address (SCM frame);
|
||||
SCM_API SCM scm_vm_frame_dynamic_link (SCM frame);
|
||||
SCM_API SCM scm_vm_frame_external_link (SCM frame);
|
||||
SCM_API SCM scm_vm_frame_stack (SCM frame);
|
||||
|
||||
SCM_API SCM scm_c_vm_frame_prev (SCM frame);
|
||||
|
|
|
|||
|
|
@ -26,7 +26,7 @@ struct scm_objcode {
|
|||
scm_t_uint8 nargs;
|
||||
scm_t_uint8 nrest;
|
||||
scm_t_uint8 nlocs;
|
||||
scm_t_uint8 nexts;
|
||||
scm_t_uint8 unused;
|
||||
scm_t_uint32 len; /* the maximum index of base[] */
|
||||
scm_t_uint32 metalen; /* well, i lie. this many bytes at the end of
|
||||
base[] for metadata */
|
||||
|
|
@ -49,7 +49,6 @@ SCM_API scm_t_bits scm_tc16_objcode;
|
|||
#define SCM_OBJCODE_NARGS(x) (SCM_OBJCODE_DATA (x)->nargs)
|
||||
#define SCM_OBJCODE_NREST(x) (SCM_OBJCODE_DATA (x)->nrest)
|
||||
#define SCM_OBJCODE_NLOCS(x) (SCM_OBJCODE_DATA (x)->nlocs)
|
||||
#define SCM_OBJCODE_NEXTS(x) (SCM_OBJCODE_DATA (x)->nexts)
|
||||
#define SCM_OBJCODE_BASE(x) (SCM_OBJCODE_DATA (x)->base)
|
||||
|
||||
#define SCM_OBJCODE_IS_MMAP(x) (SCM_SMOB_FLAGS (x) & SCM_F_OBJCODE_IS_MMAP)
|
||||
|
|
|
|||
|
|
@ -1,4 +1,4 @@
|
|||
/* Copyright (C) 2001 Free Software Foundation, Inc.
|
||||
/* 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
|
||||
|
|
@ -36,7 +36,7 @@ scm_t_bits scm_tc16_program;
|
|||
static SCM write_program = SCM_BOOL_F;
|
||||
|
||||
SCM_DEFINE (scm_make_program, "make-program", 1, 2, 0,
|
||||
(SCM objcode, SCM objtable, SCM external),
|
||||
(SCM objcode, SCM objtable, SCM free_vars),
|
||||
"")
|
||||
#define FUNC_NAME s_scm_make_program
|
||||
{
|
||||
|
|
@ -45,18 +45,12 @@ SCM_DEFINE (scm_make_program, "make-program", 1, 2, 0,
|
|||
objtable = SCM_BOOL_F;
|
||||
else if (scm_is_true (objtable))
|
||||
SCM_VALIDATE_VECTOR (2, objtable);
|
||||
if (SCM_UNLIKELY (SCM_UNBNDP (external)))
|
||||
external = SCM_EOL;
|
||||
else
|
||||
/* FIXME: currently this test is quite expensive (can be 2-3% of total
|
||||
execution time in programs that make many closures). We could remove it,
|
||||
yes, but we'd get much better gains if we used some other method, like
|
||||
just capturing the variables that we need instead of all heap-allocated
|
||||
variables. Dunno. Keeping the check for now, as it's a user-callable
|
||||
function, and inlining the op in the vm's make-closure operation. */
|
||||
SCM_VALIDATE_LIST (3, external);
|
||||
if (SCM_UNLIKELY (SCM_UNBNDP (free_vars)))
|
||||
free_vars = SCM_BOOL_F;
|
||||
else if (free_vars != SCM_BOOL_F)
|
||||
SCM_VALIDATE_VECTOR (3, free_vars);
|
||||
|
||||
SCM_RETURN_NEWSMOB3 (scm_tc16_program, objcode, objtable, external);
|
||||
SCM_RETURN_NEWSMOB3 (scm_tc16_program, objcode, objtable, free_vars);
|
||||
}
|
||||
#undef FUNC_NAME
|
||||
|
||||
|
|
@ -65,8 +59,8 @@ program_mark (SCM obj)
|
|||
{
|
||||
if (scm_is_true (SCM_PROGRAM_OBJTABLE (obj)))
|
||||
scm_gc_mark (SCM_PROGRAM_OBJTABLE (obj));
|
||||
if (!scm_is_null (SCM_PROGRAM_EXTERNALS (obj)))
|
||||
scm_gc_mark (SCM_PROGRAM_EXTERNALS (obj));
|
||||
if (scm_is_true (SCM_PROGRAM_FREE_VARS (obj)))
|
||||
scm_gc_mark (SCM_PROGRAM_FREE_VARS (obj));
|
||||
return SCM_PROGRAM_OBJCODE (obj);
|
||||
}
|
||||
|
||||
|
|
@ -151,10 +145,9 @@ SCM_DEFINE (scm_program_arity, "program-arity", 1, 0, 0,
|
|||
SCM_VALIDATE_PROGRAM (1, program);
|
||||
|
||||
p = SCM_PROGRAM_DATA (program);
|
||||
return scm_list_4 (SCM_I_MAKINUM (p->nargs),
|
||||
return scm_list_3 (SCM_I_MAKINUM (p->nargs),
|
||||
SCM_I_MAKINUM (p->nrest),
|
||||
SCM_I_MAKINUM (p->nlocs),
|
||||
SCM_I_MAKINUM (p->nexts));
|
||||
SCM_I_MAKINUM (p->nlocs));
|
||||
}
|
||||
#undef FUNC_NAME
|
||||
|
||||
|
|
@ -191,7 +184,7 @@ SCM_DEFINE (scm_program_meta, "program-meta", 1, 0, 0,
|
|||
|
||||
metaobj = scm_objcode_meta (SCM_PROGRAM_OBJCODE (program));
|
||||
if (scm_is_true (metaobj))
|
||||
return scm_make_program (metaobj, SCM_BOOL_F, SCM_EOL);
|
||||
return scm_make_program (metaobj, SCM_BOOL_F, SCM_BOOL_F);
|
||||
else
|
||||
return SCM_BOOL_F;
|
||||
}
|
||||
|
|
@ -300,26 +293,13 @@ scm_c_program_source (SCM program, size_t ip)
|
|||
return source; /* (addr . (filename . (line . column))) */
|
||||
}
|
||||
|
||||
SCM_DEFINE (scm_program_external, "program-external", 1, 0, 0,
|
||||
SCM_DEFINE (scm_program_free_vars, "program-free-vars", 1, 0, 0,
|
||||
(SCM program),
|
||||
"")
|
||||
#define FUNC_NAME s_scm_program_external
|
||||
#define FUNC_NAME s_scm_program_free_vars
|
||||
{
|
||||
SCM_VALIDATE_PROGRAM (1, program);
|
||||
return SCM_PROGRAM_EXTERNALS (program);
|
||||
}
|
||||
#undef FUNC_NAME
|
||||
|
||||
SCM_DEFINE (scm_program_external_set_x, "program-external-set!", 2, 0, 0,
|
||||
(SCM program, SCM external),
|
||||
"Modify the list of closure variables of @var{program} (for "
|
||||
"debugging purposes).")
|
||||
#define FUNC_NAME s_scm_program_external_set_x
|
||||
{
|
||||
SCM_VALIDATE_PROGRAM (1, program);
|
||||
SCM_VALIDATE_LIST (2, external);
|
||||
SCM_PROGRAM_EXTERNALS (program) = external;
|
||||
return SCM_UNSPECIFIED;
|
||||
return SCM_PROGRAM_FREE_VARS (program);
|
||||
}
|
||||
#undef FUNC_NAME
|
||||
|
||||
|
|
|
|||
|
|
@ -1,4 +1,4 @@
|
|||
/* Copyright (C) 2001 Free Software Foundation, Inc.
|
||||
/* 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
|
||||
|
|
@ -35,12 +35,12 @@ SCM_API scm_t_bits scm_tc16_program;
|
|||
#define SCM_PROGRAM_P(x) (SCM_SMOB_PREDICATE (scm_tc16_program, x))
|
||||
#define SCM_PROGRAM_OBJCODE(x) (SCM_SMOB_OBJECT (x))
|
||||
#define SCM_PROGRAM_OBJTABLE(x) (SCM_SMOB_OBJECT_2 (x))
|
||||
#define SCM_PROGRAM_EXTERNALS(x) (SCM_SMOB_OBJECT_3 (x))
|
||||
#define SCM_PROGRAM_FREE_VARS(x) (SCM_SMOB_OBJECT_3 (x))
|
||||
#define SCM_PROGRAM_DATA(x) (SCM_OBJCODE_DATA (SCM_PROGRAM_OBJCODE (x)))
|
||||
#define SCM_VALIDATE_PROGRAM(p,x) SCM_MAKE_VALIDATE (p, x, PROGRAM_P)
|
||||
#define SCM_PROGRAM_IS_BOOT(x) (SCM_SMOB_FLAGS (x) & SCM_F_PROGRAM_IS_BOOT)
|
||||
|
||||
SCM_API SCM scm_make_program (SCM objcode, SCM objtable, SCM externals);
|
||||
SCM_API SCM scm_make_program (SCM objcode, SCM objtable, SCM free_vars);
|
||||
|
||||
SCM_API SCM scm_program_p (SCM obj);
|
||||
SCM_API SCM scm_program_base (SCM program);
|
||||
|
|
@ -53,8 +53,7 @@ SCM_API SCM scm_program_properties (SCM program);
|
|||
SCM_API SCM scm_program_name (SCM program);
|
||||
SCM_API SCM scm_program_objects (SCM program);
|
||||
SCM_API SCM scm_program_module (SCM program);
|
||||
SCM_API SCM scm_program_external (SCM program);
|
||||
SCM_API SCM scm_program_external_set_x (SCM program, SCM external);
|
||||
SCM_API SCM scm_program_free_vars (SCM program);
|
||||
SCM_API SCM scm_program_objcode (SCM program);
|
||||
|
||||
SCM_API SCM scm_c_program_source (SCM program, size_t ip);
|
||||
|
|
|
|||
|
|
@ -21,14 +21,12 @@
|
|||
#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 */
|
||||
#define VM_CHECK_CLOSURE 1 /* Check closure vars */
|
||||
#define VM_PUSH_DEBUG_FRAMES 0 /* Push frames onto the evaluator debug stack */
|
||||
#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
|
||||
#define VM_CHECK_CLOSURE 1
|
||||
#define VM_PUSH_DEBUG_FRAMES 1
|
||||
|
|
@ -49,7 +47,6 @@ VM_NAME (struct scm_vm *vp, SCM program, SCM *argv, int nargs)
|
|||
|
||||
/* Cache variables */
|
||||
struct scm_objcode *bp = NULL; /* program base pointer */
|
||||
SCM external = SCM_EOL; /* external environment REMOVEME */
|
||||
SCM *closure = NULL; /* closure variables */
|
||||
size_t closure_count = 0; /* length of CLOSURE */
|
||||
SCM *objects = NULL; /* constant objects */
|
||||
|
|
@ -230,13 +227,6 @@ VM_NAME (struct scm_vm *vp, SCM program, SCM *argv, int nargs)
|
|||
goto vm_error;
|
||||
#endif
|
||||
|
||||
#if VM_CHECK_EXTERNAL
|
||||
vm_error_external:
|
||||
err_msg = scm_from_locale_string ("VM: Invalid external access");
|
||||
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");
|
||||
|
|
@ -263,8 +253,8 @@ VM_NAME (struct scm_vm *vp, SCM program, SCM *argv, int nargs)
|
|||
|
||||
#undef VM_USE_HOOKS
|
||||
#undef VM_USE_CLOCK
|
||||
#undef VM_CHECK_EXTERNAL
|
||||
#undef VM_CHECK_OBJECT
|
||||
#undef VM_CHECK_CLOSURE
|
||||
#undef VM_PUSH_DEBUG_FRAMES
|
||||
|
||||
/*
|
||||
|
|
|
|||
|
|
@ -138,11 +138,7 @@
|
|||
#define ASSERT_BOUND(x)
|
||||
#endif
|
||||
|
||||
/* Get a local copy of the program's "object table" (i.e. the vector of
|
||||
external bindings that are referenced by the program), initialized by
|
||||
`load-program'. */
|
||||
/* XXX: We could instead use the "simple vector macros", thus not having to
|
||||
call `scm_vector_writable_elements ()' and the likes. */
|
||||
/* Cache the object table and free variables. */
|
||||
#define CACHE_PROGRAM() \
|
||||
{ \
|
||||
if (bp != SCM_PROGRAM_DATA (program)) { \
|
||||
|
|
@ -156,7 +152,7 @@
|
|||
} \
|
||||
} \
|
||||
{ \
|
||||
SCM c = SCM_PROGRAM_EXTERNALS (program); \
|
||||
SCM c = SCM_PROGRAM_FREE_VARS (program); \
|
||||
if (SCM_I_IS_VECTOR (c)) \
|
||||
{ \
|
||||
closure = SCM_I_VECTOR_WELTS (c); \
|
||||
|
|
@ -185,14 +181,6 @@
|
|||
* Error check
|
||||
*/
|
||||
|
||||
#undef CHECK_EXTERNAL
|
||||
#if VM_CHECK_EXTERNAL
|
||||
#define CHECK_EXTERNAL(e) \
|
||||
do { if (SCM_UNLIKELY (!SCM_CONSP (e))) goto vm_error_external; } while (0)
|
||||
#else
|
||||
#define CHECK_EXTERNAL(e)
|
||||
#endif
|
||||
|
||||
/* Accesses to a program's object table. */
|
||||
#if VM_CHECK_OBJECT
|
||||
#define CHECK_OBJECT(_num) \
|
||||
|
|
@ -406,7 +394,7 @@ do { \
|
|||
/* New registers */ \
|
||||
fp = sp - bp->nargs + 1; \
|
||||
data = SCM_FRAME_DATA_ADDRESS (fp); \
|
||||
sp = data + 3; \
|
||||
sp = data + 2; \
|
||||
CHECK_OVERFLOW (); \
|
||||
stack_base = sp; \
|
||||
ip = bp->base; \
|
||||
|
|
@ -416,23 +404,11 @@ do { \
|
|||
data[-i] = SCM_UNDEFINED; \
|
||||
\
|
||||
/* Set frame data */ \
|
||||
data[3] = (SCM)ra; \
|
||||
data[2] = 0x0; \
|
||||
data[1] = (SCM)dl; \
|
||||
\
|
||||
/* Postpone initializing external vars, \
|
||||
because if the CONS causes a GC, we \
|
||||
want the stack marker to see the data \
|
||||
array formatted as expected. */ \
|
||||
data[0] = SCM_UNDEFINED; \
|
||||
external = SCM_PROGRAM_EXTERNALS (fp[-1]); \
|
||||
for (i = 0; i < bp->nexts; i++) \
|
||||
CONS (external, SCM_UNDEFINED, external); \
|
||||
data[0] = external; \
|
||||
data[2] = (SCM)ra; \
|
||||
data[1] = 0x0; \
|
||||
data[0] = (SCM)dl; \
|
||||
}
|
||||
|
||||
#define CACHE_EXTERNAL() external = fp[bp->nargs + bp->nlocs]
|
||||
|
||||
/*
|
||||
Local Variables:
|
||||
c-file-style: "gnu"
|
||||
|
|
|
|||
|
|
@ -114,7 +114,7 @@ VM_DEFINE_LOADER (86, load_program, "load-program")
|
|||
objcode = scm_c_make_objcode_slice (SCM_PROGRAM_OBJCODE (fp[-1]), ip);
|
||||
len = sizeof (struct scm_objcode) + SCM_OBJCODE_TOTAL_LEN (objcode);
|
||||
|
||||
PUSH (scm_make_program (objcode, objs, SCM_EOL));
|
||||
PUSH (scm_make_program (objcode, objs, SCM_BOOL_F));
|
||||
|
||||
ip += len;
|
||||
|
||||
|
|
|
|||
|
|
@ -278,21 +278,6 @@ VM_DEFINE_INSTRUCTION (25, local_ref, "local-ref", 1, 0, 1)
|
|||
NEXT;
|
||||
}
|
||||
|
||||
VM_DEFINE_INSTRUCTION (26, external_ref, "external-ref", 1, 0, 1)
|
||||
{
|
||||
unsigned int i;
|
||||
SCM e = external;
|
||||
for (i = FETCH (); i; i--)
|
||||
{
|
||||
CHECK_EXTERNAL(e);
|
||||
e = SCM_CDR (e);
|
||||
}
|
||||
CHECK_EXTERNAL(e);
|
||||
PUSH (SCM_CAR (e));
|
||||
ASSERT_BOUND (*sp);
|
||||
NEXT;
|
||||
}
|
||||
|
||||
VM_DEFINE_INSTRUCTION (27, variable_ref, "variable-ref", 0, 0, 1)
|
||||
{
|
||||
SCM x = *sp;
|
||||
|
|
@ -369,21 +354,6 @@ VM_DEFINE_INSTRUCTION (30, local_set, "local-set", 1, 1, 0)
|
|||
NEXT;
|
||||
}
|
||||
|
||||
VM_DEFINE_INSTRUCTION (31, external_set, "external-set", 1, 1, 0)
|
||||
{
|
||||
unsigned int i;
|
||||
SCM e = external;
|
||||
for (i = FETCH (); i; i--)
|
||||
{
|
||||
CHECK_EXTERNAL(e);
|
||||
e = SCM_CDR (e);
|
||||
}
|
||||
CHECK_EXTERNAL(e);
|
||||
SCM_SETCAR (e, *sp);
|
||||
DROP ();
|
||||
NEXT;
|
||||
}
|
||||
|
||||
VM_DEFINE_INSTRUCTION (32, variable_set, "variable-set", 0, 1, 0)
|
||||
{
|
||||
VARIABLE_SET (sp[0], sp[-1]);
|
||||
|
|
@ -500,14 +470,6 @@ VM_DEFINE_INSTRUCTION (41, br_if_not_null, "br-if-not-null", 2, 0, 0)
|
|||
* Subprogram call
|
||||
*/
|
||||
|
||||
VM_DEFINE_INSTRUCTION (42, make_closure, "make-closure", 0, 1, 1)
|
||||
{
|
||||
SYNC_BEFORE_GC ();
|
||||
SCM_NEWSMOB3 (*sp, scm_tc16_program, SCM_PROGRAM_OBJCODE (*sp),
|
||||
SCM_PROGRAM_OBJTABLE (*sp), external);
|
||||
NEXT;
|
||||
}
|
||||
|
||||
VM_DEFINE_INSTRUCTION (43, call, "call", 1, -1, 1)
|
||||
{
|
||||
SCM x;
|
||||
|
|
@ -656,12 +618,6 @@ VM_DEFINE_INSTRUCTION (44, goto_args, "goto/args", 1, -1, 1)
|
|||
sp -= 2;
|
||||
NULLSTACK (bp->nargs + 1);
|
||||
|
||||
/* Freshen the externals */
|
||||
external = SCM_PROGRAM_EXTERNALS (x);
|
||||
for (i = 0; i < bp->nexts; i++)
|
||||
CONS (external, SCM_UNDEFINED, external);
|
||||
SCM_FRAME_DATA_ADDRESS (fp)[0] = external;
|
||||
|
||||
/* Init locals to valid SCM values */
|
||||
for (i = 0; i < bp->nlocs; i++)
|
||||
LOCAL_SET (i + bp->nargs, SCM_UNDEFINED);
|
||||
|
|
@ -710,7 +666,7 @@ VM_DEFINE_INSTRUCTION (44, goto_args, "goto/args", 1, -1, 1)
|
|||
sure we have space for the locals now */
|
||||
data = SCM_FRAME_DATA_ADDRESS (fp);
|
||||
ip = bp->base;
|
||||
stack_base = data + 3;
|
||||
stack_base = data + 2;
|
||||
sp = stack_base;
|
||||
CHECK_OVERFLOW ();
|
||||
|
||||
|
|
@ -725,17 +681,9 @@ VM_DEFINE_INSTRUCTION (44, goto_args, "goto/args", 1, -1, 1)
|
|||
data[-i] = SCM_UNDEFINED;
|
||||
|
||||
/* Set frame data */
|
||||
data[3] = (SCM)ra;
|
||||
data[2] = (SCM)mvra;
|
||||
data[1] = (SCM)dl;
|
||||
|
||||
/* Postpone initializing external vars, because if the CONS causes a GC,
|
||||
we want the stack marker to see the data array formatted as expected. */
|
||||
data[0] = SCM_UNDEFINED;
|
||||
external = SCM_PROGRAM_EXTERNALS (fp[-1]);
|
||||
for (i = 0; i < bp->nexts; i++)
|
||||
CONS (external, SCM_UNDEFINED, external);
|
||||
data[0] = external;
|
||||
data[2] = (SCM)ra;
|
||||
data[1] = (SCM)mvra;
|
||||
data[0] = (SCM)dl;
|
||||
|
||||
ENTER_HOOK ();
|
||||
APPLY_HOOK ();
|
||||
|
|
@ -860,7 +808,7 @@ VM_DEFINE_INSTRUCTION (47, mv_call, "mv-call", 3, -1, 1)
|
|||
CACHE_PROGRAM ();
|
||||
INIT_ARGS ();
|
||||
NEW_FRAME ();
|
||||
SCM_FRAME_DATA_ADDRESS (fp)[2] = (SCM)(SCM_FRAME_RETURN_ADDRESS (fp) + offset);
|
||||
SCM_FRAME_DATA_ADDRESS (fp)[1] = (SCM)(SCM_FRAME_RETURN_ADDRESS (fp) + offset);
|
||||
ENTER_HOOK ();
|
||||
APPLY_HOOK ();
|
||||
NEXT;
|
||||
|
|
@ -1019,12 +967,12 @@ VM_DEFINE_INSTRUCTION (52, return, "return", 0, 1, 1)
|
|||
|
||||
POP (ret);
|
||||
ASSERT (sp == stack_base);
|
||||
ASSERT (stack_base == data + 3);
|
||||
ASSERT (stack_base == data + 2);
|
||||
|
||||
/* Restore registers */
|
||||
sp = SCM_FRAME_LOWER_ADDRESS (fp);
|
||||
ip = SCM_FRAME_BYTE_CAST (data[3]);
|
||||
fp = SCM_FRAME_STACK_CAST (data[1]);
|
||||
ip = SCM_FRAME_BYTE_CAST (data[2]);
|
||||
fp = SCM_FRAME_STACK_CAST (data[0]);
|
||||
{
|
||||
#ifdef VM_ENABLE_STACK_NULLING
|
||||
int nullcount = stack_base - sp;
|
||||
|
|
@ -1040,7 +988,6 @@ VM_DEFINE_INSTRUCTION (52, return, "return", 0, 1, 1)
|
|||
/* Restore the last program */
|
||||
program = SCM_FRAME_PROGRAM (fp);
|
||||
CACHE_PROGRAM ();
|
||||
CACHE_EXTERNAL ();
|
||||
CHECK_IP ();
|
||||
NEXT;
|
||||
}
|
||||
|
|
@ -1057,16 +1004,16 @@ VM_DEFINE_INSTRUCTION (53, return_values, "return/values", 1, -1, -1)
|
|||
RETURN_HOOK ();
|
||||
|
||||
data = SCM_FRAME_DATA_ADDRESS (fp);
|
||||
ASSERT (stack_base == data + 3);
|
||||
ASSERT (stack_base == data + 2);
|
||||
|
||||
/* data[2] is the mv return address */
|
||||
if (nvalues != 1 && data[2])
|
||||
/* data[1] is the mv return address */
|
||||
if (nvalues != 1 && data[1])
|
||||
{
|
||||
int i;
|
||||
/* Restore registers */
|
||||
sp = SCM_FRAME_LOWER_ADDRESS (fp) - 1;
|
||||
ip = SCM_FRAME_BYTE_CAST (data[2]); /* multiple value ra */
|
||||
fp = SCM_FRAME_STACK_CAST (data[1]);
|
||||
ip = SCM_FRAME_BYTE_CAST (data[1]); /* multiple value ra */
|
||||
fp = SCM_FRAME_STACK_CAST (data[0]);
|
||||
|
||||
/* Push return values, and the number of values */
|
||||
for (i = 0; i < nvalues; i++)
|
||||
|
|
@ -1085,8 +1032,8 @@ VM_DEFINE_INSTRUCTION (53, return_values, "return/values", 1, -1, -1)
|
|||
continuation.) */
|
||||
/* Restore registers */
|
||||
sp = SCM_FRAME_LOWER_ADDRESS (fp) - 1;
|
||||
ip = SCM_FRAME_BYTE_CAST (data[3]); /* single value ra */
|
||||
fp = SCM_FRAME_STACK_CAST (data[1]);
|
||||
ip = SCM_FRAME_BYTE_CAST (data[2]); /* single value ra */
|
||||
fp = SCM_FRAME_STACK_CAST (data[0]);
|
||||
|
||||
/* Push first value */
|
||||
*++sp = stack_base[1];
|
||||
|
|
@ -1101,7 +1048,6 @@ VM_DEFINE_INSTRUCTION (53, return_values, "return/values", 1, -1, -1)
|
|||
/* Restore the last program */
|
||||
program = SCM_FRAME_PROGRAM (fp);
|
||||
CACHE_PROGRAM ();
|
||||
CACHE_EXTERNAL ();
|
||||
CHECK_IP ();
|
||||
NEXT;
|
||||
}
|
||||
|
|
|
|||
|
|
@ -1,4 +1,4 @@
|
|||
/* Copyright (C) 2001 Free Software Foundation, Inc.
|
||||
/* 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
|
||||
|
|
@ -259,7 +259,7 @@ really_make_boot_program (long nargs)
|
|||
|
||||
u8vec = make_u8vector (bytes.bytes, sizeof (bytes.bytes));
|
||||
ret = scm_make_program (scm_bytecode_to_objcode (u8vec),
|
||||
SCM_BOOL_F, SCM_EOL);
|
||||
SCM_BOOL_F, SCM_BOOL_F);
|
||||
SCM_SET_SMOB_FLAGS (ret, SCM_F_PROGRAM_IS_BOOT);
|
||||
|
||||
return ret;
|
||||
|
|
@ -663,7 +663,7 @@ SCM_DEFINE (scm_vm_trace_frame, "vm-trace-frame", 1, 0, 0,
|
|||
SCM scm_load_compiled_with_vm (SCM file)
|
||||
{
|
||||
SCM program = scm_make_program (scm_load_objcode (file),
|
||||
SCM_BOOL_F, SCM_EOL);
|
||||
SCM_BOOL_F, SCM_BOOL_F);
|
||||
|
||||
return scm_c_vm_run (scm_the_vm (), program, NULL, 0);
|
||||
}
|
||||
|
|
|
|||
|
|
@ -1,6 +1,6 @@
|
|||
;;; Guile Lowlevel Intermediate Language
|
||||
|
||||
;; Copyright (C) 2001 Free Software Foundation, Inc.
|
||||
;; 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
|
||||
|
|
@ -31,7 +31,7 @@
|
|||
(if env (car env) (current-module)))
|
||||
|
||||
(define (objcode-env-externals env)
|
||||
(if env (cdr env) '()))
|
||||
(and env (vector? (cdr env)) (cdr env)))
|
||||
|
||||
(define (objcode->value x e opts)
|
||||
(let ((thunk (make-program x #f (objcode-env-externals e))))
|
||||
|
|
|
|||
|
|
@ -1,6 +1,6 @@
|
|||
;;; Guile VM program functions
|
||||
|
||||
;;; Copyright (C) 2001 Free Software Foundation, Inc.
|
||||
;;; 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
|
||||
|
|
@ -31,16 +31,15 @@
|
|||
program-properties program-property program-documentation
|
||||
program-name program-arguments
|
||||
|
||||
program-arity program-external-set! program-meta
|
||||
program-arity program-meta
|
||||
program-objcode program? program-objects
|
||||
program-module program-base program-external))
|
||||
program-module program-base program-free-vars))
|
||||
|
||||
(load-extension "libguile" "scm_init_programs")
|
||||
|
||||
(define arity:nargs car)
|
||||
(define arity:nrest cadr)
|
||||
(define arity:nlocs caddr)
|
||||
(define arity:nexts cadddr)
|
||||
|
||||
(define (make-binding name extp index start end)
|
||||
(list name extp index start end))
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue