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

compile expander in "static" linklet mode

Browse Source 
The expander as a linklet will be instantiated once, so there's no
need to capture references in closures among functions within the
expander. Add a "static" linklet compilation mode to inline the
variable addresses that would otherwise be referenced via a closure.

Although the change is intended to speed up the expander by avoiding
some indrections, it also reduces the bytecode size of the expander.
Bitmaps that track which linklet variables are used in closures turn
out to have been about 25% of the expander's bytecode size, since the
linklet has so many definitions.
This commit is contained in:
Matthew Flatt 2018-03-16 19:16:11 -06:00
parent ad3ab8b352
commit 37a985a681
28 changed files with 904 additions and 418 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
pkgs/base/info.rkt
View File

@ -12,7 +12,7 @@
(define collection 'multi) (define collection 'multi)
(define version "6.90.0.22") (define version "6.90.0.23")
(define deps `("racket-lib" (define deps `("racket-lib"
["racket" #:version ,version])) ["racket" #:version ,version]))

40
pkgs/racket-doc/scribblings/reference/linklet.scrbl
View File

@ -120,8 +120,7 @@ otherwise.}
[name any/c #f] [name any/c #f]
[import-keys #f #f] [import-keys #f #f]
[get-import #f #f] [get-import #f #f]
[serializable? any/c #t] [options (listof (or/c 'serializable 'unsafe 'static)) '(serializable)])
[unsafe-mode? any/c #f])
linklet?] linklet?]
[(compile-linklet [form (or/c correlated? any/c)] [(compile-linklet [form (or/c correlated? any/c)]
[name any/c] [name any/c]
@ -129,13 +128,12 @@ otherwise.}
[get-import (or/c #f (any/c . -> . (values (or/c linklet? instance? #f) [get-import (or/c #f (any/c . -> . (values (or/c linklet? instance? #f)
(or/c vector? #f)))) (or/c vector? #f))))
#f] #f]
[serializable? any/c #t] [options (listof (or/c 'serializable 'unsafe 'static)) '(serializable)])
[unsafe-mode? any/c #f])
(values linklet? vector?)])]{ (values linklet? vector?)])]{
Takes an S-expression or @tech{correlated object} for a Takes an S-expression or @tech{correlated object} for a
@schemeidfont{linklet} form and produces a @tech{linklet}. @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 resulting linklet can be marshaled to and from a byte stream when it is
part of a @tech{linklet bundle}. 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} returned linklet. Any key that is @racket[#f] or a @tech{linklet instance}
must be preserved intact, however. must be preserved intact, however.
If @racket[unsafe-mode?] is true, then the linklet is compiled in If @racket['unsafe] is included in @racket[options], then the linklet
@deftech{unsafe mode}: uses of safe operations within the linklet can is compiled in @deftech{unsafe mode}: uses of safe operations within
be converted to unsafe operations on the assumption that the relevant the linklet can be converted to unsafe operations on the assumption
contracts are satisfied. For example, @racket[car] is converted to that the relevant contracts are satisfied. For example, @racket[car]
@racket[unsafe-car]. Some substituted unsafe operations may not have is converted to @racket[unsafe-car]. Some substituted unsafe
directly accessible names, such as the unsafe variant of operations may not have directly accessible names, such as the unsafe
@racket[in-list] that can be substituted in @tech{unsafe mode}. An variant of @racket[in-list] that can be substituted in @tech{unsafe
unsafe operation is substituted only if its (unchecked) contract is mode}. An unsafe operation is substituted only if its (unchecked)
subsumed by the safe operation's contract. The fact that the linklet contract is subsumed by the safe operation's contract. The fact that
is compiled in @tech{unsafe mode} can be exposed through the linklet is compiled in @tech{unsafe mode} can be exposed through
@racket[variable-reference-from-unsafe?] using a variable reference @racket[variable-reference-from-unsafe?] using a variable reference
produced by a @racket[#%variable-reference] form within the module 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?] @defproc*[([(recompile-linklet [linklet linklet?]

32
pkgs/zo-lib/compiler/zo-marshal.rkt
View File

@ -257,22 +257,22 @@
;; ---------------------------------------- ;; ----------------------------------------
(define toplevel-type-num 0) (define toplevel-type-num 0)
(define sequence-type-num 6) (define sequence-type-num 7)
(define unclosed-procedure-type-num 8) (define unclosed-procedure-type-num 9)
(define let-value-type-num 9) (define let-value-type-num 10)
(define let-void-type-num 10) (define let-void-type-num 11)
(define letrec-type-num 11) (define letrec-type-num 12)
(define wcm-type-num 13) (define wcm-type-num 14)
(define define-values-type-num 14) (define define-values-type-num 15)
(define set-bang-type-num 15) (define set-bang-type-num 16)
(define boxenv-type-num 16) (define boxenv-type-num 17)
(define begin0-sequence-type-num 17) (define begin0-sequence-type-num 18)
(define varref-form-type-num 18) (define varref-form-type-num 19)
(define apply-values-type-num 19) (define apply-values-type-num 20)
(define with-immed-mark-type-num 20) (define with-immed-mark-type-num 21)
(define case-lambda-sequence-type-num 21) (define case-lambda-sequence-type-num 22)
(define inline-variants-type-num 22) (define inline-variants-type-num 23)
(define linklet-type-num 24) (define linklet-type-num 25)
(define-syntax define-enum (define-syntax define-enum
(syntax-rules () (syntax-rules ()

48
pkgs/zo-lib/compiler/zo-parse.rkt
View File

@ -190,22 +190,24 @@
(define (int->type i) (define (int->type i)
(case i (case i
[(0) 'toplevel-type] [(0) 'toplevel-type]
[(6) 'sequence-type] [(1) 'static-toplevel-type]
[(8) 'unclosed-procedure-type] [(7) 'sequence-type]
[(9) 'let-value-type] [(9) 'unclosed-procedure-type]
[(10) 'let-void-type] [(10) 'let-value-type]
[(11) 'letrec-type] [(11) 'let-void-type]
[(13) 'with-cont-mark-type] [(12) 'letrec-type]
[(14) 'define-values-type] [(14) 'with-cont-mark-type]
[(15) 'set-bang-type] [(15) 'define-values-type]
[(16) 'boxenv-type] [(16) 'set-bang-type]
[(17) 'begin0-sequence-type] [(17) 'boxenv-type]
[(18) 'varref-form-type] [(18) 'begin0-sequence-type]
[(19) 'apply-values-type] [(19) 'varref-form-type]
[(20) 'with-immed-mark-type] [(20) 'apply-values-type]
[(21) 'case-lambda-sequence-type] [(21) 'with-immed-mark-type]
[(22) 'inline-variant-type] [(22) 'case-lambda-sequence-type]
[(24) 'linklet-type] [(23) 'inline-variant-type]
[(25) 'linklet-type]
[(89) 'prefix-type]
[else (error 'int->type "unknown type: ~e" i)])) [else (error 'int->type "unknown type: ~e" i)]))
;; ---------------------------------------- ;; ----------------------------------------
@ -477,8 +479,8 @@
(vector->immutable-vector (list->vector lst)))] (vector->immutable-vector (list->vector lst)))]
[(pair) [(pair)
(let* ([a (read-compact cp)] (let* ([a (read-compact cp)]
[d (read-compact cp)]) [d (read-compact cp)])
(cons a d))] (cons a d))]
[(list) [(list)
(let ([len (read-compact-number cp)]) (let ([len (read-compact-number cp)])
(let loop ([i len]) (let loop ([i len])
@ -503,6 +505,9 @@
(cons (read-compact cp) (cons (read-compact cp)
(read-compact cp)))))] (read-compact cp)))))]
[(linklet) [(linklet)
(unless (zero? (read-compact-number cp))
;; read and ignore the static-prefix placeholder
(read-compact cp))
(read-linklet (read-compact cp))] (read-linklet (read-compact cp))]
[(local local-unbox) [(local local-unbox)
(let ([c (read-compact-number cp)] (let ([c (read-compact-number cp)]
@ -642,6 +647,13 @@
[(other-form) [(other-form)
(define type (read-compact-number cp)) (define type (read-compact-number cp))
(case (int->type type) (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) [(boxenv-type)
(make-boxenv (read-compact cp) (read-compact cp))] (make-boxenv (read-compact cp) (read-compact cp))]
[(with-immed-mark-type) [(with-immed-mark-type)

2
racket/src/expander/compile/form.rkt
View File

@ -252,7 +252,7 @@
((if to-source? ((if to-source?
(lambda (l name keys getter) (values l keys)) (lambda (l name keys getter) (values l keys))
(lambda (l name keys getter) (lambda (l name keys getter)
(compile-linklet l name keys getter serializable?))) (compile-linklet l name keys getter (if serializable? '(serializable) '()))))
`(linklet `(linklet
;; imports ;; imports
(,@body-imports (,@body-imports

2
racket/src/expander/compile/module.rkt
View File

@ -227,7 +227,7 @@
empty-syntax-literals-data-instance empty-syntax-literals-data-instance
empty-instance-instance) empty-instance-instance)
(lambda (inst) (values inst #f)) (lambda (inst) (values inst #f))
serializable?)) (if serializable? '(serializable) '())))
linklet))) linklet)))
`(linklet `(linklet
;; imports ;; imports

2
racket/src/expander/run/linklet.rkt
View File

@ -301,7 +301,7 @@
(define linklet-compile-to-s-expr (make-parameter #f)) (define linklet-compile-to-s-expr (make-parameter #f))
;; Compile to a serializable form ;; 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 (define l
(cond (cond
[(linklet-compile-to-s-expr) [(linklet-compile-to-s-expr)

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

@ -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; 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 *toplevels_ht);
THREAD_LOCAL_DECL(static Scheme_Hash_Table *locals_ht[2]); 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 = (Scheme_Toplevel *)scheme_malloc_atomic_tagged(sizeof(Scheme_Toplevel));
tl->iso.so.type = scheme_toplevel_type; tl->iso.so.type = scheme_toplevel_type;
tl->depth = depth; tl->u.depth = depth;
tl->position = position; tl->position = position;
SCHEME_TOPLEVEL_FLAGS(tl) = flags | HIGH_BIT_TO_DISABLE_HASHING; 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_Object *scheme_toplevel_to_flagged_toplevel(Scheme_Object *_tl, int flags)
{ {
Scheme_Toplevel *tl = (Scheme_Toplevel *)_tl; if (SAME_TYPE(SCHEME_TYPE(_tl), scheme_static_toplevel_type)) {
return scheme_make_toplevel(tl->depth, tl->position, flags); 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) 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)); v = (Scheme_Toplevel *)scheme_malloc_eternal_tagged(sizeof(Scheme_Toplevel));
#endif #endif
v->iso.so.type = scheme_toplevel_type; v->iso.so.type = scheme_toplevel_type;
v->depth = i; v->u.depth = i;
v->position = k; v->position = k;
SCHEME_TOPLEVEL_FLAGS(v) = cnst | HIGH_BIT_TO_DISABLE_HASHING; SCHEME_TOPLEVEL_FLAGS(v) = cnst | HIGH_BIT_TO_DISABLE_HASHING;

5
racket/src/racket/src/compile-startup.rkt
View File

@ -85,9 +85,8 @@
(define-values (correlated-property) (hash-ref (primitive-table '#%kernel) 'syntax-property)) (define-values (correlated-property) (hash-ref (primitive-table '#%kernel) 'syntax-property))
(define-values (linklet) (compile-linklet (rename-functions (get-linklet src)) (define-values (linklet) (compile-linklet (rename-functions (get-linklet src))
#f #f #f #f #f #f #f
;; Unsafe mode: '(serializable unsafe static)))
#t))
(define-values (DIGS-PER-LINE) 20) (define-values (DIGS-PER-LINE) 20)

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

@ -1659,8 +1659,11 @@ static Scheme_Object *define_values_execute(Scheme_Object *vec)
Scheme_Prefix *toplevels; Scheme_Prefix *toplevels;
var = SCHEME_VEC_ELS(vec)[i+delta]; var = SCHEME_VEC_ELS(vec)[i+delta];
toplevels = (Scheme_Prefix *)MZ_RUNSTACK[SCHEME_TOPLEVEL_DEPTH(var)]; if (SAME_TYPE(SCHEME_TYPE(var), scheme_toplevel_type)) {
b = (Scheme_Bucket *)toplevels->a[SCHEME_TOPLEVEL_POS(var)]; 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); 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; Scheme_Prefix *toplevels;
var = SCHEME_VEC_ELS(vec)[delta]; var = SCHEME_VEC_ELS(vec)[delta];
toplevels = (Scheme_Prefix *)MZ_RUNSTACK[SCHEME_TOPLEVEL_DEPTH(var)]; if (SAME_TYPE(SCHEME_TYPE(var), scheme_toplevel_type)) {
b = (Scheme_Bucket *)toplevels->a[SCHEME_TOPLEVEL_POS(var)]; 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); 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); val = _scheme_eval_linked_expr(sb->val);
toplevels = (Scheme_Prefix *)MZ_RUNSTACK[SCHEME_TOPLEVEL_DEPTH(sb->var)]; if (SAME_TYPE(SCHEME_TYPE(sb->var), scheme_toplevel_type)) {
var = (Scheme_Bucket *)toplevels->a[SCHEME_TOPLEVEL_POS(sb->var)]; 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); scheme_set_global_bucket("set!", var, val, sb->set_undef);
return scheme_void; return scheme_void;
@ -2721,6 +2730,17 @@ scheme_do_eval(Scheme_Object *obj, int num_rands, Scheme_Object **rands,
global_lookup(v = , obj, v); global_lookup(v = , obj, v);
goto returnv_never_multi; 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: case scheme_local_type:
{ {
v = RUNSTACK[SCHEME_LOCAL_POS(obj)]; v = RUNSTACK[SCHEME_LOCAL_POS(obj)];

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

@ -419,6 +419,7 @@ static int is_short(Scheme_Object *obj, int fuel)
return is_short(branch->fbranch, fuel); return is_short(branch->fbranch, fuel);
} }
case scheme_toplevel_type: case scheme_toplevel_type:
case scheme_static_toplevel_type:
case scheme_local_type: case scheme_local_type:
case scheme_local_unbox_type: case scheme_local_unbox_type:
case scheme_lambda_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); c = scheme_extract_global(obj, jitter->nc, 0);
if (c) { if (c) {
c = ((Scheme_Bucket *)c)->val; c = ((Scheme_Bucket *)c)->val;
@ -509,6 +511,14 @@ Scheme_Object *scheme_specialize_to_constant(Scheme_Object *obj, mz_jit_state *j
return c; 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; 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)) { if (SAME_TYPE(SCHEME_TYPE(a), scheme_local_type)) {
int pos = SCHEME_LOCAL_POS(a) - stack_start; int pos = SCHEME_LOCAL_POS(a) - stack_start;
if (pos >= 0) { 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)) { if (depth && SAME_TYPE(SCHEME_TYPE(a), scheme_closure_type)) {
Scheme_Lambda *lam; Scheme_Lambda *lam;
@ -682,6 +708,7 @@ int scheme_is_simple(Scheme_Object *obj, int depth, int just_markless, mz_jit_st
break; break;
case scheme_toplevel_type: case scheme_toplevel_type:
case scheme_static_toplevel_type:
case scheme_local_type: case scheme_local_type:
case scheme_local_unbox_type: case scheme_local_unbox_type:
case scheme_lambda_type: case scheme_lambda_type:
@ -742,6 +769,12 @@ int scheme_is_non_gc(Scheme_Object *obj, int depth)
break; break;
case scheme_toplevel_type: 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; break;
case scheme_lambda_type: case scheme_lambda_type:
break; 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; return 0;
@ -830,7 +872,8 @@ int scheme_can_delay_and_avoids_r1(Scheme_Object *obj)
{ {
Scheme_Type t = SCHEME_TYPE(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) return (((SCHEME_TOPLEVEL_FLAGS(obj) & SCHEME_TOPLEVEL_FLAGS_MASK) >= SCHEME_TOPLEVEL_FIXED)
? 1 ? 1
: 0); : 0);
@ -842,7 +885,8 @@ int scheme_is_constant_and_avoids_r1(Scheme_Object *obj)
{ {
Scheme_Type t = SCHEME_TYPE(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) return (((SCHEME_TOPLEVEL_FLAGS(obj) & SCHEME_TOPLEVEL_FLAGS_MASK) >= SCHEME_TOPLEVEL_FIXED)
? 1 ? 1
: 0); : 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)) else if (SAME_TYPE(t, scheme_local_type))
return ((SCHEME_LOCAL_POS(wrt) != pos) return ((SCHEME_LOCAL_POS(wrt) != pos)
|| !(SCHEME_GET_LOCAL_FLAGS(wrt) == SCHEME_LOCAL_CLEAR_ON_READ)); || !(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; return 1;
else if (t == scheme_application2_type) { else if (t == scheme_application2_type) {
Scheme_App2_Rec *app = (Scheme_App2_Rec *)wrt; 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 && !jitter->unbox
&& !IS_SKIP_TYPE(SCHEME_TYPE(obj)) && !IS_SKIP_TYPE(SCHEME_TYPE(obj))
&& !SAME_TYPE(SCHEME_TYPE(obj), scheme_toplevel_type) && !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_type)
&& !SAME_TYPE(SCHEME_TYPE(obj), scheme_local_unbox_type) && !SAME_TYPE(SCHEME_TYPE(obj), scheme_local_unbox_type)
&& (SCHEME_TYPE(obj) < _scheme_values_types_)) { && (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); if (for_branch) finish_branch(jitter, target, for_branch);
return 1; 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: case scheme_local_type:
{ {
/* Other parts of the JIT rely on this code modifying only the target register, /* 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); scheme_generate_non_tail(p, jitter, 0, 1, 0);
CHECK_LIMIT(); CHECK_LIMIT();
mz_rs_sync(); mz_rs_sync();
/* Load prefix: */ if (SAME_TYPE(SCHEME_TYPE(v), scheme_toplevel_type)) {
pos = mz_remap(SCHEME_TOPLEVEL_DEPTH(v)); /* Load prefix: */
mz_rs_ldxi(JIT_R2, pos); pos = mz_remap(SCHEME_TOPLEVEL_DEPTH(v));
/* Extract bucket from prefix: */ mz_rs_ldxi(JIT_R2, pos);
pos = SCHEME_TOPLEVEL_POS(v); /* Extract bucket from prefix: */
jit_ldxi_p(JIT_R2, JIT_R2, &(((Scheme_Prefix *)0x0)->a[pos])); 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(); CHECK_LIMIT();
/* R0 has values, R2 has bucket */ /* 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? */ /* 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_toplevel_pos = SCHEME_TOPLEVEL_POS(lam->context);
jitter->self_closure_size = lam->closure_size; jitter->self_closure_size = lam->closure_size;
} }

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

@ -201,6 +201,7 @@ static int is_unboxing_immediate(Scheme_Object *obj, int unsafely, int extfl)
#endif #endif
return unsafely; return unsafely;
case scheme_toplevel_type: case scheme_toplevel_type:
case scheme_static_toplevel_type:
/* Can generalize to allow any toplevel if scheme_generate_pop_unboxed() is fixed */ /* 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) if ((SCHEME_TOPLEVEL_FLAGS(obj) & SCHEME_TOPLEVEL_FLAGS_MASK) < SCHEME_TOPLEVEL_READY)
return 0; return 0;

25
racket/src/racket/src/jitcall.c
View File

@ -1856,26 +1856,33 @@ int scheme_generate_app(Scheme_App_Rec *app, Scheme_Object **alt_rands, int num_
} }
} }
} }
} else if (t == scheme_toplevel_type) { } else if ((t == scheme_toplevel_type) || (t == scheme_static_toplevel_type)) {
if ((SCHEME_TOPLEVEL_FLAGS(rator) & SCHEME_TOPLEVEL_FLAGS_MASK) >= SCHEME_TOPLEVEL_FIXED) { int flags = SCHEME_TOPLEVEL_FLAGS(rator);
if ((flags & SCHEME_TOPLEVEL_FLAGS_MASK) >= SCHEME_TOPLEVEL_FIXED) {
/* We can re-order evaluation of the rator. */ /* We can re-order evaluation of the rator. */
reorder_ok = 1; reorder_ok = 1;
if (jitter->nc 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; 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) { if (p) {
p = ((Scheme_Bucket *)p)->val; p = ((Scheme_Bucket *)p)->val;
if (can_direct_native(p, num_rands, &extract_case)) { if (can_direct_native(p, num_rands, &extract_case)) {
int pos = SCHEME_TOPLEVEL_POS(rator);
direct_native = 1; direct_native = 1;
if ((SCHEME_TOPLEVEL_POS(rator) == jitter->self_toplevel_pos) if ((pos == jitter->self_toplevel_pos)
&& (num_rands < MAX_SHARED_CALL_RANDS)) { && (num_rands < MAX_SHARED_CALL_RANDS)) {
if (is_tail) if (is_tail) {
direct_self = 1; direct_self = 1;
else if (jitter->self_nontail_code) } else if (jitter->self_nontail_code)
nontail_self = 1; nontail_self = 1;
} }
} }

13
racket/src/racket/src/jitinline.c
View File

@ -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_extract_global(o, jitter->nc, 0);
p = ((Scheme_Bucket *)p)->val; p = ((Scheme_Bucket *)p)->val;
return check_val_struct_prim(p, arity); 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)) { } else if (SAME_TYPE(SCHEME_TYPE(o), scheme_local_type)) {
Scheme_Object *p; Scheme_Object *p;
p = scheme_extract_closure_local(o, jitter, extra_push, 0); 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; 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); 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); rator = scheme_extract_global(rator, jitter->nc, 0);
if (rator) if (rator)
return ((Scheme_Bucket *)rator)->val; 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; 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")) { } else if (IS_NAMED_PRIM(rator, "syntax-e")) {
GC_CAN_IGNORE jit_insn *reffail = NULL, *ref; 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); mz_runstack_skipped(jitter, 1);

102
racket/src/racket/src/linklet.c
View File

@ -34,6 +34,9 @@ SHARED_OK Scheme_Hash_Tree *empty_hash_tree;
SHARED_OK static int validate_compile_result = 0; SHARED_OK static int validate_compile_result = 0;
SHARED_OK static int recompile_every_compile = 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 *constant_symbol;
static Scheme_Object *consistent_symbol; static Scheme_Object *consistent_symbol;
static Scheme_Object *noncm_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 *name,
Scheme_Object **_import_keys, Scheme_Object **_import_keys,
Scheme_Object *get_import, 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, static Scheme_Object *_instantiate_linklet_multi(Scheme_Linklet *linklet, Scheme_Instance *instance,
int num_instances, Scheme_Instance **instances, int num_instances, Scheme_Instance **instances,
@ -117,6 +120,13 @@ void scheme_init_linklet(Scheme_Startup_Env *env)
register_traversers(); register_traversers();
#endif #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(constant_symbol);
REGISTER_SO(consistent_symbol); REGISTER_SO(consistent_symbol);
constant_symbol = scheme_intern_symbol("constant"); 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_IMMED_PRIM("primitive-in-category?", primitive_in_category_p, 2, 2, env);
ADD_FOLDING_PRIM("linklet?", linklet_p, 1, 1, 1, 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_PRIM_W_ARITY2("recompile-linklet", recompile_linklet, 1, 4, 2, 2, env);
ADD_IMMED_PRIM("eval-linklet", eval_linklet, 1, 1, env); ADD_IMMED_PRIM("eval-linklet", eval_linklet, 1, 1, env);
ADD_PRIM_W_ARITY("read-compiled-linklet", read_compiled_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) static Scheme_Object *compile_linklet(int argc, Scheme_Object **argv)
{ {
Scheme_Object *name, *e, *import_keys, *get_import, *a[2]; Scheme_Object *name, *e, *import_keys, *get_import, *a[2];
int unsafe; int unsafe = 0, static_mode = 0;
/* Last argument, `serializable?`, is ignored */ /* Last argument, `serializable?`, is ignored */
@ -380,11 +390,40 @@ static Scheme_Object *compile_linklet(int argc, Scheme_Object **argv)
if (!SCHEME_STXP(e)) if (!SCHEME_STXP(e))
e = scheme_datum_to_syntax(e, scheme_false, DTS_CAN_GRAPH); 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, static_mode);
e = (Scheme_Object *)compile_and_or_optimize_linklet(e, NULL, name, &import_keys, get_import, unsafe);
if (import_keys) { if (import_keys) {
a[0] = e; a[0] = e;
@ -422,7 +461,7 @@ static Scheme_Object *recompile_linklet(int argc, Scheme_Object **argv)
NULL); 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) { if (import_keys) {
a[0] = (Scheme_Object *)linklet; 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, static Scheme_Linklet *compile_and_or_optimize_linklet(Scheme_Object *form, Scheme_Linklet *linklet,
Scheme_Object *name, Scheme_Object *name,
Scheme_Object **_import_keys, Scheme_Object *get_import, Scheme_Object **_import_keys, Scheme_Object *get_import,
int unsafe_mode) int unsafe_mode, int static_mode)
{ {
Scheme_Config *config; Scheme_Config *config;
int enforce_const, set_undef, can_inline; 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, linklet = scheme_optimize_linklet(linklet, enforce_const, can_inline, unsafe_mode,
_import_keys, get_import); _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); linklet = scheme_sfs_linklet(linklet);
if (recompile_every_compile) { 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_unresolve_linklet(linklet, (set_undef ? COMP_ALLOW_SET_UNDEFINED : 0));
linklet = scheme_optimize_linklet(linklet, enforce_const, can_inline, unsafe_mode, linklet = scheme_optimize_linklet(linklet, enforce_const, can_inline, unsafe_mode,
_import_keys, get_import); _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); 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) 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 */ /* 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, static Scheme_Hash_Tree *push_prefix(Scheme_Linklet *linklet, Scheme_Instance *instance,
int num_instances, Scheme_Instance **instances, int num_instances, Scheme_Instance **instances,
Scheme_Hash_Tree *source_names) Scheme_Hash_Tree *source_names)
{ {
Scheme_Object **rs, *v; Scheme_Object **rs, *v;
Scheme_Prefix *pf; 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; GC_CAN_IGNORE const char *bad_reason = NULL;
rs = MZ_RUNSTACK; 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_importss = SCHEME_VEC_SIZE(linklet->importss);
num_defns = SCHEME_VEC_SIZE(linklet->defns); num_defns = SCHEME_VEC_SIZE(linklet->defns);
i = 1 + linklet->num_total_imports + num_defns; pf = linklet->static_prefix;
tl_map_len = (i + 31) / 32; 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; --rs;
MZ_RUNSTACK = rs; MZ_RUNSTACK = rs;
rs[0] = (Scheme_Object *)pf; rs[0] = (Scheme_Object *)pf;

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

@ -21,6 +21,7 @@ static int mark_resolve_info_MARK(void *p, struct NewGC *gc) {
gcMARK2(i->toplevel_starts, gc); gcMARK2(i->toplevel_starts, gc);
gcMARK2(i->toplevel_deltas, gc); gcMARK2(i->toplevel_deltas, gc);
gcMARK2(i->toplevel_defns, gc); gcMARK2(i->toplevel_defns, gc);
gcMARK2(i->static_mode, gc);
# ifdef GC_NO_SIZE_NEEDED_FROM_PROCS # ifdef GC_NO_SIZE_NEEDED_FROM_PROCS
return 0; 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_starts, gc);
gcFIXUP2(i->toplevel_deltas, gc); gcFIXUP2(i->toplevel_deltas, gc);
gcFIXUP2(i->toplevel_defns, gc); gcFIXUP2(i->toplevel_defns, gc);
gcFIXUP2(i->static_mode, gc);
# ifdef GC_NO_SIZE_NEEDED_FROM_PROCS # ifdef GC_NO_SIZE_NEEDED_FROM_PROCS
return 0; return 0;

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

@ -158,6 +158,42 @@ static int toplevel_obj_FIXUP(void *p, struct NewGC *gc) {
#define toplevel_obj_IS_CONST_SIZE 1 #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) { static int cpointer_obj_SIZE(void *p, struct NewGC *gc) {
#ifndef GC_NO_SIZE_NEEDED_FROM_PROCS #ifndef GC_NO_SIZE_NEEDED_FROM_PROCS
(SCHEME_CPTR_HAS_OFFSET(p) (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->source_names, gc);
gcMARK2(l->bodies, gc); gcMARK2(l->bodies, gc);
gcMARK2(l->constants, gc); gcMARK2(l->constants, gc);
gcMARK2(l->static_prefix, gc);
# ifdef GC_NO_SIZE_NEEDED_FROM_PROCS # ifdef GC_NO_SIZE_NEEDED_FROM_PROCS
return 0; return 0;
# else # else
@ -3490,6 +3527,7 @@ static int linklet_val_FIXUP(void *p, struct NewGC *gc) {
gcFIXUP2(l->source_names, gc); gcFIXUP2(l->source_names, gc);
gcFIXUP2(l->bodies, gc); gcFIXUP2(l->bodies, gc);
gcFIXUP2(l->constants, gc); gcFIXUP2(l->constants, gc);
gcFIXUP2(l->static_prefix, gc);
# ifdef GC_NO_SIZE_NEEDED_FROM_PROCS # ifdef GC_NO_SIZE_NEEDED_FROM_PROCS
return 0; return 0;
# else # else

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

@ -36,6 +36,13 @@ toplevel_obj {
gcBYTES_TO_WORDS(sizeof(Scheme_Toplevel)); 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 { cpointer_obj {
mark: mark:
if (!(SCHEME_CPTR_FLAGS(p) & 0x1)) { if (!(SCHEME_CPTR_FLAGS(p) & 0x1)) {
@ -984,6 +991,7 @@ linklet_val {
gcMARK2(l->source_names, gc); gcMARK2(l->source_names, gc);
gcMARK2(l->bodies, gc); gcMARK2(l->bodies, gc);
gcMARK2(l->constants, gc); gcMARK2(l->constants, gc);
gcMARK2(l->static_prefix, gc);
size: size:
gcBYTES_TO_WORDS(sizeof(Scheme_Linklet)); gcBYTES_TO_WORDS(sizeof(Scheme_Linklet));
} }
@ -1127,6 +1135,7 @@ mark_resolve_info {
gcMARK2(i->toplevel_starts, gc); gcMARK2(i->toplevel_starts, gc);
gcMARK2(i->toplevel_deltas, gc); gcMARK2(i->toplevel_deltas, gc);
gcMARK2(i->toplevel_defns, gc); gcMARK2(i->toplevel_defns, gc);
gcMARK2(i->static_mode, gc);
size: size:
gcBYTES_TO_WORDS(sizeof(Resolve_Info)); gcBYTES_TO_WORDS(sizeof(Resolve_Info));

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

@ -519,10 +519,11 @@ int scheme_omittable_expr(Scheme_Object *o, int vals, int fuel, int flags,
return ((vals == 1) || (vals < 0)); 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); note_match(1, vals, warn_info);
if (!(flags & OMITTABLE_KEEP_VARS) && (flags & OMITTABLE_RESOLVED) && ((vals == 1) || (vals < 0))) { 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; return 1;
else else
return 0; return 0;
@ -1356,14 +1357,18 @@ static int is_ok_value(Ok_Value_Callback ok_value, void *data,
if (v) if (v)
return ok_value(data, v, OK_CONSTANT_SHAPE); 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); pos = SCHEME_TOPLEVEL_POS(arg);
if (runstack) { if (runstack) {
/* This is eval mode; conceptually, this code belongs in /* This is eval mode; conceptually, this code belongs in
define_execute_with_dynamic_state() */ define_execute_with_dynamic_state() */
Scheme_Bucket *b; Scheme_Bucket *b;
Scheme_Prefix *toplevels; 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]; b = (Scheme_Bucket *)toplevels->a[pos];
if (b->val && (((Scheme_Bucket_With_Flags *)b)->flags & GLOB_IS_CONSISTENT)) if (b->val && (((Scheme_Bucket_With_Flags *)b)->flags & GLOB_IS_CONSISTENT))
return ok_value(data, b->val, OK_CONSTANT_VALUE); 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)) { switch (SCHEME_TYPE(expr)) {
case scheme_toplevel_type: case scheme_toplevel_type:
case scheme_static_toplevel_type:
return ((SCHEME_TOPLEVEL_FLAGS(expr) & SCHEME_TOPLEVEL_FLAGS_MASK) >= SCHEME_TOPLEVEL_FIXED); return ((SCHEME_TOPLEVEL_FLAGS(expr) & SCHEME_TOPLEVEL_FLAGS_MASK) >= SCHEME_TOPLEVEL_FIXED);
case scheme_ir_local_type: case scheme_ir_local_type:
{ {

41
racket/src/racket/src/print.c
View File

@ -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, pos);
print_compact_number(pp, depth); 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 else if (compact
&& (SAME_TYPE(SCHEME_TYPE(obj), scheme_local_type) && (SAME_TYPE(SCHEME_TYPE(obj), scheme_local_type)
|| SAME_TYPE(SCHEME_TYPE(obj), scheme_local_unbox_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; Scheme_Object *v;
print_compact(pp, CPT_LINKLET); 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); v = scheme_write_linklet(obj);
closed = print(v, notdisplay, 1, NULL, mt, pp); closed = print(v, notdisplay, 1, NULL, mt, pp);

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

@ -2327,8 +2327,11 @@ typedef struct CPort {
mzlonglong bytecode_hash; mzlonglong bytecode_hash;
} CPort; } CPort;
#define CP_GETC(cp) ((int)(cp->start[cp->pos++])) #define CP_GETC(cp) ((int)(cp->start[cp->pos++]))
#define CP_UNGETC(cp) --cp->pos
#define CP_TELL(port) (port->pos + port->base) #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_list(int c, int proper, int use_stack, CPort *port);
static Scheme_Object *read_compact_quote(CPort *port, int embedded); 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; break;
case CPT_LINKLET: 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 = read_compact(port, 1);
v = scheme_read_linklet(v, port->unsafe_ok); v = scheme_read_linklet(v, port->unsafe_ok);
if (!v) scheme_ill_formed_code(port); if (!v) scheme_ill_formed_code(port);
((Scheme_Linklet *)v)->static_prefix = pf;
return v; return v;
} }
break; break;
@ -3010,7 +3025,8 @@ static Scheme_Object *read_compact(CPort *port, int use_stack)
int i, c = SCHEME_VEC_SIZE(v); int i, c = SCHEME_VEC_SIZE(v);
if (c < 1) scheme_ill_formed_code(port); if (c < 1) scheme_ill_formed_code(port);
for (i = 1; i < c; i++) { 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); scheme_ill_formed_code(port);
} }
} }
@ -3030,7 +3046,8 @@ static Scheme_Object *read_compact(CPort *port, int use_stack)
v = read_compact(port, 1); v = read_compact(port, 1);
sb->var = v; 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); scheme_ill_formed_code(port);
v = read_compact(port, 1); v = read_compact(port, 1);
sb->val = v; sb->val = v;
@ -3041,6 +3058,63 @@ static Scheme_Object *read_compact(CPort *port, int use_stack)
case CPT_OTHER_FORM: case CPT_OTHER_FORM:
{ {
switch (read_compact_number(port)) { 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: case scheme_boxenv_type:
{ {
Scheme_Object *data; Scheme_Object *data;
@ -3953,9 +4027,10 @@ static Scheme_Object *read_compiled(Scheme_Object *port,
/* Read main body: */ /* Read main body: */
result = read_compact(rp, 1); result = read_compact(rp, 1);
if (delay_info) if (delay_info) {
if (delay_info->ut) if (delay_info->ut)
delay_info->ut->rp = NULL; /* clean up */ delay_info->ut->rp = NULL; /* clean up */
}
if (*local_ht) if (*local_ht)
scheme_read_err(port, "read (compiled): unexpected graph structure"); scheme_read_err(port, "read (compiled): unexpected graph structure");

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

@ -85,6 +85,8 @@ struct Resolve_Info
#t - enqueued #t - enqueued
list - resolved with lifts list - resolved with lifts
NULL - used or has side effect */ 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) #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 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(Resolve_Info *info, Resolve_Info *new_info);
static void merge_resolve_tl_map(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 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_invent_toplevel(Resolve_Info *info);
static Scheme_Object *resolve_invented_toplevel_to_defn(Resolve_Info *info, Scheme_Object *tl); 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); 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_is_inside_proc(Resolve_Info *info);
static int resolve_has_toplevel(Resolve_Info *info); static int resolve_has_toplevel(Resolve_Info *info);
static void set_tl_pos_used(Resolve_Info *info, int pos); 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 Scheme_Object *generate_lifted_name(Scheme_Hash_Table *used_names, int search_start);
static void enable_expression_resolve_lifts(Resolve_Info *ri); static void enable_expression_resolve_lifts(Resolve_Info *ri);
static void extend_linklet_defns(Scheme_Linklet *linklet, int num_lifts); static void extend_linklet_defns(Scheme_Linklet *linklet, int num_lifts);
static void prune_unused_imports(Scheme_Linklet *linklet); static void prune_unused_imports(Scheme_Linklet *linklet);
static void prepare_definition_queue(Scheme_Linklet *linklet, Resolve_Info *rslv); static void prepare_definition_queue(Scheme_Linklet *linklet, Resolve_Info *rslv);
static void remove_definition_names(Scheme_Object *defn, Scheme_Linklet *linklet); 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 #ifdef MZ_PRECISE_GC
static void register_traversers(void); static void register_traversers(void);
@ -815,9 +818,12 @@ static int is_lifted_reference(Scheme_Object *v)
if (SCHEME_RPAIRP(v)) if (SCHEME_RPAIRP(v))
return 1; return 1;
return (SAME_TYPE(SCHEME_TYPE(v), scheme_toplevel_type) if (SAME_TYPE(SCHEME_TYPE(v), scheme_toplevel_type)
&& ((SCHEME_TOPLEVEL_FLAGS(v) & SCHEME_TOPLEVEL_FLAGS_MASK) || SAME_TYPE(SCHEME_TYPE(v), scheme_static_toplevel_type))
>= SCHEME_TOPLEVEL_CONST)); return ((SCHEME_TOPLEVEL_FLAGS(v) & SCHEME_TOPLEVEL_FLAGS_MASK)
>= SCHEME_TOPLEVEL_CONST);
return 0;
} }
static int is_closed_reference(Scheme_Object *v) 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) if (resolve_phase == 0)
lift = scheme_resolve_generate_stub_closure(); lift = scheme_resolve_generate_stub_closure();
else if (resolve_phase == 1) else if (resolve_phase == 1)
lift = resolve_generate_stub_lift(); lift = resolve_generate_stub_lift(info);
else else
lift = NULL; lift = NULL;
MZ_ASSERT(!info->no_lift || !lift); MZ_ASSERT(!info->no_lift || !lift);
@ -1605,7 +1611,9 @@ static int is_nonconstant_procedure(Scheme_Object *_lam, Resolve_Info *info, Sch
if (!lifted) if (!lifted)
return 1; return 1;
if (SAME_TYPE(SCHEME_TYPE(lifted), scheme_toplevel_type) 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; return 1;
} }
} }
@ -1667,7 +1675,7 @@ resolve_lambda(Scheme_Object *_lam, Resolve_Info *info,
cl->arg_types = NULL; 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 /* Add original closure content to `captured`, pruning variables
that are lifted (so the closure might get smaller). The that are lifted (so the closure might get smaller). The
@ -1688,7 +1696,8 @@ resolve_lambda(Scheme_Object *_lam, Resolve_Info *info,
if (lifted) { if (lifted) {
/* Drop lifted binding from closure. */ /* Drop lifted binding from closure. */
if (SAME_TYPE(SCHEME_TYPE(lifted), scheme_toplevel_type) 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. */ /* Former local variable is now a top-level variable. */
has_tl = 1; has_tl = 1;
} }
@ -1948,7 +1957,7 @@ resolve_lambda(Scheme_Object *_lam, Resolve_Info *info,
if (just_compute_lift > 1) if (just_compute_lift > 1)
result = resolve_invent_toplevel(info); result = resolve_invent_toplevel(info);
else else
result = resolve_generate_stub_lift(); result = resolve_generate_stub_lift(info);
} else { } else {
Scheme_Object *tl, *defn_tl; Scheme_Object *tl, *defn_tl;
if (precomputed_lift) { if (precomputed_lift) {
@ -2005,13 +2014,13 @@ resolve_lambda(Scheme_Object *_lam, Resolve_Info *info,
/* linklet */ /* 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; Scheme_Object *lift_vec, *body = scheme_null, *new_bodies;
Resolve_Info *rslv; Resolve_Info *rslv;
int i, cnt, num_lifts; 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); enable_expression_resolve_lifts(rslv);
if (linklet->num_exports < SCHEME_VEC_SIZE(linklet->defns)) { 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 */ the level of variables */
prune_unused_imports(linklet); prune_unused_imports(linklet);
if (static_mode)
install_static_prefix(linklet, rslv);
return linklet; 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 pos = SCHEME_TOPLEVEL_POS(tl);
int depth; int depth;
MZ_ASSERT(SAME_TYPE(SCHEME_TYPE(tl), scheme_toplevel_type));
depth = resolve_toplevel_pos(info); depth = resolve_toplevel_pos(info);
tl = scheme_make_toplevel(depth + delta, tl = scheme_make_toplevel(depth + delta,
pos, pos,
@ -2417,7 +2431,7 @@ static Scheme_Object *shift_lifted_reference(Scheme_Object *tl, Resolve_Info *in
/* compile-time env for resolve */ /* 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; Resolve_Info *naya;
int *toplevel_starts, pos, dpos, i, j; 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->enforce_const = enforce_const;
naya->linklet = linklet; 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_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)); toplevel_deltas = MALLOC_N_ATOMIC(int, (linklet->num_total_imports + SCHEME_LINKLET_PREFIX_PREFIX));
pos = 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->linklet = info->linklet;
naya->next = (lambda ? NULL : info); naya->next = (lambda ? NULL : info);
naya->enforce_const = info->enforce_const; naya->enforce_const = info->enforce_const;
naya->static_mode = info->static_mode;
naya->current_depth = (lambda ? 0 : info->current_depth) + size; naya->current_depth = (lambda ? 0 : info->current_depth) + size;
naya->current_lex_depth = info->current_lex_depth + size; naya->current_lex_depth = info->current_lex_depth + size;
naya->toplevel_pos = (lambda naya->toplevel_pos = (lambda
@ -2551,19 +2572,21 @@ static void set_tl_pos_used(Resolve_Info *info, int tl_pos)
{ {
void *tl_map; void *tl_map;
/* Fixnum-like bit packing avoids allocation in the common case of a if (!info->static_mode) {
small prefix. We use 31 fixnum-like bits (even on a 64-bit /* Fixnum-like bit packing avoids allocation in the common case of a
platform, and even though fixnums are only 30 bits). There's one small prefix. We use 31 fixnum-like bits (even on a 64-bit
bit for each normal top-level, one bit for all syntax objects, platform, and even though fixnums are only 30 bits). There's one
and one bit for each lifted top-level. */ 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); tl_map = ensure_tl_map_len(info->tl_map, tl_pos + 1);
info->tl_map = tl_map; info->tl_map = tl_map;
if ((uintptr_t)info->tl_map & 0x1) if ((uintptr_t)info->tl_map & 0x1)
info->tl_map = (void *)((uintptr_t)tl_map | ((uintptr_t)1 << (tl_pos + 1))); info->tl_map = (void *)((uintptr_t)tl_map | ((uintptr_t)1 << (tl_pos + 1)));
else else
((int *)tl_map)[1 + (tl_pos / 32)] |= ((unsigned)1 << (tl_pos & 31)); ((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 we're pruning unused definitions, then ensure a newly referenced definition */
if (info->toplevel_defns 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; 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) 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) 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) static Scheme_Object *resolve_toplevel(Resolve_Info *info, Scheme_Object *expr, int as_reference)
{ {
int skip, pos; 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_INSTANCE(expr) == -1) {
if (SCHEME_IR_TOPLEVEL_POS(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) if (as_reference)
set_tl_pos_used(info, pos); set_tl_pos_used(info, pos);
return scheme_make_toplevel(skip, pos, if (info->static_mode)
SCHEME_IR_TOPLEVEL_FLAGS((Scheme_IR_Toplevel *)expr) & SCHEME_TOPLEVEL_FLAGS_MASK); 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) 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); set_tl_pos_used(info, pos);
return scheme_make_toplevel(skip, if (info->static_mode)
pos, return make_static_toplevel(info->static_mode, pos, SCHEME_TOPLEVEL_CONST, 0);
SCHEME_TOPLEVEL_CONST); else
return scheme_make_toplevel(skip,
pos,
SCHEME_TOPLEVEL_CONST);
} }
static Scheme_Object *resolve_invented_toplevel_to_defn(Resolve_Info *info, Scheme_Object *tl) static Scheme_Object *resolve_invented_toplevel_to_defn(Resolve_Info *info, Scheme_Object *tl)
{ {
return scheme_make_toplevel(0, if (SAME_TYPE(SCHEME_TYPE(tl), scheme_toplevel_type))
SCHEME_TOPLEVEL_POS(tl), return scheme_make_toplevel(0,
SCHEME_TOPLEVEL_CONST); 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) if (SAME_TYPE(SCHEME_TYPE(rator), scheme_closure_type)
&& (SCHEME_LAMBDA_FLAGS((SCHEME_CLOSURE_CODE(rator))) & LAMBDA_HAS_TYPED_ARGS)) { && (SCHEME_LAMBDA_FLAGS((SCHEME_CLOSURE_CODE(rator))) & LAMBDA_HAS_TYPED_ARGS)) {
lam = SCHEME_CLOSURE_CODE(rator); 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))); 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); b = SCHEME_PTR2_VAL(e);
MZ_ASSERT(SCHEME_FALSEP(b) || (SAME_TYPE(SCHEME_TYPE(b), scheme_toplevel_type) MZ_ASSERT(SCHEME_FALSEP(b)
&& !SCHEME_TOPLEVEL_POS(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); b = unresolve_expr(b, ui, 0);
if (!b) return_NULL; if (!b) return_NULL;
MZ_ASSERT(SCHEME_FALSEP(b) || (SAME_TYPE(SCHEME_TYPE(b), scheme_ir_toplevel_type) 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); return unresolve_expr(SCHEME_PTR2_VAL(e), ui, 0);
} }
case scheme_toplevel_type: case scheme_toplevel_type:
case scheme_static_toplevel_type:
{ {
return unresolve_toplevel(e, ui); return unresolve_toplevel(e, ui);
} }

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

@ -1609,11 +1609,15 @@ typedef struct Scheme_Local {
typedef struct Scheme_Toplevel { typedef struct Scheme_Toplevel {
Scheme_Inclhash_Object iso; /* keyex used for flags (and can't be hashed) */ 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; int position;
} Scheme_Toplevel; } 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_POS(obj) (((Scheme_Toplevel *)(obj))->position)
#define SCHEME_TOPLEVEL_FLAGS(obj) MZ_OPT_HASH_KEY(&((Scheme_Toplevel *)(obj))->iso) #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 FIXED, READY, or UNKNOWN) or one of the two levels for a
definition (SEAL or not) */ definition (SEAL or not) */
#define SCHEME_TOPLEVEL_FLAGS_MASK 0x3 #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, /* CONST means that a toplevel is READY and always has the "same" value,
even for different instantiations or phases. "Same" means that the result 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) \ #define PREFIX_TO_USE_BITS(pf) \
(int *)((char *)pf + sizeof(Scheme_Prefix) + ((pf->num_slots - mzFLEX_DELTA) * sizeof(Scheme_Object *))) (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 #define LOAD_ON_DEMAND
void scheme_clear_delayed_load_cache(); 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_make_noninline_proc(Scheme_Object *e);
Scheme_Object *scheme_optimize_extract_tail_inside(Scheme_Object *t2); 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_Object *scheme_unresolve(Scheme_Object *, int argv, int *_has_cases,
Scheme_Linklet *linklet, Scheme_Object *linklet_key, Scheme_Linklet *linklet, Scheme_Object *linklet_key,
Optimize_Info *opt_info); Optimize_Info *opt_info);
@ -3281,6 +3289,8 @@ struct Scheme_Linklet
char reject_eval; /* true when loaded without the root inspector, for example */ 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_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) #define SCHEME_DEFN_VAR_COUNT(d) (SCHEME_VEC_SIZE(d)-1)

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

@ -13,12 +13,12 @@
consistently.) consistently.)
*/ */
#define MZSCHEME_VERSION "6.90.0.22" #define MZSCHEME_VERSION "6.90.0.23"
#define MZSCHEME_VERSION_X 6 #define MZSCHEME_VERSION_X 6
#define MZSCHEME_VERSION_Y 90 #define MZSCHEME_VERSION_Y 90
#define MZSCHEME_VERSION_Z 0 #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_MAJOR ((MZSCHEME_VERSION_X * 100) + MZSCHEME_VERSION_Y)
#define MZSCHEME_VERSION_MINOR ((MZSCHEME_VERSION_Z * 1000) + MZSCHEME_VERSION_W) #define MZSCHEME_VERSION_MINOR ((MZSCHEME_VERSION_Z * 1000) + MZSCHEME_VERSION_W)

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

@ -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)) { if (scheme_omittable_expr(rhs, 1, -1, OMITTABLE_RESOLVED, NULL, NULL)) {
rhs = scheme_false; rhs = scheme_false;
} else if ((ip < info->max_calls[pos]) } 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, /* Unusual case: we can't just drop the global-variable access,
because it might be undefined, but we don't need the value, because it might be undefined, but we don't need the value,
and we want to avoid an SFS clear in the interpreter loop. 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"); scheme_signal_error("toplevel access not at expected place");
} }
break; break;
case scheme_static_toplevel_type:
break;
case scheme_case_closure_type: case scheme_case_closure_type:
{ {
/* FIXME: maybe need to handle eagerly created closure */ /* FIXME: maybe need to handle eagerly created closure */

8
racket/src/racket/src/startup.inc
View File

@ -29362,7 +29362,9 @@ static const char *startup_source =
" name_48" " name_48"
" keys_1" " keys_1"
" getter_1" " getter_1"
" serializable?_0)))" "(if serializable?_0"
" '(serializable)"
" '()))))"
"(list*" "(list*"
" 'linklet" " 'linklet"
"(qq-append" "(qq-append"
@ -36178,7 +36180,9 @@ static const char *startup_source =
"(values" "(values"
" inst_5" " inst_5"
" #f))" " #f))"
" serializable?_3)))" "(if serializable?_3"
" '(serializable)"
" '()))))"
" linklet_7))))" " linklet_7))))"
"(list*" "(list*"
" 'linklet" " 'linklet"

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

@ -3,297 +3,298 @@ enum {
/* Compiled bytecode elements: */ /* Compiled bytecode elements: */
scheme_toplevel_type, /* 0 */ scheme_toplevel_type, /* 0 */
scheme_local_type, /* 1 */ scheme_static_toplevel_type, /* 1 */
scheme_local_unbox_type, /* 2 */ scheme_local_type, /* 2 */
scheme_application_type, /* 3 */ scheme_local_unbox_type, /* 3 */
scheme_application2_type, /* 4 */ scheme_application_type, /* 4 */
scheme_application3_type, /* 5 */ scheme_application2_type, /* 5 */
scheme_sequence_type, /* 6 */ scheme_application3_type, /* 6 */
scheme_branch_type, /* 7 */ scheme_sequence_type, /* 7 */
scheme_lambda_type, /* 8 */ scheme_branch_type, /* 8 */
scheme_let_value_type, /* 9 */ scheme_lambda_type, /* 9 */
scheme_let_void_type, /* 10 */ scheme_let_value_type, /* 10 */
scheme_letrec_type, /* 11 */ scheme_let_void_type, /* 11 */
scheme_let_one_type, /* 12 */ scheme_letrec_type, /* 12 */
scheme_with_cont_mark_type, /* 13 */ scheme_let_one_type, /* 13 */
scheme_with_cont_mark_type, /* 14 */
scheme_define_values_type, /* 14 */ scheme_define_values_type, /* 15 */
scheme_set_bang_type, /* 15 */ scheme_set_bang_type, /* 16 */
scheme_boxenv_type, /* 16 */ scheme_boxenv_type, /* 17 */
scheme_begin0_sequence_type, /* 17 */ scheme_begin0_sequence_type, /* 18 */
scheme_varref_form_type, /* 18 */ scheme_varref_form_type, /* 19 */
scheme_apply_values_type, /* 19 */ scheme_apply_values_type, /* 20 */
scheme_with_immed_mark_type, /* 20 */ scheme_with_immed_mark_type, /* 21 */
scheme_case_lambda_sequence_type, /* 21 */ scheme_case_lambda_sequence_type, /* 22 */
scheme_inline_variant_type, /* 22 */ scheme_inline_variant_type, /* 23 */
_scheme_values_types_, /* 23 */ _scheme_values_types_, /* 24 */
/* All following types are values at run time */ /* All following types are values at run time */
scheme_linklet_type, /* 24 */ scheme_linklet_type, /* 25 */
/* Replacements for some of the above as the /* Replacements for some of the above as the
compiler's intermediate representation for compiler's intermediate representation for
optimization: */ optimization: */
scheme_ir_local_type, /* 25 */ scheme_ir_local_type, /* 26 */
scheme_ir_lambda_type, /* 26 */ scheme_ir_lambda_type, /* 27 */
scheme_ir_let_value_type, /* 27 */ scheme_ir_let_value_type, /* 28 */
scheme_ir_let_header_type, /* 28 */ scheme_ir_let_header_type, /* 29 */
scheme_ir_toplevel_type, /* 29 */ scheme_ir_toplevel_type, /* 30 */
scheme_quote_compilation_type, /* used while writing, only */ scheme_quote_compilation_type, /* used while writing, only */
/* Generated in the compiler front-end, but /* Generated in the compiler front-end, but
registered in the prefix table instead of registered in the prefix table instead of
used directly as an "expression": */ 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 /* All of the following are literal values from the
perspective of the compiler */ perspective of the compiler */
scheme_linklet_bundle_type, /* 33 */ scheme_linklet_bundle_type, /* 34 */
scheme_linklet_directory_type, /* 34 */ scheme_linklet_directory_type, /* 35 */
scheme_instance_type, /* 35 */ scheme_instance_type, /* 36 */
/* procedure types */ /* procedure types */
scheme_prim_type, /* 36 */ scheme_prim_type, /* 37 */
scheme_closed_prim_type, /* 37 */ scheme_closed_prim_type, /* 38 */
scheme_closure_type, /* 38 */ scheme_closure_type, /* 39 */
scheme_case_closure_type, /* 39 */ scheme_case_closure_type, /* 40 */
scheme_cont_type, /* 40 */ scheme_cont_type, /* 41 */
scheme_escaping_cont_type, /* 41 */ scheme_escaping_cont_type, /* 42 */
scheme_proc_struct_type, /* 42 */ scheme_proc_struct_type, /* 43 */
scheme_native_closure_type, /* 43 */ scheme_native_closure_type, /* 44 */
scheme_proc_chaperone_type, /* 44 */ scheme_proc_chaperone_type, /* 45 */
scheme_chaperone_type, /* 45 */ scheme_chaperone_type, /* 46 */
/* structure type (plus one above for procs) */ /* structure type (plus one above for procs) */
scheme_structure_type, /* 46 */ scheme_structure_type, /* 47 */
/* number types (must be together) */ /* number types (must be together) */
scheme_integer_type, /* 47 */ scheme_integer_type, /* 48 */
scheme_bignum_type, /* 48 */ scheme_bignum_type, /* 49 */
scheme_rational_type, /* 49 */ scheme_rational_type, /* 50 */
scheme_float_type, /* 50 */ scheme_float_type, /* 51 */
scheme_double_type, /* 51 */ scheme_double_type, /* 52 */
scheme_complex_type, /* 52 */ scheme_complex_type, /* 53 */
/* other eqv?-able values (must be with numbers) */ /* other eqv?-able values (must be with numbers) */
scheme_char_type, /* 53 */ scheme_char_type, /* 54 */
/* other values */ /* other values */
scheme_long_double_type, /* 54 */ scheme_long_double_type, /* 55 */
scheme_char_string_type, /* 55 */ scheme_char_string_type, /* 56 */
scheme_byte_string_type, /* 56 */ scheme_byte_string_type, /* 57 */
scheme_unix_path_type, /* 57 */ scheme_unix_path_type, /* 58 */
scheme_windows_path_type, /* 58 */ scheme_windows_path_type, /* 59 */
scheme_symbol_type, /* 59 */ scheme_symbol_type, /* 60 */
scheme_keyword_type, /* 60 */ scheme_keyword_type, /* 61 */
scheme_null_type, /* 61 */ scheme_null_type, /* 62 */
scheme_pair_type, /* 62 */ scheme_pair_type, /* 63 */
scheme_mutable_pair_type, /* 63 */ scheme_mutable_pair_type, /* 64 */
scheme_vector_type, /* 64 */ scheme_vector_type, /* 65 */
scheme_inspector_type, /* 65 */ scheme_inspector_type, /* 66 */
scheme_input_port_type, /* 66 */ scheme_input_port_type, /* 67 */
scheme_output_port_type, /* 67 */ scheme_output_port_type, /* 68 */
scheme_eof_type, /* 68 */ scheme_eof_type, /* 69 */
scheme_true_type, /* 69 */ scheme_true_type, /* 70 */
scheme_false_type, /* 70 */ scheme_false_type, /* 71 */
scheme_void_type, /* 71 */ scheme_void_type, /* 72 */
scheme_primitive_syntax_type, /* 72 */ scheme_primitive_syntax_type, /* 73 */
scheme_macro_type, /* 73 */ scheme_macro_type, /* 74 */
scheme_box_type, /* 74 */ scheme_box_type, /* 75 */
scheme_thread_type, /* 75 */ scheme_thread_type, /* 76 */
scheme_cont_mark_set_type, /* 76 */ scheme_cont_mark_set_type, /* 77 */
scheme_sema_type, /* 77 */ scheme_sema_type, /* 78 */
/* hash table types (must be together for hash? /* hash table types (must be together for hash?
* implementation */ * implementation */
scheme_hash_table_type, /* 78 */ scheme_hash_table_type, /* 79 */
scheme_hash_tree_type, /* 79 */ scheme_hash_tree_type, /* 80 */
scheme_eq_hash_tree_type, /* 80 */ scheme_eq_hash_tree_type, /* 81 */
scheme_eqv_hash_tree_type, /* 81 */ scheme_eqv_hash_tree_type, /* 82 */
scheme_hash_tree_subtree_type, /* 82 */ scheme_hash_tree_subtree_type, /* 83 */
scheme_hash_tree_collision_type, /* 83 */ scheme_hash_tree_collision_type, /* 84 */
scheme_hash_tree_indirection_type, /* 84 */ scheme_hash_tree_indirection_type, /* 85 */
scheme_bucket_type, /* 85 */ scheme_bucket_type, /* 86 */
scheme_bucket_table_type, /* 86 */ scheme_bucket_table_type, /* 87 */
scheme_cpointer_type, /* 87 */ scheme_cpointer_type, /* 88 */
scheme_prefix_type, /* 88 */ scheme_prefix_type, /* 89 */
scheme_weak_box_type, /* 89 */ scheme_weak_box_type, /* 90 */
scheme_ephemeron_type, /* 90 */ scheme_ephemeron_type, /* 91 */
scheme_struct_type_type, /* 91 */ scheme_struct_type_type, /* 92 */
scheme_set_macro_type, /* 92 */ scheme_set_macro_type, /* 93 */
scheme_listener_type, /* 93 */ scheme_listener_type, /* 94 */
scheme_env_type, /* 94 */ scheme_env_type, /* 95 */
scheme_startup_env_type, /* 95 */ scheme_startup_env_type, /* 96 */
scheme_config_type, /* 96 */ scheme_config_type, /* 97 */
scheme_stx_type, /* 97 */ scheme_stx_type, /* 98 */
scheme_will_executor_type, /* 98 */ scheme_will_executor_type, /* 99 */
scheme_custodian_type, /* 99 */ scheme_custodian_type, /* 100 */
scheme_random_state_type, /* 100 */ scheme_random_state_type, /* 101 */
scheme_regexp_type, /* 101 */ scheme_regexp_type, /* 102 */
scheme_subprocess_type, /* 102 */ scheme_subprocess_type, /* 103 */
scheme_eval_waiting_type, /* 103 */ scheme_eval_waiting_type, /* 104 */
scheme_tail_call_waiting_type, /* 104 */ scheme_tail_call_waiting_type, /* 105 */
scheme_undefined_type, /* 105 */ scheme_undefined_type, /* 106 */
scheme_struct_property_type, /* 106 */ scheme_struct_property_type, /* 107 */
scheme_chaperone_property_type, /* 107 */ scheme_chaperone_property_type, /* 108 */
scheme_multiple_values_type, /* 108 */ scheme_multiple_values_type, /* 109 */
scheme_placeholder_type, /* 109 */ scheme_placeholder_type, /* 110 */
scheme_table_placeholder_type, /* 110 */ scheme_table_placeholder_type, /* 111 */
scheme_svector_type, /* 111 */ scheme_svector_type, /* 112 */
scheme_resolve_prefix_type, /* 112 */ scheme_resolve_prefix_type, /* 113 */
scheme_security_guard_type, /* 113 */ scheme_security_guard_type, /* 114 */
scheme_indent_type, /* 114 */ scheme_indent_type, /* 115 */
scheme_udp_type, /* 115 */ scheme_udp_type, /* 116 */
scheme_udp_evt_type, /* 116 */ scheme_udp_evt_type, /* 117 */
scheme_tcp_accept_evt_type, /* 117 */ scheme_tcp_accept_evt_type, /* 118 */
scheme_id_macro_type, /* 118 */ scheme_id_macro_type, /* 119 */
scheme_evt_set_type, /* 119 */ scheme_evt_set_type, /* 120 */
scheme_wrap_evt_type, /* 120 */ scheme_wrap_evt_type, /* 121 */
scheme_handle_evt_type, /* 121 */ scheme_handle_evt_type, /* 122 */
scheme_replace_evt_type, /* 122 */ scheme_replace_evt_type, /* 123 */
scheme_active_replace_evt_type, /* 123 */ scheme_active_replace_evt_type, /* 124 */
scheme_nack_guard_evt_type, /* 124 */ scheme_nack_guard_evt_type, /* 125 */
scheme_semaphore_repost_type, /* 125 */ scheme_semaphore_repost_type, /* 126 */
scheme_channel_type, /* 126 */ scheme_channel_type, /* 127 */
scheme_channel_put_type, /* 127 */ scheme_channel_put_type, /* 128 */
scheme_thread_resume_type, /* 128 */ scheme_thread_resume_type, /* 129 */
scheme_thread_suspend_type, /* 129 */ scheme_thread_suspend_type, /* 130 */
scheme_thread_dead_type, /* 130 */ scheme_thread_dead_type, /* 131 */
scheme_poll_evt_type, /* 131 */ scheme_poll_evt_type, /* 132 */
scheme_nack_evt_type, /* 132 */ scheme_nack_evt_type, /* 133 */
scheme_thread_set_type, /* 133 */ scheme_thread_set_type, /* 134 */
scheme_string_converter_type, /* 134 */ scheme_string_converter_type, /* 135 */
scheme_alarm_type, /* 135 */ scheme_alarm_type, /* 136 */
scheme_thread_recv_evt_type, /* 136 */ scheme_thread_recv_evt_type, /* 137 */
scheme_thread_cell_type, /* 137 */ scheme_thread_cell_type, /* 138 */
scheme_channel_syncer_type, /* 138 */ scheme_channel_syncer_type, /* 139 */
scheme_write_evt_type, /* 139 */ scheme_write_evt_type, /* 140 */
scheme_always_evt_type, /* 140 */ scheme_always_evt_type, /* 141 */
scheme_never_evt_type, /* 141 */ scheme_never_evt_type, /* 142 */
scheme_progress_evt_type, /* 142 */ scheme_progress_evt_type, /* 143 */
scheme_place_dead_type, /* 143 */ scheme_place_dead_type, /* 144 */
scheme_already_comp_type, /* 144 */ scheme_already_comp_type, /* 145 */
scheme_readtable_type, /* 145 */ scheme_readtable_type, /* 146 */
scheme_thread_cell_values_type, /* 146 */ scheme_thread_cell_values_type, /* 147 */
scheme_global_ref_type, /* 147 */ scheme_global_ref_type, /* 148 */
scheme_cont_mark_chain_type, /* 148 */ scheme_cont_mark_chain_type, /* 149 */
scheme_raw_pair_type, /* 149 */ scheme_raw_pair_type, /* 150 */
scheme_prompt_type, /* 150 */ scheme_prompt_type, /* 151 */
scheme_prompt_tag_type, /* 151 */ scheme_prompt_tag_type, /* 152 */
scheme_continuation_mark_key_type, /* 152 */ scheme_continuation_mark_key_type, /* 153 */
scheme_delay_syntax_type, /* 153 */ scheme_delay_syntax_type, /* 154 */
scheme_cust_box_type, /* 154 */ scheme_cust_box_type, /* 155 */
scheme_logger_type, /* 155 */ scheme_logger_type, /* 156 */
scheme_log_reader_type, /* 156 */ scheme_log_reader_type, /* 157 */
scheme_noninline_proc_type, /* 157 */ scheme_noninline_proc_type, /* 158 */
scheme_future_type, /* 158 */ scheme_future_type, /* 159 */
scheme_flvector_type, /* 159 */ scheme_flvector_type, /* 160 */
scheme_extflvector_type, /* 160 */ scheme_extflvector_type, /* 161 */
scheme_fxvector_type, /* 161 */ scheme_fxvector_type, /* 162 */
scheme_place_type, /* 162 */ scheme_place_type, /* 163 */
scheme_place_object_type, /* 163 */ scheme_place_object_type, /* 164 */
scheme_place_async_channel_type, /* 164 */ scheme_place_async_channel_type, /* 165 */
scheme_place_bi_channel_type, /* 165 */ scheme_place_bi_channel_type, /* 166 */
scheme_once_used_type, /* 166 */ scheme_once_used_type, /* 167 */
scheme_serialized_symbol_type, /* 167 */ scheme_serialized_symbol_type, /* 168 */
scheme_serialized_keyword_type, /* 168 */ scheme_serialized_keyword_type, /* 169 */
scheme_serialized_structure_type, /* 169 */ scheme_serialized_structure_type, /* 170 */
scheme_fsemaphore_type, /* 170 */ scheme_fsemaphore_type, /* 171 */
scheme_serialized_tcp_fd_type, /* 171 */ scheme_serialized_tcp_fd_type, /* 172 */
scheme_serialized_file_fd_type, /* 172 */ scheme_serialized_file_fd_type, /* 173 */
scheme_port_closed_evt_type, /* 173 */ scheme_port_closed_evt_type, /* 174 */
scheme_proc_shape_type, /* 174 */ scheme_proc_shape_type, /* 175 */
scheme_struct_prop_proc_shape_type, /* 175 */ scheme_struct_prop_proc_shape_type, /* 176 */
scheme_struct_proc_shape_type, /* 176 */ scheme_struct_proc_shape_type, /* 177 */
scheme_phantom_bytes_type, /* 177 */ scheme_phantom_bytes_type, /* 178 */
scheme_environment_variables_type, /* 178 */ scheme_environment_variables_type, /* 179 */
scheme_filesystem_change_evt_type, /* 179 */ scheme_filesystem_change_evt_type, /* 180 */
scheme_ctype_type, /* 180 */ scheme_ctype_type, /* 181 */
scheme_plumber_type, /* 181 */ scheme_plumber_type, /* 182 */
scheme_plumber_handle_type, /* 182 */ scheme_plumber_handle_type, /* 183 */
scheme_deferred_expr_type, /* 183 */ scheme_deferred_expr_type, /* 184 */
scheme_unquoted_printing_string_type, /* 184 */ scheme_unquoted_printing_string_type, /* 185 */
scheme_will_be_lambda_type, /* 185 */ scheme_will_be_lambda_type, /* 186 */
#ifdef MZTAG_REQUIRED #ifdef MZTAG_REQUIRED
_scheme_last_normal_type_, /* 186 */ _scheme_last_normal_type_, /* 187 */
/* The remaining tags exist for GC tracing (in non-conservative /* The remaining tags exist for GC tracing (in non-conservative
mode), but they are not needed for run-time tag tests */ 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_comp_env, /* 189 */
scheme_rt_constant_binding, /* 189 */ scheme_rt_constant_binding, /* 190 */
scheme_rt_resolve_info, /* 190 */ scheme_rt_resolve_info, /* 191 */
scheme_rt_unresolve_info, /* 191 */ scheme_rt_unresolve_info, /* 192 */
scheme_rt_optimize_info, /* 192 */ scheme_rt_optimize_info, /* 193 */
scheme_rt_cont_mark, /* 193 */ scheme_rt_cont_mark, /* 194 */
scheme_rt_saved_stack, /* 194 */ scheme_rt_saved_stack, /* 195 */
scheme_rt_reply_item, /* 195 */ scheme_rt_reply_item, /* 196 */
scheme_rt_ir_lambda_info, /* 196 */ scheme_rt_ir_lambda_info, /* 197 */
scheme_rt_overflow, /* 197 */ scheme_rt_overflow, /* 198 */
scheme_rt_overflow_jmp, /* 198 */ scheme_rt_overflow_jmp, /* 199 */
scheme_rt_meta_cont, /* 199 */ scheme_rt_meta_cont, /* 200 */
scheme_rt_dyn_wind_cell, /* 200 */ scheme_rt_dyn_wind_cell, /* 201 */
scheme_rt_dyn_wind_info, /* 201 */ scheme_rt_dyn_wind_info, /* 202 */
scheme_rt_dyn_wind, /* 202 */ scheme_rt_dyn_wind, /* 203 */
scheme_rt_dup_check, /* 203 */ scheme_rt_dup_check, /* 204 */
scheme_rt_thread_memory, /* 204 */ scheme_rt_thread_memory, /* 205 */
scheme_rt_input_file, /* 205 */ scheme_rt_input_file, /* 206 */
scheme_rt_input_fd, /* 206 */ scheme_rt_input_fd, /* 207 */
scheme_rt_oskit_console_input, /* 207 */ scheme_rt_oskit_console_input, /* 208 */
scheme_rt_tested_input_file, /* 208 */ scheme_rt_tested_input_file, /* 209 */
scheme_rt_tested_output_file, /* 209 */ scheme_rt_tested_output_file, /* 210 */
scheme_rt_indexed_string, /* 210 */ scheme_rt_indexed_string, /* 211 */
scheme_rt_output_file, /* 211 */ scheme_rt_output_file, /* 212 */
scheme_rt_pipe, /* 212 */ scheme_rt_pipe, /* 213 */
scheme_rt_system_child, /* 213 */ scheme_rt_system_child, /* 214 */
scheme_rt_tcp, /* 214 */ scheme_rt_tcp, /* 215 */
scheme_rt_write_data, /* 215 */ scheme_rt_write_data, /* 216 */
scheme_rt_tcp_select_info, /* 216 */ scheme_rt_tcp_select_info, /* 217 */
scheme_rt_param_data, /* 217 */ scheme_rt_param_data, /* 218 */
scheme_rt_will, /* 218 */ scheme_rt_will, /* 219 */
scheme_rt_finalization, /* 219 */ scheme_rt_finalization, /* 220 */
scheme_rt_finalizations, /* 220 */ scheme_rt_finalizations, /* 221 */
scheme_rt_cpp_object, /* 221 */ scheme_rt_cpp_object, /* 222 */
scheme_rt_cpp_array_object, /* 222 */ scheme_rt_cpp_array_object, /* 223 */
scheme_rt_stack_object, /* 223 */ scheme_rt_stack_object, /* 224 */
scheme_thread_hop_type, /* 224 */ scheme_thread_hop_type, /* 225 */
scheme_rt_srcloc, /* 225 */ scheme_rt_srcloc, /* 226 */
scheme_rt_evt, /* 226 */ scheme_rt_evt, /* 227 */
scheme_rt_syncing, /* 227 */ scheme_rt_syncing, /* 228 */
scheme_rt_comp_prefix, /* 228 */ scheme_rt_comp_prefix, /* 229 */
scheme_rt_user_input, /* 229 */ scheme_rt_user_input, /* 230 */
scheme_rt_user_output, /* 230 */ scheme_rt_user_output, /* 231 */
scheme_rt_compact_port, /* 231 */ scheme_rt_compact_port, /* 232 */
scheme_rt_read_special_dw, /* 232 */ scheme_rt_read_special_dw, /* 233 */
scheme_rt_regwork, /* 233 */ scheme_rt_regwork, /* 234 */
scheme_rt_rx_lazy_string, /* 234 */ scheme_rt_rx_lazy_string, /* 235 */
scheme_rt_buf_holder, /* 235 */ scheme_rt_buf_holder, /* 236 */
scheme_rt_parameterization, /* 236 */ scheme_rt_parameterization, /* 237 */
scheme_rt_print_params, /* 237 */ scheme_rt_print_params, /* 238 */
scheme_rt_read_params, /* 238 */ scheme_rt_read_params, /* 239 */
scheme_rt_native_code, /* 239 */ scheme_rt_native_code, /* 240 */
scheme_rt_native_code_plus_case, /* 240 */ scheme_rt_native_code_plus_case, /* 241 */
scheme_rt_jitter_data, /* 241 */ scheme_rt_jitter_data, /* 242 */
scheme_rt_module_exports, /* 242 */ scheme_rt_module_exports, /* 243 */
scheme_rt_delay_load_info, /* 243 */ scheme_rt_delay_load_info, /* 244 */
scheme_rt_marshal_info, /* 244 */ scheme_rt_marshal_info, /* 245 */
scheme_rt_unmarshal_info, /* 245 */ scheme_rt_unmarshal_info, /* 246 */
scheme_rt_runstack, /* 246 */ scheme_rt_runstack, /* 247 */
scheme_rt_sfs_info, /* 247 */ scheme_rt_sfs_info, /* 248 */
scheme_rt_validate_clearing, /* 248 */ scheme_rt_validate_clearing, /* 249 */
scheme_rt_lightweight_cont, /* 249 */ scheme_rt_lightweight_cont, /* 250 */
scheme_rt_export_info, /* 250 */ scheme_rt_export_info, /* 251 */
scheme_rt_cont_jmp, /* 251 */ scheme_rt_cont_jmp, /* 252 */
scheme_rt_letrec_check_frame, /* 252 */ scheme_rt_letrec_check_frame, /* 253 */
#endif #endif
_scheme_last_type_ _scheme_last_type_

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

@ -101,6 +101,7 @@ scheme_init_type ()
set_name(scheme_local_unbox_type, "<local-unbox-code>"); set_name(scheme_local_unbox_type, "<local-unbox-code>");
set_name(scheme_variable_type, "<global-variable-code>"); set_name(scheme_variable_type, "<global-variable-code>");
set_name(scheme_toplevel_type, "<variable-code>"); set_name(scheme_toplevel_type, "<variable-code>");
set_name(scheme_static_toplevel_type, "<variable-code>");
set_name(scheme_application_type, "<application-code>"); set_name(scheme_application_type, "<application-code>");
set_name(scheme_application2_type, "<unary-application-code>"); set_name(scheme_application2_type, "<unary-application-code>");
set_name(scheme_application3_type, "<binary-application-code>"); set_name(scheme_application3_type, "<binary-application-code>");
@ -529,6 +530,7 @@ static void FIXUP_jmpup(Scheme_Jumpup_Buf *buf, struct NewGC *gc)
void scheme_register_traversers(void) void scheme_register_traversers(void)
{ {
GC_REG_TRAV(scheme_toplevel_type, toplevel_obj); 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_variable_type, variable_obj);
GC_REG_TRAV(scheme_local_type, local_obj); GC_REG_TRAV(scheme_local_type, local_obj);
GC_REG_TRAV(scheme_local_unbox_type, local_obj); GC_REG_TRAV(scheme_local_unbox_type, local_obj);