split jit.c into multiple files
This commit is contained in:
Matthew Flatt
parent
5249152743
commit
4b13dc0ba4
|
|
@ -52,6 +52,13 @@ OBJS = salloc.@LTO@ \
|
||||||
future.@LTO@ \
|
future.@LTO@ \
|
||||||
hash.@LTO@ \
|
hash.@LTO@ \
|
||||||
jit.@LTO@ \
|
jit.@LTO@ \
|
||||||
|
jitalloc.@LTO@ \
|
||||||
|
jitarith.@LTO@ \
|
||||||
|
jitcall.@LTO@ \
|
||||||
|
jitcommon.@LTO@ \
|
||||||
|
jitinline.@LTO@ \
|
||||||
|
jitstack.@LTO@ \
|
||||||
|
jitstate.@LTO@ \
|
||||||
list.@LTO@ \
|
list.@LTO@ \
|
||||||
module.@LTO@ \
|
module.@LTO@ \
|
||||||
mzrt.@LTO@ \
|
mzrt.@LTO@ \
|
||||||
|
|
@ -97,6 +104,13 @@ XSRCS = $(XSRCDIR)/salloc.c \
|
||||||
$(XSRCDIR)/future.c \
|
$(XSRCDIR)/future.c \
|
||||||
$(XSRCDIR)/hash.c \
|
$(XSRCDIR)/hash.c \
|
||||||
$(XSRCDIR)/jit.c \
|
$(XSRCDIR)/jit.c \
|
||||||
|
$(XSRCDIR)/jitalloc.c \
|
||||||
|
$(XSRCDIR)/jitarith.c \
|
||||||
|
$(XSRCDIR)/jitcall.c \
|
||||||
|
$(XSRCDIR)/jitcommon.c \
|
||||||
|
$(XSRCDIR)/jitinline.c \
|
||||||
|
$(XSRCDIR)/jitstack.c \
|
||||||
|
$(XSRCDIR)/jitstate.c \
|
||||||
$(XSRCDIR)/list.c \
|
$(XSRCDIR)/list.c \
|
||||||
$(XSRCDIR)/module.c \
|
$(XSRCDIR)/module.c \
|
||||||
$(XSRCDIR)/network.c \
|
$(XSRCDIR)/network.c \
|
||||||
|
|
@ -183,6 +197,20 @@ $(XSRCDIR)/hash.c: ../src/hash.@LTO@ $(XFORMDEP)
|
||||||
$(XFORM) $(XSRCDIR)/hash.c $(SRCDIR)/hash.c
|
$(XFORM) $(XSRCDIR)/hash.c $(SRCDIR)/hash.c
|
||||||
$(XSRCDIR)/jit.c: ../src/jit.@LTO@ $(XFORMDEP) $(LIGHTNINGDEP)
|
$(XSRCDIR)/jit.c: ../src/jit.@LTO@ $(XFORMDEP) $(LIGHTNINGDEP)
|
||||||
$(XFORM) $(XSRCDIR)/jit.c $(SRCDIR)/jit.c
|
$(XFORM) $(XSRCDIR)/jit.c $(SRCDIR)/jit.c
|
||||||
|
$(XSRCDIR)/jitalloc.c: ../src/jitalloc.@LTO@ $(XFORMDEP) $(LIGHTNINGDEP)
|
||||||
|
$(XFORM) $(XSRCDIR)/jitalloc.c $(SRCDIR)/jitalloc.c
|
||||||
|
$(XSRCDIR)/jitarith.c: ../src/jitarith.@LTO@ $(XFORMDEP) $(LIGHTNINGDEP)
|
||||||
|
$(XFORM) $(XSRCDIR)/jitarith.c $(SRCDIR)/jitarith.c
|
||||||
|
$(XSRCDIR)/jitcall.c: ../src/jitcall.@LTO@ $(XFORMDEP) $(LIGHTNINGDEP)
|
||||||
|
$(XFORM) $(XSRCDIR)/jitcall.c $(SRCDIR)/jitcall.c
|
||||||
|
$(XSRCDIR)/jitcommon.c: ../src/jitcommon.@LTO@ $(XFORMDEP) $(LIGHTNINGDEP)
|
||||||
|
$(XFORM) $(XSRCDIR)/jitcommon.c $(SRCDIR)/jitcommon.c
|
||||||
|
$(XSRCDIR)/jitinline.c: ../src/jitinline.@LTO@ $(XFORMDEP) $(LIGHTNINGDEP)
|
||||||
|
$(XFORM) $(XSRCDIR)/jitinline.c $(SRCDIR)/jitinline.c
|
||||||
|
$(XSRCDIR)/jitstack.c: ../src/jitstack.@LTO@ $(XFORMDEP) $(LIGHTNINGDEP)
|
||||||
|
$(XFORM) $(XSRCDIR)/jitstack.c $(SRCDIR)/jitstack.c
|
||||||
|
$(XSRCDIR)/jitstate.c: ../src/jitstate.@LTO@ $(XFORMDEP) $(LIGHTNINGDEP)
|
||||||
|
$(XFORM) $(XSRCDIR)/jitstate.c $(SRCDIR)/jitstate.c
|
||||||
$(XSRCDIR)/module.c: ../src/module.@LTO@ $(XFORMDEP) $(SRCDIR)/mzrt.h
|
$(XSRCDIR)/module.c: ../src/module.@LTO@ $(XFORMDEP) $(SRCDIR)/mzrt.h
|
||||||
$(XFORM) $(XSRCDIR)/module.c $(SRCDIR)/module.c
|
$(XFORM) $(XSRCDIR)/module.c $(SRCDIR)/module.c
|
||||||
$(XSRCDIR)/list.c: ../src/list.@LTO@ $(XFORMDEP)
|
$(XSRCDIR)/list.c: ../src/list.@LTO@ $(XFORMDEP)
|
||||||
|
|
@ -266,6 +294,20 @@ hash.@LTO@: $(XSRCDIR)/hash.c
|
||||||
$(CC) $(CFLAGS) -c $(XSRCDIR)/hash.c -o hash.@LTO@
|
$(CC) $(CFLAGS) -c $(XSRCDIR)/hash.c -o hash.@LTO@
|
||||||
jit.@LTO@: $(XSRCDIR)/jit.c
|
jit.@LTO@: $(XSRCDIR)/jit.c
|
||||||
$(CC) $(CFLAGS) -c $(XSRCDIR)/jit.c -o jit.@LTO@
|
$(CC) $(CFLAGS) -c $(XSRCDIR)/jit.c -o jit.@LTO@
|
||||||
|
jitalloc.@LTO@: $(XSRCDIR)/jitalloc.c
|
||||||
|
$(CC) $(CFLAGS) -c $(XSRCDIR)/jitalloc.c -o jitalloc.@LTO@
|
||||||
|
jitarith.@LTO@: $(XSRCDIR)/jitarith.c
|
||||||
|
$(CC) $(CFLAGS) -c $(XSRCDIR)/jitarith.c -o jitarith.@LTO@
|
||||||
|
jitcall.@LTO@: $(XSRCDIR)/jitcall.c
|
||||||
|
$(CC) $(CFLAGS) -c $(XSRCDIR)/jitcall.c -o jitcall.@LTO@
|
||||||
|
jitcommon.@LTO@: $(XSRCDIR)/jitcommon.c
|
||||||
|
$(CC) $(CFLAGS) -c $(XSRCDIR)/jitcommon.c -o jitcommon.@LTO@
|
||||||
|
jitinline.@LTO@: $(XSRCDIR)/jitinline.c
|
||||||
|
$(CC) $(CFLAGS) -c $(XSRCDIR)/jitinline.c -o jitinline.@LTO@
|
||||||
|
jitstack.@LTO@: $(XSRCDIR)/jitstack.c
|
||||||
|
$(CC) $(CFLAGS) -c $(XSRCDIR)/jitstack.c -o jitstack.@LTO@
|
||||||
|
jitstate.@LTO@: $(XSRCDIR)/jitstate.c
|
||||||
|
$(CC) $(CFLAGS) -c $(XSRCDIR)/jitstate.c -o jitstate.@LTO@
|
||||||
list.@LTO@: $(XSRCDIR)/list.c
|
list.@LTO@: $(XSRCDIR)/list.c
|
||||||
$(CC) $(CFLAGS) -c $(XSRCDIR)/list.c -o list.@LTO@
|
$(CC) $(CFLAGS) -c $(XSRCDIR)/list.c -o list.@LTO@
|
||||||
module.@LTO@: $(XSRCDIR)/module.c
|
module.@LTO@: $(XSRCDIR)/module.c
|
||||||
|
|
|
||||||
|
|
@ -158,7 +158,7 @@ typedef struct Thread_Local_Variables {
|
||||||
struct Scheme_Object **fixup_runstack_base_;
|
struct Scheme_Object **fixup_runstack_base_;
|
||||||
int fixup_already_in_place_;
|
int fixup_already_in_place_;
|
||||||
void *retry_alloc_r1_;
|
void *retry_alloc_r1_;
|
||||||
double save_fp_;
|
double scheme_jit_save_fp_;
|
||||||
struct Scheme_Bucket_Table *starts_table_;
|
struct Scheme_Bucket_Table *starts_table_;
|
||||||
struct Scheme_Modidx *modidx_caching_chain_;
|
struct Scheme_Modidx *modidx_caching_chain_;
|
||||||
struct Scheme_Object *global_shift_cache_;
|
struct Scheme_Object *global_shift_cache_;
|
||||||
|
|
@ -472,7 +472,7 @@ XFORM_GC_VARIABLE_STACK_THROUGH_THREAD_LOCAL;
|
||||||
#define fixup_runstack_base XOA (scheme_get_thread_local_variables()->fixup_runstack_base_)
|
#define fixup_runstack_base XOA (scheme_get_thread_local_variables()->fixup_runstack_base_)
|
||||||
#define fixup_already_in_place XOA (scheme_get_thread_local_variables()->fixup_already_in_place_)
|
#define fixup_already_in_place XOA (scheme_get_thread_local_variables()->fixup_already_in_place_)
|
||||||
#define retry_alloc_r1 XOA (scheme_get_thread_local_variables()->retry_alloc_r1_)
|
#define retry_alloc_r1 XOA (scheme_get_thread_local_variables()->retry_alloc_r1_)
|
||||||
#define save_fp XOA (scheme_get_thread_local_variables()->save_fp_)
|
#define scheme_jit_save_fp XOA (scheme_get_thread_local_variables()->scheme_jit_save_fp_)
|
||||||
#define starts_table XOA (scheme_get_thread_local_variables()->starts_table_)
|
#define starts_table XOA (scheme_get_thread_local_variables()->starts_table_)
|
||||||
#define modidx_caching_chain XOA (scheme_get_thread_local_variables()->modidx_caching_chain_)
|
#define modidx_caching_chain XOA (scheme_get_thread_local_variables()->modidx_caching_chain_)
|
||||||
#define global_shift_cache XOA (scheme_get_thread_local_variables()->global_shift_cache_)
|
#define global_shift_cache XOA (scheme_get_thread_local_variables()->global_shift_cache_)
|
||||||
|
|
|
||||||
|
|
@ -28,6 +28,13 @@ OBJS = salloc.@LTO@ \
|
||||||
gmp.@LTO@ \
|
gmp.@LTO@ \
|
||||||
hash.@LTO@ \
|
hash.@LTO@ \
|
||||||
jit.@LTO@ \
|
jit.@LTO@ \
|
||||||
|
jitalloc.@LTO@ \
|
||||||
|
jitarith.@LTO@ \
|
||||||
|
jitcall.@LTO@ \
|
||||||
|
jitcommon.@LTO@ \
|
||||||
|
jitinline.@LTO@ \
|
||||||
|
jitstack.@LTO@ \
|
||||||
|
jitstate.@LTO@ \
|
||||||
list.@LTO@ \
|
list.@LTO@ \
|
||||||
module.@LTO@ \
|
module.@LTO@ \
|
||||||
mzrt.@LTO@ \
|
mzrt.@LTO@ \
|
||||||
|
|
@ -71,6 +78,13 @@ SRCS = $(srcdir)/salloc.c \
|
||||||
$(srcdir)/gmp/gmp.c \
|
$(srcdir)/gmp/gmp.c \
|
||||||
$(srcdir)/hash.c \
|
$(srcdir)/hash.c \
|
||||||
$(srcdir)/jit.c \
|
$(srcdir)/jit.c \
|
||||||
|
$(srcdir)/jitalloc.c \
|
||||||
|
$(srcdir)/jitarith.c \
|
||||||
|
$(srcdir)/jitcall.c \
|
||||||
|
$(srcdir)/jitcommon.c \
|
||||||
|
$(srcdir)/jitinline.c \
|
||||||
|
$(srcdir)/jitstack.c \
|
||||||
|
$(srcdir)/jitstate.c \
|
||||||
$(srcdir)/list.c \
|
$(srcdir)/list.c \
|
||||||
$(srcdir)/module.c \
|
$(srcdir)/module.c \
|
||||||
$(srcdir)/mzrt.c \
|
$(srcdir)/mzrt.c \
|
||||||
|
|
@ -180,6 +194,20 @@ hash.@LTO@: $(srcdir)/hash.c
|
||||||
$(CC) $(CFLAGS) -c $(srcdir)/hash.c -o hash.@LTO@
|
$(CC) $(CFLAGS) -c $(srcdir)/hash.c -o hash.@LTO@
|
||||||
jit.@LTO@: $(srcdir)/jit.c
|
jit.@LTO@: $(srcdir)/jit.c
|
||||||
$(CC) $(CFLAGS) -c $(srcdir)/jit.c -o jit.@LTO@
|
$(CC) $(CFLAGS) -c $(srcdir)/jit.c -o jit.@LTO@
|
||||||
|
jitalloc.@LTO@: $(srcdir)/jitalloc.c
|
||||||
|
$(CC) $(CFLAGS) -c $(srcdir)/jitalloc.c -o jitalloc.@LTO@
|
||||||
|
jitarith.@LTO@: $(srcdir)/jitarith.c
|
||||||
|
$(CC) $(CFLAGS) -c $(srcdir)/jitarith.c -o jitarith.@LTO@
|
||||||
|
jitcall.@LTO@: $(srcdir)/jitcall.c
|
||||||
|
$(CC) $(CFLAGS) -c $(srcdir)/jitcall.c -o jitcall.@LTO@
|
||||||
|
jitcommon.@LTO@: $(srcdir)/jitcommon.c
|
||||||
|
$(CC) $(CFLAGS) -c $(srcdir)/jitcommon.c -o jitcommon.@LTO@
|
||||||
|
jitinline.@LTO@: $(srcdir)/jitinline.c
|
||||||
|
$(CC) $(CFLAGS) -c $(srcdir)/jitinline.c -o jitinline.@LTO@
|
||||||
|
jitstack.@LTO@: $(srcdir)/jitstack.c
|
||||||
|
$(CC) $(CFLAGS) -c $(srcdir)/jitstack.c -o jitstack.@LTO@
|
||||||
|
jitstate.@LTO@: $(srcdir)/jitstate.c
|
||||||
|
$(CC) $(CFLAGS) -c $(srcdir)/jitstate.c -o jitstate.@LTO@
|
||||||
list.@LTO@: $(srcdir)/list.c
|
list.@LTO@: $(srcdir)/list.c
|
||||||
$(CC) $(CFLAGS) -c $(srcdir)/list.c -o list.@LTO@
|
$(CC) $(CFLAGS) -c $(srcdir)/list.c -o list.@LTO@
|
||||||
module.@LTO@: $(srcdir)/module.c
|
module.@LTO@: $(srcdir)/module.c
|
||||||
|
|
@ -242,6 +270,17 @@ SCONFIG = $(srcdir)/../sconfig.h $(srcdir)/../uconfig.h ../mzconfig.h
|
||||||
|
|
||||||
COMMON_HEADERS = $(srcdir)/schpriv.h $(srcdir)/schexn.h $(SCONFIG) $(srcdir)/../include/scheme.h \
|
COMMON_HEADERS = $(srcdir)/schpriv.h $(srcdir)/schexn.h $(SCONFIG) $(srcdir)/../include/scheme.h \
|
||||||
$(srcdir)/../include/schthread.h
|
$(srcdir)/../include/schthread.h
|
||||||
|
JIT_HEADERS = $(srcdir)/../src/jit.h \
|
||||||
|
$(srcdir)/../src/stypes.h $(srcdir)/mzmark.c \
|
||||||
|
$(srcdir)/lightning/i386/core.h $(srcdir)/lightning/i386/core-common.h \
|
||||||
|
$(srcdir)/lightning/i386/asm.h $(srcdir)/lightning/i386/asm-common.h \
|
||||||
|
$(srcdir)/lightning/i386/funcs.h $(srcdir)/lightning/i386/funcs-common.h \
|
||||||
|
$(srcdir)/lightning/i386/fp.h $(srcdir)/lightning/i386/fp-common.h \
|
||||||
|
$(srcdir)/lightning/ppc/core.h $(srcdir)/lightning/ppc/core-common.h \
|
||||||
|
$(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)/jit_ts.c $(srcdir)/jit_ts_protos.h
|
||||||
|
|
||||||
salloc.@LTO@: $(COMMON_HEADERS) \
|
salloc.@LTO@: $(COMMON_HEADERS) \
|
||||||
$(srcdir)/../gc/gc.h $(srcdir)/mzmark.c
|
$(srcdir)/../gc/gc.h $(srcdir)/mzmark.c
|
||||||
|
|
@ -276,17 +315,14 @@ future.@LTO@: $(COMMON_HEADERS) $(srcdir)/future.h $(SCONFIG) \
|
||||||
$(srcdir)/jit_ts_future_glue.c $(srcdir)/jit_ts_runtime_glue.c $(srcdir)/jit_ts_protos.h
|
$(srcdir)/jit_ts_future_glue.c $(srcdir)/jit_ts_runtime_glue.c $(srcdir)/jit_ts_protos.h
|
||||||
hash.@LTO@: $(COMMON_HEADERS) \
|
hash.@LTO@: $(COMMON_HEADERS) \
|
||||||
$(srcdir)/../src/stypes.h $(srcdir)/mzmark.c
|
$(srcdir)/../src/stypes.h $(srcdir)/mzmark.c
|
||||||
jit.@LTO@: $(COMMON_HEADERS) \
|
jit.@LTO@: $(COMMON_HEADERS) $(JIT_HEADERS)
|
||||||
$(srcdir)/../src/stypes.h $(srcdir)/codetab.inc $(srcdir)/mzmark.c \
|
jitalloc.@LTO@: $(COMMON_HEADERS) $(JIT_HEADERS)
|
||||||
$(srcdir)/lightning/i386/core.h $(srcdir)/lightning/i386/core-common.h \
|
jitarith.@LTO@: $(COMMON_HEADERS) $(JIT_HEADERS)
|
||||||
$(srcdir)/lightning/i386/asm.h $(srcdir)/lightning/i386/asm-common.h \
|
jitcall.@LTO@: $(COMMON_HEADERS) $(JIT_HEADERS)
|
||||||
$(srcdir)/lightning/i386/funcs.h $(srcdir)/lightning/i386/funcs-common.h \
|
jitcommon.@LTO@: $(COMMON_HEADERS) $(JIT_HEADERS)
|
||||||
$(srcdir)/lightning/i386/fp.h $(srcdir)/lightning/i386/fp-common.h \
|
jitinline.@LTO@: $(COMMON_HEADERS) $(JIT_HEADERS)
|
||||||
$(srcdir)/lightning/ppc/core.h $(srcdir)/lightning/ppc/core-common.h \
|
jitstack.@LTO@: $(COMMON_HEADERS) $(JIT_HEADERS) $(srcdir)/codetab.inc
|
||||||
$(srcdir)/lightning/ppc/asm.h $(srcdir)/lightning/ppc/asm-common.h \
|
jitstate.@LTO@: $(COMMON_HEADERS) $(JIT_HEADERS)
|
||||||
$(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)/jit_ts.c $(srcdir)/jit_ts_protos.h
|
|
||||||
list.@LTO@: $(COMMON_HEADERS) \
|
list.@LTO@: $(COMMON_HEADERS) \
|
||||||
$(srcdir)/../src/stypes.h
|
$(srcdir)/../src/stypes.h
|
||||||
module.@LTO@: $(COMMON_HEADERS) \
|
module.@LTO@: $(COMMON_HEADERS) \
|
||||||
|
|
|
||||||
|
|
@ -61,7 +61,7 @@ static void **malloc_node()
|
||||||
return v;
|
return v;
|
||||||
}
|
}
|
||||||
|
|
||||||
static void add_symbol(uintptr_t start, uintptr_t end, void *value, int gc_able)
|
void scheme_jit_add_symbol(uintptr_t start, uintptr_t end, void *value, int gc_able)
|
||||||
{
|
{
|
||||||
uintptr_t k1, k2, split_t_start = 0, split_t_end = 0, i;
|
uintptr_t k1, k2, split_t_start = 0, split_t_end = 0, i;
|
||||||
int m;
|
int m;
|
||||||
|
|
|
||||||
|
|
@ -189,7 +189,6 @@ extern Scheme_Object *future_touch(int futureid);
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
#else
|
#else
|
||||||
Scheme_Object *scheme_make_fsemaphore(int argc, Scheme_Object *argv[]);
|
|
||||||
#endif /* MZ_USE_FUTURES */
|
#endif /* MZ_USE_FUTURES */
|
||||||
|
|
||||||
/* always defined: */
|
/* always defined: */
|
||||||
|
|
@ -198,6 +197,7 @@ Scheme_Object *scheme_current_future(int argc, Scheme_Object *argv[]);
|
||||||
Scheme_Object *scheme_fsemaphore_p(int argc, Scheme_Object *argv[]);
|
Scheme_Object *scheme_fsemaphore_p(int argc, Scheme_Object *argv[]);
|
||||||
|
|
||||||
Scheme_Object *scheme_fsemaphore_count(int argc, Scheme_Object *argv[]);
|
Scheme_Object *scheme_fsemaphore_count(int argc, Scheme_Object *argv[]);
|
||||||
|
Scheme_Object *scheme_make_fsemaphore(int argc, Scheme_Object *argv[]);
|
||||||
Scheme_Object *scheme_make_fsemaphore_inl(Scheme_Object *ready);
|
Scheme_Object *scheme_make_fsemaphore_inl(Scheme_Object *ready);
|
||||||
Scheme_Object *scheme_fsemaphore_wait(int argc, Scheme_Object *argv[]);
|
Scheme_Object *scheme_fsemaphore_wait(int argc, Scheme_Object *argv[]);
|
||||||
Scheme_Object *scheme_fsemaphore_post(int argc, Scheme_Object *argv[]);
|
Scheme_Object *scheme_fsemaphore_post(int argc, Scheme_Object *argv[]);
|
||||||
|
|
|
||||||
11730
src/racket/src/jit.c
11730
src/racket/src/jit.c
File diff suppressed because it is too large
Load Diff
1199
src/racket/src/jit.h
Normal file
1199
src/racket/src/jit.h
Normal file
File diff suppressed because it is too large
Load Diff
|
|
@ -14,43 +14,39 @@
|
||||||
z = size_t
|
z = size_t
|
||||||
m = MZ_MARK_STACK_TYPE */
|
m = MZ_MARK_STACK_TYPE */
|
||||||
|
|
||||||
define_ts_siS_s(_scheme_apply_multi_from_native, FSRC_RATOR)
|
#ifdef JIT_TS_PROCS
|
||||||
define_ts_siS_s(_scheme_apply_from_native, FSRC_RATOR)
|
|
||||||
define_ts_siS_s(_scheme_tail_apply_from_native, FSRC_RATOR)
|
|
||||||
define_ts_s_s(scheme_force_value_same_mark, FSRC_MARKS)
|
|
||||||
define_ts_s_s(scheme_force_one_value_same_mark, FSRC_MARKS)
|
|
||||||
#if defined(INLINE_FP_OPS) && !defined(CAN_INLINE_ALLOC)
|
|
||||||
define_ts__s(malloc_double, FSRC_OTHER)
|
|
||||||
#endif
|
|
||||||
define_ts_s_s(scheme_box, FSRC_OTHER)
|
|
||||||
define_ts_ss_v(scheme_set_box, FSRC_OTHER)
|
|
||||||
#ifndef CAN_INLINE_ALLOC
|
|
||||||
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, FSRC_OTHER)
|
|
||||||
define_ts_z_p(GC_malloc_one_small_tagged, FSRC_OTHER)
|
|
||||||
#endif
|
|
||||||
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_MARKS)
|
define_ts_bsi_v(call_set_global_bucket, FSRC_MARKS)
|
||||||
#ifndef CAN_INLINE_ALLOC
|
|
||||||
define_ts_s_s(scheme_make_envunbox, FSRC_OTHER)
|
|
||||||
#endif
|
|
||||||
define_ts_s_s(make_global_ref, FSRC_OTHER)
|
define_ts_s_s(make_global_ref, FSRC_OTHER)
|
||||||
define_ts_iiS_v(lexical_binding_wrong_return_arity, FSRC_MARKS)
|
define_ts_iiS_v(lexical_binding_wrong_return_arity, FSRC_MARKS)
|
||||||
|
define_ts_siS_v(wrong_argument_count, FSRC_MARKS)
|
||||||
|
# ifdef JIT_PRECISE_GC
|
||||||
|
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, FSRC_OTHER)
|
||||||
|
define_ts_n_s(scheme_make_native_case_closure, FSRC_OTHER)
|
||||||
|
# ifndef CAN_INLINE_ALLOC
|
||||||
|
define_ts_s_s(scheme_make_envunbox, FSRC_OTHER)
|
||||||
|
# endif
|
||||||
|
define_ts_iSi_s(scheme_build_list_offset, FSRC_OTHER)
|
||||||
|
#endif
|
||||||
|
|
||||||
|
#ifdef JITARITH_TS_PROCS
|
||||||
|
# if defined(INLINE_FP_OPS) && !defined(CAN_INLINE_ALLOC)
|
||||||
|
define_ts__s(malloc_double, FSRC_OTHER)
|
||||||
|
# endif
|
||||||
|
#endif
|
||||||
|
|
||||||
|
#ifdef JITCOMMON_TS_PROCS
|
||||||
define_ts_iiS_v(call_wrong_return_arity, FSRC_MARKS)
|
define_ts_iiS_v(call_wrong_return_arity, FSRC_MARKS)
|
||||||
define_ts_b_v(scheme_unbound_global, FSRC_MARKS)
|
define_ts_s_s(tail_call_with_values_from_multiple_result, FSRC_MARKS)
|
||||||
|
define_ts_s_v(raise_bad_call_with_values, FSRC_MARKS)
|
||||||
|
define_ts_s_s(call_with_values_from_multiple_result_multi, FSRC_MARKS)
|
||||||
|
define_ts_s_s(call_with_values_from_multiple_result, FSRC_MARKS)
|
||||||
|
define_ts_S_s(apply_checked_fail, FSRC_MARKS)
|
||||||
define_ts_Sl_s(scheme_delayed_rename, FSRC_OTHER)
|
define_ts_Sl_s(scheme_delayed_rename, FSRC_OTHER)
|
||||||
|
define_ts_b_v(scheme_unbound_global, FSRC_MARKS)
|
||||||
|
define_ts_ss_v(scheme_set_box, FSRC_OTHER)
|
||||||
define_ts_iS_s(scheme_checked_car, FSRC_MARKS)
|
define_ts_iS_s(scheme_checked_car, FSRC_MARKS)
|
||||||
define_ts_iS_s(scheme_checked_cdr, FSRC_MARKS)
|
define_ts_iS_s(scheme_checked_cdr, FSRC_MARKS)
|
||||||
define_ts_iS_s(scheme_checked_caar, FSRC_MARKS)
|
define_ts_iS_s(scheme_checked_caar, FSRC_MARKS)
|
||||||
|
|
@ -67,19 +63,6 @@ define_ts_iS_s(scheme_checked_make_rectangular, FSRC_MARKS)
|
||||||
define_ts_iS_s(scheme_checked_flimag_part, FSRC_MARKS)
|
define_ts_iS_s(scheme_checked_flimag_part, FSRC_MARKS)
|
||||||
define_ts_iS_s(scheme_checked_flreal_part, FSRC_MARKS)
|
define_ts_iS_s(scheme_checked_flreal_part, FSRC_MARKS)
|
||||||
define_ts_iS_s(scheme_checked_make_flrectangular, FSRC_MARKS)
|
define_ts_iS_s(scheme_checked_make_flrectangular, FSRC_MARKS)
|
||||||
#ifndef CAN_INLINE_ALLOC
|
|
||||||
define_ts_tt_s(scheme_make_complex, FSRC_OTHER)
|
|
||||||
#endif
|
|
||||||
define_ts_s_s(scheme_unbox, FSRC_MARKS)
|
|
||||||
define_ts_s_s(scheme_vector_length, FSRC_MARKS)
|
|
||||||
define_ts_s_s(scheme_flvector_length, FSRC_MARKS)
|
|
||||||
define_ts_s_s(scheme_fxvector_length, FSRC_MARKS)
|
|
||||||
define_ts_si_s(scheme_struct_ref, FSRC_MARKS)
|
|
||||||
define_ts_sis_v(scheme_struct_set, FSRC_MARKS)
|
|
||||||
define_ts_s_s(tail_call_with_values_from_multiple_result, FSRC_MARKS)
|
|
||||||
define_ts_s_v(raise_bad_call_with_values, FSRC_MARKS)
|
|
||||||
define_ts_s_s(call_with_values_from_multiple_result_multi, FSRC_MARKS)
|
|
||||||
define_ts_s_s(call_with_values_from_multiple_result, FSRC_MARKS)
|
|
||||||
define_ts_iS_s(scheme_checked_vector_ref, FSRC_MARKS)
|
define_ts_iS_s(scheme_checked_vector_ref, FSRC_MARKS)
|
||||||
define_ts_iS_s(scheme_checked_vector_set, FSRC_MARKS)
|
define_ts_iS_s(scheme_checked_vector_set, FSRC_MARKS)
|
||||||
define_ts_iS_s(scheme_checked_string_ref, FSRC_MARKS)
|
define_ts_iS_s(scheme_checked_string_ref, FSRC_MARKS)
|
||||||
|
|
@ -91,10 +74,46 @@ define_ts_iS_s(scheme_checked_flvector_set, FSRC_MARKS)
|
||||||
define_ts_iS_s(scheme_checked_fxvector_ref, FSRC_MARKS)
|
define_ts_iS_s(scheme_checked_fxvector_ref, FSRC_MARKS)
|
||||||
define_ts_iS_s(scheme_checked_fxvector_set, FSRC_MARKS)
|
define_ts_iS_s(scheme_checked_fxvector_set, FSRC_MARKS)
|
||||||
define_ts_iS_s(scheme_checked_syntax_e, FSRC_MARKS)
|
define_ts_iS_s(scheme_checked_syntax_e, FSRC_MARKS)
|
||||||
|
define_ts_s_s(scheme_vector_length, FSRC_MARKS)
|
||||||
|
define_ts_s_s(scheme_flvector_length, FSRC_MARKS)
|
||||||
|
define_ts_s_s(scheme_fxvector_length, FSRC_MARKS)
|
||||||
|
define_ts_s_s(scheme_unbox, FSRC_MARKS)
|
||||||
|
define_ts_si_s(scheme_struct_ref, FSRC_MARKS)
|
||||||
|
define_ts_sis_v(scheme_struct_set, FSRC_MARKS)
|
||||||
define_ts_iS_s(scheme_extract_checked_procedure, FSRC_MARKS)
|
define_ts_iS_s(scheme_extract_checked_procedure, FSRC_MARKS)
|
||||||
define_ts_S_s(apply_checked_fail, FSRC_MARKS)
|
#endif
|
||||||
define_ts_iSi_s(scheme_build_list_offset, FSRC_OTHER)
|
|
||||||
define_ts_siS_v(wrong_argument_count, FSRC_MARKS)
|
#ifdef JITCALL_TS_PROCS
|
||||||
|
define_ts_siS_s(_scheme_tail_apply_from_native, FSRC_RATOR)
|
||||||
|
define_ts_s_s(scheme_force_value_same_mark, FSRC_MARKS)
|
||||||
|
define_ts_s_s(scheme_force_one_value_same_mark, FSRC_MARKS)
|
||||||
|
#endif
|
||||||
|
|
||||||
|
#ifdef JITINLINE_TS_PROCS
|
||||||
|
# ifndef CAN_INLINE_ALLOC
|
||||||
|
define_ts_ss_s(scheme_make_pair, FSRC_OTHER)
|
||||||
|
define_ts_ss_s(scheme_make_mutable_pair, FSRC_OTHER)
|
||||||
|
define_ts_tt_s(scheme_make_complex, FSRC_OTHER)
|
||||||
|
define_ts_Sl_s(scheme_jit_make_list_star, FSRC_OTHER)
|
||||||
|
define_ts_Sl_s(scheme_jit_make_list, FSRC_OTHER)
|
||||||
|
define_ts_s_s(scheme_jit_make_one_element_ivector, FSRC_OTHER)
|
||||||
|
define_ts_s_s(scheme_jit_make_one_element_vector, FSRC_OTHER)
|
||||||
|
define_ts_ss_s(scheme_jit_make_two_element_ivector, FSRC_OTHER)
|
||||||
|
define_ts_ss_s(scheme_jit_make_two_element_vector, FSRC_OTHER)
|
||||||
|
define_ts_l_s(scheme_jit_make_ivector, FSRC_OTHER)
|
||||||
|
define_ts_l_s(scheme_jit_make_vector, FSRC_OTHER)
|
||||||
|
# endif
|
||||||
|
#endif
|
||||||
|
|
||||||
|
#ifdef JIT_APPLY_TS_PROCS
|
||||||
|
define_ts_siS_s(_scheme_apply_multi_from_native, FSRC_RATOR)
|
||||||
|
define_ts_siS_s(_scheme_apply_from_native, FSRC_RATOR)
|
||||||
|
#endif
|
||||||
|
|
||||||
|
#ifdef JIT_BOX_TS_PROCS
|
||||||
|
define_ts_s_s(scheme_box, FSRC_OTHER)
|
||||||
|
#endif
|
||||||
|
|
||||||
#else
|
#else
|
||||||
# define ts__scheme_apply_multi_from_native _scheme_apply_multi_from_native
|
# 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_apply_from_native _scheme_apply_from_native
|
||||||
|
|
@ -107,15 +126,15 @@ define_ts_siS_v(wrong_argument_count, FSRC_MARKS)
|
||||||
# define ts_malloc_double malloc_double
|
# define ts_malloc_double malloc_double
|
||||||
# define ts_scheme_box scheme_box
|
# define ts_scheme_box scheme_box
|
||||||
# define ts_scheme_make_mutable_pair scheme_make_mutable_pair
|
# define ts_scheme_make_mutable_pair scheme_make_mutable_pair
|
||||||
# define ts_make_list_star make_list_star
|
# define ts_scheme_jit_make_list_star scheme_jit_make_list_star
|
||||||
# define ts_make_list make_list
|
# define ts_scheme_jit_make_list scheme_jit_make_list
|
||||||
# define ts_scheme_make_pair scheme_make_pair
|
# define ts_scheme_make_pair scheme_make_pair
|
||||||
# define ts_make_one_element_ivector make_one_element_ivector
|
# define ts_scheme_jit_make_one_element_ivector scheme_jit_make_one_element_ivector
|
||||||
# define ts_make_one_element_vector make_one_element_vector
|
# define ts_scheme_jit_make_one_element_vector scheme_jit_make_one_element_vector
|
||||||
# define ts_make_two_element_ivector make_two_element_ivector
|
# define ts_scheme_jit_make_two_element_ivector scheme_jit_make_two_element_ivector
|
||||||
# define ts_make_two_element_vector make_two_element_vector
|
# define ts_scheme_jit_make_two_element_vector scheme_jit_make_two_element_vector
|
||||||
# define ts_make_ivector make_ivector
|
# define ts_scheme_jit_make_ivector scheme_jit_make_ivector
|
||||||
# define ts_make_vector make_vector
|
# define ts_scheme_jit_make_vector scheme_jit_make_vector
|
||||||
# define ts_GC_malloc_one_small_dirty_tagged GC_malloc_one_small_dirty_tagged
|
# 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_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_closure scheme_make_native_closure
|
||||||
|
|
|
||||||
311
src/racket/src/jitalloc.c
Normal file
311
src/racket/src/jitalloc.c
Normal file
|
|
@ -0,0 +1,311 @@
|
||||||
|
/*
|
||||||
|
Racket
|
||||||
|
Copyright (c) 2006-2011 PLT Scheme Inc.
|
||||||
|
|
||||||
|
This library is free software; you can redistribute it and/or
|
||||||
|
modify it under the terms of the GNU Library General Public
|
||||||
|
License as published by the Free Software Foundation; either
|
||||||
|
version 2 of the License, or (at your option) any later version.
|
||||||
|
|
||||||
|
This library is distributed in the hope that it will be useful,
|
||||||
|
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||||
|
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
||||||
|
Library General Public License for more details.
|
||||||
|
|
||||||
|
You should have received a copy of the GNU Library General Public
|
||||||
|
License along with this library; if not, write to the Free
|
||||||
|
Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
|
||||||
|
Boston, MA 02110-1301 USA.
|
||||||
|
*/
|
||||||
|
|
||||||
|
|
||||||
|
#include "schpriv.h"
|
||||||
|
#include "schmach.h"
|
||||||
|
#include "future.h"
|
||||||
|
|
||||||
|
#ifdef MZ_USE_JIT
|
||||||
|
|
||||||
|
#include "jit.h"
|
||||||
|
#include "jit_ts.c"
|
||||||
|
|
||||||
|
/*========================================================================*/
|
||||||
|
/* inlined allocation */
|
||||||
|
/*========================================================================*/
|
||||||
|
|
||||||
|
#ifdef CAN_INLINE_ALLOC
|
||||||
|
THREAD_LOCAL_DECL(extern uintptr_t GC_gen0_alloc_page_ptr);
|
||||||
|
intptr_t GC_initial_word(int sizeb);
|
||||||
|
intptr_t GC_array_initial_word(int sizeb);
|
||||||
|
intptr_t GC_compute_alloc_size(intptr_t sizeb);
|
||||||
|
|
||||||
|
THREAD_LOCAL_DECL(static void *retry_alloc_r1); /* set by prepare_retry_alloc() */
|
||||||
|
|
||||||
|
#ifdef JIT_USE_FP_OPS
|
||||||
|
THREAD_LOCAL_DECL(double scheme_jit_save_fp);
|
||||||
|
#endif
|
||||||
|
|
||||||
|
static void *prepare_retry_alloc(void *p, void *p2)
|
||||||
|
{
|
||||||
|
/* Alocate enough to trigger a new page */
|
||||||
|
intptr_t avail, algn;
|
||||||
|
|
||||||
|
algn = GC_alloc_alignment();
|
||||||
|
avail = algn - (GC_gen0_alloc_page_ptr & (algn - 1));
|
||||||
|
|
||||||
|
if (!avail)
|
||||||
|
avail = 1;
|
||||||
|
else if (avail == algn)
|
||||||
|
avail = 1;
|
||||||
|
|
||||||
|
if (avail > sizeof(intptr_t))
|
||||||
|
avail -= sizeof(intptr_t);
|
||||||
|
|
||||||
|
/* We assume that atomic memory and tagged go to the same nursery: */
|
||||||
|
scheme_malloc_atomic(avail);
|
||||||
|
|
||||||
|
retry_alloc_r1 = p2;
|
||||||
|
|
||||||
|
return p;
|
||||||
|
}
|
||||||
|
|
||||||
|
#ifdef MZ_USE_FUTURES
|
||||||
|
static void *ts_prepare_retry_alloc(void *p, void *p2) XFORM_SKIP_PROC
|
||||||
|
{
|
||||||
|
if (scheme_use_rtcall) {
|
||||||
|
uintptr_t ret;
|
||||||
|
|
||||||
|
jit_future_storage[0] = p;
|
||||||
|
jit_future_storage[1] = p2;
|
||||||
|
ret = scheme_rtcall_alloc("[acquire_gc_page]", FSRC_OTHER);
|
||||||
|
GC_gen0_alloc_page_ptr = ret;
|
||||||
|
retry_alloc_r1 = jit_future_storage[1];
|
||||||
|
p = jit_future_storage[0];
|
||||||
|
jit_future_storage[0] = NULL;
|
||||||
|
jit_future_storage[1] = NULL;
|
||||||
|
return p;
|
||||||
|
}
|
||||||
|
|
||||||
|
return prepare_retry_alloc(p, p2);
|
||||||
|
}
|
||||||
|
#else
|
||||||
|
# define ts_prepare_retry_alloc prepare_retry_alloc
|
||||||
|
#endif
|
||||||
|
|
||||||
|
static intptr_t read_first_word(void *sp)
|
||||||
|
{
|
||||||
|
intptr_t foo;
|
||||||
|
memcpy(&foo, sp, sizeof(intptr_t));
|
||||||
|
return foo;
|
||||||
|
}
|
||||||
|
|
||||||
|
static intptr_t initial_tag_word(Scheme_Type tag, int immut)
|
||||||
|
{
|
||||||
|
GC_CAN_IGNORE Scheme_Small_Object sp;
|
||||||
|
memset(&sp, 0, sizeof(Scheme_Small_Object));
|
||||||
|
sp.iso.so.type = tag;
|
||||||
|
if (immut) SCHEME_SET_IMMUTABLE(&sp);
|
||||||
|
return read_first_word((void *)&sp);
|
||||||
|
}
|
||||||
|
|
||||||
|
int scheme_inline_alloc(mz_jit_state *jitter, int amt, Scheme_Type ty, int immut,
|
||||||
|
int keep_r0_r1, int keep_fpr1, int inline_retry)
|
||||||
|
/* Puts allocated result at JIT_V1; first word is GC tag.
|
||||||
|
Uses JIT_R2 as temporary. The allocated memory is "dirty" (i.e., not 0ed).
|
||||||
|
Save FP0 when FP ops are enabled. */
|
||||||
|
{
|
||||||
|
GC_CAN_IGNORE jit_insn *ref, *reffail;
|
||||||
|
intptr_t a_word, sz, algn;
|
||||||
|
|
||||||
|
sz = GC_compute_alloc_size(amt);
|
||||||
|
algn = GC_alloc_alignment();
|
||||||
|
|
||||||
|
__START_TINY_JUMPS__(1);
|
||||||
|
reffail = _jit.x.pc;
|
||||||
|
mz_tl_ldi_p(JIT_V1, tl_GC_gen0_alloc_page_ptr);
|
||||||
|
jit_subi_l(JIT_R2, JIT_V1, 1);
|
||||||
|
jit_andi_l(JIT_R2, JIT_R2, (algn - 1));
|
||||||
|
ref = jit_blti_l(jit_forward(), JIT_R2, (algn - sz));
|
||||||
|
CHECK_LIMIT();
|
||||||
|
__END_TINY_JUMPS__(1);
|
||||||
|
|
||||||
|
/* Failure handling */
|
||||||
|
if (keep_r0_r1) {
|
||||||
|
if (inline_retry) {
|
||||||
|
scheme_generate_alloc_retry(jitter, 1);
|
||||||
|
CHECK_LIMIT();
|
||||||
|
} else {
|
||||||
|
(void)jit_calli(sjc.retry_alloc_code_keep_r0_r1);
|
||||||
|
}
|
||||||
|
} else if (keep_fpr1) {
|
||||||
|
(void)jit_calli(sjc.retry_alloc_code_keep_fpr1);
|
||||||
|
} else {
|
||||||
|
(void)jit_calli(sjc.retry_alloc_code);
|
||||||
|
}
|
||||||
|
__START_TINY_JUMPS__(1);
|
||||||
|
(void)jit_jmpi(reffail);
|
||||||
|
__END_SHORT_JUMPS__(1);
|
||||||
|
|
||||||
|
__START_TINY_JUMPS__(1);
|
||||||
|
mz_patch_branch(ref);
|
||||||
|
jit_addi_ul(JIT_R2, JIT_V1, sz);
|
||||||
|
(void)mz_tl_sti_l(tl_GC_gen0_alloc_page_ptr, JIT_R2, JIT_R0);
|
||||||
|
|
||||||
|
/* GC header: */
|
||||||
|
if (ty >= 0) {
|
||||||
|
a_word = GC_initial_word(amt);
|
||||||
|
jit_movi_l(JIT_R2, a_word);
|
||||||
|
jit_str_l(JIT_V1, JIT_R2);
|
||||||
|
|
||||||
|
/* Scheme_Object header: */
|
||||||
|
a_word = initial_tag_word(ty, immut);
|
||||||
|
jit_movi_l(JIT_R2, a_word);
|
||||||
|
jit_stxi_l(sizeof(intptr_t), JIT_V1, JIT_R2);
|
||||||
|
} else {
|
||||||
|
/* an array of pointers */
|
||||||
|
a_word = GC_array_initial_word(amt);
|
||||||
|
jit_movi_l(JIT_R2, a_word);
|
||||||
|
jit_str_l(JIT_V1, JIT_R2);
|
||||||
|
}
|
||||||
|
|
||||||
|
CHECK_LIMIT();
|
||||||
|
__END_TINY_JUMPS__(1);
|
||||||
|
|
||||||
|
return 1;
|
||||||
|
}
|
||||||
|
#endif
|
||||||
|
|
||||||
|
int scheme_can_inline_fp_op()
|
||||||
|
{
|
||||||
|
#ifdef INLINE_FP_OPS
|
||||||
|
return 1;
|
||||||
|
#else
|
||||||
|
return 0;
|
||||||
|
#endif
|
||||||
|
}
|
||||||
|
|
||||||
|
int scheme_can_inline_fp_comp()
|
||||||
|
{
|
||||||
|
#ifdef INLINE_FP_COMP
|
||||||
|
return 1;
|
||||||
|
#else
|
||||||
|
return 0;
|
||||||
|
#endif
|
||||||
|
}
|
||||||
|
|
||||||
|
#if defined(INLINE_FP_OPS) && !defined(CAN_INLINE_ALLOC)
|
||||||
|
static void *malloc_double(void)
|
||||||
|
{
|
||||||
|
return scheme_make_double(scheme_jit_save_fp);
|
||||||
|
}
|
||||||
|
#endif
|
||||||
|
|
||||||
|
#ifdef MZ_PRECISE_GC
|
||||||
|
# define cons GC_malloc_pair
|
||||||
|
#else
|
||||||
|
# define cons scheme_make_pair
|
||||||
|
#endif
|
||||||
|
|
||||||
|
#ifndef CAN_INLINE_ALLOC
|
||||||
|
Scheme_Object *scheme_jit_make_list(GC_CAN_IGNORE Scheme_Object **rs, intptr_t n)
|
||||||
|
{
|
||||||
|
GC_CAN_IGNORE Scheme_Object *l = scheme_null;
|
||||||
|
|
||||||
|
while (n--) {
|
||||||
|
l = cons(rs[n], l);
|
||||||
|
}
|
||||||
|
|
||||||
|
return l;
|
||||||
|
}
|
||||||
|
Scheme_Object *scheme_jit_make_list_star(GC_CAN_IGNORE Scheme_Object **rs, intptr_t n)
|
||||||
|
{
|
||||||
|
GC_CAN_IGNORE Scheme_Object *l = rs[--n];
|
||||||
|
|
||||||
|
while (n--) {
|
||||||
|
l = cons(rs[n], l);
|
||||||
|
}
|
||||||
|
|
||||||
|
return l;
|
||||||
|
}
|
||||||
|
#endif
|
||||||
|
|
||||||
|
#if !defined(CAN_INLINE_ALLOC)
|
||||||
|
Scheme_Object *scheme_jit_make_vector(intptr_t n)
|
||||||
|
{
|
||||||
|
Scheme_Object *vec;
|
||||||
|
vec = scheme_make_vector(n, NULL);
|
||||||
|
return vec;
|
||||||
|
}
|
||||||
|
Scheme_Object *scheme_jit_make_ivector(intptr_t n)
|
||||||
|
{
|
||||||
|
Scheme_Object *vec;
|
||||||
|
vec = scheme_jit_make_vector(n);
|
||||||
|
SCHEME_SET_IMMUTABLE(vec);
|
||||||
|
return vec;
|
||||||
|
}
|
||||||
|
Scheme_Object *scheme_jit_make_one_element_vector(Scheme_Object *a)
|
||||||
|
{
|
||||||
|
Scheme_Object *vec;
|
||||||
|
vec = scheme_make_vector(1, a);
|
||||||
|
return vec;
|
||||||
|
}
|
||||||
|
Scheme_Object *scheme_jit_make_one_element_ivector(Scheme_Object *a)
|
||||||
|
{
|
||||||
|
Scheme_Object *vec;
|
||||||
|
vec = scheme_jit_make_one_element_vector(a);
|
||||||
|
SCHEME_SET_IMMUTABLE(vec);
|
||||||
|
return vec;
|
||||||
|
}
|
||||||
|
Scheme_Object *scheme_jit_make_two_element_vector(Scheme_Object *a, Scheme_Object *b)
|
||||||
|
{
|
||||||
|
Scheme_Object *vec;
|
||||||
|
vec = scheme_make_vector(2, a);
|
||||||
|
SCHEME_VEC_ELS(vec)[1] = b;
|
||||||
|
return vec;
|
||||||
|
}
|
||||||
|
Scheme_Object *scheme_jit_make_two_element_ivector(Scheme_Object *a, Scheme_Object *b)
|
||||||
|
{
|
||||||
|
Scheme_Object *vec;
|
||||||
|
vec = scheme_jit_make_two_element_vector(a, b);
|
||||||
|
SCHEME_SET_IMMUTABLE(vec);
|
||||||
|
return vec;
|
||||||
|
}
|
||||||
|
#endif
|
||||||
|
|
||||||
|
#ifdef CAN_INLINE_ALLOC
|
||||||
|
int scheme_generate_alloc_retry(mz_jit_state *jitter, int i)
|
||||||
|
{
|
||||||
|
GC_CAN_IGNORE jit_insn *refr;
|
||||||
|
|
||||||
|
#ifdef JIT_USE_FP_OPS
|
||||||
|
if (i == 2) {
|
||||||
|
(void)mz_tl_sti_d_fppop(tl_scheme_jit_save_fp, JIT_FPR1, JIT_R2);
|
||||||
|
}
|
||||||
|
#endif
|
||||||
|
JIT_UPDATE_THREAD_RSPTR();
|
||||||
|
jit_prepare(2);
|
||||||
|
CHECK_LIMIT();
|
||||||
|
if (i == 1) {
|
||||||
|
jit_pusharg_p(JIT_R1);
|
||||||
|
jit_pusharg_p(JIT_R0);
|
||||||
|
} else {
|
||||||
|
(void)jit_movi_p(JIT_R0, NULL);
|
||||||
|
jit_pusharg_p(JIT_R0);
|
||||||
|
jit_pusharg_p(JIT_R0);
|
||||||
|
}
|
||||||
|
(void)mz_finish_lwe(ts_prepare_retry_alloc, refr);
|
||||||
|
jit_retval(JIT_R0);
|
||||||
|
if (i == 1) {
|
||||||
|
mz_tl_ldi_l(JIT_R1, tl_retry_alloc_r1);
|
||||||
|
}
|
||||||
|
#ifdef JIT_USE_FP_OPS
|
||||||
|
if (i == 2) {
|
||||||
|
(void)mz_tl_ldi_d_fppush(JIT_FPR1, tl_scheme_jit_save_fp, JIT_R2);
|
||||||
|
}
|
||||||
|
#endif
|
||||||
|
return 1;
|
||||||
|
}
|
||||||
|
#endif
|
||||||
|
|
||||||
|
/*========================================================================*/
|
||||||
|
|
||||||
|
#endif
|
||||||
2026
src/racket/src/jitarith.c
Normal file
2026
src/racket/src/jitarith.c
Normal file
File diff suppressed because it is too large
Load Diff
1599
src/racket/src/jitcall.c
Normal file
1599
src/racket/src/jitcall.c
Normal file
File diff suppressed because it is too large
Load Diff
2399
src/racket/src/jitcommon.c
Normal file
2399
src/racket/src/jitcommon.c
Normal file
File diff suppressed because it is too large
Load Diff
3059
src/racket/src/jitinline.c
Normal file
3059
src/racket/src/jitinline.c
Normal file
File diff suppressed because it is too large
Load Diff
499
src/racket/src/jitstack.c
Normal file
499
src/racket/src/jitstack.c
Normal file
|
|
@ -0,0 +1,499 @@
|
||||||
|
/*
|
||||||
|
Racket
|
||||||
|
Copyright (c) 2006-2011 PLT Scheme Inc.
|
||||||
|
|
||||||
|
This library is free software; you can redistribute it and/or
|
||||||
|
modify it under the terms of the GNU Library General Public
|
||||||
|
License as published by the Free Software Foundation; either
|
||||||
|
version 2 of the License, or (at your option) any later version.
|
||||||
|
|
||||||
|
This library is distributed in the hope that it will be useful,
|
||||||
|
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||||
|
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
||||||
|
Library General Public License for more details.
|
||||||
|
|
||||||
|
You should have received a copy of the GNU Library General Public
|
||||||
|
License along with this library; if not, write to the Free
|
||||||
|
Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
|
||||||
|
Boston, MA 02110-1301 USA.
|
||||||
|
*/
|
||||||
|
|
||||||
|
#include "schpriv.h"
|
||||||
|
#include "schmach.h"
|
||||||
|
#ifdef MZ_USE_DWARF_LIBUNWIND
|
||||||
|
# include "unwind/libunwind.h"
|
||||||
|
#endif
|
||||||
|
#include "future.h"
|
||||||
|
|
||||||
|
#ifdef MZ_USE_JIT
|
||||||
|
|
||||||
|
#include "jit.h"
|
||||||
|
|
||||||
|
#include "codetab.inc"
|
||||||
|
|
||||||
|
/* The Stack_Cache_Elem structure type (define in schthread.h)
|
||||||
|
must have a size of 4 words. */
|
||||||
|
|
||||||
|
THREAD_LOCAL_DECL(static Stack_Cache_Elem stack_cache_stack[STACK_CACHE_SIZE]);
|
||||||
|
THREAD_LOCAL_DECL(static intptr_t stack_cache_stack_pos = 0);
|
||||||
|
|
||||||
|
void *scheme_decrement_cache_stack_pos(void *p)
|
||||||
|
{
|
||||||
|
Stack_Cache_Elem *r;
|
||||||
|
r = stack_cache_stack + stack_cache_stack_pos;
|
||||||
|
stack_cache_stack_pos--;
|
||||||
|
r->orig_result = p;
|
||||||
|
return r;
|
||||||
|
}
|
||||||
|
|
||||||
|
void scheme_register_stack_cache_stack(void)
|
||||||
|
{
|
||||||
|
REGISTER_SO(stack_cache_stack);
|
||||||
|
}
|
||||||
|
|
||||||
|
/*========================================================================*/
|
||||||
|
/* stack trace */
|
||||||
|
/*========================================================================*/
|
||||||
|
|
||||||
|
typedef void *(*Get_Stack_Proc)();
|
||||||
|
|
||||||
|
#ifdef MZ_USE_JIT_PPC
|
||||||
|
# ifdef _CALL_DARWIN
|
||||||
|
# define RETURN_ADDRESS_OFFSET 2
|
||||||
|
# else
|
||||||
|
# define RETURN_ADDRESS_OFFSET 1
|
||||||
|
# endif
|
||||||
|
#endif
|
||||||
|
#ifdef MZ_USE_JIT_I386
|
||||||
|
# define RETURN_ADDRESS_OFFSET 1
|
||||||
|
#endif
|
||||||
|
|
||||||
|
#define CACHE_STACK_MIN_TRIGGER 128
|
||||||
|
|
||||||
|
#define USE_STACK_CHECK 0
|
||||||
|
|
||||||
|
#if USE_STACK_CHECK
|
||||||
|
static void check_stack(void)
|
||||||
|
{
|
||||||
|
void *p, *q;
|
||||||
|
uintptr_t stack_end;
|
||||||
|
int pos = stack_cache_stack_pos;
|
||||||
|
Get_Stack_Proc gs;
|
||||||
|
|
||||||
|
gs = (Get_Stack_Proc)get_stack_pointer_code;
|
||||||
|
p = gs();
|
||||||
|
|
||||||
|
stack_end = (uintptr_t)(scheme_current_thread->next
|
||||||
|
? scheme_current_thread->stack_start
|
||||||
|
: scheme_current_thread->o_start);
|
||||||
|
|
||||||
|
while (STK_COMP((uintptr_t)p, stack_end)) {
|
||||||
|
q = ((void **)p)[RETURN_ADDRESS_OFFSET];
|
||||||
|
|
||||||
|
if (q == stack_cache_pop_code) {
|
||||||
|
if (!pos)
|
||||||
|
abort();
|
||||||
|
else {
|
||||||
|
if (stack_cache_stack[pos].stack_frame != (void *)(((void **)p) + RETURN_ADDRESS_OFFSET)) {
|
||||||
|
abort();
|
||||||
|
}
|
||||||
|
--pos;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
q = *(void **)p;
|
||||||
|
if (STK_COMP((uintptr_t)q, (uintptr_t)p))
|
||||||
|
break;
|
||||||
|
p = q;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
#endif
|
||||||
|
|
||||||
|
MZ_DO_NOT_INLINE(uintptr_t scheme_approx_sp());
|
||||||
|
uintptr_t scheme_approx_sp()
|
||||||
|
{
|
||||||
|
uintptr_t p;
|
||||||
|
p = (uintptr_t)&p;
|
||||||
|
return p;
|
||||||
|
}
|
||||||
|
|
||||||
|
Scheme_Object *scheme_native_stack_trace(void)
|
||||||
|
{
|
||||||
|
void *p, *q;
|
||||||
|
uintptr_t stack_end, real_stack_end, stack_start, halfway;
|
||||||
|
Scheme_Object *name, *last = NULL, *first = NULL, *tail;
|
||||||
|
int prev_had_name = 0;
|
||||||
|
#ifdef MZ_USE_DWARF_LIBUNWIND
|
||||||
|
unw_context_t cx;
|
||||||
|
unw_cursor_t c;
|
||||||
|
int manual_unw = 0;
|
||||||
|
unw_word_t stack_addr;
|
||||||
|
#else
|
||||||
|
Get_Stack_Proc gs;
|
||||||
|
#endif
|
||||||
|
int use_unw = 0;
|
||||||
|
int shift_cache_to_next = 0;
|
||||||
|
int added_list_elem;
|
||||||
|
|
||||||
|
if (!sjc.get_stack_pointer_code)
|
||||||
|
return NULL;
|
||||||
|
|
||||||
|
#if USE_STACK_CHECK
|
||||||
|
check_stack();
|
||||||
|
#endif
|
||||||
|
|
||||||
|
stack_start = scheme_approx_sp();
|
||||||
|
|
||||||
|
real_stack_end = (uintptr_t)scheme_current_thread->stack_start;
|
||||||
|
if (stack_cache_stack_pos) {
|
||||||
|
stack_end = (uintptr_t)stack_cache_stack[stack_cache_stack_pos].stack_frame;
|
||||||
|
stack_end -= (RETURN_ADDRESS_OFFSET << JIT_LOG_WORD_SIZE);
|
||||||
|
tail = stack_cache_stack[stack_cache_stack_pos].cache;
|
||||||
|
} else {
|
||||||
|
stack_end = real_stack_end;
|
||||||
|
tail = scheme_null;
|
||||||
|
}
|
||||||
|
|
||||||
|
#ifdef MZ_USE_DWARF_LIBUNWIND
|
||||||
|
unw_set_safe_pointer_range(stack_start, stack_end);
|
||||||
|
unw_reset_bad_ptr_flag();
|
||||||
|
#endif
|
||||||
|
|
||||||
|
#ifdef MZ_USE_DWARF_LIBUNWIND
|
||||||
|
unw_getcontext(&cx);
|
||||||
|
unw_init_local(&c, &cx);
|
||||||
|
use_unw = 1;
|
||||||
|
p = NULL;
|
||||||
|
#else
|
||||||
|
gs = (Get_Stack_Proc)sjc.get_stack_pointer_code;
|
||||||
|
p = gs();
|
||||||
|
#endif
|
||||||
|
|
||||||
|
halfway = STK_DIFF(stack_end, (uintptr_t)p) / 2;
|
||||||
|
if (halfway < CACHE_STACK_MIN_TRIGGER)
|
||||||
|
halfway = stack_end;
|
||||||
|
else {
|
||||||
|
#ifdef STACK_GROWS_DOWN
|
||||||
|
halfway += (uintptr_t)p;
|
||||||
|
#else
|
||||||
|
halfway += stack_end;
|
||||||
|
#endif
|
||||||
|
}
|
||||||
|
|
||||||
|
while (1) {
|
||||||
|
#ifdef MZ_USE_DWARF_LIBUNWIND
|
||||||
|
if (use_unw) {
|
||||||
|
q = (void *)unw_get_ip(&c);
|
||||||
|
} else {
|
||||||
|
q = NULL;
|
||||||
|
}
|
||||||
|
#endif
|
||||||
|
|
||||||
|
if (!use_unw) {
|
||||||
|
if (!(STK_COMP((uintptr_t)p, stack_end)
|
||||||
|
&& STK_COMP(stack_start, (uintptr_t)p)))
|
||||||
|
break;
|
||||||
|
q = ((void **)p)[RETURN_ADDRESS_OFFSET];
|
||||||
|
/* p is the frame pointer for the function called by q,
|
||||||
|
not for q. */
|
||||||
|
}
|
||||||
|
|
||||||
|
name = find_symbol((uintptr_t)q);
|
||||||
|
#ifdef MZ_USE_DWARF_LIBUNWIND
|
||||||
|
if (name) manual_unw = 1;
|
||||||
|
#endif
|
||||||
|
|
||||||
|
if (SCHEME_FALSEP(name) || SCHEME_VOIDP(name)) {
|
||||||
|
/* Code uses special calling convention */
|
||||||
|
#ifdef MZ_USE_JIT_PPC
|
||||||
|
/* JIT_LOCAL2 has the next return address */
|
||||||
|
q = ((void **)p)[JIT_LOCAL2 >> JIT_LOG_WORD_SIZE];
|
||||||
|
#endif
|
||||||
|
#ifdef MZ_USE_JIT_I386
|
||||||
|
|
||||||
|
# ifdef MZ_USE_DWARF_LIBUNWIND
|
||||||
|
if (use_unw) {
|
||||||
|
q = (void *)unw_get_frame_pointer(&c);
|
||||||
|
} else
|
||||||
|
# endif
|
||||||
|
q = *(void **)p;
|
||||||
|
|
||||||
|
/* q is now the frame pointer for the former q,
|
||||||
|
so we can find the actual q */
|
||||||
|
if (STK_COMP((uintptr_t)q, real_stack_end)
|
||||||
|
&& STK_COMP(stack_start, (uintptr_t)q)) {
|
||||||
|
if (SCHEME_VOIDP(name)) {
|
||||||
|
/* JIT_LOCAL2 has the next return address */
|
||||||
|
q = ((void **)q)[JIT_LOCAL2 >> JIT_LOG_WORD_SIZE];
|
||||||
|
} else {
|
||||||
|
/* Push after local stack of return-address proc
|
||||||
|
has the next return address */
|
||||||
|
q = ((void **)q)[-(3 + LOCAL_FRAME_SIZE + 1)];
|
||||||
|
}
|
||||||
|
} else {
|
||||||
|
q = NULL;
|
||||||
|
}
|
||||||
|
#endif
|
||||||
|
name = find_symbol((uintptr_t)q);
|
||||||
|
} else if (SCHEME_EOFP(name)) {
|
||||||
|
/* Stub (to mark start of running a module body, for example) */
|
||||||
|
/* JIT_LOCAL2 has the name to use */
|
||||||
|
#ifdef MZ_USE_JIT_PPC
|
||||||
|
name = *(Scheme_Object **)((void **)p)[JIT_LOCAL2 >> JIT_LOG_WORD_SIZE];
|
||||||
|
#endif
|
||||||
|
#ifdef MZ_USE_JIT_I386
|
||||||
|
void *np;
|
||||||
|
# ifdef MZ_USE_DWARF_LIBUNWIND
|
||||||
|
if (use_unw) {
|
||||||
|
np = (void *)unw_get_frame_pointer(&c);
|
||||||
|
} else
|
||||||
|
# endif
|
||||||
|
np = *(void **)p;
|
||||||
|
|
||||||
|
if (STK_COMP((uintptr_t)np, real_stack_end)
|
||||||
|
&& STK_COMP(stack_start, (uintptr_t)np)) {
|
||||||
|
name = *(Scheme_Object **)((void **)np)[JIT_LOCAL2 >> JIT_LOG_WORD_SIZE];
|
||||||
|
} else
|
||||||
|
name = NULL;
|
||||||
|
#endif
|
||||||
|
}
|
||||||
|
|
||||||
|
if (name && !SCHEME_NULLP(name)) { /* null is used to help unwind without a true name */
|
||||||
|
name = scheme_make_pair(name, scheme_null);
|
||||||
|
if (last)
|
||||||
|
SCHEME_CDR(last) = name;
|
||||||
|
else
|
||||||
|
first = name;
|
||||||
|
last = name;
|
||||||
|
if (shift_cache_to_next) {
|
||||||
|
stack_cache_stack[stack_cache_stack_pos].cache = last;
|
||||||
|
shift_cache_to_next = 0;
|
||||||
|
}
|
||||||
|
added_list_elem = 1;
|
||||||
|
} else
|
||||||
|
added_list_elem = 0;
|
||||||
|
|
||||||
|
/* Cache the result halfway up the stack, if possible. Only cache
|
||||||
|
on frames where the previous frame had a return address with a
|
||||||
|
name, because an arbitrary frame's return address on the stack
|
||||||
|
might not be used (depending on how the C compiler optimized the
|
||||||
|
code); any frame whose procedure has a name is JITted code, so
|
||||||
|
it will use the return address from the stack. */
|
||||||
|
if (STK_COMP((uintptr_t)halfway, (uintptr_t)p)
|
||||||
|
&& prev_had_name) {
|
||||||
|
int pos;
|
||||||
|
|
||||||
|
if (stack_cache_stack_pos >= (STACK_CACHE_SIZE - 1)) {
|
||||||
|
/* Make room on the stack */
|
||||||
|
void **z;
|
||||||
|
z = (void **)stack_cache_stack[stack_cache_stack_pos].stack_frame;
|
||||||
|
*z = stack_cache_stack[stack_cache_stack_pos].orig_return_address;
|
||||||
|
--stack_cache_stack_pos;
|
||||||
|
}
|
||||||
|
|
||||||
|
pos = ++stack_cache_stack_pos;
|
||||||
|
stack_cache_stack[pos].orig_return_address = ((void **)p)[RETURN_ADDRESS_OFFSET];
|
||||||
|
stack_cache_stack[pos].stack_frame = (void *)(((void **)p) + RETURN_ADDRESS_OFFSET);
|
||||||
|
stack_cache_stack[pos].cache = last;
|
||||||
|
((void **)p)[RETURN_ADDRESS_OFFSET] = sjc.stack_cache_pop_code;
|
||||||
|
if (!added_list_elem)
|
||||||
|
shift_cache_to_next = 1;
|
||||||
|
|
||||||
|
halfway = stack_end;
|
||||||
|
}
|
||||||
|
|
||||||
|
prev_had_name = !!name;
|
||||||
|
|
||||||
|
#ifdef MZ_USE_DWARF_LIBUNWIND
|
||||||
|
if (use_unw) {
|
||||||
|
if (manual_unw) {
|
||||||
|
/* A JIT-generated function, so we unwind ourselves... */
|
||||||
|
void **pp;
|
||||||
|
pp = (void **)unw_get_frame_pointer(&c);
|
||||||
|
if (!(STK_COMP((uintptr_t)pp, stack_end)
|
||||||
|
&& STK_COMP(stack_start, (uintptr_t)pp)))
|
||||||
|
break;
|
||||||
|
stack_addr = (unw_word_t)&(pp[RETURN_ADDRESS_OFFSET+1]);
|
||||||
|
unw_manual_step(&c, &pp[RETURN_ADDRESS_OFFSET], &pp[0],
|
||||||
|
&stack_addr, &pp[-1], &pp[-2], &pp[-3]);
|
||||||
|
manual_unw = 0;
|
||||||
|
} else {
|
||||||
|
void *prev_q = q;
|
||||||
|
unw_step(&c);
|
||||||
|
q = (void *)unw_get_ip(&c);
|
||||||
|
if ((q == prev_q)
|
||||||
|
|| unw_reset_bad_ptr_flag())
|
||||||
|
break;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
#endif
|
||||||
|
|
||||||
|
if (!use_unw) {
|
||||||
|
q = *(void **)p;
|
||||||
|
if (STK_COMP((uintptr_t)q, (uintptr_t)p))
|
||||||
|
break;
|
||||||
|
p = q;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
if (shift_cache_to_next)
|
||||||
|
stack_cache_stack[stack_cache_stack_pos].cache = scheme_null;
|
||||||
|
|
||||||
|
#ifdef MZ_USE_DWARF_LIBUNWIND
|
||||||
|
unw_destroy_local(&c);
|
||||||
|
#endif
|
||||||
|
|
||||||
|
if (last)
|
||||||
|
SCHEME_CDR(last) = tail;
|
||||||
|
else
|
||||||
|
first = tail;
|
||||||
|
|
||||||
|
if (SCHEME_NULLP(first))
|
||||||
|
return NULL;
|
||||||
|
|
||||||
|
return first;
|
||||||
|
}
|
||||||
|
|
||||||
|
#if 0
|
||||||
|
/* Sometimes useful for debugging Racket: */
|
||||||
|
void scheme_dump_stack_trace(void)
|
||||||
|
{
|
||||||
|
void *p, *q;
|
||||||
|
uintptr_t stack_end, stack_start;
|
||||||
|
Get_Stack_Proc gs;
|
||||||
|
Scheme_Object *name;
|
||||||
|
|
||||||
|
gs = (Get_Stack_Proc)sjc.get_stack_pointer_code;
|
||||||
|
p = gs();
|
||||||
|
stack_start = scheme_approx_sp();
|
||||||
|
|
||||||
|
stack_end = (uintptr_t)scheme_current_thread->stack_start;
|
||||||
|
|
||||||
|
while (STK_COMP((uintptr_t)p, stack_end)
|
||||||
|
&& STK_COMP(stack_start, (uintptr_t)p)) {
|
||||||
|
name = find_symbol((uintptr_t)q);
|
||||||
|
if (SCHEME_FALSEP(name)) {
|
||||||
|
/* Code uses special calling convention */
|
||||||
|
#ifdef MZ_USE_JIT_PPC
|
||||||
|
/* JIT_LOCAL2 has the next return address */
|
||||||
|
q = ((void **)p)[JIT_LOCAL2 >> JIT_LOG_WORD_SIZE];
|
||||||
|
#endif
|
||||||
|
#ifdef MZ_USE_JIT_I386
|
||||||
|
/* Push after local stack of return-address proc
|
||||||
|
has the next return address */
|
||||||
|
q = *(void **)p;
|
||||||
|
q = ((void **)q)[-(3 + LOCAL_FRAME_SIZE + 1)];
|
||||||
|
#endif
|
||||||
|
name = find_symbol((uintptr_t)q);
|
||||||
|
}
|
||||||
|
|
||||||
|
if (name) {
|
||||||
|
printf(" scheme\n");
|
||||||
|
} else {
|
||||||
|
printf(" %p\n", q);
|
||||||
|
}
|
||||||
|
|
||||||
|
q = *(void **)p;
|
||||||
|
if (STK_COMP((uintptr_t)q, (uintptr_t)p))
|
||||||
|
break;
|
||||||
|
p = q;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
#endif
|
||||||
|
|
||||||
|
void scheme_flush_stack_cache()
|
||||||
|
XFORM_SKIP_PROC
|
||||||
|
{
|
||||||
|
void **p;
|
||||||
|
|
||||||
|
while (stack_cache_stack_pos) {
|
||||||
|
p = (void **)stack_cache_stack[stack_cache_stack_pos].stack_frame;
|
||||||
|
*p = stack_cache_stack[stack_cache_stack_pos].orig_return_address;
|
||||||
|
--stack_cache_stack_pos;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
void scheme_jit_longjmp(mz_jit_jmp_buf b, int v)
|
||||||
|
XFORM_SKIP_PROC
|
||||||
|
{
|
||||||
|
uintptr_t limit;
|
||||||
|
void **p;
|
||||||
|
|
||||||
|
limit = b->stack_frame;
|
||||||
|
|
||||||
|
while (stack_cache_stack_pos
|
||||||
|
&& STK_COMP((uintptr_t)stack_cache_stack[stack_cache_stack_pos].stack_frame,
|
||||||
|
limit)) {
|
||||||
|
p = (void **)stack_cache_stack[stack_cache_stack_pos].stack_frame;
|
||||||
|
*p = stack_cache_stack[stack_cache_stack_pos].orig_return_address;
|
||||||
|
--stack_cache_stack_pos;
|
||||||
|
}
|
||||||
|
|
||||||
|
scheme_mz_longjmp(b->jb, v);
|
||||||
|
}
|
||||||
|
|
||||||
|
void scheme_jit_setjmp_prepare(mz_jit_jmp_buf b)
|
||||||
|
XFORM_SKIP_PROC
|
||||||
|
{
|
||||||
|
void *p;
|
||||||
|
p = &p;
|
||||||
|
b->stack_frame = (uintptr_t)p;
|
||||||
|
}
|
||||||
|
|
||||||
|
void scheme_clean_native_symtab(void)
|
||||||
|
{
|
||||||
|
#ifndef MZ_PRECISE_GC
|
||||||
|
clear_symbols_for_collected();
|
||||||
|
jit_notify_freed_code();
|
||||||
|
#endif
|
||||||
|
}
|
||||||
|
|
||||||
|
#ifdef MZ_PRECISE_GC
|
||||||
|
void scheme_jit_release_native_code(void *fnlized, void *p)
|
||||||
|
{
|
||||||
|
Scheme_Object *len;
|
||||||
|
|
||||||
|
len = SCHEME_BOX_VAL(fnlized);
|
||||||
|
|
||||||
|
scheme_jit_malloced -= SCHEME_INT_VAL(len);
|
||||||
|
|
||||||
|
/* Remove name mapping: */
|
||||||
|
scheme_jit_add_symbol((uintptr_t)p, (uintptr_t)p + SCHEME_INT_VAL(len), NULL, 0);
|
||||||
|
/* Free memory: */
|
||||||
|
scheme_free_code(p);
|
||||||
|
jit_notify_freed_code();
|
||||||
|
}
|
||||||
|
#endif
|
||||||
|
|
||||||
|
typedef void *(*Module_Run_Proc)(Scheme_Env *menv, Scheme_Env *env, Scheme_Object **name);
|
||||||
|
typedef void *(*Module_Exprun_Proc)(Scheme_Env *menv, int set_ns, Scheme_Object **name);
|
||||||
|
typedef void *(*Module_Start_Proc)(struct Start_Module_Args *a, Scheme_Object **name);
|
||||||
|
|
||||||
|
void *scheme_module_run_start(Scheme_Env *menv, Scheme_Env *env, Scheme_Object *name)
|
||||||
|
{
|
||||||
|
Module_Run_Proc proc = (Module_Run_Proc)sjc.module_run_start_code;
|
||||||
|
if (proc)
|
||||||
|
return proc(menv, env, &name);
|
||||||
|
else
|
||||||
|
return scheme_module_run_finish(menv, env);
|
||||||
|
}
|
||||||
|
|
||||||
|
void *scheme_module_exprun_start(Scheme_Env *menv, int set_ns, Scheme_Object *name)
|
||||||
|
{
|
||||||
|
Module_Exprun_Proc proc = (Module_Exprun_Proc)sjc.module_exprun_start_code;
|
||||||
|
if (proc)
|
||||||
|
return proc(menv, set_ns, &name);
|
||||||
|
else
|
||||||
|
return scheme_module_exprun_finish(menv, set_ns);
|
||||||
|
}
|
||||||
|
|
||||||
|
void *scheme_module_start_start(struct Start_Module_Args *a, Scheme_Object *name)
|
||||||
|
{
|
||||||
|
Module_Start_Proc proc = (Module_Start_Proc)sjc.module_start_start_code;
|
||||||
|
if (proc)
|
||||||
|
return proc(a, &name);
|
||||||
|
else
|
||||||
|
return scheme_module_start_finish(a);
|
||||||
|
}
|
||||||
|
|
||||||
|
#endif
|
||||||
636
src/racket/src/jitstate.c
Normal file
636
src/racket/src/jitstate.c
Normal file
|
|
@ -0,0 +1,636 @@
|
||||||
|
/*
|
||||||
|
Racket
|
||||||
|
Copyright (c) 2006-2011 PLT Scheme Inc.
|
||||||
|
|
||||||
|
This library is free software; you can redistribute it and/or
|
||||||
|
modify it under the terms of the GNU Library General Public
|
||||||
|
License as published by the Free Software Foundation; either
|
||||||
|
version 2 of the License, or (at your option) any later version.
|
||||||
|
|
||||||
|
This library is distributed in the hope that it will be useful,
|
||||||
|
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||||
|
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
||||||
|
Library General Public License for more details.
|
||||||
|
|
||||||
|
You should have received a copy of the GNU Library General Public
|
||||||
|
License along with this library; if not, write to the Free
|
||||||
|
Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
|
||||||
|
Boston, MA 02110-1301 USA.
|
||||||
|
*/
|
||||||
|
|
||||||
|
#include "schpriv.h"
|
||||||
|
#include "schmach.h"
|
||||||
|
#include "future.h"
|
||||||
|
|
||||||
|
#ifdef MZ_USE_JIT
|
||||||
|
|
||||||
|
#include "jit.h"
|
||||||
|
|
||||||
|
/* Used by vector-set-performance-stats!: */
|
||||||
|
int scheme_jit_malloced;
|
||||||
|
|
||||||
|
/*========================================================================*/
|
||||||
|
/* JIT buffer */
|
||||||
|
/*========================================================================*/
|
||||||
|
|
||||||
|
#define JIT_CACHE_SIZE_LIMIT 65536
|
||||||
|
#define JIT_BUFFER_INIT_SIZE 256
|
||||||
|
|
||||||
|
#define JIT_INIT_MAPPINGS_SIZE 32
|
||||||
|
|
||||||
|
THREAD_LOCAL_DECL(static void *jit_buffer_cache);
|
||||||
|
THREAD_LOCAL_DECL(static intptr_t jit_buffer_cache_size);
|
||||||
|
THREAD_LOCAL_DECL(static int jit_buffer_cache_registered);
|
||||||
|
|
||||||
|
static void *get_end_pointer(mz_jit_state *jitter)
|
||||||
|
{
|
||||||
|
return jit_get_ip().ptr;
|
||||||
|
}
|
||||||
|
|
||||||
|
int scheme_mz_retain_it(mz_jit_state *jitter, void *v)
|
||||||
|
{
|
||||||
|
if (jitter->retain_start) {
|
||||||
|
jitter->retain_start[jitter->retained] = v;
|
||||||
|
}
|
||||||
|
jitter->retained++;
|
||||||
|
return jitter->retained;
|
||||||
|
}
|
||||||
|
|
||||||
|
#ifdef JIT_PRECISE_GC
|
||||||
|
void scheme_mz_load_retained(mz_jit_state *jitter, int rs, int retptr)
|
||||||
|
{
|
||||||
|
void *p;
|
||||||
|
p = jitter->retain_start + retptr - 1;
|
||||||
|
(void)jit_patchable_movi_p(rs, p);
|
||||||
|
jit_ldr_p(rs, rs);
|
||||||
|
}
|
||||||
|
#endif
|
||||||
|
|
||||||
|
#if defined(MZ_USE_JIT_I386)
|
||||||
|
double *scheme_mz_retain_double(mz_jit_state *jitter, double d)
|
||||||
|
{
|
||||||
|
void *p;
|
||||||
|
if (jitter->retain_start)
|
||||||
|
jitter->retain_double_start[jitter->retained_double] = d;
|
||||||
|
p = jitter->retain_double_start + jitter->retained_double;
|
||||||
|
jitter->retained_double++;
|
||||||
|
return p;
|
||||||
|
}
|
||||||
|
#endif
|
||||||
|
|
||||||
|
void *scheme_generate_one(mz_jit_state *old_jitter,
|
||||||
|
Generate_Proc generate,
|
||||||
|
void *data,
|
||||||
|
int gcable,
|
||||||
|
void *save_ptr,
|
||||||
|
Scheme_Native_Closure_Data *ndata)
|
||||||
|
{
|
||||||
|
mz_jit_state _jitter;
|
||||||
|
mz_jit_state *jitter = &_jitter;
|
||||||
|
void *buffer;
|
||||||
|
int mappings_buffer[JIT_INIT_MAPPINGS_SIZE];
|
||||||
|
int *mappings = mappings_buffer;
|
||||||
|
intptr_t size = JIT_BUFFER_INIT_SIZE, known_size = 0;
|
||||||
|
intptr_t size_pre_retained = 0, size_pre_retained_double = 0, num_retained = 0, num_retained_double = 0, padding;
|
||||||
|
int mappings_size = JIT_INIT_MAPPINGS_SIZE;
|
||||||
|
int ok, max_extra_pushed = 0;
|
||||||
|
#ifdef MZ_PRECISE_GC
|
||||||
|
Scheme_Object *fnl_obj;
|
||||||
|
|
||||||
|
if (ndata) {
|
||||||
|
/* When fnl_obj becomes inaccessible, code generated
|
||||||
|
here can be freed. */
|
||||||
|
fnl_obj = scheme_box(scheme_false);
|
||||||
|
} else
|
||||||
|
fnl_obj = NULL;
|
||||||
|
#endif
|
||||||
|
|
||||||
|
if (!jit_buffer_cache_registered) {
|
||||||
|
jit_buffer_cache_registered = 1;
|
||||||
|
REGISTER_SO(jit_buffer_cache);
|
||||||
|
scheme_register_stack_cache_stack();
|
||||||
|
#ifdef MZ_PRECISE_GC
|
||||||
|
scheme_jit_register_traversers();
|
||||||
|
#endif
|
||||||
|
}
|
||||||
|
|
||||||
|
while (1) {
|
||||||
|
memset(jitter, 0, sizeof(_jitter));
|
||||||
|
#ifdef NEED_LONG_JUMPS
|
||||||
|
_jitl.long_jumps = 1;
|
||||||
|
#endif
|
||||||
|
#ifdef USE_TINY_JUMPS
|
||||||
|
_jitl.tiny_jumps = 0;
|
||||||
|
#endif
|
||||||
|
padding = JIT_BUFFER_PAD_SIZE;
|
||||||
|
if (known_size) {
|
||||||
|
size_pre_retained_double = known_size;
|
||||||
|
size_pre_retained = size_pre_retained_double + (num_retained_double * sizeof(double));
|
||||||
|
size = size_pre_retained + WORDS_TO_BYTES(num_retained);
|
||||||
|
padding = 0;
|
||||||
|
if (gcable) {
|
||||||
|
#ifdef MZ_PRECISE_GC
|
||||||
|
buffer = scheme_malloc_code(size);
|
||||||
|
scheme_jit_malloced += size_pre_retained_double;
|
||||||
|
#else
|
||||||
|
buffer = scheme_malloc_gcable_code(size);
|
||||||
|
#endif
|
||||||
|
} else {
|
||||||
|
buffer = scheme_malloc_code(size);
|
||||||
|
}
|
||||||
|
RECORD_CODE_SIZE(size);
|
||||||
|
} else if (old_jitter) {
|
||||||
|
/* this is a recursive generate, so use leftover space in
|
||||||
|
old_jitter's buffer */
|
||||||
|
buffer = get_end_pointer(old_jitter);
|
||||||
|
size = ((char *)old_jitter->limit - (char *)buffer);
|
||||||
|
if (size < JIT_BUFFER_INIT_SIZE) {
|
||||||
|
old_jitter = NULL;
|
||||||
|
buffer = NULL;
|
||||||
|
size = JIT_BUFFER_INIT_SIZE;
|
||||||
|
} else {
|
||||||
|
size_pre_retained_double = size;
|
||||||
|
size_pre_retained = size;
|
||||||
|
}
|
||||||
|
} else
|
||||||
|
buffer = NULL;
|
||||||
|
|
||||||
|
if (!buffer) {
|
||||||
|
if (jit_buffer_cache && (jit_buffer_cache_size >= size)) {
|
||||||
|
buffer = jit_buffer_cache;
|
||||||
|
size = jit_buffer_cache_size;
|
||||||
|
jit_buffer_cache = NULL;
|
||||||
|
} else {
|
||||||
|
#ifdef MZ_PRECISE_GC
|
||||||
|
intptr_t minsz;
|
||||||
|
minsz = GC_malloc_stays_put_threshold();
|
||||||
|
if (size < minsz)
|
||||||
|
size = minsz;
|
||||||
|
buffer = (char *)scheme_malloc_atomic(size);
|
||||||
|
#else
|
||||||
|
buffer = scheme_malloc(size);
|
||||||
|
#endif
|
||||||
|
}
|
||||||
|
size_pre_retained = size;
|
||||||
|
size_pre_retained_double = size;
|
||||||
|
}
|
||||||
|
|
||||||
|
(void)jit_set_ip(buffer).ptr;
|
||||||
|
jitter->limit = (char *)buffer + size_pre_retained_double - padding;
|
||||||
|
if (known_size) {
|
||||||
|
jitter->retain_double_start = (double *)jitter->limit;
|
||||||
|
jitter->retain_start = (void *)(jitter->limit + num_retained_double * sizeof(double));
|
||||||
|
#ifdef MZ_PRECISE_GC
|
||||||
|
if (ndata) {
|
||||||
|
memset(jitter->retain_start, 0, num_retained * sizeof(void*));
|
||||||
|
ndata->retained = (num_retained ? jitter->retain_start : NULL);
|
||||||
|
SCHEME_BOX_VAL(fnl_obj) = scheme_make_integer(size_pre_retained_double);
|
||||||
|
GC_set_finalizer(fnl_obj, 1, 3,
|
||||||
|
scheme_jit_release_native_code, buffer,
|
||||||
|
NULL, NULL);
|
||||||
|
}
|
||||||
|
#endif
|
||||||
|
} else {
|
||||||
|
jitter->retain_start = NULL;
|
||||||
|
jitter->retain_double_start = (double *)buffer;
|
||||||
|
}
|
||||||
|
|
||||||
|
jitter->mappings = mappings;
|
||||||
|
jitter->num_mappings = 0;
|
||||||
|
jitter->mappings_size = mappings_size;
|
||||||
|
mappings[0] = 0;
|
||||||
|
jitter->max_extra_pushed = max_extra_pushed;
|
||||||
|
jitter->self_pos = 1; /* beyond end of stack */
|
||||||
|
jitter->self_toplevel_pos = -1;
|
||||||
|
jitter->status_at_ptr = NULL;
|
||||||
|
|
||||||
|
/* Leave room for retained size on first pass,
|
||||||
|
install it if needed) on second pass:*/
|
||||||
|
if (!known_size || num_retained)
|
||||||
|
scheme_mz_retain_it(jitter, (void *)scheme_make_integer(num_retained));
|
||||||
|
|
||||||
|
ok = generate(jitter, data);
|
||||||
|
|
||||||
|
if (save_ptr) {
|
||||||
|
scheme_mz_retain_it(jitter, save_ptr);
|
||||||
|
}
|
||||||
|
#ifdef MZ_PRECISE_GC
|
||||||
|
if (fnl_obj) {
|
||||||
|
scheme_mz_retain_it(jitter, fnl_obj);
|
||||||
|
}
|
||||||
|
#endif
|
||||||
|
|
||||||
|
jitter->limit = (char *)jitter->limit + padding;
|
||||||
|
if (PAST_LIMIT() || (jitter->retain_start
|
||||||
|
&& (jitter->retained > num_retained))) {
|
||||||
|
scheme_console_printf("JIT buffer overflow: %p [%p,%p] (%d)!!\n",
|
||||||
|
jit_get_ip().ptr,
|
||||||
|
buffer, jitter->limit,
|
||||||
|
!!jitter->retain_start);
|
||||||
|
abort();
|
||||||
|
}
|
||||||
|
|
||||||
|
mappings_size = jitter->mappings_size;
|
||||||
|
mappings = jitter->mappings;
|
||||||
|
max_extra_pushed = jitter->max_extra_pushed;
|
||||||
|
|
||||||
|
if (ok) {
|
||||||
|
/* That was big enough: */
|
||||||
|
if (jitter->unbox || jitter->unbox_depth)
|
||||||
|
scheme_signal_error("internal error: ended with unbox or depth");
|
||||||
|
if (known_size) {
|
||||||
|
/* That was in the permanent area, so return: */
|
||||||
|
jit_flush_code(buffer, jit_get_ip().ptr);
|
||||||
|
return buffer;
|
||||||
|
} else {
|
||||||
|
/* Allocate permanent area and jit again: */
|
||||||
|
known_size = ((uintptr_t)jit_get_ip().ptr) - (uintptr_t)buffer;
|
||||||
|
if (known_size & (JIT_WORD_SIZE - 1)) {
|
||||||
|
known_size += (JIT_WORD_SIZE - (known_size & (JIT_WORD_SIZE - 1)));
|
||||||
|
}
|
||||||
|
if (jitter->retained_double) {
|
||||||
|
if (known_size & (JIT_DOUBLE_SIZE - 1)) {
|
||||||
|
known_size += (JIT_DOUBLE_SIZE - (known_size & (JIT_DOUBLE_SIZE - 1)));
|
||||||
|
}
|
||||||
|
}
|
||||||
|
num_retained = jitter->retained;
|
||||||
|
if (num_retained == 1) num_retained = 0;
|
||||||
|
num_retained_double = jitter->retained_double;
|
||||||
|
if (num_retained_double) {
|
||||||
|
if (known_size & (sizeof(double) - 1)) {
|
||||||
|
known_size += (sizeof(double) - (known_size & (sizeof(double) - 1)));
|
||||||
|
}
|
||||||
|
}
|
||||||
|
/* Keep this buffer? Don't if it's too big, or if it's
|
||||||
|
a part of old_jitter, or if there's already a bigger
|
||||||
|
cache. */
|
||||||
|
if ((jit_buffer_cache_size < JIT_CACHE_SIZE_LIMIT)
|
||||||
|
&& !old_jitter
|
||||||
|
&& (!jit_buffer_cache
|
||||||
|
|| (jit_buffer_cache_size > size))) {
|
||||||
|
jit_buffer_cache = buffer;
|
||||||
|
jit_buffer_cache_size = size;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
/* looping to try again... */
|
||||||
|
} else {
|
||||||
|
/* Need more room to try again: */
|
||||||
|
size = size * 2;
|
||||||
|
old_jitter = NULL;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
/*========================================================================*/
|
||||||
|
/* code-gen utils */
|
||||||
|
/*========================================================================*/
|
||||||
|
|
||||||
|
static void new_mapping(mz_jit_state *jitter)
|
||||||
|
{
|
||||||
|
jitter->num_mappings++;
|
||||||
|
if (jitter->num_mappings >= jitter->mappings_size) {
|
||||||
|
int *a;
|
||||||
|
a = (int *)scheme_malloc_atomic(jitter->mappings_size * 2 * sizeof(int));
|
||||||
|
memcpy(a, jitter->mappings, jitter->mappings_size * sizeof(int));
|
||||||
|
jitter->mappings = a;
|
||||||
|
jitter->mappings_size *= 2;
|
||||||
|
}
|
||||||
|
jitter->mappings[jitter->num_mappings] = 0;
|
||||||
|
}
|
||||||
|
|
||||||
|
void scheme_mz_pushr_p_it(mz_jit_state *jitter, int reg)
|
||||||
|
/* de-sync's rs */
|
||||||
|
{
|
||||||
|
int v;
|
||||||
|
|
||||||
|
jitter->extra_pushed++;
|
||||||
|
if (jitter->extra_pushed > jitter->max_extra_pushed)
|
||||||
|
jitter->max_extra_pushed = jitter->extra_pushed;
|
||||||
|
|
||||||
|
if (!(jitter->mappings[jitter->num_mappings] & 0x1)
|
||||||
|
|| (jitter->mappings[jitter->num_mappings] & 0x2)
|
||||||
|
|| (jitter->mappings[jitter->num_mappings] < 0)) {
|
||||||
|
new_mapping(jitter);
|
||||||
|
}
|
||||||
|
v = (jitter->mappings[jitter->num_mappings]) >> 2;
|
||||||
|
v++;
|
||||||
|
jitter->mappings[jitter->num_mappings] = ((v << 2) | 0x1);
|
||||||
|
|
||||||
|
mz_rs_dec(1);
|
||||||
|
CHECK_RUNSTACK_OVERFLOW_NOCL();
|
||||||
|
mz_rs_str(reg);
|
||||||
|
|
||||||
|
jitter->need_set_rs = 1;
|
||||||
|
}
|
||||||
|
|
||||||
|
void scheme_mz_popr_p_it(mz_jit_state *jitter, int reg, int discard)
|
||||||
|
/* de-sync's rs */
|
||||||
|
{
|
||||||
|
int v;
|
||||||
|
|
||||||
|
jitter->extra_pushed--;
|
||||||
|
|
||||||
|
JIT_ASSERT(jitter->mappings[jitter->num_mappings] & 0x1);
|
||||||
|
JIT_ASSERT(!(jitter->mappings[jitter->num_mappings] & 0x2));
|
||||||
|
v = jitter->mappings[jitter->num_mappings] >> 2;
|
||||||
|
v--;
|
||||||
|
if (!v)
|
||||||
|
--jitter->num_mappings;
|
||||||
|
else
|
||||||
|
jitter->mappings[jitter->num_mappings] = ((v << 2) | 0x1);
|
||||||
|
|
||||||
|
if (!discard)
|
||||||
|
mz_rs_ldr(reg);
|
||||||
|
mz_rs_inc(1);
|
||||||
|
|
||||||
|
jitter->need_set_rs = 1;
|
||||||
|
}
|
||||||
|
|
||||||
|
void scheme_mz_runstack_skipped(mz_jit_state *jitter, int n)
|
||||||
|
{
|
||||||
|
int v;
|
||||||
|
|
||||||
|
if (!(jitter->mappings[jitter->num_mappings] & 0x1)
|
||||||
|
|| (jitter->mappings[jitter->num_mappings] & 0x2)
|
||||||
|
|| (jitter->mappings[jitter->num_mappings] > 0)) {
|
||||||
|
new_mapping(jitter);
|
||||||
|
}
|
||||||
|
v = (jitter->mappings[jitter->num_mappings]) >> 2;
|
||||||
|
JIT_ASSERT(v <= 0);
|
||||||
|
v -= n;
|
||||||
|
jitter->mappings[jitter->num_mappings] = ((v << 2) | 0x1);
|
||||||
|
jitter->self_pos += n;
|
||||||
|
}
|
||||||
|
|
||||||
|
void scheme_mz_runstack_unskipped(mz_jit_state *jitter, int n)
|
||||||
|
{
|
||||||
|
int v;
|
||||||
|
|
||||||
|
JIT_ASSERT(jitter->mappings[jitter->num_mappings] & 0x1);
|
||||||
|
JIT_ASSERT(!(jitter->mappings[jitter->num_mappings] & 0x2));
|
||||||
|
v = (jitter->mappings[jitter->num_mappings]) >> 2;
|
||||||
|
JIT_ASSERT(v + n <= 0);
|
||||||
|
v += n;
|
||||||
|
if (!v)
|
||||||
|
--jitter->num_mappings;
|
||||||
|
else
|
||||||
|
jitter->mappings[jitter->num_mappings] = ((v << 2) | 0x1);
|
||||||
|
jitter->self_pos -= n;
|
||||||
|
}
|
||||||
|
|
||||||
|
void scheme_mz_runstack_pushed(mz_jit_state *jitter, int n)
|
||||||
|
{
|
||||||
|
jitter->depth += n;
|
||||||
|
if (jitter->depth > jitter->max_depth)
|
||||||
|
jitter->max_depth = jitter->depth;
|
||||||
|
jitter->self_pos += n;
|
||||||
|
if (!jitter->mappings[jitter->num_mappings]
|
||||||
|
|| (jitter->mappings[jitter->num_mappings] & 0x3)) {
|
||||||
|
new_mapping(jitter);
|
||||||
|
}
|
||||||
|
jitter->mappings[jitter->num_mappings] += (n << 2);
|
||||||
|
jitter->need_set_rs = 1;
|
||||||
|
}
|
||||||
|
|
||||||
|
void scheme_mz_runstack_closure_pushed(mz_jit_state *jitter, int a, int flags)
|
||||||
|
{
|
||||||
|
jitter->depth += 1;
|
||||||
|
if (jitter->depth > jitter->max_depth)
|
||||||
|
jitter->max_depth = jitter->depth;
|
||||||
|
jitter->self_pos += 1;
|
||||||
|
new_mapping(jitter);
|
||||||
|
jitter->mappings[jitter->num_mappings] = (a << 4) | (flags << 2) | 0x2;
|
||||||
|
jitter->need_set_rs = 1;
|
||||||
|
/* closures are never popped; they go away due to returns or tail calls */
|
||||||
|
}
|
||||||
|
|
||||||
|
#ifdef USE_FLONUM_UNBOXING
|
||||||
|
void scheme_mz_runstack_flonum_pushed(mz_jit_state *jitter, int pos)
|
||||||
|
{
|
||||||
|
jitter->depth += 1;
|
||||||
|
if (jitter->depth > jitter->max_depth)
|
||||||
|
jitter->max_depth = jitter->depth;
|
||||||
|
jitter->self_pos += 1;
|
||||||
|
new_mapping(jitter);
|
||||||
|
jitter->mappings[jitter->num_mappings] = (pos << 2) | 0x3;
|
||||||
|
jitter->need_set_rs = 1;
|
||||||
|
/* flonums are never popped; they go away due to returns or tail calls */
|
||||||
|
}
|
||||||
|
#endif
|
||||||
|
|
||||||
|
void scheme_mz_runstack_popped(mz_jit_state *jitter, int n)
|
||||||
|
{
|
||||||
|
int v;
|
||||||
|
jitter->depth -= n;
|
||||||
|
jitter->self_pos -= n;
|
||||||
|
|
||||||
|
v = jitter->mappings[jitter->num_mappings];
|
||||||
|
JIT_ASSERT(!(v & 0x1));
|
||||||
|
/* non-procedure slot */
|
||||||
|
v = v >> 2;
|
||||||
|
JIT_ASSERT(v >= n);
|
||||||
|
v -= n;
|
||||||
|
if (!v)
|
||||||
|
--jitter->num_mappings;
|
||||||
|
else
|
||||||
|
jitter->mappings[jitter->num_mappings] = (v << 2);
|
||||||
|
jitter->need_set_rs = 1;
|
||||||
|
}
|
||||||
|
|
||||||
|
int scheme_mz_try_runstack_pop(mz_jit_state *jitter, int n)
|
||||||
|
{
|
||||||
|
if (jitter->mappings[jitter->num_mappings] & 0x3)
|
||||||
|
return 0;
|
||||||
|
if ((jitter->mappings[jitter->num_mappings] >> 2) < n)
|
||||||
|
return 0;
|
||||||
|
mz_runstack_popped(jitter, n);
|
||||||
|
return 1;
|
||||||
|
}
|
||||||
|
|
||||||
|
void scheme_mz_runstack_saved(mz_jit_state *jitter)
|
||||||
|
{
|
||||||
|
new_mapping(jitter);
|
||||||
|
/* 0 slot means "saved here" */
|
||||||
|
}
|
||||||
|
|
||||||
|
int scheme_mz_compute_runstack_restored(mz_jit_state *jitter, int adj, int skip)
|
||||||
|
{
|
||||||
|
/* pop down to 0 slot */
|
||||||
|
int amt = 0, c, num_mappings;
|
||||||
|
|
||||||
|
num_mappings = jitter->num_mappings;
|
||||||
|
while (1) {
|
||||||
|
c = jitter->mappings[num_mappings];
|
||||||
|
if (!c) {
|
||||||
|
if (skip)
|
||||||
|
--skip;
|
||||||
|
else
|
||||||
|
break;
|
||||||
|
} else if (c & 0x1) {
|
||||||
|
if (c & 0x2) {
|
||||||
|
/* single flonum */
|
||||||
|
amt++;
|
||||||
|
if (adj) jitter->self_pos--;
|
||||||
|
} else {
|
||||||
|
/* native push or skip */
|
||||||
|
c >>= 2;
|
||||||
|
if (c > 0)
|
||||||
|
amt += c;
|
||||||
|
}
|
||||||
|
} else if (c & 0x2) {
|
||||||
|
/* single procedure */
|
||||||
|
amt++;
|
||||||
|
if (adj) jitter->self_pos--;
|
||||||
|
} else {
|
||||||
|
/* pushed N */
|
||||||
|
c = (c >> 2);
|
||||||
|
amt += c;
|
||||||
|
if (adj) jitter->self_pos -= c;
|
||||||
|
}
|
||||||
|
--num_mappings;
|
||||||
|
}
|
||||||
|
--num_mappings;
|
||||||
|
if (adj) {
|
||||||
|
jitter->num_mappings = num_mappings;
|
||||||
|
if (amt)
|
||||||
|
jitter->need_set_rs = 1;
|
||||||
|
jitter->depth -= amt;
|
||||||
|
}
|
||||||
|
return amt;
|
||||||
|
}
|
||||||
|
|
||||||
|
int scheme_mz_runstack_restored(mz_jit_state *jitter)
|
||||||
|
{
|
||||||
|
return scheme_mz_compute_runstack_restored(jitter, 1, 0);
|
||||||
|
}
|
||||||
|
|
||||||
|
int scheme_mz_flostack_save(mz_jit_state *jitter, int *pos)
|
||||||
|
{
|
||||||
|
*pos = jitter->flostack_offset;
|
||||||
|
return jitter->flostack_space;
|
||||||
|
}
|
||||||
|
|
||||||
|
void scheme_mz_flostack_restore(mz_jit_state *jitter, int space, int pos, int gen, int adj)
|
||||||
|
{
|
||||||
|
if (space != jitter->flostack_space) {
|
||||||
|
if (gen) {
|
||||||
|
int delta = jitter->flostack_space - space;
|
||||||
|
jit_addi_p(JIT_SP, JIT_SP, delta * sizeof(double));
|
||||||
|
}
|
||||||
|
if (adj) jitter->flostack_space = space;
|
||||||
|
}
|
||||||
|
if (adj) jitter->flostack_offset = pos;
|
||||||
|
}
|
||||||
|
|
||||||
|
int scheme_mz_remap_it(mz_jit_state *jitter, int i)
|
||||||
|
{
|
||||||
|
int j = i, p = jitter->num_mappings, c;
|
||||||
|
while (p && (j >= 0)) {
|
||||||
|
c = jitter->mappings[p];
|
||||||
|
if (c & 0x1) {
|
||||||
|
if (c & 0x2) {
|
||||||
|
/* single flonum */
|
||||||
|
j--;
|
||||||
|
} else {
|
||||||
|
/* native push or skip */
|
||||||
|
c >>= 2;
|
||||||
|
i += c;
|
||||||
|
if (c < 0)
|
||||||
|
j += c;
|
||||||
|
}
|
||||||
|
} else if (c & 0x2) {
|
||||||
|
/* single procedure */
|
||||||
|
j--;
|
||||||
|
} else {
|
||||||
|
/* pushed N */
|
||||||
|
j -= (c >> 2);
|
||||||
|
}
|
||||||
|
--p;
|
||||||
|
}
|
||||||
|
return i;
|
||||||
|
}
|
||||||
|
|
||||||
|
int scheme_mz_is_closure(mz_jit_state *jitter, int i, int arity, int *_flags)
|
||||||
|
{
|
||||||
|
int j = i, p = jitter->num_mappings, c;
|
||||||
|
while (p && (j >= 0)) {
|
||||||
|
c = jitter->mappings[p];
|
||||||
|
if (c & 0x1) {
|
||||||
|
if (c & 0x2) {
|
||||||
|
/* single flonum */
|
||||||
|
j--;
|
||||||
|
} else {
|
||||||
|
/* native push or skip */
|
||||||
|
c >>= 2;
|
||||||
|
if (c < 0)
|
||||||
|
j += c;
|
||||||
|
}
|
||||||
|
} else if (c & 0x2) {
|
||||||
|
/* procedure */
|
||||||
|
if (!j) {
|
||||||
|
/* the one we're looking for */
|
||||||
|
if ((arity == (c >> 4)) || (arity == -1)) {
|
||||||
|
*_flags = (c >> 2) & 0x3;
|
||||||
|
return 1;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
j--;
|
||||||
|
} else {
|
||||||
|
/* pushed N */
|
||||||
|
j -= (c >> 2);
|
||||||
|
}
|
||||||
|
--p;
|
||||||
|
}
|
||||||
|
return 0;
|
||||||
|
}
|
||||||
|
|
||||||
|
#ifdef USE_FLONUM_UNBOXING
|
||||||
|
int scheme_mz_flonum_pos(mz_jit_state *jitter, int i)
|
||||||
|
{
|
||||||
|
int j = i, p = jitter->num_mappings, c;
|
||||||
|
while (p && (j >= 0)) {
|
||||||
|
c = jitter->mappings[p];
|
||||||
|
if (c & 0x1) {
|
||||||
|
if (c & 0x2) {
|
||||||
|
/* single flonum */
|
||||||
|
if (!j) {
|
||||||
|
/* the one we're looking for */
|
||||||
|
return c >> 2;
|
||||||
|
}
|
||||||
|
j--;
|
||||||
|
} else {
|
||||||
|
/* native push or skip */
|
||||||
|
c >>= 2;
|
||||||
|
if (c < 0)
|
||||||
|
j += c;
|
||||||
|
}
|
||||||
|
} else if (c & 0x2) {
|
||||||
|
/* single procedure */
|
||||||
|
j--;
|
||||||
|
} else {
|
||||||
|
/* pushed N */
|
||||||
|
j -= (c >> 2);
|
||||||
|
}
|
||||||
|
--p;
|
||||||
|
}
|
||||||
|
scheme_signal_error("internal error: flonum position not found");
|
||||||
|
return 0;
|
||||||
|
}
|
||||||
|
#endif
|
||||||
|
|
||||||
|
int scheme_stack_safety(mz_jit_state *jitter, int cnt, int offset)
|
||||||
|
/* de-sync'd rs ok */
|
||||||
|
{
|
||||||
|
/* To preserve space safety, we must initialize any stack room
|
||||||
|
that we make, so that whatever happens to be there isn't
|
||||||
|
traversed in case of a GC. the value of JIT_RUNSTACK is
|
||||||
|
handy to use as a "clear" value. */
|
||||||
|
int i;
|
||||||
|
for (i = 0; i < cnt; i++) {
|
||||||
|
mz_rs_stxi(i+offset, JIT_RUNSTACK);
|
||||||
|
CHECK_LIMIT();
|
||||||
|
}
|
||||||
|
return 1;
|
||||||
|
}
|
||||||
|
|
||||||
|
#endif
|
||||||
|
|
@ -285,11 +285,7 @@ static jit_state _jit;
|
||||||
#define jit_pushr_p(rs) jit_pushr_ul(rs)
|
#define jit_pushr_p(rs) jit_pushr_ul(rs)
|
||||||
#define jit_popr_p(rs) jit_popr_ul(rs)
|
#define jit_popr_p(rs) jit_popr_ul(rs)
|
||||||
|
|
||||||
static void jit_check_arg_count(int n) {
|
#define jit_prepare(nint) jit_prepare_i((nint))
|
||||||
if (n > 3) printf("jit_prepare: arg count must be less than 3 for x86_64!\n");
|
|
||||||
}
|
|
||||||
|
|
||||||
#define jit_prepare(nint) (jit_check_arg_count(nint), jit_prepare_i((nint)))
|
|
||||||
#define jit_pusharg_c(rs) jit_pusharg_i(rs)
|
#define jit_pusharg_c(rs) jit_pusharg_i(rs)
|
||||||
#define jit_pusharg_s(rs) jit_pusharg_i(rs)
|
#define jit_pusharg_s(rs) jit_pusharg_i(rs)
|
||||||
#define jit_pusharg_uc(rs) jit_pusharg_i(rs)
|
#define jit_pusharg_uc(rs) jit_pusharg_i(rs)
|
||||||
|
|
|
||||||
|
|
@ -34,14 +34,7 @@
|
||||||
#ifndef __lightning_funcs_h
|
#ifndef __lightning_funcs_h
|
||||||
#define __lightning_funcs_h
|
#define __lightning_funcs_h
|
||||||
|
|
||||||
static void
|
#define jit_notify_freed_code() /* empty */
|
||||||
jit_notify_freed_code(void)
|
#define jit_flush_code(d, e) /* empty */
|
||||||
{
|
|
||||||
}
|
|
||||||
|
|
||||||
static void
|
|
||||||
jit_flush_code(void *dest, void *end)
|
|
||||||
{
|
|
||||||
}
|
|
||||||
|
|
||||||
#endif /* __lightning_funcs_h */
|
#endif /* __lightning_funcs_h */
|
||||||
|
|
|
||||||
|
|
@ -5452,8 +5452,10 @@ typedef struct Evt {
|
||||||
/* PLACE_THREAD_DECL */
|
/* PLACE_THREAD_DECL */
|
||||||
static int evts_array_size;
|
static int evts_array_size;
|
||||||
static Evt **evts;
|
static Evt **evts;
|
||||||
|
#if defined(MZ_PRECISE_GC) && defined(MZ_USE_PLACES)
|
||||||
THREAD_LOCAL_DECL(static int place_evts_array_size);
|
THREAD_LOCAL_DECL(static int place_evts_array_size);
|
||||||
THREAD_LOCAL_DECL(static Evt **place_evts);
|
THREAD_LOCAL_DECL(static Evt **place_evts);
|
||||||
|
#endif
|
||||||
|
|
||||||
void scheme_add_evt_worker(Evt ***evt_array,
|
void scheme_add_evt_worker(Evt ***evt_array,
|
||||||
int *evt_size,
|
int *evt_size,
|
||||||
|
|
|
||||||
|
|
@ -43,6 +43,13 @@
|
||||||
"fun"
|
"fun"
|
||||||
"hash"
|
"hash"
|
||||||
"jit"
|
"jit"
|
||||||
|
"jitalloc"
|
||||||
|
"jitarith"
|
||||||
|
"jitcall"
|
||||||
|
"jitcommon"
|
||||||
|
"jitinline"
|
||||||
|
"jitstack"
|
||||||
|
"jitstate"
|
||||||
"list"
|
"list"
|
||||||
"module"
|
"module"
|
||||||
"mzrt"
|
"mzrt"
|
||||||
|
|
|
||||||
|
|
@ -609,6 +609,34 @@
|
||||||
RelativePath="..\..\Racket\Src\jit.c"
|
RelativePath="..\..\Racket\Src\jit.c"
|
||||||
>
|
>
|
||||||
</File>
|
</File>
|
||||||
|
<File
|
||||||
|
RelativePath="..\..\Racket\Src\jitalloc.c"
|
||||||
|
>
|
||||||
|
</File>
|
||||||
|
<File
|
||||||
|
RelativePath="..\..\Racket\Src\jitarith.c"
|
||||||
|
>
|
||||||
|
</File>
|
||||||
|
<File
|
||||||
|
RelativePath="..\..\Racket\Src\jitcall.c"
|
||||||
|
>
|
||||||
|
</File>
|
||||||
|
<File
|
||||||
|
RelativePath="..\..\Racket\Src\jitcommon.c"
|
||||||
|
>
|
||||||
|
</File>
|
||||||
|
<File
|
||||||
|
RelativePath="..\..\Racket\Src\jitinline.c"
|
||||||
|
>
|
||||||
|
</File>
|
||||||
|
<File
|
||||||
|
RelativePath="..\..\Racket\Src\jitstack.c"
|
||||||
|
>
|
||||||
|
</File>
|
||||||
|
<File
|
||||||
|
RelativePath="..\..\Racket\Src\jitstate.c"
|
||||||
|
>
|
||||||
|
</File>
|
||||||
<File
|
<File
|
||||||
RelativePath="..\..\Racket\Src\List.c"
|
RelativePath="..\..\Racket\Src\List.c"
|
||||||
>
|
>
|
||||||
|
|
|
||||||
Loading…
Reference in New Issue
Block a user