Back to index

plt-scheme  4.2.1
Classes | Defines | Typedefs | Enumerations | Functions | Variables
thread.c File Reference
#include "schpriv.h"
#include "schmach.h"
#include "schgc.h"
#include <time.h>
#include "schfd.h"

Go to the source code of this file.

Classes

struct  Thread_Cell
struct  ParamData
struct  Scheme_Thread_Custodian_Hop
struct  Scheme_NSO
struct  Evt
struct  ActiveWill
struct  WillExecutor

Defines

#define SCHEME_NO_GC_PROTO
#define SIGMZTHREAD   SIGUSR2
#define DEFAULT_INIT_STACK_SIZE   1000
#define MAX_INIT_STACK_SIZE   100000
#define WATCH_FOR_NESTED_SWAPS   0
#define scheme_jit_malloced   0
#define INIT_TB_SIZE   20
#define MZ_THREAD_QUANTUM_USEC   10000
#define MALLOC_MREF()   MALLOC_ONE_WEAK(Scheme_Custodian_Reference)
#define CUSTODIAN_FAM(x)   (*(x))
#define xCUSTODIAN_FAM(x)   (*(x))
#define SETJMP(p)   scheme_setjmpup(&p->jmpup_buf, p, p->stack_start)
#define LONGJMP(p)   scheme_longjmpup(&p->jmpup_buf)
#define RESETJMP(p)   scheme_reset_jmpup_buf(&p->jmpup_buf)
#define scheme_thread_hop_type   scheme_thread_type
#define TSET_IL   MZ_INLINE
#define SCHEME_THREAD_CELLP(x)   (SAME_TYPE(SCHEME_TYPE(x), scheme_thread_cell_type))
#define IS_VECTOR(c)   (!(c)->is_param)
#define SCHEME_PARAMETERP(v)
#define RUNSTACK_TUNE(x)   /* x - Used for performance tuning */

Typedefs

typedef struct Thread_Cell Thread_Cell
typedef struct
Scheme_Thread_Custodian_Hop 
Scheme_Thread_Custodian_Hop
typedef void(* Scheme_For_Each_Func )(Scheme_Object *)
typedef struct Evt Evt
typedef Scheme_Object *(* PCheck_Proc )(int, Scheme_Object **, Scheme_Config *)
typedef struct ActiveWill ActiveWill
typedef struct WillExecutor WillExecutor

Enumerations

enum  { CONFIG_DIRECT, CONFIG_INDIRECT }

Functions

void scheme_gmp_tls_init (long *s)
voidscheme_gmp_tls_load (long *s)
void scheme_gmp_tls_unload (long *s, void *p)
void scheme_gmp_tls_snapshot (long *s, long *save)
void scheme_gmp_tls_restore_snapshot (long *s, void *data, long *save, int do_free)
static void check_ready_break ()
Scheme_Threadscheme_get_current_thread ()
long scheme_get_multiple_count ()
Scheme_Object ** scheme_get_multiple_array ()
void scheme_set_current_thread_ran_some ()
int GC_is_marked (void *)
static void get_ready_for_GC (void)
static void done_with_GC (void)
MZ_DLLIMPORT long GC_get_memory_use ()
static void prepare_this_thread_for_GC (Scheme_Thread *t)
static Scheme_Objectcustodian_require_mem (int argc, Scheme_Object *args[])
static Scheme_Objectcustodian_limit_mem (int argc, Scheme_Object *args[])
static Scheme_Objectcustodian_can_mem (int argc, Scheme_Object *args[])
static Scheme_Objectnew_tracking_fun (int argc, Scheme_Object *args[])
static Scheme_Objectunion_tracking_val (int argc, Scheme_Object *args[])
static Scheme_Objectcollect_garbage (int argc, Scheme_Object *args[])
static Scheme_Objectcurrent_memory_use (int argc, Scheme_Object *args[])
static Scheme_Objectsch_thread (int argc, Scheme_Object *args[])
static Scheme_Objectsch_thread_nokill (int argc, Scheme_Object *args[])
static Scheme_Objectsch_sleep (int argc, Scheme_Object *args[])
static Scheme_Objectthread_p (int argc, Scheme_Object *args[])
static Scheme_Objectthread_running_p (int argc, Scheme_Object *args[])
static Scheme_Objectthread_dead_p (int argc, Scheme_Object *args[])
static Scheme_Objectthread_wait (int argc, Scheme_Object *args[])
static Scheme_Objectsch_current (int argc, Scheme_Object *args[])
static Scheme_Objectkill_thread (int argc, Scheme_Object *args[])
static Scheme_Objectbreak_thread (int argc, Scheme_Object *args[])
static Scheme_Objectthread_suspend (int argc, Scheme_Object *args[])
static Scheme_Objectthread_resume (int argc, Scheme_Object *args[])
static Scheme_Objectmake_thread_suspend (int argc, Scheme_Object *args[])
static Scheme_Objectmake_thread_resume (int argc, Scheme_Object *args[])
static Scheme_Objectmake_thread_dead (int argc, Scheme_Object *args[])
static void register_thread_sync ()
static Scheme_Objectsch_sync (int argc, Scheme_Object *args[])
static Scheme_Objectsch_sync_timeout (int argc, Scheme_Object *args[])
static Scheme_Objectsch_sync_enable_break (int argc, Scheme_Object *args[])
static Scheme_Objectsch_sync_timeout_enable_break (int argc, Scheme_Object *args[])
static Scheme_Objectevt_p (int argc, Scheme_Object *args[])
static Scheme_Objectevts_to_evt (int argc, Scheme_Object *args[])
static Scheme_Objectmake_custodian (int argc, Scheme_Object *argv[])
static Scheme_Objectcustodian_p (int argc, Scheme_Object *argv[])
static Scheme_Objectcustodian_close_all (int argc, Scheme_Object *argv[])
static Scheme_Objectcustodian_to_list (int argc, Scheme_Object *argv[])
static Scheme_Objectcurrent_custodian (int argc, Scheme_Object *argv[])
static Scheme_Objectmake_custodian_box (int argc, Scheme_Object *argv[])
static Scheme_Objectcustodian_box_value (int argc, Scheme_Object *argv[])
static Scheme_Objectcustodian_box_p (int argc, Scheme_Object *argv[])
static Scheme_Objectcall_as_nested_thread (int argc, Scheme_Object *argv[])
static Scheme_Objectcurrent_namespace (int argc, Scheme_Object *args[])
static Scheme_Objectnamespace_p (int argc, Scheme_Object *args[])
static Scheme_Objectparameter_p (int argc, Scheme_Object *args[])
static Scheme_Objectparameter_procedure_eq (int argc, Scheme_Object *args[])
static Scheme_Objectmake_parameter (int argc, Scheme_Object *args[])
static Scheme_Objectmake_derived_parameter (int argc, Scheme_Object *args[])
static Scheme_Objectextend_parameterization (int argc, Scheme_Object *args[])
static Scheme_Objectparameterization_p (int argc, Scheme_Object *args[])
static Scheme_Objectmake_thread_cell (int argc, Scheme_Object *args[])
static Scheme_Objectthread_cell_p (int argc, Scheme_Object *args[])
static Scheme_Objectthread_cell_get (int argc, Scheme_Object *args[])
static Scheme_Objectthread_cell_set (int argc, Scheme_Object *args[])
static Scheme_Objectthread_cell_values (int argc, Scheme_Object *args[])
static Scheme_Objectmake_security_guard (int argc, Scheme_Object *argv[])
static Scheme_Objectsecurity_guard_p (int argc, Scheme_Object *argv[])
static Scheme_Objectcurrent_security_guard (int argc, Scheme_Object *argv[])
static Scheme_Objectmake_thread_set (int argc, Scheme_Object *argv[])
static Scheme_Objectthread_set_p (int argc, Scheme_Object *argv[])
static Scheme_Objectcurrent_thread_set (int argc, Scheme_Object *argv[])
static Scheme_Objectcurrent_thread_initial_stack_size (int argc, Scheme_Object *argv[])
static void adjust_custodian_family (void *pr, void *ignored)
static Scheme_Objectmake_will_executor (int argc, Scheme_Object *args[])
static Scheme_Objectwill_executor_p (int argc, Scheme_Object *args[])
static Scheme_Objectregister_will (int argc, Scheme_Object *args[])
static Scheme_Objectwill_executor_try (int argc, Scheme_Object *args[])
static Scheme_Objectwill_executor_go (int argc, Scheme_Object *args[])
static Scheme_Objectwill_executor_sema (Scheme_Object *w, int *repost)
static Scheme_Objectcheck_break_now (int argc, Scheme_Object *args[])
static int syncing_ready (Scheme_Object *s, Scheme_Schedule_Info *sinfo)
static void make_initial_config (Scheme_Thread *p)
static int do_kill_thread (Scheme_Thread *p)
static void suspend_thread (Scheme_Thread *p)
static void wait_until_suspend_ok ()
static int check_sleep (int need_activity, int sleep_now)
static void remove_thread (Scheme_Thread *r)
static void exit_or_escape (Scheme_Thread *p)
static int resume_suspend_ready (Scheme_Object *o, Scheme_Schedule_Info *sinfo)
static int dead_ready (Scheme_Object *o, Scheme_Schedule_Info *sinfo)
static int can_break_param (Scheme_Thread *p)
static int post_system_idle ()
static Scheme_Objectcurrent_stats (int argc, Scheme_Object *args[])
void scheme_init_thread (Scheme_Env *env)
void scheme_init_memtrace (Scheme_Env *env)
void scheme_init_parameterization_readonly_globals ()
void scheme_init_parameterization (Scheme_Env *env)
static void adjust_limit_table (Scheme_Custodian *c)
static void ensure_custodian_space (Scheme_Custodian *m, int k)
static void add_managed_box (Scheme_Custodian *m, Scheme_Object **box, Scheme_Custodian_Reference *mref, Scheme_Close_Custodian_Client *f, void *data)
static void remove_managed (Scheme_Custodian_Reference *mr, Scheme_Object *o, Scheme_Close_Custodian_Client **old_f, void **old_data)
void insert_custodian (Scheme_Custodian *m, Scheme_Custodian *parent)
Scheme_Custodianscheme_make_custodian (Scheme_Custodian *parent)
static void rebox_willdone_object (void *o, void *mr)
static void managed_object_gone (void *o, void *mr)
int scheme_custodian_is_available (Scheme_Custodian *m)
void scheme_custodian_check_available (Scheme_Custodian *m, const char *who, const char *what)
Scheme_Custodian_Referencescheme_add_managed (Scheme_Custodian *m, Scheme_Object *o, Scheme_Close_Custodian_Client *f, void *data, int must_close)
void scheme_remove_managed (Scheme_Custodian_Reference *mr, Scheme_Object *o)
Scheme_Threadscheme_do_close_managed (Scheme_Custodian *m, Scheme_Exit_Closer_Func cf)
static void for_each_managed (Scheme_Type type, Scheme_For_Each_Func cf)
void scheme_close_managed (Scheme_Custodian *m)
static Scheme_Objectextract_thread (Scheme_Object *o)
void scheme_add_custodian_extractor (Scheme_Type t, Scheme_Custodian_Extractor e)
void scheme_clean_cust_box_list (void)
static void shrink_cust_box_array (void)
static void run_closers (Scheme_Object *o, Scheme_Close_Custodian_Client *f, void *data)
static void run_atexit_closers (void)
void scheme_add_atexit_closer (Scheme_Exit_Closer_Func f)
void scheme_schedule_custodian_close (Scheme_Custodian *c)
static void check_scheduled_kills ()
static void check_current_custodian_allows (const char *who, Scheme_Thread *p)
void scheme_free_all (void)
static Scheme_Thread_Setcreate_thread_set (Scheme_Thread_Set *parent)
static TSET_IL void set_t_set_next (Scheme_Object *o, Scheme_Object *n)
static TSET_IL void set_t_set_prev (Scheme_Object *o, Scheme_Object *n)
static TSET_IL Scheme_Objectget_t_set_next (Scheme_Object *o)
static TSET_IL Scheme_Objectget_t_set_prev (Scheme_Object *o)
static void schedule_in_set (Scheme_Object *s, Scheme_Thread_Set *t_set)
static void unschedule_in_set (Scheme_Object *s, Scheme_Thread_Set *t_set)
static Scheme_Threadmake_thread (Scheme_Config *config, Scheme_Thread_Cell_Table *cells, Scheme_Object *init_break_cell, Scheme_Custodian *mgr, void *stack_base)
Scheme_Threadscheme_make_thread (void *stack_base)
static void scheme_check_tail_buffer_size (Scheme_Thread *p)
void scheme_set_tail_buffer_size (int s)
int scheme_tls_allocate ()
void scheme_tls_set (int pos, void *v)
voidscheme_tls_get (int pos)
Scheme_Object ** scheme_alloc_runstack (long len)
void scheme_set_runstack_limits (Scheme_Object **rs, long len, long start, long end)
int scheme_in_main_thread (void)
static void stash_current_marks ()
static void do_swap_thread ()
void scheme_swap_thread (Scheme_Thread *new_thread)
static void select_thread ()
static void thread_is_dead (Scheme_Thread *r)
void scheme_end_current_thread (void)
static void start_child (Scheme_Thread *volatile child, Scheme_Object *volatile child_eval)
static Scheme_Objectmake_subprocess (Scheme_Object *child_thunk, void *child_start, Scheme_Config *config, Scheme_Thread_Cell_Table *cells, Scheme_Object *break_cell, Scheme_Custodian *mgr, int normal_kill)
Scheme_Objectscheme_thread (Scheme_Object *thunk)
static int thread_wait_done (Scheme_Object *p, Scheme_Schedule_Info *sinfo)
void scheme_add_swap_callback (Scheme_Closure_Func f, Scheme_Object *data)
void scheme_add_swap_out_callback (Scheme_Closure_Func f, Scheme_Object *data)
Scheme_Objectscheme_thread_w_details (Scheme_Object *thunk, Scheme_Config *config, Scheme_Thread_Cell_Table *cells, Scheme_Object *break_cell, Scheme_Custodian *mgr, int suspend_to_kill)
static Scheme_Objectdef_nested_exn_handler (int argc, Scheme_Object *argv[])
 MZ_DO_NOT_INLINE (Scheme_Object *scheme_call_as_nested_thread(int argc, Scheme_Object *argv[], void *max_bottom))
Scheme_Objectscheme_call_as_nested_thread (int argc, Scheme_Object *argv[], void *max_bottom)
void scheme_cancel_sleep ()
void scheme_check_threads (void)
void scheme_wake_up (void)
void scheme_out_of_fuel (void)
static void init_schedule_info (Scheme_Schedule_Info *sinfo, Scheme_Thread *false_pos_ok, double sleep_end)
Scheme_Objectscheme_current_break_cell ()
int scheme_can_break (Scheme_Thread *p)
void scheme_set_can_break (int on)
void scheme_check_break_now (void)
void scheme_push_break_enable (Scheme_Cont_Frame_Data *cframe, int on, int post_check)
void scheme_pop_break_enable (Scheme_Cont_Frame_Data *cframe, int post_check)
static Scheme_Objectraise_user_break (int argc, Scheme_Object **volatile argv)
static void raise_break (Scheme_Thread *p)
void scheme_break_main_thread ()
void scheme_set_break_main_target (Scheme_Thread *p)
void scheme_break_thread (Scheme_Thread *p)
static void find_next_thread (Scheme_Thread **return_arg)
void scheme_thread_block (float sleep_time)
void scheme_making_progress ()
int scheme_block_until (Scheme_Ready_Fun _f, Scheme_Needs_Wakeup_Fun fdf, Scheme_Object *data, float delay)
int scheme_block_until_enable_break (Scheme_Ready_Fun _f, Scheme_Needs_Wakeup_Fun fdf, Scheme_Object *data, float delay, int enable_break)
static int ready_unless (Scheme_Object *o)
static void needs_wakeup_unless (Scheme_Object *o, void *fds)
int scheme_block_until_unless (Scheme_Ready_Fun f, Scheme_Needs_Wakeup_Fun fdf, Scheme_Object *data, float delay, Scheme_Object *unless, int enable_break)
void scheme_thread_block_enable_break (float sleep_time, int enable_break)
void scheme_start_atomic (void)
void scheme_end_atomic_no_swap (void)
void scheme_start_in_scheduler (void)
void scheme_end_in_scheduler (void)
void scheme_end_atomic (void)
void scheme_weak_suspend_thread (Scheme_Thread *r)
void scheme_weak_resume_thread (Scheme_Thread *r)
void scheme_about_to_move_C_stack (void)
void scheme_kill_thread (Scheme_Thread *p)
void scheme_push_kill_action (Scheme_Kill_Action_Func f, void *d)
void scheme_pop_kill_action ()
static void transitive_resume (Scheme_Object *resumes)
static void transitive_promote (Scheme_Thread *p, Scheme_Custodian *c)
static void promote_thread (Scheme_Thread *p, Scheme_Custodian *to_c)
static void add_transitive_resume (Scheme_Thread *promote_to, Scheme_Thread *p)
static Scheme_Objecttransitive_resume_k (void)
static Scheme_Objecttransitive_promote_k (void)
Scheme_Objectscheme_get_thread_suspend (Scheme_Thread *p)
Scheme_Objectscheme_get_thread_dead (Scheme_Thread *p)
static void syncing_needs_wakeup (Scheme_Object *s, void *fds)
void scheme_add_evt (Scheme_Type type, Scheme_Ready_Fun ready, Scheme_Needs_Wakeup_Fun wakeup, Scheme_Sync_Filter_Fun filter, int can_redirect)
void scheme_add_evt_through_sema (Scheme_Type type, Scheme_Sync_Sema_Fun get_sema, Scheme_Sync_Filter_Fun filter)
static Evtfind_evt (Scheme_Object *o)
int scheme_is_evt (Scheme_Object *o)
static Syncingmake_syncing (Evt_Set *evt_set, float timeout, double start_time)
static voidsplice_ptr_array (void **a, int al, void **b, int bl, int i)
static void set_sync_target (Syncing *syncing, int i, Scheme_Object *target, Scheme_Object *wrap, Scheme_Object *nack, int repost, int retry, Scheme_Accept_Sync accept)
void scheme_set_sync_target (Scheme_Schedule_Info *sinfo, Scheme_Object *target, Scheme_Object *wrap, Scheme_Object *nack, int repost, int retry, Scheme_Accept_Sync accept)
void scheme_accept_sync (Syncing *syncing, int i)
Evt_Setmake_evt_set (const char *name, int argc, Scheme_Object **argv, int delta)
Scheme_Objectscheme_make_evt_set (int argc, Scheme_Object **argv)
void scheme_post_syncing_nacks (Syncing *syncing)
static Scheme_Objectdo_sync (const char *name, int argc, Scheme_Object *argv[], int with_break, int with_timeout, int _tailok)
Scheme_Objectscheme_sync (int argc, Scheme_Object *argv[])
Scheme_Objectscheme_sync_timeout (int argc, Scheme_Object *argv[])
static Scheme_Objectdo_scheme_sync_enable_break (const char *who, int with_timeout, int tailok, int argc, Scheme_Object *argv[])
Scheme_Objectscheme_sync_enable_break (int argc, Scheme_Object *argv[])
Scheme_Objectscheme_make_thread_cell (Scheme_Object *def_val, int inherited)
Scheme_Objectscheme_thread_cell_get (Scheme_Object *cell, Scheme_Thread_Cell_Table *cells)
void scheme_thread_cell_set (Scheme_Object *cell, Scheme_Thread_Cell_Table *cells, Scheme_Object *v)
static Scheme_Thread_Cell_Tableinherit_cells (Scheme_Thread_Cell_Table *cells, Scheme_Thread_Cell_Table *t, int inherited)
Scheme_Thread_Cell_Tablescheme_inherit_cells (Scheme_Thread_Cell_Table *cells)
static Scheme_Objectdo_param (void *data, int argc, Scheme_Object *argv[])
Scheme_Configscheme_current_config ()
static Scheme_Configdo_extend_config (Scheme_Config *c, Scheme_Object *key, Scheme_Object *cell)
Scheme_Configscheme_extend_config (Scheme_Config *c, int pos, Scheme_Object *init_val)
void scheme_install_config (Scheme_Config *config)
Scheme_Objectfind_param_cell (Scheme_Config *c, Scheme_Object *k, int force_cell)
Scheme_Objectscheme_get_thread_param (Scheme_Config *c, Scheme_Thread_Cell_Table *cells, int pos)
Scheme_Objectscheme_get_param (Scheme_Config *c, int pos)
void scheme_set_thread_param (Scheme_Config *c, Scheme_Thread_Cell_Table *cells, int pos, Scheme_Object *o)
void scheme_set_param (Scheme_Config *c, int pos, Scheme_Object *o)
void scheme_flatten_config (Scheme_Config *orig_c)
static Scheme_Objectparameterization_p (int argc, Scheme_Object **argv)
static Scheme_Objectparameter_p (int argc, Scheme_Object **argv)
static Scheme_Objectmake_parameter (int argc, Scheme_Object **argv)
static Scheme_Objectmake_derived_parameter (int argc, Scheme_Object **argv)
static Scheme_Objectparameter_procedure_eq (int argc, Scheme_Object **argv)
int scheme_new_param (void)
static void init_param (Scheme_Thread_Cell_Table *cells, Scheme_Parameterization *params, int pos, Scheme_Object *v)
void scheme_set_root_param (int p, Scheme_Object *v)
void scheme_set_startup_load_on_demand (int on)
Scheme_Objectscheme_register_parameter (Scheme_Prim *function, char *name, int which)
Scheme_Objectscheme_param_config (char *name, Scheme_Object *pos, int argc, Scheme_Object **argv, int arity, Scheme_Object *(*check)(int, Scheme_Object **), char *expected, int isboolorfilter)
static Scheme_Objectexact_positive_integer_p (int argc, Scheme_Object *argv[])
Scheme_Envscheme_get_env (Scheme_Config *c)
void scheme_add_namespace_option (Scheme_Object *key, void(*f)(Scheme_Env *))
Scheme_Objectscheme_make_namespace (int argc, Scheme_Object *argv[])
static Scheme_Objectnamespace_p (int argc, Scheme_Object **argv)
void scheme_security_check_file (const char *who, const char *filename, int guards)
void scheme_security_check_file_link (const char *who, const char *filename, const char *content)
void scheme_security_check_network (const char *who, const char *host, int port, int client)
static void activate_will (void *o, void *data)
static Scheme_Objectdo_next_will (WillExecutor *w)
static Scheme_Objectmake_will_executor (int argc, Scheme_Object **argv)
static Scheme_Objectwill_executor_p (int argc, Scheme_Object **argv)
static Scheme_Objectregister_will (int argc, Scheme_Object **argv)
static Scheme_Objectwill_executor_try (int argc, Scheme_Object **argv)
static Scheme_Objectwill_executor_go (int argc, Scheme_Object **argv)
void scheme_zero_unneeded_rands (Scheme_Thread *p)
static void prepare_thread_for_GC (Scheme_Object *t)
voidscheme_malloc_gmp (unsigned long amt, void **mem_pool)
void scheme_free_gmp (void *p, void **mem_pool)
Scheme_Jumpup_Buf_Holderscheme_new_jmpupbuf_holder (void)

