mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-07-03 08:10:31 +02:00
Code Activity

Move struct scm_thread definition to private header

Browse source 
Allows us to inline the "struct scm_dynamic_state", avoiding an untagged
traced allocation.

* libguile/threads-internal.h: New file.
* libguile/Makefile.am (noinst_HEADERS): Add new file.

Adapt all users, notably of SCM_I_CURRENT_THREAD and scm_i_misc_mutex.
This commit is contained in:
Andy Wingo 2025-06-25 10:46:43 +02:00
parent a6b848dcba
commit 552960b3e2
73 changed files with 244 additions and 211 deletions
Download patch file Download diff file Expand all files Collapse all files

1
libguile/Makefile.am
View file

@ -529,6 +529,7 @@ noinst_HEADERS = atomic.h \
regex-posix.h \
strings-internal.h \
syntax.h \
threads-internal.h \
trace.h \
vectors-internal.h \
whippet-embedder.h

2
libguile/arrays.c
View file

@ -49,7 +49,7 @@
#include "srfi-13.h"
#include "srfi-4.h"
#include "strings.h"
#include "threads.h"
#include "threads-internal.h"
#include "uniform.h"
#include "variable.h"
#include "vectors.h"

1
libguile/async.c
View file

@ -36,6 +36,7 @@
#include "list.h"
#include "pairs.h"
#include "throw.h"
#include "threads-internal.h"
#include "async.h"

2
libguile/atomic.c
View file

@ -29,7 +29,7 @@
#include "extensions.h"
#include "gsubr.h"
#include "ports.h"
#include "threads.h"
#include "threads-internal.h"
#include "version.h"
#include "atomic.h"

2
libguile/bitvectors.c
View file

@ -37,7 +37,7 @@
#include "pairs.h"
#include "ports.h"
#include "srfi-4.h"
#include "threads.h"
#include "threads-internal.h"
#include "bitvectors.h"

2
libguile/bytevectors.c
View file

@ -56,7 +56,7 @@
#include "srfi-4.h"
#include "strings-internal.h"
#include "symbols.h"
#include "threads.h"
#include "threads-internal.h"
#include "uniform.h"
#include "version.h"

2
libguile/control.c
View file

@ -32,7 +32,7 @@
#include "list.h"
#include "pairs.h"
#include "programs.h"
#include "threads.h"
#include "threads-internal.h"
#include "version.h"
#include "vm.h"

2
libguile/deprecated.c
View file

@ -33,7 +33,7 @@
#include "numbers.h"
#include "ports.h"
#include "symbols.h"
#include "threads.h"
#include "threads-internal.h"
#include "variable.h"
#include "vectors.h"

4
libguile/deprecation.c
View file

