summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorAndy Wingo <wingo@pobox.com>2018-07-15 09:50:52 +0200
committerAndy Wingo <wingo@pobox.com>2018-07-20 11:42:30 +0200
commitb1705bd0f0181a6496223b26cb5da68fa470ccaa (patch)
tree709a7ac76ea0d491326ab5464820cc72132c984b
parente95f15c932650783f34253e396216c66050905f0 (diff)
downloadguile-b1705bd0f0181a6496223b26cb5da68fa470ccaa.tar.gz
Prepare for frames having separate virtual and machine return addrs
* libguile/frames.c (scm_frame_return_address): Use SCM_FRAME_VIRTUAL_RETURN_ADDRESS. (scm_c_frame_previous): Likewise. * libguile/frames.h: Update diagram for new names. (union scm_vm_stack_element): Rename "as_ip" to "as_vcode", and add "as_mcode" for machine code pointers. (SCM_FRAME_VIRTUAL_RETURN_ADDRESS) (SCM_FRAME_SET_VIRTUAL_RETURN_ADDRESS): Rename to these, from SCM_FRAME_RETURN_ADDRESS and SCM_FRAME_SET_RETURN_ADDRESS. * libguile/vm-engine.c (halt, call, call-label, return-values) (return-from-interrupt): Adapt to renamings. Make "halt" have frame size as a parameter. * libguile/vm.c (scm_i_vm_mark_stack): Adapt to renaming. (push_interrupt_frame): Take mRA as additional argument. In future we will set it as frame mRA. (capture_continuation): Adapt to renaming. (scm_call_n): Adapt to renaming and make frame size adjustable. (push_interrupt_frame, reinstate_continuation_x): Make frame size adjustable. * module/language/cps/slot-allocation.scm (allocate-slots): Make frame size adjustable. * libguile/intrinsics.h (scm_t_thread_mra_intrinsic): New type; use for push_interrupt_frame. (scm_t_thread_u8_scm_sp_vra_intrinsic): Rename from the same but was "ra" instead of "vra", and change type to uint32_t*. * module/system/vm/disassembler.scm (define-clobber-parser): Parameterize clobber set for calls by frame size.
-rw-r--r--libguile/frames.c6
-rw-r--r--libguile/frames.h46
-rw-r--r--libguile/intrinsics.c2
-rw-r--r--libguile/intrinsics.h13
-rw-r--r--libguile/vm-engine.c23
-rw-r--r--libguile/vm.c31
-rw-r--r--module/language/cps/slot-allocation.scm8
-rw-r--r--module/system/vm/disassembler.scm3
8 files changed, 70 insertions, 62 deletions
diff --git a/libguile/frames.c b/libguile/frames.c
index 845248007..d989d6292 100644
--- a/libguile/frames.c
+++ b/libguile/frames.c
@@ -366,8 +366,8 @@ SCM_DEFINE (scm_frame_return_address, "frame-return-address", 1, 0, 0,
#define FUNC_NAME s_scm_frame_return_address
{
SCM_VALIDATE_VM_FRAME (1, frame);
- return scm_from_uintptr_t ((uintptr_t) (SCM_FRAME_RETURN_ADDRESS
- (SCM_VM_FRAME_FP (frame))));
+ return scm_from_uintptr_t ((uintptr_t) (SCM_FRAME_VIRTUAL_RETURN_ADDRESS
+ (SCM_VM_FRAME_FP (frame))));
}
#undef FUNC_NAME
@@ -404,7 +404,7 @@ scm_c_frame_previous (enum scm_vm_frame_kind kind, struct scm_frame *frame)
new_sp = SCM_FRAME_PREVIOUS_SP (this_fp);
frame->fp_offset = stack_top - new_fp;
frame->sp_offset = stack_top - new_sp;
- frame->ip = SCM_FRAME_RETURN_ADDRESS (this_fp);
+ frame->ip = SCM_FRAME_VIRTUAL_RETURN_ADDRESS (this_fp);
if (scm_i_vm_is_boot_continuation_code (frame->ip))
goto again;
diff --git a/libguile/frames.h b/libguile/frames.h
index bbc47d009..85e36a5c2 100644
--- a/libguile/frames.h
+++ b/libguile/frames.h
@@ -39,29 +39,30 @@
Stack frame layout
------------------
- | ... |
- +==================+ <- fp + 2 = SCM_FRAME_PREVIOUS_SP (fp)
- | Dynamic link |
- +------------------+
- | Return address |
- +==================+ <- fp
- | Local 0 |
- +------------------+
- | Local 1 |
- +------------------+
- | ... |
- +------------------+
- | Local N-1 |
- \------------------/ <- sp
+ | ... |
+ +==============================+ <- fp + 2 = SCM_FRAME_PREVIOUS_SP (fp)
+ | Dynamic link |
+ +------------------------------+
+ | Virtual return address (vRA) |
+ +==============================+ <- fp
+ | Local 0 |
+ +------------------------------+
+ | Local 1 |
+ +------------------------------+
+ | ... |
+ +------------------------------+
+ | Local N-1 |
+ \------------------------------/ <- sp
The stack grows down.
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 FP - SP.
+ consisting of the saved FP and the saved virtual 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 FP - SP.
After ensuring that the correct number of arguments have been passed,
a function will set the stack pointer to point to the last local
@@ -90,7 +91,8 @@
union scm_vm_stack_element
{
uintptr_t as_uint;
- uint32_t *as_ip;
+ uint32_t *as_vcode;
+ uint8_t *as_mcode;
SCM as_scm;
double as_f64;
uint64_t as_u64;
@@ -102,8 +104,8 @@ union scm_vm_stack_element
};
#define SCM_FRAME_PREVIOUS_SP(fp) ((fp) + 2)
-#define SCM_FRAME_RETURN_ADDRESS(fp) ((fp)[0].as_ip)
-#define SCM_FRAME_SET_RETURN_ADDRESS(fp, ra) ((fp)[0].as_ip = (ra))
+#define SCM_FRAME_VIRTUAL_RETURN_ADDRESS(fp) ((fp)[0].as_vcode)
+#define SCM_FRAME_SET_VIRTUAL_RETURN_ADDRESS(fp, ra) ((fp)[0].as_vcode = (ra))
#define SCM_FRAME_DYNAMIC_LINK(fp) ((fp) + (fp)[1].as_uint)
#define SCM_FRAME_SET_DYNAMIC_LINK(fp, dl) ((fp)[1].as_uint = ((dl) - (fp)))
#define SCM_FRAME_SLOT(fp,i) ((fp) - (i) - 1)
diff --git a/libguile/intrinsics.c b/libguile/intrinsics.c
index 75cf2f05e..317526688 100644
--- a/libguile/intrinsics.c
+++ b/libguile/intrinsics.c
@@ -349,7 +349,7 @@ current_module (scm_thread *thread)
static void
push_prompt (scm_thread *thread, uint8_t escape_only_p,
- SCM tag, const union scm_vm_stack_element *sp, void *ra)
+ SCM tag, const union scm_vm_stack_element *sp, uint32_t *ra)
{
struct scm_vm *vp = &thread->vm;
scm_t_dynstack_prompt_flags flags;
diff --git a/libguile/intrinsics.h b/libguile/intrinsics.h
index 3c35749fc..3bd264f3d 100644
--- a/libguile/intrinsics.h
+++ b/libguile/intrinsics.h
@@ -61,10 +61,11 @@ typedef void (*scm_t_scm_noreturn_intrinsic) (SCM) SCM_NORETURN;
typedef void (*scm_t_u32_noreturn_intrinsic) (uint32_t) SCM_NORETURN;
typedef SCM (*scm_t_scm_from_thread_u64_intrinsic) (scm_thread*, uint64_t);
typedef SCM (*scm_t_scm_from_thread_intrinsic) (scm_thread*);
-typedef void (*scm_t_thread_u8_scm_sp_ra_intrinsic) (scm_thread*,
- uint8_t, SCM,
- const union scm_vm_stack_element*,
- void*);
+typedef void (*scm_t_thread_u8_scm_sp_vra_intrinsic) (scm_thread*,
+ uint8_t, SCM,
+ const union scm_vm_stack_element*,
+ uint32_t*);
+typedef void (*scm_t_thread_mra_intrinsic) (scm_thread*, uint8_t*);
#define SCM_FOR_ALL_VM_INTRINSICS(M) \
M(scm_from_scm_scm, add, "add", ADD) \
@@ -113,7 +114,7 @@ typedef void (*scm_t_thread_u8_scm_sp_ra_intrinsic) (scm_thread*,
M(scm_from_thread_u32, cons_rest, "cons-rest", CONS_REST) \
M(u32_from_thread_u32_u32, compute_kwargs_npositional, "compute-kwargs-npositional", COMPUTE_KWARGS_NPOSITIONAL) \
M(thread_u32_u32_scm_u8_u8, bind_kwargs, "bind-kwargs", BIND_KWARGS) \
- M(thread, push_interrupt_frame, "push-interrupt-frame", PUSH_INTERRUPT_FRAME) \
+ M(thread_mra, push_interrupt_frame, "push-interrupt-frame", PUSH_INTERRUPT_FRAME) \
M(scm_from_scm_scm_scmp_sp, foreign_call, "foreign-call", FOREIGN_CALL) \
M(thread_scm_noreturn, reinstate_continuation_x, "reinstate-continuation!", REINSTATE_CONTINUATION_X) \
M(scm_from_thread, capture_continuation, "capture-continuation", CAPTURE_CONTINUATION) \
@@ -130,7 +131,7 @@ typedef void (*scm_t_thread_u8_scm_sp_ra_intrinsic) (scm_thread*,
M(thread, apply_non_program, "apply-non-program", APPLY_NON_PROGRAM) \
M(scm_from_thread_u64, allocate_words, "allocate-words", ALLOCATE_WORDS) \
M(scm_from_thread, current_module, "current-module", CURRENT_MODULE) \
- M(thread_u8_scm_sp_ra, push_prompt, "push-prompt", PUSH_PROMPT) \
+ M(thread_u8_scm_sp_vra, push_prompt, "push-prompt", PUSH_PROMPT) \
/* Add new intrinsics here; also update scm_bootstrap_intrinsics. */
enum scm_vm_intrinsic
diff --git a/libguile/vm-engine.c b/libguile/vm-engine.c
index e9e1b477e..cf4cab7ff 100644
--- a/libguile/vm-engine.c
+++ b/libguile/vm-engine.c
@@ -321,13 +321,14 @@ VM_NAME (scm_thread *thread)
*/
VM_DEFINE_OP (0, halt, "halt", OP1 (X32))
{
- /* Boot closure in r0, empty frame in r1/r2, proc in r3, values from r4. */
-
- uint32_t nvals = FRAME_LOCALS_COUNT_FROM (4);
+ size_t frame_size = 2;
+ /* Boot closure, then empty frame, then callee, then values. */
+ size_t first_value = 1 + frame_size + 1;
+ uint32_t nvals = FRAME_LOCALS_COUNT_FROM (first_value);
SCM ret;
if (nvals == 1)
- ret = FP_REF (4);
+ ret = FP_REF (first_value);
else
{
uint32_t n;
@@ -335,10 +336,10 @@ VM_NAME (scm_thread *thread)
VM_ASSERT (nvals <= (UINTPTR_MAX >> 8), abort ());
ret = scm_words ((nvals << 8) | scm_tc7_values, nvals + 1);
for (n = 0; n < nvals; n++)
- SCM_SET_CELL_OBJECT (ret, n+1, FP_REF (4 + n));
+ SCM_SET_CELL_OBJECT (ret, n+1, FP_REF (first_value + n));
}
- VP->ip = SCM_FRAME_RETURN_ADDRESS (VP->fp);
+ VP->ip = SCM_FRAME_VIRTUAL_RETURN_ADDRESS (VP->fp);
VP->sp = SCM_FRAME_PREVIOUS_SP (VP->fp);
VP->fp = SCM_FRAME_DYNAMIC_LINK (VP->fp);
@@ -371,7 +372,7 @@ VM_NAME (scm_thread *thread)
old_fp = VP->fp;
VP->fp = SCM_FRAME_SLOT (old_fp, proc - 1);
SCM_FRAME_SET_DYNAMIC_LINK (VP->fp, old_fp);
- SCM_FRAME_SET_RETURN_ADDRESS (VP->fp, ip + 2);
+ SCM_FRAME_SET_VIRTUAL_RETURN_ADDRESS (VP->fp, ip + 2);
RESET_FRAME (nlocals);
@@ -414,7 +415,7 @@ VM_NAME (scm_thread *thread)
old_fp = VP->fp;
VP->fp = SCM_FRAME_SLOT (old_fp, proc - 1);
SCM_FRAME_SET_DYNAMIC_LINK (VP->fp, old_fp);
- SCM_FRAME_SET_RETURN_ADDRESS (VP->fp, ip + 3);
+ SCM_FRAME_SET_VIRTUAL_RETURN_ADDRESS (VP->fp, ip + 3);
RESET_FRAME (nlocals);
@@ -576,7 +577,7 @@ VM_NAME (scm_thread *thread)
RESET_FRAME (nlocals);
old_fp = VP->fp;
- ip = SCM_FRAME_RETURN_ADDRESS (VP->fp);
+ ip = SCM_FRAME_VIRTUAL_RETURN_ADDRESS (VP->fp);
VP->fp = SCM_FRAME_DYNAMIC_LINK (VP->fp);
/* Clear stack frame. */
@@ -2373,7 +2374,7 @@ VM_NAME (scm_thread *thread)
NEXT (1);
SYNC_IP ();
- CALL_INTRINSIC (push_interrupt_frame, (thread));
+ CALL_INTRINSIC (push_interrupt_frame, (thread, 0));
CACHE_SP ();
ip = (uint32_t *) vm_handle_interrupt_code;
APPLY_HOOK ();
@@ -2388,7 +2389,7 @@ VM_NAME (scm_thread *thread)
VM_DEFINE_OP (184, return_from_interrupt, "return-from-interrupt", OP1 (X32))
{
VP->sp = sp = SCM_FRAME_PREVIOUS_SP (VP->fp);
- ip = SCM_FRAME_RETURN_ADDRESS (VP->fp);
+ ip = SCM_FRAME_VIRTUAL_RETURN_ADDRESS (VP->fp);
VP->fp = SCM_FRAME_DYNAMIC_LINK (VP->fp);
NEXT (0);
diff --git a/libguile/vm.c b/libguile/vm.c
index 7720afaca..cf7b13cac 100644
--- a/libguile/vm.c
+++ b/libguile/vm.c
@@ -710,7 +710,7 @@ scm_i_vm_mark_stack (struct scm_vm *vp, struct GC_ms_entry *mark_stack_ptr,
Note that there may be other reasons to not have a dead slots
map, e.g. if all of the frame's slots below the callee frame
are live. */
- slot_map = find_slot_map (SCM_FRAME_RETURN_ADDRESS (fp), &cache);
+ slot_map = find_slot_map (SCM_FRAME_VIRTUAL_RETURN_ADDRESS (fp), &cache);
}
return_unused_stack_to_os (vp);
@@ -1011,24 +1011,25 @@ cons_rest (scm_thread *thread, uint32_t base)
}
static void
-push_interrupt_frame (scm_thread *thread)
+push_interrupt_frame (scm_thread *thread, uint8_t *mra)
{
union scm_vm_stack_element *old_fp;
+ size_t frame_overhead = 2;
size_t old_frame_size = frame_locals_count (thread);
SCM proc = scm_i_async_pop (thread);
/* No PUSH_CONTINUATION_HOOK, as we can't usefully
POP_CONTINUATION_HOOK because there are no return values. */
- /* Three slots: two for RA and dynamic link, one for proc. */
- alloc_frame (thread, old_frame_size + 3);
+ /* Reserve space for frame and callee. */
+ alloc_frame (thread, old_frame_size + frame_overhead + 1);
old_fp = thread->vm.fp;
- thread->vm.fp = SCM_FRAME_SLOT (old_fp, old_frame_size + 1);
+ thread->vm.fp = SCM_FRAME_SLOT (old_fp, old_frame_size + frame_overhead - 1);
SCM_FRAME_SET_DYNAMIC_LINK (thread->vm.fp, old_fp);
/* Arrange to return to the same handle-interrupts opcode to handle
any additional interrupts. */
- SCM_FRAME_SET_RETURN_ADDRESS (thread->vm.fp, thread->vm.ip);
+ SCM_FRAME_SET_VIRTUAL_RETURN_ADDRESS (thread->vm.fp, thread->vm.ip);
SCM_FRAME_LOCAL (thread->vm.fp, 0) = proc;
}
@@ -1069,7 +1070,7 @@ reinstate_continuation_x (scm_thread *thread, SCM cont)
scm_t_contregs *continuation = scm_i_contregs (cont);
struct scm_vm *vp = &thread->vm;
struct scm_vm_cont *cp;
- size_t n;
+ size_t n, i, frame_overhead = 2;
union scm_vm_stack_element *argv;
struct return_to_continuation_data data;
@@ -1091,11 +1092,11 @@ reinstate_continuation_x (scm_thread *thread, SCM cont)
/* Now we have the continuation properly copied over. We just need to
copy on an empty frame and the return values, as the continuation
- expects. */
- vm_push_sp (vp, vp->sp - 3 - n);
- vp->sp[n+2].as_scm = SCM_BOOL_F;
- vp->sp[n+1].as_scm = SCM_BOOL_F;
- vp->sp[n].as_scm = SCM_BOOL_F;
+ expects. The extra 1 is for the unused slot 0 that's part of the
+ multiple-value return convention. */
+ vm_push_sp (vp, vp->sp - (frame_overhead + 1) - n);
+ for (i = 0; i < frame_overhead + 1; i++)
+ vp->sp[n+i].as_scm = SCM_BOOL_F;
memcpy(vp->sp, argv, n * sizeof (union scm_vm_stack_element));
vp->ip = cp->ra;
@@ -1111,7 +1112,7 @@ capture_continuation (scm_thread *thread)
scm_i_vm_capture_stack (vp->stack_top,
SCM_FRAME_DYNAMIC_LINK (vp->fp),
SCM_FRAME_PREVIOUS_SP (vp->fp),
- SCM_FRAME_RETURN_ADDRESS (vp->fp),
+ SCM_FRAME_VIRTUAL_RETURN_ADDRESS (vp->fp),
scm_dynstack_capture_all (&thread->dynstack),
0);
return scm_i_make_continuation (thread, vm_cont);
@@ -1397,14 +1398,14 @@ scm_call_n (SCM proc, SCM *argv, size_t nargs)
call_fp = vp->sp + call_nlocals;
return_fp = call_fp + frame_size + return_nlocals;
- SCM_FRAME_SET_RETURN_ADDRESS (return_fp, vp->ip);
+ SCM_FRAME_SET_VIRTUAL_RETURN_ADDRESS (return_fp, vp->ip);
SCM_FRAME_SET_DYNAMIC_LINK (return_fp, vp->fp);
SCM_FRAME_LOCAL (return_fp, 0) = vm_boot_continuation;
vp->ip = (uint32_t *) vm_boot_continuation_code;
vp->fp = call_fp;
- SCM_FRAME_SET_RETURN_ADDRESS (call_fp, vp->ip);
+ SCM_FRAME_SET_VIRTUAL_RETURN_ADDRESS (call_fp, vp->ip);
SCM_FRAME_SET_DYNAMIC_LINK (call_fp, return_fp);
SCM_FRAME_LOCAL (call_fp, 0) = proc;
for (i = 0; i < nargs; i++)
diff --git a/module/language/cps/slot-allocation.scm b/module/language/cps/slot-allocation.scm
index a7a9ab57c..0febca59a 100644
--- a/module/language/cps/slot-allocation.scm
+++ b/module/language/cps/slot-allocation.scm
@@ -807,11 +807,13 @@ are comparable with eqv?. A tmp slot may be used."
needs-slot)
empty-intset)))
+ (define frame-size 2)
+
(define (empty-live-slots)
#b0)
(define (compute-call-proc-slot live-slots)
- (+ 2 (find-first-trailing-zero live-slots)))
+ (+ frame-size (find-first-trailing-zero live-slots)))
(define (compute-prompt-handler-proc-slot live-slots)
(if (zero? live-slots)
@@ -927,7 +929,7 @@ are comparable with eqv?. A tmp slot may be used."
(length results))))
(allocate* results result-slots slots post-live)))))
((slot-map) (compute-slot-map slots (intmap-ref live-out label)
- (- proc-slot 2)))
+ (- proc-slot frame-size)))
((call) (make-call-alloc proc-slot slot-map)))
(values slots
(intmap-add! call-allocs label call))))))
@@ -962,7 +964,7 @@ are comparable with eqv?. A tmp slot may be used."
(((handler-live) (compute-live-in-slots slots handler))
((proc-slot) (compute-prompt-handler-proc-slot handler-live))
((slot-map) (compute-slot-map slots (intmap-ref live-in handler)
- (- proc-slot 2)))
+ (- proc-slot frame-size)))
((result-vars) (match (get-cont kargs)
(($ $kargs names vars) vars)))
((value-slots) (integers (1+ proc-slot) (length result-vars)))
diff --git a/module/system/vm/disassembler.scm b/module/system/vm/disassembler.scm
index 2ab2bf575..f0b1a1076 100644
--- a/module/system/vm/disassembler.scm
+++ b/module/system/vm/disassembler.scm
@@ -615,9 +615,10 @@ address of that offset."
(lambda ()
(disassemble-one code (/ pos 4)))
(lambda (len elt)
+ (define frame-size 2)
(match elt
((_ proc . _)
- (let lp ((slot (- proc 2)))
+ (let lp ((slot (- proc frame-size)))
(if (and nslots-in (< slot nslots-in))
(cons slot (lp (1+ slot)))
'())))))))))