Variables

int scheme_num_read_syntax_objects
long scheme_hash_request_count
long scheme_hash_iteration_count
static int buffer_init_size = INIT_TB_SIZE
THREAD_LOCAL Scheme_Threadscheme_current_thread = NULL
THREAD_LOCAL Scheme_Threadscheme_main_thread = NULL
THREAD_LOCAL Scheme_Threadscheme_first_thread = NULL
THREAD_LOCAL Scheme_Thread_Setscheme_thread_set_top
static int num_running_threads = 1
static int swap_no_setjmp = 0
static int thread_swap_count
static int did_gc_count
static int init_load_on_demand = 1
THREAD_LOCAL Scheme_Object ** scheme_current_runstack_start
THREAD_LOCAL Scheme_Object ** scheme_current_runstack
THREAD_LOCAL MZ_MARK_STACK_TYPE scheme_current_cont_mark_stack
THREAD_LOCAL MZ_MARK_POS_TYPE scheme_current_cont_mark_pos
static THREAD_LOCAL
Scheme_Custodian
main_custodian
static THREAD_LOCAL
Scheme_Custodian
last_custodian
static THREAD_LOCAL
Scheme_Hash_Table
limited_custodians = NULL
static Scheme_Objectinitial_inspector
static int cust_box_count
static int cust_box_alloc
static Scheme_Custodian_Box ** cust_boxes
static THREAD_LOCAL Scheme_Threadswap_target
static Scheme_Objectscheduled_kills
Scheme_Objectscheme_parameterization_key
Scheme_Objectscheme_exn_handler_key
Scheme_Objectscheme_break_enabled_key
long scheme_total_gc_time
static long start_this_gc_time
static long end_this_gc_time
static volatile short delayed_break_ready = 0
static Scheme_Threadmain_break_target_thread
void(* scheme_sleep )(float seconds, void *fds)
void(* scheme_notify_multithread )(int on)
void(* scheme_wakeup_on_input )(void *fds)
int(* scheme_check_for_break )(void)
void(* scheme_on_atomic_timeout )(void)
static int do_atomic = 0
static int missed_context_switch = 0
static int have_activity = 0
int scheme_active_but_sleeping = 0
static int thread_ended_with_activity
THREAD_LOCAL int scheme_no_stack_overflow
static int needs_sleep_cancelled
static int tls_pos = 0
static Scheme_Objectread_symbol
static Scheme_Objectwrite_symbol
static Scheme_Objectexecute_symbol
static Scheme_Objectdelete_symbol
static Scheme_Objectexists_symbol
static Scheme_Objectclient_symbol
static Scheme_Objectserver_symbol
static Scheme_Objectnested_exn_handler
static Scheme_Objectclosers
static Scheme_Objectthread_swap_callbacks
static Scheme_Objectthread_swap_out_callbacks
static Scheme_Objectrecycle_cell
static Scheme_Objectmaybe_recycle_cell
static int recycle_cc_count
static mz_jmp_buf main_init_error_buf
static Scheme_Object ** config_map
Scheme_Objectmtrace_cmark_key = NULL
static Scheme_Custodian_Extractorextractors
static int num_nsos = 0
static Scheme_NSOnamespace_options = NULL
static THREAD_LOCAL int evts_array_size
static THREAD_LOCAL Evt ** evts
static int max_configs = __MZCONFIG_BUILTIN_COUNT__
int GC_words_allocd

Class Documentation

struct Thread_Cell

Definition at line 235 of file thread.c.

Collaboration diagram for Thread_Cell:
Class Members
char assigned
Scheme_Object * def_val
char inherited
Scheme_Object so
Scheme_Bucket_Table * vals
struct ParamData

Definition at line 391 of file thread.c.

Collaboration diagram for ParamData:
Class Members
Scheme_Object * defcell
Scheme_Object * extract_guard
Scheme_Object * guard
MZTAG_IF_REQUIRED short is_derived
Scheme_Object * key
struct Scheme_Thread_Custodian_Hop

Definition at line 405 of file thread.c.

Collaboration diagram for Scheme_Thread_Custodian_Hop:
Class Members
Scheme_Thread * p
Scheme_Object so
struct Evt

Definition at line 5179 of file thread.c.

Collaboration diagram for Evt:
Class Members
int can_redirect
Scheme_Sync_Filter_Fun filter
Scheme_Sync_Sema_Fun get_sema
Scheme_Needs_Wakeup_Fun needs_wakeup
Scheme_Ready_Fun_FPC ready
MZTAG_IF_REQUIRED Scheme_Type sync_type
struct ActiveWill

Definition at line 7045 of file thread.c.

Collaboration diagram for ActiveWill:
Class Members
struct ActiveWill * next
MZTAG_IF_REQUIRED Scheme_Object * o
Scheme_Object * proc
struct WillExecutor * w
struct WillExecutor

Definition at line 7053 of file thread.c.

Collaboration diagram for WillExecutor:
Class Members
ActiveWill * first
ActiveWill * last
Scheme_Object * sema
Scheme_Object so

Define Documentation

#define CUSTODIAN_FAM (   x)    (*(x))

Definition at line 277 of file thread.c.

#define DEFAULT_INIT_STACK_SIZE   1000

Definition at line 98 of file thread.c.

#define INIT_TB_SIZE   20

Definition at line 137 of file thread.c.

#define IS_VECTOR (   c)    (!(c)->is_param)

Definition at line 6157 of file thread.c.

#define LONGJMP (   p)    scheme_longjmpup(&p->jmpup_buf)

Definition at line 421 of file thread.c.

Definition at line 276 of file thread.c.

#define MAX_INIT_STACK_SIZE   100000

Definition at line 99 of file thread.c.

#define MZ_THREAD_QUANTUM_USEC   10000

Definition at line 140 of file thread.c.

#define RESETJMP (   p)    scheme_reset_jmpup_buf(&p->jmpup_buf)

Definition at line 422 of file thread.c.

#define RUNSTACK_TUNE (   x)    /* x - Used for performance tuning */
#define scheme_jit_malloced   0

Definition at line 130 of file thread.c.

Definition at line 38 of file thread.c.

#define SCHEME_PARAMETERP (   v)
Value:

Definition at line 6306 of file thread.c.

Definition at line 5973 of file thread.c.

Definition at line 434 of file thread.c.

#define SETJMP (   p)    scheme_setjmpup(&p->jmpup_buf, p, p->stack_start)

Definition at line 420 of file thread.c.

#define SIGMZTHREAD   SIGUSR2

Definition at line 78 of file thread.c.

#define TSET_IL   MZ_INLINE

Definition at line 2006 of file thread.c.

#define WATCH_FOR_NESTED_SWAPS   0

Definition at line 110 of file thread.c.

#define xCUSTODIAN_FAM (   x)    (*(x))

Definition at line 278 of file thread.c.


Typedef Documentation

typedef struct Evt Evt

Definition at line 6716 of file thread.c.

Definition at line 1553 of file thread.c.


Enumeration Type Documentation

anonymous enum
Enumerator:
CONFIG_DIRECT 
CONFIG_INDIRECT 

Definition at line 400 of file thread.c.


Function Documentation

static void activate_will ( void o,
void data 
) [static]

Definition at line 7059 of file thread.c.

{
  ActiveWill *a;
  WillExecutor *w;
  Scheme_Object *proc;

  w = (WillExecutor *)scheme_ephemeron_key(data);
  proc = scheme_ephemeron_value(data);

  if (w) {
    a = MALLOC_ONE_RT(ActiveWill);
#ifdef MZTAG_REQUIRED
    a->type = scheme_rt_will;
#endif
    a->o = (Scheme_Object *)o;
    a->proc = proc;
  
    if (w->last)
      w->last->next = a;
    else
      w->first = a;
    w->last = a;
    scheme_post_sema(w->sema);
  }
}

Here is the caller graph for this function:

static void add_managed_box ( Scheme_Custodian m,
Scheme_Object **  box,
Scheme_Custodian_Reference mref,
Scheme_Close_Custodian_Client f,
void data 
) [static]

Definition at line 1087 of file thread.c.

{
  int i;

  for (i = m->count; i--; ) {
    if (!m->boxes[i]) {
      m->boxes[i] = box;
      m->closers[i] = f;
      m->data[i] = data;
      m->mrefs[i] = mref;

      m->elems++;
      adjust_limit_table(m);

      return;
    }
  }

  ensure_custodian_space(m, 1);

  m->boxes[m->count] = box;
  m->closers[m->count] = f;
  m->data[m->count] = data;
  m->mrefs[m->count] = mref;

  m->elems++;
  adjust_limit_table(m);

  m->count++;
}

Here is the call graph for this function:

Here is the caller graph for this function:

static void add_transitive_resume ( Scheme_Thread promote_to,
Scheme_Thread p 
) [static]

Definition at line 4741 of file thread.c.

{
  Scheme_Object *running_box;
  Scheme_Hash_Table *ht;

  if (!p->running_box) {
    Scheme_Object *b;
    b = scheme_alloc_small_object();
    b->type = scheme_thread_dead_type;
    SCHEME_PTR_VAL(b) = (Scheme_Object *)p;
    p->running_box = b;
  }
  running_box = p->running_box;

  if (!promote_to->transitive_resumes) {
    /* Create table */
    ht = scheme_make_hash_table(SCHEME_hash_ptr);
    promote_to->transitive_resumes = (Scheme_Object *)ht;
  } else {
    /* Purge ht entries for threads that are now dead: */
    Scheme_Hash_Table *gone= NULL;
    int i;

    ht = (Scheme_Hash_Table *)promote_to->transitive_resumes;
    for (i = ht->size; i--; ) {
      if (ht->vals[i]) {
       if (!SCHEME_PTR_VAL(ht->keys[i])) {
         /* This one is dead */
         if (!gone)
           gone = scheme_make_hash_table(SCHEME_hash_ptr);
         scheme_hash_set(gone, ht->keys[i], scheme_true);
       }
      }
    }

    if (gone) {
      /* Remove dead ones: */
      for (i = gone->size; i--; ) {
       if (gone->vals[i]) {
         scheme_hash_set(ht, gone->keys[i], NULL);
       }
      }
    }
  }

  scheme_hash_set(ht, running_box, scheme_true);
}

Here is the caller graph for this function:

static void adjust_custodian_family ( void pr,
void ignored 
) [static]

Definition at line 1154 of file thread.c.

{
  /* Threads note: because this function is only called as a
     finalization callback, it is automatically syncronized by the GC
     locks. And it is synchronized against all finalizations, so a
     managee can't try to unregister while we're shuffling its
     custodian. */
  Scheme_Custodian *r = (Scheme_Custodian *)mgr, *parent, *m;
  int i;

  parent = CUSTODIAN_FAM(r->parent);

  if (parent) {
    /* Remove from parent's list of children: */
    if (CUSTODIAN_FAM(parent->children) == r) {
      CUSTODIAN_FAM(parent->children) = CUSTODIAN_FAM(r->sibling);
    } else {
      m = CUSTODIAN_FAM(parent->children);
      while (m && CUSTODIAN_FAM(m->sibling) != r) {
       m = CUSTODIAN_FAM(m->sibling);
      }
      if (m)
       CUSTODIAN_FAM(m->sibling) = CUSTODIAN_FAM(r->sibling);
    }

    /* Remove from global list: */
    if (CUSTODIAN_FAM(r->global_next))
      CUSTODIAN_FAM(CUSTODIAN_FAM(r->global_next)->global_prev) = CUSTODIAN_FAM(r->global_prev);
    else
      last_custodian = CUSTODIAN_FAM(r->global_prev);
    CUSTODIAN_FAM(CUSTODIAN_FAM(r->global_prev)->global_next) = CUSTODIAN_FAM(r->global_next);
    
    /* Add children to parent's list: */
    for (m = CUSTODIAN_FAM(r->children); m; ) {
      Scheme_Custodian *next = CUSTODIAN_FAM(m->sibling);
      
      CUSTODIAN_FAM(m->parent) = parent;
      CUSTODIAN_FAM(m->sibling) = CUSTODIAN_FAM(parent->children);
      CUSTODIAN_FAM(parent->children) = m;

      m = next;
    }

    adjust_limit_table(parent);

    /* Add remaining managed items to parent: */
    if (!skip_move) {
      for (i = 0; i < r->count; i++) {
       if (r->boxes[i]) {
         CUSTODIAN_FAM(r->mrefs[i]) = parent;
         add_managed_box(parent, r->boxes[i], r->mrefs[i], r->closers[i], r->data[i]);
#ifdef MZ_PRECISE_GC
         {
           Scheme_Object *o;
           o = xCUSTODIAN_FAM(r->boxes[i]);
           if (SAME_TYPE(SCHEME_TYPE(o), scheme_thread_hop_type)) {
             o = WEAKIFIED(((Scheme_Thread_Custodian_Hop *)o)->p);
             if (o)
              GC_register_thread(o, parent);
           }
         }
#endif
       }
      }
    }
  }

  CUSTODIAN_FAM(r->parent) = NULL;
  CUSTODIAN_FAM(r->sibling) = NULL;
  if (!skip_move)
    CUSTODIAN_FAM(r->children) = NULL;
  CUSTODIAN_FAM(r->global_prev) = NULL;
  CUSTODIAN_FAM(r->global_next) = NULL;
}

Here is the call graph for this function:

Here is the caller graph for this function:

static void adjust_limit_table ( Scheme_Custodian c) [static]

Definition at line 905 of file thread.c.

{
  /* If a custodian has a limit and any object or children, then it
     must not be collected and merged with its parent. To prevent
     collection, we register the custodian in the `limite_custodians'
     table. */
  if (c->has_limit) {
    if (c->elems || CUSTODIAN_FAM(c->children)) {
      if (!c->recorded) {
        c->recorded = 1;
        if (!limited_custodians)
          limited_custodians = scheme_make_hash_table(SCHEME_hash_ptr);
        scheme_hash_set(limited_custodians, (Scheme_Object *)c, scheme_true);
      }
    } else if (c->recorded) {
      c->recorded = 0;
      if (limited_custodians)
        scheme_hash_set(limited_custodians, (Scheme_Object *)c, NULL);
    }
  }
}

Here is the caller graph for this function:

static Scheme_Object * break_thread ( int  argc,
Scheme_Object args[] 
) [static]

Definition at line 4516 of file thread.c.

{
  Scheme_Thread *p;

  if (!SAME_TYPE(SCHEME_TYPE(args[0]), scheme_thread_type))
    scheme_wrong_type("break-thread", "thread", 0, argc, args);

  p = (Scheme_Thread *)args[0];

  scheme_break_thread(p);

  /* In case p == scheme_current_thread */
  if (!scheme_fuel_counter) {
    scheme_thread_block(0.0);
    scheme_current_thread->ran_some = 1;
  }

  return scheme_void;
}

Here is the caller graph for this function:

static Scheme_Object * call_as_nested_thread ( int  argc,
Scheme_Object argv[] 
) [static]

Definition at line 3459 of file thread.c.

{
  Scheme_Object *result;
  result = scheme_call_as_nested_thread(argc, argv, PROMPT_STACK(result));
  return result;
}

Here is the call graph for this function:

Here is the caller graph for this function:

static int can_break_param ( Scheme_Thread p) [static]

Definition at line 3670 of file thread.c.

Here is the caller graph for this function:

static Scheme_Object * check_break_now ( int  argc,
Scheme_Object args[] 
) [static]

Definition at line 3717 of file thread.c.

Here is the call graph for this function:

Here is the caller graph for this function:

static void check_current_custodian_allows ( const char *  who,
Scheme_Thread p 
) [static]

Definition at line 1952 of file thread.c.

{
  Scheme_Object *l;
  Scheme_Custodian_Reference *mref;
  Scheme_Custodian *m, *current;

  /* Check management of the thread: */
  current = (Scheme_Custodian *)scheme_get_param(scheme_current_config(), MZCONFIG_CUSTODIAN);

  for (l = p->extra_mrefs; !SCHEME_NULLP(l); l = SCHEME_CDR(l)) {
    mref = (Scheme_Custodian_Reference *)SCHEME_CAR(l);
    m = CUSTODIAN_FAM(mref);
    while (NOT_SAME_OBJ(m, current)) {
      m = CUSTODIAN_FAM(m->parent);
      if (!m)
       goto bad;
    }
  }

  mref = p->mref;
  if (!mref)
    return;
  m = CUSTODIAN_FAM(mref);
  if (!m)
    return;

  while (NOT_SAME_OBJ(m, current)) {
    m = CUSTODIAN_FAM(m->parent);
    if (!m)
      goto bad;
  }

  return;

 bad:
  scheme_arg_mismatch(who,
                    "the current custodian does not "
                    "solely manage the specified thread: ",
                    (Scheme_Object *)p);  
}

Here is the caller graph for this function:

static void check_ready_break ( ) [static]

Definition at line 3881 of file thread.c.

Here is the caller graph for this function:

static void check_scheduled_kills ( ) [static]

Definition at line 1942 of file thread.c.

Here is the caller graph for this function:

static int check_sleep ( int  need_activity,
int  sleep_now 
) [static]

Definition at line 3470 of file thread.c.

{
  Scheme_Thread *p, *p2;
  int end_with_act;

#if defined(USING_FDS)
  DECL_FDSET(set, 3);
  fd_set *set1, *set2;
#endif
  void *fds;

  if (scheme_no_stack_overflow)
    return 0;
  
  /* Is everything blocked? */
  if (!do_atomic) {
    p = scheme_first_thread;
    while (p) {
      if (!p->nestee
          && (p->ran_some || p->block_descriptor == NOT_BLOCKED)
          && (p->next || !(p->running & MZTHREAD_USER_SUSPENDED)))
       break;
      p = p->next;
    }
  } else
    p = NULL;
  
  p2 = scheme_first_thread;
  while (p2) {
    if (p2->ran_some) {
      scheme_notify_sleep_progress();
      p2->ran_some = 0;
    }
    p2 = p2->next;
  }
  
  end_with_act = thread_ended_with_activity;
  thread_ended_with_activity = 0;
  
  if (need_activity 
      && !end_with_act 
      && (do_atomic 
         || (!p && ((!sleep_now && scheme_wakeup_on_input)
                   || (sleep_now && scheme_sleep))))) {
    double max_sleep_time = 0;

    /* Poll from top-level process, and all subprocesses are blocked. */
    /* So, everything is blocked pending external input. */
    /* Build a list of file descriptors that we're waiting on */
    /* and turn off polling. */
    if (have_activity)
      scheme_active_but_sleeping = 1;
    if (have_activity && scheme_notify_multithread)
      scheme_notify_multithread(0);
    
#if defined(USING_FDS)
    INIT_DECL_FDSET(set, 3);
    set1 = (fd_set *) MZ_GET_FDSET(set, 1);
    set2 = (fd_set *) MZ_GET_FDSET(set, 2);

    fds = (void *)set;
    MZ_FD_ZERO(set);
    MZ_FD_ZERO(set1);
    MZ_FD_ZERO(set2);
#else
    fds = NULL;
#endif
    
    needs_sleep_cancelled = 0;

    p = scheme_first_thread;
    while (p) {
      int merge_time = 0;

      if (p->nestee) {
       /* nothing */
      } else if (p->block_descriptor == GENERIC_BLOCKED) {
       if (p->block_needs_wakeup) {
         Scheme_Needs_Wakeup_Fun f = p->block_needs_wakeup;
         f(p->blocker, fds);
       }
       merge_time = (p->sleep_end > 0.0);
      } else if (p->block_descriptor == SLEEP_BLOCKED) {
       merge_time = 1;
      }

      if (merge_time) {
       double d = p->sleep_end;
       double t;

       d = (d - scheme_get_inexact_milliseconds());

       t = (d / 1000);
       if (t <= 0) {
         t = (float)0.00001;
         needs_sleep_cancelled = 1;
       }
       if (!max_sleep_time || (t < max_sleep_time))
         max_sleep_time = t;
      } 
      p = p->next;
    }
  
    if (needs_sleep_cancelled)
      return 0;

    if (post_system_idle()) {
      return 0;
    }
  
    if (sleep_now) {
      float mst = (float)max_sleep_time;

      /* Make sure that mst didn't go to infinity: */
      if ((double)mst > (2 * max_sleep_time)) {
       mst = 100000000.0;
      }

      scheme_sleep(mst, fds);
    } else if (scheme_wakeup_on_input)
      scheme_wakeup_on_input(fds);

    return 1;
  }

  return 0;
}

