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

C thread-local variables when the C compiler don't support thread-local variables

Browse Source 
svn: r16860
This commit is contained in:
Matthew Flatt 2009-11-18 14:52:51 +00:00
parent 5cea34ec49
commit 5d79713481
44 changed files with 901 additions and 390 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

55
collects/compiler/private/xform.ss
View File

@ -78,6 +78,8 @@
(hash-table-put! used-symbols (string->symbol "GC_get_variable_stack") 1)
(hash-table-put! used-symbols (string->symbol "GC_set_variable_stack") 1)
(hash-table-put! used-symbols (string->symbol "memset") 1)
(hash-table-put! used-symbols (string->symbol "scheme_thread_local_key") 1)
(hash-table-put! used-symbols (string->symbol "pthread_getspecific") 1)
;; For dependency tracking:
(define depends-files (make-hash-table 'equal))
@ -587,6 +589,16 @@
(and (pragma? e)
(regexp-match #rx"GC_VARIABLE_STACK_THOUGH_TABLE" (pragma-s e))))
e-raw))
(define gc-var-stack-through-thread-local?
(ormap (lambda (e)
(and (tok? e)
(eq? (tok-n e) 'XFORM_GC_VARIABLE_STACK_THROUGH_THREAD_LOCAL)))
e-raw))
(define gc-var-stack-through-getspecific?
(ormap (lambda (e)
(and (tok? e)
(eq? (tok-n e) 'XFORM_GC_VARIABLE_STACK_THROUGH_GETSPECIFIC)))
e-raw))
;; The code produced by xform uses a number of macros. These macros
;; make the transformation about a little easier to debug, and they
@ -595,9 +607,14 @@
(when (and pgc? (not precompiled-header))
;; Setup GC_variable_stack macro
(printf (if gc-var-stack-through-table?
"#define GC_VARIABLE_STACK (scheme_extension_table->GC_variable_stack)~n"
"#define GC_VARIABLE_STACK GC_variable_stack~n"))
(printf (cond
[gc-var-stack-through-table?
"#define GC_VARIABLE_STACK (scheme_extension_table->GC_variable_stack)~n"]
[gc-var-stack-through-getspecific?
"#define GC_VARIABLE_STACK (((Thread_Local_Variables *)pthread_getspecific(scheme_thread_local_key))->GC_variable_stack_)~n"]
[gc-var-stack-through-thread-local?
"#define GC_VARIABLE_STACK ((&scheme_thread_locals)->GC_variable_stack_)~n"]
[else "#define GC_VARIABLE_STACK GC_variable_stack~n"]))
(if gc-variable-stack-through-funcs?
(begin
@ -713,8 +730,9 @@
(printf "#define XFORM_OK_MINUS -~n")
(printf "#define XFORM_TRUST_PLUS +~n")
(printf "#define XFORM_TRUST_MINUS -~n")
(printf "#define XFORM_OK_ASSIGN /**/~n")
(printf "~n")
;; C++ cupport:
(printf "#define NEW_OBJ(t) new (UseGC) t~n")
(printf "#define NEW_ARRAY(t, array) (new (UseGC) t array)~n")
@ -830,13 +848,14 @@
\| \|\| & && |:| ? % + - * / ^ >> << ~
#csXFORM_OK_PLUS #csXFORM_OK_MINUS #csXFORM_TRUST_PLUS #csXFORM_TRUST_MINUS
= >>= <<= ^= += *= /= -= %= \|= &= ++ --
return if for while else switch case
return if for while else switch case XFORM_OK_ASSIGN
asm __asm __asm__ __volatile __volatile__ volatile __extension__
__typeof sizeof __builtin_object_size
;; These don't act like functions:
setjmp longjmp _longjmp scheme_longjmp_setjmp scheme_mz_longjmp scheme_jit_longjmp
scheme_jit_setjmp_prepare
scheme_get_thread_local_variables pthread_getspecific
;; The following are functions, but they don't trigger GC, and
;; they either take one argument or no pointer arguments.
@ -1053,7 +1072,10 @@
(set! non-pointer-types (list-ref l 5))
(set! struct-defs (list-ref l 6))
(set! non-gcing-functions (hash-table-copy (list-ref l 7)))))))
(set! non-gcing-functions (hash-table-copy (list-ref l 7)))
(set! gc-var-stack-through-thread-local? (list-ref l 8))
(set! gc-var-stack-through-getspecific? (list-ref l 9))))))
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Pretty-printing output
@ -1160,6 +1182,7 @@
(unless (regexp-match re:boring s)
(printf "\n~a\n\n" s)
(set! line (+ line 3))))]
[(threadlocal-decl? v) (void)]
[(seq? v)
(display/indent v (tok-n v))
(let ([subindent (if (braces? v)
@ -1406,6 +1429,9 @@
[(start-arith? e)
(set! check-arith? #t)
null]
[(threadlocal-decl? e)
null]
[(access-modifier? e)
;; public, private, etc.
@ -1580,6 +1606,11 @@
(and (pair? e)
(or (eq? END_XFORM_ARITH (tok-n (car e)))
(eq? 'XFORM_START_TRUST_ARITH (tok-n (car e))))))
(define (threadlocal-decl? e)
(and (pair? e)
(or (eq? 'XFORM_GC_VARIABLE_STACK_THROUGH_GETSPECIFIC (tok-n (car e)))
(eq? 'XFORM_GC_VARIABLE_STACK_THROUGH_THREAD_LOCAL (tok-n (car e))))))
(define (access-modifier? e)
(and (memq (tok-n (car e)) '(public private protected))
@ -1907,6 +1938,7 @@
(and struct-array?
(struct-array-type-count (cdr base-is-ptr?))))])
(when (and struct-array?
(not union-ok?)
(> array-size 16))
(log-error "[SIZE] ~a in ~a: Large array of structures at ~a."
(tok-line v) (tok-file v) name))
@ -3553,7 +3585,10 @@
(and m
(not (or (array-type? (cdr m))
(struct-array-type? (cdr m)))))))))
(not (symbol? (tok-n (car assignee)))))
(and (not (symbol? (tok-n (car assignee))))
;; as below, ok if preceded by XFORM_OK_ASSIGN
(or (not (pair? (cdr assignee)))
(not (eq? (tok-n (cadr assignee)) 'XFORM_OK_ASSIGN)))))
(and (symbol? (tok-n (car assignee)))
(not (null? (cdr assignee)))
;; ok if name starts with "_stk_"
@ -3565,6 +3600,8 @@
(pair? (cddr assignee))
(symbol? (tok-n (caddr assignee)))
(null? (cdddr assignee))))
;; ok if preceded by XFORM_OK_ASSIGN
(not (eq? (tok-n (cadr assignee)) 'XFORM_OK_ASSIGN))
;; ok if preceeding is `if', `until', etc.
(not (and (parens? (cadr assignee))
(pair? (cddr assignee))
@ -3964,7 +4001,9 @@
(marshall pointer-types)
(marshall non-pointer-types)
(marshall struct-defs)
non-gcing-functions)])
non-gcing-functions
gc-var-stack-through-thread-local?
gc-var-stack-through-getspecific?)])
(with-output-to-file (change-suffix file-out #".zo")
(lambda ()
(let ([orig (current-namespace)])

2
src/mzscheme/gc2/Makefile.in
View File

@ -138,7 +138,7 @@ xobjects: $(OBJS) main.@LTO@
XFORMDEP = $(srcdir)/gc2.h $(srcdir)/gc2_obj.h $(srcdir)/xform.ss $(srcdir)/xform-mod.ss \
$(srcdir)/precomp.c $(srcdir)/../src/schpriv.h $(srcdir)/../include/scheme.h \
$(srcdir)/../sconfig.h $(srcdir)/../uconfig.h $(srcdir)/../src/schemef.h \
$(srcdir)/../src/stypes.h
$(srcdir)/../src/stypes.h $(srcdir)/../include/schthread.h
LIGHTNINGDEP = $(srcdir)/../src/lightning/i386/core.h $(srcdir)/../src/lightning/i386/core-common.h \
$(srcdir)/../src/lightning/i386/asm.h $(srcdir)/../src/lightning/i386/asm-common.h \

12
src/mzscheme/gc2/gc2.h
View File

@ -2,16 +2,6 @@
#ifndef __mzscheme_gc_2__
#define __mzscheme_gc_2__
#if defined(MZ_USE_PLACES) || defined(FUTURES_ENABLED)
# if _MSC_VER
# define THREAD_LOCAL __declspec(thread)
# else
# define THREAD_LOCAL __thread
# endif
#else
# define THREAD_LOCAL /* empty */
#endif
/***************************************************************************/
/*** See README for a general overview of the interface architecture. ***/
/***************************************************************************/
@ -288,7 +278,7 @@ GC2_EXTERN void GC_finalization_weak_ptr(void **p, int offset);
/* Cooperative GC */
/***************************************************************************/
GC2_EXTERN THREAD_LOCAL void **GC_variable_stack;
THREAD_LOCAL_DECL(GC2_EXTERN void **GC_variable_stack);
/*
See the general overview in README. */

5
src/mzscheme/gc2/gc2_obj.h
View File

@ -1,4 +1,5 @@
#include "../src/schpriv.h"
#ifndef GC2_OBJHEAD_H
#define GC2_OBJHEAD_H
#if defined(MZ_PRECISE_GC) && !defined(USE_COMPACT_3M_GC)
@ -34,3 +35,5 @@ XFORM_NONGCING extern int GC_is_allocated(void *p);
#define OBJHEAD_HASH_BITS(p) (OBJPTR_TO_OBJHEAD(p)->hash)
#endif
#endif

17
src/mzscheme/gc2/newgc.c
View File

@ -27,13 +27,16 @@
the nursery and pages being compacted.
*/
#define MZ_PRECISE_GC 1 /* required for mz includes to work right */
#define MZ_PRECISE_GC /* required for mz includes to work right */
#define XFORM_OK_ASSIGN /* annotation used when thread-local variables are needed */
#define SKIP_THREAD_LOCAL_XFORM_DECL
#include <stdlib.h>
#include <stdio.h>
#include <string.h>
#include <assert.h>
#include "pthread.h"
#include "platforms.h"
#include "../src/schpriv.h"
#include "gc2.h"
#include "gc2_dump.h"
@ -98,9 +101,9 @@ static const char *type_name[PAGE_TYPES] = {
#ifdef MZ_USE_PLACES
static NewGC *MASTERGC;
static NewGCMasterInfo *MASTERGCINFO;
static THREAD_LOCAL objhead GC_objhead_template;
THREAD_LOCAL_DECL(static objhead GC_objhead_template);
#endif
static THREAD_LOCAL NewGC *GC;
THREAD_LOCAL_DECL(static NewGC *GC);
#define GCTYPE NewGC
#define GC_get_GC() (GC)
#define GC_set_GC(gc) (GC = gc)
@ -471,8 +474,8 @@ int GC_is_allocated(void *p)
The size count helps us trigger collection quickly when we're running out of space; see
the test in allocate_big.
*/
THREAD_LOCAL unsigned long GC_gen0_alloc_page_ptr = 0;
THREAD_LOCAL unsigned long GC_gen0_alloc_page_end = 0;
THREAD_LOCAL_DECL(unsigned long GC_gen0_alloc_page_ptr = 0);
THREAD_LOCAL_DECL(unsigned long GC_gen0_alloc_page_end = 0);
/* miscellaneous variables */
static const char *zero_sized[4]; /* all 0-sized allocs get this */
@ -1242,7 +1245,7 @@ static void *get_backtrace(mpage *page, void *ptr)
/* With the exception of the "traverse" macro and resultant simplification, */
/* this code is entirely lifted from compact.c */
/*****************************************************************************/
THREAD_LOCAL void **GC_variable_stack;
THREAD_LOCAL_DECL(void **GC_variable_stack);
void **GC_get_variable_stack()
{
@ -1514,7 +1517,7 @@ inline static void reset_weak_finalizers(NewGC *gc)
#define MARK_STACK_START(ms) ((void **)(void *)&ms[1])
#define MARK_STACK_END(ms) ((void **)((char *)ms + STACK_PART_SIZE))
static THREAD_LOCAL MarkSegment *mark_stack = NULL;
THREAD_LOCAL_DECL(static MarkSegment *mark_stack = NULL);
inline static MarkSegment* mark_stack_create_frame() {
MarkSegment *mark_frame = (MarkSegment*)ofm_malloc(STACK_PART_SIZE);

17
src/mzscheme/gc2/vm_osx.c
View File

@ -250,12 +250,16 @@ kern_return_t catch_exception_raise(mach_port_t port,
/* this is the thread which forwards of exceptions read from the exception
server off to our exception catchers and then back out to the other
thread */
void exception_thread(void)
void exception_thread(void *shared_thread_state)
{
mach_msg_header_t *message;
mach_msg_header_t *reply;
kern_return_t retval;
#ifdef USE_THREAD_LOCAL
pthread_setspecific(scheme_thread_local_key, shared_thread_state);
#endif
/* allocate the space for the message and reply */
message = (mach_msg_header_t*)malloc(sizeof(mach_exc_msg_t));
reply = (mach_msg_header_t*)malloc(sizeof(mach_reply_msg_t));
@ -313,8 +317,7 @@ static void macosx_init_exception_handler()
}
#ifdef PPC_HAND_ROLLED_THREAD
/* Old hand-rolled thread creation. pthread_create is fine for our
purposes. */
/* Old hand-rolled thread creation. */
{
/* set up the subthread */
mach_port_t exc_thread;
@ -347,7 +350,11 @@ static void macosx_init_exception_handler()
#else
{
pthread_t th;
pthread_create(&th, NULL, (void *(*)(void *))exception_thread, NULL);
void *data = NULL;
#ifdef USE_THREAD_LOCAL
data = pthread_getspecific(scheme_thread_local_key);
#endif
pthread_create(&th, NULL, (void *(*)(void *))exception_thread, data);
}
#endif
}

5
src/mzscheme/include/gmzwin.def
View File

@ -3,3 +3,8 @@ EXPORTS
GC_malloc_atomic
GC_malloc_stubborn
GC_malloc_uncollectable
GC_register_traversers
GC_resolve
GC_mark
GC_fixup
GC_fixup_self

5
src/mzscheme/include/mzscheme.exp
View File

@ -202,6 +202,11 @@ scheme_remove_all_finalization
scheme_dont_gc_ptr
scheme_gc_ptr_ok
scheme_collect_garbage
GC_register_traversers
GC_resolve
GC_mark
GC_fixup
GC_fixup_self
scheme_malloc_immobile_box
scheme_free_immobile_box
scheme_make_bucket_table

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

@ -166,16 +166,6 @@ typedef struct FSSpec mzFSSpec;
#define MZ_EXTERN extern MZ_DLLSPEC
#if defined(MZ_USE_PLACES) || defined(FUTURES_ENABLED)
# if _MSC_VER
# define THREAD_LOCAL __declspec(thread)
# else
# define THREAD_LOCAL __thread
# endif
#else
# define THREAD_LOCAL /* empty */
#endif
#ifndef MZ_DONT_USE_JIT
# if defined(MZ_USE_JIT_PPC) || defined(MZ_USE_JIT_I386) || defined(MZ_USE_JIT_X86_64)
# define MZ_USE_JIT
@ -908,6 +898,11 @@ typedef struct Scheme_Cont_Frame_Data {
/* threads */
/*========================================================================*/
#ifdef MZ_PRECISE_GC
# include "../gc2/gc2_obj.h"
#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 *);
typedef Scheme_Object *(*Scheme_Custodian_Extractor)(Scheme_Object *o);
@ -1492,7 +1487,7 @@ typedef void (*Scheme_Invoke_Proc)(Scheme_Env *env, long phase_shift,
# define scheme_fuel_counter (*scheme_fuel_counter_ptr)
# endif
#else
MZ_EXTERN THREAD_LOCAL volatile int scheme_fuel_counter;
THREAD_LOCAL_DECL(MZ_EXTERN volatile int scheme_fuel_counter);
#endif
#ifdef FUEL_AUTODECEREMENTS
@ -1701,8 +1696,8 @@ MZ_EXTERN void scheme_set_logging(int syslog_level, int stderr_level);
MZ_EXTERN int scheme_get_allow_set_undefined();
#ifndef MZ_USE_PLACES
MZ_EXTERN THREAD_LOCAL Scheme_Thread *scheme_current_thread;
MZ_EXTERN THREAD_LOCAL Scheme_Thread *scheme_first_thread;
THREAD_LOCAL_DECL(MZ_EXTERN Scheme_Thread *scheme_current_thread);
THREAD_LOCAL_DECL(MZ_EXTERN Scheme_Thread *scheme_first_thread);
#endif
MZ_EXTERN Scheme_Thread *scheme_get_current_thread();
MZ_EXTERN long scheme_get_multiple_count();

362
src/mzscheme/include/schthread.h Normal file
View File

@ -0,0 +1,362 @@
/* Implements thread-local variables, which are all combined into one
big table.
When thread-local variables are not needed, this file doesn't
declare them. Instead, declarations marked with
THREAD_LOCAL_DECL() are used.
When thread-local variables are needed, then THREAD_LOCAL_DECL()
expands to nothing, and this file defines each thread-local variable
as a field in one big record. The record is accessed through a single
thread-local variable or through pthread_getspecific().
Choose the names of thread-local variables carefully. The names are
globally visible, and macros to redirect uses of thread-local
variables can create trouble and poor error messages from the C
compiler if the same name is used for a local variable. */
#ifndef SCHEME_THREADLOCAL_H
#define SCHEME_THREADLOCAL_H
#if defined(MZ_USE_PLACES) || defined(FUTURES_ENABLED)
# define USE_THREAD_LOCAL
# if _MSC_VER
# define THREAD_LOCAL __declspec(thread)
# elif defined(OS_X)
# define IMPLEMENT_THREAD_LOCAL_VIA_PTHREADS
# else
# define THREAD_LOCAL __thread
# endif
#else
# define THREAD_LOCAL /* empty */
#endif
extern void scheme_init_os_thread();
/* **************************************************************** */
/* Declarations that we wish were elsewhere, but are needed here to */
/* determine the size and type of some thread-local record fields. */
/* **************************************************************** */
#define STACK_COPY_CACHE_SIZE 10
#define BIGNUM_CACHE_SIZE 16
#define NUM_tl_VARS 14
#define STACK_CACHE_SIZE 32
/* This structure must be 4 words: */
typedef struct {
void *orig_return_address;
void *stack_frame;
struct Scheme_Object *cache;
void *orig_result;
} Stack_Cache_Elem;
typedef long rxpos;
#ifndef MZ_PRECISE_GC
typedef long objhead;
#endif
/* **************************************** */
#ifndef USE_THREAD_LOCAL
# define THREAD_LOCAL_DECL(x) x
#else
/* **************************************** */
typedef struct Thread_Local_Variables {
void **GC_variable_stack_;
objhead GC_objhead_template_;
struct NewGC *GC_;
unsigned long GC_gen0_alloc_page_ptr_;
unsigned long GC_gen0_alloc_page_end_;
struct MarkSegment *mark_stack_;
void *bignum_cache_[BIGNUM_CACHE_SIZE];
int cache_count_;
struct Scheme_Hash_Table *toplevels_ht_;
struct Scheme_Hash_Table *locals_ht_[2];
volatile int scheme_fuel_counter_;
unsigned long scheme_stack_boundary_;
unsigned long volatile scheme_jit_stack_boundary_;
struct Scheme_Object *quick_stx_;
int scheme_continuation_application_count_;
int scheme_cont_capture_count_;
int scheme_prompt_capture_count_;
struct Scheme_Prompt *available_prompt_;
struct Scheme_Prompt *available_cws_prompt_;
struct Scheme_Prompt *available_regular_prompt_;
struct Scheme_Dynamic_Wind *available_prompt_dw_;
struct Scheme_Meta_Continuation *available_prompt_mc_;
struct Scheme_Object *cached_beg_stx_;
struct Scheme_Object *cached_dv_stx_;
struct Scheme_Object *cached_ds_stx_;
int cached_stx_phase_;
struct Scheme_Cont *offstack_cont_;
struct Scheme_Overflow *offstack_overflow_;
struct Scheme_Overflow_Jmp *scheme_overflow_jmp_;
void *scheme_overflow_stack_start_;
struct future_t *current_ft_;
void **codetab_tree_;
int during_set_;
void *thread_local_pointers_[NUM_tl_VARS];
Stack_Cache_Elem stack_cache_stack_[STACK_CACHE_SIZE];
long stack_cache_stack_pos_;
struct Scheme_Object **fixup_runstack_base_;
int fixup_already_in_place_;
void *retry_alloc_r1_;
double save_fp_;
struct Scheme_Bucket_Table *starts_table_;
struct Scheme_Modidx *modidx_caching_chain_;
struct Scheme_Object *global_shift_cache_;
struct mz_proc_thread *proc_thread_self_;
struct Scheme_Object *scheme_orig_stdout_port_;
struct Scheme_Object *scheme_orig_stderr_port_;
struct Scheme_Object *scheme_orig_stdin_port_;
struct fd_set *scheme_fd_set_;
struct Scheme_Custodian *new_port_cust_;
int external_event_fd_;
int put_external_event_fd_;
char *read_string_byte_buffer_;
struct ITimer_Data *itimerdata_;
char *quick_buffer_;
char *quick_encode_buffer_;
struct Scheme_Hash_Table *cache_ht_;
char *regstr_;
char *regparsestr_;
int regmatchmin_;
int regmatchmax_;
int regmaxbackposn_;
int regsavepos_;
struct Scheme_Hash_Table *regbackknown_;
struct Scheme_Hash_Table *regbackdepends_;
rxpos regparse_;
rxpos regparse_end_;
int regnpar_;
int regncounter_;
rxpos regcode_;
rxpos regcodesize_;
rxpos regcodemax_;
long regmaxlookback_;
long rx_buffer_size_;
rxpos *startp_buffer_cache_;
rxpos *endp_buffer_cache_;
rxpos *maybep_buffer_cache_;
unsigned long scheme_os_thread_stack_base_;
int traversers_registered_;
struct Finalizations **save_fns_ptr_;
struct Scheme_Object *scheme_system_idle_channel_;
struct Scheme_Object *system_idle_put_evt_;
void *stack_copy_cache_[STACK_COPY_CACHE_SIZE];
long stack_copy_size_cache_[STACK_COPY_CACHE_SIZE];
int scc_pos_;
struct Scheme_Bucket_Table *prefab_table_;
struct Scheme_Object *nominal_ipair_cache_;
struct Scheme_Object *mark_id_;
struct Scheme_Object *current_rib_timestamp_;
struct Scheme_Hash_Table *quick_hash_table_;
struct Scheme_Object *last_phase_shift_;
struct Scheme_Object *unsealed_dependencies_;
struct Scheme_Hash_Table *id_marks_ht_;
struct Scheme_Hash_Table *than_id_marks_ht_;
struct Scheme_Bucket_Table *interned_skip_ribs_;
struct Scheme_Thread *scheme_current_thread_;
struct Scheme_Thread *scheme_main_thread_;
struct Scheme_Thread *scheme_first_thread_;
struct Scheme_Thread_Set *scheme_thread_set_top_;
int num_running_threads_;
int swap_no_setjmp_;
int thread_swap_count_;
int did_gc_count_;
struct Scheme_Object **scheme_current_runstack_start_;
struct Scheme_Object **scheme_current_runstack_;
MZ_MARK_STACK_TYPE scheme_current_cont_mark_stack_;
MZ_MARK_POS_TYPE scheme_current_cont_mark_pos_;
struct Scheme_Custodian *main_custodian_;
struct Scheme_Custodian *last_custodian_;
struct Scheme_Hash_Table *limited_custodians_;
struct Scheme_Thread *swap_target_;
struct Scheme_Object *scheduled_kills_;
int do_atomic_;
int missed_context_switch_;
int have_activity_;
int scheme_active_but_sleeping_;
int thread_ended_with_activity_;
int scheme_no_stack_overflow_;
int needs_sleep_cancelled_;
int tls_pos_;
struct Scheme_Object *the_nested_exn_handler_;
struct Scheme_Object *cust_closers_;
struct Scheme_Object *thread_swap_callbacks_;
struct Scheme_Object *thread_swap_out_callbacks_;
struct Scheme_Object *recycle_cell_;
struct Scheme_Object *maybe_recycle_cell_;
int recycle_cc_count_;
mz_jmp_buf main_init_error_buf_;
} Thread_Local_Variables;
#if defined(IMPLEMENT_THREAD_LOCAL_VIA_PTHREADS)
/* Using Pthread getspecific() */
# include <pthread.h>
MZ_EXTERN pthread_key_t scheme_thread_local_key;
# define scheme_get_thread_local_variables() ((Thread_Local_Variables *)pthread_getspecific(scheme_thread_local_key))
# if defined(MZ_PRECISE_GC) && !defined(SKIP_THREAD_LOCAL_XFORM_DECL)
XFORM_GC_VARIABLE_STACK_THROUGH_GETSPECIFIC;
# endif
#else
/* Using `THREAD_LOCAL' variable: */
MZ_EXTERN THREAD_LOCAL Thread_Local_Variables scheme_thread_locals;
# define scheme_get_thread_local_variables() (&scheme_thread_locals)
# if defined(MZ_PRECISE_GC) && !defined(SKIP_THREAD_LOCAL_XFORM_DECL)
XFORM_GC_VARIABLE_STACK_THROUGH_THREAD_LOCAL;
# endif
#endif
/* **************************************** */
#ifdef MZ_PRECISE_GC
# define XOA XFORM_OK_ASSIGN
#else
# define XOA /* empty */
#endif
#define GC_objhead_template XOA (scheme_get_thread_local_variables()->GC_objhead_template_)
#define GC XOA (scheme_get_thread_local_variables()->GC_)
#define GC_gen0_alloc_page_ptr XOA (scheme_get_thread_local_variables()->GC_gen0_alloc_page_ptr_)
#define GC_gen0_alloc_page_end XOA (scheme_get_thread_local_variables()->GC_gen0_alloc_page_end_)
#define GC_variable_stack XOA (scheme_get_thread_local_variables()->GC_variable_stack_)
#define mark_stack XOA (scheme_get_thread_local_variables()->mark_stack_)
#define bignum_cache XOA (scheme_get_thread_local_variables()->bignum_cache_)
#define cache_count XOA (scheme_get_thread_local_variables()->cache_count_)
#define toplevels_ht XOA (scheme_get_thread_local_variables()->toplevels_ht_)
#define locals_ht XOA (scheme_get_thread_local_variables()->locals_ht_)
#define scheme_fuel_counter XOA (scheme_get_thread_local_variables()->scheme_fuel_counter_)
#define scheme_stack_boundary XOA (scheme_get_thread_local_variables()->scheme_stack_boundary_)
#define scheme_jit_stack_boundary XOA (scheme_get_thread_local_variables()->scheme_jit_stack_boundary_)
#define quick_stx XOA (scheme_get_thread_local_variables()->quick_stx_)
#define scheme_continuation_application_count XOA (scheme_get_thread_local_variables()->scheme_continuation_application_count_)
#define scheme_cont_capture_count XOA (scheme_get_thread_local_variables()->scheme_cont_capture_count_)
#define scheme_prompt_capture_count XOA (scheme_get_thread_local_variables()->scheme_prompt_capture_count_)
#define available_prompt XOA (scheme_get_thread_local_variables()->available_prompt_)
#define available_cws_prompt XOA (scheme_get_thread_local_variables()->available_cws_prompt_)
#define available_regular_prompt XOA (scheme_get_thread_local_variables()->available_regular_prompt_)
#define available_prompt_dw XOA (scheme_get_thread_local_variables()->available_prompt_dw_)
#define available_prompt_mc XOA (scheme_get_thread_local_variables()->available_prompt_mc_)
#define cached_beg_stx XOA (scheme_get_thread_local_variables()->cached_beg_stx_)
#define cached_dv_stx XOA (scheme_get_thread_local_variables()->cached_dv_stx_)
#define cached_ds_stx XOA (scheme_get_thread_local_variables()->cached_ds_stx_)
#define cached_stx_phase XOA (scheme_get_thread_local_variables()->cached_stx_phase_)
#define offstack_cont XOA (scheme_get_thread_local_variables()->offstack_cont_)
#define offstack_overflow XOA (scheme_get_thread_local_variables()->offstack_overflow_)
#define scheme_overflow_jmp XOA (scheme_get_thread_local_variables()->scheme_overflow_jmp_)
#define scheme_overflow_stack_start XOA (scheme_get_thread_local_variables()->scheme_overflow_stack_start_)
#define current_ft XOA (scheme_get_thread_local_variables()->current_ft_)
#define codetab_tree XOA (scheme_get_thread_local_variables()->codetab_tree_)
#define during_set XOA (scheme_get_thread_local_variables()->during_set_)
#define thread_local_pointers XOA (scheme_get_thread_local_variables()->thread_local_pointers_)
#define stack_cache_stack XOA (scheme_get_thread_local_variables()->stack_cache_stack_)
#define stack_cache_stack_pos XOA (scheme_get_thread_local_variables()->stack_cache_stack_pos_)
#define fixup_runstack_base XOA (scheme_get_thread_local_variables()->fixup_runstack_base_)
#define fixup_already_in_place XOA (scheme_get_thread_local_variables()->fixup_already_in_place_)
#define retry_alloc_r1 XOA (scheme_get_thread_local_variables()->retry_alloc_r1_)
#define save_fp XOA (scheme_get_thread_local_variables()->save_fp_)
#define starts_table XOA (scheme_get_thread_local_variables()->starts_table_)
#define modidx_caching_chain XOA (scheme_get_thread_local_variables()->modidx_caching_chain_)
#define global_shift_cache XOA (scheme_get_thread_local_variables()->global_shift_cache_)
#define proc_thread_self XOA (scheme_get_thread_local_variables()->proc_thread_self_)
#define scheme_orig_stdout_port XOA (scheme_get_thread_local_variables()->scheme_orig_stdout_port_)
#define scheme_orig_stderr_port XOA (scheme_get_thread_local_variables()->scheme_orig_stderr_port_)
#define scheme_orig_stdin_port XOA (scheme_get_thread_local_variables()->scheme_orig_stdin_port_)
#define scheme_fd_set XOA (scheme_get_thread_local_variables()->scheme_fd_set_)
#define new_port_cust XOA (scheme_get_thread_local_variables()->new_port_cust_)
#define external_event_fd XOA (scheme_get_thread_local_variables()->external_event_fd_)
#define put_external_event_fd XOA (scheme_get_thread_local_variables()->put_external_event_fd_)
#define read_string_byte_buffer XOA (scheme_get_thread_local_variables()->read_string_byte_buffer_)
#define itimerdata XOA (scheme_get_thread_local_variables()->itimerdata_)
#define quick_buffer XOA (scheme_get_thread_local_variables()->quick_buffer_)
#define quick_encode_buffer XOA (scheme_get_thread_local_variables()->quick_encode_buffer_)
#define cache_ht XOA (scheme_get_thread_local_variables()->cache_ht_)
#define regstr XOA (scheme_get_thread_local_variables()->regstr_)
#define regparsestr XOA (scheme_get_thread_local_variables()->regparsestr_)
#define regmatchmin XOA (scheme_get_thread_local_variables()->regmatchmin_)
#define regmatchmax XOA (scheme_get_thread_local_variables()->regmatchmax_)
#define regmaxbackposn XOA (scheme_get_thread_local_variables()->regmaxbackposn_)
#define regsavepos XOA (scheme_get_thread_local_variables()->regsavepos_)
#define regbackknown XOA (scheme_get_thread_local_variables()->regbackknown_)
#define regbackdepends XOA (scheme_get_thread_local_variables()->regbackdepends_)
#define regparse XOA (scheme_get_thread_local_variables()->regparse_)
#define regparse_end XOA (scheme_get_thread_local_variables()->regparse_end_)
#define regnpar XOA (scheme_get_thread_local_variables()->regnpar_)
#define regncounter XOA (scheme_get_thread_local_variables()->regncounter_)
#define regcode XOA (scheme_get_thread_local_variables()->regcode_)
#define regcodesize XOA (scheme_get_thread_local_variables()->regcodesize_)
#define regcodemax XOA (scheme_get_thread_local_variables()->regcodemax_)
#define regmaxlookback XOA (scheme_get_thread_local_variables()->regmaxlookback_)
#define rx_buffer_size XOA (scheme_get_thread_local_variables()->rx_buffer_size_)
#define startp_buffer_cache XOA (scheme_get_thread_local_variables()->startp_buffer_cache_)
#define endp_buffer_cache XOA (scheme_get_thread_local_variables()->endp_buffer_cache_)
#define maybep_buffer_cache XOA (scheme_get_thread_local_variables()->maybep_buffer_cache_)
#define scheme_os_thread_stack_base XOA (scheme_get_thread_local_variables()->scheme_os_thread_stack_base_)
#define traversers_registered XOA (scheme_get_thread_local_variables()->traversers_registered_)
#define save_fns_ptr XOA (scheme_get_thread_local_variables()->save_fns_ptr_)
#define scheme_system_idle_channel XOA (scheme_get_thread_local_variables()->scheme_system_idle_channel_)
#define system_idle_put_evt XOA (scheme_get_thread_local_variables()->system_idle_put_evt_)
#define stack_copy_cache XOA (scheme_get_thread_local_variables()->stack_copy_cache_)
#define stack_copy_size_cache XOA (scheme_get_thread_local_variables()->stack_copy_size_cache_)
#define scc_pos XOA (scheme_get_thread_local_variables()->scc_pos_)
#define prefab_table XOA (scheme_get_thread_local_variables()->prefab_table_)
#define nominal_ipair_cache XOA (scheme_get_thread_local_variables()->nominal_ipair_cache_)
#define mark_id XOA (scheme_get_thread_local_variables()->mark_id_)
#define current_rib_timestamp XOA (scheme_get_thread_local_variables()->current_rib_timestamp_)
#define quick_hash_table XOA (scheme_get_thread_local_variables()->quick_hash_table_)
#define last_phase_shift XOA (scheme_get_thread_local_variables()->last_phase_shift_)
#define unsealed_dependencies XOA (scheme_get_thread_local_variables()->unsealed_dependencies_)
#define id_marks_ht XOA (scheme_get_thread_local_variables()->id_marks_ht_)
#define than_id_marks_ht XOA (scheme_get_thread_local_variables()->than_id_marks_ht_)
#define interned_skip_ribs XOA (scheme_get_thread_local_variables()->interned_skip_ribs_)
#define scheme_current_thread XOA (scheme_get_thread_local_variables()->scheme_current_thread_)
#define scheme_main_thread XOA (scheme_get_thread_local_variables()->scheme_main_thread_)
#define scheme_first_thread XOA (scheme_get_thread_local_variables()->scheme_first_thread_)
#define scheme_thread_set_top XOA (scheme_get_thread_local_variables()->scheme_thread_set_top_)
#define num_running_threads XOA (scheme_get_thread_local_variables()->num_running_threads_)
#define swap_no_setjmp XOA (scheme_get_thread_local_variables()->swap_no_setjmp_)
#define thread_swap_count XOA (scheme_get_thread_local_variables()->thread_swap_count_)
#define did_gc_count XOA (scheme_get_thread_local_variables()->did_gc_count_)
#define scheme_current_runstack_start XOA (scheme_get_thread_local_variables()->scheme_current_runstack_start_)
#define scheme_current_runstack XOA (scheme_get_thread_local_variables()->scheme_current_runstack_)
#define scheme_current_cont_mark_stack XOA (scheme_get_thread_local_variables()->scheme_current_cont_mark_stack_)
#define scheme_current_cont_mark_pos XOA (scheme_get_thread_local_variables()->scheme_current_cont_mark_pos_)
#define main_custodian XOA (scheme_get_thread_local_variables()->main_custodian_)
#define last_custodian XOA (scheme_get_thread_local_variables()->last_custodian_)
#define limited_custodians XOA (scheme_get_thread_local_variables()->limited_custodians_)
#define swap_target XOA (scheme_get_thread_local_variables()->swap_target_)
#define scheduled_kills XOA (scheme_get_thread_local_variables()->scheduled_kills_)
#define do_atomic XOA (scheme_get_thread_local_variables()->do_atomic_)
#define missed_context_switch XOA (scheme_get_thread_local_variables()->missed_context_switch_)
#define have_activity XOA (scheme_get_thread_local_variables()->have_activity_)
#define scheme_active_but_sleeping XOA (scheme_get_thread_local_variables()->scheme_active_but_sleeping_)
#define thread_ended_with_activity XOA (scheme_get_thread_local_variables()->thread_ended_with_activity_)
#define scheme_no_stack_overflow XOA (scheme_get_thread_local_variables()->scheme_no_stack_overflow_)
#define needs_sleep_cancelled XOA (scheme_get_thread_local_variables()->needs_sleep_cancelled_)
#define tls_pos XOA (scheme_get_thread_local_variables()->tls_pos_)
#define the_nested_exn_handler XOA (scheme_get_thread_local_variables()->the_nested_exn_handler_)
#define cust_closers XOA (scheme_get_thread_local_variables()->cust_closers_)
#define thread_swap_callbacks XOA (scheme_get_thread_local_variables()->thread_swap_callbacks_)
#define thread_swap_out_callbacks XOA (scheme_get_thread_local_variables()->thread_swap_out_callbacks_)
#define recycle_cell XOA (scheme_get_thread_local_variables()->recycle_cell_)
#define maybe_recycle_cell XOA (scheme_get_thread_local_variables()->maybe_recycle_cell_)
#define recycle_cc_count XOA (scheme_get_thread_local_variables()->recycle_cc_count_)
#define main_init_error_buf XOA (scheme_get_thread_local_variables()->main_init_error_buf_)
/* **************************************** */
# define THREAD_LOCAL_DECL(x) /* empty */
#endif
/* **************************************** */
#endif

1
src/mzscheme/mkincludes.ss
View File

@ -46,6 +46,7 @@
(copy-if-newer mzsrcdir "include/scheme.h" #f
(change-regexp "/[*]III[*]/"
"#define INCLUDE_WITHOUT_PATHS"))
(copy-if-newer mzsrcdir "include/schthread.h")
(copy-if-newer mzsrcdir "src/schemef.h")
(copy-if-newer mzsrcdir "src/schvers.h")
(copy-if-newer mzsrcdir "src/stypes.h")

81
src/mzscheme/src/Makefile.in
View File

@ -240,39 +240,42 @@ SCONFIG = $(srcdir)/../sconfig.h $(srcdir)/../uconfig.h
# More dependencies
salloc.@LTO@: $(srcdir)/schpriv.h $(srcdir)/schexn.h $(SCONFIG) $(srcdir)/../include/scheme.h \
COMMON_HEADERS = $(srcdir)/schpriv.h $(srcdir)/schexn.h $(SCONFIG) $(srcdir)/../include/scheme.h \
$(srcdir)/../include/schthread.h
salloc.@LTO@: $(COMMON_HEADERS) \
$(srcdir)/../gc/gc.h $(srcdir)/mzmark.c
bignum.@LTO@: $(srcdir)/schpriv.h $(srcdir)/schexn.h $(SCONFIG) $(srcdir)/../include/scheme.h \
bignum.@LTO@: $(COMMON_HEADERS) \
$(srcdir)/../src/stypes.h
bool.@LTO@: $(srcdir)/schpriv.h $(srcdir)/schexn.h $(SCONFIG) $(srcdir)/../include/scheme.h \
bool.@LTO@: $(COMMON_HEADERS) \
$(srcdir)/../src/stypes.h $(srcdir)/mzeqchk.inc
builtin.@LTO@: $(srcdir)/schpriv.h $(srcdir)/schexn.h $(SCONFIG) $(srcdir)/../include/scheme.h \
builtin.@LTO@: $(COMMON_HEADERS) \
$(srcdir)/../src/stypes.h $(srcdir)/schminc.h $(srcdir)/startup.inc $(srcdir)/cstartup.inc
char.@LTO@: $(srcdir)/schpriv.h $(srcdir)/schexn.h $(SCONFIG) $(srcdir)/../include/scheme.h \
char.@LTO@: $(COMMON_HEADERS) \
$(srcdir)/../src/stypes.h $(srcdir)/schuchar.inc
complex.@LTO@: $(srcdir)/schpriv.h $(srcdir)/schexn.h $(SCONFIG) $(srcdir)/../include/scheme.h \
complex.@LTO@: $(COMMON_HEADERS) \
$(srcdir)/../src/stypes.h
dynext.@LTO@: $(srcdir)/schpriv.h $(srcdir)/schexn.h $(SCONFIG) $(srcdir)/../include/scheme.h \
dynext.@LTO@: $(COMMON_HEADERS) \
$(srcdir)/../src/stypes.h $(srcdir)/../src/schemex.h \
$(srcdir)/schvers.h $(srcdir)/../gc/gc.h $(srcdir)/schemex.h
env.@LTO@: $(srcdir)/schpriv.h $(srcdir)/schexn.h $(SCONFIG) $(srcdir)/../include/scheme.h \
env.@LTO@: $(COMMON_HEADERS) \
$(srcdir)/../src/stypes.h $(srcdir)/schminc.h $(srcdir)/mzmark.c
error.@LTO@: $(srcdir)/schpriv.h $(srcdir)/schexn.h $(SCONFIG) $(srcdir)/../include/scheme.h \
error.@LTO@: $(COMMON_HEADERS) \
$(srcdir)/../src/stypes.h
eval.@LTO@: $(srcdir)/schpriv.h $(srcdir)/schexn.h $(SCONFIG) $(srcdir)/../include/scheme.h \
eval.@LTO@: $(COMMON_HEADERS) \
$(srcdir)/../src/stypes.h $(srcdir)/mzmark.c \
$(srcdir)/schmach.h $(srcdir)/mzstkchk.h $(srcdir)/schrunst.h \
$(srcdir)/future.h
file.@LTO@: $(srcdir)/schpriv.h $(srcdir)/schexn.h $(SCONFIG) $(srcdir)/../include/scheme.h \
file.@LTO@: $(COMMON_HEADERS) \
$(srcdir)/../src/stypes.h $(srcdir)/mzmark.c
fun.@LTO@: $(srcdir)/schpriv.h $(srcdir)/schexn.h $(SCONFIG) $(srcdir)/../include/scheme.h \
fun.@LTO@: $(COMMON_HEADERS) \
$(srcdir)/../src/stypes.h $(srcdir)/mzmark.c $(srcdir)/schmap.inc \
$(srcdir)/future.h
future.@LTO@: $(srcdir)/schpriv.h $(srcdir)/future.h $(SCONFIG) $(srcdir)/../include/scheme.h \
$(srcdir)/../src/stypes.h $(srcdir)/mzmark.c
hash.@LTO@: $(srcdir)/schpriv.h $(srcdir)/schexn.h $(SCONFIG) $(srcdir)/../include/scheme.h \
hash.@LTO@: $(COMMON_HEADERS) \
$(srcdir)/../src/stypes.h $(srcdir)/mzmark.c
jit.@LTO@: $(srcdir)/schpriv.h $(srcdir)/schexn.h $(SCONFIG) $(srcdir)/../include/scheme.h \
jit.@LTO@: $(COMMON_HEADERS) \
$(srcdir)/../src/stypes.h $(srcdir)/codetab.inc $(srcdir)/mzmark.c \
$(srcdir)/lightning/i386/core.h $(srcdir)/lightning/i386/core-common.h \
$(srcdir)/lightning/i386/asm.h $(srcdir)/lightning/i386/asm-common.h \
@ -283,53 +286,53 @@ jit.@LTO@: $(srcdir)/schpriv.h $(srcdir)/schexn.h $(SCONFIG) $(srcdir)/../includ
$(srcdir)/lightning/ppc/funcs.h $(srcdir)/lightning/ppc/funcs-common.h \
$(srcdir)/lightning/ppc/fp.h $(srcdir)/lightning/ppc/fp-common.h \
$(srcdir)/future.h
list.@LTO@: $(srcdir)/schpriv.h $(srcdir)/schexn.h $(SCONFIG) $(srcdir)/../include/scheme.h \
list.@LTO@: $(COMMON_HEADERS) \
$(srcdir)/../src/stypes.h
module.@LTO@: $(srcdir)/schpriv.h $(srcdir)/schexn.h $(SCONFIG) $(srcdir)/../include/scheme.h \
module.@LTO@: $(COMMON_HEADERS) \
$(srcdir)/../src/stypes.h $(srcdir)/schfd.h $(srcdir)/mzmark.c
network.@LTO@: $(srcdir)/schpriv.h $(srcdir)/schexn.h $(SCONFIG) $(srcdir)/../include/scheme.h \
network.@LTO@: $(COMMON_HEADERS) \
$(srcdir)/../src/stypes.h $(srcdir)/schfd.h $(srcdir)/mzmark.c
numarith.@LTO@: $(srcdir)/schpriv.h $(srcdir)/schexn.h $(SCONFIG) $(srcdir)/../include/scheme.h \
numarith.@LTO@: $(COMMON_HEADERS) \
$(srcdir)/../src/stypes.h $(srcdir)/nummacs.h
number.@LTO@: $(srcdir)/schpriv.h $(srcdir)/schexn.h $(SCONFIG) $(srcdir)/../include/scheme.h \
number.@LTO@: $(COMMON_HEADERS) \
$(srcdir)/../src/stypes.h $(srcdir)/nummacs.h
numcomp.@LTO@: $(srcdir)/schpriv.h $(srcdir)/schexn.h $(SCONFIG) $(srcdir)/../include/scheme.h \
numcomp.@LTO@: $(COMMON_HEADERS) \
$(srcdir)/../src/stypes.h $(srcdir)/nummacs.h
numstr.@LTO@: $(srcdir)/schpriv.h $(srcdir)/schexn.h $(SCONFIG) $(srcdir)/../include/scheme.h \
numstr.@LTO@: $(COMMON_HEADERS) \
$(srcdir)/../src/stypes.h $(srcdir)/random.inc $(srcdir)/newrandom.inc
places.@LTO@: $(srcdir)/schpriv.h $(srcdir)/schexn.h $(SCONFIG) $(srcdir)/../include/scheme.h \
places.@LTO@: $(COMMON_HEADERS) \
$(srcdir)/../src/stypes.h $(srcdir)/schfd.h $(srcdir)/mzmark.c
port.@LTO@: $(srcdir)/schpriv.h $(srcdir)/schexn.h $(SCONFIG) $(srcdir)/../include/scheme.h \
port.@LTO@: $(COMMON_HEADERS) \
$(srcdir)/../src/stypes.h $(srcdir)/schfd.h $(srcdir)/mzmark.c
portfun.@LTO@: $(srcdir)/schpriv.h $(srcdir)/schexn.h $(SCONFIG) $(srcdir)/../include/scheme.h \
portfun.@LTO@: $(COMMON_HEADERS) \
$(srcdir)/../src/stypes.h $(srcdir)/schfd.h $(srcdir)/mzmark.c
print.@LTO@: $(srcdir)/../include/scheme.h $(srcdir)/../src/stypes.h $(srcdir)/../src/schcpt.h \
$(srcdir)/schpriv.h $(srcdir)/schexn.h $(srcdir)/schvers.h $(SCONFIG) $(srcdir)/mzmark.c
thread.@LTO@: $(srcdir)/schpriv.h $(srcdir)/schexn.h $(SCONFIG) $(srcdir)/../include/scheme.h \
print.@LTO@: $(COMMON_HEADERS) $(srcdir)/../src/stypes.h $(srcdir)/../src/schcpt.h \
$(srcdir)/schvers.h $(SCONFIG) $(srcdir)/mzmark.c
thread.@LTO@: $(COMMON_HEADERS) \
$(srcdir)/../src/stypes.h $(srcdir)/schfd.h $(srcdir)/mzmark.c
rational.@LTO@: $(srcdir)/schpriv.h $(srcdir)/schexn.h $(SCONFIG) $(srcdir)/../include/scheme.h \
rational.@LTO@: $(COMMON_HEADERS) \
$(srcdir)/../src/stypes.h
read.@LTO@: $(srcdir)/schpriv.h $(srcdir)/schexn.h $(SCONFIG) $(srcdir)/../include/scheme.h \
read.@LTO@: $(COMMON_HEADERS) \
$(srcdir)/../src/schcpt.h $(srcdir)/schvers.h $(srcdir)/schminc.h \
$(srcdir)/../src/stypes.h $(srcdir)/mzmark.c
regexp.@LTO@: $(srcdir)/schpriv.h $(srcdir)/schexn.h $(SCONFIG) $(srcdir)/../include/scheme.h \
regexp.@LTO@: $(COMMON_HEADERS) \
$(srcdir)/../src/stypes.h $(srcdir)/mzmark.c $(srcdir)/schrx.h
setjmpup.@LTO@: $(srcdir)/schpriv.h $(srcdir)/schexn.h $(SCONFIG) $(srcdir)/../include/scheme.h \
setjmpup.@LTO@: $(COMMON_HEADERS) \
$(srcdir)/../src/stypes.h $(srcdir)/schmach.h
string.@LTO@: $(srcdir)/schpriv.h $(srcdir)/schexn.h $(SCONFIG) $(srcdir)/../include/scheme.h \
string.@LTO@: $(COMMON_HEADERS) \
$(srcdir)/../src/stypes.h $(srcdir)/schvers.h $(srcdir)/mzmark.c $(srcdir)/strops.inc \
$(srcdir)/schustr.inc
struct.@LTO@: $(srcdir)/schpriv.h $(srcdir)/schexn.h $(SCONFIG) $(srcdir)/../include/scheme.h \
struct.@LTO@: $(COMMON_HEADERS) \
$(srcdir)/../src/stypes.h $(srcdir)/mzmark.c
stxobj.@LTO@: $(srcdir)/schpriv.h $(srcdir)/schexn.h $(SCONFIG) $(srcdir)/../include/scheme.h \
stxobj.@LTO@: $(COMMON_HEADERS) \
$(srcdir)/../src/stypes.h $(srcdir)/schfd.h $(srcdir)/mzmark.c
symbol.@LTO@: $(srcdir)/schpriv.h $(srcdir)/schexn.h $(SCONFIG) $(srcdir)/../include/scheme.h \
symbol.@LTO@: $(COMMON_HEADERS) \
$(srcdir)/../src/stypes.h
syntax.@LTO@: $(srcdir)/schpriv.h $(srcdir)/schexn.h $(SCONFIG) $(srcdir)/../include/scheme.h \
syntax.@LTO@: $(COMMON_HEADERS) \
$(srcdir)/../src/stypes.h $(srcdir)/mzmark.c
sema.@LTO@: $(srcdir)/schpriv.h $(srcdir)/schexn.h $(SCONFIG) $(srcdir)/../include/scheme.h \
sema.@LTO@: $(COMMON_HEADERS) \
$(srcdir)/../src/stypes.h $(srcdir)/mzmark.c
type.@LTO@: $(srcdir)/schpriv.h $(srcdir)/schexn.h $(SCONFIG) $(srcdir)/../include/scheme.h \
type.@LTO@: $(COMMON_HEADERS) \
$(srcdir)/../src/stypes.h $(srcdir)/mzmark.c
vector.@LTO@: $(srcdir)/schpriv.h $(srcdir)/schexn.h $(SCONFIG) $(srcdir)/../include/scheme.h \
vector.@LTO@: $(COMMON_HEADERS) \
$(srcdir)/../src/stypes.h

5
src/mzscheme/src/bignum.c
View File

@ -111,9 +111,8 @@ static Scheme_Object *bignum_one;
extern void GC_check(void *p);
#define BIGNUM_CACHE_SIZE 16
static THREAD_LOCAL void *bignum_cache[BIGNUM_CACHE_SIZE];
static THREAD_LOCAL int cache_count;
THREAD_LOCAL_DECL(static void *bignum_cache[BIGNUM_CACHE_SIZE]);
THREAD_LOCAL_DECL(static int cache_count);
static void *copy_to_protected(void *p, long len, int zero)
{

20
src/mzscheme/src/codetab.inc
View File

@ -20,15 +20,15 @@ extern MZ_DLLIMPORT int GC_is_marked(void *);
#define NODE_STARTS_OFFSET 1
#define NODE_GCABLE_OFFSET 2
static THREAD_LOCAL void **tree;
static THREAD_LOCAL int during_set;
THREAD_LOCAL_DECL(static void **codetab_tree);
THREAD_LOCAL_DECL(static int during_set);
static int do_clear_symbols(void **t, unsigned long start, int offset, unsigned long addr, int clearing);
static void *find_symbol(unsigned long v)
{
unsigned long k;
void **t = tree, *val;
void **t = codetab_tree, *val;
int offset = (JIT_WORD_SIZE * 8);
while (offset) {
@ -68,14 +68,14 @@ static void add_symbol(unsigned long start, unsigned long end, void *value, int
int offset = (JIT_WORD_SIZE * 8), split_offset = 0;
void **t1, **t2, **split_t, *val1, *val2;
if (!tree) {
REGISTER_SO(tree);
tree = malloc_node();
if (!codetab_tree) {
REGISTER_SO(codetab_tree);
codetab_tree = malloc_node();
}
during_set++;
t1 = t2 = tree;
t1 = t2 = codetab_tree;
split_t = NULL;
while (offset) {
offset -= LOG_KEY_SIZE;
@ -175,7 +175,7 @@ static void add_symbol(unsigned long start, unsigned long end, void *value, int
/* Prune empty branches in the tree. Only do this if this
object is mapped deeply enough in the tree, otherwise
we end up scanning the whole tree. */
do_clear_symbols(tree, start, 0, 0, 0);
do_clear_symbols(codetab_tree, start, 0, 0, 0);
}
#endif
}
@ -258,8 +258,8 @@ static int do_clear_symbols(void **t, unsigned long start, int offset, unsigned
static void clear_symbols_for_collected()
{
if (tree) {
do_clear_symbols(tree, 0, (JIT_WORD_SIZE * 8) - LOG_KEY_SIZE, 0, 0);
if (codetab_tree) {
do_clear_symbols(codetab_tree, 0, (JIT_WORD_SIZE * 8) - LOG_KEY_SIZE, 0, 0);
}
}

92
src/mzscheme/src/cstartup.inc
View File

@ -1,43 +1,43 @@
{
static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,7,52,46,50,46,50,46,53,50,0,0,0,1,0,0,3,0,12,0,
17,0,21,0,26,0,31,0,35,0,42,0,45,0,58,0,65,0,72,0,78,
static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,7,52,46,50,46,51,46,50,50,0,0,0,1,0,0,3,0,12,0,
17,0,20,0,27,0,40,0,47,0,51,0,58,0,63,0,68,0,72,0,78,
0,92,0,106,0,109,0,115,0,119,0,121,0,132,0,134,0,148,0,155,0,
177,0,179,0,193,0,4,1,33,1,44,1,55,1,65,1,101,1,134,1,167,
1,226,1,36,2,114,2,180,2,185,2,205,2,96,3,116,3,167,3,233,3,
118,4,4,5,56,5,79,5,158,5,0,0,105,7,0,0,29,11,11,68,104,
101,114,101,45,115,116,120,64,108,101,116,42,63,108,101,116,64,119,104,101,110,
64,99,111,110,100,63,97,110,100,66,108,101,116,114,101,99,62,111,114,72,112,
97,114,97,109,101,116,101,114,105,122,101,66,100,101,102,105,110,101,66,117,110,
108,101,115,115,65,113,117,111,116,101,29,94,2,13,68,35,37,107,101,114,110,
101,114,101,45,115,116,120,64,99,111,110,100,62,111,114,66,108,101,116,114,101,
99,72,112,97,114,97,109,101,116,101,114,105,122,101,66,117,110,108,101,115,115,
63,108,101,116,66,100,101,102,105,110,101,64,119,104,101,110,64,108,101,116,42,
63,97,110,100,65,113,117,111,116,101,29,94,2,13,68,35,37,107,101,114,110,
101,108,11,29,94,2,13,68,35,37,112,97,114,97,109,122,11,62,105,102,65,
98,101,103,105,110,63,115,116,120,61,115,70,108,101,116,45,118,97,108,117,101,
115,61,120,73,108,101,116,114,101,99,45,118,97,108,117,101,115,66,108,97,109,
98,100,97,1,20,112,97,114,97,109,101,116,101,114,105,122,97,116,105,111,110,
45,107,101,121,61,118,73,100,101,102,105,110,101,45,118,97,108,117,101,115,97,
35,11,8,240,70,69,0,0,95,159,2,15,35,35,159,2,14,35,35,159,2,
14,35,35,16,20,2,9,2,1,2,3,2,1,2,4,2,1,2,5,2,1,
2,6,2,1,2,7,2,1,2,8,2,1,2,10,2,1,2,11,2,1,2,
12,2,1,97,36,11,8,240,70,69,0,0,93,159,2,14,35,36,16,2,2,
2,161,2,1,36,2,2,2,1,2,2,96,11,11,8,240,70,69,0,0,16,
0,96,37,11,8,240,70,69,0,0,16,0,13,16,4,35,29,11,11,2,1,
35,11,8,240,168,70,0,0,95,159,2,15,35,35,159,2,14,35,35,159,2,
14,35,35,16,20,2,3,2,1,2,5,2,1,2,6,2,1,2,7,2,1,
2,8,2,1,2,9,2,1,2,10,2,1,2,4,2,1,2,11,2,1,2,
12,2,1,97,36,11,8,240,168,70,0,0,93,159,2,14,35,36,16,2,2,
2,161,2,1,36,2,2,2,1,2,2,96,11,11,8,240,168,70,0,0,16,
0,96,37,11,8,240,168,70,0,0,16,0,13,16,4,35,29,11,11,2,1,
11,18,16,2,99,64,104,101,114,101,8,31,8,30,8,29,8,28,8,27,93,
8,224,77,69,0,0,95,9,8,224,77,69,0,0,2,1,27,248,22,137,4,
8,224,175,70,0,0,95,9,8,224,175,70,0,0,2,1,27,248,22,137,4,
195,249,22,130,4,80,158,38,35,251,22,77,2,16,248,22,92,199,12,249,22,
67,2,17,248,22,94,201,27,248,22,137,4,195,249,22,130,4,80,158,38,35,
251,22,77,2,16,248,22,92,199,249,22,67,2,17,248,22,94,201,12,27,248,
22,69,248,22,137,4,196,28,248,22,75,193,20,15,159,36,35,36,28,248,22,
75,248,22,69,194,248,22,68,193,249,22,130,4,80,158,38,35,251,22,77,2,
16,248,22,68,199,249,22,67,2,7,248,22,69,201,11,18,16,2,101,10,8,
16,248,22,68,199,249,22,67,2,12,248,22,69,201,11,18,16,2,101,10,8,
31,8,30,8,29,8,28,8,27,16,4,11,11,2,18,3,1,8,101,110,118,
49,49,48,51,49,16,4,11,11,2,19,3,1,8,101,110,118,49,49,48,51,
50,93,8,224,78,69,0,0,95,9,8,224,78,69,0,0,2,1,27,248,22,
49,49,51,56,56,16,4,11,11,2,19,3,1,8,101,110,118,49,49,51,56,
57,93,8,224,176,70,0,0,95,9,8,224,176,70,0,0,2,1,27,248,22,
69,248,22,137,4,196,28,248,22,75,193,20,15,159,36,35,36,28,248,22,75,
248,22,69,194,248,22,68,193,249,22,130,4,80,158,38,35,250,22,77,2,20,
248,22,77,249,22,77,248,22,77,2,21,248,22,68,201,251,22,77,2,16,2,
21,2,21,249,22,67,2,9,248,22,69,204,18,16,2,101,11,8,31,8,30,
8,29,8,28,8,27,16,4,11,11,2,18,3,1,8,101,110,118,49,49,48,
51,52,16,4,11,11,2,19,3,1,8,101,110,118,49,49,48,51,53,93,8,
224,79,69,0,0,95,9,8,224,79,69,0,0,2,1,248,22,137,4,193,27,
21,2,21,249,22,67,2,4,248,22,69,204,18,16,2,101,11,8,31,8,30,
8,29,8,28,8,27,16,4,11,11,2,18,3,1,8,101,110,118,49,49,51,
57,49,16,4,11,11,2,19,3,1,8,101,110,118,49,49,51,57,50,93,8,
224,177,70,0,0,95,9,8,224,177,70,0,0,2,1,248,22,137,4,193,27,
248,22,137,4,194,249,22,67,248,22,77,248,22,68,196,248,22,69,195,27,248,
22,69,248,22,137,4,23,197,1,249,22,130,4,80,158,38,35,28,248,22,53,
248,22,131,4,248,22,68,23,198,2,27,249,22,2,32,0,89,162,8,44,36,
@ -51,8 +51,8 @@
249,22,2,32,0,89,162,8,44,36,46,9,222,33,42,248,22,137,4,248,22,
68,201,248,22,69,198,27,248,22,69,248,22,137,4,196,27,248,22,137,4,248,
22,68,195,249,22,130,4,80,158,39,35,28,248,22,75,195,250,22,78,2,20,
9,248,22,69,199,250,22,77,2,4,248,22,77,248,22,68,199,250,22,78,2,
3,248,22,69,201,248,22,69,202,27,248,22,69,248,22,137,4,23,197,1,27,
9,248,22,69,199,250,22,77,2,8,248,22,77,248,22,68,199,250,22,78,2,
11,248,22,69,201,248,22,69,202,27,248,22,69,248,22,137,4,23,197,1,27,
249,22,1,22,81,249,22,2,22,137,4,248,22,137,4,248,22,68,199,249,22,
130,4,80,158,39,35,251,22,77,1,22,119,105,116,104,45,99,111,110,116,105,
110,117,97,116,105,111,110,45,109,97,114,107,2,24,250,22,78,1,23,101,120,
@ -62,14 +62,14 @@
22,69,203,27,248,22,69,248,22,137,4,196,28,248,22,75,193,20,15,159,36,
35,36,249,22,130,4,80,158,38,35,27,248,22,137,4,248,22,68,197,28,249,
22,167,8,62,61,62,248,22,131,4,248,22,92,196,250,22,77,2,20,248,22,
77,249,22,77,21,93,2,25,248,22,68,199,250,22,78,2,6,249,22,77,2,
77,249,22,77,21,93,2,25,248,22,68,199,250,22,78,2,3,249,22,77,2,
25,249,22,77,248,22,101,203,2,25,248,22,69,202,251,22,77,2,16,28,249,
22,167,8,248,22,131,4,248,22,68,200,64,101,108,115,101,10,248,22,68,197,
250,22,78,2,20,9,248,22,69,200,249,22,67,2,6,248,22,69,202,100,8,
250,22,78,2,20,9,248,22,69,200,249,22,67,2,3,248,22,69,202,100,8,
31,8,30,8,29,8,28,8,27,16,4,11,11,2,18,3,1,8,101,110,118,
49,49,48,53,55,16,4,11,11,2,19,3,1,8,101,110,118,49,49,48,53,
56,93,8,224,80,69,0,0,18,16,2,158,94,10,64,118,111,105,100,8,47,
95,9,8,224,80,69,0,0,2,1,27,248,22,69,248,22,137,4,196,249,22,
49,49,52,49,52,16,4,11,11,2,19,3,1,8,101,110,118,49,49,52,49,
53,93,8,224,178,70,0,0,18,16,2,158,94,10,64,118,111,105,100,8,47,
95,9,8,224,178,70,0,0,2,1,27,248,22,69,248,22,137,4,196,249,22,
130,4,80,158,38,35,28,248,22,53,248,22,131,4,248,22,68,197,250,22,77,
2,26,248,22,77,248,22,68,199,248,22,92,198,27,248,22,131,4,248,22,68,
197,250,22,77,2,26,248,22,77,248,22,68,197,250,22,78,2,23,248,22,69,
@ -81,25 +81,25 @@
2,3,2,4,2,5,2,6,2,7,2,8,2,9,2,10,2,11,2,12,35,
45,36,11,11,11,16,0,16,0,16,0,35,35,11,11,11,11,16,0,16,0,
16,0,35,35,16,11,16,5,2,2,20,15,159,35,35,35,35,20,102,159,35,
16,0,16,1,33,32,10,16,5,2,12,89,162,8,44,36,52,9,223,0,33,
33,35,20,102,159,35,16,1,2,2,16,0,11,16,5,2,5,89,162,8,44,
16,0,16,1,33,32,10,16,5,2,7,89,162,8,44,36,52,9,223,0,33,
33,35,20,102,159,35,16,1,2,2,16,0,11,16,5,2,10,89,162,8,44,
36,52,9,223,0,33,34,35,20,102,159,35,16,1,2,2,16,0,11,16,5,
2,7,89,162,8,44,36,52,9,223,0,33,35,35,20,102,159,35,16,1,2,
2,16,1,33,36,11,16,5,2,9,89,162,8,44,36,55,9,223,0,33,37,
35,20,102,159,35,16,1,2,2,16,1,33,38,11,16,5,2,4,89,162,8,
2,12,89,162,8,44,36,52,9,223,0,33,35,35,20,102,159,35,16,1,2,
2,16,1,33,36,11,16,5,2,4,89,162,8,44,36,55,9,223,0,33,37,
35,20,102,159,35,16,1,2,2,16,1,33,38,11,16,5,2,8,89,162,8,
44,36,57,9,223,0,33,41,35,20,102,159,35,16,1,2,2,16,0,11,16,
5,2,8,89,162,8,44,36,52,9,223,0,33,43,35,20,102,159,35,16,1,
2,2,16,0,11,16,5,2,3,89,162,8,44,36,53,9,223,0,33,44,35,
20,102,159,35,16,1,2,2,16,0,11,16,5,2,10,89,162,8,44,36,54,
9,223,0,33,45,35,20,102,159,35,16,1,2,2,16,0,11,16,5,2,6,
5,2,5,89,162,8,44,36,52,9,223,0,33,43,35,20,102,159,35,16,1,
2,2,16,0,11,16,5,2,11,89,162,8,44,36,53,9,223,0,33,44,35,
20,102,159,35,16,1,2,2,16,0,11,16,5,2,6,89,162,8,44,36,54,
9,223,0,33,45,35,20,102,159,35,16,1,2,2,16,0,11,16,5,2,3,
89,162,8,44,36,57,9,223,0,33,46,35,20,102,159,35,16,1,2,2,16,
1,33,48,11,16,5,2,11,89,162,8,44,36,53,9,223,0,33,49,35,20,
1,33,48,11,16,5,2,9,89,162,8,44,36,53,9,223,0,33,49,35,20,
102,159,35,16,1,2,2,16,0,11,16,0,94,2,14,2,15,93,2,14,9,
9,35,0};
EVAL_ONE_SIZED_STR((char *)expr, 2018);
}
{
static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,7,52,46,50,46,50,46,53,59,0,0,0,1,0,0,13,0,18,0,
static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,7,52,46,50,46,51,46,50,59,0,0,0,1,0,0,13,0,18,0,
35,0,50,0,68,0,84,0,94,0,112,0,132,0,148,0,166,0,197,0,226,
0,248,0,6,1,12,1,26,1,31,1,41,1,49,1,77,1,109,1,154,1,
199,1,223,1,6,2,8,2,65,2,155,3,196,3,31,5,135,5,239,5,100,
@ -341,26 +341,26 @@
EVAL_ONE_SIZED_STR((char *)expr, 5006);
}
{
static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,7,52,46,50,46,50,46,53,8,0,0,0,1,0,0,6,0,19,0,
34,0,48,0,62,0,76,0,118,0,0,0,23,1,0,0,65,113,117,111,116,
static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,7,52,46,50,46,51,46,50,8,0,0,0,1,0,0,6,0,19,0,
34,0,48,0,62,0,76,0,118,0,0,0,38,1,0,0,65,113,117,111,116,
101,29,94,2,1,67,35,37,117,116,105,108,115,11,29,94,2,1,69,35,37,
110,101,116,119,111,114,107,11,29,94,2,1,68,35,37,112,97,114,97,109,122,
11,29,94,2,1,68,35,37,101,120,112,111,98,115,11,29,94,2,1,68,35,
37,107,101,114,110,101,108,11,97,35,11,8,240,204,69,0,0,98,159,2,2,
37,107,101,114,110,101,108,11,97,35,11,8,240,46,71,0,0,98,159,2,2,
35,35,159,2,3,35,35,159,2,4,35,35,159,2,5,35,35,159,2,6,35,
35,159,2,6,35,35,16,0,159,35,20,102,159,35,16,1,11,16,0,83,158,
41,20,100,144,69,35,37,98,117,105,108,116,105,110,29,11,11,11,11,11,18,
96,11,42,42,42,35,80,158,35,35,20,102,159,35,16,0,16,0,16,0,35,
16,0,35,16,0,35,11,11,38,35,11,11,11,16,0,16,0,16,0,35,35,
36,11,11,11,16,0,16,0,16,0,35,35,11,11,11,11,16,0,16,0,16,
0,35,35,16,0,16,0,100,2,6,2,5,29,94,2,1,69,35,37,102,111,
0,35,35,16,0,16,0,101,2,6,2,5,29,94,2,1,69,35,37,102,111,
114,101,105,103,110,11,29,94,2,1,68,35,37,117,110,115,97,102,101,11,2,
4,2,3,2,2,29,94,2,1,67,35,37,112,108,97,99,101,11,9,9,9,
35,0};
EVAL_ONE_SIZED_STR((char *)expr, 316);
4,2,3,2,2,29,94,2,1,67,35,37,112,108,97,99,101,11,29,94,2,
1,69,35,37,102,117,116,117,114,101,115,11,9,9,9,35,0};
EVAL_ONE_SIZED_STR((char *)expr, 331);
}
{
static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,7,52,46,50,46,50,46,53,56,0,0,0,1,0,0,11,0,38,0,
static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,7,52,46,50,46,51,46,50,56,0,0,0,1,0,0,11,0,38,0,
44,0,57,0,66,0,73,0,95,0,117,0,143,0,155,0,173,0,193,0,205,
0,221,0,244,0,0,1,31,1,38,1,43,1,48,1,53,1,58,1,67,1,
72,1,76,1,84,1,93,1,101,1,204,1,249,1,13,2,42,2,73,2,129,

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

@ -67,10 +67,9 @@ static Scheme_Object *scheme_local[MAX_CONST_LOCAL_POS][MAX_CONST_LOCAL_TYPES][M
#define SCHEME_TOPLEVEL_FLAGS_MASK 0x3
static Scheme_Object *toplevels[MAX_CONST_TOPLEVEL_DEPTH][MAX_CONST_TOPLEVEL_POS][SCHEME_TOPLEVEL_FLAGS_MASK + 1];
/* globals THREAD_LOCAL
* if locked theses are probably sharable*/
static THREAD_LOCAL Scheme_Hash_Table *toplevels_ht;
static THREAD_LOCAL Scheme_Hash_Table *locals_ht[2];
/* If locked, these are probably sharable: */
THREAD_LOCAL_DECL(static Scheme_Hash_Table *toplevels_ht);
THREAD_LOCAL_DECL(static Scheme_Hash_Table *locals_ht[2]);
/* local functions */
static void make_kernel_env(void);
@ -468,9 +467,7 @@ static Scheme_Env *place_instance_init_post_kernel() {
#if defined(MZ_USE_PLACES)
scheme_jit_fill_threadlocal_table();
#endif
#ifdef FUTURES_ENABLED
scheme_init_futures(env);
#endif
#ifndef DONT_USE_FOREIGN
scheme_init_foreign(env);
@ -502,8 +499,8 @@ Scheme_Env *scheme_place_instance_init(void *stack_base) {
}
void scheme_place_instance_destroy() {
#if defined(USE_PTHREAD_THREAD_TIMER) && defined(MZ_USE_PLACES)
kill_green_thread_timer();
#if defined(MZ_USE_PLACES)
scheme_kill_green_thread_timer();
#endif
}

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

@ -149,23 +149,23 @@
#define EMBEDDED_DEFINES_START_ANYWHERE 0
/* globals */
THREAD_LOCAL volatile int scheme_fuel_counter;
THREAD_LOCAL_DECL(volatile int scheme_fuel_counter);
int scheme_startup_use_jit = 1;
void scheme_set_startup_use_jit(int v) { scheme_startup_use_jit = v; }
/* THREAD LOCAL SHARED */
#ifdef USE_STACK_BOUNDARY_VAR
THREAD_LOCAL unsigned long scheme_stack_boundary;
THREAD_LOCAL unsigned long volatile scheme_jit_stack_boundary;
THREAD_LOCAL_DECL(unsigned long scheme_stack_boundary);
THREAD_LOCAL_DECL(unsigned long volatile scheme_jit_stack_boundary);
#endif
static THREAD_LOCAL Scheme_Object *quick_stx;
THREAD_LOCAL_DECL(static Scheme_Object *quick_stx);
/* global counters */
/* FIXME needs to be atomically incremented */
int scheme_overflow_count;
int get_overflow_count() { return scheme_overflow_count; }
int THREAD_LOCAL scheme_continuation_application_count;
THREAD_LOCAL_DECL(int scheme_continuation_application_count);
/* read-only globals */
Scheme_Object *scheme_eval_waiting;
@ -8795,18 +8795,18 @@ scheme_do_eval(Scheme_Object *obj, int num_rands, Scheme_Object **rands,
{
GC_CAN_IGNORE Scheme_Quote_Syntax *qs = (Scheme_Quote_Syntax *)obj;
Scheme_Object **globs;
int i, c, p;
int i, c, pos;
i = qs->position;
c = qs->depth;
p = qs->midpoint;
pos = qs->midpoint;
globs = (Scheme_Object **)RUNSTACK[c];
v = globs[i+p+1];
v = globs[i+pos+1];
if (!v) {
v = globs[p];
v = globs[pos];
v = scheme_delayed_rename((Scheme_Object **)v, i);
globs[i+p+1] = v;
globs[i+pos+1] = v;
}
goto returnv_never_multi;

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

@ -89,8 +89,8 @@ Scheme_Object *scheme_tail_call_waiting;
Scheme_Object *scheme_inferred_name_symbol;
Scheme_Object *scheme_default_prompt_tag;
THREAD_LOCAL int scheme_cont_capture_count;
static THREAD_LOCAL int scheme_prompt_capture_count;
THREAD_LOCAL_DECL(int scheme_cont_capture_count);
THREAD_LOCAL_DECL(static int scheme_prompt_capture_count);
/* locals */
@ -169,18 +169,18 @@ static Scheme_Object *abort_continuation_proc;
static Scheme_Object *internal_call_cc_prim;
/* CACHES NEED TO BE THREAD LOCAL */
static THREAD_LOCAL Scheme_Prompt *available_prompt;
static THREAD_LOCAL Scheme_Prompt *available_cws_prompt;
static THREAD_LOCAL Scheme_Prompt *available_regular_prompt;
static THREAD_LOCAL Scheme_Dynamic_Wind *available_prompt_dw;
static THREAD_LOCAL Scheme_Meta_Continuation *available_prompt_mc;
static THREAD_LOCAL Scheme_Object *cached_beg_stx;
static THREAD_LOCAL Scheme_Object *cached_dv_stx;
static THREAD_LOCAL Scheme_Object *cached_ds_stx;
static THREAD_LOCAL int cached_stx_phase;
static THREAD_LOCAL Scheme_Cont *offstack_cont;
static THREAD_LOCAL Scheme_Overflow *offstack_overflow;
/* Caches need to be thread-local: */
THREAD_LOCAL_DECL(static Scheme_Prompt *available_prompt);
THREAD_LOCAL_DECL(static Scheme_Prompt *available_cws_prompt);
THREAD_LOCAL_DECL(static Scheme_Prompt *available_regular_prompt);
THREAD_LOCAL_DECL(static Scheme_Dynamic_Wind *available_prompt_dw);
THREAD_LOCAL_DECL(static Scheme_Meta_Continuation *available_prompt_mc);
THREAD_LOCAL_DECL(static Scheme_Object *cached_beg_stx);
THREAD_LOCAL_DECL(static Scheme_Object *cached_dv_stx);
THREAD_LOCAL_DECL(static Scheme_Object *cached_ds_stx);
THREAD_LOCAL_DECL(static int cached_stx_phase);
THREAD_LOCAL_DECL(static Scheme_Cont *offstack_cont);
THREAD_LOCAL_DECL(static Scheme_Overflow *offstack_overflow);
typedef void (*DW_PrePost_Proc)(void *);
@ -1833,8 +1833,8 @@ static void initialize_prompt(Scheme_Thread *p, Scheme_Prompt *prompt, void *sta
typedef Scheme_Object *(*Overflow_K_Proc)(void);
THREAD_LOCAL Scheme_Overflow_Jmp *scheme_overflow_jmp;
THREAD_LOCAL void *scheme_overflow_stack_start;
THREAD_LOCAL_DECL(Scheme_Overflow_Jmp *scheme_overflow_jmp);
THREAD_LOCAL_DECL(void *scheme_overflow_stack_start);
MZ_DO_NOT_INLINE(void scheme_really_create_overflow(void *stack_base));

40
src/mzscheme/src/future.c
View File

@ -7,7 +7,39 @@
int g_print_prims = 0;
#endif
#ifdef FUTURES_ENABLED
#ifndef FUTURES_ENABLED
/* Futures not enabled, but make a stub module */
static Scheme_Object *future(int argc, Scheme_Object *argv[])
{
scheme_signal_error("future: not enabled");
return NULL;
}
static Scheme_Object *touch(int argc, Scheme_Object *argv[])
{
scheme_signal_error("touch: not enabled");
return NULL;
}
# define FUTURE_PRIM_W_ARITY(name, func, a1, a2, env) GLOBAL_PRIM_W_ARITY(name, func, a1, a2, env)
void scheme_init_futures(Scheme_Env *env)
{
Scheme_Env *newenv;
newenv = scheme_primitive_module(scheme_intern_symbol("#%futures"),
env);
FUTURE_PRIM_W_ARITY("future", future, 1, 1, newenv);
FUTURE_PRIM_W_ARITY("touch", touch, 1, 1, newenv);
scheme_finish_primitive_module(newenv);
scheme_protect_primitive_provide(newenv, NULL);
}
#else
#include "future.h"
#include <stdlib.h>
@ -38,7 +70,7 @@ static pthread_mutex_t gc_ok_m = PTHREAD_MUTEX_INITIALIZER;
static pthread_cond_t gc_ok_c = PTHREAD_COND_INITIALIZER;
static int gc_not_ok;
#ifdef MZ_PRECISE_GC
extern THREAD_LOCAL unsigned long GC_gen0_alloc_page_ptr;
THREAD_LOCAL_DECL(extern unsigned long GC_gen0_alloc_page_ptr);
#endif
future_t **g_current_ft;
@ -51,7 +83,7 @@ extern void scheme_on_demand_generate_lambda(Scheme_Native_Closure *nc, int argc
static void start_gc_not_ok();
static void end_gc_not_ok();
static THREAD_LOCAL future_t *current_ft;
THREAD_LOCAL_DECL(static future_t *current_ft);
//Stuff for scheme runstack
//Some of these may mimic defines in thread.c, but are redefined here
@ -606,6 +638,8 @@ void *worker_thread_future_loop(void *arg)
future_t *ft;
int id = *(int *)arg;
scheme_init_os_thread();
//Set processor affinity
/*pthread_mutex_lock(&g_future_queue_mutex);
if (pthread_setaffinity_np(pthread_self(), sizeof(g_cur_cpu_mask), &g_cur_cpu_mask))

1
src/mzscheme/src/future.h
View File

@ -29,7 +29,6 @@ extern Scheme_Object *end_primitive_tracking(int argc, Scheme_Object *argv[]);
extern Scheme_Object *future(int argc, Scheme_Object *argv[]);
extern Scheme_Object *touch(int argc, Scheme_Object *argv[]);
extern Scheme_Object *num_processors(int argc, Scheme_Object *argv[]);
extern void scheme_init_futures(Scheme_Env *env);
extern int future_do_runtimecall(void *func, int sigtype, void *args, void *retval);
extern void futures_init(void);

27
src/mzscheme/src/jit.c
View File

@ -288,9 +288,8 @@ void scheme_jit_fill_threadlocal_table();
# define tl_save_fp 11
# define tl_scheme_fuel_counter 12
# define tl_scheme_jit_stack_boundary 13
# define NUM_tl_VARS 14
static THREAD_LOCAL void *thread_local_pointers[NUM_tl_VARS];
THREAD_LOCAL_DECL(static void *thread_local_pointers[NUM_tl_VARS]);
#ifdef MZ_XFORM
START_XFORM_SKIP;
@ -352,17 +351,11 @@ typedef struct {
Scheme_Native_Closure_Data *case_lam;
} Scheme_Native_Closure_Data_Plus_Case;
/* This structure must be 4 words: */
typedef struct {
void *orig_return_address;
void *stack_frame;
Scheme_Object *cache;
void *orig_result;
} Stack_Cache_Elem;
/* The Stack_Cache_Elem structure type (define in schthread.h)
must have a size of 4 words. */
#define STACK_CACHE_SIZE 32
static THREAD_LOCAL Stack_Cache_Elem stack_cache_stack[STACK_CACHE_SIZE];
static THREAD_LOCAL long stack_cache_stack_pos = 0;
THREAD_LOCAL_DECL(static Stack_Cache_Elem stack_cache_stack[STACK_CACHE_SIZE]);
THREAD_LOCAL_DECL(static long stack_cache_stack_pos = 0);
static void *decrement_cache_stack_pos(void *p)
{
@ -377,8 +370,8 @@ static void *decrement_cache_stack_pos(void *p)
#include "codetab.inc"
static THREAD_LOCAL Scheme_Object **fixup_runstack_base;
static THREAD_LOCAL int fixup_already_in_place;
THREAD_LOCAL_DECL(static Scheme_Object **fixup_runstack_base);
THREAD_LOCAL_DECL(static int fixup_already_in_place);
static Scheme_Object *_scheme_tail_apply_from_native_fixup_args(Scheme_Object *rator,
int argc,
@ -1365,7 +1358,7 @@ static void _jit_prolog_again(mz_jit_state *jitter, int n, int ret_addr_reg)
#endif
#ifdef CAN_INLINE_ALLOC
extern THREAD_LOCAL unsigned long GC_gen0_alloc_page_ptr;
THREAD_LOCAL_DECL(extern unsigned long GC_gen0_alloc_page_ptr);
long GC_initial_word(int sizeb);
void GC_initial_words(char *buffer, int sizeb);
long GC_compute_alloc_size(long sizeb);
@ -1375,12 +1368,12 @@ static void *retry_alloc_code;
static void *retry_alloc_code_keep_r0_r1;
static void *retry_alloc_code_keep_fpr1;
static THREAD_LOCAL void *retry_alloc_r1; /* set by prepare_retry_alloc() */
THREAD_LOCAL_DECL(static void *retry_alloc_r1); /* set by prepare_retry_alloc() */
static int generate_alloc_retry(mz_jit_state *jitter, int i);
#ifdef JIT_USE_FP_OPS
static THREAD_LOCAL double save_fp;
THREAD_LOCAL_DECL(static double save_fp);
#endif
static void *prepare_retry_alloc(void *p, void *p2)

6
src/mzscheme/src/module.c
View File

@ -198,11 +198,11 @@ static Scheme_Bucket_Table *initial_toplevel;
static Scheme_Object *empty_self_modidx;
static Scheme_Object *empty_self_modname;
static THREAD_LOCAL Scheme_Bucket_Table *starts_table;
THREAD_LOCAL_DECL(static Scheme_Bucket_Table *starts_table);
/* caches */
static THREAD_LOCAL Scheme_Modidx *modidx_caching_chain;
static THREAD_LOCAL Scheme_Object *global_shift_cache;
THREAD_LOCAL_DECL(static Scheme_Modidx *modidx_caching_chain);
THREAD_LOCAL_DECL(static Scheme_Object *global_shift_cache);
#define GLOBAL_SHIFT_CACHE_SIZE 40
#ifdef USE_SENORA_GC
# define SHIFT_CACHE_NULL scheme_false

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

@ -9,7 +9,7 @@
mz_proc_thread *scheme_master_proc_thread;
THREAD_LOCAL mz_proc_thread *proc_thread_self;
THREAD_LOCAL_DECL(mz_proc_thread *proc_thread_self);
Scheme_Object *scheme_place(int argc, Scheme_Object *args[]);
static Scheme_Object *scheme_place_wait(int argc, Scheme_Object *args[]);

117
src/mzscheme/src/port.c
View File

@ -303,11 +303,11 @@ typedef struct Scheme_FD {
/* globals */
Scheme_Object scheme_eof[1];
THREAD_LOCAL Scheme_Object *scheme_orig_stdout_port;
THREAD_LOCAL Scheme_Object *scheme_orig_stderr_port;
THREAD_LOCAL Scheme_Object *scheme_orig_stdin_port;
THREAD_LOCAL_DECL(Scheme_Object *scheme_orig_stdout_port);
THREAD_LOCAL_DECL(Scheme_Object *scheme_orig_stderr_port);
THREAD_LOCAL_DECL(Scheme_Object *scheme_orig_stdin_port);
THREAD_LOCAL fd_set *scheme_fd_set;
THREAD_LOCAL_DECL(fd_set *scheme_fd_set);
Scheme_Object *(*scheme_make_stdin)(void) = NULL;
Scheme_Object *(*scheme_make_stdout)(void) = NULL;
@ -350,11 +350,11 @@ int scheme_force_port_closed;
static int flush_out;
static int flush_err;
static THREAD_LOCAL Scheme_Custodian *new_port_cust; /* back-door argument */
THREAD_LOCAL_DECL(static Scheme_Custodian *new_port_cust); /* back-door argument */
#if defined(FILES_HAVE_FDS)
static THREAD_LOCAL int external_event_fd;
static THREAD_LOCAL int put_external_event_fd;
THREAD_LOCAL_DECL(static int external_event_fd);
THREAD_LOCAL_DECL(static int put_external_event_fd);
#endif
static void register_port_wait();
@ -420,7 +420,7 @@ Scheme_Object *scheme_none_symbol, *scheme_line_symbol, *scheme_block_symbol;
static Scheme_Object *exact_symbol;
#define READ_STRING_BYTE_BUFFER_SIZE 1024
static THREAD_LOCAL char *read_string_byte_buffer;
THREAD_LOCAL_DECL(static char *read_string_byte_buffer);
#define fail_err_symbol scheme_false
@ -8475,7 +8475,7 @@ typedef struct ITimer_Data {
volatile unsigned long * jit_stack_boundary_ptr;
} ITimer_Data;
static THREAD_LOCAL ITimer_Data itimerdata;
THREAD_LOCAL_DECL(static ITimer_Data *itimerdata);
#ifdef MZ_XFORM
START_XFORM_SKIP;
@ -8485,6 +8485,8 @@ static void *green_thread_timer(void *data)
{
ITimer_Data *itimer_data;
itimer_data = (ITimer_Data *)data;
scheme_init_os_thread();
while (1) {
if (itimer_data->die) {
@ -8512,54 +8514,63 @@ static void *green_thread_timer(void *data)
END_XFORM_SKIP;
#endif
static void start_green_thread_timer(long usec) {
itimerdata.die = 0;
itimerdata.delay = usec;
itimerdata.fuel_counter_ptr = &scheme_fuel_counter;
itimerdata.jit_stack_boundary_ptr = &scheme_jit_stack_boundary;
pthread_mutex_init(&itimerdata.mutex, NULL);
pthread_cond_init(&itimerdata.cond, NULL);
pthread_create(&itimerdata.thread, NULL, green_thread_timer, &itimerdata);
itimerdata.itimer = 1;
static void start_green_thread_timer(long usec)
{
itimerdata->die = 0;
itimerdata->delay = usec;
itimerdata->fuel_counter_ptr = &scheme_fuel_counter;
itimerdata->jit_stack_boundary_ptr = &scheme_jit_stack_boundary;
pthread_mutex_init(&itimerdata->mutex, NULL);
pthread_cond_init(&itimerdata->cond, NULL);
pthread_create(&itimerdata->thread, NULL, green_thread_timer, itimerdata);
itimerdata->itimer = 1;
}
void kill_green_thread_timer() {
void *rc;
pthread_mutex_lock(&itimerdata.mutex);
itimerdata.die = 1;
if (!itimerdata.state) {
/* itimer thread is currently running working */
} else if (itimerdata.state < 0) {
/* itimer thread is waiting on cond */
pthread_cond_signal(&itimerdata.cond);
} else {
/* itimer thread is working, and we've already
asked it to continue */
}
pthread_mutex_unlock(&itimerdata.mutex);
pthread_join(itimerdata.thread, &rc);
static void kill_green_thread_timer()
{
void *rc;
pthread_mutex_lock(&itimerdata->mutex);
itimerdata->die = 1;
if (!itimerdata->state) {
/* itimer thread is currently running working */
} else if (itimerdata->state < 0) {
/* itimer thread is waiting on cond */
pthread_cond_signal(&itimerdata->cond);
} else {
/* itimer thread is working, and we've already
asked it to continue */
}
pthread_mutex_unlock(&itimerdata->mutex);
pthread_join(itimerdata->thread, &rc);
itimerdata = NULL;
}
static void kickoff_green_thread_timer(long usec) {
pthread_mutex_lock(&itimerdata.mutex);
itimerdata.delay = usec;
if (!itimerdata.state) {
/* itimer thread is currently running working */
itimerdata.state = 1;
} else if (itimerdata.state < 0) {
/* itimer thread is waiting on cond */
itimerdata.state = 0;
pthread_cond_signal(&itimerdata.cond);
} else {
/* itimer thread is working, and we've already
asked it to continue */
}
pthread_mutex_unlock(&itimerdata.mutex);
static void kickoff_green_thread_timer(long usec)
{
pthread_mutex_lock(&itimerdata->mutex);
itimerdata->delay = usec;
if (!itimerdata->state) {
/* itimer thread is currently running working */
itimerdata->state = 1;
} else if (itimerdata->state < 0) {
/* itimer thread is waiting on cond */
itimerdata->state = 0;
pthread_cond_signal(&itimerdata->cond);
} else {
/* itimer thread is working, and we've already
asked it to continue */
}
pthread_mutex_unlock(&itimerdata->mutex);
}
static void scheme_start_itimer_thread(long usec)
{
if (!itimerdata.itimer) {
if (!itimerdata) {
itimerdata = (ITimer_Data *)malloc(sizeof(ITimer_Data));
memset(itimerdata, 0, sizeof(ITimer_Data));
}
if (!itimerdata->itimer) {
start_green_thread_timer(usec);
} else {
kickoff_green_thread_timer(usec);
@ -8617,6 +8628,13 @@ void scheme_kickoff_green_thread_time_slice_timer(long usec) {
#endif
}
void scheme_kill_green_thread_timer()
{
#if defined(USE_PTHREAD_THREAD_TIMER)
kill_green_thread_timer();
#endif
}
#ifdef OS_X
/* Sleep-in-thread support needed for GUIs Mac OS X.
@ -8669,6 +8687,7 @@ static void (*sleep_sleep)(float seconds, void *fds);
static void *do_watch()
{
scheme_init_os_thread();
while (1) {
pt_sema_wait(&sleeping_sema);

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

@ -35,14 +35,14 @@
int (*scheme_check_print_is_obj)(Scheme_Object *o);
#define QUICK_ENCODE_BUFFER_SIZE 256
static THREAD_LOCAL char *quick_buffer = NULL;
static THREAD_LOCAL char *quick_encode_buffer = NULL;
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;
static THREAD_LOCAL Scheme_Hash_Table *cache_ht;
THREAD_LOCAL_DECL(static Scheme_Hash_Table *cache_ht);
/* read-only globals */
static char compacts[_CPT_COUNT_];

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

@ -66,30 +66,30 @@ static regexp *regcomp(char *, rxpos, int, int);
/*
* Global work variables for regcomp().
*/
static THREAD_LOCAL char *regstr;
static THREAD_LOCAL char *regparsestr;
static THREAD_LOCAL int regmatchmin;
static THREAD_LOCAL int regmatchmax;
static THREAD_LOCAL int regmaxbackposn;
static THREAD_LOCAL int regsavepos;
THREAD_LOCAL_DECL(static char *regstr);
THREAD_LOCAL_DECL(static char *regparsestr);
THREAD_LOCAL_DECL(static int regmatchmin);
THREAD_LOCAL_DECL(static int regmatchmax);
THREAD_LOCAL_DECL(static int regmaxbackposn);
THREAD_LOCAL_DECL(static int regsavepos);
static THREAD_LOCAL Scheme_Hash_Table *regbackknown; /* known/assumed backreference [non-]empty */
static THREAD_LOCAL Scheme_Hash_Table *regbackdepends; /* backreferences required to be non-empty for the current to be non-empty */
THREAD_LOCAL_DECL(static Scheme_Hash_Table *regbackknown); /* known/assumed backreference [non-]empty */
THREAD_LOCAL_DECL(static Scheme_Hash_Table *regbackdepends); /* backreferences required to be non-empty for the current to be non-empty */
static THREAD_LOCAL rxpos regparse;
static THREAD_LOCAL rxpos regparse_end; /* Input-scan pointer. */
static THREAD_LOCAL int regnpar; /* () count. */
static THREAD_LOCAL int regncounter; /* {} count */
static THREAD_LOCAL rxpos regcode; /* Code-emit pointer, if less than regcodesize */
static THREAD_LOCAL rxpos regcodesize;
static THREAD_LOCAL rxpos regcodemax;
static THREAD_LOCAL long regmaxlookback;
THREAD_LOCAL_DECL(static rxpos regparse);
THREAD_LOCAL_DECL(static rxpos regparse_end); /* Input-scan pointer. */
THREAD_LOCAL_DECL(static int regnpar); /* () count. */
THREAD_LOCAL_DECL(static int regncounter); /* {} count */
THREAD_LOCAL_DECL(static rxpos regcode) ; /* Code-emit pointer, if less than regcodesize */
THREAD_LOCAL_DECL(static rxpos regcodesize);
THREAD_LOCAL_DECL(static rxpos regcodemax);
THREAD_LOCAL_DECL(static long regmaxlookback);
/* caches to avoid gc */
static THREAD_LOCAL long rx_buffer_size;
static THREAD_LOCAL rxpos *startp_buffer_cache;
static THREAD_LOCAL rxpos *endp_buffer_cache;
static THREAD_LOCAL rxpos *maybep_buffer_cache;
THREAD_LOCAL_DECL(static long rx_buffer_size);
THREAD_LOCAL_DECL(static rxpos *startp_buffer_cache);
THREAD_LOCAL_DECL(static rxpos *endp_buffer_cache);
THREAD_LOCAL_DECL(static rxpos *maybep_buffer_cache);
/*
* Forward declarations for regcomp()'s friends.

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

@ -54,9 +54,13 @@ static void **dgc_array;
static int *dgc_count;
static int dgc_size;
#ifdef IMPLEMENT_THREAD_LOCAL_VIA_PTHREADS
pthread_key_t scheme_thread_local_key;
#endif
extern int scheme_num_copied_stacks;
static unsigned long scheme_primordial_os_thread_stack_base;
static THREAD_LOCAL unsigned long scheme_os_thread_stack_base;
THREAD_LOCAL_DECL(static unsigned long scheme_os_thread_stack_base);
static Scheme_Report_Out_Of_Memory_Proc more_report_out_of_memory;
@ -151,6 +155,14 @@ int scheme_main_stack_setup(int no_auto_statics, Scheme_Nested_Main _main, void
void *stack_start;
int volatile return_code;
#ifdef IMPLEMENT_THREAD_LOCAL_VIA_PTHREADS
if (pthread_key_create(&scheme_thread_local_key, NULL)) {
fprintf(stderr, "pthread key create failed");
abort();
}
scheme_init_os_thread();
#endif
scheme_set_stack_base(PROMPT_STACK(stack_start), no_auto_statics);
return_code = _main(data);
@ -202,6 +214,34 @@ void scheme_set_report_out_of_memory(Scheme_Report_Out_Of_Memory_Proc p)
more_report_out_of_memory = p;
}
#ifdef OS_X
#include <mach/mach.h>
#endif
#ifdef MZ_XFORM
START_XFORM_SKIP;
#endif
void scheme_init_os_thread()
{
#ifdef USE_THREAD_LOCAL
Thread_Local_Variables *vars;
vars = (Thread_Local_Variables *)malloc(sizeof(Thread_Local_Variables));
memset(vars, 0, sizeof(Thread_Local_Variables));
pthread_setspecific(scheme_thread_local_key, vars);
# ifdef OS_X
/* A hack that smehow avoids a problem with calling vm_allocate()
later. There must be some deeper bug that I have't found, yet. */
if (1) {
void *r;
vm_allocate(mach_task_self(), (vm_address_t*)&r, 4096, TRUE);
}
# endif
#endif
}
#ifdef MZ_XFORM
END_XFORM_SKIP;
#endif
/************************************************************************/
/* memory utils */
/************************************************************************/
@ -998,7 +1038,7 @@ typedef struct Finalization {
struct Finalization *next, *prev;
} Finalization;
typedef struct {
typedef struct Finalizations {
MZTAG_IF_REQUIRED
short lifetime;
Finalization *scheme_first, *scheme_last;
@ -1066,8 +1106,8 @@ static void do_next_finalization(void *o, void *data)
/* Makes gc2 xformer happy: */
typedef void (*finalizer_function)(void *p, void *data);
static THREAD_LOCAL int traversers_registered;
static THREAD_LOCAL Finalizations **save_fns_ptr;
THREAD_LOCAL_DECL(static int traversers_registered);
THREAD_LOCAL_DECL(static Finalizations **save_fns_ptr);
static void add_finalizer(void *v, void (*f)(void*,void*), void *data,
int prim, int ext,

16
src/mzscheme/src/schemef.h
View File

@ -67,14 +67,14 @@ MZ_EXTERN Scheme_Object *scheme_current_break_cell();
/* threads */
/*========================================================================*/
#ifndef LINK_EXTENSIONS_BY_TABLE
# if !defined(MZ_USE_PLACES) || !defined(FUTURES_ENABLED)
MZ_EXTERN THREAD_LOCAL Scheme_Thread *scheme_current_thread;
# endif
MZ_EXTERN THREAD_LOCAL volatile int scheme_fuel_counter;
#else
#ifndef USE_THREAD_LOCAL
# ifndef LINK_EXTENSIONS_BY_TABLE
MZ_EXTERN Scheme_Thread *scheme_current_thread;
MZ_EXTERN volatile int scheme_fuel_counter;
# else
MZ_EXTERN Scheme_Thread **scheme_current_thread_ptr;
MZ_EXTERN volatile int *scheme_fuel_counter_ptr;
# endif
#endif
MZ_EXTERN Scheme_Thread *scheme_get_current_thread();
@ -407,7 +407,9 @@ MZ_EXTERN void scheme_gc_ptr_ok(void *p);
MZ_EXTERN void scheme_collect_garbage(void);
#ifdef MZ_PRECISE_GC
MZ_EXTERN THREAD_LOCAL void **GC_variable_stack;
# ifndef USE_THREAD_LOCAL
MZ_EXTERN void **GC_variable_stack;
# endif
MZ_EXTERN void GC_register_traversers(short tag, Size_Proc size, Mark_Proc mark, Fixup_Proc fixup,
int is_constant_size, int is_atomic);
MZ_EXTERN void *GC_resolve(void *p);

10
src/mzscheme/src/schemex.h
View File

@ -53,14 +53,14 @@ Scheme_Object *(*scheme_current_break_cell)();
/*========================================================================*/
/* threads */
/*========================================================================*/
#ifndef LINK_EXTENSIONS_BY_TABLE
# if !defined(MZ_USE_PLACES) || !defined(FUTURES_ENABLED)
#ifndef USE_THREAD_LOCAL
# ifndef LINK_EXTENSIONS_BY_TABLE
Scheme_Thread *scheme_current_thread;
# endif
volatile int scheme_fuel_counter;
#else
# else
Scheme_Thread **scheme_current_thread_ptr;
volatile int *scheme_fuel_counter_ptr;
# endif
#endif
Scheme_Thread *(*scheme_get_current_thread)();
void (*scheme_start_atomic)(void);
@ -329,7 +329,9 @@ void (*scheme_dont_gc_ptr)(void *p);
void (*scheme_gc_ptr_ok)(void *p);
void (*scheme_collect_garbage)(void);
#ifdef MZ_PRECISE_GC
# ifndef USE_THREAD_LOCAL
void **GC_variable_stack;
# endif
void (*GC_register_traversers)(short tag, Size_Proc size, Mark_Proc mark, Fixup_Proc fixup,
int is_constant_size, int is_atomic);
void *(*GC_resolve)(void *p);

10
src/mzscheme/src/schemex.inc
View File

@ -18,14 +18,14 @@
scheme_extension_table->scheme_get_env = scheme_get_env;
scheme_extension_table->scheme_inherit_cells = scheme_inherit_cells;
scheme_extension_table->scheme_current_break_cell = scheme_current_break_cell;
#ifndef LINK_EXTENSIONS_BY_TABLE
# if !defined(MZ_USE_PLACES) || !defined(FUTURES_ENABLED)
#ifndef USE_THREAD_LOCAL
# ifndef LINK_EXTENSIONS_BY_TABLE
scheme_extension_table->scheme_current_thread = scheme_current_thread;
# endif
scheme_extension_table->scheme_fuel_counter = scheme_fuel_counter;
#else
# else
scheme_extension_table->scheme_current_thread_ptr = scheme_current_thread_ptr;
scheme_extension_table->scheme_fuel_counter_ptr = scheme_fuel_counter_ptr;
# endif
#endif
scheme_extension_table->scheme_get_current_thread = scheme_get_current_thread;
scheme_extension_table->scheme_start_atomic = scheme_start_atomic;
@ -229,7 +229,9 @@
scheme_extension_table->scheme_gc_ptr_ok = scheme_gc_ptr_ok;
scheme_extension_table->scheme_collect_garbage = scheme_collect_garbage;
#ifdef MZ_PRECISE_GC
# ifndef USE_THREAD_LOCAL
scheme_extension_table->GC_variable_stack = GC_variable_stack;
# endif
scheme_extension_table->GC_register_traversers = GC_register_traversers;
scheme_extension_table->GC_resolve = GC_resolve;
scheme_extension_table->GC_mark = GC_mark;

10
src/mzscheme/src/schemexm.h
View File

@ -18,14 +18,14 @@
#define scheme_get_env (scheme_extension_table->scheme_get_env)
#define scheme_inherit_cells (scheme_extension_table->scheme_inherit_cells)
#define scheme_current_break_cell (scheme_extension_table->scheme_current_break_cell)
#ifndef LINK_EXTENSIONS_BY_TABLE
# if !defined(MZ_USE_PLACES) || !defined(FUTURES_ENABLED)
#ifndef USE_THREAD_LOCAL
# ifndef LINK_EXTENSIONS_BY_TABLE
#define scheme_current_thread (scheme_extension_table->scheme_current_thread)
# endif
#define scheme_fuel_counter (scheme_extension_table->scheme_fuel_counter)
#else
# else
#define scheme_current_thread_ptr (scheme_extension_table->scheme_current_thread_ptr)
#define scheme_fuel_counter_ptr (scheme_extension_table->scheme_fuel_counter_ptr)
# endif
#endif
#define scheme_get_current_thread (scheme_extension_table->scheme_get_current_thread)
#define scheme_start_atomic (scheme_extension_table->scheme_start_atomic)
@ -229,7 +229,9 @@
#define scheme_gc_ptr_ok (scheme_extension_table->scheme_gc_ptr_ok)
#define scheme_collect_garbage (scheme_extension_table->scheme_collect_garbage)
#ifdef MZ_PRECISE_GC
# ifndef USE_THREAD_LOCAL
#define GC_variable_stack (scheme_extension_table->GC_variable_stack)
# endif
#define GC_register_traversers (scheme_extension_table->GC_register_traversers)
#define GC_resolve (scheme_extension_table->GC_resolve)
#define GC_mark (scheme_extension_table->GC_mark)

2
src/mzscheme/src/schfd.h
View File

@ -1,6 +1,6 @@
#ifdef USE_FAR_MZ_FDCALLS
extern THREAD_LOCAL fd_set *scheme_fd_set;
THREAD_LOCAL_DECL(extern fd_set *scheme_fd_set);
# define DECL_FDSET(n, c) fd_set *n
# define INIT_DECL_FDSET(r, w, e) { \
r = MZ_GET_FDSET(scheme_fd_set, 0 ); \

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

@ -91,8 +91,8 @@ 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;
extern THREAD_LOCAL int scheme_cont_capture_count;
extern THREAD_LOCAL int scheme_continuation_application_count;
THREAD_LOCAL_DECL(extern int scheme_cont_capture_count);
THREAD_LOCAL_DECL(extern int scheme_continuation_application_count);
int scheme_num_types(void);
@ -224,6 +224,7 @@ void scheme_init_foreign_globals();
void scheme_init_foreign(Scheme_Env *env);
#endif
void scheme_init_place(Scheme_Env *env);
void scheme_init_futures(Scheme_Env *env);
void scheme_init_print_buffers_places(void);
void scheme_init_eval_places(void);
@ -307,9 +308,9 @@ extern Scheme_Object *scheme_equal_prim;
extern Scheme_Object *scheme_def_exit_proc;
extern THREAD_LOCAL Scheme_Object *scheme_orig_stdout_port;
extern THREAD_LOCAL Scheme_Object *scheme_orig_stdin_port;
extern THREAD_LOCAL Scheme_Object *scheme_orig_stderr_port;
THREAD_LOCAL_DECL(extern Scheme_Object *scheme_orig_stdout_port);
THREAD_LOCAL_DECL(extern Scheme_Object *scheme_orig_stdin_port);
THREAD_LOCAL_DECL(extern Scheme_Object *scheme_orig_stderr_port);
extern Scheme_Object *scheme_arity_at_least, *scheme_make_arity_at_least;
@ -335,7 +336,7 @@ extern Scheme_Object *scheme_stack_dump_key;
extern Scheme_Object *scheme_default_prompt_tag;
extern THREAD_LOCAL Scheme_Object *scheme_system_idle_channel;
THREAD_LOCAL_DECL(extern Scheme_Object *scheme_system_idle_channel);
extern Scheme_Object *scheme_input_port_property, *scheme_output_port_property;
@ -350,10 +351,10 @@ extern Scheme_Object *scheme_reduced_procedure_struct;
#define RUNSTACK_IS_GLOBAL
#ifdef RUNSTACK_IS_GLOBAL
extern THREAD_LOCAL Scheme_Object **scheme_current_runstack;
extern THREAD_LOCAL Scheme_Object **scheme_current_runstack_start;
extern THREAD_LOCAL MZ_MARK_STACK_TYPE scheme_current_cont_mark_stack;
extern THREAD_LOCAL MZ_MARK_POS_TYPE scheme_current_cont_mark_pos;
THREAD_LOCAL_DECL(extern Scheme_Object **scheme_current_runstack);
THREAD_LOCAL_DECL(extern Scheme_Object **scheme_current_runstack_start);
THREAD_LOCAL_DECL(extern MZ_MARK_STACK_TYPE scheme_current_cont_mark_stack);
THREAD_LOCAL_DECL(extern MZ_MARK_POS_TYPE scheme_current_cont_mark_pos);
# define MZ_RUNSTACK scheme_current_runstack
# define MZ_RUNSTACK_START scheme_current_runstack_start
# define MZ_CONT_MARK_STACK scheme_current_cont_mark_stack
@ -365,13 +366,13 @@ extern THREAD_LOCAL MZ_MARK_POS_TYPE scheme_current_cont_mark_pos;
# define MZ_CONT_MARK_POS (scheme_current_thread->cont_mark_pos)
#endif
extern THREAD_LOCAL volatile int scheme_fuel_counter;
THREAD_LOCAL_DECL(extern volatile int scheme_fuel_counter);
extern THREAD_LOCAL Scheme_Thread *scheme_main_thread;
THREAD_LOCAL_DECL(extern Scheme_Thread *scheme_main_thread);
#ifdef MZ_USE_PLACES
extern THREAD_LOCAL Scheme_Thread *scheme_current_thread;
extern THREAD_LOCAL Scheme_Thread *scheme_first_thread;
THREAD_LOCAL_DECL(extern Scheme_Thread *scheme_current_thread);
THREAD_LOCAL_DECL(extern Scheme_Thread *scheme_first_thread);
#define scheme_eval_wait_expr (scheme_current_thread->ku.eval.wait_expr)
#define scheme_tail_rator (scheme_current_thread->ku.apply.tail_rator)
#define scheme_tail_num_rands (scheme_current_thread->ku.apply.tail_num_rands)
@ -383,10 +384,10 @@ extern THREAD_LOCAL Scheme_Thread *scheme_first_thread;
#define scheme_multiple_array (scheme_current_thread->ku.multiple.array)
#include "mzrt.h"
extern mz_proc_thread *scheme_master_proc_thread;
extern THREAD_LOCAL mz_proc_thread *proc_thread_self;
THREAD_LOCAL_DECL(extern mz_proc_thread *proc_thread_self);
#endif
extern THREAD_LOCAL int scheme_no_stack_overflow;
THREAD_LOCAL_DECL(extern int scheme_no_stack_overflow);
typedef struct Scheme_Thread_Set {
Scheme_Object so;
@ -398,7 +399,7 @@ typedef struct Scheme_Thread_Set {
Scheme_Object *current;
} Scheme_Thread_Set;
extern THREAD_LOCAL Scheme_Thread_Set *scheme_thread_set_top;
THREAD_LOCAL_DECL(extern Scheme_Thread_Set *scheme_thread_set_top);
#define SCHEME_TAIL_COPY_THRESHOLD 5
@ -1081,8 +1082,8 @@ void scheme_notify_code_gc(void);
Scheme_Object *scheme_handle_stack_overflow(Scheme_Object *(*k)(void));
extern THREAD_LOCAL struct Scheme_Overflow_Jmp *scheme_overflow_jmp;
extern THREAD_LOCAL void *scheme_overflow_stack_start;
THREAD_LOCAL_DECL(extern struct Scheme_Overflow_Jmp *scheme_overflow_jmp);
THREAD_LOCAL_DECL(extern void *scheme_overflow_stack_start);
#ifdef MZ_PRECISE_GC
# define PROMPT_STACK(id) &__gc_var_stack__
@ -1284,10 +1285,10 @@ typedef struct Scheme_Overflow {
|| defined(BEOS_FIND_STACK_BOUNDS) || defined(OSKIT_FIXED_STACK_BOUNDS) \
|| defined(PALM_FIND_STACK_BOUNDS)
# define USE_STACK_BOUNDARY_VAR
extern THREAD_LOCAL unsigned long scheme_stack_boundary;
THREAD_LOCAL_DECL(extern unsigned long scheme_stack_boundary);
/* Same as scheme_stack_boundary, but set to an extreme value when feul auto-expires,
so that JIT-generated code can check just one variable: */
extern THREAD_LOCAL unsigned long volatile scheme_jit_stack_boundary;
THREAD_LOCAL_DECL(extern unsigned long volatile scheme_jit_stack_boundary);
#endif
typedef struct Scheme_Meta_Continuation {
@ -1459,7 +1460,7 @@ typedef struct {
bigdig *digits;
} Scheme_Bignum;
#if MZ_PRECISE_GC
#ifdef MZ_PRECISE_GC
# define SCHEME_BIGPOS(b) (MZ_OPT_HASH_KEY(&((Scheme_Bignum *)b)->iso) & 0x1)
# define SCHEME_SET_BIGPOS(b, v) MZ_OPT_HASH_KEY(&((Scheme_Bignum *)b)->iso) = ((v) | SCHEME_BIGINLINE(b))
# define SCHEME_BIGINLINE(b) (MZ_OPT_HASH_KEY(&((Scheme_Bignum *)b)->iso) & 0x2)
@ -3047,7 +3048,7 @@ extern char *scheme_convert_from_wchar(const wchar_t *ws);
# define USE_SOCKETS_TCP
#endif
extern THREAD_LOCAL int scheme_active_but_sleeping;
THREAD_LOCAL_DECL(extern int scheme_active_but_sleeping);
extern int scheme_file_open_count;
typedef struct Scheme_Indexed_String {
@ -3256,7 +3257,7 @@ typedef struct Scheme_Place {
Scheme_Env *scheme_place_instance_init();
void scheme_place_instance_destroy();
void kill_green_thread_timer();
void scheme_kill_green_thread_timer();
/*========================================================================*/
/* engine */

2
src/mzscheme/src/schrx.h
View File

@ -5,8 +5,6 @@
once, anyway.) */
/* #define INDIRECT_TO_PROGRAM */
typedef long rxpos;
struct Regwork;
typedef int (*Scheme_Regexp_Matcher)(struct Regwork *rw);

4
src/mzscheme/src/schvers.h
View File

@ -13,12 +13,12 @@
consistently.)
*/
#define MZSCHEME_VERSION "4.2.3.1"
#define MZSCHEME_VERSION "4.2.3.2"
#define MZSCHEME_VERSION_X 4
#define MZSCHEME_VERSION_Y 2
#define MZSCHEME_VERSION_Z 3
#define MZSCHEME_VERSION_W 1
#define MZSCHEME_VERSION_W 2
#define MZSCHEME_VERSION_MAJOR ((MZSCHEME_VERSION_X * 100) + MZSCHEME_VERSION_Y)
#define MZSCHEME_VERSION_MINOR ((MZSCHEME_VERSION_Z * 1000) + MZSCHEME_VERSION_W)

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

@ -24,7 +24,7 @@
#ifndef NO_SCHEME_THREADS
Scheme_Object *scheme_always_ready_evt;
THREAD_LOCAL Scheme_Object *scheme_system_idle_channel;
THREAD_LOCAL_DECL(Scheme_Object *scheme_system_idle_channel);
static Scheme_Object *make_sema(int n, Scheme_Object **p);
static Scheme_Object *semap(int n, Scheme_Object **p);
@ -59,7 +59,7 @@ static int pending_break(Scheme_Thread *p);
int scheme_main_was_once_suspended;
static THREAD_LOCAL Scheme_Object *system_idle_put_evt;
THREAD_LOCAL_DECL(static Scheme_Object *system_idle_put_evt);
static Scheme_Object *thread_recv_evt;
#ifdef MZ_PRECISE_GC

7
src/mzscheme/src/setjmpup.c
View File

@ -216,10 +216,9 @@ static void set_copy(void *s_c, void *c)
# define get_copy(s_c) (s_c)
# define set_copy(s_c, c) s_c = c
#define STACK_COPY_CACHE_SIZE 10
static THREAD_LOCAL void *stack_copy_cache[STACK_COPY_CACHE_SIZE];
static THREAD_LOCAL long stack_copy_size_cache[STACK_COPY_CACHE_SIZE];
static THREAD_LOCAL int scc_pos;
THREAD_LOCAL_DECL(static void *stack_copy_cache[STACK_COPY_CACHE_SIZE]);
THREAD_LOCAL_DECL(static long stack_copy_size_cache[STACK_COPY_CACHE_SIZE]);
THREAD_LOCAL_DECL(static int scc_pos);
#define SCC_OK_EXTRA_AMT 100
START_XFORM_SKIP;

3
src/mzscheme/src/startup.inc
View File

@ -395,7 +395,8 @@
" '#%paramz"
" '#%network"
" '#%utils"
"(only '#%place)))"
"(only '#%place)"
"(only '#%futures)))"
);
EVAL_ONE_STR(
"(module #%boot '#%kernel"

3
src/mzscheme/src/startup.ss
View File

@ -469,7 +469,8 @@
'#%paramz
'#%network
'#%utils
(only '#%place)))
(only '#%place)
(only '#%futures)))
;; ----------------------------------------
;; Handlers to install on startup

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

@ -146,7 +146,7 @@ static Scheme_Object *scheme_checked_proc_property;
static void register_traversers(void);
#endif
static THREAD_LOCAL Scheme_Bucket_Table *prefab_table;
THREAD_LOCAL_DECL(static Scheme_Bucket_Table *prefab_table);
static Scheme_Object *make_prefab_key(Scheme_Struct_Type *type);
#define cons scheme_make_pair

21
src/mzscheme/src/stxobj.c
View File

@ -82,25 +82,25 @@ static Scheme_Object *lexical_symbol;
static Scheme_Object *protected_symbol;
static Scheme_Object *nominal_id_symbol;
static THREAD_LOCAL Scheme_Object *nominal_ipair_cache;
THREAD_LOCAL_DECL(static Scheme_Object *nominal_ipair_cache);
static THREAD_LOCAL Scheme_Object *mark_id = scheme_make_integer(0);
static THREAD_LOCAL Scheme_Object *current_rib_timestamp = scheme_make_integer(0);
THREAD_LOCAL_DECL(static Scheme_Object *mark_id);
THREAD_LOCAL_DECL(static Scheme_Object *current_rib_timestamp);
static Scheme_Stx_Srcloc *empty_srcloc;
static Scheme_Object *empty_simplified;
static THREAD_LOCAL Scheme_Hash_Table *quick_hash_table;
THREAD_LOCAL_DECL(static Scheme_Hash_Table *quick_hash_table);
static THREAD_LOCAL Scheme_Object *last_phase_shift;
THREAD_LOCAL_DECL(static Scheme_Object *last_phase_shift);
static THREAD_LOCAL Scheme_Object *unsealed_dependencies;
THREAD_LOCAL_DECL(static Scheme_Object *unsealed_dependencies);
static THREAD_LOCAL Scheme_Hash_Table *id_marks_ht; /* a cache */
static THREAD_LOCAL Scheme_Hash_Table *than_id_marks_ht; /* a cache */
THREAD_LOCAL_DECL(static Scheme_Hash_Table *id_marks_ht); /* a cache */
THREAD_LOCAL_DECL(static Scheme_Hash_Table *than_id_marks_ht); /* a cache */
static THREAD_LOCAL Scheme_Bucket_Table *interned_skip_ribs;
THREAD_LOCAL_DECL(static Scheme_Bucket_Table *interned_skip_ribs);
static Scheme_Object *no_nested_inactive_certs;
@ -602,6 +602,9 @@ void scheme_init_stx(Scheme_Env *env)
nominal_id_symbol = scheme_intern_symbol("nominal-id");
REGISTER_SO(mark_id);
REGISTER_SO(current_rib_timestamp);
mark_id = scheme_make_integer(0);
current_rib_timestamp = scheme_make_integer(0);
REGISTER_SO(empty_srcloc);
empty_srcloc = MALLOC_ONE_RT(Scheme_Stx_Srcloc);

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

@ -140,40 +140,40 @@ extern int scheme_jit_malloced;
static int buffer_init_size = INIT_TB_SIZE;
THREAD_LOCAL Scheme_Thread *scheme_current_thread = NULL;
THREAD_LOCAL Scheme_Thread *scheme_main_thread = NULL;
THREAD_LOCAL Scheme_Thread *scheme_first_thread = NULL;
THREAD_LOCAL_DECL(Scheme_Thread *scheme_current_thread = NULL);
THREAD_LOCAL_DECL(Scheme_Thread *scheme_main_thread = NULL);
THREAD_LOCAL_DECL(Scheme_Thread *scheme_first_thread = NULL);
Scheme_Thread *scheme_get_current_thread() { return scheme_current_thread; }
long scheme_get_multiple_count() { return scheme_current_thread->ku.multiple.count; }
Scheme_Object **scheme_get_multiple_array() { return scheme_current_thread->ku.multiple.array; }
void scheme_set_current_thread_ran_some() { scheme_current_thread->ran_some = 1; }
THREAD_LOCAL Scheme_Thread_Set *scheme_thread_set_top;
THREAD_LOCAL_DECL(Scheme_Thread_Set *scheme_thread_set_top);
static THREAD_LOCAL int num_running_threads = 1;
THREAD_LOCAL_DECL(static int num_running_threads); /* not counting original */
#ifdef LINK_EXTENSIONS_BY_TABLE
Scheme_Thread **scheme_current_thread_ptr;
volatile int *scheme_fuel_counter_ptr;
#endif
static THREAD_LOCAL int swap_no_setjmp = 0;
THREAD_LOCAL_DECL(static int swap_no_setjmp = 0);
static THREAD_LOCAL int thread_swap_count;
static THREAD_LOCAL int did_gc_count;
THREAD_LOCAL_DECL(static int thread_swap_count);
THREAD_LOCAL_DECL(static int did_gc_count);
static int init_load_on_demand = 1;
#ifdef RUNSTACK_IS_GLOBAL
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;
THREAD_LOCAL_DECL(Scheme_Object **scheme_current_runstack_start);
THREAD_LOCAL_DECL(Scheme_Object **scheme_current_runstack);
THREAD_LOCAL_DECL(MZ_MARK_STACK_TYPE scheme_current_cont_mark_stack);
THREAD_LOCAL_DECL(MZ_MARK_POS_TYPE scheme_current_cont_mark_pos);
#endif
static THREAD_LOCAL Scheme_Custodian *main_custodian;
static THREAD_LOCAL Scheme_Custodian *last_custodian;
static THREAD_LOCAL Scheme_Hash_Table *limited_custodians = NULL;
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;
@ -188,9 +188,9 @@ extern int GC_is_marked(void *);
/* On swap, put target in a static variable, instead of on the stack,
so that the swapped-out thread is less likely to have a pointer
to the target thread. */
static THREAD_LOCAL Scheme_Thread *swap_target;
THREAD_LOCAL_DECL(static Scheme_Thread *swap_target);
static THREAD_LOCAL Scheme_Object *scheduled_kills;
THREAD_LOCAL_DECL(static Scheme_Object *scheduled_kills);
Scheme_Object *scheme_parameterization_key;
Scheme_Object *scheme_exn_handler_key;
@ -213,16 +213,16 @@ void (*scheme_wakeup_on_input)(void *fds);
int (*scheme_check_for_break)(void);
void (*scheme_on_atomic_timeout)(void);
static THREAD_LOCAL int do_atomic = 0;
static THREAD_LOCAL int missed_context_switch = 0;
static THREAD_LOCAL int have_activity = 0;
THREAD_LOCAL int scheme_active_but_sleeping = 0;
static THREAD_LOCAL int thread_ended_with_activity;
THREAD_LOCAL int scheme_no_stack_overflow;
THREAD_LOCAL_DECL(static int do_atomic = 0);
THREAD_LOCAL_DECL(static int missed_context_switch = 0);
THREAD_LOCAL_DECL(static int have_activity = 0);
THREAD_LOCAL_DECL(int scheme_active_but_sleeping = 0);
THREAD_LOCAL_DECL(static int thread_ended_with_activity);
THREAD_LOCAL_DECL(int scheme_no_stack_overflow);
static THREAD_LOCAL int needs_sleep_cancelled;
THREAD_LOCAL_DECL(static int needs_sleep_cancelled);
static THREAD_LOCAL int tls_pos = 0;
THREAD_LOCAL_DECL(static int tls_pos = 0);
#ifdef MZ_PRECISE_GC
extern long GC_get_memory_use(void *c);
@ -245,17 +245,18 @@ typedef struct Thread_Cell {
static Scheme_Object *read_symbol, *write_symbol, *execute_symbol, *delete_symbol, *exists_symbol;
static Scheme_Object *client_symbol, *server_symbol;
static THREAD_LOCAL Scheme_Object *nested_exn_handler;
THREAD_LOCAL_DECL(static Scheme_Object *the_nested_exn_handler);
static THREAD_LOCAL Scheme_Object *closers;
THREAD_LOCAL_DECL(static Scheme_Object *cust_closers);
static THREAD_LOCAL Scheme_Object *thread_swap_callbacks, *thread_swap_out_callbacks;
THREAD_LOCAL_DECL(static Scheme_Object *thread_swap_callbacks);
THREAD_LOCAL_DECL(static Scheme_Object *thread_swap_out_callbacks);
static THREAD_LOCAL Scheme_Object *recycle_cell;
static THREAD_LOCAL Scheme_Object *maybe_recycle_cell;
static THREAD_LOCAL int recycle_cc_count;
static THREAD_LOCAL mz_jmp_buf main_init_error_buf;
THREAD_LOCAL_DECL(static Scheme_Object *recycle_cell);
THREAD_LOCAL_DECL(static Scheme_Object *maybe_recycle_cell);
THREAD_LOCAL_DECL(static int recycle_cc_count);
THREAD_LOCAL_DECL(static mz_jmp_buf main_init_error_buf);
#ifdef MZ_PRECISE_GC
/* This is a trick to get the types right. Note that
@ -1888,7 +1889,7 @@ static void run_closers(Scheme_Object *o, Scheme_Close_Custodian_Client *f, void
{
Scheme_Object *l;
for (l = closers; SCHEME_RPAIRP(l); l = SCHEME_CDR(l)) {
for (l = cust_closers; SCHEME_RPAIRP(l); l = SCHEME_CDR(l)) {
Scheme_Exit_Closer_Func cf;
cf = (Scheme_Exit_Closer_Func)SCHEME_CAR(l);
cf(o, f, data);
@ -1915,18 +1916,18 @@ static void run_atexit_closers(void)
void scheme_add_atexit_closer(Scheme_Exit_Closer_Func f)
{
if (!closers) {
if (!cust_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;
REGISTER_SO(cust_closers);
cust_closers = scheme_null;
}
closers = scheme_make_raw_pair((Scheme_Object *)f, closers);
cust_closers = scheme_make_raw_pair((Scheme_Object *)f, cust_closers);
}
void scheme_schedule_custodian_close(Scheme_Custodian *c)
@ -3374,13 +3375,13 @@ Scheme_Object *scheme_call_as_nested_thread(int argc, Scheme_Object *argv[], voi
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);
if (!the_nested_exn_handler) {
REGISTER_SO(the_nested_exn_handler);
the_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);
scheme_set_cont_mark(scheme_exn_handler_key, the_nested_exn_handler);
/* Call thunk, catch escape: */
np->error_buf = &newbuf;
@ -7568,7 +7569,7 @@ static Scheme_Object *current_stats(int argc, Scheme_Object *argv[])
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);
SCHEME_VEC_ELS(v)[6] = scheme_make_integer(num_running_threads+1);
case 6:
SCHEME_VEC_ELS(v)[5] = scheme_make_integer(scheme_overflow_count);
case 5:

1
src/worksp/gc2/make.ss
View File

@ -35,6 +35,7 @@
"error"
"eval"
"file"
"future"
"fun"
"hash"
"jit"

4
src/worksp/libmzsch/libmzsch.vcproj
View File

@ -246,6 +246,10 @@
RelativePath="..\..\Mzscheme\Src\Fun.c"
>
</File>
<File
RelativePath="..\..\Mzscheme\Src\Future.c"
>
</File>
<File
RelativePath="..\..\Mzscheme\Src\gmp\gmp.c"
>