guile-commits
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[Guile-commits] GNU Guile branch, master, updated. v2.1.0-393-gb636cdb


From: Andy Wingo
Subject: [Guile-commits] GNU Guile branch, master, updated. v2.1.0-393-gb636cdb
Date: Mon, 18 Nov 2013 08:17:34 +0000

This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "GNU Guile".

http://git.savannah.gnu.org/cgit/guile.git/commit/?id=b636cdb0f3e1b7e8723c214db7a9c80edac9ead6

The branch, master has been updated
       via  b636cdb0f3e1b7e8723c214db7a9c80edac9ead6 (commit)
      from  cb8ea3805f02684c17c5dd8b55714dc1e8ce6c48 (commit)

Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.

- Log -----------------------------------------------------------------
commit b636cdb0f3e1b7e8723c214db7a9c80edac9ead6
Author: Andy Wingo <address@hidden>
Date:   Sun Nov 17 22:07:44 2013 +0100

    Frame pointer points to local 0 instead of local 1
    
    * libguile/frames.h: Change so that fp points at local 0 instead of
      local 1, and clean up a bit.
      (struct scm_vm_frame): Remove program, and rename stack to locals.
      (SCM_FRAME_DATA_ADDRESS): Remove; it was redundant with
      SCM_FRAME_LOWER_ADDRESS.
      (SCM_FRAME_STACK_ADDRESS): Remove; replace with the new
      SCM_FRAME_LOCALS_ADDRESS.
      (SCM_FRAME_UPPER_ADDRESS): Remove; unused.
      (SCM_FRAME_NUM_LOCALS, SCM_FRAME_PREVIOUS_SP): New defines.
      (SCM_FRAME_BYTE_CAST, SCM_FRAME_STACK_CAST): Remove; unused;
      (SCM_FRAME_LOCAL): New define, replaces SCM_FRAME_VARIABLE.
      (SCM_FRAME_PROGRAM): Add cautionary commentary.
    
    * libguile/frames.c: Adapt static asserts.
      (scm_frame_num_locals, scm_frame_local_ref, scm_frame_local_set_x):
      Adapt.  This means that frame-local-ref 0 now returns the procedure.
    
    * libguile/vm-engine.c (ALLOC_FRAME, RESET_FRAME)
      (FRAME_LOCALS_COUNT, LOCAL_REF, LOCAL_SET, RETURN_VALUE_LIST): Adapt
      to change in fp.
      (LOCAL_ADDRESS): New helper.
      (POP_CONTINUATION_HOOK): Reimplement, taking the previous FP as an
      argument.
      (ABORT_CONTINUATION_HOOK): Reimplement, taking no arguments.
      (RETURN_ONE_VALUE): Reimplement.
      (RETURN_VALUE_LIST): Adapt to FP change.
      (halt, return-values, subr-call, foreign-call, prompt)
      (continuation-call, compose-continuation, call/cc, abort): Adapt to FP
      change, mostly via using LOCAL_ADDRESS, etc abstractions instead of
      using the raw frame pointer.
    
    * libguile/control.c (reify_partial_continuation): Update for fp
      change.
    
    * libguile/vm.c (vm_reinstate_partial_continuation): Adapt to removal of
      SCM_FRAME_UPPER_ADDRESS.
    
    * module/system/vm/frame.scm (frame-call-representation): Adapt to
      frame-local-ref change.
    
    * module/system/vm/trace.scm (print-return): Remove unused
      frame-num-locals call.

-----------------------------------------------------------------------

Summary of changes:
 libguile/control.c         |    2 +-
 libguile/frames.c          |   26 +++++-----
 libguile/frames.h          |  126 +++++++++++++++++++++++++++----------------
 libguile/vm-engine.c       |  129 +++++++++++++++++++++++---------------------
 libguile/vm.c              |    2 +-
 module/system/vm/frame.scm |    5 +-
 module/system/vm/trace.scm |    3 +-
 7 files changed, 166 insertions(+), 127 deletions(-)