Here is the call graph for this function:

Here is the caller graph for this function:

static Scheme_Object * collect_garbage ( int  argc,
Scheme_Object args[] 
) [static]

Definition at line 867 of file thread.c.

Here is the caller graph for this function:

static Scheme_Thread_Set* create_thread_set ( Scheme_Thread_Set parent) [static]

Definition at line 2008 of file thread.c.

{
  Scheme_Thread_Set *t_set;

  t_set = MALLOC_ONE_TAGGED(Scheme_Thread_Set);
  t_set->so.type = scheme_thread_set_type;

  t_set->parent = parent;

  /* Everything in t_set is zeroed */

  return t_set;
}

Here is the caller graph for this function:

static Scheme_Object * current_custodian ( int  argc,
Scheme_Object argv[] 
) [static]

Definition at line 1750 of file thread.c.

{
  return scheme_param_config("current-custodian", 
                          scheme_make_integer(MZCONFIG_CUSTODIAN),
                          argc, argv,
                          -1, custodian_p, "custodian", 0);
}

Here is the call graph for this function:

Here is the caller graph for this function:

static Scheme_Object * current_memory_use ( int  argc,
Scheme_Object args[] 
) [static]

Definition at line 874 of file thread.c.

{
  Scheme_Object *arg = NULL;
  long retval = 0;

  if (argc) {
    if(SAME_TYPE(SCHEME_TYPE(args[0]), scheme_custodian_type)) {
      arg = args[0];
    } else if(SCHEME_PROCP(args[0])) {
      arg = args[0];
    } else {
      scheme_wrong_type("current-memory-use", 
                     "custodian or memory-trace-function", 
                     0, argc, args);
    }
  }

#ifdef MZ_PRECISE_GC
  retval = GC_get_memory_use(arg);
#else
  retval = GC_get_memory_use();
#endif
  
  return scheme_make_integer_value(retval);
}

Here is the call graph for this function:

Here is the caller graph for this function:

static Scheme_Object * current_namespace ( int  argc,
Scheme_Object args[] 
) [static]

Definition at line 6890 of file thread.c.

{
  return scheme_param_config("current-namespace", 
                          scheme_make_integer(MZCONFIG_ENV),
                          argc, argv,
                          -1, namespace_p, "namespace", 0);
}

Here is the call graph for this function:

Here is the caller graph for this function:

static Scheme_Object * current_security_guard ( int  argc,
Scheme_Object argv[] 
) [static]

Definition at line 6931 of file thread.c.

{
  return scheme_param_config("current-security-guard", 
                          scheme_make_integer(MZCONFIG_SECURITY_GUARD),
                          argc, argv,
                          -1, security_guard_p, "security-guard", 0);
}

Here is the call graph for this function:

Here is the caller graph for this function:

static Scheme_Object * current_stats ( int  argc,
Scheme_Object args[] 
) [static]

Definition at line 7441 of file thread.c.

{
  Scheme_Object *v;
  Scheme_Thread *t = NULL;
  
  v = argv[0];

  if (!SCHEME_MUTABLE_VECTORP(v))
    scheme_wrong_type("vector-set-performance-stats!", "mutable vector", 0, argc, argv);
  if (argc > 1) {
    if (!SCHEME_FALSEP(argv[1])) {
      if (!SCHEME_THREADP(argv[1]))
       scheme_wrong_type("vector-set-performance-stats!", "thread or #f", 0, argc, argv);
      t = (Scheme_Thread *)argv[1];
    }
  }
  
  if (t) {
    switch (SCHEME_VEC_SIZE(v)) {
    default:
    case 4:
      {
       /* Stack size: */
       long sz = 0;

       if (MZTHREAD_STILL_RUNNING(t->running)) {
         Scheme_Overflow *overflow;
         Scheme_Saved_Stack *runstack_saved;
         
         /* C stack */
         if (t == scheme_current_thread) {
           void *stk_start, *stk_end;
           stk_start = t->stack_start;
           stk_end = (void *)&stk_end;
#         ifdef STACK_GROWS_UP
           sz = (long)stk_end XFORM_OK_MINUS (long)stk_start;
#         endif
#         ifdef STACK_GROWS_DOWN
           sz = (long)stk_start XFORM_OK_MINUS (long)stk_end;
#         endif
         } else {
           if (t->jmpup_buf.stack_copy)
             sz = t->jmpup_buf.stack_size;
         }
         for (overflow = t->overflow; overflow; overflow = overflow->prev) {
           sz += overflow->jmp->cont.stack_size;
         }
         
         /* Scheme stack */
         {
           int ssz;
           if (t == scheme_current_thread) {
             ssz = (MZ_RUNSTACK_START + t->runstack_size) - MZ_RUNSTACK;
           } else {
             ssz = (t->runstack_start + t->runstack_size) - t->runstack;
           }
           for (runstack_saved = t->runstack_saved; runstack_saved; runstack_saved = runstack_saved->prev) {
             ssz += runstack_saved->runstack_size;
           }
           sz += sizeof(Scheme_Object *) * ssz;
         }
         
         /* Mark stack */
         if (t == scheme_current_thread) {
           sz += ((long)scheme_current_cont_mark_pos >> 1) * sizeof(Scheme_Cont_Mark);
         } else {
           sz += ((long)t->cont_mark_pos >> 1) * sizeof(Scheme_Cont_Mark);
         }
       }

       SCHEME_VEC_ELS(v)[3] = scheme_make_integer(sz);
      }
    case 3:
      SCHEME_VEC_ELS(v)[2] = (t->block_descriptor 
                           ? scheme_true 
                           : ((t->running & MZTHREAD_SUSPENDED)
                             ? scheme_true
                             : scheme_false));
    case 2:
      {
       Scheme_Object *dp;
       dp = thread_dead_p(1, (Scheme_Object **) mzALIAS &t);
       SCHEME_VEC_ELS(v)[1] = dp;
      }
    case 1:
      {
       Scheme_Object *rp;
       rp = thread_running_p(1, (Scheme_Object **) mzALIAS &t);
       SCHEME_VEC_ELS(v)[0] = rp;
      }
    case 0:
      break;
    }
  } else {
    long cpuend, end, gcend;

    cpuend = scheme_get_process_milliseconds();
    end = scheme_get_milliseconds();
    gcend = scheme_total_gc_time;
    
    switch (SCHEME_VEC_SIZE(v)) {
    default:
    case 11:
      SCHEME_VEC_ELS(v)[10] = scheme_make_integer(scheme_jit_malloced);
    case 10:
      SCHEME_VEC_ELS(v)[9] = scheme_make_integer(scheme_hash_iteration_count);
    case 9:
      SCHEME_VEC_ELS(v)[8] = scheme_make_integer(scheme_hash_request_count);
    case 8:
      SCHEME_VEC_ELS(v)[7] = scheme_make_integer(scheme_num_read_syntax_objects);
    case 7:
      SCHEME_VEC_ELS(v)[6] = scheme_make_integer(num_running_threads);
    case 6:
      SCHEME_VEC_ELS(v)[5] = scheme_make_integer(scheme_overflow_count);
    case 5:
      SCHEME_VEC_ELS(v)[4] = scheme_make_integer(thread_swap_count);
    case 4:
      SCHEME_VEC_ELS(v)[3] = scheme_make_integer(did_gc_count);
    case 3:
      SCHEME_VEC_ELS(v)[2] = scheme_make_integer(gcend);
    case 2:
      SCHEME_VEC_ELS(v)[1] = scheme_make_integer(end);
    case 1:
      SCHEME_VEC_ELS(v)[0] = scheme_make_integer(cpuend);
    case 0:
      break;
    }
  }

  return scheme_void;
}

Here is the call graph for this function:

Here is the caller graph for this function:

static Scheme_Object * current_thread_initial_stack_size ( int  argc,
Scheme_Object argv[] 
) [static]

Definition at line 6819 of file thread.c.

{
  return scheme_param_config("current-thread-initial-stack-size", 
                          scheme_make_integer(MZCONFIG_THREAD_INIT_STACK_SIZE),
                          argc, argv,
                          -1, exact_positive_integer_p, "exact positive integer", 0);
}

Here is the call graph for this function:

Here is the caller graph for this function:

static Scheme_Object * current_thread_set ( int  argc,
Scheme_Object argv[] 
) [static]

Definition at line 2043 of file thread.c.

{
  return scheme_param_config("current-thread-group", 
                          scheme_make_integer(MZCONFIG_THREAD_SET),
                          argc, argv,
                          -1, thread_set_p, "thread-group", 0);
}

Here is the call graph for this function:

Here is the caller graph for this function:

static Scheme_Object * custodian_box_p ( int  argc,
Scheme_Object argv[] 
) [static]

Definition at line 1831 of file thread.c.

{
  if (SAME_TYPE(SCHEME_TYPE(argv[0]), scheme_cust_box_type))
    return scheme_true;
  else
    return scheme_false;
}

Here is the caller graph for this function:

static Scheme_Object * custodian_box_value ( int  argc,
Scheme_Object argv[] 
) [static]

Definition at line 1817 of file thread.c.

{
  Scheme_Custodian_Box *cb;

  if (!SAME_TYPE(SCHEME_TYPE(argv[0]), scheme_cust_box_type))
    scheme_wrong_type("custodian-box-value", "custodian-box", 0, argc, argv);

  cb = (Scheme_Custodian_Box *)argv[0];
  if (cb->cust->shut_down)
    return scheme_false;

  return cb->v;
}

Here is the caller graph for this function:

static Scheme_Object * custodian_can_mem ( int  argc,
Scheme_Object args[] 
) [static]

Definition at line 1019 of file thread.c.

{
#ifdef NEWGC_BTC_ACCOUNT
  return scheme_true;
#else
  return scheme_false;
#endif
}

Here is the caller graph for this function:

static Scheme_Object * custodian_close_all ( int  argc,
Scheme_Object argv[] 
) [static]

Definition at line 1645 of file thread.c.

{
  if (!SCHEME_CUSTODIANP(argv[0]))
    scheme_wrong_type("custodian-shutdown-all", "custodian", 0, argc, argv);

  scheme_close_managed((Scheme_Custodian *)argv[0]);

  return scheme_void;
}

Here is the caller graph for this function:

static Scheme_Object * custodian_limit_mem ( int  argc,
Scheme_Object args[] 
) [static]

Definition at line 977 of file thread.c.

{
  long lim;
  
  if (NOT_SAME_TYPE(SCHEME_TYPE(args[0]), scheme_custodian_type)) {
    scheme_wrong_type("custodian-limit-memory", "custodian", 0, argc, args);
    return NULL;
  }

  if (SCHEME_INTP(args[1]) && (SCHEME_INT_VAL(args[1]) > 0)) {
    lim = SCHEME_INT_VAL(args[1]);
  } else if (SCHEME_BIGNUMP(args[1]) && SCHEME_BIGPOS(args[1])) {
    lim = 0x3fffffff; /* more memory than we actually have */
  } else {
    scheme_wrong_type("custodian-limit-memory", "positive exact integer", 1, argc, args);
    return NULL;
  }

  if (argc > 2) {
    if (NOT_SAME_TYPE(SCHEME_TYPE(args[2]), scheme_custodian_type)) {
      scheme_wrong_type("custodian-require-memory", "custodian", 2, argc, args);
      return NULL;
    }
  }

  ((Scheme_Custodian *)args[0])->has_limit = 1;
  adjust_limit_table((Scheme_Custodian *)args[0]);
  if (argc > 2) {
    ((Scheme_Custodian *)args[2])->has_limit = 1;
    adjust_limit_table((Scheme_Custodian *)args[2]);
  }

#ifdef NEWGC_BTC_ACCOUNT
  if (GC_set_account_hook(MZACCT_LIMIT, args[0], lim, (argc > 2) ? args[2] : args[0]))
    return scheme_void;
#endif

  scheme_raise_exn(MZEXN_FAIL_UNSUPPORTED,
                 "custodian-limit-memory: not supported");
  return NULL; /* doesn't get here */
}

Here is the call graph for this function:

Here is the caller graph for this function:

static Scheme_Object * custodian_p ( int  argc,
Scheme_Object argv[] 
) [static]

Definition at line 1640 of file thread.c.

{
  return SCHEME_CUSTODIANP(argv[0]) ? scheme_true : scheme_false;
}

Here is the caller graph for this function:

static Scheme_Object * custodian_require_mem ( int  argc,
Scheme_Object args[] 
) [static]

Definition at line 927 of file thread.c.

{
  long lim;
  Scheme_Custodian *c1, *c2, *cx;

  if(NOT_SAME_TYPE(SCHEME_TYPE(args[0]), scheme_custodian_type)) {
    scheme_wrong_type("custodian-require-memory", "custodian", 0, argc, args);
    return NULL;
  }

  if (SCHEME_INTP(args[1]) && (SCHEME_INT_VAL(args[1]) > 0)) {
    lim = SCHEME_INT_VAL(args[1]);
  } else if (SCHEME_BIGNUMP(args[1]) && SCHEME_BIGPOS(args[1])) {
    lim = 0x3fffffff; /* more memory than we actually have */
  } else {
    scheme_wrong_type("custodian-require-memory", "positive exact integer", 1, argc, args);
    return NULL;
  }

  if(NOT_SAME_TYPE(SCHEME_TYPE(args[2]), scheme_custodian_type)) {
    scheme_wrong_type("custodian-require-memory", "custodian", 2, argc, args);
    return NULL;
  }

  c1 = (Scheme_Custodian *)args[0];
  c2 = (Scheme_Custodian *)args[2];

  /* Check whether c1 is super to c2: */
  if (c1 == c2) {
    cx = NULL;
  } else {
    for (cx = c2; cx && NOT_SAME_OBJ(cx, c1); ) {
      cx = CUSTODIAN_FAM(cx->parent);
    }
  }
  if (!cx) {
    scheme_raise_exn(MZEXN_FAIL_CONTRACT,
                     "custodian-require-memory: second custodian is not a sub-custodian of the first custodian");
  }

#ifdef NEWGC_BTC_ACCOUNT
  if (GC_set_account_hook(MZACCT_REQUIRE, c1, lim, c2))
    return scheme_void;
#endif

  scheme_raise_exn(MZEXN_FAIL_UNSUPPORTED,
                 "custodian-require-memory: not supported");
  return NULL; /* doesn't get here */
}

Here is the call graph for this function:

Here is the caller graph for this function:

static Scheme_Object * custodian_to_list ( int  argc,
Scheme_Object argv[] 
) [static]

Definition at line 1677 of file thread.c.

{
  Scheme_Custodian *m, *m2, *c;
  Scheme_Object **hold, *o;
  int i, j, cnt, kids;
  Scheme_Type type;
  Scheme_Custodian_Extractor ex;

  if (!SCHEME_CUSTODIANP(argv[0]))
    scheme_wrong_type("custodian-managed-list", "custodian", 0, argc, argv);
  if (!SCHEME_CUSTODIANP(argv[1]))
    scheme_wrong_type("custodian-managed-list", "custodian", 1, argc, argv);

  m = (Scheme_Custodian *)argv[0];
  m2 = (Scheme_Custodian *)argv[1];

  /* Check that the second manages the first: */
  c = CUSTODIAN_FAM(m->parent);
  while (c && NOT_SAME_OBJ(m2, c)) {
    c = CUSTODIAN_FAM(c->parent);
  }
  if (!c) {
    scheme_arg_mismatch("custodian-managed-list",
                     "the second custodian does not "
                     "manage the first custodian: ",
                     argv[0]);
  }

  /* Init extractors: */
  scheme_add_custodian_extractor(0, NULL);

  /* Count children: */
  kids = 0;
  for (c = CUSTODIAN_FAM(m->children); c; c = CUSTODIAN_FAM(c->sibling)) {
    kids++;
  }

  /* Do all allocation first, since custodian links are weak.
     Furthermore, allocation may trigger collection of an otherwise
     unreferenced custodian, folding its items into this one,
     so loop until we've allocated enough. */
  do {
    cnt = m->count;
    hold = MALLOC_N(Scheme_Object *, cnt + kids);
  } while (cnt < m->count);
  
  /* Put managed items into hold array: */
  for (i = m->count, j = 0; i--; ) {
    if (m->boxes[i]) {
      o = xCUSTODIAN_FAM(m->boxes[i]);
      
      type = SCHEME_TYPE(o);
      ex = extractors[type];
      if (ex) {
       o = ex(o);
      }

      if (o) {
       hold[j] = o;
       j++;
      }
    }
  }
  /* Add kids: */
  for (c = CUSTODIAN_FAM(m->children); c; c = CUSTODIAN_FAM(c->sibling)) {
    hold[j] = (Scheme_Object *)c;
    j++;
  }

  /* Convert the array to a list: */
  return scheme_build_list(j, hold);
}

Here is the call graph for this function:

Here is the caller graph for this function:

static int dead_ready ( Scheme_Object o,
Scheme_Schedule_Info sinfo 
) [static]

Definition at line 5167 of file thread.c.

{
  scheme_set_sync_target(sinfo, SCHEME_PTR_VAL(o), o, NULL, 0, 1, NULL);
  return 0;
}

Here is the call graph for this function:

Here is the caller graph for this function:

static Scheme_Object* def_nested_exn_handler ( int  argc,
Scheme_Object argv[] 
) [static]

Definition at line 3218 of file thread.c.

{
  if (scheme_current_thread->nester) {
    Scheme_Thread *p = scheme_current_thread;
    p->cjs.jumping_to_continuation = (Scheme_Object *)scheme_current_thread;
    p->cjs.val = argv[0];
    p->cjs.is_kill = 0;
    scheme_longjmp(*p->error_buf, 1);
  }

  return scheme_void; /* misuse of exception handler (wrong kind of thread or under prompt) */
}

Here is the caller graph for this function:

static Scheme_Config* do_extend_config ( Scheme_Config c,
Scheme_Object key,
Scheme_Object cell 
) [static]

Definition at line 6122 of file thread.c.

{
  Scheme_Config *naya;

  /* In principle, the key+cell link should be weak, but it's
     difficult to imagine a parameter being GC'ed while an active
     `parameterize' is still on the stack (or, at least, difficult to
     imagine that it matters). */

  if (c->depth > 50)
    scheme_flatten_config(c);

  naya = MALLOC_ONE_TAGGED(Scheme_Config);
  naya->so.type = scheme_config_type;
  naya->depth = c->depth + 1;
  naya->key = key;
  naya->cell = cell; /* could be just a value */
  naya->next = c;

  return naya;
}

Here is the call graph for this function:

Here is the caller graph for this function:

static int do_kill_thread ( Scheme_Thread p) [static]

Definition at line 4536 of file thread.c.

{
  int kill_self = 0;

  if (!MZTHREAD_STILL_RUNNING(p->running)) {
    return 0;
  }

  if (p->suspend_to_kill) {
    if (p == scheme_current_thread)
      return 1; /* suspend in caller */
    suspend_thread(p);
    return 0;
  }

  if (p->nestee)
    scheme_break_thread(p->nestee);

  while (p->private_on_kill) {
    p->private_on_kill(p->private_kill_data);
    if (p->private_kill_next) {
      p->private_on_kill = (Scheme_Kill_Action_Func)p->private_kill_next[0];
      p->private_kill_data = p->private_kill_next[1];
      p->private_kill_next = (void **)p->private_kill_next[2];
    } else {
      p->private_on_kill = NULL;
      p->private_kill_data = NULL;
    }
  }

  if (p->on_kill)
    p->on_kill(p);

  scheme_remove_managed(p->mref, (Scheme_Object *)p->mr_hop);
  {
    Scheme_Object *l;
    for (l = p->extra_mrefs; !SCHEME_NULLP(l); l = SCHEME_CDR(l)) {
      scheme_remove_managed((Scheme_Custodian_Reference *)SCHEME_CAR(l), 
                         (Scheme_Object *)p->mr_hop);
    }
  }

  if (p->running) {
    if (p->running & MZTHREAD_USER_SUSPENDED) {
      /* end user suspension, because we need to kill the thread */
      p->running -= MZTHREAD_USER_SUSPENDED;
    }

    p->running |= MZTHREAD_KILLED;
    if ((p->running & MZTHREAD_NEED_KILL_CLEANUP)
       || p->nester)
      scheme_weak_resume_thread(p);
    else if (p != scheme_current_thread) {
      /* Do kill stuff... */
      if (p->next)
       remove_thread(p);
    }
  }
  if (p == scheme_current_thread)
    kill_self = 1;

  return kill_self;
}

Here is the call graph for this function:

Here is the caller graph for this function:

static Scheme_Object* do_next_will ( WillExecutor w) [static]

Definition at line 7085 of file thread.c.

{
  ActiveWill *a;
  Scheme_Object *o[1];

  a = w->first;
  w->first = a->next;
  if (!w->first)
    w->last = NULL;
  
  o[0] = a->o;
  a->o = NULL;

  return scheme_apply_multi(a->proc, 1, o);
}