@ -1,4 +1,4 @@
/* Copyright 2001,2005-2006,2009-2012,2016,2018-2019
/* Copyright 2001,2005-2006,2009-2012,2016,2018-2019,2025
Free Software Foundation, Inc.
This file is part of Guile.
@ -33,7 +33,7 @@
#include "ports.h"
#include "private-options.h"
#include "strings.h"
#include "threads.h"
#include "threads-internal.h"
#include "deprecation.h"

4
libguile/dynl.c
View file

@ -1,6 +1,6 @@
/* dynl.c - dynamic linking
Copyright 1990-2003,2008-2011,2017-2018,2021
Copyright 1990-2003,2008-2011,2017-2018,2021,2025
Free Software Foundation, Inc.
This file is part of Guile.
@ -48,7 +48,7 @@
#include "modules.h"
#include "numbers.h"
#include "strings.h"
#include "threads.h"
#include "threads-internal.h"
#include "variable.h"
#include "version.h"

6
libguile/dynstack.c
View file

@ -36,7 +36,7 @@
#include "eval.h"
#include "fluids-internal.h"
#include "variable.h"
#include "threads.h"
#include "threads-internal.h"
#include "trace.h"
#include "dynstack.h"
@ -442,7 +442,7 @@ scm_dynstack_wind_1 (scm_t_dynstack *dynstack, scm_t_bits *item)
case SCM_DYNSTACK_TYPE_WITH_FLUID:
scm_swap_fluid (WITH_FLUID_FLUID (item),
WITH_FLUID_VALUE_BOX (item),
SCM_I_CURRENT_THREAD->dynamic_state);
&SCM_I_CURRENT_THREAD->dynamic_state);
break;
case SCM_DYNSTACK_TYPE_PROMPT:
@ -499,7 +499,7 @@ scm_dynstack_unwind_1 (scm_t_dynstack *dynstack)
case SCM_DYNSTACK_TYPE_WITH_FLUID:
scm_swap_fluid (WITH_FLUID_FLUID (words),
WITH_FLUID_VALUE_BOX (words),
SCM_I_CURRENT_THREAD->dynamic_state);
&SCM_I_CURRENT_THREAD->dynamic_state);
clear_scm_t_bits (words, WITH_FLUID_WORDS);
break;

2
libguile/dynwind.c
View file

@ -28,7 +28,7 @@
#include "eval.h"
#include "pairs.h"
#include "ports.h"
#include "threads.h"
#include "threads-internal.h"
#include "variable.h"
#include "dynwind.h"

2
libguile/ephemerons.c
View file

@ -37,7 +37,7 @@
#include "hash.h"
#include "numbers.h"
#include "ports.h"
#include "threads.h"
#include "threads-internal.h"
#include "trace.h"
#include "version.h"

3
libguile/error.c
View file

@ -1,4 +1,4 @@
/* Copyright 1995-1998,2000-2001,2004,2006,2010,2012-2016,2018-2019
/* Copyright 1995-1998,2000-2001,2004,2006,2010,2012-2016,2018-2019,2025
Free Software Foundation, Inc.
This file is part of Guile.
@ -45,6 +45,7 @@
#include "strings.h"
#include "symbols.h"
#include "throw.h"
#include "threads-internal.h"
#include "error.h"

2
libguile/eval.c
View file

@ -58,7 +58,7 @@
#include "stackchk.h"
#include "strings.h"
#include "symbols.h"
#include "threads.h"
#include "threads-internal.h"
#include "throw.h"
#include "values.h"
#include "variable.h"

2
libguile/exceptions.c
View file

@ -137,7 +137,7 @@ scm_c_with_exception_handler (SCM type, scm_t_exception_handler handler,
SCM prompt_tag = scm_cons (SCM_INUM0, SCM_EOL);
scm_thread *t = SCM_I_CURRENT_THREAD;
scm_t_dynstack *dynstack = &t->dynstack;
scm_t_dynamic_state *dynamic_state = t->dynamic_state;
scm_t_dynamic_state *dynamic_state = &t->dynamic_state;
jmp_buf registers;
jmp_buf *prev_registers;
ptrdiff_t saved_stack_depth;

4
libguile/extensions.c
View file

@ -1,4 +1,4 @@
/* Copyright 2001,2002,2004,2006,2009-2011,2018-2019,2021
/* Copyright 2001,2002,2004,2006,2009-2011,2018-2019,2021,2025
Free Software Foundation, Inc.
This file is part of Guile.
@ -29,7 +29,7 @@
#include "gsubr.h"
#include "foreign.h"
#include "strings.h"
#include "threads.h"
#include "threads-internal.h"
#include "extensions.h"

4
libguile/fdes-finalizers.c
View file

@ -1,4 +1,4 @@
/* Copyright 2016,2018
/* Copyright 2016,2018,2025
Free Software Foundation, Inc.
This file is part of Guile.
@ -30,7 +30,7 @@
#include "list.h"
#include "numbers.h"
#include "pairs.h"
#include "threads.h"
#include "threads-internal.h"
#include "version.h"
#include "fdes-finalizers.h"

1
libguile/filesys.c
View file

@ -94,6 +94,7 @@
#include "strings.h"
#include "symbols.h"
#include "syscalls.h"
#include "threads-internal.h"
#include "vectors.h"
#include "filesys.h"

2
libguile/finalizers.c
View file

@ -51,7 +51,7 @@
#include "struct.h"
#include "symbols.h"
#include "trace.h"
#include "threads.h"
#include "threads-internal.h"
#include "version.h"
#include <gc-finalizer.h>

26
libguile/fluids.c
View file

@ -38,7 +38,7 @@
#include "pairs.h"
#include "ports.h"
#include "print.h"
#include "threads.h"
#include "threads-internal.h"
#include "variable.h"
@ -350,7 +350,7 @@ fluid_ref (scm_t_dynamic_state *dynamic_state, SCM fluid)
SCM
scm_i_fluid_ref (scm_thread *thread, SCM fluid)
{
SCM ret = fluid_ref (thread->dynamic_state, fluid);
SCM ret = fluid_ref (&thread->dynamic_state, fluid);
if (SCM_UNBNDP (ret))
scm_misc_error ("fluid-ref", "unbound fluid: ~S", scm_list_1 (fluid));
@ -390,7 +390,7 @@ SCM_DEFINE (scm_fluid_ref_star, "fluid-ref*", 2, 0, 0,
disappearing link. */
if (c_depth == 0)
{
scm_t_dynamic_state *dynamic_state = SCM_I_CURRENT_THREAD->dynamic_state;
scm_t_dynamic_state *dynamic_state = &SCM_I_CURRENT_THREAD->dynamic_state;
struct scm_cache_entry *entry;
entry = scm_cache_lookup (&dynamic_state->cache, fluid);
@ -429,7 +429,7 @@ SCM_DEFINE (scm_fluid_set_x, "fluid-set!", 2, 0, 0,
#define FUNC_NAME s_scm_fluid_set_x
{
SCM_VALIDATE_FLUID (1, fluid);
fluid_set_x (SCM_I_CURRENT_THREAD->dynamic_state, fluid, value);
fluid_set_x (&SCM_I_CURRENT_THREAD->dynamic_state, fluid, value);
return SCM_UNSPECIFIED;
}
#undef FUNC_NAME
@ -443,7 +443,7 @@ SCM_DEFINE (scm_fluid_unset_x, "fluid-unset!", 1, 0, 0,
suite demands it, but I would prefer not to. */
SCM_VALIDATE_FLUID (1, fluid);
SCM_SET_CELL_OBJECT_1 (fluid, SCM_UNDEFINED);
fluid_set_x (SCM_I_CURRENT_THREAD->dynamic_state, fluid, SCM_UNDEFINED);
fluid_set_x (&SCM_I_CURRENT_THREAD->dynamic_state, fluid, SCM_UNDEFINED);
return SCM_UNSPECIFIED;
}
#undef FUNC_NAME
@ -456,7 +456,7 @@ SCM_DEFINE (scm_fluid_bound_p, "fluid-bound?", 1, 0, 0,
{
SCM val;
SCM_VALIDATE_FLUID (1, fluid);
val = fluid_ref (SCM_I_CURRENT_THREAD->dynamic_state, fluid);
val = fluid_ref (&SCM_I_CURRENT_THREAD->dynamic_state, fluid);
return scm_from_bool (! (SCM_UNBNDP (val)));
}
#undef FUNC_NAME
@ -505,7 +505,7 @@ scm_c_with_fluids (SCM fluids, SCM values, SCM (*cproc) (), void *cdata)
{
scm_dynstack_push_fluid (&thread->dynstack,
SCM_CAR (fluids), SCM_CAR (values),
thread->dynamic_state);
&thread->dynamic_state);
fluids = SCM_CDR (fluids);
values = SCM_CDR (values);
}
@ -513,7 +513,7 @@ scm_c_with_fluids (SCM fluids, SCM values, SCM (*cproc) (), void *cdata)
ans = cproc (cdata);
for (i = 0; i < flen; i++)
scm_dynstack_unwind_fluid (&thread->dynstack, thread->dynamic_state);
scm_dynstack_unwind_fluid (&thread->dynstack, &thread->dynamic_state);
return ans;
}
@ -534,9 +534,9 @@ scm_c_with_fluid (SCM fluid, SCM value, SCM (*cproc) (), void *cdata)
scm_thread *thread = SCM_I_CURRENT_THREAD;
scm_dynstack_push_fluid (&thread->dynstack, fluid, value,
thread->dynamic_state);
&thread->dynamic_state);
ans = cproc (cdata);
scm_dynstack_unwind_fluid (&thread->dynstack, thread->dynamic_state);
scm_dynstack_unwind_fluid (&thread->dynstack, &thread->dynamic_state);
return ans;
}
@ -545,7 +545,7 @@ scm_c_with_fluid (SCM fluid, SCM value, SCM (*cproc) (), void *cdata)
static void
swap_fluid (SCM data)
{
scm_t_dynamic_state *dynstate = SCM_I_CURRENT_THREAD->dynamic_state;
scm_t_dynamic_state *dynstate = &SCM_I_CURRENT_THREAD->dynamic_state;
SCM f = SCM_CAR (data);
SCM t = fluid_ref (dynstate, f);
fluid_set_x (dynstate, f, SCM_CDR (data));
@ -591,7 +591,7 @@ SCM_DEFINE (scm_current_dynamic_state, "current-dynamic-state", 0, 0, 0,
struct scm_dynamic_state_snapshot *snapshot =
scm_allocate_tagged (thr, sizeof (*snapshot));
snapshot->tag = scm_tc7_dynamic_state;
snapshot->bindings = save_dynamic_state (thr->dynamic_state);
snapshot->bindings = save_dynamic_state (&thr->dynamic_state);
return scm_from_dynamic_state (snapshot);
}
#undef FUNC_NAME
@ -606,7 +606,7 @@ SCM_DEFINE (scm_set_current_dynamic_state, "set-current-dynamic-state", 1,0,0,
SCM old = scm_current_dynamic_state ();
SCM_ASSERT (scm_is_dynamic_state (state), state, SCM_ARG1, FUNC_NAME);
restore_dynamic_state (scm_to_dynamic_state (state)->bindings,
t->dynamic_state);
&t->dynamic_state);
return old;
}
#undef FUNC_NAME