diff --git a/libguile/control.c b/libguile/control.c
index aad5aba..3e5c0d8 100644
--- a/libguile/control.c
+++ b/libguile/control.c
@@ -109,7 +109,7 @@ reify_partial_continuation (SCM vm,
     abort();
 
   /* Capture from the top of the thunk application frame up to the end. */
-  vm_cont = scm_i_vm_capture_stack (bottom_fp - 1,
+  vm_cont = scm_i_vm_capture_stack (&SCM_FRAME_LOCAL (bottom_fp, 0),
                                     SCM_VM_DATA (vm)->fp,
                                     SCM_VM_DATA (vm)->sp,
                                     SCM_VM_DATA (vm)->ip,
diff --git a/libguile/frames.c b/libguile/frames.c
index 5ba600b..8ca628a 100644
--- a/libguile/frames.c
+++ b/libguile/frames.c
@@ -28,7 +28,7 @@
 
 /* Make sure assumptions on the layout of `struct scm_vm_frame' hold.  */
 verify (sizeof (SCM) == sizeof (SCM *));
-verify (sizeof (struct scm_vm_frame) == 4 * sizeof (SCM));
+verify (sizeof (struct scm_vm_frame) == 3 * sizeof (SCM));
 verify (offsetof (struct scm_vm_frame, dynamic_link) == 0);
 
 
@@ -115,14 +115,14 @@ SCM_DEFINE (scm_frame_num_locals, "frame-num-locals", 1, 
0, 0,
            "")
 #define FUNC_NAME s_scm_frame_num_locals
 {
-  SCM *sp, *p;
+  SCM *fp, *sp;
 
   SCM_VALIDATE_VM_FRAME (1, frame);
 
+  fp = SCM_VM_FRAME_FP (frame);
   sp = SCM_VM_FRAME_SP (frame);
-  p = SCM_FRAME_STACK_ADDRESS (SCM_VM_FRAME_FP (frame));
 
-  return scm_from_ptrdiff_t (sp + 1 - p);
+  return scm_from_ptrdiff_t (SCM_FRAME_NUM_LOCALS (fp, sp));
 }
 #undef FUNC_NAME
 
@@ -131,17 +131,17 @@ SCM_DEFINE (scm_frame_local_ref, "frame-local-ref", 2, 0, 
0,
            "")
 #define FUNC_NAME s_scm_frame_local_ref
 {
-  SCM *sp, *p;
+  SCM *fp, *sp;
   unsigned int i;
 
   SCM_VALIDATE_VM_FRAME (1, frame);
   SCM_VALIDATE_UINT_COPY (2, index, i);
 
+  fp = SCM_VM_FRAME_FP (frame);
   sp = SCM_VM_FRAME_SP (frame);
-  p = SCM_FRAME_STACK_ADDRESS (SCM_VM_FRAME_FP (frame));
 
-  if (p + i <= sp)
-    return SCM_FRAME_VARIABLE (SCM_VM_FRAME_FP (frame), i);
+  if (i < SCM_FRAME_NUM_LOCALS (fp, sp))
+    return SCM_FRAME_LOCAL (fp, i);
 
   SCM_OUT_OF_RANGE (SCM_ARG2, index);
 }
@@ -153,18 +153,18 @@ SCM_DEFINE (scm_frame_local_set_x, "frame-local-set!", 3, 
0, 0,
            "")
 #define FUNC_NAME s_scm_frame_local_set_x
 {
-  SCM *sp, *p;
+  SCM *fp, *sp;
   unsigned int i;
 
   SCM_VALIDATE_VM_FRAME (1, frame);
   SCM_VALIDATE_UINT_COPY (2, index, i);
 
+  fp = SCM_VM_FRAME_FP (frame);
   sp = SCM_VM_FRAME_SP (frame);
-  p = SCM_FRAME_STACK_ADDRESS (SCM_VM_FRAME_FP (frame));
 
-  if (p + i <= sp)
+  if (i < SCM_FRAME_NUM_LOCALS (fp, sp))
     {
-      SCM_FRAME_VARIABLE (SCM_VM_FRAME_FP (frame), i) = val;
+      SCM_FRAME_LOCAL (fp, i) = val;
       return SCM_UNSPECIFIED;
     }
 
@@ -245,7 +245,7 @@ SCM_DEFINE (scm_frame_previous, "frame-previous", 1, 0, 0,
   if (new_fp) 
     {
       new_fp = RELOC (frame, new_fp);
-      new_sp = SCM_FRAME_LOWER_ADDRESS (this_fp) - 1;
+      new_sp = SCM_FRAME_PREVIOUS_SP (this_fp);
       frame = scm_c_make_frame (SCM_VM_FRAME_STACK_HOLDER (frame),
                                 new_fp, new_sp,
                                 SCM_FRAME_RETURN_ADDRESS (this_fp),
diff --git a/libguile/frames.h b/libguile/frames.h
index f3bb9b0..bc52165 100644
--- a/libguile/frames.h
+++ b/libguile/frames.h
@@ -23,47 +23,62 @@
 #include "programs.h"
 
 
-/*
- * VM frames
- */
+/* Stack frames
+   ------------
 
-/*
- * It's a little confusing, but there are two representations of frames in this
- * file: frame pointers and Scheme objects wrapping those frame pointers. The
- * former uses the SCM_FRAME_... macro prefix, the latter SCM_VM_FRAME_..
- * prefix.
- *
- * The confusing thing is that only Scheme frame objects have functions that 
use
- * them, and they use the scm_frame_.. prefix. Hysterical raisins.
- */
+   It's a little confusing, but there are two representations of frames
+   in this file: frame pointers, and Scheme objects wrapping those frame
+   pointers.  The former uses the SCM_FRAME macro prefix, the latter
+   SCM_VM_FRAME prefix.
+
+   The confusing thing is that only Scheme frame objects have functions
+   that use them, and they use the lower-case scm_frame prefix.
 
-/* VM Frame Layout
-   ---------------
 
+   Stack frame layout
+   ------------------
+
+   /------------------\
+   | Local N-1        | <- sp
    | ...              |
-   | Intermed. val. 0 | <- fp + nargs + nlocs
-   +------------------+    
-   | Local variable 1 |
-   | Local variable 0 | <- fp + nargs
-   | Argument 1       |
-   | Argument 0       | <- fp = SCM_FRAME_STACK_ADDRESS (fp)
-   | Program          | <- fp - 1
+   | Local 1          |
+   | Local 0          | <- fp = SCM_FRAME_LOCALS_ADDRESS (fp)
    +==================+
-   | Return address   | <- SCM_FRAME_UPPER_ADDRESS (fp)
-   | Dynamic link     | <- fp - 3 = SCM_FRAME_DATA_ADDRESS (fp) = 
SCM_FRAME_LOWER_ADDRESS (fp)
+   | Return address   |
+   | Dynamic link     | <- fp - 2 = SCM_FRAME_LOWER_ADDRESS (fp)
    +==================+
-   |                  |
+   |                  | <- fp - 3 = SCM_FRAME_PREVIOUS_SP (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.
+   The calling convention is that a caller prepares a stack frame
+   consisting of the saved FP and the return address, followed by the
+   procedure and then the arguments to the call, in order.  Thus in the
+   beginning of a call, the procedure being called is in slot 0, the
+   first argument is in slot 1, and the SP points to the last argument.
+   The number of arguments, including the procedure, is thus SP - FP +
+   1.
 
-   When a program returns multiple values, it will shuffle them down to
-   start contiguously from slot 1, as for a tail call.  This means that
-   when the caller goes to access them, there are 2 or 3 empty words
-   between the top of the caller stack and the bottom of the values,
-   corresponding to the frame that was just popped.
-*/
+   After ensuring that the correct number of arguments have been passed,
+   a function will set the stack pointer to point to the last local
+   slot.  This lets a function allocate the temporary space that it
+   needs once in the beginning of the call, instead of pushing and
+   popping the stack pointer during the call's extent.
+
+   When a program returns, it returns its values in the slots starting
+   from local 1, as if the values were arguments to a tail call.  We
+   start from 1 instead of 0 for the convenience of the "values" builtin
+   function, which can just leave its arguments in place.
+
+   The callee resets the stack pointer to point to the last value.  In
+   this way the caller knows how many values there are: it's the number
+   of words between the stack pointer and the slot at which the caller
+   placed the procedure.
+
+   After checking that the number of values returned is appropriate, the
+   caller shuffles the values around (if needed), and resets the stack
+   pointer back to its original value from before the call.  */
+
+
+
 
 /* This structure maps to the contents of a VM stack frame.  It can
    alias a frame directly.  */
@@ -71,20 +86,15 @@ struct scm_vm_frame
 {
   SCM *dynamic_link;
   scm_t_uint8 *return_address;
-  SCM program;
-  SCM stack[1]; /* Variable-length */
+  SCM locals[1]; /* Variable-length */
 };
 
+#define SCM_FRAME_LOWER_ADDRESS(fp)    (((SCM *) (fp)) - 2)
 #define SCM_FRAME_STRUCT(fp)                           \
-  ((struct scm_vm_frame *) SCM_FRAME_DATA_ADDRESS (fp))
-
-#define SCM_FRAME_DATA_ADDRESS(fp)     (((SCM *) (fp)) - 3)
-#define SCM_FRAME_STACK_ADDRESS(fp)    (SCM_FRAME_STRUCT (fp)->stack)
-#define SCM_FRAME_UPPER_ADDRESS(fp)    ((SCM*)&SCM_FRAME_STRUCT 
(fp)->return_address)
-#define SCM_FRAME_LOWER_ADDRESS(fp)    ((SCM*)SCM_FRAME_STRUCT (fp))
+  ((struct scm_vm_frame *) SCM_FRAME_LOWER_ADDRESS (fp))
+#define SCM_FRAME_LOCALS_ADDRESS(fp)   (SCM_FRAME_STRUCT (fp)->locals)
 
-#define SCM_FRAME_BYTE_CAST(x)         ((scm_t_uint8 *) SCM_UNPACK (x))
-#define SCM_FRAME_STACK_CAST(x)                ((SCM *) SCM_UNPACK (x))
+#define SCM_FRAME_PREVIOUS_SP(fp)      (((SCM *) (fp)) - 3)
 
 #define SCM_FRAME_RETURN_ADDRESS(fp)            \
   (SCM_FRAME_STRUCT (fp)->return_address)
@@ -94,10 +104,32 @@ struct scm_vm_frame
   (SCM_FRAME_STRUCT (fp)->dynamic_link)
 #define SCM_FRAME_SET_DYNAMIC_LINK(fp, dl)      \
   SCM_FRAME_DYNAMIC_LINK (fp) = (dl)
-#define SCM_FRAME_VARIABLE(fp,i)                \
-  (SCM_FRAME_STRUCT (fp)->stack[i])
-#define SCM_FRAME_PROGRAM(fp)                   \
-  (SCM_FRAME_STRUCT (fp)->program)
+#define SCM_FRAME_LOCAL(fp,i)                   \
+  (SCM_FRAME_STRUCT (fp)->locals[i])
+
+#define SCM_FRAME_NUM_LOCALS(fp, sp)            \
+  ((sp) + 1 - &SCM_FRAME_LOCAL (fp, 0))
+
+/* Currently (November 2013) we keep the procedure and arguments in
+   their slots for the duration of the procedure call, regardless of
+   whether the values are live or not.  This allows for backtraces that
+   show the closure and arguments.  We may allow the compiler to relax
+   this restriction in the future, if the user so desires.  This would
+   conserve stack space and make GC more precise.  We would need better
+   debugging information to do that, however.
+
+   Even now there is an exception to the rule that slot 0 holds the
+   procedure, which is in the case of tail calls.  The compiler will
+   emit code that shuffles the new procedure and arguments into position
+   before performing the tail call, so there is a window in which
+   SCM_FRAME_PROGRAM does not correspond to the program being executed.
+
+   The moral of the story is to use the IP in a frame to determine what
+   procedure is being called.  It is only appropriate to use
+   SCM_FRAME_PROGRAM in the prologue of a procedure call, when you know
+   it must be there.  */
+
+#define SCM_FRAME_PROGRAM(fp) (SCM_FRAME_LOCAL (fp, 0))
 
 
 
diff --git a/libguile/vm-engine.c b/libguile/vm-engine.c
index 517b8c6..7fe7893 100644
--- a/libguile/vm-engine.c
+++ b/libguile/vm-engine.c
@@ -84,12 +84,16 @@
   RUN_HOOK0 (SCM_VM_APPLY_HOOK)
 #define PUSH_CONTINUATION_HOOK()                \
   RUN_HOOK0 (SCM_VM_PUSH_CONTINUATION_HOOK)
-#define POP_CONTINUATION_HOOK(vals, n)  \
-  RUN_HOOK (SCM_VM_POP_CONTINUATION_HOOK, vals, n)
+#define POP_CONTINUATION_HOOK(old_fp)           \
+  RUN_HOOK (SCM_VM_POP_CONTINUATION_HOOK,       \
+            &SCM_FRAME_LOCAL (old_fp, 1),       \
+            SCM_FRAME_NUM_LOCALS (old_fp, vp->sp) - 1)
 #define NEXT_HOOK()                             \
   RUN_HOOK0 (SCM_VM_NEXT_HOOK)
-#define ABORT_CONTINUATION_HOOK(vals, n)        \
-  RUN_HOOK (SCM_VM_ABORT_CONTINUATION_HOOK, vals, n)
+#define ABORT_CONTINUATION_HOOK()               \
+  RUN_HOOK (SCM_VM_ABORT_CONTINUATION_HOOK,     \
+            LOCAL_ADDRESS (1),                  \
+            FRAME_LOCALS_COUNT () - 1)
 #define RESTORE_CONTINUATION_HOOK()            \
   RUN_HOOK0 (SCM_VM_RESTORE_CONTINUATION_HOOK)
 
@@ -141,27 +145,28 @@
   } while (0)
 
 /* Reserve stack space for a frame.  Will check that there is sufficient
-   stack space for N locals, including the procedure, in addition to
-   2 words to set up the next frame.  Invoke after preparing the new
-   frame and setting the fp and ip.  */
+   stack space for N locals, including the procedure.  Invoke after
+   preparing the new frame and setting the fp and ip.  */
 #define ALLOC_FRAME(n)                                              \
   do {                                                              \
-    SCM *new_sp = vp->sp = fp - 1 + n - 1;                          \
-    CHECK_OVERFLOW (new_sp + 3);                                    \
+    SCM *new_sp = vp->sp = LOCAL_ADDRESS (n - 1);                   \
+    CHECK_OVERFLOW (new_sp);                                        \
   } while (0)
 
 /* Reset the current frame to hold N locals.  Used when we know that no
    stack expansion is needed.  */
 #define RESET_FRAME(n)                                              \
   do {                                                              \
-    vp->sp = fp - 2 + n;                                            \
+    vp->sp = LOCAL_ADDRESS (n - 1);                                 \
   } while (0)
 
-/* Compute the number of locals in the frame.  This is equal to the
-   number of actual arguments when a function is first called, plus
-   one for the function.  */
-#define FRAME_LOCALS_COUNT()                                        \
-  (vp->sp + 1 - (fp - 1))
+/* Compute the number of locals in the frame.  At a call, this is equal
+   to the number of actual arguments when a function is first called,
+   plus one for the function.  */
+#define FRAME_LOCALS_COUNT_FROM(slot)           \
+  (vp->sp + 1 - LOCAL_ADDRESS (slot))
+#define FRAME_LOCALS_COUNT() \
+  FRAME_LOCALS_COUNT_FROM (0)
 
 /* Restore registers after returning from a frame.  */
 #define RESTORE_FRAME()                                             \
@@ -212,8 +217,9 @@
   case opcode:
 #endif
 
-#define LOCAL_REF(i)           SCM_FRAME_VARIABLE ((fp - 1), i)
-#define LOCAL_SET(i,o)         SCM_FRAME_VARIABLE ((fp - 1), i) = o
+#define LOCAL_ADDRESS(i)       (&SCM_FRAME_LOCAL (fp, i))
+#define LOCAL_REF(i)           SCM_FRAME_LOCAL (fp, i)
+#define LOCAL_SET(i,o)         SCM_FRAME_LOCAL (fp, i) = o
 
 #define VARIABLE_REF(v)                SCM_VARIABLE_REF (v)
 #define VARIABLE_SET(v,o)      SCM_VARIABLE_SET (v, o)
@@ -222,17 +228,17 @@
 #define RETURN_ONE_VALUE(ret)                           \
   do {                                                  \
     SCM val = ret;                                      \
-    SCM *sp = SCM_FRAME_LOWER_ADDRESS (fp);             \
+    SCM *old_fp = fp;                                   \
     VM_HANDLE_INTERRUPTS;                               \
     ip = SCM_FRAME_RTL_RETURN_ADDRESS (fp);             \
     fp = vp->fp = SCM_FRAME_DYNAMIC_LINK (fp);          \
     /* Clear frame. */                                  \
-    sp[0] = SCM_BOOL_F;                                 \
-    sp[1] = SCM_BOOL_F;                                 \
+    old_fp[-1] = SCM_BOOL_F;                            \
+    old_fp[-2] = SCM_BOOL_F;                            \
     /* Leave proc. */                                   \
-    sp[3] = val;                                        \
-    vp->sp = sp + 3;                                    \
-    POP_CONTINUATION_HOOK (sp, 1);                      \
+    SCM_FRAME_LOCAL (old_fp, 1) = val;                  \
+    vp->sp = &SCM_FRAME_LOCAL (old_fp, 1);              \
+    POP_CONTINUATION_HOOK (old_fp);                     \
     NEXT (0);                                           \
   } while (0)
 
@@ -242,9 +248,9 @@
   do {                                                  \
     SCM vals = vals_;                                   \
     VM_HANDLE_INTERRUPTS;                               \
-    fp[-1] = vm_builtin_apply;                          \
-    fp[0] = vm_builtin_values;                          \
-    fp[1] = vals;                                       \
+    fp[0] = vm_builtin_apply;                           \
+    fp[1] = vm_builtin_values;                          \
+    fp[2] = vals;                                       \
     RESET_FRAME (3);                                    \
     ip = (scm_t_uint32 *) vm_builtin_apply_code;        \
     goto op_tail_apply;                                 \
@@ -432,7 +438,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_)
          to pull all our state back from the ip/fp/sp.
       */
       CACHE_REGISTER ();
-      ABORT_CONTINUATION_HOOK (fp, FRAME_LOCALS_COUNT () - 1);
+      ABORT_CONTINUATION_HOOK ();
       NEXT (0);
     }
 
@@ -465,14 +471,14 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t 
nargs_)
     base[0] = SCM_PACK (fp); /* dynamic link */
     base[1] = SCM_PACK (ip); /* ra */
     base[2] = rtl_boot_continuation;
-    fp = &base[3];
+    fp = &base[2];
     ip = (scm_t_uint32 *) rtl_boot_continuation_code;
 
     /* MV-call frame, function & arguments */
     base[3] = SCM_PACK (fp); /* dynamic link */
     base[4] = SCM_PACK (ip); /* ra */
     base[5] = program;
-    fp = vp->fp = &base[6];
+    fp = vp->fp = &base[5];
     RESET_FRAME (nargs_ + 1);
   }
 
@@ -483,7 +489,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_)
 
       if (SCM_STRUCTP (proc) && SCM_STRUCT_APPLICABLE_P (proc))
         {
-          fp[-1] = SCM_STRUCT_PROCEDURE (proc);
+          LOCAL_SET (0, SCM_STRUCT_PROCEDURE (proc));
           continue;
         }
       if (SCM_HAS_TYP7 (proc, scm_tc7_smob) && SCM_SMOB_APPLICABLE_P (proc))
@@ -522,11 +528,11 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t 
nargs_)
    */
   VM_DEFINE_OP (0, halt, "halt", OP1 (U8_X24))
     {
-      scm_t_uint32 nvals = FRAME_LOCALS_COUNT() - 4;
-      SCM ret;
-
       /* Boot closure in r0, empty frame in r1/r2, proc in r3, values from r4. 
 */
 
+      scm_t_uint32 nvals = FRAME_LOCALS_COUNT_FROM (4);
+      SCM ret;
+
       if (nvals == 1)
         ret = LOCAL_REF (4);
       else
@@ -540,7 +546,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_)
         }
 
       vp->ip = SCM_FRAME_RETURN_ADDRESS (fp);