Here is the caller graph for this function:

static Scheme_Object * do_param ( void data,
int  argc,
Scheme_Object argv[] 
) [static]

Definition at line 6360 of file thread.c.

{
  Scheme_Object *guard, **argv2, *pos[2];
  ParamData *data = (ParamData *)_data;

  if (argc && argv[0]) {
    guard = data->guard;
    if (guard) {
      Scheme_Object *v;
      
      v = scheme_apply(guard, 1, argv);

      if (argc == 2) {
       /* Special hook for parameterize: */
       argv[1] = v;
       return data->key;
      }

      argv2 = MALLOC_N(Scheme_Object *, argc);
      memcpy(argv2, argv, argc * sizeof(Scheme_Object *));
      argv2[0] = v;
    } else if (argc == 2) {
      /* Special hook for parameterize: */
      argv[1] = argv[0];
      return data->key;
    } else
      argv2 = argv;
  } else
    argv2 = argv;

  if (data->is_derived) {
    if (!argc) {
      Scheme_Object *v;
      v = _scheme_apply(data->key, argc, argv2);
      pos[0] = v;
      return _scheme_tail_apply(data->extract_guard, 1, pos);
    } else {
      return _scheme_tail_apply(data->key, argc, argv2);
    }
  }

  pos[0] = data->key;
  pos[1] = data->defcell;
  
  return scheme_param_config("parameter-procedure", 
                          (Scheme_Object *)(void *)pos,
                          argc, argv2,
                          -2, NULL, NULL, 0);
}

Here is the call graph for this function:

Here is the caller graph for this function:

static Scheme_Object* do_scheme_sync_enable_break ( const char *  who,
int  with_timeout,
int  tailok,
int  argc,
Scheme_Object argv[] 
) [static]

Definition at line 5939 of file thread.c.

{
  if (argc == 2 && SCHEME_FALSEP(argv[0]) && SCHEME_SEMAP(argv[1])) {
    scheme_wait_sema(argv[1], -1);
    return scheme_void;
  }

  return do_sync(who, argc, argv, 1, with_timeout, tailok);
}

Here is the call graph for this function:

Here is the caller graph for this function:

static void do_swap_thread ( ) [static]

Definition at line 2495 of file thread.c.

{
 start:

  scheme_zero_unneeded_rands(scheme_current_thread);

#if WATCH_FOR_NESTED_SWAPS
  if (swapping)
    printf("death\n");
  swapping = 1;
#endif

  if (!swap_no_setjmp && SETJMP(scheme_current_thread)) {
    /* We're back! */
    /* See also initial swap in in start_child() */
    thread_swap_count++;
#ifdef RUNSTACK_IS_GLOBAL
    MZ_RUNSTACK = scheme_current_thread->runstack;
    MZ_RUNSTACK_START = scheme_current_thread->runstack_start;
    MZ_CONT_MARK_STACK = scheme_current_thread->cont_mark_stack;
    MZ_CONT_MARK_POS = scheme_current_thread->cont_mark_pos;
#endif
    RESETJMP(scheme_current_thread);
#if WATCH_FOR_NESTED_SWAPS
    swapping = 0;
#endif
    scheme_gmp_tls_unload(scheme_current_thread->gmp_tls, scheme_current_thread->gmp_tls_data);
    scheme_current_thread->gmp_tls_data = NULL;

    {
      Scheme_Object *l, *o;
      Scheme_Closure_Func f;
      for (l = thread_swap_callbacks; SCHEME_RPAIRP(l); l = SCHEME_CDR(l)) {
       o = SCHEME_CAR(l);
       f = SCHEME_CLOS_FUNC(o);
       o = SCHEME_CLOS_DATA(o);
       f(o);
      }
    }
    if ((scheme_current_thread->runstack_owner
        && ((*scheme_current_thread->runstack_owner) != scheme_current_thread))
       || (scheme_current_thread->cont_mark_stack_owner
           && ((*scheme_current_thread->cont_mark_stack_owner) != scheme_current_thread))) {
      scheme_takeover_stacks(scheme_current_thread);
    }

    {
      long cpm;
      cpm = scheme_get_process_milliseconds();
      scheme_current_thread->current_start_process_msec = cpm;
    }

    if (scheme_current_thread->return_marks_to) {
      stash_current_marks();
      goto start;
    }
  } else {
    Scheme_Thread *new_thread = swap_target;

    {
      long cpm;
      cpm = scheme_get_process_milliseconds();
      scheme_current_thread->accum_process_msec += (cpm - scheme_current_thread->current_start_process_msec);
    }

    swap_target = NULL;

    swap_no_setjmp = 0;

    /* We're leaving... */

    {
      Scheme_Object *l, *o;
      Scheme_Closure_Func f;
      for (l = thread_swap_out_callbacks; SCHEME_RPAIRP(l); l = SCHEME_CDR(l)) {
       o = SCHEME_CAR(l);
       f = SCHEME_CLOS_FUNC(o);
       o = SCHEME_CLOS_DATA(o);
       f(o);
      }
    }

    if (scheme_current_thread->init_break_cell) {
      int cb;
      cb = can_break_param(scheme_current_thread);
      scheme_current_thread->can_break_at_swap = cb;
    }
    {
      GC_CAN_IGNORE void *data;
      data = scheme_gmp_tls_load(scheme_current_thread->gmp_tls);
      scheme_current_thread->gmp_tls_data = data;
    }
#ifdef RUNSTACK_IS_GLOBAL
    scheme_current_thread->runstack = MZ_RUNSTACK;
    scheme_current_thread->runstack_start = MZ_RUNSTACK_START;
    scheme_current_thread->cont_mark_stack = MZ_CONT_MARK_STACK;
    scheme_current_thread->cont_mark_pos = MZ_CONT_MARK_POS;
#endif
    scheme_current_thread = new_thread;

    /* Fixup current pointers in thread sets */
    if (!scheme_current_thread->return_marks_to) {
      Scheme_Thread_Set *t_set = new_thread->t_set_parent;
      t_set->current = (Scheme_Object *)new_thread;
      while (t_set->parent) {
       t_set->parent->current = (Scheme_Object *)t_set;
       t_set = t_set->parent;
      }
    }

    LONGJMP(scheme_current_thread);
  }
}

Here is the call graph for this function:

Here is the caller graph for this function:

static Scheme_Object* do_sync ( const char *  name,
int  argc,
Scheme_Object argv[],
int  with_break,
int  with_timeout,
int  _tailok 
) [static]

Definition at line 5741 of file thread.c.

{
  volatile int tailok = _tailok;
  Evt_Set * volatile evt_set;
  Syncing * volatile syncing;
  volatile float timeout = -1.0;
  double start_time;
  Scheme_Cont_Frame_Data cframe;

  if (with_timeout) {
    if (!SCHEME_FALSEP(argv[0])) {
      if (SCHEME_REALP(argv[0]))
       timeout = (float)scheme_real_to_double(argv[0]);
      
      if (timeout < 0.0) {
       scheme_wrong_type(name, "non-negative real number", 0, argc, argv);
       return NULL;
      }
      
      start_time = scheme_get_inexact_milliseconds();
    } else
      start_time = 0;
  } else {
    start_time = 0;
  }

  /* Special case: no timeout, only object is a semaphore */
  if (argc == (with_timeout + 1) && !start_time && SCHEME_SEMAP(argv[with_timeout])) {
    scheme_wait_sema(argv[with_timeout], with_break ? -1 : 0);
    return argv[with_timeout];
  }

  evt_set = NULL;

  /* Special case: only argument is an immutable evt set: */
  if ((argc == (with_timeout + 1)) && SCHEME_EVTSETP(argv[with_timeout])) {
    int i;
    evt_set = (Evt_Set *)argv[with_timeout];
    for (i = evt_set->argc; i--; ) {
      if (evt_set->ws[i]->can_redirect) {
       /* Need to copy this set to handle redirections. */
       evt_set = NULL;
       break;
      }
    }
  }

  if (!evt_set)
    evt_set = make_evt_set(name, argc, argv, with_timeout);

  if (with_break) {
    scheme_push_break_enable(&cframe, 1, 1);
  }

  /* Check for another special case: syncing on a set of semaphores
     without a timeout. Use general code for channels.
     (Note that we check for this case after evt-set flattening.) */
  if (timeout < 0.0) {
    int i;
    for (i = evt_set->argc; i--; ) {
      if (!SCHEME_SEMAP(evt_set->argv[i]))
       break;
    }
    if (i < 0) {
      /* Hit the special case. */
      i = scheme_wait_semas_chs(evt_set->argc, evt_set->argv, 0, NULL);

      if (with_break) {
       scheme_pop_break_enable(&cframe, 1);
      } else {
       /* In case a break appeared after we received a post,
          check for a break, because scheme_wait_semas_chs() won't: */
       scheme_check_break_now();
      }

      if (i)
       return evt_set->argv[i - 1];
      else
       return (tailok ? scheme_false : NULL);
    }
  }

  syncing = make_syncing(evt_set, timeout, start_time);

  if (timeout < 0.0)
    timeout = 0.0; /* means "no timeout" to block_until */

  if (with_break) {
    /* Suspended breaks when something is selected. */
    syncing->disable_break = scheme_current_thread;
  }

  BEGIN_ESCAPEABLE(scheme_post_syncing_nacks, syncing);
  scheme_block_until((Scheme_Ready_Fun)syncing_ready, syncing_needs_wakeup, 
                   (Scheme_Object *)syncing, timeout);
  END_ESCAPEABLE();

  if (!syncing->result)
    scheme_post_syncing_nacks(syncing);

  if (with_break) {
    scheme_pop_break_enable(&cframe, 0);
  }

  if (with_break) {
    /* Reverse low-level break disable: */
    --syncing->disable_break->suspend_break;
  }

  if (syncing->result) {
    /* Apply wrap functions to the selected evt: */
    Scheme_Object *o, *l, *a, *to_call = NULL, *args[1];
    int to_call_is_cont = 0;

    o = evt_set->argv[syncing->result - 1];
    if (SAME_TYPE(SCHEME_TYPE(o), scheme_channel_syncer_type)) {
      /* This is a put that got changed to a syncer, but not changed back */
      o = ((Scheme_Channel_Syncer *)o)->obj;
    }
    if (syncing->wrapss) {
      l = syncing->wrapss[syncing->result - 1];
      if (l) {
       for (; SCHEME_PAIRP(l); l = SCHEME_CDR(l)) {
         a = SCHEME_CAR(l);
         if (to_call) {
           args[0] = o;
           
           /* Call wrap proc with breaks disabled */
           scheme_push_break_enable(&cframe, 0, 0);
           
           o = scheme_apply(to_call, 1, args);
           
           scheme_pop_break_enable(&cframe, 0);

           to_call = NULL;
         }
         if (SCHEME_BOXP(a) || SCHEME_PROCP(a)) {
           if (SCHEME_BOXP(a)) {
             a = SCHEME_BOX_VAL(a);
             to_call_is_cont = 1;
           }
           to_call = a;
         } else if (SAME_TYPE(scheme_thread_suspend_type, SCHEME_TYPE(a))
                   || SAME_TYPE(scheme_thread_resume_type, SCHEME_TYPE(a)))
           o = SCHEME_PTR2_VAL(a);
         else
           o = a;
       }

       if (to_call) {
         args[0] = o;
         
         /* If to_call is still a wrap-evt (not a cont-evt),
            then set the config one more time: */
         if (!to_call_is_cont) {
           scheme_push_break_enable(&cframe, 0, 0);
           tailok = 0;
         }

         if (tailok) {
           return _scheme_tail_apply(to_call, 1, args);
         } else {
           o = scheme_apply(to_call, 1, args);
           if (!to_call_is_cont)
             scheme_pop_break_enable(&cframe, 1);
           return o;
         }
       }
      }
    }
    return o;
  } else if (tailok)
    return scheme_false;
  else
    return NULL;
}

Here is the call graph for this function:

Here is the caller graph for this function:

static void done_with_GC ( void  ) [static]

Definition at line 7382 of file thread.c.

{
  scheme_gmp_tls_unload(scheme_current_thread->gmp_tls, scheme_current_thread->gmp_tls_data);
  scheme_current_thread->gmp_tls_data = NULL;

#ifdef RUNSTACK_IS_GLOBAL
# ifdef MZ_PRECISE_GC
  if (scheme_current_thread->running) {
    MZ_RUNSTACK = scheme_current_thread->runstack;
    MZ_RUNSTACK_START = scheme_current_thread->runstack_start;
  }
# endif
#endif
#ifdef WINDOWS_PROCESSES
  scheme_resume_remembered_threads();
#endif
#ifdef UNIX_PROCESSES
  scheme_block_child_signals(0);
#endif

  end_this_gc_time = scheme_get_process_milliseconds();
  scheme_total_gc_time += (end_this_gc_time - start_this_gc_time);
}

Here is the call graph for this function:

Here is the caller graph for this function:

static void ensure_custodian_space ( Scheme_Custodian m,
int  k 
) [static]

Definition at line 1050 of file thread.c.

{
  int i;

  if (m->count + k >= m->alloc) {
    Scheme_Object ***naya_boxes;
    Scheme_Custodian_Reference **naya_mrefs;
    Scheme_Close_Custodian_Client **naya_closers;
    void **naya_data;

    m->alloc = (m->alloc ? (2 * m->alloc) : 4);
    if (m->alloc < k)
      m->alloc += k;
    
    naya_boxes = MALLOC_N(Scheme_Object**, m->alloc);
    naya_closers = MALLOC_N(Scheme_Close_Custodian_Client*, m->alloc);
    naya_data = MALLOC_N(void*, m->alloc);
    naya_mrefs = MALLOC_N(Scheme_Custodian_Reference*, m->alloc);

    for (i = m->count; i--; ) {
      naya_boxes[i] = m->boxes[i];
      m->boxes[i] = NULL;
      naya_closers[i] = m->closers[i];
      m->closers[i] = NULL;
      naya_data[i] = m->data[i];
      m->data[i] = NULL;
      naya_mrefs[i] = m->mrefs[i];
      m->mrefs[i] = NULL;
    }

    m->boxes = naya_boxes;
    m->closers = naya_closers;
    m->data = naya_data;
    m->mrefs = naya_mrefs;
  }
}

Here is the caller graph for this function:

static Scheme_Object * evt_p ( int  argc,
Scheme_Object args[] 
) [static]

Definition at line 5642 of file thread.c.

{
  return (scheme_is_evt(argv[0])
         ? scheme_true
         : scheme_false);
}

Here is the caller graph for this function:

static Scheme_Object * evts_to_evt ( int  argc,
Scheme_Object args[] 
) [static]

Definition at line 5964 of file thread.c.

{
  return (Scheme_Object *)make_evt_set("choice-evt", argc, argv, 0);
}

Here is the call graph for this function:

Here is the caller graph for this function:

static Scheme_Object* exact_positive_integer_p ( int  argc,
Scheme_Object argv[] 
) [static]

Definition at line 6808 of file thread.c.

{
  Scheme_Object *n = argv[0];
  if (SCHEME_INTP(n) && (SCHEME_INT_VAL(n) > 0))
    return scheme_true;
  if (SCHEME_BIGNUMP(n) && SCHEME_BIGPOS(n))
    return scheme_true;

  return scheme_false;
}

Here is the caller graph for this function:

static void exit_or_escape ( Scheme_Thread p) [static]

Definition at line 3839 of file thread.c.

{
  /* Maybe this killed thread is nested: */
  if (p->nester) {
    if (p->running & MZTHREAD_KILLED)
      p->running -= MZTHREAD_KILLED;
    p->cjs.jumping_to_continuation = (Scheme_Object *)p;
    p->cjs.is_kill = 1;
    scheme_longjmp(*p->error_buf, 1);
  }

  if (SAME_OBJ(p, scheme_main_thread)) {
    /* Hard exit: */
    if (scheme_exit)
      scheme_exit(0);
    
    /* We really have to exit: */
    exit(0);
  }

  remove_thread(p);
  select_thread();
}

Here is the call graph for this function:

Here is the caller graph for this function:

static Scheme_Object * extend_parameterization ( int  argc,
Scheme_Object args[] 
) [static]

Definition at line 6309 of file thread.c.

{
  Scheme_Object *key, *a[2], *param;
  Scheme_Config *c;
  int i;

  c = (Scheme_Config *)argv[0];

  if (argc < 2) {
    scheme_flatten_config(c);
  } else if (SCHEME_CONFIGP(c) && (argc & 1)) {
    for (i = 1; i < argc; i += 2) {
      if (!SCHEME_PARAMETERP(argv[i])) {
       scheme_wrong_type("parameterize", "parameter", i, argc, argv);
       return NULL;
      }
      a[0] = argv[i + 1];
      a[1] = scheme_false;
      param = argv[i];
      while (1) {
        if (SCHEME_PRIMP(param)) {
          Scheme_Prim *proc;
          proc = (Scheme_Prim *)((Scheme_Primitive_Proc *)param)->prim_val;
          key = proc(2, a); /* leads to scheme_param_config to set a[1] */
          break;
        } else {
          /* sets a[1] */
          key = do_param(((Scheme_Closed_Primitive_Proc *)param)->data, 2, a);
          if (SCHEME_PARAMETERP(key)) {
            param = key;
            a[0] = a[1];
          } else
            break;
        }
      }
      c = do_extend_config(c, key, a[1]);
    }
  }

  return (Scheme_Object *)c;
}

Here is the call graph for this function:

Here is the caller graph for this function:

static Scheme_Object* extract_thread ( Scheme_Object o) [static]

Definition at line 1656 of file thread.c.

Here is the caller graph for this function:

static Evt* find_evt ( Scheme_Object o) [static]

Definition at line 5237 of file thread.c.

{
  Scheme_Type t;
  Evt *w;

  t = SCHEME_TYPE(o);
  w = evts[t];
  if (w) {
    if (w->filter) {
      Scheme_Sync_Filter_Fun filter;
      filter = w->filter;
      if (!filter(o))
       return NULL;
    }
    return w;
  }

  return NULL;
}

Here is the caller graph for this function:

static void find_next_thread ( Scheme_Thread **  return_arg) [static]

Definition at line 3919 of file thread.c.

                                                         {
  Scheme_Thread *next;
  Scheme_Thread *p = scheme_current_thread;
  Scheme_Object *next_in_set;
  Scheme_Thread_Set *t_set;

  double msecs = 0.0;

  /* Find the next process. Skip processes that are definitely
     blocked. */

  /* Start from the root */
  next_in_set = (Scheme_Object *)scheme_thread_set_top;
  t_set = NULL; /* this will get set at the beginning of the loop */

  /* Each thread may or may not be available. If it's not available,
     we search thread by thread to find something that is available. */
  while (1) {
    /* next_in_set is the thread or set to try... */

    /* While it's a set, go down into the set, choosing the next
       item after the set's current. For each set, remember where we
       started searching for something to run, so we'll know when
       we've tried everything in the set. */
    while (!SCHEME_THREADP(next_in_set)) {
      t_set = (Scheme_Thread_Set *)next_in_set;
      next_in_set = get_t_set_next(t_set->current);
      if (!next_in_set)
        next_in_set = t_set->first;
      t_set->current = next_in_set;
      t_set->search_start = next_in_set;
    }

    /* Now `t_set' is the set we're trying, and `next' will be the
       thread to try: */
    next = (Scheme_Thread *)next_in_set;

    /* If we get back to the current thread, then
       no other thread was ready. */
    if (SAME_PTR(next, p)) {
      next = NULL;
      break;
    }

    /* Check whether `next' is ready... */

    if (next->nestee) {
      /* Blocked on nestee */
    } else if (next->running & MZTHREAD_USER_SUSPENDED) {
      if (next->next || (next->running & MZTHREAD_NEED_SUSPEND_CLEANUP)) {
        /* If a non-main thread is still in the queue, 
           it needs to be swapped in so it can clean up
           and suspend itself. */
        break;
      }
    } else if (next->running & MZTHREAD_KILLED) {
      /* This one has been terminated. */
      if ((next->running & MZTHREAD_NEED_KILL_CLEANUP) 
          || next->nester
          || !next->next) {
        /* The thread needs to clean up. Swap it in so it can die. */
        break;
      } else
        remove_thread(next);
      break;
    } else if (next->external_break && scheme_can_break(next)) {
      break;
    } else {
      if (next->block_descriptor == GENERIC_BLOCKED) {
        if (next->block_check) {
          Scheme_Ready_Fun_FPC f = (Scheme_Ready_Fun_FPC)next->block_check;
          Scheme_Schedule_Info sinfo;
          init_schedule_info(&sinfo, next, next->sleep_end);
          if (f(next->blocker, &sinfo))
            break;
          next->sleep_end = sinfo.sleep_end;
          msecs = 0.0; /* that could have taken a while */
        }
      } else if (next->block_descriptor == SLEEP_BLOCKED) {
        if (!msecs)
          msecs = scheme_get_inexact_milliseconds();
        if (next->sleep_end <= msecs)
          break;
      } else
        break;
    }

    /* Look for the next thread/set in this set */
    if (next->t_set_next)
      next_in_set = next->t_set_next;
    else
      next_in_set = t_set->first;

    /* If we run out of things to try in this set,
       go up to find the next set. */
    if (SAME_OBJ(next_in_set, t_set->search_start)) {
      /* Loop to go up past exhausted sets, clearing search_start
         from each exhausted set. */
      while (1) {
        t_set->search_start = NULL;
        t_set = t_set->parent;

        if (t_set) {
          next_in_set = get_t_set_next(t_set->current);
          if (!next_in_set)
            next_in_set = t_set->first;

          if (SAME_OBJ(next_in_set, t_set->search_start)) {
            t_set->search_start = NULL;
            /* continue going up */
          } else {
            t_set->current = next_in_set;
            break;
          }
        } else
          break;
      }

      if (!t_set) {
        /* We ran out of things to try. If we
           start again with the top, we should
           land back at p. */
        next = NULL;
        break;
      }
    } else {
      /* Set current... */
      t_set->current = next_in_set;
    } 
    /* As we go back to the top of the loop, we'll check whether
       next_in_set is a thread or set, etc. */
  }

  p           = NULL;
  next_in_set = NULL;
  t_set       = NULL;
  *return_arg = next;
  next        = NULL;
}

