The dynamic stack records SP and FP values as offsets

* libguile/dynstack.h:
* libguile/dynstack.c (PROMPT_FP, PROMPT_SP):
  (scm_dynstack_push_prompt, scm_dynstack_find_prompt): Prompts on the
  dynstack are recorded as offsets from the base stack address in this
  thread.

* libguile/control.c (scm_c_abort):
* libguile/eval.c (eval):
* libguile/stacks.c (find_prompt, narrow_stack):
* libguile/throw.c (pre_init_catch):
* libguile/vm-engine.c (prompt): Adapt.

diff --git a/libguile/control.c b/libguile/control.c
index 0ef8e23..e326086 100644 (file)
--- a/libguile/control.c
+++ b/libguile/control.c
@@ -129,17 +129,22 @@ scm_c_abort (SCM vm, SCM tag, size_t n, SCM *argv,
   scm_t_dynstack *dynstack = &SCM_I_CURRENT_THREAD->dynstack;
   scm_t_bits *prompt;
   scm_t_dynstack_prompt_flags flags;
+  scm_t_ptrdiff fp_offset, sp_offset;
   SCM *fp, *sp;
   scm_t_uint32 *ip;
   scm_i_jmp_buf *registers;
   size_t i;
 
   prompt = scm_dynstack_find_prompt (dynstack, tag,
-                                     &flags, &fp, &sp, &ip, &registers);
+                                     &flags, &fp_offset, &sp_offset, &ip,
+                                     &registers);
 
   if (!prompt)
     scm_misc_error ("abort", "Abort to unknown prompt", scm_list_1 (tag));
 
+  fp = SCM_VM_DATA (vm)->stack_base + fp_offset;
+  sp = SCM_VM_DATA (vm)->stack_base + sp_offset;
+
   /* Only reify if the continuation referenced in the handler. */
   if (flags & SCM_F_DYNSTACK_PROMPT_ESCAPE_ONLY)
     cont = SCM_BOOL_F;

diff --git a/libguile/dynstack.c b/libguile/dynstack.c
index 2d8895e..9235ec4 100644 (file)
--- a/libguile/dynstack.c
+++ b/libguile/dynstack.c
@@ -36,8 +36,8 @@
 
 #define PROMPT_WORDS 5
 #define PROMPT_KEY(top) (SCM_PACK ((top)[0]))
-#define PROMPT_FP(top) ((SCM *) ((top)[1]))
-#define PROMPT_SP(top) ((SCM *) ((top)[2]))
+#define PROMPT_FP(top) ((scm_t_ptrdiff) ((top)[1]))
+#define PROMPT_SP(top) ((scm_t_ptrdiff) ((top)[2]))
 #define PROMPT_IP(top) ((scm_t_uint32 *) ((top)[3]))
 #define PROMPT_JMPBUF(top) ((scm_i_jmp_buf *) ((top)[4]))
 
@@ -186,16 +186,16 @@ void
 scm_dynstack_push_prompt (scm_t_dynstack *dynstack,
                           scm_t_dynstack_prompt_flags flags,
                           SCM key,
-                          SCM *fp, SCM *sp, scm_t_uint32 *ip,
-                          scm_i_jmp_buf *registers)
+                          scm_t_ptrdiff fp_offset, scm_t_ptrdiff sp_offset,
+                          scm_t_uint32 *ip, scm_i_jmp_buf *registers)
 {
   scm_t_bits *words;
 
   words = push_dynstack_entry (dynstack, SCM_DYNSTACK_TYPE_PROMPT, flags,
                                PROMPT_WORDS);
   words[0] = SCM_UNPACK (key);
-  words[1] = (scm_t_bits) fp;
-  words[2] = (scm_t_bits) sp;
+  words[1] = (scm_t_bits) fp_offset;
+  words[2] = (scm_t_bits) sp_offset;
   words[3] = (scm_t_bits) ip;
   words[4] = (scm_t_bits) registers;
 }
