From 064776348a4529b30f497376b98bd0ae95e45807 Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Fri, 19 Dec 2008 17:16:39 +0000 Subject: [PATCH] fix ready-toplevel optimization svn: r12905 --- collects/compiler/decompile.ss | 4 ++-- collects/compiler/zo-parse.ss | 6 +++--- src/mzscheme/src/env.c | 7 +++++-- src/mzscheme/src/eval.c | 13 ++++++++++++- src/mzscheme/src/module.c | 23 ++++++++++++++--------- src/mzscheme/src/schpriv.h | 2 +- src/mzscheme/src/syntax.c | 2 +- 7 files changed, 38 insertions(+), 19 deletions(-) diff --git a/collects/compiler/decompile.ss b/collects/compiler/decompile.ss index 99336c5e37..c78d310a40 100644 --- a/collects/compiler/decompile.ss +++ b/collects/compiler/decompile.ss @@ -172,9 +172,9 @@ (define (decompile-expr expr globs stack closed) (match expr - [(struct toplevel (depth pos const? mutated?)) + [(struct toplevel (depth pos const? ready?)) (let ([id (list-ref/protect globs pos 'toplevel)]) - (if const? + (if (or const? ready?) id `(#%checked ,id)))] [(struct topsyntax (depth pos midpt)) diff --git a/collects/compiler/zo-parse.ss b/collects/compiler/zo-parse.ss index 41366dafdb..00c1a5dbb2 100644 --- a/collects/compiler/zo-parse.ss +++ b/collects/compiler/zo-parse.ss @@ -37,7 +37,7 @@ (define-form-struct localref (unbox? offset clear?)) ; access local via stack -(define-form-struct toplevel (depth pos const? mutated?)) ; access binding via prefix array (which is on stack) +(define-form-struct toplevel (depth pos const? ready?)) ; access binding via prefix array (which is on stack) (define-form-struct topsyntax (depth pos midpt)) ; access syntax object via prefix array (which is on stack) (define-form-struct application (rator rands)) ; function call @@ -68,12 +68,12 @@ (define (read-toplevel v) (define SCHEME_TOPLEVEL_CONST #x01) - (define SCHEME_TOPLEVEL_MUTATED #x02) + (define SCHEME_TOPLEVEL_READY #x02) (match v [(cons depth (cons pos flags)) (make-toplevel depth pos (positive? (bitwise-and flags SCHEME_TOPLEVEL_CONST)) - (positive? (bitwise-and flags SCHEME_TOPLEVEL_MUTATED)))] + (positive? (bitwise-and flags SCHEME_TOPLEVEL_READY)))] [(cons depth pos) (make-toplevel depth pos #f #f)])) diff --git a/src/mzscheme/src/env.c b/src/mzscheme/src/env.c index 3b467e7e66..d39eaef82c 100644 --- a/src/mzscheme/src/env.c +++ b/src/mzscheme/src/env.c @@ -3690,7 +3690,7 @@ int scheme_resolve_quote_syntax_pos(Resolve_Info *info) return info->prefix->num_toplevels; } -Scheme_Object *scheme_resolve_toplevel(Resolve_Info *info, Scheme_Object *expr) +Scheme_Object *scheme_resolve_toplevel(Resolve_Info *info, Scheme_Object *expr, int keep_ready) { int skip; @@ -3699,7 +3699,10 @@ Scheme_Object *scheme_resolve_toplevel(Resolve_Info *info, Scheme_Object *expr) return make_toplevel(skip + SCHEME_TOPLEVEL_DEPTH(expr), /* depth is 0 (normal) or 1 (exp-time) */ SCHEME_TOPLEVEL_POS(expr), 1, - SCHEME_TOPLEVEL_FLAGS(expr) & SCHEME_TOPLEVEL_CONST); + SCHEME_TOPLEVEL_FLAGS(expr) & (SCHEME_TOPLEVEL_CONST + | (keep_ready + ? SCHEME_TOPLEVEL_READY + : 0))); } Scheme_Object *scheme_shift_toplevel(Scheme_Object *expr, int delta) diff --git a/src/mzscheme/src/eval.c b/src/mzscheme/src/eval.c index 5fb9529f3c..70013d0363 100644 --- a/src/mzscheme/src/eval.c +++ b/src/mzscheme/src/eval.c @@ -778,6 +778,17 @@ int scheme_omittable_expr(Scheme_Object *o, int vals, int fuel, int resolved, } } + if (vtype == scheme_compiled_toplevel_type) { + note_match(1, vals, warn_info); + if ((vals == 1) || (vals < 0)) { + if (SCHEME_TOPLEVEL_FLAGS(o) + & (SCHEME_TOPLEVEL_CONST | SCHEME_TOPLEVEL_READY)) + return 1; + else + return 0; + } + } + if ((vtype == scheme_syntax_type) && (SCHEME_PINT_VAL(o) == CASE_LAMBDA_EXPD)) { note_match(1, vals, warn_info); @@ -1906,7 +1917,7 @@ Scheme_Object *scheme_resolve_expr(Scheme_Object *expr, Resolve_Info *info) case scheme_compiled_let_void_type: return scheme_resolve_lets(expr, info); case scheme_compiled_toplevel_type: - return scheme_resolve_toplevel(info, expr); + return scheme_resolve_toplevel(info, expr, 1); case scheme_compiled_quote_syntax_type: { Scheme_Quote_Syntax *qs; diff --git a/src/mzscheme/src/module.c b/src/mzscheme/src/module.c index a1c2b39b40..28156d0998 100644 --- a/src/mzscheme/src/module.c +++ b/src/mzscheme/src/module.c @@ -4803,7 +4803,7 @@ module_optimize(Scheme_Object *data, Optimize_Info *info) int start_simltaneous = 0, i_m, cnt; Scheme_Object *cl_first = NULL, *cl_last = NULL; Scheme_Hash_Table *consts = NULL, *ready_table = NULL, *re_consts = NULL; - int cont; + int cont, next_pos_ready = -1; old_context = info->context; info->context = (Scheme_Object *)m; @@ -4887,14 +4887,8 @@ module_optimize(Scheme_Object *data, Optimize_Info *info) /* Test for ISCONST to indicate no set!: */ if (!(SCHEME_TOPLEVEL_FLAGS(a) & SCHEME_TOPLEVEL_MUTATED)) { pos = SCHEME_TOPLEVEL_POS(a); - - if (!ready_table) { - ready_table = scheme_make_hash_table(SCHEME_hash_ptr); - if (!consts) - consts = scheme_make_hash_table(SCHEME_hash_ptr); - scheme_hash_set(consts, scheme_false, (Scheme_Object *)ready_table); - } - scheme_hash_set(ready_table, scheme_make_integer(pos), scheme_true); + + next_pos_ready = pos; } } } @@ -4966,6 +4960,17 @@ module_optimize(Scheme_Object *data, Optimize_Info *info) re_consts = NULL; start_simltaneous = i_m + 1; } + + if (next_pos_ready > -1) { + if (!ready_table) { + ready_table = scheme_make_hash_table(SCHEME_hash_ptr); + if (!consts) + consts = scheme_make_hash_table(SCHEME_hash_ptr); + scheme_hash_set(consts, scheme_false, (Scheme_Object *)ready_table); + } + scheme_hash_set(ready_table, scheme_make_integer(next_pos_ready), scheme_true); + next_pos_ready = -1; + } } /* Check one more time for expressions that we can omit: */ diff --git a/src/mzscheme/src/schpriv.h b/src/mzscheme/src/schpriv.h index 798d84c3ec..0ff2debbc0 100644 --- a/src/mzscheme/src/schpriv.h +++ b/src/mzscheme/src/schpriv.h @@ -2225,7 +2225,7 @@ int scheme_resolve_toplevel_pos(Resolve_Info *info); int scheme_resolve_is_toplevel_available(Resolve_Info *info); int scheme_resolve_quote_syntax_offset(int i, Resolve_Info *info); int scheme_resolve_quote_syntax_pos(Resolve_Info *info); -Scheme_Object *scheme_resolve_toplevel(Resolve_Info *info, Scheme_Object *expr); +Scheme_Object *scheme_resolve_toplevel(Resolve_Info *info, Scheme_Object *expr, int keep_ready); Scheme_Object *scheme_resolve_invent_toplevel(Resolve_Info *info); Scheme_Object *scheme_resolve_invented_toplevel_to_defn(Resolve_Info *info, Scheme_Object *tl); Scheme_Object *scheme_shift_toplevel(Scheme_Object *expr, int delta); diff --git a/src/mzscheme/src/syntax.c b/src/mzscheme/src/syntax.c index 85a738ce65..00c61b81ee 100644 --- a/src/mzscheme/src/syntax.c +++ b/src/mzscheme/src/syntax.c @@ -1010,7 +1010,7 @@ define_values_resolve(Scheme_Object *data, Resolve_Info *rslv) && (!(SCHEME_TOPLEVEL_FLAGS(a) & SCHEME_TOPLEVEL_MUTATED))) { a = scheme_toplevel_to_flagged_toplevel(a, SCHEME_TOPLEVEL_CONST); } - a = scheme_resolve_toplevel(rslv, a); + a = scheme_resolve_toplevel(rslv, a, 0); SCHEME_CAR(l) = a; cnt++; }