Give continuations (contregs) their own static tc16

* libguile/continuations-internal.h: New file, for internal definitions.
* libguile/continuations.h: Move out internal definitions.
* libguile/Makefile.am: Add new file.
* libguile/continuations.c: Adapt to put the tag in the beginning of the
continuation (contregs) structure.
* libguile/eq.c:
* libguile/goops.c:
* libguile/init.c:
* libguile/print.c:
* libguile/scm.h:
* libguile/stacks.c:
* libguile/vm.c:
* module/oop/goops.scm: Adapt to contregs tc16 change.

libguile/Makefile.am

@@ -525,6 +525,7 @@ noinst_HEADERS = custom-ports.h					\
                  arrays-internal.h				\
                  bytevectors-internal.h				\
                  cache-internal.h				\
+                 continuations-internal.h			\
                  gc-inline.h					\
                  gc-internal.h					\
                  gsubr-internal.h				\

libguile/continuations-internal.h

@@ -0,0 +1,108 @@
+#ifndef SCM_CONTINUATIONS_INTERNAL_H
+#define SCM_CONTINUATIONS_INTERNAL_H
+
+/* Copyright 1995-1996,2000-2001,2006,2008-2010,2012-2014,2018,2025
+     Free Software Foundation, Inc.
+
+   This file is part of Guile.
+
+   Guile is free software: you can redistribute it and/or modify it
+   under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   Guile is distributed in the hope that it will be useful, but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+   License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with Guile.  If not, see
+   <https://www.gnu.org/licenses/>.  */
+
+
+
+#ifndef _WIN64
+#include <setjmp.h>
+#else
+#include "libguile/setjump-win.h"
+#endif
+
+#include "libguile/gc.h"
+#include "libguile/scm.h"
+#include "libguile/throw.h"
+
+
+
+struct scm_vm_cont;
+
+struct scm_continuation
+{
+  scm_t_bits tag;
+  jmp_buf jmpbuf;
+#if SCM_HAVE_AUXILIARY_STACK
+  void *auxiliary_stack;
+  unsigned long auxiliary_stack_size;
+#endif
+  SCM root;                 /* continuation root identifier.  */
+  struct scm_vm_cont *vm_cont; /* vm's stack and regs */
+
+  /* The offset from the live stack location to this copy.  This is
+     used to adjust pointers from within the copied stack to the stack
+     itself.
+
+     Thus, when you read a pointer from the copied stack that points
+     into the live stack, you need to add OFFSET so that it points
+     into the copy.
+  */
+  ptrdiff_t offset;
+
+  size_t num_stack_items;   /* size of the saved stack.  */
+  SCM_STACKITEM stack[];    /* copied stack of size num_stack_items.  */ 
+};
+
+static inline int
+scm_is_continuation (SCM c)
+{
+  return SCM_HAS_TYP16 (c, scm_tc16_continuation);
+}
+
+static inline struct scm_continuation*
+scm_to_continuation (SCM c)
+{
+  if (!scm_is_continuation (c))
+    abort ();
+
+  return (struct scm_continuation*) SCM_UNPACK_POINTER (c);
+}
+
+static inline SCM
+scm_from_continuation (struct scm_continuation* c)
+{
+  return SCM_PACK_POINTER (c);
+}
+
+
+
+
+SCM_INTERNAL SCM
+scm_i_make_continuation (scm_thread *thread, struct scm_vm_cont *vm_cont);
+SCM_INTERNAL void scm_i_reinstate_continuation (struct scm_continuation *cont,
+                                                uint8_t *mra) SCM_NORETURN;
+
+SCM_INTERNAL int scm_i_continuation_to_frame (SCM cont,
+                                              struct scm_frame *frame);
+SCM_INTERNAL int scm_i_print_continuation (SCM cont, SCM port,
+                                           scm_print_state *state);
+
+SCM_INTERNAL SCM
+scm_i_with_continuation_barrier (scm_t_catch_body body,
+				 void *body_data,
+				 scm_t_catch_handler handler,
+				 void *handler_data,
+				 scm_t_catch_handler pre_unwind_handler,
+				 void *pre_unwind_handler_data);
+
+SCM_INTERNAL void scm_init_continuations (void);
+
+#endif  /* SCM_CONTINUATIONS_INTERNAL_H */

libguile/continuations.c

