mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-20 03:30:27 +02:00
Code Activity

Prepare for frames having separate virtual and machine return addrs

Browse source 
* 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.
This commit is contained in:
Andy Wingo 2018-07-15 09:50:52 +02:00
parent e95f15c932
commit b1705bd0f0
8 changed files with 70 additions and 62 deletions
Download patch file Download diff file Expand all files Collapse all files

6
libguile/frames.c
View file

@ -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;

46
libguile/frames.h
View file

@ -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)

2
libguile/intrinsics.c
View file

@ -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;

13
libguile/intrinsics.h
View file

@ -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

23
libguile/vm-engine.c
View file

@ -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);

31
libguile/vm.c
View file

@ -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++)

8
module/language/cps/slot-allocation.scm
View file

@ -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)))

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

@ -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)))
'())))))))))