From eb9eeda873726f59f4576e0ff215aae5430e948f Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Thu, 19 Nov 2009 21:56:17 +0000 Subject: [PATCH] cover all functions called form JIT that need to go back to runtime thread svn: r16898 --- src/mzscheme/include/schthread.h | 2 + src/mzscheme/src/Makefile.in | 5 +- src/mzscheme/src/future.c | 322 +++-------------------- src/mzscheme/src/future.h | 77 ++---- src/mzscheme/src/gen-jit-ts.ss | 167 ++++++++++++ src/mzscheme/src/jit.c | 253 +++++++----------- src/mzscheme/src/jit_ts.c | 134 ++++++++++ src/mzscheme/src/jit_ts_def.c | 190 ++++++++++++++ src/mzscheme/src/jit_ts_future_glue.c | 341 +++++++++++++++++++++++++ src/mzscheme/src/jit_ts_glue.c | 240 +++++++++++++++++ src/mzscheme/src/jit_ts_protos.h | 57 +++++ src/mzscheme/src/jit_ts_runtime_glue.c | 171 +++++++++++++ src/mzscheme/src/mzmark.c | 24 +- src/mzscheme/src/mzmarksrc.c | 12 +- 14 files changed, 1482 insertions(+), 513 deletions(-) create mode 100644 src/mzscheme/src/gen-jit-ts.ss create mode 100644 src/mzscheme/src/jit_ts.c create mode 100644 src/mzscheme/src/jit_ts_def.c create mode 100644 src/mzscheme/src/jit_ts_future_glue.c create mode 100644 src/mzscheme/src/jit_ts_glue.c create mode 100644 src/mzscheme/src/jit_ts_protos.h create mode 100644 src/mzscheme/src/jit_ts_runtime_glue.c diff --git a/src/mzscheme/include/schthread.h b/src/mzscheme/include/schthread.h index 37fb3b7dba..e86aad0b49 100644 --- a/src/mzscheme/include/schthread.h +++ b/src/mzscheme/include/schthread.h @@ -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_) diff --git a/src/mzscheme/src/Makefile.in b/src/mzscheme/src/Makefile.in index b95cadcb60..5b6dce72e8 100644 --- a/src/mzscheme/src/Makefile.in +++ b/src/mzscheme/src/Makefile.in @@ -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) \ diff --git a/src/mzscheme/src/future.c b/src/mzscheme/src/future.c index b7fa5e1c85..e95e3505cb 100644 --- a/src/mzscheme/src/future.c +++ b/src/mzscheme/src/future.c @@ -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); diff --git a/src/mzscheme/src/future.h b/src/mzscheme/src/future.h index 69d03ae6b5..364e06c325 100644 --- a/src/mzscheme/src/future.h +++ b/src/mzscheme/src/future.h @@ -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 diff --git a/src/mzscheme/src/gen-jit-ts.ss b/src/mzscheme/src/gen-jit-ts.ss new file mode 100644 index 0000000000..b11dc24e51 --- /dev/null +++ b/src/mzscheme/src/gen-jit-ts.ss @@ -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))) diff --git a/src/mzscheme/src/jit.c b/src/mzscheme/src/jit.c index 03afa3dea5..c5fb9152e4 100644 --- a/src/mzscheme/src/jit.c +++ b/src/mzscheme/src/jit.c @@ -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(); } diff --git a/src/mzscheme/src/jit_ts.c b/src/mzscheme/src/jit_ts.c new file mode 100644 index 0000000000..75ce340f12 --- /dev/null +++ b/src/mzscheme/src/jit_ts.c @@ -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 diff --git a/src/mzscheme/src/jit_ts_def.c b/src/mzscheme/src/jit_ts_def.c new file mode 100644 index 0000000000..4add12c66d --- /dev/null +++ b/src/mzscheme/src/jit_ts_def.c @@ -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; \ +} diff --git a/src/mzscheme/src/jit_ts_future_glue.c b/src/mzscheme/src/jit_ts_future_glue.c new file mode 100644 index 0000000000..894f3cd735 --- /dev/null +++ b/src/mzscheme/src/jit_ts_future_glue.c @@ -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; +} diff --git a/src/mzscheme/src/jit_ts_glue.c b/src/mzscheme/src/jit_ts_glue.c new file mode 100644 index 0000000000..8c9bc4b6a1 --- /dev/null +++ b/src/mzscheme/src/jit_ts_glue.c @@ -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; +} \ No newline at end of file diff --git a/src/mzscheme/src/jit_ts_protos.h b/src/mzscheme/src/jit_ts_protos.h new file mode 100644 index 0000000000..f065f74c5d --- /dev/null +++ b/src/mzscheme/src/jit_ts_protos.h @@ -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); diff --git a/src/mzscheme/src/jit_ts_runtime_glue.c b/src/mzscheme/src/jit_ts_runtime_glue.c new file mode 100644 index 0000000000..9ea93cabc5 --- /dev/null +++ b/src/mzscheme/src/jit_ts_runtime_glue.c @@ -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; + } diff --git a/src/mzscheme/src/mzmark.c b/src/mzscheme/src/mzmark.c index c2c8dc974d..c680d4c4e2 100644 --- a/src/mzscheme/src/mzmark.c +++ b/src/mzscheme/src/mzmark.c @@ -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); diff --git a/src/mzscheme/src/mzmarksrc.c b/src/mzscheme/src/mzmarksrc.c index 12599cc9ed..ebde7f7438 100644 --- a/src/mzscheme/src/mzmarksrc.c +++ b/src/mzscheme/src/mzmarksrc.c @@ -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);