diff options
-rw-r--r-- | libguile/frames.c | 6 | ||||
-rw-r--r-- | libguile/frames.h | 33 | ||||
-rw-r--r-- | libguile/vm-engine.c | 7 | ||||
-rw-r--r-- | libguile/vm-engine.h | 29 | ||||
-rw-r--r-- | libguile/vm-i-system.c | 116 | ||||
-rw-r--r-- | libguile/vm.c | 17 |
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 }; |