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

cover all functions called form JIT that need to go back to runtime thread

Browse Source 
svn: r16898
This commit is contained in:
Matthew Flatt 2009-11-19 21:56:17 +00:00
parent 8d96441673
commit eb9eeda873
14 changed files with 1482 additions and 513 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -92,6 +92,7 @@ typedef struct Thread_Local_Variables {
unsigned long scheme_stack_boundary_;
unsigned long volatile scheme_jit_stack_boundary_;
volatile int scheme_future_need_gc_pause_;
int scheme_use_rtcall_;
struct Scheme_Object *quick_stx_;
int scheme_continuation_application_count_;
int scheme_cont_capture_count_;
@ -255,6 +256,7 @@ XFORM_GC_VARIABLE_STACK_THROUGH_THREAD_LOCAL;
#define scheme_stack_boundary XOA (scheme_get_thread_local_variables()->scheme_stack_boundary_)
#define scheme_jit_stack_boundary XOA (scheme_get_thread_local_variables()->scheme_jit_stack_boundary_)
#define scheme_future_need_gc_pause XOA (scheme_get_thread_local_variables()->scheme_future_need_gc_pause_)
#define scheme_use_rtcall XOA (scheme_get_thread_local_variables()->scheme_use_rtcall_)
#define quick_stx XOA (scheme_get_thread_local_variables()->quick_stx_)
#define scheme_continuation_application_count XOA (scheme_get_thread_local_variables()->scheme_continuation_application_count_)
#define scheme_cont_capture_count XOA (scheme_get_thread_local_variables()->scheme_cont_capture_count_)

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

@ -272,7 +272,8 @@ fun.@LTO@: $(COMMON_HEADERS) \
$(srcdir)/../src/stypes.h $(srcdir)/mzmark.c $(srcdir)/schmap.inc \
$(srcdir)/future.h
future.@LTO@: $(srcdir)/schpriv.h $(srcdir)/future.h $(SCONFIG) $(srcdir)/../include/scheme.h \
$(srcdir)/../src/stypes.h $(srcdir)/mzmark.c
$(srcdir)/../src/stypes.h $(srcdir)/mzmark.c \
$(srcdir)/jit_ts_future_glue.c $(srcdir)/jit_ts_runtime_glue.c $(srcdir)/jit_ts_protos.h
hash.@LTO@: $(COMMON_HEADERS) \
$(srcdir)/../src/stypes.h $(srcdir)/mzmark.c
jit.@LTO@: $(COMMON_HEADERS) \
@ -285,7 +286,7 @@ jit.@LTO@: $(COMMON_HEADERS) \
$(srcdir)/lightning/ppc/asm.h $(srcdir)/lightning/ppc/asm-common.h \
$(srcdir)/lightning/ppc/funcs.h $(srcdir)/lightning/ppc/funcs-common.h \
$(srcdir)/lightning/ppc/fp.h $(srcdir)/lightning/ppc/fp-common.h \
$(srcdir)/future.h
$(srcdir)/future.h $(srcdir)/jit_ts.c $(srcdir)/jit_ts_protos.h
list.@LTO@: $(COMMON_HEADERS) \
$(srcdir)/../src/stypes.h
module.@LTO@: $(COMMON_HEADERS) \

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

@ -61,8 +61,8 @@ static unsigned long g_cur_cpu_mask = 1;
static void *g_signal_handle = NULL;
static struct NewGC *g_shared_GC;
future_t *g_future_queue = NULL;
future_t *g_future_waiting_atomic = NULL;
static future_t *g_future_queue = NULL;
static future_t *g_future_waiting_atomic = NULL;
int g_next_futureid = 0;
pthread_t g_rt_threadid = 0;
@ -86,13 +86,15 @@ static void **g_jit_future_storage;
static int *gc_counter_ptr;
THREAD_LOCAL_DECL(static int worker_gc_counter);
#ifdef MZ_PRECISE_GC
static void register_traversers(void);
#endif
extern void scheme_on_demand_generate_lambda(Scheme_Native_Closure *nc, int argc, Scheme_Object **argv);
static void start_gc_not_ok(int with_lock);
static void end_gc_not_ok(future_t *ft, int with_lock);
static int future_do_runtimecall(void *func, int is_atomic, void *retval);
static void future_do_runtimecall(void *func, int is_atomic);
THREAD_LOCAL_DECL(static future_t *current_ft);
@ -110,7 +112,6 @@ static void *worker_thread_future_loop(void *arg);
static void invoke_rtcall(future_t *future);
static future_t *enqueue_future(future_t *ft);;
static future_t *get_pending_future(void);
static future_t *get_my_future(void);
static future_t *get_last_future(void);
#else
//Garbage stubs for unit testing
@ -549,7 +550,7 @@ int future_ready(Scheme_Object *obj)
int ret = 0;
future_t *ft = (future_t*)obj;
pthread_mutex_lock(&g_future_queue_mutex);
if (ft->work_completed || ft->rt_prim != NULL)
if (ft->work_completed || ft->rt_prim)
{
ret = 1;
}
@ -630,7 +631,7 @@ Scheme_Object *touch(int argc, Scheme_Object *argv[])
g_num_avail_threads++;
pthread_mutex_unlock(&g_future_queue_mutex);
}
else if (ft->rt_prim != NULL)
else if (ft->rt_prim)
{
//Invoke the primitive and stash the result
//Release the lock so other threads can manipulate the queue
@ -683,6 +684,8 @@ void *worker_thread_future_loop(void *arg)
pthread_cond_init(&worker_can_continue_cv, NULL);
scheme_use_rtcall = 1;
scheme_fuel_counter = 1;
scheme_jit_stack_boundary = ((unsigned long)&v) - INITIAL_C_STACK_SIZE;
@ -795,12 +798,8 @@ void scheme_check_future_work()
//i.e. if we are already running on the runtime thread. Otherwise returns
//1, and 'retval' is set to point to the return value of the runtime
//call invocation.
int future_do_runtimecall(
void *func,
int is_atomic,
//int sigtype,
//void *args,
void *retval)
void future_do_runtimecall(void *func,
int is_atomic)
/* Called in future thread */
{
START_XFORM_SKIP;
@ -813,7 +812,7 @@ int future_do_runtimecall(
{
//Should never get here! This check should be done
//by the caller using the macros defined in scheme-futures.h!
return 0;
return;
}
//Fetch the future descriptor for this thread
@ -829,6 +828,7 @@ int future_do_runtimecall(
//will use this value to temporarily swap its stack
//for the worker thread's
future->runstack = MZ_RUNSTACK;
future->prim_func = func;
future->rt_prim = 1;
future->rt_prim_is_atomic = is_atomic;
@ -853,7 +853,6 @@ int future_do_runtimecall(
pthread_mutex_unlock(&g_future_queue_mutex);
return 1;
END_XFORM_SKIP;
}
@ -861,244 +860,43 @@ int future_do_runtimecall(
/**********************************************************************/
/* Functions for primitive invocation */
/**********************************************************************/
int rtcall_void_void_3args(void (*f)())
void rtcall_void_void_3args(void (*f)())
/* Called in future thread */
{
START_XFORM_SKIP;
future_t *future;
prim_data_t data;
if (!IS_WORKER_THREAD)
{
return 0;
}
current_ft->prim_protocol = SIG_VOID_VOID_3ARGS;
memset(&data, 0, sizeof(prim_data_t));
data.void_void_3args = f;
data.sigtype = SIG_VOID_VOID_3ARGS;
future_do_runtimecall((void*)f, 1);
future = current_ft;
future->prim_data = data;
future_do_runtimecall((void*)f, 1, NULL);
future = current_ft;
return 1;
END_XFORM_SKIP;
}
int rtcall_alloc_void_pvoid(void (*f)(), void **retval)
void *rtcall_alloc_void_pvoid(void (*f)())
/* Called in future thread */
{
START_XFORM_SKIP;
future_t *future;
prim_data_t data;
if (!IS_WORKER_THREAD)
{
return 0;
}
void *retval;
while (1) {
memset(&data, 0, sizeof(prim_data_t));
current_ft->prim_protocol = SIG_ALLOC_VOID_PVOID;
data.alloc_void_pvoid = f;
data.sigtype = SIG_ALLOC_VOID_PVOID;
future_do_runtimecall((void*)f, 1);
future = current_ft;
future->prim_data = data;
future_do_runtimecall((void*)f, 1, NULL);
future = current_ft;
*retval = future->alloc_retval;
retval = future->alloc_retval;
future->alloc_retval = NULL;
if (*gc_counter_ptr == future->alloc_retval_counter)
break;
}
return 1;
return retval;
END_XFORM_SKIP;
}
int rtcall_obj_int_pobj_obj(
prim_obj_int_pobj_obj_t f,
Scheme_Object *rator,
int argc,
Scheme_Object **argv,
Scheme_Object **retval)
/* Called in future thread */
{
START_XFORM_SKIP;
future_t *future;
prim_data_t data;
if (!IS_WORKER_THREAD)
{
return 0;
}
memset(&data, 0, sizeof(prim_data_t));
#ifdef DEBUG_FUTURES
printf("scheme_fuel_counter = %d\n", scheme_fuel_counter);
printf("scheme_jit_stack_boundary = %p\n", (void*)scheme_jit_stack_boundary);
printf("scheme_current_runstack = %p\n", scheme_current_runstack);
printf("scheme_current_runstack_start = %p\n", scheme_current_runstack_start);
printf("stack address = %p\n", &future);
#endif
data.obj_int_pobj_obj = f;
data.p = rator;
data.argc = argc;
data.argv = argv;
data.sigtype = SIG_OBJ_INT_POBJ_OBJ;
future = current_ft;
future->prim_data = data;
future_do_runtimecall((void*)f, 0, NULL);
future = current_ft;
*retval = future->prim_data.retval;
future->prim_data.retval = NULL;
return 1;
END_XFORM_SKIP;
}
int rtcall_int_pobj_obj(
prim_int_pobj_obj_t f,
int argc,
Scheme_Object **argv,
Scheme_Object **retval)
/* Called in future thread */
{
START_XFORM_SKIP;
future_t *future;
prim_data_t data;
if (!IS_WORKER_THREAD)
{
return 0;
}
memset(&data, 0, sizeof(prim_data_t));
#ifdef DEBUG_FUTURES
printf("scheme_fuel_counter = %d\n", scheme_fuel_counter);
printf("scheme_jit_stack_boundary = %p\n", (void*)scheme_jit_stack_boundary);
printf("scheme_current_runstack = %p\n", scheme_current_runstack);
printf("scheme_current_runstack_start = %p\n", scheme_current_runstack_start);
printf("stack address = %p\n", &future);
#endif
data.int_pobj_obj = f;
data.argc = argc;
data.argv = argv;
data.sigtype = SIG_INT_OBJARR_OBJ;
future = current_ft;
future->prim_data = data;
future_do_runtimecall((void*)f, 0, NULL);
future = current_ft;
*retval = future->prim_data.retval;
future->prim_data.retval = NULL;
return 1;
END_XFORM_SKIP;
}
int rtcall_pvoid_pvoid_pvoid(
prim_pvoid_pvoid_pvoid_t f,
void *a,
void *b,
void **retval)
/* Called in future thread */
{
START_XFORM_SKIP;
future_t *future;
prim_data_t data;
if (!IS_WORKER_THREAD)
{
return 0;
}
memset(&data, 0, sizeof(prim_data_t));
#ifdef DEBUG_FUTURES
printf("scheme_fuel_counter = %d\n", scheme_fuel_counter);
printf("scheme_jit_stack_boundary = %p\n", (void*)scheme_jit_stack_boundary);
printf("scheme_current_runstack = %p\n", scheme_current_runstack);
printf("scheme_current_runstack_start = %p\n", scheme_current_runstack_start);
printf("stack address = %p\n", &future);
#endif
data.pvoid_pvoid_pvoid = f;
data.a = a;
data.b = b;
data.sigtype = SIG_PVOID_PVOID_PVOID;
future = current_ft;
future->prim_data = data;
future_do_runtimecall((void*)f, 0, NULL);
future = current_ft;
*retval = future->prim_data.c;
return 1;
END_XFORM_SKIP;
}
int rtcall_int_pobj_obj_obj(
prim_int_pobj_obj_obj_t f,
int argc,
Scheme_Object **argv,
Scheme_Object *p,
Scheme_Object **retval)
/* Called in future thread */
{
START_XFORM_SKIP;
future_t *future;
prim_data_t data;
if (!IS_WORKER_THREAD)
{
return 0;
}
memset(&data, 0, sizeof(prim_data_t));
#ifdef DEBUG_FUTURES
printf("scheme_fuel_counter = %d\n", scheme_fuel_counter);
printf("scheme_jit_stack_boundary = %p\n", (void*)scheme_jit_stack_boundary);
printf("scheme_current_runstack = %p\n", scheme_current_runstack);
printf("scheme_current_runstack_start = %p\n", scheme_current_runstack_start);
printf("stack address = %p\n", &future);
#endif
data.int_pobj_obj_obj = f;
data.argc = argc;
data.argv = argv;
data.p = p;
data.sigtype = SIG_INT_POBJ_OBJ_OBJ;
future = current_ft;
future->prim_data = data;
future_do_runtimecall((void*)f, 0, NULL);
future = current_ft;
*retval = future->prim_data.retval;
future->prim_data.retval = NULL;
return 1;
END_XFORM_SKIP;
}
#include "jit_ts_future_glue.c"
//Does the work of actually invoking a primitive on behalf of a
//future. This function is always invoked on the main (runtime)
@ -1112,11 +910,11 @@ void invoke_rtcall(future_t *future)
future->rt_prim = 0;
switch (future->prim_data.sigtype)
switch (future->prim_protocol)
{
case SIG_VOID_VOID_3ARGS:
{
prim_void_void_3args_t func = future->prim_data.void_void_3args;
prim_void_void_3args_t func = (prim_void_void_3args_t)future->prim_func;
func(future->runstack);
@ -1125,77 +923,17 @@ void invoke_rtcall(future_t *future)
case SIG_ALLOC_VOID_PVOID:
{
void *ret;
prim_alloc_void_pvoid_t func = future->prim_data.alloc_void_pvoid;
prim_alloc_void_pvoid_t func = (prim_alloc_void_pvoid_t)future->prim_func;
ret = func();
future->alloc_retval = ret;
ret = NULL;
future->alloc_retval_counter = scheme_did_gc_count;
break;
}
case SIG_OBJ_INT_POBJ_OBJ:
{
Scheme_Object *ret;
prim_obj_int_pobj_obj_t func = future->prim_data.obj_int_pobj_obj;
ret = func(
future->prim_data.p,
future->prim_data.argc,
future->prim_data.argv);
future->prim_data.retval = ret;
/*future->prim_data.retval = future->prim_data.prim_obj_int_pobj_obj(
future->prim_data.p,
future->prim_data.argc,
future->prim_data.argv); */
break;
}
case SIG_INT_OBJARR_OBJ:
{
Scheme_Object *ret;
prim_int_pobj_obj_t func = future->prim_data.int_pobj_obj;
ret = func(
future->prim_data.argc,
future->prim_data.argv);
future->prim_data.retval = ret;
/*future->prim_data.retval = future->prim_data.prim_int_pobj_obj(
future->prim_data.argc,
future->prim_data.argv);
*/
break;
}
case SIG_INT_POBJ_OBJ_OBJ:
{
Scheme_Object *ret;
prim_int_pobj_obj_obj_t func = future->prim_data.int_pobj_obj_obj;
ret = func(
future->prim_data.argc,
future->prim_data.argv,
future->prim_data.p);
future->prim_data.retval = ret;
/*future->prim_data.retval = future->prim_data.prim_int_pobj_obj_obj(
future->prim_data.argc,
future->prim_data.argv,
future->prim_data.p);
*/
break;
}
case SIG_PVOID_PVOID_PVOID:
{
void *pret = NULL;
prim_pvoid_pvoid_pvoid_t func = future->prim_data.pvoid_pvoid_pvoid;
pret = func(future->prim_data.a, future->prim_data.b);
future->prim_data.c = pret;
/*future->prim_data.c = future->prim_data.prim_pvoid_pvoid_pvoid(
future->prim_data.a,
future->prim_data.b);
*/
break;
}
# include "jit_ts_runtime_glue.c"
default:
scheme_signal_error("unknown protocol %d", future->prim_protocol);
break;
}
pthread_mutex_lock(&g_future_queue_mutex);

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

@ -38,39 +38,12 @@ typedef Scheme_Object* (*prim_int_pobj_obj_t)(int, Scheme_Object**);
typedef Scheme_Object* (*prim_int_pobj_obj_obj_t)(int, Scheme_Object**, Scheme_Object*);
typedef void* (*prim_pvoid_pvoid_pvoid_t)(void*, void*);
typedef struct {
unsigned int sigtype;
prim_void_void_3args_t void_void_3args;
prim_alloc_void_pvoid_t alloc_void_pvoid;
prim_obj_int_pobj_obj_t obj_int_pobj_obj;
prim_int_pobj_obj_t int_pobj_obj;
prim_int_pobj_obj_obj_t int_pobj_obj_obj;
prim_pvoid_pvoid_pvoid_t pvoid_pvoid_pvoid;
//Scheme_Object* (*prim_obj_int_pobj_obj)(Scheme_Object* rator, int argc, Scheme_Object** argv);
//Scheme_Object* (*prim_int_pobj_obj)(int argc, Scheme_Object** argv);
//Scheme_Object* (*prim_int_pobj_obj_obj)(int argc, Scheme_Object** argv, Scheme_Object* p);
//void (*prim_void_void)(void);
//void* (*prim_pvoid_pvoid_pvoid)(void *a, void *b);
Scheme_Object *p;
int argc;
Scheme_Object **argv;
Scheme_Object *retval;
void *a;
void *b;
void *c;
} prim_data_t;
#define PENDING 0
#define RUNNING 1
#define WAITING_FOR_PRIM 2
#define FINISHED 3
typedef struct future {
typedef struct future_t {
Scheme_Object so;
int id;
@ -89,14 +62,32 @@ typedef struct future {
int rt_prim; /* flag to indicate waiting for a prim call */
int rt_prim_is_atomic;
prim_data_t prim_data;
void *alloc_retval;
int alloc_retval_counter;
void *prim_func;
int prim_protocol;
Scheme_Object *arg_s0;
Scheme_Object **arg_S0;
Scheme_Bucket *arg_b0;
int arg_i0;
long arg_l0;
Scheme_Native_Closure_Data *arg_n0;
Scheme_Object *arg_s1;
Scheme_Object **arg_S1;
int arg_i1;
long arg_l1;
Scheme_Object **arg_s2;
Scheme_Object **arg_S2;
int arg_i2;
Scheme_Object *retval_s;
MZ_MARK_STACK_TYPE retval_m;
Scheme_Object *retval;
struct future *prev;
struct future *next;
struct future *next_waiting_atomic;
struct future_t *prev;
struct future_t *next;
struct future_t *next_waiting_atomic;
} future_t;
#ifdef UNIT_TEST
@ -156,10 +147,8 @@ extern void print_ms_and_us(void);
//Here the convention is SIG_[arg1type]_[arg2type]..._[return type]
#define SIG_VOID_VOID_3ARGS 1 //void -> void, copy 3 args from runstack
#define SIG_ALLOC_VOID_PVOID 2 //void -> void*
#define SIG_OBJ_INT_POBJ_OBJ 3 //Scheme_Object* -> int -> Scheme_Object** -> Scheme_Object*
#define SIG_INT_OBJARR_OBJ 4 //int -> Scheme_Object*[] -> Scheme_Object
#define SIG_INT_POBJ_OBJ_OBJ 17 //int -> Scheme_Object** -> Scheme_Object* -> Scheme_Object*
#define SIG_PVOID_PVOID_PVOID 18 //void* -> void* -> void*
# include "jit_ts_protos.h"
//Helper macros for argument marshaling
#ifdef FUTURES_ENABLED
@ -171,20 +160,8 @@ extern void print_ms_and_us(void);
/*GDB_BREAK;*/ \
}
extern int rtcall_void_void_3args(void (*f)());
extern int rtcall_alloc_void_pvoid(void (*f)(), void **retval);
extern int rtcall_obj_int_pobj_obj(
Scheme_Object* (*f)(Scheme_Object*, int, Scheme_Object**),
Scheme_Object *a,
int b,
Scheme_Object **c,
Scheme_Object **retval);
extern int rtcall_int_pobj_obj(
Scheme_Object* (*f)(int, Scheme_Object**),
int argc,
Scheme_Object **argv,
Scheme_Object **retval);
extern void rtcall_void_void_3args(void (*f)());
extern void *rtcall_alloc_void_pvoid(void (*f)());
#else

167
src/mzscheme/src/gen-jit-ts.ss Normal file
View File

@ -0,0 +1,167 @@
#lang at-exp scheme/base
(require scheme/string)
(define (char->type c)
(case c
[(#\s) "Scheme_Object*"]
[(#\S) "Scheme_Object**"]
[(#\b) "Scheme_Bucket*"]
[(#\n) "Scheme_Native_Closure_Data*"]
[(#\m) "MZ_MARK_STACK_TYPE"]
[(#\i) "int"]
[(#\l) "long"]
[(#\v) "void"]
[else (error 'char->type "unknown: ~e" c)]))
(define (type->arg-string t)
(let* ([t (symbol->string t)])
(substring t 0 (- (string-length t) 2))))
(define (parse-type t)
(let* ([s (symbol->string t)])
(values
(for/list ([c (in-string (type->arg-string t))])
(char->type c))
(char->type (string-ref s (sub1 (string-length s)))))))
(define (make-arg-list arg-types arg-names)
(string-join (map (lambda (t a)
(string-append t " " a))
arg-types arg-names)
", "))
(define (gen-definer t)
(define-values (arg-types result-type) (parse-type t))
(define arg-names (map symbol->string (map (lambda (v) (gensym)) arg-types)))
(define return (if (equal? result-type "void") "" "return"))
(define args (make-arg-list arg-types arg-names))
(define ts (symbol->string t))
(for-each display
@list{#define define_ts_@|ts|(id) \
static @|result-type| ts_ ## id(@|args|) \
{ \
START_XFORM_SKIP; \
if (scheme_use_rtcall) \
@|return| scheme_rtcall_@|t|(id, @(string-join arg-names ", ")); \
else \
@|return| id(@(string-join arg-names ", ")); \
END_XFORM_SKIP; \
}})
(newline))
(define (gen-future-side t)
(define-values (arg-types result-type) (parse-type t))
(define arg-names (map symbol->string (map (lambda (v) (gensym)) arg-types)))
(define return (if (equal? result-type "void") "" "return"))
(define args (make-arg-list arg-types arg-names))
(define ts (symbol->string t))
(define fretval @string-append{future->retval_@|(substring ts (sub1 (string-length ts)))|})
(for-each
display
@list{
@|result-type| scheme_rtcall_@|ts|(prim_@|ts| f@|(if (null? arg-types) "" ",")| @|args|)
{
START_XFORM_SKIP;
future_t *future;
@(if (string=? result-type "void") "" @string-append{@|result-type| retval;})
future = current_ft;
future->prim_protocol = SIG_@|ts|;
future->prim_func = f;
@(string-join
(for/list ([t (in-string (type->arg-string t))]
[a arg-names]
[i (in-naturals)])
@string-append{ future->arg_@|(string t)|@|(number->string i)| = @|a|;})
"\n")
future_do_runtimecall((void*)f, 0);
future = current_ft;
@(if (string=? result-type "void") "" @string-append{retval = @|fretval|;})
@(if (string=? result-type "void") "" @string-append{@|fretval| = NULL;})
@(if (string=? result-type "void") "" "return retval;")
END_XFORM_SKIP;
}
})
(newline))
(define (gen-runtime-side t)
(define-values (arg-types result-type) (parse-type t))
(define arg-names (map symbol->string (map (lambda (v) (gensym)) arg-types)))
(define return (if (equal? result-type "void") "" "return"))
(define args (make-arg-list arg-types arg-names))
(define ts (symbol->string t))
(for-each
display
@list{
case SIG_@|ts|:
{
prim_@|ts| f = (prim_@|ts|)future->prim_func;
@(if (string=? result-type "void") "" @string-append{@|result-type| retval;})
@(if (string=? result-type "void") "" "retval = ")
f(@(string-join
(for/list ([t (in-string (type->arg-string t))]
[i (in-naturals)])
@string-append{future->arg_@|(string t)|@|(number->string i)|})
", "));
@(if (string=? result-type "void") "" @string-append{future->retval_@(substring ts (sub1 (string-length ts))) = retval;})
break;
}
})
(newline))
(define proto-counter 5)
(define (gen-protos t)
(define-values (arg-types result-type) (parse-type t))
(define arg-names (map symbol->string (map (lambda (v) (gensym)) arg-types)))
(define return (if (equal? result-type "void") "" "return"))
(define args (make-arg-list arg-types arg-names))
(define ts (symbol->string t))
(printf "#define SIG_~a ~a\n" t proto-counter)
(set! proto-counter (add1 proto-counter))
(display
@string-append{typedef @|result-type| (*prim_@|ts|)(@(string-join arg-types ", "));})
(newline)
(display @string-append{@|result-type| scheme_rtcall_@|ts|(prim_@|ts| f@(if (null? arg-types) "" ",") @|args|);})
(newline))
(define types
'(siS_s
iSs_s
s_s
n_s
_s
ss_s
ss_m
Sl_s
l_s
bsi_v
iiS_v
ss_v
b_v
sl_s
iS_s
S_s
s_v
iSi_s
siS_v))
(with-output-to-file "jit_ts_def.c"
#:exists 'replace
(lambda ()
(for-each gen-definer types)))
(with-output-to-file "jit_ts_future_glue.c"
#:exists 'replace
(lambda ()
(for-each gen-future-side types)))
(with-output-to-file "jit_ts_runtime_glue.c"
#:exists 'replace
(lambda ()
(for-each gen-runtime-side types)))
(with-output-to-file "jit_ts_protos.h"
#:exists 'replace
(lambda ()
(for-each gen-protos types)))

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

@ -2157,104 +2157,42 @@ extern int g_print_prims;
# define mz_direct_only(p) /* skip this arg, so that total count <= 3 args */
static Scheme_Object *noncm_prim_indirect(Scheme_Prim proc, int argc)
{
Scheme_Object *ret;
LOG_PRIM_START(proc);
START_XFORM_SKIP;
if (rtcall_int_pobj_obj(proc,
argc,
MZ_RUNSTACK,
&ret))
{
LOG_PRIM_END(proc);
return ret;
}
if (scheme_use_rtcall)
return scheme_rtcall_iS_s(proc,
argc,
MZ_RUNSTACK);
else
return proc(argc, MZ_RUNSTACK);
ret = proc(argc, MZ_RUNSTACK);
LOG_PRIM_END(proc);
return ret;
END_XFORM_SKIP;
}
static Scheme_Object *prim_indirect(Scheme_Primitive_Closure_Proc proc, int argc, Scheme_Object *self)
{
Scheme_Object *ret;
LOG_PRIM_START(proc);
START_XFORM_SKIP;
if (rtcall_int_pobj_obj_obj(proc,
argc,
MZ_RUNSTACK,
self,
&ret))
{
LOG_PRIM_END(proc);
return ret;
}
if (scheme_use_rtcall)
return scheme_rtcall_iSs_s(proc, argc, MZ_RUNSTACK, self);
else
return proc(argc, MZ_RUNSTACK, self);
ret = proc(argc, MZ_RUNSTACK, self);
LOG_PRIM_END(proc);
return ret;
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 Scheme_Object *ts_scheme_apply_multi_from_native(Scheme_Object *rator, int argc, Scheme_Object **argv)
{
START_XFORM_SKIP;
Scheme_Object *retptr;
if (rtcall_obj_int_pobj_obj(_scheme_apply_multi_from_native,
rator,
argc,
argv,
&retptr)) {
return retptr;
}
return _scheme_apply_multi_from_native(rator, argc, argv);
END_XFORM_SKIP;
}
static Scheme_Object *ts_scheme_apply_from_native(Scheme_Object *rator, int argc, Scheme_Object **argv)
{
START_XFORM_SKIP;
Scheme_Object *retptr;
if (rtcall_obj_int_pobj_obj(_scheme_apply_from_native,
rator,
argc,
argv,
&retptr)) {
return retptr;
}
return _scheme_apply_from_native(rator, argc, argv);
END_XFORM_SKIP;
}
static Scheme_Object *ts_scheme_tail_apply_from_native(Scheme_Object *rator, int argc, Scheme_Object **argv)
{
START_XFORM_SKIP;
Scheme_Object *retptr;
if (rtcall_obj_int_pobj_obj(_scheme_tail_apply_from_native,
rator,
argc,
argv,
&retptr)) {
return retptr;
}
return _scheme_tail_apply_from_native(rator, argc, argv);
END_XFORM_SKIP;
}
#include "jit_ts.c"
static void ts_on_demand(void)
{
START_XFORM_SKIP;
if (rtcall_void_void_3args(on_demand_with_args)) {
return;
}
on_demand();
if (scheme_use_rtcall)
rtcall_void_void_3args(on_demand_with_args);
else
on_demand();
END_XFORM_SKIP;
}
@ -2264,10 +2202,11 @@ static void *ts_prepare_retry_alloc(void *p, void *p2)
START_XFORM_SKIP;
void *ret;
LOG_PRIM_START(&prepare_retry_alloc);
jit_future_storage[0] = p;
jit_future_storage[1] = p2;
if (rtcall_alloc_void_pvoid(GC_make_jit_nursery_page,
&ret)) {
if (scheme_use_rtcall) {
jit_future_storage[0] = p;
jit_future_storage[1] = p2;
ret = rtcall_alloc_void_pvoid(GC_make_jit_nursery_page);
GC_gen0_alloc_page_ptr = ret;
retry_alloc_r1 = jit_future_storage[1];
p = jit_future_storage[0];
@ -2276,9 +2215,6 @@ static void *ts_prepare_retry_alloc(void *p, void *p2)
return p;
}
jit_future_storage[0] = NULL;
jit_future_storage[1] = NULL;
ret = prepare_retry_alloc(p, p2);
LOG_PRIM_END(&prepare_retry_alloc);
return ret;
@ -2290,9 +2226,6 @@ static void *ts_prepare_retry_alloc(void *p, void *p2)
# define mz_prepare_direct_prim(n) mz_prepare(n)
# define mz_finishr_direct_prim(reg, proc) mz_finishr(reg)
# define mz_direct_only(p) p
# define ts_scheme_apply_multi_from_native _scheme_apply_multi_from_native
# define ts_scheme_apply_from_native _scheme_apply_from_native
# define ts_scheme_tail_apply_from_native _scheme_tail_apply_from_native
# define ts_on_demand on_demand
# define ts_prepare_retry_alloc prepare_retry_alloc
#endif
@ -2540,9 +2473,9 @@ static int generate_finish_tail_call(mz_jit_state *jitter, int direct_native)
jit_pusharg_i(JIT_R0);
jit_pusharg_p(JIT_V1);
if (direct_native > 1) { /* => some_args_already_in_place */
(void)mz_finish(_scheme_tail_apply_from_native_fixup_args);
(void)mz_finish(ts__scheme_tail_apply_from_native_fixup_args);
} else {
(void)mz_finish(ts_scheme_tail_apply_from_native);
(void)mz_finish(ts__scheme_tail_apply_from_native);
}
CHECK_LIMIT();
/* Return: */
@ -2840,9 +2773,9 @@ static int generate_non_tail_call(mz_jit_state *jitter, int num_rands, int direc
mz_prepare(1);
jit_pusharg_p(JIT_R0);
if (multi_ok) {
(void)mz_finish(scheme_force_value_same_mark);
(void)mz_finish(ts_scheme_force_value_same_mark);
} else {
(void)mz_finish(scheme_force_one_value_same_mark);
(void)mz_finish(ts_scheme_force_one_value_same_mark);
}
ref5 = jit_jmpi(jit_forward());
CHECK_LIMIT();
@ -2894,9 +2827,9 @@ static int generate_non_tail_call(mz_jit_state *jitter, int num_rands, int direc
mz_prepare(1);
jit_pusharg_p(JIT_R0);
if (multi_ok) {
(void)mz_finish(scheme_force_value_same_mark);
(void)mz_finish(ts_scheme_force_value_same_mark);
} else {
(void)mz_finish(scheme_force_one_value_same_mark);
(void)mz_finish(ts_scheme_force_one_value_same_mark);
}
CHECK_LIMIT();
ref8 = jit_jmpi(jit_forward());
@ -2940,9 +2873,9 @@ static int generate_non_tail_call(mz_jit_state *jitter, int num_rands, int direc
jit_pusharg_p(JIT_V1);
if (num_rands < 0) { jit_movr_p(JIT_V1, JIT_R0); } /* save argc to manually pop runstack */
if (multi_ok) {
(void)mz_finish(ts_scheme_apply_multi_from_native);
(void)mz_finish(ts__scheme_apply_multi_from_native);
} else {
(void)mz_finish(ts_scheme_apply_from_native);
(void)mz_finish(ts__scheme_apply_from_native);
}
CHECK_LIMIT();
mz_patch_ucbranch(ref5);
@ -3793,7 +3726,7 @@ static int generate_alloc_double(mz_jit_state *jitter)
(void)mz_tl_sti_d_fppop(tl_double_result, JIT_FPR0, JIT_R0);
JIT_UPDATE_THREAD_RSPTR_IF_NEEDED();
mz_prepare(0);
(void)mz_finish(malloc_double);
(void)mz_finish(ts_malloc_double);
jit_retval(JIT_R0);
# endif
#endif
@ -5375,7 +5308,7 @@ static int generate_inlined_unary(mz_jit_state *jitter, Scheme_App2_Rec *app, in
JIT_UPDATE_THREAD_RSPTR_IF_NEEDED();
mz_prepare(1);
jit_pusharg_p(JIT_R0);
(void)mz_finish(scheme_box);
(void)mz_finish(ts_scheme_box);
jit_retval(JIT_R0);
#endif
@ -6061,7 +5994,7 @@ static int generate_inlined_binary(mz_jit_state *jitter, Scheme_App3_Rec *app, i
mz_prepare(2);
jit_pusharg_p(JIT_R1);
jit_pusharg_p(JIT_R0);
(void)mz_finish(scheme_make_mutable_pair);
(void)mz_finish(ts_scheme_make_mutable_pair);
jit_retval(JIT_R0);
#endif
@ -6311,9 +6244,9 @@ static int generate_inlined_nary(mz_jit_state *jitter, Scheme_App_Rec *app, int
jit_pusharg_l(JIT_R0);
jit_pusharg_l(JIT_RUNSTACK);
if (star)
(void)mz_finish(make_list_star);
(void)mz_finish(ts_make_list_star);
else
(void)mz_finish(make_list);
(void)mz_finish(ts_make_list);
jit_retval(JIT_R0);
#endif
@ -6376,7 +6309,7 @@ static int generate_cons_alloc(mz_jit_state *jitter, int rev, int inline_retry)
jit_pusharg_p(JIT_R1);
jit_pusharg_p(JIT_R0);
}
(void)mz_finish(scheme_make_pair);
(void)mz_finish(ts_scheme_make_pair);
jit_retval(JIT_R0);
#endif
@ -6433,25 +6366,25 @@ static int generate_vector_alloc(mz_jit_state *jitter, Scheme_Object *rator,
mz_prepare(1);
jit_pusharg_p(JIT_R0);
if (imm)
(void)mz_finish(make_one_element_ivector);
(void)mz_finish(ts_make_one_element_ivector);
else
(void)mz_finish(make_one_element_vector);
(void)mz_finish(ts_make_one_element_vector);
} else if (c == 2) {
mz_prepare(2);
jit_pusharg_p(JIT_R1);
jit_pusharg_p(JIT_R0);
if (imm)
(void)mz_finish(make_two_element_ivector);
(void)mz_finish(ts_make_two_element_ivector);
else
(void)mz_finish(make_two_element_vector);
(void)mz_finish(ts_make_two_element_vector);
} else {
jit_movi_l(JIT_R1, c);
mz_prepare(1);
jit_pusharg_l(JIT_R1);
if (imm)
(void)mz_finish(make_ivector);
(void)mz_finish(ts_make_ivector);
else
(void)mz_finish(make_vector);
(void)mz_finish(ts_make_vector);
}
jit_retval(JIT_R0);
#endif
@ -6539,9 +6472,9 @@ static int generate_closure(Scheme_Closure_Data *data,
mz_prepare(1);
jit_pusharg_l(JIT_R0);
if (immediately_filled) {
(void)mz_finish(GC_malloc_one_small_dirty_tagged);
(void)mz_finish(ts_GC_malloc_one_small_dirty_tagged);
} else {
(void)mz_finish(GC_malloc_one_small_tagged);
(void)mz_finish(ts_GC_malloc_one_small_tagged);
}
jit_retval(JIT_R0);
memcpy(&init_word, &example_so, sizeof(long));
@ -6566,7 +6499,7 @@ static int generate_closure(Scheme_Closure_Data *data,
(void)jit_patchable_movi_p(JIT_R0, code); /* !! */
#endif
jit_pusharg_p(JIT_R0);
(void)mz_finish(scheme_make_native_closure);
(void)mz_finish(ts_scheme_make_native_closure);
jit_retval(JIT_R0);
return 1;
@ -6665,7 +6598,7 @@ static int generate_case_closure(Scheme_Object *obj, mz_jit_state *jitter, int t
(void)jit_patchable_movi_p(JIT_R0, ndata); /* !! */
#endif
jit_pusharg_p(JIT_R0);
(void)mz_finish(scheme_make_native_case_closure);
(void)mz_finish(ts_scheme_make_native_case_closure);
jit_retval(JIT_R1);
CHECK_LIMIT();
@ -7061,7 +6994,7 @@ static int generate(Scheme_Object *obj, mz_jit_state *jitter, int is_tail, int m
jit_pusharg_p(JIT_R0);
jit_pusharg_p(JIT_R2);
CHECK_LIMIT();
(void)mz_finish(call_set_global_bucket);
(void)mz_finish(ts_call_set_global_bucket);
CHECK_LIMIT();
(void)jit_movi_p(target, scheme_void);
END_JIT_DATA(7);
@ -7227,7 +7160,7 @@ static int generate(Scheme_Object *obj, mz_jit_state *jitter, int is_tail, int m
jit_ldxi_p(JIT_R2, JIT_RUNSTACK, WORDS_TO_BYTES(pos));
mz_prepare(1);
jit_pusharg_p(JIT_R2);
(void)mz_finish(scheme_make_envunbox);
(void)mz_finish(ts_scheme_make_envunbox);
jit_retval(JIT_R0);
jit_stxi_p(WORDS_TO_BYTES(pos), JIT_RUNSTACK, JIT_R0);
CHECK_LIMIT();
@ -7254,7 +7187,7 @@ static int generate(Scheme_Object *obj, mz_jit_state *jitter, int is_tail, int m
JIT_UPDATE_THREAD_RSPTR_IF_NEEDED();
mz_prepare(1);
jit_pusharg_p(JIT_R2);
(void)mz_finish(make_global_ref);
(void)mz_finish(ts_make_global_ref);
CHECK_LIMIT();
jit_retval(target);
VALIDATE_RESULT(target);
@ -7594,7 +7527,7 @@ static int generate(Scheme_Object *obj, mz_jit_state *jitter, int is_tail, int m
CHECK_LIMIT();
jit_movi_i(JIT_V1, lv->count);
jit_pusharg_i(JIT_V1);
(void)mz_finish(lexical_binding_wrong_return_arity);
(void)mz_finish(ts_lexical_binding_wrong_return_arity);
CHECK_LIMIT();
/* Continue with expected values; R2 has value array: */
@ -7642,7 +7575,7 @@ static int generate(Scheme_Object *obj, mz_jit_state *jitter, int is_tail, int m
(void)jit_movi_p(JIT_R0, scheme_undefined);
mz_prepare(1);
jit_pusharg_p(JIT_R0);
(void)mz_finish(scheme_make_envunbox);
(void)mz_finish(ts_scheme_make_envunbox);
jit_retval(JIT_R0);
jit_stxi_p(WORDS_TO_BYTES(i), JIT_RUNSTACK, JIT_R0);
}
@ -7768,7 +7701,7 @@ static int generate(Scheme_Object *obj, mz_jit_state *jitter, int is_tail, int m
mz_prepare(2);
jit_pusharg_p(JIT_R0);
jit_pusharg_p(JIT_V1);
(void)mz_finish(scheme_set_cont_mark);
(void)mz_finish(ts_scheme_set_cont_mark);
CHECK_LIMIT();
END_JIT_DATA(18);
@ -8021,7 +7954,7 @@ static int do_generate_common(mz_jit_state *jitter, void *_data)
CHECK_LIMIT();
jit_movi_i(JIT_V1, 1);
jit_pusharg_i(JIT_V1);
(void)mz_finish(call_wrong_return_arity);
(void)mz_finish(ts_call_wrong_return_arity);
CHECK_LIMIT();
/* *** unbound_global_code *** */
@ -8029,7 +7962,7 @@ static int do_generate_common(mz_jit_state *jitter, void *_data)
JIT_UPDATE_THREAD_RSPTR();
mz_prepare(1);
jit_pusharg_p(JIT_R2);
(void)mz_finish(scheme_unbound_global);
(void)mz_finish(ts_scheme_unbound_global);
CHECK_LIMIT();
/* *** quote_syntax_code *** */
@ -8067,7 +8000,7 @@ static int do_generate_common(mz_jit_state *jitter, void *_data)
mz_prepare(2);
jit_pusharg_l(JIT_R1);
jit_pusharg_p(JIT_R0);
(void)mz_finish(scheme_delayed_rename);
(void)mz_finish(ts_scheme_delayed_rename);
CHECK_LIMIT();
jit_retval(JIT_R0);
/* Restore global array into JIT_R1, and put computed element at i+p+1: */
@ -8130,28 +8063,28 @@ static int do_generate_common(mz_jit_state *jitter, void *_data)
jit_pusharg_i(JIT_R1);
switch (i) {
case 0:
(void)mz_finish(scheme_checked_car);
(void)mz_finish(ts_scheme_checked_car);
break;
case 1:
(void)mz_finish(scheme_checked_cdr);
(void)mz_finish(ts_scheme_checked_cdr);
break;
case 2:
(void)mz_finish(scheme_checked_caar);
(void)mz_finish(ts_scheme_checked_caar);
break;
case 3:
(void)mz_finish(scheme_checked_cadr);
(void)mz_finish(ts_scheme_checked_cadr);
break;
case 4:
(void)mz_finish(scheme_checked_cdar);
(void)mz_finish(ts_scheme_checked_cdar);
break;
case 5:
(void)mz_finish(scheme_checked_cddr);
(void)mz_finish(ts_scheme_checked_cddr);
break;
case 6:
(void)mz_finish(scheme_checked_mcar);
(void)mz_finish(ts_scheme_checked_mcar);
break;
case 7:
(void)mz_finish(scheme_checked_mcdr);
(void)mz_finish(ts_scheme_checked_mcdr);
break;
}
CHECK_LIMIT();
@ -8185,10 +8118,10 @@ static int do_generate_common(mz_jit_state *jitter, void *_data)
jit_pusharg_i(JIT_R1);
switch (i) {
case 0:
(void)mz_finish(scheme_checked_set_mcar);
(void)mz_finish(ts_scheme_checked_set_mcar);
break;
case 1:
(void)mz_finish(scheme_checked_set_mcdr);
(void)mz_finish(ts_scheme_checked_set_mcdr);
break;
}
CHECK_LIMIT();
@ -8200,8 +8133,8 @@ static int do_generate_common(mz_jit_state *jitter, void *_data)
bad_unbox_code = jit_get_ip().ptr;
mz_prolog(JIT_R1);
jit_prepare(1);
jit_pusharg_i(JIT_R0);
(void)mz_finish(scheme_unbox);
jit_pusharg_p(JIT_R0);
(void)mz_finish(ts_scheme_unbox);
CHECK_LIMIT();
register_sub_func(jitter, bad_unbox_code, scheme_false);
@ -8211,7 +8144,7 @@ static int do_generate_common(mz_jit_state *jitter, void *_data)
mz_prolog(JIT_R1);
jit_prepare(1);
jit_pusharg_i(JIT_R0);
(void)mz_finish(scheme_vector_length);
(void)mz_finish(ts_scheme_vector_length);
CHECK_LIMIT();
register_sub_func(jitter, bad_vector_length_code, scheme_false);
@ -8353,7 +8286,7 @@ static int do_generate_common(mz_jit_state *jitter, void *_data)
jit_pusharg_p(JIT_R2);
jit_pusharg_p(JIT_R1);
jit_pusharg_p(JIT_R0);
(void)mz_finish(ts_scheme_apply_multi_from_native);
(void)mz_finish(ts__scheme_apply_multi_from_native);
CHECK_LIMIT();
mz_pop_threadlocal();
mz_pop_locals();
@ -8368,7 +8301,7 @@ static int do_generate_common(mz_jit_state *jitter, void *_data)
JIT_UPDATE_THREAD_RSPTR();
mz_prepare(1);
jit_pusharg_p(JIT_V1);
(void)mz_finish(tail_call_with_values_from_multiple_result);
(void)mz_finish(ts_tail_call_with_values_from_multiple_result);
jit_retval(JIT_R0);
VALIDATE_RESULT(JIT_R0);
/* Return: */
@ -8441,7 +8374,7 @@ static int do_generate_common(mz_jit_state *jitter, void *_data)
JIT_UPDATE_THREAD_RSPTR();
mz_prepare(1);
jit_pusharg_p(JIT_R0);
(void)mz_finish(raise_bad_call_with_values);
(void)mz_finish(ts_raise_bad_call_with_values);
/* Doesn't return */
CHECK_LIMIT();
@ -8457,9 +8390,9 @@ static int do_generate_common(mz_jit_state *jitter, void *_data)
mz_prepare(1);
jit_pusharg_p(JIT_V1);
if (i) {
(void)mz_finish(call_with_values_from_multiple_result_multi);
(void)mz_finish(ts_call_with_values_from_multiple_result_multi);
} else {
(void)mz_finish(call_with_values_from_multiple_result);
(void)mz_finish(ts_call_with_values_from_multiple_result);
}
jit_retval(JIT_R0);
VALIDATE_RESULT(JIT_R0);
@ -8570,28 +8503,28 @@ static int do_generate_common(mz_jit_state *jitter, void *_data)
switch (ii) {
case 0:
if (!iii) {
(void)mz_finish(scheme_checked_vector_ref);
(void)mz_finish(ts_scheme_checked_vector_ref);
} else {
(void)mz_finish(scheme_checked_vector_set);
(void)mz_finish(ts_scheme_checked_vector_set);
}
break;
case 1:
if (!iii) {
(void)mz_finish(scheme_checked_string_ref);
(void)mz_finish(ts_scheme_checked_string_ref);
/* might return, if char was outside Latin-1 */
jit_addi_p(JIT_RUNSTACK, JIT_RUNSTACK, WORDS_TO_BYTES(2));
JIT_UPDATE_THREAD_RSPTR();
jit_retval(JIT_R0);
mz_epilog(JIT_R2);
} else {
(void)mz_finish(scheme_checked_string_set);
(void)mz_finish(ts_scheme_checked_string_set);
}
break;
case 2:
if (!iii) {
(void)mz_finish(scheme_checked_byte_string_ref);
(void)mz_finish(ts_scheme_checked_byte_string_ref);
} else {
(void)mz_finish(scheme_checked_byte_string_set);
(void)mz_finish(ts_scheme_checked_byte_string_set);
}
break;
}
@ -8704,7 +8637,7 @@ static int do_generate_common(mz_jit_state *jitter, void *_data)
jit_prepare(2);
jit_pusharg_p(JIT_RUNSTACK);
jit_pusharg_i(JIT_R1);
(void)mz_finish(scheme_checked_syntax_e);
(void)mz_finish(ts_scheme_checked_syntax_e);
jit_retval(JIT_R0);
jit_addi_p(JIT_RUNSTACK, JIT_RUNSTACK, WORDS_TO_BYTES(1));
mz_epilog(JIT_R2);
@ -8802,9 +8735,9 @@ static int do_generate_common(mz_jit_state *jitter, void *_data)
jit_pusharg_p(JIT_V1);
jit_pusharg_p(JIT_R0);
if (ii == 1) {
(void)mz_finish(ts_scheme_apply_multi_from_native);
(void)mz_finish(ts__scheme_apply_multi_from_native);
} else {
(void)mz_finish(ts_scheme_apply_from_native);
(void)mz_finish(ts__scheme_apply_from_native);
}
jit_retval(JIT_R0);
VALIDATE_RESULT(JIT_R0);
@ -9044,8 +8977,8 @@ static int do_generate_more_common(mz_jit_state *jitter, void *_data)
jit_movi_i(JIT_V1, 5);
jit_prepare(2);
jit_pusharg_p(JIT_RUNSTACK);
jit_pusharg_p(JIT_V1);
(void)mz_finish(scheme_extract_checked_procedure);
jit_pusharg_i(JIT_V1);
(void)mz_finish(ts_scheme_extract_checked_procedure);
jit_retval(JIT_R0);
VALIDATE_RESULT(JIT_R0);
mz_epilog(JIT_V1);
@ -9112,7 +9045,7 @@ static int do_generate_more_common(mz_jit_state *jitter, void *_data)
JIT_UPDATE_THREAD_RSPTR();
jit_prepare(1);
jit_pusharg_p(JIT_RUNSTACK);
(void)mz_finish(apply_checked_fail);
(void)mz_finish(ts_apply_checked_fail);
CHECK_LIMIT();
jit_retval(JIT_R0);
VALIDATE_RESULT(JIT_R0);
@ -9353,7 +9286,7 @@ static int do_generate_closure(mz_jit_state *jitter, void *_data)
jit_pusharg_p(JIT_R2);
jit_pusharg_i(JIT_R1);
CHECK_LIMIT();
(void)mz_finish(scheme_build_list_offset);
(void)mz_finish(ts_scheme_build_list_offset);
jit_retval(JIT_V1);
#ifndef JIT_PRECISE_GC
if (data->closure_size)
@ -9667,10 +9600,10 @@ static int generate_simple_arity_check(mz_jit_state *jitter, int num_params, int
/* Not negative, so report run-time arity mismatch */
mz_prepare(3);
jit_pusharg_p(JIT_R2);
jit_pusharg_p(JIT_R1);
jit_pusharg_i(JIT_R1);
jit_pusharg_p(JIT_R0);
CHECK_LIMIT();
(void)mz_nonrs_finish(wrong_argument_count);
(void)mz_nonrs_finish(ts_wrong_argument_count);
CHECK_LIMIT();
/* Arity check or reporting. If argv is NULL, it's a reporting request */
@ -9705,7 +9638,7 @@ static int generate_simple_arity_check(mz_jit_state *jitter, int num_params, int
if (is_method) {
mz_prepare(1);
jit_pusharg_p(JIT_R0);
(void)mz_nonrs_finish(scheme_box);
(void)mz_nonrs_finish(ts_scheme_box);
mz_pop_threadlocal();
mz_pop_locals();
jit_ret();
@ -9805,10 +9738,10 @@ static int generate_case_lambda_dispatch(mz_jit_state *jitter, Scheme_Case_Lambd
JIT_UPDATE_THREAD_RSPTR();
mz_prepare(3);
jit_pusharg_p(JIT_R2);
jit_pusharg_p(JIT_R1);
jit_pusharg_i(JIT_R1);
jit_pusharg_p(JIT_R0);
CHECK_LIMIT();
(void)mz_finish(wrong_argument_count);
(void)mz_finish(ts_wrong_argument_count);
CHECK_LIMIT();
}

134
src/mzscheme/src/jit_ts.c Normal file
View File

@ -0,0 +1,134 @@
#ifdef FUTURES_ENABLED
# include "jit_ts_def.c"
/* s = Scheme_Object*
i = int
l = long
S = Scheme_Object**
v = void
b = Scheme_Bucket*
n = Scheme_Native_Closure_Data*
m = MZ_MARK_STACK_TYPE */
define_ts_siS_s(_scheme_apply_multi_from_native)
define_ts_siS_s(_scheme_apply_from_native)
define_ts_siS_s(_scheme_tail_apply_from_native)
define_ts_siS_s(_scheme_tail_apply_from_native_fixup_args)
define_ts_s_s(scheme_force_value_same_mark)
define_ts_s_s(scheme_force_one_value_same_mark)
#if defined(INLINE_FP_OPS) && !defined(CAN_INLINE_ALLOC)
define_ts__s(malloc_double)
#endif
define_ts_s_s(scheme_box)
#ifndef CAN_INLINE_ALLOC
define_ts_ss_s(scheme_make_mutable_pair)
define_ts_Sl_s(make_list_star)
define_ts_Sl_s(make_list)
define_ts_ss_s(scheme_make_pair)
define_ts_s_s(make_one_element_ivector)
define_ts_s_s(make_one_element_vector)
define_ts_ss_s(make_two_element_ivector)
define_ts_ss_s(make_two_element_vector)
define_ts_l_s(make_ivector)
define_ts_l_s(make_vector)
#endif
#ifdef JIT_PRECISE_GC
define_ts_l_s(GC_malloc_one_small_dirty_tagged)
define_ts_l_s(GC_malloc_one_small_tagged)
#endif
define_ts_n_s(scheme_make_native_closure)
define_ts_n_s(scheme_make_native_case_closure)
define_ts_bsi_v(call_set_global_bucket)
define_ts_s_s(scheme_make_envunbox)
define_ts_s_s(make_global_ref)
define_ts_iiS_v(lexical_binding_wrong_return_arity)
define_ts_ss_m(scheme_set_cont_mark)
define_ts_iiS_v(call_wrong_return_arity)
define_ts_b_v(scheme_unbound_global)
define_ts_Sl_s(scheme_delayed_rename)
define_ts_iS_s(scheme_checked_car)
define_ts_iS_s(scheme_checked_cdr)
define_ts_iS_s(scheme_checked_caar)
define_ts_iS_s(scheme_checked_cadr)
define_ts_iS_s(scheme_checked_cdar)
define_ts_iS_s(scheme_checked_cddr)
define_ts_iS_s(scheme_checked_mcar)
define_ts_iS_s(scheme_checked_mcdr)
define_ts_iS_s(scheme_checked_set_mcar)
define_ts_iS_s(scheme_checked_set_mcdr)
define_ts_s_s(scheme_unbox)
define_ts_s_s(scheme_vector_length)
define_ts_s_s(tail_call_with_values_from_multiple_result)
define_ts_s_v(raise_bad_call_with_values)
define_ts_s_s(call_with_values_from_multiple_result_multi)
define_ts_s_s(call_with_values_from_multiple_result)
define_ts_iS_s(scheme_checked_vector_ref)
define_ts_iS_s(scheme_checked_vector_set)
define_ts_iS_s(scheme_checked_string_ref)
define_ts_iS_s(scheme_checked_string_set)
define_ts_iS_s(scheme_checked_byte_string_ref)
define_ts_iS_s(scheme_checked_byte_string_set)
define_ts_iS_s(scheme_checked_syntax_e)
define_ts_iS_s(scheme_extract_checked_procedure)
define_ts_S_s(apply_checked_fail)
define_ts_iSi_s(scheme_build_list_offset)
define_ts_siS_v(wrong_argument_count)
#else
# define ts__scheme_tail_apply_from_native_fixup_args _scheme_tail_apply_from_native_fixup_args
# define ts_scheme_force_value_same_mark scheme_force_value_same_mark
# define ts_scheme_force_one_value_same_mark scheme_force_one_value_same_mark
# define ts_scheme_force_value_same_mark scheme_force_value_same_mark
# define ts_scheme_force_one_value_same_mark scheme_force_one_value_same_mark
# define ts_malloc_double malloc_double
# define ts_scheme_box scheme_box
# define ts_scheme_make_mutable_pair scheme_make_mutable_pair
# define ts_make_list_star make_list_star
# define ts_make_list make_list
# define ts_scheme_make_pair scheme_make_pair
# define ts_make_one_element_ivector make_one_element_ivector
# define ts_make_one_element_vector make_one_element_vector
# define ts_make_two_element_ivector make_two_element_ivector
# define ts_make_two_element_vector make_two_element_vector
# define ts_make_ivector make_ivector
# define ts_make_vector make_vector
# define ts_GC_malloc_one_small_dirty_tagged GC_malloc_one_small_dirty_tagged
# define ts_GC_malloc_one_small_tagged GC_malloc_one_small_tagged
# define ts_scheme_make_native_closure scheme_make_native_closure
# define ts_scheme_make_native_case_closure scheme_make_native_case_closure
# define ts_call_set_global_bucket call_set_global_bucket
# define ts_scheme_make_envunbox scheme_make_envunbox
# define ts_make_global_ref make_global_ref
# define ts_lexical_binding_wrong_return_arity lexical_binding_wrong_return_arity
# define ts_scheme_set_cont_mark scheme_set_cont_mark
# define ts_call_wrong_return_arity call_wrong_return_arity
# define ts_scheme_unbound_global scheme_unbound_global
# define ts_scheme_delayed_rename scheme_delayed_rename
# define ts_scheme_checked_car scheme_checked_car
# define ts_scheme_checked_cdr scheme_checked_cdr
# define ts_scheme_checked_caar scheme_checked_caar
# define ts_scheme_checked_cadr scheme_checked_cadr
# define ts_scheme_checked_cdar scheme_checked_cdar
# define ts_scheme_checked_cddr scheme_checked_cddr
# define ts_scheme_checked_mcar scheme_checked_mcar
# define ts_scheme_checked_mcdr scheme_checked_mcdr
# define ts_scheme_checked_set_mcar scheme_checked_set_mcar
# define ts_scheme_checked_set_mcdr scheme_checked_set_mcdr
# define ts_scheme_unbox scheme_unbox
# define ts_scheme_vector_length scheme_vector_length
# define ts_tail_call_with_values_from_multiple_result tail_call_with_values_from_multiple_result
# define ts_raise_bad_call_with_values raise_bad_call_with_values
# define ts_call_with_values_from_multiple_result_multi call_with_values_from_multiple_result_multi
# define ts_call_with_values_from_multiple_result call_with_values_from_multiple_result
# define ts_scheme_checked_vector_ref scheme_checked_vector_ref
# define ts_scheme_checked_vector_set scheme_checked_vector_set
# define ts_scheme_checked_string_ref scheme_checked_string_ref
# define ts_scheme_checked_string_set scheme_checked_string_set
# define ts_scheme_checked_byte_string_ref scheme_checked_byte_string_ref
# define ts_scheme_checked_byte_string_set scheme_checked_byte_string_set
# define ts_scheme_checked_syntax_e scheme_checked_syntax_e
# define ts_scheme_extract_checked_procedure scheme_extract_checked_procedure
# define ts_apply_checked_fail apply_checked_fail
# define ts_scheme_build_list_offset scheme_build_list_offset
# define ts_wrong_argument_count wrong_argument_count
#endif

190
src/mzscheme/src/jit_ts_def.c Normal file
View File

@ -0,0 +1,190 @@
#define define_ts_siS_s(id) \
static Scheme_Object* ts_ ## id(Scheme_Object* g7, int g8, Scheme_Object** g9) \
{ \
START_XFORM_SKIP; \
if (scheme_use_rtcall) \
return scheme_rtcall_siS_s(id, g7, g8, g9); \
else \
return id(g7, g8, g9); \
END_XFORM_SKIP; \
}
#define define_ts_iSs_s(id) \
static Scheme_Object* ts_ ## id(int g10, Scheme_Object** g11, Scheme_Object* g12) \
{ \
START_XFORM_SKIP; \
if (scheme_use_rtcall) \
return scheme_rtcall_iSs_s(id, g10, g11, g12); \
else \
return id(g10, g11, g12); \
END_XFORM_SKIP; \
}
#define define_ts_s_s(id) \
static Scheme_Object* ts_ ## id(Scheme_Object* g13) \
{ \
START_XFORM_SKIP; \
if (scheme_use_rtcall) \
return scheme_rtcall_s_s(id, g13); \
else \
return id(g13); \
END_XFORM_SKIP; \
}
#define define_ts_n_s(id) \
static Scheme_Object* ts_ ## id(Scheme_Native_Closure_Data* g14) \
{ \
START_XFORM_SKIP; \
if (scheme_use_rtcall) \
return scheme_rtcall_n_s(id, g14); \
else \
return id(g14); \
END_XFORM_SKIP; \
}
#define define_ts__s(id) \
static Scheme_Object* ts_ ## id() \
{ \
START_XFORM_SKIP; \
if (scheme_use_rtcall) \
return scheme_rtcall__s(id, ); \
else \
return id(); \
END_XFORM_SKIP; \
}
#define define_ts_ss_s(id) \
static Scheme_Object* ts_ ## id(Scheme_Object* g15, Scheme_Object* g16) \
{ \
START_XFORM_SKIP; \
if (scheme_use_rtcall) \
return scheme_rtcall_ss_s(id, g15, g16); \
else \
return id(g15, g16); \
END_XFORM_SKIP; \
}
#define define_ts_ss_m(id) \
static MZ_MARK_STACK_TYPE ts_ ## id(Scheme_Object* g17, Scheme_Object* g18) \
{ \
START_XFORM_SKIP; \
if (scheme_use_rtcall) \
return scheme_rtcall_ss_m(id, g17, g18); \
else \
return id(g17, g18); \
END_XFORM_SKIP; \
}
#define define_ts_Sl_s(id) \
static Scheme_Object* ts_ ## id(Scheme_Object** g19, long g20) \
{ \
START_XFORM_SKIP; \
if (scheme_use_rtcall) \
return scheme_rtcall_Sl_s(id, g19, g20); \
else \
return id(g19, g20); \
END_XFORM_SKIP; \
}
#define define_ts_l_s(id) \
static Scheme_Object* ts_ ## id(long g21) \
{ \
START_XFORM_SKIP; \
if (scheme_use_rtcall) \
return scheme_rtcall_l_s(id, g21); \
else \
return id(g21); \
END_XFORM_SKIP; \
}
#define define_ts_bsi_v(id) \
static void ts_ ## id(Scheme_Bucket* g22, Scheme_Object* g23, int g24) \
{ \
START_XFORM_SKIP; \
if (scheme_use_rtcall) \
scheme_rtcall_bsi_v(id, g22, g23, g24); \
else \
id(g22, g23, g24); \
END_XFORM_SKIP; \
}
#define define_ts_iiS_v(id) \
static void ts_ ## id(int g25, int g26, Scheme_Object** g27) \
{ \
START_XFORM_SKIP; \
if (scheme_use_rtcall) \
scheme_rtcall_iiS_v(id, g25, g26, g27); \
else \
id(g25, g26, g27); \
END_XFORM_SKIP; \
}
#define define_ts_ss_v(id) \
static void ts_ ## id(Scheme_Object* g28, Scheme_Object* g29) \
{ \
START_XFORM_SKIP; \
if (scheme_use_rtcall) \
scheme_rtcall_ss_v(id, g28, g29); \
else \
id(g28, g29); \
END_XFORM_SKIP; \
}
#define define_ts_b_v(id) \
static void ts_ ## id(Scheme_Bucket* g30) \
{ \
START_XFORM_SKIP; \
if (scheme_use_rtcall) \
scheme_rtcall_b_v(id, g30); \
else \
id(g30); \
END_XFORM_SKIP; \
}
#define define_ts_sl_s(id) \
static Scheme_Object* ts_ ## id(Scheme_Object* g31, long g32) \
{ \
START_XFORM_SKIP; \
if (scheme_use_rtcall) \
return scheme_rtcall_sl_s(id, g31, g32); \
else \
return id(g31, g32); \
END_XFORM_SKIP; \
}
#define define_ts_iS_s(id) \
static Scheme_Object* ts_ ## id(int g33, Scheme_Object** g34) \
{ \
START_XFORM_SKIP; \
if (scheme_use_rtcall) \
return scheme_rtcall_iS_s(id, g33, g34); \
else \
return id(g33, g34); \
END_XFORM_SKIP; \
}
#define define_ts_S_s(id) \
static Scheme_Object* ts_ ## id(Scheme_Object** g35) \
{ \
START_XFORM_SKIP; \
if (scheme_use_rtcall) \
return scheme_rtcall_S_s(id, g35); \
else \
return id(g35); \
END_XFORM_SKIP; \
}
#define define_ts_s_v(id) \
static void ts_ ## id(Scheme_Object* g36) \
{ \
START_XFORM_SKIP; \
if (scheme_use_rtcall) \
scheme_rtcall_s_v(id, g36); \
else \
id(g36); \
END_XFORM_SKIP; \
}
#define define_ts_iSi_s(id) \
static Scheme_Object* ts_ ## id(int g37, Scheme_Object** g38, int g39) \
{ \
START_XFORM_SKIP; \
if (scheme_use_rtcall) \
return scheme_rtcall_iSi_s(id, g37, g38, g39); \
else \
return id(g37, g38, g39); \
END_XFORM_SKIP; \
}
#define define_ts_siS_v(id) \
static void ts_ ## id(Scheme_Object* g40, int g41, Scheme_Object** g42) \
{ \
START_XFORM_SKIP; \
if (scheme_use_rtcall) \
scheme_rtcall_siS_v(id, g40, g41, g42); \
else \
id(g40, g41, g42); \
END_XFORM_SKIP; \
}

341
src/mzscheme/src/jit_ts_future_glue.c Normal file
View File

@ -0,0 +1,341 @@
Scheme_Object* scheme_rtcall_siS_s(prim_siS_s f, Scheme_Object* g43, int g44, Scheme_Object** g45)
{
START_XFORM_SKIP;
future_t *future;
Scheme_Object* retval;
future = current_ft;
future->prim_protocol = SIG_siS_s;
future->prim_func = f;
future->arg_s0 = g43;
future->arg_i1 = g44;
future->arg_S2 = g45;
future_do_runtimecall((void*)f, 0);
future = current_ft;
retval = future->retval_s;
future->retval_s = NULL;
return retval;
END_XFORM_SKIP;
}
Scheme_Object* scheme_rtcall_iSs_s(prim_iSs_s f, int g46, Scheme_Object** g47, Scheme_Object* g48)
{
START_XFORM_SKIP;
future_t *future;
Scheme_Object* retval;
future = current_ft;
future->prim_protocol = SIG_iSs_s;
future->prim_func = f;
future->arg_i0 = g46;
future->arg_S1 = g47;
future->arg_s2 = g48;
future_do_runtimecall((void*)f, 0);
future = current_ft;
retval = future->retval_s;
future->retval_s = NULL;
return retval;
END_XFORM_SKIP;
}
Scheme_Object* scheme_rtcall_s_s(prim_s_s f, Scheme_Object* g49)
{
START_XFORM_SKIP;
future_t *future;
Scheme_Object* retval;
future = current_ft;
future->prim_protocol = SIG_s_s;
future->prim_func = f;
future->arg_s0 = g49;
future_do_runtimecall((void*)f, 0);
future = current_ft;
retval = future->retval_s;
future->retval_s = NULL;
return retval;
END_XFORM_SKIP;
}
Scheme_Object* scheme_rtcall_n_s(prim_n_s f, Scheme_Native_Closure_Data* g50)
{
START_XFORM_SKIP;
future_t *future;
Scheme_Object* retval;
future = current_ft;
future->prim_protocol = SIG_n_s;
future->prim_func = f;
future->arg_n0 = g50;
future_do_runtimecall((void*)f, 0);
future = current_ft;
retval = future->retval_s;
future->retval_s = NULL;
return retval;
END_XFORM_SKIP;
}
Scheme_Object* scheme_rtcall__s(prim__s f )
{
START_XFORM_SKIP;
future_t *future;
Scheme_Object* retval;
future = current_ft;
future->prim_protocol = SIG__s;
future->prim_func = f;
future_do_runtimecall((void*)f, 0);
future = current_ft;
retval = future->retval_s;
future->retval_s = NULL;
return retval;
END_XFORM_SKIP;
}
Scheme_Object* scheme_rtcall_ss_s(prim_ss_s f, Scheme_Object* g51, Scheme_Object* g52)
{
START_XFORM_SKIP;
future_t *future;
Scheme_Object* retval;
future = current_ft;
future->prim_protocol = SIG_ss_s;
future->prim_func = f;
future->arg_s0 = g51;
future->arg_s1 = g52;
future_do_runtimecall((void*)f, 0);
future = current_ft;
retval = future->retval_s;
future->retval_s = NULL;
return retval;
END_XFORM_SKIP;
}
MZ_MARK_STACK_TYPE scheme_rtcall_ss_m(prim_ss_m f, Scheme_Object* g53, Scheme_Object* g54)
{
START_XFORM_SKIP;
future_t *future;
MZ_MARK_STACK_TYPE retval;
future = current_ft;
future->prim_protocol = SIG_ss_m;
future->prim_func = f;
future->arg_s0 = g53;
future->arg_s1 = g54;
future_do_runtimecall((void*)f, 0);
future = current_ft;
retval = future->retval_m;
future->retval_m = NULL;
return retval;
END_XFORM_SKIP;
}
Scheme_Object* scheme_rtcall_Sl_s(prim_Sl_s f, Scheme_Object** g55, long g56)
{
START_XFORM_SKIP;
future_t *future;
Scheme_Object* retval;
future = current_ft;
future->prim_protocol = SIG_Sl_s;
future->prim_func = f;
future->arg_S0 = g55;
future->arg_l1 = g56;
future_do_runtimecall((void*)f, 0);
future = current_ft;
retval = future->retval_s;
future->retval_s = NULL;
return retval;
END_XFORM_SKIP;
}
Scheme_Object* scheme_rtcall_l_s(prim_l_s f, long g57)
{
START_XFORM_SKIP;
future_t *future;
Scheme_Object* retval;
future = current_ft;
future->prim_protocol = SIG_l_s;
future->prim_func = f;
future->arg_l0 = g57;
future_do_runtimecall((void*)f, 0);
future = current_ft;
retval = future->retval_s;
future->retval_s = NULL;
return retval;
END_XFORM_SKIP;
}
void scheme_rtcall_bsi_v(prim_bsi_v f, Scheme_Bucket* g58, Scheme_Object* g59, int g60)
{
START_XFORM_SKIP;
future_t *future;
future = current_ft;
future->prim_protocol = SIG_bsi_v;
future->prim_func = f;
future->arg_b0 = g58;
future->arg_s1 = g59;
future->arg_i2 = g60;
future_do_runtimecall((void*)f, 0);
future = current_ft;
END_XFORM_SKIP;
}
void scheme_rtcall_iiS_v(prim_iiS_v f, int g61, int g62, Scheme_Object** g63)
{
START_XFORM_SKIP;
future_t *future;
future = current_ft;
future->prim_protocol = SIG_iiS_v;
future->prim_func = f;
future->arg_i0 = g61;
future->arg_i1 = g62;
future->arg_S2 = g63;
future_do_runtimecall((void*)f, 0);
future = current_ft;
END_XFORM_SKIP;
}
void scheme_rtcall_ss_v(prim_ss_v f, Scheme_Object* g64, Scheme_Object* g65)
{
START_XFORM_SKIP;
future_t *future;
future = current_ft;
future->prim_protocol = SIG_ss_v;
future->prim_func = f;
future->arg_s0 = g64;
future->arg_s1 = g65;
future_do_runtimecall((void*)f, 0);
future = current_ft;
END_XFORM_SKIP;
}
void scheme_rtcall_b_v(prim_b_v f, Scheme_Bucket* g66)
{
START_XFORM_SKIP;
future_t *future;
future = current_ft;
future->prim_protocol = SIG_b_v;
future->prim_func = f;
future->arg_b0 = g66;
future_do_runtimecall((void*)f, 0);
future = current_ft;
END_XFORM_SKIP;
}
Scheme_Object* scheme_rtcall_sl_s(prim_sl_s f, Scheme_Object* g67, long g68)
{
START_XFORM_SKIP;
future_t *future;
Scheme_Object* retval;
future = current_ft;
future->prim_protocol = SIG_sl_s;
future->prim_func = f;
future->arg_s0 = g67;
future->arg_l1 = g68;
future_do_runtimecall((void*)f, 0);
future = current_ft;
retval = future->retval_s;
future->retval_s = NULL;
return retval;
END_XFORM_SKIP;
}
Scheme_Object* scheme_rtcall_iS_s(prim_iS_s f, int g69, Scheme_Object** g70)
{
START_XFORM_SKIP;
future_t *future;
Scheme_Object* retval;
future = current_ft;
future->prim_protocol = SIG_iS_s;
future->prim_func = f;
future->arg_i0 = g69;
future->arg_S1 = g70;
future_do_runtimecall((void*)f, 0);
future = current_ft;
retval = future->retval_s;
future->retval_s = NULL;
return retval;
END_XFORM_SKIP;
}
Scheme_Object* scheme_rtcall_S_s(prim_S_s f, Scheme_Object** g71)
{
START_XFORM_SKIP;
future_t *future;
Scheme_Object* retval;
future = current_ft;
future->prim_protocol = SIG_S_s;
future->prim_func = f;
future->arg_S0 = g71;
future_do_runtimecall((void*)f, 0);
future = current_ft;
retval = future->retval_s;
future->retval_s = NULL;
return retval;
END_XFORM_SKIP;
}
void scheme_rtcall_s_v(prim_s_v f, Scheme_Object* g72)
{
START_XFORM_SKIP;
future_t *future;
future = current_ft;
future->prim_protocol = SIG_s_v;
future->prim_func = f;
future->arg_s0 = g72;
future_do_runtimecall((void*)f, 0);
future = current_ft;
END_XFORM_SKIP;
}
Scheme_Object* scheme_rtcall_iSi_s(prim_iSi_s f, int g73, Scheme_Object** g74, int g75)
{
START_XFORM_SKIP;
future_t *future;
Scheme_Object* retval;
future = current_ft;
future->prim_protocol = SIG_iSi_s;
future->prim_func = f;
future->arg_i0 = g73;
future->arg_S1 = g74;
future->arg_i2 = g75;
future_do_runtimecall((void*)f, 0);
future = current_ft;
retval = future->retval_s;
future->retval_s = NULL;
return retval;
END_XFORM_SKIP;
}
void scheme_rtcall_siS_v(prim_siS_v f, Scheme_Object* g76, int g77, Scheme_Object** g78)
{
START_XFORM_SKIP;
future_t *future;
future = current_ft;
future->prim_protocol = SIG_siS_v;
future->prim_func = f;
future->arg_s0 = g76;
future->arg_i1 = g77;
future->arg_S2 = g78;
future_do_runtimecall((void*)f, 0);
future = current_ft;
END_XFORM_SKIP;
}

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

@ -0,0 +1,240 @@
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;
}

57
src/mzscheme/src/jit_ts_protos.h Normal file
View File

@ -0,0 +1,57 @@
#define SIG_siS_s 5
typedef Scheme_Object* (*prim_siS_s)(Scheme_Object*, int, Scheme_Object**);
Scheme_Object* scheme_rtcall_siS_s(prim_siS_s f, Scheme_Object* g115, int g116, Scheme_Object** g117);
#define SIG_iSs_s 6
typedef Scheme_Object* (*prim_iSs_s)(int, Scheme_Object**, Scheme_Object*);
Scheme_Object* scheme_rtcall_iSs_s(prim_iSs_s f, int g118, Scheme_Object** g119, Scheme_Object* g120);
#define SIG_s_s 7
typedef Scheme_Object* (*prim_s_s)(Scheme_Object*);
Scheme_Object* scheme_rtcall_s_s(prim_s_s f, Scheme_Object* g121);
#define SIG_n_s 8
typedef Scheme_Object* (*prim_n_s)(Scheme_Native_Closure_Data*);
Scheme_Object* scheme_rtcall_n_s(prim_n_s f, Scheme_Native_Closure_Data* g122);
#define SIG__s 9
typedef Scheme_Object* (*prim__s)();
Scheme_Object* scheme_rtcall__s(prim__s f );
#define SIG_ss_s 10
typedef Scheme_Object* (*prim_ss_s)(Scheme_Object*, Scheme_Object*);
Scheme_Object* scheme_rtcall_ss_s(prim_ss_s f, Scheme_Object* g123, Scheme_Object* g124);
#define SIG_ss_m 11
typedef MZ_MARK_STACK_TYPE (*prim_ss_m)(Scheme_Object*, Scheme_Object*);
MZ_MARK_STACK_TYPE scheme_rtcall_ss_m(prim_ss_m f, Scheme_Object* g125, Scheme_Object* g126);
#define SIG_Sl_s 12
typedef Scheme_Object* (*prim_Sl_s)(Scheme_Object**, long);
Scheme_Object* scheme_rtcall_Sl_s(prim_Sl_s f, Scheme_Object** g127, long g128);
#define SIG_l_s 13
typedef Scheme_Object* (*prim_l_s)(long);
Scheme_Object* scheme_rtcall_l_s(prim_l_s f, long g129);
#define SIG_bsi_v 14
typedef void (*prim_bsi_v)(Scheme_Bucket*, Scheme_Object*, int);
void scheme_rtcall_bsi_v(prim_bsi_v f, Scheme_Bucket* g130, Scheme_Object* g131, int g132);
#define SIG_iiS_v 15
typedef void (*prim_iiS_v)(int, int, Scheme_Object**);
void scheme_rtcall_iiS_v(prim_iiS_v f, int g133, int g134, Scheme_Object** g135);
#define SIG_ss_v 16
typedef void (*prim_ss_v)(Scheme_Object*, Scheme_Object*);
void scheme_rtcall_ss_v(prim_ss_v f, Scheme_Object* g136, Scheme_Object* g137);
#define SIG_b_v 17
typedef void (*prim_b_v)(Scheme_Bucket*);
void scheme_rtcall_b_v(prim_b_v f, Scheme_Bucket* g138);
#define SIG_sl_s 18
typedef Scheme_Object* (*prim_sl_s)(Scheme_Object*, long);
Scheme_Object* scheme_rtcall_sl_s(prim_sl_s f, Scheme_Object* g139, long g140);
#define SIG_iS_s 19
typedef Scheme_Object* (*prim_iS_s)(int, Scheme_Object**);
Scheme_Object* scheme_rtcall_iS_s(prim_iS_s f, int g141, Scheme_Object** g142);
#define SIG_S_s 20
typedef Scheme_Object* (*prim_S_s)(Scheme_Object**);
Scheme_Object* scheme_rtcall_S_s(prim_S_s f, Scheme_Object** g143);
#define SIG_s_v 21
typedef void (*prim_s_v)(Scheme_Object*);
void scheme_rtcall_s_v(prim_s_v f, Scheme_Object* g144);
#define SIG_iSi_s 22
typedef Scheme_Object* (*prim_iSi_s)(int, Scheme_Object**, int);
Scheme_Object* scheme_rtcall_iSi_s(prim_iSi_s f, int g145, Scheme_Object** g146, int g147);
#define SIG_siS_v 23
typedef void (*prim_siS_v)(Scheme_Object*, int, Scheme_Object**);
void scheme_rtcall_siS_v(prim_siS_v f, Scheme_Object* g148, int g149, Scheme_Object** g150);

171
src/mzscheme/src/jit_ts_runtime_glue.c Normal file
View File

@ -0,0 +1,171 @@
case SIG_siS_s:
{
prim_siS_s f = (prim_siS_s)future->prim_func;
Scheme_Object* retval;
retval =
f(future->arg_s0, future->arg_i1, future->arg_S2);
future->retval_s = retval;
break;
}
case SIG_iSs_s:
{
prim_iSs_s f = (prim_iSs_s)future->prim_func;
Scheme_Object* retval;
retval =
f(future->arg_i0, future->arg_S1, future->arg_s2);
future->retval_s = retval;
break;
}
case SIG_s_s:
{
prim_s_s f = (prim_s_s)future->prim_func;
Scheme_Object* retval;
retval =
f(future->arg_s0);
future->retval_s = retval;
break;
}
case SIG_n_s:
{
prim_n_s f = (prim_n_s)future->prim_func;
Scheme_Object* retval;
retval =
f(future->arg_n0);
future->retval_s = retval;
break;
}
case SIG__s:
{
prim__s f = (prim__s)future->prim_func;
Scheme_Object* retval;
retval =
f();
future->retval_s = retval;
break;
}
case SIG_ss_s:
{
prim_ss_s f = (prim_ss_s)future->prim_func;
Scheme_Object* retval;
retval =
f(future->arg_s0, future->arg_s1);
future->retval_s = retval;
break;
}
case SIG_ss_m:
{
prim_ss_m f = (prim_ss_m)future->prim_func;
MZ_MARK_STACK_TYPE retval;
retval =
f(future->arg_s0, future->arg_s1);
future->retval_m = retval;
break;
}
case SIG_Sl_s:
{
prim_Sl_s f = (prim_Sl_s)future->prim_func;
Scheme_Object* retval;
retval =
f(future->arg_S0, future->arg_l1);
future->retval_s = retval;
break;
}
case SIG_l_s:
{
prim_l_s f = (prim_l_s)future->prim_func;
Scheme_Object* retval;
retval =
f(future->arg_l0);
future->retval_s = retval;
break;
}
case SIG_bsi_v:
{
prim_bsi_v f = (prim_bsi_v)future->prim_func;
f(future->arg_b0, future->arg_s1, future->arg_i2);
break;
}
case SIG_iiS_v:
{
prim_iiS_v f = (prim_iiS_v)future->prim_func;
f(future->arg_i0, future->arg_i1, future->arg_S2);
break;
}
case SIG_ss_v:
{
prim_ss_v f = (prim_ss_v)future->prim_func;
f(future->arg_s0, future->arg_s1);
break;
}
case SIG_b_v:
{
prim_b_v f = (prim_b_v)future->prim_func;
f(future->arg_b0);
break;
}
case SIG_sl_s:
{
prim_sl_s f = (prim_sl_s)future->prim_func;
Scheme_Object* retval;
retval =
f(future->arg_s0, future->arg_l1);
future->retval_s = retval;
break;
}
case SIG_iS_s:
{
prim_iS_s f = (prim_iS_s)future->prim_func;
Scheme_Object* retval;
retval =
f(future->arg_i0, future->arg_S1);
future->retval_s = retval;
break;
}
case SIG_S_s:
{
prim_S_s f = (prim_S_s)future->prim_func;
Scheme_Object* retval;
retval =
f(future->arg_S0);
future->retval_s = retval;
break;
}
case SIG_s_v:
{
prim_s_v f = (prim_s_v)future->prim_func;
f(future->arg_s0);
break;
}
case SIG_iSi_s:
{
prim_iSi_s f = (prim_iSi_s)future->prim_func;
Scheme_Object* retval;
retval =
f(future->arg_i0, future->arg_S1, future->arg_i2);
future->retval_s = retval;
break;
}
case SIG_siS_v:
{
prim_siS_v f = (prim_siS_v)future->prim_func;
f(future->arg_s0, future->arg_i1, future->arg_S2);
break;
}

24
src/mzscheme/src/mzmark.c
View File

@ -5423,9 +5423,15 @@ static int future_MARK(void *p) {
gcMARK(f->runstack);
gcMARK(f->runstack_start);
gcMARK(f->orig_lambda);
gcMARK(f->prim_data.p);
gcMARK(f->prim_data.argv);
gcMARK(f->prim_data.retval);
gcMARK(f->arg_s0);
gcMARK(f->arg_S0);
gcMARK(f->arg_b0);
gcMARK(f->arg_n0);
gcMARK(f->arg_s1);
gcMARK(f->arg_S1);
gcMARK(f->arg_s2);
gcMARK(f->arg_S2);
gcMARK(f->retval_s);
gcMARK(f->retval);
gcMARK(f->prev);
gcMARK(f->next);
@ -5439,9 +5445,15 @@ static int future_FIXUP(void *p) {
gcFIXUP(f->runstack);
gcFIXUP(f->runstack_start);
gcFIXUP(f->orig_lambda);
gcFIXUP(f->prim_data.p);
gcFIXUP(f->prim_data.argv);
gcFIXUP(f->prim_data.retval);
gcFIXUP(f->arg_s0);
gcFIXUP(f->arg_S0);
gcFIXUP(f->arg_b0);
gcFIXUP(f->arg_n0);
gcFIXUP(f->arg_s1);
gcFIXUP(f->arg_S1);
gcFIXUP(f->arg_s2);
gcFIXUP(f->arg_S2);
gcFIXUP(f->retval_s);
gcFIXUP(f->retval);
gcFIXUP(f->prev);
gcFIXUP(f->next);

12
src/mzscheme/src/mzmarksrc.c
View File

@ -2226,9 +2226,15 @@ future {
gcMARK(f->runstack);
gcMARK(f->runstack_start);
gcMARK(f->orig_lambda);
gcMARK(f->prim_data.p);
gcMARK(f->prim_data.argv);
gcMARK(f->prim_data.retval);
gcMARK(f->arg_s0);
gcMARK(f->arg_S0);
gcMARK(f->arg_b0);
gcMARK(f->arg_n0);
gcMARK(f->arg_s1);
gcMARK(f->arg_S1);
gcMARK(f->arg_s2);
gcMARK(f->arg_S2);
gcMARK(f->retval_s);
gcMARK(f->retval);
gcMARK(f->prev);
gcMARK(f->next);