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

fix ready-toplevel optimization

Browse Source 
svn: r12905
This commit is contained in:
Matthew Flatt 2008-12-19 17:16:39 +00:00
parent 4412652784
commit 064776348a
7 changed files with 38 additions and 19 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
collects/compiler/decompile.ss
View File

@ -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))

6
collects/compiler/zo-parse.ss
View File

@ -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)]))

7
src/mzscheme/src/env.c
View File

@ -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)

13
src/mzscheme/src/eval.c
View File

@ -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;

23
src/mzscheme/src/module.c
View File

@ -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: */

2
src/mzscheme/src/schpriv.h
View File

@ -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);

2
src/mzscheme/src/syntax.c
View File

@ -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++;
}