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

split jit.c into multiple files

Browse Source
This commit is contained in:
Matthew Flatt 2011-02-18 16:52:04 -07:00
parent 5249152743
commit 4b13dc0ba4
20 changed files with 12167 additions and 11590 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

42
src/racket/gc2/Makefile.in
View File

@ -52,6 +52,13 @@ OBJS = salloc.@LTO@ \
future.@LTO@ \
hash.@LTO@ \
jit.@LTO@ \
jitalloc.@LTO@ \
jitarith.@LTO@ \
jitcall.@LTO@ \
jitcommon.@LTO@ \
jitinline.@LTO@ \
jitstack.@LTO@ \
jitstate.@LTO@ \
list.@LTO@ \
module.@LTO@ \
mzrt.@LTO@ \
@ -97,6 +104,13 @@ XSRCS = $(XSRCDIR)/salloc.c \
$(XSRCDIR)/future.c \
$(XSRCDIR)/hash.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)/module.c \
$(XSRCDIR)/network.c \
@ -183,6 +197,20 @@ $(XSRCDIR)/hash.c: ../src/hash.@LTO@ $(XFORMDEP)
$(XFORM) $(XSRCDIR)/hash.c $(SRCDIR)/hash.c
$(XSRCDIR)/jit.c: ../src/jit.@LTO@ $(XFORMDEP) $(LIGHTNINGDEP)
$(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
$(XFORM) $(XSRCDIR)/module.c $(SRCDIR)/module.c
$(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@
jit.@LTO@: $(XSRCDIR)/jit.c
$(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
$(CC) $(CFLAGS) -c $(XSRCDIR)/list.c -o list.@LTO@
module.@LTO@: $(XSRCDIR)/module.c

4
src/racket/include/schthread.h
View File

@ -158,7 +158,7 @@ typedef struct Thread_Local_Variables {
struct Scheme_Object **fixup_runstack_base_;
int fixup_already_in_place_;
void *retry_alloc_r1_;
double save_fp_;
double scheme_jit_save_fp_;
struct Scheme_Bucket_Table *starts_table_;
struct Scheme_Modidx *modidx_caching_chain_;
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_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 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 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_)

58
src/racket/src/Makefile.in
View File

@ -28,6 +28,13 @@ OBJS = salloc.@LTO@ \
gmp.@LTO@ \
hash.@LTO@ \
jit.@LTO@ \
jitalloc.@LTO@ \
jitarith.@LTO@ \
jitcall.@LTO@ \
jitcommon.@LTO@ \
jitinline.@LTO@ \
jitstack.@LTO@ \
jitstate.@LTO@ \
list.@LTO@ \
module.@LTO@ \
mzrt.@LTO@ \
@ -71,6 +78,13 @@ SRCS = $(srcdir)/salloc.c \
$(srcdir)/gmp/gmp.c \
$(srcdir)/hash.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)/module.c \
$(srcdir)/mzrt.c \
@ -180,6 +194,20 @@ hash.@LTO@: $(srcdir)/hash.c
$(CC) $(CFLAGS) -c $(srcdir)/hash.c -o hash.@LTO@
jit.@LTO@: $(srcdir)/jit.c
$(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
$(CC) $(CFLAGS) -c $(srcdir)/list.c -o list.@LTO@
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 \
$(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) \
$(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
hash.@LTO@: $(COMMON_HEADERS) \
$(srcdir)/../src/stypes.h $(srcdir)/mzmark.c
jit.@LTO@: $(COMMON_HEADERS) \
$(srcdir)/../src/stypes.h $(srcdir)/codetab.inc $(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
jit.@LTO@: $(COMMON_HEADERS) $(JIT_HEADERS)
jitalloc.@LTO@: $(COMMON_HEADERS) $(JIT_HEADERS)
jitarith.@LTO@: $(COMMON_HEADERS) $(JIT_HEADERS)
jitcall.@LTO@: $(COMMON_HEADERS) $(JIT_HEADERS)
jitcommon.@LTO@: $(COMMON_HEADERS) $(JIT_HEADERS)
jitinline.@LTO@: $(COMMON_HEADERS) $(JIT_HEADERS)
jitstack.@LTO@: $(COMMON_HEADERS) $(JIT_HEADERS) $(srcdir)/codetab.inc
jitstate.@LTO@: $(COMMON_HEADERS) $(JIT_HEADERS)
list.@LTO@: $(COMMON_HEADERS) \
$(srcdir)/../src/stypes.h
module.@LTO@: $(COMMON_HEADERS) \

2
src/racket/src/codetab.inc
View File

@ -61,7 +61,7 @@ static void **malloc_node()
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;
int m;

2
src/racket/src/future.h
View File

@ -189,7 +189,6 @@ extern Scheme_Object *future_touch(int futureid);
#endif
#else
Scheme_Object *scheme_make_fsemaphore(int argc, Scheme_Object *argv[]);
#endif /* MZ_USE_FUTURES */
/* 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_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_fsemaphore_wait(int argc, Scheme_Object *argv[]);
Scheme_Object *scheme_fsemaphore_post(int argc, Scheme_Object *argv[]);

11736
src/racket/src/jit.c
View File

File diff suppressed because it is too large Load Diff

1199
src/racket/src/jit.h Normal file
View File

File diff suppressed because it is too large Load Diff

131
src/racket/src/jit_ts.c
View File

@ -14,43 +14,39 @@
z = size_t
m = MZ_MARK_STACK_TYPE */
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_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)
#ifdef JIT_TS_PROCS
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_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_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_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_cdr, 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_flreal_part, 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_set, 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_set, 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_S_s(apply_checked_fail, FSRC_MARKS)
define_ts_iSi_s(scheme_build_list_offset, FSRC_OTHER)
define_ts_siS_v(wrong_argument_count, FSRC_MARKS)
#endif
#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
# define ts__scheme_apply_multi_from_native _scheme_apply_multi_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_scheme_box scheme_box
# define ts_scheme_make_mutable_pair scheme_make_mutable_pair
# define ts_make_list_star make_list_star
# define ts_make_list make_list
# define ts_scheme_jit_make_list_star scheme_jit_make_list_star
# define ts_scheme_jit_make_list scheme_jit_make_list
# define ts_scheme_make_pair scheme_make_pair
# define ts_make_one_element_ivector make_one_element_ivector
# define ts_make_one_element_vector make_one_element_vector
# define ts_make_two_element_ivector make_two_element_ivector
# define ts_make_two_element_vector make_two_element_vector
# define ts_make_ivector make_ivector
# define ts_make_vector make_vector
# define ts_scheme_jit_make_one_element_ivector scheme_jit_make_one_element_ivector
# define ts_scheme_jit_make_one_element_vector scheme_jit_make_one_element_vector
# define ts_scheme_jit_make_two_element_ivector scheme_jit_make_two_element_ivector
# define ts_scheme_jit_make_two_element_vector scheme_jit_make_two_element_vector
# define ts_scheme_jit_make_ivector scheme_jit_make_ivector
# 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_tagged GC_malloc_one_small_tagged
# define ts_scheme_make_native_closure scheme_make_native_closure

311
src/racket/src/jitalloc.c Normal file
View 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
View File

File diff suppressed because it is too large Load Diff

1599
src/racket/src/jitcall.c Normal file
View File

File diff suppressed because it is too large Load Diff

2399
src/racket/src/jitcommon.c Normal file
View File

File diff suppressed because it is too large Load Diff

3059
src/racket/src/jitinline.c Normal file
View File

File diff suppressed because it is too large Load Diff

499
src/racket/src/jitstack.c Normal file
View 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
View 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

6
src/racket/src/lightning/i386/core-common.h
View File

@ -285,11 +285,7 @@ static jit_state _jit;
#define jit_pushr_p(rs) jit_pushr_ul(rs)
#define jit_popr_p(rs) jit_popr_ul(rs)
static void jit_check_arg_count(int n) {
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_prepare(nint) jit_prepare_i((nint))
#define jit_pusharg_c(rs) jit_pusharg_i(rs)
#define jit_pusharg_s(rs) jit_pusharg_i(rs)
#define jit_pusharg_uc(rs) jit_pusharg_i(rs)

11
src/racket/src/lightning/i386/funcs.h
View File

@ -34,14 +34,7 @@
#ifndef __lightning_funcs_h
#define __lightning_funcs_h
static void
jit_notify_freed_code(void)
{
}
static void
jit_flush_code(void *dest, void *end)
{
}
#define jit_notify_freed_code() /* empty */
#define jit_flush_code(d, e) /* empty */
#endif /* __lightning_funcs_h */

2
src/racket/src/thread.c
View File

@ -5452,8 +5452,10 @@ typedef struct Evt {
/* PLACE_THREAD_DECL */
static int evts_array_size;
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 Evt **place_evts);
#endif
void scheme_add_evt_worker(Evt ***evt_array,
int *evt_size,

7
src/worksp/gc2/make.rkt
View File

@ -43,6 +43,13 @@
"fun"
"hash"
"jit"
"jitalloc"
"jitarith"
"jitcall"
"jitcommon"
"jitinline"
"jitstack"
"jitstate"
"list"
"module"
"mzrt"

28
src/worksp/libracket/libracket.vcproj
View File

@ -609,6 +609,34 @@
RelativePath="..\..\Racket\Src\jit.c"
>
</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
RelativePath="..\..\Racket\Src\List.c"
>