-      vp->sp = SCM_FRAME_LOWER_ADDRESS (fp) - 1;
+      vp->sp = SCM_FRAME_PREVIOUS_SP (fp);
       vp->fp = SCM_FRAME_DYNAMIC_LINK (fp);
 
       return ret;
@@ -703,18 +709,17 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t 
nargs_)
    */
   VM_DEFINE_OP (7, return_values, "return-values", OP1 (U8_X24))
     {
-      scm_t_uint32 nvalues _GL_UNUSED = FRAME_LOCALS_COUNT();
-      SCM *base = fp;
+      SCM *old_fp = fp;
 
       VM_HANDLE_INTERRUPTS;
       ip = SCM_FRAME_RTL_RETURN_ADDRESS (fp);
       fp = vp->fp = SCM_FRAME_DYNAMIC_LINK (fp);
 
       /* Clear stack frame.  */
-      base[-2] = SCM_BOOL_F;
-      base[-3] = SCM_BOOL_F;
+      old_fp[-1] = SCM_BOOL_F;
+      old_fp[-2] = SCM_BOOL_F;
 
-      POP_CONTINUATION_HOOK (base, nvalues);
+      POP_CONTINUATION_HOOK (old_fp);
 
       NEXT (0);
     }
@@ -747,40 +752,40 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t 
nargs_)
       VM_HANDLE_INTERRUPTS;
       SYNC_IP ();
 
