From be80e7d864ecf212d3ec2669d9a9b637720f904e Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Sat, 3 Dec 2011 13:54:58 -0700 Subject: [PATCH] fix an over-eager reordering by the bytecode compiler The over-eager transformation could be space-unsafe, and it could duplicate an unsafe operation whose result is used only once in a function that eds up being inlined multiple times. --- collects/tests/racket/optimize.rktl | 29 +++++++++++++++ src/racket/src/compile.c | 8 +++- src/racket/src/optimize.c | 57 ++++++++++++++++++++++------- 3 files changed, 78 insertions(+), 16 deletions(-) diff --git a/collects/tests/racket/optimize.rktl b/collects/tests/racket/optimize.rktl index e53aa60afe..e619d1e642 100644 --- a/collects/tests/racket/optimize.rktl +++ b/collects/tests/racket/optimize.rktl @@ -5,6 +5,7 @@ (require racket/flonum racket/fixnum + racket/unsafe/ops compiler/zo-parse) ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -1364,6 +1365,34 @@ (- (expt 2 31) 2)) #f) +;; don't duplicate an operation by moving it into a lambda': +(test-comp '(lambda (x) + (let ([y (unsafe-flvector-length x)]) + (let ([f (lambda () y)]) + (+ (f) (f))))) + '(lambda (x) + (+ (unsafe-flvector-length x) (unsafe-flvector-length x))) + #f) + +;; don't delay an unsafe car, because it might be space-unsafe +(test-comp '(lambda (f x) + (let ([y (unsafe-car x)]) + (f) + y)) + '(lambda (f x) + (f) + (unsafe-car x)) + #f) + +;; it's ok to delay `list', because there's no space-safety issue +(test-comp '(lambda (f x) + (let ([y (list x)]) + (f) + y)) + '(lambda (f x) + (f) + (list x))) + ;; simple cross-module inlining (test-comp `(module m racket/base (require racket/bool) diff --git a/src/racket/src/compile.c b/src/racket/src/compile.c index c57062667a..e900150baf 100644 --- a/src/racket/src/compile.c +++ b/src/racket/src/compile.c @@ -2078,8 +2078,7 @@ gen_let_syntax (Scheme_Object *form, Scheme_Comp_Env *origenv, char *formname, Scheme_Compiled_Let_Value *last = NULL, *lv; DupCheckRecord r; int rec_env_already = rec[drec].env_already; - int rev_bind_order = recursive; - int post_bind = !recursive && !star; + int rev_bind_order, post_bind; Scheme_Let_Header *head; form = scheme_stx_taint_disarm(form, NULL); @@ -2103,6 +2102,11 @@ gen_let_syntax (Scheme_Object *form, Scheme_Comp_Env *origenv, char *formname, if (num_clauses < 0) scheme_wrong_syntax(NULL, bindings, form, NULL); + if (num_clauses < 2) star = 0; + + post_bind = !recursive && !star; + rev_bind_order = recursive; + forms = SCHEME_STX_CDR(form); forms = SCHEME_STX_CDR(forms); forms = scheme_datum_to_syntax(forms, form, form, 0, 0); diff --git a/src/racket/src/optimize.c b/src/racket/src/optimize.c index 2482a13eb4..e876222fb6 100644 --- a/src/racket/src/optimize.c +++ b/src/racket/src/optimize.c @@ -528,16 +528,24 @@ static int single_valued_noncm_expression(Scheme_Object *expr, int fuel) } static int is_movable_prim(Scheme_Object *rator, int n, int cross_lambda) +/* A -1 return means that the arguments must be movable without + changing space complexity. */ { if (rator && SCHEME_PRIMP(rator)) { - if (((Scheme_Prim_Proc_Header *)rator)->flags & SCHEME_PRIM_IS_UNSAFE_FUNCTIONAL) - return 1; + if (((Scheme_Prim_Proc_Header *)rator)->flags & SCHEME_PRIM_IS_UNSAFE_FUNCTIONAL) { + /* Although it's semantically ok to return -1 even when cross_lambda, + doing so risks duplicating a computation of the relevant `lambda' + is later inlined. */ + return -1; + } } if (SAME_OBJ(scheme_void_proc, rator)) - return 1; + return -1; if (!cross_lambda + /* Note that none of these have space-safety issues, since they + return values that contain all arguments: */ && (SAME_OBJ(scheme_list_proc, rator) || (SAME_OBJ(scheme_cons_proc, rator) && (n == 2)) || SAME_OBJ(scheme_list_star_proc, rator) @@ -549,44 +557,66 @@ static int is_movable_prim(Scheme_Object *rator, int n, int cross_lambda) return 0; } -static int movable_expression(Scheme_Object *expr, Optimize_Info *info, int delta, int cross_lambda, int fuel) +static int movable_expression(Scheme_Object *expr, Optimize_Info *info, int delta, int cross_lambda, + int check_space, int fuel) /* An expression that can't necessarily be constant-folded, but can be delayed because it has no side-effects (or is unsafe); also not sensitive to being in tail position */ { + int can_move; + if (fuel < 0) return 0; switch (SCHEME_TYPE(expr)) { + case scheme_toplevel_type: + return ((SCHEME_TOPLEVEL_FLAGS(expr) & SCHEME_TOPLEVEL_FLAGS_MASK) >= SCHEME_TOPLEVEL_FIXED); + case scheme_compiled_quote_syntax_type: + return 1; case scheme_local_type: { /* Ok if not mutable */ int pos = SCHEME_LOCAL_POS(expr); if (pos + delta < 0) return 1; - else if (!optimize_is_mutated(info, pos + delta)) + else if (!optimize_is_mutated(info, pos + delta)) { + if (check_space) { + if (optimize_is_flonum_valued(info, pos + delta)) + return 1; + /* the value of the identifier might be something that would + retain significant memory, so we can't delay evaluation */ + return 0; + } return 1; + } } break; case scheme_application_type: - if (is_movable_prim(((Scheme_App_Rec *)expr)->args[0], ((Scheme_App_Rec *)expr)->num_args, cross_lambda)) { + can_move = is_movable_prim(((Scheme_App_Rec *)expr)->args[0], ((Scheme_App_Rec *)expr)->num_args, cross_lambda); + if (can_move) { int i; for (i = ((Scheme_App_Rec *)expr)->num_args; i--; ) { - if (!movable_expression(((Scheme_App_Rec *)expr)->args[i+1], info, delta, cross_lambda, fuel - 1)) + if (!movable_expression(((Scheme_App_Rec *)expr)->args[i+1], info, delta, cross_lambda, + check_space || (can_move < 0), fuel - 1)) return 0; } return 1; } break; case scheme_application2_type: - if (is_movable_prim(((Scheme_App2_Rec *)expr)->rator, 1, cross_lambda)) { - if (movable_expression(((Scheme_App2_Rec *)expr)->rand, info, delta, cross_lambda, fuel - 1)) + can_move = is_movable_prim(((Scheme_App2_Rec *)expr)->rator, 1, cross_lambda); + if (can_move) { + if (movable_expression(((Scheme_App2_Rec *)expr)->rand, info, delta, cross_lambda, + check_space || (can_move < 0), fuel - 1)) return 1; } break; case scheme_application3_type: - if (is_movable_prim(((Scheme_App3_Rec *)expr)->rator, 2, cross_lambda)) { - if (movable_expression(((Scheme_App3_Rec *)expr)->rand1, info, delta, cross_lambda, fuel - 1) - && movable_expression(((Scheme_App3_Rec *)expr)->rand2, info, delta, cross_lambda, fuel - 1)) + can_move = is_movable_prim(((Scheme_App3_Rec *)expr)->rator, 2, cross_lambda); + if (can_move) { + if (movable_expression(((Scheme_App3_Rec *)expr)->rand1, info, delta, cross_lambda, + check_space || (can_move < 0), fuel - 1) + && movable_expression(((Scheme_App3_Rec *)expr)->rand2, info, delta, cross_lambda, + check_space || (can_move < 0), fuel - 1)) return 1; } break; @@ -3226,7 +3256,6 @@ int scheme_compiled_propagate_ok(Scheme_Object *value, Optimize_Info *info) return 1; } - if (SAME_TYPE(SCHEME_TYPE(value), scheme_compiled_toplevel_type)) { if ((SCHEME_TOPLEVEL_FLAGS(value) & SCHEME_TOPLEVEL_FLAGS_MASK) >= SCHEME_TOPLEVEL_FIXED) return 1; @@ -5075,7 +5104,7 @@ Scheme_Object *scheme_optimize_expr(Scheme_Object *expr, Optimize_Info *info, in if (((o->vclock == info->vclock) && single_valued_noncm_expression(o->expr, 5)) || ((o->vclock != info->vclock) - && movable_expression(o->expr, info, o->delta, o->cross_lambda, 5))) { + && movable_expression(o->expr, info, o->delta, o->cross_lambda, 0, 5))) { val = scheme_optimize_clone(1, o->expr, info, o->delta, 0); if (val) { info->size -= 1;