@@ -53,23 +53,9 @@
 #include "symbols.h"
 #include "vm.h"
 
-#include "continuations.h"
+#include "continuations-internal.h"
 
 
-
-
-static scm_t_bits tc16_continuation;
-#define SCM_CONTREGSP(x)	SCM_TYP16_PREDICATE (tc16_continuation, x)
-
-#define SCM_CONTREGS(x)		((scm_t_contregs *) SCM_SMOB_DATA_1 (x))
-
-#define SCM_CONTINUATION_LENGTH(x) (SCM_CONTREGS (x)->num_stack_items)
-#define SCM_SET_CONTINUATION_LENGTH(x, n)\
-   (SCM_CONTREGS (x)->num_stack_items = (n))
-#define SCM_JMPBUF(x)		 ((SCM_CONTREGS (x))->jmpbuf)
-#define SCM_CONTINUATION_ROOT(x) ((SCM_CONTREGS (x))->root)   
-#define SCM_DFRAME(x)		 ((SCM_CONTREGS (x))->dframe)
-
 
 
 /* scm_i_make_continuation will return a procedure whose code will
@@ -98,7 +84,7 @@ struct goto_continuation_code goto_continuation_code = {
 };
 
 static SCM
-make_continuation_trampoline (SCM contregs)
+make_continuation_trampoline (struct scm_continuation *cont)
 {
   scm_t_bits nfree = 1;
   scm_t_bits flags = SCM_F_PROGRAM_IS_CONTINUATION;
@@ -109,7 +95,7 @@ make_continuation_trampoline (SCM contregs)
                    "foreign procedure");
   ret->tag_flags_and_free_variable_count = tag;
   ret->code = goto_continuation_code.code;
-  ret->free_variables[0] = contregs;
+  ret->free_variables[0] = scm_from_continuation (cont);
 
   return scm_from_program (ret);
 }
@@ -119,10 +105,10 @@ make_continuation_trampoline (SCM contregs)
  */
 
 