-      switch (FRAME_LOCALS_COUNT () - 1)
+      switch (FRAME_LOCALS_COUNT_FROM (1))
         {
         case 0:
           ret = subr ();
           break;
         case 1:
-          ret = subr (fp[0]);
+          ret = subr (fp[1]);
           break;
         case 2:
-          ret = subr (fp[0], fp[1]);
+          ret = subr (fp[1], fp[2]);
           break;
         case 3:
-          ret = subr (fp[0], fp[1], fp[2]);
+          ret = subr (fp[1], fp[2], fp[3]);
           break;
         case 4:
-          ret = subr (fp[0], fp[1], fp[2], fp[3]);
+          ret = subr (fp[1], fp[2], fp[3], fp[4]);
           break;
         case 5:
-          ret = subr (fp[0], fp[1], fp[2], fp[3], fp[4]);
+          ret = subr (fp[1], fp[2], fp[3], fp[4], fp[5]);
           break;
         case 6:
-          ret = subr (fp[0], fp[1], fp[2], fp[3], fp[4], fp[5]);
+          ret = subr (fp[1], fp[2], fp[3], fp[4], fp[5], fp[6]);
           break;
         case 7:
-          ret = subr (fp[0], fp[1], fp[2], fp[3], fp[4], fp[5], fp[6]);
+          ret = subr (fp[1], fp[2], fp[3], fp[4], fp[5], fp[6], fp[7]);
           break;
         case 8:
-          ret = subr (fp[0], fp[1], fp[2], fp[3], fp[4], fp[5], fp[6], fp[7]);
+          ret = subr (fp[1], fp[2], fp[3], fp[4], fp[5], fp[6], fp[7], fp[8]);
           break;
         case 9:
-          ret = subr (fp[0], fp[1], fp[2], fp[3], fp[4], fp[5], fp[6], fp[7], 
fp[8]);
+          ret = subr (fp[1], fp[2], fp[3], fp[4], fp[5], fp[6], fp[7], fp[8], 
fp[9]);
           break;
         case 10:
-          ret = subr (fp[0], fp[1], fp[2], fp[3], fp[4], fp[5], fp[6], fp[7], 
fp[8], fp[9]);
+          ret = subr (fp[1], fp[2], fp[3], fp[4], fp[5], fp[6], fp[7], fp[8], 
fp[9], fp[10]);
           break;
         default:
           abort ();
@@ -818,7 +823,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_)
       VM_HANDLE_INTERRUPTS;
 
       // FIXME: separate args