Here is the call graph for this function:

Here is the caller graph for this function:

Scheme_Object* find_param_cell ( Scheme_Config c,
Scheme_Object k,
int  force_cell 
)

Definition at line 6160 of file thread.c.

{
  while (1) {
    if (SAME_OBJ(c->key, k)) {
      if (force_cell && !SCHEME_THREAD_CELLP(c->cell)) {
       Scheme_Object *cell;
       cell = scheme_make_thread_cell(c->cell, 1);
       c->cell = cell;
      }
      return c->cell;
    } else if (!c->next) {
      /* Eventually bottoms out here */
      Scheme_Parameterization *p = (Scheme_Parameterization *)c->cell;
      if (SCHEME_INTP(k))
       return p->prims[SCHEME_INT_VAL(k)];
      else {
       if (p->extensions)
         return scheme_lookup_in_table(p->extensions, (const char *)k);
       else
         return NULL;
      }
    } else
      c = c->next;
  }
}

Here is the call graph for this function:

Here is the caller graph for this function:

static void for_each_managed ( Scheme_Type  type,
Scheme_For_Each_Func  cf 
) [static]

Definition at line 1555 of file thread.c.

{
  Scheme_Custodian *m;
  int i;

  if (SAME_TYPE(type, scheme_thread_type))
    type = scheme_thread_hop_type;

  /* back to front so children are first: */
  m = last_custodian;

  while (m) {
    for (i = m->count; i--; ) {
      if (m->boxes[i]) {
       Scheme_Object *o;

       o = xCUSTODIAN_FAM(m->boxes[i]);
      
       if (SAME_TYPE(SCHEME_TYPE(o), type)) {
         if (SAME_TYPE(type, scheme_thread_hop_type)) {
           /* We've added an indirection and made it weak. See mr_hop note above. */
           Scheme_Thread *t;
           t = (Scheme_Thread *)WEAKIFIED(((Scheme_Thread_Custodian_Hop *)o)->p);
           if (!t) {
             /* The thread is already collected */
             continue;
           } else if (SAME_OBJ(t->mref, m->mrefs[i]))
             o = (Scheme_Object *)t;
           else {
             /* The main custodian for this thread is someone else */
             continue;
           }
         }

         cf(o);
       }
      }
    }

    m = CUSTODIAN_FAM(m->global_prev);
  }
}

Here is the caller graph for this function:

Definition at line 1198 of file misc.c.

{
  long c = 0;
  LOCK();
  GC_apply_to_all_blocks(get_size, (word)&c);
  UNLOCK();
  return c;
}

Here is the call graph for this function:

static void get_ready_for_GC ( void  ) [static]

Definition at line 7333 of file thread.c.

{
  start_this_gc_time = scheme_get_process_milliseconds();

  scheme_zero_unneeded_rands(scheme_current_thread);

  scheme_clear_modidx_cache();
  scheme_clear_shift_cache();
  scheme_clear_prompt_cache();
  scheme_clear_rx_buffers();
  scheme_clear_bignum_cache();
  scheme_clear_delayed_load_cache();

#ifdef RUNSTACK_IS_GLOBAL
  if (scheme_current_thread->running) {
    scheme_current_thread->runstack = MZ_RUNSTACK;
    scheme_current_thread->runstack_start = MZ_RUNSTACK_START;
    scheme_current_thread->cont_mark_stack = MZ_CONT_MARK_STACK;
    scheme_current_thread->cont_mark_pos = MZ_CONT_MARK_POS;
  }
#endif

  for_each_managed(scheme_thread_type, prepare_thread_for_GC);

#ifdef MZ_PRECISE_GC
  scheme_flush_stack_copy_cache();
#endif

  scheme_fuel_counter = 0;
  scheme_jit_stack_boundary = (unsigned long)-1;

#ifdef WINDOWS_PROCESSES
  scheme_suspend_remembered_threads();
#endif
#ifdef UNIX_PROCESSES
  scheme_block_child_signals(1);
#endif

  {
    GC_CAN_IGNORE void *data;
    data = scheme_gmp_tls_load(scheme_current_thread->gmp_tls);
    scheme_current_thread->gmp_tls_data = data;
  }

  did_gc_count++;
}

Here is the call graph for this function:

Here is the caller graph for this function:

Definition at line 2067 of file thread.c.

{
  if (SCHEME_THREADP(o))
    return ((Scheme_Thread *)o)->t_set_next;
  else
    return ((Scheme_Thread_Set *)o)->next;
}

Here is the caller graph for this function:

Definition at line 2075 of file thread.c.

{
  if (SCHEME_THREADP(o))
    return ((Scheme_Thread *)o)->t_set_prev;
  else
    return ((Scheme_Thread_Set *)o)->prev;
}

Here is the caller graph for this function:

static Scheme_Thread_Cell_Table* inherit_cells ( Scheme_Thread_Cell_Table cells,
Scheme_Thread_Cell_Table t,
int  inherited 
) [static]

Definition at line 6008 of file thread.c.

{
  Scheme_Bucket *bucket;
  Scheme_Object *cell, *v;
  int i;

  if (!cells)
    cells = scheme_current_thread->cell_values;
  
  if (!t)
    t = scheme_make_bucket_table(20, SCHEME_hash_weak_ptr);
  
  for (i = cells->size; i--; ) {
    bucket = cells->buckets[i];
    if (bucket && bucket->val && bucket->key) {
      cell = (Scheme_Object *)HT_EXTRACT_WEAK(bucket->key);
      if (cell && (((Thread_Cell *)cell)->inherited == inherited)) {
       v = (Scheme_Object *)bucket->val;
       scheme_add_to_table(t, (char *)cell, v, 0);
      }
    }
  }

  return t;
}

Here is the caller graph for this function:

static void init_param ( Scheme_Thread_Cell_Table cells,
Scheme_Parameterization params,
int  pos,
Scheme_Object v 
) [static]

Definition at line 6488 of file thread.c.

{
  Scheme_Object *cell;
  cell = scheme_make_thread_cell(v, 1);
  params->prims[pos] = cell;
}

Here is the caller graph for this function:

static void init_schedule_info ( Scheme_Schedule_Info sinfo,
Scheme_Thread false_pos_ok,
double  sleep_end 
) [static]

Definition at line 3654 of file thread.c.

{
  sinfo->false_positive_ok = false_pos_ok;
  sinfo->potentially_false_positive = 0;
  sinfo->current_syncing = NULL;
  sinfo->spin = 0;
  sinfo->is_poll = 0;
  sinfo->sleep_end = sleep_end;
}

Here is the caller graph for this function:

Definition at line 1229 of file thread.c.

{
  /* insert into parent's list: */
  CUSTODIAN_FAM(m->parent) = parent;
  if (parent) {
    CUSTODIAN_FAM(m->sibling) = CUSTODIAN_FAM(parent->children);
    CUSTODIAN_FAM(parent->children) = m;
  } else
    CUSTODIAN_FAM(m->sibling) = NULL;

  /* Insert into global chain. A custodian is always inserted
     directly after its parent, so families stay together, and
     the local list stays in the same order as the sibling list. */
  if (parent) {
    Scheme_Custodian *next;
    next = CUSTODIAN_FAM(parent->global_next);
    CUSTODIAN_FAM(m->global_next) = next;
    CUSTODIAN_FAM(m->global_prev) = parent;
    CUSTODIAN_FAM(parent->global_next) = m;
    if (next)
      CUSTODIAN_FAM(next->global_prev) = m;
    else
      last_custodian = m;
  } else {
    CUSTODIAN_FAM(m->global_next) = NULL;
    CUSTODIAN_FAM(m->global_prev) = NULL;
  }

  if (parent)
    adjust_limit_table(parent);
}

Here is the call graph for this function:

Here is the caller graph for this function:

static Scheme_Object * kill_thread ( int  argc,
Scheme_Object args[] 
) [static]

Definition at line 4616 of file thread.c.

{
  Scheme_Thread *p = (Scheme_Thread *)argv[0];

  if (!SAME_TYPE(SCHEME_TYPE(argv[0]), scheme_thread_type))
    scheme_wrong_type("kill-thread", "thread", 0, argc, argv);

  if (!MZTHREAD_STILL_RUNNING(p->running))
    return scheme_void;

  check_current_custodian_allows("kill-thread", p);

  scheme_kill_thread(p);

  return scheme_void;
}

Here is the call graph for this function:

Here is the caller graph for this function:

static Scheme_Object * make_custodian ( int  argc,
Scheme_Object argv[] 
) [static]

Definition at line 1621 of file thread.c.

{
  Scheme_Custodian *m;

  if (argc) {
    if (!SCHEME_CUSTODIANP(argv[0]))
      scheme_wrong_type("make-custodian", "custodian", 0, argc, argv);
    m = (Scheme_Custodian *)argv[0];
  } else
    m = (Scheme_Custodian *)scheme_get_param(scheme_current_config(), MZCONFIG_CUSTODIAN);

  if (m->shut_down)
    scheme_arg_mismatch("make-custodian", 
                     "the custodian has been shut down: ", 
                     (Scheme_Object *)m);

  return (Scheme_Object *)scheme_make_custodian(m);
}

Here is the caller graph for this function:

static Scheme_Object * make_custodian_box ( int  argc,
Scheme_Object argv[] 
) [static]

Definition at line 1758 of file thread.c.

{
  Scheme_Custodian_Box *cb;

  if (!SCHEME_CUSTODIANP(argv[0]))
    scheme_wrong_type("make-custodian-box", "custodian", 0, argc, argv);

  cb = MALLOC_ONE_TAGGED(Scheme_Custodian_Box);
  cb->so.type = scheme_cust_box_type;
  cb->cust = (Scheme_Custodian *)argv[0];
  cb->v = argv[1];

#ifdef MZ_PRECISE_GC
  /* 3m  */
  {
    Scheme_Object *wb, *pr, *prev;
    wb = GC_malloc_weak_box(cb, NULL, 0);
    pr = scheme_make_raw_pair(wb, cb->cust->cust_boxes);
    cb->cust->cust_boxes = pr;
    cb->cust->num_cust_boxes++;
    
    /* The GC prunes the list of custodian boxes in accounting mode,
       but prune here in case accounting is never triggered. */
    if (cb->cust->num_cust_boxes > 2 * cb->cust->checked_cust_boxes) {
      prev = pr;
      pr = SCHEME_CDR(pr);
      while (pr) {
        wb = SCHEME_CAR(pr);
        if (!SCHEME_BOX_VAL(pr)) {
          SCHEME_CDR(prev) = SCHEME_CDR(pr);
          --cb->cust->num_cust_boxes;
        } else {
          prev = pr;
        }
        pr = SCHEME_CDR(pr);
      } 
      cb->cust->checked_cust_boxes = cb->cust->num_cust_boxes;
    }
  }
#else
  /* CGC */
  if (cust_box_count >= cust_box_alloc) {
    Scheme_Custodian_Box **cbs;
    if (!cust_box_alloc) {
      cust_box_alloc = 16;
      REGISTER_SO(cust_boxes);
    } else {
      cust_box_alloc = 2 * cust_box_alloc;
    }
    cbs = (Scheme_Custodian_Box **)scheme_malloc_atomic(cust_box_alloc * sizeof(Scheme_Custodian_Box *));
    memcpy(cbs, cust_boxes, cust_box_count * sizeof(Scheme_Custodian_Box *));
    cust_boxes = cbs;
  }
  cust_boxes[cust_box_count++] = cb;
#endif

  return (Scheme_Object *)cb;
}

Here is the call graph for this function:

Here is the caller graph for this function:

static Scheme_Object* make_derived_parameter ( int  argc,
Scheme_Object args[] 
) [static]

Here is the caller graph for this function:

static Scheme_Object* make_derived_parameter ( int  argc,
Scheme_Object **  argv 
) [static]

Definition at line 6437 of file thread.c.

{
  Scheme_Object *p;
  ParamData *data;

  if (!SCHEME_PARAMETERP(argv[0]))
    scheme_wrong_type("make-derived-parameter", "parameter", 0, argc, argv);

  scheme_check_proc_arity("make-derived-parameter", 1, 1, argc, argv);
  scheme_check_proc_arity("make-derived-parameter", 1, 2, argc, argv);

  data = MALLOC_ONE_RT(ParamData);
#ifdef MZTAG_REQUIRED
  data->type = scheme_rt_param_data;
#endif
  data->is_derived = 1;
  data->key = argv[0];
  data->guard = argv[1];
  data->extract_guard = argv[2];

  p = scheme_make_closed_prim_w_arity(do_param, (void *)data, 
                                  "parameter-procedure", 0, 1);
  ((Scheme_Primitive_Proc *)p)->pp.flags |= SCHEME_PRIM_IS_PARAMETER;

  return p;
}

Here is the call graph for this function:

Evt_Set* make_evt_set ( const char *  name,
int  argc,
Scheme_Object **  argv,
int  delta 
)

Definition at line 5649 of file thread.c.

{
  Evt *w, **iws, **ws;
  Evt_Set *evt_set, *subset;
  Scheme_Object **args;
  int i, j, count = 0, reuse = 1;

  iws = MALLOC_N(Evt*, argc-delta);
  
  /* Find Evt record for each non-set argument, and compute flattened size. */
  for (i = 0; i < (argc - delta); i++) {
    if (!SCHEME_EVTSETP(argv[i+delta])) {
      w = find_evt(argv[i+delta]);
      if (!w) {
       scheme_wrong_type(name, "evt", i+delta, argc, argv);
       return NULL;
      }
      iws[i] = w;
      count++;
    } else {
      int n;
      n = ((Evt_Set *)argv[i+delta])->argc;
      if (n != 1)
        reuse = 0;
      count += n;
    }
  }

  evt_set = MALLOC_ONE_TAGGED(Evt_Set);
  evt_set->so.type = scheme_evt_set_type;
  evt_set->argc = count;

  if (reuse && (count == (argc - delta)))
    ws = iws;
  else
    ws = MALLOC_N(Evt*, count);

  args = MALLOC_N(Scheme_Object*, count);
  for (i = delta, j = 0; i < argc; i++, j++) {
    if (SCHEME_EVTSETP(argv[i])) {
      int k, n;
      subset = (Evt_Set *)argv[i];
      n = subset->argc;
      for (k = 0; k < n; k++, j++) {
       args[j] = subset->argv[k];
       ws[j] = subset->ws[k];
      }
      --j;
    } else {
      ws[j] = iws[i-delta];
      args[j] = argv[i];
    }
  }

  evt_set->ws = ws;
  evt_set->argv = args;

  return evt_set;
}

Here is the call graph for this function:

Here is the caller graph for this function:

static void make_initial_config ( Scheme_Thread p) [static]

Definition at line 6505 of file thread.c.

{
  Scheme_Thread_Cell_Table *cells;
  Scheme_Parameterization *paramz;
  Scheme_Config *config;

  cells = scheme_make_bucket_table(5, SCHEME_hash_weak_ptr);
  p->cell_values = cells;

  paramz = (Scheme_Parameterization *)scheme_malloc_tagged(sizeof(Scheme_Parameterization) + 
                                                    (max_configs - 1) * sizeof(Scheme_Object*));
#ifdef MZTAG_REQUIRED
  paramz->type = scheme_rt_parameterization;
#endif

  config = MALLOC_ONE_TAGGED(Scheme_Config);
  config->so.type = scheme_config_type;
  config->cell = (Scheme_Object *)paramz;

  p->init_config = config;

  init_param(cells, paramz, MZCONFIG_READTABLE, scheme_make_default_readtable());
  
  init_param(cells, paramz, MZCONFIG_CAN_READ_GRAPH, scheme_true);
  init_param(cells, paramz, MZCONFIG_CAN_READ_COMPILED, scheme_false);
  init_param(cells, paramz, MZCONFIG_CAN_READ_BOX, scheme_true);
  init_param(cells, paramz, MZCONFIG_CAN_READ_PIPE_QUOTE, scheme_true);
  init_param(cells, paramz, MZCONFIG_CAN_READ_DOT, scheme_true);
  init_param(cells, paramz, MZCONFIG_CAN_READ_INFIX_DOT, scheme_true);
  init_param(cells, paramz, MZCONFIG_CAN_READ_QUASI, scheme_true);
  init_param(cells, paramz, MZCONFIG_READ_DECIMAL_INEXACT, scheme_true);
  init_param(cells, paramz, MZCONFIG_CAN_READ_READER, scheme_false);
  init_param(cells, paramz, MZCONFIG_LOAD_DELAY_ENABLED, init_load_on_demand ? scheme_true : scheme_false);
  init_param(cells, paramz, MZCONFIG_DELAY_LOAD_INFO, scheme_false);

  init_param(cells, paramz, MZCONFIG_PRINT_GRAPH, scheme_false);
  init_param(cells, paramz, MZCONFIG_PRINT_STRUCT, scheme_true);
  init_param(cells, paramz, MZCONFIG_PRINT_BOX, scheme_true);
  init_param(cells, paramz, MZCONFIG_PRINT_VEC_SHORTHAND, scheme_false);
  init_param(cells, paramz, MZCONFIG_PRINT_HASH_TABLE, scheme_true);
  init_param(cells, paramz, MZCONFIG_PRINT_UNREADABLE, scheme_true);
  init_param(cells, paramz, MZCONFIG_PRINT_PAIR_CURLY, scheme_false);
  init_param(cells, paramz, MZCONFIG_PRINT_MPAIR_CURLY, scheme_true);

  init_param(cells, paramz, MZCONFIG_HONU_MODE, scheme_false);

  init_param(cells, paramz, MZCONFIG_COMPILE_MODULE_CONSTS, scheme_true);
  init_param(cells, paramz, MZCONFIG_USE_JIT, scheme_startup_use_jit ? scheme_true : scheme_false);

  {
    Scheme_Object *s;
    s = scheme_make_immutable_sized_utf8_string("", 0);
    init_param(cells, paramz, MZCONFIG_LOCALE, s);
  }

  init_param(cells, paramz, MZCONFIG_CASE_SENS, (scheme_case_sensitive ? scheme_true : scheme_false));
  init_param(cells, paramz, MZCONFIG_SQUARE_BRACKETS_ARE_PARENS, (scheme_square_brackets_are_parens
                                                         ? scheme_true : scheme_false));
  init_param(cells, paramz, MZCONFIG_CURLY_BRACES_ARE_PARENS, (scheme_curly_braces_are_parens
                                                       ? scheme_true : scheme_false));

  init_param(cells, paramz, MZCONFIG_ERROR_PRINT_WIDTH, scheme_make_integer(256));
  init_param(cells, paramz, MZCONFIG_ERROR_PRINT_CONTEXT_LENGTH, scheme_make_integer(16));
  init_param(cells, paramz, MZCONFIG_ERROR_PRINT_SRCLOC, scheme_true);

  REGISTER_SO(main_custodian);
  REGISTER_SO(last_custodian);
  REGISTER_SO(limited_custodians);
  main_custodian = scheme_make_custodian(NULL);
#ifdef MZ_PRECISE_GC
  GC_register_root_custodian(main_custodian);
#endif
  last_custodian = main_custodian;
  init_param(cells, paramz, MZCONFIG_CUSTODIAN, (Scheme_Object *)main_custodian);

  init_param(cells, paramz, MZCONFIG_ALLOW_SET_UNDEFINED, (scheme_allow_set_undefined
                                                   ? scheme_true
                                                   : scheme_false));

  init_param(cells, paramz, MZCONFIG_COLLECTION_PATHS,  scheme_null);

  {
    Scheme_Object *s;
    s = scheme_make_path(scheme_os_getcwd(NULL, 0, NULL, 1));
    s = scheme_path_to_directory_path(s);
    init_param(cells, paramz, MZCONFIG_CURRENT_DIRECTORY, s);
    scheme_set_original_dir(s);
  }

  {
    Scheme_Object *rs;
    rs = scheme_make_random_state(scheme_get_milliseconds());
    init_param(cells, paramz, MZCONFIG_RANDOM_STATE, rs);
    rs = scheme_make_random_state(scheme_get_milliseconds());
    init_param(cells, paramz, MZCONFIG_SCHEDULER_RANDOM_STATE, rs);
  }

  {
    Scheme_Object *eh;
    eh = scheme_make_prim_w_arity2(scheme_default_eval_handler,
                               "default-eval-handler",
                               1, 1,
                               0, -1);
    init_param(cells, paramz, MZCONFIG_EVAL_HANDLER, eh);
  }
  
  {
    Scheme_Object *eh;
    eh = scheme_make_prim_w_arity(scheme_default_compile_handler,
                              "default-compile-handler",
                              2, 2);
    init_param(cells, paramz, MZCONFIG_COMPILE_HANDLER, eh);
  }
  
  {
    Scheme_Object *ph, *prh;

    ph = scheme_make_prim_w_arity(scheme_default_print_handler,
                              "default-print-handler",
                              1, 1);
    init_param(cells, paramz, MZCONFIG_PRINT_HANDLER, ph);

    prh = scheme_make_prim_w_arity(scheme_default_prompt_read_handler,
                               "default-prompt-read-handler",
                               0, 0);
    init_param(cells, paramz, MZCONFIG_PROMPT_READ_HANDLER, prh);
  }
  init_param(cells, paramz, MZCONFIG_PORT_COUNT_LINES, scheme_false);

  {
    Scheme_Object *lh;
    lh = scheme_make_prim_w_arity2(scheme_default_load_extension,
                               "default-load-extension-handler",
                               2, 2,
                               0, -1);
    init_param(cells, paramz, MZCONFIG_LOAD_EXTENSION_HANDLER, lh);
  }

  {
    Scheme_Object *ins;
    if (initial_inspector) {
      ins = initial_inspector;
    } else {
      ins = scheme_make_initial_inspectors();
      /* Keep the initial inspector in case someone resets Scheme (by
         calling scheme_basic_env() a second time. Using the same
         inspector after a reset lets us use the same initial module
         instances. */
      REGISTER_SO(initial_inspector);
      initial_inspector = ins;
    }
    init_param(cells, paramz, MZCONFIG_INSPECTOR, ins);
    init_param(cells, paramz, MZCONFIG_CODE_INSPECTOR, ins);
  }
  
  {
    Scheme_Object *zlv;
    zlv = scheme_make_vector(0, NULL);
    init_param(cells, paramz, MZCONFIG_CMDLINE_ARGS, zlv);
  }

  {
    Scheme_Security_Guard *sg;

    sg = MALLOC_ONE_TAGGED(Scheme_Security_Guard);
    sg->so.type = scheme_security_guard_type;
    init_param(cells, paramz, MZCONFIG_SECURITY_GUARD, (Scheme_Object *)sg);
  }

  {
    Scheme_Thread_Set *t_set;
    t_set = create_thread_set(NULL);
    init_param(cells, paramz, MZCONFIG_THREAD_SET, (Scheme_Object *)t_set);
  }
  
  init_param(cells, paramz, MZCONFIG_THREAD_INIT_STACK_SIZE, scheme_make_integer(DEFAULT_INIT_STACK_SIZE));

  {
    int i;
    for (i = 0; i < max_configs; i++) {
      if (!paramz->prims[i])
       init_param(cells, paramz, i, scheme_false);      
    }
  }
}