2
libguile/foreign-object.c
View file

@ -31,7 +31,7 @@
#include "modules.h"
#include "numbers.h"
#include "procs.h"
#include "threads.h"
#include "threads-internal.h"
#include "variable.h"
#include "version.h"

2
libguile/foreign.c
View file

@ -53,7 +53,7 @@
#include "stacks.h"
#include "strings-internal.h"
#include "symbols.h"
#include "threads.h"
#include "threads-internal.h"
#include "version.h"
#include "uniform.h"

1
libguile/fports.c
View file

@ -66,6 +66,7 @@
#include "strings-internal.h"
#include "symbols.h"
#include "syscalls.h"
#include "threads-internal.h"
#include "variable.h"
#include "version.h"

2
libguile/frames.c
View file

@ -35,7 +35,7 @@
#include "ports.h"
#include "programs.h"
#include "symbols.h"
#include "threads.h"
#include "threads-internal.h"
#include "variable.h"
#include "version.h"
#include "vm.h"

2
libguile/gc-inline.h
View file

@ -41,7 +41,7 @@
#include "libguile/gc.h"
#include "libguile/gc-internal.h"
#include "libguile/threads.h"
#include "libguile/threads-internal.h"

2
libguile/gc-malloc.c
View file

@ -28,7 +28,7 @@
#include <unistd.h>
#include "gc-inline.h"
#include "threads.h"
#include "threads-internal.h"
#include "gc.h"

2
libguile/gsubr.c
View file

@ -39,7 +39,7 @@
#include "programs.h"
#include "srfi-4.h"
#include "symbols.h"
#include "threads.h"
#include "threads-internal.h"
#include "vectors.h"
#include "gsubr-internal.h"

2
libguile/hashtab.c
View file