-      ret = scm_i_foreign_call (scm_cons (cif, pointer), fp);
+      ret = scm_i_foreign_call (scm_cons (cif, pointer), LOCAL_ADDRESS (1));
 
       // NULLSTACK_FOR_NONLOCAL_EXIT ();
 
@@ -851,7 +856,8 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_)
       scm_i_check_continuation (contregs);
       vm_return_to_continuation (scm_i_contregs_vm (contregs),
                                  scm_i_contregs_vm_cont (contregs),
-                                 FRAME_LOCALS_COUNT () - 1, fp);
+                                 FRAME_LOCALS_COUNT_FROM (1),
+                                 LOCAL_ADDRESS (1));
       scm_i_reinstate_continuation (contregs);
 
       /* no NEXT */
@@ -877,7 +883,8 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_)
       SYNC_IP ();
       VM_ASSERT (SCM_VM_CONT_REWINDABLE_P (vmcont),
                  vm_error_continuation_not_rewindable (vmcont));
-      vm_reinstate_partial_continuation (vm, vmcont, FRAME_LOCALS_COUNT () - 
1, fp,
+      vm_reinstate_partial_continuation (vm, vmcont, FRAME_LOCALS_COUNT_FROM 
(1),
+                                         LOCAL_ADDRESS (1),
                                          &current_thread->dynstack,
                                          &registers);
       CACHE_REGISTER ();
@@ -947,7 +954,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_)
       dynstack = scm_dynstack_capture_all (&current_thread->dynstack);
       vm_cont = scm_i_vm_capture_stack (vp->stack_base,
                                         SCM_FRAME_DYNAMIC_LINK (fp),
-                                        SCM_FRAME_LOWER_ADDRESS (fp) - 1,
+                                        SCM_FRAME_PREVIOUS_SP (fp),
                                         SCM_FRAME_RETURN_ADDRESS (fp),
                                         dynstack,
                                         0);
