mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-14 23:50:19 +02:00
Code Activity

Frame pointer points to local 0 instead of local 1

Browse source 
* libguile/frames.h: Change so that fp points at local 0 instead of
  local 1, and clean up a bit.
  (struct scm_vm_frame): Remove program, and rename stack to locals.
  (SCM_FRAME_DATA_ADDRESS): Remove; it was redundant with
  SCM_FRAME_LOWER_ADDRESS.
  (SCM_FRAME_STACK_ADDRESS): Remove; replace with the new
  SCM_FRAME_LOCALS_ADDRESS.
  (SCM_FRAME_UPPER_ADDRESS): Remove; unused.
  (SCM_FRAME_NUM_LOCALS, SCM_FRAME_PREVIOUS_SP): New defines.
  (SCM_FRAME_BYTE_CAST, SCM_FRAME_STACK_CAST): Remove; unused;
  (SCM_FRAME_LOCAL): New define, replaces SCM_FRAME_VARIABLE.
  (SCM_FRAME_PROGRAM): Add cautionary commentary.

* libguile/frames.c: Adapt static asserts.
  (scm_frame_num_locals, scm_frame_local_ref, scm_frame_local_set_x):
  Adapt.  This means that frame-local-ref 0 now returns the procedure.

* libguile/vm-engine.c (ALLOC_FRAME, RESET_FRAME)
  (FRAME_LOCALS_COUNT, LOCAL_REF, LOCAL_SET, RETURN_VALUE_LIST): Adapt
  to change in fp.
  (LOCAL_ADDRESS): New helper.
  (POP_CONTINUATION_HOOK): Reimplement, taking the previous FP as an
  argument.
  (ABORT_CONTINUATION_HOOK): Reimplement, taking no arguments.
  (RETURN_ONE_VALUE): Reimplement.
  (RETURN_VALUE_LIST): Adapt to FP change.
  (halt, return-values, subr-call, foreign-call, prompt)
  (continuation-call, compose-continuation, call/cc, abort): Adapt to FP
  change, mostly via using LOCAL_ADDRESS, etc abstractions instead of
  using the raw frame pointer.

* libguile/control.c (reify_partial_continuation): Update for fp
  change.

* libguile/vm.c (vm_reinstate_partial_continuation): Adapt to removal of
  SCM_FRAME_UPPER_ADDRESS.

* module/system/vm/frame.scm (frame-call-representation): Adapt to
  frame-local-ref change.

* module/system/vm/trace.scm (print-return): Remove unused
  frame-num-locals call.
This commit is contained in:
Andy Wingo 2013-11-17 22:07:44 +01:00
parent cb8ea3805f
commit b636cdb0f3
7 changed files with 166 additions and 127 deletions
Download patch file Download diff file Expand all files Collapse all files

2
libguile/control.c
View file

