diff options
-rw-r--r-- | libguile/frames.c | 12 | ||||
-rw-r--r-- | libguile/frames.h | 6 | ||||
-rw-r--r-- | libguile/vm-engine.h | 5 | ||||
-rw-r--r-- | libguile/vm-i-system.c | 12 |
4 files changed, 27 insertions, 8 deletions
diff --git a/libguile/frames.c b/libguile/frames.c index c4f2f275d..36f057f7e 100644 --- a/libguile/frames.c +++ b/libguile/frames.c @@ -151,6 +151,18 @@ SCM_DEFINE (scm_frame_return_address, "frame-return-address", 1, 0, 0, } #undef FUNC_NAME +SCM_DEFINE (scm_frame_mv_return_address, "frame-mv-return-address", 1, 0, 0, + (SCM frame), + "") +#define FUNC_NAME s_scm_frame_mv_return_address +{ + SCM_VALIDATE_HEAP_FRAME (1, frame); + return scm_from_ulong ((unsigned long) + (SCM_FRAME_MV_RETURN_ADDRESS + (SCM_HEAP_FRAME_POINTER (frame)))); +} +#undef FUNC_NAME + SCM_DEFINE (scm_frame_dynamic_link, "frame-dynamic-link", 1, 0, 0, (SCM frame), "") diff --git a/libguile/frames.h b/libguile/frames.h index 53fc4e858..f5323f712 100644 --- a/libguile/frames.h +++ b/libguile/frames.h @@ -56,6 +56,7 @@ | | <- fp + bp->nargs + bp->nlocs + 4 +------------------+ = SCM_FRAME_UPPER_ADDRESS (fp) | Return address | + | MV return address| | Dynamic link | | Heap link | | External link | <- fp + bp->nargs + bp->nlocs @@ -74,13 +75,15 @@ #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) + 4) +#define SCM_FRAME_UPPER_ADDRESS(fp) (SCM_FRAME_DATA_ADDRESS (fp) + 5) #define SCM_FRAME_LOWER_ADDRESS(fp) (fp - 1) #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)[4])) +#define SCM_FRAME_MV_RETURN_ADDRESS(fp) \ (SCM_FRAME_BYTE_CAST (SCM_FRAME_DATA_ADDRESS (fp)[3])) #define SCM_FRAME_DYNAMIC_LINK(fp) \ (SCM_FRAME_STACK_CAST (SCM_FRAME_DATA_ADDRESS (fp)[2])) @@ -109,6 +112,7 @@ extern SCM scm_frame_program (SCM frame); extern SCM scm_frame_local_ref (SCM frame, SCM index); extern SCM scm_frame_local_set_x (SCM frame, SCM index, SCM val); extern SCM scm_frame_return_address (SCM frame); +extern SCM scm_frame_mv_return_address (SCM frame); extern SCM scm_frame_dynamic_link (SCM frame); extern SCM scm_frame_external_link (SCM frame); diff --git a/libguile/vm-engine.h b/libguile/vm-engine.h index 516eedcb4..0d0c03d8a 100644 --- a/libguile/vm-engine.h +++ b/libguile/vm-engine.h @@ -422,7 +422,7 @@ do { \ /* New registers */ \ fp = sp - bp->nargs + 1; \ data = SCM_FRAME_DATA_ADDRESS (fp); \ - sp = data + 3; \ + sp = data + 4; \ CHECK_OVERFLOW (); \ stack_base = sp; \ ip = bp->base; \ @@ -437,7 +437,8 @@ do { \ CONS (external, SCM_UNDEFINED, external); \ \ /* Set frame data */ \ - data[3] = (SCM)ra; \ + data[4] = (SCM)ra; \ + data[3] = 0x0; \ data[2] = (SCM)dl; \ data[1] = SCM_BOOL_F; \ data[0] = external; \ diff --git a/libguile/vm-i-system.c b/libguile/vm-i-system.c index 9f75dff52..23bd239ab 100644 --- a/libguile/vm-i-system.c +++ b/libguile/vm-i-system.c @@ -571,13 +571,14 @@ VM_DEFINE_INSTRUCTION (tail_call, "tail-call", 1, -1, 1) { SCM *data, *tail_args, *dl; int i; - scm_byte_t *ra; + scm_byte_t *ra, *mvra; 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 */ @@ -590,7 +591,7 @@ VM_DEFINE_INSTRUCTION (tail_call, "tail-call", 1, -1, 1) sure we have space for the locals now */ data = SCM_FRAME_DATA_ADDRESS (fp); ip = bp->base; - stack_base = data + 3; + stack_base = data + 4; sp = stack_base; CHECK_OVERFLOW (); @@ -608,7 +609,8 @@ VM_DEFINE_INSTRUCTION (tail_call, "tail-call", 1, -1, 1) CONS (external, SCM_UNDEFINED, external); /* Set frame data */ - data[3] = (SCM)ra; + data[4] = (SCM)ra; + data[3] = (SCM)mvra; data[2] = (SCM)dl; data[1] = SCM_BOOL_F; data[0] = external; @@ -731,13 +733,13 @@ VM_DEFINE_INSTRUCTION (return, "return", 0, 0, 1) #ifdef THE_GOVERNMENT_IS_AFTER_ME if (sp != stack_base) abort (); - if (stack_base != data + 3) + if (stack_base != data + 4) abort (); #endif /* Restore registers */ sp = SCM_FRAME_LOWER_ADDRESS (fp); - ip = SCM_FRAME_BYTE_CAST (data[3]); + ip = SCM_FRAME_BYTE_CAST (data[4]); fp = SCM_FRAME_STACK_CAST (data[2]); stack_base = SCM_FRAME_UPPER_ADDRESS (fp) - 1; |