Heap frames have a "frame kind" bit

* libguile/frames.h (enum scm_vm_frame_kind, SCM_VM_FRAME_KIND)
  (scm_c_make_frame): Add a "frame kind" bit to the first word.  This
  will allow the "stack holder" to be a non-SCM object.

* libguile/continuations.c (scm_i_continuation_to_frame):
* libguile/frames.c (scm_c_make_frame, scm_frame_previous)
* libguile/stacks.c (scm_make_stack):
* libguile/vm.c (vm_dispatch_hook): Adapt frame creators to set the
  frame kind bit.

diff --git a/libguile/continuations.c b/libguile/continuations.c
index 7c40dbf..31e3644 100644 (file)
--- a/libguile/continuations.c
+++ b/libguile/continuations.c
@@ -177,7 +177,7 @@ scm_i_continuation_to_frame (SCM continuation)
   if (scm_is_true (cont->vm_cont))
     {
       struct scm_vm_cont *data = SCM_VM_CONT_DATA (cont->vm_cont);
-      return scm_c_make_frame (cont->vm_cont,
+      return scm_c_make_frame (SCM_VM_FRAME_KIND_CONT, cont->vm_cont,
                                (data->fp + data->reloc) - data->stack_base,
                                (data->sp + data->reloc) - data->stack_base,
                                data->ra);

diff --git a/libguile/frames.c b/libguile/frames.c
index 0fc0b9e..824f2c8 100644 (file)
--- a/libguile/frames.c
+++ b/libguile/frames.c
@@ -37,8 +37,9 @@ verify (offsetof (struct scm_vm_frame, dynamic_link) == 0);
   (((SCM *) (val)) + SCM_VM_FRAME_OFFSET (frame))
 
 SCM
-scm_c_make_frame (SCM stack_holder, scm_t_ptrdiff fp_offset,
-                  scm_t_ptrdiff sp_offset, scm_t_uint32 *ip)
+scm_c_make_frame (enum scm_vm_frame_kind frame_kind, SCM stack_holder,
+                  scm_t_ptrdiff fp_offset, scm_t_ptrdiff sp_offset,
+                  scm_t_uint32 *ip)
 {
   struct scm_frame *p = scm_gc_malloc (sizeof (struct scm_frame),
                                        "vmframe");
@@ -46,7 +47,7 @@ scm_c_make_frame (SCM stack_holder, scm_t_ptrdiff fp_offset,
   p->fp_offset = fp_offset;
   p->sp_offset = sp_offset;
   p->ip = ip;
-  return scm_cell (scm_tc7_frame, (scm_t_bits)p);
+  return scm_cell (scm_tc7_frame | (frame_kind << 8), (scm_t_bits)p);
 }
 
 void
@@ -282,7 +283,8 @@ SCM_DEFINE (scm_frame_previous, "frame-previous", 1, 0, 0,
       SCM *stack_base = scm_i_frame_stack_base (frame);
       new_fp = RELOC (frame, new_fp);
       new_sp = SCM_FRAME_PREVIOUS_SP (this_fp);
-      frame = scm_c_make_frame (SCM_VM_FRAME_STACK_HOLDER (frame),
+      frame = scm_c_make_frame (SCM_VM_FRAME_KIND (frame),
+                                SCM_VM_FRAME_STACK_HOLDER (frame),
                                 new_fp - stack_base, new_sp - stack_base,
                                 SCM_FRAME_RETURN_ADDRESS (this_fp));
       proc = scm_frame_procedure (frame);

diff --git a/libguile/frames.h b/libguile/frames.h
index 3876c2f..67130ad 100644 (file)
--- a/libguile/frames.h
+++ b/libguile/frames.h
@@ -146,7 +146,14 @@ struct scm_frame
   scm_t_uint32 *ip;
 };
 
+enum scm_vm_frame_kind
+  {
+    SCM_VM_FRAME_KIND_VM,
+    SCM_VM_FRAME_KIND_CONT
+  };
+
 #define SCM_VM_FRAME_P(x)      (SCM_HAS_TYP7 (x, scm_tc7_frame))
+#define SCM_VM_FRAME_KIND(x)   ((enum scm_vm_frame_kind) (SCM_CELL_WORD_0 (x) >> 8))
 #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_OFFSET(f)      SCM_VM_FRAME_DATA (f)->fp_offset
@@ -160,7 +167,8 @@ struct scm_frame
 SCM_INTERNAL SCM* scm_i_frame_stack_base (SCM frame);
 SCM_INTERNAL scm_t_ptrdiff scm_i_frame_offset (SCM frame);
 
-SCM_INTERNAL SCM scm_c_make_frame (SCM stack_holder, scm_t_ptrdiff fp_offset,
+SCM_INTERNAL SCM scm_c_make_frame (enum scm_vm_frame_kind vm_frame_kind,
+                                   SCM stack_holder, scm_t_ptrdiff fp_offset,
                                    scm_t_ptrdiff sp_offset, scm_t_uint32 *ip);
 
 #endif

diff --git a/libguile/stacks.c b/libguile/stacks.c
index 97b1495..c478b06 100644 (file)
--- a/libguile/stacks.c
+++ b/libguile/stacks.c
@@ -258,7 +258,7 @@ SCM_DEFINE (scm_make_stack, "make-stack", 1, 0, 1,
       cont = scm_i_capture_current_stack ();
       c = SCM_VM_CONT_DATA (cont);
 
-      frame = scm_c_make_frame (cont,
+      frame = scm_c_make_frame (SCM_VM_FRAME_KIND_CONT, cont,
                                 (c->fp + c->reloc) - c->stack_base,
                                 (c->sp + c->reloc) - c->stack_base,
                                 c->ra);

diff --git a/libguile/vm.c b/libguile/vm.c
index 65e822b..afb5c42 100644 (file)
--- a/libguile/vm.c
+++ b/libguile/vm.c
@@ -211,7 +211,7 @@ vm_dispatch_hook (SCM vm, int hook_num, SCM *argv, int n)
   frame = alloca (sizeof (*frame) + 8);
   frame = (scm_t_cell *) ROUND_UP ((scm_t_uintptr) frame, 8UL);
 
-  frame->word_0 = SCM_PACK (scm_tc7_frame);
+  frame->word_0 = SCM_PACK (scm_tc7_frame | (SCM_VM_FRAME_KIND_VM << 8));
   frame->word_1 = SCM_PACK_POINTER (&c_frame);
 
   if (n == 0)