@ -40,7 +40,7 @@
#include "pairs.h"
#include "ports.h"
#include "procs.h"
#include "threads.h"
#include "threads-internal.h"
#include "variable.h"
#include "vectors.h"

2
libguile/i18n.c
View file

@ -44,7 +44,7 @@
#include "strings-internal.h"
#include "symbols.h"
#include "syscalls.h"
#include "threads.h"
#include "threads-internal.h"
#include "values.h"
#include "variable.h"
#include "version.h"

4
libguile/instructions.c
View file

@ -1,4 +1,4 @@
/* Copyright 2001,2009-2013,2017-2018,2020
/* Copyright 2001,2009-2013,2017-2018,2020,2025
Free Software Foundation, Inc.
This file is part of Guile.
@ -27,7 +27,7 @@
#include "numbers.h"
#include "pairs.h"
#include "symbols.h"
#include "threads.h"
#include "threads-internal.h"
#include "version.h"
#include "instructions.h"

2
libguile/integers.c
View file

@ -33,7 +33,7 @@
#include "boolean.h"
#include "numbers.h"
#include "strings.h"
#include "threads.h"
#include "threads-internal.h"
#include "integers.h"

14
libguile/intrinsics.c
View file

@ -40,7 +40,7 @@
#include "strings-internal.h"
#include "struct.h"
#include "symbols.h"
#include "threads.h"
#include "threads-internal.h"
#include "variable.h"
#include "version.h"
@ -179,13 +179,13 @@ static void
push_fluid (scm_thread *thread, SCM fluid, SCM value)
{
scm_dynstack_push_fluid (&thread->dynstack, fluid, value,
thread->dynamic_state);
&thread->dynamic_state);
}
static void
pop_fluid (scm_thread *thread)
{
scm_dynstack_unwind_fluid (&thread->dynstack, thread->dynamic_state);
scm_dynstack_unwind_fluid (&thread->dynstack, &thread->dynamic_state);
}
static SCM
@ -194,7 +194,7 @@ fluid_ref (scm_thread *thread, SCM fluid)
struct scm_cache_entry *entry;
/* If we find FLUID in the cache, then it is indeed a fluid. */
entry = scm_cache_lookup (&thread->dynamic_state->cache, fluid);
entry = scm_cache_lookup (&thread->dynamic_state.cache, fluid);
if (SCM_LIKELY (scm_is_eq (SCM_PACK (entry->key), fluid)
&& !SCM_UNBNDP (SCM_PACK (entry->value))))
return SCM_PACK (entry->value);
@ -208,7 +208,7 @@ fluid_set_x (scm_thread *thread, SCM fluid, SCM value)
struct scm_cache_entry *entry;
/* If we find FLUID in the cache, then it is indeed a fluid. */
entry = scm_cache_lookup (&thread->dynamic_state->cache, fluid);
entry = scm_cache_lookup (&thread->dynamic_state.cache, fluid);
if (SCM_LIKELY (scm_is_eq (SCM_PACK (entry->key), fluid)))
entry->value = SCM_UNPACK (value);
else
@ -219,14 +219,14 @@ static void
push_dynamic_state (scm_thread *thread, SCM state)
{
scm_dynstack_push_dynamic_state (&thread->dynstack, state,
thread->dynamic_state);
&thread->dynamic_state);
}
static void
pop_dynamic_state (scm_thread *thread)
{
scm_dynstack_unwind_dynamic_state (&thread->dynstack,
thread->dynamic_state);
&thread->dynamic_state);
}
static SCM

2
libguile/jit.c
View file

@ -34,7 +34,7 @@
#include "instructions.h"
#include "intrinsics.h"
#include "simpos.h" /* scm_getenv_int */
#include "threads.h"
#include "threads-internal.h"
#include "vm-builtins.h"
#include "vm-operations.h"

2
libguile/keywords.c
View file

@ -35,7 +35,7 @@
#include "ports.h"
#include "strings.h"
#include "symbols.h"
#include "threads.h"
#include "threads-internal.h"
#include "keywords-internal.h"

2
libguile/load.c
View file

@ -58,7 +58,7 @@
#include "strings-internal.h"
#include "strports.h"
#include "symbols.h"
#include "threads.h"
#include "threads-internal.h"
#include "throw.h"
#include "variable.h"
#include "version.h"

2
libguile/loader.c
View file

@ -48,7 +48,7 @@
#include "pairs.h"
#include "programs.h"
#include "strings.h"
#include "threads.h"
#include "threads-internal.h"
#include "trace.h"
#include "version.h"

2
libguile/macros.c
View file

@ -32,7 +32,7 @@
#include "procs.h"
#include "random.h"
#include "symbols.h"
#include "threads.h"
#include "threads-internal.h"
#include "variable.h"
#include "macros.h"

10
libguile/memoize.c
View file

