diff --git a/collects/compiler/private/xform.ss b/collects/compiler/private/xform.ss index 8ef3191e48..190ad51e5c 100644 --- a/collects/compiler/private/xform.ss +++ b/collects/compiler/private/xform.ss @@ -730,6 +730,7 @@ (printf "#define XFORM_END_SKIP /**/~n") (printf "#define XFORM_START_SUSPEND /**/~n") (printf "#define XFORM_END_SUSPEND /**/~n") + (printf "#define XFORM_SKIP_PROC /**/~n") ;; For avoiding warnings: (printf "#define XFORM_OK_PLUS +~n") (printf "#define XFORM_OK_MINUS -~n") @@ -1522,43 +1523,45 @@ null e))))] [(function? e) - (let ([name (register-proto-information e)]) - (when (eq? (tok-n (car e)) '__xform_nongcing__) - (hash-table-put! non-gcing-functions name #t)) - (when show-info? (printf "/* FUNCTION ~a */~n" name)) - (if (or (positive? suspend-xform) - (not pgc?) - (and where - (regexp-match re:h where) - (let loop ([e e][prev #f]) - (cond - [(null? e) #t] - [(and (eq? '|::| (tok-n (car e))) - prev - (eq? (tok-n prev) (tok-n (cadr e)))) - ;; inline constructor: need to convert - #f] - [else (loop (cdr e) (car e))])))) - ;; Not pgc, xform suspended, - ;; or still in headers and probably a simple inlined function - (let ([palm-static? (and palm? (eq? 'static (tok-n (car e))))]) - (when palm? - (fprintf map-port "(~aimpl ~s)~n" - (if palm-static? "s" "") - name) - (call-graph name e)) - (append - (if palm-static? - ;; Need to make sure prototype is there for section - (add-segment-label - name - (let loop ([e e]) - (if (braces? (car e)) - (list (make-tok semi #f #f)) - (cons (car e) (loop (cdr e)))))) - null) - e)) - (convert-function e name)))] + (if (skip-function? e) + e + (let ([name (register-proto-information e)]) + (when (eq? (tok-n (car e)) '__xform_nongcing__) + (hash-table-put! non-gcing-functions name #t)) + (when show-info? (printf "/* FUNCTION ~a */~n" name)) + (if (or (positive? suspend-xform) + (not pgc?) + (and where + (regexp-match re:h where) + (let loop ([e e][prev #f]) + (cond + [(null? e) #t] + [(and (eq? '|::| (tok-n (car e))) + prev + (eq? (tok-n prev) (tok-n (cadr e)))) + ;; inline constructor: need to convert + #f] + [else (loop (cdr e) (car e))])))) + ;; Not pgc, xform suspended, + ;; or still in headers and probably a simple inlined function + (let ([palm-static? (and palm? (eq? 'static (tok-n (car e))))]) + (when palm? + (fprintf map-port "(~aimpl ~s)~n" + (if palm-static? "s" "") + name) + (call-graph name e)) + (append + (if palm-static? + ;; Need to make sure prototype is there for section + (add-segment-label + name + (let loop ([e e]) + (if (braces? (car e)) + (list (make-tok semi #f #f)) + (cons (car e) (loop (cdr e)))))) + null) + e)) + (convert-function e name))))] [(var-decl? e) (when show-info? (printf "/* VAR */~n")) (if (and can-drop-vars? @@ -1709,12 +1712,16 @@ (and (braces? v) (let ([v (list-ref e (sub1 ll))]) (or (parens? v) + (eq? (tok-n v) 'XFORM_SKIP_PROC) ;; `const' can appear between the arg parens ;; and the function body; this happens in the ;; OS X headers (and (eq? 'const (tok-n v)) (positive? (sub1 ll)) (parens? (list-ref e (- ll 2)))))))))))) + + (define (skip-function? e) + (ormap (lambda (v) (eq? (tok-n v) 'XFORM_SKIP_PROC)) e)) ;; Recognize a top-level variable declaration: (define (var-decl? e) diff --git a/collects/scribblings/inside/memory.scrbl b/collects/scribblings/inside/memory.scrbl index d5e174b8dc..ff53885768 100644 --- a/collects/scribblings/inside/memory.scrbl +++ b/collects/scribblings/inside/memory.scrbl @@ -550,6 +550,17 @@ The following macros can be used (with care!) to navigate MZ_PRECISE_GC} and @cpp{#endif}; a semi-colon by itself at the top level is not legal in C.} +@item{@cppdef{XFORM_SKIP_PROC}: annotate a function so that its body + is skipped in the same way as bracketing it with + @cpp{XFORM_START_SKIP} and @cpp{XFORM_END_SKIP}. + + Example: + + @verbatim[#:indent 2]{ + int foo(int c, ...) XFORM_END_SKIP { + } + }} + @item{@cppdef{XFORM_HIDE_EXPR}: a macro that takes wraps an expression to disable processing of the expression. diff --git a/src/mzscheme/include/scheme.h b/src/mzscheme/include/scheme.h index 909b573f31..891b1c4caa 100644 --- a/src/mzscheme/include/scheme.h +++ b/src/mzscheme/include/scheme.h @@ -1658,6 +1658,7 @@ extern void *scheme_malloc_envunbox(size_t); # define XFORM_END_SKIP /**/ # define XFORM_START_SUSPEND /**/ # define XFORM_END_SUSPEND /**/ +# define XFORM_SKIP_PROC /**/ # define XFORM_START_TRUST_ARITH /**/ # define XFORM_END_TRUST_ARITH /**/ # define XFORM_CAN_IGNORE /**/ diff --git a/src/mzscheme/src/bignum.c b/src/mzscheme/src/bignum.c index be985853a6..d2fb94dbd3 100644 --- a/src/mzscheme/src/bignum.c +++ b/src/mzscheme/src/bignum.c @@ -174,14 +174,10 @@ void scheme_clear_bignum_cache(void) void scheme_clear_bignum_cache(void) { } #endif -#ifdef MZ_XFORM -START_XFORM_SKIP; -#endif - - #define xor(a, b) (!(a) ^ !(b)) Scheme_Object *scheme_make_small_bignum(long v, Small_Bignum *o) + XFORM_SKIP_PROC { bigdig bv; @@ -208,10 +204,6 @@ Scheme_Object *scheme_make_small_bignum(long v, Small_Bignum *o) return (Scheme_Object *) mzALIAS o; } -#ifdef MZ_XFORM -END_XFORM_SKIP; -#endif - Scheme_Object *scheme_make_bignum(long v) { Small_Bignum *r; diff --git a/src/mzscheme/src/complex.c b/src/mzscheme/src/complex.c index 0a74a59410..5eb359e88b 100644 --- a/src/mzscheme/src/complex.c +++ b/src/mzscheme/src/complex.c @@ -56,11 +56,8 @@ Scheme_Object *scheme_real_to_complex(const Scheme_Object *n) return make_complex(n, zero, 0); } -#ifdef MZ_XFORM -START_XFORM_SKIP; -#endif - Scheme_Object *scheme_make_small_complex(const Scheme_Object *n, Small_Complex *s) + XFORM_SKIP_PROC { s->so.type = scheme_complex_type; s->r = (Scheme_Object *)n; @@ -69,10 +66,6 @@ Scheme_Object *scheme_make_small_complex(const Scheme_Object *n, Small_Complex * return (Scheme_Object *)s; } -#ifdef MZ_XFORM -END_XFORM_SKIP; -#endif - int scheme_is_complex_exact(const Scheme_Object *o) { Scheme_Complex *c = (Scheme_Complex *)o; diff --git a/src/mzscheme/src/dynext.c b/src/mzscheme/src/dynext.c index e38417d32c..5cb994113b 100644 --- a/src/mzscheme/src/dynext.c +++ b/src/mzscheme/src/dynext.c @@ -463,19 +463,12 @@ static Scheme_Object *do_load_extension(const char *filename, #endif } -#ifdef MZ_XFORM -START_XFORM_SKIP; -#endif - void scheme_register_extension_global(void *ptr, long size) + XFORM_SKIP_PROC { GC_add_roots((char *)ptr, (char *)(((char *)ptr) + size + 1)); } -#ifdef MZ_XFORM -END_XFORM_SKIP; -#endif - static Scheme_Object *load_extension(int argc, Scheme_Object **argv) { return scheme_load_with_clrd(argc, argv, "load-extension", MZCONFIG_LOAD_EXTENSION_HANDLER); diff --git a/src/mzscheme/src/fun.c b/src/mzscheme/src/fun.c index 5dfc190be8..6354dbaeb0 100644 --- a/src/mzscheme/src/fun.c +++ b/src/mzscheme/src/fun.c @@ -7945,11 +7945,9 @@ void scheme_apply_dw_in_meta(Scheme_Dynamic_Wind *dw, int post_part, int meta_de #define CLOCKS_PER_SEC 1000000 #endif -#ifdef MZ_XFORM -START_XFORM_SKIP; -#endif - long scheme_get_milliseconds(void) + XFORM_SKIP_PROC +/* this function can be called from any OS thread */ { #ifdef USE_MACTIME return scheme_get_process_milliseconds(); @@ -7971,10 +7969,8 @@ long scheme_get_milliseconds(void) #endif } -#ifdef MZ_XFORM -START_XFORM_SKIP; -#endif double scheme_get_inexact_milliseconds(void) + XFORM_SKIP_PROC /* this function can be called from any OS thread */ { #ifdef USE_MACTIME @@ -8002,12 +7998,9 @@ double scheme_get_inexact_milliseconds(void) # endif #endif } -#ifdef MZ_XFORM -END_XFORM_SKIP; -#endif - long scheme_get_process_milliseconds(void) + XFORM_SKIP_PROC { #ifdef USER_TIME_IS_CLOCK return scheme_get_milliseconds(); @@ -8051,6 +8044,7 @@ long scheme_get_process_milliseconds(void) } long scheme_get_thread_milliseconds(Scheme_Object *thrd) + XFORM_SKIP_PROC { Scheme_Thread *t = thrd ? (Scheme_Thread *)thrd : scheme_current_thread; @@ -8063,10 +8057,6 @@ long scheme_get_thread_milliseconds(Scheme_Object *thrd) } } -#ifdef MZ_XFORM -END_XFORM_SKIP; -#endif - long scheme_get_seconds(void) { #ifdef USE_MACTIME diff --git a/src/mzscheme/src/future.c b/src/mzscheme/src/future.c index 29912b22a2..1e99450f02 100644 --- a/src/mzscheme/src/future.c +++ b/src/mzscheme/src/future.c @@ -485,10 +485,9 @@ int future_ready(Scheme_Object *obj) } static void dequeue_future(Scheme_Future_State *fs, future_t *ft) + XFORM_SKIP_PROC /* called from both future and runtime threads */ { - START_XFORM_SKIP; - if (ft->prev == NULL) fs->future_queue = ft->next; else @@ -503,8 +502,6 @@ static void dequeue_future(Scheme_Future_State *fs, future_t *ft) ft->prev = NULL; --fs->future_queue_count; - - END_XFORM_SKIP; } Scheme_Object *touch(int argc, Scheme_Object *argv[]) @@ -619,10 +616,10 @@ Scheme_Object *processor_count(int argc, Scheme_Object *argv[]) //executing futures. This function will never terminate //(until the process dies). void *worker_thread_future_loop(void *arg) + XFORM_SKIP_PROC /* Called in future thread; runtime thread is blocked until ready_sema is signaled. */ { - START_XFORM_SKIP; /* valid only until signaling */ future_thread_params_t *params = (future_thread_params_t *)arg; Scheme_Future_Thread_State *fts = params->fts; @@ -742,7 +739,6 @@ void *worker_thread_future_loop(void *arg) goto wait_for_work; return NULL; - END_XFORM_SKIP; } void scheme_check_future_work() @@ -783,9 +779,9 @@ void scheme_check_future_work() static void future_do_runtimecall(Scheme_Future_Thread_State *fts, void *func, int is_atomic) + XFORM_SKIP_PROC /* Called in future thread */ { - START_XFORM_SKIP; future_t *future; Scheme_Future_State *fs = scheme_future_state; @@ -829,8 +825,6 @@ static void future_do_runtimecall(Scheme_Future_Thread_State *fts, future->no_retval = 0; scheme_future_longjmp(*scheme_current_thread->error_buf, 1); } - - END_XFORM_SKIP; } @@ -838,9 +832,9 @@ static void future_do_runtimecall(Scheme_Future_Thread_State *fts, /* Functions for primitive invocation */ /**********************************************************************/ void scheme_rtcall_void_void_3args(const char *who, int src_type, prim_void_void_3args_t f) + XFORM_SKIP_PROC /* Called in future thread */ { - START_XFORM_SKIP; Scheme_Future_Thread_State *fts = scheme_future_thread_state; future_t *future = fts->current_ft; @@ -855,14 +849,12 @@ void scheme_rtcall_void_void_3args(const char *who, int src_type, prim_void_void future_do_runtimecall(fts, (void*)f, 1); future->arg_S0 = NULL; - - END_XFORM_SKIP; } unsigned long scheme_rtcall_alloc_void_pvoid(const char *who, int src_type, prim_alloc_void_pvoid_t f) + XFORM_SKIP_PROC /* Called in future thread */ { - START_XFORM_SKIP; future_t *future; unsigned long retval; Scheme_Future_Thread_State *fts = scheme_future_thread_state; @@ -887,10 +879,10 @@ unsigned long scheme_rtcall_alloc_void_pvoid(const char *who, int src_type, prim } return retval; - END_XFORM_SKIP; } static void receive_special_result(future_t *f, Scheme_Object *retval) + XFORM_SKIP_PROC /* Called in future thread */ { if (SAME_OBJ(retval, SCHEME_MULTIPLE_VALUES)) { @@ -1041,9 +1033,9 @@ future_t *enqueue_future(Scheme_Future_State *fs, future_t *ft) } future_t *get_pending_future(Scheme_Future_State *fs) + XFORM_SKIP_PROC /* Called in future thread */ { - START_XFORM_SKIP; future_t *f; for (f = fs->future_queue; f != NULL; f = f->next) { @@ -1052,7 +1044,6 @@ future_t *get_pending_future(Scheme_Future_State *fs) } return NULL; - END_XFORM_SKIP; } /**********************************************************************/ diff --git a/src/mzscheme/src/gen-jit-ts.ss b/src/mzscheme/src/gen-jit-ts.ss index e1d2fd5542..e6a2f7eec9 100644 --- a/src/mzscheme/src/gen-jit-ts.ss +++ b/src/mzscheme/src/gen-jit-ts.ss @@ -41,13 +41,12 @@ (for-each display @list{#define define_ts_@|ts|(id, src_type) \ static @|result-type| ts_ ## id(@|args|) \ + XFORM_SKIP_PROC \ { \ - START_XFORM_SKIP; \ if (scheme_use_rtcall) \ @|return| scheme_rtcall_@|t|("[" #id "]", src_type, id, @(string-join arg-names ", ")); \ else \ @|return| id(@(string-join arg-names ", ")); \ - END_XFORM_SKIP; \ }}) (newline)) @@ -62,8 +61,8 @@ display @list{ @|result-type| scheme_rtcall_@|ts|(const char *who, int src_type, prim_@|ts| f@|(if (null? arg-types) "" ",")| @|args|) + XFORM_SKIP_PROC { - START_XFORM_SKIP; Scheme_Future_Thread_State *fts = scheme_future_thread_state; future_t *future; double tm; @@ -88,7 +87,6 @@ @(if (string=? result-type "void") "" @string-append{@|fretval| = 0;}) @(if (string=? result-type "Scheme_Object*") @string-append{receive_special_result(future, retval);} "") @(if (string=? result-type "void") "" "return retval;") - END_XFORM_SKIP; } }) (newline)) diff --git a/src/mzscheme/src/jit.c b/src/mzscheme/src/jit.c index 6af88e813c..507b136694 100644 --- a/src/mzscheme/src/jit.c +++ b/src/mzscheme/src/jit.c @@ -298,13 +298,7 @@ void scheme_jit_fill_threadlocal_table(); # define tl_scheme_future_need_gc_pause tl_delta(scheme_future_need_gc_pause) # define tl_scheme_use_rtcall tl_delta(scheme_use_rtcall) -#ifdef MZ_XFORM -START_XFORM_SKIP; -#endif -static void *get_threadlocal_table() { return &BOTTOM_VARIABLE; } -#ifdef MZ_XFORM -END_XFORM_SKIP; -#endif +static void *get_threadlocal_table() XFORM_SKIP_PROC { return &BOTTOM_VARIABLE; } # ifdef JIT_X86_64 # define JIT_R10 JIT_R(10) @@ -2216,10 +2210,9 @@ extern int g_print_prims; mz_patch_ucbranch(refcont); \ __END_TINY_JUMPS__(1); \ } -static Scheme_Object *noncm_prim_indirect(Scheme_Prim proc, int argc) +static Scheme_Object *noncm_prim_indirect(Scheme_Prim proc, int argc) + XFORM_SKIP_PROC { - START_XFORM_SKIP; - if (scheme_use_rtcall) return scheme_rtcall_iS_s("[prim_indirect]", FSRC_PRIM, @@ -2228,39 +2221,31 @@ static Scheme_Object *noncm_prim_indirect(Scheme_Prim proc, int argc) MZ_RUNSTACK); else return proc(argc, MZ_RUNSTACK); - - END_XFORM_SKIP; } -static Scheme_Object *prim_indirect(Scheme_Primitive_Closure_Proc proc, int argc, Scheme_Object *self) +static Scheme_Object *prim_indirect(Scheme_Primitive_Closure_Proc proc, int argc, Scheme_Object *self) + XFORM_SKIP_PROC { - START_XFORM_SKIP; - if (scheme_use_rtcall) return scheme_rtcall_iSs_s("[prim_indirect]", FSRC_PRIM, proc, argc, MZ_RUNSTACK, self); else return proc(argc, MZ_RUNSTACK, self); - - END_XFORM_SKIP; } /* Various specific 'futurized' versions of primitives that may be invoked directly from JIT code and are not considered thread-safe (are not invoked via apply_multi_from_native, etc.) */ -static void ts_on_demand(void) +static void ts_on_demand(void) XFORM_SKIP_PROC { - START_XFORM_SKIP; if (scheme_use_rtcall) { scheme_rtcall_void_void_3args("[jit_on_demand]", FSRC_OTHER, on_demand_with_args); } else on_demand(); - END_XFORM_SKIP; } #ifdef MZ_PRECISE_GC -static void *ts_prepare_retry_alloc(void *p, void *p2) +static void *ts_prepare_retry_alloc(void *p, void *p2) XFORM_SKIP_PROC { - START_XFORM_SKIP; unsigned long ret; if (scheme_use_rtcall) { @@ -2277,7 +2262,6 @@ static void *ts_prepare_retry_alloc(void *p, void *p2) ret = prepare_retry_alloc(p, p2); return ret; - END_XFORM_SKIP; } #endif #else @@ -10316,11 +10300,8 @@ void scheme_dump_stack_trace(void) } #endif -#ifdef MZ_XFORM -START_XFORM_SKIP; -#endif - void scheme_flush_stack_cache() + XFORM_SKIP_PROC { void **p; @@ -10332,6 +10313,7 @@ void scheme_flush_stack_cache() } void scheme_jit_longjmp(mz_jit_jmp_buf b, int v) + XFORM_SKIP_PROC { unsigned long limit; void **p; @@ -10350,16 +10332,13 @@ void scheme_jit_longjmp(mz_jit_jmp_buf b, int v) } void scheme_jit_setjmp_prepare(mz_jit_jmp_buf b) + XFORM_SKIP_PROC { void *p; p = &p; b->stack_frame = (unsigned long)p; } -#ifdef MZ_XFORM -END_XFORM_SKIP; -#endif - void scheme_clean_native_symtab(void) { #ifndef MZ_PRECISE_GC diff --git a/src/mzscheme/src/jit_ts_def.c b/src/mzscheme/src/jit_ts_def.c index 9dfc76623b..2f09ee2d9f 100644 --- a/src/mzscheme/src/jit_ts_def.c +++ b/src/mzscheme/src/jit_ts_def.c @@ -1,200 +1,180 @@ #define define_ts_siS_s(id, src_type) \ static Scheme_Object* ts_ ## id(Scheme_Object* g7, int g8, Scheme_Object** g9) \ + XFORM_SKIP_PROC \ { \ - START_XFORM_SKIP; \ if (scheme_use_rtcall) \ return scheme_rtcall_siS_s("[" #id "]", src_type, id, g7, g8, g9); \ else \ return id(g7, g8, g9); \ - END_XFORM_SKIP; \ } #define define_ts_iSs_s(id, src_type) \ static Scheme_Object* ts_ ## id(int g10, Scheme_Object** g11, Scheme_Object* g12) \ + XFORM_SKIP_PROC \ { \ - START_XFORM_SKIP; \ if (scheme_use_rtcall) \ return scheme_rtcall_iSs_s("[" #id "]", src_type, id, g10, g11, g12); \ else \ return id(g10, g11, g12); \ - END_XFORM_SKIP; \ } #define define_ts_s_s(id, src_type) \ static Scheme_Object* ts_ ## id(Scheme_Object* g13) \ + XFORM_SKIP_PROC \ { \ - START_XFORM_SKIP; \ if (scheme_use_rtcall) \ return scheme_rtcall_s_s("[" #id "]", src_type, id, g13); \ else \ return id(g13); \ - END_XFORM_SKIP; \ } #define define_ts_n_s(id, src_type) \ static Scheme_Object* ts_ ## id(Scheme_Native_Closure_Data* g14) \ + XFORM_SKIP_PROC \ { \ - START_XFORM_SKIP; \ if (scheme_use_rtcall) \ return scheme_rtcall_n_s("[" #id "]", src_type, id, g14); \ else \ return id(g14); \ - END_XFORM_SKIP; \ } #define define_ts__s(id, src_type) \ static Scheme_Object* ts_ ## id() \ + XFORM_SKIP_PROC \ { \ - START_XFORM_SKIP; \ if (scheme_use_rtcall) \ return scheme_rtcall__s("[" #id "]", src_type, id, ); \ else \ return id(); \ - END_XFORM_SKIP; \ } #define define_ts_ss_s(id, src_type) \ static Scheme_Object* ts_ ## id(Scheme_Object* g15, Scheme_Object* g16) \ + XFORM_SKIP_PROC \ { \ - START_XFORM_SKIP; \ if (scheme_use_rtcall) \ return scheme_rtcall_ss_s("[" #id "]", src_type, id, g15, g16); \ else \ return id(g15, g16); \ - END_XFORM_SKIP; \ } #define define_ts_ss_m(id, src_type) \ static MZ_MARK_STACK_TYPE ts_ ## id(Scheme_Object* g17, Scheme_Object* g18) \ + XFORM_SKIP_PROC \ { \ - START_XFORM_SKIP; \ if (scheme_use_rtcall) \ return scheme_rtcall_ss_m("[" #id "]", src_type, id, g17, g18); \ else \ return id(g17, g18); \ - END_XFORM_SKIP; \ } #define define_ts_Sl_s(id, src_type) \ static Scheme_Object* ts_ ## id(Scheme_Object** g19, long g20) \ + XFORM_SKIP_PROC \ { \ - START_XFORM_SKIP; \ if (scheme_use_rtcall) \ return scheme_rtcall_Sl_s("[" #id "]", src_type, id, g19, g20); \ else \ return id(g19, g20); \ - END_XFORM_SKIP; \ } #define define_ts_l_s(id, src_type) \ static Scheme_Object* ts_ ## id(long g21) \ + XFORM_SKIP_PROC \ { \ - START_XFORM_SKIP; \ if (scheme_use_rtcall) \ return scheme_rtcall_l_s("[" #id "]", src_type, id, g21); \ else \ return id(g21); \ - END_XFORM_SKIP; \ } #define define_ts_bsi_v(id, src_type) \ static void ts_ ## id(Scheme_Bucket* g22, Scheme_Object* g23, int g24) \ + XFORM_SKIP_PROC \ { \ - START_XFORM_SKIP; \ if (scheme_use_rtcall) \ scheme_rtcall_bsi_v("[" #id "]", src_type, id, g22, g23, g24); \ else \ id(g22, g23, g24); \ - END_XFORM_SKIP; \ } #define define_ts_iiS_v(id, src_type) \ static void ts_ ## id(int g25, int g26, Scheme_Object** g27) \ + XFORM_SKIP_PROC \ { \ - START_XFORM_SKIP; \ if (scheme_use_rtcall) \ scheme_rtcall_iiS_v("[" #id "]", src_type, id, g25, g26, g27); \ else \ id(g25, g26, g27); \ - END_XFORM_SKIP; \ } #define define_ts_ss_v(id, src_type) \ static void ts_ ## id(Scheme_Object* g28, Scheme_Object* g29) \ + XFORM_SKIP_PROC \ { \ - START_XFORM_SKIP; \ if (scheme_use_rtcall) \ scheme_rtcall_ss_v("[" #id "]", src_type, id, g28, g29); \ else \ id(g28, g29); \ - END_XFORM_SKIP; \ } #define define_ts_b_v(id, src_type) \ static void ts_ ## id(Scheme_Bucket* g30) \ + XFORM_SKIP_PROC \ { \ - START_XFORM_SKIP; \ if (scheme_use_rtcall) \ scheme_rtcall_b_v("[" #id "]", src_type, id, g30); \ else \ id(g30); \ - END_XFORM_SKIP; \ } #define define_ts_sl_s(id, src_type) \ static Scheme_Object* ts_ ## id(Scheme_Object* g31, long g32) \ + XFORM_SKIP_PROC \ { \ - START_XFORM_SKIP; \ if (scheme_use_rtcall) \ return scheme_rtcall_sl_s("[" #id "]", src_type, id, g31, g32); \ else \ return id(g31, g32); \ - END_XFORM_SKIP; \ } #define define_ts_iS_s(id, src_type) \ static Scheme_Object* ts_ ## id(int g33, Scheme_Object** g34) \ + XFORM_SKIP_PROC \ { \ - START_XFORM_SKIP; \ if (scheme_use_rtcall) \ return scheme_rtcall_iS_s("[" #id "]", src_type, id, g33, g34); \ else \ return id(g33, g34); \ - END_XFORM_SKIP; \ } #define define_ts_S_s(id, src_type) \ static Scheme_Object* ts_ ## id(Scheme_Object** g35) \ + XFORM_SKIP_PROC \ { \ - START_XFORM_SKIP; \ if (scheme_use_rtcall) \ return scheme_rtcall_S_s("[" #id "]", src_type, id, g35); \ else \ return id(g35); \ - END_XFORM_SKIP; \ } #define define_ts_s_v(id, src_type) \ static void ts_ ## id(Scheme_Object* g36) \ + XFORM_SKIP_PROC \ { \ - START_XFORM_SKIP; \ if (scheme_use_rtcall) \ scheme_rtcall_s_v("[" #id "]", src_type, id, g36); \ else \ id(g36); \ - END_XFORM_SKIP; \ } #define define_ts_iSi_s(id, src_type) \ static Scheme_Object* ts_ ## id(int g37, Scheme_Object** g38, int g39) \ + XFORM_SKIP_PROC \ { \ - START_XFORM_SKIP; \ if (scheme_use_rtcall) \ return scheme_rtcall_iSi_s("[" #id "]", src_type, id, g37, g38, g39); \ else \ return id(g37, g38, g39); \ - END_XFORM_SKIP; \ } #define define_ts_siS_v(id, src_type) \ static void ts_ ## id(Scheme_Object* g40, int g41, Scheme_Object** g42) \ + XFORM_SKIP_PROC \ { \ - START_XFORM_SKIP; \ if (scheme_use_rtcall) \ scheme_rtcall_siS_v("[" #id "]", src_type, id, g40, g41, g42); \ else \ id(g40, g41, g42); \ - END_XFORM_SKIP; \ } #define define_ts_z_p(id, src_type) \ static void* ts_ ## id(size_t g43) \ + XFORM_SKIP_PROC \ { \ - START_XFORM_SKIP; \ if (scheme_use_rtcall) \ return scheme_rtcall_z_p("[" #id "]", src_type, id, g43); \ else \ return id(g43); \ - END_XFORM_SKIP; \ } diff --git a/src/mzscheme/src/jit_ts_future_glue.c b/src/mzscheme/src/jit_ts_future_glue.c index 3c7177bca9..0964d32c8e 100644 --- a/src/mzscheme/src/jit_ts_future_glue.c +++ b/src/mzscheme/src/jit_ts_future_glue.c @@ -1,6 +1,6 @@ Scheme_Object* scheme_rtcall_siS_s(const char *who, int src_type, prim_siS_s f, Scheme_Object* g44, int g45, Scheme_Object** g46) + XFORM_SKIP_PROC { - START_XFORM_SKIP; Scheme_Future_Thread_State *fts = scheme_future_thread_state; future_t *future; double tm; @@ -22,11 +22,10 @@ future->retval_s = 0; receive_special_result(future, retval); return retval; - END_XFORM_SKIP; } Scheme_Object* scheme_rtcall_iSs_s(const char *who, int src_type, prim_iSs_s f, int g47, Scheme_Object** g48, Scheme_Object* g49) + XFORM_SKIP_PROC { - START_XFORM_SKIP; Scheme_Future_Thread_State *fts = scheme_future_thread_state; future_t *future; double tm; @@ -48,11 +47,10 @@ future->retval_s = 0; receive_special_result(future, retval); return retval; - END_XFORM_SKIP; } Scheme_Object* scheme_rtcall_s_s(const char *who, int src_type, prim_s_s f, Scheme_Object* g50) + XFORM_SKIP_PROC { - START_XFORM_SKIP; Scheme_Future_Thread_State *fts = scheme_future_thread_state; future_t *future; double tm; @@ -72,11 +70,10 @@ future->retval_s = 0; receive_special_result(future, retval); return retval; - END_XFORM_SKIP; } Scheme_Object* scheme_rtcall_n_s(const char *who, int src_type, prim_n_s f, Scheme_Native_Closure_Data* g51) + XFORM_SKIP_PROC { - START_XFORM_SKIP; Scheme_Future_Thread_State *fts = scheme_future_thread_state; future_t *future; double tm; @@ -96,11 +93,10 @@ future->retval_s = 0; receive_special_result(future, retval); return retval; - END_XFORM_SKIP; } Scheme_Object* scheme_rtcall__s(const char *who, int src_type, prim__s f ) + XFORM_SKIP_PROC { - START_XFORM_SKIP; Scheme_Future_Thread_State *fts = scheme_future_thread_state; future_t *future; double tm; @@ -120,11 +116,10 @@ future->retval_s = 0; receive_special_result(future, retval); return retval; - END_XFORM_SKIP; } Scheme_Object* scheme_rtcall_ss_s(const char *who, int src_type, prim_ss_s f, Scheme_Object* g52, Scheme_Object* g53) + XFORM_SKIP_PROC { - START_XFORM_SKIP; Scheme_Future_Thread_State *fts = scheme_future_thread_state; future_t *future; double tm; @@ -145,11 +140,10 @@ future->retval_s = 0; receive_special_result(future, retval); return retval; - END_XFORM_SKIP; } MZ_MARK_STACK_TYPE scheme_rtcall_ss_m(const char *who, int src_type, prim_ss_m f, Scheme_Object* g54, Scheme_Object* g55) + XFORM_SKIP_PROC { - START_XFORM_SKIP; Scheme_Future_Thread_State *fts = scheme_future_thread_state; future_t *future; double tm; @@ -170,11 +164,10 @@ future->retval_m = 0; return retval; - END_XFORM_SKIP; } Scheme_Object* scheme_rtcall_Sl_s(const char *who, int src_type, prim_Sl_s f, Scheme_Object** g56, long g57) + XFORM_SKIP_PROC { - START_XFORM_SKIP; Scheme_Future_Thread_State *fts = scheme_future_thread_state; future_t *future; double tm; @@ -195,11 +188,10 @@ future->retval_s = 0; receive_special_result(future, retval); return retval; - END_XFORM_SKIP; } Scheme_Object* scheme_rtcall_l_s(const char *who, int src_type, prim_l_s f, long g58) + XFORM_SKIP_PROC { - START_XFORM_SKIP; Scheme_Future_Thread_State *fts = scheme_future_thread_state; future_t *future; double tm; @@ -219,11 +211,10 @@ future->retval_s = 0; receive_special_result(future, retval); return retval; - END_XFORM_SKIP; } void scheme_rtcall_bsi_v(const char *who, int src_type, prim_bsi_v f, Scheme_Bucket* g59, Scheme_Object* g60, int g61) + XFORM_SKIP_PROC { - START_XFORM_SKIP; Scheme_Future_Thread_State *fts = scheme_future_thread_state; future_t *future; double tm; @@ -245,11 +236,10 @@ - END_XFORM_SKIP; } void scheme_rtcall_iiS_v(const char *who, int src_type, prim_iiS_v f, int g62, int g63, Scheme_Object** g64) + XFORM_SKIP_PROC { - START_XFORM_SKIP; Scheme_Future_Thread_State *fts = scheme_future_thread_state; future_t *future; double tm; @@ -271,11 +261,10 @@ - END_XFORM_SKIP; } void scheme_rtcall_ss_v(const char *who, int src_type, prim_ss_v f, Scheme_Object* g65, Scheme_Object* g66) + XFORM_SKIP_PROC { - START_XFORM_SKIP; Scheme_Future_Thread_State *fts = scheme_future_thread_state; future_t *future; double tm; @@ -296,11 +285,10 @@ - END_XFORM_SKIP; } void scheme_rtcall_b_v(const char *who, int src_type, prim_b_v f, Scheme_Bucket* g67) + XFORM_SKIP_PROC { - START_XFORM_SKIP; Scheme_Future_Thread_State *fts = scheme_future_thread_state; future_t *future; double tm; @@ -320,11 +308,10 @@ - END_XFORM_SKIP; } Scheme_Object* scheme_rtcall_sl_s(const char *who, int src_type, prim_sl_s f, Scheme_Object* g68, long g69) + XFORM_SKIP_PROC { - START_XFORM_SKIP; Scheme_Future_Thread_State *fts = scheme_future_thread_state; future_t *future; double tm; @@ -345,11 +332,10 @@ future->retval_s = 0; receive_special_result(future, retval); return retval; - END_XFORM_SKIP; } Scheme_Object* scheme_rtcall_iS_s(const char *who, int src_type, prim_iS_s f, int g70, Scheme_Object** g71) + XFORM_SKIP_PROC { - START_XFORM_SKIP; Scheme_Future_Thread_State *fts = scheme_future_thread_state; future_t *future; double tm; @@ -370,11 +356,10 @@ future->retval_s = 0; receive_special_result(future, retval); return retval; - END_XFORM_SKIP; } Scheme_Object* scheme_rtcall_S_s(const char *who, int src_type, prim_S_s f, Scheme_Object** g72) + XFORM_SKIP_PROC { - START_XFORM_SKIP; Scheme_Future_Thread_State *fts = scheme_future_thread_state; future_t *future; double tm; @@ -394,11 +379,10 @@ future->retval_s = 0; receive_special_result(future, retval); return retval; - END_XFORM_SKIP; } void scheme_rtcall_s_v(const char *who, int src_type, prim_s_v f, Scheme_Object* g73) + XFORM_SKIP_PROC { - START_XFORM_SKIP; Scheme_Future_Thread_State *fts = scheme_future_thread_state; future_t *future; double tm; @@ -418,11 +402,10 @@ - END_XFORM_SKIP; } Scheme_Object* scheme_rtcall_iSi_s(const char *who, int src_type, prim_iSi_s f, int g74, Scheme_Object** g75, int g76) + XFORM_SKIP_PROC { - START_XFORM_SKIP; Scheme_Future_Thread_State *fts = scheme_future_thread_state; future_t *future; double tm; @@ -444,11 +427,10 @@ future->retval_s = 0; receive_special_result(future, retval); return retval; - END_XFORM_SKIP; } void scheme_rtcall_siS_v(const char *who, int src_type, prim_siS_v f, Scheme_Object* g77, int g78, Scheme_Object** g79) + XFORM_SKIP_PROC { - START_XFORM_SKIP; Scheme_Future_Thread_State *fts = scheme_future_thread_state; future_t *future; double tm; @@ -470,11 +452,10 @@ - END_XFORM_SKIP; } void* scheme_rtcall_z_p(const char *who, int src_type, prim_z_p f, size_t g80) + XFORM_SKIP_PROC { - START_XFORM_SKIP; Scheme_Future_Thread_State *fts = scheme_future_thread_state; future_t *future; double tm; @@ -494,5 +475,4 @@ future->retval_p = 0; return retval; - END_XFORM_SKIP; } diff --git a/src/mzscheme/src/jit_ts_glue.c b/src/mzscheme/src/jit_ts_glue.c deleted file mode 100644 index 8c9bc4b6a1..0000000000 --- a/src/mzscheme/src/jit_ts_glue.c +++ /dev/null @@ -1,240 +0,0 @@ - Scheme_Object* rtcall_siS_s(prim_siS_s f, Scheme_Object* g37, int g38, Scheme_Object** g39) -{ - START_XFORM_SKIP; - future_t *future; - Scheme_Object* retval; - - future = current_ft; - future->arg_s0 = g37; - future->arg_i1 = g38; - future->arg_S2 = g39; - future_do_runtimecall((void*)f, 0, NULL); - future = current_ft; - retval = future->retval_s; - future->prim_data.retval = NULL; - return retval; - END_XFORM_SKIP; -} Scheme_Object* rtcall_s_s(prim_s_s f, Scheme_Object* g40) -{ - START_XFORM_SKIP; - future_t *future; - Scheme_Object* retval; - - future = current_ft; - future->arg_s0 = g40; - future_do_runtimecall((void*)f, 0, NULL); - future = current_ft; - retval = future->retval_s; - future->prim_data.retval = NULL; - return retval; - END_XFORM_SKIP; -} Scheme_Object* rtcall__s(prim__s f, ) -{ - START_XFORM_SKIP; - future_t *future; - Scheme_Object* retval; - - future = current_ft; - - future_do_runtimecall((void*)f, 0, NULL); - future = current_ft; - retval = future->retval_s; - future->prim_data.retval = NULL; - return retval; - END_XFORM_SKIP; -} Scheme_Object* rtcall_ss_s(prim_ss_s f, Scheme_Object* g41, Scheme_Object* g42) -{ - START_XFORM_SKIP; - future_t *future; - Scheme_Object* retval; - - future = current_ft; - future->arg_s0 = g41; - future->arg_s1 = g42; - future_do_runtimecall((void*)f, 0, NULL); - future = current_ft; - retval = future->retval_s; - future->prim_data.retval = NULL; - return retval; - END_XFORM_SKIP; -} Scheme_Object* rtcall_lS_s(prim_lS_s f, long g43, Scheme_Object** g44) -{ - START_XFORM_SKIP; - future_t *future; - Scheme_Object* retval; - - future = current_ft; - future->arg_l0 = g43; - future->arg_S1 = g44; - future_do_runtimecall((void*)f, 0, NULL); - future = current_ft; - retval = future->retval_s; - future->prim_data.retval = NULL; - return retval; - END_XFORM_SKIP; -} Scheme_Object* rtcall_l_s(prim_l_s f, long g45) -{ - START_XFORM_SKIP; - future_t *future; - Scheme_Object* retval; - - future = current_ft; - future->arg_l0 = g45; - future_do_runtimecall((void*)f, 0, NULL); - future = current_ft; - retval = future->retval_s; - future->prim_data.retval = NULL; - return retval; - END_XFORM_SKIP; -} void rtcall_bsi_v(prim_bsi_v f, Scheme_Bucket* g46, Scheme_Object* g47, int g48) -{ - START_XFORM_SKIP; - future_t *future; - void retval; - - future = current_ft; - future->arg_b0 = g46; - future->arg_s1 = g47; - future->arg_i2 = g48; - future_do_runtimecall((void*)f, 0, NULL); - future = current_ft; - retval = future->retval_v; - future->prim_data.retval = NULL; - return retval; - END_XFORM_SKIP; -} Scheme_Object* rtcall_s_s(prim_s_s f, Scheme_Object* g49) -{ - START_XFORM_SKIP; - future_t *future; - Scheme_Object* retval; - - future = current_ft; - future->arg_s0 = g49; - future_do_runtimecall((void*)f, 0, NULL); - future = current_ft; - retval = future->retval_s; - future->prim_data.retval = NULL; - return retval; - END_XFORM_SKIP; -} void rtcall_iiS_v(prim_iiS_v f, int g50, int g51, Scheme_Object** g52) -{ - START_XFORM_SKIP; - future_t *future; - void retval; - - future = current_ft; - future->arg_i0 = g50; - future->arg_i1 = g51; - future->arg_S2 = g52; - future_do_runtimecall((void*)f, 0, NULL); - future = current_ft; - retval = future->retval_v; - future->prim_data.retval = NULL; - return retval; - END_XFORM_SKIP; -} void rtcall_ss_v(prim_ss_v f, Scheme_Object* g53, Scheme_Object* g54) -{ - START_XFORM_SKIP; - future_t *future; - void retval; - - future = current_ft; - future->arg_s0 = g53; - future->arg_s1 = g54; - future_do_runtimecall((void*)f, 0, NULL); - future = current_ft; - retval = future->retval_v; - future->prim_data.retval = NULL; - return retval; - END_XFORM_SKIP; -} void rtcall_b_v(prim_b_v f, Scheme_Bucket* g55) -{ - START_XFORM_SKIP; - future_t *future; - void retval; - - future = current_ft; - future->arg_b0 = g55; - future_do_runtimecall((void*)f, 0, NULL); - future = current_ft; - retval = future->retval_v; - future->prim_data.retval = NULL; - return retval; - END_XFORM_SKIP; -} Scheme_Object* rtcall_sl_s(prim_sl_s f, Scheme_Object* g56, long g57) -{ - START_XFORM_SKIP; - future_t *future; - Scheme_Object* retval; - - future = current_ft; - future->arg_s0 = g56; - future->arg_l1 = g57; - future_do_runtimecall((void*)f, 0, NULL); - future = current_ft; - retval = future->retval_s; - future->prim_data.retval = NULL; - return retval; - END_XFORM_SKIP; -} Scheme_Object* rtcall_iS_s(prim_iS_s f, int g58, Scheme_Object** g59) -{ - START_XFORM_SKIP; - future_t *future; - Scheme_Object* retval; - - future = current_ft; - future->arg_i0 = g58; - future->arg_S1 = g59; - future_do_runtimecall((void*)f, 0, NULL); - future = current_ft; - retval = future->retval_s; - future->prim_data.retval = NULL; - return retval; - END_XFORM_SKIP; -} void rtcall_s_v(prim_s_v f, Scheme_Object* g60) -{ - START_XFORM_SKIP; - future_t *future; - void retval; - - future = current_ft; - future->arg_s0 = g60; - future_do_runtimecall((void*)f, 0, NULL); - future = current_ft; - retval = future->retval_v; - future->prim_data.retval = NULL; - return retval; - END_XFORM_SKIP; -} Scheme_Object* rtcall_iSi_s(prim_iSi_s f, int g61, Scheme_Object** g62, int g63) -{ - START_XFORM_SKIP; - future_t *future; - Scheme_Object* retval; - - future = current_ft; - future->arg_i0 = g61; - future->arg_S1 = g62; - future->arg_i2 = g63; - future_do_runtimecall((void*)f, 0, NULL); - future = current_ft; - retval = future->retval_s; - future->prim_data.retval = NULL; - return retval; - END_XFORM_SKIP; -} void rtcall_siS_v(prim_siS_v f, Scheme_Object* g64, int g65, Scheme_Object** g66) -{ - START_XFORM_SKIP; - future_t *future; - void retval; - - future = current_ft; - future->arg_s0 = g64; - future->arg_i1 = g65; - future->arg_S2 = g66; - future_do_runtimecall((void*)f, 0, NULL); - future = current_ft; - retval = future->retval_v; - future->prim_data.retval = NULL; - return retval; - END_XFORM_SKIP; -} \ No newline at end of file diff --git a/src/mzscheme/src/network.c b/src/mzscheme/src/network.c index eaafaec2ac..30205f60f7 100644 --- a/src/mzscheme/src/network.c +++ b/src/mzscheme/src/network.c @@ -338,11 +338,9 @@ static struct protoent *proto; # define mz_gai_strerror gai_strerror #else # define mzAI_PASSIVE 0 -# ifdef MZ_XFORM -START_XFORM_SKIP; -# endif static int mz_getaddrinfo(const char *nodename, const char *servname, const struct mz_addrinfo *hints, struct mz_addrinfo **res) + XFORM_SKIP_PROC { struct hostent *h; @@ -386,17 +384,16 @@ static int mz_getaddrinfo(const char *nodename, const char *servname, return h_errno; } void mz_freeaddrinfo(struct mz_addrinfo *ai) + XFORM_SKIP_PROC { free(ai->ai_addr); free(ai); } const char *mz_gai_strerror(int ecode) + XFORM_SKIP_PROC { return hstrerror(ecode); } -# ifdef MZ_XFORM -END_XFORM_SKIP; -# endif #endif #if defined(USE_WINSOCK_TCP) || defined(PTHREADS_OK_FOR_GHBN) @@ -441,11 +438,8 @@ HANDLE ready_sema; int ready_fd; # endif -#ifdef MZ_XFORM -START_XFORM_SKIP; -#endif - static long getaddrinfo_in_thread(void *data) + XFORM_SKIP_PROC { int ok; struct mz_addrinfo *res, hints; @@ -487,10 +481,6 @@ static long getaddrinfo_in_thread(void *data) return 1; } -#ifdef MZ_XFORM -END_XFORM_SKIP; -#endif - static void release_ghbn_lock(GHBN_Rec *rec) { ghbn_lock = 0; diff --git a/src/mzscheme/src/numcomp.c b/src/mzscheme/src/numcomp.c index 48744b9129..6e678070d6 100644 --- a/src/mzscheme/src/numcomp.c +++ b/src/mzscheme/src/numcomp.c @@ -150,11 +150,8 @@ void scheme_init_unsafe_numcomp(Scheme_Env *env) /* Prototype needed for 3m conversion: */ static MZ_INLINE Scheme_Object *force_rat(Scheme_Object *n, Small_Rational *sr); -#ifdef MZ_XFORM -START_XFORM_SKIP; -#endif - static MZ_INLINE Scheme_Object *force_rat(Scheme_Object *n, Small_Rational *sr) + XFORM_SKIP_PROC { Scheme_Type t = SCHEME_TYPE(n); if (t == scheme_rational_type) @@ -163,10 +160,6 @@ static MZ_INLINE Scheme_Object *force_rat(Scheme_Object *n, Small_Rational *sr) return scheme_make_small_bn_rational(n, sr); } -#ifdef MZ_XFORM -END_XFORM_SKIP; -#endif - GEN_NARY_COMP(eq, "=", scheme_bin_eq, SCHEME_NUMBERP, "number") GEN_NARY_COMP(lt, "<", scheme_bin_lt, SCHEME_REALP, REAL_NUMBER_STR) GEN_NARY_COMP(gt, ">", scheme_bin_gt, SCHEME_REALP, REAL_NUMBER_STR) diff --git a/src/mzscheme/src/port.c b/src/mzscheme/src/port.c index 35bfb7f79e..be14d99b34 100644 --- a/src/mzscheme/src/port.c +++ b/src/mzscheme/src/port.c @@ -206,11 +206,8 @@ static int *malloc_refcount() return (int *)malloc(sizeof(int)); } -#ifdef MZ_XFORM -START_XFORM_SKIP; -#endif - static int dec_refcount(int *refcount) + XFORM_SKIP_PROC { int rc; @@ -227,10 +224,6 @@ static int dec_refcount(int *refcount) return rc; } -#ifdef MZ_XFORM -END_XFORM_SKIP; -#endif - #else static int *malloc_refcount() @@ -693,11 +686,8 @@ static int dynamic_fd_size; # define STORED_ACTUAL_FDSET_LIMIT # define FDSET_LIMIT(fd) (*(int *)((char *)fd XFORM_OK_PLUS dynamic_fd_size)) -#ifdef MZ_XFORM -START_XFORM_SKIP; -#endif - void *scheme_alloc_fdset_array(int count, int permanent) + XFORM_SKIP_PROC { /* Note: alloc only at the end, because this function isn't annotated. We skip annotation so that it's @@ -722,10 +712,6 @@ void *scheme_alloc_fdset_array(int count, int permanent) return scheme_malloc_atomic(count * (dynamic_fd_size + sizeof(long))); } -#ifdef MZ_XFORM -END_XFORM_SKIP; -#endif - void *scheme_init_fdset_array(void *fdarray, int count) { return fdarray; @@ -1184,11 +1170,8 @@ void scheme_remember_subthread(struct Scheme_Thread_Memory *tm, void *t) tm->subhandle = t; } -#ifdef MZ_XFORM -START_XFORM_SKIP; -#endif - void scheme_forget_thread(struct Scheme_Thread_Memory *tm) + XFORM_SKIP_PROC { if (tm->prev) tm->prev->next = tm->next; @@ -1207,11 +1190,13 @@ void scheme_forget_thread(struct Scheme_Thread_Memory *tm) } void scheme_forget_subthread(struct Scheme_Thread_Memory *tm) + XFORM_SKIP_PROC { tm->subhandle = NULL; } void scheme_suspend_remembered_threads(void) + XFORM_SKIP_PROC { Scheme_Thread_Memory *tm, *next, *prev = NULL; int keep; @@ -1249,6 +1234,7 @@ void scheme_suspend_remembered_threads(void) } void scheme_resume_remembered_threads(void) + XFORM_SKIP_PROC { Scheme_Thread_Memory *tm; @@ -1259,10 +1245,6 @@ void scheme_resume_remembered_threads(void) } } -#ifdef MZ_XFORM -END_XFORM_SKIP; -#endif - #endif /*========================================================================*/ @@ -5442,11 +5424,8 @@ make_fd_input_port(int fd, Scheme_Object *name, int regfile, int win_textmode, i # ifdef WINDOWS_FILE_HANDLES -#ifdef MZ_XFORM -START_XFORM_SKIP; -#endif - static long WindowsFDReader(Win_FD_Input_Thread *th) + XFORM_SKIP_PROC { DWORD toget, got; int perma_eof = 0; @@ -5502,6 +5481,7 @@ static long WindowsFDReader(Win_FD_Input_Thread *th) } static void WindowsFDICleanup(Win_FD_Input_Thread *th) + XFORM_SKIP_PROC { int rc; @@ -5516,10 +5496,6 @@ static void WindowsFDICleanup(Win_FD_Input_Thread *th) free(th); } -#ifdef MZ_XFORM -END_XFORM_SKIP; -#endif - # endif #endif @@ -6649,11 +6625,8 @@ static void flush_if_output_fds(Scheme_Object *o, Scheme_Close_Custodian_Client #ifdef WINDOWS_FILE_HANDLES -#ifdef MZ_XFORM -START_XFORM_SKIP; -#endif - static long WindowsFDWriter(Win_FD_Output_Thread *oth) + XFORM_SKIP_PROC { DWORD towrite, wrote, start; int ok, more_work = 0, err_no; @@ -6717,6 +6690,7 @@ static long WindowsFDWriter(Win_FD_Output_Thread *oth) } static void WindowsFDOCleanup(Win_FD_Output_Thread *oth) + XFORM_SKIP_PROC { int rc; @@ -6732,10 +6706,6 @@ static void WindowsFDOCleanup(Win_FD_Output_Thread *oth) free(oth); } -#ifdef MZ_XFORM -END_XFORM_SKIP; -#endif - #endif #endif @@ -6827,11 +6797,8 @@ static int MyPipe(int *ph, int near_index) { static int need_to_check_children; -#ifdef MZ_XFORM -START_XFORM_SKIP; -#endif - void scheme_block_child_signals(int block) + XFORM_SKIP_PROC { sigset_t sigs; @@ -6844,6 +6811,7 @@ void scheme_block_child_signals(int block) } static void child_done(int ingored) + XFORM_SKIP_PROC { need_to_check_children = 1; scheme_signal_received(); @@ -6853,10 +6821,6 @@ static void child_done(int ingored) # endif } -#ifdef MZ_XFORM -END_XFORM_SKIP; -#endif - static int sigchld_installed = 0; static void init_sigchld(void) @@ -8115,16 +8079,12 @@ void scheme_notify_sleep_progress() /******************** Main sleep function *****************/ /* The simple select() stuff is buried in Windows complexity. */ +static void default_sleep(float v, void *fds) +#ifdef OS_X + XFORM_SKIP_PROC +#endif /* This sleep function is not allowed to allocate in OS X, because it is called in a non-main thread. */ - -#ifdef OS_X -# ifdef MZ_XFORM -START_XFORM_SKIP; -# endif -#endif - -static void default_sleep(float v, void *fds) { /* REMEMBER: don't allocate in this function (at least not GCable memory) for OS X. Not that FD setups are ok, because they use @@ -8359,17 +8319,8 @@ static void default_sleep(float v, void *fds) #endif } -#ifdef OS_X -# ifdef MZ_XFORM -END_XFORM_SKIP; -# endif -#endif - -#ifdef MZ_XFORM -START_XFORM_SKIP; -#endif - void scheme_signal_received_at(void *h) + XFORM_SKIP_PROC /* Ensure that MzScheme wakes up if asleep. */ { #if defined(FILES_HAVE_FDS) @@ -8387,6 +8338,7 @@ void scheme_signal_received_at(void *h) } void *scheme_get_signal_handle() + XFORM_SKIP_PROC { #if defined(FILES_HAVE_FDS) return &put_external_event_fd; @@ -8400,14 +8352,11 @@ void *scheme_get_signal_handle() } void scheme_signal_received(void) + XFORM_SKIP_PROC { scheme_signal_received_at(scheme_get_signal_handle()); } -#ifdef MZ_XFORM -END_XFORM_SKIP; -#endif - int scheme_get_external_event_fd(void) { #if defined(FILES_HAVE_FDS) @@ -8423,11 +8372,8 @@ static HANDLE itimer; static OS_SEMAPHORE_TYPE itimer_semaphore; static long itimer_delay; -#ifdef MZ_XFORM -START_XFORM_SKIP; -#endif - static long ITimer(void) + XFORM_SKIP_PROC { WaitForSingleObject(itimer_semaphore, INFINITE); @@ -8440,10 +8386,6 @@ static long ITimer(void) } } -#ifdef MZ_XFORM -END_XFORM_SKIP; -#endif - static void scheme_start_itimer_thread(long usec) { DWORD id; @@ -8477,11 +8419,8 @@ typedef struct ITimer_Data { THREAD_LOCAL_DECL(static ITimer_Data *itimerdata); -#ifdef MZ_XFORM -START_XFORM_SKIP; -#endif - static void *green_thread_timer(void *data) + XFORM_SKIP_PROC { ITimer_Data *itimer_data; itimer_data = (ITimer_Data *)data; @@ -8510,10 +8449,6 @@ static void *green_thread_timer(void *data) return NULL; } -#ifdef MZ_XFORM -END_XFORM_SKIP; -#endif - static void start_green_thread_timer(long usec) { itimerdata->die = 0; @@ -8581,11 +8516,8 @@ static void scheme_start_itimer_thread(long usec) #ifdef USE_ITIMER -#ifdef MZ_XFORM -START_XFORM_SKIP; -#endif - static void itimer_expired(int ignored) + XFORM_SKIP_PROC { scheme_fuel_counter = 0; scheme_jit_stack_boundary = (unsigned long)-1; @@ -8594,7 +8526,9 @@ static void itimer_expired(int ignored) # endif } -static void kickoff_itimer(long usec) { +static void kickoff_itimer(long usec) + XFORM_SKIP_PROC +{ struct itimerval t; struct itimerval old; static int itimer_handler_installed = 0; @@ -8612,10 +8546,6 @@ static void kickoff_itimer(long usec) { setitimer(ITIMER_PROF, &t, &old); } -#ifdef MZ_XFORM -END_XFORM_SKIP; -#endif - #endif void scheme_kickoff_green_thread_time_slice_timer(long usec) { diff --git a/src/mzscheme/src/print.c b/src/mzscheme/src/print.c index 90c2c3608d..6a960455ea 100644 --- a/src/mzscheme/src/print.c +++ b/src/mzscheme/src/print.c @@ -534,16 +534,13 @@ static int check_cycles(Scheme_Object *obj, int for_write, Scheme_Hash_Table *ht return 0; } -#ifdef MZ_XFORM -START_XFORM_SKIP; -#endif - /* The fast cycle-checker plays a dangerous game: it changes type tags. No GCs can occur here, and no thread switches. If the fast version takes to long, we back out to the general case. (We don't even check for stack overflow, so keep the max limit low.) */ static int check_cycles_fast(Scheme_Object *obj, PrintParams *pp, int *fast_checker_counter) + XFORM_SKIP_PROC { Scheme_Type t; int cycle = 0; @@ -618,10 +615,6 @@ static int check_cycles_fast(Scheme_Object *obj, PrintParams *pp, int *fast_chec return cycle; } -#ifdef MZ_XFORM -END_XFORM_SKIP; -#endif - #ifdef DO_STACK_CHECK static void setup_graph_table(Scheme_Object *obj, int for_write, Scheme_Hash_Table *ht, int *counter, PrintParams *pp); diff --git a/src/mzscheme/src/rational.c b/src/mzscheme/src/rational.c index 85ea6d30f2..34a0a1db5c 100644 --- a/src/mzscheme/src/rational.c +++ b/src/mzscheme/src/rational.c @@ -56,11 +56,8 @@ Scheme_Object *scheme_integer_to_rational(const Scheme_Object *n) return make_rational(n, one, 0); } -#ifdef MZ_XFORM -START_XFORM_SKIP; -#endif - Scheme_Object *scheme_make_small_rational(long n, Small_Rational *s) + XFORM_SKIP_PROC { s->so.type = scheme_rational_type; s->num = scheme_make_integer(n); @@ -70,6 +67,7 @@ Scheme_Object *scheme_make_small_rational(long n, Small_Rational *s) } Scheme_Object *scheme_make_small_bn_rational(Scheme_Object *n, Small_Rational *s) + XFORM_SKIP_PROC { s->so.type = scheme_rational_type; s->num = n; @@ -78,10 +76,6 @@ Scheme_Object *scheme_make_small_bn_rational(Scheme_Object *n, Small_Rational *s return (Scheme_Object *)s; } -#ifdef MZ_XFORM -END_XFORM_SKIP; -#endif - int scheme_is_rational_positive(const Scheme_Object *o) { Scheme_Rational *r = (Scheme_Rational *)o; diff --git a/src/mzscheme/src/salloc.c b/src/mzscheme/src/salloc.c index 96f0315564..87e4dc715e 100644 --- a/src/mzscheme/src/salloc.c +++ b/src/mzscheme/src/salloc.c @@ -178,11 +178,7 @@ static int do_main_stack_setup(int no_auto_statics, Scheme_Nested_Main _main, vo return return_code; } -#ifdef MZ_PRECISE_GC -START_XFORM_SKIP; -#endif - -int scheme_main_stack_setup(int no_auto_statics, Scheme_Nested_Main _main, void *data) +int scheme_main_stack_setup(int no_auto_statics, Scheme_Nested_Main _main, void *data) XFORM_SKIP_PROC { #ifdef IMPLEMENT_THREAD_LOCAL_VIA_PTHREADS # ifdef INLINE_GETSPECIFIC_ASSEMBLY_CODE @@ -233,10 +229,6 @@ int scheme_main_stack_setup(int no_auto_statics, Scheme_Nested_Main _main, void return do_main_stack_setup(no_auto_statics, _main, data); } -#ifdef MZ_PRECISE_GC -END_XFORM_SKIP; -#endif - void scheme_set_stack_bounds(void *base, void *deepest, int no_auto_statics) { scheme_set_stack_base(base, no_auto_statics); @@ -283,10 +275,7 @@ extern void GC_attach_current_thread_exceptions_to_handler(); # endif #endif -#ifdef MZ_XFORM -START_XFORM_SKIP; -#endif -void scheme_init_os_thread() +void scheme_init_os_thread() XFORM_SKIP_PROC { #ifdef IMPLEMENT_THREAD_LOCAL_VIA_PTHREADS Thread_Local_Variables *vars; @@ -300,9 +289,6 @@ void scheme_init_os_thread() # endif #endif } -#ifdef MZ_XFORM -END_XFORM_SKIP; -#endif /************************************************************************/ /* memory utils */ @@ -577,11 +563,7 @@ void *scheme_malloc_uncollectable(size_t size_in_bytes) } #endif -#ifdef MZ_XFORM -START_XFORM_SKIP; -#endif - -void scheme_register_static(void *ptr, long size) +void scheme_register_static(void *ptr, long size) XFORM_SKIP_PROC { #if defined(MZ_PRECISE_GC) || defined(USE_SENORA_GC) /* Always register for precise and Senora GC: */ @@ -595,10 +577,6 @@ void scheme_register_static(void *ptr, long size) #endif } -#ifdef MZ_XFORM -END_XFORM_SKIP; -#endif - #ifdef USE_TAGGED_ALLOCATION struct GC_Set *tagged, *real_tagged, *tagged_atomic, *tagged_eternal, *tagged_uncollectable, *stacks, *envunbox; diff --git a/src/mzscheme/src/setjmpup.c b/src/mzscheme/src/setjmpup.c index 90807ca0d1..f5d8063249 100644 --- a/src/mzscheme/src/setjmpup.c +++ b/src/mzscheme/src/setjmpup.c @@ -221,9 +221,8 @@ 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; - void scheme_flush_stack_copy_cache(void) + XFORM_SKIP_PROC { int i; for (i = 0; i < STACK_COPY_CACHE_SIZE; i++) { @@ -232,8 +231,6 @@ void scheme_flush_stack_copy_cache(void) } } -END_XFORM_SKIP; - #endif /**********************************************************************/ diff --git a/src/mzscheme/src/thread.c b/src/mzscheme/src/thread.c index 96e72532a9..780af68acb 100644 --- a/src/mzscheme/src/thread.c +++ b/src/mzscheme/src/thread.c @@ -1550,14 +1550,11 @@ Scheme_Thread *scheme_do_close_managed(Scheme_Custodian *m, Scheme_Exit_Closer_F return kill_self; } -#ifdef MZ_XFORM -START_XFORM_SKIP; -#endif - typedef void (*Scheme_For_Each_Func)(Scheme_Object *); static void for_each_managed(Scheme_Type type, Scheme_For_Each_Func cf) - /* This function must not allocate. */ + XFORM_SKIP_PROC +/* This function must not allocate. */ { Scheme_Custodian *m; int i; @@ -1600,10 +1597,6 @@ static void for_each_managed(Scheme_Type type, Scheme_For_Each_Func cf) } } -#ifdef MZ_XFORM -END_XFORM_SKIP; -#endif - void scheme_close_managed(Scheme_Custodian *m) /* The trick is that we may need to kill the thread that is running us. If so, delay it to the very @@ -2436,11 +2429,8 @@ void *scheme_tls_get(int pos) return p->user_tls[pos]; } -#ifdef MZ_XFORM -START_XFORM_SKIP; -#endif - Scheme_Object **scheme_alloc_runstack(long len) + XFORM_SKIP_PROC { #ifdef MZ_PRECISE_GC long sz; @@ -2458,6 +2448,7 @@ Scheme_Object **scheme_alloc_runstack(long len) } void scheme_set_runstack_limits(Scheme_Object **rs, long len, long start, long end) + XFORM_SKIP_PROC /* With 3m, we can tell the GC not to scan the unused parts, and we can have the fixup function zero out the unused parts; that avoids writing and scanning pages that could be skipped for a minor @@ -2474,10 +2465,6 @@ void scheme_set_runstack_limits(Scheme_Object **rs, long len, long start, long e #endif } -#ifdef MZ_XFORM -END_XFORM_SKIP; -#endif - /*========================================================================*/ /* thread creation and swapping */ /*========================================================================*/ @@ -6842,11 +6829,8 @@ static Scheme_Object *current_thread_initial_stack_size(int argc, Scheme_Object /* namespaces */ /*========================================================================*/ -#ifdef MZ_XFORM -START_XFORM_SKIP; -#endif - Scheme_Env *scheme_get_env(Scheme_Config *c) + XFORM_SKIP_PROC { Scheme_Object *o; @@ -6857,10 +6841,6 @@ Scheme_Env *scheme_get_env(Scheme_Config *c) return (Scheme_Env *)o; } -#ifdef MZ_XFORM -END_XFORM_SKIP; -#endif - void scheme_add_namespace_option(Scheme_Object *key, void (*f)(Scheme_Env *)) { Scheme_NSO *old = namespace_options;