wingo pushed a commit to branch wip-whippet
in repository guile.
commit 12da6739b18b889904c8da6786ab5e88d86fe9af
Author: Andy Wingo <wi...@pobox.com>
AuthorDate: Fri Jun 13 13:13:02 2025 +0200
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 | 1 +
.../{continuations.h => continuations-internal.h} | 59 ++++++++------
libguile/continuations.c | 90 +++++++---------------
libguile/continuations.h | 65 +---------------
libguile/eq.c | 1 +
libguile/goops.c | 4 +
libguile/init.c | 2 +-
libguile/print.c | 5 +-
libguile/scm.h | 2 +-
libguile/stacks.c | 2 +-
libguile/vm.c | 6 +-
module/oop/goops.scm | 3 +-
12 files changed, 84 insertions(+), 156 deletions(-)
diff --git a/libguile/Makefile.am b/libguile/Makefile.am
index 3c4d472a9..7a4d4a347 100644
--- a/libguile/Makefile.am
+++ b/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 \
diff --git a/libguile/continuations.h b/libguile/continuations-internal.h
similarity index 68%
copy from libguile/continuations.h
copy to libguile/continuations-internal.h
index 298b1d032..d16b664e9 100644
--- a/libguile/continuations.h
+++ b/libguile/continuations-internal.h
@@ -1,5 +1,5 @@
-#ifndef SCM_CONTINUATIONS_H
-#define SCM_CONTINUATIONS_H
+#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.
@@ -28,28 +28,22 @@
#include "libguile/setjump-win.h"
#endif
+#include "libguile/gc.h"
+#include "libguile/scm.h"
#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
+struct scm_continuation
{
+ scm_t_bits tag;
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 */
@@ -63,24 +57,43 @@ typedef struct
*/
ptrdiff_t offset;
- SCM_STACKITEM stack[1]; /* copied stack of size num_stack_items. */
-} scm_t_contregs;
+ 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 (SCM cont,
+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 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 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,
@@ -92,4 +105,4 @@ scm_i_with_continuation_barrier (scm_t_catch_body body,
SCM_INTERNAL void scm_init_continuations (void);
-#endif /* SCM_CONTINUATIONS_H */
+#endif /* SCM_CONTINUATIONS_INTERNAL_H */
diff --git a/libguile/continuations.c b/libguile/continuations.c
index 847d6bf70..2ea7d29fb 100644
--- a/libguile/continuations.c
+++ b/libguile/continuations.c
@@ -53,25 +53,11 @@
#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
reinstate the continuation. Here, as in gsubr.c, we define the form
of that trampoline function.
@@ -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
-continuation_print (SCM obj, SCM port, scm_print_state *state SCM_UNUSED)
+int
+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);
- continuation = scm_gc_malloc (sizeof (scm_t_contregs)
- + (stack_size - 1) * sizeof (SCM_STACKITEM),
- "continuation");
- continuation->num_stack_items = stack_size;
+ long stack_size = scm_stack_size (thread->continuation_base);
+ struct scm_continuation *continuation =
+ scm_gc_malloc (sizeof (struct scm_continuation)
+ + stack_size * sizeof (SCM_STACKITEM),
+ "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->vm_cont = vm_cont;
- capture_auxiliary_stack (thread, continuation);
-
- SCM_NEWSMOB (cont, tc16_continuation, continuation);
+ continuation->offset = continuation->stack - src;
+ continuation->num_stack_items = stack_size;
- return make_continuation_trampoline (cont);
+ return make_continuation_trampoline (continuation);
}
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"
}
diff --git a/libguile/continuations.h b/libguile/continuations.h
index 298b1d032..94aa9fecc 100644
--- a/libguile/continuations.h
+++ b/libguile/continuations.h
@@ -22,74 +22,11 @@
-#ifndef _WIN64
-#include <setjmp.h>
-#else
-#include "libguile/setjump-win.h"
-#endif
-
-#include "libguile/throw.h"
+#include "libguile/scm.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 */
diff --git a/libguile/eq.c b/libguile/eq.c
index 813c86563..31be33b1e 100644
--- a/libguile/eq.c
+++ b/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 ();
diff --git a/libguile/goops.c b/libguile/goops.c
index b07180f39..a6b2ce490 100644
--- a/libguile/goops.c
+++ b/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 ();
diff --git a/libguile/init.c b/libguile/init.c
index 38712b647..e46b39638 100644
--- a/libguile/init.c
+++ b/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"
diff --git a/libguile/print.c b/libguile/print.c
index 40d35adb6..55ccb00e5 100644
--- a/libguile/print.c
+++ b/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 ();
}
diff --git a/libguile/scm.h b/libguile/scm.h
index 1b3533a6d..d5b2b402b 100644
--- a/libguile/scm.h
+++ b/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
diff --git a/libguile/stacks.c b/libguile/stacks.c
index be4f5873d..0800b0a2d 100644
--- a/libguile/stacks.c
+++ b/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"
diff --git a/libguile/vm.c b/libguile/vm.c
index 603e8fb98..0450256da 100644
--- a/libguile/vm.c
+++ b/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
diff --git a/module/oop/goops.scm b/module/oop/goops.scm
index b2f37064b..9ad565a19 100644
--- a/module/oop/goops.scm
+++ b/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>))
