From 6151119d5e758f259c8053c5a688bc06cdb13646 Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Tue, 5 Jan 2010 20:24:59 +0000 Subject: [PATCH] JIT tweak for flonum comparisons; better bytecode-compiler transformations for expressions used as branch tests svn: r17486 --- .../scribblings/gui/bitmap-dc-class.scrbl | 7 +- collects/tests/mzscheme/optimize.ss | 8 ++ src/mzscheme/src/eval.c | 42 +++++---- src/mzscheme/src/lightning/i386/fp.h | 21 ++++- src/mzscheme/src/schpriv.h | 5 +- src/mzscheme/src/syntax.c | 89 +++++++++---------- 6 files changed, 101 insertions(+), 71 deletions(-) diff --git a/collects/scribblings/gui/bitmap-dc-class.scrbl b/collects/scribblings/gui/bitmap-dc-class.scrbl index 4a71ab80cd..58d649d4b8 100644 --- a/collects/scribblings/gui/bitmap-dc-class.scrbl +++ b/collects/scribblings/gui/bitmap-dc-class.scrbl @@ -72,7 +72,7 @@ The pixel RGB values are copied into @scheme[pixels]. The first byte If @scheme[alpha?] is false, then the alpha value for each pixel is set to 255. If @scheme[alpha?] is true, then @italic{only} the alpha - value is set for each pixel, based on each pixel's value. Thus, the + value is set for each pixel, based on each pixel's inverted value. Thus, the same @scheme[pixels] byte string is in general filled from two bitmaps: one (the main image) for the pixel values and one (the mask) for the alpha values. @@ -129,8 +129,9 @@ The pixel RGB values are taken from @scheme[pixels]. The first byte order, left to right then top to bottom. If @scheme[alpha?] is false, then the alpha value for each pixel is - ignored. If @scheme[alpha?] is true, then @italic{only} the each - pixel is set based @italic{only} on the alpha value. Thus, the same + ignored. If @scheme[alpha?] is true, then each + pixel is set based @italic{only} on the alpha value, but inverted to serve + as a mask. Thus, the same @scheme[pixels] byte string is in general used with two bitmaps, one (the main image) for the pixel values and one (the mask) for the alpha values. diff --git a/collects/tests/mzscheme/optimize.ss b/collects/tests/mzscheme/optimize.ss index 7a40c0e34d..a1f177ba2e 100644 --- a/collects/tests/mzscheme/optimize.ss +++ b/collects/tests/mzscheme/optimize.ss @@ -678,6 +678,14 @@ (test-comp '(lambda (x) (if (cons 1 x) 78 78)) '(lambda (x) 78)) +(test-comp '(lambda (x) (if (let ([r (something)]) + (if r r (something-else))) + (a1) + (a2))) + '(lambda (x) (if (if (something) #t (something-else)) + (a1) + (a2)))) + (test-comp '(values 10) 10) (test-comp '(let ([x (values 10)]) diff --git a/src/mzscheme/src/eval.c b/src/mzscheme/src/eval.c index 1bb5624af3..65552badc9 100644 --- a/src/mzscheme/src/eval.c +++ b/src/mzscheme/src/eval.c @@ -3586,7 +3586,10 @@ static Scheme_Object *optimize_sequence(Scheme_Object *o, Optimize_Info *info, i for (i = 0; i < count; i++) { prev_size = info->size; - le = scheme_optimize_expr(s->array[i], info, 0); + le = scheme_optimize_expr(s->array[i], info, + ((i + 1 == count) + ? scheme_optimize_tail_context(context) + : 0)); if (i == s->count - 1) { single_result = info->single_result; preserves_marks = info->preserves_marks; @@ -3674,6 +3677,19 @@ static Scheme_Object *optimize_branch(Scheme_Object *o, Optimize_Info *info, int tb = b->tbranch; fb = b->fbranch; + if (context & OPT_CONTEXT_BOOLEAN) { + /* For test position, convert (if #t #f) to */ + if (SAME_OBJ(tb, scheme_true) && SAME_OBJ(fb, scheme_false)) + return scheme_optimize_expr(t, info, context); + + /* Convert (if expr) to (if #t expr) */ + if (SAME_TYPE(SCHEME_TYPE(t), scheme_local_type) + && SAME_TYPE(SCHEME_TYPE(tb), scheme_local_type) + && (SCHEME_LOCAL_POS(t) == SCHEME_LOCAL_POS(tb))) { + b->tbranch = tb = scheme_true; + } + } + /* Try optimize: (if (not x) y z) => (if x z y) */ while (1) { if (SAME_TYPE(SCHEME_TYPE(t), scheme_application2_type)) { @@ -3691,33 +3707,23 @@ static Scheme_Object *optimize_branch(Scheme_Object *o, Optimize_Info *info, int break; } - if (SAME_TYPE(SCHEME_TYPE(t), scheme_compiled_let_void_type)) { - /* Maybe convert: (let ([x M]) (if x x N)) => (if M #t N) */ - t = scheme_optimize_lets_for_test(t, info, 0); - } else - t = scheme_optimize_expr(t, info, 0); + t = scheme_optimize_expr(t, info, OPT_CONTEXT_BOOLEAN); info->vclock += 1; /* model branch as clock increment */ - /* For test position, convert (if #t #f) to */ - if (SAME_TYPE(SCHEME_TYPE(t), scheme_branch_type) - && SAME_OBJ(((Scheme_Branch_Rec *)t)->tbranch, scheme_true) - && SAME_OBJ(((Scheme_Branch_Rec *)t)->fbranch, scheme_false)) - t = ((Scheme_Branch_Rec *)t)->test; - if (SCHEME_TYPE(t) > _scheme_compiled_values_types_) { info->size -= 1; if (SCHEME_FALSEP(t)) - return scheme_optimize_expr(fb, info, 0); + return scheme_optimize_expr(fb, info, scheme_optimize_tail_context(context)); else - return scheme_optimize_expr(tb, info, 0); + return scheme_optimize_expr(tb, info, scheme_optimize_tail_context(context)); } else if (SAME_TYPE(SCHEME_TYPE(t), scheme_compiled_quote_syntax_type) || SAME_TYPE(SCHEME_TYPE(t), scheme_compiled_unclosed_procedure_type)) { info->size -= 1; /* could be more precise for better for procedure size */ - return scheme_optimize_expr(tb, info, 0); + return scheme_optimize_expr(tb, info, scheme_optimize_tail_context(context)); } - tb = scheme_optimize_expr(tb, info, 0); + tb = scheme_optimize_expr(tb, info, scheme_optimize_tail_context(context)); if (!info->preserves_marks) preserves_marks = 0; @@ -3728,7 +3734,7 @@ static Scheme_Object *optimize_branch(Scheme_Object *o, Optimize_Info *info, int else if (info->single_result < 0) single_result = -1; - fb = scheme_optimize_expr(fb, info, 0); + fb = scheme_optimize_expr(fb, info, scheme_optimize_tail_context(context)); if (!info->preserves_marks) preserves_marks = 0; @@ -3797,7 +3803,7 @@ static Scheme_Object *optimize_wcm(Scheme_Object *o, Optimize_Info *info, int co v = scheme_optimize_expr(wcm->val, info, 0); - b = scheme_optimize_expr(wcm->body, info, 0); + b = scheme_optimize_expr(wcm->body, info, scheme_optimize_tail_context(context)); /* info->single_result is already set */ info->preserves_marks = 0; diff --git a/src/mzscheme/src/lightning/i386/fp.h b/src/mzscheme/src/lightning/i386/fp.h index 85c89f40d9..89de7548ed 100644 --- a/src/mzscheme/src/lightning/i386/fp.h +++ b/src/mzscheme/src/lightning/i386/fp.h @@ -346,6 +346,19 @@ union jit_double_imm { (void) (_jitl.r0_can_be_tmp ? 0 : POPQr(_EAX)), \ res ((d), 0, 0, 0), _jit.x.pc) +#define jit_fp_btest_fppop(d, n, _and, cmp, res) \ + (FUCOMPPr(1), \ + (_jitl.r0_can_be_tmp ? 0 : PUSHQr(_EAX)), \ + FNSTSWr(_EAX), \ + SHRLir(n, _EAX), \ + (void)((_and) ? ANDLir ((_and), _EAX) : 0), \ + (void)((cmp) ? CMPLir ((cmp), _AL) : 0), \ + (void) (_jitl.r0_can_be_tmp ? 0 : POPQr(_EAX)), \ + res ((d), 0, 0, 0), _jit.x.pc) + +#define jit_fp_btest_fppop_2(d, res) \ + (FUCOMIPr(1), FSTPr(0), res ((d), 0, 0, 0), _jit.x.pc) + #define jit_nothing_needed(x) /* After FNSTSW we have 1 if <, 40 if =, 0 if >, 45 if unordered. Here @@ -408,17 +421,21 @@ union jit_double_imm { #define jit_bunordr_d(d, s1, s2) jit_fp_btest((d), (s1), (s2), 11, 0, 0, JCm) #define jit_bger_d_fppop(d, s1, s2) jit_fp_btest_fppop((d), 9, 0, 0, JNCm) -#define jit_bantiger_d_fppop(d, s1, s2) jit_fp_btest_fppop((d), 9, 0, 0, JCm) +/* #define jit_bantiger_d_fppop(d, s1, s2) jit_fp_btest_fppop((d), 9, 0, 0, JCm) */ +#define jit_bantiger_d_fppop(d, s1, s2) jit_fp_btest_fppop_2((d), JBm) #define jit_bler_d_fppop(d, s1, s2) (FXCHr(1), jit_bger_d_fppop(d, s1, s2)) #define jit_bantiler_d_fppop(d, s1, s2) (FXCHr(1), jit_bantiger_d_fppop(d, s1, s2)) #define jit_bgtr_d_fppop(d, s1, s2) jit_fp_btest_fppop((d), 8, 0x45, 0, JZm) -#define jit_bantigtr_d_fppop(d, s1, s2) jit_fp_btest_fppop((d), 8, 0x45, 0, JNZm) +/* #define jit_bantigtr_d_fppop(d, s1, s2) jit_fp_btest_fppop((d), 8, 0x45, 0, JNZm) */ +#define jit_bantigtr_d_fppop(d, s1, s2) jit_fp_btest_fppop_2((d), JBEm) #define jit_bltr_d_fppop(d, s1, s2) (FXCHr(1), jit_bgtr_d_fppop(d, s1, s2)) #define jit_bantiltr_d_fppop(d, s1, s2) (FXCHr(1), jit_bantigtr_d_fppop(d, s1, s2)) #define jit_beqr_d_fppop(d, s1, s2) jit_fp_btest_fppop((d), 8, 0x45, 0x40, JZm) #define jit_bantieqr_d_fppop(d, s1, s2) jit_fp_btest_fppop((d), 8, 0x45, 0x40, JNZm) +/* Doesn't work right with +nan.0: */ +/* #define jit_bantieqr_d_fppop(d, s1, s2) jit_fp_btest_fppop_2((d), JNZm) */ #define jit_getarg_f(rd, ofs) jit_ldxi_f((rd), JIT_FP,(ofs)) #define jit_getarg_d(rd, ofs) jit_ldxi_d((rd), JIT_FP,(ofs)) diff --git a/src/mzscheme/src/schpriv.h b/src/mzscheme/src/schpriv.h index 9d87c19064..f6821670ec 100644 --- a/src/mzscheme/src/schpriv.h +++ b/src/mzscheme/src/schpriv.h @@ -2269,9 +2269,12 @@ Scheme_Object *scheme_make_syntax_compiled(int idx, Scheme_Object *data); Scheme_Object *scheme_optimize_expr(Scheme_Object *, Optimize_Info *, int context); Scheme_Object *scheme_optimize_lets(Scheme_Object *form, Optimize_Info *info, int for_inline, int context); -Scheme_Object *scheme_optimize_lets_for_test(Scheme_Object *form, Optimize_Info *info, int context); #define OPT_CONTEXT_FLONUM_ARG 0x1 +#define OPT_CONTEXT_BOOLEAN 0x2 + +#define scheme_optimize_result_context(c) (c & (~OPT_CONTEXT_FLONUM_ARG)) +#define scheme_optimize_tail_context(c) scheme_optimize_result_context(c) Scheme_Object *scheme_optimize_apply_values(Scheme_Object *f, Scheme_Object *e, Optimize_Info *info, diff --git a/src/mzscheme/src/syntax.c b/src/mzscheme/src/syntax.c index 6e55a2868f..3d0d623b6b 100644 --- a/src/mzscheme/src/syntax.c +++ b/src/mzscheme/src/syntax.c @@ -3039,6 +3039,43 @@ scheme_optimize_lets(Scheme_Object *form, Optimize_Info *info, int for_inline, i int size_before_opt, did_set_value; int remove_last_one = 0, inline_fuel; + if (context & OPT_CONTEXT_BOOLEAN) { + /* Special case: (let ([x M]) (if x x N)), where x is not in N, + to (if M #t #f), since we're in a test position. */ + if (!(SCHEME_LET_FLAGS(head) & SCHEME_LET_RECURSIVE) && (head->count == 1) && (head->num_clauses == 1)) { + clv = (Scheme_Compiled_Let_Value *)head->body; + if (SAME_TYPE(SCHEME_TYPE(clv->body), scheme_branch_type) + && (((clv->flags[0] & SCHEME_USE_COUNT_MASK) >> SCHEME_USE_COUNT_SHIFT) + == 2)) { + Scheme_Branch_Rec *b = (Scheme_Branch_Rec *)clv->body; + if (SAME_TYPE(SCHEME_TYPE(b->test), scheme_local_type) + && SAME_TYPE(SCHEME_TYPE(b->tbranch), scheme_local_type) + && !SCHEME_LOCAL_POS(b->test) + && !SCHEME_LOCAL_POS(b->tbranch)) { + Scheme_Branch_Rec *b3; + Optimize_Info *sub_info; + + b3 = MALLOC_ONE_TAGGED(Scheme_Branch_Rec); + b3->so.type = scheme_branch_type; + b3->test = clv->value; + b3->tbranch = scheme_true; + b3->fbranch = b->fbranch; + + sub_info = scheme_optimize_info_add_frame(info, 1, 0, 0); + + form = scheme_optimize_expr((Scheme_Object *)b3, sub_info, context); + + info->single_result = sub_info->single_result; + info->preserves_marks = sub_info->preserves_marks; + + scheme_optimize_info_done(sub_info); + + return form; + } + } + } + } + /* Special case: (let ([x E]) x) where E is lambda, case-lambda, or a constant. (If we allowed arbitrary E here, it would affect the tailness of E.) */ @@ -3408,7 +3445,7 @@ scheme_optimize_lets(Scheme_Object *form, Optimize_Info *info, int for_inline, i body_info->vclock = rhs_info->vclock; } - body = scheme_optimize_expr(body, body_info, 0); + body = scheme_optimize_expr(body, body_info, scheme_optimize_tail_context(context)); if (head->num_clauses) pre_body->body = body; else @@ -3536,51 +3573,6 @@ scheme_optimize_lets(Scheme_Object *form, Optimize_Info *info, int for_inline, i return form; } -Scheme_Object * -scheme_optimize_lets_for_test(Scheme_Object *form, Optimize_Info *info, int context) -/* Special case for when the `let' expression appears in an `if' test */ -{ - Scheme_Let_Header *head = (Scheme_Let_Header *)form; - - /* Special case: (let ([x M]) (if x x N)), where x is not in N, - to (if M #t #f), since we're in a test position. */ - if (!(SCHEME_LET_FLAGS(head) & SCHEME_LET_RECURSIVE) && (head->count == 1) && (head->num_clauses == 1)) { - Scheme_Compiled_Let_Value *clv; - clv = (Scheme_Compiled_Let_Value *)head->body; - if (SAME_TYPE(SCHEME_TYPE(clv->body), scheme_branch_type) - && (((clv->flags[0] & SCHEME_USE_COUNT_MASK) >> SCHEME_USE_COUNT_SHIFT) - == 2)) { - Scheme_Branch_Rec *b = (Scheme_Branch_Rec *)clv->body; - if (SAME_TYPE(SCHEME_TYPE(b->test), scheme_local_type) - && SAME_TYPE(SCHEME_TYPE(b->tbranch), scheme_local_type) - && !SCHEME_LOCAL_POS(b->test) - && !SCHEME_LOCAL_POS(b->tbranch)) { - Scheme_Branch_Rec *b3; - Optimize_Info *sub_info; - - b3 = MALLOC_ONE_TAGGED(Scheme_Branch_Rec); - b3->so.type = scheme_branch_type; - b3->test = clv->value; - b3->tbranch = scheme_true; - b3->fbranch = b->fbranch; - - sub_info = scheme_optimize_info_add_frame(info, 1, 0, 0); - - form = scheme_optimize_expr((Scheme_Object *)b3, sub_info, context); - - info->single_result = sub_info->single_result; - info->preserves_marks = sub_info->preserves_marks; - - scheme_optimize_info_done(sub_info); - - return form; - } - } - } - - return scheme_optimize_lets(form, info, 0, context); -} - static int is_lifted_reference(Scheme_Object *v) { if (SCHEME_RPAIRP(v)) @@ -4909,7 +4901,10 @@ begin0_optimize(Scheme_Object *obj, Optimize_Info *info, int context) for (i = 0; i < count; i++) { Scheme_Object *le; - le = scheme_optimize_expr(((Scheme_Sequence *)obj)->array[i], info, 0); + le = scheme_optimize_expr(((Scheme_Sequence *)obj)->array[i], info, + (!i + ? scheme_optimize_result_context(context) + : 0)); ((Scheme_Sequence *)obj)->array[i] = le; }