diff --git a/pkgs/base/info.rkt b/pkgs/base/info.rkt index bd7c2d7fed..88c6ed0da3 100644 --- a/pkgs/base/info.rkt +++ b/pkgs/base/info.rkt @@ -12,7 +12,7 @@ (define collection 'multi) -(define version "6.90.0.22") +(define version "6.90.0.23") (define deps `("racket-lib" ["racket" #:version ,version])) diff --git a/pkgs/racket-doc/scribblings/reference/linklet.scrbl b/pkgs/racket-doc/scribblings/reference/linklet.scrbl index f124da1912..ae7aefab3d 100644 --- a/pkgs/racket-doc/scribblings/reference/linklet.scrbl +++ b/pkgs/racket-doc/scribblings/reference/linklet.scrbl @@ -120,8 +120,7 @@ otherwise.} [name any/c #f] [import-keys #f #f] [get-import #f #f] - [serializable? any/c #t] - [unsafe-mode? any/c #f]) + [options (listof (or/c 'serializable 'unsafe 'static)) '(serializable)]) linklet?] [(compile-linklet [form (or/c correlated? any/c)] [name any/c] @@ -129,13 +128,12 @@ otherwise.} [get-import (or/c #f (any/c . -> . (values (or/c linklet? instance? #f) (or/c vector? #f)))) #f] - [serializable? any/c #t] - [unsafe-mode? any/c #f]) + [options (listof (or/c 'serializable 'unsafe 'static)) '(serializable)]) (values linklet? vector?)])]{ Takes an S-expression or @tech{correlated object} for a @schemeidfont{linklet} form and produces a @tech{linklet}. -As long as @racket[serializable?] is true, the +As long as @racket['serializable] included in @racket[options], the resulting linklet can be marshaled to and from a byte stream when it is part of a @tech{linklet bundle}. @@ -171,19 +169,29 @@ linklet. The result vector specifies the keys of the imports for the returned linklet. Any key that is @racket[#f] or a @tech{linklet instance} must be preserved intact, however. -If @racket[unsafe-mode?] is true, then the linklet is compiled in -@deftech{unsafe mode}: uses of safe operations within the linklet can -be converted to unsafe operations on the assumption that the relevant -contracts are satisfied. For example, @racket[car] is converted to -@racket[unsafe-car]. Some substituted unsafe operations may not have -directly accessible names, such as the unsafe variant of -@racket[in-list] that can be substituted in @tech{unsafe mode}. An -unsafe operation is substituted only if its (unchecked) contract is -subsumed by the safe operation's contract. The fact that the linklet -is compiled in @tech{unsafe mode} can be exposed through +If @racket['unsafe] is included in @racket[options], then the linklet +is compiled in @deftech{unsafe mode}: uses of safe operations within +the linklet can be converted to unsafe operations on the assumption +that the relevant contracts are satisfied. For example, @racket[car] +is converted to @racket[unsafe-car]. Some substituted unsafe +operations may not have directly accessible names, such as the unsafe +variant of @racket[in-list] that can be substituted in @tech{unsafe +mode}. An unsafe operation is substituted only if its (unchecked) +contract is subsumed by the safe operation's contract. The fact that +the linklet is compiled in @tech{unsafe mode} can be exposed through @racket[variable-reference-from-unsafe?] using a variable reference produced by a @racket[#%variable-reference] form within the module -body.} +body. + +If @racket['static] is included in @racket[options] then the linklet +must be instantiated only once; in the linklet is serialized, then any +individual instance read from the serialized form must be instantiated +at most once. Compilation with @racket['static] is intended to improve +the performance of references within the linklet to defined and +imported variables. + +The symbols in @racket[options] must be distinct, otherwise +@exnraise[exn:fail:contract].} @defproc*[([(recompile-linklet [linklet linklet?] diff --git a/pkgs/zo-lib/compiler/zo-marshal.rkt b/pkgs/zo-lib/compiler/zo-marshal.rkt index ece6a8453e..95124a9c48 100644 --- a/pkgs/zo-lib/compiler/zo-marshal.rkt +++ b/pkgs/zo-lib/compiler/zo-marshal.rkt @@ -257,22 +257,22 @@ ;; ---------------------------------------- (define toplevel-type-num 0) -(define sequence-type-num 6) -(define unclosed-procedure-type-num 8) -(define let-value-type-num 9) -(define let-void-type-num 10) -(define letrec-type-num 11) -(define wcm-type-num 13) -(define define-values-type-num 14) -(define set-bang-type-num 15) -(define boxenv-type-num 16) -(define begin0-sequence-type-num 17) -(define varref-form-type-num 18) -(define apply-values-type-num 19) -(define with-immed-mark-type-num 20) -(define case-lambda-sequence-type-num 21) -(define inline-variants-type-num 22) -(define linklet-type-num 24) +(define sequence-type-num 7) +(define unclosed-procedure-type-num 9) +(define let-value-type-num 10) +(define let-void-type-num 11) +(define letrec-type-num 12) +(define wcm-type-num 14) +(define define-values-type-num 15) +(define set-bang-type-num 16) +(define boxenv-type-num 17) +(define begin0-sequence-type-num 18) +(define varref-form-type-num 19) +(define apply-values-type-num 20) +(define with-immed-mark-type-num 21) +(define case-lambda-sequence-type-num 22) +(define inline-variants-type-num 23) +(define linklet-type-num 25) (define-syntax define-enum (syntax-rules () diff --git a/pkgs/zo-lib/compiler/zo-parse.rkt b/pkgs/zo-lib/compiler/zo-parse.rkt index 8370851c58..b6d0402d20 100644 --- a/pkgs/zo-lib/compiler/zo-parse.rkt +++ b/pkgs/zo-lib/compiler/zo-parse.rkt @@ -190,22 +190,24 @@ (define (int->type i) (case i [(0) 'toplevel-type] - [(6) 'sequence-type] - [(8) 'unclosed-procedure-type] - [(9) 'let-value-type] - [(10) 'let-void-type] - [(11) 'letrec-type] - [(13) 'with-cont-mark-type] - [(14) 'define-values-type] - [(15) 'set-bang-type] - [(16) 'boxenv-type] - [(17) 'begin0-sequence-type] - [(18) 'varref-form-type] - [(19) 'apply-values-type] - [(20) 'with-immed-mark-type] - [(21) 'case-lambda-sequence-type] - [(22) 'inline-variant-type] - [(24) 'linklet-type] + [(1) 'static-toplevel-type] + [(7) 'sequence-type] + [(9) 'unclosed-procedure-type] + [(10) 'let-value-type] + [(11) 'let-void-type] + [(12) 'letrec-type] + [(14) 'with-cont-mark-type] + [(15) 'define-values-type] + [(16) 'set-bang-type] + [(17) 'boxenv-type] + [(18) 'begin0-sequence-type] + [(19) 'varref-form-type] + [(20) 'apply-values-type] + [(21) 'with-immed-mark-type] + [(22) 'case-lambda-sequence-type] + [(23) 'inline-variant-type] + [(25) 'linklet-type] + [(89) 'prefix-type] [else (error 'int->type "unknown type: ~e" i)])) ;; ---------------------------------------- @@ -477,8 +479,8 @@ (vector->immutable-vector (list->vector lst)))] [(pair) (let* ([a (read-compact cp)] - [d (read-compact cp)]) - (cons a d))] + [d (read-compact cp)]) + (cons a d))] [(list) (let ([len (read-compact-number cp)]) (let loop ([i len]) @@ -503,6 +505,9 @@ (cons (read-compact cp) (read-compact cp)))))] [(linklet) + (unless (zero? (read-compact-number cp)) + ;; read and ignore the static-prefix placeholder + (read-compact cp)) (read-linklet (read-compact cp))] [(local local-unbox) (let ([c (read-compact-number cp)] @@ -642,6 +647,13 @@ [(other-form) (define type (read-compact-number cp)) (case (int->type type) + [(static-toplevel-type) + (begin0 + (read-toplevel (read-compact-number cp) (read-compact-number cp) 0) + ;; read and discard the prefix identity: + (read-compact cp))] + [(prefix-type) + (read-compact-number cp)] [(boxenv-type) (make-boxenv (read-compact cp) (read-compact cp))] [(with-immed-mark-type) diff --git a/racket/src/expander/compile/form.rkt b/racket/src/expander/compile/form.rkt index e4de3363ab..3e7e72b0d4 100644 --- a/racket/src/expander/compile/form.rkt +++ b/racket/src/expander/compile/form.rkt @@ -252,7 +252,7 @@ ((if to-source? (lambda (l name keys getter) (values l keys)) (lambda (l name keys getter) - (compile-linklet l name keys getter serializable?))) + (compile-linklet l name keys getter (if serializable? '(serializable) '())))) `(linklet ;; imports (,@body-imports diff --git a/racket/src/expander/compile/module.rkt b/racket/src/expander/compile/module.rkt index 00638b9cd0..1644aea9f8 100644 --- a/racket/src/expander/compile/module.rkt +++ b/racket/src/expander/compile/module.rkt @@ -227,7 +227,7 @@ empty-syntax-literals-data-instance empty-instance-instance) (lambda (inst) (values inst #f)) - serializable?)) + (if serializable? '(serializable) '()))) linklet))) `(linklet ;; imports diff --git a/racket/src/expander/run/linklet.rkt b/racket/src/expander/run/linklet.rkt index e9d66e8109..de4d56857e 100644 --- a/racket/src/expander/run/linklet.rkt +++ b/racket/src/expander/run/linklet.rkt @@ -301,7 +301,7 @@ (define linklet-compile-to-s-expr (make-parameter #f)) ;; Compile to a serializable form -(define (compile-linklet c [name #f] [import-keys #f] [get-import (lambda (key) (values #f #f))] [serializable? #t]) +(define (compile-linklet c [name #f] [import-keys #f] [get-import (lambda (key) (values #f #f))] [options '(serializable)]) (define l (cond [(linklet-compile-to-s-expr) diff --git a/racket/src/racket/src/compenv.c b/racket/src/racket/src/compenv.c index ef6fabd19b..8cf254913f 100644 --- a/racket/src/racket/src/compenv.c +++ b/racket/src/racket/src/compenv.c @@ -36,7 +36,6 @@ READ_ONLY static Scheme_Object *toplevels[MAX_CONST_TOPLEVEL_DEPTH][MAX_CONST_TO ROSYM static Scheme_Object *undefined_error_name_symbol; -/* If locked, these are probably sharable: */ THREAD_LOCAL_DECL(static Scheme_Hash_Table *toplevels_ht); THREAD_LOCAL_DECL(static Scheme_Hash_Table *locals_ht[2]); @@ -107,7 +106,7 @@ Scheme_Object *scheme_make_toplevel(mzshort depth, int position, int flags) tl = (Scheme_Toplevel *)scheme_malloc_atomic_tagged(sizeof(Scheme_Toplevel)); tl->iso.so.type = scheme_toplevel_type; - tl->depth = depth; + tl->u.depth = depth; tl->position = position; SCHEME_TOPLEVEL_FLAGS(tl) = flags | HIGH_BIT_TO_DISABLE_HASHING; @@ -121,8 +120,13 @@ Scheme_Object *scheme_make_toplevel(mzshort depth, int position, int flags) Scheme_Object *scheme_toplevel_to_flagged_toplevel(Scheme_Object *_tl, int flags) { - Scheme_Toplevel *tl = (Scheme_Toplevel *)_tl; - return scheme_make_toplevel(tl->depth, tl->position, flags); + if (SAME_TYPE(SCHEME_TYPE(_tl), scheme_static_toplevel_type)) { + SCHEME_TOPLEVEL_FLAGS(_tl) |= flags; + return _tl; + } else { + Scheme_Toplevel *tl = (Scheme_Toplevel *)_tl; + return scheme_make_toplevel(tl->u.depth, tl->position, flags); + } } Scheme_IR_Toplevel *scheme_make_ir_toplevel(int instance_pos, int variable_pos, int flags) @@ -220,7 +224,7 @@ static void init_toplevels() v = (Scheme_Toplevel *)scheme_malloc_eternal_tagged(sizeof(Scheme_Toplevel)); #endif v->iso.so.type = scheme_toplevel_type; - v->depth = i; + v->u.depth = i; v->position = k; SCHEME_TOPLEVEL_FLAGS(v) = cnst | HIGH_BIT_TO_DISABLE_HASHING; diff --git a/racket/src/racket/src/compile-startup.rkt b/racket/src/racket/src/compile-startup.rkt index f83089e9de..e8f3f70332 100644 --- a/racket/src/racket/src/compile-startup.rkt +++ b/racket/src/racket/src/compile-startup.rkt @@ -85,9 +85,8 @@ (define-values (correlated-property) (hash-ref (primitive-table '#%kernel) 'syntax-property)) (define-values (linklet) (compile-linklet (rename-functions (get-linklet src)) - #f #f #f #f - ;; Unsafe mode: - #t)) + #f #f #f + '(serializable unsafe static))) (define-values (DIGS-PER-LINE) 20) diff --git a/racket/src/racket/src/eval.c b/racket/src/racket/src/eval.c index 779e8eed73..35bcdd5099 100644 --- a/racket/src/racket/src/eval.c +++ b/racket/src/racket/src/eval.c @@ -1659,8 +1659,11 @@ static Scheme_Object *define_values_execute(Scheme_Object *vec) Scheme_Prefix *toplevels; var = SCHEME_VEC_ELS(vec)[i+delta]; - toplevels = (Scheme_Prefix *)MZ_RUNSTACK[SCHEME_TOPLEVEL_DEPTH(var)]; - b = (Scheme_Bucket *)toplevels->a[SCHEME_TOPLEVEL_POS(var)]; + if (SAME_TYPE(SCHEME_TYPE(var), scheme_toplevel_type)) { + toplevels = (Scheme_Prefix *)MZ_RUNSTACK[SCHEME_TOPLEVEL_DEPTH(var)]; + b = (Scheme_Bucket *)toplevels->a[SCHEME_TOPLEVEL_POS(var)]; + } else + b = (Scheme_Bucket *)SCHEME_STATIC_TOPLEVEL_PREFIX(var)->a[SCHEME_TOPLEVEL_POS(var)]; scheme_set_global_bucket("define-values", b, values[i], 1); @@ -1681,8 +1684,11 @@ static Scheme_Object *define_values_execute(Scheme_Object *vec) Scheme_Prefix *toplevels; var = SCHEME_VEC_ELS(vec)[delta]; - toplevels = (Scheme_Prefix *)MZ_RUNSTACK[SCHEME_TOPLEVEL_DEPTH(var)]; - b = (Scheme_Bucket *)toplevels->a[SCHEME_TOPLEVEL_POS(var)]; + if (SAME_TYPE(SCHEME_TYPE(var), scheme_toplevel_type)) { + toplevels = (Scheme_Prefix *)MZ_RUNSTACK[SCHEME_TOPLEVEL_DEPTH(var)]; + b = (Scheme_Bucket *)toplevels->a[SCHEME_TOPLEVEL_POS(var)]; + } else + b = (Scheme_Bucket *)SCHEME_STATIC_TOPLEVEL_PREFIX(var)->a[SCHEME_TOPLEVEL_POS(var)]; scheme_set_global_bucket("define-values", b, vals, 1); @@ -1737,9 +1743,12 @@ static Scheme_Object *set_execute (Scheme_Object *data) val = _scheme_eval_linked_expr(sb->val); - toplevels = (Scheme_Prefix *)MZ_RUNSTACK[SCHEME_TOPLEVEL_DEPTH(sb->var)]; - var = (Scheme_Bucket *)toplevels->a[SCHEME_TOPLEVEL_POS(sb->var)]; - + if (SAME_TYPE(SCHEME_TYPE(sb->var), scheme_toplevel_type)) { + toplevels = (Scheme_Prefix *)MZ_RUNSTACK[SCHEME_TOPLEVEL_DEPTH(sb->var)]; + var = (Scheme_Bucket *)toplevels->a[SCHEME_TOPLEVEL_POS(sb->var)]; + } else + var = (Scheme_Bucket *)SCHEME_STATIC_TOPLEVEL_PREFIX(sb->var)->a[SCHEME_TOPLEVEL_POS(sb->var)]; + scheme_set_global_bucket("set!", var, val, sb->set_undef); return scheme_void; @@ -2721,6 +2730,17 @@ scheme_do_eval(Scheme_Object *obj, int num_rands, Scheme_Object **rands, global_lookup(v = , obj, v); goto returnv_never_multi; } + case scheme_static_toplevel_type: + { + obj = SCHEME_STATIC_TOPLEVEL_PREFIX(obj)->a[SCHEME_TOPLEVEL_POS(obj)]; + v = (Scheme_Object *)(SCHEME_VAR_BUCKET(obj))->val; + if (!v) { + UPDATE_THREAD_RSPTR_FOR_ERROR(); + scheme_unbound_global((Scheme_Bucket *)obj); + return NULL; + } + goto returnv_never_multi; + } case scheme_local_type: { v = RUNSTACK[SCHEME_LOCAL_POS(obj)]; diff --git a/racket/src/racket/src/jit.c b/racket/src/racket/src/jit.c index 8f0828430e..96ebf686a4 100644 --- a/racket/src/racket/src/jit.c +++ b/racket/src/racket/src/jit.c @@ -419,6 +419,7 @@ static int is_short(Scheme_Object *obj, int fuel) return is_short(branch->fbranch, fuel); } case scheme_toplevel_type: + case scheme_static_toplevel_type: case scheme_local_type: case scheme_local_unbox_type: case scheme_lambda_type: @@ -501,7 +502,8 @@ Scheme_Object *scheme_specialize_to_constant(Scheme_Object *obj, mz_jit_state *j } } - if (SAME_TYPE(SCHEME_TYPE(obj), scheme_toplevel_type)) { + if (SAME_TYPE(SCHEME_TYPE(obj), scheme_toplevel_type) + && (SCHEME_TOPLEVEL_FLAGS(obj) & SCHEME_TOPLEVEL_FLAGS_MASK) >= SCHEME_TOPLEVEL_FIXED) { c = scheme_extract_global(obj, jitter->nc, 0); if (c) { c = ((Scheme_Bucket *)c)->val; @@ -509,6 +511,14 @@ Scheme_Object *scheme_specialize_to_constant(Scheme_Object *obj, mz_jit_state *j return c; } } + + if (SAME_TYPE(SCHEME_TYPE(obj), scheme_static_toplevel_type) + && (SCHEME_TOPLEVEL_FLAGS(obj) & SCHEME_TOPLEVEL_FLAGS_MASK) >= SCHEME_TOPLEVEL_FIXED) { + c = SCHEME_STATIC_TOPLEVEL_PREFIX(obj)->a[SCHEME_TOPLEVEL_POS(obj)]; + c = ((Scheme_Bucket *)c)->val; + if (c) + return c; + } } return obj; @@ -566,6 +576,17 @@ int scheme_is_noncm(Scheme_Object *a, mz_jit_state *jitter, int depth, int stack } } + if (SAME_TYPE(SCHEME_TYPE(a), scheme_static_toplevel_type) + && ((SCHEME_TOPLEVEL_FLAGS(a) & SCHEME_TOPLEVEL_FLAGS_MASK) >= SCHEME_TOPLEVEL_FIXED)) { + Scheme_Object *p; + p = SCHEME_STATIC_TOPLEVEL_PREFIX(a)->a[SCHEME_TOPLEVEL_POS(a)]; + p = ((Scheme_Bucket *)p)->val; + if (p && SAME_TYPE(SCHEME_TYPE(p), scheme_native_closure_type)) { + if (scheme_native_closure_preserves_marks(p)) + return 1; + } + } + if (SAME_TYPE(SCHEME_TYPE(a), scheme_local_type)) { int pos = SCHEME_LOCAL_POS(a) - stack_start; if (pos >= 0) { @@ -576,6 +597,11 @@ int scheme_is_noncm(Scheme_Object *a, mz_jit_state *jitter, int depth, int stack } } + if (SAME_TYPE(SCHEME_TYPE(a), scheme_native_closure_type)) { + if (scheme_native_closure_preserves_marks(a)) + return 1; + } + if (depth && SAME_TYPE(SCHEME_TYPE(a), scheme_closure_type)) { Scheme_Lambda *lam; @@ -682,6 +708,7 @@ int scheme_is_simple(Scheme_Object *obj, int depth, int just_markless, mz_jit_st break; case scheme_toplevel_type: + case scheme_static_toplevel_type: case scheme_local_type: case scheme_local_unbox_type: case scheme_lambda_type: @@ -742,6 +769,12 @@ int scheme_is_non_gc(Scheme_Object *obj, int depth) break; case scheme_toplevel_type: + if ((SCHEME_TOPLEVEL_FLAGS(obj) & SCHEME_TOPLEVEL_FLAGS_MASK) >= SCHEME_TOPLEVEL_CONST) + return 1; + break; + case scheme_static_toplevel_type: + if ((SCHEME_TOPLEVEL_FLAGS(obj) & SCHEME_TOPLEVEL_FLAGS_MASK) >= SCHEME_TOPLEVEL_FIXED) + return 1; break; case scheme_lambda_type: break; @@ -788,6 +821,15 @@ static int is_a_procedure(Scheme_Object *v, mz_jit_state *jitter) } } } + } else if (t == scheme_static_toplevel_type) { + if ((SCHEME_TOPLEVEL_FLAGS(v) & SCHEME_TOPLEVEL_FLAGS_MASK) >= SCHEME_TOPLEVEL_FIXED) { + Scheme_Object *p; + + p = SCHEME_STATIC_TOPLEVEL_PREFIX(v)->a[SCHEME_TOPLEVEL_POS(v)]; + p = ((Scheme_Bucket *)p)->val; + if (p) + return SAME_TYPE(SCHEME_TYPE(p), scheme_native_closure_type); + } } return 0; @@ -830,7 +872,8 @@ int scheme_can_delay_and_avoids_r1(Scheme_Object *obj) { Scheme_Type t = SCHEME_TYPE(obj); - if (SAME_TYPE(t, scheme_toplevel_type)) { + if (SAME_TYPE(t, scheme_toplevel_type) + || SAME_TYPE(t, scheme_static_toplevel_type)) { return (((SCHEME_TOPLEVEL_FLAGS(obj) & SCHEME_TOPLEVEL_FLAGS_MASK) >= SCHEME_TOPLEVEL_FIXED) ? 1 : 0); @@ -842,7 +885,8 @@ int scheme_is_constant_and_avoids_r1(Scheme_Object *obj) { Scheme_Type t = SCHEME_TYPE(obj); - if (SAME_TYPE(t, scheme_toplevel_type)) { + if (SAME_TYPE(t, scheme_toplevel_type) + || SAME_TYPE(t, scheme_static_toplevel_type)) { return (((SCHEME_TOPLEVEL_FLAGS(obj) & SCHEME_TOPLEVEL_FLAGS_MASK) >= SCHEME_TOPLEVEL_FIXED) ? 1 : 0); @@ -862,7 +906,7 @@ static int expression_avoids_clearing_local(Scheme_Object *wrt, int pos, int fue else if (SAME_TYPE(t, scheme_local_type)) return ((SCHEME_LOCAL_POS(wrt) != pos) || !(SCHEME_GET_LOCAL_FLAGS(wrt) == SCHEME_LOCAL_CLEAR_ON_READ)); - else if (SAME_TYPE(t, scheme_toplevel_type)) + else if (SAME_TYPE(t, scheme_toplevel_type) || SAME_TYPE(t, scheme_static_toplevel_type)) return 1; else if (t == scheme_application2_type) { Scheme_App2_Rec *app = (Scheme_App2_Rec *)wrt; @@ -2028,6 +2072,7 @@ int scheme_generate(Scheme_Object *obj, mz_jit_state *jitter, int is_tail, int w && !jitter->unbox && !IS_SKIP_TYPE(SCHEME_TYPE(obj)) && !SAME_TYPE(SCHEME_TYPE(obj), scheme_toplevel_type) + && !SAME_TYPE(SCHEME_TYPE(obj), scheme_static_toplevel_type) && !SAME_TYPE(SCHEME_TYPE(obj), scheme_local_type) && !SAME_TYPE(SCHEME_TYPE(obj), scheme_local_unbox_type) && (SCHEME_TYPE(obj) < _scheme_values_types_)) { @@ -2100,6 +2145,43 @@ int scheme_generate(Scheme_Object *obj, mz_jit_state *jitter, int is_tail, int w if (for_branch) finish_branch(jitter, target, for_branch); return 1; } + case scheme_static_toplevel_type: + { + int can_fail; + /* Other parts of the JIT rely on this code not modifying R1 */ + can_fail = ((SCHEME_TOPLEVEL_FLAGS(obj) & SCHEME_TOPLEVEL_FLAGS_MASK) < SCHEME_TOPLEVEL_READY); + if (!can_fail && result_ignored) { + /* skip */ + } else { + Scheme_Object *b; + START_JIT_DATA(); + LOG_IT(("static-top-level\n")); + if ((SCHEME_TOPLEVEL_FLAGS(obj) & SCHEME_TOPLEVEL_FLAGS_MASK) >= SCHEME_TOPLEVEL_FIXED) { + /* load constant */ + b = SCHEME_STATIC_TOPLEVEL_PREFIX(obj)->a[SCHEME_TOPLEVEL_POS(obj)]; + b = ((Scheme_Bucket *)b)->val; + scheme_mz_load_retained(jitter, target, b); + } else { + mz_rs_sync_fail_branch(); + /* Load bucket: */ + b = SCHEME_STATIC_TOPLEVEL_PREFIX(obj)->a[SCHEME_TOPLEVEL_POS(obj)]; + scheme_mz_load_retained(jitter, JIT_R2, b); + /* Extract bucket value */ + jit_ldxi_p(target, JIT_R2, &(SCHEME_VAR_BUCKET(0x0)->val)); + CHECK_LIMIT(); + if (can_fail) { + /* Is it NULL? */ + scheme_generate_pop_unboxed(jitter); + CHECK_LIMIT(); + (void)jit_beqi_p(sjc.unbound_global_code, target, 0); + } + if (jitter->unbox) scheme_generate_unboxing(jitter, target); + END_JIT_DATA(0); + } + if (for_branch) finish_branch(jitter, target, for_branch); + } + return 1; + } case scheme_local_type: { /* Other parts of the JIT rely on this code modifying only the target register, @@ -2342,13 +2424,19 @@ int scheme_generate(Scheme_Object *obj, mz_jit_state *jitter, int is_tail, int w scheme_generate_non_tail(p, jitter, 0, 1, 0); CHECK_LIMIT(); mz_rs_sync(); - - /* Load prefix: */ - pos = mz_remap(SCHEME_TOPLEVEL_DEPTH(v)); - mz_rs_ldxi(JIT_R2, pos); - /* Extract bucket from prefix: */ - pos = SCHEME_TOPLEVEL_POS(v); - jit_ldxi_p(JIT_R2, JIT_R2, &(((Scheme_Prefix *)0x0)->a[pos])); + + if (SAME_TYPE(SCHEME_TYPE(v), scheme_toplevel_type)) { + /* Load prefix: */ + pos = mz_remap(SCHEME_TOPLEVEL_DEPTH(v)); + mz_rs_ldxi(JIT_R2, pos); + /* Extract bucket from prefix: */ + pos = SCHEME_TOPLEVEL_POS(v); + jit_ldxi_p(JIT_R2, JIT_R2, &(((Scheme_Prefix *)0x0)->a[pos])); + } else { + /* Load bucket */ + v = SCHEME_STATIC_TOPLEVEL_PREFIX(v)->a[SCHEME_TOPLEVEL_POS(v)]; + scheme_mz_load_retained(jitter, JIT_R2, v); + } CHECK_LIMIT(); /* R0 has values, R2 has bucket */ @@ -3810,7 +3898,8 @@ static int do_generate_closure(mz_jit_state *jitter, void *_data) } /* A define-values context? */ - if (lam->context && SAME_TYPE(SCHEME_TYPE(lam->context), scheme_toplevel_type)) { + if (lam->context && (SAME_TYPE(SCHEME_TYPE(lam->context), scheme_toplevel_type) + || SAME_TYPE(SCHEME_TYPE(lam->context), scheme_static_toplevel_type))) { jitter->self_toplevel_pos = SCHEME_TOPLEVEL_POS(lam->context); jitter->self_closure_size = lam->closure_size; } diff --git a/racket/src/racket/src/jitarith.c b/racket/src/racket/src/jitarith.c index 327f1a46b4..c970689a9c 100644 --- a/racket/src/racket/src/jitarith.c +++ b/racket/src/racket/src/jitarith.c @@ -201,6 +201,7 @@ static int is_unboxing_immediate(Scheme_Object *obj, int unsafely, int extfl) #endif return unsafely; case scheme_toplevel_type: + case scheme_static_toplevel_type: /* Can generalize to allow any toplevel if scheme_generate_pop_unboxed() is fixed */ if ((SCHEME_TOPLEVEL_FLAGS(obj) & SCHEME_TOPLEVEL_FLAGS_MASK) < SCHEME_TOPLEVEL_READY) return 0; diff --git a/racket/src/racket/src/jitcall.c b/racket/src/racket/src/jitcall.c index 95bd9d7b1f..11eda68411 100644 --- a/racket/src/racket/src/jitcall.c +++ b/racket/src/racket/src/jitcall.c @@ -1856,26 +1856,33 @@ int scheme_generate_app(Scheme_App_Rec *app, Scheme_Object **alt_rands, int num_ } } } - } else if (t == scheme_toplevel_type) { - if ((SCHEME_TOPLEVEL_FLAGS(rator) & SCHEME_TOPLEVEL_FLAGS_MASK) >= SCHEME_TOPLEVEL_FIXED) { + } else if ((t == scheme_toplevel_type) || (t == scheme_static_toplevel_type)) { + int flags = SCHEME_TOPLEVEL_FLAGS(rator); + + if ((flags & SCHEME_TOPLEVEL_FLAGS_MASK) >= SCHEME_TOPLEVEL_FIXED) { /* We can re-order evaluation of the rator. */ reorder_ok = 1; - + if (jitter->nc - && ((SCHEME_TOPLEVEL_FLAGS(rator) & SCHEME_TOPLEVEL_FLAGS_MASK) >= SCHEME_TOPLEVEL_CONST)) { + && ((flags & SCHEME_TOPLEVEL_FLAGS_MASK) >= SCHEME_TOPLEVEL_CONST)) { Scheme_Object *p; - p = scheme_extract_global(rator, jitter->nc, 0); + if (t == scheme_toplevel_type) + p = scheme_extract_global(rator, jitter->nc, 0); + else + p = SCHEME_STATIC_TOPLEVEL_PREFIX(rator)->a[SCHEME_TOPLEVEL_POS(rator)]; if (p) { p = ((Scheme_Bucket *)p)->val; if (can_direct_native(p, num_rands, &extract_case)) { + int pos = SCHEME_TOPLEVEL_POS(rator); + direct_native = 1; - - if ((SCHEME_TOPLEVEL_POS(rator) == jitter->self_toplevel_pos) + + if ((pos == jitter->self_toplevel_pos) && (num_rands < MAX_SHARED_CALL_RANDS)) { - if (is_tail) + if (is_tail) { direct_self = 1; - else if (jitter->self_nontail_code) + } else if (jitter->self_nontail_code) nontail_self = 1; } } diff --git a/racket/src/racket/src/jitinline.c b/racket/src/racket/src/jitinline.c index 3f334cda95..53c95b6b0d 100644 --- a/racket/src/racket/src/jitinline.c +++ b/racket/src/racket/src/jitinline.c @@ -181,6 +181,11 @@ static int inlineable_struct_prim(Scheme_Object *o, mz_jit_state *jitter, int ex p = scheme_extract_global(o, jitter->nc, 0); p = ((Scheme_Bucket *)p)->val; return check_val_struct_prim(p, arity); + } else if (SAME_TYPE(SCHEME_TYPE(o), scheme_static_toplevel_type)) { + Scheme_Object *p; + p = SCHEME_STATIC_TOPLEVEL_PREFIX(o)->a[SCHEME_TOPLEVEL_POS(o)]; + p = ((Scheme_Bucket *)p)->val; + return check_val_struct_prim(p, arity); } else if (SAME_TYPE(SCHEME_TYPE(o), scheme_local_type)) { Scheme_Object *p; p = scheme_extract_closure_local(o, jitter, extra_push, 0); @@ -542,7 +547,7 @@ static int generate_inlined_char_category_test(mz_jit_state *jitter, Scheme_App2 { GC_CAN_IGNORE jit_insn *reffail = NULL, *ref, *pref; - LOG_IT(("inlined %s\n", ((Scheme_Primitive_Proc *)rator)->name)); + LOG_IT(("inlined %s\n", ((Scheme_Primitive_Proc *)app->rator)->name)); mz_runstack_skipped(jitter, 1); @@ -617,6 +622,10 @@ static Scheme_Object *extract_struct_constant(mz_jit_state *jitter, Scheme_Objec rator = scheme_extract_global(rator, jitter->nc, 0); if (rator) return ((Scheme_Bucket *)rator)->val; + } else if (SAME_TYPE(SCHEME_TYPE(rator), scheme_static_toplevel_type) + && (SCHEME_TOPLEVEL_FLAGS(rator) & SCHEME_TOPLEVEL_FLAGS_MASK) >= SCHEME_TOPLEVEL_FIXED) { + rator = SCHEME_STATIC_TOPLEVEL_PREFIX(rator)->a[SCHEME_TOPLEVEL_POS(rator)]; + return ((Scheme_Bucket *)rator)->val; } return NULL; @@ -1700,7 +1709,7 @@ int scheme_generate_inlined_unary(mz_jit_state *jitter, Scheme_App2_Rec *app, in } else if (IS_NAMED_PRIM(rator, "syntax-e")) { GC_CAN_IGNORE jit_insn *reffail = NULL, *ref; - LOG_IT("inlined syntax-e\n"); + LOG_IT(("inlined syntax-e\n")); mz_runstack_skipped(jitter, 1); diff --git a/racket/src/racket/src/linklet.c b/racket/src/racket/src/linklet.c index bbfc83237d..9b5731eca4 100644 --- a/racket/src/racket/src/linklet.c +++ b/racket/src/racket/src/linklet.c @@ -34,6 +34,9 @@ SHARED_OK Scheme_Hash_Tree *empty_hash_tree; SHARED_OK static int validate_compile_result = 0; SHARED_OK static int recompile_every_compile = 0; +static Scheme_Object *serializable_symbol; +static Scheme_Object *unsafe_symbol; +static Scheme_Object *static_symbol; static Scheme_Object *constant_symbol; static Scheme_Object *consistent_symbol; static Scheme_Object *noncm_symbol; @@ -83,7 +86,7 @@ static Scheme_Linklet *compile_and_or_optimize_linklet(Scheme_Object *form, Sche Scheme_Object *name, Scheme_Object **_import_keys, Scheme_Object *get_import, - int unsafe_mode); + int unsafe_mode, int static_mode); static Scheme_Object *_instantiate_linklet_multi(Scheme_Linklet *linklet, Scheme_Instance *instance, int num_instances, Scheme_Instance **instances, @@ -117,6 +120,13 @@ void scheme_init_linklet(Scheme_Startup_Env *env) register_traversers(); #endif + REGISTER_SO(serializable_symbol); + REGISTER_SO(unsafe_symbol); + REGISTER_SO(static_symbol); + serializable_symbol = scheme_intern_symbol("serializable"); + unsafe_symbol = scheme_intern_symbol("unsafe"); + static_symbol = scheme_intern_symbol("static"); + REGISTER_SO(constant_symbol); REGISTER_SO(consistent_symbol); constant_symbol = scheme_intern_symbol("constant"); @@ -138,7 +148,7 @@ void scheme_init_linklet(Scheme_Startup_Env *env) ADD_IMMED_PRIM("primitive-in-category?", primitive_in_category_p, 2, 2, env); ADD_FOLDING_PRIM("linklet?", linklet_p, 1, 1, 1, env); - ADD_PRIM_W_ARITY2("compile-linklet", compile_linklet, 1, 6, 2, 2, env); + ADD_PRIM_W_ARITY2("compile-linklet", compile_linklet, 1, 5, 2, 2, env); ADD_PRIM_W_ARITY2("recompile-linklet", recompile_linklet, 1, 4, 2, 2, env); ADD_IMMED_PRIM("eval-linklet", eval_linklet, 1, 1, env); ADD_PRIM_W_ARITY("read-compiled-linklet", read_compiled_linklet, 1, 1, env); @@ -365,7 +375,7 @@ void extract_import_info(const char *who, int argc, Scheme_Object **argv, static Scheme_Object *compile_linklet(int argc, Scheme_Object **argv) { Scheme_Object *name, *e, *import_keys, *get_import, *a[2]; - int unsafe; + int unsafe = 0, static_mode = 0; /* Last argument, `serializable?`, is ignored */ @@ -380,11 +390,40 @@ static Scheme_Object *compile_linklet(int argc, Scheme_Object **argv) if (!SCHEME_STXP(e)) e = scheme_datum_to_syntax(e, scheme_false, DTS_CAN_GRAPH); - /* We don't care about `serializable?` at this layer. */ + if (argc > 4) { + Scheme_Object *flags, *redundant = NULL, *flag; + int serializable = 0; + + flags = argv[4]; + while (SCHEME_PAIRP(flags)) { + flag = SCHEME_CAR(flags); + if (SAME_OBJ(flag, serializable_symbol)) { + if (serializable && !redundant) + redundant = flag; + serializable = 1; + } else if (SAME_OBJ(flag, unsafe_symbol)) { + if (unsafe && !redundant) + redundant = flag; + unsafe = 1; + } else if (SAME_OBJ(flag, static_symbol)) { + if (static_mode && !redundant) + redundant = flag; + static_mode = 1; + } else + break; + flags = SCHEME_CDR(flags); + } + if (!SCHEME_NULLP(flags)) + scheme_wrong_contract("compile-linklet", "(listof/c 'serializable 'unsafe)", 4, argc, argv); + if (redundant) + scheme_contract_error("compile-linklet", "redundant option", + "redundant option", 1, redundant, + "supplied options", 1, argv[4], + NULL); + } - unsafe = ((argc > 5) && SCHEME_TRUEP(argv[5])); - - e = (Scheme_Object *)compile_and_or_optimize_linklet(e, NULL, name, &import_keys, get_import, unsafe); + e = (Scheme_Object *)compile_and_or_optimize_linklet(e, NULL, name, &import_keys, get_import, + unsafe, static_mode); if (import_keys) { a[0] = e; @@ -422,7 +461,7 @@ static Scheme_Object *recompile_linklet(int argc, Scheme_Object **argv) NULL); } - linklet = compile_and_or_optimize_linklet(NULL, linklet, name, &import_keys, get_import, 0); + linklet = compile_and_or_optimize_linklet(NULL, linklet, name, &import_keys, get_import, 0, 0); if (import_keys) { a[0] = (Scheme_Object *)linklet; @@ -1123,7 +1162,7 @@ static Scheme_Hash_Tree *update_source_names(Scheme_Hash_Tree *source_names, static Scheme_Linklet *compile_and_or_optimize_linklet(Scheme_Object *form, Scheme_Linklet *linklet, Scheme_Object *name, Scheme_Object **_import_keys, Scheme_Object *get_import, - int unsafe_mode) + int unsafe_mode, int static_mode) { Scheme_Config *config; int enforce_const, set_undef, can_inline; @@ -1146,7 +1185,7 @@ static Scheme_Linklet *compile_and_or_optimize_linklet(Scheme_Object *form, Sche linklet = scheme_optimize_linklet(linklet, enforce_const, can_inline, unsafe_mode, _import_keys, get_import); - linklet = scheme_resolve_linklet(linklet, enforce_const); + linklet = scheme_resolve_linklet(linklet, enforce_const, static_mode); linklet = scheme_sfs_linklet(linklet); if (recompile_every_compile) { @@ -1155,7 +1194,7 @@ static Scheme_Linklet *compile_and_or_optimize_linklet(Scheme_Object *form, Sche linklet = scheme_unresolve_linklet(linklet, (set_undef ? COMP_ALLOW_SET_UNDEFINED : 0)); linklet = scheme_optimize_linklet(linklet, enforce_const, can_inline, unsafe_mode, _import_keys, get_import); - linklet = scheme_resolve_linklet(linklet, enforce_const); + linklet = scheme_resolve_linklet(linklet, enforce_const, static_mode); linklet = scheme_sfs_linklet(linklet); } } @@ -1168,7 +1207,7 @@ static Scheme_Linklet *compile_and_or_optimize_linklet(Scheme_Object *form, Sche Scheme_Linklet *scheme_compile_and_optimize_linklet(Scheme_Object *form, Scheme_Object *name) { - return compile_and_or_optimize_linklet(form, NULL, name, NULL, NULL, 0); + return compile_and_or_optimize_linklet(form, NULL, name, NULL, NULL, 0, 1); } /*========================================================================*/ @@ -1405,13 +1444,40 @@ Scheme_Object *scheme_instantiate_linklet_multi(Scheme_Linklet *linklet, Scheme_ /* creating/pushing prefix for top-levels and syntax objects */ /*========================================================================*/ +Scheme_Prefix *scheme_allocate_linklet_prefix(Scheme_Linklet *linklet, int extra) +{ + int num_defns, n; + + num_defns = SCHEME_VEC_SIZE(linklet->defns); + + n = 1 + linklet->num_total_imports + num_defns + extra; + + return scheme_allocate_prefix(n); +} + +Scheme_Prefix *scheme_allocate_prefix(intptr_t n) +{ + Scheme_Prefix *pf; + int tl_map_len; + + tl_map_len = (n + 31) / 32; + + pf = scheme_malloc_tagged(sizeof(Scheme_Prefix) + + ((n-mzFLEX_DELTA) * sizeof(Scheme_Object *)) + + (tl_map_len * sizeof(int))); + pf->iso.so.type = scheme_prefix_type; + pf->num_slots = n; + + return pf; +} + static Scheme_Hash_Tree *push_prefix(Scheme_Linklet *linklet, Scheme_Instance *instance, int num_instances, Scheme_Instance **instances, Scheme_Hash_Tree *source_names) { Scheme_Object **rs, *v; Scheme_Prefix *pf; - int i, j, pos, tl_map_len, num_importss, num_defns, starts_empty; + int i, j, pos, num_importss, num_defns, starts_empty; GC_CAN_IGNORE const char *bad_reason = NULL; rs = MZ_RUNSTACK; @@ -1419,14 +1485,10 @@ static Scheme_Hash_Tree *push_prefix(Scheme_Linklet *linklet, Scheme_Instance *i num_importss = SCHEME_VEC_SIZE(linklet->importss); num_defns = SCHEME_VEC_SIZE(linklet->defns); - i = 1 + linklet->num_total_imports + num_defns; - tl_map_len = (i + 31) / 32; + pf = linklet->static_prefix; + if (!pf) + pf = scheme_allocate_linklet_prefix(linklet, 0); - pf = scheme_malloc_tagged(sizeof(Scheme_Prefix) - + ((i-mzFLEX_DELTA) * sizeof(Scheme_Object *)) - + (tl_map_len * sizeof(int))); - pf->iso.so.type = scheme_prefix_type; - pf->num_slots = i; --rs; MZ_RUNSTACK = rs; rs[0] = (Scheme_Object *)pf; diff --git a/racket/src/racket/src/mzmark_resolve.inc b/racket/src/racket/src/mzmark_resolve.inc index 28ece3e457..baec513ece 100644 --- a/racket/src/racket/src/mzmark_resolve.inc +++ b/racket/src/racket/src/mzmark_resolve.inc @@ -21,6 +21,7 @@ static int mark_resolve_info_MARK(void *p, struct NewGC *gc) { gcMARK2(i->toplevel_starts, gc); gcMARK2(i->toplevel_deltas, gc); gcMARK2(i->toplevel_defns, gc); + gcMARK2(i->static_mode, gc); # ifdef GC_NO_SIZE_NEEDED_FROM_PROCS return 0; @@ -44,6 +45,7 @@ static int mark_resolve_info_FIXUP(void *p, struct NewGC *gc) { gcFIXUP2(i->toplevel_starts, gc); gcFIXUP2(i->toplevel_deltas, gc); gcFIXUP2(i->toplevel_defns, gc); + gcFIXUP2(i->static_mode, gc); # ifdef GC_NO_SIZE_NEEDED_FROM_PROCS return 0; diff --git a/racket/src/racket/src/mzmark_type.inc b/racket/src/racket/src/mzmark_type.inc index e3fcd1e1df..444821bb0e 100644 --- a/racket/src/racket/src/mzmark_type.inc +++ b/racket/src/racket/src/mzmark_type.inc @@ -158,6 +158,42 @@ static int toplevel_obj_FIXUP(void *p, struct NewGC *gc) { #define toplevel_obj_IS_CONST_SIZE 1 +static int static_toplevel_obj_SIZE(void *p, struct NewGC *gc) { +#ifndef GC_NO_SIZE_NEEDED_FROM_PROCS + gcBYTES_TO_WORDS(sizeof(Scheme_Static_Toplevel)); +#else + return 0; +#endif +} + +static int static_toplevel_obj_MARK(void *p, struct NewGC *gc) { +#ifndef GC_NO_MARK_PROCEDURE_NEEDED + gcMARK2(SCHEME_STATIC_TOPLEVEL_PREFIX(p), gc); +# ifdef GC_NO_SIZE_NEEDED_FROM_PROCS + return 0; +# else + return + gcBYTES_TO_WORDS(sizeof(Scheme_Static_Toplevel)); +# endif +#endif +} + +static int static_toplevel_obj_FIXUP(void *p, struct NewGC *gc) { +#ifndef GC_NO_FIXUP_PROCEDURE_NEEDED + gcFIXUP2(SCHEME_STATIC_TOPLEVEL_PREFIX(p), gc); +# ifdef GC_NO_SIZE_NEEDED_FROM_PROCS + return 0; +# else + return + gcBYTES_TO_WORDS(sizeof(Scheme_Static_Toplevel)); +# endif +#endif +} + +#define static_toplevel_obj_IS_ATOMIC 0 +#define static_toplevel_obj_IS_CONST_SIZE 1 + + static int cpointer_obj_SIZE(void *p, struct NewGC *gc) { #ifndef GC_NO_SIZE_NEEDED_FROM_PROCS (SCHEME_CPTR_HAS_OFFSET(p) @@ -3470,6 +3506,7 @@ static int linklet_val_MARK(void *p, struct NewGC *gc) { gcMARK2(l->source_names, gc); gcMARK2(l->bodies, gc); gcMARK2(l->constants, gc); + gcMARK2(l->static_prefix, gc); # ifdef GC_NO_SIZE_NEEDED_FROM_PROCS return 0; # else @@ -3490,6 +3527,7 @@ static int linklet_val_FIXUP(void *p, struct NewGC *gc) { gcFIXUP2(l->source_names, gc); gcFIXUP2(l->bodies, gc); gcFIXUP2(l->constants, gc); + gcFIXUP2(l->static_prefix, gc); # ifdef GC_NO_SIZE_NEEDED_FROM_PROCS return 0; # else diff --git a/racket/src/racket/src/mzmarksrc.c b/racket/src/racket/src/mzmarksrc.c index 6173372504..1ab8b5ac97 100644 --- a/racket/src/racket/src/mzmarksrc.c +++ b/racket/src/racket/src/mzmarksrc.c @@ -36,6 +36,13 @@ toplevel_obj { gcBYTES_TO_WORDS(sizeof(Scheme_Toplevel)); } +static_toplevel_obj { + mark: + gcMARK2(SCHEME_STATIC_TOPLEVEL_PREFIX(p), gc); + size: + gcBYTES_TO_WORDS(sizeof(Scheme_Toplevel)); +} + cpointer_obj { mark: if (!(SCHEME_CPTR_FLAGS(p) & 0x1)) { @@ -984,6 +991,7 @@ linklet_val { gcMARK2(l->source_names, gc); gcMARK2(l->bodies, gc); gcMARK2(l->constants, gc); + gcMARK2(l->static_prefix, gc); size: gcBYTES_TO_WORDS(sizeof(Scheme_Linklet)); } @@ -1127,6 +1135,7 @@ mark_resolve_info { gcMARK2(i->toplevel_starts, gc); gcMARK2(i->toplevel_deltas, gc); gcMARK2(i->toplevel_defns, gc); + gcMARK2(i->static_mode, gc); size: gcBYTES_TO_WORDS(sizeof(Resolve_Info)); diff --git a/racket/src/racket/src/optimize.c b/racket/src/racket/src/optimize.c index e5bf08b825..5f4988e924 100644 --- a/racket/src/racket/src/optimize.c +++ b/racket/src/racket/src/optimize.c @@ -519,10 +519,11 @@ int scheme_omittable_expr(Scheme_Object *o, int vals, int fuel, int flags, return ((vals == 1) || (vals < 0)); } - if (vtype == scheme_toplevel_type) { + if ((vtype == scheme_toplevel_type) || (vtype == scheme_static_toplevel_type)) { note_match(1, vals, warn_info); if (!(flags & OMITTABLE_KEEP_VARS) && (flags & OMITTABLE_RESOLVED) && ((vals == 1) || (vals < 0))) { - if (SCHEME_TOPLEVEL_FLAGS(o) & SCHEME_TOPLEVEL_FLAGS_MASK) + int tl_flags = SCHEME_TOPLEVEL_FLAGS(o); + if (tl_flags & SCHEME_TOPLEVEL_FLAGS_MASK) return 1; else return 0; @@ -1356,14 +1357,18 @@ static int is_ok_value(Ok_Value_Callback ok_value, void *data, if (v) return ok_value(data, v, OK_CONSTANT_SHAPE); } - } else if (SAME_TYPE(SCHEME_TYPE(arg), scheme_toplevel_type)) { + } else if (SAME_TYPE(SCHEME_TYPE(arg), scheme_toplevel_type) + || SAME_TYPE(SCHEME_TYPE(arg), scheme_static_toplevel_type)) { pos = SCHEME_TOPLEVEL_POS(arg); if (runstack) { /* This is eval mode; conceptually, this code belongs in define_execute_with_dynamic_state() */ Scheme_Bucket *b; Scheme_Prefix *toplevels; - toplevels = (Scheme_Prefix *)runstack[SCHEME_TOPLEVEL_DEPTH(arg) - rs_delta]; + if (SAME_TYPE(SCHEME_TYPE(arg), scheme_toplevel_type)) + toplevels = (Scheme_Prefix *)runstack[SCHEME_TOPLEVEL_DEPTH(arg) - rs_delta]; + else + toplevels = SCHEME_STATIC_TOPLEVEL_PREFIX(arg); b = (Scheme_Bucket *)toplevels->a[pos]; if (b->val && (((Scheme_Bucket_With_Flags *)b)->flags & GLOB_IS_CONSISTENT)) return ok_value(data, b->val, OK_CONSTANT_VALUE); @@ -2134,6 +2139,7 @@ static int movable_expression(Scheme_Object *expr, Optimize_Info *info, switch (SCHEME_TYPE(expr)) { case scheme_toplevel_type: + case scheme_static_toplevel_type: return ((SCHEME_TOPLEVEL_FLAGS(expr) & SCHEME_TOPLEVEL_FLAGS_MASK) >= SCHEME_TOPLEVEL_FIXED); case scheme_ir_local_type: { diff --git a/racket/src/racket/src/print.c b/racket/src/racket/src/print.c index ed6decde2e..12460689e7 100644 --- a/racket/src/racket/src/print.c +++ b/racket/src/racket/src/print.c @@ -2844,6 +2844,40 @@ print(Scheme_Object *obj, int notdisplay, int compact, Scheme_Hash_Table *ht, print_compact_number(pp, pos); print_compact_number(pp, depth); } + else if (compact && (SAME_TYPE(SCHEME_TYPE(obj), scheme_static_toplevel_type))) + { + int flags, pos; + + print_compact(pp, CPT_OTHER_FORM); + print_compact_number(pp, scheme_static_toplevel_type); + + flags = (SCHEME_TOPLEVEL_FLAGS(obj) & SCHEME_TOPLEVEL_FLAGS_MASK); + pos = SCHEME_TOPLEVEL_POS(obj); + + print_compact_number(pp, flags); + print_compact_number(pp, pos); + + closed = print((Scheme_Object *)SCHEME_STATIC_TOPLEVEL_PREFIX(obj), notdisplay, 1, NULL, mt, pp); + } + else if (compact && (SAME_TYPE(SCHEME_TYPE(obj), scheme_prefix_type))) + { + /* Should only get here for a prefix referenced by a linklet or static toplevel */ + Scheme_Object *idx; + if (compact) + idx = get_symtab_idx(mt, obj); + else + idx = NULL; + + if (idx) { + print_symtab_ref(pp, idx); + } else if (compact) { + print_compact(pp, CPT_OTHER_FORM); + print_compact_number(pp, scheme_prefix_type); + print_compact_number(pp, ((Scheme_Prefix *)obj)->num_slots); + + symtab_set(pp, mt, obj); + } + } else if (compact && (SAME_TYPE(SCHEME_TYPE(obj), scheme_local_type) || SAME_TYPE(SCHEME_TYPE(obj), scheme_local_unbox_type))) @@ -3280,6 +3314,13 @@ print(Scheme_Object *obj, int notdisplay, int compact, Scheme_Hash_Table *ht, Scheme_Object *v; print_compact(pp, CPT_LINKLET); + + if (((Scheme_Linklet *)obj)->static_prefix) { + print_compact_number(pp, 1); + print((Scheme_Object *)((Scheme_Linklet *)obj)->static_prefix, notdisplay, 1, NULL, mt, pp); + } else + print_compact_number(pp, 0); + v = scheme_write_linklet(obj); closed = print(v, notdisplay, 1, NULL, mt, pp); diff --git a/racket/src/racket/src/read.c b/racket/src/racket/src/read.c index f698b106d7..959a01b44b 100644 --- a/racket/src/racket/src/read.c +++ b/racket/src/racket/src/read.c @@ -2327,8 +2327,11 @@ typedef struct CPort { mzlonglong bytecode_hash; } CPort; #define CP_GETC(cp) ((int)(cp->start[cp->pos++])) +#define CP_UNGETC(cp) --cp->pos #define CP_TELL(port) (port->pos + port->base) +typedef void *(*GC_Alloc_Proc)(size_t); + static Scheme_Object *read_compact_list(int c, int proper, int use_stack, CPort *port); static Scheme_Object *read_compact_quote(CPort *port, int embedded); @@ -2778,9 +2781,21 @@ static Scheme_Object *read_compact(CPort *port, int use_stack) break; case CPT_LINKLET: { + int has_prefix; + Scheme_Prefix *pf; + + has_prefix = read_compact_number(port); + if (has_prefix) + pf = (Scheme_Prefix *)read_compact(port, 0); + else + pf = NULL; + v = read_compact(port, 1); v = scheme_read_linklet(v, port->unsafe_ok); if (!v) scheme_ill_formed_code(port); + + ((Scheme_Linklet *)v)->static_prefix = pf; + return v; } break; @@ -3010,7 +3025,8 @@ static Scheme_Object *read_compact(CPort *port, int use_stack) int i, c = SCHEME_VEC_SIZE(v); if (c < 1) scheme_ill_formed_code(port); for (i = 1; i < c; i++) { - if (!SAME_TYPE(SCHEME_TYPE(SCHEME_VEC_ELS(v)[i]), scheme_toplevel_type)) + if (!SAME_TYPE(SCHEME_TYPE(SCHEME_VEC_ELS(v)[i]), scheme_toplevel_type) + && !SAME_TYPE(SCHEME_TYPE(SCHEME_VEC_ELS(v)[i]), scheme_static_toplevel_type)) scheme_ill_formed_code(port); } } @@ -3030,7 +3046,8 @@ static Scheme_Object *read_compact(CPort *port, int use_stack) v = read_compact(port, 1); sb->var = v; - if (!SAME_TYPE(SCHEME_TYPE(v), scheme_toplevel_type)) + if (!SAME_TYPE(SCHEME_TYPE(v), scheme_toplevel_type) + && !SAME_TYPE(SCHEME_TYPE(v), scheme_static_toplevel_type)) scheme_ill_formed_code(port); v = read_compact(port, 1); sb->val = v; @@ -3041,6 +3058,63 @@ static Scheme_Object *read_compact(CPort *port, int use_stack) case CPT_OTHER_FORM: { switch (read_compact_number(port)) { + case scheme_static_toplevel_type: + { + Scheme_Object *tl = scheme_false; + Scheme_Prefix *pf; + intptr_t flags, pos, i; + + flags = read_compact_number(port); + pos = read_compact_number(port); + + /* Avoid recur on very common case of a reference to the prefix: */ + ch = CP_GETC(port); + if (ch == CPT_SYMREF) { + l = read_compact_number(port); + RANGE_POS_CHECK(l, < port->symtab_size); + pf = (Scheme_Prefix *)port->symtab[l]; + } else { + CP_UNGETC(port); + pf = (Scheme_Prefix *)read_compact(port, 0); + } + + if ((pos < 0) || (pos >= pf->num_slots)) + scheme_ill_formed_code(port); + + flags &= SCHEME_TOPLEVEL_FLAGS_MASK; + i = ((pos << SCHEME_LOG_TOPLEVEL_FLAG_MASK) | flags); + + tl = ((Scheme_Object **)pf->a[pf->num_slots-1])[i]; + if (!tl) { + tl = (Scheme_Object *)MALLOC_ONE_TAGGED(Scheme_Toplevel); + tl->type = scheme_static_toplevel_type; + SCHEME_STATIC_TOPLEVEL_PREFIX(tl) = pf; + SCHEME_TOPLEVEL_POS(tl) = pos; + SCHEME_TOPLEVEL_FLAGS(tl) |= flags; + ((Scheme_Object **)pf->a[pf->num_slots-1])[i] = tl; + } + + return tl; + } + break; + case scheme_prefix_type: + { + intptr_t prefix_size; + Scheme_Object **a; + + prefix_size = read_compact_number(port); + if (prefix_size <= 0) scheme_ill_formed_code(port); + if (prefix_size < 4096) + v = (Scheme_Object *)scheme_allocate_prefix(prefix_size); + else + v = scheme_malloc_fail_ok((GC_Alloc_Proc)scheme_allocate_prefix, prefix_size); + + /* Last prefix slot is a cache of Scheme_Toplevel values */ + a = MALLOC_N(Scheme_Object *, prefix_size * (SCHEME_TOPLEVEL_FLAGS_MASK + 1)); + ((Scheme_Prefix *)v)->a[prefix_size-1] = (Scheme_Object *)a; + + return v; + } case scheme_boxenv_type: { Scheme_Object *data; @@ -3953,9 +4027,10 @@ static Scheme_Object *read_compiled(Scheme_Object *port, /* Read main body: */ result = read_compact(rp, 1); - if (delay_info) + if (delay_info) { if (delay_info->ut) delay_info->ut->rp = NULL; /* clean up */ + } if (*local_ht) scheme_read_err(port, "read (compiled): unexpected graph structure"); diff --git a/racket/src/racket/src/resolve.c b/racket/src/racket/src/resolve.c index 3ff10c14b2..f4b06fed85 100644 --- a/racket/src/racket/src/resolve.c +++ b/racket/src/racket/src/resolve.c @@ -85,6 +85,8 @@ struct Resolve_Info #t - enqueued list - resolved with lifts NULL - used or has side effect */ + + Scheme_Hash_Table *static_mode; /* defn pos or ref (cons pos flags) -> static-toplevel */ }; #define cons(a,b) scheme_make_pair(a,b) @@ -101,9 +103,9 @@ static Scheme_Object *resolve_info_lift_added(Resolve_Info *resolve, Scheme_Obje static void resolve_info_set_toplevel_pos(Resolve_Info *info, int pos); static void merge_resolve(Resolve_Info *info, Resolve_Info *new_info); static void merge_resolve_tl_map(Resolve_Info *info, Resolve_Info *new_info); -static Scheme_Object *resolve_generate_stub_lift(void); +static Scheme_Object *resolve_generate_stub_lift(Resolve_Info *info); static int resolve_toplevel_pos(Resolve_Info *info); -static Scheme_Object *resolve_toplevel(Resolve_Info *info, Scheme_Object *expr, int keep_ready); +static Scheme_Object *resolve_toplevel(Resolve_Info *info, Scheme_Object *expr, int as_reference); static Scheme_Object *resolve_invent_toplevel(Resolve_Info *info); static Scheme_Object *resolve_invented_toplevel_to_defn(Resolve_Info *info, Scheme_Object *tl); static Scheme_Object *shift_lifted_reference(Scheme_Object *tl, Resolve_Info *info, int delta); @@ -112,13 +114,14 @@ static int is_nonconstant_procedure(Scheme_Object *lam, Resolve_Info *info, Sche static int resolve_is_inside_proc(Resolve_Info *info); static int resolve_has_toplevel(Resolve_Info *info); static void set_tl_pos_used(Resolve_Info *info, int pos); +static void install_static_prefix(Scheme_Linklet *linket, Resolve_Info *ri); static Scheme_Object *generate_lifted_name(Scheme_Hash_Table *used_names, int search_start); static void enable_expression_resolve_lifts(Resolve_Info *ri); static void extend_linklet_defns(Scheme_Linklet *linklet, int num_lifts); static void prune_unused_imports(Scheme_Linklet *linklet); static void prepare_definition_queue(Scheme_Linklet *linklet, Resolve_Info *rslv); static void remove_definition_names(Scheme_Object *defn, Scheme_Linklet *linklet); -static Resolve_Info *resolve_info_create(Scheme_Linklet *rp, int enforce_const); +static Resolve_Info *resolve_info_create(Scheme_Linklet *rp, int enforce_const, int static_mode); #ifdef MZ_PRECISE_GC static void register_traversers(void); @@ -815,9 +818,12 @@ static int is_lifted_reference(Scheme_Object *v) if (SCHEME_RPAIRP(v)) return 1; - return (SAME_TYPE(SCHEME_TYPE(v), scheme_toplevel_type) - && ((SCHEME_TOPLEVEL_FLAGS(v) & SCHEME_TOPLEVEL_FLAGS_MASK) - >= SCHEME_TOPLEVEL_CONST)); + if (SAME_TYPE(SCHEME_TYPE(v), scheme_toplevel_type) + || SAME_TYPE(SCHEME_TYPE(v), scheme_static_toplevel_type)) + return ((SCHEME_TOPLEVEL_FLAGS(v) & SCHEME_TOPLEVEL_FLAGS_MASK) + >= SCHEME_TOPLEVEL_CONST); + + return 0; } static int is_closed_reference(Scheme_Object *v) @@ -1131,7 +1137,7 @@ static Resolve_Info *compute_possible_lifts(Scheme_IR_Let_Header *head, Resolve_ if (resolve_phase == 0) lift = scheme_resolve_generate_stub_closure(); else if (resolve_phase == 1) - lift = resolve_generate_stub_lift(); + lift = resolve_generate_stub_lift(info); else lift = NULL; MZ_ASSERT(!info->no_lift || !lift); @@ -1605,7 +1611,9 @@ static int is_nonconstant_procedure(Scheme_Object *_lam, Resolve_Info *info, Sch if (!lifted) return 1; if (SAME_TYPE(SCHEME_TYPE(lifted), scheme_toplevel_type) - || SAME_TYPE(SCHEME_TYPE(SCHEME_CAR(lifted)), scheme_toplevel_type)) + || SAME_TYPE(SCHEME_TYPE(lifted), scheme_static_toplevel_type) + || SAME_TYPE(SCHEME_TYPE(SCHEME_CAR(lifted)), scheme_toplevel_type) + || SAME_TYPE(SCHEME_TYPE(SCHEME_CAR(lifted)), scheme_static_toplevel_type)) return 1; } } @@ -1667,7 +1675,7 @@ resolve_lambda(Scheme_Object *_lam, Resolve_Info *info, cl->arg_types = NULL; } - has_tl = cl->has_tl; + has_tl = (info->static_mode ? 0 : cl->has_tl); /* Add original closure content to `captured`, pruning variables that are lifted (so the closure might get smaller). The @@ -1688,7 +1696,8 @@ resolve_lambda(Scheme_Object *_lam, Resolve_Info *info, if (lifted) { /* Drop lifted binding from closure. */ if (SAME_TYPE(SCHEME_TYPE(lifted), scheme_toplevel_type) - || SAME_TYPE(SCHEME_TYPE(SCHEME_CAR(lifted)), scheme_toplevel_type)) { + || (SCHEME_RPAIRP(lifted) + && SAME_TYPE(SCHEME_TYPE(SCHEME_CAR(lifted)), scheme_toplevel_type))) { /* Former local variable is now a top-level variable. */ has_tl = 1; } @@ -1948,7 +1957,7 @@ resolve_lambda(Scheme_Object *_lam, Resolve_Info *info, if (just_compute_lift > 1) result = resolve_invent_toplevel(info); else - result = resolve_generate_stub_lift(); + result = resolve_generate_stub_lift(info); } else { Scheme_Object *tl, *defn_tl; if (precomputed_lift) { @@ -2005,13 +2014,13 @@ resolve_lambda(Scheme_Object *_lam, Resolve_Info *info, /* linklet */ /*========================================================================*/ -Scheme_Linklet *scheme_resolve_linklet(Scheme_Linklet *linklet, int enforce_const) +Scheme_Linklet *scheme_resolve_linklet(Scheme_Linklet *linklet, int enforce_const, int static_mode) { Scheme_Object *lift_vec, *body = scheme_null, *new_bodies; Resolve_Info *rslv; int i, cnt, num_lifts; - rslv = resolve_info_create(linklet, enforce_const); + rslv = resolve_info_create(linklet, enforce_const, static_mode); enable_expression_resolve_lifts(rslv); if (linklet->num_exports < SCHEME_VEC_SIZE(linklet->defns)) { @@ -2104,6 +2113,9 @@ Scheme_Linklet *scheme_resolve_linklet(Scheme_Linklet *linklet, int enforce_cons the level of variables */ prune_unused_imports(linklet); + if (static_mode) + install_static_prefix(linklet, rslv); + return linklet; } @@ -2401,6 +2413,8 @@ static Scheme_Object *shift_lifted_reference(Scheme_Object *tl, Resolve_Info *in int pos = SCHEME_TOPLEVEL_POS(tl); int depth; + MZ_ASSERT(SAME_TYPE(SCHEME_TYPE(tl), scheme_toplevel_type)); + depth = resolve_toplevel_pos(info); tl = scheme_make_toplevel(depth + delta, pos, @@ -2417,7 +2431,7 @@ static Scheme_Object *shift_lifted_reference(Scheme_Object *tl, Resolve_Info *in /* compile-time env for resolve */ /*========================================================================*/ -static Resolve_Info *resolve_info_create(Scheme_Linklet *linklet, int enforce_const) +static Resolve_Info *resolve_info_create(Scheme_Linklet *linklet, int enforce_const, int static_mode) { Resolve_Info *naya; int *toplevel_starts, pos, dpos, i, j; @@ -2434,6 +2448,12 @@ static Resolve_Info *resolve_info_create(Scheme_Linklet *linklet, int enforce_co naya->enforce_const = enforce_const; naya->linklet = linklet; + if (static_mode) { + Scheme_Hash_Table *ht; + ht = scheme_make_hash_table_equal(); + naya->static_mode = ht; + } + toplevel_starts = MALLOC_N_ATOMIC(int, SCHEME_VEC_SIZE(linklet->importss) + 1); toplevel_deltas = MALLOC_N_ATOMIC(int, (linklet->num_total_imports + SCHEME_LINKLET_PREFIX_PREFIX)); pos = SCHEME_LINKLET_PREFIX_PREFIX; @@ -2488,6 +2508,7 @@ static Resolve_Info *resolve_info_extend(Resolve_Info *info, int size, int lambd naya->linklet = info->linklet; naya->next = (lambda ? NULL : info); naya->enforce_const = info->enforce_const; + naya->static_mode = info->static_mode; naya->current_depth = (lambda ? 0 : info->current_depth) + size; naya->current_lex_depth = info->current_lex_depth + size; naya->toplevel_pos = (lambda @@ -2551,19 +2572,21 @@ static void set_tl_pos_used(Resolve_Info *info, int tl_pos) { void *tl_map; - /* Fixnum-like bit packing avoids allocation in the common case of a - small prefix. We use 31 fixnum-like bits (even on a 64-bit - platform, and even though fixnums are only 30 bits). There's one - bit for each normal top-level, one bit for all syntax objects, - and one bit for each lifted top-level. */ + if (!info->static_mode) { + /* Fixnum-like bit packing avoids allocation in the common case of a + small prefix. We use 31 fixnum-like bits (even on a 64-bit + platform, and even though fixnums are only 30 bits). There's one + bit for each normal top-level, one bit for all syntax objects, + and one bit for each lifted top-level. */ - tl_map = ensure_tl_map_len(info->tl_map, tl_pos + 1); - info->tl_map = tl_map; + tl_map = ensure_tl_map_len(info->tl_map, tl_pos + 1); + info->tl_map = tl_map; - if ((uintptr_t)info->tl_map & 0x1) - info->tl_map = (void *)((uintptr_t)tl_map | ((uintptr_t)1 << (tl_pos + 1))); - else - ((int *)tl_map)[1 + (tl_pos / 32)] |= ((unsigned)1 << (tl_pos & 31)); + if ((uintptr_t)info->tl_map & 0x1) + info->tl_map = (void *)((uintptr_t)tl_map | ((uintptr_t)1 << (tl_pos + 1))); + else + ((int *)tl_map)[1 + (tl_pos / 32)] |= ((unsigned)1 << (tl_pos & 31)); + } /* If we're pruning unused definitions, then ensure a newly referenced definition */ if (info->toplevel_defns @@ -2685,9 +2708,51 @@ static int resolve_info_lookup(Resolve_Info *info, Scheme_IR_Local *var, Scheme_ return info->current_depth - depth + convert_shift; } -static Scheme_Object *resolve_generate_stub_lift() +static Scheme_Object *make_static_toplevel(Scheme_Hash_Table *static_mode, int pos, int flags, int as_ref) { - return scheme_make_toplevel(0, 0, SCHEME_TOPLEVEL_CONST); + Scheme_Object *key, *tl; + + if (as_ref) + key = scheme_make_pair(scheme_make_integer(pos), scheme_make_integer(flags)); + else + key = scheme_make_integer(pos); + + tl = scheme_hash_get(static_mode, key); + if (!tl) { + tl = (Scheme_Object *)MALLOC_ONE_TAGGED(Scheme_Toplevel); + tl->type = scheme_static_toplevel_type; + SCHEME_TOPLEVEL_POS(tl) = pos; + SCHEME_TOPLEVEL_FLAGS(tl) |= flags; + scheme_hash_set(static_mode, key, tl); + } + + return tl; +} + +static void install_static_prefix(Scheme_Linklet *linklet, Resolve_Info *ri) +{ + Scheme_Prefix *pf; + int i; + Scheme_Hash_Table *ht = ri->static_mode; + + /* Allocate prefix with one extra slot, which is used when + reading bytecode to cache Scheme_Toplevel values */ + pf = scheme_allocate_linklet_prefix(linklet, 1); + linklet->static_prefix = pf; + + for (i = 0; i < ht->size; i++) { + if (ht->vals[i]) { + SCHEME_STATIC_TOPLEVEL_PREFIX(ht->vals[i]) = pf; + } + } +} + +static Scheme_Object *resolve_generate_stub_lift(Resolve_Info *info) +{ + if (info->static_mode) + return make_static_toplevel(info->static_mode, 0, SCHEME_TOPLEVEL_CONST, 0); + else + return scheme_make_toplevel(0, 0, SCHEME_TOPLEVEL_CONST); } static int resolve_toplevel_pos(Resolve_Info *info) @@ -2703,14 +2768,17 @@ static int resolve_is_inside_proc(Resolve_Info *info) static int resolve_has_toplevel(Resolve_Info *info) { - return info->toplevel_pos >= 0; + return (info->toplevel_pos >= 0) || info->static_mode; } static Scheme_Object *resolve_toplevel(Resolve_Info *info, Scheme_Object *expr, int as_reference) { int skip, pos; - skip = resolve_toplevel_pos(info); + if (info->static_mode) + skip = 0; + else + skip = resolve_toplevel_pos(info); if (SCHEME_IR_TOPLEVEL_INSTANCE(expr) == -1) { if (SCHEME_IR_TOPLEVEL_POS(expr) == -1) { @@ -2727,8 +2795,13 @@ static Scheme_Object *resolve_toplevel(Resolve_Info *info, Scheme_Object *expr, if (as_reference) set_tl_pos_used(info, pos); - return scheme_make_toplevel(skip, pos, - SCHEME_IR_TOPLEVEL_FLAGS((Scheme_IR_Toplevel *)expr) & SCHEME_TOPLEVEL_FLAGS_MASK); + if (info->static_mode) + return make_static_toplevel(info->static_mode, pos, + SCHEME_IR_TOPLEVEL_FLAGS((Scheme_IR_Toplevel *)expr) & SCHEME_TOPLEVEL_FLAGS_MASK, + as_reference); + else + return scheme_make_toplevel(skip, pos, + SCHEME_IR_TOPLEVEL_FLAGS((Scheme_IR_Toplevel *)expr) & SCHEME_TOPLEVEL_FLAGS_MASK); } static Scheme_Object *shift_toplevel(Scheme_Object *expr, int delta) @@ -2752,16 +2825,22 @@ static Scheme_Object *resolve_invent_toplevel(Resolve_Info *info) set_tl_pos_used(info, pos); - return scheme_make_toplevel(skip, - pos, - SCHEME_TOPLEVEL_CONST); + if (info->static_mode) + return make_static_toplevel(info->static_mode, pos, SCHEME_TOPLEVEL_CONST, 0); + else + return scheme_make_toplevel(skip, + pos, + SCHEME_TOPLEVEL_CONST); } static Scheme_Object *resolve_invented_toplevel_to_defn(Resolve_Info *info, Scheme_Object *tl) { - return scheme_make_toplevel(0, - SCHEME_TOPLEVEL_POS(tl), - SCHEME_TOPLEVEL_CONST); + if (SAME_TYPE(SCHEME_TYPE(tl), scheme_toplevel_type)) + return scheme_make_toplevel(0, + SCHEME_TOPLEVEL_POS(tl), + SCHEME_TOPLEVEL_CONST); + else + return tl; } /*========================================================================*/ @@ -3396,7 +3475,8 @@ static Scheme_Object *maybe_unresolve_app_refs(Scheme_Object *rator, if (SAME_TYPE(SCHEME_TYPE(rator), scheme_closure_type) && (SCHEME_LAMBDA_FLAGS((SCHEME_CLOSURE_CODE(rator))) & LAMBDA_HAS_TYPED_ARGS)) { lam = SCHEME_CLOSURE_CODE(rator); - } else if (SAME_TYPE(SCHEME_TYPE(rator), scheme_toplevel_type)) { + } else if (SAME_TYPE(SCHEME_TYPE(rator), scheme_toplevel_type) + || SAME_TYPE(SCHEME_TYPE(rator), scheme_static_toplevel_type)) { lam = (Scheme_Lambda *)scheme_hash_get(ui->ref_lifts, scheme_make_integer(SCHEME_TOPLEVEL_POS(rator))); } @@ -3851,8 +3931,11 @@ static Scheme_Object *unresolve_expr(Scheme_Object *e, Unresolve_Info *ui, int a } b = SCHEME_PTR2_VAL(e); - MZ_ASSERT(SCHEME_FALSEP(b) || (SAME_TYPE(SCHEME_TYPE(b), scheme_toplevel_type) - && !SCHEME_TOPLEVEL_POS(b))); + MZ_ASSERT(SCHEME_FALSEP(b) + || (SAME_TYPE(SCHEME_TYPE(b), scheme_toplevel_type) + && !SCHEME_TOPLEVEL_POS(b)) + || (SAME_TYPE(SCHEME_TYPE(b), scheme_static_toplevel_type) + && !SCHEME_TOPLEVEL_POS(b))); b = unresolve_expr(b, ui, 0); if (!b) return_NULL; MZ_ASSERT(SCHEME_FALSEP(b) || (SAME_TYPE(SCHEME_TYPE(b), scheme_ir_toplevel_type) @@ -3875,6 +3958,7 @@ static Scheme_Object *unresolve_expr(Scheme_Object *e, Unresolve_Info *ui, int a return unresolve_expr(SCHEME_PTR2_VAL(e), ui, 0); } case scheme_toplevel_type: + case scheme_static_toplevel_type: { return unresolve_toplevel(e, ui); } diff --git a/racket/src/racket/src/schpriv.h b/racket/src/racket/src/schpriv.h index fedf74a727..6b62bb9010 100644 --- a/racket/src/racket/src/schpriv.h +++ b/racket/src/racket/src/schpriv.h @@ -1609,11 +1609,15 @@ typedef struct Scheme_Local { typedef struct Scheme_Toplevel { Scheme_Inclhash_Object iso; /* keyex used for flags (and can't be hashed) */ - mzshort depth; + union { + mzshort depth; /* normal mode */ + struct Scheme_Prefix *prefix; /* for a linklet that is only instantiated once */ + } u; int position; } Scheme_Toplevel; -#define SCHEME_TOPLEVEL_DEPTH(obj) (((Scheme_Toplevel *)(obj))->depth) +#define SCHEME_TOPLEVEL_DEPTH(obj) (((Scheme_Toplevel *)(obj))->u.depth) +#define SCHEME_STATIC_TOPLEVEL_PREFIX(obj) (((Scheme_Toplevel *)(obj))->u.prefix) #define SCHEME_TOPLEVEL_POS(obj) (((Scheme_Toplevel *)(obj))->position) #define SCHEME_TOPLEVEL_FLAGS(obj) MZ_OPT_HASH_KEY(&((Scheme_Toplevel *)(obj))->iso) @@ -1621,6 +1625,7 @@ typedef struct Scheme_Toplevel { FIXED, READY, or UNKNOWN) or one of the two levels for a definition (SEAL or not) */ #define SCHEME_TOPLEVEL_FLAGS_MASK 0x3 +#define SCHEME_LOG_TOPLEVEL_FLAG_MASK 2 /* CONST means that a toplevel is READY and always has the "same" value, even for different instantiations or phases. "Same" means that the result @@ -2559,6 +2564,9 @@ typedef struct Scheme_Prefix #define PREFIX_TO_USE_BITS(pf) \ (int *)((char *)pf + sizeof(Scheme_Prefix) + ((pf->num_slots - mzFLEX_DELTA) * sizeof(Scheme_Object *))) +Scheme_Prefix *scheme_allocate_prefix(intptr_t n); +Scheme_Prefix *scheme_allocate_linklet_prefix(Scheme_Linklet *linklet, int extra); + #define LOAD_ON_DEMAND void scheme_clear_delayed_load_cache(); @@ -2945,7 +2953,7 @@ XFORM_NONGCING int scheme_predicate_to_local_type(Scheme_Object *pred); Scheme_Object *scheme_make_noninline_proc(Scheme_Object *e); Scheme_Object *scheme_optimize_extract_tail_inside(Scheme_Object *t2); -Scheme_Linklet *scheme_resolve_linklet(Scheme_Linklet *, int enforce_const); +Scheme_Linklet *scheme_resolve_linklet(Scheme_Linklet *, int enforce_const, int static_mode); Scheme_Object *scheme_unresolve(Scheme_Object *, int argv, int *_has_cases, Scheme_Linklet *linklet, Scheme_Object *linklet_key, Optimize_Info *opt_info); @@ -3281,6 +3289,8 @@ struct Scheme_Linklet char reject_eval; /* true when loaded without the root inspector, for example */ Scheme_Hash_Table *constants; /* holds info about the linklet's body for inlining */ + + Scheme_Prefix *static_prefix; /* non-NULL for a linklet compiled in static mode */ }; #define SCHEME_DEFN_VAR_COUNT(d) (SCHEME_VEC_SIZE(d)-1) diff --git a/racket/src/racket/src/schvers.h b/racket/src/racket/src/schvers.h index ca955afdea..8010f601bd 100644 --- a/racket/src/racket/src/schvers.h +++ b/racket/src/racket/src/schvers.h @@ -13,12 +13,12 @@ consistently.) */ -#define MZSCHEME_VERSION "6.90.0.22" +#define MZSCHEME_VERSION "6.90.0.23" #define MZSCHEME_VERSION_X 6 #define MZSCHEME_VERSION_Y 90 #define MZSCHEME_VERSION_Z 0 -#define MZSCHEME_VERSION_W 22 +#define MZSCHEME_VERSION_W 23 #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/racket/src/racket/src/sfs.c b/racket/src/racket/src/sfs.c index f9e719a574..99a6b0b830 100644 --- a/racket/src/racket/src/sfs.c +++ b/racket/src/racket/src/sfs.c @@ -789,7 +789,8 @@ static Scheme_Object *sfs_let_one(Scheme_Object *o, SFS_Info *info) if (scheme_omittable_expr(rhs, 1, -1, OMITTABLE_RESOLVED, NULL, NULL)) { rhs = scheme_false; } else if ((ip < info->max_calls[pos]) - && SAME_TYPE(SCHEME_TYPE(rhs), scheme_toplevel_type)) { + && (SAME_TYPE(SCHEME_TYPE(rhs), scheme_toplevel_type) + || SAME_TYPE(SCHEME_TYPE(rhs), scheme_static_toplevel_type))) { /* Unusual case: we can't just drop the global-variable access, because it might be undefined, but we don't need the value, and we want to avoid an SFS clear in the interpreter loop. @@ -1426,6 +1427,8 @@ static Scheme_Object *sfs_expr(Scheme_Object *expr, SFS_Info *info, int closure_ scheme_signal_error("toplevel access not at expected place"); } break; + case scheme_static_toplevel_type: + break; case scheme_case_closure_type: { /* FIXME: maybe need to handle eagerly created closure */ diff --git a/racket/src/racket/src/startup.inc b/racket/src/racket/src/startup.inc index 09eb311d6b..939f481346 100644 --- a/racket/src/racket/src/startup.inc +++ b/racket/src/racket/src/startup.inc @@ -29362,7 +29362,9 @@ static const char *startup_source = " name_48" " keys_1" " getter_1" -" serializable?_0)))" +"(if serializable?_0" +" '(serializable)" +" '()))))" "(list*" " 'linklet" "(qq-append" @@ -36178,7 +36180,9 @@ static const char *startup_source = "(values" " inst_5" " #f))" -" serializable?_3)))" +"(if serializable?_3" +" '(serializable)" +" '()))))" " linklet_7))))" "(list*" " 'linklet" diff --git a/racket/src/racket/src/stypes.h b/racket/src/racket/src/stypes.h index 2a9e67e896..262c4089d8 100644 --- a/racket/src/racket/src/stypes.h +++ b/racket/src/racket/src/stypes.h @@ -3,297 +3,298 @@ enum { /* Compiled bytecode elements: */ scheme_toplevel_type, /* 0 */ - scheme_local_type, /* 1 */ - scheme_local_unbox_type, /* 2 */ - scheme_application_type, /* 3 */ - scheme_application2_type, /* 4 */ - scheme_application3_type, /* 5 */ - scheme_sequence_type, /* 6 */ - scheme_branch_type, /* 7 */ - scheme_lambda_type, /* 8 */ - scheme_let_value_type, /* 9 */ - scheme_let_void_type, /* 10 */ - scheme_letrec_type, /* 11 */ - scheme_let_one_type, /* 12 */ - scheme_with_cont_mark_type, /* 13 */ + scheme_static_toplevel_type, /* 1 */ + scheme_local_type, /* 2 */ + scheme_local_unbox_type, /* 3 */ + scheme_application_type, /* 4 */ + scheme_application2_type, /* 5 */ + scheme_application3_type, /* 6 */ + scheme_sequence_type, /* 7 */ + scheme_branch_type, /* 8 */ + scheme_lambda_type, /* 9 */ + scheme_let_value_type, /* 10 */ + scheme_let_void_type, /* 11 */ + scheme_letrec_type, /* 12 */ + scheme_let_one_type, /* 13 */ + scheme_with_cont_mark_type, /* 14 */ - scheme_define_values_type, /* 14 */ - scheme_set_bang_type, /* 15 */ - scheme_boxenv_type, /* 16 */ - scheme_begin0_sequence_type, /* 17 */ - scheme_varref_form_type, /* 18 */ - scheme_apply_values_type, /* 19 */ - scheme_with_immed_mark_type, /* 20 */ - scheme_case_lambda_sequence_type, /* 21 */ - scheme_inline_variant_type, /* 22 */ + scheme_define_values_type, /* 15 */ + scheme_set_bang_type, /* 16 */ + scheme_boxenv_type, /* 17 */ + scheme_begin0_sequence_type, /* 18 */ + scheme_varref_form_type, /* 19 */ + scheme_apply_values_type, /* 20 */ + scheme_with_immed_mark_type, /* 21 */ + scheme_case_lambda_sequence_type, /* 22 */ + scheme_inline_variant_type, /* 23 */ - _scheme_values_types_, /* 23 */ + _scheme_values_types_, /* 24 */ /* All following types are values at run time */ - scheme_linklet_type, /* 24 */ + scheme_linklet_type, /* 25 */ /* Replacements for some of the above as the compiler's intermediate representation for optimization: */ - scheme_ir_local_type, /* 25 */ - scheme_ir_lambda_type, /* 26 */ - scheme_ir_let_value_type, /* 27 */ - scheme_ir_let_header_type, /* 28 */ - scheme_ir_toplevel_type, /* 29 */ + scheme_ir_local_type, /* 26 */ + scheme_ir_lambda_type, /* 27 */ + scheme_ir_let_value_type, /* 28 */ + scheme_ir_let_header_type, /* 29 */ + scheme_ir_toplevel_type, /* 30 */ scheme_quote_compilation_type, /* used while writing, only */ /* Generated in the compiler front-end, but registered in the prefix table instead of used directly as an "expression": */ - scheme_variable_type, /* 31 */ + scheme_variable_type, /* 32 */ - _scheme_ir_values_types_, /* 32 */ + _scheme_ir_values_types_, /* 33 */ /* All of the following are literal values from the perspective of the compiler */ - scheme_linklet_bundle_type, /* 33 */ - scheme_linklet_directory_type, /* 34 */ - scheme_instance_type, /* 35 */ + scheme_linklet_bundle_type, /* 34 */ + scheme_linklet_directory_type, /* 35 */ + scheme_instance_type, /* 36 */ /* procedure types */ - scheme_prim_type, /* 36 */ - scheme_closed_prim_type, /* 37 */ - scheme_closure_type, /* 38 */ - scheme_case_closure_type, /* 39 */ - scheme_cont_type, /* 40 */ - scheme_escaping_cont_type, /* 41 */ - scheme_proc_struct_type, /* 42 */ - scheme_native_closure_type, /* 43 */ - scheme_proc_chaperone_type, /* 44 */ + 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_chaperone_type, /* 45 */ + scheme_chaperone_type, /* 46 */ /* structure type (plus one above for procs) */ - scheme_structure_type, /* 46 */ + scheme_structure_type, /* 47 */ /* number types (must be together) */ - scheme_integer_type, /* 47 */ - scheme_bignum_type, /* 48 */ - scheme_rational_type, /* 49 */ - scheme_float_type, /* 50 */ - scheme_double_type, /* 51 */ - scheme_complex_type, /* 52 */ + scheme_integer_type, /* 48 */ + scheme_bignum_type, /* 49 */ + scheme_rational_type, /* 50 */ + scheme_float_type, /* 51 */ + scheme_double_type, /* 52 */ + scheme_complex_type, /* 53 */ /* other eqv?-able values (must be with numbers) */ - scheme_char_type, /* 53 */ + scheme_char_type, /* 54 */ /* other values */ - scheme_long_double_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_primitive_syntax_type, /* 72 */ - scheme_macro_type, /* 73 */ - scheme_box_type, /* 74 */ - scheme_thread_type, /* 75 */ - scheme_cont_mark_set_type, /* 76 */ - scheme_sema_type, /* 77 */ + scheme_long_double_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_primitive_syntax_type, /* 73 */ + scheme_macro_type, /* 74 */ + scheme_box_type, /* 75 */ + scheme_thread_type, /* 76 */ + scheme_cont_mark_set_type, /* 77 */ + scheme_sema_type, /* 78 */ /* hash table types (must be together for hash? * implementation */ - scheme_hash_table_type, /* 78 */ - scheme_hash_tree_type, /* 79 */ - scheme_eq_hash_tree_type, /* 80 */ - scheme_eqv_hash_tree_type, /* 81 */ - scheme_hash_tree_subtree_type, /* 82 */ - scheme_hash_tree_collision_type, /* 83 */ - scheme_hash_tree_indirection_type, /* 84 */ - scheme_bucket_type, /* 85 */ - scheme_bucket_table_type, /* 86 */ + scheme_hash_table_type, /* 79 */ + scheme_hash_tree_type, /* 80 */ + scheme_eq_hash_tree_type, /* 81 */ + scheme_eqv_hash_tree_type, /* 82 */ + scheme_hash_tree_subtree_type, /* 83 */ + scheme_hash_tree_collision_type, /* 84 */ + scheme_hash_tree_indirection_type, /* 85 */ + scheme_bucket_type, /* 86 */ + scheme_bucket_table_type, /* 87 */ - scheme_cpointer_type, /* 87 */ - scheme_prefix_type, /* 88 */ - scheme_weak_box_type, /* 89 */ - scheme_ephemeron_type, /* 90 */ - scheme_struct_type_type, /* 91 */ - scheme_set_macro_type, /* 92 */ - scheme_listener_type, /* 93 */ - scheme_env_type, /* 94 */ - scheme_startup_env_type, /* 95 */ - scheme_config_type, /* 96 */ - scheme_stx_type, /* 97 */ - scheme_will_executor_type, /* 98 */ - scheme_custodian_type, /* 99 */ - scheme_random_state_type, /* 100 */ - scheme_regexp_type, /* 101 */ - scheme_subprocess_type, /* 102 */ - scheme_eval_waiting_type, /* 103 */ - scheme_tail_call_waiting_type, /* 104 */ - scheme_undefined_type, /* 105 */ - scheme_struct_property_type, /* 106 */ - scheme_chaperone_property_type, /* 107 */ - scheme_multiple_values_type, /* 108 */ - scheme_placeholder_type, /* 109 */ - scheme_table_placeholder_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_replace_evt_type, /* 122 */ - scheme_active_replace_evt_type, /* 123 */ - scheme_nack_guard_evt_type, /* 124 */ - scheme_semaphore_repost_type, /* 125 */ - scheme_channel_type, /* 126 */ - scheme_channel_put_type, /* 127 */ - scheme_thread_resume_type, /* 128 */ - scheme_thread_suspend_type, /* 129 */ - scheme_thread_dead_type, /* 130 */ - scheme_poll_evt_type, /* 131 */ - scheme_nack_evt_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_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_thread_cell_values_type, /* 146 */ - scheme_global_ref_type, /* 147 */ - scheme_cont_mark_chain_type, /* 148 */ - scheme_raw_pair_type, /* 149 */ - scheme_prompt_type, /* 150 */ - scheme_prompt_tag_type, /* 151 */ - scheme_continuation_mark_key_type, /* 152 */ - scheme_delay_syntax_type, /* 153 */ - scheme_cust_box_type, /* 154 */ - scheme_logger_type, /* 155 */ - scheme_log_reader_type, /* 156 */ - scheme_noninline_proc_type, /* 157 */ - scheme_future_type, /* 158 */ - scheme_flvector_type, /* 159 */ - scheme_extflvector_type, /* 160 */ - scheme_fxvector_type, /* 161 */ - scheme_place_type, /* 162 */ - scheme_place_object_type, /* 163 */ - scheme_place_async_channel_type, /* 164 */ - scheme_place_bi_channel_type, /* 165 */ - scheme_once_used_type, /* 166 */ - scheme_serialized_symbol_type, /* 167 */ - scheme_serialized_keyword_type, /* 168 */ - scheme_serialized_structure_type, /* 169 */ - scheme_fsemaphore_type, /* 170 */ - scheme_serialized_tcp_fd_type, /* 171 */ - scheme_serialized_file_fd_type, /* 172 */ - scheme_port_closed_evt_type, /* 173 */ - scheme_proc_shape_type, /* 174 */ - scheme_struct_prop_proc_shape_type, /* 175 */ - scheme_struct_proc_shape_type, /* 176 */ - scheme_phantom_bytes_type, /* 177 */ - scheme_environment_variables_type, /* 178 */ - scheme_filesystem_change_evt_type, /* 179 */ - scheme_ctype_type, /* 180 */ - scheme_plumber_type, /* 181 */ - scheme_plumber_handle_type, /* 182 */ - scheme_deferred_expr_type, /* 183 */ - scheme_unquoted_printing_string_type, /* 184 */ - scheme_will_be_lambda_type, /* 185 */ + scheme_cpointer_type, /* 88 */ + scheme_prefix_type, /* 89 */ + scheme_weak_box_type, /* 90 */ + scheme_ephemeron_type, /* 91 */ + scheme_struct_type_type, /* 92 */ + scheme_set_macro_type, /* 93 */ + scheme_listener_type, /* 94 */ + scheme_env_type, /* 95 */ + scheme_startup_env_type, /* 96 */ + scheme_config_type, /* 97 */ + scheme_stx_type, /* 98 */ + scheme_will_executor_type, /* 99 */ + scheme_custodian_type, /* 100 */ + scheme_random_state_type, /* 101 */ + scheme_regexp_type, /* 102 */ + scheme_subprocess_type, /* 103 */ + scheme_eval_waiting_type, /* 104 */ + scheme_tail_call_waiting_type, /* 105 */ + scheme_undefined_type, /* 106 */ + scheme_struct_property_type, /* 107 */ + scheme_chaperone_property_type, /* 108 */ + scheme_multiple_values_type, /* 109 */ + scheme_placeholder_type, /* 110 */ + scheme_table_placeholder_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_replace_evt_type, /* 123 */ + scheme_active_replace_evt_type, /* 124 */ + scheme_nack_guard_evt_type, /* 125 */ + scheme_semaphore_repost_type, /* 126 */ + scheme_channel_type, /* 127 */ + scheme_channel_put_type, /* 128 */ + scheme_thread_resume_type, /* 129 */ + scheme_thread_suspend_type, /* 130 */ + scheme_thread_dead_type, /* 131 */ + scheme_poll_evt_type, /* 132 */ + scheme_nack_evt_type, /* 133 */ + scheme_thread_set_type, /* 134 */ + scheme_string_converter_type, /* 135 */ + scheme_alarm_type, /* 136 */ + scheme_thread_recv_evt_type, /* 137 */ + scheme_thread_cell_type, /* 138 */ + scheme_channel_syncer_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_thread_cell_values_type, /* 147 */ + scheme_global_ref_type, /* 148 */ + scheme_cont_mark_chain_type, /* 149 */ + scheme_raw_pair_type, /* 150 */ + scheme_prompt_type, /* 151 */ + scheme_prompt_tag_type, /* 152 */ + scheme_continuation_mark_key_type, /* 153 */ + scheme_delay_syntax_type, /* 154 */ + scheme_cust_box_type, /* 155 */ + scheme_logger_type, /* 156 */ + scheme_log_reader_type, /* 157 */ + scheme_noninline_proc_type, /* 158 */ + scheme_future_type, /* 159 */ + scheme_flvector_type, /* 160 */ + scheme_extflvector_type, /* 161 */ + scheme_fxvector_type, /* 162 */ + scheme_place_type, /* 163 */ + scheme_place_object_type, /* 164 */ + scheme_place_async_channel_type, /* 165 */ + scheme_place_bi_channel_type, /* 166 */ + scheme_once_used_type, /* 167 */ + scheme_serialized_symbol_type, /* 168 */ + scheme_serialized_keyword_type, /* 169 */ + scheme_serialized_structure_type, /* 170 */ + scheme_fsemaphore_type, /* 171 */ + scheme_serialized_tcp_fd_type, /* 172 */ + scheme_serialized_file_fd_type, /* 173 */ + scheme_port_closed_evt_type, /* 174 */ + scheme_proc_shape_type, /* 175 */ + scheme_struct_prop_proc_shape_type, /* 176 */ + scheme_struct_proc_shape_type, /* 177 */ + scheme_phantom_bytes_type, /* 178 */ + scheme_environment_variables_type, /* 179 */ + scheme_filesystem_change_evt_type, /* 180 */ + scheme_ctype_type, /* 181 */ + scheme_plumber_type, /* 182 */ + scheme_plumber_handle_type, /* 183 */ + scheme_deferred_expr_type, /* 184 */ + scheme_unquoted_printing_string_type, /* 185 */ + scheme_will_be_lambda_type, /* 186 */ #ifdef MZTAG_REQUIRED - _scheme_last_normal_type_, /* 186 */ + _scheme_last_normal_type_, /* 187 */ /* The remaining tags exist for GC tracing (in non-conservative mode), but they are not needed for run-time tag tests */ - scheme_rt_weak_array, /* 187 */ + scheme_rt_weak_array, /* 188 */ - scheme_rt_comp_env, /* 188 */ - scheme_rt_constant_binding, /* 189 */ - scheme_rt_resolve_info, /* 190 */ - scheme_rt_unresolve_info, /* 191 */ - scheme_rt_optimize_info, /* 192 */ - scheme_rt_cont_mark, /* 193 */ - scheme_rt_saved_stack, /* 194 */ - scheme_rt_reply_item, /* 195 */ - scheme_rt_ir_lambda_info, /* 196 */ - scheme_rt_overflow, /* 197 */ - scheme_rt_overflow_jmp, /* 198 */ - scheme_rt_meta_cont, /* 199 */ - scheme_rt_dyn_wind_cell, /* 200 */ - scheme_rt_dyn_wind_info, /* 201 */ - scheme_rt_dyn_wind, /* 202 */ - scheme_rt_dup_check, /* 203 */ - scheme_rt_thread_memory, /* 204 */ - scheme_rt_input_file, /* 205 */ - scheme_rt_input_fd, /* 206 */ - scheme_rt_oskit_console_input, /* 207 */ - scheme_rt_tested_input_file, /* 208 */ - scheme_rt_tested_output_file, /* 209 */ - scheme_rt_indexed_string, /* 210 */ - scheme_rt_output_file, /* 211 */ - scheme_rt_pipe, /* 212 */ - scheme_rt_system_child, /* 213 */ - scheme_rt_tcp, /* 214 */ - scheme_rt_write_data, /* 215 */ - scheme_rt_tcp_select_info, /* 216 */ - scheme_rt_param_data, /* 217 */ - scheme_rt_will, /* 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_thread_hop_type, /* 224 */ - scheme_rt_srcloc, /* 225 */ - scheme_rt_evt, /* 226 */ - scheme_rt_syncing, /* 227 */ - scheme_rt_comp_prefix, /* 228 */ - scheme_rt_user_input, /* 229 */ - scheme_rt_user_output, /* 230 */ - scheme_rt_compact_port, /* 231 */ - scheme_rt_read_special_dw, /* 232 */ - scheme_rt_regwork, /* 233 */ - scheme_rt_rx_lazy_string, /* 234 */ - scheme_rt_buf_holder, /* 235 */ - scheme_rt_parameterization, /* 236 */ - scheme_rt_print_params, /* 237 */ - scheme_rt_read_params, /* 238 */ - scheme_rt_native_code, /* 239 */ - scheme_rt_native_code_plus_case, /* 240 */ - scheme_rt_jitter_data, /* 241 */ - scheme_rt_module_exports, /* 242 */ - scheme_rt_delay_load_info, /* 243 */ - scheme_rt_marshal_info, /* 244 */ - scheme_rt_unmarshal_info, /* 245 */ - scheme_rt_runstack, /* 246 */ - scheme_rt_sfs_info, /* 247 */ - scheme_rt_validate_clearing, /* 248 */ - scheme_rt_lightweight_cont, /* 249 */ - scheme_rt_export_info, /* 250 */ - scheme_rt_cont_jmp, /* 251 */ - scheme_rt_letrec_check_frame, /* 252 */ + scheme_rt_comp_env, /* 189 */ + scheme_rt_constant_binding, /* 190 */ + scheme_rt_resolve_info, /* 191 */ + scheme_rt_unresolve_info, /* 192 */ + scheme_rt_optimize_info, /* 193 */ + scheme_rt_cont_mark, /* 194 */ + scheme_rt_saved_stack, /* 195 */ + scheme_rt_reply_item, /* 196 */ + scheme_rt_ir_lambda_info, /* 197 */ + scheme_rt_overflow, /* 198 */ + scheme_rt_overflow_jmp, /* 199 */ + scheme_rt_meta_cont, /* 200 */ + scheme_rt_dyn_wind_cell, /* 201 */ + scheme_rt_dyn_wind_info, /* 202 */ + scheme_rt_dyn_wind, /* 203 */ + scheme_rt_dup_check, /* 204 */ + scheme_rt_thread_memory, /* 205 */ + scheme_rt_input_file, /* 206 */ + scheme_rt_input_fd, /* 207 */ + scheme_rt_oskit_console_input, /* 208 */ + scheme_rt_tested_input_file, /* 209 */ + scheme_rt_tested_output_file, /* 210 */ + scheme_rt_indexed_string, /* 211 */ + scheme_rt_output_file, /* 212 */ + scheme_rt_pipe, /* 213 */ + scheme_rt_system_child, /* 214 */ + scheme_rt_tcp, /* 215 */ + scheme_rt_write_data, /* 216 */ + scheme_rt_tcp_select_info, /* 217 */ + scheme_rt_param_data, /* 218 */ + scheme_rt_will, /* 219 */ + scheme_rt_finalization, /* 220 */ + scheme_rt_finalizations, /* 221 */ + scheme_rt_cpp_object, /* 222 */ + scheme_rt_cpp_array_object, /* 223 */ + scheme_rt_stack_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_lightweight_cont, /* 250 */ + scheme_rt_export_info, /* 251 */ + scheme_rt_cont_jmp, /* 252 */ + scheme_rt_letrec_check_frame, /* 253 */ #endif _scheme_last_type_ diff --git a/racket/src/racket/src/type.c b/racket/src/racket/src/type.c index 780199aa65..e9e72110fe 100644 --- a/racket/src/racket/src/type.c +++ b/racket/src/racket/src/type.c @@ -101,6 +101,7 @@ scheme_init_type () set_name(scheme_local_unbox_type, ""); set_name(scheme_variable_type, ""); set_name(scheme_toplevel_type, ""); + set_name(scheme_static_toplevel_type, ""); set_name(scheme_application_type, ""); set_name(scheme_application2_type, ""); set_name(scheme_application3_type, ""); @@ -529,6 +530,7 @@ static void FIXUP_jmpup(Scheme_Jumpup_Buf *buf, struct NewGC *gc) void scheme_register_traversers(void) { GC_REG_TRAV(scheme_toplevel_type, toplevel_obj); + GC_REG_TRAV(scheme_static_toplevel_type, static_toplevel_obj); GC_REG_TRAV(scheme_variable_type, variable_obj); GC_REG_TRAV(scheme_local_type, local_obj); GC_REG_TRAV(scheme_local_unbox_type, local_obj);