Inline "struct scm_frame" into tagged frame objects

This avoids an indirection and will make the tracer's job easier.

* libguile/frames.h (struct scm_vm_frame): New data type.
(scm_is_vm_frame):
(scm_vm_frame):
(scm_vm_frame_kind):
(scm_vm_frame_fp):
(scm_vm_frame_sp):
(scm_vm_frame_ip):
(scm_frame_init_from_vm_frame): New helpers.

* libguile/frames.c:
* libguile/stacks.c:
* libguile/stacks.h:
* libguile/vm.c: Update all users of SCM_VM_FRAME_* macros to use new
helpers.

libguile/frames.c

@@ -93,13 +93,10 @@ frame_stack_top (enum scm_vm_frame_kind kind, const struct scm_frame *frame)
 }
 
 union scm_vm_stack_element*
-scm_i_frame_stack_top (SCM frame)
+scm_vm_frame_stack_top (struct scm_vm_frame *frame)
 #define FUNC_NAME "frame-stack-top"
 {
-  SCM_VALIDATE_VM_FRAME (1, frame);
+  return frame_stack_top (scm_vm_frame_kind (frame), &frame->frame);
-
-  return frame_stack_top (SCM_VM_FRAME_KIND (frame),
-                          SCM_VM_FRAME_DATA (frame));
 }
 #undef FUNC_NAME
 
@@ -111,7 +108,7 @@ SCM_DEFINE (scm_frame_p, "frame?", 1, 0, 0,
 	    "")
 #define FUNC_NAME s_scm_frame_p
 {
-  return scm_from_bool (SCM_VM_FRAME_P (obj));
+  return scm_from_bool (scm_is_vm_frame (obj));
 }
 #undef FUNC_NAME
 
@@ -218,9 +215,10 @@ scm_frame_num_locals (SCM frame)
   union scm_vm_stack_element *fp, *sp;
 
   SCM_VALIDATE_VM_FRAME (1, frame);
+  struct scm_vm_frame *f = scm_vm_frame (frame);
 
-  fp = SCM_VM_FRAME_FP (frame);
+  fp = scm_vm_frame_fp (f);
-  sp = SCM_VM_FRAME_SP (frame);
+  sp = scm_vm_frame_sp (f);
 
   return scm_from_ptrdiff_t (SCM_FRAME_NUM_LOCALS (fp, sp));
 }
@@ -263,11 +261,12 @@ scm_frame_local_ref (SCM frame, SCM index, SCM representation)
   enum stack_item_representation repr;
 
   SCM_VALIDATE_VM_FRAME (1, frame);
+  struct scm_vm_frame *f = scm_vm_frame (frame);
   SCM_VALIDATE_UINT_COPY (2, index, i);
   repr = scm_to_stack_item_representation (representation, FUNC_NAME, SCM_ARG3);
 
