From 779b419c03f294fb696f765e37dae1f1c73a263d Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Tue, 29 Nov 2011 20:20:05 -0700 Subject: [PATCH] first cut at cross-module function inlining 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). --- collects/compiler/decompile.rkt | 7 +- collects/compiler/zo-marshal.rkt | 8 +- collects/compiler/zo-parse.rkt | 13 +- collects/compiler/zo-structs.rkt | 5 +- collects/scribblings/raco/decompile.scrbl | 24 +- collects/scribblings/raco/zo-struct.scrbl | 9 +- doc/release-notes/racket/HISTORY.txt | 4 + src/racket/src/compenv.c | 49 ++- src/racket/src/compile.c | 46 +-- src/racket/src/cstartup.inc | 64 ++-- src/racket/src/env.c | 4 +- src/racket/src/eval.c | 7 +- src/racket/src/jit.c | 1 + src/racket/src/jitprep.c | 32 +- src/racket/src/marshal.c | 26 ++ src/racket/src/module.c | 10 +- src/racket/src/mzmark_optimize.inc | 2 + src/racket/src/mzmark_resolve.inc | 31 ++ src/racket/src/mzmark_type.inc | 2 + src/racket/src/mzmarksrc.c | 14 + src/racket/src/optimize.c | 123 +++++- src/racket/src/read.c | 4 +- src/racket/src/resolve.c | 351 +++++++++++++++++ src/racket/src/schpriv.h | 11 +- src/racket/src/schvers.h | 4 +- src/racket/src/sfs.c | 14 + src/racket/src/stypes.h | 444 +++++++++++----------- src/racket/src/syntax.c | 4 +- src/racket/src/type.c | 1 + src/racket/src/validate.c | 29 ++ 30 files changed, 1000 insertions(+), 343 deletions(-) diff --git a/collects/compiler/decompile.rkt b/collects/compiler/decompile.rkt index 053ad00fb9..48671220a2 100644 --- a/collects/compiler/decompile.rkt +++ b/collects/compiler/decompile.rkt @@ -193,7 +193,12 @@ [(struct toplevel (depth pos const? set-const?)) (list-ref/protect (glob-desc-vars globs) pos 'def-vals)])) 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)) `(define-syntaxes ,ids ,(let-values ([(globs defns) (decompile-prefix prefix stx-ht)]) diff --git a/collects/compiler/zo-marshal.rkt b/collects/compiler/zo-marshal.rkt index 22f5d5b95e..bfa9deb811 100644 --- a/collects/compiler/zo-marshal.rkt +++ b/collects/compiler/zo-marshal.rkt @@ -168,10 +168,10 @@ (define apply-values-type-num 24) (define case-lambda-sequence-type-num 25) (define module-type-num 26) -(define variable-type-num 34) -(define top-type-num 99) -(define prefix-type-num 112) -(define free-id-info-type-num 161) +(define inline-variants-type-num 27) +(define variable-type-num 35) +(define prefix-type-num 113) +(define free-id-info-type-num 162) (define-syntax define-enum (syntax-rules () diff --git a/collects/compiler/zo-parse.rkt b/collects/compiler/zo-parse.rkt index 5f47e9cc54..0f8ecde12e 100644 --- a/collects/compiler/zo-parse.rkt +++ b/collects/compiler/zo-parse.rkt @@ -329,6 +329,9 @@ (define (read-module-wrap v) v) +(define (read-inline-variant v) + (make-inline-variant (car v) (cdr v))) + ;; ---------------------------------------- ;; Unmarshal dispatch for various types @@ -355,10 +358,11 @@ [(24) 'apply-values-type] [(25) 'case-lambda-sequence-type] [(26) 'module-type] - [(34) 'variable-type] - [(35) 'module-variable-type] - [(112) 'resolve-prefix-type] - [(161) 'free-id-info-type] + [(27) 'inline-variant-type] + [(35) 'variable-type] + [(36) 'module-variable-type] + [(113) 'resolve-prefix-type] + [(162) 'free-id-info-type] [else (error 'int->type "unknown type: ~e" i)])) (define type-readers @@ -378,6 +382,7 @@ (cons 'case-lambda-sequence-type read-case-lambda) (cons 'begin0-sequence-type read-begin0) (cons 'module-type read-module) + (cons 'inline-variant-type read-inline-variant) (cons 'resolve-prefix-type read-resolve-prefix) (cons 'free-id-info-type read-free-id-info) (cons 'define-values-type read-define-values) diff --git a/collects/compiler/zo-structs.rkt b/collects/compiler/zo-structs.rkt index d1ed02537d..971e7b06c1 100644 --- a/collects/compiler/zo-structs.rkt +++ b/collects/compiler/zo-structs.rkt @@ -94,9 +94,12 @@ [max-let-depth exact-nonnegative-integer?] [dummy (or/c toplevel? #f)])) +(define-form-struct (inline-variant form) ([direct expr?] + [inline expr?])) + ;; Definitions (top level or within module): (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?))] [rhs (or/c expr? seq? any/c)] [prefix prefix?] diff --git a/collects/scribblings/raco/decompile.scrbl b/collects/scribblings/raco/decompile.scrbl index 29b3afa0ec..8dd3d15d60 100644 --- a/collects/scribblings/raco/decompile.scrbl +++ b/collects/scribblings/raco/decompile.scrbl @@ -21,7 +21,7 @@ Many forms in the decompiled code, such as @racket[module], @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{_}, which helps expose the difference between uses of local variables 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 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 location holding the variable will be cleared to prevent the 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 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]) and/or source-location information, then it is shown as a quoted 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 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 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 inline the operation. (Inlining information is not part of the 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] 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 @racketidfont{#%flonum}, indicating a place where the JIT compiler 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 an argument to an operation that can work with unboxed values).} - @item{A @racketidfont{#%decode-syntax} form corresponds to a syntax - object. Future improvements to the decompiler will convert such - syntax objects to a readable form.} +@item{A @racketidfont{#%decode-syntax} form corresponds to a syntax + object.} ] diff --git a/collects/scribblings/raco/zo-struct.scrbl b/collects/scribblings/raco/zo-struct.scrbl index a08ebf4522..12c78c20ab 100644 --- a/collects/scribblings/raco/zo-struct.scrbl +++ b/collects/scribblings/raco/zo-struct.scrbl @@ -94,7 +94,7 @@ structures that are produced by @racket[zo-parse] and consumed by @defstruct+[(def-values form) ([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 @racket[ids] will reference via the prefix either a top-level 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 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) ([name symbol?] [srcname symbol?] diff --git a/doc/release-notes/racket/HISTORY.txt b/doc/release-notes/racket/HISTORY.txt index 347252b224..f94d79cdbd 100644 --- a/doc/release-notes/racket/HISTORY.txt +++ b/doc/release-notes/racket/HISTORY.txt @@ -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 Regexps are `equal?' when they have the same source [byte] string and mode diff --git a/src/racket/src/compenv.c b/src/racket/src/compenv.c index 30a3528d2d..5dacf7ba2b 100644 --- a/src/racket/src/compenv.c +++ b/src/racket/src/compenv.c @@ -599,19 +599,12 @@ Scheme_Object *scheme_make_toplevel(mzshort depth, int position, int resolved, i return (Scheme_Object *)tl; } -Scheme_Object *scheme_register_toplevel_in_prefix(Scheme_Object *var, Scheme_Comp_Env *env, - Scheme_Compile_Info *rec, int drec, - int imported) +Scheme_Object *scheme_register_toplevel_in_comp_prefix(Scheme_Object *var, Comp_Prefix *cp, + int imported, Scheme_Object *inline_variant) { - Comp_Prefix *cp = env->prefix; Scheme_Hash_Table *ht; 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; if (!ht) { 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)) : 0)); - cp->num_toplevels++; 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; } +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) { 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_Object *in_modidx, Scheme_Env **_menv, int *_protected, - Scheme_Object **_lexical_binding_id) + Scheme_Object **_lexical_binding_id, + Scheme_Object **_inline_variant) { Scheme_Comp_Env *frame; 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; else if (SAME_OBJ(mod_constant, scheme_fixed_key)) 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) return mod_constant; 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); 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 (!SAME_TYPE(SCHEME_TYPE(v), scheme_variable_type)) { *_use_map = -1; diff --git a/src/racket/src/compile.c b/src/racket/src/compile.c index 108a2d0770..834abc9bdf 100644 --- a/src/racket/src/compile.c +++ b/src/racket/src/compile.c @@ -590,9 +590,7 @@ make_closure_compilation(Scheme_Comp_Env *env, Scheme_Object *code, scheme_merge_lambda_rec(rec, drec, &lam, 0); cl = MALLOC_ONE_RT(Closure_Info); -#ifdef MZTAG_REQUIRED - cl->type = scheme_rt_closure_info; -#endif + SET_REQUIRED_TAG(cl->type = scheme_rt_closure_info); { int *local_flags; 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); } /* 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); if (last) @@ -1169,7 +1167,7 @@ set_syntax (Scheme_Object *form, Scheme_Comp_Env *env, Scheme_Compile_Info *rec, ? SCHEME_RESOLVE_MODIDS : 0), env->in_modidx, - &menv, NULL, NULL); + &menv, NULL, NULL, NULL); if (SAME_TYPE(SCHEME_TYPE(var), scheme_macro_type)) { /* 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) || 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) 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; var = scheme_lookup_binding(find_name, env, SCHEME_SETTING, env->in_modidx, - &menv, NULL, &lexical_binding_id); + &menv, NULL, &lexical_binding_id, NULL); 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 : 0), env->in_modidx, - &menv, NULL, &lex_id); + &menv, NULL, &lex_id, NULL); if (SAME_TYPE(SCHEME_TYPE(var), scheme_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); 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) 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 used to "link" to the right environment at run time. The #f as 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) @@ -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); + 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 expression may have syntax objects with a lexical rename that is still being extended. For letrec-syntaxes+values, don't simplify because it's too expensive. */ 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); a = scheme_resolve_expr(a, ri); @@ -4280,7 +4278,7 @@ Scheme_Object *scheme_check_immediate_macro(Scheme_Object *first, ? SCHEME_RESOLVE_MODIDS : 0), env->in_modidx, - &menv, NULL, NULL); + &menv, NULL, NULL, NULL); if (SCHEME_STX_PAIRP(first)) *current_val = val; @@ -4458,11 +4456,12 @@ scheme_compile_expand_expr(Scheme_Object *form, Scheme_Comp_Env *env, normal = app_expander; } else if (!SCHEME_STX_PAIRP(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; while (1) { lexical_binding_id = NULL; + inline_variant = NULL; var = scheme_lookup_binding(find_name, env, SCHEME_NULL_FOR_UNBOUND + 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) : 0), env->in_modidx, - &menv, &protected, &lexical_binding_id); + &menv, &protected, &lexical_binding_id, &inline_variant); 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) || SAME_TYPE(SCHEME_TYPE(var), scheme_module_variable_type)) return scheme_register_toplevel_in_prefix(var, env, rec, drec, - scheme_is_imported(var, env)); + scheme_is_imported(var, env), + inline_variant); else return var; } 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) : 0), env->in_modidx, - &menv, NULL, NULL); + &menv, NULL, NULL, NULL); SCHEME_EXPAND_OBSERVE_RESOLVE(rec[drec].observer, find_name); 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) : 0), env->in_modidx, - &menv, NULL, NULL); + &menv, NULL, NULL, NULL); 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) : 0), 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); } - 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 * diff --git a/src/racket/src/cstartup.inc b/src/racket/src/cstartup.inc index 5d1dda7b0b..46afea858d 100644 --- a/src/racket/src/cstartup.inc +++ b/src/racket/src/cstartup.inc @@ -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,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, @@ -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, 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, -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, 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, 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, -3,1,8,101,110,118,49,52,57,55,51,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, +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,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, 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, @@ -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, 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, -20,3,1,8,101,110,118,49,52,57,57,54,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, +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,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, 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, -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, -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, 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, 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, -80,158,36,36,36,20,112,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, +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,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, -20,112,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, -5,2,6,88,163,8,36,37,56,37,9,223,0,33,38,36,20,112,159,36,16, +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,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,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, -0,33,42,36,20,112,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, -11,16,5,2,9,88,163,8,36,37,54,37,9,223,0,33,45,36,20,112,159, +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,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,113,159, 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, -8,36,37,58,37,9,223,0,33,47,36,20,112,159,36,16,1,2,13,16,1, +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,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, -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}; 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,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, @@ -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, 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, -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, 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, @@ -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,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, -39,193,159,36,20,112,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, +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,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, 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, @@ -596,7 +596,7 @@ 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,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, @@ -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, 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, -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, -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, 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, @@ -623,7 +623,7 @@ 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,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, @@ -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, 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, -159,36,20,112,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, +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,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, 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, @@ -919,7 +919,7 @@ 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,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, @@ -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, 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, -16,0,159,36,20,112,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, +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,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, 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, diff --git a/src/racket/src/env.c b/src/racket/src/env.c index 5fcde6b89d..18bc7803af 100644 --- a/src/racket/src/env.c +++ b/src/racket/src/env.c @@ -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_OUT_OF_CONTEXT_OK + SCHEME_ELIM_CONST), scheme_current_thread->current_local_modidx, - &menv, NULL, NULL); + &menv, NULL, NULL, NULL); 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_OUT_OF_CONTEXT_OK + SCHEME_ELIM_CONST), scheme_current_thread->current_local_modidx, - NULL, NULL, &binder); + NULL, NULL, &binder, NULL); /* Deref globals */ if (v && SAME_TYPE(SCHEME_TYPE(v), scheme_variable_type)) diff --git a/src/racket/src/eval.c b/src/racket/src/eval.c index 1ad7bbb49a..d8162a269c 100644 --- a/src/racket/src/eval.c +++ b/src/racket/src/eval.c @@ -3555,6 +3555,11 @@ scheme_do_eval(Scheme_Object *obj, int num_rands, Scheme_Object **rands, v = define_values_execute(obj); break; } + case scheme_inline_variant_type: + { + obj = SCHEME_VEC_ELS(obj)[0]; + goto eval_top; + } case scheme_define_syntaxes_type: { UPDATE_THREAD_RSPTR(); @@ -3894,7 +3899,7 @@ static void *compile_k(void) break; } - oi = scheme_optimize_info_create(); + oi = scheme_optimize_info_create(cenv->prefix); scheme_optimize_info_enforce_const(oi, enforce_consts); if (!(comp_flags & COMP_CAN_INLINE)) scheme_optimize_info_never_inline(oi); diff --git a/src/racket/src/jit.c b/src/racket/src/jit.c index 7554ef39bf..7811f3237b 100644 --- a/src/racket/src/jit.c +++ b/src/racket/src/jit.c @@ -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_require_form_type: case scheme_module_type: + case scheme_inline_variant_type: { scheme_signal_error("internal error: cannot JIT a top-level form"); return 0; diff --git a/src/racket/src/jitprep.c b/src/racket/src/jitprep.c index d50cd0aaba..71b210a9e8 100644 --- a/src/racket/src/jitprep.c +++ b/src/racket/src/jitprep.c @@ -288,6 +288,16 @@ static Scheme_Object *jit_wcm(Scheme_Object *o) /* 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) { 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) && (SCHEME_VEC_SIZE(data) == 2)) 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); 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) { 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); case scheme_module_type: return scheme_module_jit(expr); + case scheme_inline_variant_type: + return inline_variant_jit(expr); default: return expr; } diff --git a/src/racket/src/marshal.c b/src/racket/src/marshal.c index 2328c53b22..952a4b055a 100644 --- a/src/racket/src/marshal.c +++ b/src/racket/src/marshal.c @@ -55,6 +55,8 @@ static Scheme_Object *read_varref(Scheme_Object *obj); static Scheme_Object *write_varref(Scheme_Object *obj); static Scheme_Object *read_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 *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_writer(scheme_apply_values_type, write_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_reader(scheme_compilation_top_type, read_top); @@ -518,6 +522,28 @@ Scheme_Object *read_boxenv(Scheme_Object *o) 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) static Scheme_Object *write_application(Scheme_Object *obj) diff --git a/src/racket/src/module.c b/src/racket/src/module.c index 6e32a60c97..f5878c61d0 100644 --- a/src/racket/src/module.c +++ b/src/racket/src/module.c @@ -3604,6 +3604,11 @@ static void setup_accessible_table(Scheme_Module *m) && scheme_compiled_duplicate_ok(SCHEME_VEC_ELS(form)[0], 1)) { /* record simple constant from cross-module propagation: */ 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])) { /* record that it's constant across all instantiations: */ v = scheme_make_pair(v, scheme_constant_key); @@ -4863,6 +4868,9 @@ static int needs_prompt(Scheme_Object *e) case scheme_define_values_type: e = SCHEME_VEC_ELS(e)[0]; break; + case scheme_inline_variant_type: + e = SCHEME_VEC_ELS(e)[0]; + break; default: return 1; } @@ -7082,7 +7090,7 @@ static Scheme_Object *do_module_begin_at_phase(Scheme_Object *form, Scheme_Comp_ if (!for_stx) 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); if (!(rec[drec].comp_flags & COMP_CAN_INLINE)) scheme_optimize_info_never_inline(oi); diff --git a/src/racket/src/mzmark_optimize.inc b/src/racket/src/mzmark_optimize.inc index ac8e290f75..0c1fd16d7e 100644 --- a/src/racket/src/mzmark_optimize.inc +++ b/src/racket/src/mzmark_optimize.inc @@ -13,6 +13,7 @@ static int mark_optimize_info_MARK(void *p, struct NewGC *gc) { gcMARK2(i->next, gc); gcMARK2(i->use, gc); gcMARK2(i->consts, gc); + gcMARK2(i->cp, gc); gcMARK2(i->top_level_consts, gc); gcMARK2(i->transitive_use, 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->use, gc); gcFIXUP2(i->consts, gc); + gcFIXUP2(i->cp, gc); gcFIXUP2(i->top_level_consts, gc); gcFIXUP2(i->transitive_use, gc); gcFIXUP2(i->transitive_use_len, gc); diff --git a/src/racket/src/mzmark_resolve.inc b/src/racket/src/mzmark_resolve.inc index 97ec17850f..5157314d1e 100644 --- a/src/racket/src/mzmark_resolve.inc +++ b/src/racket/src/mzmark_resolve.inc @@ -45,3 +45,34 @@ static int mark_resolve_info_FIXUP(void *p, struct NewGC *gc) { #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 + + diff --git a/src/racket/src/mzmark_type.inc b/src/racket/src/mzmark_type.inc index d724ef73fb..0c420e511c 100644 --- a/src/racket/src/mzmark_type.inc +++ b/src/racket/src/mzmark_type.inc @@ -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) { Comp_Prefix *cp = (Comp_Prefix *)p; gcMARK2(cp->toplevels, gc); + gcMARK2(cp->inline_variants, gc); gcMARK2(cp->unbound, gc); gcMARK2(cp->stxes, 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) { Comp_Prefix *cp = (Comp_Prefix *)p; gcFIXUP2(cp->toplevels, gc); + gcFIXUP2(cp->inline_variants, gc); gcFIXUP2(cp->unbound, gc); gcFIXUP2(cp->stxes, gc); gcFIXUP2(cp->uses_unsafe, gc); diff --git a/src/racket/src/mzmarksrc.c b/src/racket/src/mzmarksrc.c index 1fd733b215..89d63b70d7 100644 --- a/src/racket/src/mzmarksrc.c +++ b/src/racket/src/mzmarksrc.c @@ -958,6 +958,7 @@ comp_prefix_val { mark: Comp_Prefix *cp = (Comp_Prefix *)p; gcMARK2(cp->toplevels, gc); + gcMARK2(cp->inline_variants, gc); gcMARK2(cp->unbound, gc); gcMARK2(cp->stxes, gc); gcMARK2(cp->uses_unsafe, gc); @@ -1232,6 +1233,18 @@ mark_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; /**********************************************************************/ @@ -1265,6 +1278,7 @@ mark_optimize_info { gcMARK2(i->next, gc); gcMARK2(i->use, gc); gcMARK2(i->consts, gc); + gcMARK2(i->cp, gc); gcMARK2(i->top_level_consts, gc); gcMARK2(i->transitive_use, gc); gcMARK2(i->transitive_use_len, gc); diff --git a/src/racket/src/optimize.c b/src/racket/src/optimize.c index 136b9f654b..9d80bd91ac 100644 --- a/src/racket/src/optimize.c +++ b/src/racket/src/optimize.c @@ -41,6 +41,7 @@ #define OPT_DELAY_GROUP_PROPAGATE 0 #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) @@ -51,6 +52,7 @@ struct Optimize_Info struct Optimize_Info *next; int original_frame, new_frame; Scheme_Object *consts; + Comp_Prefix *cp; /* Propagated up and down the chain: */ 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) \ || 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 { 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)) || (vtype == scheme_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_quote_syntax_type) @@ -953,10 +956,25 @@ Scheme_Object *optimize_for_inline(Optimize_Info *info, Scheme_Object *le, int a if (le) { while (SAME_TYPE(SCHEME_TYPE(le), scheme_compiled_toplevel_type)) { + int pos; + pos = SCHEME_TOPLEVEL_POS(le); 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) { - int pos; - pos = SCHEME_TOPLEVEL_POS(le); le = scheme_hash_get(info->top_level_consts, scheme_make_integer(pos)); if (le && SCHEME_BOXP(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_INTP(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) /* Values that are hashed by the printer and/or interned on 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]; - einfo = scheme_optimize_info_create(); + einfo = scheme_optimize_info_create(info->cp); if (info->inline_fuel < 0) 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]; while (!SCHEME_NULLP(l)) { - einfo = scheme_optimize_info_create(); + einfo = scheme_optimize_info_create(info->cp); if (info->inline_fuel < 0) einfo->inline_fuel = -1; @@ -3411,15 +3429,24 @@ static int set_code_flags(Scheme_Compiled_Let_Value *retry_start, 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)) - return closure_body_size((Scheme_Closure_Data *)o, 0, NULL, NULL); - else if (SAME_TYPE(SCHEME_TYPE(o), scheme_case_lambda_sequence_type)) { + int bsz; + + 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; int i, sz = 0; 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; } else @@ -3428,7 +3455,7 @@ static int compiled_proc_body_size(Scheme_Object *o) 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) @@ -4014,7 +4041,7 @@ scheme_optimize_lets(Scheme_Object *form, Optimize_Info *info, int for_inline, i self_value = SCHEME_CDR(cl_first); /* 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); /* 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: */ int new_sz; 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 new_sz = 0; if (new_sz <= sz) @@ -4550,6 +4577,16 @@ static int set_code_closure_flags(Scheme_Object *clones, 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 * 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; int start_simltaneous = 0, i_m, cnt; 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; + Comp_Prefix *prev_cp; old_context = info->context; info->context = (Scheme_Object *)m; + prev_cp = info->cp; + info->cp = m->comp_prefix; + cnt = SCHEME_VEC_SIZE(m->bodies[0]); 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)) { Scheme_Object *sub_e; 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 old_sz = 0; } else @@ -4784,13 +4825,21 @@ module_optimize(Scheme_Object *data, Optimize_Info *info, int context) Scheme_Object *rpos; rpos = scheme_hash_get(re_consts, scheme_make_integer(start_simltaneous)); if (rpos) { + Scheme_Object *old_e; + 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) && scheme_is_statically_proc(e, info)) { /* If we previously installed a procedure for inlining, 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)) e = NULL; else @@ -4799,7 +4848,7 @@ module_optimize(Scheme_Object *data, Optimize_Info *info, int context) if (e) { 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 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: */ { int can_omit = 0; @@ -4873,9 +4951,11 @@ module_optimize(Scheme_Object *data, Optimize_Info *info, int context) } m->bodies[0] = vec; } + cnt -= can_omit; } info->context = old_context; + info->cp = prev_cp; /* 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 */ /*========================================================================*/ -Optimize_Info *scheme_optimize_info_create() +Optimize_Info *scheme_optimize_info_create(Comp_Prefix *cp) { Optimize_Info *info; @@ -5467,6 +5547,7 @@ Optimize_Info *scheme_optimize_info_create() info->type = scheme_rt_optimize_info; #endif info->inline_fuel = 32; + info->cp = cp; return info; } @@ -5990,7 +6071,7 @@ static Optimize_Info *optimize_info_add_frame(Optimize_Info *info, int orig, int { Optimize_Info *naya; - naya = scheme_optimize_info_create(); + naya = scheme_optimize_info_create(info->cp); naya->flags = (short)flags; naya->next = info; naya->original_frame = orig; diff --git a/src/racket/src/read.c b/src/racket/src/read.c index c080820ce6..888ff6e1f2 100644 --- a/src/racket/src/read.c +++ b/src/racket/src/read.c @@ -3103,7 +3103,7 @@ read_here_string(Scheme_Object *port, Scheme_Object *stxsrc, if (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); @@ -4361,7 +4361,7 @@ static Scheme_Object *read_compact(CPort *port, int use_stack) break; case CPT_CHAR: l = read_compact_number(port); - return scheme_make_character(l); + return make_interned_char(l); break; case CPT_INT: return scheme_make_integer(read_compact_number(port)); diff --git a/src/racket/src/resolve.c b/src/racket/src/resolve.c index fbe0949ca5..ee98eabe1c 100644 --- a/src/racket/src/resolve.c +++ b/src/racket/src/resolve.c @@ -622,6 +622,22 @@ static void resolve_lift_definition(Resolve_Info *info, Scheme_Object *var, Sche 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 * 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; case scheme_define_values_type: return define_values_resolve(expr, info); + case scheme_inline_variant_type: + return inline_variant_resolve(expr, info); case scheme_define_syntaxes_type: return define_syntaxes_resolve(expr, info); case scheme_begin_for_syntax_type: @@ -2983,6 +3001,338 @@ static int resolving_in_procedure(Resolve_Info *info) 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 */ /*========================================================================*/ @@ -2996,6 +3346,7 @@ START_XFORM_SKIP; static void register_traversers(void) { GC_REG_TRAV(scheme_rt_resolve_info, mark_resolve_info); + GC_REG_TRAV(scheme_rt_unresolve_info, mark_unresolve_info); } END_XFORM_SKIP; diff --git a/src/racket/src/schpriv.h b/src/racket/src/schpriv.h index 88b03a8970..cf24e1e149 100644 --- a/src/racket/src/schpriv.h +++ b/src/racket/src/schpriv.h @@ -2163,6 +2163,7 @@ typedef struct Comp_Prefix MZTAG_IF_REQUIRED int num_toplevels, num_stxes; 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_Hash_Table *stxes; /* syntax objects */ 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 *in_modidx, 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); 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_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); Scheme_Object *scheme_register_stx_in_prefix(Scheme_Object *var, Scheme_Comp_Env *env, 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_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); @@ -2618,7 +2623,7 @@ int scheme_resolve_info_use_jit(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); -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_set_context(Optimize_Info *, Scheme_Object *ctx); void scheme_optimize_info_never_inline(Optimize_Info *); diff --git a/src/racket/src/schvers.h b/src/racket/src/schvers.h index 6f539b375c..0b8caa2f19 100644 --- a/src/racket/src/schvers.h +++ b/src/racket/src/schvers.h @@ -13,12 +13,12 @@ consistently.) */ -#define MZSCHEME_VERSION "5.2.0.4" +#define MZSCHEME_VERSION "5.2.0.5" #define MZSCHEME_VERSION_X 5 #define MZSCHEME_VERSION_Y 2 #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_MINOR ((MZSCHEME_VERSION_Z * 1000) + MZSCHEME_VERSION_W) diff --git a/src/racket/src/sfs.c b/src/racket/src/sfs.c index cc62b7c9d4..ffd97a39c9 100644 --- a/src/racket/src/sfs.c +++ b/src/racket/src/sfs.c @@ -781,6 +781,17 @@ define_values_sfs(Scheme_Object *data, SFS_Info *info) 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 * 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: expr = module_sfs(expr, info); break; + case scheme_inline_variant_type: + expr = inline_variant_sfs(expr, info); + break; default: break; } diff --git a/src/racket/src/stypes.h b/src/racket/src/stypes.h index 137395349c..cbe8a3d52c 100644 --- a/src/racket/src/stypes.h +++ b/src/racket/src/stypes.h @@ -30,248 +30,250 @@ enum { scheme_apply_values_type, /* 24 */ scheme_case_lambda_sequence_type, /* 25 */ scheme_module_type, /* 26 */ + scheme_inline_variant_type, /* 27 */ _scheme_values_types_, /* All following types are values */ /* intermediate compiled: */ - scheme_compiled_unclosed_procedure_type,/* 28 */ - scheme_compiled_let_value_type, /* 29 */ - scheme_compiled_let_void_type, /* 30 */ - scheme_compiled_toplevel_type, /* 31 */ - scheme_compiled_quote_syntax_type, /* 32 */ + scheme_compiled_unclosed_procedure_type,/* 29 */ + scheme_compiled_let_value_type, /* 30 */ + scheme_compiled_let_void_type, /* 31 */ + scheme_compiled_toplevel_type, /* 32 */ + scheme_compiled_quote_syntax_type, /* 33 */ scheme_quote_compilation_type, /* used while writing, only */ /* Registered in prefix table: */ - scheme_variable_type, /* 34 */ + scheme_variable_type, /* 35 */ scheme_module_variable_type, /* link replaces with scheme_variable_type */ - _scheme_compiled_values_types_, /* 36 */ + _scheme_compiled_values_types_, /* 37 */ /* procedure types */ - scheme_prim_type, /* 37 */ - scheme_closed_prim_type, /* 38 */ - scheme_closure_type, /* 39 */ - scheme_case_closure_type, /* 40 */ - scheme_cont_type, /* 41 */ - scheme_escaping_cont_type, /* 42 */ - scheme_proc_struct_type, /* 43 */ - scheme_native_closure_type, /* 44 */ - scheme_proc_chaperone_type, /* 45 */ + scheme_prim_type, /* 38 */ + scheme_closed_prim_type, /* 39 */ + scheme_closure_type, /* 40 */ + scheme_case_closure_type, /* 41 */ + scheme_cont_type, /* 42 */ + scheme_escaping_cont_type, /* 43 */ + scheme_proc_struct_type, /* 44 */ + scheme_native_closure_type, /* 45 */ + scheme_proc_chaperone_type, /* 46 */ - scheme_chaperone_type, /* 46 */ + scheme_chaperone_type, /* 47 */ /* structure type (plus one above for procs) */ - scheme_structure_type, /* 47 */ + scheme_structure_type, /* 48 */ /* basic types */ - scheme_char_type, /* 48 */ - scheme_integer_type, /* 49 */ - scheme_bignum_type, /* 50 */ - scheme_rational_type, /* 51 */ - scheme_float_type, /* 52 */ - scheme_double_type, /* 53 */ - scheme_complex_type, /* 54 */ - scheme_char_string_type, /* 55 */ - scheme_byte_string_type, /* 56 */ - scheme_unix_path_type, /* 57 */ - scheme_windows_path_type, /* 58 */ - scheme_symbol_type, /* 59 */ - scheme_keyword_type, /* 60 */ - scheme_null_type, /* 61 */ - scheme_pair_type, /* 62 */ - scheme_mutable_pair_type, /* 63 */ - scheme_vector_type, /* 64 */ - scheme_inspector_type, /* 65 */ - scheme_input_port_type, /* 66 */ - scheme_output_port_type, /* 67 */ - scheme_eof_type, /* 68 */ - scheme_true_type, /* 69 */ - scheme_false_type, /* 70 */ - scheme_void_type, /* 71 */ - scheme_syntax_compiler_type, /* 72 */ - scheme_macro_type, /* 73 */ - scheme_box_type, /* 74 */ - scheme_thread_type, /* 75 */ - scheme_stx_offset_type, /* 76 */ - scheme_cont_mark_set_type, /* 77 */ - scheme_sema_type, /* 78 */ - scheme_hash_table_type, /* 79 */ - scheme_hash_tree_type, /* 80 */ - scheme_cpointer_type, /* 81 */ - scheme_prefix_type, /* 82 */ - scheme_weak_box_type, /* 83 */ - scheme_ephemeron_type, /* 84 */ - scheme_struct_type_type, /* 85 */ - scheme_module_index_type, /* 86 */ - scheme_set_macro_type, /* 87 */ - scheme_listener_type, /* 88 */ - scheme_namespace_type, /* 89 */ - scheme_config_type, /* 90 */ - scheme_stx_type, /* 91 */ - scheme_will_executor_type, /* 92 */ - scheme_custodian_type, /* 93 */ - scheme_random_state_type, /* 94 */ - scheme_regexp_type, /* 95 */ - scheme_bucket_type, /* 96 */ - scheme_bucket_table_type, /* 97 */ - scheme_subprocess_type, /* 98 */ - scheme_compilation_top_type, /* 99 */ - scheme_wrap_chunk_type, /* 100 */ - scheme_eval_waiting_type, /* 101 */ - scheme_tail_call_waiting_type, /* 102 */ - scheme_undefined_type, /* 103 */ - scheme_struct_property_type, /* 104 */ - scheme_chaperone_property_type, /* 105 */ - scheme_multiple_values_type, /* 106 */ - scheme_placeholder_type, /* 107 */ - scheme_table_placeholder_type, /* 108 */ - scheme_rename_table_type, /* 109 */ - scheme_rename_table_set_type, /* 110 */ - scheme_svector_type, /* 111 */ - scheme_resolve_prefix_type, /* 112 */ - scheme_security_guard_type, /* 113 */ - scheme_indent_type, /* 114 */ - scheme_udp_type, /* 115 */ - scheme_udp_evt_type, /* 116 */ - scheme_tcp_accept_evt_type, /* 117 */ - scheme_id_macro_type, /* 118 */ - scheme_evt_set_type, /* 119 */ - scheme_wrap_evt_type, /* 120 */ - scheme_handle_evt_type, /* 121 */ - scheme_nack_guard_evt_type, /* 122 */ - scheme_semaphore_repost_type, /* 123 */ - scheme_channel_type, /* 124 */ - scheme_channel_put_type, /* 125 */ - scheme_thread_resume_type, /* 126 */ - scheme_thread_suspend_type, /* 127 */ - scheme_thread_dead_type, /* 128 */ - scheme_poll_evt_type, /* 129 */ - scheme_nack_evt_type, /* 130 */ - scheme_module_registry_type, /* 131 */ - scheme_thread_set_type, /* 132 */ - scheme_string_converter_type, /* 133 */ - scheme_alarm_type, /* 134 */ - scheme_thread_recv_evt_type, /* 135 */ - scheme_thread_cell_type, /* 136 */ - scheme_channel_syncer_type, /* 137 */ - scheme_special_comment_type, /* 138 */ - scheme_write_evt_type, /* 139 */ - scheme_always_evt_type, /* 140 */ - scheme_never_evt_type, /* 141 */ - scheme_progress_evt_type, /* 142 */ - scheme_place_dead_type, /* 143 */ - scheme_already_comp_type, /* 144 */ - scheme_readtable_type, /* 145 */ - scheme_intdef_context_type, /* 146 */ - scheme_lexical_rib_type, /* 147 */ - scheme_thread_cell_values_type, /* 148 */ - scheme_global_ref_type, /* 149 */ - scheme_cont_mark_chain_type, /* 150 */ - scheme_raw_pair_type, /* 151 */ - scheme_prompt_type, /* 152 */ - scheme_prompt_tag_type, /* 153 */ - scheme_expanded_syntax_type, /* 154 */ - scheme_delay_syntax_type, /* 155 */ - scheme_cust_box_type, /* 156 */ - scheme_resolved_module_path_type, /* 157 */ - scheme_module_phase_exports_type, /* 158 */ - scheme_logger_type, /* 159 */ - scheme_log_reader_type, /* 160 */ - scheme_free_id_info_type, /* 161 */ - scheme_rib_delimiter_type, /* 162 */ - scheme_noninline_proc_type, /* 163 */ - scheme_prune_context_type, /* 164 */ - scheme_future_type, /* 165 */ - scheme_flvector_type, /* 166 */ - scheme_fxvector_type, /* 167 */ - scheme_place_type, /* 168 */ - scheme_place_object_type, /* 169 */ - scheme_place_async_channel_type, /* 170 */ - scheme_place_bi_channel_type, /* 171 */ - scheme_once_used_type, /* 172 */ - scheme_serialized_symbol_type, /* 173 */ - scheme_serialized_structure_type, /* 174 */ - scheme_fsemaphore_type, /* 175 */ - scheme_serialized_tcp_fd_type, /* 176 */ - scheme_serialized_file_fd_type, /* 177 */ - scheme_port_closed_evt_type, /* 178 */ + scheme_char_type, /* 49 */ + scheme_integer_type, /* 50 */ + scheme_bignum_type, /* 51 */ + scheme_rational_type, /* 52 */ + scheme_float_type, /* 53 */ + scheme_double_type, /* 54 */ + scheme_complex_type, /* 55 */ + scheme_char_string_type, /* 56 */ + scheme_byte_string_type, /* 57 */ + scheme_unix_path_type, /* 58 */ + scheme_windows_path_type, /* 59 */ + scheme_symbol_type, /* 60 */ + scheme_keyword_type, /* 61 */ + scheme_null_type, /* 62 */ + scheme_pair_type, /* 63 */ + scheme_mutable_pair_type, /* 64 */ + scheme_vector_type, /* 65 */ + scheme_inspector_type, /* 66 */ + scheme_input_port_type, /* 67 */ + scheme_output_port_type, /* 68 */ + scheme_eof_type, /* 69 */ + scheme_true_type, /* 70 */ + scheme_false_type, /* 71 */ + scheme_void_type, /* 72 */ + scheme_syntax_compiler_type, /* 73 */ + scheme_macro_type, /* 74 */ + scheme_box_type, /* 75 */ + scheme_thread_type, /* 76 */ + scheme_stx_offset_type, /* 77 */ + scheme_cont_mark_set_type, /* 78 */ + scheme_sema_type, /* 79 */ + scheme_hash_table_type, /* 80 */ + scheme_hash_tree_type, /* 81 */ + scheme_cpointer_type, /* 82 */ + scheme_prefix_type, /* 83 */ + scheme_weak_box_type, /* 84 */ + scheme_ephemeron_type, /* 85 */ + scheme_struct_type_type, /* 86 */ + scheme_module_index_type, /* 87 */ + scheme_set_macro_type, /* 88 */ + scheme_listener_type, /* 89 */ + scheme_namespace_type, /* 90 */ + scheme_config_type, /* 91 */ + scheme_stx_type, /* 92 */ + scheme_will_executor_type, /* 93 */ + scheme_custodian_type, /* 94 */ + scheme_random_state_type, /* 95 */ + scheme_regexp_type, /* 96 */ + scheme_bucket_type, /* 97 */ + scheme_bucket_table_type, /* 98 */ + scheme_subprocess_type, /* 99 */ + scheme_compilation_top_type, /* 100 */ + scheme_wrap_chunk_type, /* 101 */ + scheme_eval_waiting_type, /* 102 */ + scheme_tail_call_waiting_type, /* 103 */ + scheme_undefined_type, /* 104 */ + scheme_struct_property_type, /* 105 */ + scheme_chaperone_property_type, /* 106 */ + scheme_multiple_values_type, /* 107 */ + scheme_placeholder_type, /* 108 */ + scheme_table_placeholder_type, /* 109 */ + scheme_rename_table_type, /* 110 */ + scheme_rename_table_set_type, /* 111 */ + scheme_svector_type, /* 112 */ + scheme_resolve_prefix_type, /* 113 */ + scheme_security_guard_type, /* 114 */ + scheme_indent_type, /* 115 */ + scheme_udp_type, /* 116 */ + scheme_udp_evt_type, /* 117 */ + scheme_tcp_accept_evt_type, /* 118 */ + scheme_id_macro_type, /* 119 */ + scheme_evt_set_type, /* 120 */ + scheme_wrap_evt_type, /* 121 */ + scheme_handle_evt_type, /* 122 */ + scheme_nack_guard_evt_type, /* 123 */ + scheme_semaphore_repost_type, /* 124 */ + scheme_channel_type, /* 125 */ + scheme_channel_put_type, /* 126 */ + scheme_thread_resume_type, /* 127 */ + scheme_thread_suspend_type, /* 128 */ + scheme_thread_dead_type, /* 129 */ + scheme_poll_evt_type, /* 130 */ + scheme_nack_evt_type, /* 131 */ + scheme_module_registry_type, /* 132 */ + scheme_thread_set_type, /* 133 */ + scheme_string_converter_type, /* 134 */ + scheme_alarm_type, /* 135 */ + scheme_thread_recv_evt_type, /* 136 */ + scheme_thread_cell_type, /* 137 */ + scheme_channel_syncer_type, /* 138 */ + scheme_special_comment_type, /* 139 */ + scheme_write_evt_type, /* 140 */ + scheme_always_evt_type, /* 141 */ + scheme_never_evt_type, /* 142 */ + scheme_progress_evt_type, /* 143 */ + scheme_place_dead_type, /* 144 */ + scheme_already_comp_type, /* 145 */ + scheme_readtable_type, /* 146 */ + scheme_intdef_context_type, /* 147 */ + scheme_lexical_rib_type, /* 148 */ + scheme_thread_cell_values_type, /* 149 */ + scheme_global_ref_type, /* 150 */ + scheme_cont_mark_chain_type, /* 151 */ + scheme_raw_pair_type, /* 152 */ + scheme_prompt_type, /* 153 */ + scheme_prompt_tag_type, /* 154 */ + scheme_expanded_syntax_type, /* 155 */ + scheme_delay_syntax_type, /* 156 */ + scheme_cust_box_type, /* 157 */ + scheme_resolved_module_path_type, /* 158 */ + scheme_module_phase_exports_type, /* 159 */ + scheme_logger_type, /* 160 */ + scheme_log_reader_type, /* 161 */ + scheme_free_id_info_type, /* 162 */ + scheme_rib_delimiter_type, /* 163 */ + scheme_noninline_proc_type, /* 164 */ + scheme_prune_context_type, /* 165 */ + scheme_future_type, /* 166 */ + scheme_flvector_type, /* 167 */ + scheme_fxvector_type, /* 168 */ + scheme_place_type, /* 169 */ + scheme_place_object_type, /* 170 */ + scheme_place_async_channel_type, /* 171 */ + scheme_place_bi_channel_type, /* 172 */ + scheme_once_used_type, /* 173 */ + scheme_serialized_symbol_type, /* 174 */ + scheme_serialized_structure_type, /* 175 */ + scheme_fsemaphore_type, /* 176 */ + scheme_serialized_tcp_fd_type, /* 177 */ + scheme_serialized_file_fd_type, /* 178 */ + scheme_port_closed_evt_type, /* 179 */ #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_constant_binding, /* 182 */ - scheme_rt_resolve_info, /* 183 */ - scheme_rt_optimize_info, /* 184 */ - scheme_rt_compile_info, /* 185 */ - scheme_rt_cont_mark, /* 186 */ - scheme_rt_saved_stack, /* 187 */ - scheme_rt_reply_item, /* 188 */ - scheme_rt_closure_info, /* 189 */ - scheme_rt_overflow, /* 190 */ - scheme_rt_overflow_jmp, /* 191 */ - scheme_rt_meta_cont, /* 192 */ - scheme_rt_dyn_wind_cell, /* 193 */ - scheme_rt_dyn_wind_info, /* 194 */ - scheme_rt_dyn_wind, /* 195 */ - scheme_rt_dup_check, /* 196 */ - scheme_rt_thread_memory, /* 197 */ - scheme_rt_input_file, /* 198 */ - scheme_rt_input_fd, /* 199 */ - scheme_rt_oskit_console_input, /* 200 */ - scheme_rt_tested_input_file, /* 201 */ - scheme_rt_tested_output_file, /* 202 */ - scheme_rt_indexed_string, /* 203 */ - scheme_rt_output_file, /* 204 */ - scheme_rt_load_handler_data, /* 205 */ - scheme_rt_pipe, /* 206 */ - scheme_rt_beos_process, /* 207 */ - scheme_rt_system_child, /* 208 */ - scheme_rt_tcp, /* 209 */ - scheme_rt_write_data, /* 210 */ - scheme_rt_tcp_select_info, /* 211 */ - scheme_rt_param_data, /* 212 */ - scheme_rt_will, /* 213 */ - scheme_rt_struct_proc_info, /* 214 */ - scheme_rt_linker_name, /* 215 */ - scheme_rt_param_map, /* 216 */ - scheme_rt_finalization, /* 217 */ - scheme_rt_finalizations, /* 218 */ - scheme_rt_cpp_object, /* 219 */ - scheme_rt_cpp_array_object, /* 220 */ - scheme_rt_stack_object, /* 221 */ - scheme_rt_preallocated_object, /* 222 */ - scheme_thread_hop_type, /* 223 */ - scheme_rt_srcloc, /* 224 */ - scheme_rt_evt, /* 225 */ - scheme_rt_syncing, /* 226 */ - scheme_rt_comp_prefix, /* 227 */ - scheme_rt_user_input, /* 228 */ - scheme_rt_user_output, /* 229 */ - scheme_rt_compact_port, /* 230 */ - scheme_rt_read_special_dw, /* 231 */ - scheme_rt_regwork, /* 232 */ - scheme_rt_rx_lazy_string, /* 233 */ - scheme_rt_buf_holder, /* 234 */ - scheme_rt_parameterization, /* 235 */ - scheme_rt_print_params, /* 236 */ - scheme_rt_read_params, /* 237 */ - scheme_rt_native_code, /* 238 */ - scheme_rt_native_code_plus_case, /* 239 */ - scheme_rt_jitter_data, /* 240 */ - scheme_rt_module_exports, /* 241 */ - scheme_rt_delay_load_info, /* 242 */ - scheme_rt_marshal_info, /* 243 */ - scheme_rt_unmarshal_info, /* 244 */ - scheme_rt_runstack, /* 245 */ - scheme_rt_sfs_info, /* 246 */ - scheme_rt_validate_clearing, /* 247 */ - scheme_rt_rb_node, /* 248 */ - scheme_rt_lightweight_cont, /* 249 */ - scheme_rt_export_info, /* 250 */ + scheme_rt_comp_env, /* 182 */ + scheme_rt_constant_binding, /* 183 */ + scheme_rt_resolve_info, /* 184 */ + scheme_rt_unresolve_info, /* 185 */ + scheme_rt_optimize_info, /* 186 */ + scheme_rt_compile_info, /* 187 */ + scheme_rt_cont_mark, /* 188 */ + scheme_rt_saved_stack, /* 189 */ + scheme_rt_reply_item, /* 190 */ + scheme_rt_closure_info, /* 191 */ + scheme_rt_overflow, /* 192 */ + scheme_rt_overflow_jmp, /* 193 */ + scheme_rt_meta_cont, /* 194 */ + scheme_rt_dyn_wind_cell, /* 195 */ + scheme_rt_dyn_wind_info, /* 196 */ + scheme_rt_dyn_wind, /* 197 */ + scheme_rt_dup_check, /* 198 */ + scheme_rt_thread_memory, /* 199 */ + scheme_rt_input_file, /* 200 */ + scheme_rt_input_fd, /* 201 */ + scheme_rt_oskit_console_input, /* 202 */ + scheme_rt_tested_input_file, /* 203 */ + scheme_rt_tested_output_file, /* 204 */ + scheme_rt_indexed_string, /* 205 */ + scheme_rt_output_file, /* 206 */ + scheme_rt_load_handler_data, /* 207 */ + scheme_rt_pipe, /* 208 */ + scheme_rt_beos_process, /* 209 */ + scheme_rt_system_child, /* 210 */ + scheme_rt_tcp, /* 211 */ + scheme_rt_write_data, /* 212 */ + scheme_rt_tcp_select_info, /* 213 */ + scheme_rt_param_data, /* 214 */ + scheme_rt_will, /* 215 */ + scheme_rt_struct_proc_info, /* 216 */ + scheme_rt_linker_name, /* 217 */ + scheme_rt_param_map, /* 218 */ + scheme_rt_finalization, /* 219 */ + scheme_rt_finalizations, /* 220 */ + scheme_rt_cpp_object, /* 221 */ + scheme_rt_cpp_array_object, /* 222 */ + scheme_rt_stack_object, /* 223 */ + scheme_rt_preallocated_object, /* 224 */ + scheme_thread_hop_type, /* 225 */ + scheme_rt_srcloc, /* 226 */ + scheme_rt_evt, /* 227 */ + scheme_rt_syncing, /* 228 */ + scheme_rt_comp_prefix, /* 229 */ + scheme_rt_user_input, /* 230 */ + scheme_rt_user_output, /* 231 */ + scheme_rt_compact_port, /* 232 */ + scheme_rt_read_special_dw, /* 233 */ + scheme_rt_regwork, /* 234 */ + scheme_rt_rx_lazy_string, /* 235 */ + scheme_rt_buf_holder, /* 236 */ + scheme_rt_parameterization, /* 237 */ + scheme_rt_print_params, /* 238 */ + scheme_rt_read_params, /* 239 */ + scheme_rt_native_code, /* 240 */ + scheme_rt_native_code_plus_case, /* 241 */ + scheme_rt_jitter_data, /* 242 */ + scheme_rt_module_exports, /* 243 */ + scheme_rt_delay_load_info, /* 244 */ + scheme_rt_marshal_info, /* 245 */ + scheme_rt_unmarshal_info, /* 246 */ + scheme_rt_runstack, /* 247 */ + scheme_rt_sfs_info, /* 248 */ + scheme_rt_validate_clearing, /* 249 */ + scheme_rt_rb_node, /* 250 */ + scheme_rt_lightweight_cont, /* 251 */ + scheme_rt_export_info, /* 252 */ #endif _scheme_last_type_ diff --git a/src/racket/src/syntax.c b/src/racket/src/syntax.c index d8112ad462..48d74efc41 100644 --- a/src/racket/src/syntax.c +++ b/src/racket/src/syntax.c @@ -4261,6 +4261,8 @@ static Scheme_Object *resolve_env(Scheme_Object *a, Scheme_Object *orig_phase, } else if (SCHEME_PRUNEP(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 */ + if (_depends_on_unsealed_rib) + *_depends_on_unsealed_rib = depends_on_unsealed_rib; 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. Give up on the "fast" traversal. */ Scheme_Object *modname, *names[7]; - int rib_dep; + int rib_dep = 0; names[0] = NULL; names[1] = NULL; diff --git a/src/racket/src/type.c b/src/racket/src/type.c index fa8a272ff6..0ec9d0f7be 100644 --- a/src/racket/src/type.c +++ b/src/racket/src/type.c @@ -562,6 +562,7 @@ void scheme_register_traversers(void) GC_REG_TRAV(scheme_module_type, module_val); GC_REG_TRAV(scheme_rt_export_info, exp_info_val); 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); diff --git a/src/racket/src/validate.c b/src/racket/src/validate.c index d1e7ecb1db..f9904a1bb7 100644 --- a/src/racket/src/validate.c +++ b/src/racket/src/validate.c @@ -346,6 +346,29 @@ static void apply_values_validate(Scheme_Object *data, Mz_CPort *port, 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, int depth, int letlimit, int delta, 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, result_ignored, vc, tailpos, procs); 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: /* All values are definitely ok, except pre-closed closures. Such a closure can refer back to itself, so we use a flag