guile/libguile/threads-internal.h

#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/dynstack.h"
#include "libguile/iselect.h"
#include "libguile/fluids-internal.h"
#include "libguile/vm-internal.h"

#include "libguile/threads.h"



struct gc_mutator;

/* See async.c for the details about how to wake up a thread.  */
struct scm_thread_wake_data
{
  uint32_t seq;
  int state;
  int fd;
  scm_i_pthread_mutex_t *mutex;
  scm_i_pthread_cond_t *cond;
};

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;

  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_data;
  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;

enum scm_mutex_kind {
  /* A standard mutex can only be locked once.  If you try to lock it
     again from the thread that locked it to begin with (the "owner"
     thread), it throws an error.  It can only be unlocked from the
     thread that locked it in the first place.  */
  SCM_MUTEX_STANDARD,
  /* A recursive mutex can be locked multiple times by its owner.  It
     then has to be unlocked the corresponding number of times, and like
     standard mutexes can only be unlocked by the owner thread.  */
  SCM_MUTEX_RECURSIVE,
  /* An unowned mutex is like a standard mutex, except that it can be
     unlocked by any thread.  A corrolary of this behavior is that a
     thread's attempt to lock a mutex that it already owns will block
     instead of signaling an error, as it could be that some other
     thread unlocks the mutex, allowing the owner thread to proceed.
     This kind of mutex is a bit strange and is here for use by
     SRFI-18.  */
  SCM_MUTEX_UNOWNED
};

struct scm_mutex {
  scm_t_bits tag_and_flags;
  /* The thread that owns this mutex, or #f if the mutex is unlocked.  */
  SCM owner;
  /* Queue of threads waiting for this mutex.  */
  SCM waiting;
  /* For SCM_MUTEX_RECURSIVE (and only SCM_MUTEX_RECURSIVE), the
     recursive lock count.  The first lock does not count.  */
  int level;
  scm_i_pthread_mutex_t lock;
};

#define SCM_MUTEXP(x)     SCM_HAS_TYP16 (x, scm_tc16_mutex)

static inline struct scm_mutex*
scm_to_mutex (SCM x)
{
  if (!SCM_MUTEXP (x)) abort ();
  return (struct scm_mutex*) SCM_UNPACK_POINTER (x);
}

static inline SCM
scm_from_mutex (struct scm_mutex *m)
{
  return SCM_PACK_POINTER (m);
}

static inline enum scm_mutex_kind
scm_mutex_kind (struct scm_mutex *m)
{
  return m->tag_and_flags >> 16;
}

struct scm_cond {
  scm_t_bits tag;
  SCM waiting;               /* the threads waiting for this condition. */
  /* FIXME: Using one cond with multiple mutexes may race on the waiting
     list.  */
};

#define SCM_CONDVARP(x)   SCM_HAS_TYP16 (x, scm_tc16_condition_variable)

static inline struct scm_cond*
scm_to_condvar (SCM x)
{
  if (!SCM_CONDVARP (x)) abort ();
  return (struct scm_cond*) SCM_UNPACK_POINTER (x);
}

static inline SCM
scm_from_condvar (struct scm_cond *c)
{
  return SCM_PACK_POINTER (c);
}


#endif  /* SCM_THREADS_INTERNAL_H */