mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-07-02 23:50:47 +02:00
Code Activity

Give continuations (contregs) their own static tc16

Browse source 
* 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.
This commit is contained in:
Andy Wingo 2025-06-13 13:13:02 +02:00
parent f47fe6e752
commit 12da6739b1
12 changed files with 156 additions and 133 deletions
Download patch file Download diff file Expand all files Collapse all files

1
libguile/Makefile.am
View file

@ -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 \

108
libguile/continuations-internal.h Normal file
View file

@ -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 */

90
libguile/continuations.c
View file

@ -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
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);
continuation->offset = continuation->stack - src;
continuation->num_stack_items = stack_size;
SCM_NEWSMOB (cont, tc16_continuation, continuation);
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"
}

65
libguile/continuations.h
View file

@ -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 */

1
libguile/eq.c
View file

@ -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 ();

4
libguile/goops.c
View file

@ -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 ();

2
libguile/init.c
View file

@ -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"

5
libguile/print.c
View file

@ -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 ();
}

2
libguile/scm.h
View file

@ -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

2
libguile/stacks.c
View file

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

6
libguile/vm.c
View file

@ -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