Here is the call graph for this function:

Here is the caller graph for this function:

static Scheme_Object* make_parameter ( int  argc,
Scheme_Object args[] 
) [static]

Here is the caller graph for this function:

static Scheme_Object* make_parameter ( int  argc,
Scheme_Object **  argv 
) [static]

Definition at line 6410 of file thread.c.

{
  Scheme_Object *p, *cell;
  ParamData *data;
  void *k;

  k = scheme_make_pair(scheme_true, scheme_false); /* generates a key */

  if (argc > 1)
    scheme_check_proc_arity("make-parameter", 1, 1, argc, argv);

  data = MALLOC_ONE_RT(ParamData);
#ifdef MZTAG_REQUIRED
  data->type = scheme_rt_param_data;
#endif
  data->key = (Scheme_Object *)k;
  cell = scheme_make_thread_cell(argv[0], 1);
  data->defcell = cell;
  data->guard = ((argc > 1) ? argv[1] : NULL);

  p = scheme_make_closed_prim_w_arity(do_param, (void *)data, 
                                  "parameter-procedure", 0, 1);
  ((Scheme_Primitive_Proc *)p)->pp.flags |= SCHEME_PRIM_IS_PARAMETER;

  return p;
}

Here is the call graph for this function:

static Scheme_Object * make_security_guard ( int  argc,
Scheme_Object argv[] 
) [static]

Definition at line 6902 of file thread.c.

{
  Scheme_Security_Guard *sg;

  if (!(SAME_TYPE(SCHEME_TYPE(argv[0]), scheme_security_guard_type)))
    scheme_wrong_type("make-security-guard", "security-guard", 0, argc, argv);
  scheme_check_proc_arity("make-security-guard", 3, 1, argc, argv);
  scheme_check_proc_arity("make-security-guard", 4, 2, argc, argv);
  if (argc > 3)
    scheme_check_proc_arity2("make-security-guard", 3, 3, argc, argv, 1);

  sg = MALLOC_ONE_TAGGED(Scheme_Security_Guard);
  sg->so.type = scheme_security_guard_type;
  sg->parent = (Scheme_Security_Guard *)argv[0];
  sg->file_proc = argv[1];
  sg->network_proc = argv[2];
  if ((argc > 3) && SCHEME_TRUEP(argv[3]))
    sg->link_proc = argv[3];

  return (Scheme_Object *)sg;
}

Here is the call graph for this function:

Here is the caller graph for this function:

static Scheme_Object* make_subprocess ( Scheme_Object child_thunk,
void child_start,
Scheme_Config config,
Scheme_Thread_Cell_Table cells,
Scheme_Object break_cell,
Scheme_Custodian mgr,
int  normal_kill 
) [static]

Definition at line 2933 of file thread.c.

{
  Scheme_Thread *child;
  int turn_on_multi;
 
  turn_on_multi = !scheme_first_thread->next;
  
  if (!config)
    config = scheme_current_config();
  if (!cells)
    cells = scheme_inherit_cells(NULL);
  if (!break_cell) {
    break_cell = scheme_current_break_cell();
    if (SAME_OBJ(break_cell, maybe_recycle_cell))
      maybe_recycle_cell = NULL;
  }

  child = make_thread(config, cells, break_cell, mgr, child_start);

  /* Use child_thunk name, if any, for the thread name: */
  {
    Scheme_Object *sym;
    const char *s;
    int len;
    
    s = scheme_get_proc_name(child_thunk, &len, -1);
    if (s)  {
      if (len < 0)
       sym = (Scheme_Object *)s;
      else
       sym = scheme_intern_exact_symbol(s, len);
      child->name = sym;
    }
  }

  {
    Scheme_Object *v;
    v = scheme_thread_cell_get(break_cell, cells);
    child->can_break_at_swap = SCHEME_TRUEP(v);
  }

  if (!normal_kill)
    child->suspend_to_kill = 1;

  child->stack_start = child_start;

  /* Sets the child's jmpbuf for swapping in later: */
  start_child(child, child_thunk);

  if (scheme_notify_multithread && turn_on_multi) {
    scheme_notify_multithread(1);
    have_activity = 1;
  }

  SCHEME_USE_FUEL(1000);
  
  return (Scheme_Object *)child;
}

Here is the call graph for this function:

Here is the caller graph for this function:

static Syncing* make_syncing ( Evt_Set evt_set,
float  timeout,
double  start_time 
) [static]

Definition at line 5265 of file thread.c.

{
  Syncing *syncing;
  int pos;

  syncing = MALLOC_ONE_RT(Syncing);
#ifdef MZTAG_REQUIRED
  syncing->type = scheme_rt_syncing;
#endif
  syncing->set = evt_set;
  syncing->timeout = timeout;
  if (timeout >= 0)
    syncing->sleep_end = start_time + (timeout * 1000);
  else
    syncing->sleep_end = 0.0;

  if (evt_set->argc > 1) {
    Scheme_Config *config;
    Scheme_Object *rand_state;
    config = scheme_current_config();
    rand_state = scheme_get_param(config, MZCONFIG_SCHEDULER_RANDOM_STATE);
    pos = scheme_rand((Scheme_Random_State *)rand_state);
    syncing->start_pos = (pos % evt_set->argc);
  }

  return syncing;
}

Here is the call graph for this function:

Here is the caller graph for this function:

static Scheme_Thread* make_thread ( Scheme_Config config,
Scheme_Thread_Cell_Table cells,
Scheme_Object init_break_cell,
Scheme_Custodian mgr,
void stack_base 
) [static]

Definition at line 2142 of file thread.c.

{
  Scheme_Thread *process;
  int prefix = 0;

  process = MALLOC_ONE_TAGGED(Scheme_Thread);

  process->so.type = scheme_thread_type;

  if (!scheme_main_thread) {
    /* Creating the first thread... */
#ifdef MZ_PRECISE_GC
    register_traversers();
#endif
    REGISTER_SO(scheme_current_thread);
    REGISTER_SO(scheme_main_thread);
    REGISTER_SO(scheme_first_thread);
    REGISTER_SO(thread_swap_callbacks);
    REGISTER_SO(thread_swap_out_callbacks);
    REGISTER_SO(swap_target);

    scheme_current_thread = process;
    scheme_first_thread = scheme_main_thread = process;
    process->prev = NULL;
    process->next = NULL;

    process->suspend_break = 1; /* until start-up finished */

    process->error_buf = &main_init_error_buf;

    thread_swap_callbacks = scheme_null;
    thread_swap_out_callbacks = scheme_null;

    GC_set_collect_start_callback(get_ready_for_GC);
    GC_set_collect_end_callback(done_with_GC);
#ifdef MZ_PRECISE_GC
    GC_set_collect_inform_callback(inform_GC);
#endif

#ifdef LINK_EXTENSIONS_BY_TABLE
    scheme_current_thread_ptr = &scheme_current_thread;
    scheme_fuel_counter_ptr = &scheme_fuel_counter;
#endif
    
#if defined(MZ_PRECISE_GC)
    GC_set_get_thread_stack_base(scheme_get_current_thread_stack_start);
#endif
    process->stack_start = stack_base;

  } else {
    prefix = 1;
  }

  process->engine_weight = 10000;

  process->cont_mark_pos = (MZ_MARK_POS_TYPE)1;
  process->cont_mark_stack = 0;
  process->cont_mark_stack_segments = NULL;
  process->cont_mark_seg_count = 0;

  if (!config) {
    make_initial_config(process);
    config = process->init_config;
  } else {
    process->init_config = config;
    process->cell_values = cells;
  }

  if (init_break_cell) {
    process->init_break_cell = init_break_cell;
  } else {
    Scheme_Object *v;
    v = scheme_make_thread_cell(scheme_false, 1);
    process->init_break_cell = v;
  }

  if (!mgr)
    mgr = (Scheme_Custodian *)scheme_get_param(config, MZCONFIG_CUSTODIAN);

#ifdef MZ_PRECISE_GC
  GC_register_new_thread(process, mgr);
#endif

  {
    Scheme_Object *t_set;
    t_set = scheme_get_param(config, MZCONFIG_THREAD_SET);
    process->t_set_parent = (Scheme_Thread_Set *)t_set;
  }
  
  if (SAME_OBJ(process, scheme_first_thread)) {
    REGISTER_SO(scheme_thread_set_top);
    scheme_thread_set_top = process->t_set_parent;
    scheme_thread_set_top->first = (Scheme_Object *)process;
    scheme_thread_set_top->current = (Scheme_Object *)process;
  } else
    schedule_in_set((Scheme_Object *)process, process->t_set_parent);
    
  scheme_init_jmpup_buf(&process->jmpup_buf);

  process->running = MZTHREAD_RUNNING;

  process->dw = NULL;

  process->block_descriptor = NOT_BLOCKED;
  process->block_check = NULL;
  process->block_needs_wakeup = NULL;
  process->sleep_end = 0;

  process->current_local_env = NULL;

  process->external_break = 0;

  process->ran_some = 1;

  process->list_stack = NULL;

  scheme_gmp_tls_init(process->gmp_tls);
  
  if (prefix) {
    process->next = scheme_first_thread;
    process->prev = NULL;
    process->next->prev = process;
    scheme_first_thread = process;
  }

  {
    Scheme_Object **tb;
    tb = MALLOC_N(Scheme_Object *, buffer_init_size);
    process->tail_buffer = tb;
  }
  process->tail_buffer_size = buffer_init_size;
 
  {
    int init_stack_size;
    Scheme_Object *iss;

    iss = scheme_get_thread_param(config, cells, MZCONFIG_THREAD_INIT_STACK_SIZE);
    if (SCHEME_INTP(iss))
      init_stack_size = SCHEME_INT_VAL(iss);
    else if (SCHEME_BIGNUMP(iss))
      init_stack_size = 0x7FFFFFFF;
    else
      init_stack_size = DEFAULT_INIT_STACK_SIZE;
    
    /* A too-large stack size won't help performance.
       A too-small stack size is unsafe for certain kinds of
       tail calls. */
    if (init_stack_size > MAX_INIT_STACK_SIZE)
      init_stack_size = MAX_INIT_STACK_SIZE;
    if (init_stack_size < SCHEME_TAIL_COPY_THRESHOLD)
      init_stack_size = SCHEME_TAIL_COPY_THRESHOLD;

    process->runstack_size = init_stack_size;
    {
      Scheme_Object **sa;
      sa = scheme_alloc_runstack(init_stack_size);
      process->runstack_start = sa;
    }
    process->runstack = process->runstack_start + init_stack_size;
  }
  
  process->runstack_saved = NULL;

#ifdef RUNSTACK_IS_GLOBAL
  if (!prefix) {
# ifndef MZ_PRECISE_GC
    /* Precise GC: we intentionally don't register MZ_RUNSTACK. See done_with_GC() */
    REGISTER_SO(MZ_RUNSTACK);
# endif
    REGISTER_SO(MZ_RUNSTACK_START);

    MZ_RUNSTACK = process->runstack;
    MZ_RUNSTACK_START = process->runstack_start;
    MZ_CONT_MARK_STACK = process->cont_mark_stack;
    MZ_CONT_MARK_POS = process->cont_mark_pos;
  }
#endif

  process->on_kill = NULL;

  process->user_tls = NULL;
  process->user_tls_size = 0;
  
  process->nester = process->nestee = NULL;

  process->mbox_first = NULL;
  process->mbox_last = NULL;
  process->mbox_sema = NULL;

  process->mref = NULL;
  process->extra_mrefs = NULL;

    

  /* A thread points to a lot of stuff, so it's bad to put a finalization
     on it, which is what registering with a custodian does. Instead, we
     register a weak indirection with the custodian. That way, the thread
     (and anything it points to) can be collected one GC cycle earlier. 

     It's possible that the thread will be collected before the indirection
     record, so when we use the indirection (e.g., in custodian traversals),
     we'll need to check for NULL. */
  {
    Scheme_Thread_Custodian_Hop *hop;
    Scheme_Custodian_Reference *mref;
    hop = MALLOC_ONE_WEAK_RT(Scheme_Thread_Custodian_Hop);
    process->mr_hop = hop;
    hop->so.type = scheme_thread_hop_type;
    {
      Scheme_Thread *wp;
      wp = (Scheme_Thread *)WEAKIFY((Scheme_Object *)process);
      hop->p = wp;
    }

    mref = scheme_add_managed(mgr, (Scheme_Object *)hop, NULL, NULL, 0);
    process->mref = mref;
    process->extra_mrefs = scheme_null;

#ifndef MZ_PRECISE_GC
    scheme_weak_reference((void **)(void *)&hop->p);
#endif
  }

  return process;
}

Here is the call graph for this function:

Here is the caller graph for this function:

static Scheme_Object * make_thread_cell ( int  argc,
Scheme_Object args[] 
) [static]

Definition at line 6070 of file thread.c.

{
  return scheme_make_thread_cell(argv[0], (argc > 1) && SCHEME_TRUEP(argv[1]));
}

Here is the caller graph for this function:

static Scheme_Object * make_thread_dead ( int  argc,
Scheme_Object args[] 
) [static]

Definition at line 5140 of file thread.c.

{
  if (!SAME_TYPE(SCHEME_TYPE(argv[0]), scheme_thread_type))
    scheme_wrong_type("thread-dead-evt", "thread", 0, argc, argv);

  return scheme_get_thread_dead((Scheme_Thread *)argv[0]);
}

Here is the call graph for this function:

Here is the caller graph for this function:

static Scheme_Object * make_thread_resume ( int  argc,
Scheme_Object args[] 
) [static]

Definition at line 5100 of file thread.c.

{
  Scheme_Thread *p;

  if (!SAME_TYPE(SCHEME_TYPE(argv[0]), scheme_thread_type))
    scheme_wrong_type("thread-resume-evt", "thread", 0, argc, argv);

  p = (Scheme_Thread *)argv[0];

  if (!p->resumed_box) {
    Scheme_Object *b;
    b = scheme_alloc_object();
    b->type = scheme_thread_resume_type;
    if (MZTHREAD_STILL_RUNNING(p->running) && !(p->running & MZTHREAD_USER_SUSPENDED))
      SCHEME_PTR2_VAL(b) = (Scheme_Object *)p;
    else {
      Scheme_Object *sema;
      sema = scheme_make_sema(0);
      SCHEME_PTR1_VAL(b) = sema;
    }
    p->resumed_box = b;
  }

  return p->resumed_box;
}

Here is the caller graph for this function:

static Scheme_Object * make_thread_set ( int  argc,
Scheme_Object argv[] 
) [static]

Definition at line 2022 of file thread.c.

{
  Scheme_Thread_Set *parent;

  if (argc) {
    if (!(SAME_TYPE(SCHEME_TYPE(argv[0]), scheme_thread_set_type)))
      scheme_wrong_type("make-thread-group", "thread-group", 0, argc, argv);
    parent = (Scheme_Thread_Set *)argv[0];
  } else
    parent = (Scheme_Thread_Set *)scheme_get_param(scheme_current_config(), MZCONFIG_THREAD_SET);

  return (Scheme_Object *)create_thread_set(parent);
}

Here is the call graph for this function:

Here is the caller graph for this function:

static Scheme_Object * make_thread_suspend ( int  argc,
Scheme_Object args[] 
) [static]

Definition at line 5069 of file thread.c.

{
  Scheme_Thread *p;

  if (!SAME_TYPE(SCHEME_TYPE(argv[0]), scheme_thread_type))
    scheme_wrong_type("thread-suspend-evt", "thread", 0, argc, argv);

  p = (Scheme_Thread *)argv[0];

  return scheme_get_thread_suspend(p);
}

Here is the call graph for this function:

Here is the caller graph for this function:

static Scheme_Object* make_will_executor ( int  argc,
Scheme_Object args[] 
) [static]

Here is the caller graph for this function:

static Scheme_Object* make_will_executor ( int  argc,
Scheme_Object **  argv 
) [static]

Definition at line 7101 of file thread.c.

static void managed_object_gone ( void o,
void mr 
) [static]

Definition at line 1325 of file thread.c.

{
  Scheme_Custodian *m = CUSTODIAN_FAM((Scheme_Custodian_Reference *)mr);

  /* Still has management? */
  if (m)
    remove_managed(mr, o, NULL, NULL);
}

Here is the call graph for this function:

Here is the caller graph for this function:

MZ_DO_NOT_INLINE ( Scheme_Object scheme_call_as_nested_threadint argc, Scheme_Object *argv[], void *max_bottom)
static Scheme_Object* namespace_p ( int  argc,
Scheme_Object args[] 
) [static]

Here is the caller graph for this function:

static Scheme_Object* namespace_p ( int  argc,
Scheme_Object **  argv 
) [static]

Definition at line 6883 of file thread.c.

static void needs_wakeup_unless ( Scheme_Object o,
void fds 
) [static]

Definition at line 4353 of file thread.c.

{
  Scheme_Object *data;
  Scheme_Needs_Wakeup_Fun fdf;

  data = (Scheme_Object *)((void **)o)[0];
  fdf = (Scheme_Needs_Wakeup_Fun)((void **)o)[3];

  fdf(data, fds);
}

Here is the caller graph for this function:

static Scheme_Object * new_tracking_fun ( int  argc,
Scheme_Object args[] 
) [static]

Definition at line 1028 of file thread.c.

{
  int retval = 0;

#ifdef MZ_PRECISE_GC
  retval = GC_mtrace_new_id(args[0]);
#endif

  return scheme_make_integer(retval);
}

Here is the call graph for this function:

Here is the caller graph for this function:

static Scheme_Object* parameter_p ( int  argc,
Scheme_Object args[] 
) [static]

Here is the caller graph for this function:

static Scheme_Object* parameter_p ( int  argc,
Scheme_Object **  argv 
) [static]

Definition at line 6351 of file thread.c.

{
  Scheme_Object *v = argv[0];

  return (SCHEME_PARAMETERP(v)
         ? scheme_true
         : scheme_false);
}
static Scheme_Object* parameter_procedure_eq ( int  argc,
Scheme_Object args[] 
) [static]

Here is the caller graph for this function:

static Scheme_Object* parameter_procedure_eq ( int  argc,
Scheme_Object **  argv 
) [static]

Definition at line 6464 of file thread.c.

{
  Scheme_Object *a, *b;

  a = argv[0];
  b = argv[1];

  if (!((SCHEME_PRIMP(a) || SCHEME_CLSD_PRIMP(a))
       && (((Scheme_Primitive_Proc *)a)->pp.flags & SCHEME_PRIM_IS_PARAMETER)))
    scheme_wrong_type("parameter-procedure=?", "parameter-procedure", 0, argc, argv);
  if (!((SCHEME_PRIMP(b) || SCHEME_CLSD_PRIMP(b))
       && (((Scheme_Primitive_Proc *)b)->pp.flags & SCHEME_PRIM_IS_PARAMETER)))
    scheme_wrong_type("parameter-procedure=?", "parameter-procedure", 1, argc, argv);

  return (SAME_OBJ(a, b)
         ? scheme_true
         : scheme_false);
}
static Scheme_Object* parameterization_p ( int  argc,
Scheme_Object args[] 
) [static]

