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

reorgnize datatypes of less common bytecode forms

Browse Source 
removing a layer of indirection, and setting up
 for an internal reorganization of the compiler code
This commit is contained in:
Matthew Flatt 2011-05-05 20:52:23 -06:00
parent 047c21edb4
commit e9721058fb
15 changed files with 2472 additions and 2459 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -149,21 +149,29 @@
;; ----------------------------------------
(define toplevel-type-num 0)
(define syntax-type-num 3)
(define sequence-type-num 7)
(define unclosed-procedure-type-num 9)
(define let-value-type-num 10)
(define let-void-type-num 11)
(define letrec-type-num 12)
(define wcm-type-num 14)
(define quote-syntax-type-num 15)
(define variable-type-num 24)
(define top-type-num 89)
(define case-lambda-sequence-type-num 99)
(define begin0-sequence-type-num 100)
(define module-type-num 103)
(define prefix-type-num 105)
(define free-id-info-type-num 154)
(define sequence-type-num 6)
(define unclosed-procedure-type-num 8)
(define let-value-type-num 9)
(define let-void-type-num 10)
(define letrec-type-num 11)
(define wcm-type-num 13)
(define quote-syntax-type-num 14)
(define define-values-type-num 15)
(define define-syntaxes-type-num 16)
(define define-for-syntax-type-num 17)
(define set-bang-type-num 18)
(define boxenv-type-num 19)
(define begin0-sequence-type-num 20)
(define splice-sequence-type-num 21)
(define require-form-type-num 22)
(define varref-form-type-num 23)
(define apply-values-type-num 24)
(define case-lambda-sequence-type-num 25)
(define module-type-num 26)
(define variable-type-num 34)
(define top-type-num 99)
(define prefix-type-num 112)
(define free-id-info-type-num 161)
(define-syntax define-enum
(syntax-rules ()
@ -212,21 +220,6 @@
CPT_PREFAB
CPT_LET_ONE_UNUSED)
(define-enum
0
DEFINE_VALUES_EXPD
DEFINE_SYNTAX_EXPD
SET_EXPD
CASE_LAMBDA_EXPD
BEGIN0_EXPD
BOXENV_EXPD
MODULE_EXPD
REQUIRE_EXPD
DEFINE_FOR_SYNTAX_EXPD
REF_EXPD
APPVALS_EXPD
SPLICE_EXPD)
(define CPT_SMALL_NUMBER_START 36)
(define CPT_SMALL_NUMBER_END 60)
@ -271,10 +264,6 @@
#f
#f))
(define-struct case-seq (name lams))
(define-struct (seq0 seq) ())
(define (encode-module-bindings module-bindings)
(define encode-nominal-path
(match-lambda
@ -440,9 +429,6 @@
(out-byte #xF0 out)
(out-bytes (int->bytes n) out)]))
(define (out-syntax key val out)
(out-marshaled syntax-type-num (list* key val) out))
(define (out-marshaled type-num val out)
(if (type-num . < . (- CPT_SMALL_MARSHALLED_END CPT_SMALL_MARSHALLED_START))
(out-byte (+ CPT_SMALL_MARSHALLED_START type-num) out)
@ -541,11 +527,11 @@
[(? mod?)
(out-module v out)]
[(struct def-values (ids rhs))
(out-syntax DEFINE_VALUES_EXPD
(out-marshaled define-values-type-num
(list->vector (cons (protect-quote rhs) ids))
out)]
[(struct def-syntaxes (ids rhs prefix max-let-depth))
(out-syntax DEFINE_SYNTAX_EXPD
(out-marshaled define-syntaxes-type-num
(list->vector (list* (protect-quote rhs)
prefix
max-let-depth
@ -553,22 +539,22 @@
ids))
out)]
[(struct def-for-syntax (ids rhs prefix max-let-depth))
(out-syntax DEFINE_FOR_SYNTAX_EXPD
(out-marshaled define-for-syntax-type-num
(list->vector (list* (protect-quote rhs)
prefix
max-let-depth
*dummy*
ids))
out)]
[(struct seq0 (forms))
[(struct beg0 (forms))
(out-marshaled begin0-sequence-type-num (map protect-quote forms) out)]
[(struct seq (forms))
(out-marshaled sequence-type-num (map protect-quote forms) out)]
[(struct splice (forms))
(out-syntax SPLICE_EXPD (make-seq forms) out)]
(out-marshaled splice-sequence-type-num forms out)]
[(struct req (reqs dummy))
(error "cannot handle top-level `require', yet")
(out-syntax REQUIRE_EXPD (cons dummy reqs) out)]
(out-marshaled require-form-type-num (cons dummy reqs) out)]
[(struct toplevel (depth pos const? ready?))
(out-marshaled toplevel-type-num
(cons
@ -589,7 +575,7 @@
(out-byte CPT_REFERENCE out)
(out-number id out)]
[(struct assign (id rhs undef-ok?))
(out-syntax SET_EXPD
(out-marshaled set-bang-type-num
(cons undef-ok? (cons id rhs))
out)]
[(struct localref (unbox? offset clear? other-clears? flonum?))
@ -617,19 +603,6 @@
[(? lam?)
(out-lam v out)]
[(struct case-lam (name lams))
(let ([seq (make-case-seq name lams)])
;; XXX: This seems like an optimization, which should probably happen somewhere else
;; If all closures are empty, generate a case sequence directly
(if (andmap (lambda (lam)
(or (closure? lam)
(and (lam? lam)
(equal? (lam-closure-map lam) #()))))
lams)
(out-anything seq out)
(out-syntax CASE_LAMBDA_EXPD
seq
out)))]
[(struct case-seq (name lams))
(out-marshaled case-lambda-sequence-type-num
(cons (or name null)
lams)
@ -666,7 +639,7 @@
(protect-quote body))
out)]
[(struct boxenv (pos body))
(out-syntax BOXENV_EXPD
(out-marshaled boxenv-type-num
(cons
pos
(protect-quote body))
@ -687,14 +660,10 @@
(out-anything (protect-quote e) out))
(cons rator rands)))]
[(struct apply-values (proc args-expr))
(out-syntax APPVALS_EXPD
(out-marshaled apply-values-type-num
(cons (protect-quote proc)
(protect-quote args-expr))
out)]
[(struct beg0 (exprs))
(out-syntax BEGIN0_EXPD
(make-seq0 exprs)
out)]
[(struct with-cont-mark (key val body))
(out-marshaled wcm-type-num
(list*
@ -703,7 +672,7 @@
(protect-quote body))
out)]
[(struct varref (expr))
(out-syntax REF_EXPD
(out-marshaled varref-form-type-num
expr
out)]
[(protected-symref v)
@ -823,10 +792,6 @@
(let-values ([(name base) (module-path-index-split v)])
(out-anything name out)
(out-anything base out))]
[(module-decl content)
(out-marshaled module-type-num
content
out)]
[(stx encoded)
(out-byte CPT_STX out)
(out-anything encoded out)]
@ -866,13 +831,10 @@
(out-bytes bstr out)]
[else (error 'out-anything "~s" (current-type-trace))])))))
(define-struct module-decl (content))
(define (out-module mod-form out)
(match mod-form
[(struct mod (name srcname self-modidx prefix provides requires body syntax-body unexported
max-let-depth dummy lang-info internal-context))
(out-syntax MODULE_EXPD
(let* ([lookup-req (lambda (phase)
(let ([a (assq phase requires)])
(if a
@ -956,9 +918,9 @@
[l (cons self-modidx l)]
[l (cons srcname l)]
[l (cons name l)])
(make-module-decl l))
out)]))
(out-marshaled module-type-num
l
out))]))
(define (lookup-encoded-wrapped w out)
(hash-ref! (out-encoded-wraps out) w

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

@ -200,9 +200,7 @@
(make-case-lam (car v) (cdr v)))
(define (read-begin0 v)
(match v
[(struct seq (exprs))
(make-beg0 exprs)]))
(make-beg0 v))
(define (read-boxenv v)
(make-boxenv (car v) (cdr v)))
@ -213,7 +211,7 @@
(define (read-apply-values v)
(make-apply-values (car v) (cdr v)))
(define (read-splice v)
(make-splice (seq-forms v)))
(make-splice v))
(define (in-list* l n)
(make-do-sequence
@ -303,51 +301,39 @@
;; ----------------------------------------
;; Unmarshal dispatch for various types
(define (read-more-syntax v)
(let ([id (car v)]
[v (cdr v)])
;; This is the ..._EXPD mapping from "schpriv.h":
(case id
[(0) (read-define-values v)]
[(1) (read-define-syntax v)]
[(2) (read-set! v)]
[(3) v] ; a case-lam already
[(4) (read-begin0 v)]
[(5) (read-boxenv v)]
[(6) (read-module-wrap v)]
[(7) (read-require v)]
[(8) (read-define-for-syntax v)]
[(9) (read-#%variable-ref v)]
[(10) (read-apply-values v)]
[(11) (read-splice v)]
[else (error 'read-mode-unsyntax "unknown id: ~e" id)])))
;; Type mappings from "stypes.h":
(define (int->type i)
(case i
[(0) 'toplevel-type]
[(3) 'syntax-type]
[(7) 'sequence-type]
[(9) 'unclosed-procedure-type]
[(10) 'let-value-type]
[(11) 'let-void-type]
[(12) 'letrec-type]
[(14) 'with-cont-mark-type]
[(15) 'quote-syntax-type]
[(24) 'variable-type]
[(25) 'module-variable-type]
[(99) 'case-lambda-sequence-type]
[(100) 'begin0-sequence-type]
[(103) 'module-type]
[(105) 'resolve-prefix-type]
[(154) 'free-id-info-type]
[(6) 'sequence-type]
[(8) 'unclosed-procedure-type]
[(9) 'let-value-type]
[(10) 'let-void-type]
[(11) 'letrec-type]
[(13) 'with-cont-mark-type]
[(14) 'quote-syntax-type]
[(15) 'define-values-type]
[(16) 'define-syntaxes-type]
[(17) 'define-for-syntax-type]
[(18) 'set-bang-type]
[(19) 'boxenv-type]
[(20) 'begin0-sequence-type]
[(21) 'splice-sequence-type]
[(22) 'require-form-type]
[(23) 'varref-form-type]
[(24) 'apply-values-type]
[(25) 'case-lambda-sequence-type]
[(26) 'module-type]
[(34) 'variable-type]
[(35) 'module-variable-type]
[(112) 'resolve-prefix-type]
[(161) 'free-id-info-type]
[else (error 'int->type "unknown type: ~e" i)]))
(define type-readers
(make-immutable-hash
(list
(cons 'toplevel-type read-toplevel)
(cons 'syntax-type read-more-syntax)
(cons 'sequence-type read-sequence)
(cons 'unclosed-procedure-type read-unclosed-procedure)
(cons 'let-value-type read-let-value)
@ -359,10 +345,19 @@
(cons 'module-variable-type do-not-read-variable)
(cons 'compilation-top-type read-compilation-top)
(cons 'case-lambda-sequence-type read-case-lambda)
(cons 'begin0-sequence-type read-sequence)
(cons 'begin0-sequence-type read-begin0)
(cons 'module-type read-module)
(cons 'resolve-prefix-type read-resolve-prefix)
(cons 'free-id-info-type read-free-id-info))))
(cons 'free-id-info-type read-free-id-info)
(cons 'define-values-type read-define-values)
(cons 'define-syntaxes-type read-define-syntax)
(cons 'define-for-syntax-type read-define-for-syntax)
(cons 'set-bang-type read-set!)
(cons 'boxenv-type read-boxenv)
(cons 'require-form-type read-require)
(cons 'varref-form-type read-#%variable-ref)
(cons 'apply-values-type read-apply-values)
(cons 'sequence-splice-type read-splice))))
(define (get-reader type)
(hash-ref type-readers type

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

File diff suppressed because it is too large Load Diff

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

@ -3744,8 +3744,7 @@ static Scheme_Object *do_optimize_info_lookup(Optimize_Info *info, int pos, int
break;
else
*closure_offset = delta;
} else if (SAME_TYPE(SCHEME_TYPE(n), scheme_compiled_syntax_type)
&& (SCHEME_PINT_VAL(n) == CASE_LAMBDA_EXPD)) {
} else if (SAME_TYPE(SCHEME_TYPE(n), scheme_case_lambda_sequence_type)) {
if (!closure_offset)
break;
else

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

@ -111,7 +111,8 @@
The fourth pass, "sfs", performs another liveness analysis on stack
slows and inserts operations to clear stack slots as necessary to
make execution safe for space. In particular, dead slots need to be
cleared before a non-tail call into arbitrary Scheme code.
cleared before a non-tail call into arbitrary Scheme code. This pass
can mutate the result of the "resolve" pass.
Just-in-time compilation:
@ -239,12 +240,11 @@ static Scheme_Object *read_application(Scheme_Object *obj);
static Scheme_Object *write_sequence(Scheme_Object *obj);
static Scheme_Object *read_sequence(Scheme_Object *obj);
static Scheme_Object *read_sequence_save_first(Scheme_Object *obj);
static Scheme_Object *read_sequence_splice(Scheme_Object *obj);
static Scheme_Object *write_branch(Scheme_Object *obj);
static Scheme_Object *read_branch(Scheme_Object *obj);
static Scheme_Object *write_with_cont_mark(Scheme_Object *obj);
static Scheme_Object *read_with_cont_mark(Scheme_Object *obj);
static Scheme_Object *write_syntax(Scheme_Object *obj);
static Scheme_Object *read_syntax(Scheme_Object *obj);
static Scheme_Object *write_quote_syntax(Scheme_Object *obj);
static Scheme_Object *read_quote_syntax(Scheme_Object *obj);
@ -366,10 +366,10 @@ scheme_init_eval (Scheme_Env *env)
scheme_install_type_reader(scheme_with_cont_mark_type, read_with_cont_mark);
scheme_install_type_writer(scheme_quote_syntax_type, write_quote_syntax);
scheme_install_type_reader(scheme_quote_syntax_type, read_quote_syntax);
scheme_install_type_writer(scheme_syntax_type, write_syntax);
scheme_install_type_reader(scheme_syntax_type, read_syntax);
scheme_install_type_writer(scheme_begin0_sequence_type, write_sequence);
scheme_install_type_reader(scheme_begin0_sequence_type, read_sequence_save_first);
scheme_install_type_writer(scheme_splice_sequence_type, write_sequence);
scheme_install_type_reader(scheme_splice_sequence_type, read_sequence_splice);
GLOBAL_PRIM_W_ARITY2("eval", eval, 1, 2, 0, -1, env);
GLOBAL_PRIM_W_ARITY2("eval-syntax", eval_stx, 1, 2, 0, -1, env);
@ -787,7 +787,7 @@ int scheme_omittable_expr(Scheme_Object *o, int vals, int fuel, int resolved,
&& (SCHEME_LOCAL_POS(o) > deeper_than))
|| (vtype == scheme_unclosed_procedure_type)
|| (vtype == scheme_compiled_unclosed_procedure_type)
|| ((vtype == scheme_compiled_syntax_type) && (SCHEME_PINT_VAL(o) == CASE_LAMBDA_EXPD))
|| (vtype == scheme_case_lambda_sequence_type)
|| (vtype == scheme_case_lambda_sequence_type)
|| (vtype == scheme_quote_syntax_type)
|| (vtype == scheme_compiled_quote_syntax_type)) {
@ -817,8 +817,7 @@ int scheme_omittable_expr(Scheme_Object *o, int vals, int fuel, int resolved,
}
}
if ((vtype == scheme_syntax_type)
&& (SCHEME_PINT_VAL(o) == CASE_LAMBDA_EXPD)) {
if (vtype == scheme_case_lambda_sequence_type) {
note_match(1, vals, warn_info);
return 1;
}
@ -1804,7 +1803,7 @@ static Scheme_Object *look_for_letv_change(Scheme_Sequence *s)
Scheme_Sequence *naya;
naya = malloc_sequence(nsize);
naya->so.type = scheme_sequence_type;
naya->so.type = s->so.type;
naya->count = nsize;
nv = (Scheme_Object *)naya;
@ -1817,7 +1816,7 @@ static Scheme_Object *look_for_letv_change(Scheme_Sequence *s)
if (esize > 1) {
Scheme_Sequence *e;
e = malloc_sequence(esize);
e->so.type = scheme_sequence_type;
e->so.type = s->so.type;
e->count = esize;
for (i = 0; i < esize; i++) {
@ -1852,30 +1851,6 @@ static Scheme_Object *resolve_sequence(Scheme_Object *o, Resolve_Info *info)
return look_for_letv_change(s);
}
Scheme_Object *scheme_make_syntax_resolved(int idx, Scheme_Object *data)
{
Scheme_Object *v;
v = scheme_alloc_object();
v->type = scheme_syntax_type;
SCHEME_PINT_VAL(v) = idx;
SCHEME_IPTR_VAL(v) = (void *)data;
return v;
}
Scheme_Object *scheme_make_syntax_compiled(int idx, Scheme_Object *data)
{
Scheme_Object *v;
v = scheme_alloc_object();
v->type = scheme_compiled_syntax_type;
SCHEME_PINT_VAL(v) = idx;
SCHEME_IPTR_VAL(v) = (void *)data;
return v;
}
static Scheme_Object *link_module_variable(Scheme_Object *modidx,
Scheme_Object *varname,
int check_access, Scheme_Object *insp,
@ -2073,13 +2048,6 @@ Scheme_Object *scheme_resolve_expr(Scheme_Object *expr, Resolve_Info *info)
: 0));
}
}
case scheme_compiled_syntax_type:
{
Scheme_Syntax_Resolver f;
f = scheme_syntax_resolvers[SCHEME_PINT_VAL(expr)];
return f((Scheme_Object *)SCHEME_IPTR_VAL(expr), info);
}
case scheme_application_type:
return resolve_application(expr, info, 0);
case scheme_application2_type:
@ -2087,6 +2055,8 @@ Scheme_Object *scheme_resolve_expr(Scheme_Object *expr, Resolve_Info *info)
case scheme_application3_type:
return resolve_application3(expr, info, 0);
case scheme_sequence_type:
case scheme_begin0_sequence_type:
case scheme_splice_sequence_type:
return resolve_sequence(expr, info);
case scheme_branch_type:
return resolve_branch(expr, info);
@ -2120,6 +2090,26 @@ Scheme_Object *scheme_resolve_expr(Scheme_Object *expr, Resolve_Info *info)
case scheme_module_variable_type:
scheme_signal_error("got top-level in wrong place");
return 0;
case scheme_define_values_type:
return scheme_define_values_resolve(expr, info);
case scheme_define_syntaxes_type:
return scheme_define_syntaxes_resolve(expr, info);
case scheme_define_for_syntax_type:
return scheme_define_for_syntaxes_resolve(expr, info);
case scheme_set_bang_type:
return scheme_set_resolve(expr, info);
case scheme_require_form_type:
return scheme_top_level_require_resolve(expr, info);
case scheme_varref_form_type:
return scheme_ref_resolve(expr, info);
case scheme_apply_values_type:
return scheme_apply_values_resolve(expr, info);
case scheme_case_lambda_sequence_type:
return scheme_case_lambda_resolve(expr, info);
case scheme_module_type:
return scheme_module_expr_resolve(expr, info);
case scheme_boxenv_type:
scheme_signal_error("internal error: no boxenv resolve");
default:
return expr;
}
@ -2210,10 +2200,6 @@ Scheme_Object *scheme_uncompile_expr(Scheme_Object *expr, Resolve_Prefix *prefix
sprintf(buf, "@!%d", SCHEME_LOCAL_POS(expr));
return scheme_intern_symbol(buf);
}
case scheme_compiled_syntax_type:
{
return scheme_void;
}
case scheme_application_type:
{
Scheme_App_Rec *app = (Scheme_App_Rec *)expr;
@ -2395,22 +2381,18 @@ static int estimate_expr_size(Scheme_Object *expr, int sz, int fuel)
sz += 1;
break;
}
case scheme_compiled_syntax_type:
case scheme_case_lambda_sequence_type:
{
if (SCHEME_PINT_VAL(expr) == CASE_LAMBDA_EXPD) {
int max_sz = sz + 1, a_sz;
Scheme_Case_Lambda *cl = (Scheme_Case_Lambda *)SCHEME_IPTR_VAL(expr);
Scheme_Case_Lambda *cl = (Scheme_Case_Lambda *)expr;
int i;
for (i = cl->count; i--; ) {
a_sz = estimate_expr_size(cl->array[i], sz, fuel);
if (a_sz > max_sz) max_sz = a_sz;
}
sz = max_sz;
} else {
sz += 1; /* FIXME */
}
break;
}
case scheme_application2_type:
{
Scheme_App2_Rec *app = (Scheme_App2_Rec *)expr;
@ -2490,6 +2472,7 @@ static int estimate_expr_size(Scheme_Object *expr, int sz, int fuel)
}
case scheme_compiled_toplevel_type:
case scheme_compiled_quote_syntax_type:
/* FIXME: other syntax types not covered */
default:
sz += 1;
break;
@ -2686,10 +2669,8 @@ Scheme_Object *optimize_for_inline(Optimize_Info *info, Scheme_Object *le, int a
}
}
if (le
&& SAME_TYPE(SCHEME_TYPE(le), scheme_compiled_syntax_type)
&& (SCHEME_PINT_VAL(le) == CASE_LAMBDA_EXPD)) {
Scheme_Case_Lambda *cl = (Scheme_Case_Lambda *)SCHEME_IPTR_VAL(le);
if (le && SAME_TYPE(SCHEME_TYPE(le), scheme_case_lambda_sequence_type)) {
Scheme_Case_Lambda *cl = (Scheme_Case_Lambda *)le;
Scheme_Object *cp;
int i, count;
@ -3656,10 +3637,8 @@ static Scheme_Object *lookup_constant_proc(Optimize_Info *info, Scheme_Object *r
}
}
if (c
&& (SAME_TYPE(scheme_compiled_unclosed_procedure_type, SCHEME_TYPE(c))
|| (SAME_TYPE(scheme_compiled_syntax_type, SCHEME_TYPE(c))
&& (SCHEME_PINT_VAL(c) == CASE_LAMBDA_EXPD))))
if (c && (SAME_TYPE(scheme_compiled_unclosed_procedure_type, SCHEME_TYPE(c))
|| SAME_TYPE(scheme_case_lambda_sequence_type, SCHEME_TYPE(c))))
return c;
return NULL;
@ -3930,7 +3909,7 @@ static Scheme_Object *finish_optimize_application3(Scheme_App3_Rec *app, Optimiz
cnt = 1;
cl = NULL;
} else {
cl = (Scheme_Case_Lambda *)SCHEME_IPTR_VAL(proc);
cl = (Scheme_Case_Lambda *)proc;
cnt = cl->count;
}
@ -4119,7 +4098,14 @@ Scheme_Object *scheme_optimize_apply_values(Scheme_Object *f, Scheme_Object *e,
return (Scheme_Object *)app2;
}
return scheme_make_syntax_compiled(APPVALS_EXPD, cons(f, e));
{
Scheme_Object *av;
av = scheme_alloc_object();
av->type = scheme_apply_values_type;
SCHEME_PTR1_VAL(av) = f;
SCHEME_PTR2_VAL(av) = e;
return av;
}
}
static Scheme_Object *optimize_sequence(Scheme_Object *o, Optimize_Info *info, int context)
@ -4164,7 +4150,7 @@ static Scheme_Object *optimize_sequence(Scheme_Object *o, Optimize_Info *info, i
int j = 0;
s2 = malloc_sequence(s->count - drop);
s2->so.type = scheme_sequence_type;
s2->so.type = s->so.type;
s2->count = s->count - drop;
for (i = 0; i < s->count; i++) {
@ -4451,13 +4437,6 @@ Scheme_Object *scheme_optimize_expr(Scheme_Object *expr, Optimize_Info *info, in
return expr;
}
case scheme_compiled_syntax_type:
{
Scheme_Syntax_Optimizer f;
f = scheme_syntax_optimizers[SCHEME_PINT_VAL(expr)];
return f((Scheme_Object *)SCHEME_IPTR_VAL(expr), info, context);
}
case scheme_application_type:
return optimize_application(expr, info, context);
case scheme_application2_type:
@ -4465,6 +4444,7 @@ Scheme_Object *scheme_optimize_expr(Scheme_Object *expr, Optimize_Info *info, in
case scheme_application3_type:
return optimize_application3(expr, info, context);
case scheme_sequence_type:
case scheme_splice_sequence_type:
return optimize_sequence(expr, info, context);
case scheme_branch_type:
return optimize_branch(expr, info, context);
@ -4525,6 +4505,26 @@ Scheme_Object *scheme_optimize_expr(Scheme_Object *expr, Optimize_Info *info, in
case scheme_module_variable_type:
scheme_signal_error("got top-level in wrong place");
return 0;
case scheme_define_values_type:
return scheme_define_values_optimize(expr, info, context);
case scheme_varref_form_type:
return scheme_ref_optimize(expr, info, context);
case scheme_set_bang_type:
return scheme_set_optimize(expr, info, context);
case scheme_define_syntaxes_type:
return scheme_define_syntaxes_optimize(expr, info, context);
case scheme_define_for_syntax_type:
return scheme_define_for_syntaxes_optimize(expr, info, context);
case scheme_case_lambda_sequence_type:
return scheme_case_lambda_optimize(expr, info, context);
case scheme_begin0_sequence_type:
return scheme_begin0_optimize(expr, info, context);
case scheme_apply_values_type:
return scheme_apply_values_optimize(expr, info, context);
case scheme_require_form_type:
return scheme_top_level_require_optimize(expr, info, context);
case scheme_module_type:
return scheme_module_optimize(expr, info, context);
default:
info->size += 1;
return expr;
@ -4552,14 +4552,6 @@ Scheme_Object *scheme_optimize_clone(int dup_ok, Scheme_Object *expr, Optimize_I
}
return expr;
}
case scheme_compiled_syntax_type:
{
Scheme_Syntax_Cloner f;
f = scheme_syntax_cloners[SCHEME_PINT_VAL(expr)];
if (!f) return NULL;
return f(dup_ok, (Scheme_Object *)SCHEME_IPTR_VAL(expr), info, delta, closure_depth);
}
case scheme_application2_type:
{
Scheme_App2_Rec *app = (Scheme_App2_Rec *)expr, *app2;
@ -4673,6 +4665,7 @@ Scheme_Object *scheme_optimize_clone(int dup_ok, Scheme_Object *expr, Optimize_I
}
case scheme_sequence_type:
case scheme_begin0_sequence_type:
case scheme_splice_sequence_type:
{
Scheme_Sequence *seq = (Scheme_Sequence *)expr, *seq2;
int i;
@ -4736,6 +4729,22 @@ Scheme_Object *scheme_optimize_clone(int dup_ok, Scheme_Object *expr, Optimize_I
case scheme_compiled_toplevel_type:
case scheme_compiled_quote_syntax_type:
return expr;
case scheme_define_values_type:
case scheme_define_syntaxes_type:
case scheme_define_for_syntax_type:
case scheme_set_bang_type:
case scheme_boxenv_type:
return NULL;
case scheme_require_form_type:
return NULL;
case scheme_varref_form_type:
return NULL;
case scheme_apply_values_type:
return scheme_apply_values_clone(dup_ok, expr, info, delta, closure_depth);
case scheme_case_lambda_sequence_type:
return scheme_case_lambda_clone(dup_ok, expr, info, delta, closure_depth);
case scheme_module_type:
return NULL;
default:
if (t > _scheme_compiled_values_types_) {
if (dup_ok || scheme_compiled_duplicate_ok(expr))
@ -4766,18 +4775,6 @@ Scheme_Object *scheme_optimize_shift(Scheme_Object *expr, int delta, int after_d
}
return expr;
}
case scheme_compiled_syntax_type:
{
Scheme_Syntax_Shifter f;
f = scheme_syntax_shifters[SCHEME_PINT_VAL(expr)];
if (!f) {
scheme_signal_error("scheme_optimize_shift: no shift available for %d", SCHEME_PINT_VAL(expr));
return NULL;
}
return f((Scheme_Object *)SCHEME_IPTR_VAL(expr), delta, after_depth);
}
case scheme_application_type:
{
Scheme_App_Rec *app = (Scheme_App_Rec *)expr;
@ -4845,6 +4842,7 @@ Scheme_Object *scheme_optimize_shift(Scheme_Object *expr, int delta, int after_d
return (Scheme_Object *)head;
}
case scheme_sequence_type:
case scheme_splice_sequence_type:
case scheme_begin0_sequence_type:
{
Scheme_Sequence *seq = (Scheme_Sequence *)expr;
@ -4892,6 +4890,22 @@ Scheme_Object *scheme_optimize_shift(Scheme_Object *expr, int delta, int after_d
case scheme_compiled_toplevel_type:
case scheme_compiled_quote_syntax_type:
return expr;
case scheme_set_bang_type:
return scheme_set_shift(expr, delta, after_depth);
case scheme_varref_form_type:
return scheme_ref_shift(expr, delta, after_depth);
case scheme_apply_values_type:
return scheme_apply_values_shift(expr, delta, after_depth);
case scheme_case_lambda_sequence_type:
return scheme_case_lambda_shift(expr, delta, after_depth);
case scheme_boxenv_type:
case scheme_define_values_type:
case scheme_define_syntaxes_type:
case scheme_define_for_syntax_type:
case scheme_require_form_type:
case scheme_module_type:
scheme_signal_error("scheme_optimize_shift: no shift available for %d", SCHEME_TYPE(expr));
return NULL;
default:
return expr;
}
@ -5067,10 +5081,7 @@ Scheme_Object *scheme_sfs_add_clears(Scheme_Object *expr, Scheme_Object *clears,
clears = SCHEME_CDR(clears);
}
if (pre)
return (Scheme_Object *)s;
else
return scheme_make_syntax_resolved(BEGIN0_EXPD, (Scheme_Object *)s);
}
static void sfs_note_app(SFS_Info *info, Scheme_Object *rator)
@ -5589,12 +5600,11 @@ static Scheme_Object *sfs_letrec(Scheme_Object *o, SFS_Info *info)
for (i = 0; i < count; i++) {
v = scheme_sfs_expr(procs[i], info, i);
if (SAME_TYPE(SCHEME_TYPE(v), scheme_syntax_type)
&& (SCHEME_PINT_VAL(v) == BEGIN0_EXPD)) {
if (SAME_TYPE(SCHEME_TYPE(v), scheme_begin0_sequence_type)) {
/* Some clearing actions were added to the closure.
Lift them out. */
int j;
Scheme_Sequence *cseq = (Scheme_Sequence *)SCHEME_IPTR_VAL(v);
Scheme_Sequence *cseq = (Scheme_Sequence *)v;
for (j = 1; j < cseq->count; j++) {
int pos;
pos = SCHEME_LOCAL_POS(cseq->array[j]);
@ -5670,18 +5680,6 @@ Scheme_Object *scheme_sfs_expr(Scheme_Object *expr, SFS_Info *info, int closure_
}
}
break;
case scheme_syntax_type:
{
Scheme_Syntax_SFSer f;
Scheme_Object *orig, *naya;
f = scheme_syntax_sfsers[SCHEME_PINT_VAL(expr)];
orig = SCHEME_IPTR_VAL(expr);
naya = f(orig, info);
if (!SAME_OBJ(orig, naya))
expr = naya;
}
break;
case scheme_application_type:
expr = sfs_application(expr, info);
break;
@ -5692,6 +5690,7 @@ Scheme_Object *scheme_sfs_expr(Scheme_Object *expr, SFS_Info *info, int closure_
expr = sfs_application3(expr, info);
break;
case scheme_sequence_type:
case scheme_splice_sequence_type:
expr = sfs_sequence(expr, info);
break;
case scheme_branch_type:
@ -5721,9 +5720,8 @@ Scheme_Object *scheme_sfs_expr(Scheme_Object *expr, SFS_Info *info, int closure_
if (ZERO_SIZED_CLOSUREP(c)) {
Scheme_Object *code;
code = scheme_sfs_closure((Scheme_Object *)c->code, info, closure_self_pos);
if (SAME_TYPE(SCHEME_TYPE(code), scheme_syntax_type)
&& (SCHEME_PINT_VAL(code) == BEGIN0_EXPD)) {
Scheme_Sequence *seq = (Scheme_Sequence *)SCHEME_IPTR_VAL(code);
if (SAME_TYPE(SCHEME_TYPE(code), scheme_begin0_sequence_type)) {
Scheme_Sequence *seq = (Scheme_Sequence *)code;
c->code = (Scheme_Closure_Data *)seq->array[0];
seq->array[0] = expr;
expr = code;
@ -5745,6 +5743,39 @@ Scheme_Object *scheme_sfs_expr(Scheme_Object *expr, SFS_Info *info, int closure_
/* FIXME: maybe need to handle eagerly created closure */
}
break;
case scheme_define_values_type:
expr = scheme_define_values_sfs(expr, info);
break;
case scheme_define_syntaxes_type:
expr = scheme_define_for_syntaxes_sfs(expr, info);
break;
case scheme_define_for_syntax_type:
expr = scheme_define_syntaxes_sfs(expr, info);
break;
case scheme_set_bang_type:
expr = scheme_set_sfs(expr, info);
break;
case scheme_boxenv_type:
expr = scheme_bangboxenv_sfs(expr, info);
break;
case scheme_begin0_sequence_type:
expr = scheme_begin0_sfs(expr, info);
break;
case scheme_require_form_type:
expr = scheme_top_level_require_sfs(expr, info);
break;
case scheme_varref_form_type:
expr = scheme_ref_sfs(expr, info);
break;
case scheme_apply_values_type:
expr = scheme_apply_values_sfs(expr, info);
break;
case scheme_case_lambda_sequence_type:
expr = scheme_case_lambda_sfs(expr, info);
break;
case scheme_module_type:
expr = scheme_module_sfs(expr, info);
break;
default:
break;
}
@ -6020,19 +6051,6 @@ Scheme_Object *scheme_jit_expr(Scheme_Object *expr)
Scheme_Type type = SCHEME_TYPE(expr);
switch (type) {
case scheme_syntax_type:
{
Scheme_Syntax_Jitter f;
Scheme_Object *orig, *naya;
f = scheme_syntax_jitters[SCHEME_PINT_VAL(expr)];
orig = SCHEME_IPTR_VAL(expr);
naya = f(orig);
if (SAME_OBJ(orig, naya))
return expr;
return scheme_make_syntax_resolved(SCHEME_PINT_VAL(expr), naya);
}
case scheme_application_type:
return jit_application(expr);
case scheme_application2_type:
@ -6040,6 +6058,7 @@ Scheme_Object *scheme_jit_expr(Scheme_Object *expr)
case scheme_application3_type:
return jit_application3(expr);
case scheme_sequence_type:
case scheme_splice_sequence_type:
return jit_sequence(expr);
case scheme_branch_type:
return jit_branch(expr);
@ -6068,6 +6087,28 @@ Scheme_Object *scheme_jit_expr(Scheme_Object *expr)
{
return scheme_unclose_case_lambda(expr, 1);
}
case scheme_define_values_type:
return scheme_define_values_jit(expr);
case scheme_define_syntaxes_type:
return scheme_define_syntaxes_jit(expr);
case scheme_define_for_syntax_type:
return scheme_define_for_syntaxes_jit(expr);
case scheme_set_bang_type:
return scheme_set_jit(expr);
case scheme_boxenv_type:
return scheme_bangboxenv_jit(expr);
case scheme_begin0_sequence_type:
return scheme_begin0_jit(expr);
case scheme_require_form_type:
return scheme_top_level_require_jit(expr);
case scheme_varref_form_type:
return scheme_ref_jit(expr);
case scheme_apply_values_type:
return scheme_apply_values_jit(expr);
case scheme_case_lambda_sequence_type:
return scheme_case_lambda_jit(expr);
case scheme_module_type:
return scheme_module_jit(expr);
default:
return expr;
}
@ -9783,15 +9824,6 @@ scheme_do_eval(Scheme_Object *obj, int num_rands, Scheme_Object **rands,
EVAL_SFS_CLEAR(RUNSTACK, obj);
goto returnv_never_multi;
}
case scheme_syntax_type:
{
Scheme_Syntax_Executer f;
UPDATE_THREAD_RSPTR();
f = scheme_syntax_executers[SCHEME_PINT_VAL(obj)];
v = f((Scheme_Object *)SCHEME_IPTR_VAL(obj));
break;
}
case scheme_application_type:
{
Scheme_App_Rec *app;
@ -10335,6 +10367,78 @@ scheme_do_eval(Scheme_Object *obj, int num_rands, Scheme_Object **rands,
goto returnv_never_multi;
}
case scheme_define_values_type:
{
UPDATE_THREAD_RSPTR();
v = scheme_define_values_execute(obj);
break;
}
case scheme_define_syntaxes_type:
{
UPDATE_THREAD_RSPTR();
v = scheme_define_syntaxes_execute(obj);
break;
}
case scheme_define_for_syntax_type:
{
UPDATE_THREAD_RSPTR();
v = scheme_define_for_syntaxes_execute(obj);
break;
}
case scheme_set_bang_type:
{
UPDATE_THREAD_RSPTR();
v = scheme_set_execute(obj);
break;
}
case scheme_boxenv_type:
{
UPDATE_THREAD_RSPTR();
v = scheme_bangboxenv_execute(obj);
break;
}
case scheme_begin0_sequence_type:
{
UPDATE_THREAD_RSPTR();
v = scheme_begin0_execute(obj);
break;
}
case scheme_splice_sequence_type:
{
UPDATE_THREAD_RSPTR();
v = scheme_splice_execute(obj);
break;
}
case scheme_require_form_type:
{
UPDATE_THREAD_RSPTR();
v = scheme_top_level_require_execute(obj);
break;
}
case scheme_varref_form_type:
{
UPDATE_THREAD_RSPTR();
v = scheme_ref_execute(obj);
break;
}
case scheme_apply_values_type:
{
UPDATE_THREAD_RSPTR();
v = scheme_apply_values_execute(obj);
break;
}
case scheme_case_lambda_sequence_type:
{
UPDATE_THREAD_RSPTR();
v = scheme_case_lambda_execute(obj);
break;
}
case scheme_module_type:
{
UPDATE_THREAD_RSPTR();
v = scheme_module_execute(obj, NULL);
break;
}
default:
v = obj;
goto returnv_never_multi;
@ -11748,31 +11852,16 @@ Scheme_Object *scheme_eval_clone(Scheme_Object *expr)
/* Clone as much as necessary of `expr' so that prefixes are
cloned. Cloned prefixes, in turn, can be updated by linking to
reduce the overhead of cross-module references. */
if (SAME_TYPE(SCHEME_TYPE(expr), scheme_syntax_type)) {
int kind;
Scheme_Object *orig, *naya;
kind = SCHEME_PINT_VAL(expr);
orig = SCHEME_IPTR_VAL(expr);
switch (kind) {
case MODULE_EXPD:
naya = scheme_module_eval_clone(orig);
break;
case DEFINE_SYNTAX_EXPD:
case DEFINE_FOR_SYNTAX_EXPD:
naya = scheme_syntaxes_eval_clone(orig);
switch (SCHEME_TYPE(expr)) {
case scheme_module_type:
return scheme_module_eval_clone(expr);
break;
case scheme_define_syntaxes_type:
case scheme_define_for_syntax_type:
return scheme_syntaxes_eval_clone(expr);
default:
naya = orig;
break;
return expr;
}
if (SAME_OBJ(orig, naya))
return expr;
return scheme_make_syntax_resolved(kind, naya);
} else
return expr;
}
Resolve_Prefix *scheme_prefix_eval_clone(Resolve_Prefix *rp)
@ -12666,21 +12755,6 @@ void scheme_validate_expr(Mz_CPort *port, Scheme_Object *expr,
}
}
break;
case scheme_syntax_type:
{
Scheme_Syntax_Validater f;
int p = SCHEME_PINT_VAL(expr);
no_flo(need_flonum, port);
if ((p < 0) || (p >= _COUNT_EXPD_))
scheme_ill_formed_code(port);
f = scheme_syntax_validaters[p];
f((Scheme_Object *)SCHEME_IPTR_VAL(expr), port, stack, tls, depth, letlimit, delta,
num_toplevels, num_stxes, num_lifts, tl_use_map, result_ignored, vc, tailpos, procs);
}
break;
case scheme_application_type:
{
Scheme_App_Rec *app = (Scheme_App_Rec *)expr;
@ -12754,6 +12828,7 @@ void scheme_validate_expr(Mz_CPort *port, Scheme_Object *expr,
}
break;
case scheme_sequence_type:
case scheme_splice_sequence_type:
{
Scheme_Sequence *seq = (Scheme_Sequence *)expr;
int cnt;
@ -12989,6 +13064,73 @@ void scheme_validate_expr(Mz_CPort *port, Scheme_Object *expr,
goto top;
}
break;
case scheme_define_values_type:
no_flo(need_flonum, port);
scheme_define_values_validate(expr, port, stack, tls, depth, letlimit, delta,
num_toplevels, num_stxes, num_lifts, tl_use_map,
result_ignored, vc, tailpos, procs);
break;
case scheme_define_syntaxes_type:
no_flo(need_flonum, port);
scheme_define_syntaxes_validate(expr, port, stack, tls, depth, letlimit, delta,
num_toplevels, num_stxes, num_lifts, tl_use_map,
result_ignored, vc, tailpos, procs);
break;
case scheme_define_for_syntax_type:
no_flo(need_flonum, port);
scheme_define_for_syntaxes_validate(expr, port, stack, tls, depth, letlimit, delta,
num_toplevels, num_stxes, num_lifts, tl_use_map,
result_ignored, vc, tailpos, procs);
break;
case scheme_set_bang_type:
no_flo(need_flonum, port);
scheme_set_validate(expr, port, stack, tls, depth, letlimit, delta,
num_toplevels, num_stxes, num_lifts, tl_use_map,
result_ignored, vc, tailpos, procs);
break;
case scheme_boxenv_type:
no_flo(need_flonum, port);
scheme_bangboxenv_validate(expr, port, stack, tls, depth, letlimit, delta,
num_toplevels, num_stxes, num_lifts, tl_use_map,
result_ignored, vc, tailpos, procs);
break;
case scheme_begin0_sequence_type:
no_flo(need_flonum, port);
scheme_begin0_validate(expr, port, stack, tls, depth, letlimit, delta,
num_toplevels, num_stxes, num_lifts, tl_use_map,
result_ignored, vc, tailpos, procs);
break;
case scheme_require_form_type:
no_flo(need_flonum, port);
scheme_top_level_require_validate(expr, port, stack, tls, depth, letlimit, delta,
num_toplevels, num_stxes, num_lifts, tl_use_map,
result_ignored, vc, tailpos, procs);
break;
case scheme_varref_form_type:
no_flo(need_flonum, port);
scheme_ref_validate(expr, port, stack, tls, depth, letlimit, delta,
num_toplevels, num_stxes, num_lifts, tl_use_map,
result_ignored, vc, tailpos, procs);
break;
case scheme_apply_values_type:
no_flo(need_flonum, port);
scheme_apply_values_validate(expr, port, stack, tls, depth, letlimit, delta,
num_toplevels, num_stxes, num_lifts, tl_use_map,
result_ignored, vc, tailpos, procs);
break;
case scheme_case_lambda_sequence_type:
no_flo(need_flonum, port);
scheme_case_lambda_validate(expr, port, stack, tls, depth, letlimit, delta,
num_toplevels, num_stxes, num_lifts, tl_use_map,
result_ignored, vc, tailpos, procs);
break;
case scheme_module_type:
no_flo(need_flonum, port);
scheme_module_validate(expr, port, stack, tls, depth, letlimit, delta,
num_toplevels, num_stxes, num_lifts, tl_use_map,
result_ignored, vc, tailpos, procs);
break;
default:
/* All values are definitely ok, except pre-closed closures.
Such a closure can refer back to itself, so we use a flag
@ -13105,6 +13247,14 @@ static Scheme_Object *read_sequence_save_first(Scheme_Object *obj)
return scheme_make_sequence_compilation(obj, -2);
}
static Scheme_Object *read_sequence_splice(Scheme_Object *obj)
{
obj = scheme_make_sequence_compilation(obj, 1);
if (SAME_TYPE(SCHEME_TYPE(obj), scheme_sequence_type))
obj->type = scheme_splice_sequence_type;
return obj;
}
static Scheme_Object *write_branch(Scheme_Object *obj)
{
scheme_signal_error("branch writer shouldn't be used");
@ -13143,118 +13293,6 @@ static Scheme_Object *read_with_cont_mark(Scheme_Object *obj)
return (Scheme_Object *)wcm;
}
static Scheme_Object *write_syntax(Scheme_Object *obj)
{
Scheme_Object *idx, *rest, *l;
int protect_after, c;
c = SCHEME_PINT_VAL(obj);
idx = scheme_make_integer(c);
protect_after = scheme_syntax_protect_afters[c];
if (c == BEGIN0_EXPD) {
Scheme_Object *v;
v = SCHEME_PTR_VAL(obj);
switch (SCHEME_TYPE(v)) {
case scheme_sequence_type:
case scheme_begin0_sequence_type:
break;
default:
break;
}
}
l = rest = (Scheme_Object *)SCHEME_IPTR_VAL(obj);
if (protect_after == -2) {
/* -2 => protect first element of vector */
if (SCHEME_VECTORP(l)) {
l = scheme_protect_quote(SCHEME_VEC_ELS(rest)[0]);
if (!SAME_OBJ(l, SCHEME_VEC_ELS(rest)[0])) {
Scheme_Object *vec;
intptr_t i, len;
len = SCHEME_VEC_SIZE(rest);
vec = scheme_make_vector(len, NULL);
SCHEME_VEC_ELS(vec)[0] = l;
for (i = 1; i < len; i++) {
SCHEME_VEC_ELS(vec)[i] = SCHEME_VEC_ELS(rest)[i];
}
rest = vec;
}
} else {
scheme_signal_error("expected a vector for syntax");
}
} else {
for (c = 0; SCHEME_PAIRP(l) && (c < protect_after); c++) {
l = SCHEME_CDR(l);
}
if (!SCHEME_NULLP(l) && (c == protect_after)) {
Scheme_Object *new_l;
new_l = scheme_protect_quote(l);
if (new_l != l) {
Scheme_Object *first = NULL, *last = NULL;
while (rest != l) {
Scheme_Object *p;
p = scheme_make_pair(SCHEME_CAR(rest), scheme_null);
if (last)
SCHEME_CDR(last) = p;
else
first = p;
last = p;
rest = SCHEME_CDR(rest);
}
if (last)
SCHEME_CDR(last) = new_l;
else
first = new_l;
rest = first;
}
}
}
return cons(idx, rest);
}
static Scheme_Object *read_syntax(Scheme_Object *obj)
{
Scheme_Object *idx;
Scheme_Object *first = NULL, *last = NULL;
int limit;
if (!SCHEME_PAIRP(obj) || !SCHEME_INTP(SCHEME_CAR(obj)))
return NULL; /* bad .zo */
idx = SCHEME_CAR(obj);
/* Copy obj, up to number of cons cells before a "protected" value: */
limit = scheme_syntax_protect_afters[SCHEME_INT_VAL(idx)];
obj = SCHEME_CDR(obj);
while (SCHEME_PAIRP(obj) && (limit > 0)) {
Scheme_Object *p;
p = scheme_make_pair(SCHEME_CAR(obj), scheme_null);
if (last)
SCHEME_CDR(last) = p;
else
first = p;
last = p;
obj = SCHEME_CDR(obj);
limit--;
}
if (last)
SCHEME_CDR(last) = obj;
else
first = obj;
return scheme_make_syntax_resolved(SCHEME_INT_VAL(idx), first);
}
static Scheme_Object *write_quote_syntax(Scheme_Object *obj)
{
Scheme_Quote_Syntax *qs = (Scheme_Quote_Syntax *)obj;

12
src/racket/src/fun.c
View File

@ -1789,9 +1789,11 @@ scheme_resolve_closure_compilation(Scheme_Object *_data, Resolve_Info *info,
int j = i + closure_size + convert_size;
Scheme_Object *bcode;
bcode = scheme_make_syntax_resolved(BOXENV_EXPD,
scheme_make_pair(scheme_make_integer(j),
data->code));
bcode = scheme_alloc_object();
bcode->type = scheme_boxenv_type;
SCHEME_PTR1_VAL(bcode) = scheme_make_integer(j);
SCHEME_PTR2_VAL(bcode) = data->code;
data->code = bcode;
}
}
@ -3585,8 +3587,8 @@ const char *scheme_get_proc_name(Scheme_Object *p, int *len, int for_error)
name = ((Scheme_Closure_Data *)p)->name;
} else if (type == scheme_closure_type) {
name = SCHEME_COMPILED_CLOS_CODE(p)->name;
} else if (type == scheme_compiled_syntax_type) {
Scheme_Case_Lambda *cl = (Scheme_Case_Lambda *)SCHEME_IPTR_VAL(p);
} else if (type == scheme_case_lambda_sequence_type) {
Scheme_Case_Lambda *cl = (Scheme_Case_Lambda *)p;
if (!cl->count)
name = NULL;
else

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

@ -320,15 +320,8 @@ static int is_short(Scheme_Object *obj, int fuel)
t = SCHEME_TYPE(obj);
switch (t) {
case scheme_syntax_type:
{
int t;
t = SCHEME_PINT_VAL(obj);
if (t == CASE_LAMBDA_EXPD)
case scheme_case_lambda_sequence_type:
return fuel - 1;
else
return 0;
}
break;
case scheme_application_type:
{
@ -552,12 +545,8 @@ int scheme_is_simple(Scheme_Object *obj, int depth, int just_markless, mz_jit_st
type = SCHEME_TYPE(obj);
switch (type) {
case scheme_syntax_type:
{
int t;
t = SCHEME_PINT_VAL(obj);
return (t == CASE_LAMBDA_EXPD);
}
case scheme_case_lambda_sequence_type:
return 1;
break;
case scheme_branch_type:
@ -636,9 +625,6 @@ int scheme_is_non_gc(Scheme_Object *obj, int depth)
type = SCHEME_TYPE(obj);
switch (type) {
case scheme_syntax_type:
break;
case scheme_branch_type:
if (depth) {
Scheme_Branch_Rec *b = (Scheme_Branch_Rec *)obj;
@ -711,8 +697,8 @@ static int is_a_procedure(Scheme_Object *v, mz_jit_state *jitter)
if (SAME_TYPE(t, scheme_closure_type)
|| SAME_TYPE(t, scheme_unclosed_procedure_type))
return 1;
else if (SAME_TYPE(t, scheme_syntax_type)) {
return (SCHEME_PINT_VAL(v) == CASE_LAMBDA_EXPD);
else if (SAME_TYPE(t, scheme_case_lambda_sequence_type)) {
return 1;
} else if (SAME_TYPE(t, scheme_local_type)) {
int flags;
return scheme_mz_is_closure(jitter, SCHEME_LOCAL_POS(v), -1, &flags);
@ -1889,12 +1875,7 @@ int scheme_generate(Scheme_Object *obj, mz_jit_state *jitter, int is_tail, int w
END_JIT_DATA(3);
return 1;
}
case scheme_syntax_type:
{
int pos;
pos = SCHEME_PINT_VAL(obj);
switch (pos) {
case CASE_LAMBDA_EXPD:
case scheme_case_lambda_sequence_type:
{
START_JIT_DATA();
LOG_IT(("case-lambda\n"));
@ -1902,11 +1883,12 @@ int scheme_generate(Scheme_Object *obj, mz_jit_state *jitter, int is_tail, int w
if (for_branch)
finish_branch_with_true(jitter, for_branch);
else
generate_case_closure(SCHEME_IPTR_VAL(obj), jitter, target);
generate_case_closure(obj, jitter, target);
END_JIT_DATA(5);
return 1;
}
break;
case BEGIN0_EXPD:
case scheme_begin0_sequence_type:
{
Scheme_Sequence *seq;
GC_CAN_IGNORE jit_insn *ref, *ref2;
@ -1915,7 +1897,7 @@ int scheme_generate(Scheme_Object *obj, mz_jit_state *jitter, int is_tail, int w
LOG_IT(("begin0\n"));
seq = (Scheme_Sequence *)SCHEME_IPTR_VAL(obj);
seq = (Scheme_Sequence *)obj;
/* Evaluate first expression, and for consistency with bytecode
evaluation, allow multiple values. */
@ -1985,23 +1967,24 @@ int scheme_generate(Scheme_Object *obj, mz_jit_state *jitter, int is_tail, int w
if (for_branch) finish_branch(jitter, target, for_branch);
END_JIT_DATA(6);
return 1;
}
break;
case SET_EXPD:
case scheme_set_bang_type:
{
Scheme_Set_Bang *sb = (Scheme_Set_Bang *)obj;
Scheme_Object *p, *v;
int pos, set_undef;
GC_CAN_IGNORE jit_insn *ref1, *ref2, *ref3
GC_CAN_IGNORE jit_insn *ref1, *ref2, *ref3;
START_JIT_DATA();
LOG_IT(("set!\n"));
p = SCHEME_IPTR_VAL(obj);
v = SCHEME_CAR(p);
set_undef = SCHEME_TRUEP(v);
p = SCHEME_CDR(p);
v = SCHEME_CAR(p);
p = SCHEME_CDR(p);
p = sb->val;
v = sb->var;
set_undef = sb->set_undef;
scheme_generate_non_tail(p, jitter, 0, 1, 0);
CHECK_LIMIT();
@ -2051,9 +2034,11 @@ int scheme_generate(Scheme_Object *obj, mz_jit_state *jitter, int is_tail, int w
(void)jit_movi_p(target, scheme_void);
}
END_JIT_DATA(7);
return 1;
}
break;
case APPVALS_EXPD:
case scheme_apply_values_type:
{
Scheme_Object *p, *v;
GC_CAN_IGNORE jit_insn *ref, *ref2, *ref3, *ref5, *refloop;
@ -2061,9 +2046,8 @@ int scheme_generate(Scheme_Object *obj, mz_jit_state *jitter, int is_tail, int w
LOG_IT(("appvals\n"));
p = SCHEME_IPTR_VAL(obj);
v = SCHEME_CAR(p);
p = SCHEME_CDR(p);
v = SCHEME_PTR1_VAL(obj);
p = SCHEME_PTR2_VAL(obj);
scheme_generate_non_tail(v, jitter, 0, 1, 0);
CHECK_LIMIT();
@ -2198,9 +2182,10 @@ int scheme_generate(Scheme_Object *obj, mz_jit_state *jitter, int is_tail, int w
if (is_tail)
return 2;
return 1;
}
break;
case BOXENV_EXPD:
case scheme_boxenv_type:
{
Scheme_Object *p, *v;
int pos;
@ -2211,10 +2196,9 @@ int scheme_generate(Scheme_Object *obj, mz_jit_state *jitter, int is_tail, int w
mz_rs_sync();
JIT_UPDATE_THREAD_RSPTR_IF_NEEDED();
p = (Scheme_Object *)SCHEME_IPTR_VAL(obj);
v = SCHEME_CAR(p);
v = SCHEME_PTR1_VAL(obj);
pos = mz_remap(SCHEME_INT_VAL(v));
p = SCHEME_CDR(p);
p = SCHEME_PTR2_VAL(obj);
#ifdef CAN_INLINE_ALLOC
scheme_inline_alloc(jitter, sizeof(Scheme_Object*), -1, 0, 0, 0, 0);
@ -2238,18 +2222,20 @@ int scheme_generate(Scheme_Object *obj, mz_jit_state *jitter, int is_tail, int w
scheme_generate(p, jitter, is_tail, wcm_may_replace, multi_ok, orig_target, for_branch);
END_JIT_DATA(8);
return 1;
}
break;
case REF_EXPD:
case scheme_varref_form_type:
{
if (for_branch)
finish_branch_with_true(jitter, for_branch);
else {
Scheme_Object *dummy;
int pos;
mz_rs_sync();
obj = SCHEME_IPTR_VAL(obj);
dummy = SCHEME_PTR2_VAL(obj);
obj = SCHEME_PTR1_VAL(obj);
@ -2278,31 +2264,21 @@ int scheme_generate(Scheme_Object *obj, mz_jit_state *jitter, int is_tail, int w
jit_retval(target);
VALIDATE_RESULT(target);
}
}
break;
case SPLICE_EXPD:
{
scheme_signal_error("internal error: cannot JIT a top-level splice form");
}
break;
default:
{
mz_rs_sync();
JIT_UPDATE_THREAD_RSPTR_IF_NEEDED();
obj = SCHEME_IPTR_VAL(obj);
(void)jit_patchable_movi_p(JIT_R2, obj); /* !! */
CHECK_LIMIT();
mz_prepare(1);
jit_pusharg_p(JIT_R2);
(void)mz_finish(scheme_syntax_executers[pos]);
CHECK_LIMIT();
jit_retval(target);
VALIDATE_RESULT(target);
if (for_branch) finish_branch(jitter, target, for_branch);
}
}
return 1;
}
break;
case scheme_splice_sequence_type:
case scheme_define_values_type:
case scheme_define_syntaxes_type:
case scheme_define_for_syntax_type:
case scheme_require_form_type:
case scheme_module_type:
{
scheme_signal_error("internal error: cannot JIT a top-level form");
return 0;
}
break;
case scheme_application_type:
{
Scheme_App_Rec *app = (Scheme_App_Rec *)obj;

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

@ -88,36 +88,10 @@ static Scheme_Object *require_expand(Scheme_Object *form, Scheme_Comp_Env *env,
static Scheme_Object *provide_syntax(Scheme_Object *form, Scheme_Comp_Env *env, Scheme_Compile_Info *rec, int drec);
static Scheme_Object *provide_expand(Scheme_Object *form, Scheme_Comp_Env *env, Scheme_Expand_Info *erec, int drec);
static Scheme_Object *module_execute(Scheme_Object *data);
static Scheme_Object *top_level_require_execute(Scheme_Object *data);
static Scheme_Object *module_jit(Scheme_Object *data);
static Scheme_Object *top_level_require_jit(Scheme_Object *data);
static Scheme_Object *module_optimize(Scheme_Object *data, Optimize_Info *info, int context);
static Scheme_Object *module_resolve(Scheme_Object *data, Resolve_Info *info);
static Scheme_Object *module_sfs(Scheme_Object *data, SFS_Info *info);
static Scheme_Object *top_level_require_optimize(Scheme_Object *data, Optimize_Info *info, int context);
static Scheme_Object *top_level_require_resolve(Scheme_Object *data, Resolve_Info *info);
static Scheme_Object *top_level_require_sfs(Scheme_Object *data, SFS_Info *info);
static void module_validate(Scheme_Object *data, Mz_CPort *port,
char *stack, Validate_TLS tls,
int depth, int letlimit, int delta,
int num_toplevels, int num_stxes, int num_lifts,
void *tl_use_map, int result_ignored,
struct Validate_Clearing *vc, int tailpos,
Scheme_Hash_Tree *procs);
static void top_level_require_validate(Scheme_Object *data, Mz_CPort *port,
char *stack, Validate_TLS tls,
int depth, int letlimit, int delta,
int num_toplevels, int num_stxes, int num_lifts,
void *tl_use_map, int result_ignored,
struct Validate_Clearing *vc, int tailpos,
Scheme_Hash_Tree *procs);
static Scheme_Object *write_module(Scheme_Object *obj);
static Scheme_Object *read_module(Scheme_Object *obj);
static Scheme_Object *read_top_level_require(Scheme_Object *obj);
static Scheme_Object *write_top_level_require(Scheme_Object *obj);
static Scheme_Module *module_load(Scheme_Object *modname, Scheme_Env *env, const char *who);
@ -303,17 +277,6 @@ static void qsort_provides(Scheme_Object **exs, Scheme_Object **exsns, Scheme_Ob
void scheme_init_module(Scheme_Env *env)
{
scheme_register_syntax(MODULE_EXPD,
module_optimize,
module_resolve, module_sfs, module_validate,
module_execute, module_jit,
NULL, NULL, -1);
scheme_register_syntax(REQUIRE_EXPD,
top_level_require_optimize,
top_level_require_resolve, top_level_require_sfs, top_level_require_validate,
top_level_require_execute, top_level_require_jit,
NULL, NULL, 2);
scheme_add_global_keyword("module",
scheme_make_compiled_syntax(module_syntax,
module_expand),
@ -386,6 +349,8 @@ void scheme_init_module(Scheme_Env *env)
scheme_install_type_writer(scheme_module_type, write_module);
scheme_install_type_reader(scheme_module_type, read_module);
scheme_install_type_writer(scheme_require_form_type, write_top_level_require);
scheme_install_type_reader(scheme_require_form_type, read_top_level_require);
GLOBAL_PARAMETER("current-module-name-resolver", current_module_name_resolver, MZCONFIG_CURRENT_MODULE_RESOLVER, env);
GLOBAL_PARAMETER("current-module-declare-name", current_module_name_prefix, MZCONFIG_CURRENT_MODULE_NAME, env);
@ -4690,21 +4655,14 @@ static int needs_prompt(Scheme_Object *e)
case scheme_local_type:
case scheme_local_unbox_type:
return 0;
case scheme_syntax_type:
switch (SCHEME_PINT_VAL(e)) {
case CASE_LAMBDA_EXPD:
case scheme_case_lambda_sequence_type:
return 0;
case DEFINE_VALUES_EXPD:
e = (Scheme_Object *)SCHEME_IPTR_VAL(e);
case scheme_define_values_type:
e = SCHEME_VEC_ELS(e)[0];
break;
default:
return 1;
}
break;
default:
return 1;
}
}
}
@ -5015,9 +4973,8 @@ Scheme_Module *scheme_extract_compiled_module(Scheme_Object *o)
if (!c->prefix) /* => compiled module is in `code' field */
return (Scheme_Module *)c->code;
if (SAME_TYPE(SCHEME_TYPE(c->code), scheme_syntax_type)
&& (SCHEME_PINT_VAL(c->code) == MODULE_EXPD)) {
return (Scheme_Module *)SCHEME_IPTR_VAL(c->code);
if (SAME_TYPE(SCHEME_TYPE(c->code), scheme_module_type)) {
return (Scheme_Module *)c->code;
}
}
@ -5387,11 +5344,6 @@ static Scheme_Object *do_module_execute(Scheme_Object *data, Scheme_Env *genv, i
return scheme_void;
}
static Scheme_Object *module_execute(Scheme_Object *data)
{
return do_module_execute(data, NULL, 1);
}
Scheme_Object *scheme_module_execute(Scheme_Object *data, Scheme_Env *genv)
{
return do_module_execute(data, genv, 0);
@ -5507,7 +5459,7 @@ static Scheme_Object *do_module_clone(Scheme_Object *data, int jit)
return (Scheme_Object *)m;
}
static Scheme_Object *module_jit(Scheme_Object *data)
Scheme_Object *scheme_module_jit(Scheme_Object *data)
{
return do_module_clone(data, 1);
}
@ -5517,7 +5469,7 @@ Scheme_Object *scheme_module_eval_clone(Scheme_Object *data)
return do_module_clone(data, 0);
}
static void module_validate(Scheme_Object *data, Mz_CPort *port,
void scheme_module_validate(Scheme_Object *data, Mz_CPort *port,
char *stack, Validate_TLS tls,
int depth, int letlimit, int delta,
int num_toplevels, int num_stxes, int num_lifts,
@ -5530,9 +5482,6 @@ static void module_validate(Scheme_Object *data, Mz_CPort *port,
Resolve_Prefix *rp;
Scheme_Object *e;
if (!SAME_TYPE(SCHEME_TYPE(data), scheme_module_type))
scheme_ill_formed_code(port);
m = (Scheme_Module *)data;
if (!SCHEME_MODNAMEP(m->modname))
@ -5590,8 +5539,8 @@ static int set_code_closure_flags(Scheme_Object *clones,
return flags;
}
static Scheme_Object *
module_optimize(Scheme_Object *data, Optimize_Info *info, int context)
Scheme_Object *
scheme_module_optimize(Scheme_Object *data, Optimize_Info *info, int context)
{
Scheme_Module *m = (Scheme_Module *)data;
Scheme_Object *e, *vars, *old_context;
@ -5612,13 +5561,11 @@ module_optimize(Scheme_Object *data, Optimize_Info *info, int context)
at the expense of later inlining. */
for (i_m = 0; i_m < cnt; i_m++) {
e = SCHEME_VEC_ELS(m->body)[i_m];
if (SAME_TYPE(SCHEME_TYPE(e), scheme_compiled_syntax_type)
&& (SCHEME_PINT_VAL(e) == DEFINE_VALUES_EXPD)) {
if (SAME_TYPE(SCHEME_TYPE(e), scheme_define_values_type)) {
int n;
e = (Scheme_Object *)SCHEME_IPTR_VAL(e);
vars = SCHEME_CAR(e);
e = SCHEME_CDR(e);
vars = SCHEME_VEC_ELS(e)[0];
e = SCHEME_VEC_ELS(e)[1];
n = scheme_list_length(vars);
if (n == 1) {
@ -5654,11 +5601,10 @@ module_optimize(Scheme_Object *data, Optimize_Info *info, int context)
is_proc_def = 0;
if (OPT_DISCOURAGE_EARLY_INLINE && info->enforce_const) {
if (SAME_TYPE(SCHEME_TYPE(e), scheme_compiled_syntax_type)
&& (SCHEME_PINT_VAL(e) == DEFINE_VALUES_EXPD)) {
if (SAME_TYPE(SCHEME_TYPE(e), scheme_define_values_type)) {
Scheme_Object *e2;
e2 = (Scheme_Object *)SCHEME_IPTR_VAL(e);
e2 = SCHEME_CDR(e2);
e2 = (Scheme_Object *)e;
e2 = SCHEME_VEC_ELS(e2)[1];
if (IS_COMPILED_PROC(e2))
is_proc_def = 1;
}
@ -5682,14 +5628,11 @@ module_optimize(Scheme_Object *data, Optimize_Info *info, int context)
/* If this expression/definition can't have any side effect
(including raising an exception), then continue the group of
simultaneous definitions: */
if (SAME_TYPE(SCHEME_TYPE(e), scheme_compiled_syntax_type)
&& (SCHEME_PINT_VAL(e) == DEFINE_VALUES_EXPD)) {
if (SAME_TYPE(SCHEME_TYPE(e), scheme_define_values_type)) {
int n, cnst = 0, sproc = 0;
e = (Scheme_Object *)SCHEME_IPTR_VAL(e);
vars = SCHEME_CAR(e);
e = SCHEME_CDR(e);
vars = SCHEME_VEC_ELS(e)[0];
e = SCHEME_VEC_ELS(e)[1];
n = scheme_list_length(vars);
cont = scheme_omittable_expr(e, n, -1, 0, info, -1);
@ -5810,11 +5753,9 @@ module_optimize(Scheme_Object *data, Optimize_Info *info, int context)
e = SCHEME_VEC_ELS(m->body)[start_simltaneous];
if (OPT_LIMIT_FUNCTION_RESIZE) {
if (SAME_TYPE(SCHEME_TYPE(e), scheme_compiled_syntax_type)
&& (SCHEME_PINT_VAL(e) == DEFINE_VALUES_EXPD)) {
if (SAME_TYPE(SCHEME_TYPE(e), scheme_define_values_type)) {
Scheme_Object *sub_e;
sub_e = (Scheme_Object *)SCHEME_IPTR_VAL(e);
sub_e = SCHEME_CDR(sub_e);
sub_e = SCHEME_VEC_ELS(e)[1];
if (IS_COMPILED_PROC(sub_e))
old_sz = scheme_compiled_proc_body_size(sub_e);
else
@ -5833,8 +5774,7 @@ module_optimize(Scheme_Object *data, Optimize_Info *info, int context)
Scheme_Object *rpos;
rpos = scheme_hash_get(re_consts, scheme_make_integer(start_simltaneous));
if (rpos) {
e = (Scheme_Object *)SCHEME_IPTR_VAL(e);
e = SCHEME_CDR(e);
e = SCHEME_VEC_ELS(e)[1];
if (!scheme_compiled_propagate_ok(e, info)
&& scheme_is_statically_proc(e, info)) {
/* If we previously installed a procedure for inlining,
@ -5921,11 +5861,11 @@ module_optimize(Scheme_Object *data, Optimize_Info *info, int context)
/* Exp-time body was optimized during compilation */
return scheme_make_syntax_compiled(MODULE_EXPD, data);
return data;
}
static Scheme_Object *
module_resolve(Scheme_Object *data, Resolve_Info *old_rslv)
Scheme_Object *
scheme_module_expr_resolve(Scheme_Object *data, Resolve_Info *old_rslv)
{
Scheme_Module *m = (Scheme_Module *)data;
Scheme_Object *b, *lift_vec;
@ -5967,11 +5907,11 @@ module_resolve(Scheme_Object *data, Resolve_Info *old_rslv)
/* Exp-time body was resolved during compilation */
return scheme_make_syntax_resolved(MODULE_EXPD, data);
return data;
}
static Scheme_Object *
module_sfs(Scheme_Object *data, SFS_Info *old_info)
Scheme_Object *
scheme_module_sfs(Scheme_Object *data, SFS_Info *old_info)
{
Scheme_Module *m = (Scheme_Module *)data;
Scheme_Object *e, *ex;
@ -5984,9 +5924,7 @@ module_sfs(Scheme_Object *data, SFS_Info *old_info)
info = scheme_new_sfs_info(m->max_let_depth);
info->for_mod = 1;
scheme_sfs(scheme_make_syntax_resolved(MODULE_EXPD, data),
info,
m->max_let_depth);
scheme_sfs(data, info, m->max_let_depth);
return data;
}
@ -6243,7 +6181,7 @@ static Scheme_Object *do_module(Scheme_Object *form, Scheme_Comp_Env *env,
m->lang_info = pv;
}
fm = scheme_make_syntax_compiled(MODULE_EXPD, (Scheme_Object *)m);
fm = (Scheme_Object *)m;
} else {
Scheme_Object *hints, *formname;
@ -9928,21 +9866,21 @@ do_require_execute(Scheme_Env *env, Scheme_Object *form)
return scheme_void;
}
static Scheme_Object *
top_level_require_execute(Scheme_Object *data)
Scheme_Object *
scheme_top_level_require_execute(Scheme_Object *data)
{
do_require_execute(scheme_environment_from_dummy(SCHEME_CAR(data)),
SCHEME_CDR(data));
do_require_execute(scheme_environment_from_dummy(SCHEME_PTR1_VAL(data)),
SCHEME_PTR2_VAL(data));
return scheme_void;
}
static Scheme_Object *
top_level_require_jit(Scheme_Object *data)
Scheme_Object *
scheme_top_level_require_jit(Scheme_Object *data)
{
return data;
}
static void top_level_require_validate(Scheme_Object *data, Mz_CPort *port,
void scheme_top_level_require_validate(Scheme_Object *data, Mz_CPort *port,
char *stack, Validate_TLS tls,
int depth, int letlimit, int delta,
int num_toplevels, int num_stxes, int num_lifts,
@ -9952,24 +9890,26 @@ static void top_level_require_validate(Scheme_Object *data, Mz_CPort *port,
{
}
static Scheme_Object *
top_level_require_optimize(Scheme_Object *data, Optimize_Info *info, int context)
Scheme_Object *
scheme_top_level_require_optimize(Scheme_Object *data, Optimize_Info *info, int context)
{
return scheme_make_syntax_compiled(REQUIRE_EXPD, data);
return data;
}
static Scheme_Object *
top_level_require_resolve(Scheme_Object *data, Resolve_Info *rslv)
Scheme_Object *
scheme_top_level_require_resolve(Scheme_Object *data, Resolve_Info *rslv)
{
Scheme_Object *dummy = SCHEME_CAR(data);
Scheme_Object *dummy = SCHEME_PTR1_VAL(data);
dummy = scheme_resolve_expr(dummy, rslv);
return scheme_make_syntax_resolved(REQUIRE_EXPD, cons(dummy, SCHEME_CDR(data)));
SCHEME_PTR1_VAL(data) = dummy;
return data;
}
static Scheme_Object *
top_level_require_sfs(Scheme_Object *data, SFS_Info *rslv)
Scheme_Object *
scheme_top_level_require_sfs(Scheme_Object *data, SFS_Info *rslv)
{
return data;
}
@ -9978,7 +9918,7 @@ static Scheme_Object *do_require(Scheme_Object *form, Scheme_Comp_Env *env,
Scheme_Compile_Expand_Info *rec, int drec)
{
Scheme_Hash_Table *ht;
Scheme_Object *rn_set, *dummy, *modidx;
Scheme_Object *rn_set, *dummy, *modidx, *data;
Scheme_Env *genv;
if (!scheme_is_toplevel(env))
@ -10014,9 +9954,13 @@ static Scheme_Object *do_require(Scheme_Object *form, Scheme_Comp_Env *env,
scheme_compile_rec_done_local(rec, drec);
scheme_default_compile_rec(rec, drec);
return scheme_make_syntax_compiled(REQUIRE_EXPD,
cons(dummy,
form));
data = scheme_alloc_object();
data->type = scheme_require_form_type;
SCHEME_PTR1_VAL(data) = dummy;
SCHEME_PTR2_VAL(data) = form;
return data;
} else
return form;
}
@ -10664,3 +10608,22 @@ static Scheme_Object *read_module(Scheme_Object *obj)
return (Scheme_Object *)m;
}
Scheme_Object *write_top_level_require(Scheme_Object *o)
{
return scheme_make_pair(SCHEME_PTR1_VAL(o), SCHEME_PTR2_VAL(o));
}
Scheme_Object *read_top_level_require(Scheme_Object *o)
{
Scheme_Object *data;
if (!SCHEME_PAIRP(o)) return NULL;
data = scheme_alloc_object();
data->type = scheme_require_form_type;
SCHEME_PTR1_VAL(data) = SCHEME_CAR(o);
SCHEME_PTR2_VAL(data) = SCHEME_CDR(o);
return data;
}

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

@ -656,6 +656,35 @@ static int let_header_FIXUP(void *p, struct NewGC *gc) {
#define let_header_IS_CONST_SIZE 1
static int set_bang_SIZE(void *p, struct NewGC *gc) {
return
gcBYTES_TO_WORDS(sizeof(Scheme_Set_Bang));
}
static int set_bang_MARK(void *p, struct NewGC *gc) {
Scheme_Set_Bang *b = (Scheme_Set_Bang *)p;
gcMARK2(b->var, gc);
gcMARK2(b->val, gc);
return
gcBYTES_TO_WORDS(sizeof(Scheme_Set_Bang));
}
static int set_bang_FIXUP(void *p, struct NewGC *gc) {
Scheme_Set_Bang *b = (Scheme_Set_Bang *)p;
gcFIXUP2(b->var, gc);
gcFIXUP2(b->val, gc);
return
gcBYTES_TO_WORDS(sizeof(Scheme_Set_Bang));
}
#define set_bang_IS_ATOMIC 0
#define set_bang_IS_CONST_SIZE 1
static int prim_proc_SIZE(void *p, struct NewGC *gc) {
Scheme_Primitive_Proc *prim = (Scheme_Primitive_Proc *)p;

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

@ -243,6 +243,17 @@ let_header {
gcBYTES_TO_WORDS(sizeof(Scheme_Let_Header));
}
set_bang {
mark:
Scheme_Set_Bang *b = (Scheme_Set_Bang *)p;
gcMARK2(b->var, gc);
gcMARK2(b->val, gc);
size:
gcBYTES_TO_WORDS(sizeof(Scheme_Set_Bang));
}
prim_proc {
Scheme_Primitive_Proc *prim = (Scheme_Primitive_Proc *)p;

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

@ -2495,6 +2495,12 @@ Scheme_Object *scheme_sfs_add_clears(Scheme_Object *expr, Scheme_Object *clears,
typedef struct Scheme_Object *(*Scheme_Syntax_SFSer)(Scheme_Object *data, SFS_Info *info);
typedef struct Scheme_Set_Bang {
Scheme_Object so;
int set_undef;
Scheme_Object *var, *val;
} Scheme_Set_Bang;
/* Resolving & linking */
#define DEFINE_VALUES_EXPD 0
#define DEFINE_SYNTAX_EXPD 1
@ -2510,34 +2516,10 @@ typedef struct Scheme_Object *(*Scheme_Syntax_SFSer)(Scheme_Object *data, SFS_In
#define SPLICE_EXPD 11
#define _COUNT_EXPD_ 12
#define scheme_register_syntax(i, fo, fr, fs, fv, fe, fj, cl, sh, pa) \
(scheme_syntax_optimizers[i] = fo, \
scheme_syntax_resolvers[i] = fr, \
scheme_syntax_executers[i] = fe, \
scheme_syntax_sfsers[i] = fs, \
scheme_syntax_validaters[i] = fv, \
scheme_syntax_jitters[i] = fj, \
scheme_syntax_cloners[i] = cl, \
scheme_syntax_shifters[i] = sh, \
scheme_syntax_protect_afters[i] = pa)
extern Scheme_Syntax_Optimizer scheme_syntax_optimizers[_COUNT_EXPD_];
extern Scheme_Syntax_Resolver scheme_syntax_resolvers[_COUNT_EXPD_];
extern Scheme_Syntax_SFSer scheme_syntax_sfsers[_COUNT_EXPD_];
extern Scheme_Syntax_Validater scheme_syntax_validaters[_COUNT_EXPD_];
extern Scheme_Syntax_Executer scheme_syntax_executers[_COUNT_EXPD_];
extern Scheme_Syntax_Jitter scheme_syntax_jitters[_COUNT_EXPD_];
extern Scheme_Syntax_Cloner scheme_syntax_cloners[_COUNT_EXPD_];
extern Scheme_Syntax_Shifter scheme_syntax_shifters[_COUNT_EXPD_];
extern int scheme_syntax_protect_afters[_COUNT_EXPD_];
Scheme_Object *scheme_protect_quote(Scheme_Object *expr);
Scheme_Object *scheme_make_syntax_resolved(int idx, Scheme_Object *data);
Scheme_Object *scheme_make_syntax_compiled(int idx, Scheme_Object *data);
#define IS_COMPILED_PROC(vals_expr) (SAME_TYPE(SCHEME_TYPE(vals_expr), scheme_compiled_unclosed_procedure_type) \
|| (SAME_TYPE(SCHEME_TYPE(vals_expr), scheme_compiled_syntax_type) \
&& (SCHEME_PINT_VAL(vals_expr) == CASE_LAMBDA_EXPD)))
|| SAME_TYPE(SCHEME_TYPE(vals_expr), scheme_case_lambda_sequence_type))
int scheme_compiled_proc_body_size(Scheme_Object *o);
Scheme_Object *scheme_optimize_expr(Scheme_Object *, Optimize_Info *, int context);
@ -2954,6 +2936,153 @@ Scheme_Object *scheme_rename_transformer_id(Scheme_Object *o);
int scheme_is_set_transformer(Scheme_Object *o);
Scheme_Object *scheme_set_transformer_proc(Scheme_Object *o);
Scheme_Object *scheme_define_values_execute(Scheme_Object *data);
Scheme_Object *scheme_ref_execute(Scheme_Object *data);
Scheme_Object *scheme_set_execute(Scheme_Object *data);
Scheme_Object *scheme_define_syntaxes_execute(Scheme_Object *expr);
Scheme_Object *scheme_define_for_syntaxes_execute(Scheme_Object *expr);
Scheme_Object *scheme_case_lambda_execute(Scheme_Object *expr);
Scheme_Object *scheme_begin0_execute(Scheme_Object *data);
Scheme_Object *scheme_apply_values_execute(Scheme_Object *data);
Scheme_Object *scheme_splice_execute(Scheme_Object *data);
Scheme_Object *scheme_bangboxenv_execute(Scheme_Object *data);
Scheme_Object *scheme_top_level_require_execute(Scheme_Object *data);
Scheme_Object *scheme_define_values_optimize(Scheme_Object *data, Optimize_Info *info, int context);
Scheme_Object *scheme_ref_optimize(Scheme_Object *data, Optimize_Info *info, int context);
Scheme_Object *scheme_set_optimize(Scheme_Object *data, Optimize_Info *info, int context);
Scheme_Object *scheme_define_syntaxes_optimize(Scheme_Object *expr, Optimize_Info *info, int context);
Scheme_Object *scheme_define_for_syntaxes_optimize(Scheme_Object *expr, Optimize_Info *info, int context);
Scheme_Object *scheme_case_lambda_optimize(Scheme_Object *expr, Optimize_Info *info, int context);
Scheme_Object *scheme_begin0_optimize(Scheme_Object *data, Optimize_Info *info, int context);
Scheme_Object *scheme_apply_values_optimize(Scheme_Object *data, Optimize_Info *info, int context);
Scheme_Object *scheme_module_optimize(Scheme_Object *data, Optimize_Info *info, int context);
Scheme_Object *scheme_top_level_require_optimize(Scheme_Object *data, Optimize_Info *info, int context);
Scheme_Object *scheme_begin0_clone(int dup_ok, Scheme_Object *data, Optimize_Info *info, int delta, int closure_depth);
Scheme_Object *scheme_set_clone(int dup_ok, Scheme_Object *data, Optimize_Info *info, int delta, int closure_depth);
Scheme_Object *scheme_apply_values_clone(int dup_ok, Scheme_Object *data, Optimize_Info *info, int delta, int closure_depth);
Scheme_Object *scheme_case_lambda_clone(int dup_ok, Scheme_Object *data, Optimize_Info *info, int delta, int closure_depth);
Scheme_Object *scheme_begin0_shift(Scheme_Object *data, int delta, int after_depth);
Scheme_Object *scheme_set_shift(Scheme_Object *data, int delta, int after_depth);
Scheme_Object *scheme_ref_shift(Scheme_Object *data, int delta, int after_depth);
Scheme_Object *scheme_case_lambda_shift(Scheme_Object *data, int delta, int after_depth);
Scheme_Object *scheme_apply_values_shift(Scheme_Object *data, int delta, int after_depth);
Scheme_Object *scheme_define_values_resolve(Scheme_Object *data, Resolve_Info *info);
Scheme_Object *scheme_ref_resolve(Scheme_Object *data, Resolve_Info *info);
Scheme_Object *scheme_set_resolve(Scheme_Object *data, Resolve_Info *info);
Scheme_Object *scheme_define_syntaxes_resolve(Scheme_Object *expr, Resolve_Info *info);
Scheme_Object *scheme_define_for_syntaxes_resolve(Scheme_Object *expr, Resolve_Info *info);
Scheme_Object *scheme_case_lambda_resolve(Scheme_Object *expr, Resolve_Info *info);
Scheme_Object *scheme_begin0_resolve(Scheme_Object *data, Resolve_Info *info);
Scheme_Object *scheme_apply_values_resolve(Scheme_Object *data, Resolve_Info *info);
Scheme_Object *scheme_module_expr_resolve(Scheme_Object *data, Resolve_Info *info);
Scheme_Object *scheme_top_level_require_resolve(Scheme_Object *data, Resolve_Info *info);
Scheme_Object *scheme_define_values_sfs(Scheme_Object *data, SFS_Info *info);
Scheme_Object *scheme_ref_sfs(Scheme_Object *data, SFS_Info *info);
Scheme_Object *scheme_set_sfs(Scheme_Object *data, SFS_Info *info);
Scheme_Object *scheme_define_syntaxes_sfs(Scheme_Object *expr, SFS_Info *info);
Scheme_Object *scheme_define_for_syntaxes_sfs(Scheme_Object *expr, SFS_Info *info);
Scheme_Object *scheme_case_lambda_sfs(Scheme_Object *expr, SFS_Info *info);
Scheme_Object *scheme_begin0_sfs(Scheme_Object *data, SFS_Info *info);
Scheme_Object *scheme_apply_values_sfs(Scheme_Object *data, SFS_Info *info);
Scheme_Object *scheme_bangboxenv_sfs(Scheme_Object *data, SFS_Info *info);
Scheme_Object *scheme_module_sfs(Scheme_Object *data, SFS_Info *info);
Scheme_Object *scheme_top_level_require_sfs(Scheme_Object *data, SFS_Info *info);
void scheme_define_values_validate(Scheme_Object *data, Mz_CPort *port,
char *stack, Validate_TLS tls,
int depth, int letlimit, int delta,
int num_toplevels, int num_stxes, int num_lifts,
void *tl_use_map, int result_ignored,
struct Validate_Clearing *vc, int tailpos,
Scheme_Hash_Tree *procs);
void scheme_ref_validate(Scheme_Object *data, Mz_CPort *port,
char *stack, Validate_TLS tls,
int depth, int letlimit, int delta,
int num_toplevels, int num_stxes, int num_lifts,
void *tl_use_map, int result_ignored,
struct Validate_Clearing *vc, int tailpos,
Scheme_Hash_Tree *procs);
void scheme_set_validate(Scheme_Object *data, Mz_CPort *port,
char *stack, Validate_TLS tls,
int depth, int letlimit, int delta,
int num_toplevels, int num_stxes, int num_lifts,
void *tl_use_map, int result_ignored,
struct Validate_Clearing *vc, int tailpos,
Scheme_Hash_Tree *procs);
void scheme_define_syntaxes_validate(Scheme_Object *data, Mz_CPort *port,
char *stack, Validate_TLS tls,
int depth, int letlimit, int delta,
int num_toplevels, int num_stxes, int num_lifts,
void *tl_use_map, int result_ignored,
struct Validate_Clearing *vc, int tailpos,
Scheme_Hash_Tree *procs);
void scheme_define_for_syntaxes_validate(Scheme_Object *data, Mz_CPort *port,
char *stack, Validate_TLS tls,
int depth, int letlimit, int delta,
int num_toplevels, int num_stxes, int num_lifts,
void *tl_use_map, int result_ignored,
struct Validate_Clearing *vc, int tailpos,
Scheme_Hash_Tree *procs);
void scheme_case_lambda_validate(Scheme_Object *data, Mz_CPort *port,
char *stack, Validate_TLS tls,
int depth, int letlimit, int delta,
int num_toplevels, int num_stxes, int num_lifts,
void *tl_use_map, int result_ignored,
struct Validate_Clearing *vc, int tailpos,
Scheme_Hash_Tree *procs);
void scheme_begin0_validate(Scheme_Object *data, Mz_CPort *port,
char *stack, Validate_TLS tls,
int depth, int letlimit, int delta,
int num_toplevels, int num_stxes, int num_lifts,
void *tl_use_map, int result_ignored,
struct Validate_Clearing *vc, int tailpos,
Scheme_Hash_Tree *procs);
void scheme_apply_values_validate(Scheme_Object *data, Mz_CPort *port,
char *stack, Validate_TLS tls,
int depth, int letlimit, int delta,
int num_toplevels, int num_stxes, int num_lifts,
void *tl_use_map, int result_ignored,
struct Validate_Clearing *vc, int tailpos,
Scheme_Hash_Tree *procs);
void scheme_bangboxenv_validate(Scheme_Object *data, Mz_CPort *port,
char *stack, Validate_TLS tls,
int depth, int letlimit, int delta,
int num_toplevels, int num_stxes, int num_lifts,
void *tl_use_map, int result_ignored,
struct Validate_Clearing *vc, int tailpos,
Scheme_Hash_Tree *procs);
void scheme_module_validate(Scheme_Object *data, Mz_CPort *port,
char *stack, Validate_TLS tls,
int depth, int letlimit, int delta,
int num_toplevels, int num_stxes, int num_lifts,
void *tl_use_map, int result_ignored,
struct Validate_Clearing *vc, int tailpos,
Scheme_Hash_Tree *procs);
void scheme_top_level_require_validate(Scheme_Object *data, Mz_CPort *port,
char *stack, Validate_TLS tls,
int depth, int letlimit, int delta,
int num_toplevels, int num_stxes, int num_lifts,
void *tl_use_map, int result_ignored,
struct Validate_Clearing *vc, int tailpos,
Scheme_Hash_Tree *procs);
Scheme_Object *scheme_define_values_jit(Scheme_Object *data);
Scheme_Object *scheme_ref_jit(Scheme_Object *data);
Scheme_Object *scheme_set_jit(Scheme_Object *data);
Scheme_Object *scheme_define_syntaxes_jit(Scheme_Object *expr);
Scheme_Object *scheme_define_for_syntaxes_jit(Scheme_Object *expr);
Scheme_Object *scheme_case_lambda_jit(Scheme_Object *expr);
Scheme_Object *scheme_begin0_jit(Scheme_Object *data);
Scheme_Object *scheme_apply_values_jit(Scheme_Object *data);
Scheme_Object *scheme_bangboxenv_jit(Scheme_Object *data);
Scheme_Object *scheme_module_jit(Scheme_Object *data);
Scheme_Object *scheme_top_level_require_jit(Scheme_Object *data);
/*========================================================================*/
/* namespaces and modules */
/*========================================================================*/

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

@ -13,12 +13,12 @@
consistently.)
*/
#define MZSCHEME_VERSION "5.1.1.4"
#define MZSCHEME_VERSION "5.1.1.5"
#define MZSCHEME_VERSION_X 5
#define MZSCHEME_VERSION_Y 1
#define MZSCHEME_VERSION_Z 1
#define MZSCHEME_VERSION_W 4
#define MZSCHEME_VERSION_W 5
#define MZSCHEME_VERSION_MAJOR ((MZSCHEME_VERSION_X * 100) + MZSCHEME_VERSION_Y)
#define MZSCHEME_VERSION_MINOR ((MZSCHEME_VERSION_Z * 1000) + MZSCHEME_VERSION_W)

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

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

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

File diff suppressed because it is too large Load Diff

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

@ -107,15 +107,24 @@ scheme_init_type ()
set_name(scheme_application3_type, "<binary-application-code>");
set_name(scheme_compiled_unclosed_procedure_type, "<procedure-semi-code>");
set_name(scheme_unclosed_procedure_type, "<procedure-code>");
set_name(scheme_syntax_type, "<syntax-code>");
set_name(scheme_compiled_syntax_type, "<syntax-semi-code>");
set_name(scheme_branch_type, "<branch-code>");
set_name(scheme_sequence_type, "<sequence-code>");
set_name(scheme_case_lambda_sequence_type, "<case-lambda-code>");
set_name(scheme_begin0_sequence_type, "<begin0-code>");
set_name(scheme_with_cont_mark_type, "<with-continuation-mark-code>");
set_name(scheme_quote_syntax_type, "<quote-syntax-code>");
set_name(scheme_define_values_type, "<define-values-code>");
set_name(scheme_define_syntaxes_type, "<define-syntaxes-code>");
set_name(scheme_define_for_syntax_type, "<define-for-syntax-code>");
set_name(scheme_begin0_sequence_type, "<begin0-code>");
set_name(scheme_splice_sequence_type, "<splicing-begin-code>");
set_name(scheme_module_type, "<module-code>");
set_name(scheme_set_bang_type, "<set!-code>");
set_name(scheme_boxenv_type, "<boxenv-code>");
set_name(scheme_require_form_type, "<require-code>");
set_name(scheme_varref_form_type, "<varref-code>");
set_name(scheme_apply_values_type, "<apply-values-code>");
set_name(scheme_case_lambda_sequence_type, "<case-lambda-code>");
set_name(scheme_let_value_type, "<let-value-code>");
set_name(scheme_let_void_type, "<let-void-code>");
set_name(scheme_compiled_let_value_type, "<let-value-semi-code>");
@ -214,7 +223,6 @@ scheme_init_type ()
set_name(scheme_set_macro_type, "<set!-transformer>");
set_name(scheme_id_macro_type, "<rename-transformer>");
set_name(scheme_module_type, "<module-code>");
set_name(scheme_module_index_type, "<module-path-index>");
set_name(scheme_subprocess_type, "<subprocess>");
@ -502,7 +510,6 @@ void scheme_register_traversers(void)
GC_REG_TRAV(scheme_variable_type, variable_obj);
GC_REG_TRAV(scheme_local_type, local_obj);
GC_REG_TRAV(scheme_local_unbox_type, local_obj);
GC_REG_TRAV(scheme_syntax_type, iptr_obj);
GC_REG_TRAV(scheme_application_type, app_rec);
GC_REG_TRAV(scheme_application2_type, app2_rec);
GC_REG_TRAV(scheme_application3_type, app3_rec);
@ -517,12 +524,24 @@ void scheme_register_traversers(void)
GC_REG_TRAV(scheme_quote_syntax_type, quotesyntax_obj);
GC_REG_TRAV(scheme_module_variable_type, module_var);
GC_REG_TRAV(scheme_define_values_type, vector_obj);
GC_REG_TRAV(scheme_define_syntaxes_type, vector_obj);
GC_REG_TRAV(scheme_define_for_syntax_type, vector_obj);
GC_REG_TRAV(scheme_varref_form_type, twoptr_obj);
GC_REG_TRAV(scheme_apply_values_type, twoptr_obj);
GC_REG_TRAV(scheme_boxenv_type, twoptr_obj);
GC_REG_TRAV(scheme_case_lambda_sequence_type, case_closure);
GC_REG_TRAV(scheme_begin0_sequence_type, seq_rec);
GC_REG_TRAV(scheme_splice_sequence_type, seq_rec);
GC_REG_TRAV(scheme_set_bang_type, set_bang);
GC_REG_TRAV(scheme_module_type, module_val);
GC_REG_TRAV(scheme_require_form_type, twoptr_obj);
GC_REG_TRAV(_scheme_values_types_, bad_trav);
GC_REG_TRAV(scheme_compiled_unclosed_procedure_type, unclosed_proc);
GC_REG_TRAV(scheme_compiled_let_value_type, comp_let_value);
GC_REG_TRAV(scheme_compiled_let_void_type, let_header);
GC_REG_TRAV(scheme_compiled_syntax_type, iptr_obj);
GC_REG_TRAV(scheme_compiled_toplevel_type, toplevel_obj);
GC_REG_TRAV(scheme_compiled_quote_syntax_type, local_obj);
@ -603,8 +622,6 @@ void scheme_register_traversers(void)
GC_REG_TRAV(scheme_undefined_type, char_obj); /* small */
GC_REG_TRAV(scheme_placeholder_type, small_object);
GC_REG_TRAV(scheme_table_placeholder_type, iptr_obj);
GC_REG_TRAV(scheme_case_lambda_sequence_type, case_closure);
GC_REG_TRAV(scheme_begin0_sequence_type, seq_rec);
GC_REG_TRAV(scheme_svector_type, svector_val);
@ -614,7 +631,6 @@ void scheme_register_traversers(void)
GC_REG_TRAV(scheme_stx_type, stx_val);
GC_REG_TRAV(scheme_stx_offset_type, stx_off_val);
GC_REG_TRAV(scheme_expanded_syntax_type, twoptr_obj);
GC_REG_TRAV(scheme_module_type, module_val);
GC_REG_TRAV(scheme_rt_module_exports, module_exports_val);
GC_REG_TRAV(scheme_module_phase_exports_type, module_phase_exports_val);
GC_REG_TRAV(scheme_module_index_type, modidx_val);