@ -42,7 +42,7 @@
#include "print.h"
#include "strings-internal.h"
#include "symbols.h"
#include "threads.h"
#include "threads-internal.h"
#include "throw.h"
#include "variable.h"
#include "vectors.h"
@ -99,7 +99,7 @@ do_push_fluid (SCM fluid, SCM val)
{
scm_thread *thread = SCM_I_CURRENT_THREAD;
scm_dynstack_push_fluid (&thread->dynstack, fluid, val,
thread->dynamic_state);
&thread->dynamic_state);
return SCM_UNSPECIFIED;
}
@ -107,7 +107,7 @@ static SCM
do_pop_fluid (void)
{
scm_thread *thread = SCM_I_CURRENT_THREAD;
scm_dynstack_unwind_fluid (&thread->dynstack, thread->dynamic_state);
scm_dynstack_unwind_fluid (&thread->dynstack, &thread->dynamic_state);
return SCM_UNSPECIFIED;
}
@ -116,7 +116,7 @@ do_push_dynamic_state (SCM state)
{
scm_thread *thread = SCM_I_CURRENT_THREAD;
scm_dynstack_push_dynamic_state (&thread->dynstack, state,
thread->dynamic_state);
&thread->dynamic_state);
return SCM_UNSPECIFIED;
}
@ -125,7 +125,7 @@ do_pop_dynamic_state (void)
{
scm_thread *thread = SCM_I_CURRENT_THREAD;
scm_dynstack_unwind_dynamic_state (&thread->dynstack,
thread->dynamic_state);
&thread->dynamic_state);
return SCM_UNSPECIFIED;
}

2
libguile/modules.c
View file

@ -37,7 +37,7 @@
#include "procprop.h"
#include "struct.h"
#include "symbols.h"
#include "threads.h"
#include "threads-internal.h"
#include "variable.h"
#include "vectors.h"

4
libguile/null-threads.c
View file

@ -1,4 +1,4 @@
/* Copyright 2002,2006,2008,2018
/* Copyright 2002,2006,2008,2018,2025
Free Software Foundation, Inc.
This file is part of Guile.
@ -27,7 +27,7 @@
#if SCM_USE_NULL_THREADS
#include "null-threads.h"
#include "null-threads-internal.h"
static scm_i_pthread_key_t *all_keys = NULL;

2
libguile/numbers.c
View file

@ -71,7 +71,7 @@
#include "ports.h"
#include "simpos.h"
#include "strings-internal.h"
#include "threads.h"
#include "threads-internal.h"
#include "values.h"
#include "numbers.h"

2
libguile/options.c
View file

@ -28,7 +28,7 @@
#include "pairs.h"
#include "strings.h"
#include "symbols.h"
#include "threads.h"
#include "threads-internal.h"
#include "options.h"

2
libguile/pairs.c
View file

@ -28,7 +28,7 @@
#include "boolean.h"
#include "gc-internal.h"
#include "trace.h"
#include "threads.h"
#include "threads-internal.h"
#include "gsubr.h"
#include "pairs.h"

3
libguile/ports.c
View file

@ -73,6 +73,7 @@
#include "strings-internal.h"
#include "symbols.h"
#include "syscalls.h"
#include "threads-internal.h"
#include "variable.h"
#include "vectors.h"
#include "version.h"
@ -800,7 +801,7 @@ scm_c_make_port_with_encoding (scm_t_port_type *ptob, unsigned long mode_bits,
SCM encoding, SCM conversion_strategy,
scm_t_bits stream)
{
scm_t_port *pt = scm_gc_typed_calloc (scm_t_port);
scm_t_port *pt = scm_allocate_tagged (SCM_I_CURRENT_THREAD, sizeof (*pt));
pt->tag_and_flags = scm_tc7_port | mode_bits | SCM_OPN;
pt->ptob = ptob;
pt->stream = stream;

2
libguile/posix-w32.c
View file

@ -34,7 +34,7 @@
#include <fcntl.h>
#include "gc.h" /* for scm_*alloc, scm_strdup */
#include "threads.h" /* for scm_i_scm_pthread_mutex_lock */
#include "threads-internal.h" /* for scm_i_scm_pthread_mutex_lock */
#include "posix-w32.h"

2
libguile/posix.c
View file

@ -76,7 +76,7 @@
#include "strings-internal.h"
#include "symbols.h"
#include "syscalls.h"
#include "threads.h"
#include "threads-internal.h"
#include "values.h"
#include "vectors.h"
#include "verify.h"

2
libguile/print.c
View file

@ -68,7 +68,7 @@
#include "struct.h"
#include "symbols.h"
#include "syntax.h"
#include "threads.h"
#include "threads-internal.h"
#include "values.h"
#include "variable.h"
#include "vectors.h"

2
libguile/procprop.c
View file

@ -36,7 +36,7 @@
#include "programs.h"
#include "smob.h"
#include "symbols.h"
#include "threads.h"
#include "threads-internal.h"
#include "vectors.h"
#include "vm-builtins.h"

4
libguile/programs.h
View file

@ -21,7 +21,7 @@
#define _SCM_PROGRAMS_H_
#include <libguile/gc.h>
#include <libguile/threads.h>
#include "threads-internal.h"
/*
* Programs
@ -123,8 +123,6 @@ scm_program_free_variable_set_x (struct scm_program *program, size_t idx, SCM v)
program->free_variables[idx] = v;
}
#include "threads.h"
static inline SCM
scm_i_make_program (const uint32_t *code)
{

2
libguile/r6rs-ports.c
View file

@ -39,7 +39,7 @@
#include "strings.h"
#include "symbols.h"
#include "syscalls.h"
#include "threads.h"
#include "threads-internal.h"
#include "values.h"
#include "variable.h"
#include "vectors.h"

7
libguile/random.c
View file

@ -50,7 +50,7 @@
#include "stime.h"
#include "strings-internal.h"
#include "symbols.h"
#include "threads.h"
#include "threads-internal.h"
#include "variable.h"
#include "vectors.h"
@ -328,9 +328,7 @@ scm_c_random_bignum (scm_t_rstate *state, SCM m)
/* we know the result will be this big */
mpz_realloc2 (result, m_bits);
random_chunks =
(uint32_t *) scm_gc_calloc (num_chunks * sizeof (uint32_t),
"random bignum chunks");
random_chunks = scm_calloc (num_chunks * sizeof (uint32_t));
do
{
@ -370,6 +368,7 @@ scm_c_random_bignum (scm_t_rstate *state, SCM m)
mpz_clear (zm);
SCM ret = scm_from_mpz (result);
mpz_clear (result);
free (random_chunks);
return ret;
}