Here is the caller graph for this function:

static Scheme_Object* parameterization_p ( int  argc,
Scheme_Object **  argv 
) [static]

Definition at line 6296 of file thread.c.

{
  Scheme_Object *v = argv[0];

  return (SCHEME_CONFIGP(v)
         ? scheme_true
         : scheme_false);
}
static int post_system_idle ( ) [static]

Definition at line 3599 of file thread.c.

Here is the call graph for this function:

Here is the caller graph for this function:

static void prepare_this_thread_for_GC ( Scheme_Thread t) [static]

Definition at line 7320 of file thread.c.

{
  if (p == scheme_current_thread) {
#ifdef RUNSTACK_IS_GLOBAL
    scheme_current_thread->runstack = MZ_RUNSTACK;
    scheme_current_thread->runstack_start = MZ_RUNSTACK_START;
    scheme_current_thread->cont_mark_stack = MZ_CONT_MARK_STACK;
    scheme_current_thread->cont_mark_pos = MZ_CONT_MARK_POS;
#endif
  }
  prepare_thread_for_GC((Scheme_Object *)p);
}

Here is the call graph for this function:

Here is the caller graph for this function:

static void prepare_thread_for_GC ( Scheme_Object t) [static]

Definition at line 7189 of file thread.c.

{
  Scheme_Thread *p = (Scheme_Thread *)t;

  /* zero ununsed part of env stack in each thread */

  if (!p->nestee) {
    Scheme_Saved_Stack *saved;
# define RUNSTACK_TUNE(x) /* x   - Used for performance tuning */
    RUNSTACK_TUNE( long size; );

    if ((!p->runstack_owner
         || (p == *p->runstack_owner))
        && p->runstack_start) {
      long rs_end;
      Scheme_Object **rs_start;

      /* If there's a meta-prompt, we can also zero out past the unused part */
      if (p->meta_prompt && (p->meta_prompt->runstack_boundary_start == p->runstack_start)) {
        rs_end = p->meta_prompt->runstack_boundary_offset;
      } else {
        rs_end = p->runstack_size;
      }

      if ((p->runstack_tmp_keep >= p->runstack_start)
          && (p->runstack_tmp_keep < p->runstack))
        rs_start = p->runstack_tmp_keep;
      else
        rs_start = p->runstack;

      scheme_set_runstack_limits(p->runstack_start, 
                                 p->runstack_size,
                                 rs_start - p->runstack_start,
                                 rs_end);
      
      RUNSTACK_TUNE( size = p->runstack_size - (p->runstack - p->runstack_start); );
      
      for (saved = p->runstack_saved; saved; saved = saved->prev) {
       RUNSTACK_TUNE( size += saved->runstack_size; );

        if (p->meta_prompt && (p->meta_prompt->runstack_boundary_start == saved->runstack_start)) {
          rs_end = p->meta_prompt->runstack_boundary_offset;
        } else {
          rs_end = saved->runstack_size;
        }

        scheme_set_runstack_limits(saved->runstack_start,
                                   saved->runstack_size,
                                   saved->runstack_offset,
                                   rs_end);
      }
    }

    RUNSTACK_TUNE( printf("%ld\n", size); );

    if (p->tail_buffer && (p->tail_buffer != p->runstack_tmp_keep)) {
      int i;
      for (i = 0; i < p->tail_buffer_size; i++) {
       p->tail_buffer[i] = NULL;
      }
    }
  }
      
  if ((!p->cont_mark_stack_owner
       || (p == *p->cont_mark_stack_owner))
      && p->cont_mark_stack) {
    int segcount, i, segpos;

    /* release unused cont mark stack segments */
    if (p->cont_mark_stack)
      segcount = ((long)(p->cont_mark_stack - 1) >> SCHEME_LOG_MARK_SEGMENT_SIZE) + 1;
    else
      segcount = 0;
    for (i = segcount; i < p->cont_mark_seg_count; i++) {
      p->cont_mark_stack_segments[i] = NULL;
    }
    if (segcount < p->cont_mark_seg_count)
      p->cont_mark_seg_count = segcount;
      
    /* zero unused part of last mark stack segment */
    segpos = ((long)p->cont_mark_stack >> SCHEME_LOG_MARK_SEGMENT_SIZE);
    
    if (segpos < p->cont_mark_seg_count) {
      Scheme_Cont_Mark *seg = p->cont_mark_stack_segments[segpos];
      int stackpos = ((long)p->cont_mark_stack & SCHEME_MARK_SEGMENT_MASK);
      if (seg) {
        for (i = stackpos; i < SCHEME_MARK_SEGMENT_SIZE; i++) {
          if (seg[i].key) {
            seg[i].key = NULL;
            seg[i].val = NULL;
            seg[i].cache = NULL;
          } else {
            /* NULL means we already cleared from here on. */
            break;
          }
        }
      }
    }

    {
      MZ_MARK_STACK_TYPE pos;
      /* also zero out slots before the current bottom */
      for (pos = 0; pos < p->cont_mark_stack_bottom; pos++) {
        Scheme_Cont_Mark *seg;
        int stackpos;
        segpos = ((long)pos >> SCHEME_LOG_MARK_SEGMENT_SIZE);
        seg = p->cont_mark_stack_segments[segpos];
        if (seg) {
          stackpos = ((long)pos & SCHEME_MARK_SEGMENT_MASK);
          seg[stackpos].key = NULL;
          seg[stackpos].val = NULL;
          seg[stackpos].cache = NULL;
        }
      }
    }
  }

  if (p->values_buffer) {
    if (p->values_buffer_size > 128)
      p->values_buffer = NULL;
    else {
      memset(p->values_buffer, 0, sizeof(Scheme_Object*) * p->values_buffer_size);
    }
  }

  p->spare_runstack = NULL;

  /* zero ununsed part of list stack */
  scheme_clean_list_stack(p);
}

Here is the call graph for this function:

Here is the caller graph for this function:

static void promote_thread ( Scheme_Thread p,
Scheme_Custodian to_c 
) [static]

Definition at line 4887 of file thread.c.

{
  Scheme_Custodian *c, *cx;
  Scheme_Custodian_Reference *mref;  
  Scheme_Object *l;

  /* This function also handles transitive promotion. Every transitive
     target for p always has at least the custodians of p, so if we don't
     add a custodian to p, we don't need to check the rest. */
  
  if (!p->mref || !CUSTODIAN_FAM(p->mref)) {
    /* The thread has no running custodian, so fall through to
       just use to_c */
  } else {
    c = CUSTODIAN_FAM(p->mref);

    /* Check whether c is an ancestor of to_c (in which case we do nothing) */
    for (cx = to_c; cx && NOT_SAME_OBJ(cx, c); ) {
      cx = CUSTODIAN_FAM(cx->parent);
    }
    if (cx) return;

    /* Check whether any of the extras are super to to_c. 
       If so, do nothing. */
    for (l = p->extra_mrefs; !SCHEME_NULLP(l); l = SCHEME_CDR(l)) {
      mref = (Scheme_Custodian_Reference *)SCHEME_CAR(l);
      c = CUSTODIAN_FAM(mref);
      
      for (cx = to_c; cx && NOT_SAME_OBJ(cx, c); ) {
       cx = CUSTODIAN_FAM(cx->parent);
      }
      if (cx) return;
    }

    /* Check whether to_c is super of c: */
    for (cx = c; cx && NOT_SAME_OBJ(cx, to_c); ) {
      cx = CUSTODIAN_FAM(cx->parent);
    }
    
    /* If cx, fall through to replace the main custodian with to_c, 
       because it's an ancestor of the current one. Otherwise, they're
       unrelated. */
    if (!cx) {
      /* Check whether any of the extras should be replaced by to_c */
      for (l = p->extra_mrefs; !SCHEME_NULLP(l); l = SCHEME_CDR(l)) {
       /* Is to_c super of c? */
       for (cx = c; cx && NOT_SAME_OBJ(cx, to_c); ) {
         cx = CUSTODIAN_FAM(cx->parent);
       }
       if (cx) {
         /* Replace this custodian with to_c */
         mref = (Scheme_Custodian_Reference *)SCHEME_CAR(l);
         scheme_remove_managed(mref, (Scheme_Object *)p->mr_hop);
         mref = scheme_add_managed(to_c, (Scheme_Object *)p->mr_hop, NULL, NULL, 0);
         SCHEME_CAR(l) = (Scheme_Object *)mref;

         /* It's possible that one of the other custodians is also
            junior to to_c. Remove it if we find one. */
         {
           Scheme_Object *prev;
           prev = l;
           for (l = SCHEME_CDR(l); !SCHEME_NULLP(l); l = SCHEME_CDR(l)) {
             mref = (Scheme_Custodian_Reference *)SCHEME_CAR(l);
             c = CUSTODIAN_FAM(mref);
             for (cx = c; cx && NOT_SAME_OBJ(cx, to_c); ) {
              cx = CUSTODIAN_FAM(cx->parent);
             }
             if (cx)
              SCHEME_CDR(prev) = SCHEME_CDR(l);
           }
         }

         transitive_promote(p, to_c);

         return;
       }
      }

      /* Otherwise, this is custodian is unrelated to the existing ones.
        Add it as an extra custodian. */
      mref = scheme_add_managed(to_c, (Scheme_Object *)p->mr_hop, NULL, NULL, 0);
      l = scheme_make_raw_pair((Scheme_Object *)mref, p->extra_mrefs);
      p->extra_mrefs = l;

      transitive_promote(p, to_c);
      return;
    }
  }

  /* Replace p's main custodian (if any) with to_c */
  scheme_remove_managed(p->mref, (Scheme_Object *)p->mr_hop);
  mref = scheme_add_managed(to_c, (Scheme_Object *)p->mr_hop, NULL, NULL, 0);
  p->mref = mref;
#ifdef MZ_PRECISE_GC
  GC_register_thread(p, to_c);
#endif
  
  transitive_promote(p, to_c);
}

Here is the call graph for this function:

Here is the caller graph for this function:

static void raise_break ( Scheme_Thread p) [static]

Definition at line 3794 of file thread.c.

{
  int block_descriptor;
  Scheme_Object *blocker; /* semaphore or port */
  Scheme_Ready_Fun block_check;
  Scheme_Needs_Wakeup_Fun block_needs_wakeup;
  Scheme_Object *a[1];
  Scheme_Cont_Frame_Data cframe;

  p->external_break = 0;

  if (p->blocker && (p->block_check == (Scheme_Ready_Fun)syncing_ready)) {
    /* Get out of lines for channels, etc., before calling a break exn handler. */
    scheme_post_syncing_nacks((Syncing *)p->blocker);
  }

  block_descriptor = p->block_descriptor;
  blocker = p->blocker;
  block_check = p->block_check;
  block_needs_wakeup = p->block_needs_wakeup;
  
  p->block_descriptor = NOT_BLOCKED;
  p->blocker = NULL;
  p->block_check = NULL;
  p->block_needs_wakeup = NULL;
  p->ran_some = 1;
  
  a[0] = scheme_make_prim((Scheme_Prim *)raise_user_break);

  /* Continuation frame ensures that this doesn't
     look like it's in tail position with respect to
     an existing escape continuation */
  scheme_push_continuation_frame(&cframe);

  scheme_call_ec(1, a);

  scheme_pop_continuation_frame(&cframe);

  /* Continue from break... */
  p->block_descriptor = block_descriptor;
  p->blocker = blocker;
  p->block_check = block_check;
  p->block_needs_wakeup = block_needs_wakeup;
}

Here is the call graph for this function:

Here is the caller graph for this function:

static Scheme_Object* raise_user_break ( int  argc,
Scheme_Object **volatile  argv 
) [static]

Definition at line 3760 of file thread.c.

{
  /* The main action here is buried in code to free temporary bignum
     space on escapes. Aside from a thread kill, this is the only
     place where we have to worry about freeing bignum space, because
     kill and escape are the only possible actions within a bignum
     calculaion. It is possible to have nested bignum calculations,
     though (if the break handler performs bignum arithmetic), so
     that's why we save and restore an old snapshot. */
  mz_jmp_buf *savebuf, newbuf;
  long save[4];

  savebuf = scheme_current_thread->error_buf;
  scheme_current_thread->error_buf = &newbuf;
  scheme_gmp_tls_snapshot(scheme_current_thread->gmp_tls, save);

  if (!scheme_setjmp(newbuf)) {
    /* >>>> This is the main action <<<< */
    scheme_raise_exn(MZEXN_BREAK, argv[0], "user break");
    /* will definitely escape (or thread will die) */
  } else {
    /* As expected, we're escaping. Unless we're continuing, then
       reset temporary bignum memory. */
    int cont;
    cont = SAME_OBJ((Scheme_Object *)scheme_jumping_to_continuation,
                  argv[0]);
    scheme_gmp_tls_restore_snapshot(scheme_current_thread->gmp_tls, NULL, save, !cont);
    scheme_longjmp(*savebuf, 1);
  }

  /* Can't get here */
  return NULL;
}

Here is the call graph for this function:

Here is the caller graph for this function:

static int ready_unless ( Scheme_Object o) [static]

Definition at line 4341 of file thread.c.

{
  Scheme_Object *unless_evt, *data;
  Scheme_Ready_Fun f;

  data = (Scheme_Object *)((void **)o)[0];
  unless_evt = (Scheme_Object *)((void **)o)[1];
  f = (Scheme_Ready_Fun)((void **)o)[2];

  return f(data);
}

Here is the caller graph for this function:

static void rebox_willdone_object ( void o,
void mr 
) [static]

Definition at line 1295 of file thread.c.

{
  Scheme_Custodian *m = CUSTODIAN_FAM((Scheme_Custodian_Reference *)mr);
  Scheme_Close_Custodian_Client *f;
  void *data;

  /* Still needs management? */
  if (m) {
#ifdef MZ_PRECISE_GC
    Scheme_Object *b;
#else
    Scheme_Object **b;
#endif

    remove_managed(mr, o, &f, &data);

#ifdef MZ_PRECISE_GC
    b = scheme_box(NULL);
#else
    b = MALLOC_ONE(Scheme_Object*); /* not atomic this time */
#endif
    xCUSTODIAN_FAM(b) = o;
    
    /* Put the custodian back: */
    CUSTODIAN_FAM((Scheme_Custodian_Reference *)mr) = m;

    add_managed_box(m, (Scheme_Object **)b, (Scheme_Custodian_Reference *)mr, f, data);
  }
}

Here is the call graph for this function:

Here is the caller graph for this function:

static void register_thread_sync ( ) [static]

Definition at line 3085 of file thread.c.

Here is the call graph for this function:

Here is the caller graph for this function:

static Scheme_Object* register_will ( int  argc,
Scheme_Object args[] 
) [static]

Here is the caller graph for this function:

static Scheme_Object* register_will ( int  argc,
Scheme_Object **  argv 
) [static]

Definition at line 7124 of file thread.c.

{
  Scheme_Object *e;

  if (NOT_SAME_TYPE(SCHEME_TYPE(argv[0]), scheme_will_executor_type))
    scheme_wrong_type("will-register", "will-executor", 0, argc, argv);
  scheme_check_proc_arity("will-register", 1, 2, argc, argv);

  /* If we lose track of the will executor, then drop the finalizer. */
  e = scheme_make_ephemeron(argv[0], argv[2]);

  scheme_add_scheme_finalizer(argv[1], activate_will, e);

  return scheme_void;
}

Here is the call graph for this function:

static void remove_managed ( Scheme_Custodian_Reference mr,
Scheme_Object o,
Scheme_Close_Custodian_Client **  old_f,
void **  old_data 
) [static]

Definition at line 1120 of file thread.c.

{
  Scheme_Custodian *m;
  int i;

  if (!mr)
    return;
  m = CUSTODIAN_FAM(mr);
  if (!m)
    return;

  for (i = m->count; i--; ) {
    if (m->boxes[i] && SAME_OBJ((xCUSTODIAN_FAM(m->boxes[i])),  o)) {
      xCUSTODIAN_FAM(m->boxes[i]) = 0;
      m->boxes[i] = NULL;
      CUSTODIAN_FAM(m->mrefs[i]) = 0;
      m->mrefs[i] = NULL;
      if (old_f)
       *old_f = m->closers[i];
      if (old_data)
       *old_data = m->data[i];
      m->data[i] = NULL;
      --m->elems;
      adjust_limit_table(m);
      break;
    }
  }

  while (m->count && !m->boxes[m->count - 1]) {
    --m->count;
  }
}

Here is the call graph for this function:

Here is the caller graph for this function:

static void remove_thread ( Scheme_Thread r) [static]

Definition at line 2722 of file thread.c.

{
  Scheme_Saved_Stack *saved;
  Scheme_Object *l;

  r->running = 0;

  if (r->prev) {
    r->prev->next = r->next;
    r->next->prev = r->prev;
  } else if (r->next) {
    r->next->prev = NULL;
    scheme_first_thread = r->next;
  }
  r->next = r->prev = NULL;

  unschedule_in_set((Scheme_Object *)r, r->t_set_parent);
  
#ifdef RUNSTACK_IS_GLOBAL
  if (r == scheme_current_thread) {
    r->runstack = MZ_RUNSTACK;
    MZ_RUNSTACK = NULL;
    r->runstack_start = MZ_RUNSTACK_START;
    MZ_RUNSTACK_START = NULL;
    r->cont_mark_stack = MZ_CONT_MARK_STACK;
    r->cont_mark_pos = MZ_CONT_MARK_POS;
  }
#endif

  if (r->runstack_owner) {
    /* Drop ownership, if active, and clear the stack */
    if (r == *(r->runstack_owner)) {
      if (r->runstack_start) {
        scheme_set_runstack_limits(r->runstack_start, r->runstack_size, 0, 0);
        r->runstack_start = NULL;
      }
      for (saved = r->runstack_saved; saved; saved = saved->prev) {
        scheme_set_runstack_limits(saved->runstack_start, saved->runstack_size, 0, 0);
      }
      r->runstack_saved = NULL;
      *(r->runstack_owner) = NULL;
      r->runstack_owner = NULL;
    }
  } else {
    /* Only this thread used the runstack, so clear/free it
       as aggressively as possible */
#if defined(SENORA_GC_NO_FREE) || defined(MZ_PRECISE_GC)
    memset(r->runstack_start, 0, r->runstack_size * sizeof(Scheme_Object*));
#else
    GC_free(r->runstack_start);
#endif
    r->runstack_start = NULL;
    for (saved = r->runstack_saved; saved; saved = saved->prev) {
#if defined(SENORA_GC_NO_FREE) || defined(MZ_PRECISE_GC)
      memset(saved->runstack_start, 0, saved->runstack_size * sizeof(Scheme_Object*));
#else
      GC_free(saved->runstack_start);
#endif
      saved->runstack_start = NULL;
    }
  }

  r->runstack = NULL;
  r->runstack_swapped = NULL;

  if (r->cont_mark_stack_owner
      && ((*r->cont_mark_stack_owner) == r)) {
    *r->cont_mark_stack_owner = NULL;
  }

  r->cont_mark_stack = 0;
  r->cont_mark_stack_owner = NULL;
  r->cont_mark_stack_swapped = NULL;

  r->ku.apply.tail_rator = NULL;
  r->ku.apply.tail_rands = NULL;
  r->tail_buffer = NULL;
  r->ku.multiple.array = NULL;
  r->values_buffer = NULL;

#ifndef SENORA_GC_NO_FREE
  if (r->list_stack)
    GC_free(r->list_stack);
#endif

  thread_is_dead(r);

  /* In case we kill a thread while in a bignum operation: */
  scheme_gmp_tls_restore_snapshot(r->gmp_tls, r->gmp_tls_data, 
                                  NULL, ((r == scheme_current_thread) ? 1 : 2));

  if (r == scheme_current_thread) {
    /* We're going to be swapped out immediately. */
    swap_no_setjmp = 1;
  } else
    RESETJMP(r);

  scheme_remove_managed(r->mref, (Scheme_Object *)r->mr_hop);
  for (l = r->extra_mrefs; !SCHEME_NULLP(l); l = SCHEME_CDR(l)) {
    scheme_remove_managed((Scheme_Custodian_Reference *)SCHEME_CAR(l), (Scheme_Object *)r->mr_hop);
  }
  r->extra_mrefs = scheme_null;
}

Here is the call graph for this function:

Here is the caller graph for this function:

static int resume_suspend_ready ( Scheme_Object o,
Scheme_Schedule_Info sinfo 
) [static]

Definition at line 5126 of file thread.c.

{
  Scheme_Object *t;

  t = SCHEME_PTR2_VAL(o);
  if (t) {
    scheme_set_sync_target(sinfo, o, t, NULL, 0, 0, NULL);
    return 1;
  }

  scheme_set_sync_target(sinfo, SCHEME_PTR1_VAL(o), o, NULL, 0, 1, NULL);
  return 0;
}

Here is the call graph for this function:

Here is the caller graph for this function:

static void run_atexit_closers ( void  ) [static]

Definition at line 1893 of file thread.c.

{
  mz_jmp_buf newbuf, *savebuf;

  /* scheme_start_atomic(); */
  /* Atomic would be needed if this was run to implement
     a custodian shutdown, but an actual custodian shutdown
     will have terminated everything else anyway. For a
     polite exit, other threads can run. */

  savebuf = scheme_current_thread->error_buf;
  scheme_current_thread->error_buf = &newbuf;
  if (!scheme_setjmp(newbuf)) {  
    scheme_do_close_managed(NULL, run_closers);
  }
  scheme_current_thread->error_buf = savebuf;
}

