mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-05-20 11:40:18 +02:00
add a multiple values return address to stack frames
* libguile/frames.c (frame-mv-return-address): New accessor. * libguile/frames.h: Update frame diagram. (SCM_FRAME_UPPER_ADDRESS): Update for data area growing by one pointer. (SCM_FRAME_MV_RETURN_ADDRESS): New macro. * libguile/vm-engine.h (NEW_FRAME): Update for frame getting bigger by a pointer. In a normal NEW_FRAME, set the MV return address to NULL, to indicate that this continuation does not accept multiple values. * libguile/vm-i-system.c (tail-call): Update frame replacement code to understand the MV return address. (return): Make room for the MVRA.
This commit is contained in:
parent
28106f547d
commit
da320011a3
4 changed files with 27 additions and 8 deletions
|
@ -151,6 +151,18 @@ SCM_DEFINE (scm_frame_return_address, "frame-return-address", 1, 0, 0,
|
||||||
}
|
}
|
||||||
#undef FUNC_NAME
|
#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_DEFINE (scm_frame_dynamic_link, "frame-dynamic-link", 1, 0, 0,
|
||||||
(SCM frame),
|
(SCM frame),
|
||||||
"")
|
"")
|
||||||
|
|
|
@ -56,6 +56,7 @@
|
||||||
| | <- fp + bp->nargs + bp->nlocs + 4
|
| | <- fp + bp->nargs + bp->nlocs + 4
|
||||||
+------------------+ = SCM_FRAME_UPPER_ADDRESS (fp)
|
+------------------+ = SCM_FRAME_UPPER_ADDRESS (fp)
|
||||||
| Return address |
|
| Return address |
|
||||||
|
| MV return address|
|
||||||
| Dynamic link |
|
| Dynamic link |
|
||||||
| Heap link |
|
| Heap link |
|
||||||
| External link | <- fp + bp->nargs + bp->nlocs
|
| External link | <- fp + bp->nargs + bp->nlocs
|
||||||
|
@ -74,13 +75,15 @@
|
||||||
#define SCM_FRAME_DATA_ADDRESS(fp) \
|
#define SCM_FRAME_DATA_ADDRESS(fp) \
|
||||||
(fp + SCM_PROGRAM_DATA (SCM_FRAME_PROGRAM (fp))->nargs \
|
(fp + SCM_PROGRAM_DATA (SCM_FRAME_PROGRAM (fp))->nargs \
|
||||||
+ SCM_PROGRAM_DATA (SCM_FRAME_PROGRAM (fp))->nlocs)
|
+ 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_LOWER_ADDRESS(fp) (fp - 1)
|
||||||
|
|
||||||
#define SCM_FRAME_BYTE_CAST(x) ((scm_byte_t *) SCM_UNPACK (x))
|
#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_STACK_CAST(x) ((SCM *) SCM_UNPACK (x))
|
||||||
|
|
||||||
#define SCM_FRAME_RETURN_ADDRESS(fp) \
|
#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]))
|
(SCM_FRAME_BYTE_CAST (SCM_FRAME_DATA_ADDRESS (fp)[3]))
|
||||||
#define SCM_FRAME_DYNAMIC_LINK(fp) \
|
#define SCM_FRAME_DYNAMIC_LINK(fp) \
|
||||||
(SCM_FRAME_STACK_CAST (SCM_FRAME_DATA_ADDRESS (fp)[2]))
|
(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_ref (SCM frame, SCM index);
|
||||||
extern SCM scm_frame_local_set_x (SCM frame, SCM index, SCM val);
|
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_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_dynamic_link (SCM frame);
|
||||||
extern SCM scm_frame_external_link (SCM frame);
|
extern SCM scm_frame_external_link (SCM frame);
|
||||||
|
|
||||||
|
|
|
@ -422,7 +422,7 @@ do { \
|
||||||
/* New registers */ \
|
/* New registers */ \
|
||||||
fp = sp - bp->nargs + 1; \
|
fp = sp - bp->nargs + 1; \
|
||||||
data = SCM_FRAME_DATA_ADDRESS (fp); \
|
data = SCM_FRAME_DATA_ADDRESS (fp); \
|
||||||
sp = data + 3; \
|
sp = data + 4; \
|
||||||
CHECK_OVERFLOW (); \
|
CHECK_OVERFLOW (); \
|
||||||
stack_base = sp; \
|
stack_base = sp; \
|
||||||
ip = bp->base; \
|
ip = bp->base; \
|
||||||
|
@ -437,7 +437,8 @@ do { \
|
||||||
CONS (external, SCM_UNDEFINED, external); \
|
CONS (external, SCM_UNDEFINED, external); \
|
||||||
\
|
\
|
||||||
/* Set frame data */ \
|
/* Set frame data */ \
|
||||||
data[3] = (SCM)ra; \
|
data[4] = (SCM)ra; \
|
||||||
|
data[3] = 0x0; \
|
||||||
data[2] = (SCM)dl; \
|
data[2] = (SCM)dl; \
|
||||||
data[1] = SCM_BOOL_F; \
|
data[1] = SCM_BOOL_F; \
|
||||||
data[0] = external; \
|
data[0] = external; \
|
||||||
|
|
|
@ -571,13 +571,14 @@ VM_DEFINE_INSTRUCTION (tail_call, "tail-call", 1, -1, 1)
|
||||||
{
|
{
|
||||||
SCM *data, *tail_args, *dl;
|
SCM *data, *tail_args, *dl;
|
||||||
int i;
|
int i;
|
||||||
scm_byte_t *ra;
|
scm_byte_t *ra, *mvra;
|
||||||
|
|
||||||
EXIT_HOOK ();
|
EXIT_HOOK ();
|
||||||
|
|
||||||
/* save registers */
|
/* save registers */
|
||||||
tail_args = stack_base + 2;
|
tail_args = stack_base + 2;
|
||||||
ra = SCM_FRAME_RETURN_ADDRESS (fp);
|
ra = SCM_FRAME_RETURN_ADDRESS (fp);
|
||||||
|
mvra = SCM_FRAME_MV_RETURN_ADDRESS (fp);
|
||||||
dl = SCM_FRAME_DYNAMIC_LINK (fp);
|
dl = SCM_FRAME_DYNAMIC_LINK (fp);
|
||||||
|
|
||||||
/* switch programs */
|
/* switch programs */
|
||||||
|
@ -590,7 +591,7 @@ VM_DEFINE_INSTRUCTION (tail_call, "tail-call", 1, -1, 1)
|
||||||
sure we have space for the locals now */
|
sure we have space for the locals now */
|
||||||
data = SCM_FRAME_DATA_ADDRESS (fp);
|
data = SCM_FRAME_DATA_ADDRESS (fp);
|
||||||
ip = bp->base;
|
ip = bp->base;
|
||||||
stack_base = data + 3;
|
stack_base = data + 4;
|
||||||
sp = stack_base;
|
sp = stack_base;
|
||||||
CHECK_OVERFLOW ();
|
CHECK_OVERFLOW ();
|
||||||
|
|
||||||
|
@ -608,7 +609,8 @@ VM_DEFINE_INSTRUCTION (tail_call, "tail-call", 1, -1, 1)
|
||||||
CONS (external, SCM_UNDEFINED, external);
|
CONS (external, SCM_UNDEFINED, external);
|
||||||
|
|
||||||
/* Set frame data */
|
/* Set frame data */
|
||||||
data[3] = (SCM)ra;
|
data[4] = (SCM)ra;
|
||||||
|
data[3] = (SCM)mvra;
|
||||||
data[2] = (SCM)dl;
|
data[2] = (SCM)dl;
|
||||||
data[1] = SCM_BOOL_F;
|
data[1] = SCM_BOOL_F;
|
||||||
data[0] = external;
|
data[0] = external;
|
||||||
|
@ -731,13 +733,13 @@ VM_DEFINE_INSTRUCTION (return, "return", 0, 0, 1)
|
||||||
#ifdef THE_GOVERNMENT_IS_AFTER_ME
|
#ifdef THE_GOVERNMENT_IS_AFTER_ME
|
||||||
if (sp != stack_base)
|
if (sp != stack_base)
|
||||||
abort ();
|
abort ();
|
||||||
if (stack_base != data + 3)
|
if (stack_base != data + 4)
|
||||||
abort ();
|
abort ();
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
/* Restore registers */
|
/* Restore registers */
|
||||||
sp = SCM_FRAME_LOWER_ADDRESS (fp);
|
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]);
|
fp = SCM_FRAME_STACK_CAST (data[2]);
|
||||||
stack_base = SCM_FRAME_UPPER_ADDRESS (fp) - 1;
|
stack_base = SCM_FRAME_UPPER_ADDRESS (fp) - 1;
|
||||||
|
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue