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)
exception. */
#define SYNC_IP() \
- vp->ip = (scm_t_uint8 *) (ip)
+ vp->ip = (ip)
#define SYNC_REGISTER() \
SYNC_IP()
} 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
- 3 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 + 4); \
+ 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() \
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)
#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); \
+ ip = SCM_FRAME_RETURN_ADDRESS (fp); \
fp = vp->fp = SCM_FRAME_DYNAMIC_LINK (fp); \
/* Clear frame. */ \
- sp[0] = SCM_BOOL_F; \
- sp[1] = SCM_BOOL_F; \
- sp[2] = SCM_BOOL_F; \
+ old_fp[-1] = SCM_BOOL_F; \
+ old_fp[-2] = SCM_BOOL_F; \
/* Leave proc. */ \
- sp[4] = val; \
- vp->sp = sp + 4; \
- 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)
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; \
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);
}
{
SCM *base;
- /* Check that we have enough space: 4 words for the boot
- continuation, 4 + nargs for the procedure application, and 4 for
+ /* Check that we have enough space: 3 words for the boot
+ continuation, 3 + nargs for the procedure application, and 3 for
setting up a new frame. */
base = vp->sp + 1;
- CHECK_OVERFLOW (vp->sp + 4 + 4 + nargs_ + 4);
+ CHECK_OVERFLOW (vp->sp + 3 + 3 + nargs_ + 3);
/* Since it's possible to receive the arguments on the stack itself,
and indeed the regular VM invokes us that way, shuffle up the
{
int i;
for (i = nargs_ - 1; i >= 0; i--)
- base[8 + i] = argv[i];
+ base[6 + i] = argv[i];
}
/* Initial frame, saving previous fp and ip, with the boot
continuation. */
base[0] = SCM_PACK (fp); /* dynamic link */
- base[1] = SCM_PACK (0); /* the boot continuation does not return to scheme */
- base[2] = SCM_PACK (ip); /* ra */
- base[3] = rtl_boot_continuation;
- fp = &base[4];
+ base[1] = SCM_PACK (ip); /* ra */
+ base[2] = rtl_boot_continuation;
+ fp = &base[2];
ip = (scm_t_uint32 *) rtl_boot_continuation_code;
/* MV-call frame, function & arguments */
- base[4] = SCM_PACK (fp); /* dynamic link */
- base[5] = SCM_PACK (ip); /* in RTL programs, MVRA same as RA */
- base[6] = SCM_PACK (ip); /* ra */
- base[7] = program;
- fp = vp->fp = &base[8];
+ base[3] = SCM_PACK (fp); /* dynamic link */
+ base[4] = SCM_PACK (ip); /* ra */
+ base[5] = program;
+ fp = vp->fp = &base[5];
RESET_FRAME (nargs_ + 1);
}
apply:
- while (!SCM_RTL_PROGRAM_P (SCM_FRAME_PROGRAM (fp)))
+ while (!SCM_PROGRAM_P (SCM_FRAME_PROGRAM (fp)))
{
SCM proc = SCM_FRAME_PROGRAM (fp);
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))
}
/* Let's go! */
- ip = SCM_RTL_PROGRAM_CODE (SCM_FRAME_PROGRAM (fp));
+ ip = SCM_PROGRAM_CODE (SCM_FRAME_PROGRAM (fp));
NEXT (0);
BEGIN_DISPATCH_SWITCH;
*/
VM_DEFINE_OP (0, halt, "halt", OP1 (U8_X24))
{
- scm_t_uint32 nvals = FRAME_LOCALS_COUNT() - 5;
- 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/r3, proc in r4, values from r5. */
+ scm_t_uint32 nvals = FRAME_LOCALS_COUNT_FROM (4);
+ SCM ret;
if (nvals == 1)
- ret = LOCAL_REF (5);
+ ret = LOCAL_REF (4);
else
{
scm_t_uint32 n;
ret = SCM_EOL;
SYNC_BEFORE_GC();
for (n = nvals; n > 0; n--)
- ret = scm_cons (LOCAL_REF (5 + n - 1), ret);
+ ret = scm_cons (LOCAL_REF (4 + n - 1), ret);
ret = scm_values (ret);
}
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;
fp = vp->fp = old_fp + proc;
SCM_FRAME_SET_DYNAMIC_LINK (fp, old_fp);
- SCM_FRAME_SET_RTL_MV_RETURN_ADDRESS (fp, ip + 2);
- SCM_FRAME_SET_RTL_RETURN_ADDRESS (fp, ip + 2);
+ SCM_FRAME_SET_RETURN_ADDRESS (fp, ip + 2);
RESET_FRAME (nlocals);
PUSH_CONTINUATION_HOOK ();
APPLY_HOOK ();
- if (SCM_UNLIKELY (!SCM_RTL_PROGRAM_P (SCM_FRAME_PROGRAM (fp))))
+ if (SCM_UNLIKELY (!SCM_PROGRAM_P (SCM_FRAME_PROGRAM (fp))))
goto apply;
- ip = SCM_RTL_PROGRAM_CODE (SCM_FRAME_PROGRAM (fp));
+ ip = SCM_PROGRAM_CODE (SCM_FRAME_PROGRAM (fp));
NEXT (0);
}
APPLY_HOOK ();
- if (SCM_UNLIKELY (!SCM_RTL_PROGRAM_P (SCM_FRAME_PROGRAM (fp))))
+ if (SCM_UNLIKELY (!SCM_PROGRAM_P (SCM_FRAME_PROGRAM (fp))))
goto apply;
- ip = SCM_RTL_PROGRAM_CODE (SCM_FRAME_PROGRAM (fp));
+ ip = SCM_PROGRAM_CODE (SCM_FRAME_PROGRAM (fp));
NEXT (0);
}
APPLY_HOOK ();
- if (SCM_UNLIKELY (!SCM_RTL_PROGRAM_P (SCM_FRAME_PROGRAM (fp))))
+ if (SCM_UNLIKELY (!SCM_PROGRAM_P (SCM_FRAME_PROGRAM (fp))))
goto apply;
- ip = SCM_RTL_PROGRAM_CODE (SCM_FRAME_PROGRAM (fp));
+ ip = SCM_PROGRAM_CODE (SCM_FRAME_PROGRAM (fp));
NEXT (0);
}
*/
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_MV_RETURN_ADDRESS (fp);
+ ip = SCM_FRAME_RETURN_ADDRESS (fp);
fp = vp->fp = SCM_FRAME_DYNAMIC_LINK (fp);
/* Clear stack frame. */
- base[-2] = SCM_BOOL_F;
- base[-3] = SCM_BOOL_F;
- base[-4] = 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);
}
SCM_UNPACK_RTL_24 (op, ptr_idx);
- pointer = SCM_RTL_PROGRAM_FREE_VARIABLE_REF (LOCAL_REF (0), ptr_idx);
+ pointer = SCM_PROGRAM_FREE_VARIABLE_REF (LOCAL_REF (0), ptr_idx);
subr = SCM_POINTER_VALUE (pointer);
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 ();
SCM_UNPACK_RTL_12_12 (op, cif_idx, ptr_idx);
closure = LOCAL_REF (0);
- cif = SCM_RTL_PROGRAM_FREE_VARIABLE_REF (closure, cif_idx);
- pointer = SCM_RTL_PROGRAM_FREE_VARIABLE_REF (closure, ptr_idx);
+ cif = SCM_PROGRAM_FREE_VARIABLE_REF (closure, cif_idx);
+ pointer = SCM_PROGRAM_FREE_VARIABLE_REF (closure, ptr_idx);
SYNC_IP ();
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 ();
SCM_UNPACK_RTL_24 (op, contregs_idx);
contregs =
- SCM_RTL_PROGRAM_FREE_VARIABLE_REF (LOCAL_REF (0), contregs_idx);
+ SCM_PROGRAM_FREE_VARIABLE_REF (LOCAL_REF (0), contregs_idx);
SYNC_IP ();
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 */
scm_t_uint32 cont_idx;
SCM_UNPACK_RTL_24 (op, cont_idx);
- vmcont = SCM_RTL_PROGRAM_FREE_VARIABLE_REF (LOCAL_REF (0), cont_idx);
+ vmcont = SCM_PROGRAM_FREE_VARIABLE_REF (LOCAL_REF (0), cont_idx);
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 ();
APPLY_HOOK ();
- if (SCM_UNLIKELY (!SCM_RTL_PROGRAM_P (SCM_FRAME_PROGRAM (fp))))
+ if (SCM_UNLIKELY (!SCM_PROGRAM_P (SCM_FRAME_PROGRAM (fp))))
goto apply;
- ip = SCM_RTL_PROGRAM_CODE (SCM_FRAME_PROGRAM (fp));
+ ip = SCM_PROGRAM_CODE (SCM_FRAME_PROGRAM (fp));
NEXT (0);
}
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),
- SCM_FRAME_MV_RETURN_ADDRESS (fp),
dynstack,
0);
/* FIXME: Seems silly to capture the registers here, when they are
APPLY_HOOK ();
- if (SCM_UNLIKELY (!SCM_RTL_PROGRAM_P (SCM_FRAME_PROGRAM (fp))))
+ if (SCM_UNLIKELY (!SCM_PROGRAM_P (SCM_FRAME_PROGRAM (fp))))
goto apply;
- ip = SCM_RTL_PROGRAM_CODE (SCM_FRAME_PROGRAM (fp));
+ ip = SCM_PROGRAM_CODE (SCM_FRAME_PROGRAM (fp));
NEXT (0);
}
else
{
CACHE_REGISTER ();
- ABORT_CONTINUATION_HOOK (fp, FRAME_LOCALS_COUNT () - 1);
+ ABORT_CONTINUATION_HOOK ();
NEXT (0);
}
}
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 ();
SCM_UNPACK_RTL_24 (ip[2], nfree);
// FIXME: Assert range of nfree?
- closure = scm_words (scm_tc7_rtl_program | (nfree << 16), nfree + 2);
+ closure = scm_words (scm_tc7_program | (nfree << 16), nfree + 2);
SCM_SET_CELL_WORD_1 (closure, ip + offset);
// FIXME: Elide these initializations?
for (n = 0; n < nfree; n++)
- SCM_RTL_PROGRAM_FREE_VARIABLE_SET (closure, n, SCM_BOOL_F);
+ SCM_PROGRAM_FREE_VARIABLE_SET (closure, n, SCM_BOOL_F);
LOCAL_SET (dst, closure);
NEXT (3);
}
SCM_UNPACK_RTL_12_12 (op, dst, src);
SCM_UNPACK_RTL_24 (ip[1], idx);
/* CHECK_FREE_VARIABLE (src); */
- LOCAL_SET (dst, SCM_RTL_PROGRAM_FREE_VARIABLE_REF (LOCAL_REF (src), idx));
+ LOCAL_SET (dst, SCM_PROGRAM_FREE_VARIABLE_REF (LOCAL_REF (src), idx));
NEXT (2);
}
SCM_UNPACK_RTL_12_12 (op, dst, src);
SCM_UNPACK_RTL_24 (ip[1], idx);
/* CHECK_FREE_VARIABLE (src); */
- SCM_RTL_PROGRAM_FREE_VARIABLE_SET (LOCAL_REF (dst), idx, LOCAL_REF (src));
+ SCM_PROGRAM_FREE_VARIABLE_SET (LOCAL_REF (dst), idx, LOCAL_REF (src));
NEXT (2);
}
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);
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;
}
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;
}
scm_dynstack_push_prompt (¤t_thread->dynstack, flags,
LOCAL_REF (tag),
fp,
- &LOCAL_REF (proc_slot),
- (scm_t_uint8 *)(ip + offset),
+ LOCAL_ADDRESS (proc_slot),
+ ip + offset,
®isters);
NEXT (3);
}
HCoop / bpt / guile.git / blobdiff