diff --git a/src/mzscheme/src/env.c b/src/mzscheme/src/env.c index a4c4d2ac19..c98945537b 100644 --- a/src/mzscheme/src/env.c +++ b/src/mzscheme/src/env.c @@ -1361,6 +1361,37 @@ Scheme_Hash_Table *scheme_map_constants_to_globals(void) return result; } +const char *scheme_look_for_primitive(void *code) +{ + Scheme_Bucket_Table *ht; + Scheme_Bucket **bs; + Scheme_Env *kenv; + long i; + int j; + + for (j = 0; j < 2; j++) { + if (!j) + kenv = kernel_env; + else + kenv = unsafe_env; + + ht = kenv->toplevel; + bs = ht->buckets; + + for (i = ht->size; i--; ) { + Scheme_Bucket *b = bs[i]; + if (b && b->val) { + if (SCHEME_PRIMP(b->val)) { + if (SCHEME_PRIM(b->val) == code) + return ((Scheme_Primitive_Proc *)b->val)->name; + } + } + } + } + + return NULL; +} + /*========================================================================*/ /* compile-time env, constructors and simple queries */ /*========================================================================*/ diff --git a/src/mzscheme/src/error.c b/src/mzscheme/src/error.c index 1bb6fa88e2..0ba8526b9a 100644 --- a/src/mzscheme/src/error.c +++ b/src/mzscheme/src/error.c @@ -343,7 +343,6 @@ static long sch_vsprintf(char *s, long maxlen, const char *msg, va_list args, ch case 'f': { double f; - j++; f = dbls[dp++]; sprintf(buf, "%f", f); t = buf; diff --git a/src/mzscheme/src/fun.c b/src/mzscheme/src/fun.c index bf32589335..c47c12e119 100644 --- a/src/mzscheme/src/fun.c +++ b/src/mzscheme/src/fun.c @@ -7972,7 +7972,9 @@ long scheme_get_milliseconds(void) } double scheme_get_inexact_milliseconds(void) +/* this function can be called from any OS thread */ { + START_XFORM_SKIP; #ifdef USE_MACTIME { UnsignedWide time; @@ -7997,6 +7999,7 @@ double scheme_get_inexact_milliseconds(void) # endif # endif #endif + END_XFORM_SKIP; } long scheme_get_process_milliseconds(void) diff --git a/src/mzscheme/src/future.c b/src/mzscheme/src/future.c index c6f8734664..a2754c27cb 100644 --- a/src/mzscheme/src/future.c +++ b/src/mzscheme/src/future.c @@ -5,7 +5,6 @@ //This will be TRUE if primitive tracking has been enabled //by the program -int g_print_prims = 0; #ifndef FUTURES_ENABLED @@ -29,18 +28,6 @@ static Scheme_Object *processor_count(int argc, Scheme_Object *argv[]) return NULL; } -static Scheme_Object *start_primitive_tracking(int argc, Scheme_Object *argv[]) -{ - scheme_signal_error("start-primitive-tracking: not enabled"); - return NULL; -} - -static Scheme_Object *end_primitive_tracking(int argc, Scheme_Object *argv[]) -{ - scheme_signal_error("end-primitive-tracking: not enabled"); - return NULL; -} - # define FUTURE_PRIM_W_ARITY(name, func, a1, a2, env) GLOBAL_PRIM_W_ARITY(name, func, a1, a2, env) void scheme_init_futures(Scheme_Env *env) @@ -53,8 +40,6 @@ void scheme_init_futures(Scheme_Env *env) FUTURE_PRIM_W_ARITY("future", future, 1, 1, newenv); FUTURE_PRIM_W_ARITY("touch", touch, 1, 1, newenv); FUTURE_PRIM_W_ARITY("processor-count", processor_count, 1, 1, newenv); - FUTURE_PRIM_W_ARITY("start-primitive-tracking", start_primitive_tracking, 0, 0, newenv); - FUTURE_PRIM_W_ARITY("end-primitive-tracking", end_primitive_tracking, 0, 0, newenv); scheme_finish_primitive_module(newenv); scheme_protect_primitive_provide(newenv, NULL); @@ -299,24 +284,6 @@ void scheme_init_futures(Scheme_Env *env) 1), newenv); - scheme_add_global_constant( - "start-primitive-tracking", - scheme_make_prim_w_arity( - start_primitive_tracking, - "start-primitive-tracking", - 0, - 0), - newenv); - - scheme_add_global_constant( - "end-primitive-tracking", - scheme_make_prim_w_arity( - end_primitive_tracking, - "end-primitive-tracking", - 0, - 0), - newenv); - scheme_finish_primitive_module(newenv); scheme_protect_primitive_provide(newenv, NULL); @@ -468,33 +435,6 @@ void scheme_future_gc_pause() /* Primitive implementations */ /**********************************************************************/ -Scheme_Object *start_primitive_tracking(int argc, Scheme_Object *argv[]) -{ - g_print_prims = 1; - return scheme_void; -} - -Scheme_Object *end_primitive_tracking(int argc, Scheme_Object *argv[]) -{ - g_print_prims = 0; - return scheme_void; -} - -void scheme_log_future_to_runtime(const char *who, void *p) -/* Called in future thread */ -{ - START_XFORM_SKIP; - - if (g_print_prims) { - if (p) - fprintf(stderr, "%p at %lf\n", p, scheme_get_inexact_milliseconds()); - else - fprintf(stderr, "%s at %lf\n", who, scheme_get_inexact_milliseconds()); - } - - END_XFORM_SKIP; -} - Scheme_Object *future(int argc, Scheme_Object *argv[]) /* Called in runtime thread */ { @@ -947,19 +887,24 @@ void future_do_runtimecall(void *func, /**********************************************************************/ /* Functions for primitive invocation */ /**********************************************************************/ -void rtcall_void_void_3args(void (*f)()) +void scheme_rtcall_void_void_3args(const char *who, int src_type, void (*f)()) /* Called in future thread */ { START_XFORM_SKIP; + future_t *future = current_ft; - current_ft->prim_protocol = SIG_VOID_VOID_3ARGS; + future->prim_protocol = SIG_VOID_VOID_3ARGS; + + future->time_of_request = scheme_get_inexact_milliseconds(); + future->source_of_request = who; + future->source_type = src_type; future_do_runtimecall((void*)f, 1); END_XFORM_SKIP; } -void *rtcall_alloc_void_pvoid(void (*f)()) +void *scheme_rtcall_alloc_void_pvoid(const char *who, int src_type, void (*f)()) /* Called in future thread */ { START_XFORM_SKIP; @@ -967,7 +912,12 @@ void *rtcall_alloc_void_pvoid(void (*f)()) void *retval; while (1) { - current_ft->prim_protocol = SIG_ALLOC_VOID_PVOID; + future = current_ft; + future->time_of_request = scheme_get_inexact_milliseconds(); + future->source_of_request = who; + future->source_type = src_type; + + future->prim_protocol = SIG_ALLOC_VOID_PVOID; future_do_runtimecall((void*)f, 1); @@ -1034,6 +984,25 @@ static void do_invoke_rtcall(future_t *future) future->rt_prim = 0; + if (scheme_log_level_p(scheme_main_logger, SCHEME_LOG_DEBUG)) { + const char *src; + + src = future->source_of_request; + if (future->source_type == FSRC_RATOR) { + int len; + src = scheme_get_proc_name(future->arg_s0, &len, 1); + } else if (future->source_type == FSRC_PRIM) { + const char *src2; + src2 = scheme_look_for_primitive(future->prim_func); + if (src2) src = src2; + } + + scheme_log(scheme_main_logger, SCHEME_LOG_DEBUG, 0, + "future: waiting for runtime at %f: %s", + future->time_of_request, + src); + } + switch (future->prim_protocol) { case SIG_VOID_VOID_3ARGS: diff --git a/src/mzscheme/src/future.h b/src/mzscheme/src/future.h index c0d7994a09..0d51b00c69 100644 --- a/src/mzscheme/src/future.h +++ b/src/mzscheme/src/future.h @@ -32,7 +32,7 @@ extern Scheme_Object *processor_count(int argc, Scheme_Object *argv[]); extern void futures_init(void); typedef void (*prim_void_void_3args_t)(Scheme_Object **); -typedef void *(*prim_alloc_void_pvoid_t)(void); +typedef void *(*prim_alloc_void_pvoid_t)(); typedef Scheme_Object* (*prim_obj_int_pobj_obj_t)(Scheme_Object*, int, Scheme_Object**); 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*); @@ -43,6 +43,10 @@ typedef void* (*prim_pvoid_pvoid_pvoid_t)(void*, void*); #define WAITING_FOR_PRIM 2 #define FINISHED 3 +#define FSRC_OTHER 0 +#define FSRC_RATOR 1 +#define FSRC_PRIM 2 + typedef struct future_t { Scheme_Object so; @@ -61,6 +65,9 @@ typedef struct future_t { //Runtime call stuff int rt_prim; /* flag to indicate waiting for a prim call */ int rt_prim_is_atomic; + double time_of_request; + const char *source_of_request; + int source_type; void *alloc_retval; int alloc_retval_counter; @@ -120,12 +127,6 @@ extern void clear_futures(void); //Primitive instrumentation stuff -extern void scheme_log_future_to_runtime(const char *who, void *addr); -#define LOG_PRIM_START(p) scheme_log_future_to_runtime(# p, NULL) -#define LOG_PRIM_END(p) /* empty */ -#define LOG_PRIM_W_NAME(name) scheme_log_future_to_runtime(name, NULL) -#define LOG_PRIM_W_ADDR(addr) scheme_log_future_to_runtime(NULL, addr) - //Signature flags for primitive invocations //Here the convention is SIG_[arg1type]_[arg2type]..._[return type] #define SIG_VOID_VOID_3ARGS 1 //void -> void, copy 3 args from runstack @@ -143,8 +144,8 @@ extern void scheme_log_future_to_runtime(const char *who, void *addr); /*GDB_BREAK;*/ \ } -extern void rtcall_void_void_3args(void (*f)()); -extern void *rtcall_alloc_void_pvoid(void (*f)()); +extern void scheme_rtcall_void_void_3args(const char *who, int src_type, void (*f)()); +extern void *scheme_rtcall_alloc_void_pvoid(const char *who, int src_type, void (*f)()); #else diff --git a/src/mzscheme/src/gen-jit-ts.ss b/src/mzscheme/src/gen-jit-ts.ss index e8b102bc98..7d4928c723 100644 --- a/src/mzscheme/src/gen-jit-ts.ss +++ b/src/mzscheme/src/gen-jit-ts.ss @@ -39,14 +39,13 @@ (define args (make-arg-list arg-types arg-names)) (define ts (symbol->string t)) (for-each display - @list{#define define_ts_@|ts|(id) \ + @list{#define define_ts_@|ts|(id, src_type) \ static @|result-type| ts_ ## id(@|args|) \ { \ START_XFORM_SKIP; \ - if (scheme_use_rtcall) { \ - LOG_PRIM_START(id); \ - @|return| scheme_rtcall_@|t|(id, @(string-join arg-names ", ")); \ - } else \ + if (scheme_use_rtcall) \ + @|return| scheme_rtcall_@|t|("[" #id "]", src_type, id, @(string-join arg-names ", ")); \ + else \ @|return| id(@(string-join arg-names ", ")); \ END_XFORM_SKIP; \ }}) @@ -62,15 +61,20 @@ (for-each display @list{ - @|result-type| scheme_rtcall_@|ts|(prim_@|ts| f@|(if (null? arg-types) "" ",")| @|args|) + @|result-type| scheme_rtcall_@|ts|(const char *who, int src_type, prim_@|ts| f@|(if (null? arg-types) "" ",")| @|args|) { START_XFORM_SKIP; future_t *future; + double tm; @(if (string=? result-type "void") "" @string-append{@|result-type| retval;}) future = current_ft; future->prim_protocol = SIG_@|ts|; future->prim_func = f; + tm = scheme_get_inexact_milliseconds(); + future->time_of_request = tm; + future->source_of_request = who; + future->source_type = src_type; @(string-join (for/list ([t (in-string (type->arg-string t))] [a arg-names] @@ -127,7 +131,7 @@ (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|);}) + (display @string-append{@|result-type| scheme_rtcall_@|ts|(const char *who, int src_type, prim_@|ts| f@(if (null? arg-types) "" ",") @|args|);}) (newline)) (define types diff --git a/src/mzscheme/src/jit.c b/src/mzscheme/src/jit.c index d61b91d4cc..a944f94a8d 100644 --- a/src/mzscheme/src/jit.c +++ b/src/mzscheme/src/jit.c @@ -2168,12 +2168,13 @@ static Scheme_Object *noncm_prim_indirect(Scheme_Prim proc, int argc) { START_XFORM_SKIP; - if (scheme_use_rtcall) { - LOG_PRIM_W_ADDR(proc); - return scheme_rtcall_iS_s(proc, + if (scheme_use_rtcall) + return scheme_rtcall_iS_s("[prim_indirect]", + FSRC_PRIM, + proc, argc, MZ_RUNSTACK); - } else + else return proc(argc, MZ_RUNSTACK); END_XFORM_SKIP; @@ -2182,10 +2183,9 @@ static Scheme_Object *prim_indirect(Scheme_Primitive_Closure_Proc proc, int argc { START_XFORM_SKIP; - if (scheme_use_rtcall) { - LOG_PRIM_W_ADDR(proc); - return scheme_rtcall_iSs_s(proc, argc, MZ_RUNSTACK, self); - } else + if (scheme_use_rtcall) + return scheme_rtcall_iSs_s("[prim_indirect]", FSRC_PRIM, proc, argc, MZ_RUNSTACK, self); + else return proc(argc, MZ_RUNSTACK, self); END_XFORM_SKIP; @@ -2199,8 +2199,7 @@ static void ts_on_demand(void) { START_XFORM_SKIP; if (scheme_use_rtcall) { - LOG_PRIM_START(on_demand); - rtcall_void_void_3args(on_demand_with_args); + scheme_rtcall_void_void_3args("[jit_on_demand]", FSRC_OTHER, on_demand_with_args); } else on_demand(); END_XFORM_SKIP; @@ -2213,10 +2212,9 @@ static void *ts_prepare_retry_alloc(void *p, void *p2) void *ret; if (scheme_use_rtcall) { - LOG_PRIM_START(prepare_retry_alloc); jit_future_storage[0] = p; jit_future_storage[1] = p2; - ret = rtcall_alloc_void_pvoid(GC_make_jit_nursery_page); + ret = scheme_rtcall_alloc_void_pvoid("[acquire_gc_page]", FSRC_OTHER, GC_make_jit_nursery_page); GC_gen0_alloc_page_ptr = ret; retry_alloc_r1 = jit_future_storage[1]; p = jit_future_storage[0]; @@ -2226,7 +2224,6 @@ static void *ts_prepare_retry_alloc(void *p, void *p2) } ret = prepare_retry_alloc(p, p2); - LOG_PRIM_END(&prepare_retry_alloc); return ret; END_XFORM_SKIP; } diff --git a/src/mzscheme/src/jit_ts.c b/src/mzscheme/src/jit_ts.c index 6d96530909..1b778e1f7c 100644 --- a/src/mzscheme/src/jit_ts.c +++ b/src/mzscheme/src/jit_ts.c @@ -13,69 +13,69 @@ z = size_t 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) +define_ts_siS_s(_scheme_apply_multi_from_native, FSRC_RATOR) +define_ts_siS_s(_scheme_apply_from_native, FSRC_RATOR) +define_ts_siS_s(_scheme_tail_apply_from_native, FSRC_RATOR) +define_ts_siS_s(_scheme_tail_apply_from_native_fixup_args, FSRC_RATOR) +define_ts_s_s(scheme_force_value_same_mark, FSRC_OTHER) +define_ts_s_s(scheme_force_one_value_same_mark, FSRC_OTHER) #if defined(INLINE_FP_OPS) && !defined(CAN_INLINE_ALLOC) -define_ts__s(malloc_double) +define_ts__s(malloc_double, FSRC_OTHER) #endif -define_ts_s_s(scheme_box) +define_ts_s_s(scheme_box, FSRC_OTHER) #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) +define_ts_ss_s(scheme_make_mutable_pair, FSRC_OTHER) +define_ts_Sl_s(make_list_star, FSRC_OTHER) +define_ts_Sl_s(make_list, FSRC_OTHER) +define_ts_ss_s(scheme_make_pair, FSRC_OTHER) +define_ts_s_s(make_one_element_ivector, FSRC_OTHER) +define_ts_s_s(make_one_element_vector, FSRC_OTHER) +define_ts_ss_s(make_two_element_ivector, FSRC_OTHER) +define_ts_ss_s(make_two_element_vector, FSRC_OTHER) +define_ts_l_s(make_ivector, FSRC_OTHER) +define_ts_l_s(make_vector, FSRC_OTHER) #endif #ifdef JIT_PRECISE_GC -define_ts_z_p(GC_malloc_one_small_dirty_tagged) -define_ts_z_p(GC_malloc_one_small_tagged) +define_ts_z_p(GC_malloc_one_small_dirty_tagged, FSRC_OTHER) +define_ts_z_p(GC_malloc_one_small_tagged, FSRC_OTHER) #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) +define_ts_n_s(scheme_make_native_closure, FSRC_OTHER) +define_ts_n_s(scheme_make_native_case_closure, FSRC_OTHER) +define_ts_bsi_v(call_set_global_bucket, FSRC_OTHER) +define_ts_s_s(scheme_make_envunbox, FSRC_OTHER) +define_ts_s_s(make_global_ref, FSRC_OTHER) +define_ts_iiS_v(lexical_binding_wrong_return_arity, FSRC_OTHER) +define_ts_ss_m(scheme_set_cont_mark, FSRC_OTHER) +define_ts_iiS_v(call_wrong_return_arity, FSRC_OTHER) +define_ts_b_v(scheme_unbound_global, FSRC_OTHER) +define_ts_Sl_s(scheme_delayed_rename, FSRC_OTHER) +define_ts_iS_s(scheme_checked_car, FSRC_OTHER) +define_ts_iS_s(scheme_checked_cdr, FSRC_OTHER) +define_ts_iS_s(scheme_checked_caar, FSRC_OTHER) +define_ts_iS_s(scheme_checked_cadr, FSRC_OTHER) +define_ts_iS_s(scheme_checked_cdar, FSRC_OTHER) +define_ts_iS_s(scheme_checked_cddr, FSRC_OTHER) +define_ts_iS_s(scheme_checked_mcar, FSRC_OTHER) +define_ts_iS_s(scheme_checked_mcdr, FSRC_OTHER) +define_ts_iS_s(scheme_checked_set_mcar, FSRC_OTHER) +define_ts_iS_s(scheme_checked_set_mcdr, FSRC_OTHER) +define_ts_s_s(scheme_unbox, FSRC_OTHER) +define_ts_s_s(scheme_vector_length, FSRC_OTHER) +define_ts_s_s(tail_call_with_values_from_multiple_result, FSRC_OTHER) +define_ts_s_v(raise_bad_call_with_values, FSRC_OTHER) +define_ts_s_s(call_with_values_from_multiple_result_multi, FSRC_OTHER) +define_ts_s_s(call_with_values_from_multiple_result, FSRC_OTHER) +define_ts_iS_s(scheme_checked_vector_ref, FSRC_OTHER) +define_ts_iS_s(scheme_checked_vector_set, FSRC_OTHER) +define_ts_iS_s(scheme_checked_string_ref, FSRC_OTHER) +define_ts_iS_s(scheme_checked_string_set, FSRC_OTHER) +define_ts_iS_s(scheme_checked_byte_string_ref, FSRC_OTHER) +define_ts_iS_s(scheme_checked_byte_string_set, FSRC_OTHER) +define_ts_iS_s(scheme_checked_syntax_e, FSRC_OTHER) +define_ts_iS_s(scheme_extract_checked_procedure, FSRC_OTHER) +define_ts_S_s(apply_checked_fail, FSRC_OTHER) +define_ts_iSi_s(scheme_build_list_offset, FSRC_OTHER) +define_ts_siS_v(wrong_argument_count, FSRC_OTHER) #else # define ts__scheme_apply_multi_from_native _scheme_apply_multi_from_native # define ts__scheme_apply_from_native _scheme_apply_from_native diff --git a/src/mzscheme/src/jit_ts_def.c b/src/mzscheme/src/jit_ts_def.c index d606a61223..9dfc76623b 100644 --- a/src/mzscheme/src/jit_ts_def.c +++ b/src/mzscheme/src/jit_ts_def.c @@ -1,220 +1,200 @@ -#define define_ts_siS_s(id) \ +#define define_ts_siS_s(id, src_type) \ static Scheme_Object* ts_ ## id(Scheme_Object* g7, int g8, Scheme_Object** g9) \ { \ START_XFORM_SKIP; \ - if (scheme_use_rtcall) { \ - LOG_PRIM_START(id); \ - return scheme_rtcall_siS_s(id, g7, g8, g9); \ - } else \ + if (scheme_use_rtcall) \ + return scheme_rtcall_siS_s("[" #id "]", src_type, id, g7, g8, g9); \ + else \ return id(g7, g8, g9); \ END_XFORM_SKIP; \ } -#define define_ts_iSs_s(id) \ +#define define_ts_iSs_s(id, src_type) \ static Scheme_Object* ts_ ## id(int g10, Scheme_Object** g11, Scheme_Object* g12) \ { \ START_XFORM_SKIP; \ - if (scheme_use_rtcall) { \ - LOG_PRIM_START(id); \ - return scheme_rtcall_iSs_s(id, g10, g11, g12); \ - } else \ + if (scheme_use_rtcall) \ + return scheme_rtcall_iSs_s("[" #id "]", src_type, id, g10, g11, g12); \ + else \ return id(g10, g11, g12); \ END_XFORM_SKIP; \ } -#define define_ts_s_s(id) \ +#define define_ts_s_s(id, src_type) \ static Scheme_Object* ts_ ## id(Scheme_Object* g13) \ { \ START_XFORM_SKIP; \ - if (scheme_use_rtcall) { \ - LOG_PRIM_START(id); \ - return scheme_rtcall_s_s(id, g13); \ - } else \ + if (scheme_use_rtcall) \ + return scheme_rtcall_s_s("[" #id "]", src_type, id, g13); \ + else \ return id(g13); \ END_XFORM_SKIP; \ } -#define define_ts_n_s(id) \ +#define define_ts_n_s(id, src_type) \ static Scheme_Object* ts_ ## id(Scheme_Native_Closure_Data* g14) \ { \ START_XFORM_SKIP; \ - if (scheme_use_rtcall) { \ - LOG_PRIM_START(id); \ - return scheme_rtcall_n_s(id, g14); \ - } else \ + if (scheme_use_rtcall) \ + return scheme_rtcall_n_s("[" #id "]", src_type, id, g14); \ + else \ return id(g14); \ END_XFORM_SKIP; \ } -#define define_ts__s(id) \ +#define define_ts__s(id, src_type) \ static Scheme_Object* ts_ ## id() \ { \ START_XFORM_SKIP; \ - if (scheme_use_rtcall) { \ - LOG_PRIM_START(id); \ - return scheme_rtcall__s(id, ); \ - } else \ + if (scheme_use_rtcall) \ + return scheme_rtcall__s("[" #id "]", src_type, id, ); \ + else \ return id(); \ END_XFORM_SKIP; \ } -#define define_ts_ss_s(id) \ +#define define_ts_ss_s(id, src_type) \ static Scheme_Object* ts_ ## id(Scheme_Object* g15, Scheme_Object* g16) \ { \ START_XFORM_SKIP; \ - if (scheme_use_rtcall) { \ - LOG_PRIM_START(id); \ - return scheme_rtcall_ss_s(id, g15, g16); \ - } else \ + if (scheme_use_rtcall) \ + return scheme_rtcall_ss_s("[" #id "]", src_type, id, g15, g16); \ + else \ return id(g15, g16); \ END_XFORM_SKIP; \ } -#define define_ts_ss_m(id) \ +#define define_ts_ss_m(id, src_type) \ static MZ_MARK_STACK_TYPE ts_ ## id(Scheme_Object* g17, Scheme_Object* g18) \ { \ START_XFORM_SKIP; \ - if (scheme_use_rtcall) { \ - LOG_PRIM_START(id); \ - return scheme_rtcall_ss_m(id, g17, g18); \ - } else \ + if (scheme_use_rtcall) \ + return scheme_rtcall_ss_m("[" #id "]", src_type, id, g17, g18); \ + else \ return id(g17, g18); \ END_XFORM_SKIP; \ } -#define define_ts_Sl_s(id) \ +#define define_ts_Sl_s(id, src_type) \ static Scheme_Object* ts_ ## id(Scheme_Object** g19, long g20) \ { \ START_XFORM_SKIP; \ - if (scheme_use_rtcall) { \ - LOG_PRIM_START(id); \ - return scheme_rtcall_Sl_s(id, g19, g20); \ - } else \ + if (scheme_use_rtcall) \ + return scheme_rtcall_Sl_s("[" #id "]", src_type, id, g19, g20); \ + else \ return id(g19, g20); \ END_XFORM_SKIP; \ } -#define define_ts_l_s(id) \ +#define define_ts_l_s(id, src_type) \ static Scheme_Object* ts_ ## id(long g21) \ { \ START_XFORM_SKIP; \ - if (scheme_use_rtcall) { \ - LOG_PRIM_START(id); \ - return scheme_rtcall_l_s(id, g21); \ - } else \ + if (scheme_use_rtcall) \ + return scheme_rtcall_l_s("[" #id "]", src_type, id, g21); \ + else \ return id(g21); \ END_XFORM_SKIP; \ } -#define define_ts_bsi_v(id) \ +#define define_ts_bsi_v(id, src_type) \ static void ts_ ## id(Scheme_Bucket* g22, Scheme_Object* g23, int g24) \ { \ START_XFORM_SKIP; \ - if (scheme_use_rtcall) { \ - LOG_PRIM_START(id); \ - scheme_rtcall_bsi_v(id, g22, g23, g24); \ - } else \ + if (scheme_use_rtcall) \ + scheme_rtcall_bsi_v("[" #id "]", src_type, id, g22, g23, g24); \ + else \ id(g22, g23, g24); \ END_XFORM_SKIP; \ } -#define define_ts_iiS_v(id) \ +#define define_ts_iiS_v(id, src_type) \ static void ts_ ## id(int g25, int g26, Scheme_Object** g27) \ { \ START_XFORM_SKIP; \ - if (scheme_use_rtcall) { \ - LOG_PRIM_START(id); \ - scheme_rtcall_iiS_v(id, g25, g26, g27); \ - } else \ + if (scheme_use_rtcall) \ + scheme_rtcall_iiS_v("[" #id "]", src_type, id, g25, g26, g27); \ + else \ id(g25, g26, g27); \ END_XFORM_SKIP; \ } -#define define_ts_ss_v(id) \ +#define define_ts_ss_v(id, src_type) \ static void ts_ ## id(Scheme_Object* g28, Scheme_Object* g29) \ { \ START_XFORM_SKIP; \ - if (scheme_use_rtcall) { \ - LOG_PRIM_START(id); \ - scheme_rtcall_ss_v(id, g28, g29); \ - } else \ + if (scheme_use_rtcall) \ + scheme_rtcall_ss_v("[" #id "]", src_type, id, g28, g29); \ + else \ id(g28, g29); \ END_XFORM_SKIP; \ } -#define define_ts_b_v(id) \ +#define define_ts_b_v(id, src_type) \ static void ts_ ## id(Scheme_Bucket* g30) \ { \ START_XFORM_SKIP; \ - if (scheme_use_rtcall) { \ - LOG_PRIM_START(id); \ - scheme_rtcall_b_v(id, g30); \ - } else \ + if (scheme_use_rtcall) \ + scheme_rtcall_b_v("[" #id "]", src_type, id, g30); \ + else \ id(g30); \ END_XFORM_SKIP; \ } -#define define_ts_sl_s(id) \ +#define define_ts_sl_s(id, src_type) \ static Scheme_Object* ts_ ## id(Scheme_Object* g31, long g32) \ { \ START_XFORM_SKIP; \ - if (scheme_use_rtcall) { \ - LOG_PRIM_START(id); \ - return scheme_rtcall_sl_s(id, g31, g32); \ - } else \ + if (scheme_use_rtcall) \ + return scheme_rtcall_sl_s("[" #id "]", src_type, id, g31, g32); \ + else \ return id(g31, g32); \ END_XFORM_SKIP; \ } -#define define_ts_iS_s(id) \ +#define define_ts_iS_s(id, src_type) \ static Scheme_Object* ts_ ## id(int g33, Scheme_Object** g34) \ { \ START_XFORM_SKIP; \ - if (scheme_use_rtcall) { \ - LOG_PRIM_START(id); \ - return scheme_rtcall_iS_s(id, g33, g34); \ - } else \ + if (scheme_use_rtcall) \ + return scheme_rtcall_iS_s("[" #id "]", src_type, id, g33, g34); \ + else \ return id(g33, g34); \ END_XFORM_SKIP; \ } -#define define_ts_S_s(id) \ +#define define_ts_S_s(id, src_type) \ static Scheme_Object* ts_ ## id(Scheme_Object** g35) \ { \ START_XFORM_SKIP; \ - if (scheme_use_rtcall) { \ - LOG_PRIM_START(id); \ - return scheme_rtcall_S_s(id, g35); \ - } else \ + if (scheme_use_rtcall) \ + return scheme_rtcall_S_s("[" #id "]", src_type, id, g35); \ + else \ return id(g35); \ END_XFORM_SKIP; \ } -#define define_ts_s_v(id) \ +#define define_ts_s_v(id, src_type) \ static void ts_ ## id(Scheme_Object* g36) \ { \ START_XFORM_SKIP; \ - if (scheme_use_rtcall) { \ - LOG_PRIM_START(id); \ - scheme_rtcall_s_v(id, g36); \ - } else \ + if (scheme_use_rtcall) \ + scheme_rtcall_s_v("[" #id "]", src_type, id, g36); \ + else \ id(g36); \ END_XFORM_SKIP; \ } -#define define_ts_iSi_s(id) \ +#define define_ts_iSi_s(id, src_type) \ static Scheme_Object* ts_ ## id(int g37, Scheme_Object** g38, int g39) \ { \ START_XFORM_SKIP; \ - if (scheme_use_rtcall) { \ - LOG_PRIM_START(id); \ - return scheme_rtcall_iSi_s(id, g37, g38, g39); \ - } else \ + if (scheme_use_rtcall) \ + return scheme_rtcall_iSi_s("[" #id "]", src_type, id, g37, g38, g39); \ + else \ return id(g37, g38, g39); \ END_XFORM_SKIP; \ } -#define define_ts_siS_v(id) \ +#define define_ts_siS_v(id, src_type) \ static void ts_ ## id(Scheme_Object* g40, int g41, Scheme_Object** g42) \ { \ START_XFORM_SKIP; \ - if (scheme_use_rtcall) { \ - LOG_PRIM_START(id); \ - scheme_rtcall_siS_v(id, g40, g41, g42); \ - } else \ + if (scheme_use_rtcall) \ + scheme_rtcall_siS_v("[" #id "]", src_type, id, g40, g41, g42); \ + else \ id(g40, g41, g42); \ END_XFORM_SKIP; \ } -#define define_ts_z_p(id) \ +#define define_ts_z_p(id, src_type) \ static void* ts_ ## id(size_t g43) \ { \ START_XFORM_SKIP; \ - if (scheme_use_rtcall) { \ - LOG_PRIM_START(id); \ - return scheme_rtcall_z_p(id, g43); \ - } else \ + if (scheme_use_rtcall) \ + return scheme_rtcall_z_p("[" #id "]", src_type, id, g43); \ + else \ return id(g43); \ END_XFORM_SKIP; \ } diff --git a/src/mzscheme/src/jit_ts_future_glue.c b/src/mzscheme/src/jit_ts_future_glue.c index 1d152a76b3..cd02973459 100644 --- a/src/mzscheme/src/jit_ts_future_glue.c +++ b/src/mzscheme/src/jit_ts_future_glue.c @@ -1,12 +1,17 @@ - Scheme_Object* scheme_rtcall_siS_s(prim_siS_s f, Scheme_Object* g44, int g45, Scheme_Object** g46) + Scheme_Object* scheme_rtcall_siS_s(const char *who, int src_type, prim_siS_s f, Scheme_Object* g44, int g45, Scheme_Object** g46) { START_XFORM_SKIP; future_t *future; + double tm; Scheme_Object* retval; future = current_ft; future->prim_protocol = SIG_siS_s; future->prim_func = f; + tm = scheme_get_inexact_milliseconds(); + future->time_of_request = tm; + future->source_of_request = who; + future->source_type = src_type; future->arg_s0 = g44; future->arg_i1 = g45; future->arg_S2 = g46; @@ -18,15 +23,20 @@ return retval; END_XFORM_SKIP; } - Scheme_Object* scheme_rtcall_iSs_s(prim_iSs_s f, int g47, Scheme_Object** g48, Scheme_Object* g49) + Scheme_Object* scheme_rtcall_iSs_s(const char *who, int src_type, prim_iSs_s f, int g47, Scheme_Object** g48, Scheme_Object* g49) { START_XFORM_SKIP; future_t *future; + double tm; Scheme_Object* retval; future = current_ft; future->prim_protocol = SIG_iSs_s; future->prim_func = f; + tm = scheme_get_inexact_milliseconds(); + future->time_of_request = tm; + future->source_of_request = who; + future->source_type = src_type; future->arg_i0 = g47; future->arg_S1 = g48; future->arg_s2 = g49; @@ -38,15 +48,20 @@ return retval; END_XFORM_SKIP; } - Scheme_Object* scheme_rtcall_s_s(prim_s_s f, Scheme_Object* g50) + Scheme_Object* scheme_rtcall_s_s(const char *who, int src_type, prim_s_s f, Scheme_Object* g50) { START_XFORM_SKIP; future_t *future; + double tm; Scheme_Object* retval; future = current_ft; future->prim_protocol = SIG_s_s; future->prim_func = f; + tm = scheme_get_inexact_milliseconds(); + future->time_of_request = tm; + future->source_of_request = who; + future->source_type = src_type; future->arg_s0 = g50; future_do_runtimecall((void*)f, 0); future = current_ft; @@ -56,15 +71,20 @@ return retval; END_XFORM_SKIP; } - Scheme_Object* scheme_rtcall_n_s(prim_n_s f, Scheme_Native_Closure_Data* g51) + Scheme_Object* scheme_rtcall_n_s(const char *who, int src_type, prim_n_s f, Scheme_Native_Closure_Data* g51) { START_XFORM_SKIP; future_t *future; + double tm; Scheme_Object* retval; future = current_ft; future->prim_protocol = SIG_n_s; future->prim_func = f; + tm = scheme_get_inexact_milliseconds(); + future->time_of_request = tm; + future->source_of_request = who; + future->source_type = src_type; future->arg_n0 = g51; future_do_runtimecall((void*)f, 0); future = current_ft; @@ -74,15 +94,20 @@ return retval; END_XFORM_SKIP; } - Scheme_Object* scheme_rtcall__s(prim__s f ) + Scheme_Object* scheme_rtcall__s(const char *who, int src_type, prim__s f ) { START_XFORM_SKIP; future_t *future; + double tm; Scheme_Object* retval; future = current_ft; future->prim_protocol = SIG__s; future->prim_func = f; + tm = scheme_get_inexact_milliseconds(); + future->time_of_request = tm; + future->source_of_request = who; + future->source_type = src_type; future_do_runtimecall((void*)f, 0); future = current_ft; @@ -92,15 +117,20 @@ return retval; END_XFORM_SKIP; } - Scheme_Object* scheme_rtcall_ss_s(prim_ss_s f, Scheme_Object* g52, Scheme_Object* g53) + Scheme_Object* scheme_rtcall_ss_s(const char *who, int src_type, prim_ss_s f, Scheme_Object* g52, Scheme_Object* g53) { START_XFORM_SKIP; future_t *future; + double tm; Scheme_Object* retval; future = current_ft; future->prim_protocol = SIG_ss_s; future->prim_func = f; + tm = scheme_get_inexact_milliseconds(); + future->time_of_request = tm; + future->source_of_request = who; + future->source_type = src_type; future->arg_s0 = g52; future->arg_s1 = g53; future_do_runtimecall((void*)f, 0); @@ -111,15 +141,20 @@ return retval; END_XFORM_SKIP; } - MZ_MARK_STACK_TYPE scheme_rtcall_ss_m(prim_ss_m f, Scheme_Object* g54, Scheme_Object* g55) + MZ_MARK_STACK_TYPE scheme_rtcall_ss_m(const char *who, int src_type, prim_ss_m f, Scheme_Object* g54, Scheme_Object* g55) { START_XFORM_SKIP; future_t *future; + double tm; MZ_MARK_STACK_TYPE retval; future = current_ft; future->prim_protocol = SIG_ss_m; future->prim_func = f; + tm = scheme_get_inexact_milliseconds(); + future->time_of_request = tm; + future->source_of_request = who; + future->source_type = src_type; future->arg_s0 = g54; future->arg_s1 = g55; future_do_runtimecall((void*)f, 0); @@ -130,15 +165,20 @@ return retval; END_XFORM_SKIP; } - Scheme_Object* scheme_rtcall_Sl_s(prim_Sl_s f, Scheme_Object** g56, long g57) + Scheme_Object* scheme_rtcall_Sl_s(const char *who, int src_type, prim_Sl_s f, Scheme_Object** g56, long g57) { START_XFORM_SKIP; future_t *future; + double tm; Scheme_Object* retval; future = current_ft; future->prim_protocol = SIG_Sl_s; future->prim_func = f; + tm = scheme_get_inexact_milliseconds(); + future->time_of_request = tm; + future->source_of_request = who; + future->source_type = src_type; future->arg_S0 = g56; future->arg_l1 = g57; future_do_runtimecall((void*)f, 0); @@ -149,15 +189,20 @@ return retval; END_XFORM_SKIP; } - Scheme_Object* scheme_rtcall_l_s(prim_l_s f, long g58) + Scheme_Object* scheme_rtcall_l_s(const char *who, int src_type, prim_l_s f, long g58) { START_XFORM_SKIP; future_t *future; + double tm; Scheme_Object* retval; future = current_ft; future->prim_protocol = SIG_l_s; future->prim_func = f; + tm = scheme_get_inexact_milliseconds(); + future->time_of_request = tm; + future->source_of_request = who; + future->source_type = src_type; future->arg_l0 = g58; future_do_runtimecall((void*)f, 0); future = current_ft; @@ -167,15 +212,20 @@ return retval; END_XFORM_SKIP; } - void scheme_rtcall_bsi_v(prim_bsi_v f, Scheme_Bucket* g59, Scheme_Object* g60, int g61) + void scheme_rtcall_bsi_v(const char *who, int src_type, prim_bsi_v f, Scheme_Bucket* g59, Scheme_Object* g60, int g61) { START_XFORM_SKIP; future_t *future; + double tm; future = current_ft; future->prim_protocol = SIG_bsi_v; future->prim_func = f; + tm = scheme_get_inexact_milliseconds(); + future->time_of_request = tm; + future->source_of_request = who; + future->source_type = src_type; future->arg_b0 = g59; future->arg_s1 = g60; future->arg_i2 = g61; @@ -187,15 +237,20 @@ END_XFORM_SKIP; } - void scheme_rtcall_iiS_v(prim_iiS_v f, int g62, int g63, Scheme_Object** g64) + void scheme_rtcall_iiS_v(const char *who, int src_type, prim_iiS_v f, int g62, int g63, Scheme_Object** g64) { START_XFORM_SKIP; future_t *future; + double tm; future = current_ft; future->prim_protocol = SIG_iiS_v; future->prim_func = f; + tm = scheme_get_inexact_milliseconds(); + future->time_of_request = tm; + future->source_of_request = who; + future->source_type = src_type; future->arg_i0 = g62; future->arg_i1 = g63; future->arg_S2 = g64; @@ -207,15 +262,20 @@ END_XFORM_SKIP; } - void scheme_rtcall_ss_v(prim_ss_v f, Scheme_Object* g65, Scheme_Object* g66) + void scheme_rtcall_ss_v(const char *who, int src_type, prim_ss_v f, Scheme_Object* g65, Scheme_Object* g66) { START_XFORM_SKIP; future_t *future; + double tm; future = current_ft; future->prim_protocol = SIG_ss_v; future->prim_func = f; + tm = scheme_get_inexact_milliseconds(); + future->time_of_request = tm; + future->source_of_request = who; + future->source_type = src_type; future->arg_s0 = g65; future->arg_s1 = g66; future_do_runtimecall((void*)f, 0); @@ -226,15 +286,20 @@ END_XFORM_SKIP; } - void scheme_rtcall_b_v(prim_b_v f, Scheme_Bucket* g67) + void scheme_rtcall_b_v(const char *who, int src_type, prim_b_v f, Scheme_Bucket* g67) { START_XFORM_SKIP; future_t *future; + double tm; future = current_ft; future->prim_protocol = SIG_b_v; future->prim_func = f; + tm = scheme_get_inexact_milliseconds(); + future->time_of_request = tm; + future->source_of_request = who; + future->source_type = src_type; future->arg_b0 = g67; future_do_runtimecall((void*)f, 0); future = current_ft; @@ -244,15 +309,20 @@ END_XFORM_SKIP; } - Scheme_Object* scheme_rtcall_sl_s(prim_sl_s f, Scheme_Object* g68, long g69) + Scheme_Object* scheme_rtcall_sl_s(const char *who, int src_type, prim_sl_s f, Scheme_Object* g68, long g69) { START_XFORM_SKIP; future_t *future; + double tm; Scheme_Object* retval; future = current_ft; future->prim_protocol = SIG_sl_s; future->prim_func = f; + tm = scheme_get_inexact_milliseconds(); + future->time_of_request = tm; + future->source_of_request = who; + future->source_type = src_type; future->arg_s0 = g68; future->arg_l1 = g69; future_do_runtimecall((void*)f, 0); @@ -263,15 +333,20 @@ return retval; END_XFORM_SKIP; } - Scheme_Object* scheme_rtcall_iS_s(prim_iS_s f, int g70, Scheme_Object** g71) + Scheme_Object* scheme_rtcall_iS_s(const char *who, int src_type, prim_iS_s f, int g70, Scheme_Object** g71) { START_XFORM_SKIP; future_t *future; + double tm; Scheme_Object* retval; future = current_ft; future->prim_protocol = SIG_iS_s; future->prim_func = f; + tm = scheme_get_inexact_milliseconds(); + future->time_of_request = tm; + future->source_of_request = who; + future->source_type = src_type; future->arg_i0 = g70; future->arg_S1 = g71; future_do_runtimecall((void*)f, 0); @@ -282,15 +357,20 @@ return retval; END_XFORM_SKIP; } - Scheme_Object* scheme_rtcall_S_s(prim_S_s f, Scheme_Object** g72) + Scheme_Object* scheme_rtcall_S_s(const char *who, int src_type, prim_S_s f, Scheme_Object** g72) { START_XFORM_SKIP; future_t *future; + double tm; Scheme_Object* retval; future = current_ft; future->prim_protocol = SIG_S_s; future->prim_func = f; + tm = scheme_get_inexact_milliseconds(); + future->time_of_request = tm; + future->source_of_request = who; + future->source_type = src_type; future->arg_S0 = g72; future_do_runtimecall((void*)f, 0); future = current_ft; @@ -300,15 +380,20 @@ return retval; END_XFORM_SKIP; } - void scheme_rtcall_s_v(prim_s_v f, Scheme_Object* g73) + void scheme_rtcall_s_v(const char *who, int src_type, prim_s_v f, Scheme_Object* g73) { START_XFORM_SKIP; future_t *future; + double tm; future = current_ft; future->prim_protocol = SIG_s_v; future->prim_func = f; + tm = scheme_get_inexact_milliseconds(); + future->time_of_request = tm; + future->source_of_request = who; + future->source_type = src_type; future->arg_s0 = g73; future_do_runtimecall((void*)f, 0); future = current_ft; @@ -318,15 +403,20 @@ END_XFORM_SKIP; } - Scheme_Object* scheme_rtcall_iSi_s(prim_iSi_s f, int g74, Scheme_Object** g75, int g76) + Scheme_Object* scheme_rtcall_iSi_s(const char *who, int src_type, prim_iSi_s f, int g74, Scheme_Object** g75, int g76) { START_XFORM_SKIP; future_t *future; + double tm; Scheme_Object* retval; future = current_ft; future->prim_protocol = SIG_iSi_s; future->prim_func = f; + tm = scheme_get_inexact_milliseconds(); + future->time_of_request = tm; + future->source_of_request = who; + future->source_type = src_type; future->arg_i0 = g74; future->arg_S1 = g75; future->arg_i2 = g76; @@ -338,15 +428,20 @@ return retval; END_XFORM_SKIP; } - void scheme_rtcall_siS_v(prim_siS_v f, Scheme_Object* g77, int g78, Scheme_Object** g79) + void scheme_rtcall_siS_v(const char *who, int src_type, prim_siS_v f, Scheme_Object* g77, int g78, Scheme_Object** g79) { START_XFORM_SKIP; future_t *future; + double tm; future = current_ft; future->prim_protocol = SIG_siS_v; future->prim_func = f; + tm = scheme_get_inexact_milliseconds(); + future->time_of_request = tm; + future->source_of_request = who; + future->source_type = src_type; future->arg_s0 = g77; future->arg_i1 = g78; future->arg_S2 = g79; @@ -358,15 +453,20 @@ END_XFORM_SKIP; } - void* scheme_rtcall_z_p(prim_z_p f, size_t g80) + void* scheme_rtcall_z_p(const char *who, int src_type, prim_z_p f, size_t g80) { START_XFORM_SKIP; future_t *future; + double tm; void* retval; future = current_ft; future->prim_protocol = SIG_z_p; future->prim_func = f; + tm = scheme_get_inexact_milliseconds(); + future->time_of_request = tm; + future->source_of_request = who; + future->source_type = src_type; future->arg_z0 = g80; future_do_runtimecall((void*)f, 0); future = current_ft; diff --git a/src/mzscheme/src/jit_ts_protos.h b/src/mzscheme/src/jit_ts_protos.h index 136bfdad9c..0d980befd4 100644 --- a/src/mzscheme/src/jit_ts_protos.h +++ b/src/mzscheme/src/jit_ts_protos.h @@ -1,60 +1,60 @@ #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* g118, int g119, Scheme_Object** g120); +Scheme_Object* scheme_rtcall_siS_s(const char *who, int src_type, prim_siS_s f, Scheme_Object* g118, int g119, Scheme_Object** g120); #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 g121, Scheme_Object** g122, Scheme_Object* g123); +Scheme_Object* scheme_rtcall_iSs_s(const char *who, int src_type, prim_iSs_s f, int g121, Scheme_Object** g122, Scheme_Object* g123); #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* g124); +Scheme_Object* scheme_rtcall_s_s(const char *who, int src_type, prim_s_s f, Scheme_Object* g124); #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* g125); +Scheme_Object* scheme_rtcall_n_s(const char *who, int src_type, prim_n_s f, Scheme_Native_Closure_Data* g125); #define SIG__s 9 typedef Scheme_Object* (*prim__s)(); -Scheme_Object* scheme_rtcall__s(prim__s f ); +Scheme_Object* scheme_rtcall__s(const char *who, int src_type, 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* g126, Scheme_Object* g127); +Scheme_Object* scheme_rtcall_ss_s(const char *who, int src_type, prim_ss_s f, Scheme_Object* g126, Scheme_Object* g127); #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* g128, Scheme_Object* g129); +MZ_MARK_STACK_TYPE scheme_rtcall_ss_m(const char *who, int src_type, prim_ss_m f, Scheme_Object* g128, Scheme_Object* g129); #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** g130, long g131); +Scheme_Object* scheme_rtcall_Sl_s(const char *who, int src_type, prim_Sl_s f, Scheme_Object** g130, long g131); #define SIG_l_s 13 typedef Scheme_Object* (*prim_l_s)(long); -Scheme_Object* scheme_rtcall_l_s(prim_l_s f, long g132); +Scheme_Object* scheme_rtcall_l_s(const char *who, int src_type, prim_l_s f, long g132); #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* g133, Scheme_Object* g134, int g135); +void scheme_rtcall_bsi_v(const char *who, int src_type, prim_bsi_v f, Scheme_Bucket* g133, Scheme_Object* g134, int g135); #define SIG_iiS_v 15 typedef void (*prim_iiS_v)(int, int, Scheme_Object**); -void scheme_rtcall_iiS_v(prim_iiS_v f, int g136, int g137, Scheme_Object** g138); +void scheme_rtcall_iiS_v(const char *who, int src_type, prim_iiS_v f, int g136, int g137, Scheme_Object** g138); #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* g139, Scheme_Object* g140); +void scheme_rtcall_ss_v(const char *who, int src_type, prim_ss_v f, Scheme_Object* g139, Scheme_Object* g140); #define SIG_b_v 17 typedef void (*prim_b_v)(Scheme_Bucket*); -void scheme_rtcall_b_v(prim_b_v f, Scheme_Bucket* g141); +void scheme_rtcall_b_v(const char *who, int src_type, prim_b_v f, Scheme_Bucket* g141); #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* g142, long g143); +Scheme_Object* scheme_rtcall_sl_s(const char *who, int src_type, prim_sl_s f, Scheme_Object* g142, long g143); #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 g144, Scheme_Object** g145); +Scheme_Object* scheme_rtcall_iS_s(const char *who, int src_type, prim_iS_s f, int g144, Scheme_Object** g145); #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** g146); +Scheme_Object* scheme_rtcall_S_s(const char *who, int src_type, prim_S_s f, Scheme_Object** g146); #define SIG_s_v 21 typedef void (*prim_s_v)(Scheme_Object*); -void scheme_rtcall_s_v(prim_s_v f, Scheme_Object* g147); +void scheme_rtcall_s_v(const char *who, int src_type, prim_s_v f, Scheme_Object* g147); #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 g148, Scheme_Object** g149, int g150); +Scheme_Object* scheme_rtcall_iSi_s(const char *who, int src_type, prim_iSi_s f, int g148, Scheme_Object** g149, int g150); #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* g151, int g152, Scheme_Object** g153); +void scheme_rtcall_siS_v(const char *who, int src_type, prim_siS_v f, Scheme_Object* g151, int g152, Scheme_Object** g153); #define SIG_z_p 24 typedef void* (*prim_z_p)(size_t); -void* scheme_rtcall_z_p(prim_z_p f, size_t g154); +void* scheme_rtcall_z_p(const char *who, int src_type, prim_z_p f, size_t g154); diff --git a/src/mzscheme/src/schpriv.h b/src/mzscheme/src/schpriv.h index d89cd69b12..c7579f2353 100644 --- a/src/mzscheme/src/schpriv.h +++ b/src/mzscheme/src/schpriv.h @@ -2422,6 +2422,7 @@ int *scheme_env_get_flags(Scheme_Comp_Env *frame, int start, int count); #define SCHEME_OUT_OF_CONTEXT_LOCAL 8192 Scheme_Hash_Table *scheme_map_constants_to_globals(void); +const char *scheme_look_for_primitive(void *code); Scheme_Object *scheme_expand_expr(Scheme_Object *form, Scheme_Comp_Env *env, Scheme_Expand_Info *erec, int drec);