@ -109,7 +109,7 @@ reify_partial_continuation (SCM vm,
abort(); abort();
/* Capture from the top of the thunk application frame up to the end. */ /* Capture from the top of the thunk application frame up to the end. */
vm_cont = scm_i_vm_capture_stack (bottom_fp - 1, vm_cont = scm_i_vm_capture_stack (&SCM_FRAME_LOCAL (bottom_fp, 0),
SCM_VM_DATA (vm)->fp, SCM_VM_DATA (vm)->fp,
SCM_VM_DATA (vm)->sp, SCM_VM_DATA (vm)->sp,
SCM_VM_DATA (vm)->ip, SCM_VM_DATA (vm)->ip,

26
libguile/frames.c
View file

@ -28,7 +28,7 @@
/* Make sure assumptions on the layout of `struct scm_vm_frame' hold. */ /* Make sure assumptions on the layout of `struct scm_vm_frame' hold. */
verify (sizeof (SCM) == sizeof (SCM *)); verify (sizeof (SCM) == sizeof (SCM *));
verify (sizeof (struct scm_vm_frame) == 4 * sizeof (SCM)); verify (sizeof (struct scm_vm_frame) == 3 * sizeof (SCM));
verify (offsetof (struct scm_vm_frame, dynamic_link) == 0); verify (offsetof (struct scm_vm_frame, dynamic_link) == 0);
@ -115,14 +115,14 @@ SCM_DEFINE (scm_frame_num_locals, "frame-num-locals", 1, 0, 0,
"") "")
#define FUNC_NAME s_scm_frame_num_locals #define FUNC_NAME s_scm_frame_num_locals
{ {
SCM *sp, *p; SCM *fp, *sp;
SCM_VALIDATE_VM_FRAME (1, frame); SCM_VALIDATE_VM_FRAME (1, frame);
fp = SCM_VM_FRAME_FP (frame);
sp = SCM_VM_FRAME_SP (frame); sp = SCM_VM_FRAME_SP (frame);
p = SCM_FRAME_STACK_ADDRESS (SCM_VM_FRAME_FP (frame));
return scm_from_ptrdiff_t (sp + 1 - p); return scm_from_ptrdiff_t (SCM_FRAME_NUM_LOCALS (fp, sp));
} }
#undef FUNC_NAME #undef FUNC_NAME
@ -131,17 +131,17 @@ SCM_DEFINE (scm_frame_local_ref, "frame-local-ref", 2, 0, 0,
"") "")
#define FUNC_NAME s_scm_frame_local_ref #define FUNC_NAME s_scm_frame_local_ref
{ {
SCM *sp, *p; SCM *fp, *sp;
unsigned int i; unsigned int i;
SCM_VALIDATE_VM_FRAME (1, frame); SCM_VALIDATE_VM_FRAME (1, frame);
SCM_VALIDATE_UINT_COPY (2, index, i); SCM_VALIDATE_UINT_COPY (2, index, i);
fp = SCM_VM_FRAME_FP (frame);
sp = SCM_VM_FRAME_SP (frame); sp = SCM_VM_FRAME_SP (frame);
p = SCM_FRAME_STACK_ADDRESS (SCM_VM_FRAME_FP (frame));
if (p + i <= sp) if (i < SCM_FRAME_NUM_LOCALS (fp, sp))
return SCM_FRAME_VARIABLE (SCM_VM_FRAME_FP (frame), i); return SCM_FRAME_LOCAL (fp, i);
SCM_OUT_OF_RANGE (SCM_ARG2, index); SCM_OUT_OF_RANGE (SCM_ARG2, index);
} }
@ -153,18 +153,18 @@ SCM_DEFINE (scm_frame_local_set_x, "frame-local-set!", 3, 0, 0,
"") "")
#define FUNC_NAME s_scm_frame_local_set_x #define FUNC_NAME s_scm_frame_local_set_x
{ {
SCM *sp, *p; SCM *fp, *sp;
unsigned int i; unsigned int i;
SCM_VALIDATE_VM_FRAME (1, frame); SCM_VALIDATE_VM_FRAME (1, frame);
SCM_VALIDATE_UINT_COPY (2, index, i); SCM_VALIDATE_UINT_COPY (2, index, i);
fp = SCM_VM_FRAME_FP (frame);
sp = SCM_VM_FRAME_SP (frame); sp = SCM_VM_FRAME_SP (frame);
p = SCM_FRAME_STACK_ADDRESS (SCM_VM_FRAME_FP (frame));
if (p + i <= sp) if (i < SCM_FRAME_NUM_LOCALS (fp, sp))
{ {
SCM_FRAME_VARIABLE (SCM_VM_FRAME_FP (frame), i) = val; SCM_FRAME_LOCAL (fp, i) = val;
return SCM_UNSPECIFIED; return SCM_UNSPECIFIED;
} }
@ -245,7 +245,7 @@ SCM_DEFINE (scm_frame_previous, "frame-previous", 1, 0, 0,
if (new_fp) if (new_fp)
{ {
new_fp = RELOC (frame, new_fp); new_fp = RELOC (frame, new_fp);
new_sp = SCM_FRAME_LOWER_ADDRESS (this_fp) - 1; new_sp = SCM_FRAME_PREVIOUS_SP (this_fp);
frame = scm_c_make_frame (SCM_VM_FRAME_STACK_HOLDER (frame), frame = scm_c_make_frame (SCM_VM_FRAME_STACK_HOLDER (frame),
new_fp, new_sp, new_fp, new_sp,
SCM_FRAME_RETURN_ADDRESS (this_fp), SCM_FRAME_RETURN_ADDRESS (this_fp),

126
libguile/frames.h
View file

@ -23,47 +23,62 @@
#include "programs.h" #include "programs.h"
/* /* Stack frames
* VM frames ------------
*/
/* It's a little confusing, but there are two representations of frames
* It's a little confusing, but there are two representations of frames in this in this file: frame pointers, and Scheme objects wrapping those frame
* file: frame pointers and Scheme objects wrapping those frame pointers. The pointers. The former uses the SCM_FRAME macro prefix, the latter
* former uses the SCM_FRAME_... macro prefix, the latter SCM_VM_FRAME_.. SCM_VM_FRAME prefix.
* prefix.
*
* The confusing thing is that only Scheme frame objects have functions that use
* them, and they use the scm_frame_.. prefix. Hysterical raisins.
*/
/* VM Frame Layout The confusing thing is that only Scheme frame objects have functions
--------------- that use them, and they use the lower-case scm_frame prefix.
Stack frame layout
------------------
/------------------\
| Local N-1 | <- sp
| ... | | ... |
| Intermed. val. 0 | <- fp + nargs + nlocs | Local 1 |
+------------------+ | Local 0 | <- fp = SCM_FRAME_LOCALS_ADDRESS (fp)
| Local variable 1 |
| Local variable 0 | <- fp + nargs
| Argument 1 |
| Argument 0 | <- fp = SCM_FRAME_STACK_ADDRESS (fp)
| Program | <- fp - 1
+==================+ +==================+
| Return address | <- SCM_FRAME_UPPER_ADDRESS (fp) | Return address |
| Dynamic link | <- fp - 3 = SCM_FRAME_DATA_ADDRESS (fp) = SCM_FRAME_LOWER_ADDRESS (fp) | Dynamic link | <- fp - 2 = SCM_FRAME_LOWER_ADDRESS (fp)
+==================+ +==================+
| | | | <- fp - 3 = SCM_FRAME_PREVIOUS_SP (fp)
As can be inferred from this drawing, it is assumed that The calling convention is that a caller prepares a stack frame
`sizeof (SCM *) == sizeof (SCM)', since pointers (the `link' parts) are consisting of the saved FP and the return address, followed by the
assumed to be as long as SCM objects. procedure and then the arguments to the call, in order. Thus in the
beginning of a call, the procedure being called is in slot 0, the
first argument is in slot 1, and the SP points to the last argument.
The number of arguments, including the procedure, is thus SP - FP +
1.
When a program returns multiple values, it will shuffle them down to After ensuring that the correct number of arguments have been passed,
start contiguously from slot 1, as for a tail call. This means that a function will set the stack pointer to point to the last local
when the caller goes to access them, there are 2 or 3 empty words slot. This lets a function allocate the temporary space that it
between the top of the caller stack and the bottom of the values, needs once in the beginning of the call, instead of pushing and
corresponding to the frame that was just popped. popping the stack pointer during the call's extent.
*/
When a program returns, it returns its values in the slots starting
from local 1, as if the values were arguments to a tail call. We
start from 1 instead of 0 for the convenience of the "values" builtin
function, which can just leave its arguments in place.
The callee resets the stack pointer to point to the last value. In
this way the caller knows how many values there are: it's the number
of words between the stack pointer and the slot at which the caller
placed the procedure.
After checking that the number of values returned is appropriate, the
caller shuffles the values around (if needed), and resets the stack
pointer back to its original value from before the call. */
/* This structure maps to the contents of a VM stack frame. It can /* This structure maps to the contents of a VM stack frame. It can
alias a frame directly. */ alias a frame directly. */
@ -71,20 +86,15 @@ struct scm_vm_frame
{ {
SCM *dynamic_link; SCM *dynamic_link;
scm_t_uint8 *return_address; scm_t_uint8 *return_address;
SCM program; SCM locals[1]; /* Variable-length */
SCM stack[1]; /* Variable-length */
}; };
#define SCM_FRAME_LOWER_ADDRESS(fp) (((SCM *) (fp)) - 2)
#define SCM_FRAME_STRUCT(fp) \ #define SCM_FRAME_STRUCT(fp) \
((struct scm_vm_frame *) SCM_FRAME_DATA_ADDRESS (fp)) ((struct scm_vm_frame *) SCM_FRAME_LOWER_ADDRESS (fp))
#define SCM_FRAME_LOCALS_ADDRESS(fp) (SCM_FRAME_STRUCT (fp)->locals)
#define SCM_FRAME_DATA_ADDRESS(fp) (((SCM *) (fp)) - 3) #define SCM_FRAME_PREVIOUS_SP(fp) (((SCM *) (fp)) - 3)
#define SCM_FRAME_STACK_ADDRESS(fp) (SCM_FRAME_STRUCT (fp)->stack)
#define SCM_FRAME_UPPER_ADDRESS(fp) ((SCM*)&SCM_FRAME_STRUCT (fp)->return_address)
#define SCM_FRAME_LOWER_ADDRESS(fp) ((SCM*)SCM_FRAME_STRUCT (fp))
#define SCM_FRAME_BYTE_CAST(x) ((scm_t_uint8 *) 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_STRUCT (fp)->return_address) (SCM_FRAME_STRUCT (fp)->return_address)
@ -94,10 +104,32 @@ struct scm_vm_frame
(SCM_FRAME_STRUCT (fp)->dynamic_link) (SCM_FRAME_STRUCT (fp)->dynamic_link)
#define SCM_FRAME_SET_DYNAMIC_LINK(fp, dl) \ #define SCM_FRAME_SET_DYNAMIC_LINK(fp, dl) \
SCM_FRAME_DYNAMIC_LINK (fp) = (dl) SCM_FRAME_DYNAMIC_LINK (fp) = (dl)
#define SCM_FRAME_VARIABLE(fp,i) \ #define SCM_FRAME_LOCAL(fp,i) \
(SCM_FRAME_STRUCT (fp)->stack[i]) (SCM_FRAME_STRUCT (fp)->locals[i])
#define SCM_FRAME_PROGRAM(fp) \
(SCM_FRAME_STRUCT (fp)->program) #define SCM_FRAME_NUM_LOCALS(fp, sp) \
((sp) + 1 - &SCM_FRAME_LOCAL (fp, 0))
/* Currently (November 2013) we keep the procedure and arguments in
their slots for the duration of the procedure call, regardless of
whether the values are live or not. This allows for backtraces that
show the closure and arguments. We may allow the compiler to relax
this restriction in the future, if the user so desires. This would
conserve stack space and make GC more precise. We would need better
debugging information to do that, however.
Even now there is an exception to the rule that slot 0 holds the
procedure, which is in the case of tail calls. The compiler will
emit code that shuffles the new procedure and arguments into position
before performing the tail call, so there is a window in which
SCM_FRAME_PROGRAM does not correspond to the program being executed.
The moral of the story is to use the IP in a frame to determine what
procedure is being called. It is only appropriate to use
SCM_FRAME_PROGRAM in the prologue of a procedure call, when you know
it must be there. */
#define SCM_FRAME_PROGRAM(fp) (SCM_FRAME_LOCAL (fp, 0))

129
libguile/vm-engine.c
View file

@ -84,12 +84,16 @@
RUN_HOOK0 (SCM_VM_APPLY_HOOK) RUN_HOOK0 (SCM_VM_APPLY_HOOK)
#define PUSH_CONTINUATION_HOOK() \ #define PUSH_CONTINUATION_HOOK() \
RUN_HOOK0 (SCM_VM_PUSH_CONTINUATION_HOOK) RUN_HOOK0 (SCM_VM_PUSH_CONTINUATION_HOOK)
#define POP_CONTINUATION_HOOK(vals, n) \ #define POP_CONTINUATION_HOOK(old_fp) \
RUN_HOOK (SCM_VM_POP_CONTINUATION_HOOK, vals, n) RUN_HOOK (SCM_VM_POP_CONTINUATION_HOOK, \
&SCM_FRAME_LOCAL (old_fp, 1), \
SCM_FRAME_NUM_LOCALS (old_fp, vp->sp) - 1)
#define NEXT_HOOK() \ #define NEXT_HOOK() \
RUN_HOOK0 (SCM_VM_NEXT_HOOK) RUN_HOOK0 (SCM_VM_NEXT_HOOK)
#define ABORT_CONTINUATION_HOOK(vals, n) \ #define ABORT_CONTINUATION_HOOK() \
RUN_HOOK (SCM_VM_ABORT_CONTINUATION_HOOK, vals, n) RUN_HOOK (SCM_VM_ABORT_CONTINUATION_HOOK, \
LOCAL_ADDRESS (1), \
FRAME_LOCALS_COUNT () - 1)
#define RESTORE_CONTINUATION_HOOK() \ #define RESTORE_CONTINUATION_HOOK() \
RUN_HOOK0 (SCM_VM_RESTORE_CONTINUATION_HOOK) RUN_HOOK0 (SCM_VM_RESTORE_CONTINUATION_HOOK)
@ -141,27 +145,28 @@
} while (0) } while (0)
/* Reserve stack space for a frame. Will check that there is sufficient /* Reserve stack space for a frame. Will check that there is sufficient
stack space for N locals, including the procedure, in addition to stack space for N locals, including the procedure. Invoke after
2 words to set up the next frame. Invoke after preparing the new preparing the new frame and setting the fp and ip. */
frame and setting the fp and ip. */
#define ALLOC_FRAME(n) \ #define ALLOC_FRAME(n) \
do { \ do { \
SCM *new_sp = vp->sp = fp - 1 + n - 1; \ SCM *new_sp = vp->sp = LOCAL_ADDRESS (n - 1); \
CHECK_OVERFLOW (new_sp + 3); \ CHECK_OVERFLOW (new_sp); \
} while (0) } while (0)
/* Reset the current frame to hold N locals. Used when we know that no /* Reset the current frame to hold N locals. Used when we know that no
stack expansion is needed. */ stack expansion is needed. */
#define RESET_FRAME(n) \ #define RESET_FRAME(n) \
do { \ do { \
vp->sp = fp - 2 + n; \ vp->sp = LOCAL_ADDRESS (n - 1); \
} while (0) } while (0)
/* Compute the number of locals in the frame. This is equal to the /* Compute the number of locals in the frame. At a call, this is equal
number of actual arguments when a function is first called, plus to the number of actual arguments when a function is first called,
one for the function. */ plus one for the function. */
#define FRAME_LOCALS_COUNT() \ #define FRAME_LOCALS_COUNT_FROM(slot) \
(vp->sp + 1 - (fp - 1)) (vp->sp + 1 - LOCAL_ADDRESS (slot))
#define FRAME_LOCALS_COUNT() \
FRAME_LOCALS_COUNT_FROM (0)
/* Restore registers after returning from a frame. */ /* Restore registers after returning from a frame. */
#define RESTORE_FRAME() \ #define RESTORE_FRAME() \
@ -212,8 +217,9 @@
case opcode: case opcode:
#endif #endif
#define LOCAL_REF(i) SCM_FRAME_VARIABLE ((fp - 1), i) #define LOCAL_ADDRESS(i) (&SCM_FRAME_LOCAL (fp, i))
#define LOCAL_SET(i,o) SCM_FRAME_VARIABLE ((fp - 1), i) = o #define LOCAL_REF(i) SCM_FRAME_LOCAL (fp, i)
#define LOCAL_SET(i,o) SCM_FRAME_LOCAL (fp, i) = o
#define VARIABLE_REF(v) SCM_VARIABLE_REF (v) #define VARIABLE_REF(v) SCM_VARIABLE_REF (v)
#define VARIABLE_SET(v,o) SCM_VARIABLE_SET (v, o) #define VARIABLE_SET(v,o) SCM_VARIABLE_SET (v, o)
@ -222,17 +228,17 @@
#define RETURN_ONE_VALUE(ret) \ #define RETURN_ONE_VALUE(ret) \
do { \ do { \
SCM val = ret; \ SCM val = ret; \
SCM *sp = SCM_FRAME_LOWER_ADDRESS (fp); \ SCM *old_fp = fp; \
VM_HANDLE_INTERRUPTS; \ VM_HANDLE_INTERRUPTS; \
ip = SCM_FRAME_RTL_RETURN_ADDRESS (fp); \ ip = SCM_FRAME_RTL_RETURN_ADDRESS (fp); \
fp = vp->fp = SCM_FRAME_DYNAMIC_LINK (fp); \ fp = vp->fp = SCM_FRAME_DYNAMIC_LINK (fp); \
/* Clear frame. */ \ /* Clear frame. */ \
sp[0] = SCM_BOOL_F; \ old_fp[-1] = SCM_BOOL_F; \
sp[1] = SCM_BOOL_F; \ old_fp[-2] = SCM_BOOL_F; \
/* Leave proc. */ \ /* Leave proc. */ \
sp[3] = val; \ SCM_FRAME_LOCAL (old_fp, 1) = val; \
vp->sp = sp + 3; \ vp->sp = &SCM_FRAME_LOCAL (old_fp, 1); \
POP_CONTINUATION_HOOK (sp, 1); \ POP_CONTINUATION_HOOK (old_fp); \
NEXT (0); \ NEXT (0); \
} while (0) } while (0)
@ -242,9 +248,9 @@
do { \ do { \
SCM vals = vals_; \ SCM vals = vals_; \
VM_HANDLE_INTERRUPTS; \ VM_HANDLE_INTERRUPTS; \
fp[-1] = vm_builtin_apply; \ fp[0] = vm_builtin_apply; \
fp[0] = vm_builtin_values; \ fp[1] = vm_builtin_values; \
fp[1] = vals; \ fp[2] = vals; \
RESET_FRAME (3); \ RESET_FRAME (3); \
ip = (scm_t_uint32 *) vm_builtin_apply_code; \ ip = (scm_t_uint32 *) vm_builtin_apply_code; \
goto op_tail_apply; \ goto op_tail_apply; \
@ -432,7 +438,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_)
to pull all our state back from the ip/fp/sp. to pull all our state back from the ip/fp/sp.
*/ */
CACHE_REGISTER (); CACHE_REGISTER ();
ABORT_CONTINUATION_HOOK (fp, FRAME_LOCALS_COUNT () - 1); ABORT_CONTINUATION_HOOK ();
NEXT (0); NEXT (0);
} }
@ -465,14 +471,14 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_)
base[0] = SCM_PACK (fp); /* dynamic link */ base[0] = SCM_PACK (fp); /* dynamic link */
base[1] = SCM_PACK (ip); /* ra */ base[1] = SCM_PACK (ip); /* ra */
base[2] = rtl_boot_continuation; base[2] = rtl_boot_continuation;
fp = &base[3]; fp = &base[2];
ip = (scm_t_uint32 *) rtl_boot_continuation_code; ip = (scm_t_uint32 *) rtl_boot_continuation_code;
/* MV-call frame, function & arguments */ /* MV-call frame, function & arguments */
base[3] = SCM_PACK (fp); /* dynamic link */ base[3] = SCM_PACK (fp); /* dynamic link */
base[4] = SCM_PACK (ip); /* ra */ base[4] = SCM_PACK (ip); /* ra */
base[5] = program; base[5] = program;
fp = vp->fp = &base[6]; fp = vp->fp = &base[5];
RESET_FRAME (nargs_ + 1); RESET_FRAME (nargs_ + 1);
} }
@ -483,7 +489,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_)
if (SCM_STRUCTP (proc) && SCM_STRUCT_APPLICABLE_P (proc)) if (SCM_STRUCTP (proc) && SCM_STRUCT_APPLICABLE_P (proc))
{ {
fp[-1] = SCM_STRUCT_PROCEDURE (proc); LOCAL_SET (0, SCM_STRUCT_PROCEDURE (proc));
continue; continue;
} }
if (SCM_HAS_TYP7 (proc, scm_tc7_smob) && SCM_SMOB_APPLICABLE_P (proc)) if (SCM_HAS_TYP7 (proc, scm_tc7_smob) && SCM_SMOB_APPLICABLE_P (proc))
@ -522,11 +528,11 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_)
*/ */
VM_DEFINE_OP (0, halt, "halt", OP1 (U8_X24)) VM_DEFINE_OP (0, halt, "halt", OP1 (U8_X24))
{ {
scm_t_uint32 nvals = FRAME_LOCALS_COUNT() - 4;
SCM ret;
/* Boot closure in r0, empty frame in r1/r2, proc in r3, values from r4. */ /* Boot closure in r0, empty frame in r1/r2, proc in r3, values from r4. */
scm_t_uint32 nvals = FRAME_LOCALS_COUNT_FROM (4);
SCM ret;
if (nvals == 1) if (nvals == 1)
ret = LOCAL_REF (4); ret = LOCAL_REF (4);
else else
@ -540,7 +546,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_)
} }
vp->ip = SCM_FRAME_RETURN_ADDRESS (fp); vp->ip = SCM_FRAME_RETURN_ADDRESS (fp);
vp->sp = SCM_FRAME_LOWER_ADDRESS (fp) - 1; vp->sp = SCM_FRAME_PREVIOUS_SP (fp);
vp->fp = SCM_FRAME_DYNAMIC_LINK (fp); vp->fp = SCM_FRAME_DYNAMIC_LINK (fp);
return ret; return ret;
@ -703,18 +709,17 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_)
*/ */
VM_DEFINE_OP (7, return_values, "return-values", OP1 (U8_X24)) VM_DEFINE_OP (7, return_values, "return-values", OP1 (U8_X24))
{ {
scm_t_uint32 nvalues _GL_UNUSED = FRAME_LOCALS_COUNT(); SCM *old_fp = fp;
SCM *base = fp;
VM_HANDLE_INTERRUPTS; VM_HANDLE_INTERRUPTS;
ip = SCM_FRAME_RTL_RETURN_ADDRESS (fp); ip = SCM_FRAME_RTL_RETURN_ADDRESS (fp);
fp = vp->fp = SCM_FRAME_DYNAMIC_LINK (fp); fp = vp->fp = SCM_FRAME_DYNAMIC_LINK (fp);
/* Clear stack frame. */ /* Clear stack frame. */
base[-2] = SCM_BOOL_F; old_fp[-1] = SCM_BOOL_F;
base[-3] = SCM_BOOL_F; old_fp[-2] = SCM_BOOL_F;
POP_CONTINUATION_HOOK (base, nvalues); POP_CONTINUATION_HOOK (old_fp);
NEXT (0); NEXT (0);
} }
@ -747,40 +752,40 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_)
VM_HANDLE_INTERRUPTS; VM_HANDLE_INTERRUPTS;
SYNC_IP (); SYNC_IP ();
switch (FRAME_LOCALS_COUNT () - 1) switch (FRAME_LOCALS_COUNT_FROM (1))
{ {
case 0: case 0:
ret = subr (); ret = subr ();
break; break;
case 1: case 1:
ret = subr (fp[0]); ret = subr (fp[1]);
break; break;
case 2: case 2:
ret = subr (fp[0], fp[1]); ret = subr (fp[1], fp[2]);
break; break;
case 3: case 3:
ret = subr (fp[0], fp[1], fp[2]); ret = subr (fp[1], fp[2], fp[3]);
break; break;
case 4: case 4:
ret = subr (fp[0], fp[1], fp[2], fp[3]); ret = subr (fp[1], fp[2], fp[3], fp[4]);
break; break;
case 5: case 5:
ret = subr (fp[0], fp[1], fp[2], fp[3], fp[4]); ret = subr (fp[1], fp[2], fp[3], fp[4], fp[5]);
break; break;
case 6: case 6:
ret = subr (fp[0], fp[1], fp[2], fp[3], fp[4], fp[5]); ret = subr (fp[1], fp[2], fp[3], fp[4], fp[5], fp[6]);
break; break;
case 7: case 7:
ret = subr (fp[0], fp[1], fp[2], fp[3], fp[4], fp[5], fp[6]); ret = subr (fp[1], fp[2], fp[3], fp[4], fp[5], fp[6], fp[7]);
break; break;
case 8: case 8:
ret = subr (fp[0], fp[1], fp[2], fp[3], fp[4], fp[5], fp[6], fp[7]); ret = subr (fp[1], fp[2], fp[3], fp[4], fp[5], fp[6], fp[7], fp[8]);
break; break;
case 9: case 9:
ret = subr (fp[0], fp[1], fp[2], fp[3], fp[4], fp[5], fp[6], fp[7], fp[8]); ret = subr (fp[1], fp[2], fp[3], fp[4], fp[5], fp[6], fp[7], fp[8], fp[9]);
break; break;
case 10: case 10:
ret = subr (fp[0], fp[1], fp[2], fp[3], fp[4], fp[5], fp[6], fp[7], fp[8], fp[9]); ret = subr (fp[1], fp[2], fp[3], fp[4], fp[5], fp[6], fp[7], fp[8], fp[9], fp[10]);
break; break;
default: default:
abort (); abort ();
@ -818,7 +823,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_)
VM_HANDLE_INTERRUPTS; VM_HANDLE_INTERRUPTS;
// FIXME: separate args // FIXME: separate args
ret = scm_i_foreign_call (scm_cons (cif, pointer), fp); ret = scm_i_foreign_call (scm_cons (cif, pointer), LOCAL_ADDRESS (1));
// NULLSTACK_FOR_NONLOCAL_EXIT (); // NULLSTACK_FOR_NONLOCAL_EXIT ();
@ -851,7 +856,8 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_)
scm_i_check_continuation (contregs); scm_i_check_continuation (contregs);
vm_return_to_continuation (scm_i_contregs_vm (contregs), vm_return_to_continuation (scm_i_contregs_vm (contregs),
scm_i_contregs_vm_cont (contregs), scm_i_contregs_vm_cont (contregs),
FRAME_LOCALS_COUNT () - 1, fp); FRAME_LOCALS_COUNT_FROM (1),
LOCAL_ADDRESS (1));
scm_i_reinstate_continuation (contregs); scm_i_reinstate_continuation (contregs);
/* no NEXT */ /* no NEXT */
@ -877,7 +883,8 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_)
SYNC_IP (); SYNC_IP ();
VM_ASSERT (SCM_VM_CONT_REWINDABLE_P (vmcont), VM_ASSERT (SCM_VM_CONT_REWINDABLE_P (vmcont),
vm_error_continuation_not_rewindable (vmcont)); vm_error_continuation_not_rewindable (vmcont));
vm_reinstate_partial_continuation (vm, vmcont, FRAME_LOCALS_COUNT () - 1, fp, vm_reinstate_partial_continuation (vm, vmcont, FRAME_LOCALS_COUNT_FROM (1),
LOCAL_ADDRESS (1),
&current_thread->dynstack, &current_thread->dynstack,
&registers); &registers);
CACHE_REGISTER (); CACHE_REGISTER ();
@ -947,7 +954,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_)
dynstack = scm_dynstack_capture_all (&current_thread->dynstack); dynstack = scm_dynstack_capture_all (&current_thread->dynstack);
vm_cont = scm_i_vm_capture_stack (vp->stack_base, vm_cont = scm_i_vm_capture_stack (vp->stack_base,
SCM_FRAME_DYNAMIC_LINK (fp), SCM_FRAME_DYNAMIC_LINK (fp),
SCM_FRAME_LOWER_ADDRESS (fp) - 1, SCM_FRAME_PREVIOUS_SP (fp),
SCM_FRAME_RETURN_ADDRESS (fp), SCM_FRAME_RETURN_ADDRESS (fp),
dynstack, dynstack,
0); 0);
@ -975,7 +982,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_)
else else
{ {
CACHE_REGISTER (); CACHE_REGISTER ();
ABORT_CONTINUATION_HOOK (fp, FRAME_LOCALS_COUNT () - 1); ABORT_CONTINUATION_HOOK ();
NEXT (0); NEXT (0);
} }
} }
@ -996,8 +1003,8 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_)
it continues with the next instruction. */ it continues with the next instruction. */
ip++; ip++;
SYNC_IP (); SYNC_IP ();
vm_abort (vm, LOCAL_REF (1), nlocals - 2, &LOCAL_REF (2), vm_abort (vm, LOCAL_REF (1), nlocals - 2, LOCAL_ADDRESS (2),
SCM_EOL, &LOCAL_REF (0), &registers); SCM_EOL, LOCAL_ADDRESS (0), &registers);
/* vm_abort should not return */ /* vm_abort should not return */
abort (); abort ();
@ -1825,7 +1832,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_)
var = scm_lookup (LOCAL_REF (sym)); var = scm_lookup (LOCAL_REF (sym));
if (ip[1] & 0x1) if (ip[1] & 0x1)
VM_ASSERT (VARIABLE_BOUNDP (var), VM_ASSERT (VARIABLE_BOUNDP (var),
vm_error_unbound (fp[-1], LOCAL_REF (sym))); vm_error_unbound (fp[0], LOCAL_REF (sym)));
LOCAL_SET (dst, var); LOCAL_SET (dst, var);
NEXT (2); NEXT (2);
@ -1902,7 +1909,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_)
var = scm_module_lookup (mod, sym); var = scm_module_lookup (mod, sym);
if (ip[4] & 0x1) if (ip[4] & 0x1)
VM_ASSERT (VARIABLE_BOUNDP (var), vm_error_unbound (fp[-1], sym)); VM_ASSERT (VARIABLE_BOUNDP (var), vm_error_unbound (fp[0], sym));
*var_loc = var; *var_loc = var;
} }
@ -1964,7 +1971,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_)
var = scm_private_lookup (SCM_CDR (modname), sym); var = scm_private_lookup (SCM_CDR (modname), sym);
if (ip[4] & 0x1) if (ip[4] & 0x1)
VM_ASSERT (VARIABLE_BOUNDP (var), vm_error_unbound (fp[-1], sym)); VM_ASSERT (VARIABLE_BOUNDP (var), vm_error_unbound (fp[0], sym));
*var_loc = var; *var_loc = var;
} }
@ -2004,7 +2011,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_)
scm_dynstack_push_prompt (&current_thread->dynstack, flags, scm_dynstack_push_prompt (&current_thread->dynstack, flags,
LOCAL_REF (tag), LOCAL_REF (tag),
fp, fp,
&LOCAL_REF (proc_slot), LOCAL_ADDRESS (proc_slot),
(scm_t_uint8 *)(ip + offset), (scm_t_uint8 *)(ip + offset),
&registers); &registers);
NEXT (3); NEXT (3);