Here is the call graph for this function:

Here is the caller graph for this function:

static void run_closers ( Scheme_Object o,
Scheme_Close_Custodian_Client f,
void data 
) [static]

Definition at line 1882 of file thread.c.

Here is the caller graph for this function:

static Scheme_Object * sch_current ( int  argc,
Scheme_Object args[] 
) [static]

Definition at line 3019 of file thread.c.

Here is the caller graph for this function:

static Scheme_Object * sch_sleep ( int  argc,
Scheme_Object args[] 
) [static]

Definition at line 4496 of file thread.c.

{
  float t;

  if (argc && !SCHEME_REALP(args[0]))
    scheme_wrong_type("sleep", "non-negative real number", 0, argc, args);

  if (argc) {
    t = (float)scheme_real_to_double(args[0]);
    if (t < 0)
      scheme_wrong_type("sleep", "non-negative real number", 0, argc, args);
  } else
    t = 0;

  scheme_thread_block(t);
  scheme_current_thread->ran_some = 1;

  return scheme_void;
}

Here is the caller graph for this function:

static Scheme_Object * sch_sync ( int  argc,
Scheme_Object args[] 
) [static]

Definition at line 5919 of file thread.c.

{
  return do_sync("sync", argc, argv, 0, 0, 1);
}

Here is the call graph for this function:

Here is the caller graph for this function:

static Scheme_Object * sch_sync_enable_break ( int  argc,
Scheme_Object args[] 
) [static]

Definition at line 5954 of file thread.c.

{
  return do_scheme_sync_enable_break("sync/enable-break", 0, 1, argc, argv);
}

Here is the call graph for this function:

Here is the caller graph for this function:

static Scheme_Object * sch_sync_timeout ( int  argc,
Scheme_Object args[] 
) [static]

Definition at line 5924 of file thread.c.

{
  return do_sync("sync/timeout", argc, argv, 0, 1, 1);
}

Here is the call graph for this function:

Here is the caller graph for this function:

static Scheme_Object * sch_sync_timeout_enable_break ( int  argc,
Scheme_Object args[] 
) [static]

Definition at line 5959 of file thread.c.

{
  return do_scheme_sync_enable_break("sync/timeout/enable-break", 1, 1, argc, argv);
}

Here is the call graph for this function:

Here is the caller graph for this function:

static Scheme_Object * sch_thread ( int  argc,
Scheme_Object args[] 
) [static]

Definition at line 3003 of file thread.c.

{
  scheme_check_proc_arity("thread", 0, 0, argc, args);
  scheme_custodian_check_available(NULL, "thread", "thread");

  return scheme_thread(args[0]);
}

Here is the caller graph for this function:

static Scheme_Object * sch_thread_nokill ( int  argc,
Scheme_Object args[] 
) [static]

Definition at line 3011 of file thread.c.

{
  scheme_check_proc_arity("thread/suspend-to-kill", 0, 0, argc, args);
  scheme_custodian_check_available(NULL, "thread/suspend-to-kill", "thread");

  return scheme_thread_w_details(args[0], NULL, NULL, NULL, NULL, 1);
}

Here is the caller graph for this function:

static void schedule_in_set ( Scheme_Object s,
Scheme_Thread_Set t_set 
) [static]

Definition at line 2083 of file thread.c.

{
  num_running_threads += 1;

  while (1) {
    set_t_set_next(s, t_set->first);
    if (t_set->first)
      set_t_set_prev(t_set->first, s);
    t_set->first = s;
    if (t_set->current)
      break;

    t_set->current = s;

    s = (Scheme_Object *)t_set;
    t_set = t_set->parent;
  }
}

Here is the call graph for this function:

Here is the caller graph for this function:

Definition at line 4490 of file thread.c.

Here is the call graph for this function:

Here is the caller graph for this function:

void scheme_accept_sync ( Syncing syncing,
int  i 
)

Definition at line 5604 of file thread.c.

{
  /* run atomic accept action to revise the wrap */
  Scheme_Accept_Sync accept;
  Scheme_Object *v, *pr;
  
  accept = syncing->accepts[i];
  syncing->accepts[i] = NULL;
  pr = syncing->wrapss[i];
  
  v = SCHEME_CAR(pr);
  pr = SCHEME_CDR(pr);
  
  v = accept(v);
  
  pr = scheme_make_pair(v, pr);
  syncing->wrapss[i] = pr;
}

Here is the caller graph for this function:

Definition at line 1911 of file thread.c.

{
  if (!closers) {
#ifdef USE_ON_EXIT_FOR_ATEXIT
    on_exit(run_atexit_closers, NULL);
#else
    atexit(run_atexit_closers);
#endif

    REGISTER_SO(closers);
    closers = scheme_null;
  }

  closers = scheme_make_raw_pair((Scheme_Object *)f, closers);
}

Here is the call graph for this function:

Definition at line 1661 of file thread.c.

Here is the call graph for this function:

void scheme_add_evt ( Scheme_Type  type,
Scheme_Ready_Fun  ready,
Scheme_Needs_Wakeup_Fun  wakeup,
Scheme_Sync_Filter_Fun  filter,
int  can_redirect 
)

Definition at line 5192 of file thread.c.

{
  Evt *naya;

  if (!evts) {
    REGISTER_SO(evts);
  }

  if (evts_array_size <= type) {
    Evt **nevts;
    int new_size;
    new_size = type + 1;
    if (new_size < _scheme_last_type_)
      new_size = _scheme_last_type_;
    nevts = MALLOC_N(Evt*, new_size);
    memcpy(nevts, evts, evts_array_size * sizeof(Evt*));
    evts = nevts;
    evts_array_size = new_size;
  }

  naya = MALLOC_ONE_RT(Evt);
#ifdef MZTAG_REQUIRED
  naya->type = scheme_rt_evt;
#endif
  naya->sync_type = type;
  naya->ready = (Scheme_Ready_Fun_FPC)ready;
  naya->needs_wakeup = wakeup;
  naya->filter = filter;
  naya->can_redirect = can_redirect;

  evts[type] = naya;
}

Definition at line 5229 of file thread.c.

{
  scheme_add_evt(type, NULL, NULL, filter, 0);
  evts[type]->get_sema = get_sema;
}

Definition at line 1351 of file thread.c.

{
#ifdef MZ_PRECISE_GC
    Scheme_Object *b;
#else
    Scheme_Object **b;
#endif
  Scheme_Custodian_Reference *mr;

  if (!m)
    m = (Scheme_Custodian *)scheme_get_param(scheme_current_config(), MZCONFIG_CUSTODIAN);
  
  if (m->shut_down) {
    /* The custodian was shut down in the time that it took
       to allocate o. This situation should be avoided if at
       all possible, but here's the fail-safe. */
    if (f)
      f(o, data);
    return NULL;
  }

#ifdef MZ_PRECISE_GC
  b = scheme_make_weak_box(NULL);
#else
  b = MALLOC_ONE_WEAK(Scheme_Object*);
#endif
  xCUSTODIAN_FAM(b) = o;

  mr = MALLOC_MREF();

  CUSTODIAN_FAM(mr) = m;

  /* The atomic link via the box `b' allows the execution of wills for
     o. After this, we should either drop the object or we have to
     hold on to the object strongly (for when custodian-close-all is
     called). */
  if (must_close)
    scheme_add_finalizer(o, rebox_willdone_object, mr);
  else
    scheme_add_finalizer(o, managed_object_gone, mr);

  add_managed_box(m, (Scheme_Object **)b, mr, f, data);

  return mr;
}

Here is the call graph for this function:

Definition at line 6850 of file thread.c.

{
  Scheme_NSO *old = namespace_options;
  
  namespace_options = MALLOC_N_RT(Scheme_NSO, (num_nsos + 1));

  memcpy(namespace_options, old, num_nsos * sizeof(Scheme_NSO));

#ifdef MZTAG_REQUIRED
  namespace_options[num_nsos].type = scheme_rt_namespace_option;
#endif
  namespace_options[num_nsos].key = key;
  namespace_options[num_nsos].f = f;
  
  num_nsos++;
}

Definition at line 2439 of file thread.c.

{
#ifdef MZ_PRECISE_GC
  long sz;
  void **p;
  sz = sizeof(Scheme_Object*) * (len + 4);
  p = (void **)GC_malloc_tagged_allow_interior(sz);
  *(Scheme_Type *)(void *)p = scheme_rt_runstack;
  ((long *)(void *)p)[1] = gcBYTES_TO_WORDS(sz);
  ((long *)(void *)p)[2] = 0;
  ((long *)(void *)p)[3] = len;
  return (Scheme_Object **)(p + 4);
#else
  return (Scheme_Object **)scheme_malloc_allow_interior(sizeof(Scheme_Object*) * len);
#endif
}

Here is the call graph for this function:

Here is the caller graph for this function:

int scheme_block_until ( Scheme_Ready_Fun  _f,
Scheme_Needs_Wakeup_Fun  fdf,
Scheme_Object data,
float  delay 
)

Definition at line 4272 of file thread.c.

{
  int result;
  Scheme_Thread *p = scheme_current_thread;
  Scheme_Ready_Fun_FPC f = (Scheme_Ready_Fun_FPC)_f;
  Scheme_Schedule_Info sinfo;
  double sleep_end;

  if (!delay)
    sleep_end = 0.0;
  else {
    sleep_end = scheme_get_inexact_milliseconds();
    sleep_end += (delay * 1000.0);    
  }

  /* We make an sinfo to be polite, but we also assume
     that f will not generate any redirections! */
  init_schedule_info(&sinfo, NULL, sleep_end);

  while (!(result = f((Scheme_Object *)data, &sinfo))) {
    sleep_end = sinfo.sleep_end;
    if (sinfo.spin) {
      init_schedule_info(&sinfo, NULL, 0.0);
      scheme_thread_block(0.0);
      scheme_current_thread->ran_some = 1;
    } else {
      if (sleep_end) {
       delay = (float)(sleep_end - scheme_get_inexact_milliseconds());
       delay /= 1000.0;
       if (delay < 0)
         delay = (float)0.00001;
      } else
       delay = 0.0;

      p->block_descriptor = GENERIC_BLOCKED;
      p->blocker = (Scheme_Object *)data;
      p->block_check = (Scheme_Ready_Fun)f;
      p->block_needs_wakeup = fdf;
      
      scheme_thread_block(delay);
      
      p->block_descriptor = NOT_BLOCKED;
      p->blocker = NULL;
      p->block_check = NULL;
      p->block_needs_wakeup = NULL;
    }
  }
  p->ran_some = 1;

  return result;
}

Here is the call graph for this function:

int scheme_block_until_enable_break ( Scheme_Ready_Fun  _f,
Scheme_Needs_Wakeup_Fun  fdf,
Scheme_Object data,
float  delay,
int  enable_break 
)

Definition at line 4325 of file thread.c.

{
  if (enable_break) {
    int v;
    Scheme_Cont_Frame_Data cframe;

    scheme_push_break_enable(&cframe, 1, 1);
    v = scheme_block_until(_f, fdf, data, delay);
    scheme_pop_break_enable(&cframe, 0);

    return v;
  } else
    return scheme_block_until(_f, fdf, data, delay);
}
int scheme_block_until_unless ( Scheme_Ready_Fun  f,
Scheme_Needs_Wakeup_Fun  fdf,
Scheme_Object data,
float  delay,
Scheme_Object unless,
int  enable_break 
)

Definition at line 4365 of file thread.c.

{
  if (unless) {
    void **a;
    a = MALLOC_N(void *, 4);
    a[0] = data;
    a[1] = unless;
    a[2] = f;
    a[3] = fdf;

    data = (Scheme_Object *) mzALIAS a;
    f = ready_unless;
    if (fdf)
      fdf = needs_wakeup_unless;
  }
   
  return scheme_block_until_enable_break(f, fdf, data, delay, enable_break);
}

Here is the call graph for this function:

Definition at line 3863 of file thread.c.

Definition at line 3891 of file thread.c.

{
  if (!p) {
    p = scheme_main_thread;
    if (!p)
      return;
  }

  /* Propagate breaks: */
  while (p->nestee) {
    p = p->nestee;
  }

  p->external_break = 1;

  if (p == scheme_current_thread) {
    if (scheme_can_break(p)) {
      scheme_fuel_counter = 0;
      scheme_jit_stack_boundary = (unsigned long)-1;
    }
  }
  scheme_weak_resume_thread(p);
# if defined(WINDOWS_PROCESSES) || defined(WINDOWS_FILE_HANDLES)
  if (SAME_OBJ(p, scheme_main_thread))
    ReleaseSemaphore(scheme_break_semaphore, 1, NULL);
# endif
}

Here is the call graph for this function:

Scheme_Object* scheme_call_as_nested_thread ( int  argc,
Scheme_Object argv[],
void max_bottom 
)

Definition at line 3233 of file thread.c.

{
  Scheme_Thread *p = scheme_current_thread;
  Scheme_Thread * volatile np;
  Scheme_Custodian *mgr;
  Scheme_Object * volatile v;
  mz_jmp_buf newbuf;
  volatile int failure;

  scheme_check_proc_arity("call-in-nested-thread", 0, 0, argc, argv);
  if (argc > 1) {
    if (SCHEME_CUSTODIANP(argv[1]))
      mgr = (Scheme_Custodian *)argv[1];
    else {
      scheme_wrong_type("call-in-nested-thread", "custodian", 1, argc, argv);
      return NULL;
    }
  } else
    mgr = (Scheme_Custodian *)scheme_get_param(scheme_current_config(), MZCONFIG_CUSTODIAN);

  scheme_custodian_check_available(mgr, "call-in-nested-thread", "thread");

  SCHEME_USE_FUEL(25);

  wait_until_suspend_ok();

  np = MALLOC_ONE_TAGGED(Scheme_Thread);
  np->so.type = scheme_thread_type;
#ifdef MZ_PRECISE_GC
  GC_register_new_thread(np, mgr);
#endif
  np->running = MZTHREAD_RUNNING;
  np->ran_some = 1;

#ifdef RUNSTACK_IS_GLOBAL
  p->runstack = MZ_RUNSTACK;
  p->runstack_start = MZ_RUNSTACK_START;
  p->cont_mark_stack = MZ_CONT_MARK_STACK;
  p->cont_mark_pos = MZ_CONT_MARK_POS;
#endif

  /* zero out anything we need now, because nestee disables
     GC cleaning for this thread: */
  prepare_this_thread_for_GC(p);

  if (!p->runstack_owner) {
    Scheme_Thread **owner;
    owner = MALLOC_N(Scheme_Thread *, 1);
    p->runstack_owner = owner;
    *owner = p;
  }

  np->runstack = p->runstack;
  np->runstack_start = p->runstack_start;
  np->runstack_size = p->runstack_size;
  np->runstack_saved = p->runstack_saved;
  np->runstack_owner = p->runstack_owner;
  *np->runstack_owner = np;
  np->stack_start = p->stack_start;
  np->engine_weight = p->engine_weight;
  {
    Scheme_Object **tb;
    tb = MALLOC_N(Scheme_Object *, p->tail_buffer_size);
    np->tail_buffer = tb;
  }
  np->tail_buffer_size = p->tail_buffer_size;

  np->list_stack = p->list_stack;
  np->list_stack_pos = p->list_stack_pos;

  scheme_gmp_tls_init(np->gmp_tls);

  /* np->prev = NULL; - 0ed by allocation */
  np->next = scheme_first_thread;
  scheme_first_thread->prev = np;
  scheme_first_thread = np;

  np->t_set_parent = p->t_set_parent;
  schedule_in_set((Scheme_Object *)np, np->t_set_parent);

  {
    Scheme_Thread_Cell_Table *cells;
    cells = scheme_inherit_cells(p->cell_values);
    np->cell_values = cells;
  }
  {
    Scheme_Config *config;
    config = scheme_current_config();
    np->init_config = config;
  }
  {
    int cb;
    Scheme_Object *bc;
    cb = scheme_can_break(p);
    p->can_break_at_swap = cb;
    bc = scheme_current_break_cell();
    np->init_break_cell = bc;
    if (SAME_OBJ(bc, maybe_recycle_cell))
      maybe_recycle_cell = NULL;
  }
  np->cont_mark_pos = (MZ_MARK_POS_TYPE)1;
  /* others 0ed already by allocation */

  check_ready_break();

  np->nester = p;
  p->nestee = np;
  np->external_break = p->external_break;
  p->external_break = 0;

  {
    Scheme_Thread_Custodian_Hop *hop;
    Scheme_Custodian_Reference *mref;
    hop = MALLOC_ONE_WEAK_RT(Scheme_Thread_Custodian_Hop);
    np->mr_hop = hop;
    hop->so.type = scheme_thread_hop_type;
    {
      Scheme_Thread *wp;
      wp = (Scheme_Thread *)WEAKIFY((Scheme_Object *)np);
      hop->p = wp;
    }
    mref = scheme_add_managed(mgr, (Scheme_Object *)hop, NULL, NULL, 0);
    np->mref = mref;
    np->extra_mrefs = scheme_null;
#ifndef MZ_PRECISE_GC
    scheme_weak_reference((void **)(void *)&hop->p);
#endif
  }

#ifdef RUNSTACK_IS_GLOBAL
  MZ_CONT_MARK_STACK = np->cont_mark_stack;
  MZ_CONT_MARK_POS = np->cont_mark_pos;
#endif

  scheme_current_thread = np;

  if (p != scheme_main_thread)
    scheme_weak_suspend_thread(p);

  if (!nested_exn_handler) {
    REGISTER_SO(nested_exn_handler);
    nested_exn_handler = scheme_make_prim_w_arity(def_nested_exn_handler,
                                                  "nested-thread-exception-handler",
                                                  1, 1);
  }
  scheme_set_cont_mark(scheme_exn_handler_key, nested_exn_handler);

  /* Call thunk, catch escape: */
  np->error_buf = &newbuf;
  if (scheme_setjmp(newbuf)) {
    if (!np->cjs.is_kill)
      v = np->cjs.val;
    else
      v = NULL;
    failure = 1;
  } else {
    v = scheme_apply(argv[0], 0, NULL);
    failure = 0;
  }

  scheme_remove_managed(np->mref, (Scheme_Object *)np->mr_hop);
  {
    Scheme_Object *l;
    for (l = np->extra_mrefs; !SCHEME_NULLP(l); l = SCHEME_CDR(l)) {
      scheme_remove_managed((Scheme_Custodian_Reference *)SCHEME_CAR(l), 
                         (Scheme_Object *)np->mr_hop);
    }
  }
  np->extra_mrefs = scheme_null;
#ifdef MZ_PRECISE_GC
  WEAKIFIED(np->mr_hop->p) = NULL;
#else
  scheme_unweak_reference((void **)(void *)&np->mr_hop->p);
#endif
  scheme_remove_all_finalization(np->mr_hop);

  if (np->prev)
    np->prev->next = np->next;
  else
    scheme_first_thread = np->next;
  np->next->prev = np->prev;

  np->next = NULL;
  np->prev = NULL;

  unschedule_in_set((Scheme_Object *)np, np->t_set_parent);

  np->running = 0;

  *p->runstack_owner = p;

  p->external_break = np->external_break;
  p->nestee = NULL;
  np->nester = NULL;

  thread_is_dead(np);

  scheme_current_thread = p;

  if (p != scheme_main_thread)
    scheme_weak_resume_thread(p);

#ifdef RUNSTACK_IS_GLOBAL
  MZ_CONT_MARK_STACK = p->cont_mark_stack;
  MZ_CONT_MARK_POS = p->cont_mark_pos;
#endif

  if ((p->running & MZTHREAD_KILLED)
      || (p->running & MZTHREAD_USER_SUSPENDED))
    scheme_thread_block(0.0);

  if (failure) {
    if (!v)
      scheme_raise_exn(MZEXN_FAIL, 
                     "call-in-nested-thread: the thread was killed, or it exited via the default error escape handler");
    else
      scheme_raise(v);
  }

  /* May have just moved a break to a breakable thread: */
  /* Check for external break again after swap or sleep */
  scheme_check_break_now();

  return v;
}

Here is the call graph for this function:

Here is the caller graph for this function:

Definition at line 3684 of file thread.c.

{
  if (!p->suspend_break && !scheme_no_stack_overflow) {
    return can_break_param(p);
  } else
    return 0;
}

Here is the call graph for this function:

Here is the caller graph for this function:

Definition at line 3604 of file thread.c.

Definition at line 3705 of file thread.c.

Here is the call graph for this function:

Here is the caller graph for this function:

Definition at line 2378 of file thread.c.

Here is the caller graph for this function:

Definition at line 3609 of file thread.c.

{
  scheme_current_thread->suspend_break++;
  scheme_thread_block((float)0);
  --scheme_current_thread->suspend_break;

  check_sleep(have_activity, 0);
}

Here is the call graph for this function:

Definition at line 1840 of file thread.c.

{
  int src = 0, dest = 0;
  Scheme_Custodian_Box *cb;
  void *b;

  while (src < cust_box_count) {
    cb = cust_boxes[src];
    b = GC_base(cb);
    if (b 
#ifndef USE_SENORA_GC
        && GC_is_marked(b)
#endif
        ) {
      cust_boxes[dest++] = cb;
      if (cb->v) {
        if (cb->cust->shut_down) {
          cb->v = NULL;
        }
      }
    }
    src++;
  }
  cust_box_count = dest;
}

Here is the call graph for this function:

Here is the caller graph for this function:

Definition at line 1603 of file thread.c.