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

first cut at cross-module function inlining

Browse Source 
Inline only trivial functions, such as `(empty? x)' -> `(null? x)',
to avoid generating too much code.

Bytecode includes a new `inline-variant' form, which records a
version of a function that is suitable for cross-module inlining.
Mostly, the variant let the run-time system to retain a copy
of the bytecode while JITting (and dropping the bytecode of)
the main variant, but it may be different from the main variant
in other ways that make it better for inlining (such a less loop
unrolling).
This commit is contained in:
Matthew Flatt 2011-11-29 20:20:05 -07:00
parent 1ebde53db7
commit 779b419c03
30 changed files with 1000 additions and 343 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
collects/compiler/decompile.rkt
View File

@ -193,7 +193,12 @@
[(struct toplevel (depth pos const? set-const?)) [(struct toplevel (depth pos const? set-const?))
(list-ref/protect (glob-desc-vars globs) pos 'def-vals)])) (list-ref/protect (glob-desc-vars globs) pos 'def-vals)]))
ids) ids)
,(decompile-expr rhs globs stack closed))] ,(if (inline-variant? rhs)
`(begin
,(list 'quote '%%inline-variant%%)
,(decompile-expr (inline-variant-inline rhs) globs stack closed)
,(decompile-expr (inline-variant-direct rhs) globs stack closed))
(decompile-expr rhs globs stack closed)))]
[(struct def-syntaxes (ids rhs prefix max-let-depth dummy)) [(struct def-syntaxes (ids rhs prefix max-let-depth dummy))
`(define-syntaxes ,ids `(define-syntaxes ,ids
,(let-values ([(globs defns) (decompile-prefix prefix stx-ht)]) ,(let-values ([(globs defns) (decompile-prefix prefix stx-ht)])

8
collects/compiler/zo-marshal.rkt
View File

@ -168,10 +168,10 @@
(define apply-values-type-num 24) (define apply-values-type-num 24)
(define case-lambda-sequence-type-num 25) (define case-lambda-sequence-type-num 25)
(define module-type-num 26) (define module-type-num 26)
(define variable-type-num 34) (define inline-variants-type-num 27)
(define top-type-num 99) (define variable-type-num 35)
(define prefix-type-num 112) (define prefix-type-num 113)
(define free-id-info-type-num 161) (define free-id-info-type-num 162)
(define-syntax define-enum (define-syntax define-enum
(syntax-rules () (syntax-rules ()

13
collects/compiler/zo-parse.rkt
View File

@ -329,6 +329,9 @@
(define (read-module-wrap v) (define (read-module-wrap v)
v) v)
(define (read-inline-variant v)
(make-inline-variant (car v) (cdr v)))
;; ---------------------------------------- ;; ----------------------------------------
;; Unmarshal dispatch for various types ;; Unmarshal dispatch for various types
@ -355,10 +358,11 @@
[(24) 'apply-values-type] [(24) 'apply-values-type]
[(25) 'case-lambda-sequence-type] [(25) 'case-lambda-sequence-type]
[(26) 'module-type] [(26) 'module-type]
[(34) 'variable-type] [(27) 'inline-variant-type]
[(35) 'module-variable-type] [(35) 'variable-type]
[(112) 'resolve-prefix-type] [(36) 'module-variable-type]
[(161) 'free-id-info-type] [(113) 'resolve-prefix-type]
[(162) 'free-id-info-type]
[else (error 'int->type "unknown type: ~e" i)])) [else (error 'int->type "unknown type: ~e" i)]))
(define type-readers (define type-readers
@ -378,6 +382,7 @@
(cons 'case-lambda-sequence-type read-case-lambda) (cons 'case-lambda-sequence-type read-case-lambda)
(cons 'begin0-sequence-type read-begin0) (cons 'begin0-sequence-type read-begin0)
(cons 'module-type read-module) (cons 'module-type read-module)
(cons 'inline-variant-type read-inline-variant)
(cons 'resolve-prefix-type read-resolve-prefix) (cons 'resolve-prefix-type read-resolve-prefix)
(cons 'free-id-info-type read-free-id-info) (cons 'free-id-info-type read-free-id-info)
(cons 'define-values-type read-define-values) (cons 'define-values-type read-define-values)

5
collects/compiler/zo-structs.rkt
View File

@ -94,9 +94,12 @@
[max-let-depth exact-nonnegative-integer?] [max-let-depth exact-nonnegative-integer?]
[dummy (or/c toplevel? #f)])) [dummy (or/c toplevel? #f)]))
(define-form-struct (inline-variant form) ([direct expr?]
[inline expr?]))
;; Definitions (top level or within module): ;; Definitions (top level or within module):
(define-form-struct (def-values form) ([ids (listof (or/c toplevel? symbol?))] (define-form-struct (def-values form) ([ids (listof (or/c toplevel? symbol?))]
[rhs (or/c expr? seq? any/c)])) [rhs (or/c expr? seq? inline-variant? any/c)]))
(define-form-struct (def-syntaxes form) ([ids (listof (or/c toplevel? symbol?))] (define-form-struct (def-syntaxes form) ([ids (listof (or/c toplevel? symbol?))]
[rhs (or/c expr? seq? any/c)] [rhs (or/c expr? seq? any/c)]
[prefix prefix?] [prefix prefix?]

24
collects/scribblings/raco/decompile.scrbl
View File

@ -21,7 +21,7 @@ Many forms in the decompiled code, such as @racket[module],
@itemize[ @itemize[
@item{Top-level variables, variables defined within the module, and @item{Top-level variables, variables defined within the module, and
variables imported from other modules are prefixed with @litchar{_}, variables imported from other modules are prefixed with @litchar{_},
which helps expose the difference between uses of local variables which helps expose the difference between uses of local variables
versus other variables. Variables imported from other modules, versus other variables. Variables imported from other modules,
@ -37,7 +37,7 @@ Many forms in the decompiled code, such as @racket[module],
Uses of core primitives are shown without a leading @litchar{_}, and Uses of core primitives are shown without a leading @litchar{_}, and
they are never wrapped with @racketidfont{#%checked}.} they are never wrapped with @racketidfont{#%checked}.}
@item{Local-variable access may be wrapped with @item{Local-variable access may be wrapped with
@racketidfont{#%sfs-clear}, which indicates that the variable-stack @racketidfont{#%sfs-clear}, which indicates that the variable-stack
location holding the variable will be cleared to prevent the location holding the variable will be cleared to prevent the
variable's value from being retained by the garbage collector. variable's value from being retained by the garbage collector.
@ -61,7 +61,7 @@ Many forms in the decompiled code, such as @racket[module],
how closures capture values in variable-stack locations, as opposed how closures capture values in variable-stack locations, as opposed
to stack locations.} to stack locations.}
@item{In a @racket[lambda] form, if the procedure produced by the @item{In a @racket[lambda] form, if the procedure produced by the
@racket[lambda] has a name (accessible via @racket[object-name]) @racket[lambda] has a name (accessible via @racket[object-name])
and/or source-location information, then it is shown as a quoted and/or source-location information, then it is shown as a quoted
constant at the start of the procedure's body. Afterward, if the constant at the start of the procedure's body. Afterward, if the
@ -79,11 +79,18 @@ Many forms in the decompiled code, such as @racket[module],
it may even contain cyclic references to itself or other constant it may even contain cyclic references to itself or other constant
closures.} closures.}
@item{A form @racket[(#%apply-values _proc _expr)] is equivalent to @item{A form @racket[(#%apply-values _proc _expr)] is equivalent to
@racket[(call-with-values (lambda () _expr) _proc)], but the run-time @racket[(call-with-values (lambda () _expr) _proc)], but the run-time
system avoids allocating a closure for @racket[_expr].} system avoids allocating a closure for @racket[_expr].}
@item{Some applications of core primitives are annotated with @item{A @racket[define-values] form may have @racket[(begin
'%%inline-variant%% _expr1 _expr2)] for its expression, in which case
@racket[_expr2] is the normal result, but @racket[_expr1] may be
inlined for calls to the definition from other modules. Definitions
of functions without an @racket['%%inline-variant%%] are never
inlined across modules.}
@item{Some applications of core primitives are annotated with
@racketidfont{#%in}, which indicates that the JIT compiler will @racketidfont{#%in}, which indicates that the JIT compiler will
inline the operation. (Inlining information is not part of the inline the operation. (Inlining information is not part of the
bytecode, but is instead based on an enumeration of primitives that bytecode, but is instead based on an enumeration of primitives that
@ -91,7 +98,7 @@ Many forms in the decompiled code, such as @racket[module],
@racketmodname[racket/flonum] and @racketmodname[racket/unsafe/ops] @racketmodname[racket/flonum] and @racketmodname[racket/unsafe/ops]
are always inlined, so @racketidfont{#%in} is not shown for them.} are always inlined, so @racketidfont{#%in} is not shown for them.}
@item{Some applications of flonum operations from @racketmodname[racket/flonum] @item{Some applications of flonum operations from @racketmodname[racket/flonum]
and @racketmodname[racket/unsafe/ops] are annotated with and @racketmodname[racket/unsafe/ops] are annotated with
@racketidfont{#%flonum}, indicating a place where the JIT compiler @racketidfont{#%flonum}, indicating a place where the JIT compiler
might avoid allocation for intermediate flonum results. A single might avoid allocation for intermediate flonum results. A single
@ -104,9 +111,8 @@ Many forms in the decompiled code, such as @racket[module],
which indicates a local binding that can avoid boxing (when used as which indicates a local binding that can avoid boxing (when used as
an argument to an operation that can work with unboxed values).} an argument to an operation that can work with unboxed values).}
@item{A @racketidfont{#%decode-syntax} form corresponds to a syntax @item{A @racketidfont{#%decode-syntax} form corresponds to a syntax
object. Future improvements to the decompiler will convert such object.}
syntax objects to a readable form.}
] ]

9
collects/scribblings/raco/zo-struct.scrbl
View File

@ -94,7 +94,7 @@ structures that are produced by @racket[zo-parse] and consumed by
@defstruct+[(def-values form) @defstruct+[(def-values form)
([ids (listof toplevel?)] ([ids (listof toplevel?)]
[rhs (or/c expr? seq? any/c)])]{ [rhs (or/c expr? seq? inline-variant? any/c)])]{
Represents a @racket[define-values] form. Each element of Represents a @racket[define-values] form. Each element of
@racket[ids] will reference via the prefix either a top-level variable @racket[ids] will reference via the prefix either a top-level variable
or a local module variable. or a local module variable.
@ -146,6 +146,13 @@ structures that are produced by @racket[zo-parse] and consumed by
After each form in @racket[forms] is evaluated, the stack is restored After each form in @racket[forms] is evaluated, the stack is restored
to its depth from before evaluating the form.} to its depth from before evaluating the form.}
@defstruct+[(inline-variant form) ([direct expr?]
[inline expr?])]{
Represents a function that is bound by @racket[define-values], where the
function has two variants.
The first variant is used for normal calls to the function. The second may
be used for cross-module inlining of the function.}
@defstruct+[(mod form) @defstruct+[(mod form)
([name symbol?] ([name symbol?]
[srcname symbol?] [srcname symbol?]

4
doc/release-notes/racket/HISTORY.txt
View File

@ -1,3 +1,7 @@
Version 5.2.0.5
Cross-module inlining of trivial functions
compiler/zo-structs: added inline-variant
Version 5.2.0.4 Version 5.2.0.4
Regexps are `equal?' when they have the same source [byte] string Regexps are `equal?' when they have the same source [byte] string
and mode and mode

49
src/racket/src/compenv.c
View File

@ -599,19 +599,12 @@ Scheme_Object *scheme_make_toplevel(mzshort depth, int position, int resolved, i
return (Scheme_Object *)tl; return (Scheme_Object *)tl;
} }
Scheme_Object *scheme_register_toplevel_in_prefix(Scheme_Object *var, Scheme_Comp_Env *env, Scheme_Object *scheme_register_toplevel_in_comp_prefix(Scheme_Object *var, Comp_Prefix *cp,
Scheme_Compile_Info *rec, int drec, int imported, Scheme_Object *inline_variant)
int imported)
{ {
Comp_Prefix *cp = env->prefix;
Scheme_Hash_Table *ht; Scheme_Hash_Table *ht;
Scheme_Object *o; Scheme_Object *o;
if (rec && rec[drec].dont_mark_local_use) {
/* Make up anything; it's going to be ignored. */
return scheme_make_toplevel(0, 0, 0, 0);
}
ht = cp->toplevels; ht = cp->toplevels;
if (!ht) { if (!ht) {
ht = scheme_make_hash_table(SCHEME_hash_ptr); ht = scheme_make_hash_table(SCHEME_hash_ptr);
@ -631,12 +624,36 @@ Scheme_Object *scheme_register_toplevel_in_prefix(Scheme_Object *var, Scheme_Com
: SCHEME_TOPLEVEL_READY)) : SCHEME_TOPLEVEL_READY))
: 0)); : 0));
cp->num_toplevels++;
scheme_hash_set(ht, var, o); scheme_hash_set(ht, var, o);
if (inline_variant) {
ht = cp->inline_variants;
if (!ht) {
ht = scheme_make_hash_table(SCHEME_hash_ptr);
cp->inline_variants = ht;
}
scheme_hash_set(ht, scheme_make_integer(cp->num_toplevels), inline_variant);
}
cp->num_toplevels++;
return o; return o;
} }
Scheme_Object *scheme_register_toplevel_in_prefix(Scheme_Object *var, Scheme_Comp_Env *env,
Scheme_Compile_Info *rec, int drec,
int imported, Scheme_Object *inline_variant)
{
Comp_Prefix *cp = env->prefix;
if (rec && rec[drec].dont_mark_local_use) {
/* Make up anything; it's going to be ignored. */
return scheme_make_toplevel(0, 0, 0, 0);
}
return scheme_register_toplevel_in_comp_prefix(var, cp, imported, inline_variant);
}
void scheme_register_unbound_toplevel(Scheme_Comp_Env *env, Scheme_Object *id) void scheme_register_unbound_toplevel(Scheme_Comp_Env *env, Scheme_Object *id)
{ {
Comp_Prefix *cp = env->prefix; Comp_Prefix *cp = env->prefix;
@ -1659,7 +1676,8 @@ Scheme_Object *
scheme_lookup_binding(Scheme_Object *find_id, Scheme_Comp_Env *env, int flags, scheme_lookup_binding(Scheme_Object *find_id, Scheme_Comp_Env *env, int flags,
Scheme_Object *in_modidx, Scheme_Object *in_modidx,
Scheme_Env **_menv, int *_protected, Scheme_Env **_menv, int *_protected,
Scheme_Object **_lexical_binding_id) Scheme_Object **_lexical_binding_id,
Scheme_Object **_inline_variant)
{ {
Scheme_Comp_Env *frame; Scheme_Comp_Env *frame;
int j = 0, p = 0, modpos, skip_stops = 0, module_self_reference = 0, is_constant; int j = 0, p = 0, modpos, skip_stops = 0, module_self_reference = 0, is_constant;
@ -1963,7 +1981,11 @@ scheme_lookup_binding(Scheme_Object *find_id, Scheme_Comp_Env *env, int flags,
is_constant = 2; is_constant = 2;
else if (SAME_OBJ(mod_constant, scheme_fixed_key)) else if (SAME_OBJ(mod_constant, scheme_fixed_key))
is_constant = 1; is_constant = 1;
else { else if (SAME_TYPE(SCHEME_TYPE(mod_constant), scheme_inline_variant_type)) {
if (_inline_variant)
*_inline_variant = mod_constant;
is_constant = 2;
} else {
if (flags & SCHEME_ELIM_CONST) if (flags & SCHEME_ELIM_CONST)
return mod_constant; return mod_constant;
is_constant = 2; is_constant = 2;
@ -2350,7 +2372,8 @@ Scheme_Object *scheme_namespace_lookup_value(Scheme_Object *sym, Scheme_Env *gen
init_compile_data((Scheme_Comp_Env *)&inlined_e); init_compile_data((Scheme_Comp_Env *)&inlined_e);
inlined_e.base.prefix = NULL; inlined_e.base.prefix = NULL;
v = scheme_lookup_binding(id, (Scheme_Comp_Env *)&inlined_e, SCHEME_RESOLVE_MODIDS, NULL, NULL, NULL, NULL); v = scheme_lookup_binding(id, (Scheme_Comp_Env *)&inlined_e, SCHEME_RESOLVE_MODIDS,
NULL, NULL, NULL, NULL, NULL);
if (v) { if (v) {
if (!SAME_TYPE(SCHEME_TYPE(v), scheme_variable_type)) { if (!SAME_TYPE(SCHEME_TYPE(v), scheme_variable_type)) {
*_use_map = -1; *_use_map = -1;

46
src/racket/src/compile.c
View File

@ -590,9 +590,7 @@ make_closure_compilation(Scheme_Comp_Env *env, Scheme_Object *code,
scheme_merge_lambda_rec(rec, drec, &lam, 0); scheme_merge_lambda_rec(rec, drec, &lam, 0);
cl = MALLOC_ONE_RT(Closure_Info); cl = MALLOC_ONE_RT(Closure_Info);
#ifdef MZTAG_REQUIRED SET_REQUIRED_TAG(cl->type = scheme_rt_closure_info);
cl->type = scheme_rt_closure_info;
#endif
{ {
int *local_flags; int *local_flags;
local_flags = scheme_env_get_flags(frame, 0, data->num_params); local_flags = scheme_env_get_flags(frame, 0, data->num_params);
@ -758,7 +756,7 @@ defn_targets_syntax (Scheme_Object *var, Scheme_Comp_Env *env, Scheme_Compile_In
-1, env->genv->mod_phase, 0); -1, env->genv->mod_phase, 0);
} }
/* Get indirection through the prefix: */ /* Get indirection through the prefix: */
bucket = scheme_register_toplevel_in_prefix(bucket, env, rec, drec, 0); bucket = scheme_register_toplevel_in_prefix(bucket, env, rec, drec, 0, NULL);
pr = cons(bucket, scheme_null); pr = cons(bucket, scheme_null);
if (last) if (last)
@ -1169,7 +1167,7 @@ set_syntax (Scheme_Object *form, Scheme_Comp_Env *env, Scheme_Compile_Info *rec,
? SCHEME_RESOLVE_MODIDS ? SCHEME_RESOLVE_MODIDS
: 0), : 0),
env->in_modidx, env->in_modidx,
&menv, NULL, NULL); &menv, NULL, NULL, NULL);
if (SAME_TYPE(SCHEME_TYPE(var), scheme_macro_type)) { if (SAME_TYPE(SCHEME_TYPE(var), scheme_macro_type)) {
/* Redirect to a macro? */ /* Redirect to a macro? */
@ -1195,7 +1193,7 @@ set_syntax (Scheme_Object *form, Scheme_Comp_Env *env, Scheme_Compile_Info *rec,
if (SAME_TYPE(SCHEME_TYPE(var), scheme_variable_type) if (SAME_TYPE(SCHEME_TYPE(var), scheme_variable_type)
|| SAME_TYPE(SCHEME_TYPE(var), scheme_module_variable_type)) { || SAME_TYPE(SCHEME_TYPE(var), scheme_module_variable_type)) {
var = scheme_register_toplevel_in_prefix(var, env, rec, drec, 0); var = scheme_register_toplevel_in_prefix(var, env, rec, drec, 0, NULL);
if (env->genv->module) if (env->genv->module)
SCHEME_TOPLEVEL_FLAGS(var) |= SCHEME_TOPLEVEL_MUTATED; SCHEME_TOPLEVEL_FLAGS(var) |= SCHEME_TOPLEVEL_MUTATED;
} }
@ -1257,7 +1255,7 @@ set_expand(Scheme_Object *orig_form, Scheme_Comp_Env *env, Scheme_Expand_Info *e
lexical_binding_id = NULL; lexical_binding_id = NULL;
var = scheme_lookup_binding(find_name, env, SCHEME_SETTING, var = scheme_lookup_binding(find_name, env, SCHEME_SETTING,
env->in_modidx, env->in_modidx,
&menv, NULL, &lexical_binding_id); &menv, NULL, &lexical_binding_id, NULL);
SCHEME_EXPAND_OBSERVE_RESOLVE(erec[drec].observer, find_name); SCHEME_EXPAND_OBSERVE_RESOLVE(erec[drec].observer, find_name);
@ -1389,7 +1387,7 @@ ref_syntax (Scheme_Object *form, Scheme_Comp_Env *env, Scheme_Compile_Info *rec,
? SCHEME_RESOLVE_MODIDS ? SCHEME_RESOLVE_MODIDS
: 0), : 0),
env->in_modidx, env->in_modidx,
&menv, NULL, &lex_id); &menv, NULL, &lex_id, NULL);
if (SAME_TYPE(SCHEME_TYPE(var), scheme_variable_type) if (SAME_TYPE(SCHEME_TYPE(var), scheme_variable_type)
|| SAME_TYPE(SCHEME_TYPE(var), scheme_module_variable_type)) { || SAME_TYPE(SCHEME_TYPE(var), scheme_module_variable_type)) {
@ -1397,7 +1395,7 @@ ref_syntax (Scheme_Object *form, Scheme_Comp_Env *env, Scheme_Compile_Info *rec,
imported = scheme_is_imported(var, env); imported = scheme_is_imported(var, env);
if (rec[drec].comp) { if (rec[drec].comp) {
var = scheme_register_toplevel_in_prefix(var, env, rec, drec, imported); var = scheme_register_toplevel_in_prefix(var, env, rec, drec, imported, NULL);
if (!imported && env->genv->module && !rec[drec].testing_constantness) if (!imported && env->genv->module && !rec[drec].testing_constantness)
SCHEME_TOPLEVEL_FLAGS(var) |= SCHEME_TOPLEVEL_MUTATED; SCHEME_TOPLEVEL_FLAGS(var) |= SCHEME_TOPLEVEL_MUTATED;
} }
@ -3436,7 +3434,7 @@ Scheme_Object *scheme_make_environment_dummy(Scheme_Comp_Env *env)
/* Get a prefixed-based accessor for a dummy top-level bucket. It's /* Get a prefixed-based accessor for a dummy top-level bucket. It's
used to "link" to the right environment at run time. The #f as used to "link" to the right environment at run time. The #f as
a toplevel is handled in the prefix linker specially. */ a toplevel is handled in the prefix linker specially. */
return scheme_register_toplevel_in_prefix(scheme_false, env, NULL, 0, 0); return scheme_register_toplevel_in_prefix(scheme_false, env, NULL, 0, 0, NULL);
} }
Scheme_Env *scheme_environment_from_dummy(Scheme_Object *dummy) Scheme_Env *scheme_environment_from_dummy(Scheme_Object *dummy)
@ -3560,17 +3558,17 @@ void scheme_bind_syntaxes(const char *where, Scheme_Object *names, Scheme_Object
a = scheme_compile_expr_lift_to_let(a, eenv, &mrec, 0); a = scheme_compile_expr_lift_to_let(a, eenv, &mrec, 0);
oi = scheme_optimize_info_create(eenv->prefix);
if (!(rec[drec].comp_flags & COMP_CAN_INLINE))
scheme_optimize_info_never_inline(oi);
a = scheme_optimize_expr(a, oi, 0);
/* For internal defn, don't simplify as resolving, because the /* For internal defn, don't simplify as resolving, because the
expression may have syntax objects with a lexical rename that expression may have syntax objects with a lexical rename that
is still being extended. is still being extended.
For letrec-syntaxes+values, don't simplify because it's too expensive. */ For letrec-syntaxes+values, don't simplify because it's too expensive. */
rp = scheme_resolve_prefix(eenv->genv->phase, eenv->prefix, 0); rp = scheme_resolve_prefix(eenv->genv->phase, eenv->prefix, 0);
oi = scheme_optimize_info_create();
if (!(rec[drec].comp_flags & COMP_CAN_INLINE))
scheme_optimize_info_never_inline(oi);
a = scheme_optimize_expr(a, oi, 0);
ri = scheme_resolve_info_create(rp); ri = scheme_resolve_info_create(rp);
a = scheme_resolve_expr(a, ri); a = scheme_resolve_expr(a, ri);
@ -4280,7 +4278,7 @@ Scheme_Object *scheme_check_immediate_macro(Scheme_Object *first,
? SCHEME_RESOLVE_MODIDS ? SCHEME_RESOLVE_MODIDS
: 0), : 0),
env->in_modidx, env->in_modidx,
&menv, NULL, NULL); &menv, NULL, NULL, NULL);
if (SCHEME_STX_PAIRP(first)) if (SCHEME_STX_PAIRP(first))
*current_val = val; *current_val = val;
@ -4458,11 +4456,12 @@ scheme_compile_expand_expr(Scheme_Object *form, Scheme_Comp_Env *env,
normal = app_expander; normal = app_expander;
} else if (!SCHEME_STX_PAIRP(form)) { } else if (!SCHEME_STX_PAIRP(form)) {
if (SCHEME_STX_SYMBOLP(form)) { if (SCHEME_STX_SYMBOLP(form)) {
Scheme_Object *find_name = form, *lexical_binding_id; Scheme_Object *find_name = form, *lexical_binding_id, *inline_variant;
int protected = 0; int protected = 0;
while (1) { while (1) {
lexical_binding_id = NULL; lexical_binding_id = NULL;
inline_variant = NULL;
var = scheme_lookup_binding(find_name, env, var = scheme_lookup_binding(find_name, env,
SCHEME_NULL_FOR_UNBOUND SCHEME_NULL_FOR_UNBOUND
+ SCHEME_ENV_CONSTANTS_OK + SCHEME_ENV_CONSTANTS_OK
@ -4482,7 +4481,7 @@ scheme_compile_expand_expr(Scheme_Object *form, Scheme_Comp_Env *env,
? (SCHEME_OUT_OF_CONTEXT_OK | SCHEME_OUT_OF_CONTEXT_LOCAL) ? (SCHEME_OUT_OF_CONTEXT_OK | SCHEME_OUT_OF_CONTEXT_LOCAL)
: 0), : 0),
env->in_modidx, env->in_modidx,
&menv, &protected, &lexical_binding_id); &menv, &protected, &lexical_binding_id, &inline_variant);
SCHEME_EXPAND_OBSERVE_RESOLVE(rec[drec].observer,find_name); SCHEME_EXPAND_OBSERVE_RESOLVE(rec[drec].observer,find_name);
@ -4545,7 +4544,8 @@ scheme_compile_expand_expr(Scheme_Object *form, Scheme_Comp_Env *env,
} else if (SAME_TYPE(SCHEME_TYPE(var), scheme_variable_type) } else if (SAME_TYPE(SCHEME_TYPE(var), scheme_variable_type)
|| SAME_TYPE(SCHEME_TYPE(var), scheme_module_variable_type)) || SAME_TYPE(SCHEME_TYPE(var), scheme_module_variable_type))
return scheme_register_toplevel_in_prefix(var, env, rec, drec, return scheme_register_toplevel_in_prefix(var, env, rec, drec,
scheme_is_imported(var, env)); scheme_is_imported(var, env),
inline_variant);
else else
return var; return var;
} else { } else {
@ -4599,7 +4599,7 @@ scheme_compile_expand_expr(Scheme_Object *form, Scheme_Comp_Env *env,
? (SCHEME_OUT_OF_CONTEXT_OK | SCHEME_OUT_OF_CONTEXT_LOCAL) ? (SCHEME_OUT_OF_CONTEXT_OK | SCHEME_OUT_OF_CONTEXT_LOCAL)
: 0), : 0),
env->in_modidx, env->in_modidx,
&menv, NULL, NULL); &menv, NULL, NULL, NULL);
SCHEME_EXPAND_OBSERVE_RESOLVE(rec[drec].observer, find_name); SCHEME_EXPAND_OBSERVE_RESOLVE(rec[drec].observer, find_name);
if (var && SAME_TYPE(SCHEME_TYPE(var), scheme_macro_type) if (var && SAME_TYPE(SCHEME_TYPE(var), scheme_macro_type)
@ -4690,7 +4690,7 @@ scheme_compile_expand_expr(Scheme_Object *form, Scheme_Comp_Env *env,
? (SCHEME_OUT_OF_CONTEXT_OK | SCHEME_OUT_OF_CONTEXT_LOCAL) ? (SCHEME_OUT_OF_CONTEXT_OK | SCHEME_OUT_OF_CONTEXT_LOCAL)
: 0), : 0),
env->in_modidx, env->in_modidx,
&menv, NULL, NULL); &menv, NULL, NULL, NULL);
SCHEME_EXPAND_OBSERVE_RESOLVE(rec[drec].observer, find_name); SCHEME_EXPAND_OBSERVE_RESOLVE(rec[drec].observer, find_name);
@ -4732,7 +4732,7 @@ scheme_compile_expand_expr(Scheme_Object *form, Scheme_Comp_Env *env,
? (SCHEME_OUT_OF_CONTEXT_OK | SCHEME_OUT_OF_CONTEXT_LOCAL) ? (SCHEME_OUT_OF_CONTEXT_OK | SCHEME_OUT_OF_CONTEXT_LOCAL)
: 0), : 0),
env->in_modidx, env->in_modidx,
&menv, NULL, NULL); &menv, NULL, NULL, NULL);
} }
} }
@ -5252,7 +5252,7 @@ top_syntax(Scheme_Object *form, Scheme_Comp_Env *env, Scheme_Compile_Info *rec,
c = (Scheme_Object *)scheme_global_bucket(c, env->genv); c = (Scheme_Object *)scheme_global_bucket(c, env->genv);
} }
return scheme_register_toplevel_in_prefix(c, env, rec, drec, 0); return scheme_register_toplevel_in_prefix(c, env, rec, drec, 0, NULL);
} }
static Scheme_Object * static Scheme_Object *

64
src/racket/src/cstartup.inc
View File

@ -1,5 +1,5 @@
{ {
SHARED_OK static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,7,53,46,50,46,48,46,52,0,0,0,0,0,0,0,0,0,0,0, SHARED_OK static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,7,53,46,50,46,48,46,53,0,0,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,51,0,0,0,1,0,0,10,0,13,0,18, 0,0,0,0,0,0,0,0,0,51,0,0,0,1,0,0,10,0,13,0,18,
0,25,0,30,0,33,0,46,0,53,0,58,0,62,0,66,0,73,0,82,0, 0,25,0,30,0,33,0,46,0,53,0,58,0,62,0,66,0,73,0,82,0,
85,0,91,0,105,0,119,0,122,0,128,0,132,0,134,0,145,0,147,0,161, 85,0,91,0,105,0,119,0,122,0,128,0,132,0,134,0,145,0,147,0,161,
@ -30,14 +30,14 @@
74,193,249,22,148,4,80,158,39,36,251,22,83,2,18,248,22,74,199,249,22, 74,193,249,22,148,4,80,158,39,36,251,22,83,2,18,248,22,74,199,249,22,
73,2,11,248,22,75,201,11,18,100,10,13,16,5,36,2,14,2,2,11,11, 73,2,11,248,22,75,201,11,18,100,10,13,16,5,36,2,14,2,2,11,11,
8,32,8,31,8,30,8,29,16,4,11,11,2,20,3,1,8,101,110,118,49, 8,32,8,31,8,30,8,29,16,4,11,11,2,20,3,1,8,101,110,118,49,
52,57,55,48,16,4,11,11,2,21,3,1,8,101,110,118,49,52,57,55,49, 52,57,54,54,16,4,11,11,2,21,3,1,8,101,110,118,49,52,57,54,55,
27,248,22,75,248,22,155,4,196,28,248,22,81,193,20,14,159,37,36,37,28, 27,248,22,75,248,22,155,4,196,28,248,22,81,193,20,14,159,37,36,37,28,
248,22,81,248,22,75,194,248,22,74,193,249,22,148,4,80,158,39,36,250,22, 248,22,81,248,22,75,194,248,22,74,193,249,22,148,4,80,158,39,36,250,22,
83,2,22,248,22,83,249,22,83,248,22,83,2,23,248,22,74,201,251,22,83, 83,2,22,248,22,83,249,22,83,248,22,83,2,23,248,22,74,201,251,22,83,
2,18,2,23,2,23,249,22,73,2,6,248,22,75,204,18,100,11,13,16,5, 2,18,2,23,2,23,249,22,73,2,6,248,22,75,204,18,100,11,13,16,5,
36,2,14,2,2,11,11,8,32,8,31,8,30,8,29,16,4,11,11,2,20, 36,2,14,2,2,11,11,8,32,8,31,8,30,8,29,16,4,11,11,2,20,
3,1,8,101,110,118,49,52,57,55,51,16,4,11,11,2,21,3,1,8,101, 3,1,8,101,110,118,49,52,57,54,57,16,4,11,11,2,21,3,1,8,101,
110,118,49,52,57,55,52,248,22,155,4,193,27,248,22,155,4,194,249,22,73, 110,118,49,52,57,55,48,248,22,155,4,193,27,248,22,155,4,194,249,22,73,
248,22,83,248,22,74,196,248,22,75,195,27,248,22,75,248,22,155,4,23,197, 248,22,83,248,22,74,196,248,22,75,195,27,248,22,75,248,22,155,4,23,197,
1,249,22,148,4,80,158,39,36,28,248,22,58,248,22,149,4,248,22,74,23, 1,249,22,148,4,80,158,39,36,28,248,22,58,248,22,149,4,248,22,74,23,
198,2,27,249,22,2,32,0,88,163,8,36,37,43,11,9,222,33,40,248,22, 198,2,27,249,22,2,32,0,88,163,8,36,37,43,11,9,222,33,40,248,22,
@ -67,39 +67,39 @@
139,9,248,22,149,4,248,22,74,200,64,101,108,115,101,10,248,22,74,197,250, 139,9,248,22,149,4,248,22,74,200,64,101,108,115,101,10,248,22,74,197,250,
22,84,2,22,9,248,22,75,200,249,22,73,2,5,248,22,75,202,99,13,16, 22,84,2,22,9,248,22,75,200,249,22,73,2,5,248,22,75,202,99,13,16,
5,36,2,14,2,2,11,11,8,32,8,31,8,30,8,29,16,4,11,11,2, 5,36,2,14,2,2,11,11,8,32,8,31,8,30,8,29,16,4,11,11,2,
20,3,1,8,101,110,118,49,52,57,57,54,16,4,11,11,2,21,3,1,8, 20,3,1,8,101,110,118,49,52,57,57,50,16,4,11,11,2,21,3,1,8,
101,110,118,49,52,57,57,55,18,158,94,10,64,118,111,105,100,8,48,27,248, 101,110,118,49,52,57,57,51,18,158,94,10,64,118,111,105,100,8,48,27,248,
22,75,248,22,155,4,196,249,22,148,4,80,158,39,36,28,248,22,58,248,22, 22,75,248,22,155,4,196,249,22,148,4,80,158,39,36,28,248,22,58,248,22,
149,4,248,22,74,197,250,22,83,2,28,248,22,83,248,22,74,199,248,22,98, 149,4,248,22,74,197,250,22,83,2,28,248,22,83,248,22,74,199,248,22,98,
198,27,248,22,149,4,248,22,74,197,250,22,83,2,28,248,22,83,248,22,74, 198,27,248,22,149,4,248,22,74,197,250,22,83,2,28,248,22,83,248,22,74,
197,250,22,84,2,25,248,22,75,199,248,22,75,202,159,36,20,112,159,36,16, 197,250,22,84,2,25,248,22,75,199,248,22,75,202,159,36,20,113,159,36,16,
1,11,16,0,20,26,146,2,1,2,1,2,2,11,11,11,10,36,80,158,36, 1,11,16,0,20,26,146,2,1,2,1,2,2,11,11,11,10,36,80,158,36,
36,20,112,159,36,16,0,16,0,38,39,36,16,0,36,16,0,36,11,11,11, 36,20,113,159,36,16,0,16,0,38,39,36,16,0,36,16,0,36,11,11,11,
16,10,2,3,2,4,2,5,2,6,2,7,2,8,2,9,2,10,2,11,2, 16,10,2,3,2,4,2,5,2,6,2,7,2,8,2,9,2,10,2,11,2,
12,16,10,11,11,11,11,11,11,11,11,11,11,16,10,2,3,2,4,2,5, 12,16,10,11,11,11,11,11,11,11,11,11,11,16,10,2,3,2,4,2,5,
2,6,2,7,2,8,2,9,2,10,2,11,2,12,36,46,37,16,0,36,16, 2,6,2,7,2,8,2,9,2,10,2,11,2,12,36,46,37,16,0,36,16,
1,2,13,37,11,11,11,16,0,16,0,16,0,36,36,11,12,11,11,16,0, 1,2,13,37,11,11,11,16,0,16,0,16,0,36,36,11,12,11,11,16,0,
16,0,16,0,36,36,16,11,16,5,11,20,15,16,2,20,14,159,36,36,37, 16,0,16,0,36,36,16,11,16,5,11,20,15,16,2,20,14,159,36,36,37,
80,158,36,36,36,20,112,159,36,16,1,2,13,16,1,33,33,10,16,5,2, 80,158,36,36,36,20,113,159,36,16,1,2,13,16,1,33,33,10,16,5,2,
12,88,163,8,36,37,53,37,9,223,0,33,34,36,20,112,159,36,16,1,2, 12,88,163,8,36,37,53,37,9,223,0,33,34,36,20,113,159,36,16,1,2,
13,16,0,11,16,5,2,3,88,163,8,36,37,53,37,9,223,0,33,35,36, 13,16,0,11,16,5,2,3,88,163,8,36,37,53,37,9,223,0,33,35,36,
20,112,159,36,16,1,2,13,16,0,11,16,5,2,11,88,163,8,36,37,53, 20,113,159,36,16,1,2,13,16,0,11,16,5,2,11,88,163,8,36,37,53,
37,9,223,0,33,36,36,20,112,159,36,16,1,2,13,16,1,33,37,11,16, 37,9,223,0,33,36,36,20,113,159,36,16,1,2,13,16,1,33,37,11,16,
5,2,6,88,163,8,36,37,56,37,9,223,0,33,38,36,20,112,159,36,16, 5,2,6,88,163,8,36,37,56,37,9,223,0,33,38,36,20,113,159,36,16,
1,2,13,16,1,33,39,11,16,5,2,10,88,163,8,36,37,58,37,9,223, 1,2,13,16,1,33,39,11,16,5,2,10,88,163,8,36,37,58,37,9,223,
0,33,42,36,20,112,159,36,16,1,2,13,16,0,11,16,5,2,8,88,163, 0,33,42,36,20,113,159,36,16,1,2,13,16,0,11,16,5,2,8,88,163,
8,36,37,53,37,9,223,0,33,44,36,20,112,159,36,16,1,2,13,16,0, 8,36,37,53,37,9,223,0,33,44,36,20,113,159,36,16,1,2,13,16,0,
11,16,5,2,9,88,163,8,36,37,54,37,9,223,0,33,45,36,20,112,159, 11,16,5,2,9,88,163,8,36,37,54,37,9,223,0,33,45,36,20,113,159,
36,16,1,2,13,16,0,11,16,5,2,7,88,163,8,36,37,56,37,9,223, 36,16,1,2,13,16,0,11,16,5,2,7,88,163,8,36,37,56,37,9,223,
0,33,46,36,20,112,159,36,16,1,2,13,16,0,11,16,5,2,5,88,163, 0,33,46,36,20,113,159,36,16,1,2,13,16,0,11,16,5,2,5,88,163,
8,36,37,58,37,9,223,0,33,47,36,20,112,159,36,16,1,2,13,16,1, 8,36,37,58,37,9,223,0,33,47,36,20,113,159,36,16,1,2,13,16,1,
33,49,11,16,5,2,4,88,163,8,36,37,54,37,9,223,0,33,50,36,20, 33,49,11,16,5,2,4,88,163,8,36,37,54,37,9,223,0,33,50,36,20,
112,159,36,16,1,2,13,16,0,11,16,0,94,2,16,2,17,93,2,16,9, 113,159,36,16,1,2,13,16,0,11,16,0,94,2,16,2,17,93,2,16,9,
9,36,0}; 9,36,0};
EVAL_ONE_SIZED_STR((char *)expr, 2018); EVAL_ONE_SIZED_STR((char *)expr, 2018);
} }
{ {
SHARED_OK static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,7,53,46,50,46,48,46,52,0,0,0,0,0,0,0,0,0,0,0, SHARED_OK static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,7,53,46,50,46,48,46,53,0,0,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,107,0,0,0,1,0,0,8,0,21,0,26, 0,0,0,0,0,0,0,0,0,107,0,0,0,1,0,0,8,0,21,0,26,
0,43,0,65,0,94,0,109,0,127,0,143,0,157,0,179,0,195,0,212,0, 0,43,0,65,0,94,0,109,0,127,0,143,0,157,0,179,0,195,0,212,0,
234,0,245,0,251,0,4,1,11,1,18,1,30,1,46,1,70,1,102,1,120, 234,0,245,0,251,0,4,1,11,1,18,1,30,1,46,1,70,1,102,1,120,
@ -367,7 +367,7 @@
2,3,33,85,23,195,1,23,197,1,249,22,157,2,195,88,163,8,36,38,48, 2,3,33,85,23,195,1,23,197,1,249,22,157,2,195,88,163,8,36,38,48,
11,9,223,3,33,86,28,197,86,94,20,18,159,11,80,158,42,47,193,20,18, 11,9,223,3,33,86,28,197,86,94,20,18,159,11,80,158,42,47,193,20,18,
159,11,80,158,42,48,196,86,94,20,18,159,11,80,158,42,53,193,20,18,159, 159,11,80,158,42,48,196,86,94,20,18,159,11,80,158,42,53,193,20,18,159,
11,80,158,42,54,196,193,28,193,80,158,38,47,80,158,38,53,248,22,8,88, 11,80,158,42,54,196,193,28,193,80,158,38,47,80,158,38,53,248,22,9,88,
163,8,32,37,8,40,8,240,0,188,23,0,9,224,1,2,33,87,0,7,35, 163,8,32,37,8,40,8,240,0,188,23,0,9,224,1,2,33,87,0,7,35,
114,120,34,47,43,34,28,248,22,129,7,23,195,2,27,249,22,145,15,2,89, 114,120,34,47,43,34,28,248,22,129,7,23,195,2,27,249,22,145,15,2,89,
196,28,192,28,249,22,184,3,248,22,97,195,248,22,174,3,248,22,132,7,198, 196,28,192,28,249,22,184,3,248,22,97,195,248,22,174,3,248,22,132,7,198,
@ -539,8 +539,8 @@
22,131,4,23,202,1,27,28,23,194,2,23,194,1,86,94,23,194,1,36,249, 22,131,4,23,202,1,27,28,23,194,2,23,194,1,86,94,23,194,1,36,249,
22,187,5,23,199,1,20,20,95,88,163,8,36,36,48,11,9,224,4,2,33, 22,187,5,23,199,1,20,20,95,88,163,8,36,36,48,11,9,224,4,2,33,
105,23,195,1,23,197,1,27,248,22,172,5,23,195,1,248,80,159,39,8,31, 105,23,195,1,23,197,1,27,248,22,172,5,23,195,1,248,80,159,39,8,31,
39,193,159,36,20,112,159,36,16,1,11,16,0,20,26,141,2,1,2,1,29, 39,193,159,36,20,113,159,36,16,1,11,16,0,20,26,141,2,1,2,1,29,
11,11,11,11,11,10,43,80,158,36,36,20,112,159,40,16,28,2,2,2,3, 11,11,11,11,11,10,43,80,158,36,36,20,113,159,40,16,28,2,2,2,3,
2,4,2,5,2,6,2,7,2,8,2,9,2,10,2,11,2,12,2,13,2, 2,4,2,5,2,6,2,7,2,8,2,9,2,10,2,11,2,12,2,13,2,
14,2,15,30,2,18,76,102,105,110,100,45,108,105,110,107,115,45,112,97,116, 14,2,15,30,2,18,76,102,105,110,100,45,108,105,110,107,115,45,112,97,116,
104,33,4,30,2,19,1,20,112,97,114,97,109,101,116,101,114,105,122,97,116, 104,33,4,30,2,19,1,20,112,97,114,97,109,101,116,101,114,105,122,97,116,
@ -596,7 +596,7 @@
EVAL_ONE_SIZED_STR((char *)expr, 10364); EVAL_ONE_SIZED_STR((char *)expr, 10364);
} }
{ {
SHARED_OK static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,7,53,46,50,46,48,46,52,0,0,0,0,0,0,0,0,0,0,0, SHARED_OK static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,7,53,46,50,46,48,46,53,0,0,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,12,0,0,0,1,0,0,15,0,40,0,57, 0,0,0,0,0,0,0,0,0,12,0,0,0,1,0,0,15,0,40,0,57,
0,75,0,97,0,120,0,140,0,162,0,169,0,176,0,183,0,0,0,175,1, 0,75,0,97,0,120,0,140,0,162,0,169,0,176,0,183,0,0,0,175,1,
0,0,74,35,37,112,108,97,99,101,45,115,116,114,117,99,116,1,23,115,116, 0,0,74,35,37,112,108,97,99,101,45,115,116,114,117,99,116,1,23,115,116,
@ -607,9 +607,9 @@
108,97,99,101,45,99,104,97,110,110,101,108,45,115,101,116,33,79,84,72,45, 108,97,99,101,45,99,104,97,110,110,101,108,45,115,101,116,33,79,84,72,45,
112,108,97,99,101,45,99,104,97,110,110,101,108,45,105,110,1,20,84,72,45, 112,108,97,99,101,45,99,104,97,110,110,101,108,45,105,110,1,20,84,72,45,
112,108,97,99,101,45,99,104,97,110,110,101,108,45,111,117,116,249,80,158,38, 112,108,97,99,101,45,99,104,97,110,110,101,108,45,111,117,116,249,80,158,38,
39,195,36,249,80,158,38,39,195,36,249,80,158,38,39,195,37,159,36,20,112, 39,195,36,249,80,158,38,39,195,36,249,80,158,38,39,195,37,159,36,20,113,
159,36,16,1,11,16,0,20,26,141,2,1,2,1,29,11,11,11,11,11,10, 159,36,16,1,11,16,0,20,26,141,2,1,2,1,29,11,11,11,11,11,10,
45,80,158,36,36,20,112,159,36,16,7,2,2,2,3,2,4,2,5,2,6, 45,80,158,36,36,20,113,159,36,16,7,2,2,2,3,2,4,2,5,2,6,
2,7,2,8,16,0,37,39,36,16,0,36,16,2,2,5,2,6,38,11,11, 2,7,2,8,16,0,37,39,36,16,0,36,16,2,2,5,2,6,38,11,11,
11,16,5,2,3,2,7,2,8,2,4,2,2,16,5,11,11,11,11,11,16, 11,16,5,2,3,2,7,2,8,2,4,2,2,16,5,11,11,11,11,11,16,
5,2,3,2,7,2,8,2,4,2,2,41,41,37,12,11,11,16,0,16,0, 5,2,3,2,7,2,8,2,4,2,2,41,41,37,12,11,11,16,0,16,0,
@ -623,7 +623,7 @@
EVAL_ONE_SIZED_STR((char *)expr, 496); EVAL_ONE_SIZED_STR((char *)expr, 496);
} }
{ {
SHARED_OK static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,7,53,46,50,46,48,46,52,0,0,0,0,0,0,0,0,0,0,0, SHARED_OK static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,7,53,46,50,46,48,46,53,0,0,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,69,0,0,0,1,0,0,7,0,18,0,45, 0,0,0,0,0,0,0,0,0,69,0,0,0,1,0,0,7,0,18,0,45,
0,51,0,64,0,73,0,80,0,102,0,124,0,150,0,158,0,170,0,185,0, 0,51,0,64,0,73,0,80,0,102,0,124,0,150,0,158,0,170,0,185,0,
201,0,219,0,239,0,251,0,11,1,34,1,46,1,77,1,84,1,89,1,94, 201,0,219,0,239,0,251,0,11,1,34,1,46,1,77,1,84,1,89,1,94,
@ -875,8 +875,8 @@
8,25,37,249,22,27,11,80,159,39,55,37,248,22,179,4,80,159,37,54,38, 8,25,37,249,22,27,11,80,159,39,55,37,248,22,179,4,80,159,37,54,38,
248,22,160,5,80,159,37,37,39,248,22,188,13,80,159,37,42,39,20,18,159, 248,22,160,5,80,159,37,37,39,248,22,188,13,80,159,37,42,39,20,18,159,
11,80,158,36,53,248,80,159,37,8,25,37,249,22,27,11,80,159,39,55,37, 11,80,158,36,53,248,80,159,37,8,25,37,249,22,27,11,80,159,39,55,37,
159,36,20,112,159,36,16,1,11,16,0,20,26,141,2,1,2,1,29,11,11, 159,36,20,113,159,36,16,1,11,16,0,20,26,141,2,1,2,1,29,11,11,
11,11,11,10,38,80,158,36,36,20,112,159,40,16,26,2,2,2,3,30,2, 11,11,11,10,38,80,158,36,36,20,113,159,40,16,26,2,2,2,3,30,2,
5,72,112,97,116,104,45,115,116,114,105,110,103,63,11,30,2,5,75,112,97, 5,72,112,97,116,104,45,115,116,114,105,110,103,63,11,30,2,5,75,112,97,
116,104,45,97,100,100,45,115,117,102,102,105,120,8,30,2,7,2,8,6,30, 116,104,45,97,100,100,45,115,117,102,102,105,120,8,30,2,7,2,8,6,30,
2,7,1,23,101,120,116,101,110,100,45,112,97,114,97,109,101,116,101,114,105, 2,7,1,23,101,120,116,101,110,100,45,112,97,114,97,109,101,116,101,114,105,
@ -919,7 +919,7 @@
EVAL_ONE_SIZED_STR((char *)expr, 6149); EVAL_ONE_SIZED_STR((char *)expr, 6149);
} }
{ {
SHARED_OK static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,7,53,46,50,46,48,46,52,0,0,0,0,0,0,0,0,0,0,0, SHARED_OK static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,7,53,46,50,46,48,46,53,0,0,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,11,0,0,0,1,0,0,10,0,16,0,29, 0,0,0,0,0,0,0,0,0,11,0,0,0,1,0,0,10,0,16,0,29,
0,44,0,58,0,78,0,90,0,104,0,118,0,170,0,0,0,94,1,0,0, 0,44,0,58,0,78,0,90,0,104,0,118,0,170,0,0,0,94,1,0,0,
69,35,37,98,117,105,108,116,105,110,65,113,117,111,116,101,29,94,2,2,67, 69,35,37,98,117,105,108,116,105,110,65,113,117,111,116,101,29,94,2,2,67,
@ -930,8 +930,8 @@
94,2,2,68,35,37,107,101,114,110,101,108,11,97,36,11,8,240,13,78,0, 94,2,2,68,35,37,107,101,114,110,101,108,11,97,36,11,8,240,13,78,0,
0,100,159,2,3,36,36,159,2,4,36,36,159,2,5,36,36,159,2,6,36, 0,100,159,2,3,36,36,159,2,4,36,36,159,2,5,36,36,159,2,6,36,
36,159,2,7,36,36,159,2,8,36,36,159,2,9,36,36,159,2,9,36,36, 36,159,2,7,36,36,159,2,8,36,36,159,2,9,36,36,159,2,9,36,36,
16,0,159,36,20,112,159,36,16,1,11,16,0,20,26,141,2,1,2,1,29, 16,0,159,36,20,113,159,36,16,1,11,16,0,20,26,141,2,1,2,1,29,
11,11,11,11,11,18,96,11,46,46,46,36,80,158,36,36,20,112,159,36,16, 11,11,11,11,11,18,96,11,46,46,46,36,80,158,36,36,20,113,159,36,16,
0,16,0,37,39,36,16,0,36,16,0,36,11,11,11,16,0,16,0,16,0, 0,16,0,37,39,36,16,0,36,16,0,36,11,11,11,16,0,16,0,16,0,
36,36,37,12,11,11,16,0,16,0,16,0,36,36,11,12,11,11,16,0,16, 36,36,37,12,11,11,16,0,16,0,16,0,36,36,11,12,11,11,16,0,16,
0,16,0,36,36,16,0,104,2,9,2,8,29,94,2,2,69,35,37,102,111, 0,16,0,36,36,16,0,104,2,9,2,8,29,94,2,2,69,35,37,102,111,

4
src/racket/src/env.c
View File

@ -1913,7 +1913,7 @@ do_local_exp_time_value(const char *name, int argc, Scheme_Object *argv[], int r
+ SCHEME_APP_POS + SCHEME_ENV_CONSTANTS_OK + SCHEME_APP_POS + SCHEME_ENV_CONSTANTS_OK
+ SCHEME_OUT_OF_CONTEXT_OK + SCHEME_ELIM_CONST), + SCHEME_OUT_OF_CONTEXT_OK + SCHEME_ELIM_CONST),
scheme_current_thread->current_local_modidx, scheme_current_thread->current_local_modidx,
&menv, NULL, NULL); &menv, NULL, NULL, NULL);
SCHEME_EXPAND_OBSERVE_RESOLVE(observer, sym); SCHEME_EXPAND_OBSERVE_RESOLVE(observer, sym);
@ -2327,7 +2327,7 @@ local_make_delta_introduce(int argc, Scheme_Object *argv[])
+ SCHEME_APP_POS + SCHEME_ENV_CONSTANTS_OK + SCHEME_APP_POS + SCHEME_ENV_CONSTANTS_OK
+ SCHEME_OUT_OF_CONTEXT_OK + SCHEME_ELIM_CONST), + SCHEME_OUT_OF_CONTEXT_OK + SCHEME_ELIM_CONST),
scheme_current_thread->current_local_modidx, scheme_current_thread->current_local_modidx,
NULL, NULL, &binder); NULL, NULL, &binder, NULL);
/* Deref globals */ /* Deref globals */
if (v && SAME_TYPE(SCHEME_TYPE(v), scheme_variable_type)) if (v && SAME_TYPE(SCHEME_TYPE(v), scheme_variable_type))

7
src/racket/src/eval.c
View File

@ -3555,6 +3555,11 @@ scheme_do_eval(Scheme_Object *obj, int num_rands, Scheme_Object **rands,
v = define_values_execute(obj); v = define_values_execute(obj);
break; break;
} }
case scheme_inline_variant_type:
{
obj = SCHEME_VEC_ELS(obj)[0];
goto eval_top;
}
case scheme_define_syntaxes_type: case scheme_define_syntaxes_type:
{ {
UPDATE_THREAD_RSPTR(); UPDATE_THREAD_RSPTR();
@ -3894,7 +3899,7 @@ static void *compile_k(void)
break; break;
} }
oi = scheme_optimize_info_create(); oi = scheme_optimize_info_create(cenv->prefix);
scheme_optimize_info_enforce_const(oi, enforce_consts); scheme_optimize_info_enforce_const(oi, enforce_consts);
if (!(comp_flags & COMP_CAN_INLINE)) if (!(comp_flags & COMP_CAN_INLINE))
scheme_optimize_info_never_inline(oi); scheme_optimize_info_never_inline(oi);

1
src/racket/src/jit.c
View File

@ -2402,6 +2402,7 @@ int scheme_generate(Scheme_Object *obj, mz_jit_state *jitter, int is_tail, int w
case scheme_begin_for_syntax_type: case scheme_begin_for_syntax_type:
case scheme_require_form_type: case scheme_require_form_type:
case scheme_module_type: case scheme_module_type:
case scheme_inline_variant_type:
{ {
scheme_signal_error("internal error: cannot JIT a top-level form"); scheme_signal_error("internal error: cannot JIT a top-level form");
return 0; return 0;

32
src/racket/src/jitprep.c
View File

@ -288,6 +288,16 @@ static Scheme_Object *jit_wcm(Scheme_Object *o)
/* other syntax */ /* other syntax */
/*========================================================================*/ /*========================================================================*/
static Scheme_Object *clone_inline_variant(Scheme_Object *obj, Scheme_Object *naya)
{
Scheme_Object *naya2;
naya2 = scheme_make_vector(3, scheme_false);
naya2->type = scheme_inline_variant_type;
SCHEME_VEC_ELS(naya2)[0] = naya;
SCHEME_VEC_ELS(naya2)[1] = SCHEME_VEC_ELS(obj)[1];
return naya2;
}
static Scheme_Object *define_values_jit(Scheme_Object *data) static Scheme_Object *define_values_jit(Scheme_Object *data)
{ {
Scheme_Object *orig = SCHEME_VEC_ELS(data)[0], *naya; Scheme_Object *orig = SCHEME_VEC_ELS(data)[0], *naya;
@ -295,7 +305,13 @@ static Scheme_Object *define_values_jit(Scheme_Object *data)
if (SAME_TYPE(SCHEME_TYPE(orig), scheme_unclosed_procedure_type) if (SAME_TYPE(SCHEME_TYPE(orig), scheme_unclosed_procedure_type)
&& (SCHEME_VEC_SIZE(data) == 2)) && (SCHEME_VEC_SIZE(data) == 2))
naya = scheme_jit_closure(orig, SCHEME_VEC_ELS(data)[1]); naya = scheme_jit_closure(orig, SCHEME_VEC_ELS(data)[1]);
else else if (SAME_TYPE(SCHEME_TYPE(orig), scheme_inline_variant_type)
&& SAME_TYPE(SCHEME_TYPE(SCHEME_VEC_ELS(orig)[0]), scheme_unclosed_procedure_type)
&& (SCHEME_VEC_SIZE(data) == 2)) {
naya = scheme_jit_closure(SCHEME_VEC_ELS(orig)[0], SCHEME_VEC_ELS(data)[1]);
if (!SAME_OBJ(naya, SCHEME_VEC_ELS(orig)[0]))
naya = clone_inline_variant(orig, naya);
} else
naya = scheme_jit_expr(orig); naya = scheme_jit_expr(orig);
if (SAME_OBJ(naya, orig)) if (SAME_OBJ(naya, orig))
@ -308,6 +324,18 @@ static Scheme_Object *define_values_jit(Scheme_Object *data)
} }
} }
static Scheme_Object *inline_variant_jit(Scheme_Object *data)
{
Scheme_Object *a, *orig;
orig = SCHEME_VEC_ELS(data)[0];
a = scheme_jit_expr(orig);
if (!SAME_OBJ(a, orig))
return clone_inline_variant(data, a);
else
return data;
}
static Scheme_Object *set_jit(Scheme_Object *data) static Scheme_Object *set_jit(Scheme_Object *data)
{ {
Scheme_Set_Bang *sb = (Scheme_Set_Bang *)data, *naya; Scheme_Set_Bang *sb = (Scheme_Set_Bang *)data, *naya;
@ -601,6 +629,8 @@ Scheme_Object *scheme_jit_expr(Scheme_Object *expr)
return scheme_case_lambda_jit(expr); return scheme_case_lambda_jit(expr);
case scheme_module_type: case scheme_module_type:
return scheme_module_jit(expr); return scheme_module_jit(expr);
case scheme_inline_variant_type:
return inline_variant_jit(expr);
default: default:
return expr; return expr;
} }

26
src/racket/src/marshal.c
View File

@ -55,6 +55,8 @@ static Scheme_Object *read_varref(Scheme_Object *obj);
static Scheme_Object *write_varref(Scheme_Object *obj); static Scheme_Object *write_varref(Scheme_Object *obj);
static Scheme_Object *read_apply_values(Scheme_Object *obj); static Scheme_Object *read_apply_values(Scheme_Object *obj);
static Scheme_Object *write_apply_values(Scheme_Object *obj); static Scheme_Object *write_apply_values(Scheme_Object *obj);
static Scheme_Object *read_inline_variant(Scheme_Object *obj);
static Scheme_Object *write_inline_variant(Scheme_Object *obj);
static Scheme_Object *write_application(Scheme_Object *obj); static Scheme_Object *write_application(Scheme_Object *obj);
static Scheme_Object *read_application(Scheme_Object *obj); static Scheme_Object *read_application(Scheme_Object *obj);
@ -135,6 +137,8 @@ void scheme_init_marshal(Scheme_Env *env)
scheme_install_type_reader(scheme_varref_form_type, read_varref); scheme_install_type_reader(scheme_varref_form_type, read_varref);
scheme_install_type_writer(scheme_apply_values_type, write_apply_values); scheme_install_type_writer(scheme_apply_values_type, write_apply_values);
scheme_install_type_reader(scheme_apply_values_type, read_apply_values); scheme_install_type_reader(scheme_apply_values_type, read_apply_values);
scheme_install_type_writer(scheme_inline_variant_type, write_inline_variant);
scheme_install_type_reader(scheme_inline_variant_type, read_inline_variant);
scheme_install_type_writer(scheme_compilation_top_type, write_top); scheme_install_type_writer(scheme_compilation_top_type, write_top);
scheme_install_type_reader(scheme_compilation_top_type, read_top); scheme_install_type_reader(scheme_compilation_top_type, read_top);
@ -518,6 +522,28 @@ Scheme_Object *read_boxenv(Scheme_Object *o)
return data; return data;
} }
static Scheme_Object *read_inline_variant(Scheme_Object *obj)
{
Scheme_Object *data;
if (!SCHEME_PAIRP(obj)) return NULL;
data = scheme_make_vector(3, scheme_false);
data->type = scheme_inline_variant_type;
SCHEME_VEC_ELS(data)[0] = SCHEME_CAR(obj);
SCHEME_VEC_ELS(data)[1] = SCHEME_CDR(obj);
/* third slot is filled when module->accessible table is made */
return data;
}
static Scheme_Object *write_inline_variant(Scheme_Object *obj)
{
return scheme_make_pair(SCHEME_VEC_ELS(obj)[0],
SCHEME_VEC_ELS(obj)[1]);
}
#define BOOL(x) (x ? scheme_true : scheme_false) #define BOOL(x) (x ? scheme_true : scheme_false)
static Scheme_Object *write_application(Scheme_Object *obj) static Scheme_Object *write_application(Scheme_Object *obj)

10
src/racket/src/module.c
View File

@ -3604,6 +3604,11 @@ static void setup_accessible_table(Scheme_Module *m)
&& scheme_compiled_duplicate_ok(SCHEME_VEC_ELS(form)[0], 1)) { && scheme_compiled_duplicate_ok(SCHEME_VEC_ELS(form)[0], 1)) {
/* record simple constant from cross-module propagation: */ /* record simple constant from cross-module propagation: */
v = scheme_make_pair(v, SCHEME_VEC_ELS(form)[0]); v = scheme_make_pair(v, SCHEME_VEC_ELS(form)[0]);
} else if (SAME_TYPE(SCHEME_TYPE(SCHEME_VEC_ELS(form)[0]), scheme_inline_variant_type)) {
/* record a potentially inlineable function */
if (SCHEME_VEC_ELS(SCHEME_VEC_ELS(form)[0])[2] != (Scheme_Object *)m->prefix)
SCHEME_VEC_ELS(SCHEME_VEC_ELS(form)[0])[2] = (Scheme_Object *)m->prefix;
v = scheme_make_pair(v, SCHEME_VEC_ELS(form)[0]);
} else if (is_procedure_expression(SCHEME_VEC_ELS(form)[0])) { } else if (is_procedure_expression(SCHEME_VEC_ELS(form)[0])) {
/* record that it's constant across all instantiations: */ /* record that it's constant across all instantiations: */
v = scheme_make_pair(v, scheme_constant_key); v = scheme_make_pair(v, scheme_constant_key);
@ -4863,6 +4868,9 @@ static int needs_prompt(Scheme_Object *e)
case scheme_define_values_type: case scheme_define_values_type:
e = SCHEME_VEC_ELS(e)[0]; e = SCHEME_VEC_ELS(e)[0];
break; break;
case scheme_inline_variant_type:
e = SCHEME_VEC_ELS(e)[0];
break;
default: default:
return 1; return 1;
} }
@ -7082,7 +7090,7 @@ static Scheme_Object *do_module_begin_at_phase(Scheme_Object *form, Scheme_Comp_
if (!for_stx) if (!for_stx)
lifted_reqs = scheme_append(scheme_frame_get_require_lifts(eenv), lifted_reqs); lifted_reqs = scheme_append(scheme_frame_get_require_lifts(eenv), lifted_reqs);
oi = scheme_optimize_info_create(); oi = scheme_optimize_info_create(eenv->prefix);
scheme_optimize_info_set_context(oi, (Scheme_Object *)env->genv->module); scheme_optimize_info_set_context(oi, (Scheme_Object *)env->genv->module);
if (!(rec[drec].comp_flags & COMP_CAN_INLINE)) if (!(rec[drec].comp_flags & COMP_CAN_INLINE))
scheme_optimize_info_never_inline(oi); scheme_optimize_info_never_inline(oi);

2
src/racket/src/mzmark_optimize.inc
View File

@ -13,6 +13,7 @@ static int mark_optimize_info_MARK(void *p, struct NewGC *gc) {
gcMARK2(i->next, gc); gcMARK2(i->next, gc);
gcMARK2(i->use, gc); gcMARK2(i->use, gc);
gcMARK2(i->consts, gc); gcMARK2(i->consts, gc);
gcMARK2(i->cp, gc);
gcMARK2(i->top_level_consts, gc); gcMARK2(i->top_level_consts, gc);
gcMARK2(i->transitive_use, gc); gcMARK2(i->transitive_use, gc);
gcMARK2(i->transitive_use_len, gc); gcMARK2(i->transitive_use_len, gc);
@ -30,6 +31,7 @@ static int mark_optimize_info_FIXUP(void *p, struct NewGC *gc) {
gcFIXUP2(i->next, gc); gcFIXUP2(i->next, gc);
gcFIXUP2(i->use, gc); gcFIXUP2(i->use, gc);
gcFIXUP2(i->consts, gc); gcFIXUP2(i->consts, gc);
gcFIXUP2(i->cp, gc);
gcFIXUP2(i->top_level_consts, gc); gcFIXUP2(i->top_level_consts, gc);
gcFIXUP2(i->transitive_use, gc); gcFIXUP2(i->transitive_use, gc);
gcFIXUP2(i->transitive_use_len, gc); gcFIXUP2(i->transitive_use_len, gc);

31
src/racket/src/mzmark_resolve.inc
View File

@ -45,3 +45,34 @@ static int mark_resolve_info_FIXUP(void *p, struct NewGC *gc) {
#define mark_resolve_info_IS_CONST_SIZE 1 #define mark_resolve_info_IS_CONST_SIZE 1
static int mark_unresolve_info_SIZE(void *p, struct NewGC *gc) {
return
gcBYTES_TO_WORDS(sizeof(Unresolve_Info));
}
static int mark_unresolve_info_MARK(void *p, struct NewGC *gc) {
Unresolve_Info *i = (Unresolve_Info *)p;
gcMARK2(i->flags, gc);
gcMARK2(i->depths, gc);
gcMARK2(i->prefix, gc);
return
gcBYTES_TO_WORDS(sizeof(Unresolve_Info));
}
static int mark_unresolve_info_FIXUP(void *p, struct NewGC *gc) {
Unresolve_Info *i = (Unresolve_Info *)p;
gcFIXUP2(i->flags, gc);
gcFIXUP2(i->depths, gc);
gcFIXUP2(i->prefix, gc);
return
gcBYTES_TO_WORDS(sizeof(Unresolve_Info));
}
#define mark_unresolve_info_IS_ATOMIC 0
#define mark_unresolve_info_IS_CONST_SIZE 1

2
src/racket/src/mzmark_type.inc
View File

@ -2389,6 +2389,7 @@ static int comp_prefix_val_SIZE(void *p, struct NewGC *gc) {
static int comp_prefix_val_MARK(void *p, struct NewGC *gc) { static int comp_prefix_val_MARK(void *p, struct NewGC *gc) {
Comp_Prefix *cp = (Comp_Prefix *)p; Comp_Prefix *cp = (Comp_Prefix *)p;
gcMARK2(cp->toplevels, gc); gcMARK2(cp->toplevels, gc);
gcMARK2(cp->inline_variants, gc);
gcMARK2(cp->unbound, gc); gcMARK2(cp->unbound, gc);
gcMARK2(cp->stxes, gc); gcMARK2(cp->stxes, gc);
gcMARK2(cp->uses_unsafe, gc); gcMARK2(cp->uses_unsafe, gc);
@ -2400,6 +2401,7 @@ static int comp_prefix_val_MARK(void *p, struct NewGC *gc) {
static int comp_prefix_val_FIXUP(void *p, struct NewGC *gc) { static int comp_prefix_val_FIXUP(void *p, struct NewGC *gc) {
Comp_Prefix *cp = (Comp_Prefix *)p; Comp_Prefix *cp = (Comp_Prefix *)p;
gcFIXUP2(cp->toplevels, gc); gcFIXUP2(cp->toplevels, gc);
gcFIXUP2(cp->inline_variants, gc);
gcFIXUP2(cp->unbound, gc); gcFIXUP2(cp->unbound, gc);
gcFIXUP2(cp->stxes, gc); gcFIXUP2(cp->stxes, gc);
gcFIXUP2(cp->uses_unsafe, gc); gcFIXUP2(cp->uses_unsafe, gc);

14
src/racket/src/mzmarksrc.c
View File

@ -958,6 +958,7 @@ comp_prefix_val {
mark: mark:
Comp_Prefix *cp = (Comp_Prefix *)p; Comp_Prefix *cp = (Comp_Prefix *)p;
gcMARK2(cp->toplevels, gc); gcMARK2(cp->toplevels, gc);
gcMARK2(cp->inline_variants, gc);
gcMARK2(cp->unbound, gc); gcMARK2(cp->unbound, gc);
gcMARK2(cp->stxes, gc); gcMARK2(cp->stxes, gc);
gcMARK2(cp->uses_unsafe, gc); gcMARK2(cp->uses_unsafe, gc);
@ -1232,6 +1233,18 @@ mark_resolve_info {
gcBYTES_TO_WORDS(sizeof(Resolve_Info)); gcBYTES_TO_WORDS(sizeof(Resolve_Info));
} }
mark_unresolve_info {
mark:
Unresolve_Info *i = (Unresolve_Info *)p;
gcMARK2(i->flags, gc);
gcMARK2(i->depths, gc);
gcMARK2(i->prefix, gc);
size:
gcBYTES_TO_WORDS(sizeof(Unresolve_Info));
}
END resolve; END resolve;
/**********************************************************************/ /**********************************************************************/
@ -1265,6 +1278,7 @@ mark_optimize_info {
gcMARK2(i->next, gc); gcMARK2(i->next, gc);
gcMARK2(i->use, gc); gcMARK2(i->use, gc);
gcMARK2(i->consts, gc); gcMARK2(i->consts, gc);
gcMARK2(i->cp, gc);
gcMARK2(i->top_level_consts, gc); gcMARK2(i->top_level_consts, gc);
gcMARK2(i->transitive_use, gc); gcMARK2(i->transitive_use, gc);
gcMARK2(i->transitive_use_len, gc); gcMARK2(i->transitive_use_len, gc);

123
src/racket/src/optimize.c
View File

@ -41,6 +41,7 @@
#define OPT_DELAY_GROUP_PROPAGATE 0 #define OPT_DELAY_GROUP_PROPAGATE 0
#define MAX_PROC_INLINE_SIZE 256 #define MAX_PROC_INLINE_SIZE 256
#define CROSS_MODULE_INLINE_SIZE 8
#define SCHEME_PRIM_IS_UNSAFE_NONMUTATING (SCHEME_PRIM_IS_UNSAFE_FUNCTIONAL | SCHEME_PRIM_IS_UNSAFE_OMITABLE) #define SCHEME_PRIM_IS_UNSAFE_NONMUTATING (SCHEME_PRIM_IS_UNSAFE_FUNCTIONAL | SCHEME_PRIM_IS_UNSAFE_OMITABLE)
@ -51,6 +52,7 @@ struct Optimize_Info
struct Optimize_Info *next; struct Optimize_Info *next;
int original_frame, new_frame; int original_frame, new_frame;
Scheme_Object *consts; Scheme_Object *consts;
Comp_Prefix *cp;
/* Propagated up and down the chain: */ /* Propagated up and down the chain: */
int size, vclock, psize; int size, vclock, psize;
@ -110,7 +112,7 @@ static Scheme_Object *no_potential_size(Scheme_Object *value);
#define IS_COMPILED_PROC(vals_expr) (SAME_TYPE(SCHEME_TYPE(vals_expr), scheme_compiled_unclosed_procedure_type) \ #define IS_COMPILED_PROC(vals_expr) (SAME_TYPE(SCHEME_TYPE(vals_expr), scheme_compiled_unclosed_procedure_type) \
|| SAME_TYPE(SCHEME_TYPE(vals_expr), scheme_case_lambda_sequence_type)) || SAME_TYPE(SCHEME_TYPE(vals_expr), scheme_case_lambda_sequence_type))
static int compiled_proc_body_size(Scheme_Object *o); static int compiled_proc_body_size(Scheme_Object *o, int less_args);
typedef struct Scheme_Once_Used { typedef struct Scheme_Once_Used {
Scheme_Object so; Scheme_Object so;
@ -222,6 +224,7 @@ int scheme_omittable_expr(Scheme_Object *o, int vals, int fuel, int resolved,
&& (SCHEME_LOCAL_POS(o) > deeper_than)) && (SCHEME_LOCAL_POS(o) > deeper_than))
|| (vtype == scheme_unclosed_procedure_type) || (vtype == scheme_unclosed_procedure_type)
|| (vtype == scheme_compiled_unclosed_procedure_type) || (vtype == scheme_compiled_unclosed_procedure_type)
|| (vtype == scheme_inline_variant_type)
|| (vtype == scheme_case_lambda_sequence_type) || (vtype == scheme_case_lambda_sequence_type)
|| (vtype == scheme_case_lambda_sequence_type) || (vtype == scheme_case_lambda_sequence_type)
|| (vtype == scheme_quote_syntax_type) || (vtype == scheme_quote_syntax_type)
@ -953,10 +956,25 @@ Scheme_Object *optimize_for_inline(Optimize_Info *info, Scheme_Object *le, int a
if (le) { if (le) {
while (SAME_TYPE(SCHEME_TYPE(le), scheme_compiled_toplevel_type)) { while (SAME_TYPE(SCHEME_TYPE(le), scheme_compiled_toplevel_type)) {
int pos;
pos = SCHEME_TOPLEVEL_POS(le);
single_use = 0; single_use = 0;
if (info->cp->inline_variants) {
Scheme_Object *iv;
iv = scheme_hash_get(info->cp->inline_variants, scheme_make_integer(pos));
if (iv) {
if (SAME_TYPE(SCHEME_TYPE(iv), scheme_inline_variant_type)) {
iv = scheme_unresolve(iv);
// printf("un: %p\n", iv);
scheme_hash_set(info->cp->inline_variants, scheme_make_integer(pos), iv);
}
if (iv) {
le = iv;
break;
}
}
}
if (info->top_level_consts) { if (info->top_level_consts) {
int pos;
pos = SCHEME_TOPLEVEL_POS(le);
le = scheme_hash_get(info->top_level_consts, scheme_make_integer(pos)); le = scheme_hash_get(info->top_level_consts, scheme_make_integer(pos));
if (le && SCHEME_BOXP(le)) { if (le && SCHEME_BOXP(le)) {
psize = SCHEME_INT_VAL(SCHEME_BOX_VAL(le)); psize = SCHEME_INT_VAL(SCHEME_BOX_VAL(le));
@ -2516,7 +2534,7 @@ int scheme_compiled_duplicate_ok(Scheme_Object *fb, int cross_module)
|| SCHEME_EOFP(fb) || SCHEME_EOFP(fb)
|| SCHEME_INTP(fb) || SCHEME_INTP(fb)
|| SCHEME_NULLP(fb) || SCHEME_NULLP(fb)
|| SAME_TYPE(SCHEME_TYPE(fb), scheme_local_type) || (!cross_module && SAME_TYPE(SCHEME_TYPE(fb), scheme_local_type))
|| SCHEME_PRIMP(fb) || SCHEME_PRIMP(fb)
/* Values that are hashed by the printer and/or interned on /* Values that are hashed by the printer and/or interned on
read to avoid duplication: */ read to avoid duplication: */
@ -3032,7 +3050,7 @@ static Scheme_Object *do_define_syntaxes_optimize(Scheme_Object *data, Optimize_
val = SCHEME_VEC_ELS(data)[3]; val = SCHEME_VEC_ELS(data)[3];
einfo = scheme_optimize_info_create(); einfo = scheme_optimize_info_create(info->cp);
if (info->inline_fuel < 0) if (info->inline_fuel < 0)
einfo->inline_fuel = -1; einfo->inline_fuel = -1;
@ -3056,7 +3074,7 @@ static Scheme_Object *begin_for_syntax_optimize(Scheme_Object *data, Optimize_In
l = SCHEME_VEC_ELS(data)[2]; l = SCHEME_VEC_ELS(data)[2];
while (!SCHEME_NULLP(l)) { while (!SCHEME_NULLP(l)) {
einfo = scheme_optimize_info_create(); einfo = scheme_optimize_info_create(info->cp);
if (info->inline_fuel < 0) if (info->inline_fuel < 0)
einfo->inline_fuel = -1; einfo->inline_fuel = -1;
@ -3411,15 +3429,24 @@ static int set_code_flags(Scheme_Compiled_Let_Value *retry_start,
return flags; return flags;
} }
static int compiled_proc_body_size(Scheme_Object *o) static int compiled_proc_body_size(Scheme_Object *o, int less_args)
{ {
if (SAME_TYPE(SCHEME_TYPE(o), scheme_compiled_unclosed_procedure_type)) int bsz;
return closure_body_size((Scheme_Closure_Data *)o, 0, NULL, NULL);
else if (SAME_TYPE(SCHEME_TYPE(o), scheme_case_lambda_sequence_type)) { if (SAME_TYPE(SCHEME_TYPE(o), scheme_compiled_unclosed_procedure_type)) {
bsz = closure_body_size((Scheme_Closure_Data *)o, 0, NULL, NULL);
if (less_args) bsz -= ((Scheme_Closure_Data *)o)->num_params;
return bsz;
} else if (SAME_TYPE(SCHEME_TYPE(o), scheme_case_lambda_sequence_type)) {
Scheme_Case_Lambda *cl = (Scheme_Case_Lambda *)o; Scheme_Case_Lambda *cl = (Scheme_Case_Lambda *)o;
int i, sz = 0; int i, sz = 0;
for (i = cl->count; i--; ) { for (i = cl->count; i--; ) {
sz += closure_body_size((Scheme_Closure_Data *)cl->array[i], 0, NULL, NULL); bsz = closure_body_size((Scheme_Closure_Data *)cl->array[i], 0, NULL, NULL);
if (less_args) {
bsz -= ((Scheme_Closure_Data *)cl->array[i])->num_params;
if (bsz > sz) sz = bsz;
} else
sz += bsz;
} }
return sz; return sz;
} else } else
@ -3428,7 +3455,7 @@ static int compiled_proc_body_size(Scheme_Object *o)
static int expr_size(Scheme_Object *o, Optimize_Info *info) static int expr_size(Scheme_Object *o, Optimize_Info *info)
{ {
return compiled_proc_body_size(o) + 1; return compiled_proc_body_size(o, 0) + 1;
} }
int scheme_might_invoke_call_cc(Scheme_Object *value) int scheme_might_invoke_call_cc(Scheme_Object *value)
@ -4014,7 +4041,7 @@ scheme_optimize_lets(Scheme_Object *form, Optimize_Info *info, int for_inline, i
self_value = SCHEME_CDR(cl_first); self_value = SCHEME_CDR(cl_first);
/* Drop old size, and remove old inline fuel: */ /* Drop old size, and remove old inline fuel: */
sz = compiled_proc_body_size(value); sz = compiled_proc_body_size(value, 0);
rhs_info->size -= (sz + 1); rhs_info->size -= (sz + 1);
/* Setting letrec_not_twice prevents inlinining /* Setting letrec_not_twice prevents inlinining
@ -4040,7 +4067,7 @@ scheme_optimize_lets(Scheme_Object *form, Optimize_Info *info, int for_inline, i
maybe only if it didn't grow too much: */ maybe only if it didn't grow too much: */
int new_sz; int new_sz;
if (OPT_DELAY_GROUP_PROPAGATE || OPT_LIMIT_FUNCTION_RESIZE) if (OPT_DELAY_GROUP_PROPAGATE || OPT_LIMIT_FUNCTION_RESIZE)
new_sz = compiled_proc_body_size(value); new_sz = compiled_proc_body_size(value, 0);
else else
new_sz = 0; new_sz = 0;
if (new_sz <= sz) if (new_sz <= sz)
@ -4550,6 +4577,16 @@ static int set_code_closure_flags(Scheme_Object *clones,
return flags; return flags;
} }
static Scheme_Object *is_cross_module_inline_candidiate(Scheme_Object *e, Optimize_Info *info)
{
if (SAME_TYPE(SCHEME_TYPE(e), scheme_compiled_unclosed_procedure_type)) {
if (compiled_proc_body_size(e, 1) < CROSS_MODULE_INLINE_SIZE)
return scheme_optimize_clone(0, e, info, 0, 0);
}
return NULL;
}
static Scheme_Object * static Scheme_Object *
module_optimize(Scheme_Object *data, Optimize_Info *info, int context) module_optimize(Scheme_Object *data, Optimize_Info *info, int context)
{ {
@ -4557,12 +4594,16 @@ module_optimize(Scheme_Object *data, Optimize_Info *info, int context)
Scheme_Object *e, *vars, *old_context; Scheme_Object *e, *vars, *old_context;
int start_simltaneous = 0, i_m, cnt; int start_simltaneous = 0, i_m, cnt;
Scheme_Object *cl_first = NULL, *cl_last = NULL; Scheme_Object *cl_first = NULL, *cl_last = NULL;
Scheme_Hash_Table *consts = NULL, *fixed_table = NULL, *re_consts = NULL; Scheme_Hash_Table *consts = NULL, *fixed_table = NULL, *re_consts = NULL, *originals = NULL;
int cont, next_pos_ready = -1, inline_fuel, is_proc_def; int cont, next_pos_ready = -1, inline_fuel, is_proc_def;
Comp_Prefix *prev_cp;
old_context = info->context; old_context = info->context;
info->context = (Scheme_Object *)m; info->context = (Scheme_Object *)m;
prev_cp = info->cp;
info->cp = m->comp_prefix;
cnt = SCHEME_VEC_SIZE(m->bodies[0]); cnt = SCHEME_VEC_SIZE(m->bodies[0]);
if (OPT_ESTIMATE_FUTURE_SIZES) { if (OPT_ESTIMATE_FUTURE_SIZES) {
@ -4769,7 +4810,7 @@ module_optimize(Scheme_Object *data, Optimize_Info *info, int context)
if (SAME_TYPE(SCHEME_TYPE(e), scheme_define_values_type)) { if (SAME_TYPE(SCHEME_TYPE(e), scheme_define_values_type)) {
Scheme_Object *sub_e; Scheme_Object *sub_e;
sub_e = SCHEME_VEC_ELS(e)[1]; sub_e = SCHEME_VEC_ELS(e)[1];
old_sz = compiled_proc_body_size(sub_e); old_sz = compiled_proc_body_size(sub_e, 0);
} else } else
old_sz = 0; old_sz = 0;
} else } else
@ -4784,13 +4825,21 @@ module_optimize(Scheme_Object *data, Optimize_Info *info, int context)
Scheme_Object *rpos; Scheme_Object *rpos;
rpos = scheme_hash_get(re_consts, scheme_make_integer(start_simltaneous)); rpos = scheme_hash_get(re_consts, scheme_make_integer(start_simltaneous));
if (rpos) { if (rpos) {
Scheme_Object *old_e;
e = SCHEME_VEC_ELS(e)[1]; e = SCHEME_VEC_ELS(e)[1];
old_e = scheme_hash_get(info->top_level_consts, rpos);
if (old_e && IS_COMPILED_PROC(old_e)) {
if (!originals)
originals = scheme_make_hash_table(SCHEME_hash_ptr);
scheme_hash_set(originals, scheme_make_integer(start_simltaneous), old_e);
}
if (!scheme_compiled_propagate_ok(e, info) if (!scheme_compiled_propagate_ok(e, info)
&& scheme_is_statically_proc(e, info)) { && scheme_is_statically_proc(e, info)) {
/* If we previously installed a procedure for inlining, /* If we previously installed a procedure for inlining,
don't replace that with a worse approximation. */ don't replace that with a worse approximation. */
Scheme_Object *old_e;
old_e = scheme_hash_get(info->top_level_consts, rpos);
if (IS_COMPILED_PROC(old_e)) if (IS_COMPILED_PROC(old_e))
e = NULL; e = NULL;
else else
@ -4799,7 +4848,7 @@ module_optimize(Scheme_Object *data, Optimize_Info *info, int context)
if (e) { if (e) {
if (OPT_DELAY_GROUP_PROPAGATE || OPT_LIMIT_FUNCTION_RESIZE) if (OPT_DELAY_GROUP_PROPAGATE || OPT_LIMIT_FUNCTION_RESIZE)
new_sz = compiled_proc_body_size(e); new_sz = compiled_proc_body_size(e, 0);
else else
new_sz = 0; new_sz = 0;
@ -4850,6 +4899,35 @@ module_optimize(Scheme_Object *data, Optimize_Info *info, int context)
} }
} }
/* For functions that are potentially inlineable, perhaps
before optimization, insert inline_variant records: */
for (i_m = 0; i_m < cnt; i_m++) {
/* Optimize this expression: */
e = SCHEME_VEC_ELS(m->bodies[0])[i_m];
if (SAME_TYPE(SCHEME_TYPE(e), scheme_define_values_type)) {
Scheme_Object *sub_e, *alt_e;
sub_e = SCHEME_VEC_ELS(e)[1];
if (IS_COMPILED_PROC(sub_e)) {
alt_e = is_cross_module_inline_candidiate(sub_e, info);
if (!alt_e && originals) {
alt_e = scheme_hash_get(originals, scheme_make_integer(i_m));
if (SAME_OBJ(alt_e, sub_e))
alt_e = NULL;
else if (alt_e)
alt_e = is_cross_module_inline_candidiate(alt_e, info);
}
if (alt_e) {
Scheme_Object *iv;
iv = scheme_make_vector(3, scheme_false);
iv->type = scheme_inline_variant_type;
SCHEME_VEC_ELS(iv)[0] = sub_e;
SCHEME_VEC_ELS(iv)[1] = alt_e;
SCHEME_VEC_ELS(e)[1] = iv;
}
}
}
}
/* Check one more time for expressions that we can omit: */ /* Check one more time for expressions that we can omit: */
{ {
int can_omit = 0; int can_omit = 0;
@ -4873,9 +4951,11 @@ module_optimize(Scheme_Object *data, Optimize_Info *info, int context)
} }
m->bodies[0] = vec; m->bodies[0] = vec;
} }
cnt -= can_omit;
} }
info->context = old_context; info->context = old_context;
info->cp = prev_cp;
/* Exp-time body was optimized during compilation */ /* Exp-time body was optimized during compilation */
@ -5458,7 +5538,7 @@ Scheme_Object *scheme_optimize_shift(Scheme_Object *expr, int delta, int after_d
/* compile-time env for optimization */ /* compile-time env for optimization */
/*========================================================================*/ /*========================================================================*/
Optimize_Info *scheme_optimize_info_create() Optimize_Info *scheme_optimize_info_create(Comp_Prefix *cp)
{ {
Optimize_Info *info; Optimize_Info *info;
@ -5467,6 +5547,7 @@ Optimize_Info *scheme_optimize_info_create()
info->type = scheme_rt_optimize_info; info->type = scheme_rt_optimize_info;
#endif #endif
info->inline_fuel = 32; info->inline_fuel = 32;
info->cp = cp;
return info; return info;
} }
@ -5990,7 +6071,7 @@ static Optimize_Info *optimize_info_add_frame(Optimize_Info *info, int orig, int
{ {
Optimize_Info *naya; Optimize_Info *naya;
naya = scheme_optimize_info_create(); naya = scheme_optimize_info_create(info->cp);
naya->flags = (short)flags; naya->flags = (short)flags;
naya->next = info; naya->next = info;
naya->original_frame = orig; naya->original_frame = orig;

4
src/racket/src/read.c
View File

@ -3103,7 +3103,7 @@ read_here_string(Scheme_Object *port, Scheme_Object *stxsrc,
if (len < 0) if (len < 0)
len = 0; len = 0;
str = scheme_make_sized_char_string(s, len, 1); str = scheme_make_immutable_sized_char_string(s, len, 1);
str = scheme_intern_literal_string(str); str = scheme_intern_literal_string(str);
@ -4361,7 +4361,7 @@ static Scheme_Object *read_compact(CPort *port, int use_stack)
break; break;
case CPT_CHAR: case CPT_CHAR:
l = read_compact_number(port); l = read_compact_number(port);
return scheme_make_character(l); return make_interned_char(l);
break; break;
case CPT_INT: case CPT_INT:
return scheme_make_integer(read_compact_number(port)); return scheme_make_integer(read_compact_number(port));

351
src/racket/src/resolve.c
View File

@ -622,6 +622,22 @@ static void resolve_lift_definition(Resolve_Info *info, Scheme_Object *var, Sche
SCHEME_VEC_ELS(vec)[0] = pr; SCHEME_VEC_ELS(vec)[0] = pr;
} }
static Scheme_Object *
inline_variant_resolve(Scheme_Object *data, Resolve_Info *rslv)
{
Scheme_Object *a;
a = SCHEME_VEC_ELS(data)[0];
a = scheme_resolve_expr(a, rslv);
SCHEME_VEC_ELS(data)[0] = a;
a = SCHEME_VEC_ELS(data)[1];
a = scheme_resolve_expr(a, rslv);
SCHEME_VEC_ELS(data)[1] = a;
return data;
}
static Scheme_Object * static Scheme_Object *
set_resolve(Scheme_Object *data, Resolve_Info *rslv) set_resolve(Scheme_Object *data, Resolve_Info *rslv)
{ {
@ -2326,6 +2342,8 @@ Scheme_Object *scheme_resolve_expr(Scheme_Object *expr, Resolve_Info *info)
return 0; return 0;
case scheme_define_values_type: case scheme_define_values_type:
return define_values_resolve(expr, info); return define_values_resolve(expr, info);
case scheme_inline_variant_type:
return inline_variant_resolve(expr, info);
case scheme_define_syntaxes_type: case scheme_define_syntaxes_type:
return define_syntaxes_resolve(expr, info); return define_syntaxes_resolve(expr, info);
case scheme_begin_for_syntax_type: case scheme_begin_for_syntax_type:
@ -2983,6 +3001,338 @@ static int resolving_in_procedure(Resolve_Info *info)
return 0; return 0;
} }
/*========================================================================*/
/* uresolve */
/*========================================================================*/
typedef struct Unresolve_Info {
MZTAG_IF_REQUIRED
int stack_pos; /* stack in resolved coordinates */
int depth; /* stack in unresolved coordinates */
int stack_size;
int *flags;
mzshort *depths;
Scheme_Prefix *prefix;
int fail_after_all;
} Unresolve_Info;
static Scheme_Object *unresolve_expr(Scheme_Object *e, Unresolve_Info *ui);
static Unresolve_Info *new_unresolve_info(Scheme_Prefix *prefix)
{
Unresolve_Info *ui;
int *f, *d;
ui = MALLOC_ONE_RT(Unresolve_Info);
SET_REQUIRED_TAG(ui->type = scheme_rt_unresolve_info);
ui->stack_pos = 0;
ui->stack_size = 10;
f = (int *)scheme_malloc_atomic(sizeof(int) * ui->stack_size);
ui->flags = f;
d = (mzshort *)scheme_malloc_atomic(sizeof(mzshort) * ui->stack_size);
ui->depths = d;
return ui;
}
static int unresolve_stack_push(Unresolve_Info *ui, int n, int r_only)
{
int pos, *f, i;
mzshort *d;
pos = ui->stack_pos;
if (pos + n > ui->stack_size) {
f = (int *)scheme_malloc_atomic(sizeof(int) * ((2 * ui->stack_size) + n));
memcpy(f, ui->flags, sizeof(int) * pos);
d = (mzshort *)scheme_malloc_atomic(sizeof(mzshort) * ((2 * ui->stack_size) + n));
memcpy(d, ui->depths, sizeof(mzshort) * pos);
ui->stack_size = (2 * ui->stack_size) + n;
}
memset(ui->flags + pos, 0, sizeof(int) * n);
if (!r_only) {
for (i = 0; i < n; i++) {
ui->depths[pos + i] = ui->depth++;
}
}
ui->stack_pos += n;
return pos;
}
static int *unresolve_stack_pop(Unresolve_Info *ui, int pos, int n)
{
int *f;
ui->stack_pos = pos;
if (n) {
f = (int *)scheme_malloc_atomic(sizeof(int) * n);
memcpy(f, ui->flags + pos, n * sizeof(int));
ui->depth -= n;
} else
f = NULL;
return f;
}
static int unresolve_set_flag(Unresolve_Info *ui, int pos, int flag)
{
int i = ui->stack_pos - pos - 1;
if (pos >= ui->stack_pos) scheme_signal_error("internal error: unresolve too far");
flag |= ui->flags[i];
if (((flag & SCHEME_USE_COUNT_MASK) >> SCHEME_USE_COUNT_SHIFT) < SCHEME_USE_COUNT_INF)
flag += (1 << SCHEME_USE_COUNT_SHIFT);
ui->flags[i] = flag;
return ui->depth - ui->depths[i] - 1;
}
Scheme_Object *unresolve_closure(Scheme_Closure_Data *rdata, Unresolve_Info *ui)
{
Scheme_Closure_Data *data;
Scheme_Object *body;
Closure_Info *cl;
int pos, data_pos, *flags;
scheme_delay_load_closure(rdata);
if (rdata->closure_size)
return 0; /* won't work, yet */
data = MALLOC_ONE_TAGGED(Scheme_Closure_Data);
data->iso.so.type = scheme_compiled_unclosed_procedure_type;
SCHEME_CLOSURE_DATA_FLAGS(data) = (SCHEME_CLOSURE_DATA_FLAGS(rdata)
& (CLOS_HAS_REST | CLOS_IS_METHOD));
data->num_params = rdata->num_params;
data->name = rdata->name;
pos = unresolve_stack_push(ui, data->num_params, 0);
if (rdata->closure_size)
data_pos = unresolve_stack_push(ui, data->closure_size, 0);
body = unresolve_expr(rdata->code, ui);
if (!body) return NULL;
data->code = body;
cl = MALLOC_ONE_RT(Closure_Info);
SET_REQUIRED_TAG(cl->type = scheme_rt_closure_info);
data->closure_map = (mzshort *)cl;
if (rdata->closure_size)
(void)unresolve_stack_pop(ui, data_pos, 0);
flags = unresolve_stack_pop(ui, pos, data->num_params);
cl->local_flags = flags;
return (Scheme_Object *)data;
}
static Scheme_Object *unresolve_expr_k(void)
{
Scheme_Thread *p = scheme_current_thread;
Scheme_Object *e = (Scheme_Object *)p->ku.k.p1;
Unresolve_Info *ui = (Unresolve_Info *)p->ku.k.p2;
p->ku.k.p1 = NULL;
p->ku.k.p2 = NULL;
return unresolve_expr(e, ui);
}
static Scheme_Object *unresolve_expr(Scheme_Object *e, Unresolve_Info *ui)
{
#ifdef DO_STACK_CHECK
{
# include "mzstkchk.h"
{
Scheme_Thread *p = scheme_current_thread;
p->ku.k.p1 = (void *)e;
p->ku.k.p2 = (void *)ui;
return scheme_handle_stack_overflow(unresolve_expr_k);
}
}
#endif
switch (SCHEME_TYPE(e)) {
case scheme_local_type:
return scheme_make_local(scheme_local_type,
unresolve_set_flag(ui, SCHEME_LOCAL_POS(e), SCHEME_WAS_USED),
0);
case scheme_local_unbox_type:
return scheme_make_local(scheme_local_type,
unresolve_set_flag(ui, SCHEME_LOCAL_POS(e),
(SCHEME_WAS_SET_BANGED | SCHEME_WAS_USED)),
0);
case scheme_application_type:
{
Scheme_App_Rec *app = (Scheme_App_Rec *)e, *app2;
Scheme_Object *a;
int pos, i;
pos = unresolve_stack_push(ui, app->num_args, 1);
app2 = scheme_malloc_application(app->num_args+1);
for (i = app->num_args + 1; i--; ) {
a = unresolve_expr(app->args[i], ui);
if (!a) return NULL;
app2->args[i] = a;
}
(void)unresolve_stack_pop(ui, pos, 0);
return (Scheme_Object *)app2;
}
case scheme_application2_type:
{
Scheme_App2_Rec *app = (Scheme_App2_Rec *)e, *app2;
Scheme_Object *rator, *rand;
int pos;
pos = unresolve_stack_push(ui, 1, 1);
rator = unresolve_expr(app->rator, ui);
if (!rator) return NULL;
rand = unresolve_expr(app->rand, ui);
if (!rand) return NULL;
(void)unresolve_stack_pop(ui, pos, 0);
app2 = MALLOC_ONE_TAGGED(Scheme_App2_Rec);
app2->iso.so.type = scheme_application2_type;
app2->rator = rator;
app2->rand = rand;
return (Scheme_Object *)app2;
}
case scheme_application3_type:
{
Scheme_App3_Rec *app = (Scheme_App3_Rec *)e, *app2;
Scheme_Object *rator, *rand1, *rand2;
int pos;
pos = unresolve_stack_push(ui, 2, 1);
rator = unresolve_expr(app->rator, ui);
if (!rator) return NULL;
rand1 = unresolve_expr(app->rand1, ui);
if (!rand1) return NULL;
rand2 = unresolve_expr(app->rand2, ui);
if (!rand2) return NULL;
(void)unresolve_stack_pop(ui, pos, 0);
app2 = MALLOC_ONE_TAGGED(Scheme_App3_Rec);
app2->iso.so.type = scheme_application3_type;
app2->rator = rator;
app2->rand1 = rand1;
app2->rand2 = rand2;
return (Scheme_Object *)app2;
}
case scheme_branch_type:
{
Scheme_Branch_Rec *b = (Scheme_Branch_Rec *)e, *b2;
Scheme_Object *tst, *thn, *els;
tst = unresolve_expr(b->test, ui);
if (!tst) return NULL;
thn = unresolve_expr(b->tbranch, ui);
if (!thn) return NULL;
els = unresolve_expr(b->fbranch, ui);
if (!els) return NULL;
b2 = MALLOC_ONE_TAGGED(Scheme_Branch_Rec);
b2->so.type = scheme_branch_type;
b2->test = tst;
b2->tbranch = thn;
b2->fbranch = els;
return (Scheme_Object *)b2;
}
case scheme_let_one_type:
{
Scheme_Let_One *lo = (Scheme_Let_One *)e;
Scheme_Object *rhs, *body;
Scheme_Let_Header *lh;
Scheme_Compiled_Let_Value *lv;
int *flags, pos;
ui->fail_after_all = 1;
pos = unresolve_stack_push(ui, 1, 1 /* => pre-bind RHS */);
rhs = unresolve_expr(lo->value, ui);
if (!rhs) return NULL;
(void)unresolve_stack_pop(ui, pos, 0);
pos = unresolve_stack_push(ui, 1, 0);
body = unresolve_expr(lo->body, ui);
if (!body) return NULL;
flags = unresolve_stack_pop(ui, pos, 1);
lh = MALLOC_ONE_TAGGED(Scheme_Let_Header);
lh->iso.so.type = scheme_compiled_let_void_type;
lh->count = 1;
lh->num_clauses = 1;
lv = MALLOC_ONE_TAGGED(Scheme_Compiled_Let_Value);
lv->iso.so.type = scheme_compiled_let_value_type;
lv->count = 1;
lv->position = 0;
lv->value = rhs;
lv->flags = flags;
lv->body = body;
lh->body = (Scheme_Object *)lv;
return (Scheme_Object *)lh;
}
default:
if (SCHEME_TYPE(e) > _scheme_values_types_) {
if (scheme_compiled_duplicate_ok(e, 1))
return e;
}
// printf("no %d\n", SCHEME_TYPE(e));
return NULL;
}
}
Scheme_Object *scheme_unresolve(Scheme_Object *iv)
{
Scheme_Object *o;
o = SCHEME_VEC_ELS(iv)[1];
if (SAME_TYPE(SCHEME_TYPE(o), scheme_closure_type)) {
o = (Scheme_Object *)((Scheme_Closure *)o)->code;
if (((Scheme_Closure_Data *)o)->closure_size)
return NULL;
}
if (SAME_TYPE(SCHEME_TYPE(o), scheme_unclosed_procedure_type)) {
/* convert an optimized & resolved closure back to compiled form: */
return unresolve_closure((Scheme_Closure_Data *)o,
new_unresolve_info((Scheme_Prefix *)SCHEME_VEC_ELS(iv)[2]));
}
return NULL;
}
/*========================================================================*/ /*========================================================================*/
/* precise GC traversers */ /* precise GC traversers */
/*========================================================================*/ /*========================================================================*/
@ -2996,6 +3346,7 @@ START_XFORM_SKIP;
static void register_traversers(void) static void register_traversers(void)
{ {
GC_REG_TRAV(scheme_rt_resolve_info, mark_resolve_info); GC_REG_TRAV(scheme_rt_resolve_info, mark_resolve_info);
GC_REG_TRAV(scheme_rt_unresolve_info, mark_unresolve_info);
} }
END_XFORM_SKIP; END_XFORM_SKIP;

11
src/racket/src/schpriv.h
View File

@ -2163,6 +2163,7 @@ typedef struct Comp_Prefix
MZTAG_IF_REQUIRED MZTAG_IF_REQUIRED
int num_toplevels, num_stxes; int num_toplevels, num_stxes;
Scheme_Hash_Table *toplevels; /* buckets for toplevel/module variables */ Scheme_Hash_Table *toplevels; /* buckets for toplevel/module variables */
Scheme_Hash_Table *inline_variants; /* position -> inline_variant */
Scheme_Object *unbound; /* identifiers (and lists of phase-1 shifted unbounds) that were unbound at compile */ Scheme_Object *unbound; /* identifiers (and lists of phase-1 shifted unbounds) that were unbound at compile */
Scheme_Hash_Table *stxes; /* syntax objects */ Scheme_Hash_Table *stxes; /* syntax objects */
Scheme_Object *uses_unsafe; /* NULL, inspector, or hashtree of inspectors */ Scheme_Object *uses_unsafe; /* NULL, inspector, or hashtree of inspectors */
@ -2471,7 +2472,8 @@ Scheme_Comp_Env *scheme_require_renames(Scheme_Comp_Env *env);
Scheme_Object *scheme_lookup_binding(Scheme_Object *symbol, Scheme_Comp_Env *env, int flags, Scheme_Object *scheme_lookup_binding(Scheme_Object *symbol, Scheme_Comp_Env *env, int flags,
Scheme_Object *in_modidx, Scheme_Object *in_modidx,
Scheme_Env **_menv, int *_protected, Scheme_Env **_menv, int *_protected,
Scheme_Object **_lexical_binding_id); Scheme_Object **_lexical_binding_id,
Scheme_Object **_inline_variant);
int scheme_is_imported(Scheme_Object *var, Scheme_Comp_Env *env); int scheme_is_imported(Scheme_Object *var, Scheme_Comp_Env *env);
Scheme_Object *scheme_extract_unsafe(Scheme_Object *o); Scheme_Object *scheme_extract_unsafe(Scheme_Object *o);
@ -2532,7 +2534,9 @@ int scheme_check_top_identifier_bound(Scheme_Object *symbol, Scheme_Env *genv, i
Scheme_Object *scheme_register_toplevel_in_prefix(Scheme_Object *var, Scheme_Comp_Env *env, Scheme_Object *scheme_register_toplevel_in_prefix(Scheme_Object *var, Scheme_Comp_Env *env,
Scheme_Compile_Info *rec, int drec, Scheme_Compile_Info *rec, int drec,
int imported); int imported, Scheme_Object *inline_variant);
Scheme_Object *scheme_register_toplevel_in_comp_prefix(Scheme_Object *var, Comp_Prefix *cp,
int imported, Scheme_Object *inline_variant);
void scheme_register_unbound_toplevel(Scheme_Comp_Env *env, Scheme_Object *id); void scheme_register_unbound_toplevel(Scheme_Comp_Env *env, Scheme_Object *id);
Scheme_Object *scheme_register_stx_in_prefix(Scheme_Object *var, Scheme_Comp_Env *env, Scheme_Object *scheme_register_stx_in_prefix(Scheme_Object *var, Scheme_Comp_Env *env,
Scheme_Compile_Info *rec, int drec); Scheme_Compile_Info *rec, int drec);
@ -2602,6 +2606,7 @@ Scheme_Object *scheme_make_noninline_proc(Scheme_Object *e);
Scheme_Object *scheme_resolve_expr(Scheme_Object *, Resolve_Info *); Scheme_Object *scheme_resolve_expr(Scheme_Object *, Resolve_Info *);
Scheme_Object *scheme_resolve_list(Scheme_Object *, Resolve_Info *); Scheme_Object *scheme_resolve_list(Scheme_Object *, Resolve_Info *);
Scheme_Object *scheme_unresolve(Scheme_Object *);
int scheme_is_compiled_procedure(Scheme_Object *o, int can_be_closed, int can_be_liftable); int scheme_is_compiled_procedure(Scheme_Object *o, int can_be_closed, int can_be_liftable);
@ -2618,7 +2623,7 @@ int scheme_resolve_info_use_jit(Resolve_Info *ri);
void scheme_enable_expression_resolve_lifts(Resolve_Info *ri); void scheme_enable_expression_resolve_lifts(Resolve_Info *ri);
Scheme_Object *scheme_merge_expression_resolve_lifts(Scheme_Object *expr, Resolve_Prefix *rp, Resolve_Info *ri); Scheme_Object *scheme_merge_expression_resolve_lifts(Scheme_Object *expr, Resolve_Prefix *rp, Resolve_Info *ri);
Optimize_Info *scheme_optimize_info_create(void); Optimize_Info *scheme_optimize_info_create(Comp_Prefix *cp);
void scheme_optimize_info_enforce_const(Optimize_Info *, int enforce_const); void scheme_optimize_info_enforce_const(Optimize_Info *, int enforce_const);
void scheme_optimize_info_set_context(Optimize_Info *, Scheme_Object *ctx); void scheme_optimize_info_set_context(Optimize_Info *, Scheme_Object *ctx);
void scheme_optimize_info_never_inline(Optimize_Info *); void scheme_optimize_info_never_inline(Optimize_Info *);

4
src/racket/src/schvers.h
View File

@ -13,12 +13,12 @@
consistently.) consistently.)
*/ */
#define MZSCHEME_VERSION "5.2.0.4" #define MZSCHEME_VERSION "5.2.0.5"
#define MZSCHEME_VERSION_X 5 #define MZSCHEME_VERSION_X 5
#define MZSCHEME_VERSION_Y 2 #define MZSCHEME_VERSION_Y 2
#define MZSCHEME_VERSION_Z 0 #define MZSCHEME_VERSION_Z 0
#define MZSCHEME_VERSION_W 4 #define MZSCHEME_VERSION_W 5
#define MZSCHEME_VERSION_MAJOR ((MZSCHEME_VERSION_X * 100) + MZSCHEME_VERSION_Y) #define MZSCHEME_VERSION_MAJOR ((MZSCHEME_VERSION_X * 100) + MZSCHEME_VERSION_Y)
#define MZSCHEME_VERSION_MINOR ((MZSCHEME_VERSION_Z * 1000) + MZSCHEME_VERSION_W) #define MZSCHEME_VERSION_MINOR ((MZSCHEME_VERSION_Z * 1000) + MZSCHEME_VERSION_W)

14
src/racket/src/sfs.c
View File

@ -781,6 +781,17 @@ define_values_sfs(Scheme_Object *data, SFS_Info *info)
return data; return data;
} }
static Scheme_Object *
inline_variant_sfs(Scheme_Object *data, SFS_Info *info)
{
Scheme_Object *e;
scheme_sfs_start_sequence(info, 1, 0);
e = scheme_sfs_expr(SCHEME_VEC_ELS(data)[0], info, -1);
SCHEME_VEC_ELS(data)[0] = e;
/* we don't bother with inlinable variant, since it isn't called directly */
return data;
}
static Scheme_Object * static Scheme_Object *
set_sfs(Scheme_Object *data, SFS_Info *info) set_sfs(Scheme_Object *data, SFS_Info *info)
{ {
@ -1250,6 +1261,9 @@ Scheme_Object *scheme_sfs_expr(Scheme_Object *expr, SFS_Info *info, int closure_
case scheme_module_type: case scheme_module_type:
expr = module_sfs(expr, info); expr = module_sfs(expr, info);
break; break;
case scheme_inline_variant_type:
expr = inline_variant_sfs(expr, info);
break;
default: default:
break; break;
} }

444
src/racket/src/stypes.h
View File

@ -30,248 +30,250 @@ enum {
scheme_apply_values_type, /* 24 */ scheme_apply_values_type, /* 24 */
scheme_case_lambda_sequence_type, /* 25 */ scheme_case_lambda_sequence_type, /* 25 */
scheme_module_type, /* 26 */ scheme_module_type, /* 26 */
scheme_inline_variant_type, /* 27 */
_scheme_values_types_, /* All following types are values */ _scheme_values_types_, /* All following types are values */
/* intermediate compiled: */ /* intermediate compiled: */
scheme_compiled_unclosed_procedure_type,/* 28 */ scheme_compiled_unclosed_procedure_type,/* 29 */
scheme_compiled_let_value_type, /* 29 */ scheme_compiled_let_value_type, /* 30 */
scheme_compiled_let_void_type, /* 30 */ scheme_compiled_let_void_type, /* 31 */
scheme_compiled_toplevel_type, /* 31 */ scheme_compiled_toplevel_type, /* 32 */
scheme_compiled_quote_syntax_type, /* 32 */ scheme_compiled_quote_syntax_type, /* 33 */
scheme_quote_compilation_type, /* used while writing, only */ scheme_quote_compilation_type, /* used while writing, only */
/* Registered in prefix table: */ /* Registered in prefix table: */
scheme_variable_type, /* 34 */ scheme_variable_type, /* 35 */
scheme_module_variable_type, /* link replaces with scheme_variable_type */ scheme_module_variable_type, /* link replaces with scheme_variable_type */
_scheme_compiled_values_types_, /* 36 */ _scheme_compiled_values_types_, /* 37 */
/* procedure types */ /* procedure types */
scheme_prim_type, /* 37 */ scheme_prim_type, /* 38 */
scheme_closed_prim_type, /* 38 */ scheme_closed_prim_type, /* 39 */
scheme_closure_type, /* 39 */ scheme_closure_type, /* 40 */
scheme_case_closure_type, /* 40 */ scheme_case_closure_type, /* 41 */
scheme_cont_type, /* 41 */ scheme_cont_type, /* 42 */
scheme_escaping_cont_type, /* 42 */ scheme_escaping_cont_type, /* 43 */
scheme_proc_struct_type, /* 43 */ scheme_proc_struct_type, /* 44 */
scheme_native_closure_type, /* 44 */ scheme_native_closure_type, /* 45 */
scheme_proc_chaperone_type, /* 45 */ scheme_proc_chaperone_type, /* 46 */
scheme_chaperone_type, /* 46 */ scheme_chaperone_type, /* 47 */
/* structure type (plus one above for procs) */ /* structure type (plus one above for procs) */
scheme_structure_type, /* 47 */ scheme_structure_type, /* 48 */
/* basic types */ /* basic types */
scheme_char_type, /* 48 */ scheme_char_type, /* 49 */
scheme_integer_type, /* 49 */ scheme_integer_type, /* 50 */
scheme_bignum_type, /* 50 */ scheme_bignum_type, /* 51 */
scheme_rational_type, /* 51 */ scheme_rational_type, /* 52 */
scheme_float_type, /* 52 */ scheme_float_type, /* 53 */
scheme_double_type, /* 53 */ scheme_double_type, /* 54 */
scheme_complex_type, /* 54 */ scheme_complex_type, /* 55 */
scheme_char_string_type, /* 55 */ scheme_char_string_type, /* 56 */
scheme_byte_string_type, /* 56 */ scheme_byte_string_type, /* 57 */
scheme_unix_path_type, /* 57 */ scheme_unix_path_type, /* 58 */
scheme_windows_path_type, /* 58 */ scheme_windows_path_type, /* 59 */
scheme_symbol_type, /* 59 */ scheme_symbol_type, /* 60 */
scheme_keyword_type, /* 60 */ scheme_keyword_type, /* 61 */
scheme_null_type, /* 61 */ scheme_null_type, /* 62 */
scheme_pair_type, /* 62 */ scheme_pair_type, /* 63 */
scheme_mutable_pair_type, /* 63 */ scheme_mutable_pair_type, /* 64 */
scheme_vector_type, /* 64 */ scheme_vector_type, /* 65 */
scheme_inspector_type, /* 65 */ scheme_inspector_type, /* 66 */
scheme_input_port_type, /* 66 */ scheme_input_port_type, /* 67 */
scheme_output_port_type, /* 67 */ scheme_output_port_type, /* 68 */
scheme_eof_type, /* 68 */ scheme_eof_type, /* 69 */
scheme_true_type, /* 69 */ scheme_true_type, /* 70 */
scheme_false_type, /* 70 */ scheme_false_type, /* 71 */
scheme_void_type, /* 71 */ scheme_void_type, /* 72 */
scheme_syntax_compiler_type, /* 72 */ scheme_syntax_compiler_type, /* 73 */
scheme_macro_type, /* 73 */ scheme_macro_type, /* 74 */
scheme_box_type, /* 74 */ scheme_box_type, /* 75 */
scheme_thread_type, /* 75 */ scheme_thread_type, /* 76 */
scheme_stx_offset_type, /* 76 */ scheme_stx_offset_type, /* 77 */
scheme_cont_mark_set_type, /* 77 */ scheme_cont_mark_set_type, /* 78 */
scheme_sema_type, /* 78 */ scheme_sema_type, /* 79 */
scheme_hash_table_type, /* 79 */ scheme_hash_table_type, /* 80 */
scheme_hash_tree_type, /* 80 */ scheme_hash_tree_type, /* 81 */
scheme_cpointer_type, /* 81 */ scheme_cpointer_type, /* 82 */
scheme_prefix_type, /* 82 */ scheme_prefix_type, /* 83 */
scheme_weak_box_type, /* 83 */ scheme_weak_box_type, /* 84 */
scheme_ephemeron_type, /* 84 */ scheme_ephemeron_type, /* 85 */
scheme_struct_type_type, /* 85 */ scheme_struct_type_type, /* 86 */
scheme_module_index_type, /* 86 */ scheme_module_index_type, /* 87 */
scheme_set_macro_type, /* 87 */ scheme_set_macro_type, /* 88 */
scheme_listener_type, /* 88 */ scheme_listener_type, /* 89 */
scheme_namespace_type, /* 89 */ scheme_namespace_type, /* 90 */
scheme_config_type, /* 90 */ scheme_config_type, /* 91 */
scheme_stx_type, /* 91 */ scheme_stx_type, /* 92 */
scheme_will_executor_type, /* 92 */ scheme_will_executor_type, /* 93 */
scheme_custodian_type, /* 93 */ scheme_custodian_type, /* 94 */
scheme_random_state_type, /* 94 */ scheme_random_state_type, /* 95 */
scheme_regexp_type, /* 95 */ scheme_regexp_type, /* 96 */
scheme_bucket_type, /* 96 */ scheme_bucket_type, /* 97 */
scheme_bucket_table_type, /* 97 */ scheme_bucket_table_type, /* 98 */
scheme_subprocess_type, /* 98 */ scheme_subprocess_type, /* 99 */
scheme_compilation_top_type, /* 99 */ scheme_compilation_top_type, /* 100 */
scheme_wrap_chunk_type, /* 100 */ scheme_wrap_chunk_type, /* 101 */
scheme_eval_waiting_type, /* 101 */ scheme_eval_waiting_type, /* 102 */
scheme_tail_call_waiting_type, /* 102 */ scheme_tail_call_waiting_type, /* 103 */
scheme_undefined_type, /* 103 */ scheme_undefined_type, /* 104 */
scheme_struct_property_type, /* 104 */ scheme_struct_property_type, /* 105 */
scheme_chaperone_property_type, /* 105 */ scheme_chaperone_property_type, /* 106 */
scheme_multiple_values_type, /* 106 */ scheme_multiple_values_type, /* 107 */
scheme_placeholder_type, /* 107 */ scheme_placeholder_type, /* 108 */
scheme_table_placeholder_type, /* 108 */ scheme_table_placeholder_type, /* 109 */
scheme_rename_table_type, /* 109 */ scheme_rename_table_type, /* 110 */
scheme_rename_table_set_type, /* 110 */ scheme_rename_table_set_type, /* 111 */
scheme_svector_type, /* 111 */ scheme_svector_type, /* 112 */
scheme_resolve_prefix_type, /* 112 */ scheme_resolve_prefix_type, /* 113 */
scheme_security_guard_type, /* 113 */ scheme_security_guard_type, /* 114 */
scheme_indent_type, /* 114 */ scheme_indent_type, /* 115 */
scheme_udp_type, /* 115 */ scheme_udp_type, /* 116 */
scheme_udp_evt_type, /* 116 */ scheme_udp_evt_type, /* 117 */
scheme_tcp_accept_evt_type, /* 117 */ scheme_tcp_accept_evt_type, /* 118 */
scheme_id_macro_type, /* 118 */ scheme_id_macro_type, /* 119 */
scheme_evt_set_type, /* 119 */ scheme_evt_set_type, /* 120 */
scheme_wrap_evt_type, /* 120 */ scheme_wrap_evt_type, /* 121 */
scheme_handle_evt_type, /* 121 */ scheme_handle_evt_type, /* 122 */
scheme_nack_guard_evt_type, /* 122 */ scheme_nack_guard_evt_type, /* 123 */
scheme_semaphore_repost_type, /* 123 */ scheme_semaphore_repost_type, /* 124 */
scheme_channel_type, /* 124 */ scheme_channel_type, /* 125 */
scheme_channel_put_type, /* 125 */ scheme_channel_put_type, /* 126 */
scheme_thread_resume_type, /* 126 */ scheme_thread_resume_type, /* 127 */
scheme_thread_suspend_type, /* 127 */ scheme_thread_suspend_type, /* 128 */
scheme_thread_dead_type, /* 128 */ scheme_thread_dead_type, /* 129 */
scheme_poll_evt_type, /* 129 */ scheme_poll_evt_type, /* 130 */
scheme_nack_evt_type, /* 130 */ scheme_nack_evt_type, /* 131 */
scheme_module_registry_type, /* 131 */ scheme_module_registry_type, /* 132 */
scheme_thread_set_type, /* 132 */ scheme_thread_set_type, /* 133 */
scheme_string_converter_type, /* 133 */ scheme_string_converter_type, /* 134 */
scheme_alarm_type, /* 134 */ scheme_alarm_type, /* 135 */
scheme_thread_recv_evt_type, /* 135 */ scheme_thread_recv_evt_type, /* 136 */
scheme_thread_cell_type, /* 136 */ scheme_thread_cell_type, /* 137 */
scheme_channel_syncer_type, /* 137 */ scheme_channel_syncer_type, /* 138 */
scheme_special_comment_type, /* 138 */ scheme_special_comment_type, /* 139 */
scheme_write_evt_type, /* 139 */ scheme_write_evt_type, /* 140 */
scheme_always_evt_type, /* 140 */ scheme_always_evt_type, /* 141 */
scheme_never_evt_type, /* 141 */ scheme_never_evt_type, /* 142 */
scheme_progress_evt_type, /* 142 */ scheme_progress_evt_type, /* 143 */
scheme_place_dead_type, /* 143 */ scheme_place_dead_type, /* 144 */
scheme_already_comp_type, /* 144 */ scheme_already_comp_type, /* 145 */
scheme_readtable_type, /* 145 */ scheme_readtable_type, /* 146 */
scheme_intdef_context_type, /* 146 */ scheme_intdef_context_type, /* 147 */
scheme_lexical_rib_type, /* 147 */ scheme_lexical_rib_type, /* 148 */
scheme_thread_cell_values_type, /* 148 */ scheme_thread_cell_values_type, /* 149 */
scheme_global_ref_type, /* 149 */ scheme_global_ref_type, /* 150 */
scheme_cont_mark_chain_type, /* 150 */ scheme_cont_mark_chain_type, /* 151 */
scheme_raw_pair_type, /* 151 */ scheme_raw_pair_type, /* 152 */
scheme_prompt_type, /* 152 */ scheme_prompt_type, /* 153 */
scheme_prompt_tag_type, /* 153 */ scheme_prompt_tag_type, /* 154 */
scheme_expanded_syntax_type, /* 154 */ scheme_expanded_syntax_type, /* 155 */
scheme_delay_syntax_type, /* 155 */ scheme_delay_syntax_type, /* 156 */
scheme_cust_box_type, /* 156 */ scheme_cust_box_type, /* 157 */
scheme_resolved_module_path_type, /* 157 */ scheme_resolved_module_path_type, /* 158 */
scheme_module_phase_exports_type, /* 158 */ scheme_module_phase_exports_type, /* 159 */
scheme_logger_type, /* 159 */ scheme_logger_type, /* 160 */
scheme_log_reader_type, /* 160 */ scheme_log_reader_type, /* 161 */
scheme_free_id_info_type, /* 161 */ scheme_free_id_info_type, /* 162 */
scheme_rib_delimiter_type, /* 162 */ scheme_rib_delimiter_type, /* 163 */
scheme_noninline_proc_type, /* 163 */ scheme_noninline_proc_type, /* 164 */
scheme_prune_context_type, /* 164 */ scheme_prune_context_type, /* 165 */
scheme_future_type, /* 165 */ scheme_future_type, /* 166 */
scheme_flvector_type, /* 166 */ scheme_flvector_type, /* 167 */
scheme_fxvector_type, /* 167 */ scheme_fxvector_type, /* 168 */
scheme_place_type, /* 168 */ scheme_place_type, /* 169 */
scheme_place_object_type, /* 169 */ scheme_place_object_type, /* 170 */
scheme_place_async_channel_type, /* 170 */ scheme_place_async_channel_type, /* 171 */
scheme_place_bi_channel_type, /* 171 */ scheme_place_bi_channel_type, /* 172 */
scheme_once_used_type, /* 172 */ scheme_once_used_type, /* 173 */
scheme_serialized_symbol_type, /* 173 */ scheme_serialized_symbol_type, /* 174 */
scheme_serialized_structure_type, /* 174 */ scheme_serialized_structure_type, /* 175 */
scheme_fsemaphore_type, /* 175 */ scheme_fsemaphore_type, /* 176 */
scheme_serialized_tcp_fd_type, /* 176 */ scheme_serialized_tcp_fd_type, /* 177 */
scheme_serialized_file_fd_type, /* 177 */ scheme_serialized_file_fd_type, /* 178 */
scheme_port_closed_evt_type, /* 178 */ scheme_port_closed_evt_type, /* 179 */
#ifdef MZTAG_REQUIRED #ifdef MZTAG_REQUIRED
_scheme_last_normal_type_, /* 179 */ _scheme_last_normal_type_, /* 180 */
scheme_rt_weak_array, /* 180 */ scheme_rt_weak_array, /* 181 */
scheme_rt_comp_env, /* 181 */ scheme_rt_comp_env, /* 182 */
scheme_rt_constant_binding, /* 182 */ scheme_rt_constant_binding, /* 183 */
scheme_rt_resolve_info, /* 183 */ scheme_rt_resolve_info, /* 184 */
scheme_rt_optimize_info, /* 184 */ scheme_rt_unresolve_info, /* 185 */
scheme_rt_compile_info, /* 185 */ scheme_rt_optimize_info, /* 186 */
scheme_rt_cont_mark, /* 186 */ scheme_rt_compile_info, /* 187 */
scheme_rt_saved_stack, /* 187 */ scheme_rt_cont_mark, /* 188 */
scheme_rt_reply_item, /* 188 */ scheme_rt_saved_stack, /* 189 */
scheme_rt_closure_info, /* 189 */ scheme_rt_reply_item, /* 190 */
scheme_rt_overflow, /* 190 */ scheme_rt_closure_info, /* 191 */
scheme_rt_overflow_jmp, /* 191 */ scheme_rt_overflow, /* 192 */
scheme_rt_meta_cont, /* 192 */ scheme_rt_overflow_jmp, /* 193 */
scheme_rt_dyn_wind_cell, /* 193 */ scheme_rt_meta_cont, /* 194 */
scheme_rt_dyn_wind_info, /* 194 */ scheme_rt_dyn_wind_cell, /* 195 */
scheme_rt_dyn_wind, /* 195 */ scheme_rt_dyn_wind_info, /* 196 */
scheme_rt_dup_check, /* 196 */ scheme_rt_dyn_wind, /* 197 */
scheme_rt_thread_memory, /* 197 */ scheme_rt_dup_check, /* 198 */
scheme_rt_input_file, /* 198 */ scheme_rt_thread_memory, /* 199 */
scheme_rt_input_fd, /* 199 */ scheme_rt_input_file, /* 200 */
scheme_rt_oskit_console_input, /* 200 */ scheme_rt_input_fd, /* 201 */
scheme_rt_tested_input_file, /* 201 */ scheme_rt_oskit_console_input, /* 202 */
scheme_rt_tested_output_file, /* 202 */ scheme_rt_tested_input_file, /* 203 */
scheme_rt_indexed_string, /* 203 */ scheme_rt_tested_output_file, /* 204 */
scheme_rt_output_file, /* 204 */ scheme_rt_indexed_string, /* 205 */
scheme_rt_load_handler_data, /* 205 */ scheme_rt_output_file, /* 206 */
scheme_rt_pipe, /* 206 */ scheme_rt_load_handler_data, /* 207 */
scheme_rt_beos_process, /* 207 */ scheme_rt_pipe, /* 208 */
scheme_rt_system_child, /* 208 */ scheme_rt_beos_process, /* 209 */
scheme_rt_tcp, /* 209 */ scheme_rt_system_child, /* 210 */
scheme_rt_write_data, /* 210 */ scheme_rt_tcp, /* 211 */
scheme_rt_tcp_select_info, /* 211 */ scheme_rt_write_data, /* 212 */
scheme_rt_param_data, /* 212 */ scheme_rt_tcp_select_info, /* 213 */
scheme_rt_will, /* 213 */ scheme_rt_param_data, /* 214 */
scheme_rt_struct_proc_info, /* 214 */ scheme_rt_will, /* 215 */
scheme_rt_linker_name, /* 215 */ scheme_rt_struct_proc_info, /* 216 */
scheme_rt_param_map, /* 216 */ scheme_rt_linker_name, /* 217 */
scheme_rt_finalization, /* 217 */ scheme_rt_param_map, /* 218 */
scheme_rt_finalizations, /* 218 */ scheme_rt_finalization, /* 219 */
scheme_rt_cpp_object, /* 219 */ scheme_rt_finalizations, /* 220 */
scheme_rt_cpp_array_object, /* 220 */ scheme_rt_cpp_object, /* 221 */
scheme_rt_stack_object, /* 221 */ scheme_rt_cpp_array_object, /* 222 */
scheme_rt_preallocated_object, /* 222 */ scheme_rt_stack_object, /* 223 */
scheme_thread_hop_type, /* 223 */ scheme_rt_preallocated_object, /* 224 */
scheme_rt_srcloc, /* 224 */ scheme_thread_hop_type, /* 225 */
scheme_rt_evt, /* 225 */ scheme_rt_srcloc, /* 226 */
scheme_rt_syncing, /* 226 */ scheme_rt_evt, /* 227 */
scheme_rt_comp_prefix, /* 227 */ scheme_rt_syncing, /* 228 */
scheme_rt_user_input, /* 228 */ scheme_rt_comp_prefix, /* 229 */
scheme_rt_user_output, /* 229 */ scheme_rt_user_input, /* 230 */
scheme_rt_compact_port, /* 230 */ scheme_rt_user_output, /* 231 */
scheme_rt_read_special_dw, /* 231 */ scheme_rt_compact_port, /* 232 */
scheme_rt_regwork, /* 232 */ scheme_rt_read_special_dw, /* 233 */
scheme_rt_rx_lazy_string, /* 233 */ scheme_rt_regwork, /* 234 */
scheme_rt_buf_holder, /* 234 */ scheme_rt_rx_lazy_string, /* 235 */
scheme_rt_parameterization, /* 235 */ scheme_rt_buf_holder, /* 236 */
scheme_rt_print_params, /* 236 */ scheme_rt_parameterization, /* 237 */
scheme_rt_read_params, /* 237 */ scheme_rt_print_params, /* 238 */
scheme_rt_native_code, /* 238 */ scheme_rt_read_params, /* 239 */
scheme_rt_native_code_plus_case, /* 239 */ scheme_rt_native_code, /* 240 */
scheme_rt_jitter_data, /* 240 */ scheme_rt_native_code_plus_case, /* 241 */
scheme_rt_module_exports, /* 241 */ scheme_rt_jitter_data, /* 242 */
scheme_rt_delay_load_info, /* 242 */ scheme_rt_module_exports, /* 243 */
scheme_rt_marshal_info, /* 243 */ scheme_rt_delay_load_info, /* 244 */
scheme_rt_unmarshal_info, /* 244 */ scheme_rt_marshal_info, /* 245 */
scheme_rt_runstack, /* 245 */ scheme_rt_unmarshal_info, /* 246 */
scheme_rt_sfs_info, /* 246 */ scheme_rt_runstack, /* 247 */
scheme_rt_validate_clearing, /* 247 */ scheme_rt_sfs_info, /* 248 */
scheme_rt_rb_node, /* 248 */ scheme_rt_validate_clearing, /* 249 */
scheme_rt_lightweight_cont, /* 249 */ scheme_rt_rb_node, /* 250 */
scheme_rt_export_info, /* 250 */ scheme_rt_lightweight_cont, /* 251 */
scheme_rt_export_info, /* 252 */
#endif #endif
_scheme_last_type_ _scheme_last_type_

4
src/racket/src/syntax.c
View File

@ -4261,6 +4261,8 @@ static Scheme_Object *resolve_env(Scheme_Object *a, Scheme_Object *orig_phase,
} else if (SCHEME_PRUNEP(WRAP_POS_FIRST(wraps))) { } else if (SCHEME_PRUNEP(WRAP_POS_FIRST(wraps))) {
if (!is_member(SCHEME_STX_VAL(a), SCHEME_BOX_VAL(WRAP_POS_FIRST(wraps)))) { if (!is_member(SCHEME_STX_VAL(a), SCHEME_BOX_VAL(WRAP_POS_FIRST(wraps)))) {
/* Doesn't match pruned-to sym; already produce #f */ /* Doesn't match pruned-to sym; already produce #f */
if (_depends_on_unsealed_rib)
*_depends_on_unsealed_rib = depends_on_unsealed_rib;
return scheme_false; return scheme_false;
} }
} }
@ -4505,7 +4507,7 @@ static Scheme_Object *get_module_src_name(Scheme_Object *a, Scheme_Object *orig_
/* Has a relevant-looking free-id mapping. /* Has a relevant-looking free-id mapping.
Give up on the "fast" traversal. */ Give up on the "fast" traversal. */
Scheme_Object *modname, *names[7]; Scheme_Object *modname, *names[7];
int rib_dep; int rib_dep = 0;
names[0] = NULL; names[0] = NULL;
names[1] = NULL; names[1] = NULL;

1
src/racket/src/type.c
View File

@ -562,6 +562,7 @@ void scheme_register_traversers(void)
GC_REG_TRAV(scheme_module_type, module_val); GC_REG_TRAV(scheme_module_type, module_val);
GC_REG_TRAV(scheme_rt_export_info, exp_info_val); GC_REG_TRAV(scheme_rt_export_info, exp_info_val);
GC_REG_TRAV(scheme_require_form_type, twoptr_obj); GC_REG_TRAV(scheme_require_form_type, twoptr_obj);
GC_REG_TRAV(scheme_inline_variant_type, vector_obj);
GC_REG_TRAV(_scheme_values_types_, bad_trav); GC_REG_TRAV(_scheme_values_types_, bad_trav);

29
src/racket/src/validate.c
View File

@ -346,6 +346,29 @@ static void apply_values_validate(Scheme_Object *data, Mz_CPort *port,
NULL, 0, 0, vc, 0, 0, procs); NULL, 0, 0, vc, 0, 0, procs);
} }
static void inline_variant_validate(Scheme_Object *data, Mz_CPort *port,
char *stack, Validate_TLS tls,
int depth, int letlimit, int delta,
int num_toplevels, int num_stxes, int num_lifts,
void *tl_use_map, int result_ignored,
struct Validate_Clearing *vc, int tailpos,
Scheme_Hash_Tree *procs)
{
Scheme_Object *f1, *f2;
f1 = SCHEME_VEC_ELS(data)[0];
f2 = SCHEME_VEC_ELS(data)[1];
scheme_validate_expr(port, f1, stack, tls,
depth, letlimit, delta,
num_toplevels, num_stxes, num_lifts, tl_use_map,
NULL, 0, 0, vc, 0, 0, procs);
scheme_validate_expr(port, f2, stack, tls,
depth, letlimit, delta,
num_toplevels, num_stxes, num_lifts, tl_use_map,
NULL, 0, 0, vc, 0, 0, procs);
}
static void case_lambda_validate(Scheme_Object *data, Mz_CPort *port, char *stack, Validate_TLS tls, static void case_lambda_validate(Scheme_Object *data, Mz_CPort *port, char *stack, Validate_TLS tls,
int depth, int letlimit, int delta, int depth, int letlimit, int delta,
int num_toplevels, int num_stxes, int num_lifts, int num_toplevels, int num_stxes, int num_lifts,
@ -1501,6 +1524,12 @@ void scheme_validate_expr(Mz_CPort *port, Scheme_Object *expr,
num_toplevels, num_stxes, num_lifts, tl_use_map, num_toplevels, num_stxes, num_lifts, tl_use_map,
result_ignored, vc, tailpos, procs); result_ignored, vc, tailpos, procs);
break; break;
case scheme_inline_variant_type:
no_flo(need_flonum, port);
inline_variant_validate(expr, port, stack, tls, depth, letlimit, delta,
num_toplevels, num_stxes, num_lifts, tl_use_map,
result_ignored, vc, tailpos, procs);
break;
default: default:
/* All values are definitely ok, except pre-closed closures. /* All values are definitely ok, except pre-closed closures.
Such a closure can refer back to itself, so we use a flag Such a closure can refer back to itself, so we use a flag