2
libguile/vm.c
View file

@ -312,7 +312,7 @@ vm_reinstate_partial_continuation (SCM vm, SCM cont, size_t n, SCM *argv,
vp = SCM_VM_DATA (vm); vp = SCM_VM_DATA (vm);
cp = SCM_VM_CONT_DATA (cont); cp = SCM_VM_CONT_DATA (cont);
base = SCM_FRAME_UPPER_ADDRESS (vp->fp) + 1; base = SCM_FRAME_LOCALS_ADDRESS (vp->fp);
reloc = cp->reloc + (base - cp->stack_base); reloc = cp->reloc + (base - cp->stack_base);
#define RELOC(scm_p) \ #define RELOC(scm_p) \

5
module/system/vm/frame.scm
View file

@ -105,7 +105,7 @@
(opt (or (assq-ref arguments 'optional) '())) (opt (or (assq-ref arguments 'optional) '()))
(key (or (assq-ref arguments 'keyword) '())) (key (or (assq-ref arguments 'keyword) '()))
(rest (or (assq-ref arguments 'rest) #f)) (rest (or (assq-ref arguments 'rest) #f))
(i 0)) (i 1))
(cond (cond
((pair? req) ((pair? req)
(cons (binding-ref (car req) i) (cons (binding-ref (car req) i)
@ -125,7 +125,8 @@
;; case 2 ;; case 2
(map (lambda (i) (map (lambda (i)
(frame-local-ref frame i)) (frame-local-ref frame i))
(iota (frame-num-locals frame)))))))) ;; Cdr past the 0th local, which is the procedure.
(cdr (iota (frame-num-locals frame)))))))))

3
module/system/vm/trace.scm
View file

@ -50,8 +50,7 @@
(frame-call-representation frame)))) (frame-call-representation frame))))
(define* (print-return frame depth width prefix max-indent values) (define* (print-return frame depth width prefix max-indent values)
(let* ((len (frame-num-locals frame)) (let ((prefix (build-prefix prefix depth "| " "~d< "max-indent)))
(prefix (build-prefix prefix depth "| " "~d< "max-indent)))
(case (length values) (case (length values)
((0) ((0)
(format (current-error-port) "~ano values\n" prefix)) (format (current-error-port) "~ano values\n" prefix))