2
libguile/read.c
View file

@ -59,7 +59,7 @@
#include "strings-internal.h"
#include "strports.h"
#include "symbols.h"
#include "threads.h"
#include "threads-internal.h"
#include "variable.h"
#include "vectors.h"

1
libguile/regex-posix.c
View file

@ -50,6 +50,7 @@
#include "strings.h"
#include "strports.h"
#include "symbols.h"
#include "threads-internal.h"
#include "vectors.h"
#include "version.h"

2
libguile/scmsigs.c
View file

@ -55,7 +55,7 @@
#include "pairs.h"
#include "procs.h"
#include "syscalls.h"
#include "threads.h"
#include "threads-internal.h"
#include "variable.h"
#include "vectors.h"

2
libguile/smob.c
View file

@ -37,7 +37,7 @@
#include "numbers.h"
#include "ports.h"
#include "programs.h"
#include "threads.h"
#include "threads-internal.h"
#include "smob.h"

2
libguile/srfi-14.c
View file

@ -39,7 +39,7 @@
#include "procs.h"
#include "strings-internal.h"
#include "symbols.h"
#include "threads.h"
#include "threads-internal.h"
#include "values.h"
#include "version.h"

4
libguile/stackchk.c
View file

@ -1,4 +1,4 @@
/* Copyright 1995-1997,2000-2001,2006,2008,2010-2011,2014,2018
/* Copyright 1995-1997,2000-2001,2006,2008,2010-2011,2014,2018,2025
Free Software Foundation, Inc.
This file is part of Guile.
@ -28,7 +28,7 @@
#include "gsubr.h"
#include "numbers.h"
#include "ports.h"
#include "threads.h"
#include "threads-internal.h"
#include "stackchk.h"

3
libguile/stackchk.h
View file

@ -1,7 +1,7 @@
#ifndef SCM_STACKCHK_H
#define SCM_STACKCHK_H
/* Copyright 1995-1996,1998,2000,2003,2006,2008-2011,2014,2018
/* Copyright 1995-1996,1998,2000,2003,2006,2008-2011,2014,2018,2025
Free Software Foundation, Inc.
This file is part of Guile.
@ -32,6 +32,7 @@
#define SCM_STACK_CHECKING_P SCM_STACK_LIMIT
#if defined BUILDING_LIBGUILE
#include "libguile/threads-internal.h"
#include "libguile/private-options.h"
# if SCM_STACK_GROWS_UP
# define SCM_STACK_OVERFLOW_P(s)\

2
libguile/stacks.c
View file

@ -43,7 +43,7 @@
#include "strings.h"
#include "struct.h"
#include "symbols.h"
#include "threads.h"
#include "threads-internal.h"
#include "vm.h" /* to capture vm stacks */
#include "stacks.h"

2
libguile/strings.c
View file

@ -47,7 +47,7 @@
#include "private-options.h"
#include "striconveh.h"
#include "symbols.h"
#include "threads.h"
#include "threads-internal.h"
#include "strings-internal.h"

2
libguile/strports.c
View file

@ -42,7 +42,7 @@
#include "strings-internal.h"
#include "symbols.h"
#include "syscalls.h"
#include "threads.h"
#include "threads-internal.h"
#include "variable.h"
#include "vectors.h"

1
libguile/struct.c
View file

@ -47,6 +47,7 @@
#include "srfi-13.h"
#include "strings-internal.h"
#include "symbols.h"
#include "threads-internal.h"
#include "struct.h"

2
libguile/symbols.c
View file

@ -43,7 +43,7 @@
#include "srfi-13.h"
#include "strings-internal.h"
#include "strorder.h"
#include "threads.h"
#include "threads-internal.h"
#include "variable.h"
#include "vectors.h"

2
libguile/syntax.c
View file

@ -31,7 +31,7 @@
#include "modules.h"
#include "pairs.h"
#include "ports.h"
#include "threads.h"
#include "threads-internal.h"
#include "variable.h"
#include "vectors.h"

130
libguile/threads-internal.h Normal file
View file

