From b510d142f3b0de94690fcacf0cf62d138698fb9c Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Thu, 9 Feb 2006 04:04:34 +0000 Subject: [PATCH] inline a few more little tests svn: r2182 --- src/mzscheme/src/bool.c | 9 ++--- src/mzscheme/src/eval.c | 2 +- src/mzscheme/src/jit.c | 82 +++++++++++++++++++++++++++++++-------- src/mzscheme/src/number.c | 21 +++++----- 4 files changed, 80 insertions(+), 34 deletions(-) diff --git a/src/mzscheme/src/bool.c b/src/mzscheme/src/bool.c index dde054f57d..06aa5b5aa8 100644 --- a/src/mzscheme/src/bool.c +++ b/src/mzscheme/src/bool.c @@ -70,14 +70,11 @@ void scheme_init_bool (Scheme_Env *env) p = scheme_make_folding_prim(not_prim, "not", 1, 1, 1); scheme_not_prim = p; SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_IS_UNARY_INLINED; - scheme_add_global_constant("not", p, env); - scheme_add_global_constant("boolean?", - scheme_make_folding_prim(boolean_p_prim, - "boolean?", - 1, 1, 1), - env); + p = scheme_make_folding_prim(boolean_p_prim, "boolean?", 1, 1, 1); + SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_IS_UNARY_INLINED; + scheme_add_global_constant("boolean?", p, env); p = scheme_make_folding_prim(eq_prim, "eq?", 2, 2, 1); SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_IS_BINARY_INLINED; diff --git a/src/mzscheme/src/eval.c b/src/mzscheme/src/eval.c index 3fd12b868b..7e843d08ee 100644 --- a/src/mzscheme/src/eval.c +++ b/src/mzscheme/src/eval.c @@ -68,7 +68,7 @@ The eval half of the loop detects a limited set of core syntactic forms, such as application and letrecs. Otherwise, it dispatches to external functions to implement elaborate syntactic forms, such as - class and unit expressions. + begin0 and case-lambda expressions. When collecting the arguments for an application, scheme_do_eval() avoids recursive C calls to evaluate arguments by recogzining diff --git a/src/mzscheme/src/jit.c b/src/mzscheme/src/jit.c index c7654a0442..cf1cad5c0b 100644 --- a/src/mzscheme/src/jit.c +++ b/src/mzscheme/src/jit.c @@ -1602,7 +1602,8 @@ static int generate_arith(mz_jit_state *jitter, Scheme_Object *rator, Scheme_Obj } static int generate_inlined_constant_test(mz_jit_state *jitter, Scheme_App2_Rec *app, - Scheme_Object *cnst, jit_insn **for_branch, int branch_short) + Scheme_Object *cnst, Scheme_Object *cnst2, + jit_insn **for_branch, int branch_short) { GC_CAN_IGNORE jit_insn *ref, *ref2; @@ -1617,7 +1618,14 @@ static int generate_inlined_constant_test(mz_jit_state *jitter, Scheme_App2_Rec __START_SHORT_JUMPS__(branch_short); - ref = jit_bnei_p(jit_forward(), JIT_R0, cnst); + if (cnst2) { + ref2 = jit_beqi_p(jit_forward(), JIT_R0, cnst); + ref = jit_bnei_p(jit_forward(), JIT_R0, cnst2); + mz_patch_branch(ref2); + } else { + ref = jit_bnei_p(jit_forward(), JIT_R0, cnst); + } + if (for_branch) { for_branch[0] = ref; } else { @@ -1634,9 +1642,13 @@ static int generate_inlined_constant_test(mz_jit_state *jitter, Scheme_App2_Rec } static int generate_inlined_type_test(mz_jit_state *jitter, Scheme_App2_Rec *app, - Scheme_Type ty, jit_insn **for_branch, int branch_short) + Scheme_Type lo_ty, Scheme_Type hi_ty, + jit_insn **for_branch, int branch_short) { - GC_CAN_IGNORE jit_insn *ref, *ref2, *ref3; + GC_CAN_IGNORE jit_insn *ref, *ref2, *ref3, *ref4; + int int_ok; + + int_ok = ((lo_ty <= scheme_integer_type) && (scheme_integer_type <= hi_ty)); LOG_IT(("inlined %s\n", ((Scheme_Primitive_Proc *)app->rator)->name)); @@ -1651,15 +1663,35 @@ static int generate_inlined_type_test(mz_jit_state *jitter, Scheme_App2_Rec *app ref = jit_bmsi_ul(jit_forward(), JIT_R0, 0x1); jit_ldxi_s(JIT_R0, JIT_R0, &((Scheme_Object *)0x0)->type); - ref3 = jit_bnei_p(jit_forward(), JIT_R0, ty); - if (for_branch) { - for_branch[0] = ref; - for_branch[1] = ref3; + if (lo_ty == hi_ty) { + ref3 = jit_bnei_p(jit_forward(), JIT_R0, lo_ty); + ref4 = NULL; } else { + ref3 = jit_blti_p(jit_forward(), JIT_R0, lo_ty); + ref4 = jit_bgti_p(jit_forward(), JIT_R0, hi_ty); + } + if (int_ok) { + mz_patch_branch(ref); + } + if (for_branch) { + if (!int_ok) { + for_branch[0] = ref; + } + for_branch[1] = ref3; + for_branch[3] = ref4; + } else { + if ((lo_ty <= scheme_integer_type) && (scheme_integer_type <= hi_ty)) { + mz_patch_branch(ref); + } (void)jit_movi_p(JIT_R0, scheme_true); ref2 = jit_jmpi(jit_forward()); - mz_patch_branch(ref); + if (!int_ok) { + mz_patch_branch(ref); + } mz_patch_branch(ref3); + if (ref4) { + mz_patch_branch(ref4); + } (void)jit_movi_p(JIT_R0, scheme_false); mz_patch_ucbranch(ref2); } @@ -1681,22 +1713,31 @@ static int generate_inlined_unary(mz_jit_state *jitter, Scheme_App2_Rec *app, in return 0; if (IS_NAMED_PRIM(rator, "not")) { - generate_inlined_constant_test(jitter, app, scheme_false, for_branch, branch_short); + generate_inlined_constant_test(jitter, app, scheme_false, NULL, for_branch, branch_short); return 1; } else if (IS_NAMED_PRIM(rator, "null?")) { - generate_inlined_constant_test(jitter, app, scheme_null, for_branch, branch_short); + generate_inlined_constant_test(jitter, app, scheme_null, NULL, for_branch, branch_short); return 1; } else if (IS_NAMED_PRIM(rator, "pair?")) { - generate_inlined_type_test(jitter, app, scheme_pair_type, for_branch, branch_short); + generate_inlined_type_test(jitter, app, scheme_pair_type, scheme_pair_type, for_branch, branch_short); return 1; } else if (IS_NAMED_PRIM(rator, "symbol?")) { - generate_inlined_type_test(jitter, app, scheme_symbol_type, for_branch, branch_short); + generate_inlined_type_test(jitter, app, scheme_symbol_type, scheme_symbol_type, for_branch, branch_short); return 1; } else if (IS_NAMED_PRIM(rator, "syntax?")) { - generate_inlined_type_test(jitter, app, scheme_stx_type, for_branch, branch_short); + generate_inlined_type_test(jitter, app, scheme_stx_type, scheme_stx_type, for_branch, branch_short); return 1; } else if (IS_NAMED_PRIM(rator, "char?")) { - generate_inlined_type_test(jitter, app, scheme_char_type, for_branch, branch_short); + generate_inlined_type_test(jitter, app, scheme_char_type, scheme_char_type, for_branch, branch_short); + return 1; + } else if (IS_NAMED_PRIM(rator, "boolean?")) { + generate_inlined_constant_test(jitter, app, scheme_false, scheme_true, for_branch, branch_short); + return 1; + } else if (IS_NAMED_PRIM(rator, "number?")) { + generate_inlined_type_test(jitter, app, scheme_integer_type, scheme_complex_type, for_branch, branch_short); + return 1; + } else if (IS_NAMED_PRIM(rator, "real?")) { + generate_inlined_type_test(jitter, app, scheme_integer_type, scheme_complex_izi_type, for_branch, branch_short); return 1; } else if (IS_NAMED_PRIM(rator, "zero?")) { generate_arith(jitter, rator, app->rand, NULL, 1, 0, 0, 0, for_branch, branch_short); @@ -2603,7 +2644,7 @@ static int generate(Scheme_Object *obj, mz_jit_state *jitter, int is_tail, int m case scheme_branch_type: { Scheme_Branch_Rec *branch = (Scheme_Branch_Rec *)obj; - jit_insn *refs[3], *ref2; + jit_insn *refs[4], *ref2; int nsrs, nsrs1, g1, g2, amt; #ifdef MZ_USE_JIT_PPC int then_short_ok, else_short_ok; @@ -2623,8 +2664,10 @@ static int generate(Scheme_Object *obj, mz_jit_state *jitter, int is_tail, int m LOG_IT(("if...\n")); + refs[0] = NULL; refs[1] = NULL; refs[2] = NULL; + refs[3] = NULL; if (!generate_inlined_test(jitter, branch->test, then_short_ok, refs)) { CHECK_LIMIT(); @@ -2662,13 +2705,18 @@ static int generate(Scheme_Object *obj, mz_jit_state *jitter, int is_tail, int m /* False branch */ mz_runstack_saved(jitter); __START_SHORT_JUMPS__(then_short_ok); - mz_patch_branch(refs[0]); + if (refs[0]) { + mz_patch_branch(refs[0]); + } if (refs[1]) { mz_patch_branch(refs[1]); } if (refs[2]) { jit_patch_movi(refs[2], (_jit.x.pc)); } + if (refs[3]) { + mz_patch_branch(refs[3]); + } __END_SHORT_JUMPS__(then_short_ok); PAUSE_JIT_DATA(); LOG_IT(("...else\n")); diff --git a/src/mzscheme/src/number.c b/src/mzscheme/src/number.c index 35213473cc..24a9638d67 100644 --- a/src/mzscheme/src/number.c +++ b/src/mzscheme/src/number.c @@ -118,6 +118,8 @@ double scheme_floating_point_nzero = 0.0; /* negated below; many compilers treat void scheme_init_number (Scheme_Env *env) { + Scheme_Object *p; + REGISTER_SO(scheme_pi); REGISTER_SO(scheme_half_pi); REGISTER_SO(scheme_zerod); @@ -217,21 +219,20 @@ scheme_init_number (Scheme_Env *env) scheme_single_nan_object = scheme_make_float((float)not_a_number_val); #endif - scheme_add_global_constant("number?", - scheme_make_folding_prim(number_p, - "number?", - 1, 1, 1), - env); + p = scheme_make_folding_prim(number_p, "number?", 1, 1, 1); + SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_IS_UNARY_INLINED; + scheme_add_global_constant("number?", p, env); + scheme_add_global_constant("complex?", scheme_make_folding_prim(complex_p, "complex?", 1, 1, 1), env); - scheme_add_global_constant("real?", - scheme_make_folding_prim(real_p, - "real?", - 1, 1, 1), - env); + + p = scheme_make_folding_prim(real_p, "real?", 1, 1, 1); + SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_IS_UNARY_INLINED; + scheme_add_global_constant("real?", p, env); + scheme_add_global_constant("rational?", scheme_make_folding_prim(rational_p, "rational?",