From 8d774adef78b36b28e1868655372c04e8a0e371b Mon Sep 17 00:00:00 2001 From: Kevin Tew Date: Fri, 8 Jan 2010 04:36:46 +0000 Subject: [PATCH] global tagging svn: r17561 --- src/mzscheme/include/scheme.h | 3 +- src/mzscheme/include/schthread.h | 38 ++++++++ src/mzscheme/src/env.c | 4 + src/mzscheme/src/print.c | 10 +-- src/mzscheme/src/read.c | 149 ++++++++++++++++--------------- src/mzscheme/src/regexp.c | 2 +- src/mzscheme/src/salloc.c | 20 +++-- src/mzscheme/src/schpriv.h | 8 +- src/mzscheme/src/sema.c | 3 +- src/mzscheme/src/string.c | 32 +++---- src/mzscheme/src/thread.c | 110 ++++++++++------------- 11 files changed, 208 insertions(+), 171 deletions(-) diff --git a/src/mzscheme/include/scheme.h b/src/mzscheme/include/scheme.h index e1b437471c..f1b4e5469c 100644 --- a/src/mzscheme/include/scheme.h +++ b/src/mzscheme/include/scheme.h @@ -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) diff --git a/src/mzscheme/include/schthread.h b/src/mzscheme/include/schthread.h index ba198fd4c6..4ee4665c40 100644 --- a/src/mzscheme/include/schthread.h +++ b/src/mzscheme/include/schthread.h @@ -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*/ /* **************************************** */ diff --git a/src/mzscheme/src/env.c b/src/mzscheme/src/env.c index e2ee3e8282..990fa77885 100644 --- a/src/mzscheme/src/env.c +++ b/src/mzscheme/src/env.c @@ -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; } diff --git a/src/mzscheme/src/print.c b/src/mzscheme/src/print.c index d08a5a4d1d..b21bb59cd0 100644 --- a/src/mzscheme/src/print.c +++ b/src/mzscheme/src/print.c @@ -32,21 +32,21 @@ # include #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: */ diff --git a/src/mzscheme/src/read.c b/src/mzscheme/src/read.c index 6167f00c2e..e28db07262 100644 --- a/src/mzscheme/src/read.c +++ b/src/mzscheme/src/read.c @@ -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"); @@ -385,9 +389,62 @@ void scheme_init_read(Scheme_Env *env) quasisyntax_symbol = scheme_intern_symbol("quasisyntax"); paren_shape_symbol = scheme_intern_symbol("paren-shape"); - unresolved_uninterned_symbol = scheme_make_symbol("unresolved"); - tainted_uninterned_symbol = scheme_make_symbol("tainted"); + 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, ¶ms, 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) diff --git a/src/mzscheme/src/regexp.c b/src/mzscheme/src/regexp.c index 19e9118afd..2343814d9f 100644 --- a/src/mzscheme/src/regexp.c +++ b/src/mzscheme/src/regexp.c @@ -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) diff --git a/src/mzscheme/src/salloc.c b/src/mzscheme/src/salloc.c index 37b9ded6c4..70ed8050fd 100644 --- a/src/mzscheme/src/salloc.c +++ b/src/mzscheme/src/salloc.c @@ -50,15 +50,15 @@ # include #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) { diff --git a/src/mzscheme/src/schpriv.h b/src/mzscheme/src/schpriv.h index 8caeb64b38..c8ce7e868c 100644 --- a/src/mzscheme/src/schpriv.h +++ b/src/mzscheme/src/schpriv.h @@ -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 { diff --git a/src/mzscheme/src/sema.c b/src/mzscheme/src/sema.c index 960ee3bdc3..f6f78d0b0a 100644 --- a/src/mzscheme/src/sema.c +++ b/src/mzscheme/src/sema.c @@ -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; diff --git a/src/mzscheme/src/string.c b/src/mzscheme/src/string.c index 2d7f6ea922..d3db745161 100644 --- a/src/mzscheme/src/string.c +++ b/src/mzscheme/src/string.c @@ -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; } diff --git a/src/mzscheme/src/thread.c b/src/mzscheme/src/thread.c index 501514dcb7..4cd742a66e 100644 --- a/src/mzscheme/src/thread.c +++ b/src/mzscheme/src/thread.c @@ -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));