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