@@ -975,7 +982,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_)
       else
         {
           CACHE_REGISTER ();
-          ABORT_CONTINUATION_HOOK (fp, FRAME_LOCALS_COUNT () - 1);
+          ABORT_CONTINUATION_HOOK ();
           NEXT (0);
         }
     }
@@ -996,8 +1003,8 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_)
          it continues with the next instruction.  */
       ip++;
       SYNC_IP ();
-      vm_abort (vm, LOCAL_REF (1), nlocals - 2, &LOCAL_REF (2),
-                SCM_EOL, &LOCAL_REF (0), &registers);
+      vm_abort (vm, LOCAL_REF (1), nlocals - 2, LOCAL_ADDRESS (2),
+                SCM_EOL, LOCAL_ADDRESS (0), &registers);
 
       /* vm_abort should not return */
       abort ();
@@ -1825,7 +1832,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t 
nargs_)
       var = scm_lookup (LOCAL_REF (sym));
       if (ip[1] & 0x1)
         VM_ASSERT (VARIABLE_BOUNDP (var),
-                   vm_error_unbound (fp[-1], LOCAL_REF (sym)));
+                   vm_error_unbound (fp[0], LOCAL_REF (sym)));
       LOCAL_SET (dst, var);
 
       NEXT (2);
@@ -1902,7 +1909,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t 
nargs_)
 
           var = scm_module_lookup (mod, sym);
           if (ip[4] & 0x1)