@ -0,0 +1,130 @@
#ifndef SCM_THREADS_INTERNAL_H
#define SCM_THREADS_INTERNAL_H
/* Copyright 1996-1998,2000-2004,2006-2009,2011-2014,2018-2019,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/>. */
#include "libguile/fluids-internal.h"
#include "libguile/threads.h"
struct gc_mutator;
struct scm_thread {
scm_t_bits tag;
struct scm_thread *next_thread;
/* VM state for this thread. */
struct scm_vm vm;
/* For system asyncs.
*/
SCM pending_asyncs; /* The thunks to be run at the next
safe point. Accessed atomically. */
unsigned int block_asyncs; /* Non-zero means that asyncs should
not be run. */
/* Every thread is a mutator for the GC. */
struct gc_mutator *mutator;
scm_i_pthread_t pthread;
SCM result;
int exited;
/* Boolean indicating whether the thread is in guile mode. */
int guile_mode;
/* Boolean indicating whether to call GC_unregister_my_thread () when
this thread exits. */
int needs_unregister;
struct scm_thread_wake_data *wake;
scm_i_pthread_cond_t sleep_cond;
int sleep_pipe[2];
/* Other thread local things.
*/
struct scm_dynamic_state dynamic_state;
/* The dynamic stack. */
scm_t_dynstack dynstack;
/* The current continuation root and the stack base for it.
The continuation root is an arbitrary but unique object that
identifies a dynamic extent. Continuations created during that
extent can also only be invoked during it.
We use pairs where the car is the thread handle and the cdr links
to the previous pair. This might be used for better error
messages but is not essential for identifying continuation roots.
The continuation base is the far end of the stack upto which it
needs to be copied.
*/
SCM continuation_root;
SCM_STACKITEM *continuation_base;
/* Stack base. Used when checking for C stack overflow. */
SCM_STACKITEM *base;
/* For joinable threads, a cond to wait on joining, and a lock to
protect the results. #f if not joinable. */
SCM join_cond;
SCM join_lock;
SCM join_results;
/* JIT state; NULL until this thread needs to JIT-compile something. */
struct scm_jit_state *jit_state;
};
SCM_INTERNAL void scm_init_threads (void);
SCM_INTERNAL void scm_init_threads_default_dynamic_state (void);
SCM_INTERNAL void scm_i_dynwind_pthread_mutex_lock_block_asyncs (scm_i_pthread_mutex_t *mutex);
SCM_INTERNAL int scm_i_print_thread (SCM t, SCM port, scm_print_state *pstate);
SCM_INTERNAL int scm_i_print_mutex (SCM m, SCM port, scm_print_state *pstate);
SCM_INTERNAL int scm_i_print_condition_variable (SCM cv, SCM port,
scm_print_state *pstate);
/* Though we don't need the key for SCM_I_CURRENT_THREAD if we have TLS,
we do use it for cleanup purposes. */
SCM_INTERNAL scm_i_pthread_key_t scm_i_thread_key;
#ifdef SCM_HAVE_THREAD_STORAGE_CLASS
SCM_INTERNAL SCM_THREAD_LOCAL scm_thread *scm_i_current_thread;
# define SCM_I_CURRENT_THREAD (scm_i_current_thread)
#else /* !SCM_HAVE_THREAD_STORAGE_CLASS */
# define SCM_I_CURRENT_THREAD \
((scm_thread *) scm_i_pthread_getspecific (scm_i_thread_key))
#endif /* !SCM_HAVE_THREAD_STORAGE_CLASS */
SCM_INTERNAL scm_i_pthread_mutex_t scm_i_misc_mutex;
#endif /* SCM_THREADS_INTERNAL_H */

10
libguile/threads.c
View file