-static int
+int
-continuation_print (SCM obj, SCM port, scm_print_state *state SCM_UNUSED)
+scm_i_print_continuation (SCM obj, SCM port, scm_print_state *state SCM_UNUSED)
 {
-  scm_t_contregs *continuation = SCM_CONTREGS (obj);
+  struct scm_continuation *continuation = scm_to_continuation (obj);
 
   scm_puts ("#<continuation ", port);
   scm_intprint (continuation->num_stack_items, 10, port);
@@ -144,7 +130,7 @@ continuation_print (SCM obj, SCM port, scm_print_state *state SCM_UNUSED)
 #endif
 
 static void
-capture_auxiliary_stack (scm_thread *thread, scm_t_contregs *continuation)
+capture_auxiliary_stack (scm_thread *thread, struct scm_continuation *continuation)
 {
 #if SCM_HAVE_AUXILIARY_STACK
 # if !defined __ia64 || !defined __ia64__
@@ -178,7 +164,7 @@ capture_auxiliary_stack (scm_thread *thread, scm_t_contregs *continuation)
 }
 
 static void
-restore_auxiliary_stack (scm_thread *thread, scm_t_contregs *continuation)
+restore_auxiliary_stack (scm_thread *thread, struct scm_continuation *continuation)
 {
 #if SCM_HAVE_AUXILIARY_STACK
   memcpy (thread->auxiliary_stack_base, continuation->auxiliary_stack,
@@ -189,42 +175,37 @@ restore_auxiliary_stack (scm_thread *thread, scm_t_contregs *continuation)
 SCM 
 scm_i_make_continuation (scm_thread *thread, struct scm_vm_cont *vm_cont)
 {
-  SCM cont;
-  scm_t_contregs *continuation;
-  long stack_size;
-  SCM_STACKITEM * src;
-
   SCM_FLUSH_REGISTER_WINDOWS;
-  stack_size = scm_stack_size (thread->continuation_base);
+  long stack_size = scm_stack_size (thread->continuation_base);
-  continuation = scm_gc_malloc (sizeof (scm_t_contregs)
+  struct scm_continuation *continuation =
-				+ (stack_size - 1) * sizeof (SCM_STACKITEM),
+    scm_gc_malloc (sizeof (struct scm_continuation)
-				"continuation");
+                   + stack_size * sizeof (SCM_STACKITEM),
-  continuation->num_stack_items = stack_size;
+                   "continuation");
+  continuation->tag = scm_tc16_continuation;
+  memcpy (continuation->jmpbuf, thread->vm.registers, sizeof (jmp_buf));
+  capture_auxiliary_stack (thread, continuation);
   continuation->root = thread->continuation_root;
-  src = thread->continuation_base;
+  continuation->vm_cont = vm_cont;
+  SCM_STACKITEM * src = thread->continuation_base;
 #if ! SCM_STACK_GROWS_UP
   src -= stack_size;
 #endif
-  continuation->offset = continuation->stack - src;
   memcpy (continuation->stack, src, sizeof (SCM_STACKITEM) * stack_size);
-  memcpy (continuation->jmpbuf, thread->vm.registers, sizeof (jmp_buf));
+  continuation->offset = continuation->stack - src;
-  continuation->vm_cont = vm_cont;
+  continuation->num_stack_items = stack_size;
-  capture_auxiliary_stack (thread, continuation);
 
-  SCM_NEWSMOB (cont, tc16_continuation, continuation);
+  return make_continuation_trampoline (continuation);
-
-  return make_continuation_trampoline (cont);
 }
 
 int
 scm_i_continuation_to_frame (SCM continuation, struct scm_frame *frame)
 {
   SCM contregs;
-  scm_t_contregs *cont;
+  struct scm_continuation *cont;
 
   struct scm_program *program = scm_to_program (continuation);
   contregs = scm_program_free_variable_ref (program, 0);
-  cont = SCM_CONTREGS (contregs);
+  cont = scm_to_continuation (contregs);
 
   if (cont->vm_cont)
     {
@@ -241,16 +222,6 @@ scm_i_continuation_to_frame (SCM continuation, struct scm_frame *frame)
     return 0;
 }
 
-scm_t_contregs *
-scm_i_contregs (SCM contregs)
-{
-  if (!SCM_CONTREGSP (contregs))
-    abort ();
-
-  return SCM_CONTREGS (contregs);
-}
-
-
 /* {Apply}
  */
 
@@ -266,7 +237,7 @@ scm_i_contregs (SCM contregs)
  * with their correct stack.
  */
 
-static void scm_dynthrow (SCM, uint8_t *);
+static void scm_dynthrow (struct scm_continuation *, uint8_t *);
 
 /* Grow the stack by a fixed amount to provide space to copy in the
  * continuation.  Possibly this function has to be called several times
@@ -278,7 +249,7 @@ static void scm_dynthrow (SCM, uint8_t *);
 static scm_t_bits scm_i_dummy;
 
 static void 
-grow_stack (SCM cont, uint8_t *mra)
+grow_stack (struct scm_continuation *cont, uint8_t *mra)
 {
   scm_t_bits growth[100];
 
@@ -293,7 +264,7 @@ grow_stack (SCM cont, uint8_t *mra)
  */
 
 static void
-copy_stack_and_call (scm_t_contregs *continuation,
+copy_stack_and_call (struct scm_continuation *continuation,
 		     SCM_STACKITEM * dst, uint8_t *mra)
 {
   scm_t_dynstack *dynstack;
@@ -319,10 +290,9 @@ copy_stack_and_call (scm_t_contregs *continuation,
  * actual copying and continuation calling.
  */
 static void 
-scm_dynthrow (SCM cont, uint8_t *mra)
+scm_dynthrow (struct scm_continuation *continuation, uint8_t *mra)
 {
   scm_thread *thread = SCM_I_CURRENT_THREAD;
-  scm_t_contregs *continuation = SCM_CONTREGS (cont);
   SCM_STACKITEM *dst = thread->continuation_base;
   SCM_STACKITEM stack_top_element;
 
@@ -332,7 +302,7 @@ scm_dynthrow (SCM cont, uint8_t *mra)
 #else
   dst -= continuation->num_stack_items;
   if (dst <= &stack_top_element)
-    grow_stack (cont, mra);
+    grow_stack (continuation, mra);
 #endif /* def SCM_STACK_GROWS_UP */
 
   SCM_FLUSH_REGISTER_WINDOWS;
@@ -340,7 +310,7 @@ scm_dynthrow (SCM cont, uint8_t *mra)
 }
 
 void
-scm_i_reinstate_continuation (SCM cont, uint8_t *mra)
+scm_i_reinstate_continuation (struct scm_continuation *cont, uint8_t *mra)
 {
   scm_dynthrow (cont, mra);
   abort (); /* Unreachable.  */
@@ -521,7 +491,5 @@ SCM_DEFINE (scm_with_continuation_barrier, "with-continuation-barrier", 1,0,0,
 void
 scm_init_continuations ()
 {
-  tc16_continuation = scm_make_smob_type ("continuation", 0);
-  scm_set_smob_print (tc16_continuation, continuation_print);
 #include "continuations.x"
 }

libguile/continuations.h

@@ -22,74 +22,11 @@
 
 
 
-#ifndef _WIN64
+#include "libguile/scm.h"
-#include <setjmp.h>
-#else
-#include "libguile/setjump-win.h"
-#endif
-
-#include "libguile/throw.h"
 
 
 
-/* a continuation SCM is a non-immediate pointing to a heap cell with:
-   word 0: bits 0-15: smob type tag: scm_tc16_continuation.
-           bits 16-31: unused.
-   word 1: malloc block containing an scm_t_contregs structure with a
-           tail array of SCM_STACKITEM.  the size of the array is stored
-	   in the num_stack_items field of the structure.
-*/
-
-struct scm_vm_cont;
-
-typedef struct 
-{
-  jmp_buf jmpbuf;
-#if SCM_HAVE_AUXILIARY_STACK
-  void *auxiliary_stack;
-  unsigned long auxiliary_stack_size;
-#endif
-  size_t num_stack_items;   /* size of the saved stack.  */
-  SCM root;                 /* continuation root identifier.  */
-  struct scm_vm_cont *vm_cont; /* vm's stack and regs */
-
-  /* The offset from the live stack location to this copy.  This is
-     used to adjust pointers from within the copied stack to the stack
-     itself.
-
-     Thus, when you read a pointer from the copied stack that points
-     into the live stack, you need to add OFFSET so that it points
-     into the copy.
-  */
-  ptrdiff_t offset;
-
-  SCM_STACKITEM stack[1];    /* copied stack of size num_stack_items.  */ 
-} scm_t_contregs;
-
-
-
-
-SCM_INTERNAL SCM scm_i_make_continuation (scm_thread *thread,
-                                          struct scm_vm_cont *vm_cont);
-SCM_INTERNAL void scm_i_reinstate_continuation (SCM cont,
-                                                uint8_t *mra) SCM_NORETURN;
-
-SCM_INTERNAL int scm_i_continuation_to_frame (SCM cont,
-                                              struct scm_frame *frame);
-
-SCM_INTERNAL scm_t_contregs* scm_i_contregs (SCM contregs);
-
 SCM_API void *scm_c_with_continuation_barrier (void *(*func)(void*), void *);
 SCM_API SCM scm_with_continuation_barrier (SCM proc);
 
-SCM_INTERNAL SCM
-scm_i_with_continuation_barrier (scm_t_catch_body body,
-				 void *body_data,
-				 scm_t_catch_handler handler,
-				 void *handler_data,
-				 scm_t_catch_handler pre_unwind_handler,
-				 void *pre_unwind_handler_data);
-
-SCM_INTERNAL void scm_init_continuations (void);
-
 #endif  /* SCM_CONTINUATIONS_H */

libguile/eq.c

@@ -390,6 +390,7 @@ scm_equal_p (SCM x, SCM y)
           return scm_from_bool (scm_i_char_sets_equal (x, y));
         case scm_tc16_condition_variable:
         case scm_tc16_mutex:
+        case scm_tc16_continuation:
           return SCM_BOOL_F;
         default:
           abort ();

libguile/goops.c

@@ -141,6 +141,7 @@ static SCM class_ephemeron_table;
 static SCM class_character_set;
 static SCM class_condition_variable;
 static SCM class_mutex;
+static SCM class_continuation;
 
 static struct scm_ephemeron_table *vtable_class_map;
 static SCM pre_goops_vtables = SCM_EOL;
@@ -351,6 +352,8 @@ SCM_DEFINE (scm_class_of, "class-of", 1, 0, 0,
                 return class_condition_variable;
               case scm_tc16_mutex:
                 return class_mutex;
+              case scm_tc16_continuation:
+                return class_continuation;
               default:
                 abort ();
               }
@@ -988,6 +991,7 @@ SCM_DEFINE (scm_sys_goops_early_init, "%goops-early-init", 0, 0, 0,
   class_character_set = scm_variable_ref (scm_c_lookup ("<character-set>"));
   class_condition_variable = scm_variable_ref (scm_c_lookup ("<condition-variable>"));
   class_mutex = scm_variable_ref (scm_c_lookup ("<mutex>"));
+  class_continuation = scm_variable_ref (scm_c_lookup ("<continuation>"));
 
   create_smob_classes ();
   create_struct_classes ();

libguile/init.c

@@ -49,7 +49,7 @@
 #include "boolean.h"
 #include "bytevectors-internal.h"
 #include "chars.h"
-#include "continuations.h"
+#include "continuations-internal.h"
 #include "control.h"
 #include "custom-ports.h"
 #include "debug.h"

libguile/print.c

@@ -37,7 +37,7 @@
 #include "bytevectors-internal.h"
 #include "boolean.h"
 #include "chars.h"
-#include "continuations.h"
+#include "continuations-internal.h"
 #include "control.h"
 #include "ephemerons.h"
 #include "eval.h"
@@ -798,6 +798,9 @@ iprin1 (SCM exp, SCM port, scm_print_state *pstate)
               case scm_tc16_mutex:
                 scm_i_print_mutex (exp, port, pstate);
                 break;
+              case scm_tc16_continuation:
+                scm_i_print_continuation (exp, port, pstate);
+                break;
               default:
                 abort ();
             }

libguile/scm.h

@@ -511,8 +511,8 @@ typedef uintptr_t scm_t_bits;
 #define scm_tc16_charset		0x007f
 #define scm_tc16_condition_variable	0x017f
 #define scm_tc16_mutex			0x027f
+#define scm_tc16_continuation		0x037f
 /*
-#define scm_tc16_continuation		0x067f
 #define scm_tc16_directory		0x077f
 #define scm_tc16_hook			0x097f
 #define scm_tc16_macro			0x0a7f

libguile/stacks.c

@@ -25,7 +25,7 @@
 #endif
 
 #include "boolean.h"
-#include "continuations.h"
+#include "continuations-internal.h"
 #include "control.h"
 #include "debug.h"
 #include "eval.h"

libguile/vm.c

@@ -40,7 +40,7 @@
 #include "atomic.h"
 #include "atomics-internal.h"
 #include "cache-internal.h"
-#include "continuations.h"
+#include "continuations-internal.h"
 #include "control.h"
 #include "dynwind.h"
 #include "eval.h"
@@ -1080,7 +1080,7 @@ static void reinstate_continuation_x (scm_thread *thread, SCM cont) SCM_NORETURN
 static void
 reinstate_continuation_x (scm_thread *thread, SCM cont)
 {
-  scm_t_contregs *continuation = scm_i_contregs (cont);
+  struct scm_continuation *continuation = scm_to_continuation (cont);
   struct scm_vm *vp = &thread->vm;
   struct scm_vm_cont *cp;
   size_t n, i, frame_overhead = 3;
@@ -1120,7 +1120,7 @@ reinstate_continuation_x (scm_thread *thread, SCM cont)
 
   vp->ip = cp->vra;
 
-  scm_i_reinstate_continuation (cont, cp->mra);
+  scm_i_reinstate_continuation (continuation, cp->mra);
 }
 
 static SCM

module/oop/goops.scm

@@ -71,7 +71,7 @@
             <fluid> <dynamic-state> <frame> <vm> <vm-continuation>
             <keyword> <syntax> <atomic-box> <thread> <bitvector>
             <finalizer> <ephemeron> <ephemeron-table> <character-set>
-            <mutex> <condition-variable>
+            <mutex> <condition-variable> <continuation>
 
             ;; Numbers.
             <number> <complex> <real> <integer> <fraction>
@@ -1086,6 +1086,7 @@ slots as we go."
 (define-standard-class <character-set> (<top>))
 (define-standard-class <condition-variable> (<top>))
 (define-standard-class <mutex> (<top>))
+(define-standard-class <continuation> (<top>))
 (define-standard-class <thread> (<top>))
 (define-standard-class <number> (<top>))
 (define-standard-class <complex> (<number>))