mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-11 08:10:21 +02:00
Code Activity

remove "externals" from the vm

Browse source 
* 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 2009-07-23 17:12:10 +02:00
parent 66d3e9a32c
commit 20d47c3915
12 changed files with 59 additions and 183 deletions
Download patch file Download diff file Expand all files Collapse all files

12
libguile/frames.c
View file

@ -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 * This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public License * 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 #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_DEFINE (scm_vm_frame_stack, "vm-frame-stack", 1, 0, 0,
(SCM frame), (SCM frame),
"") "")

17
libguile/frames.h
View file

@ -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 * This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public License * modify it under the terms of the GNU Lesser General Public License
@ -30,12 +30,11 @@
/* VM Frame Layout /* VM Frame Layout
--------------- ---------------
| | <- fp + bp->nargs + bp->nlocs + 4 | | <- fp + bp->nargs + bp->nlocs + 3
+------------------+ = SCM_FRAME_UPPER_ADDRESS (fp) +------------------+ = SCM_FRAME_UPPER_ADDRESS (fp)
| Return address | | Return address |
| MV return address| | MV return address|
| Dynamic link | | Dynamic link | <- fp + bp->nargs + bp->blocs
| External link | <- fp + bp->nargs + bp->nlocs
| Local variable 1 | = SCM_FRAME_DATA_ADDRESS (fp) | Local variable 1 | = SCM_FRAME_DATA_ADDRESS (fp)
| Local variable 0 | <- fp + bp->nargs | Local variable 0 | <- fp + bp->nargs
| Argument 1 | | Argument 1 |
@ -51,21 +50,20 @@
#define SCM_FRAME_DATA_ADDRESS(fp) \ #define SCM_FRAME_DATA_ADDRESS(fp) \
(fp + SCM_PROGRAM_DATA (SCM_FRAME_PROGRAM (fp))->nargs \ (fp + SCM_PROGRAM_DATA (SCM_FRAME_PROGRAM (fp))->nargs \
+ SCM_PROGRAM_DATA (SCM_FRAME_PROGRAM (fp))->nlocs) + 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_LOWER_ADDRESS(fp) (fp - 1)
#define SCM_FRAME_BYTE_CAST(x) ((scm_byte_t *) SCM_UNPACK (x)) #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_STACK_CAST(x) ((SCM *) SCM_UNPACK (x))
#define SCM_FRAME_RETURN_ADDRESS(fp) \ #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])) (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) \ #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) \ #define SCM_FRAME_SET_DYNAMIC_LINK(fp, dl) \
((SCM_FRAME_DATA_ADDRESS (fp)[1])) = (SCM)(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_VARIABLE(fp,i) fp[i]
#define SCM_FRAME_PROGRAM(fp) fp[-1] #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_return_address (SCM frame);
SCM_API SCM scm_vm_frame_mv_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_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_vm_frame_stack (SCM frame);
SCM_API SCM scm_c_vm_frame_prev (SCM frame); SCM_API SCM scm_c_vm_frame_prev (SCM frame);

3
libguile/objcodes.h
View file

@ -26,7 +26,7 @@ struct scm_objcode {
scm_t_uint8 nargs; scm_t_uint8 nargs;
scm_t_uint8 nrest; scm_t_uint8 nrest;
scm_t_uint8 nlocs; scm_t_uint8 nlocs;
scm_t_uint8 nexts; scm_t_uint8 unused;
scm_t_uint32 len; /* the maximum index of base[] */ scm_t_uint32 len; /* the maximum index of base[] */
scm_t_uint32 metalen; /* well, i lie. this many bytes at the end of scm_t_uint32 metalen; /* well, i lie. this many bytes at the end of
base[] for metadata */ 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_NARGS(x) (SCM_OBJCODE_DATA (x)->nargs)
#define SCM_OBJCODE_NREST(x) (SCM_OBJCODE_DATA (x)->nrest) #define SCM_OBJCODE_NREST(x) (SCM_OBJCODE_DATA (x)->nrest)
#define SCM_OBJCODE_NLOCS(x) (SCM_OBJCODE_DATA (x)->nlocs) #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_BASE(x) (SCM_OBJCODE_DATA (x)->base)
#define SCM_OBJCODE_IS_MMAP(x) (SCM_SMOB_FLAGS (x) & SCM_F_OBJCODE_IS_MMAP) #define SCM_OBJCODE_IS_MMAP(x) (SCM_SMOB_FLAGS (x) & SCM_F_OBJCODE_IS_MMAP)

50
libguile/programs.c
View file

