suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

global tagging

Browse Source 
svn: r17561
This commit is contained in:
Kevin Tew 2010-01-08 04:36:46 +00:00
parent 179f3615e2
commit 8d774adef7
11 changed files with 208 additions and 171 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
src/mzscheme/include/scheme.h
View File

@ -916,7 +916,6 @@ typedef struct Scheme_Cont_Frame_Data {
# include "../gc2/gc2_obj.h"
# endif
#endif
#include "schthread.h"
typedef void (Scheme_Close_Custodian_Client)(Scheme_Object *o, void *data);
typedef void (*Scheme_Exit_Closer_Func)(Scheme_Object *, Scheme_Close_Custodian_Client *, void *);
@ -1115,6 +1114,8 @@ typedef struct Scheme_Thread {
#endif
} Scheme_Thread;
#include "schthread.h"
#if !SCHEME_DIRECT_EMBEDDED
# ifdef LINK_EXTENSIONS_BY_TABLE
# define scheme_current_thread (*scheme_current_thread_ptr)

38
src/mzscheme/include/schthread.h
View File

@ -239,6 +239,25 @@ typedef struct Thread_Local_Variables {
int scheme_force_port_closed_;
int fd_reserved_;
int the_fd_;
int scheme_num_read_syntax_objects_;
struct Scheme_Load_Delay *clear_bytes_chain_;
const char *failure_msg_for_read_;
void **dgc_array_;
int *dgc_count_;
int dgc_size_;
void (*save_oom_)(void);
int current_lifetime_;
int scheme_main_was_once_suspended_;
int buffer_init_size_;
Scheme_Object *initial_inspector_;
long scheme_total_gc_time_;
long start_this_gc_time_;
long end_this_gc_time_;
volatile short delayed_break_ready_;
Scheme_Thread *main_break_target_thread_;
long scheme_code_page_total_;
int locale_on_;
const mzchar *current_locale_name_;
/*KPLAKE1*/
} Thread_Local_Variables;
@ -463,6 +482,25 @@ XFORM_GC_VARIABLE_STACK_THROUGH_THREAD_LOCAL;
#define scheme_force_port_closed XOA (scheme_get_thread_local_variables()->scheme_force_port_closed_)
#define fd_reserved XOA (scheme_get_thread_local_variables()->fd_reserved_)
#define the_fd XOA (scheme_get_thread_local_variables()->the_fd_)
#define scheme_num_read_syntax_objects XOA (scheme_get_thread_local_variables()->scheme_num_read_syntax_objects_)
#define clear_bytes_chain XOA (scheme_get_thread_local_variables()->clear_bytes_chain_)
#define failure_msg_for_read XOA (scheme_get_thread_local_variables()->failure_msg_for_read_)
#define dgc_array XOA (scheme_get_thread_local_variables()->dgc_array_)
#define dgc_count XOA (scheme_get_thread_local_variables()->dgc_count_)
#define dgc_size XOA (scheme_get_thread_local_variables()->dgc_size_)
#define save_oom XOA (scheme_get_thread_local_variables()->save_oom_)
#define current_lifetime XOA (scheme_get_thread_local_variables()->current_lifetime_)
#define scheme_main_was_once_suspended XOA (scheme_get_thread_local_variables()->scheme_main_was_once_suspended_)
#define buffer_init_size XOA (scheme_get_thread_local_variables()->buffer_init_size_)
#define initial_inspector XOA (scheme_get_thread_local_variables()->initial_inspector_)
#define scheme_total_gc_time XOA (scheme_get_thread_local_variables()->scheme_total_gc_time_)
#define start_this_gc_time XOA (scheme_get_thread_local_variables()->start_this_gc_time_)
#define end_this_gc_time XOA (scheme_get_thread_local_variables()->end_this_gc_time_)
#define delayed_break_ready XOA (scheme_get_thread_local_variables()->delayed_break_ready_)
#define main_break_target_thread XOA (scheme_get_thread_local_variables()->main_break_target_thread_)
#define scheme_code_page_total XOA (scheme_get_thread_local_variables()->scheme_code_page_total_)
#define locale_on XOA (scheme_get_thread_local_variables()->locale_on_)
#define current_locale_name XOA (scheme_get_thread_local_variables()->current_locale_name_)
/*KPLAKE2*/
/* **************************************** */

4
src/mzscheme/src/env.c
View File

@ -350,6 +350,7 @@ Scheme_Env *scheme_engine_instance_init() {
scheme_init_symbol_table();
scheme_init_module_path_table();
scheme_init_type();
scheme_init_custodian_extractors();
#ifndef DONT_USE_FOREIGN
scheme_init_foreign_globals();
#endif
@ -481,6 +482,8 @@ static Scheme_Env *place_instance_init_post_kernel(int initial_main_os_thread) {
scheme_init_port_places();
scheme_init_error_escape_proc(NULL);
scheme_init_print_buffers_places();
scheme_init_thread_places();
scheme_init_string_places();
scheme_init_logger();
scheme_init_eval_places();
scheme_init_regexp_places();
@ -727,6 +730,7 @@ static void make_kernel_env(void)
init_flfxnum(env);
scheme_init_print_global_constants();
scheme_init_variable_references_constants();
scheme_defining_primitives = 0;
}

10
src/mzscheme/src/print.c
View File

@ -32,21 +32,21 @@
# include <malloc.h>
#endif
int (*scheme_check_print_is_obj)(Scheme_Object *o);
HOOK_SHARED_OK int (*scheme_check_print_is_obj)(Scheme_Object *o);
#define QUICK_ENCODE_BUFFER_SIZE 256
THREAD_LOCAL_DECL(static char *quick_buffer = NULL);
THREAD_LOCAL_DECL(static char *quick_encode_buffer = NULL);
/* FIXME places possible race condition on growing printer size */
static Scheme_Type_Printer *printers;
static int printers_count;
SHARED_OK static Scheme_Type_Printer *printers;
SHARED_OK static int printers_count;
THREAD_LOCAL_DECL(static Scheme_Hash_Table *cache_ht);
/* read-only globals */
static char compacts[_CPT_COUNT_];
static Scheme_Hash_Table *global_constants_ht;
SHARED_OK static char compacts[_CPT_COUNT_];
SHARED_OK static Scheme_Hash_Table *global_constants_ht;
static Scheme_Object *quote_link_symbol = NULL;
/* Flag for debugging compiled code in printed form: */

145
src/mzscheme/src/read.c
View File

@ -53,18 +53,20 @@
/* these are used to set initial config parameterizations */
SHARED_OK int scheme_square_brackets_are_parens = 1;
SHARED_OK int scheme_curly_braces_are_parens = 1;
/* performance counter */ /* FIXME should be atomically incremented or not shared */
int scheme_num_read_syntax_objects;
/* global flag set from environment variable */
SHARED_OK static int use_perma_cache = 1;
THREAD_LOCAL_DECL(int scheme_num_read_syntax_objects);
/* read-only global symbols */
static char *builtin_fast; /* FIXME possible init race condition */
SHARED_OK static char *builtin_fast;
SHARED_OK static unsigned char delim[128];
SHARED_OK static unsigned char cpt_branch[256];
/* Table of built-in variable refs for .zo loading: */
static Scheme_Object **variable_references;
SHARED_OK static Scheme_Object **variable_references;
ROSYM static Scheme_Object *quote_symbol;
ROSYM static Scheme_Object *quasiquote_symbol;
ROSYM static Scheme_Object *unquote_symbol;
@ -360,8 +362,6 @@ typedef struct {
void scheme_init_read(Scheme_Env *env)
{
REGISTER_SO(variable_references);
REGISTER_SO(quote_symbol);
REGISTER_SO(quasiquote_symbol);
REGISTER_SO(unquote_symbol);
@ -374,6 +374,10 @@ void scheme_init_read(Scheme_Env *env)
REGISTER_SO(unresolved_uninterned_symbol);
REGISTER_SO(tainted_uninterned_symbol);
REGISTER_SO(terminating_macro_symbol);
REGISTER_SO(non_terminating_macro_symbol);
REGISTER_SO(dispatch_macro_symbol);
REGISTER_SO(builtin_fast);
quote_symbol = scheme_intern_symbol("quote");
quasiquote_symbol = scheme_intern_symbol("quasiquote");
@ -388,6 +392,59 @@ void scheme_init_read(Scheme_Env *env)
unresolved_uninterned_symbol = scheme_make_symbol("unresolved");
tainted_uninterned_symbol = scheme_make_symbol("tainted");
terminating_macro_symbol = scheme_intern_symbol("terminating-macro");
non_terminating_macro_symbol = scheme_intern_symbol("non-terminating-macro");
dispatch_macro_symbol = scheme_intern_symbol("dispatch-macro");
/* initialize builtin_fast */
{
int i;
builtin_fast = scheme_malloc_atomic(128);
memset(builtin_fast, READTABLE_CONTINUING, 128);
for (i = 0; i < 128; i++) {
if (scheme_isspace(i))
builtin_fast[i] = READTABLE_WHITESPACE;
}
builtin_fast[';'] = READTABLE_TERMINATING;
builtin_fast['\''] = READTABLE_TERMINATING;
builtin_fast[','] = READTABLE_TERMINATING;
builtin_fast['"'] = READTABLE_TERMINATING;
builtin_fast['|'] = READTABLE_MULTIPLE_ESCAPE;
builtin_fast['\\'] = READTABLE_SINGLE_ESCAPE;
builtin_fast['('] = READTABLE_TERMINATING;
builtin_fast['['] = READTABLE_TERMINATING;
builtin_fast['{'] = READTABLE_TERMINATING;
builtin_fast[')'] = READTABLE_TERMINATING;
builtin_fast[']'] = READTABLE_TERMINATING;
builtin_fast['}'] = READTABLE_TERMINATING;
}
/* initialize cpt_branch */
{
int i;
for (i = 0; i < 256; i++) {
cpt_branch[i] = i;
}
#define FILL_IN(v) \
for (i = CPT_ ## v ## _START; i < CPT_ ## v ## _END; i++) { \
cpt_branch[i] = CPT_ ## v ## _START; \
}
FILL_IN(SMALL_NUMBER);
FILL_IN(SMALL_SYMBOL);
FILL_IN(SMALL_MARSHALLED);
FILL_IN(SMALL_LIST);
FILL_IN(SMALL_PROPER_LIST);
FILL_IN(SMALL_LOCAL);
FILL_IN(SMALL_LOCAL_UNBOX);
FILL_IN(SMALL_SVECTOR);
FILL_IN(SMALL_APPLICATION);
/* These two are handled specially: */
cpt_branch[CPT_SMALL_APPLICATION2] = CPT_SMALL_APPLICATION2;
cpt_branch[CPT_SMALL_APPLICATION3] = CPT_SMALL_APPLICATION3;
}
REGISTER_SO(honu_comma);
REGISTER_SO(honu_semicolon);
@ -489,6 +546,13 @@ void scheme_init_read(Scheme_Env *env)
}
}
void scheme_init_variable_references_constants()
{
REGISTER_SO(variable_references);
variable_references = scheme_make_builtin_references_table();
}
static Scheme_Simple_Object *malloc_list_stack()
{
#ifdef MZ_PRECISE_GC
@ -4263,7 +4327,8 @@ typedef struct Scheme_Load_Delay {
int perma_cache;
unsigned char *cached;
Scheme_Object *cached_port;
struct Scheme_Load_Delay *clear_bytes_prev, *clear_bytes_next;
struct Scheme_Load_Delay *clear_bytes_prev;
struct Scheme_Load_Delay *clear_bytes_next;
} Scheme_Load_Delay;
#define ZO_CHECK(x) if (!(x)) scheme_ill_formed_code(port);
@ -4443,7 +4508,6 @@ static Scheme_Object *read_compact_escape(CPort *port)
return read_inner(ep, NULL, port->ht, scheme_null, &params, 0);
}
static unsigned char cpt_branch[256];
static Scheme_Object *read_compact(CPort *port, int use_stack);
@ -5129,35 +5193,6 @@ static Scheme_Object *read_compiled(Scheme_Object *port,
Scheme_Object *dir;
Scheme_Config *config;
if (!cpt_branch[1]) {
int i;
for (i = 0; i < 256; i++) {
cpt_branch[i] = i;
}
#define FILL_IN(v) \
for (i = CPT_ ## v ## _START; i < CPT_ ## v ## _END; i++) { \
cpt_branch[i] = CPT_ ## v ## _START; \
}
FILL_IN(SMALL_NUMBER);
FILL_IN(SMALL_SYMBOL);
FILL_IN(SMALL_MARSHALLED);
FILL_IN(SMALL_LIST);
FILL_IN(SMALL_PROPER_LIST);
FILL_IN(SMALL_LOCAL);
FILL_IN(SMALL_LOCAL_UNBOX);
FILL_IN(SMALL_SVECTOR);
FILL_IN(SMALL_APPLICATION);
/* These two are handled specially: */
cpt_branch[CPT_SMALL_APPLICATION2] = CPT_SMALL_APPLICATION2;
cpt_branch[CPT_SMALL_APPLICATION3] = CPT_SMALL_APPLICATION3;
}
if (!variable_references)
variable_references = scheme_make_builtin_references_table();
/* Allow delays? */
if (params->delay_load_info) {
delay_info = MALLOC_ONE_RT(Scheme_Load_Delay);
@ -5338,7 +5373,7 @@ static Scheme_Object *read_compiled(Scheme_Object *port,
return result;
}
static Scheme_Load_Delay *clear_bytes_chain;
THREAD_LOCAL_DECL(static Scheme_Load_Delay *clear_bytes_chain);
void scheme_clear_delayed_load_cache()
{
@ -5792,36 +5827,6 @@ static Scheme_Object *make_readtable(int argc, Scheme_Object **argv)
orig_t = (Readtable *)argv[0];
}
if (!terminating_macro_symbol) {
REGISTER_SO(terminating_macro_symbol);
REGISTER_SO(non_terminating_macro_symbol);
REGISTER_SO(dispatch_macro_symbol);
REGISTER_SO(builtin_fast);
terminating_macro_symbol = scheme_intern_symbol("terminating-macro");
non_terminating_macro_symbol = scheme_intern_symbol("non-terminating-macro");
dispatch_macro_symbol = scheme_intern_symbol("dispatch-macro");
fast = scheme_malloc_atomic(128);
memset(fast, READTABLE_CONTINUING, 128);
for (i = 0; i < 128; i++) {
if (scheme_isspace(i))
fast[i] = READTABLE_WHITESPACE;
}
fast[';'] = READTABLE_TERMINATING;
fast['\''] = READTABLE_TERMINATING;
fast[','] = READTABLE_TERMINATING;
fast['"'] = READTABLE_TERMINATING;
fast['|'] = READTABLE_MULTIPLE_ESCAPE;
fast['\\'] = READTABLE_SINGLE_ESCAPE;
fast['('] = READTABLE_TERMINATING;
fast['['] = READTABLE_TERMINATING;
fast['{'] = READTABLE_TERMINATING;
fast[')'] = READTABLE_TERMINATING;
fast[']'] = READTABLE_TERMINATING;
fast['}'] = READTABLE_TERMINATING;
builtin_fast = fast;
}
t = MALLOC_ONE_TAGGED(Readtable);
t->so.type = scheme_readtable_type;
if (orig_t)

2
src/mzscheme/src/regexp.c
View File

@ -125,7 +125,7 @@ regerror(char *s)
"regexp: %s", s);
}
const char *failure_msg_for_read;
THREAD_LOCAL_DECL(const char *failure_msg_for_read);
static void
regcomperror(char *s)

20
src/mzscheme/src/salloc.c
View File

@ -50,15 +50,15 @@
# include <windows.h>
#endif
static void **dgc_array;
static int *dgc_count;
static int dgc_size;
THREAD_LOCAL_DECL(static void **dgc_array);
THREAD_LOCAL_DECL(static int *dgc_count);
THREAD_LOCAL_DECL(static int dgc_size);
#ifdef USE_THREAD_LOCAL
# ifdef IMPLEMENT_THREAD_LOCAL_VIA_PTHREADS
pthread_key_t scheme_thread_local_key;
# else
THREAD_LOCAL Thread_Local_Variables scheme_thread_locals;
SHARED_OK THREAD_LOCAL Thread_Local_Variables scheme_thread_locals;
# endif
#endif
@ -532,7 +532,7 @@ void scheme_free_immobile_box(void **b)
#endif
}
static void (*save_oom)(void);
THREAD_LOCAL_DECL(static void (*save_oom)(void));
static void raise_out_of_memory(void)
{
@ -726,7 +726,8 @@ START_XFORM_SKIP;
/* Max of desired alignment and 2 * sizeof(long): */
#define CODE_HEADER_SIZE 16
long scheme_code_page_total;
THREAD_LOCAL_DECL(long scheme_code_page_total);
#if defined(MZ_JIT_USE_MPROTECT) && !defined(MAP_ANON)
static int fd, fd_created;
@ -737,7 +738,8 @@ static int fd, fd_created;
#if defined(MZ_JIT_USE_MPROTECT) || defined(MZ_JIT_USE_WINDOWS_VIRTUAL_ALLOC)
struct free_list_entry {
FIXME_LATER struct free_list_entry {
long size; /* size of elements in this bucket */
void *elems; /* doubly linked list for free blocks */
int count; /* number of items in `elems' */
@ -751,7 +753,7 @@ static long get_page_size()
# ifdef PAGESIZE
const long page_size = PAGESIZE;
# else
static unsigned long page_size = -1;
SHARED_OK static unsigned long page_size = -1;
if (page_size == -1) {
# ifdef MZ_JIT_USE_WINDOWS_VIRTUAL_ALLOC
SYSTEM_INFO info;
@ -1136,7 +1138,7 @@ END_XFORM_SKIP;
#endif
static int current_lifetime;
THREAD_LOCAL_DECL(static int current_lifetime);
void scheme_reset_finalizations(void)
{

8
src/mzscheme/src/schpriv.h
View File

@ -104,7 +104,7 @@ Scheme_Object *scheme_dump_gc_stats(int c, Scheme_Object *p[]);
#define REGISTER_SO(x) MZ_REGISTER_STATIC(x)
extern long scheme_total_gc_time;
THREAD_LOCAL_DECL(extern long scheme_total_gc_time);
THREAD_LOCAL_DECL(extern int scheme_cont_capture_count);
THREAD_LOCAL_DECL(extern int scheme_continuation_application_count);
@ -184,6 +184,7 @@ void scheme_init_true_false(void);
void scheme_init_symbol_table(void);
void scheme_init_symbol_type(Scheme_Env *env);
void scheme_init_type();
void scheme_init_custodian_extractors();
void scheme_init_bignum();
void scheme_init_list(Scheme_Env *env);
void scheme_init_unsafe_list(Scheme_Env *env);
@ -248,6 +249,8 @@ void scheme_init_place(Scheme_Env *env);
void scheme_init_futures(Scheme_Env *env);
void scheme_init_print_buffers_places(void);
void scheme_init_string_places(void);
void scheme_init_thread_places(void);
void scheme_init_eval_places(void);
void scheme_init_port_places(void);
void scheme_init_regexp_places(void);
@ -256,6 +259,7 @@ void scheme_init_fun_places(void);
void scheme_init_sema_places(void);
void scheme_init_gmp_places(void);
void scheme_init_print_global_constants(void);
void scheme_init_variable_references_constants(void);
void scheme_init_logger(void);
void scheme_init_file_places(void);
Scheme_Logger *scheme_get_main_logger(void);
@ -540,7 +544,7 @@ typedef int (*Scheme_Ready_Fun_FPC)(Scheme_Object *o, Scheme_Schedule_Info *sinf
void scheme_check_break_now(void);
extern int scheme_main_was_once_suspended;
THREAD_LOCAL_DECL(extern int scheme_main_was_once_suspended);
/* A "flattened" config. Maps parameters to thread cells. */
typedef struct {

3
src/mzscheme/src/sema.c
View File

@ -57,8 +57,7 @@ static int thread_recv_ready(Scheme_Object *ch, Scheme_Schedule_Info *sinfo);
static int pending_break(Scheme_Thread *p);
int scheme_main_was_once_suspended;
THREAD_LOCAL_DECL(int scheme_main_was_once_suspended);
THREAD_LOCAL_DECL(static Scheme_Object *system_idle_put_evt);
READ_ONLY static Scheme_Object *thread_recv_evt;

32
src/mzscheme/src/string.c
View File

@ -162,8 +162,8 @@ typedef struct Scheme_Converter {
is called after continuation marks (and hence parameterization)
may have changed. Similarly, setlocale() is only up-to-date
when reset_locale() has been called. */
static int locale_on;
static const mzchar *current_locale_name = (mzchar *)"xxxx\0\0\0\0";
THREAD_LOCAL_DECL(static int locale_on);
THREAD_LOCAL_DECL(static const mzchar *current_locale_name);
static void reset_locale(void);
#ifdef USE_ICONV_DLL
@ -341,7 +341,8 @@ READ_ONLY static Scheme_Object *zero_length_byte_string;
SHARED_OK static Scheme_Hash_Table *putenv_str_table;
SHARED_OK static char *embedding_banner;
static Scheme_Object *vers_str, *banner_str;
SHARED_OK static Scheme_Object *vers_str;
SHARED_OK static Scheme_Object *banner_str;
READ_ONLY static Scheme_Object *complete_symbol, *continues_symbol, *aborts_symbol, *error_symbol;
@ -385,7 +386,13 @@ scheme_init_string (Scheme_Env *env)
REGISTER_SO(putenv_str_table);
REGISTER_SO(embedding_banner);
REGISTER_SO(current_locale_name);
REGISTER_SO(vers_str);
REGISTER_SO(banner_str);
vers_str = scheme_make_utf8_string(scheme_version());
SCHEME_SET_CHAR_STRING_IMMUTABLE(vers_str);
banner_str = scheme_make_utf8_string(scheme_banner());
SCHEME_SET_CHAR_STRING_IMMUTABLE(banner_str);
p = scheme_make_folding_prim(string_p, "string?", 1, 1, 1);
SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_IS_UNARY_INLINED;
@ -845,6 +852,11 @@ scheme_init_string (Scheme_Env *env)
#endif
}
void scheme_init_string_places(void) {
REGISTER_SO(current_locale_name);
current_locale_name = (mzchar *)"xxxx\0\0\0\0";
}
/**********************************************************************/
/* UTF-8 char constructors */
/**********************************************************************/
@ -1902,24 +1914,12 @@ sch_fprintf(int argc, Scheme_Object *argv[])
static Scheme_Object *
version(int argc, Scheme_Object *argv[])
{
if (!vers_str) {
REGISTER_SO(vers_str);
vers_str = scheme_make_utf8_string(scheme_version());
SCHEME_SET_CHAR_STRING_IMMUTABLE(vers_str);
}
return vers_str;
}
static Scheme_Object *
banner(int argc, Scheme_Object *argv[])
{
if (!banner_str) {
REGISTER_SO(banner_str);
banner_str = scheme_make_utf8_string(scheme_banner());
SCHEME_SET_CHAR_STRING_IMMUTABLE(banner_str);
}
return banner_str;
}

110
src/mzscheme/src/thread.c
View File

@ -119,7 +119,7 @@ extern void scheme_gmp_tls_restore_snapshot(long *s, void *data, long *save, int
static void check_ready_break();
extern int scheme_num_read_syntax_objects;
THREAD_LOCAL_DECL(extern int scheme_num_read_syntax_objects);
THREAD_LOCAL_DECL(extern long scheme_hash_request_count);
THREAD_LOCAL_DECL(extern long scheme_hash_iteration_count);
#ifdef MZ_USE_JIT
@ -138,7 +138,7 @@ extern int scheme_jit_malloced;
# define MZ_THREAD_QUANTUM_USEC 10000
#endif
static int buffer_init_size = INIT_TB_SIZE;
THREAD_LOCAL_DECL(static int buffer_init_size);
THREAD_LOCAL_DECL(Scheme_Thread *scheme_current_thread = NULL);
THREAD_LOCAL_DECL(Scheme_Thread *scheme_main_thread = NULL);
@ -162,7 +162,7 @@ THREAD_LOCAL_DECL(static int swap_no_setjmp = 0);
THREAD_LOCAL_DECL(static int thread_swap_count);
THREAD_LOCAL_DECL(int scheme_did_gc_count);
static int init_load_on_demand = 1;
SHARED_OK static int init_load_on_demand = 1;
#ifdef RUNSTACK_IS_GLOBAL
THREAD_LOCAL_DECL(Scheme_Object **scheme_current_runstack_start);
@ -174,8 +174,7 @@ THREAD_LOCAL_DECL(MZ_MARK_POS_TYPE scheme_current_cont_mark_pos);
THREAD_LOCAL_DECL(static Scheme_Custodian *main_custodian);
THREAD_LOCAL_DECL(static Scheme_Custodian *last_custodian);
THREAD_LOCAL_DECL(static Scheme_Hash_Table *limited_custodians = NULL);
static Scheme_Object *initial_inspector;
THREAD_LOCAL_DECL(static Scheme_Object *initial_inspector);
#ifndef MZ_PRECISE_GC
static int cust_box_count, cust_box_alloc;
@ -190,22 +189,23 @@ ROSYM Scheme_Object *scheme_parameterization_key;
ROSYM Scheme_Object *scheme_exn_handler_key;
ROSYM Scheme_Object *scheme_break_enabled_key;
long scheme_total_gc_time;
static long start_this_gc_time, end_this_gc_time;
THREAD_LOCAL_DECL(long scheme_total_gc_time);
THREAD_LOCAL_DECL(static long start_this_gc_time);
THREAD_LOCAL_DECL(static long end_this_gc_time);
static void get_ready_for_GC(void);
static void done_with_GC(void);
#ifdef MZ_PRECISE_GC
static void inform_GC(int major_gc, long pre_used, long post_used);
#endif
static volatile short delayed_break_ready = 0;
static Scheme_Thread *main_break_target_thread;
THREAD_LOCAL_DECL(static volatile short delayed_break_ready);
THREAD_LOCAL_DECL(static Scheme_Thread *main_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);
HOOK_SHARED_OK void (*scheme_sleep)(float seconds, void *fds);
HOOK_SHARED_OK void (*scheme_notify_multithread)(int on);
HOOK_SHARED_OK void (*scheme_wakeup_on_input)(void *fds);
HOOK_SHARED_OK int (*scheme_check_for_break)(void);
HOOK_SHARED_OK void (*scheme_on_atomic_timeout)(void);
ROSYM static Scheme_Object *read_symbol, *write_symbol, *execute_symbol, *delete_symbol, *exists_symbol;
ROSYM static Scheme_Object *client_symbol, *server_symbol;
@ -377,7 +377,7 @@ static int post_system_idle();
static Scheme_Object *current_stats(int argc, Scheme_Object *args[]);
static Scheme_Object **config_map;
SHARED_OK static Scheme_Object **config_map;
typedef struct {
MZTAG_IF_REQUIRED
@ -398,15 +398,14 @@ typedef struct Scheme_Thread_Custodian_Hop {
Scheme_Thread *p; /* really an indirection with precise gc */
} Scheme_Thread_Custodian_Hop;
static Scheme_Custodian_Extractor *extractors;
SHARED_OK static Scheme_Custodian_Extractor *extractors;
typedef struct {
MZTAG_IF_REQUIRED
Scheme_Object *key;
void (*f)(Scheme_Env *);
} Scheme_NSO;
static int num_nsos = 0;
static Scheme_NSO *namespace_options = NULL;
#define SETJMP(p) scheme_setjmpup(&p->jmpup_buf, p, p->stack_start)
#define LONGJMP(p) scheme_longjmpup(&p->jmpup_buf)
@ -435,6 +434,24 @@ unsigned long scheme_get_current_thread_stack_start(void);
void scheme_init_thread(Scheme_Env *env)
{
REGISTER_SO(read_symbol);
REGISTER_SO(write_symbol);
REGISTER_SO(execute_symbol);
REGISTER_SO(delete_symbol);
REGISTER_SO(exists_symbol);
read_symbol = scheme_intern_symbol("read");
write_symbol = scheme_intern_symbol("write");
execute_symbol = scheme_intern_symbol("execute");
delete_symbol = scheme_intern_symbol("delete");
exists_symbol = scheme_intern_symbol("exists");
REGISTER_SO(client_symbol);
REGISTER_SO(server_symbol);
client_symbol = scheme_intern_symbol("client");
server_symbol = scheme_intern_symbol("server");
scheme_add_global_constant("dump-memory-stats",
scheme_make_prim_w_arity(scheme_dump_gc_stats,
"dump-memory-stats",
@ -782,9 +799,10 @@ void scheme_init_thread(Scheme_Env *env)
"current-thread-initial-stack-size",
MZCONFIG_THREAD_INIT_STACK_SIZE),
env);
}
REGISTER_SO(namespace_options);
void scheme_init_thread_places(void) {
buffer_init_size = INIT_TB_SIZE;
}
void scheme_init_memtrace(Scheme_Env *env)
@ -1647,7 +1665,7 @@ static Scheme_Object *extract_thread(Scheme_Object *o)
return (Scheme_Object *)WEAKIFIED(((Scheme_Thread_Custodian_Hop *)o)->p);
}
void scheme_add_custodian_extractor(Scheme_Type t, Scheme_Custodian_Extractor e)
void scheme_init_custodian_extractors()
{
if (!extractors) {
int n;
@ -1657,7 +1675,10 @@ void scheme_add_custodian_extractor(Scheme_Type t, Scheme_Custodian_Extractor e)
memset(extractors, 0, sizeof(Scheme_Custodian_Extractor) * n);
extractors[scheme_thread_hop_type] = extract_thread;
}
}
void scheme_add_custodian_extractor(Scheme_Type t, Scheme_Custodian_Extractor e)
{
if (t) {
extractors[t] = e;
}
@ -5170,8 +5191,10 @@ typedef struct Evt {
int can_redirect;
} Evt;
static int evts_array_size;
static Evt **evts;
/* PLACE_THREAD_DECL */
FIXME_LATER static int evts_array_size;
FIXME_LATER static Evt **evts;
void scheme_add_evt(Scheme_Type type,
Scheme_Ready_Fun ready,
@ -6083,7 +6106,7 @@ static Scheme_Object *thread_cell_set(int argc, Scheme_Object *argv[])
/* parameters */
/*========================================================================*/
static int max_configs = __MZCONFIG_BUILTIN_COUNT__;
SHARED_OK static int max_configs = __MZCONFIG_BUILTIN_COUNT__;
static Scheme_Object *do_param(void *data, int argc, Scheme_Object *argv[]);
Scheme_Config *scheme_current_config()
@ -6866,23 +6889,6 @@ Scheme_Env *scheme_get_env(Scheme_Config *c)
return (Scheme_Env *)o;
}
void scheme_add_namespace_option(Scheme_Object *key, void (*f)(Scheme_Env *))
{
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++;
}
Scheme_Object *scheme_make_namespace(int argc, Scheme_Object *argv[])
{
Scheme_Env *genv, *env;
@ -6965,20 +6971,6 @@ void scheme_security_check_file(const char *who, const char *filename, int guard
if (sg->file_proc) {
Scheme_Object *l = scheme_null, *a[3];
if (!read_symbol) {
REGISTER_SO(read_symbol);
REGISTER_SO(write_symbol);
REGISTER_SO(execute_symbol);
REGISTER_SO(delete_symbol);
REGISTER_SO(exists_symbol);
read_symbol = scheme_intern_symbol("read");
write_symbol = scheme_intern_symbol("write");
execute_symbol = scheme_intern_symbol("execute");
delete_symbol = scheme_intern_symbol("delete");
exists_symbol = scheme_intern_symbol("exists");
}
if (guards & SCHEME_GUARD_FILE_EXISTS)
l = scheme_make_pair(exists_symbol, l);
if (guards & SCHEME_GUARD_FILE_DELETE)
@ -7037,14 +7029,6 @@ void scheme_security_check_network(const char *who, const char *host, int port,
if (sg->network_proc) {
Scheme_Object *a[4];
if (!client_symbol) {
REGISTER_SO(client_symbol);
REGISTER_SO(server_symbol);
client_symbol = scheme_intern_symbol("client");
server_symbol = scheme_intern_symbol("server");
}
a[0] = scheme_intern_symbol(who);
a[1] = (host ? scheme_make_sized_utf8_string((char *)host, -1) : scheme_false);
a[2] = ((port < 1) ? scheme_false : scheme_make_integer(port));