summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--libguile/frames.c12
-rw-r--r--libguile/frames.h6
-rw-r--r--libguile/vm-engine.h5
-rw-r--r--libguile/vm-i-system.c12
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;