From b636cdb0f3e1b7e8723c214db7a9c80edac9ead6 Mon Sep 17 00:00:00 2001 From: Andy Wingo Date: Sun, 17 Nov 2013 22:07:44 +0100 Subject: [PATCH] Frame pointer points to local 0 instead of local 1 * 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. --- libguile/control.c | 2 +- libguile/frames.c | 26 ++++---- libguile/frames.h | 126 ++++++++++++++++++++++-------------- libguile/vm-engine.c | 129 +++++++++++++++++++------------------ libguile/vm.c | 2 +- module/system/vm/frame.scm | 5 +- module/system/vm/trace.scm | 3 +- 7 files changed, 166 insertions(+), 127 deletions(-) diff --git a/libguile/control.c b/libguile/control.c index aad5aba5f..3e5c0d855 100644 --- a/libguile/control.c +++ b/libguile/control.c @@ -109,7 +109,7 @@ reify_partial_continuation (SCM vm, abort(); /* 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)->sp, SCM_VM_DATA (vm)->ip, diff --git a/libguile/frames.c b/libguile/frames.c index 5ba600bd6..8ca628ae4 100644 --- a/libguile/frames.c +++ b/libguile/frames.c @@ -28,7 +28,7 @@ /* Make sure assumptions on the layout of `struct scm_vm_frame' hold. */ 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); @@ -115,14 +115,14 @@ SCM_DEFINE (scm_frame_num_locals, "frame-num-locals", 1, 0, 0, "") #define FUNC_NAME s_scm_frame_num_locals { - SCM *sp, *p; + SCM *fp, *sp; SCM_VALIDATE_VM_FRAME (1, frame); + fp = SCM_VM_FRAME_FP (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 @@ -131,17 +131,17 @@ SCM_DEFINE (scm_frame_local_ref, "frame-local-ref", 2, 0, 0, "") #define FUNC_NAME s_scm_frame_local_ref { - SCM *sp, *p; + SCM *fp, *sp; unsigned int i; SCM_VALIDATE_VM_FRAME (1, frame); SCM_VALIDATE_UINT_COPY (2, index, i); + fp = SCM_VM_FRAME_FP (frame); sp = SCM_VM_FRAME_SP (frame); - p = SCM_FRAME_STACK_ADDRESS (SCM_VM_FRAME_FP (frame)); - if (p + i <= sp) - return SCM_FRAME_VARIABLE (SCM_VM_FRAME_FP (frame), i); + if (i < SCM_FRAME_NUM_LOCALS (fp, sp)) + return SCM_FRAME_LOCAL (fp, i); 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 { - SCM *sp, *p; + SCM *fp, *sp; unsigned int i; SCM_VALIDATE_VM_FRAME (1, frame); SCM_VALIDATE_UINT_COPY (2, index, i); + fp = SCM_VM_FRAME_FP (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; } @@ -245,7 +245,7 @@ SCM_DEFINE (scm_frame_previous, "frame-previous", 1, 0, 0, if (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), new_fp, new_sp, SCM_FRAME_RETURN_ADDRESS (this_fp), diff --git a/libguile/frames.h b/libguile/frames.h index f3bb9b046..bc5216568 100644 --- a/libguile/frames.h +++ b/libguile/frames.h @@ -23,47 +23,62 @@ #include "programs.h" -/* - * VM frames - */ +/* Stack frames + ------------ -/* - * It's a little confusing, but there are two representations of frames in this - * file: frame pointers and Scheme objects wrapping those frame pointers. The - * former uses the SCM_FRAME_... macro prefix, the latter SCM_VM_FRAME_.. - * prefix. - * - * The confusing thing is that only Scheme frame objects have functions that use - * them, and they use the scm_frame_.. prefix. Hysterical raisins. - */ + It's a little confusing, but there are two representations of frames + in this file: frame pointers, and Scheme objects wrapping those frame + pointers. The former uses the SCM_FRAME macro prefix, the latter + SCM_VM_FRAME prefix. + + The confusing thing is that only Scheme frame objects have functions + that use them, and they use the lower-case scm_frame prefix. -/* VM Frame Layout - --------------- + Stack frame layout + ------------------ + + /------------------\ + | Local N-1 | <- sp | ... | - | Intermed. val. 0 | <- fp + nargs + nlocs - +------------------+ - | Local variable 1 | - | Local variable 0 | <- fp + nargs - | Argument 1 | - | Argument 0 | <- fp = SCM_FRAME_STACK_ADDRESS (fp) - | Program | <- fp - 1 + | Local 1 | + | Local 0 | <- fp = SCM_FRAME_LOCALS_ADDRESS (fp) +==================+ - | Return address | <- SCM_FRAME_UPPER_ADDRESS (fp) - | Dynamic link | <- fp - 3 = SCM_FRAME_DATA_ADDRESS (fp) = SCM_FRAME_LOWER_ADDRESS (fp) + | Return address | + | 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 - `sizeof (SCM *) == sizeof (SCM)', since pointers (the `link' parts) are - assumed to be as long as SCM objects. + The calling convention is that a caller prepares a stack frame + consisting of the saved FP and the return address, followed by the + 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 - start contiguously from slot 1, as for a tail call. This means that - when the caller goes to access them, there are 2 or 3 empty words - between the top of the caller stack and the bottom of the values, - corresponding to the frame that was just popped. -*/ + After ensuring that the correct number of arguments have been passed, + a function will set the stack pointer to point to the last local + slot. This lets a function allocate the temporary space that it + needs once in the beginning of the call, instead of pushing and + 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 alias a frame directly. */ @@ -71,20 +86,15 @@ struct scm_vm_frame { SCM *dynamic_link; scm_t_uint8 *return_address; - SCM program; - SCM stack[1]; /* Variable-length */ + SCM locals[1]; /* Variable-length */ }; +#define SCM_FRAME_LOWER_ADDRESS(fp) (((SCM *) (fp)) - 2) #define SCM_FRAME_STRUCT(fp) \ - ((struct scm_vm_frame *) SCM_FRAME_DATA_ADDRESS (fp)) - -#define SCM_FRAME_DATA_ADDRESS(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)) + ((struct scm_vm_frame *) SCM_FRAME_LOWER_ADDRESS (fp)) +#define SCM_FRAME_LOCALS_ADDRESS(fp) (SCM_FRAME_STRUCT (fp)->locals) -#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_PREVIOUS_SP(fp) (((SCM *) (fp)) - 3) #define SCM_FRAME_RETURN_ADDRESS(fp) \ (SCM_FRAME_STRUCT (fp)->return_address) @@ -94,10 +104,32 @@ struct scm_vm_frame (SCM_FRAME_STRUCT (fp)->dynamic_link) #define SCM_FRAME_SET_DYNAMIC_LINK(fp, dl) \ SCM_FRAME_DYNAMIC_LINK (fp) = (dl) -#define SCM_FRAME_VARIABLE(fp,i) \ - (SCM_FRAME_STRUCT (fp)->stack[i]) -#define SCM_FRAME_PROGRAM(fp) \ - (SCM_FRAME_STRUCT (fp)->program) +#define SCM_FRAME_LOCAL(fp,i) \ + (SCM_FRAME_STRUCT (fp)->locals[i]) + +#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)) diff --git a/libguile/vm-engine.c b/libguile/vm-engine.c index 517b8c651..7fe78933c 100644 --- a/libguile/vm-engine.c +++ b/libguile/vm-engine.c @@ -84,12 +84,16 @@ RUN_HOOK0 (SCM_VM_APPLY_HOOK) #define PUSH_CONTINUATION_HOOK() \ RUN_HOOK0 (SCM_VM_PUSH_CONTINUATION_HOOK) -#define POP_CONTINUATION_HOOK(vals, n) \ - RUN_HOOK (SCM_VM_POP_CONTINUATION_HOOK, vals, n) +#define POP_CONTINUATION_HOOK(old_fp) \ + 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() \ RUN_HOOK0 (SCM_VM_NEXT_HOOK) -#define ABORT_CONTINUATION_HOOK(vals, n) \ - RUN_HOOK (SCM_VM_ABORT_CONTINUATION_HOOK, vals, n) +#define ABORT_CONTINUATION_HOOK() \ + RUN_HOOK (SCM_VM_ABORT_CONTINUATION_HOOK, \ + LOCAL_ADDRESS (1), \ + FRAME_LOCALS_COUNT () - 1) #define RESTORE_CONTINUATION_HOOK() \ RUN_HOOK0 (SCM_VM_RESTORE_CONTINUATION_HOOK) @@ -141,27 +145,28 @@ } while (0) /* Reserve stack space for a frame. Will check that there is sufficient - stack space for N locals, including the procedure, in addition to - 2 words to set up the next frame. Invoke after preparing the new - frame and setting the fp and ip. */ + stack space for N locals, including the procedure. Invoke after + preparing the new frame and setting the fp and ip. */ #define ALLOC_FRAME(n) \ do { \ - SCM *new_sp = vp->sp = fp - 1 + n - 1; \ - CHECK_OVERFLOW (new_sp + 3); \ + SCM *new_sp = vp->sp = LOCAL_ADDRESS (n - 1); \ + CHECK_OVERFLOW (new_sp); \ } while (0) /* Reset the current frame to hold N locals. Used when we know that no stack expansion is needed. */ #define RESET_FRAME(n) \ do { \ - vp->sp = fp - 2 + n; \ + vp->sp = LOCAL_ADDRESS (n - 1); \ } while (0) -/* Compute the number of locals in the frame. This is equal to the - number of actual arguments when a function is first called, plus - one for the function. */ -#define FRAME_LOCALS_COUNT() \ - (vp->sp + 1 - (fp - 1)) +/* Compute the number of locals in the frame. At a call, this is equal + to the number of actual arguments when a function is first called, + plus one for the function. */ +#define FRAME_LOCALS_COUNT_FROM(slot) \ + (vp->sp + 1 - LOCAL_ADDRESS (slot)) +#define FRAME_LOCALS_COUNT() \ + FRAME_LOCALS_COUNT_FROM (0) /* Restore registers after returning from a frame. */ #define RESTORE_FRAME() \ @@ -212,8 +217,9 @@ case opcode: #endif -#define LOCAL_REF(i) SCM_FRAME_VARIABLE ((fp - 1), i) -#define LOCAL_SET(i,o) SCM_FRAME_VARIABLE ((fp - 1), i) = o +#define LOCAL_ADDRESS(i) (&SCM_FRAME_LOCAL (fp, i)) +#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_SET(v,o) SCM_VARIABLE_SET (v, o) @@ -222,17 +228,17 @@ #define RETURN_ONE_VALUE(ret) \ do { \ SCM val = ret; \ - SCM *sp = SCM_FRAME_LOWER_ADDRESS (fp); \ + SCM *old_fp = fp; \ VM_HANDLE_INTERRUPTS; \ ip = SCM_FRAME_RTL_RETURN_ADDRESS (fp); \ fp = vp->fp = SCM_FRAME_DYNAMIC_LINK (fp); \ /* Clear frame. */ \ - sp[0] = SCM_BOOL_F; \ - sp[1] = SCM_BOOL_F; \ + old_fp[-1] = SCM_BOOL_F; \ + old_fp[-2] = SCM_BOOL_F; \ /* Leave proc. */ \ - sp[3] = val; \ - vp->sp = sp + 3; \ - POP_CONTINUATION_HOOK (sp, 1); \ + SCM_FRAME_LOCAL (old_fp, 1) = val; \ + vp->sp = &SCM_FRAME_LOCAL (old_fp, 1); \ + POP_CONTINUATION_HOOK (old_fp); \ NEXT (0); \ } while (0) @@ -242,9 +248,9 @@ do { \ SCM vals = vals_; \ VM_HANDLE_INTERRUPTS; \ - fp[-1] = vm_builtin_apply; \ - fp[0] = vm_builtin_values; \ - fp[1] = vals; \ + fp[0] = vm_builtin_apply; \ + fp[1] = vm_builtin_values; \ + fp[2] = vals; \ RESET_FRAME (3); \ ip = (scm_t_uint32 *) vm_builtin_apply_code; \ 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. */ CACHE_REGISTER (); - ABORT_CONTINUATION_HOOK (fp, FRAME_LOCALS_COUNT () - 1); + ABORT_CONTINUATION_HOOK (); 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[1] = SCM_PACK (ip); /* ra */ base[2] = rtl_boot_continuation; - fp = &base[3]; + fp = &base[2]; ip = (scm_t_uint32 *) rtl_boot_continuation_code; /* MV-call frame, function & arguments */ base[3] = SCM_PACK (fp); /* dynamic link */ base[4] = SCM_PACK (ip); /* ra */ base[5] = program; - fp = vp->fp = &base[6]; + fp = vp->fp = &base[5]; 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)) { - fp[-1] = SCM_STRUCT_PROCEDURE (proc); + LOCAL_SET (0, SCM_STRUCT_PROCEDURE (proc)); continue; } 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)) { - 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. */ + scm_t_uint32 nvals = FRAME_LOCALS_COUNT_FROM (4); + SCM ret; + if (nvals == 1) ret = LOCAL_REF (4); 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->sp = SCM_FRAME_LOWER_ADDRESS (fp) - 1; + vp->sp = SCM_FRAME_PREVIOUS_SP (fp); vp->fp = SCM_FRAME_DYNAMIC_LINK (fp); 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)) { - scm_t_uint32 nvalues _GL_UNUSED = FRAME_LOCALS_COUNT(); - SCM *base = fp; + SCM *old_fp = fp; VM_HANDLE_INTERRUPTS; ip = SCM_FRAME_RTL_RETURN_ADDRESS (fp); fp = vp->fp = SCM_FRAME_DYNAMIC_LINK (fp); /* Clear stack frame. */ - base[-2] = SCM_BOOL_F; - base[-3] = SCM_BOOL_F; + old_fp[-1] = SCM_BOOL_F; + old_fp[-2] = SCM_BOOL_F; - POP_CONTINUATION_HOOK (base, nvalues); + POP_CONTINUATION_HOOK (old_fp); NEXT (0); } @@ -747,40 +752,40 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_) VM_HANDLE_INTERRUPTS; SYNC_IP (); - switch (FRAME_LOCALS_COUNT () - 1) + switch (FRAME_LOCALS_COUNT_FROM (1)) { case 0: ret = subr (); break; case 1: - ret = subr (fp[0]); + ret = subr (fp[1]); break; case 2: - ret = subr (fp[0], fp[1]); + ret = subr (fp[1], fp[2]); break; case 3: - ret = subr (fp[0], fp[1], fp[2]); + ret = subr (fp[1], fp[2], fp[3]); break; case 4: - ret = subr (fp[0], fp[1], fp[2], fp[3]); + ret = subr (fp[1], fp[2], fp[3], fp[4]); break; 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; 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; 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; 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; 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; 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; default: abort (); @@ -818,7 +823,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_) VM_HANDLE_INTERRUPTS; // 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 (); @@ -851,7 +856,8 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_) scm_i_check_continuation (contregs); vm_return_to_continuation (scm_i_contregs_vm (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); /* no NEXT */ @@ -877,7 +883,8 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_) SYNC_IP (); VM_ASSERT (SCM_VM_CONT_REWINDABLE_P (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), ¤t_thread->dynstack, ®isters); CACHE_REGISTER (); @@ -947,7 +954,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_) dynstack = scm_dynstack_capture_all (¤t_thread->dynstack); vm_cont = scm_i_vm_capture_stack (vp->stack_base, SCM_FRAME_DYNAMIC_LINK (fp), - SCM_FRAME_LOWER_ADDRESS (fp) - 1, + SCM_FRAME_PREVIOUS_SP (fp), SCM_FRAME_RETURN_ADDRESS (fp), dynstack, 0); @@ -975,7 +982,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_) else { CACHE_REGISTER (); - ABORT_CONTINUATION_HOOK (fp, FRAME_LOCALS_COUNT () - 1); + ABORT_CONTINUATION_HOOK (); NEXT (0); } } @@ -996,8 +1003,8 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_) it continues with the next instruction. */ ip++; SYNC_IP (); - vm_abort (vm, LOCAL_REF (1), nlocals - 2, &LOCAL_REF (2), - SCM_EOL, &LOCAL_REF (0), ®isters); + vm_abort (vm, LOCAL_REF (1), nlocals - 2, LOCAL_ADDRESS (2), + SCM_EOL, LOCAL_ADDRESS (0), ®isters); /* vm_abort should not return */ abort (); @@ -1825,7 +1832,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_) var = scm_lookup (LOCAL_REF (sym)); if (ip[1] & 0x1) 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); NEXT (2); @@ -1902,7 +1909,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_) var = scm_module_lookup (mod, sym); 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; } @@ -1964,7 +1971,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_) var = scm_private_lookup (SCM_CDR (modname), sym); 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; } @@ -2004,7 +2011,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_) scm_dynstack_push_prompt (¤t_thread->dynstack, flags, LOCAL_REF (tag), fp, - &LOCAL_REF (proc_slot), + LOCAL_ADDRESS (proc_slot), (scm_t_uint8 *)(ip + offset), ®isters); NEXT (3); diff --git a/libguile/vm.c b/libguile/vm.c index 9550f81f3..b083d061f 100644 --- a/libguile/vm.c +++ b/libguile/vm.c @@ -312,7 +312,7 @@ vm_reinstate_partial_continuation (SCM vm, SCM cont, size_t n, SCM *argv, vp = SCM_VM_DATA (vm); 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); #define RELOC(scm_p) \ diff --git a/module/system/vm/frame.scm b/module/system/vm/frame.scm index ed042face..3ab3e1ed8 100644 --- a/module/system/vm/frame.scm +++ b/module/system/vm/frame.scm @@ -105,7 +105,7 @@ (opt (or (assq-ref arguments 'optional) '())) (key (or (assq-ref arguments 'keyword) '())) (rest (or (assq-ref arguments 'rest) #f)) - (i 0)) + (i 1)) (cond ((pair? req) (cons (binding-ref (car req) i) @@ -125,7 +125,8 @@ ;; case 2 (map (lambda (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))))))))) diff --git a/module/system/vm/trace.scm b/module/system/vm/trace.scm index 7657be4e1..717013fc7 100644 --- a/module/system/vm/trace.scm +++ b/module/system/vm/trace.scm @@ -50,8 +50,7 @@ (frame-call-representation frame)))) (define* (print-return frame depth width prefix max-indent values) - (let* ((len (frame-num-locals frame)) - (prefix (build-prefix prefix depth "| " "~d< "max-indent))) + (let ((prefix (build-prefix prefix depth "| " "~d< "max-indent))) (case (length values) ((0) (format (current-error-port) "~ano values\n" prefix)) -- 2.20.1