summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--libguile/frames.c6
-rw-r--r--libguile/frames.h33
-rw-r--r--libguile/vm-engine.c7
-rw-r--r--libguile/vm-engine.h29
-rw-r--r--libguile/vm-i-system.c116
-rw-r--r--libguile/vm.c17
6 files changed, 85 insertions, 123 deletions
diff --git a/libguile/frames.c b/libguile/frames.c
index e89184d79..86480e352 100644
--- a/libguile/frames.c
+++ b/libguile/frames.c
@@ -111,12 +111,12 @@ SCM_DEFINE (scm_vm_frame_arguments, "vm-frame-arguments", 1, 0, 0,
if (!bp->nargs)
return SCM_EOL;
else if (bp->nrest)
- ret = fp[bp->nargs - 1];
+ ret = SCM_FRAME_VARIABLE (fp, bp->nargs - 1);
else
- ret = scm_cons (fp[bp->nargs - 1], SCM_EOL);
+ ret = scm_cons (SCM_FRAME_VARIABLE (fp, bp->nargs - 1), SCM_EOL);
for (i = bp->nargs - 2; i >= 0; i--)
- ret = scm_cons (fp[i], ret);
+ ret = scm_cons (SCM_FRAME_VARIABLE (fp, i), ret);
return ret;
}
diff --git a/libguile/frames.h b/libguile/frames.h
index 1b3153a3e..cce661f8f 100644
--- a/libguile/frames.h
+++ b/libguile/frames.h
@@ -30,39 +30,46 @@
/* VM Frame Layout
---------------
- | | <- fp + bp->nargs + bp->nlocs + 3
- +------------------+ = SCM_FRAME_UPPER_ADDRESS (fp)
- | Return address |
- | MV return address|
- | Dynamic link | <- fp + bp->nargs + bp->blocs
- | Local variable 1 | = SCM_FRAME_DATA_ADDRESS (fp)
+ | ... |
+ | Intermed. val. 0 | <- fp + bp->nargs + bp->nlocs = SCM_FRAME_UPPER_ADDRESS (fp)
+ +==================+
+ | Local variable 1 |
| Local variable 0 | <- fp + bp->nargs
| Argument 1 |
| Argument 0 | <- fp
| Program | <- fp - 1
- +------------------+ = SCM_FRAME_LOWER_ADDRESS (fp)
+ +------------------+
+ | Return address |
+ | MV return address|
+ | Dynamic link | <- fp - 4 = SCM_FRAME_DATA_ADDRESS (fp) = SCM_FRAME_LOWER_ADDRESS (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. */
-#define SCM_FRAME_DATA_ADDRESS(fp) \
- (fp + SCM_PROGRAM_DATA (SCM_FRAME_PROGRAM (fp))->nargs \
- + SCM_PROGRAM_DATA (SCM_FRAME_PROGRAM (fp))->nlocs)
-#define SCM_FRAME_UPPER_ADDRESS(fp) (SCM_FRAME_DATA_ADDRESS (fp) + 3)
-#define SCM_FRAME_LOWER_ADDRESS(fp) (fp - 1)
+#define SCM_FRAME_DATA_ADDRESS(fp) (fp - 4)
+#define SCM_FRAME_UPPER_ADDRESS(fp) \
+ (fp \
+ + SCM_PROGRAM_DATA (SCM_FRAME_PROGRAM (fp))->nargs \
+ + SCM_PROGRAM_DATA (SCM_FRAME_PROGRAM (fp))->nlocs)
+#define SCM_FRAME_LOWER_ADDRESS(fp) (fp - 4)
#define SCM_FRAME_BYTE_CAST(x) ((scm_byte_t *) SCM_UNPACK (x))
#define SCM_FRAME_STACK_CAST(x) ((SCM *) SCM_UNPACK (x))
#define SCM_FRAME_RETURN_ADDRESS(fp) \
(SCM_FRAME_BYTE_CAST (SCM_FRAME_DATA_ADDRESS (fp)[2]))
+#define SCM_FRAME_SET_RETURN_ADDRESS(fp, ra) \
+ ((SCM_FRAME_DATA_ADDRESS (fp)[2])) = (SCM)(ra);
#define SCM_FRAME_MV_RETURN_ADDRESS(fp) \
(SCM_FRAME_BYTE_CAST (SCM_FRAME_DATA_ADDRESS (fp)[1]))
+#define SCM_FRAME_SET_MV_RETURN_ADDRESS(fp, mvra) \
+ ((SCM_FRAME_DATA_ADDRESS (fp)[1])) = (SCM)(mvra);
#define SCM_FRAME_DYNAMIC_LINK(fp) \
(SCM_FRAME_STACK_CAST (SCM_FRAME_DATA_ADDRESS (fp)[0]))
-#define SCM_FRAME_SET_DYNAMIC_LINK(fp, dl) \
+#define SCM_FRAME_SET_DYNAMIC_LINK(fp, dl) \
((SCM_FRAME_DATA_ADDRESS (fp)[0])) = (SCM)(dl);
#define SCM_FRAME_VARIABLE(fp,i) fp[i]
#define SCM_FRAME_PROGRAM(fp) fp[-1]
diff --git a/libguile/vm-engine.c b/libguile/vm-engine.c
index b0888c1ec..0c011d1aa 100644
--- a/libguile/vm-engine.c
+++ b/libguile/vm-engine.c
@@ -107,10 +107,13 @@ VM_NAME (struct scm_vm *vp, SCM program, SCM *argv, int nargs)
/* Initial frame */
CACHE_REGISTER ();
+ PUSH ((SCM)fp); /* dynamic link */
+ PUSH (0); /* ra */
+ PUSH (0); /* mvra */
CACHE_PROGRAM ();
PUSH (program);
- NEW_FRAME ();
-
+ fp = sp + 1;
+ INIT_FRAME ();
/* Initial arguments */
PUSH (prog);
if (SCM_UNLIKELY (sp + nargs >= stack_limit))
diff --git a/libguile/vm-engine.h b/libguile/vm-engine.h
index 240969c37..36d4d2867 100644
--- a/libguile/vm-engine.h
+++ b/libguile/vm-engine.h
@@ -386,34 +386,29 @@ do { \
/* See frames.h for the layout of stack frames */
/* When this is called, bp points to the new program data,
and the arguments are already on the stack */
-#define NEW_FRAME() \
+#define INIT_FRAME() \
{ \
int i; \
- SCM *dl, *data; \
- scm_byte_t *ra = ip; \
- \
- /* Save old registers */ \
- ra = ip; \
- dl = fp; \
\
/* New registers */ \
- fp = sp - bp->nargs + 1; \
- data = SCM_FRAME_DATA_ADDRESS (fp); \
- sp = data + 2; \
+ sp += bp->nlocs; \
CHECK_OVERFLOW (); \
stack_base = sp; \
ip = bp->base; \
\
/* Init local variables */ \
- for (i=bp->nlocs; i; i--) \
- data[-i] = SCM_UNDEFINED; \
- \
- /* Set frame data */ \
- data[2] = (SCM)ra; \
- data[1] = 0x0; \
- data[0] = (SCM)dl; \
+ for (i=bp->nlocs; i;) \
+ sp[-(--i)] = SCM_UNDEFINED; \
}
+#define DROP_FRAME() \
+ { \
+ sp -= 3; \
+ NULLSTACK (3); \
+ CHECK_UNDERFLOW (); \
+ }
+
+
/*
Local Variables:
c-file-style: "gnu"
diff --git a/libguile/vm-i-system.c b/libguile/vm-i-system.c
index 5be961087..ea53ce917 100644
--- a/libguile/vm-i-system.c
+++ b/libguile/vm-i-system.c
@@ -491,10 +491,20 @@ VM_DEFINE_INSTRUCTION (38, call, "call", 1, -1, 1)
*/
if (SCM_PROGRAM_P (x))
{
+ int i;
+ /* shuffle up */
+ sp += 3;
+ CHECK_OVERFLOW ();
+ for (i = 0; i <= nargs; i++)
+ sp[-i] = sp[-(i + 3)];
program = x;
CACHE_PROGRAM ();
INIT_ARGS ();
- NEW_FRAME ();
+ SCM_FRAME_SET_DYNAMIC_LINK (sp - bp->nargs + 1, fp);
+ fp = sp - bp->nargs + 1;
+ SCM_FRAME_SET_RETURN_ADDRESS (fp, ip);
+ SCM_FRAME_SET_MV_RETURN_ADDRESS (fp, 0);
+ INIT_FRAME ();
ENTER_HOOK ();
APPLY_HOOK ();
NEXT;
@@ -540,93 +550,42 @@ VM_DEFINE_INSTRUCTION (39, goto_args, "goto/args", 1, -1, 1)
SCM_TICK; /* allow interrupt here */
/*
- * Tail recursive call
- */
- if (SCM_EQ_P (x, program))
- {
- int i;
-
- /* Move arguments */
- INIT_ARGS ();
- sp -= bp->nargs - 1;
- for (i = 0; i < bp->nargs; i++)
- LOCAL_SET (i, sp[i]);
-
- /* Drop the first argument and the program itself. */
- sp -= 2;
- NULLSTACK (bp->nargs + 1);
-
- /* Init locals to valid SCM values */
- for (i = 0; i < bp->nlocs; i++)
- LOCAL_SET (i + bp->nargs, SCM_UNDEFINED);
-
- /* Call itself */
- ip = bp->base;
- APPLY_HOOK ();
- NEXT;
- }
-
- /*
- * Tail call, but not to self -- reuse the frame, keeping the ra and dl
+ * Tail call
*/
if (SCM_PROGRAM_P (x))
{
- SCM *data, *tail_args, *dl;
int i;
- scm_byte_t *ra, *mvra;
#ifdef VM_ENABLE_STACK_NULLING
SCM *old_sp;
#endif
EXIT_HOOK ();
- /* save registers */
- tail_args = stack_base + 2;
- ra = SCM_FRAME_RETURN_ADDRESS (fp);
- mvra = SCM_FRAME_MV_RETURN_ADDRESS (fp);
- dl = SCM_FRAME_DYNAMIC_LINK (fp);
-
/* switch programs */
program = x;
CACHE_PROGRAM ();
INIT_ARGS ();
- /* delay updating the frame so that if INIT_ARGS has to cons up a rest
- arg, going into GC, the stack still makes sense */
- fp[-1] = program;
- nargs = bp->nargs;
#ifdef VM_ENABLE_STACK_NULLING
old_sp = sp;
CHECK_STACK_LEAK ();
#endif
- /* new registers -- logically this would be better later, but let's make
- sure we have space for the locals now */
- data = SCM_FRAME_DATA_ADDRESS (fp);
- ip = bp->base;
- stack_base = data + 2;
- sp = stack_base;
- CHECK_OVERFLOW ();
-
- /* copy args, bottom-up */
- for (i = 0; i < nargs; i++)
- fp[i] = tail_args[i];
+ /* delay shuffling the new program+args down so that if INIT_ARGS had to
+ cons up a rest arg, going into GC, the stack still made sense */
+ for (i = -1, sp = sp - bp->nargs + 1; i < bp->nargs; i++)
+ fp[i] = sp[i];
+ sp = fp + i - 1;
NULLSTACK (old_sp - sp);
- /* init locals */
- for (i = bp->nlocs; i; i--)
- data[-i] = SCM_UNDEFINED;
-
- /* Set frame data */
- data[2] = (SCM)ra;
- data[1] = (SCM)mvra;
- data[0] = (SCM)dl;
+ INIT_FRAME ();
ENTER_HOOK ();
APPLY_HOOK ();
NEXT;
}
+
/*
* Other interpreted or compiled call
*/
@@ -690,11 +649,20 @@ VM_DEFINE_INSTRUCTION (42, mv_call, "mv-call", 3, -1, 1)
*/
if (SCM_PROGRAM_P (x))
{
+ int i;
+ /* shuffle up */
+ sp += 3;
+ CHECK_OVERFLOW ();
+ for (i = 0; i <= nargs; i++)
+ sp[-i] = sp[-(i + 3)];
program = x;
CACHE_PROGRAM ();
INIT_ARGS ();
- NEW_FRAME ();
- SCM_FRAME_DATA_ADDRESS (fp)[1] = (SCM)mvra;
+ SCM_FRAME_SET_DYNAMIC_LINK (sp - bp->nargs + 1, fp);
+ fp = sp - bp->nargs + 1;
+ SCM_FRAME_SET_RETURN_ADDRESS (fp, ip);
+ SCM_FRAME_SET_MV_RETURN_ADDRESS (fp, mvra);
+ INIT_FRAME ();
ENTER_HOOK ();
APPLY_HOOK ();
NEXT;
@@ -840,17 +808,16 @@ VM_DEFINE_INSTRUCTION (47, return, "return", 0, 1, 1)
SYNC_REGISTER ();
SCM_TICK; /* allow interrupt here */
{
- SCM ret, *data;
- data = SCM_FRAME_DATA_ADDRESS (fp);
+ SCM ret;
POP (ret);
ASSERT (sp == stack_base);
- ASSERT (stack_base == data + 2);
+ ASSERT (stack_base == SCM_FRAME_UPPER_ADDRESS (fp) - 1);
/* Restore registers */
sp = SCM_FRAME_LOWER_ADDRESS (fp);
- ip = SCM_FRAME_BYTE_CAST (data[2]);
- fp = SCM_FRAME_STACK_CAST (data[0]);
+ ip = SCM_FRAME_RETURN_ADDRESS (fp);
+ fp = SCM_FRAME_DYNAMIC_LINK (fp);
{
#ifdef VM_ENABLE_STACK_NULLING
int nullcount = stack_base - sp;
@@ -874,24 +841,21 @@ VM_DEFINE_INSTRUCTION (48, return_values, "return/values", 1, -1, -1)
{
/* nvalues declared at top level, because for some reason gcc seems to think
that perhaps it might be used without declaration. Fooey to that, I say. */
- SCM *data;
-
nvalues = FETCH ();
vm_return_values:
EXIT_HOOK ();
RETURN_HOOK ();
- data = SCM_FRAME_DATA_ADDRESS (fp);
- ASSERT (stack_base == data + 2);
+ ASSERT (stack_base == SCM_FRAME_UPPER_ADDRESS (fp) - 1);
/* data[1] is the mv return address */
- if (nvalues != 1 && data[1])
+ if (nvalues != 1 && SCM_FRAME_MV_RETURN_ADDRESS (fp))
{
int i;
/* Restore registers */
sp = SCM_FRAME_LOWER_ADDRESS (fp) - 1;
- ip = SCM_FRAME_BYTE_CAST (data[1]); /* multiple value ra */
- fp = SCM_FRAME_STACK_CAST (data[0]);
+ ip = SCM_FRAME_MV_RETURN_ADDRESS (fp);
+ fp = SCM_FRAME_DYNAMIC_LINK (fp);
/* Push return values, and the number of values */
for (i = 0; i < nvalues; i++)
@@ -910,8 +874,8 @@ VM_DEFINE_INSTRUCTION (48, return_values, "return/values", 1, -1, -1)
continuation.) */
/* Restore registers */
sp = SCM_FRAME_LOWER_ADDRESS (fp) - 1;
- ip = SCM_FRAME_BYTE_CAST (data[2]); /* single value ra */
- fp = SCM_FRAME_STACK_CAST (data[0]);
+ ip = SCM_FRAME_RETURN_ADDRESS (fp);
+ fp = SCM_FRAME_DYNAMIC_LINK (fp);
/* Push first value */
*++sp = stack_base[1];
diff --git a/libguile/vm.c b/libguile/vm.c
index cc5e4f924..660f25cb4 100644
--- a/libguile/vm.c
+++ b/libguile/vm.c
@@ -66,21 +66,20 @@ scm_t_bits scm_tc16_vm_cont;
static void
vm_mark_stack (SCM *base, scm_t_ptrdiff size, SCM *fp, scm_t_ptrdiff reloc)
{
- SCM *sp, *upper, *lower;
+ SCM *sp, *mark;
sp = base + size - 1;
while (sp > base && fp)
{
- upper = SCM_FRAME_UPPER_ADDRESS (fp);
- lower = SCM_FRAME_LOWER_ADDRESS (fp);
+ mark = SCM_FRAME_LOWER_ADDRESS (fp) + 3;
- for (; sp >= upper; sp--)
+ for (; sp >= mark; sp--)
if (SCM_NIMP (*sp))
{
if (scm_in_heap_p (*sp))
scm_gc_mark (*sp);
- else
- fprintf (stderr, "BADNESS: crap on the stack: %p\n", *sp);
+ /* this can happen for open frames */
+ /* else fprintf (stderr, "BADNESS: crap on the stack: %p\n", *sp); */
}
@@ -89,11 +88,6 @@ vm_mark_stack (SCM *base, scm_t_ptrdiff size, SCM *fp, scm_t_ptrdiff reloc)
/* update fp from the dynamic link */
fp = (SCM*)*sp-- + reloc;
-
- /* mark from the el down to the lower address */
- for (; sp >= lower; sp--)
- if (*sp && SCM_NIMP (*sp))
- scm_gc_mark (*sp);
}
}
@@ -224,7 +218,6 @@ static SCM
really_make_boot_program (long nargs)
{
SCM u8vec;
- /* Make sure "bytes" is 64-bit aligned. */
scm_t_uint8 text[] = { scm_op_mv_call, 0, 0, 1,
scm_op_make_int8_1, scm_op_nop, scm_op_nop, scm_op_nop,
scm_op_halt };