@ -69,7 +69,7 @@
#include "vm.h"
#include "whippet-embedder.h"
#include "threads.h"
#include "threads-internal.h"
@ -100,8 +100,8 @@ scm_trace_thread (struct scm_thread *thread,
trace_edge (gc_edge (&thread->result), heap, trace_data);
/* FIXME: This is not a tagged allocation. */
trace_edge (gc_edge (&thread->dynamic_state), heap, trace_data);
/* FIXME: Use scm_trace_dynamic_state or so. */
// trace_edge (gc_edge (&thread->dynamic_state), heap, trace_data);
scm_trace_dynstack (&thread->dynstack, trace_edge, heap, trace_data);
@ -468,8 +468,7 @@ guilify_self_2 (SCM dynamic_state)
t->continuation_root = scm_cons (scm_thread_handle (t), SCM_EOL);
t->continuation_base = t->base;
t->dynamic_state = scm_gc_typed_calloc (scm_t_dynamic_state);
t->dynamic_state->thread_local_values = scm_c_make_hash_table (0);
t->dynamic_state.thread_local_values = scm_c_make_hash_table (0);
scm_set_current_dynamic_state (dynamic_state);
scm_dynstack_init_for_thread (&t->dynstack);
@ -520,7 +519,6 @@ on_thread_exit (void *v)
/* Although this thread has exited, the thread object might still be
alive. Release unused memory. */
t->dynamic_state = NULL;
t->dynstack.base = NULL;
t->dynstack.top = NULL;
t->dynstack.limit = NULL;

103
libguile/threads.h
View file

@ -38,77 +38,8 @@
struct scm_thread;
struct scm_thread_wake_data;
struct gc_mutator;
struct scm_thread {
scm_t_bits tag;
struct scm_thread *next_thread;
/* VM state for this thread. */
struct scm_vm vm;
/* For system asyncs.
*/
SCM pending_asyncs; /* The thunks to be run at the next
safe point. Accessed atomically. */
unsigned int block_asyncs; /* Non-zero means that asyncs should
not be run. */
/* Every thread is a mutator for the GC. */
struct gc_mutator *mutator;
scm_i_pthread_t pthread;
SCM result;
int exited;
/* Boolean indicating whether the thread is in guile mode. */
int guile_mode;
/* Boolean indicating whether to call GC_unregister_my_thread () when
this thread exits. */
int needs_unregister;
struct scm_thread_wake_data *wake;
scm_i_pthread_cond_t sleep_cond;
int sleep_pipe[2];
/* Other thread local things.
*/
scm_t_dynamic_state *dynamic_state;
/* The dynamic stack. */
scm_t_dynstack dynstack;
/* The current continuation root and the stack base for it.
The continuation root is an arbitrary but unique object that
identifies a dynamic extent. Continuations created during that
extent can also only be invoked during it.
We use pairs where the car is the thread handle and the cdr links
to the previous pair. This might be used for better error
messages but is not essential for identifying continuation roots.
The continuation base is the far end of the stack upto which it
needs to be copied.
*/
SCM continuation_root;
SCM_STACKITEM *continuation_base;
/* Stack base. Used when checking for C stack overflow. */
SCM_STACKITEM *base;
/* For joinable threads, a cond to wait on joining, and a lock to
protect the results. #f if not joinable. */
SCM join_cond;
SCM join_lock;
SCM join_results;
/* JIT state; NULL until this thread needs to JIT-compile something. */
struct scm_jit_state *jit_state;
};
static inline SCM
scm_thread_handle (struct scm_thread *thread)
@ -128,16 +59,6 @@ SCM_API SCM scm_spawn_thread (scm_t_catch_body body, void *body_data,
SCM_API void *scm_without_guile (void *(*func)(void *), void *data);
SCM_API void *scm_with_guile (void *(*func)(void *), void *data);
SCM_INTERNAL void scm_init_threads (void);
SCM_INTERNAL void scm_init_threads_default_dynamic_state (void);
SCM_INTERNAL void scm_i_dynwind_pthread_mutex_lock_block_asyncs (scm_i_pthread_mutex_t *mutex);
SCM_INTERNAL int scm_i_print_thread (SCM t, SCM port, scm_print_state *pstate);
SCM_INTERNAL int scm_i_print_mutex (SCM m, SCM port, scm_print_state *pstate);
SCM_INTERNAL int scm_i_print_condition_variable (SCM cv, SCM port,
scm_print_state *pstate);
SCM_API SCM scm_call_with_new_thread (SCM thunk, SCM handler);
SCM_API SCM scm_yield (void);
SCM_API SCM scm_cancel_thread (SCM t);
@ -172,28 +93,6 @@ SCM_API SCM scm_all_threads (void);
SCM_API int scm_c_thread_exited_p (SCM thread);
SCM_API SCM scm_thread_exited_p (SCM thread);
#ifdef BUILDING_LIBGUILE
/* Though we don't need the key for SCM_I_CURRENT_THREAD if we have TLS,
we do use it for cleanup purposes. */
SCM_INTERNAL scm_i_pthread_key_t scm_i_thread_key;
# ifdef SCM_HAVE_THREAD_STORAGE_CLASS
SCM_INTERNAL SCM_THREAD_LOCAL scm_thread *scm_i_current_thread;
# define SCM_I_CURRENT_THREAD (scm_i_current_thread)
# else /* !SCM_HAVE_THREAD_STORAGE_CLASS */
# define SCM_I_CURRENT_THREAD \
((scm_thread *) scm_i_pthread_getspecific (scm_i_thread_key))
# endif /* !SCM_HAVE_THREAD_STORAGE_CLASS */
#endif /* BUILDING_LIBGUILE */
SCM_INTERNAL scm_i_pthread_mutex_t scm_i_misc_mutex;
/* Convenience functions for working with the pthread API in guile
mode.
*/

6
libguile/trace.h
View file

@ -1,5 +1,5 @@
#ifndef SCM_THREADS_INTERNAL_H
#define SCM_THREADS_INTERNAL_H
#ifndef SCM_TRACE_H
#define SCM_TRACE_H
/* Copyright 2025 Free Software Foundation, Inc.
@ -96,4 +96,4 @@ scm_trace_dynstack_roots (struct scm_dynstack *dynstack,
struct gc_heap *heap,
void *trace_data);
#endif /* SCM_THREADS_INTERNAL_H */
#endif /* SCM_TRACE_H */

2
libguile/values.c
View file

@ -27,7 +27,7 @@
#include "list.h"
#include "numbers.h"
#include "pairs.h"
#include "threads.h"
#include "threads-internal.h"
#include "values.h"

2
libguile/variable.c
View file

@ -30,7 +30,7 @@
#include "gsubr.h"
#include "list.h"
#include "ports.h"
#include "threads.h"
#include "threads-internal.h"
#include "variable.h"

2
libguile/vectors.c
View file

@ -35,7 +35,7 @@
#include "list.h"
#include "numbers.h"
#include "pairs.h"
#include "threads.h"
#include "threads-internal.h"
#include "vectors-internal.h"

4
libguile/vports.c
View file

@ -1,4 +1,4 @@
/* Copyright 1995-1996,1998-2003,2006,2009-2011,2013,2018,2023
/* Copyright 1995-1996,1998-2003,2006,2009-2011,2013,2018,2023,2025
Free Software Foundation, Inc.
This file is part of Guile.
@ -26,7 +26,7 @@
#include "eval.h"
#include "modules.h"
#include "threads.h"
#include "threads-internal.h"
#include "variable.h"
#include "vports.h"