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

convert START_XFORM_SKIP...END_XFORM_SKIP mostly to XFORM_SKIP_PROC

Browse Source 
svn: r16972
This commit is contained in:
Matthew Flatt 2009-11-22 23:30:21 +00:00
parent 6395be3347
commit 78578a3eab
21 changed files with 165 additions and 635 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -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)

11
collects/scribblings/inside/memory.scrbl
View File

@ -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.

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

@ -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 /**/

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

@ -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;

9
src/mzscheme/src/complex.c
View File

@ -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;

9
src/mzscheme/src/dynext.c
View File

@ -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);

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

@ -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

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

@ -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;
}
/**********************************************************************/

6
src/mzscheme/src/gen-jit-ts.ss
View File

@ -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))

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

@ -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

60
src/mzscheme/src/jit_ts_def.c
View File

@ -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; \
}

60
src/mzscheme/src/jit_ts_future_glue.c
View File

@ -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;
}

240
src/mzscheme/src/jit_ts_glue.c
View File

@ -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;
}

18
src/mzscheme/src/network.c
View File

@ -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;

9
src/mzscheme/src/numcomp.c
View File

@ -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)

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

@ -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) {

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

@ -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);

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

@ -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;

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

@ -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;

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

@ -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
/**********************************************************************/

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

@ -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;