-            VM_ASSERT (VARIABLE_BOUNDP (var), vm_error_unbound (fp[-1], sym));
+            VM_ASSERT (VARIABLE_BOUNDP (var), vm_error_unbound (fp[0], sym));
 
           *var_loc = var;
         }
@@ -1964,7 +1971,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t 
nargs_)
             var = scm_private_lookup (SCM_CDR (modname), sym);
 
           if (ip[4] & 0x1)
-            VM_ASSERT (VARIABLE_BOUNDP (var), vm_error_unbound (fp[-1], sym));
+            VM_ASSERT (VARIABLE_BOUNDP (var), vm_error_unbound (fp[0], sym));
 
           *var_loc = var;
         }
@@ -2004,7 +2011,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t 
nargs_)
       scm_dynstack_push_prompt (&current_thread->dynstack, flags,
                                 LOCAL_REF (tag),
                                 fp,
-                                &LOCAL_REF (proc_slot),
+                                LOCAL_ADDRESS (proc_slot),
                                 (scm_t_uint8 *)(ip + offset),
                                 &registers);
       NEXT (3);
diff --git a/libguile/vm.c b/libguile/vm.c
index 9550f81..b083d06 100644
--- a/libguile/vm.c
+++ b/libguile/vm.c
@@ -312,7 +312,7 @@ vm_reinstate_partial_continuation (SCM vm, SCM cont, size_t 
n, SCM *argv,
 
   vp = SCM_VM_DATA (vm);
   cp = SCM_VM_CONT_DATA (cont);
-  base = SCM_FRAME_UPPER_ADDRESS (vp->fp) + 1;
+  base = SCM_FRAME_LOCALS_ADDRESS (vp->fp);
   reloc = cp->reloc + (base - cp->stack_base);
 
 #define RELOC(scm_p)                                           \
diff --git a/module/system/vm/frame.scm b/module/system/vm/frame.scm
index ed042fa..3ab3e1e 100644
--- a/module/system/vm/frame.scm
+++ b/module/system/vm/frame.scm
@@ -105,7 +105,7 @@
                      (opt (or (assq-ref arguments 'optional) '()))
                      (key (or (assq-ref arguments 'keyword) '()))
                      (rest (or (assq-ref arguments 'rest) #f))
-                     (i 0))
+                     (i 1))
               (cond
                ((pair? req)
                 (cons (binding-ref (car req) i)
@@ -125,7 +125,8 @@
        ;; case 2
        (map (lambda (i)
               (frame-local-ref frame i))
-            (iota (frame-num-locals frame))))))))
+            ;; Cdr past the 0th local, which is the procedure.
+            (cdr (iota (frame-num-locals frame)))))))))
 
 
 
diff --git a/module/system/vm/trace.scm b/module/system/vm/trace.scm
index 7657be4..717013f 100644
--- a/module/system/vm/trace.scm
+++ b/module/system/vm/trace.scm
@@ -50,8 +50,7 @@
             (frame-call-representation frame))))
 
 (define* (print-return frame depth width prefix max-indent values)
-  (let* ((len (frame-num-locals frame))
-         (prefix (build-prefix prefix depth "|  " "~d< "max-indent)))
+  (let ((prefix (build-prefix prefix depth "|  " "~d< "max-indent)))
     (case (length values)
       ((0)
        (format (current-error-port) "~ano values\n" prefix))


hooks/post-receive
-- 
GNU Guile



reply via email to

[Prev in Thread] Current Thread [Next in Thread]