@@ -442,8 +442,8 @@ scm_dynstack_unwind_fork (scm_t_dynstack *dynstack, scm_t_dynstack *branch)
 scm_t_bits*
 scm_dynstack_find_prompt (scm_t_dynstack *dynstack, SCM key,
                           scm_t_dynstack_prompt_flags *flags,
-                          SCM **fp, SCM **sp, scm_t_uint32 **ip,
-                          scm_i_jmp_buf **registers)
+                          scm_t_ptrdiff *fp_offset, scm_t_ptrdiff *sp_offset,
+                          scm_t_uint32 **ip, scm_i_jmp_buf **registers)
 {
   scm_t_bits *walk;
 
@@ -457,10 +457,10 @@ scm_dynstack_find_prompt (scm_t_dynstack *dynstack, SCM key,
         {
           if (flags)
             *flags = SCM_DYNSTACK_TAG_FLAGS (tag);
-          if (fp)
-            *fp = PROMPT_FP (walk);
-          if (sp)
-            *sp = PROMPT_SP (walk);
+          if (fp_offset)
+            *fp_offset = PROMPT_FP (walk);
+          if (sp_offset)
+            *sp_offset = PROMPT_SP (walk);
           if (ip)
             *ip = PROMPT_IP (walk);
           if (registers)

diff --git a/libguile/dynstack.h b/libguile/dynstack.h
index fe5bb54..d4a604d 100644 (file)
--- a/libguile/dynstack.h
+++ b/libguile/dynstack.h
@@ -155,7 +155,9 @@ SCM_INTERNAL void scm_dynstack_push_fluid (scm_t_dynstack *,
 SCM_INTERNAL void scm_dynstack_push_prompt (scm_t_dynstack *,
                                             scm_t_dynstack_prompt_flags,
                                             SCM key,
-                                            SCM *fp, SCM *sp, scm_t_uint32 *ip,
+                                            scm_t_ptrdiff fp_offset,
+                                            scm_t_ptrdiff sp_offset,
+                                            scm_t_uint32 *ip,
                                             scm_i_jmp_buf *registers);
 SCM_INTERNAL void scm_dynstack_push_dynwind (scm_t_dynstack *,
                                              SCM enter, SCM leave);
@@ -191,7 +193,9 @@ SCM_INTERNAL void scm_dynstack_unwind_fluid (scm_t_dynstack *dynstack,
 
 SCM_INTERNAL scm_t_bits* scm_dynstack_find_prompt (scm_t_dynstack *, SCM,
                                                    scm_t_dynstack_prompt_flags *,
-                                                   SCM **, SCM **, scm_t_uint32 **,
+                                                   scm_t_ptrdiff *,
+                                                   scm_t_ptrdiff *,
+                                                   scm_t_uint32 **,
                                                    scm_i_jmp_buf **);
 
 SCM_INTERNAL void scm_dynstack_wind_prompt (scm_t_dynstack *, scm_t_bits *,

diff --git a/libguile/eval.c b/libguile/eval.c
index df4b64f..7b09d84 100644 (file)
--- a/libguile/eval.c
+++ b/libguile/eval.c
@@ -449,14 +449,14 @@ eval (SCM x, SCM env)
         vm = scm_the_vm ();
 
         /* Push the prompt onto the dynamic stack. */
-        scm_dynstack_push_prompt (&SCM_I_CURRENT_THREAD->dynstack,
-                                  SCM_F_DYNSTACK_PROMPT_ESCAPE_ONLY
-                                  | SCM_F_DYNSTACK_PROMPT_PUSH_NARGS,
-                                  k,
-                                  SCM_VM_DATA (vm)->fp,
-                                  SCM_VM_DATA (vm)->sp,
-                                  SCM_VM_DATA (vm)->ip,
-                                  &registers);
+        scm_dynstack_push_prompt
+          (&SCM_I_CURRENT_THREAD->dynstack,
+           SCM_F_DYNSTACK_PROMPT_ESCAPE_ONLY | SCM_F_DYNSTACK_PROMPT_PUSH_NARGS,
+           k,
+           SCM_VM_DATA (vm)->fp - SCM_VM_DATA (vm)->stack_base,
+           SCM_VM_DATA (vm)->sp - SCM_VM_DATA (vm)->stack_base,
+           SCM_VM_DATA (vm)->ip,
+           &registers);
 
         if (SCM_I_SETJMP (registers))
           {

diff --git a/libguile/frames.h b/libguile/frames.h
index bd85b7e..3876c2f 100644 (file)
--- a/libguile/frames.h
+++ b/libguile/frames.h
@@ -148,10 +148,12 @@ struct scm_frame
 
 #define SCM_VM_FRAME_P(x)      (SCM_HAS_TYP7 (x, scm_tc7_frame))
 #define SCM_VM_FRAME_DATA(x)   ((struct scm_frame*)SCM_CELL_WORD_1 (x))
-#define SCM_VM_FRAME_STACK_HOLDER(f)   SCM_VM_FRAME_DATA(f)->stack_holder
-#define SCM_VM_FRAME_FP(f)     (SCM_VM_FRAME_DATA(f)->fp_offset + scm_i_frame_stack_base(f))
-#define SCM_VM_FRAME_SP(f)     (SCM_VM_FRAME_DATA(f)->sp_offset + scm_i_frame_stack_base(f))
-#define SCM_VM_FRAME_IP(f)     SCM_VM_FRAME_DATA(f)->ip
+#define SCM_VM_FRAME_STACK_HOLDER(f)   SCM_VM_FRAME_DATA (f)->stack_holder
+#define SCM_VM_FRAME_FP_OFFSET(f)      SCM_VM_FRAME_DATA (f)->fp_offset
+#define SCM_VM_FRAME_SP_OFFSET(f)      SCM_VM_FRAME_DATA (f)->sp_offset
+#define SCM_VM_FRAME_FP(f)     (SCM_VM_FRAME_FP_OFFSET (f) + scm_i_frame_stack_base (f))
+#define SCM_VM_FRAME_SP(f)     (SCM_VM_FRAME_SP_OFFSET (f) + scm_i_frame_stack_base (f))
+#define SCM_VM_FRAME_IP(f)     SCM_VM_FRAME_DATA (f)->ip
 #define SCM_VM_FRAME_OFFSET(f) scm_i_frame_offset (f)
 #define SCM_VALIDATE_VM_FRAME(p,x)     SCM_MAKE_VALIDATE (p, x, VM_FRAME_P)
 

diff --git a/libguile/stacks.c b/libguile/stacks.c
index 4b3016a..97b1495 100644 (file)
--- a/libguile/stacks.c
+++ b/libguile/stacks.c
@@ -95,17 +95,17 @@ stack_depth (SCM frame)
  * encountered.
  */
 
-static SCM*
+static scm_t_ptrdiff
 find_prompt (SCM key)
 {
-  SCM *fp;
+  scm_t_ptrdiff fp_offset;
 
   if (!scm_dynstack_find_prompt (&SCM_I_CURRENT_THREAD->dynstack, key,
-                                 NULL, &fp, NULL, NULL, NULL))
+                                 NULL, &fp_offset, NULL, NULL, NULL))
     scm_misc_error ("make-stack", "Prompt tag not found while narrowing stack",
                     scm_list_1 (key));
 
-  return fp;
+  return fp_offset;
 }
 
 static void
@@ -144,9 +144,9 @@ narrow_stack (SCM stack, SCM inner_cut, SCM outer_cut)
   else
     {
       /* Cut until the given prompt tag is seen. */
-      SCM *fp = find_prompt (inner_cut);
+      scm_t_ptrdiff fp_offset = find_prompt (inner_cut);
       for (; len; len--, frame = scm_frame_previous (frame))
-        if (fp == SCM_VM_FRAME_FP (frame) - SCM_VM_FRAME_OFFSET (frame))
+        if (fp_offset == SCM_VM_FRAME_FP_OFFSET (frame))
           break;
     }
 
@@ -178,12 +178,12 @@ narrow_stack (SCM stack, SCM inner_cut, SCM outer_cut)
   else
     {
       /* Cut until the given prompt tag is seen. */
-      SCM *fp = find_prompt (outer_cut);
+      scm_t_ptrdiff fp_offset = find_prompt (outer_cut);
       while (len)
         {
           frame = scm_stack_ref (stack, scm_from_long (len - 1));
           len--;
-          if (fp == SCM_VM_FRAME_FP (frame) - SCM_VM_FRAME_OFFSET (frame))
+          if (fp_offset == SCM_VM_FRAME_FP_OFFSET (frame))
             break;
         }
     }

diff --git a/libguile/throw.c b/libguile/throw.c
index bd7a984..e68f428 100644 (file)
--- a/libguile/throw.c
+++ b/libguile/throw.c
@@ -477,8 +477,8 @@ pre_init_catch (SCM tag, SCM thunk, SCM handler, SCM pre_unwind_handler)
                             SCM_F_DYNSTACK_PROMPT_ESCAPE_ONLY
                             | SCM_F_DYNSTACK_PROMPT_PUSH_NARGS,
                             sym_pre_init_catch_tag,
-                            SCM_VM_DATA (vm)->fp,
-                            SCM_VM_DATA (vm)->sp,
+                            SCM_VM_DATA (vm)->fp - SCM_VM_DATA (vm)->stack_base,
+                            SCM_VM_DATA (vm)->sp - SCM_VM_DATA (vm)->stack_base,
                             SCM_VM_DATA (vm)->ip,
                             &registers);
 

diff --git a/libguile/vm-engine.c b/libguile/vm-engine.c
index 87d2a78..ad6ec62 100644 (file)
--- a/libguile/vm-engine.c
+++ b/libguile/vm-engine.c
@@ -2050,8 +2050,8 @@ VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_)
       flags = escape_only_p ? SCM_F_DYNSTACK_PROMPT_ESCAPE_ONLY : 0;
       scm_dynstack_push_prompt (&current_thread->dynstack, flags,
                                 LOCAL_REF (tag),
-                                fp,
-                                LOCAL_ADDRESS (proc_slot),
+                                fp - vp->stack_base,
+                                LOCAL_ADDRESS (proc_slot) - vp->stack_base,
                                 ip + offset,
                                 &registers);
       NEXT (3);