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.

diff --git a/libguile/frames.c b/libguile/frames.c
index c4f2f27..36f057f 100644 (file)
--- 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 53fc4e8..f5323f7 100644 (file)
--- 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 516eedc..0d0c03d 100644 (file)
--- 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 9f75dff..23bd239 100644 (file)
--- 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;