@ -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 * This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public License * 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; static SCM write_program = SCM_BOOL_F;
SCM_DEFINE (scm_make_program, "make-program", 1, 2, 0, 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 #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; objtable = SCM_BOOL_F;
else if (scm_is_true (objtable)) else if (scm_is_true (objtable))
SCM_VALIDATE_VECTOR (2, objtable); SCM_VALIDATE_VECTOR (2, objtable);
if (SCM_UNLIKELY (SCM_UNBNDP (external))) if (SCM_UNLIKELY (SCM_UNBNDP (free_vars)))
external = SCM_EOL; free_vars = SCM_BOOL_F;
else else if (free_vars != SCM_BOOL_F)
/* FIXME: currently this test is quite expensive (can be 2-3% of total SCM_VALIDATE_VECTOR (3, free_vars);
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);
SCM_RETURN_NEWSMOB3 (scm_tc16_program, objcode, objtable, external); SCM_RETURN_NEWSMOB3 (scm_tc16_program, objcode, objtable, free_vars);
} }
#undef FUNC_NAME #undef FUNC_NAME
@ -65,8 +59,8 @@ program_mark (SCM obj)
{ {
if (scm_is_true (SCM_PROGRAM_OBJTABLE (obj))) if (scm_is_true (SCM_PROGRAM_OBJTABLE (obj)))
scm_gc_mark (SCM_PROGRAM_OBJTABLE (obj)); scm_gc_mark (SCM_PROGRAM_OBJTABLE (obj));
if (!scm_is_null (SCM_PROGRAM_EXTERNALS (obj))) if (scm_is_true (SCM_PROGRAM_FREE_VARS (obj)))
scm_gc_mark (SCM_PROGRAM_EXTERNALS (obj)); scm_gc_mark (SCM_PROGRAM_FREE_VARS (obj));
return SCM_PROGRAM_OBJCODE (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); SCM_VALIDATE_PROGRAM (1, program);
p = SCM_PROGRAM_DATA (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->nrest),
SCM_I_MAKINUM (p->nlocs), SCM_I_MAKINUM (p->nlocs));
SCM_I_MAKINUM (p->nexts));
} }
#undef FUNC_NAME #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)); metaobj = scm_objcode_meta (SCM_PROGRAM_OBJCODE (program));
if (scm_is_true (metaobj)) 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 else
return SCM_BOOL_F; return SCM_BOOL_F;
} }
@ -300,26 +293,13 @@ scm_c_program_source (SCM program, size_t ip)
return source; /* (addr . (filename . (line . column))) */ 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), (SCM program),
"") "")
#define FUNC_NAME s_scm_program_external #define FUNC_NAME s_scm_program_free_vars
{ {
SCM_VALIDATE_PROGRAM (1, program); SCM_VALIDATE_PROGRAM (1, program);
return SCM_PROGRAM_EXTERNALS (program); return SCM_PROGRAM_FREE_VARS (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;
} }
#undef FUNC_NAME #undef FUNC_NAME

9
libguile/programs.h
View file

@ -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 * This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public License * 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_P(x) (SCM_SMOB_PREDICATE (scm_tc16_program, x))
#define SCM_PROGRAM_OBJCODE(x) (SCM_SMOB_OBJECT (x)) #define SCM_PROGRAM_OBJCODE(x) (SCM_SMOB_OBJECT (x))
#define SCM_PROGRAM_OBJTABLE(x) (SCM_SMOB_OBJECT_2 (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_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_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) #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_p (SCM obj);
SCM_API SCM scm_program_base (SCM program); 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_name (SCM program);
SCM_API SCM scm_program_objects (SCM program); SCM_API SCM scm_program_objects (SCM program);
SCM_API SCM scm_program_module (SCM program); SCM_API SCM scm_program_module (SCM program);
SCM_API SCM scm_program_external (SCM program); SCM_API SCM scm_program_free_vars (SCM program);
SCM_API SCM scm_program_external_set_x (SCM program, SCM external);
SCM_API SCM scm_program_objcode (SCM program); SCM_API SCM scm_program_objcode (SCM program);
SCM_API SCM scm_c_program_source (SCM program, size_t ip); SCM_API SCM scm_c_program_source (SCM program, size_t ip);

12
libguile/vm-engine.c
View file

@ -21,14 +21,12 @@
#if (VM_ENGINE == SCM_VM_REGULAR_ENGINE) #if (VM_ENGINE == SCM_VM_REGULAR_ENGINE)
#define VM_USE_HOOKS 0 /* Various hooks */ #define VM_USE_HOOKS 0 /* Various hooks */
#define VM_USE_CLOCK 0 /* Bogoclock */ #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_OBJECT 1 /* Check object table */
#define VM_CHECK_CLOSURE 1 /* Check closure vars */ #define VM_CHECK_CLOSURE 1 /* Check closure vars */
#define VM_PUSH_DEBUG_FRAMES 0 /* Push frames onto the evaluator debug stack */ #define VM_PUSH_DEBUG_FRAMES 0 /* Push frames onto the evaluator debug stack */
#elif (VM_ENGINE == SCM_VM_DEBUG_ENGINE) #elif (VM_ENGINE == SCM_VM_DEBUG_ENGINE)
#define VM_USE_HOOKS 1 #define VM_USE_HOOKS 1
#define VM_USE_CLOCK 1 #define VM_USE_CLOCK 1
#define VM_CHECK_EXTERNAL 1
#define VM_CHECK_OBJECT 1 #define VM_CHECK_OBJECT 1
#define VM_CHECK_CLOSURE 1 #define VM_CHECK_CLOSURE 1
#define VM_PUSH_DEBUG_FRAMES 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 */ /* Cache variables */
struct scm_objcode *bp = NULL; /* program base pointer */ struct scm_objcode *bp = NULL; /* program base pointer */
SCM external = SCM_EOL; /* external environment REMOVEME */
SCM *closure = NULL; /* closure variables */ SCM *closure = NULL; /* closure variables */
size_t closure_count = 0; /* length of CLOSURE */ size_t closure_count = 0; /* length of CLOSURE */
SCM *objects = NULL; /* constant objects */ SCM *objects = NULL; /* constant objects */
@ -230,13 +227,6 @@ VM_NAME (struct scm_vm *vp, SCM program, SCM *argv, int nargs)
goto vm_error; goto vm_error;
#endif #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 #if VM_CHECK_OBJECT
vm_error_object: vm_error_object:
err_msg = scm_from_locale_string ("VM: Invalid object table access"); 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_HOOKS
#undef VM_USE_CLOCK #undef VM_USE_CLOCK
#undef VM_CHECK_EXTERNAL
#undef VM_CHECK_OBJECT #undef VM_CHECK_OBJECT
#undef VM_CHECK_CLOSURE
#undef VM_PUSH_DEBUG_FRAMES #undef VM_PUSH_DEBUG_FRAMES
/* /*

36
libguile/vm-engine.h
View file

@ -138,11 +138,7 @@
#define ASSERT_BOUND(x) #define ASSERT_BOUND(x)
#endif #endif
/* Get a local copy of the program's "object table" (i.e. the vector of /* Cache the object table and free variables. */
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. */
#define CACHE_PROGRAM() \ #define CACHE_PROGRAM() \
{ \ { \
if (bp != SCM_PROGRAM_DATA (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)) \ if (SCM_I_IS_VECTOR (c)) \
{ \ { \
closure = SCM_I_VECTOR_WELTS (c); \ closure = SCM_I_VECTOR_WELTS (c); \
@ -185,14 +181,6 @@
* Error check * 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. */ /* Accesses to a program's object table. */
#if VM_CHECK_OBJECT #if VM_CHECK_OBJECT
#define CHECK_OBJECT(_num) \ #define CHECK_OBJECT(_num) \
@ -406,7 +394,7 @@ do { \
/* New registers */ \ /* New registers */ \
fp = sp - bp->nargs + 1; \ fp = sp - bp->nargs + 1; \
data = SCM_FRAME_DATA_ADDRESS (fp); \ data = SCM_FRAME_DATA_ADDRESS (fp); \
sp = data + 3; \ sp = data + 2; \
CHECK_OVERFLOW (); \ CHECK_OVERFLOW (); \
stack_base = sp; \ stack_base = sp; \
ip = bp->base; \ ip = bp->base; \
@ -416,23 +404,11 @@ do { \
data[-i] = SCM_UNDEFINED; \ data[-i] = SCM_UNDEFINED; \
\ \
/* Set frame data */ \ /* Set frame data */ \
data[3] = (SCM)ra; \ data[2] = (SCM)ra; \
data[2] = 0x0; \ data[1] = 0x0; \
data[1] = (SCM)dl; \ data[0] = (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; \
} }
#define CACHE_EXTERNAL() external = fp[bp->nargs + bp->nlocs]
/* /*
Local Variables: Local Variables:
c-file-style: "gnu" c-file-style: "gnu"

2
libguile/vm-i-loader.c
View file

@ -114,7 +114,7 @@ VM_DEFINE_LOADER (86, load_program, "load-program")
objcode = scm_c_make_objcode_slice (SCM_PROGRAM_OBJCODE (fp[-1]), ip); objcode = scm_c_make_objcode_slice (SCM_PROGRAM_OBJCODE (fp[-1]), ip);
len = sizeof (struct scm_objcode) + SCM_OBJCODE_TOTAL_LEN (objcode); 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; ip += len;

84
libguile/vm-i-system.c
View file

@ -278,21 +278,6 @@ VM_DEFINE_INSTRUCTION (25, local_ref, "local-ref", 1, 0, 1)
NEXT; 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) VM_DEFINE_INSTRUCTION (27, variable_ref, "variable-ref", 0, 0, 1)
{ {
SCM x = *sp; SCM x = *sp;
@ -369,21 +354,6 @@ VM_DEFINE_INSTRUCTION (30, local_set, "local-set", 1, 1, 0)
NEXT; 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) VM_DEFINE_INSTRUCTION (32, variable_set, "variable-set", 0, 1, 0)
{ {
VARIABLE_SET (sp[0], sp[-1]); 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 * 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) VM_DEFINE_INSTRUCTION (43, call, "call", 1, -1, 1)
{ {
SCM x; SCM x;
@ -656,12 +618,6 @@ VM_DEFINE_INSTRUCTION (44, goto_args, "goto/args", 1, -1, 1)
sp -= 2; sp -= 2;
NULLSTACK (bp->nargs + 1); 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 */ /* Init locals to valid SCM values */
for (i = 0; i < bp->nlocs; i++) for (i = 0; i < bp->nlocs; i++)
LOCAL_SET (i + bp->nargs, SCM_UNDEFINED); 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 */ sure we have space for the locals now */
data = SCM_FRAME_DATA_ADDRESS (fp); data = SCM_FRAME_DATA_ADDRESS (fp);
ip = bp->base; ip = bp->base;
stack_base = data + 3; stack_base = data + 2;
sp = stack_base; sp = stack_base;
CHECK_OVERFLOW (); CHECK_OVERFLOW ();
@ -725,17 +681,9 @@ VM_DEFINE_INSTRUCTION (44, goto_args, "goto/args", 1, -1, 1)
data[-i] = SCM_UNDEFINED; data[-i] = SCM_UNDEFINED;
/* Set frame data */ /* Set frame data */
data[3] = (SCM)ra; data[2] = (SCM)ra;
data[2] = (SCM)mvra; data[1] = (SCM)mvra;
data[1] = (SCM)dl; data[0] = (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;
ENTER_HOOK (); ENTER_HOOK ();
APPLY_HOOK (); APPLY_HOOK ();
@ -860,7 +808,7 @@ VM_DEFINE_INSTRUCTION (47, mv_call, "mv-call", 3, -1, 1)
CACHE_PROGRAM (); CACHE_PROGRAM ();
INIT_ARGS (); INIT_ARGS ();
NEW_FRAME (); 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 (); ENTER_HOOK ();
APPLY_HOOK (); APPLY_HOOK ();
NEXT; NEXT;
@ -1019,12 +967,12 @@ VM_DEFINE_INSTRUCTION (52, return, "return", 0, 1, 1)
POP (ret); POP (ret);
ASSERT (sp == stack_base); ASSERT (sp == stack_base);
ASSERT (stack_base == data + 3); ASSERT (stack_base == data + 2);
/* Restore registers */ /* Restore registers */
sp = SCM_FRAME_LOWER_ADDRESS (fp); sp = SCM_FRAME_LOWER_ADDRESS (fp);
ip = SCM_FRAME_BYTE_CAST (data[3]); ip = SCM_FRAME_BYTE_CAST (data[2]);
fp = SCM_FRAME_STACK_CAST (data[1]); fp = SCM_FRAME_STACK_CAST (data[0]);
{ {
#ifdef VM_ENABLE_STACK_NULLING #ifdef VM_ENABLE_STACK_NULLING
int nullcount = stack_base - sp; int nullcount = stack_base - sp;
@ -1040,7 +988,6 @@ VM_DEFINE_INSTRUCTION (52, return, "return", 0, 1, 1)
/* Restore the last program */ /* Restore the last program */
program = SCM_FRAME_PROGRAM (fp); program = SCM_FRAME_PROGRAM (fp);
CACHE_PROGRAM (); CACHE_PROGRAM ();
CACHE_EXTERNAL ();
CHECK_IP (); CHECK_IP ();
NEXT; NEXT;
} }
@ -1057,16 +1004,16 @@ VM_DEFINE_INSTRUCTION (53, return_values, "return/values", 1, -1, -1)
RETURN_HOOK (); RETURN_HOOK ();
data = SCM_FRAME_DATA_ADDRESS (fp); data = SCM_FRAME_DATA_ADDRESS (fp);
ASSERT (stack_base == data + 3); ASSERT (stack_base == data + 2);
/* data[2] is the mv return address */ /* data[1] is the mv return address */
if (nvalues != 1 && data[2]) if (nvalues != 1 && data[1])
{ {
int i; int i;
/* Restore registers */ /* Restore registers */
sp = SCM_FRAME_LOWER_ADDRESS (fp) - 1; sp = SCM_FRAME_LOWER_ADDRESS (fp) - 1;
ip = SCM_FRAME_BYTE_CAST (data[2]); /* multiple value ra */ ip = SCM_FRAME_BYTE_CAST (data[1]); /* multiple value ra */
fp = SCM_FRAME_STACK_CAST (data[1]); fp = SCM_FRAME_STACK_CAST (data[0]);
/* Push return values, and the number of values */ /* Push return values, and the number of values */
for (i = 0; i < nvalues; i++) for (i = 0; i < nvalues; i++)
@ -1085,8 +1032,8 @@ VM_DEFINE_INSTRUCTION (53, return_values, "return/values", 1, -1, -1)
continuation.) */ continuation.) */
/* Restore registers */ /* Restore registers */
sp = SCM_FRAME_LOWER_ADDRESS (fp) - 1; sp = SCM_FRAME_LOWER_ADDRESS (fp) - 1;
ip = SCM_FRAME_BYTE_CAST (data[3]); /* single value ra */ ip = SCM_FRAME_BYTE_CAST (data[2]); /* single value ra */
fp = SCM_FRAME_STACK_CAST (data[1]); fp = SCM_FRAME_STACK_CAST (data[0]);
/* Push first value */ /* Push first value */
*++sp = stack_base[1]; *++sp = stack_base[1];
@ -1101,7 +1048,6 @@ VM_DEFINE_INSTRUCTION (53, return_values, "return/values", 1, -1, -1)
/* Restore the last program */ /* Restore the last program */
program = SCM_FRAME_PROGRAM (fp); program = SCM_FRAME_PROGRAM (fp);
CACHE_PROGRAM (); CACHE_PROGRAM ();
CACHE_EXTERNAL ();
CHECK_IP (); CHECK_IP ();
NEXT; NEXT;
} }

6
libguile/vm.c
View file

@ -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 * This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public License * 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)); u8vec = make_u8vector (bytes.bytes, sizeof (bytes.bytes));
ret = scm_make_program (scm_bytecode_to_objcode (u8vec), 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); SCM_SET_SMOB_FLAGS (ret, SCM_F_PROGRAM_IS_BOOT);
return ret; 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 scm_load_compiled_with_vm (SCM file)
{ {
SCM program = scm_make_program (scm_load_objcode (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); return scm_c_vm_run (scm_the_vm (), program, NULL, 0);
} }

4
module/language/objcode/spec.scm
View file

@ -1,6 +1,6 @@
;;; Guile Lowlevel Intermediate Language ;;; 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 ;;;; This library is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU Lesser General Public ;;;; modify it under the terms of the GNU Lesser General Public
@ -31,7 +31,7 @@
(if env (car env) (current-module))) (if env (car env) (current-module)))
(define (objcode-env-externals env) (define (objcode-env-externals env)
(if env (cdr env) '())) (and env (vector? (cdr env)) (cdr env)))
(define (objcode->value x e opts) (define (objcode->value x e opts)
(let ((thunk (make-program x #f (objcode-env-externals e)))) (let ((thunk (make-program x #f (objcode-env-externals e))))

7
module/system/vm/program.scm
View file

@ -1,6 +1,6 @@
;;; Guile VM program functions ;;; 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 ;;; This library is free software; you can redistribute it and/or
;;; modify it under the terms of the GNU Lesser General Public ;;; modify it under the terms of the GNU Lesser General Public
@ -31,16 +31,15 @@
program-properties program-property program-documentation program-properties program-property program-documentation
program-name program-arguments program-name program-arguments
program-arity program-external-set! program-meta program-arity program-meta
program-objcode program? program-objects program-objcode program? program-objects
program-module program-base program-external)) program-module program-base program-free-vars))
(load-extension "libguile" "scm_init_programs") (load-extension "libguile" "scm_init_programs")
(define arity:nargs car) (define arity:nargs car)
(define arity:nrest cadr) (define arity:nrest cadr)
(define arity:nlocs caddr) (define arity:nlocs caddr)
(define arity:nexts cadddr)
(define (make-binding name extp index start end) (define (make-binding name extp index start end)
(list name extp index start end)) (list name extp index start end))