-  fp = SCM_VM_FRAME_FP (frame);
+  fp = scm_vm_frame_fp (f);
-  sp = SCM_VM_FRAME_SP (frame);
+  sp = scm_vm_frame_sp (f);
 
   if (i < SCM_FRAME_NUM_LOCALS (fp, sp))
     {
@@ -306,8 +305,9 @@ scm_frame_local_set_x (SCM frame, SCM index, SCM val, SCM representation)
   SCM_VALIDATE_UINT_COPY (2, index, i);
   repr = scm_to_stack_item_representation (representation, FUNC_NAME, SCM_ARG3);
 
-  fp = SCM_VM_FRAME_FP (frame);
+  struct scm_vm_frame *f = scm_vm_frame (frame);
-  sp = SCM_VM_FRAME_SP (frame);
+  fp = scm_vm_frame_fp (f);
+  sp = scm_vm_frame_sp (f);
 
   if (i < SCM_FRAME_NUM_LOCALS (fp, sp))
     {
@@ -349,10 +349,11 @@ scm_frame_return_values (SCM frame)
   size_t n;
 
   SCM_VALIDATE_VM_FRAME (1, frame);
+  struct scm_vm_frame *f = scm_vm_frame (frame);
 
-  ip = SCM_VM_FRAME_IP (frame);
+  ip = scm_vm_frame_ip (f);
-  fp = SCM_VM_FRAME_FP (frame);
+  fp = scm_vm_frame_fp (f);
-  sp = SCM_VM_FRAME_SP (frame);
+  sp = scm_vm_frame_sp (f);
 
   if ((*ip & 0xff) != scm_op_return_values)
     scm_wrong_type_arg_msg (FUNC_NAME, 1, frame, "not a return frame");
@@ -371,7 +372,7 @@ SCM_DEFINE (scm_frame_address, "frame-address", 1, 0, 0,
 #define FUNC_NAME s_scm_frame_address
 {
   SCM_VALIDATE_VM_FRAME (1, frame);
-  return scm_from_ptrdiff_t (SCM_VM_FRAME_FP_OFFSET (frame));
+  return scm_from_ptrdiff_t (scm_vm_frame (frame)->frame.fp_offset);
 }
 #undef FUNC_NAME
 
@@ -382,7 +383,7 @@ SCM_DEFINE (scm_frame_stack_pointer, "frame-stack-pointer", 1, 0, 0,
 {
   SCM_VALIDATE_VM_FRAME (1, frame);
 
-  return scm_from_ptrdiff_t (SCM_VM_FRAME_SP_OFFSET (frame));
+  return scm_from_ptrdiff_t (scm_vm_frame (frame)->frame.sp_offset);
 }
 #undef FUNC_NAME
 
@@ -393,7 +394,7 @@ SCM_DEFINE (scm_frame_instruction_pointer, "frame-instruction-pointer", 1, 0, 0,
 {
   SCM_VALIDATE_VM_FRAME (1, frame);
 
-  return scm_from_uintptr_t ((uintptr_t) SCM_VM_FRAME_IP (frame));
+  return scm_from_uintptr_t ((uintptr_t) scm_vm_frame (frame)->frame.ip);
 }
 #undef FUNC_NAME
 
@@ -403,8 +404,9 @@ SCM_DEFINE (scm_frame_return_address, "frame-return-address", 1, 0, 0,
 #define FUNC_NAME s_scm_frame_return_address
 {
   SCM_VALIDATE_VM_FRAME (1, frame);
+  struct scm_vm_frame *f = scm_vm_frame (frame);
   return scm_from_uintptr_t ((uintptr_t) (SCM_FRAME_VIRTUAL_RETURN_ADDRESS
-                                          (SCM_VM_FRAME_FP (frame))));
+                                          (scm_vm_frame_fp (f))));
 }
 #undef FUNC_NAME
 
@@ -417,7 +419,7 @@ SCM_DEFINE (scm_frame_dynamic_link, "frame-dynamic-link", 1, 0, 0,
   /* fixme: munge fp if holder is a continuation */
   return scm_from_uintptr_t
     ((uintptr_t)
-     SCM_FRAME_DYNAMIC_LINK (SCM_VM_FRAME_FP (frame)));
+     SCM_FRAME_DYNAMIC_LINK (scm_vm_frame_fp (scm_vm_frame (frame))));
 }
 #undef FUNC_NAME
 
@@ -454,15 +456,14 @@ SCM_DEFINE (scm_frame_previous, "frame-previous", 1, 0, 0,
 	    "")
 #define FUNC_NAME s_scm_frame_previous
 {
-  enum scm_vm_frame_kind kind;
-  struct scm_frame tmp;
-
   SCM_VALIDATE_VM_FRAME (1, frame);
 
-  kind = SCM_VM_FRAME_KIND (frame);
+  struct scm_vm_frame *vm_frame = scm_vm_frame (frame);
-  memcpy (&tmp, SCM_VM_FRAME_DATA (frame), sizeof tmp);
+  enum scm_vm_frame_kind kind = scm_vm_frame_kind (vm_frame);
+  struct scm_frame tmp;
+  scm_frame_init_from_vm_frame (&tmp, vm_frame);
 
-  if (!scm_c_frame_previous (SCM_VM_FRAME_KIND (frame), &tmp))
+  if (!scm_c_frame_previous (kind, &tmp))
     return SCM_BOOL_F;
 
   return scm_c_make_frame (kind, &tmp);

libguile/frames.h

@@ -1,4 +1,4 @@
-/* Copyright 2001,2009-2015,2018
+/* Copyright 2001,2009-2015,2018,2025
      Free Software Foundation, Inc.
 
    This file is part of Guile.
@@ -20,6 +20,8 @@
 #ifndef _SCM_FRAMES_H_
 #define _SCM_FRAMES_H_
 
+#include <string.h>
+
 #include <libguile/gc.h>
 #include "programs.h"
 
@@ -127,24 +129,61 @@ struct scm_frame
   uint32_t *ip;
 };
 
-enum scm_vm_frame_kind
+struct scm_vm_frame
-  {
+{
-    SCM_VM_FRAME_KIND_VM,
+  scm_t_bits tag_and_flags;
-    SCM_VM_FRAME_KIND_CONT
+  struct scm_frame frame;
-  };
+};
 
-#define SCM_VM_FRAME_P(x)	(SCM_HAS_TYP7 (x, scm_tc7_frame))
+enum scm_vm_frame_kind
-#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))
+  SCM_VM_FRAME_KIND_VM,
-#define SCM_VM_FRAME_STACK_HOLDER(f)	SCM_VM_FRAME_DATA (f)->stack_holder
+  SCM_VM_FRAME_KIND_CONT
-#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_i_frame_stack_top (f) - SCM_VM_FRAME_FP_OFFSET (f))
+static inline int
-#define SCM_VM_FRAME_SP(f)	(scm_i_frame_stack_top (f) - SCM_VM_FRAME_SP_OFFSET (f))
+scm_is_vm_frame (SCM x)
-#define SCM_VM_FRAME_IP(f)	SCM_VM_FRAME_DATA (f)->ip
+{
+  return SCM_HAS_TYP7 (x, scm_tc7_frame);
+}
+
+#define SCM_VM_FRAME_P(x)		(scm_is_vm_frame (x))
 #define SCM_VALIDATE_VM_FRAME(p,x)	SCM_MAKE_VALIDATE (p, x, VM_FRAME_P)
 
-SCM_INTERNAL union scm_vm_stack_element* scm_i_frame_stack_top (SCM frame);
+static inline struct scm_vm_frame*
+scm_vm_frame (SCM x)
+{
+  if (!scm_is_vm_frame (x))
+    abort ();
+  return (struct scm_vm_frame *) SCM_UNPACK_POINTER (x);
+}
+
+static inline enum scm_vm_frame_kind
+scm_vm_frame_kind (struct scm_vm_frame *frame)
+{
+  return (enum scm_vm_frame_kind) (frame->tag_and_flags >> 8);
+}
+
+SCM_INTERNAL union scm_vm_stack_element*
+scm_vm_frame_stack_top (struct scm_vm_frame *frame);
+
+static inline union scm_vm_stack_element*
+scm_vm_frame_fp (struct scm_vm_frame *frame)
+{
+  return scm_vm_frame_stack_top (frame) - frame->frame.fp_offset;
+}
+
+static inline union scm_vm_stack_element*
+scm_vm_frame_sp (struct scm_vm_frame *frame)
+{
+  return scm_vm_frame_stack_top (frame) - frame->frame.sp_offset;
+}
+
+static inline uint32_t*
+scm_vm_frame_ip (struct scm_vm_frame *frame)
+{
+  return frame->frame.ip;
+}
 
 /* See notes in frames.c before using this.  */
 SCM_INTERNAL SCM scm_c_frame_closure (enum scm_vm_frame_kind kind,
@@ -156,6 +195,13 @@ SCM_INTERNAL SCM scm_c_make_frame (enum scm_vm_frame_kind kind,
 SCM_INTERNAL int scm_c_frame_previous (enum scm_vm_frame_kind kind,
                                        struct scm_frame *frame);
 
+static inline void
+scm_frame_init_from_vm_frame (struct scm_frame *frame,
+                              const struct scm_vm_frame *vm_frame)
+{
+  memcpy (frame, &vm_frame->frame, sizeof (*frame));
+}
+
 #endif
 
 SCM_API SCM scm_frame_p (SCM obj);

libguile/stacks.c

@@ -333,8 +333,9 @@ SCM_DEFINE (scm_make_stack, "make-stack", 1, 0, 1,
     }
   else if (SCM_VM_FRAME_P (obj))
     {
-      kind = SCM_VM_FRAME_KIND (obj);
+      struct scm_vm_frame *f = scm_vm_frame (obj);
-      memcpy (&frame, SCM_VM_FRAME_DATA (obj), sizeof frame);
+      kind = scm_vm_frame_kind (f);
+      scm_frame_init_from_vm_frame (&frame, f);
     }
   else if (SCM_CONTINUATIONP (obj))
     /* FIXME: Narrowing to prompt tags should narrow with respect to the prompts

libguile/stacks.h

@@ -1,7 +1,7 @@
 #ifndef SCM_STACKS_H
 #define SCM_STACKS_H
 
-/* Copyright 1995-1996,2000-2001,2004,2006,2008,2018
+/* Copyright 1995-1996,2000-2001,2004,2006,2008,2018,2025
      Free Software Foundation, Inc.
 
    This file is part of Guile.
@@ -43,7 +43,7 @@ SCM_API SCM scm_stack_type;
 #define SCM_STACK_FRAME(obj) (SCM_STRUCT_SLOT_REF (obj,2))
 #define SCM_SET_STACK_FRAME(obj,f) (SCM_STRUCT_SLOT_SET (obj,2,f))
 
-#define SCM_FRAMEP(obj) (SCM_VM_FRAME_P (obj))
+#define SCM_FRAMEP(obj) (scm_is_vm_frame (obj))
 
 #define SCM_VALIDATE_STACK(pos, v) \
   SCM_MAKE_VALIDATE_MSG (pos, v, STACKP, "stack")

libguile/vm.c

@@ -276,8 +276,7 @@ static void
 invoke_hook (scm_thread *thread, SCM hook)
 {
   struct scm_vm *vp = &thread->vm;
-  struct scm_frame c_frame;
+  struct scm_vm_frame *frame;
-  scm_t_cell *frame;
   SCM scm_frame;
   int saved_trace_level;
   uint8_t saved_compare_result;
@@ -296,17 +295,14 @@ invoke_hook (scm_thread *thread, SCM hook)
      while the stack frame represented by the frame object is visible, so it
      seems reasonable to limit the lifetime of frame objects.  */
 
-  c_frame.stack_holder = vp;
-  c_frame.fp_offset = vp->stack_top - vp->fp;
-  c_frame.sp_offset = vp->stack_top - vp->sp;
-  c_frame.ip = vp->ip;
-
   /* Arrange for FRAME to be 8-byte aligned, like any other cell.  */
   frame = alloca (sizeof (*frame) + 8);
-  frame = (scm_t_cell *) ROUND_UP ((uintptr_t) frame, 8UL);
+  frame = (struct scm_vm_frame *) ROUND_UP ((uintptr_t) frame, 8UL);
-
+  frame->tag_and_flags = scm_tc7_frame | (SCM_VM_FRAME_KIND_VM << 8);
-  frame->word_0 = SCM_PACK (scm_tc7_frame | (SCM_VM_FRAME_KIND_VM << 8));
+  frame->frame.stack_holder = vp;
-  frame->word_1 = SCM_PACK_POINTER (&c_frame);
+  frame->frame.fp_offset = vp->stack_top - vp->fp;
+  frame->frame.sp_offset = vp->stack_top - vp->sp;
+  frame->frame.ip = vp->ip;
 
   scm_frame = SCM_PACK_POINTER (frame);
   scm_c_run_hookn (hook, &scm_frame, 1);