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

improve names for some internal structures and functions

Browse Source 
Changes:

    ...unclosed_procedure... -> lambda
    ...procedure_compilation... -> lambda
    ..._Closure_Data -> ..._Lambda
    `code` field in Scheme_Lambda -> `body` field
    ..._CLOSURE_DATA_FLAGS -> ..._LAMBDA_FLAGS
    CLOS_... -> LAMBDA_... (e.g., CLOS_IS_METHOD)
    SCHEME_COMPILED_CLOS_CODE -> SCHEME_CLOSURE_CODE
    SCHEME_COMPILED_CLOS_ENV -> SCHEME_CLOSURE_ENV

    ..._compiled_... -> ..._ir_... (where "ir" is "intermediate
                                    representation")
    ..._Compiled_... -> ..._IR_... (e.g., Scheme_Compiled_Let_Value)
    Scheme_Let_Header -> Scheme_IR_Let_Header (since it's IR-only)
    Closure_Info -> Scheme_IR_Lambda_Info

    make_syntax_compiler -> make_primitive_syntax
    scheme_syntax_compiler_type -> scheme_primitive_syntax_type
    ..._syntax -> ..._compiler (e.g., lambda_syntax -> lambda_compile)

    scheme_..._prim -> scheme_..._proc
    scheme_values_func -> scheme_values_proc

Closes #1249
This commit is contained in:
Matthew Flatt 2016-02-19 08:44:08 -07:00
parent 37a8031803
commit 5f7d0317e8
42 changed files with 2296 additions and 2305 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
racket/src/racket/include/scheme.h
View File

@ -883,7 +883,7 @@ typedef struct {
/* ------------------------------------------------- */
#define SCHEME_PROCP(obj) (!SCHEME_INTP(obj) && ((_SCHEME_TYPE(obj) >= scheme_prim_type) && (_SCHEME_TYPE(obj) <= scheme_proc_chaperone_type)))
#define SCHEME_SYNTAXP(obj) SAME_TYPE(SCHEME_TYPE(obj), scheme_syntax_compiler_type)
#define SCHEME_SYNTAXP(obj) SAME_TYPE(SCHEME_TYPE(obj), scheme_primitive_syntax_type)
#define SCHEME_PRIMP(obj) SAME_TYPE(SCHEME_TYPE(obj), scheme_prim_type)
#define SCHEME_CLSD_PRIMP(obj) SAME_TYPE(SCHEME_TYPE(obj), scheme_closed_prim_type)
#define SCHEME_CONTP(obj) SAME_TYPE(SCHEME_TYPE(obj), scheme_cont_type)
@ -895,8 +895,8 @@ typedef struct {
#define SCHEME_PRIM(obj) (((Scheme_Primitive_Proc *)(obj))->prim_val)
#define SCHEME_CLSD_PRIM(obj) (((Scheme_Closed_Primitive_Proc *)(obj))->prim_val)
#define SCHEME_CLSD_PRIM_DATA(obj) (((Scheme_Closed_Primitive_Proc *)(obj))->data)
#define SCHEME_CLOS_FUNC(obj) ((Scheme_Closure_Func)SCHEME_CAR(obj))
#define SCHEME_CLOS_DATA(obj) SCHEME_CDR(obj)
#define SCHEME_RAW_CLOS_FUNC(obj) ((Scheme_Closure_Func)SCHEME_CAR(obj))
#define SCHEME_RAW_CLOS_DATA(obj) SCHEME_CDR(obj)
/*========================================================================*/
/* hash tables and environments */

28
racket/src/racket/src/bool.c
View File

@ -34,10 +34,10 @@
READ_ONLY Scheme_Object scheme_true[1];
READ_ONLY Scheme_Object scheme_false[1];
READ_ONLY Scheme_Object *scheme_not_prim;
READ_ONLY Scheme_Object *scheme_eq_prim;
READ_ONLY Scheme_Object *scheme_eqv_prim;
READ_ONLY Scheme_Object *scheme_equal_prim;
READ_ONLY Scheme_Object *scheme_not_proc;
READ_ONLY Scheme_Object *scheme_eq_proc;
READ_ONLY Scheme_Object *scheme_eqv_proc;
READ_ONLY Scheme_Object *scheme_equal_proc;
/* locals */
static Scheme_Object *not_prim (int argc, Scheme_Object *argv[]);
@ -82,13 +82,13 @@ void scheme_init_bool (Scheme_Env *env)
{
Scheme_Object *p;
REGISTER_SO(scheme_not_prim);
REGISTER_SO(scheme_eq_prim);
REGISTER_SO(scheme_eqv_prim);
REGISTER_SO(scheme_equal_prim);
REGISTER_SO(scheme_not_proc);
REGISTER_SO(scheme_eq_proc);
REGISTER_SO(scheme_eqv_proc);
REGISTER_SO(scheme_equal_proc);
p = scheme_make_folding_prim(not_prim, "not", 1, 1, 1);
scheme_not_prim = p;
scheme_not_proc = p;
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_UNARY_INLINED
| SCHEME_PRIM_IS_OMITABLE);
scheme_add_global_constant("not", p, env);
@ -101,19 +101,19 @@ void scheme_init_bool (Scheme_Env *env)
p = scheme_make_folding_prim(eq_prim, "eq?", 2, 2, 1);
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_BINARY_INLINED
| SCHEME_PRIM_IS_OMITABLE);
scheme_eq_prim = p;
scheme_eq_proc = p;
scheme_add_global_constant("eq?", p, env);
p = scheme_make_folding_prim(eqv_prim, "eqv?", 2, 2, 1);
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_BINARY_INLINED
| SCHEME_PRIM_IS_OMITABLE);
scheme_eqv_prim = p;
scheme_add_global_constant("eqv?", scheme_eqv_prim, env);
scheme_eqv_proc = p;
scheme_add_global_constant("eqv?", scheme_eqv_proc, env);
p = scheme_make_prim_w_arity(equal_prim, "equal?", 2, 2);
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_BINARY_INLINED);
scheme_equal_prim = p;
scheme_add_global_constant("equal?", scheme_equal_prim, env);
scheme_equal_proc = p;
scheme_add_global_constant("equal?", scheme_equal_proc, env);
scheme_add_global_constant("equal?/recur",
scheme_make_prim_w_arity(equalish_prim, "equal?/recur", 3, 3),

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

@ -602,7 +602,7 @@ Scheme_Object *scheme_make_toplevel(mzshort depth, int position, int resolved, i
pr = NULL;
tl = (Scheme_Toplevel *)scheme_malloc_atomic_tagged(sizeof(Scheme_Toplevel));
tl->iso.so.type = (resolved ? scheme_toplevel_type : scheme_compiled_toplevel_type);
tl->iso.so.type = (resolved ? scheme_toplevel_type : scheme_ir_toplevel_type);
tl->depth = depth;
tl->position = position;
SCHEME_TOPLEVEL_FLAGS(tl) = flags | HIGH_BIT_TO_DISABLE_HASHING;
@ -712,7 +712,7 @@ Scheme_Object *scheme_register_stx_in_comp_prefix(Scheme_Object *var, Comp_Prefi
pos = cp->num_stxes;
l = (Scheme_Local *)scheme_malloc_atomic_tagged(sizeof(Scheme_Local));
l->iso.so.type = scheme_compiled_quote_syntax_type;
l->iso.so.type = scheme_ir_quote_syntax_type;
l->position = pos;
cp->num_stxes++;
@ -732,7 +732,7 @@ Scheme_Object *scheme_register_stx_in_prefix(Scheme_Object *var, Scheme_Comp_Env
if (rec && rec[drec].dont_mark_local_use) {
/* Make up anything; it's going to be ignored. */
l = (Scheme_Local *)scheme_malloc_atomic_tagged(sizeof(Scheme_Local));
l->iso.so.type = scheme_compiled_quote_syntax_type;
l->iso.so.type = scheme_ir_quote_syntax_type;
l->position = 0;
return (Scheme_Object *)l;
@ -887,12 +887,12 @@ static Scheme_Object *get_local_name(Scheme_Object *id)
return SCHEME_STX_VAL(id);
}
static Scheme_Compiled_Local *make_variable(Scheme_Object *id)
static Scheme_IR_Local *make_variable(Scheme_Object *id)
{
Scheme_Compiled_Local *var;
Scheme_IR_Local *var;
var = MALLOC_ONE_TAGGED(Scheme_Compiled_Local);
var->so.type = scheme_compiled_local_type;
var = MALLOC_ONE_TAGGED(Scheme_IR_Local);
var->so.type = scheme_ir_local_type;
if (id) {
id = get_local_name(id);
var->name = id;
@ -901,19 +901,19 @@ static Scheme_Compiled_Local *make_variable(Scheme_Object *id)
return var;
}
static Scheme_Compiled_Local *get_frame_loc(Scheme_Comp_Env *frame,
int i, int j, int p, int flags)
/* Generates a Scheme_Compiled_Local record as needed, and also
static Scheme_IR_Local *get_frame_loc(Scheme_Comp_Env *frame,
int i, int j, int p, int flags)
/* Generates a Scheme_IR_Local record as needed, and also
marks the variable as used for closures. */
{
if (!frame->vars) {
Scheme_Compiled_Local **vars;
vars = MALLOC_N(Scheme_Compiled_Local*, frame->num_bindings);
Scheme_IR_Local **vars;
vars = MALLOC_N(Scheme_IR_Local*, frame->num_bindings);
frame->vars = vars;
}
if (!frame->vars[i]) {
Scheme_Compiled_Local *var;
Scheme_IR_Local *var;
var = make_variable(frame->binders ? frame->binders[i] : NULL);
frame->vars[i] = var;
}
@ -935,14 +935,14 @@ static Scheme_Compiled_Local *get_frame_loc(Scheme_Comp_Env *frame,
void scheme_env_make_variables(Scheme_Comp_Env *frame)
{
Scheme_Compiled_Local *var, **vars;
Scheme_IR_Local *var, **vars;
int i;
if (!frame->num_bindings)
return;
if (!frame->vars) {
vars = MALLOC_N(Scheme_Compiled_Local*, frame->num_bindings);
vars = MALLOC_N(Scheme_IR_Local*, frame->num_bindings);
frame->vars = vars;
}
@ -954,7 +954,7 @@ void scheme_env_make_variables(Scheme_Comp_Env *frame)
}
}
void scheme_set_compilation_variables(Scheme_Comp_Env *frame, Scheme_Compiled_Local **vars,
void scheme_set_compilation_variables(Scheme_Comp_Env *frame, Scheme_IR_Local **vars,
int pos, int count)
{
int i;
@ -962,8 +962,8 @@ void scheme_set_compilation_variables(Scheme_Comp_Env *frame, Scheme_Compiled_Lo
MZ_ASSERT((pos + count) <= frame->num_bindings);
if (!frame->vars) {
Scheme_Compiled_Local **fvars;
fvars = MALLOC_N(Scheme_Compiled_Local*, frame->num_bindings);
Scheme_IR_Local **fvars;
fvars = MALLOC_N(Scheme_IR_Local*, frame->num_bindings);
frame->vars = fvars;
}
@ -1195,7 +1195,7 @@ static void set_binder(Scheme_Object **_binder, Scheme_Object *ref, Scheme_Objec
scheme_macro_id_type (id was bound to a rename-transformer),
scheme_compiled_local_type (id was lexical),
scheme_ir_local_type (id was lexical),
scheme_variable_type (id is a global or module-bound variable),
or

383
racket/src/racket/src/compile.c
View File

@ -38,7 +38,6 @@ READ_ONLY Scheme_Object *scheme_define_syntaxes_syntax;
READ_ONLY Scheme_Object *scheme_ref_syntax;
READ_ONLY Scheme_Object *scheme_begin_syntax;
READ_ONLY Scheme_Object *scheme_lambda_syntax;
READ_ONLY Scheme_Object *scheme_compiled_void_code;
READ_ONLY Scheme_Object scheme_undefined[1];
/* read-only globals */
@ -74,55 +73,55 @@ THREAD_LOCAL_DECL(struct Scheme_Object *cwv_stx);
THREAD_LOCAL_DECL(int cwv_stx_phase);
/* locals */
static Scheme_Object *lambda_syntax(Scheme_Object *form, Scheme_Comp_Env *env, Scheme_Compile_Info *rec, int drec);
static Scheme_Object *lambda_compile(Scheme_Object *form, Scheme_Comp_Env *env, Scheme_Compile_Info *rec, int drec);
static Scheme_Object *lambda_expand(Scheme_Object *form, Scheme_Comp_Env *env, Scheme_Expand_Info *erec, int drec);
static Scheme_Object *define_values_syntax(Scheme_Object *form, Scheme_Comp_Env *env, Scheme_Compile_Info *rec, int drec);
static Scheme_Object *define_values_compile(Scheme_Object *form, Scheme_Comp_Env *env, Scheme_Compile_Info *rec, int drec);
static Scheme_Object *define_values_expand(Scheme_Object *form, Scheme_Comp_Env *env, Scheme_Expand_Info *erec, int drec);
static Scheme_Object *ref_syntax(Scheme_Object *form, Scheme_Comp_Env *env, Scheme_Compile_Info *rec, int drec);
static Scheme_Object *ref_compile(Scheme_Object *form, Scheme_Comp_Env *env, Scheme_Compile_Info *rec, int drec);
static Scheme_Object *ref_expand(Scheme_Object *form, Scheme_Comp_Env *env, Scheme_Expand_Info *erec, int drec);
static Scheme_Object *quote_syntax(Scheme_Object *form, Scheme_Comp_Env *env, Scheme_Compile_Info *rec, int drec);
static Scheme_Object *quote_compile(Scheme_Object *form, Scheme_Comp_Env *env, Scheme_Compile_Info *rec, int drec);
static Scheme_Object *quote_expand(Scheme_Object *form, Scheme_Comp_Env *env, Scheme_Expand_Info *erec, int drec);
static Scheme_Object *if_syntax(Scheme_Object *form, Scheme_Comp_Env *env, Scheme_Compile_Info *rec, int drec);
static Scheme_Object *if_compile(Scheme_Object *form, Scheme_Comp_Env *env, Scheme_Compile_Info *rec, int drec);
static Scheme_Object *if_expand(Scheme_Object *form, Scheme_Comp_Env *env, Scheme_Expand_Info *erec, int drec);
static Scheme_Object *set_expand(Scheme_Object *form, Scheme_Comp_Env *env, Scheme_Expand_Info *erec, int drec);
static Scheme_Object *set_syntax(Scheme_Object *form, Scheme_Comp_Env *env, Scheme_Compile_Info *rec, int drec);
static Scheme_Object *case_lambda_syntax(Scheme_Object *form, Scheme_Comp_Env *env, Scheme_Compile_Info *rec, int drec);
static Scheme_Object *set_compile(Scheme_Object *form, Scheme_Comp_Env *env, Scheme_Compile_Info *rec, int drec);
static Scheme_Object *case_lambda_compile(Scheme_Object *form, Scheme_Comp_Env *env, Scheme_Compile_Info *rec, int drec);
static Scheme_Object *case_lambda_expand(Scheme_Object *form, Scheme_Comp_Env *env, Scheme_Expand_Info *erec, int drec);
static Scheme_Object *let_values_expand(Scheme_Object *form, Scheme_Comp_Env *env, Scheme_Expand_Info *erec, int drec);
static Scheme_Object *let_values_syntax(Scheme_Object *form, Scheme_Comp_Env *env, Scheme_Compile_Info *rec, int drec);
static Scheme_Object *let_values_compile(Scheme_Object *form, Scheme_Comp_Env *env, Scheme_Compile_Info *rec, int drec);
static Scheme_Object *letrec_values_expand(Scheme_Object *form, Scheme_Comp_Env *env, Scheme_Expand_Info *erec, int drec);
static Scheme_Object *letrec_values_syntax (Scheme_Object *form, Scheme_Comp_Env *env, Scheme_Compile_Info *rec, int drec);
static Scheme_Object *begin_syntax (Scheme_Object *form, Scheme_Comp_Env *env, Scheme_Compile_Info *rec, int drec);
static Scheme_Object *letrec_values_compile (Scheme_Object *form, Scheme_Comp_Env *env, Scheme_Compile_Info *rec, int drec);
static Scheme_Object *begin_compile (Scheme_Object *form, Scheme_Comp_Env *env, Scheme_Compile_Info *rec, int drec);
static Scheme_Object *begin_expand (Scheme_Object *form, Scheme_Comp_Env *env, Scheme_Expand_Info *erec, int drec);
static Scheme_Object *begin0_syntax (Scheme_Object *form, Scheme_Comp_Env *env, Scheme_Compile_Info *rec, int drec);
static Scheme_Object *begin0_compile (Scheme_Object *form, Scheme_Comp_Env *env, Scheme_Compile_Info *rec, int drec);
static Scheme_Object *begin0_expand (Scheme_Object *form, Scheme_Comp_Env *env, Scheme_Expand_Info *erec, int drec);
static Scheme_Object *stratified_body_syntax (Scheme_Object *form, Scheme_Comp_Env *env, Scheme_Compile_Info *rec, int drec);
static Scheme_Object *stratified_body_compile (Scheme_Object *form, Scheme_Comp_Env *env, Scheme_Compile_Info *rec, int drec);
static Scheme_Object *stratified_body_expand (Scheme_Object *form, Scheme_Comp_Env *env, Scheme_Expand_Info *erec, int drec);
static Scheme_Object *expression_syntax(Scheme_Object *form, Scheme_Comp_Env *env, Scheme_Compile_Info *rec, int drec);
static Scheme_Object *expression_compile(Scheme_Object *form, Scheme_Comp_Env *env, Scheme_Compile_Info *rec, int drec);
static Scheme_Object *expression_expand(Scheme_Object *form, Scheme_Comp_Env *env, Scheme_Expand_Info *erec, int drec);
static Scheme_Object *unquote_syntax(Scheme_Object *form, Scheme_Comp_Env *env, Scheme_Compile_Info *rec, int drec);
static Scheme_Object *unquote_compile(Scheme_Object *form, Scheme_Comp_Env *env, Scheme_Compile_Info *rec, int drec);
static Scheme_Object *unquote_expand(Scheme_Object *form, Scheme_Comp_Env *env, Scheme_Expand_Info *erec, int drec);
static Scheme_Object *with_cont_mark_syntax(Scheme_Object *form, Scheme_Comp_Env *env, Scheme_Compile_Info *rec, int drec);
static Scheme_Object *with_cont_mark_compile(Scheme_Object *form, Scheme_Comp_Env *env, Scheme_Compile_Info *rec, int drec);
static Scheme_Object *with_cont_mark_expand(Scheme_Object *form, Scheme_Comp_Env *env, Scheme_Expand_Info *erec, int drec);
static Scheme_Object *quote_syntax_syntax(Scheme_Object *form, Scheme_Comp_Env *env, Scheme_Compile_Info *rec, int drec);
static Scheme_Object *quote_syntax_compile(Scheme_Object *form, Scheme_Comp_Env *env, Scheme_Compile_Info *rec, int drec);
static Scheme_Object *quote_syntax_expand(Scheme_Object *form, Scheme_Comp_Env *env, Scheme_Expand_Info *erec, int drec);
static Scheme_Object *define_syntaxes_syntax(Scheme_Object *form, Scheme_Comp_Env *env, Scheme_Compile_Info *rec, int drec);
static Scheme_Object *define_syntaxes_compile(Scheme_Object *form, Scheme_Comp_Env *env, Scheme_Compile_Info *rec, int drec);
static Scheme_Object *define_syntaxes_expand(Scheme_Object *form, Scheme_Comp_Env *env, Scheme_Expand_Info *erec, int drec);
static Scheme_Object *begin_for_syntax_syntax(Scheme_Object *form, Scheme_Comp_Env *env, Scheme_Compile_Info *rec, int drec);
static Scheme_Object *begin_for_syntax_compile(Scheme_Object *form, Scheme_Comp_Env *env, Scheme_Compile_Info *rec, int drec);
static Scheme_Object *begin_for_syntax_expand(Scheme_Object *form, Scheme_Comp_Env *env, Scheme_Expand_Info *erec, int drec);
static Scheme_Object *letrec_syntaxes_syntax(Scheme_Object *form, Scheme_Comp_Env *env, Scheme_Compile_Info *rec, int drec);
static Scheme_Object *letrec_syntaxes_compile(Scheme_Object *form, Scheme_Comp_Env *env, Scheme_Compile_Info *rec, int drec);
static Scheme_Object *letrec_syntaxes_expand(Scheme_Object *form, Scheme_Comp_Env *env, Scheme_Expand_Info *erec, int drec);
static Scheme_Object *app_syntax(Scheme_Object *form, Scheme_Comp_Env *env, Scheme_Compile_Info *rec, int drec);
static Scheme_Object *app_compile(Scheme_Object *form, Scheme_Comp_Env *env, Scheme_Compile_Info *rec, int drec);
static Scheme_Object *app_expand(Scheme_Object *form, Scheme_Comp_Env *env, Scheme_Expand_Info *erec, int drec);
static Scheme_Object *datum_syntax(Scheme_Object *form, Scheme_Comp_Env *env, Scheme_Compile_Info *rec, int drec);
static Scheme_Object *datum_compile(Scheme_Object *form, Scheme_Comp_Env *env, Scheme_Compile_Info *rec, int drec);
static Scheme_Object *datum_expand(Scheme_Object *form, Scheme_Comp_Env *env, Scheme_Expand_Info *erec, int drec);
static Scheme_Object *top_syntax(Scheme_Object *form, Scheme_Comp_Env *env, Scheme_Compile_Info *rec, int drec);
static Scheme_Object *top_compile(Scheme_Object *form, Scheme_Comp_Env *env, Scheme_Compile_Info *rec, int drec);
static Scheme_Object *top_expand(Scheme_Object *form, Scheme_Comp_Env *env, Scheme_Expand_Info *erec, int drec);
static Scheme_Object *stop_syntax(Scheme_Object *form, Scheme_Comp_Env *env, Scheme_Compile_Info *rec, int drec);
static Scheme_Object *stop_compile(Scheme_Object *form, Scheme_Comp_Env *env, Scheme_Compile_Info *rec, int drec);
static Scheme_Object *stop_expand(Scheme_Object *form, Scheme_Comp_Env *env, Scheme_Expand_Info *erec, int drec);
static Scheme_Object *expand_lam(int argc, Scheme_Object **argv);
@ -168,7 +167,6 @@ void scheme_init_compile (Scheme_Env *env)
REGISTER_SO(scheme_define_syntaxes_syntax);
REGISTER_SO(scheme_lambda_syntax);
REGISTER_SO(scheme_begin_syntax);
REGISTER_SO(scheme_compiled_void_code);
REGISTER_SO(lambda_symbol);
REGISTER_SO(letrec_values_symbol);
@ -202,14 +200,14 @@ void scheme_init_compile (Scheme_Env *env)
existing_variables_symbol = scheme_make_symbol("existing-variables");
scheme_define_values_syntax = scheme_make_compiled_syntax(define_values_syntax,
define_values_expand);
scheme_define_syntaxes_syntax = scheme_make_compiled_syntax(define_syntaxes_syntax,
define_syntaxes_expand);
scheme_lambda_syntax = scheme_make_compiled_syntax(lambda_syntax,
lambda_expand);
scheme_begin_syntax = scheme_make_compiled_syntax(begin_syntax,
begin_expand);
scheme_define_values_syntax = scheme_make_primitive_syntax(define_values_compile,
define_values_expand);
scheme_define_syntaxes_syntax = scheme_make_primitive_syntax(define_syntaxes_compile,
define_syntaxes_expand);
scheme_lambda_syntax = scheme_make_primitive_syntax(lambda_compile,
lambda_expand);
scheme_begin_syntax = scheme_make_primitive_syntax(begin_compile,
begin_expand);
scheme_add_global_keyword("lambda",
scheme_lambda_syntax,
@ -227,80 +225,80 @@ void scheme_init_compile (Scheme_Env *env)
}
scheme_add_global_keyword("define-values", scheme_define_values_syntax, env);
scheme_add_global_keyword("quote",
scheme_make_compiled_syntax(quote_syntax,
quote_expand),
scheme_make_primitive_syntax(quote_compile,
quote_expand),
env);
scheme_add_global_keyword("if",
scheme_make_compiled_syntax(if_syntax,
if_expand),
scheme_make_primitive_syntax(if_compile,
if_expand),
env);
scheme_add_global_keyword("set!",
scheme_make_compiled_syntax(set_syntax,
set_expand),
scheme_make_primitive_syntax(set_compile,
set_expand),
env);
scheme_add_global_keyword("#%variable-reference",
scheme_make_compiled_syntax(ref_syntax,
ref_expand),
scheme_make_primitive_syntax(ref_compile,
ref_expand),
env);
scheme_add_global_keyword("#%expression",
scheme_make_compiled_syntax(expression_syntax,
expression_expand),
scheme_make_primitive_syntax(expression_compile,
expression_expand),
env);
scheme_add_global_keyword("case-lambda",
scheme_make_compiled_syntax(case_lambda_syntax,
case_lambda_expand),
scheme_make_primitive_syntax(case_lambda_compile,
case_lambda_expand),
env);
scheme_add_global_keyword("let-values",
scheme_make_compiled_syntax(let_values_syntax,
let_values_expand),
scheme_make_primitive_syntax(let_values_compile,
let_values_expand),
env);
scheme_add_global_keyword("letrec-values",
scheme_make_compiled_syntax(letrec_values_syntax,
letrec_values_expand),
scheme_make_primitive_syntax(letrec_values_compile,
letrec_values_expand),
env);
scheme_add_global_keyword("begin",
scheme_begin_syntax,
env);
scheme_add_global_keyword("#%stratified-body",
scheme_make_compiled_syntax(stratified_body_syntax,
stratified_body_expand),
scheme_make_primitive_syntax(stratified_body_compile,
stratified_body_expand),
env);
scheme_add_global_keyword("begin0",
scheme_make_compiled_syntax(begin0_syntax,
begin0_expand),
scheme_make_primitive_syntax(begin0_compile,
begin0_expand),
env);
scheme_add_global_keyword("unquote",
scheme_make_compiled_syntax(unquote_syntax,
unquote_expand),
scheme_make_primitive_syntax(unquote_compile,
unquote_expand),
env);
scheme_add_global_keyword("unquote-splicing",
scheme_make_compiled_syntax(unquote_syntax,
unquote_expand),
scheme_make_primitive_syntax(unquote_compile,
unquote_expand),
env);
scheme_add_global_keyword("with-continuation-mark",
scheme_make_compiled_syntax(with_cont_mark_syntax,
with_cont_mark_expand),
scheme_make_primitive_syntax(with_cont_mark_compile,
with_cont_mark_expand),
env);
scheme_add_global_keyword("quote-syntax",
scheme_make_compiled_syntax(quote_syntax_syntax,
quote_syntax_expand),
scheme_make_primitive_syntax(quote_syntax_compile,
quote_syntax_expand),
env);
scheme_add_global_keyword("define-syntaxes", scheme_define_syntaxes_syntax, env);
scheme_add_global_keyword("begin-for-syntax",
scheme_make_compiled_syntax(begin_for_syntax_syntax,
begin_for_syntax_expand),
scheme_make_primitive_syntax(begin_for_syntax_compile,
begin_for_syntax_expand),
env);
scheme_add_global_keyword("letrec-syntaxes+values",
scheme_make_compiled_syntax(letrec_syntaxes_syntax,
letrec_syntaxes_expand),
scheme_make_primitive_syntax(letrec_syntaxes_compile,
letrec_syntaxes_expand),
env);
REGISTER_SO(app_symbol);
@ -328,10 +326,10 @@ void scheme_init_compile (Scheme_Env *env)
REGISTER_SO(top_expander);
REGISTER_SO(stop_expander);
app_expander = scheme_make_compiled_syntax(app_syntax, app_expand);
datum_expander = scheme_make_compiled_syntax(datum_syntax, datum_expand);
top_expander = scheme_make_compiled_syntax(top_syntax, top_expand);
stop_expander = scheme_make_compiled_syntax(stop_syntax, stop_expand);
app_expander = scheme_make_primitive_syntax(app_compile, app_expand);
datum_expander = scheme_make_primitive_syntax(datum_compile, datum_expand);
top_expander = scheme_make_primitive_syntax(top_compile, top_expand);
stop_expander = scheme_make_primitive_syntax(stop_compile, stop_expand);
scheme_add_global_keyword("#%app", app_expander, env);
scheme_add_global_keyword("#%datum", datum_expander, env);
scheme_add_global_keyword("#%top", top_expander, env);
@ -346,13 +344,13 @@ void scheme_init_compile_places()
}
Scheme_Object *
scheme_make_compiled_syntax(Scheme_Syntax *proc,
Scheme_Syntax_Expander *eproc)
scheme_make_primitive_syntax(Scheme_Syntax *proc,
Scheme_Syntax_Expander *eproc)
{
Scheme_Object *syntax;
syntax = scheme_alloc_eternal_object();
syntax->type = scheme_syntax_compiler_type;
syntax->type = scheme_primitive_syntax_type;
SCHEME_SYNTAX(syntax) = (Scheme_Object *)proc;
SCHEME_SYNTAX_EXP(syntax) = (Scheme_Object *)eproc;
@ -601,21 +599,21 @@ Scheme_Object *scheme_build_closure_name(Scheme_Object *code, Scheme_Comp_Env *e
}
static Scheme_Object *
make_closure_compilation(Scheme_Comp_Env *env, Scheme_Object *code,
Scheme_Compile_Info *rec, int drec)
make_lambda(Scheme_Comp_Env *env, Scheme_Object *code,
Scheme_Compile_Info *rec, int drec)
/* Compiles a `lambda' expression */
{
Scheme_Object *allparams, *params, *forms, *param, *name, *scope;
Scheme_Closure_Data *data;
Scheme_Compile_Info lam;
Scheme_Lambda *lam;
Scheme_Compile_Info lrec;
Scheme_Comp_Env *frame;
int i;
intptr_t num_params;
Closure_Info *cl;
Scheme_IR_Lambda_Info *cl;
data = MALLOC_ONE_TAGGED(Scheme_Closure_Data);
lam = MALLOC_ONE_TAGGED(Scheme_Lambda);
data->iso.so.type = scheme_compiled_unclosed_procedure_type;
lam->iso.so.type = scheme_ir_lambda_type;
params = SCHEME_STX_CDR(code);
params = SCHEME_STX_CAR(params);
@ -625,23 +623,23 @@ make_closure_compilation(Scheme_Comp_Env *env, Scheme_Object *code,
for (; SCHEME_STX_PAIRP(params); params = SCHEME_STX_CDR(params)) {
num_params++;
}
SCHEME_CLOSURE_DATA_FLAGS(data) = 0;
SCHEME_LAMBDA_FLAGS(lam) = 0;
if (!SCHEME_STX_NULLP(params)) {
SCHEME_CLOSURE_DATA_FLAGS(data) |= CLOS_HAS_REST;
SCHEME_LAMBDA_FLAGS(lam) |= LAMBDA_HAS_REST;
num_params++;
}
data->num_params = num_params;
if ((data->num_params > 0) && scheme_has_method_property(code))
SCHEME_CLOSURE_DATA_FLAGS(data) |= CLOS_IS_METHOD;
lam->num_params = num_params;
if ((lam->num_params > 0) && scheme_has_method_property(code))
SCHEME_LAMBDA_FLAGS(lam) |= LAMBDA_IS_METHOD;
forms = SCHEME_STX_CDR(code);
forms = SCHEME_STX_CDR(forms);
scope = scheme_new_scope(SCHEME_STX_LOCAL_BIND_SCOPE);
frame = scheme_new_compilation_frame(data->num_params, SCHEME_LAMBDA_FRAME, scope, env);
frame = scheme_new_compilation_frame(lam->num_params, SCHEME_LAMBDA_FRAME, scope, env);
params = allparams;
for (i = 0; i < data->num_params; i++) {
for (i = 0; i < lam->num_params; i++) {
if (!SCHEME_STX_PAIRP(params))
param = params;
else
@ -660,33 +658,33 @@ make_closure_compilation(Scheme_Comp_Env *env, Scheme_Object *code,
forms = scheme_stx_add_scope(forms, scope, scheme_env_phase(env->genv));
name = scheme_build_closure_name(code, env);
data->name = name;
lam->name = name;
scheme_compile_rec_done_local(rec, drec);
scheme_init_lambda_rec(rec, drec, &lam, 0);
scheme_init_lambda_rec(rec, drec, &lrec, 0);
{
Scheme_Object *datacode;
datacode = compile_sequence(forms,
scheme_no_defines(frame),
&lam, 0,
1);
data->code = datacode;
Scheme_Object *body;
body = compile_sequence(forms,
scheme_no_defines(frame),
&lrec, 0,
1);
lam->body = body;
}
scheme_merge_lambda_rec(rec, drec, &lam, 0);
scheme_merge_lambda_rec(rec, drec, &lrec, 0);
cl = MALLOC_ONE_RT(Closure_Info);
SET_REQUIRED_TAG(cl->type = scheme_rt_closure_info);
cl = MALLOC_ONE_RT(Scheme_IR_Lambda_Info);
SET_REQUIRED_TAG(cl->type = scheme_rt_ir_lambda_info);
cl->vars = frame->vars;
data->closure_map = (mzshort *)cl;
lam->ir_info = cl;
return (Scheme_Object *)data;
return (Scheme_Object *)lam;
}
static Scheme_Object *
lambda_syntax (Scheme_Object *form, Scheme_Comp_Env *env, Scheme_Compile_Info *rec, int drec)
lambda_compile (Scheme_Object *form, Scheme_Comp_Env *env, Scheme_Compile_Info *rec, int drec)
{
Scheme_Object *args;
@ -696,7 +694,7 @@ lambda_syntax (Scheme_Object *form, Scheme_Comp_Env *env, Scheme_Compile_Info *r
args = SCHEME_STX_CAR(args);
lambda_check_args(args, form, env);
return make_closure_compilation(env, form, rec, drec);
return make_lambda(env, form, rec, drec);
}
static Scheme_Object *
@ -763,19 +761,19 @@ static Scheme_Object *expand_lam(int argc, Scheme_Object **argv)
return scheme_datum_to_syntax(cons(fn, args), form, form, 0, 2);
}
Scheme_Object *scheme_clone_vector(Scheme_Object *data, int skip, int set_type)
Scheme_Object *scheme_clone_vector(Scheme_Object *lam, int skip, int set_type)
{
Scheme_Object *naya;
int i, size;
size = SCHEME_VEC_SIZE(data);
size = SCHEME_VEC_SIZE(lam);
naya = scheme_make_vector(size - skip, NULL);
for (i = skip; i < size; i++) {
SCHEME_VEC_ELS(naya)[i - skip] = SCHEME_VEC_ELS(data)[i];
SCHEME_VEC_ELS(naya)[i - skip] = SCHEME_VEC_ELS(lam)[i];
}
if (set_type)
naya->type = data->type;
naya->type = lam->type;
return naya;
}
@ -869,7 +867,7 @@ static Scheme_Object *global_binding(Scheme_Object *id, Scheme_Comp_Env *env)
}
static Scheme_Object *
defn_targets_syntax (Scheme_Object *var, Scheme_Comp_Env *env, Scheme_Compile_Info *rec, int drec)
defn_targets_compile (Scheme_Object *var, Scheme_Comp_Env *env, Scheme_Compile_Info *rec, int drec)
{
Scheme_Object *first = scheme_null, *last = NULL;
@ -905,14 +903,14 @@ defn_targets_syntax (Scheme_Object *var, Scheme_Comp_Env *env, Scheme_Compile_In
}
static Scheme_Object *
define_values_syntax (Scheme_Object *form, Scheme_Comp_Env *env, Scheme_Compile_Info *rec, int drec)
define_values_compile (Scheme_Object *form, Scheme_Comp_Env *env, Scheme_Compile_Info *rec, int drec)
{
Scheme_Object *var, *val, *targets, *variables, *vec, *value_name;
scheme_define_parse(form, &var, &val, 0, env, 0);
variables = var;
targets = defn_targets_syntax(var, env, rec, drec);
targets = defn_targets_compile(var, env, rec, drec);
scheme_compile_rec_done_local(rec, drec);
if (SCHEME_STX_PAIRP(targets) && SCHEME_STX_NULLP(SCHEME_STX_CDR(targets))) {
@ -985,7 +983,7 @@ define_values_expand(Scheme_Object *form, Scheme_Comp_Env *env, Scheme_Expand_In
/**********************************************************************/
static Scheme_Object *
quote_syntax (Scheme_Object *form, Scheme_Comp_Env *env, Scheme_Compile_Info *rec, int drec)
quote_compile (Scheme_Object *form, Scheme_Comp_Env *env, Scheme_Compile_Info *rec, int drec)
{
Scheme_Object *v, *rest;
@ -1041,7 +1039,7 @@ scheme_make_branch(Scheme_Object *test, Scheme_Object *thenp,
{
Scheme_Branch_Rec *b;
if (SCHEME_TYPE(test) > _scheme_compiled_values_types_) {
if (SCHEME_TYPE(test) > _scheme_ir_values_types_) {
if (SCHEME_FALSEP(test))
return elsep;
else
@ -1059,7 +1057,7 @@ scheme_make_branch(Scheme_Object *test, Scheme_Object *thenp,
}
static Scheme_Object *
if_syntax (Scheme_Object *form, Scheme_Comp_Env *env, Scheme_Compile_Info *rec, int drec)
if_compile (Scheme_Object *form, Scheme_Comp_Env *env, Scheme_Compile_Info *rec, int drec)
{
int len, opt;
Scheme_Object *test, *thenp, *elsep, *name, *rest;
@ -1092,7 +1090,7 @@ if_syntax (Scheme_Object *form, Scheme_Comp_Env *env, Scheme_Compile_Info *rec,
test = scheme_compile_expr(test, env, recs, 0);
if (SCHEME_TYPE(test) > _scheme_compiled_values_types_) {
if (SCHEME_TYPE(test) > _scheme_ir_values_types_) {
opt = 1;
if (SCHEME_FALSEP(test)) {
@ -1195,7 +1193,7 @@ if_expand(Scheme_Object *orig_form, Scheme_Comp_Env *env, Scheme_Expand_Info *er
/**********************************************************************/
static Scheme_Object *
with_cont_mark_syntax(Scheme_Object *form, Scheme_Comp_Env *env, Scheme_Compile_Info *rec, int drec)
with_cont_mark_compile(Scheme_Object *form, Scheme_Comp_Env *env, Scheme_Compile_Info *rec, int drec)
{
Scheme_Object *key, *val, *expr, *value_name;
Scheme_Compile_Info recs[3];
@ -1293,7 +1291,7 @@ with_cont_mark_expand(Scheme_Object *orig_form, Scheme_Comp_Env *env, Scheme_Exp
/**********************************************************************/
static Scheme_Object *
set_syntax (Scheme_Object *form, Scheme_Comp_Env *env, Scheme_Compile_Info *rec, int drec)
set_compile (Scheme_Object *form, Scheme_Comp_Env *env, Scheme_Compile_Info *rec, int drec)
{
Scheme_Set_Bang *sb;
Scheme_Env *menv = NULL;
@ -1347,7 +1345,7 @@ set_syntax (Scheme_Object *form, Scheme_Comp_Env *env, Scheme_Compile_Info *rec,
}
if (SAME_TYPE(SCHEME_TYPE(var), scheme_macro_type)
|| SAME_TYPE(SCHEME_TYPE(var), scheme_syntax_compiler_type)) {
|| SAME_TYPE(SCHEME_TYPE(var), scheme_primitive_syntax_type)) {
scheme_wrong_syntax(NULL, name, form, "cannot mutate syntax identifier");
return NULL;
}
@ -1447,7 +1445,7 @@ set_expand(Scheme_Object *orig_form, Scheme_Comp_Env *env, Scheme_Expand_Info *e
}
if (SAME_TYPE(SCHEME_TYPE(var), scheme_macro_type)
|| SAME_TYPE(SCHEME_TYPE(var), scheme_syntax_compiler_type)) {
|| SAME_TYPE(SCHEME_TYPE(var), scheme_primitive_syntax_type)) {
scheme_wrong_syntax(NULL, name, form, "cannot mutate syntax identifier");
}
@ -1480,7 +1478,7 @@ set_expand(Scheme_Object *orig_form, Scheme_Comp_Env *env, Scheme_Expand_Info *e
/**********************************************************************/
static Scheme_Object *
ref_syntax (Scheme_Object *form, Scheme_Comp_Env *env, Scheme_Compile_Info *rec, int drec)
ref_compile (Scheme_Object *form, Scheme_Comp_Env *env, Scheme_Compile_Info *rec, int drec)
{
Scheme_Env *menv = NULL;
Scheme_Object *var, *name, *rest, *dummy, *bind_id;
@ -1566,7 +1564,7 @@ ref_syntax (Scheme_Object *form, Scheme_Comp_Env *env, Scheme_Compile_Info *rec,
if (!imported && env->genv->module && !rec[drec].testing_constantness)
SCHEME_TOPLEVEL_FLAGS(var) |= SCHEME_TOPLEVEL_MUTATED;
}
} else if (SAME_TYPE(SCHEME_TYPE(var), scheme_compiled_local_type)) {
} else if (SAME_TYPE(SCHEME_TYPE(var), scheme_ir_local_type)) {
/* ok */
} else {
scheme_wrong_syntax(NULL, name, form, "identifier does not refer to a variable");
@ -1602,7 +1600,7 @@ ref_expand(Scheme_Object *form, Scheme_Comp_Env *env, Scheme_Expand_Info *erec,
SCHEME_EXPAND_OBSERVE_PRIM_VARREF(env->observer);
/* Error checking, and lexical variable update: */
naya = ref_syntax(form, env, erec, drec);
naya = ref_compile(form, env, erec, drec);
if (!naya)
/* No change: */
@ -1677,7 +1675,7 @@ static void case_lambda_check_line(Scheme_Object *line, Scheme_Object *form, Sch
}
static Scheme_Object *
case_lambda_syntax (Scheme_Object *form, Scheme_Comp_Env *env,
case_lambda_compile (Scheme_Object *form, Scheme_Comp_Env *env,
Scheme_Compile_Info *rec, int drec)
{
Scheme_Object *list, *last, *c, *orig_form = form, *name;
@ -1725,7 +1723,7 @@ case_lambda_syntax (Scheme_Object *form, Scheme_Comp_Env *env,
c);
c = scheme_datum_to_syntax(c, orig_form, orig_form, 0, 2);
return lambda_syntax(c, env, rec, drec);
return lambda_compile(c, env, rec, drec);
}
scheme_compile_rec_done_local(rec, drec);
@ -1780,16 +1778,16 @@ case_lambda_syntax (Scheme_Object *form, Scheme_Comp_Env *env,
scheme_merge_compile_recs(rec, drec, recs, count);
if (scheme_has_method_property(orig_form)) {
Scheme_Closure_Data *data;
Scheme_Lambda *lam;
/* Make sure no branch has 0 arguments: */
for (i = 0; i < count; i++) {
data = (Scheme_Closure_Data *)cl->array[i];
if (!data->num_params)
lam = (Scheme_Lambda *)cl->array[i];
if (!lam->num_params)
break;
}
if (i >= count) {
data = (Scheme_Closure_Data *)cl->array[0];
SCHEME_CLOSURE_DATA_FLAGS(data) |= CLOS_IS_METHOD;
lam = (Scheme_Lambda *)cl->array[0];
SCHEME_LAMBDA_FLAGS(lam) |= LAMBDA_IS_METHOD;
}
}
@ -1859,13 +1857,13 @@ case_lambda_expand(Scheme_Object *orig_form, Scheme_Comp_Env *env, Scheme_Expand
/* let, let-values, letrec, etc. */
/**********************************************************************/
static Scheme_Let_Header *make_header(Scheme_Object *first, int num_bindings, int num_clauses,
int flags)
static Scheme_IR_Let_Header *make_header(Scheme_Object *first, int num_bindings, int num_clauses,
int flags)
{
Scheme_Let_Header *head;
Scheme_IR_Let_Header *head;
head = MALLOC_ONE_TAGGED(Scheme_Let_Header);
head->iso.so.type = scheme_compiled_let_void_type;
head = MALLOC_ONE_TAGGED(Scheme_IR_Let_Header);
head->iso.so.type = scheme_ir_let_void_type;
head->body = first;
head->count = num_bindings;
head->num_clauses = num_clauses;
@ -2012,7 +2010,7 @@ static Scheme_Object *detect_traditional_letrec(Scheme_Object *form, Scheme_Comp
}
static Scheme_Object *
gen_let_syntax (Scheme_Object *form, Scheme_Comp_Env *origenv, char *formname,
do_let_compile (Scheme_Object *form, Scheme_Comp_Env *origenv, char *formname,
int recursive, int multi, Scheme_Compile_Info *rec, int drec,
Scheme_Comp_Env *frame_already)
{
@ -2021,10 +2019,10 @@ gen_let_syntax (Scheme_Object *form, Scheme_Comp_Env *origenv, char *formname,
Scheme_Comp_Env *frame, *env, *rhs_env;
Scheme_Compile_Info *recs;
Scheme_Object *first = NULL, *existing_vars;
Scheme_Compiled_Let_Value *last = NULL, *lv;
Scheme_IR_Let_Value *last = NULL, *lv;
DupCheckRecord r;
int rec_env_already = rec[drec].env_already, body_block;
Scheme_Let_Header *head;
Scheme_IR_Let_Header *head;
form = scheme_stx_taint_disarm(form, NULL);
@ -2192,8 +2190,8 @@ gen_let_syntax (Scheme_Object *form, Scheme_Comp_Env *origenv, char *formname,
}
}
lv = MALLOC_ONE_TAGGED(Scheme_Compiled_Let_Value);
lv->iso.so.type = scheme_compiled_let_value_type;
lv = MALLOC_ONE_TAGGED(Scheme_IR_Let_Value);
lv->iso.so.type = scheme_ir_let_value_type;
if (!last)
first = (Scheme_Object *)lv;
else
@ -2227,7 +2225,7 @@ gen_let_syntax (Scheme_Object *form, Scheme_Comp_Env *origenv, char *formname,
if (SCHEME_TRUEP(existing_vars)) {
/* Install variables already generated by a lift: */
scheme_set_compilation_variables(frame, (Scheme_Compiled_Local **)SCHEME_CDR(existing_vars),
scheme_set_compilation_variables(frame, (Scheme_IR_Local **)SCHEME_CDR(existing_vars),
pre_k, k - pre_k);
}
@ -2243,18 +2241,18 @@ gen_let_syntax (Scheme_Object *form, Scheme_Comp_Env *origenv, char *formname,
scheme_env_make_variables(env);
k = 0;
lv = (Scheme_Compiled_Let_Value *)first;
lv = (Scheme_IR_Let_Value *)first;
for (i = 0; i < num_clauses; i++) {
Scheme_Compiled_Local **vars;
Scheme_IR_Local **vars;
vars = MALLOC_N(Scheme_Compiled_Local*, lv->count);
vars = MALLOC_N(Scheme_IR_Local*, lv->count);
lv->vars = vars;
for (j = lv->count; j--; ) {
vars[j] = env->vars[k+j];
}
k += lv->count;
lv = (Scheme_Compiled_Let_Value *)lv->body;
lv = (Scheme_IR_Let_Value *)lv->body;
}
head = make_header(first, num_bindings, num_clauses,
@ -2265,8 +2263,8 @@ gen_let_syntax (Scheme_Object *form, Scheme_Comp_Env *origenv, char *formname,
int group_clauses = 0;
k = 0;
lv = (Scheme_Compiled_Let_Value *)first;
for (i = 0; i < num_clauses; i++, lv = (Scheme_Compiled_Let_Value *)lv->body) {
lv = (Scheme_IR_Let_Value *)first;
for (i = 0; i < num_clauses; i++, lv = (Scheme_IR_Let_Value *)lv->body) {
Scheme_Object *ce, *rhs;
rhs = lv->value;
if (scope)
@ -2284,7 +2282,7 @@ gen_let_syntax (Scheme_Object *form, Scheme_Comp_Env *origenv, char *formname,
always break bindings into smaller sets based on this
information; otherwise, we have to be more conservative as reflected
by scheme_might_invoke_call_cc(), so record with
SCHEME_CLV_NO_GROUP_LATER_USES and check again at the end. */
SCHEME_IRLV_NO_GROUP_LATER_USES and check again at the end. */
if ((rec_env_already == 2) /* int def: semantics is `let' */
|| (!prev_might_invoke
&& !scheme_might_invoke_call_cc(ce))) {
@ -2292,11 +2290,11 @@ gen_let_syntax (Scheme_Object *form, Scheme_Comp_Env *origenv, char *formname,
if ((group_clauses == 1)
&& !scheme_env_max_use_above(env, k)) {
/* A clause that should be in its own `let' */
SCHEME_CLV_FLAGS(lv) |= SCHEME_CLV_NO_GROUP_USES;
SCHEME_IRLV_FLAGS(lv) |= SCHEME_IRLV_NO_GROUP_USES;
group_clauses = 0;
} else if (!scheme_env_max_use_above(env, k + lv->count)) {
/* End a recursive `letrec' group */
SCHEME_CLV_FLAGS(lv) |= SCHEME_CLV_NO_GROUP_LATER_USES;
SCHEME_IRLV_FLAGS(lv) |= SCHEME_IRLV_NO_GROUP_LATER_USES;
group_clauses = 0;
}
} else
@ -2306,20 +2304,20 @@ gen_let_syntax (Scheme_Object *form, Scheme_Comp_Env *origenv, char *formname,
}
if (!prev_might_invoke) {
Scheme_Let_Header *current_head = head;
Scheme_Compiled_Let_Value *next = NULL;
Scheme_IR_Let_Header *current_head = head;
Scheme_IR_Let_Value *next = NULL;
int group_count = 0;
lv = (Scheme_Compiled_Let_Value *)first;
lv = (Scheme_IR_Let_Value *)first;
group_clauses = 0;
for (i = 0; i < num_clauses; i++, lv = next) {
next = (Scheme_Compiled_Let_Value *)lv->body;
next = (Scheme_IR_Let_Value *)lv->body;
group_clauses++;
group_count += lv->count;
if (SCHEME_CLV_FLAGS(lv) & (SCHEME_CLV_NO_GROUP_USES
| SCHEME_CLV_NO_GROUP_LATER_USES)) {
if (SCHEME_IRLV_FLAGS(lv) & (SCHEME_IRLV_NO_GROUP_USES
| SCHEME_IRLV_NO_GROUP_LATER_USES)) {
/* A clause that should be in its own `let' */
Scheme_Let_Header *next_head;
int single = (SCHEME_CLV_FLAGS(lv) & SCHEME_CLV_NO_GROUP_USES);
Scheme_IR_Let_Header *next_head;
int single = (SCHEME_IRLV_FLAGS(lv) & SCHEME_IRLV_NO_GROUP_USES);
MZ_ASSERT(!single || (group_clauses == 1));
if (current_head->num_clauses - group_clauses) {
next_head = make_header(lv->body,
@ -2631,16 +2629,16 @@ letrec_values_expand(Scheme_Object *form, Scheme_Comp_Env *env, Scheme_Expand_In
static Scheme_Object *
let_values_syntax (Scheme_Object *form, Scheme_Comp_Env *env,
let_values_compile (Scheme_Object *form, Scheme_Comp_Env *env,
Scheme_Compile_Info *rec, int drec)
{
return gen_let_syntax(form, env, "let-values", 0, 1, rec, drec, NULL);
return do_let_compile(form, env, "let-values", 0, 1, rec, drec, NULL);
}
static Scheme_Object *
letrec_values_syntax (Scheme_Object *form, Scheme_Comp_Env *env, Scheme_Compile_Info *rec, int drec)
letrec_values_compile (Scheme_Object *form, Scheme_Comp_Env *env, Scheme_Compile_Info *rec, int drec)
{
return gen_let_syntax(form, env, "letrec-values", 1, 1, rec, drec, NULL);
return do_let_compile(form, env, "letrec-values", 1, 1, rec, drec, NULL);
}
/**********************************************************************/
@ -2673,7 +2671,7 @@ Scheme_Object *scheme_compiled_void()
}
static Scheme_Object *
do_begin_syntax(char *name,
do_begin_compile(char *name,
Scheme_Object *form, Scheme_Comp_Env *env, Scheme_Compile_Info *rec, int drec,
int zero)
{
@ -2756,15 +2754,15 @@ do_begin_syntax(char *name,
}
static Scheme_Object *
begin_syntax (Scheme_Object *form, Scheme_Comp_Env *env, Scheme_Compile_Info *rec, int drec)
begin_compile (Scheme_Object *form, Scheme_Comp_Env *env, Scheme_Compile_Info *rec, int drec)
{
return do_begin_syntax("begin", form, env, rec, drec, 0);
return do_begin_compile("begin", form, env, rec, drec, 0);
}
static Scheme_Object *
begin0_syntax (Scheme_Object *form, Scheme_Comp_Env *env, Scheme_Compile_Info *rec, int drec)
begin0_compile (Scheme_Object *form, Scheme_Comp_Env *env, Scheme_Compile_Info *rec, int drec)
{
return do_begin_syntax("begin0", form, env, rec, drec, 1);
return do_begin_compile("begin0", form, env, rec, drec, 1);
}
Scheme_Sequence *scheme_malloc_sequence(int count)
@ -2875,7 +2873,7 @@ Scheme_Object *scheme_make_sequence_compilation(Scheme_Object *seq, int opt, int
}
static Scheme_Object *
stratified_body_syntax (Scheme_Object *form, Scheme_Comp_Env *env, Scheme_Compile_Info *rec, int drec)
stratified_body_compile (Scheme_Object *form, Scheme_Comp_Env *env, Scheme_Compile_Info *rec, int drec)
{
Scheme_Object *body;
@ -3033,7 +3031,7 @@ static Scheme_Object *check_single(Scheme_Object *form, Scheme_Comp_Env *top_onl
}
static Scheme_Object *
single_syntax(Scheme_Object *form, Scheme_Comp_Env *env, Scheme_Compile_Info *rec, int drec, int top_only)
single_compile(Scheme_Object *form, Scheme_Comp_Env *env, Scheme_Compile_Info *rec, int drec, int top_only)
{
return scheme_compile_expr(check_single(form, top_only ? env: NULL), env, rec, drec);
}
@ -3062,9 +3060,9 @@ single_expand(Scheme_Object *orig_form, Scheme_Comp_Env *env, Scheme_Expand_Info
0, 2);
}
static Scheme_Object *expression_syntax(Scheme_Object *form, Scheme_Comp_Env *env, Scheme_Compile_Info *rec, int drec)
static Scheme_Object *expression_compile(Scheme_Object *form, Scheme_Comp_Env *env, Scheme_Compile_Info *rec, int drec)
{
return single_syntax(form, scheme_no_defines(env), rec, drec, 0);
return single_compile(form, scheme_no_defines(env), rec, drec, 0);
}
static Scheme_Object *expression_expand(Scheme_Object *form, Scheme_Comp_Env *env, Scheme_Expand_Info *erec, int drec)
@ -3080,7 +3078,7 @@ static Scheme_Object *expression_expand(Scheme_Object *form, Scheme_Comp_Env *en
/**********************************************************************/
static Scheme_Object *
unquote_syntax(Scheme_Object *form, Scheme_Comp_Env *env, Scheme_Compile_Info *rec, int drec)
unquote_compile(Scheme_Object *form, Scheme_Comp_Env *env, Scheme_Compile_Info *rec, int drec)
{
int len;
@ -3098,7 +3096,7 @@ unquote_syntax(Scheme_Object *form, Scheme_Comp_Env *env, Scheme_Compile_Info *r
static Scheme_Object *
unquote_expand(Scheme_Object *form, Scheme_Comp_Env *env, Scheme_Expand_Info *erec, int drec)
{
return unquote_syntax(form, env, erec, drec);
return unquote_compile(form, env, erec, drec);
}
/**********************************************************************/
@ -3106,7 +3104,7 @@ unquote_expand(Scheme_Object *form, Scheme_Comp_Env *env, Scheme_Expand_Info *er
/**********************************************************************/
static Scheme_Object *
quote_syntax_syntax(Scheme_Object *orig_form, Scheme_Comp_Env *env, Scheme_Compile_Info *rec, int drec)
quote_syntax_compile(Scheme_Object *orig_form, Scheme_Comp_Env *env, Scheme_Compile_Info *rec, int drec)
{
int len, local;
Scheme_Object *stx, *form;
@ -3174,7 +3172,7 @@ static Scheme_Object *
quote_syntax_expand(Scheme_Object *form, Scheme_Comp_Env *env, Scheme_Expand_Info *erec, int drec)
{
SCHEME_EXPAND_OBSERVE_PRIM_QUOTE_SYNTAX(env->observer);
return quote_syntax_syntax(form, env, erec, drec);
return quote_syntax_compile(form, env, erec, drec);
}
@ -3200,7 +3198,7 @@ static Scheme_Object *stx_val(Scheme_Object *name, Scheme_Object *_env)
}
static Scheme_Object *
do_define_syntaxes_syntax(Scheme_Object *form, Scheme_Comp_Env *env,
do_define_syntaxes_compile(Scheme_Object *form, Scheme_Comp_Env *env,
Scheme_Compile_Info *rec, int drec)
{
Scheme_Object *names, *code, *dummy;
@ -3244,10 +3242,10 @@ do_define_syntaxes_syntax(Scheme_Object *form, Scheme_Comp_Env *env,
}
static Scheme_Object *
define_syntaxes_syntax(Scheme_Object *form, Scheme_Comp_Env *env,
define_syntaxes_compile(Scheme_Object *form, Scheme_Comp_Env *env,
Scheme_Compile_Info *rec, int drec)
{
return do_define_syntaxes_syntax(form, env, rec, drec);
return do_define_syntaxes_compile(form, env, rec, drec);
}
static Scheme_Object *
@ -3372,7 +3370,7 @@ begin_for_syntax_expand(Scheme_Object *orig_form, Scheme_Comp_Env *in_env, Schem
}
static Scheme_Object *
begin_for_syntax_syntax(Scheme_Object *form, Scheme_Comp_Env *env,
begin_for_syntax_compile(Scheme_Object *form, Scheme_Comp_Env *env,
Scheme_Compile_Info *rec, int drec)
{
return begin_for_syntax_expand(form, env, rec, drec);
@ -3890,7 +3888,7 @@ do_letrec_syntaxes(const char *where,
}
if (rec[drec].comp) {
v = gen_let_syntax(v, stx_env, "letrec-values", 1, 1, rec, drec, var_env);
v = do_let_compile(v, stx_env, "letrec-values", 1, 1, rec, drec, var_env);
} else {
if (restore && (rec[drec].env_already == 2)) {
/* don't sort out after all, because we're keeping `letrec-values+syntaxes' */
@ -3922,7 +3920,7 @@ do_letrec_syntaxes(const char *where,
}
static Scheme_Object *
letrec_syntaxes_syntax(Scheme_Object *form, Scheme_Comp_Env *env,
letrec_syntaxes_compile(Scheme_Object *form, Scheme_Comp_Env *env,
Scheme_Compile_Info *rec, int drec)
{
return do_letrec_syntaxes("letrec-syntaxes+values", form, env, rec, drec);
@ -3949,7 +3947,7 @@ int scheme_get_eval_type(Scheme_Object *obj)
if (type > _scheme_values_types_)
return SCHEME_EVAL_CONSTANT;
else if (SAME_TYPE(type, scheme_compiled_local_type)
else if (SAME_TYPE(type, scheme_ir_local_type)
|| SAME_TYPE(type, scheme_local_type))
return SCHEME_EVAL_LOCAL;
else if (SAME_TYPE(type, scheme_local_unbox_type))
@ -3995,13 +3993,13 @@ Scheme_Object *scheme_try_apply(Scheme_Object *f, Scheme_Object *args, Optimize_
static int foldable_body(Scheme_Object *f)
{
Scheme_Closure_Data *d;
Scheme_Lambda *d;
d = SCHEME_COMPILED_CLOS_CODE(f);
d = SCHEME_CLOSURE_CODE(f);
scheme_delay_load_closure(d);
return (SCHEME_TYPE(d->code) > _scheme_values_types_);
return (SCHEME_TYPE(d->body) > _scheme_values_types_);
}
int scheme_is_foldable_prim(Scheme_Object *f)
@ -4033,7 +4031,7 @@ Scheme_Object *scheme_make_application(Scheme_Object *v, Optimize_Info *info)
n++;
type = SCHEME_TYPE(SCHEME_CAR(o));
if (type < _scheme_compiled_values_types_)
if (type < _scheme_ir_values_types_)
nv = 1;
o = SCHEME_CDR(o);
}
@ -4573,7 +4571,7 @@ compile_expand_expr(Scheme_Object *form, Scheme_Comp_Env *env,
has_orig_unbound = 1;
form = find_name; /* in case it was re-mapped */
} else {
if (SAME_TYPE(SCHEME_TYPE(var), scheme_syntax_compiler_type)) {
if (SAME_TYPE(SCHEME_TYPE(var), scheme_primitive_syntax_type)) {
if (var == stop_expander) {
if (!rec[drec].comp) {
SCHEME_EXPAND_OBSERVE_ENTER_PRIM(env->observer,form);
@ -4696,12 +4694,12 @@ compile_expand_expr(Scheme_Object *form, Scheme_Comp_Env *env,
/* apply to global variable: compile it normally */
orig_unbound_name = find_name;
has_orig_unbound = 1;
} else if (SAME_TYPE(SCHEME_TYPE(var), scheme_compiled_local_type)) {
} else if (SAME_TYPE(SCHEME_TYPE(var), scheme_ir_local_type)) {
/* apply to local variable: compile it normally */
} else {
if (SAME_TYPE(SCHEME_TYPE(var), scheme_macro_type)) {
goto macro;
} else if (SAME_TYPE(SCHEME_TYPE(var), scheme_syntax_compiler_type)) {
} else if (SAME_TYPE(SCHEME_TYPE(var), scheme_primitive_syntax_type)) {
if (rec[drec].comp) {
Scheme_Syntax *f;
f = (Scheme_Syntax *)SCHEME_SYNTAX(var);
@ -4798,7 +4796,7 @@ compile_expand_expr(Scheme_Object *form, Scheme_Comp_Env *env,
}
if (var && (SAME_TYPE(SCHEME_TYPE(var), scheme_macro_type)
|| SAME_TYPE(SCHEME_TYPE(var), scheme_syntax_compiler_type))) {
|| SAME_TYPE(SCHEME_TYPE(var), scheme_primitive_syntax_type))) {
if (SAME_OBJ(var, stop_expander)) {
/* Return original: */
if (!rec[drec].comp) {
@ -4832,7 +4830,7 @@ compile_expand_expr(Scheme_Object *form, Scheme_Comp_Env *env,
}
}
if (SAME_TYPE(SCHEME_TYPE(var), scheme_syntax_compiler_type)) {
if (SAME_TYPE(SCHEME_TYPE(var), scheme_primitive_syntax_type)) {
if (rec[drec].comp) {
Scheme_Syntax *f;
f = (Scheme_Syntax *)SCHEME_SYNTAX(var);
@ -5195,7 +5193,7 @@ compile_expand_app(Scheme_Object *orig_form, Scheme_Comp_Env *env,
}
static Scheme_Object *
app_syntax(Scheme_Object *form, Scheme_Comp_Env *env, Scheme_Compile_Info *rec, int drec)
app_compile(Scheme_Object *form, Scheme_Comp_Env *env, Scheme_Compile_Info *rec, int drec)
{
return compile_expand_app(form, env, rec, drec);
}
@ -5208,7 +5206,7 @@ app_expand(Scheme_Object *form, Scheme_Comp_Env *env, Scheme_Expand_Info *erec,
}
static Scheme_Object *
datum_syntax(Scheme_Object *form, Scheme_Comp_Env *env, Scheme_Compile_Info *rec, int drec)
datum_compile(Scheme_Object *form, Scheme_Comp_Env *env, Scheme_Compile_Info *rec, int drec)
{
Scheme_Object *c, *v;
@ -5341,7 +5339,7 @@ static Scheme_Object *check_top(Scheme_Object *orig_form,
}
static Scheme_Object *
top_syntax(Scheme_Object *form, Scheme_Comp_Env *env, Scheme_Compile_Info *rec, int drec)
top_compile(Scheme_Object *form, Scheme_Comp_Env *env, Scheme_Compile_Info *rec, int drec)
{
Scheme_Object *c, *b;
int need_bound_check = 0;
@ -6165,8 +6163,8 @@ scheme_flatten_begin(Scheme_Object *expr, Scheme_Object *append_onto)
/* stop expander */
/**********************************************************************/
static Scheme_Object *stop_syntax(Scheme_Object *form, Scheme_Comp_Env *env,
Scheme_Compile_Info *rec, int drec)
static Scheme_Object *stop_compile(Scheme_Object *form, Scheme_Comp_Env *env,
Scheme_Compile_Info *rec, int drec)
{
scheme_signal_error("internal error: shouldn't get to stop syntax");
return NULL;
@ -6202,6 +6200,7 @@ START_XFORM_SKIP;
static void register_traversers(void)
{
GC_REG_TRAV(scheme_rt_ir_lambda_info, mark_ir_lambda_info);
}
END_XFORM_SKIP;

18
racket/src/racket/src/error.c
View File

@ -1375,12 +1375,12 @@ void scheme_wrong_count_m(const char *name, int minc, int maxc,
if (minc == -1) {
/* Extract arity, check for is_method in case-lambda, etc. */
if (SAME_TYPE(SCHEME_TYPE((Scheme_Object *)name), scheme_closure_type)) {
Scheme_Closure_Data *data;
data = SCHEME_COMPILED_CLOS_CODE((Scheme_Object *)name);
Scheme_Lambda *data;
data = SCHEME_CLOSURE_CODE((Scheme_Object *)name);
name = scheme_get_proc_name((Scheme_Object *)name, NULL, 1);
minc = data->num_params;
if (SCHEME_CLOSURE_DATA_FLAGS(data) & CLOS_HAS_REST) {
if (SCHEME_LAMBDA_FLAGS(data) & LAMBDA_HAS_REST) {
minc -= 1;
maxc = -1;
} else
@ -1388,9 +1388,9 @@ void scheme_wrong_count_m(const char *name, int minc, int maxc,
} else if (SAME_TYPE(SCHEME_TYPE((Scheme_Object *)name), scheme_case_closure_type)) {
Scheme_Case_Lambda *cl = (Scheme_Case_Lambda *)name;
if (cl->count) {
Scheme_Closure_Data *data;
data = (Scheme_Closure_Data *)SCHEME_COMPILED_CLOS_CODE(cl->array[0]);
if (SCHEME_CLOSURE_DATA_FLAGS(data) & CLOS_IS_METHOD)
Scheme_Lambda *data;
data = (Scheme_Lambda *)SCHEME_CLOSURE_CODE(cl->array[0]);
if (SCHEME_LAMBDA_FLAGS(data) & LAMBDA_IS_METHOD)
is_method = 1;
} else if (cl->name && SCHEME_BOXP(cl->name)) {
/* See note in schpriv.h about the IS_METHOD hack */
@ -1527,11 +1527,11 @@ char *scheme_make_arity_expect_string(const char *map_name,
mina = -1;
maxa = 0;
} else {
Scheme_Closure_Data *data;
Scheme_Lambda *data;
data = (Scheme_Closure_Data *)SCHEME_COMPILED_CLOS_CODE(proc);
data = (Scheme_Lambda *)SCHEME_CLOSURE_CODE(proc);
mina = maxa = data->num_params;
if (SCHEME_CLOSURE_DATA_FLAGS(data) & CLOS_HAS_REST) {
if (SCHEME_LAMBDA_FLAGS(data) & LAMBDA_HAS_REST) {
--mina;
maxa = -1;
}

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

@ -87,10 +87,10 @@
tracks variable usage (including whether a variable is mutated or
not). See "compile.c" along with "compenv.c".
The second pass, called "letrec_rec", determines which references
The second pass, called "letrec_check", determines which references
to `letrec'-bound variables need to be guarded with a run-time
check to prevent use before definition. The analysis result is
reflected by the insertion of `check-notunsafe-undefined`
reflected by the insertion of `check-not-unsafe-undefined`
calls. This this pass mutates records produced by the "compile"
pass.
@ -134,7 +134,7 @@
forms are converted to native-code generators, instead of bytecode
variants. The code is not actually JITted until it is called; this
preparation step merely sets up a JIT hook for each function. The
preparation pass is a shallow, function (i.e., it doesn't mutate
preparation pass is a shallow, functional (i.e., it doesn't mutate
the original bytecode) pass; the body of a function is prepared for
JITting lazily. See "jitprep.c".
@ -2085,7 +2085,7 @@ define_execute_with_dynamic_state(Scheme_Object *vec, int delta, int defmacro,
if (SCHEME_TOPLEVEL_FLAGS(var) & SCHEME_TOPLEVEL_SEAL) {
int flags = GLOB_IS_IMMUTATED;
if (SCHEME_PROCP(vals_expr)
|| SAME_TYPE(SCHEME_TYPE(vals_expr), scheme_unclosed_procedure_type)
|| SAME_TYPE(SCHEME_TYPE(vals_expr), scheme_lambda_type)
|| SAME_TYPE(SCHEME_TYPE(vals_expr), scheme_case_lambda_sequence_type)
|| SAME_TYPE(SCHEME_TYPE(vals_expr), scheme_inline_variant_type))
flags |= GLOB_IS_CONSISTENT;
@ -2243,9 +2243,9 @@ scheme_case_lambda_execute(Scheme_Object *expr)
#ifdef MZ_USE_JIT
if (seqin->native_code) {
Scheme_Native_Closure_Data *ndata;
Scheme_Native_Lambda *ndata;
Scheme_Native_Closure *nc, *na;
Scheme_Closure_Data *data;
Scheme_Lambda *data;
Scheme_Object *val;
GC_CAN_IGNORE Scheme_Object **runstack;
GC_CAN_IGNORE mzshort *map;
@ -2258,7 +2258,7 @@ scheme_case_lambda_execute(Scheme_Object *expr)
for (i = 0; i < cnt; i++) {
val = seqin->array[i];
if (!SCHEME_PROCP(val)) {
data = (Scheme_Closure_Data *)val;
data = (Scheme_Lambda *)val;
na = (Scheme_Native_Closure *)scheme_make_native_closure(data->u.native_code);
runstack = MZ_RUNSTACK;
jcnt = data->closure_size;
@ -2483,21 +2483,21 @@ scheme_make_closure(Scheme_Thread *p, Scheme_Object *code, int close)
time; note that the byte-code marshaller in print.c can handle
empty closures for that reason). */
{
Scheme_Closure_Data *data;
Scheme_Lambda *data;
Scheme_Closure *closure;
GC_CAN_IGNORE Scheme_Object **runstack;
GC_CAN_IGNORE Scheme_Object **dest;
GC_CAN_IGNORE mzshort *map;
int i;
data = (Scheme_Closure_Data *)code;
data = (Scheme_Lambda *)code;
#ifdef MZ_USE_JIT
if (data->u.native_code
/* If the union points to a another Scheme_Closure_Data*, then it's not actually
/* If the union points to a another Scheme_Lambda*, then it's not actually
a pointer to native code. We must have a closure referenced frmo non-JITted code
where the closure is also referenced by JITted code. */
&& !SAME_TYPE(SCHEME_TYPE(data->u.native_code), scheme_unclosed_procedure_type)) {
&& !SAME_TYPE(SCHEME_TYPE(data->u.native_code), scheme_lambda_type)) {
Scheme_Object *nc;
nc = scheme_make_native_closure(data->u.native_code);
@ -2525,7 +2525,7 @@ scheme_make_closure(Scheme_Thread *p, Scheme_Object *code, int close)
+ (i - mzFLEX_DELTA) * sizeof(Scheme_Object *));
closure->so.type = scheme_closure_type;
SCHEME_COMPILED_CLOS_CODE(closure) = data;
SCHEME_CLOSURE_CODE(closure) = data;
if (!close || !i)
return (Scheme_Object *)closure;
@ -2552,20 +2552,20 @@ Scheme_Closure *scheme_malloc_empty_closure()
return cl;
}
void scheme_delay_load_closure(Scheme_Closure_Data *data)
void scheme_delay_load_closure(Scheme_Lambda *data)
{
if (SCHEME_RPAIRP(data->code)) {
if (SCHEME_RPAIRP(data->body)) {
Scheme_Object *v, *vinfo = NULL;
v = SCHEME_CAR(data->code);
v = SCHEME_CAR(data->body);
if (SCHEME_VECTORP(v)) {
/* Has info for delayed validation */
vinfo = v;
v = SCHEME_VEC_ELS(vinfo)[0];
}
v = scheme_load_delayed_code(SCHEME_INT_VAL(v),
(struct Scheme_Load_Delay *)SCHEME_CDR(data->code));
data->code = v;
(struct Scheme_Load_Delay *)SCHEME_CDR(data->body));
data->body = v;
if (vinfo) {
scheme_validate_closure(NULL,
@ -2779,13 +2779,13 @@ scheme_do_eval(Scheme_Object *obj, int num_rands, Scheme_Object **rands,
DEBUG_CHECK_TYPE(v);
} else if (type == scheme_closure_type) {
Scheme_Closure_Data *data;
Scheme_Lambda *data;
GC_CAN_IGNORE Scheme_Object **stack, **src;
int i, has_rest, num_params;
DO_CHECK_FOR_BREAK(p, UPDATE_THREAD_RSPTR_FOR_GC(); if (rands == p->tail_buffer) make_tail_buffer_safe(););
data = SCHEME_COMPILED_CLOS_CODE(obj);
data = SCHEME_CLOSURE_CODE(obj);
if ((RUNSTACK - RUNSTACK_START) < data->max_let_depth) {
rands = evacuate_runstack(num_rands, rands, RUNSTACK);
@ -2808,7 +2808,7 @@ scheme_do_eval(Scheme_Object *obj, int num_rands, Scheme_Object **rands,
}
num_params = data->num_params;
has_rest = SCHEME_CLOSURE_DATA_FLAGS(data) & CLOS_HAS_REST;
has_rest = SCHEME_LAMBDA_FLAGS(data) & LAMBDA_HAS_REST;
if (num_params) {
if (has_rest) {
@ -2820,7 +2820,7 @@ scheme_do_eval(Scheme_Object *obj, int num_rands, Scheme_Object **rands,
scheme_wrong_count_m((const char *)obj,
-1, -1,
num_rands, rands,
SCHEME_CLOSURE_DATA_FLAGS(data) & CLOS_IS_METHOD);
SCHEME_LAMBDA_FLAGS(data) & LAMBDA_IS_METHOD);
return NULL; /* Doesn't get here */
}
@ -2883,7 +2883,7 @@ scheme_do_eval(Scheme_Object *obj, int num_rands, Scheme_Object **rands,
scheme_wrong_count_m((const char *)obj,
-1, -1,
num_rands, rands,
SCHEME_CLOSURE_DATA_FLAGS(data) & CLOS_IS_METHOD);
SCHEME_LAMBDA_FLAGS(data) & LAMBDA_IS_METHOD);
return NULL; /* Doesn't get here */
}
@ -2919,7 +2919,7 @@ scheme_do_eval(Scheme_Object *obj, int num_rands, Scheme_Object **rands,
int n = data->closure_size;
if (n) {
src = SCHEME_COMPILED_CLOS_ENV(obj);
src = SCHEME_CLOSURE_ENV(obj);
stack = PUSH_RUNSTACK(p, RUNSTACK, n);
RUNSTACK_CHANGED();
@ -2929,13 +2929,13 @@ scheme_do_eval(Scheme_Object *obj, int num_rands, Scheme_Object **rands,
}
}
obj = data->code;
obj = data->body;
if (SCHEME_RPAIRP(obj)) {
UPDATE_THREAD_RSPTR_FOR_GC();
make_tail_buffer_safe();
scheme_delay_load_closure(data);
obj = data->code;
obj = data->body;
}
if (pmstack >= 0) {
@ -2979,16 +2979,16 @@ scheme_do_eval(Scheme_Object *obj, int num_rands, Scheme_Object **rands,
goto eval_top;
} else if (type == scheme_case_closure_type) {
Scheme_Case_Lambda *seq;
Scheme_Closure_Data *data;
Scheme_Lambda *data;
int i;
seq = (Scheme_Case_Lambda *)obj;
for (i = 0; i < seq->count; i++) {
data = SCHEME_COMPILED_CLOS_CODE(seq->array[i]);
if ((!(SCHEME_CLOSURE_DATA_FLAGS(data) & CLOS_HAS_REST)
data = SCHEME_CLOSURE_CODE(seq->array[i]);
if ((!(SCHEME_LAMBDA_FLAGS(data) & LAMBDA_HAS_REST)
&& (data->num_params == num_rands))
|| ((SCHEME_CLOSURE_DATA_FLAGS(data) & CLOS_HAS_REST)
|| ((SCHEME_LAMBDA_FLAGS(data) & LAMBDA_HAS_REST)
&& (data->num_params - 1 <= num_rands))) {
obj = seq->array[i];
goto apply_top;
@ -3002,7 +3002,7 @@ scheme_do_eval(Scheme_Object *obj, int num_rands, Scheme_Object **rands,
return NULL; /* Doesn't get here. */
#ifdef MZ_USE_JIT
} else if (type == scheme_native_closure_type) {
GC_CAN_IGNORE Scheme_Native_Closure_Data *data;
GC_CAN_IGNORE Scheme_Native_Lambda *data;
VACATE_TAIL_BUFFER_USE_RUNSTACK();
@ -3552,7 +3552,7 @@ scheme_do_eval(Scheme_Object *obj, int num_rands, Scheme_Object **rands,
goto eval_top;
}
case scheme_unclosed_procedure_type:
case scheme_lambda_type:
UPDATE_THREAD_RSPTR();
v = scheme_make_closure(p, obj, 1);
goto returnv_never_multi;
@ -3672,7 +3672,7 @@ scheme_do_eval(Scheme_Object *obj, int num_rands, Scheme_Object **rands,
GC_CAN_IGNORE Scheme_Object *clos;
GC_CAN_IGNORE Scheme_Object **dest;
GC_CAN_IGNORE mzshort *map;
GC_CAN_IGNORE Scheme_Closure_Data *data;
GC_CAN_IGNORE Scheme_Lambda *data;
int j;
clos = stack[i];
@ -3687,7 +3687,7 @@ scheme_do_eval(Scheme_Object *obj, int num_rands, Scheme_Object **rands,
dest = ((Scheme_Closure *)clos)->vals;
#endif
data = (Scheme_Closure_Data *)a[i];
data = (Scheme_Lambda *)a[i];
map = data->closure_map;
j = data->closure_size;
@ -4454,7 +4454,7 @@ static void *eval_k(void)
if (as_tail) {
/* Cons up a closure to capture the prefix */
Scheme_Closure_Data *data;
Scheme_Lambda *data;
mzshort *map;
int i, sz;
@ -4464,13 +4464,13 @@ static void *eval_k(void)
map[i] = i;
}
data = MALLOC_ONE_TAGGED(Scheme_Closure_Data);
data->iso.so.type = scheme_compiled_unclosed_procedure_type;
data = MALLOC_ONE_TAGGED(Scheme_Lambda);
data->iso.so.type = scheme_ir_lambda_type;
data->num_params = 0;
data->max_let_depth = top->max_let_depth + sz;
data->closure_size = sz;
data->closure_map = map;
data->code = v;
data->body = v;
v = scheme_make_closure(p, (Scheme_Object *)data, 1);
@ -6159,12 +6159,12 @@ static void mark_pruned_prefixes(struct NewGC *gc) XFORM_SKIP_PROC
Scheme_Object *next;
if (SCHEME_TYPE(clo) == scheme_closure_type) {
Scheme_Closure *cl = (Scheme_Closure *)clo;
int closure_size = ((Scheme_Closure_Data *)GC_resolve2(cl->code, gc))->closure_size;
int closure_size = ((Scheme_Lambda *)GC_resolve2(cl->code, gc))->closure_size;
next = cl->vals[closure_size - 1];
cl->vals[closure_size-1] = (Scheme_Object *)pf;
} else if (SCHEME_TYPE(clo) == scheme_native_closure_type) {
Scheme_Native_Closure *cl = (Scheme_Native_Closure *)clo;
int closure_size = ((Scheme_Native_Closure_Data *)GC_resolve2(cl->code, gc))->closure_size;
int closure_size = ((Scheme_Native_Lambda *)GC_resolve2(cl->code, gc))->closure_size;
next = cl->vals[closure_size - 1];
cl->vals[closure_size-1] = (Scheme_Object *)pf;
} else {

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

@ -76,7 +76,7 @@ SHARED_OK int scheme_defining_primitives; /* set to 1 during start-up */
SHARED_OK int scheme_prim_opt_flags[(1 << SCHEME_PRIM_OPT_INDEX_SIZE)];
READ_ONLY Scheme_Object scheme_void[1]; /* the void constant */
READ_ONLY Scheme_Object *scheme_values_func; /* the function bound to `values' */
READ_ONLY Scheme_Object *scheme_values_proc; /* the function bound to `values' */
READ_ONLY Scheme_Object *scheme_procedure_p_proc;
READ_ONLY Scheme_Object *scheme_procedure_arity_includes_proc;
READ_ONLY Scheme_Object *scheme_procedure_specialize_proc;
@ -309,17 +309,17 @@ scheme_init_fun (Scheme_Env *env)
scheme_call_with_values_proc,
env);
REGISTER_SO(scheme_values_func);
scheme_values_func = scheme_make_prim_w_arity2(scheme_values,
REGISTER_SO(scheme_values_proc);
scheme_values_proc = scheme_make_prim_w_arity2(scheme_values,
"values",
0, -1,
0, -1);
SCHEME_PRIM_PROC_FLAGS(scheme_values_func) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_UNARY_INLINED
SCHEME_PRIM_PROC_FLAGS(scheme_values_proc) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_UNARY_INLINED
| SCHEME_PRIM_IS_BINARY_INLINED
| SCHEME_PRIM_IS_NARY_INLINED
| SCHEME_PRIM_IS_OMITABLE);
scheme_add_global_constant("values",
scheme_values_func,
scheme_values_proc,
env);
o = scheme_make_prim_w_arity2(scheme_call_ec,
@ -2168,7 +2168,7 @@ static Scheme_Object *get_or_check_arity(Scheme_Object *p, intptr_t a, Scheme_Ob
} else if ((type == scheme_case_closure_type)
|| (type == scheme_case_lambda_sequence_type)) {
Scheme_Case_Lambda *seq;
Scheme_Closure_Data *data;
Scheme_Lambda *data;
int i;
Scheme_Object *first, *last = NULL, *v;
@ -2180,12 +2180,12 @@ static Scheme_Object *get_or_check_arity(Scheme_Object *p, intptr_t a, Scheme_Ob
seq = (Scheme_Case_Lambda *)p;
for (i = 0; i < seq->count; i++) {
v = seq->array[i];
if (SAME_TYPE(SCHEME_TYPE(v), scheme_unclosed_procedure_type))
data = (Scheme_Closure_Data *)v;
if (SAME_TYPE(SCHEME_TYPE(v), scheme_lambda_type))
data = (Scheme_Lambda *)v;
else
data = SCHEME_COMPILED_CLOS_CODE(v);
data = SCHEME_CLOSURE_CODE(v);
mina = maxa = data->num_params;
if (SCHEME_CLOSURE_DATA_FLAGS(data) & CLOS_HAS_REST) {
if (SCHEME_LAMBDA_FLAGS(data) & LAMBDA_HAS_REST) {
if (mina)
--mina;
maxa = -1;
@ -2376,15 +2376,15 @@ static Scheme_Object *get_or_check_arity(Scheme_Object *p, intptr_t a, Scheme_Ob
SCHEME_USE_FUEL(1);
goto top;
} else {
Scheme_Closure_Data *data;
Scheme_Lambda *data;
if (type == scheme_unclosed_procedure_type)
data = (Scheme_Closure_Data *)p;
if (type == scheme_lambda_type)
data = (Scheme_Lambda *)p;
else
data = SCHEME_COMPILED_CLOS_CODE(p);
data = SCHEME_CLOSURE_CODE(p);
mina = maxa = data->num_params;
if (SCHEME_CLOSURE_DATA_FLAGS(data) & CLOS_HAS_REST) {
if (SCHEME_LAMBDA_FLAGS(data) & LAMBDA_HAS_REST) {
if (mina)
--mina;
maxa = -1;
@ -2544,7 +2544,7 @@ int scheme_check_proc_arity(const char *where, int a,
int scheme_closure_preserves_marks(Scheme_Object *p)
{
Scheme_Type type = SCHEME_TYPE(p);
Scheme_Closure_Data *data;
Scheme_Lambda *data;
#ifdef MZ_USE_JIT
if (type == scheme_native_closure_type)
@ -2552,13 +2552,13 @@ int scheme_closure_preserves_marks(Scheme_Object *p)
#endif
if (type == scheme_closure_type) {
data = SCHEME_COMPILED_CLOS_CODE(p);
} else if (type == scheme_unclosed_procedure_type) {
data = (Scheme_Closure_Data *)p;
data = SCHEME_CLOSURE_CODE(p);
} else if (type == scheme_lambda_type) {
data = (Scheme_Lambda *)p;
} else
return 0;
if (SCHEME_CLOSURE_DATA_FLAGS(data) & CLOS_PRESERVES_MARKS)
if (SCHEME_LAMBDA_FLAGS(data) & LAMBDA_PRESERVES_MARKS)
return 1;
return 0;
@ -2826,23 +2826,23 @@ const char *scheme_get_proc_name(Scheme_Object *p, int *len, int for_error)
} else {
Scheme_Object *name;
if (type == scheme_compiled_unclosed_procedure_type) {
name = ((Scheme_Closure_Data *)p)->name;
if (type == scheme_ir_lambda_type) {
name = ((Scheme_Lambda *)p)->name;
} else if (type == scheme_closure_type) {
name = SCHEME_COMPILED_CLOS_CODE(p)->name;
name = SCHEME_CLOSURE_CODE(p)->name;
} else if (type == scheme_case_lambda_sequence_type) {
Scheme_Case_Lambda *cl = (Scheme_Case_Lambda *)p;
if (!cl->count)
name = NULL;
else
name = ((Scheme_Closure_Data *)cl->array[0])->name;
name = ((Scheme_Lambda *)cl->array[0])->name;
} else {
/* Native closure: */
name = ((Scheme_Native_Closure *)p)->code->u2.name;
if (name && SAME_TYPE(SCHEME_TYPE(name), scheme_unclosed_procedure_type)) {
if (name && SAME_TYPE(SCHEME_TYPE(name), scheme_lambda_type)) {
/* Not yet jitted. Use `name' as the other alternaive of
the union: */
name = ((Scheme_Closure_Data *)name)->name;
name = ((Scheme_Lambda *)name)->name;
}
}
@ -2916,7 +2916,7 @@ static Scheme_Object *procedure_result_arity(int argc, Scheme_Object *argv[])
}
if (SAME_TYPE(SCHEME_TYPE(o), scheme_closure_type)) {
if ((SCHEME_CLOSURE_DATA_FLAGS(SCHEME_COMPILED_CLOS_CODE(o)) & CLOS_SINGLE_RESULT)) {
if ((SCHEME_LAMBDA_FLAGS(SCHEME_CLOSURE_CODE(o)) & LAMBDA_SINGLE_RESULT)) {
return scheme_make_integer(1);
}
#ifdef MZ_USE_JIT
@ -2929,7 +2929,7 @@ static Scheme_Object *procedure_result_arity(int argc, Scheme_Object *argv[])
int i;
for (i = cl->count; i--; ) {
if (!(SCHEME_CLOSURE_DATA_FLAGS(SCHEME_COMPILED_CLOS_CODE(cl->array[i])) & CLOS_SINGLE_RESULT))
if (!(SCHEME_LAMBDA_FLAGS(SCHEME_CLOSURE_CODE(cl->array[i])) & LAMBDA_SINGLE_RESULT))
break;
}
@ -3313,7 +3313,7 @@ static int proc_is_method(Scheme_Object *proc)
}
if (SAME_TYPE(SCHEME_TYPE(proc), scheme_closure_type)) {
return ((SCHEME_CLOSURE_DATA_FLAGS(SCHEME_COMPILED_CLOS_CODE(proc)) & CLOS_IS_METHOD)
return ((SCHEME_LAMBDA_FLAGS(SCHEME_CLOSURE_CODE(proc)) & LAMBDA_IS_METHOD)
? 1
: 0);
}
@ -3513,16 +3513,16 @@ static Scheme_Object *procedure_specialize(int argc, Scheme_Object *argv[])
if (SAME_TYPE(SCHEME_TYPE(argv[0]), scheme_native_closure_type)) {
Scheme_Native_Closure *nc = (Scheme_Native_Closure *)argv[0];
if ((nc->code->start_code == scheme_on_demand_jit_code)
&& !(SCHEME_NATIVE_CLOSURE_DATA_FLAGS(nc->code) & NATIVE_SPECIALIZED)) {
Scheme_Native_Closure_Data *data;
&& !(SCHEME_NATIVE_LAMBDA_FLAGS(nc->code) & NATIVE_SPECIALIZED)) {
Scheme_Native_Lambda *data;
if (!nc->code->eq_key) {
void *p;
p = scheme_malloc_atomic(sizeof(int));
nc->code->eq_key = p;
}
data = MALLOC_ONE_TAGGED(Scheme_Native_Closure_Data);
memcpy(data, nc->code, sizeof(Scheme_Native_Closure_Data));
SCHEME_NATIVE_CLOSURE_DATA_FLAGS(data) |= NATIVE_SPECIALIZED;
data = MALLOC_ONE_TAGGED(Scheme_Native_Lambda);
memcpy(data, nc->code, sizeof(Scheme_Native_Lambda));
SCHEME_NATIVE_LAMBDA_FLAGS(data) |= NATIVE_SPECIALIZED;
nc->code = data;
}
}
@ -3714,7 +3714,7 @@ static Scheme_Object *do_apply_chaperone(Scheme_Object *o, int argc, Scheme_Obje
static Scheme_Object *_apply_native(Scheme_Object *obj, int num_rands, Scheme_Object **rands)
{
Scheme_Native_Closure_Data *data;
Scheme_Native_Lambda *data;
GC_MAYBE_IGNORE_INTERIOR MZ_MARK_STACK_TYPE old_cont_mark_stack;
GC_MAYBE_IGNORE_INTERIOR Scheme_Object **rs;
@ -6335,7 +6335,7 @@ internal_call_cc (int argc, Scheme_Object *argv[])
cc_guard = get_set_cont_mark_by_pos(prompt_cc_guard_key, p, mc, pos, NULL);
if (SCHEME_FALSEP(cc_guard))
cc_guard = scheme_values_func;
cc_guard = scheme_values_proc;
if (SCHEME_NP_CHAPERONEP(cont->prompt_tag))
cc_guard = chaperone_wrap_cc_guard(cont->prompt_tag, cc_guard);
@ -6968,7 +6968,7 @@ static Scheme_Object **chaperone_do_control(const char *name, int mode,
if (init_guard || !SCHEME_PROMPT_TAGP(obj)) {
if (init_guard) {
proc = init_guard;
if (SAME_OBJ(NULL, scheme_values_func))
if (SAME_OBJ(NULL, scheme_values_proc))
proc = NULL;
px = NULL;
} else {
@ -7333,7 +7333,7 @@ static Scheme_Object *call_with_prompt (int in_argc, Scheme_Object *in_argv[])
argv = chaperone_do_prompt_handler(chaperone, argc, argv);
}
if (SAME_OBJ(handler, scheme_values_func)) {
if (SAME_OBJ(handler, scheme_values_proc)) {
v = scheme_values(argc, argv);
if (v == SCHEME_MULTIPLE_VALUES) {
if (SAME_OBJ(p->ku.multiple.array, p->values_buffer))
@ -7412,7 +7412,7 @@ static Scheme_Object *call_with_prompt (int in_argc, Scheme_Object *in_argv[])
if (handler) {
return _scheme_tail_apply(handler, argc, argv);
} else if (cc_guard) {
if (SAME_OBJ(cc_guard, scheme_values_func))
if (SAME_OBJ(cc_guard, scheme_values_proc))
cc_guard = NULL;
if (cc_guard || chaperone)
return do_cc_guard(v, cc_guard, chaperone);
@ -10416,7 +10416,6 @@ START_XFORM_SKIP;
static void register_traversers(void)
{
GC_REG_TRAV(scheme_rt_closure_info, mark_closure_info);
GC_REG_TRAV(scheme_rt_dyn_wind_cell, mark_dyn_wind_cell);
GC_REG_TRAV(scheme_rt_dyn_wind_info, mark_dyn_wind_info);
GC_REG_TRAV(scheme_cont_mark_chain_type, mark_cont_mark_chain);

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

@ -1291,7 +1291,7 @@ static Scheme_Object *make_future(Scheme_Object *lambda, int enqueue, future_t *
int futureid;
future_t *ft;
Scheme_Native_Closure *nc;
Scheme_Native_Closure_Data *ncd;
Scheme_Native_Lambda *ncd;
Scheme_Custodian *c;
if (SAME_TYPE(SCHEME_TYPE(lambda), scheme_native_closure_type)) {

2
racket/src/racket/src/future.h
View File

@ -155,7 +155,7 @@ typedef struct future_t {
int arg_i0;
intptr_t arg_l0;
size_t arg_z0;
Scheme_Native_Closure_Data *arg_n0;
Scheme_Native_Lambda *arg_n0;
Scheme_Object *arg_s1;
const Scheme_Object *arg_t1;
Scheme_Object **arg_S1;

2
racket/src/racket/src/gen-jit-ts.rkt
View File

@ -7,7 +7,7 @@
[(#\t) "const Scheme_Object*"]
[(#\S) "Scheme_Object**"]
[(#\b) "Scheme_Bucket*"]
[(#\n) "Scheme_Native_Closure_Data*"]
[(#\n) "Scheme_Native_Lambda*"]
[(#\m) "MZ_MARK_STACK_TYPE"]
[(#\p) "void*"]
[(#\i) "int"]

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

File diff suppressed because it is too large Load Diff

12
racket/src/racket/src/jit.h
View File

@ -413,7 +413,7 @@ typedef struct mz_jit_state {
int need_set_rs;
void **retain_start;
double *retain_double_start;
Scheme_Native_Closure_Data *retaining_data; /* poke when setting retain_start for generational GC */
Scheme_Native_Lambda *retaining_data; /* poke when setting retain_start for generational GC */
int local1_busy, pushed_marks;
int log_depth;
int self_pos, self_closure_size, self_toplevel_pos;
@ -424,7 +424,7 @@ typedef struct mz_jit_state {
void *self_restart_code;
void *self_nontail_code;
Scheme_Native_Closure *nc; /* for extract_globals and extract_closure_local, only */
Scheme_Closure_Data *self_data;
Scheme_Lambda *self_lam;
void *status_at_ptr;
int r0_status, r1_status;
void *patch_depth;
@ -1344,7 +1344,7 @@ void *scheme_generate_one(mz_jit_state *old_jitter,
void *data,
int gcable,
void *save_ptr,
Scheme_Native_Closure_Data *ndata);
Scheme_Native_Lambda *ndata);
int scheme_mz_is_closure(mz_jit_state *jitter, int i, int arity, int *_flags);
void scheme_mz_runstack_saved(mz_jit_state *jitter);
int scheme_mz_runstack_restored(mz_jit_state *jitter);
@ -1482,7 +1482,7 @@ int scheme_generate_app(Scheme_App_Rec *app, Scheme_Object **alt_rands, int num_
int no_call);
int scheme_generate_tail_call(mz_jit_state *jitter, int num_rands, int direct_native, int need_set_rs,
int is_inline, Scheme_Native_Closure *direct_to_code, jit_direct_arg *direct_arg,
Scheme_Closure_Data *direct_data);
Scheme_Lambda *direct_data);
int scheme_generate_non_tail_call(mz_jit_state *jitter, int num_rands, int direct_native, int need_set_rs,
int multi_ok, int result_ignored, int nontail_self, int pop_and_jump,
int is_inlined, int unboxed_args, jit_insn *reftop);
@ -1577,10 +1577,10 @@ int scheme_is_simple(Scheme_Object *obj, int depth, int just_markless, mz_jit_st
int scheme_is_non_gc(Scheme_Object *obj, int depth);
#ifdef USE_FLONUM_UNBOXING
int scheme_jit_check_closure_flonum_bit(Scheme_Closure_Data *data, int pos, int delta);
int scheme_jit_check_closure_flonum_bit(Scheme_Lambda *data, int pos, int delta);
# define CLOSURE_ARGUMENT_IS_FLONUM(data, pos) scheme_jit_check_closure_flonum_bit(data, pos, 0)
# define CLOSURE_CONTENT_IS_FLONUM(data, pos) scheme_jit_check_closure_flonum_bit(data, pos, data->num_params)
int scheme_jit_check_closure_extflonum_bit(Scheme_Closure_Data *data, int pos, int delta);
int scheme_jit_check_closure_extflonum_bit(Scheme_Lambda *data, int pos, int delta);
# define CLOSURE_ARGUMENT_IS_EXTFLONUM(data, pos) scheme_jit_check_closure_extflonum_bit(data, pos, 0)
# define CLOSURE_CONTENT_IS_EXTFLONUM(data, pos) scheme_jit_check_closure_extflonum_bit(data, pos, data->num_params)
#endif

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

@ -9,7 +9,7 @@
S = Scheme_Object**
v = void
b = Scheme_Bucket*
n = Scheme_Native_Closure_Data*
n = Scheme_Native_Lambda*
p = void*, CGC only
z = size_t
m = MZ_MARK_STACK_TYPE */

162
racket/src/racket/src/jit_ts_def.c
View File

@ -1,38 +1,38 @@
#define define_ts_siS_s(id, src_type) \
static Scheme_Object* ts_ ## id(Scheme_Object* g12, int g13, Scheme_Object** g14) \
static Scheme_Object* ts_ ## id(Scheme_Object* g178, int g179, Scheme_Object** g180) \
XFORM_SKIP_PROC \
{ \
if (scheme_use_rtcall) \
return scheme_rtcall_siS_s("[" #id "]", src_type, id, g12, g13, g14); \
return scheme_rtcall_siS_s("[" #id "]", src_type, id, g178, g179, g180); \
else \
return id(g12, g13, g14); \
return id(g178, g179, g180); \
}
#define define_ts_iSs_s(id, src_type) \
static Scheme_Object* ts_ ## id(int g15, Scheme_Object** g16, Scheme_Object* g17) \
static Scheme_Object* ts_ ## id(int g181, Scheme_Object** g182, Scheme_Object* g183) \
XFORM_SKIP_PROC \
{ \
if (scheme_use_rtcall) \
return scheme_rtcall_iSs_s("[" #id "]", src_type, id, g15, g16, g17); \
return scheme_rtcall_iSs_s("[" #id "]", src_type, id, g181, g182, g183); \
else \
return id(g15, g16, g17); \
return id(g181, g182, g183); \
}
#define define_ts_s_s(id, src_type) \
static Scheme_Object* ts_ ## id(Scheme_Object* g18) \
static Scheme_Object* ts_ ## id(Scheme_Object* g184) \
XFORM_SKIP_PROC \
{ \
if (scheme_use_rtcall) \
return scheme_rtcall_s_s("[" #id "]", src_type, id, g18); \
return scheme_rtcall_s_s("[" #id "]", src_type, id, g184); \
else \
return id(g18); \
return id(g184); \
}
#define define_ts_n_s(id, src_type) \
static Scheme_Object* ts_ ## id(Scheme_Native_Closure_Data* g19) \
static Scheme_Object* ts_ ## id(Scheme_Native_Lambda* g185) \
XFORM_SKIP_PROC \
{ \
if (scheme_use_rtcall) \
return scheme_rtcall_n_s("[" #id "]", src_type, id, g19); \
return scheme_rtcall_n_s("[" #id "]", src_type, id, g185); \
else \
return id(g19); \
return id(g185); \
}
#define define_ts__s(id, src_type) \
static Scheme_Object* ts_ ## id() \
@ -44,202 +44,202 @@ static Scheme_Object* ts_ ## id() \
return id(); \
}
#define define_ts_ss_s(id, src_type) \
static Scheme_Object* ts_ ## id(Scheme_Object* g20, Scheme_Object* g21) \
static Scheme_Object* ts_ ## id(Scheme_Object* g186, Scheme_Object* g187) \
XFORM_SKIP_PROC \
{ \
if (scheme_use_rtcall) \
return scheme_rtcall_ss_s("[" #id "]", src_type, id, g20, g21); \
return scheme_rtcall_ss_s("[" #id "]", src_type, id, g186, g187); \
else \
return id(g20, g21); \
return id(g186, g187); \
}
#define define_ts_ssi_s(id, src_type) \
static Scheme_Object* ts_ ## id(Scheme_Object* g22, Scheme_Object* g23, int g24) \
static Scheme_Object* ts_ ## id(Scheme_Object* g188, Scheme_Object* g189, int g190) \
XFORM_SKIP_PROC \
{ \
if (scheme_use_rtcall) \
return scheme_rtcall_ssi_s("[" #id "]", src_type, id, g22, g23, g24); \
return scheme_rtcall_ssi_s("[" #id "]", src_type, id, g188, g189, g190); \
else \
return id(g22, g23, g24); \
return id(g188, g189, g190); \
}
#define define_ts_tt_s(id, src_type) \
static Scheme_Object* ts_ ## id(const Scheme_Object* g25, const Scheme_Object* g26) \
static Scheme_Object* ts_ ## id(const Scheme_Object* g191, const Scheme_Object* g192) \
XFORM_SKIP_PROC \
{ \
if (scheme_use_rtcall) \
return scheme_rtcall_tt_s("[" #id "]", src_type, id, g25, g26); \
return scheme_rtcall_tt_s("[" #id "]", src_type, id, g191, g192); \
else \
return id(g25, g26); \
return id(g191, g192); \
}
#define define_ts_ss_m(id, src_type) \
static MZ_MARK_STACK_TYPE ts_ ## id(Scheme_Object* g27, Scheme_Object* g28) \
static MZ_MARK_STACK_TYPE ts_ ## id(Scheme_Object* g193, Scheme_Object* g194) \
XFORM_SKIP_PROC \
{ \
if (scheme_use_rtcall) \
return scheme_rtcall_ss_m("[" #id "]", src_type, id, g27, g28); \
return scheme_rtcall_ss_m("[" #id "]", src_type, id, g193, g194); \
else \
return id(g27, g28); \
return id(g193, g194); \
}
#define define_ts_Sl_s(id, src_type) \
static Scheme_Object* ts_ ## id(Scheme_Object** g29, intptr_t g30) \
static Scheme_Object* ts_ ## id(Scheme_Object** g195, intptr_t g196) \
XFORM_SKIP_PROC \
{ \
if (scheme_use_rtcall) \
return scheme_rtcall_Sl_s("[" #id "]", src_type, id, g29, g30); \
return scheme_rtcall_Sl_s("[" #id "]", src_type, id, g195, g196); \
else \
return id(g29, g30); \
return id(g195, g196); \
}
#define define_ts_l_s(id, src_type) \
static Scheme_Object* ts_ ## id(intptr_t g31) \
static Scheme_Object* ts_ ## id(intptr_t g197) \
XFORM_SKIP_PROC \
{ \
if (scheme_use_rtcall) \
return scheme_rtcall_l_s("[" #id "]", src_type, id, g31); \
return scheme_rtcall_l_s("[" #id "]", src_type, id, g197); \
else \
return id(g31); \
return id(g197); \
}
#define define_ts_bsi_v(id, src_type) \
static void ts_ ## id(Scheme_Bucket* g32, Scheme_Object* g33, int g34) \
static void ts_ ## id(Scheme_Bucket* g198, Scheme_Object* g199, int g200) \
XFORM_SKIP_PROC \
{ \
if (scheme_use_rtcall) \
scheme_rtcall_bsi_v("[" #id "]", src_type, id, g32, g33, g34); \
scheme_rtcall_bsi_v("[" #id "]", src_type, id, g198, g199, g200); \
else \
id(g32, g33, g34); \
id(g198, g199, g200); \
}
#define define_ts_iiS_v(id, src_type) \
static void ts_ ## id(int g35, int g36, Scheme_Object** g37) \
static void ts_ ## id(int g201, int g202, Scheme_Object** g203) \
XFORM_SKIP_PROC \
{ \
if (scheme_use_rtcall) \
scheme_rtcall_iiS_v("[" #id "]", src_type, id, g35, g36, g37); \
scheme_rtcall_iiS_v("[" #id "]", src_type, id, g201, g202, g203); \
else \
id(g35, g36, g37); \
id(g201, g202, g203); \
}
#define define_ts_ss_v(id, src_type) \
static void ts_ ## id(Scheme_Object* g38, Scheme_Object* g39) \
static void ts_ ## id(Scheme_Object* g204, Scheme_Object* g205) \
XFORM_SKIP_PROC \
{ \
if (scheme_use_rtcall) \
scheme_rtcall_ss_v("[" #id "]", src_type, id, g38, g39); \
scheme_rtcall_ss_v("[" #id "]", src_type, id, g204, g205); \
else \
id(g38, g39); \
id(g204, g205); \
}
#define define_ts_b_v(id, src_type) \
static void ts_ ## id(Scheme_Bucket* g40) \
static void ts_ ## id(Scheme_Bucket* g206) \
XFORM_SKIP_PROC \
{ \
if (scheme_use_rtcall) \
scheme_rtcall_b_v("[" #id "]", src_type, id, g40); \
scheme_rtcall_b_v("[" #id "]", src_type, id, g206); \
else \
id(g40); \
id(g206); \
}
#define define_ts_sl_s(id, src_type) \
static Scheme_Object* ts_ ## id(Scheme_Object* g41, intptr_t g42) \
static Scheme_Object* ts_ ## id(Scheme_Object* g207, intptr_t g208) \
XFORM_SKIP_PROC \
{ \
if (scheme_use_rtcall) \
return scheme_rtcall_sl_s("[" #id "]", src_type, id, g41, g42); \
return scheme_rtcall_sl_s("[" #id "]", src_type, id, g207, g208); \
else \
return id(g41, g42); \
return id(g207, g208); \
}
#define define_ts_iS_s(id, src_type) \
static Scheme_Object* ts_ ## id(int g43, Scheme_Object** g44) \
static Scheme_Object* ts_ ## id(int g209, Scheme_Object** g210) \
XFORM_SKIP_PROC \
{ \
if (scheme_use_rtcall) \
return scheme_rtcall_iS_s("[" #id "]", src_type, id, g43, g44); \
return scheme_rtcall_iS_s("[" #id "]", src_type, id, g209, g210); \
else \
return id(g43, g44); \
return id(g209, g210); \
}
#define define_ts_S_s(id, src_type) \
static Scheme_Object* ts_ ## id(Scheme_Object** g45) \
static Scheme_Object* ts_ ## id(Scheme_Object** g211) \
XFORM_SKIP_PROC \
{ \
if (scheme_use_rtcall) \
return scheme_rtcall_S_s("[" #id "]", src_type, id, g45); \
return scheme_rtcall_S_s("[" #id "]", src_type, id, g211); \
else \
return id(g45); \
return id(g211); \
}
#define define_ts_s_v(id, src_type) \
static void ts_ ## id(Scheme_Object* g46) \
static void ts_ ## id(Scheme_Object* g212) \
XFORM_SKIP_PROC \
{ \
if (scheme_use_rtcall) \
scheme_rtcall_s_v("[" #id "]", src_type, id, g46); \
scheme_rtcall_s_v("[" #id "]", src_type, id, g212); \
else \
id(g46); \
id(g212); \
}
#define define_ts_iSi_s(id, src_type) \
static Scheme_Object* ts_ ## id(int g47, Scheme_Object** g48, int g49) \
static Scheme_Object* ts_ ## id(int g213, Scheme_Object** g214, int g215) \
XFORM_SKIP_PROC \
{ \
if (scheme_use_rtcall) \
return scheme_rtcall_iSi_s("[" #id "]", src_type, id, g47, g48, g49); \
return scheme_rtcall_iSi_s("[" #id "]", src_type, id, g213, g214, g215); \
else \
return id(g47, g48, g49); \
return id(g213, g214, g215); \
}
#define define_ts_siS_v(id, src_type) \
static void ts_ ## id(Scheme_Object* g50, int g51, Scheme_Object** g52) \
static void ts_ ## id(Scheme_Object* g216, int g217, Scheme_Object** g218) \
XFORM_SKIP_PROC \
{ \
if (scheme_use_rtcall) \
scheme_rtcall_siS_v("[" #id "]", src_type, id, g50, g51, g52); \
scheme_rtcall_siS_v("[" #id "]", src_type, id, g216, g217, g218); \
else \
id(g50, g51, g52); \
id(g216, g217, g218); \
}
#define define_ts_z_p(id, src_type) \
static void* ts_ ## id(size_t g53) \
static void* ts_ ## id(size_t g219) \
XFORM_SKIP_PROC \
{ \
if (scheme_use_rtcall) \
return scheme_rtcall_z_p("[" #id "]", src_type, id, g53); \
return scheme_rtcall_z_p("[" #id "]", src_type, id, g219); \
else \
return id(g53); \
return id(g219); \
}
#define define_ts_si_s(id, src_type) \
static Scheme_Object* ts_ ## id(Scheme_Object* g54, int g55) \
static Scheme_Object* ts_ ## id(Scheme_Object* g220, int g221) \
XFORM_SKIP_PROC \
{ \
if (scheme_use_rtcall) \
return scheme_rtcall_si_s("[" #id "]", src_type, id, g54, g55); \
return scheme_rtcall_si_s("[" #id "]", src_type, id, g220, g221); \
else \
return id(g54, g55); \
return id(g220, g221); \
}
#define define_ts_sis_v(id, src_type) \
static void ts_ ## id(Scheme_Object* g56, int g57, Scheme_Object* g58) \
static void ts_ ## id(Scheme_Object* g222, int g223, Scheme_Object* g224) \
XFORM_SKIP_PROC \
{ \
if (scheme_use_rtcall) \
scheme_rtcall_sis_v("[" #id "]", src_type, id, g56, g57, g58); \
scheme_rtcall_sis_v("[" #id "]", src_type, id, g222, g223, g224); \
else \
id(g56, g57, g58); \
id(g222, g223, g224); \
}
#define define_ts_ss_i(id, src_type) \
static int ts_ ## id(Scheme_Object* g59, Scheme_Object* g60) \
static int ts_ ## id(Scheme_Object* g225, Scheme_Object* g226) \
XFORM_SKIP_PROC \
{ \
if (scheme_use_rtcall) \
return scheme_rtcall_ss_i("[" #id "]", src_type, id, g59, g60); \
return scheme_rtcall_ss_i("[" #id "]", src_type, id, g225, g226); \
else \
return id(g59, g60); \
return id(g225, g226); \
}
#define define_ts_iSp_v(id, src_type) \
static void ts_ ## id(int g61, Scheme_Object** g62, void* g63) \
static void ts_ ## id(int g227, Scheme_Object** g228, void* g229) \
XFORM_SKIP_PROC \
{ \
if (scheme_use_rtcall) \
scheme_rtcall_iSp_v("[" #id "]", src_type, id, g61, g62, g63); \
scheme_rtcall_iSp_v("[" #id "]", src_type, id, g227, g228, g229); \
else \
id(g61, g62, g63); \
id(g227, g228, g229); \
}
#define define_ts_sss_s(id, src_type) \
static Scheme_Object* ts_ ## id(Scheme_Object* g64, Scheme_Object* g65, Scheme_Object* g66) \
static Scheme_Object* ts_ ## id(Scheme_Object* g230, Scheme_Object* g231, Scheme_Object* g232) \
XFORM_SKIP_PROC \
{ \
if (scheme_use_rtcall) \
return scheme_rtcall_sss_s("[" #id "]", src_type, id, g64, g65, g66); \
return scheme_rtcall_sss_s("[" #id "]", src_type, id, g230, g231, g232); \
else \
return id(g64, g65, g66); \
return id(g230, g231, g232); \
}
#define define_ts__v(id, src_type) \
static void ts_ ## id() \
@ -251,11 +251,11 @@ static void ts_ ## id() \
id(); \
}
#define define_ts_iS_v(id, src_type) \
static void ts_ ## id(int g67, Scheme_Object** g68) \
static void ts_ ## id(int g233, Scheme_Object** g234) \
XFORM_SKIP_PROC \
{ \
if (scheme_use_rtcall) \
scheme_rtcall_iS_v("[" #id "]", src_type, id, g67, g68); \
scheme_rtcall_iS_v("[" #id "]", src_type, id, g233, g234); \
else \
id(g67, g68); \
id(g233, g234); \
}

172
racket/src/racket/src/jit_ts_future_glue.c
View File

@ -1,4 +1,4 @@
Scheme_Object* scheme_rtcall_siS_s(const char *who, int src_type, prim_siS_s f, Scheme_Object* g69, int g70, Scheme_Object** g71)
Scheme_Object* scheme_rtcall_siS_s(const char *who, int src_type, prim_siS_s f, Scheme_Object* g235, int g236, Scheme_Object** g237)
XFORM_SKIP_PROC
{
Scheme_Future_Thread_State *fts = scheme_future_thread_state;
@ -13,9 +13,9 @@
future->time_of_request = tm;
future->source_of_request = who;
future->source_type = src_type;
future->arg_s0 = g69;
future->arg_i1 = g70;
future->arg_S2 = g71;
future->arg_s0 = g235;
future->arg_i1 = g236;
future->arg_S2 = g237;
future_do_runtimecall(fts, (void*)f, 0, 1, 0);
fts->thread = scheme_current_thread;
@ -25,7 +25,7 @@
receive_special_result(future, retval, 1);
return retval;
}
Scheme_Object* scheme_rtcall_iSs_s(const char *who, int src_type, prim_iSs_s f, int g72, Scheme_Object** g73, Scheme_Object* g74)
Scheme_Object* scheme_rtcall_iSs_s(const char *who, int src_type, prim_iSs_s f, int g238, Scheme_Object** g239, Scheme_Object* g240)
XFORM_SKIP_PROC
{
Scheme_Future_Thread_State *fts = scheme_future_thread_state;
@ -40,9 +40,9 @@
future->time_of_request = tm;
future->source_of_request = who;
future->source_type = src_type;
future->arg_i0 = g72;
future->arg_S1 = g73;
future->arg_s2 = g74;
future->arg_i0 = g238;
future->arg_S1 = g239;
future->arg_s2 = g240;
future_do_runtimecall(fts, (void*)f, 0, 1, 0);
fts->thread = scheme_current_thread;
@ -52,7 +52,7 @@
receive_special_result(future, retval, 1);
return retval;
}
Scheme_Object* scheme_rtcall_s_s(const char *who, int src_type, prim_s_s f, Scheme_Object* g75)
Scheme_Object* scheme_rtcall_s_s(const char *who, int src_type, prim_s_s f, Scheme_Object* g241)
XFORM_SKIP_PROC
{
Scheme_Future_Thread_State *fts = scheme_future_thread_state;
@ -67,8 +67,8 @@
future->time_of_request = tm;
future->source_of_request = who;
future->source_type = src_type;
future->arg_s0 = g75;
send_special_result(future, g75);
future->arg_s0 = g241;
send_special_result(future, g241);
future_do_runtimecall(fts, (void*)f, 0, 1, 0);
fts->thread = scheme_current_thread;
future = fts->thread->current_ft;
@ -77,7 +77,7 @@
receive_special_result(future, retval, 1);
return retval;
}
Scheme_Object* scheme_rtcall_n_s(const char *who, int src_type, prim_n_s f, Scheme_Native_Closure_Data* g76)
Scheme_Object* scheme_rtcall_n_s(const char *who, int src_type, prim_n_s f, Scheme_Native_Lambda* g242)
XFORM_SKIP_PROC
{
Scheme_Future_Thread_State *fts = scheme_future_thread_state;
@ -92,7 +92,7 @@
future->time_of_request = tm;
future->source_of_request = who;
future->source_type = src_type;
future->arg_n0 = g76;
future->arg_n0 = g242;
future_do_runtimecall(fts, (void*)f, 0, 1, 0);
fts->thread = scheme_current_thread;
@ -127,7 +127,7 @@
receive_special_result(future, retval, 1);
return retval;
}
Scheme_Object* scheme_rtcall_ss_s(const char *who, int src_type, prim_ss_s f, Scheme_Object* g77, Scheme_Object* g78)
Scheme_Object* scheme_rtcall_ss_s(const char *who, int src_type, prim_ss_s f, Scheme_Object* g243, Scheme_Object* g244)
XFORM_SKIP_PROC
{
Scheme_Future_Thread_State *fts = scheme_future_thread_state;
@ -142,8 +142,8 @@
future->time_of_request = tm;
future->source_of_request = who;
future->source_type = src_type;
future->arg_s0 = g77;
future->arg_s1 = g78;
future->arg_s0 = g243;
future->arg_s1 = g244;
future_do_runtimecall(fts, (void*)f, 0, 1, 0);
fts->thread = scheme_current_thread;
@ -153,7 +153,7 @@
receive_special_result(future, retval, 1);
return retval;
}
Scheme_Object* scheme_rtcall_ssi_s(const char *who, int src_type, prim_ssi_s f, Scheme_Object* g79, Scheme_Object* g80, int g81)
Scheme_Object* scheme_rtcall_ssi_s(const char *who, int src_type, prim_ssi_s f, Scheme_Object* g245, Scheme_Object* g246, int g247)
XFORM_SKIP_PROC
{
Scheme_Future_Thread_State *fts = scheme_future_thread_state;
@ -168,9 +168,9 @@
future->time_of_request = tm;
future->source_of_request = who;
future->source_type = src_type;
future->arg_s0 = g79;
future->arg_s1 = g80;
future->arg_i2 = g81;
future->arg_s0 = g245;
future->arg_s1 = g246;
future->arg_i2 = g247;
future_do_runtimecall(fts, (void*)f, 0, 1, 0);
fts->thread = scheme_current_thread;
@ -180,7 +180,7 @@
receive_special_result(future, retval, 1);
return retval;
}
Scheme_Object* scheme_rtcall_tt_s(const char *who, int src_type, prim_tt_s f, const Scheme_Object* g82, const Scheme_Object* g83)
Scheme_Object* scheme_rtcall_tt_s(const char *who, int src_type, prim_tt_s f, const Scheme_Object* g248, const Scheme_Object* g249)
XFORM_SKIP_PROC
{
Scheme_Future_Thread_State *fts = scheme_future_thread_state;
@ -195,8 +195,8 @@
future->time_of_request = tm;
future->source_of_request = who;
future->source_type = src_type;
future->arg_t0 = g82;
future->arg_t1 = g83;
future->arg_t0 = g248;
future->arg_t1 = g249;
future_do_runtimecall(fts, (void*)f, 0, 1, 0);
fts->thread = scheme_current_thread;
@ -206,7 +206,7 @@
receive_special_result(future, retval, 1);
return retval;
}
MZ_MARK_STACK_TYPE scheme_rtcall_ss_m(const char *who, int src_type, prim_ss_m f, Scheme_Object* g84, Scheme_Object* g85)
MZ_MARK_STACK_TYPE scheme_rtcall_ss_m(const char *who, int src_type, prim_ss_m f, Scheme_Object* g250, Scheme_Object* g251)
XFORM_SKIP_PROC
{
Scheme_Future_Thread_State *fts = scheme_future_thread_state;
@ -221,8 +221,8 @@
future->time_of_request = tm;
future->source_of_request = who;
future->source_type = src_type;
future->arg_s0 = g84;
future->arg_s1 = g85;
future->arg_s0 = g250;
future->arg_s1 = g251;
future_do_runtimecall(fts, (void*)f, 0, 1, 0);
fts->thread = scheme_current_thread;
@ -232,7 +232,7 @@
return retval;
}
Scheme_Object* scheme_rtcall_Sl_s(const char *who, int src_type, prim_Sl_s f, Scheme_Object** g86, intptr_t g87)
Scheme_Object* scheme_rtcall_Sl_s(const char *who, int src_type, prim_Sl_s f, Scheme_Object** g252, intptr_t g253)
XFORM_SKIP_PROC
{
Scheme_Future_Thread_State *fts = scheme_future_thread_state;
@ -247,8 +247,8 @@
future->time_of_request = tm;
future->source_of_request = who;
future->source_type = src_type;
future->arg_S0 = g86;
future->arg_l1 = g87;
future->arg_S0 = g252;
future->arg_l1 = g253;
future_do_runtimecall(fts, (void*)f, 0, 1, 0);
fts->thread = scheme_current_thread;
@ -258,7 +258,7 @@
receive_special_result(future, retval, 1);
return retval;
}
Scheme_Object* scheme_rtcall_l_s(const char *who, int src_type, prim_l_s f, intptr_t g88)
Scheme_Object* scheme_rtcall_l_s(const char *who, int src_type, prim_l_s f, intptr_t g254)
XFORM_SKIP_PROC
{
Scheme_Future_Thread_State *fts = scheme_future_thread_state;
@ -273,7 +273,7 @@
future->time_of_request = tm;
future->source_of_request = who;
future->source_type = src_type;
future->arg_l0 = g88;
future->arg_l0 = g254;
future_do_runtimecall(fts, (void*)f, 0, 1, 0);
fts->thread = scheme_current_thread;
@ -283,7 +283,7 @@
receive_special_result(future, retval, 1);
return retval;
}
void scheme_rtcall_bsi_v(const char *who, int src_type, prim_bsi_v f, Scheme_Bucket* g89, Scheme_Object* g90, int g91)
void scheme_rtcall_bsi_v(const char *who, int src_type, prim_bsi_v f, Scheme_Bucket* g255, Scheme_Object* g256, int g257)
XFORM_SKIP_PROC
{
Scheme_Future_Thread_State *fts = scheme_future_thread_state;
@ -298,9 +298,9 @@
future->time_of_request = tm;
future->source_of_request = who;
future->source_type = src_type;
future->arg_b0 = g89;
future->arg_s1 = g90;
future->arg_i2 = g91;
future->arg_b0 = g255;
future->arg_s1 = g256;
future->arg_i2 = g257;
future_do_runtimecall(fts, (void*)f, 0, 1, 0);
fts->thread = scheme_current_thread;
@ -310,7 +310,7 @@
}
void scheme_rtcall_iiS_v(const char *who, int src_type, prim_iiS_v f, int g92, int g93, Scheme_Object** g94)
void scheme_rtcall_iiS_v(const char *who, int src_type, prim_iiS_v f, int g258, int g259, Scheme_Object** g260)
XFORM_SKIP_PROC
{
Scheme_Future_Thread_State *fts = scheme_future_thread_state;
@ -325,9 +325,9 @@
future->time_of_request = tm;
future->source_of_request = who;
future->source_type = src_type;
future->arg_i0 = g92;
future->arg_i1 = g93;
future->arg_S2 = g94;
future->arg_i0 = g258;
future->arg_i1 = g259;
future->arg_S2 = g260;
future_do_runtimecall(fts, (void*)f, 0, 1, 0);
fts->thread = scheme_current_thread;
@ -337,7 +337,7 @@
}
void scheme_rtcall_ss_v(const char *who, int src_type, prim_ss_v f, Scheme_Object* g95, Scheme_Object* g96)
void scheme_rtcall_ss_v(const char *who, int src_type, prim_ss_v f, Scheme_Object* g261, Scheme_Object* g262)
XFORM_SKIP_PROC
{
Scheme_Future_Thread_State *fts = scheme_future_thread_state;
@ -352,8 +352,8 @@
future->time_of_request = tm;
future->source_of_request = who;
future->source_type = src_type;
future->arg_s0 = g95;
future->arg_s1 = g96;
future->arg_s0 = g261;
future->arg_s1 = g262;
future_do_runtimecall(fts, (void*)f, 0, 1, 0);
fts->thread = scheme_current_thread;
@ -363,7 +363,7 @@
}
void scheme_rtcall_b_v(const char *who, int src_type, prim_b_v f, Scheme_Bucket* g97)
void scheme_rtcall_b_v(const char *who, int src_type, prim_b_v f, Scheme_Bucket* g263)
XFORM_SKIP_PROC
{
Scheme_Future_Thread_State *fts = scheme_future_thread_state;
@ -378,7 +378,7 @@
future->time_of_request = tm;
future->source_of_request = who;
future->source_type = src_type;
future->arg_b0 = g97;
future->arg_b0 = g263;
future_do_runtimecall(fts, (void*)f, 0, 1, 0);
fts->thread = scheme_current_thread;
@ -388,7 +388,7 @@
}
Scheme_Object* scheme_rtcall_sl_s(const char *who, int src_type, prim_sl_s f, Scheme_Object* g98, intptr_t g99)
Scheme_Object* scheme_rtcall_sl_s(const char *who, int src_type, prim_sl_s f, Scheme_Object* g264, intptr_t g265)
XFORM_SKIP_PROC
{
Scheme_Future_Thread_State *fts = scheme_future_thread_state;
@ -403,8 +403,8 @@
future->time_of_request = tm;
future->source_of_request = who;
future->source_type = src_type;
future->arg_s0 = g98;
future->arg_l1 = g99;
future->arg_s0 = g264;
future->arg_l1 = g265;
future_do_runtimecall(fts, (void*)f, 0, 1, 0);
fts->thread = scheme_current_thread;
@ -414,7 +414,7 @@
receive_special_result(future, retval, 1);
return retval;
}
Scheme_Object* scheme_rtcall_iS_s(const char *who, int src_type, prim_iS_s f, int g100, Scheme_Object** g101)
Scheme_Object* scheme_rtcall_iS_s(const char *who, int src_type, prim_iS_s f, int g266, Scheme_Object** g267)
XFORM_SKIP_PROC
{
Scheme_Future_Thread_State *fts = scheme_future_thread_state;
@ -429,8 +429,8 @@
future->time_of_request = tm;
future->source_of_request = who;
future->source_type = src_type;
future->arg_i0 = g100;
future->arg_S1 = g101;
future->arg_i0 = g266;
future->arg_S1 = g267;
future_do_runtimecall(fts, (void*)f, 0, 1, 0);
fts->thread = scheme_current_thread;
@ -440,7 +440,7 @@
receive_special_result(future, retval, 1);
return retval;
}
Scheme_Object* scheme_rtcall_S_s(const char *who, int src_type, prim_S_s f, Scheme_Object** g102)
Scheme_Object* scheme_rtcall_S_s(const char *who, int src_type, prim_S_s f, Scheme_Object** g268)
XFORM_SKIP_PROC
{
Scheme_Future_Thread_State *fts = scheme_future_thread_state;
@ -455,7 +455,7 @@
future->time_of_request = tm;
future->source_of_request = who;
future->source_type = src_type;
future->arg_S0 = g102;
future->arg_S0 = g268;
future_do_runtimecall(fts, (void*)f, 0, 1, 0);
fts->thread = scheme_current_thread;
@ -465,7 +465,7 @@
receive_special_result(future, retval, 1);
return retval;
}
void scheme_rtcall_s_v(const char *who, int src_type, prim_s_v f, Scheme_Object* g103)
void scheme_rtcall_s_v(const char *who, int src_type, prim_s_v f, Scheme_Object* g269)
XFORM_SKIP_PROC
{
Scheme_Future_Thread_State *fts = scheme_future_thread_state;
@ -480,8 +480,8 @@
future->time_of_request = tm;
future->source_of_request = who;
future->source_type = src_type;
future->arg_s0 = g103;
send_special_result(future, g103);
future->arg_s0 = g269;
send_special_result(future, g269);
future_do_runtimecall(fts, (void*)f, 0, 1, 0);
fts->thread = scheme_current_thread;
future = fts->thread->current_ft;
@ -490,7 +490,7 @@
}
Scheme_Object* scheme_rtcall_iSi_s(const char *who, int src_type, prim_iSi_s f, int g104, Scheme_Object** g105, int g106)
Scheme_Object* scheme_rtcall_iSi_s(const char *who, int src_type, prim_iSi_s f, int g270, Scheme_Object** g271, int g272)
XFORM_SKIP_PROC
{
Scheme_Future_Thread_State *fts = scheme_future_thread_state;
@ -505,9 +505,9 @@
future->time_of_request = tm;
future->source_of_request = who;
future->source_type = src_type;
future->arg_i0 = g104;
future->arg_S1 = g105;
future->arg_i2 = g106;
future->arg_i0 = g270;
future->arg_S1 = g271;
future->arg_i2 = g272;
future_do_runtimecall(fts, (void*)f, 0, 1, 0);
fts->thread = scheme_current_thread;
@ -517,7 +517,7 @@
receive_special_result(future, retval, 1);
return retval;
}
void scheme_rtcall_siS_v(const char *who, int src_type, prim_siS_v f, Scheme_Object* g107, int g108, Scheme_Object** g109)
void scheme_rtcall_siS_v(const char *who, int src_type, prim_siS_v f, Scheme_Object* g273, int g274, Scheme_Object** g275)
XFORM_SKIP_PROC
{
Scheme_Future_Thread_State *fts = scheme_future_thread_state;
@ -532,9 +532,9 @@
future->time_of_request = tm;
future->source_of_request = who;
future->source_type = src_type;
future->arg_s0 = g107;
future->arg_i1 = g108;
future->arg_S2 = g109;
future->arg_s0 = g273;
future->arg_i1 = g274;
future->arg_S2 = g275;
future_do_runtimecall(fts, (void*)f, 0, 1, 0);
fts->thread = scheme_current_thread;
@ -544,7 +544,7 @@
}
void* scheme_rtcall_z_p(const char *who, int src_type, prim_z_p f, size_t g110)
void* scheme_rtcall_z_p(const char *who, int src_type, prim_z_p f, size_t g276)
XFORM_SKIP_PROC
{
Scheme_Future_Thread_State *fts = scheme_future_thread_state;
@ -559,7 +559,7 @@
future->time_of_request = tm;
future->source_of_request = who;
future->source_type = src_type;
future->arg_z0 = g110;
future->arg_z0 = g276;
future_do_runtimecall(fts, (void*)f, 0, 1, 0);
fts->thread = scheme_current_thread;
@ -569,7 +569,7 @@
return retval;
}
Scheme_Object* scheme_rtcall_si_s(const char *who, int src_type, prim_si_s f, Scheme_Object* g111, int g112)
Scheme_Object* scheme_rtcall_si_s(const char *who, int src_type, prim_si_s f, Scheme_Object* g277, int g278)
XFORM_SKIP_PROC
{
Scheme_Future_Thread_State *fts = scheme_future_thread_state;
@ -584,8 +584,8 @@
future->time_of_request = tm;
future->source_of_request = who;
future->source_type = src_type;
future->arg_s0 = g111;
future->arg_i1 = g112;
future->arg_s0 = g277;
future->arg_i1 = g278;
future_do_runtimecall(fts, (void*)f, 0, 1, 0);
fts->thread = scheme_current_thread;
@ -595,7 +595,7 @@
receive_special_result(future, retval, 1);
return retval;
}
void scheme_rtcall_sis_v(const char *who, int src_type, prim_sis_v f, Scheme_Object* g113, int g114, Scheme_Object* g115)
void scheme_rtcall_sis_v(const char *who, int src_type, prim_sis_v f, Scheme_Object* g279, int g280, Scheme_Object* g281)
XFORM_SKIP_PROC
{
Scheme_Future_Thread_State *fts = scheme_future_thread_state;
@ -610,9 +610,9 @@
future->time_of_request = tm;
future->source_of_request = who;
future->source_type = src_type;
future->arg_s0 = g113;
future->arg_i1 = g114;
future->arg_s2 = g115;
future->arg_s0 = g279;
future->arg_i1 = g280;
future->arg_s2 = g281;
future_do_runtimecall(fts, (void*)f, 0, 1, 0);
fts->thread = scheme_current_thread;
@ -622,7 +622,7 @@
}
int scheme_rtcall_ss_i(const char *who, int src_type, prim_ss_i f, Scheme_Object* g116, Scheme_Object* g117)
int scheme_rtcall_ss_i(const char *who, int src_type, prim_ss_i f, Scheme_Object* g282, Scheme_Object* g283)
XFORM_SKIP_PROC
{
Scheme_Future_Thread_State *fts = scheme_future_thread_state;
@ -637,8 +637,8 @@
future->time_of_request = tm;
future->source_of_request = who;
future->source_type = src_type;
future->arg_s0 = g116;
future->arg_s1 = g117;
future->arg_s0 = g282;
future->arg_s1 = g283;
future_do_runtimecall(fts, (void*)f, 0, 1, 0);
fts->thread = scheme_current_thread;
@ -648,7 +648,7 @@
return retval;
}
void scheme_rtcall_iSp_v(const char *who, int src_type, prim_iSp_v f, int g118, Scheme_Object** g119, void* g120)
void scheme_rtcall_iSp_v(const char *who, int src_type, prim_iSp_v f, int g284, Scheme_Object** g285, void* g286)
XFORM_SKIP_PROC
{
Scheme_Future_Thread_State *fts = scheme_future_thread_state;
@ -663,9 +663,9 @@
future->time_of_request = tm;
future->source_of_request = who;
future->source_type = src_type;
future->arg_i0 = g118;
future->arg_S1 = g119;
future->arg_p2 = g120;
future->arg_i0 = g284;
future->arg_S1 = g285;
future->arg_p2 = g286;
future_do_runtimecall(fts, (void*)f, 0, 1, 0);
fts->thread = scheme_current_thread;
@ -675,7 +675,7 @@
}
Scheme_Object* scheme_rtcall_sss_s(const char *who, int src_type, prim_sss_s f, Scheme_Object* g121, Scheme_Object* g122, Scheme_Object* g123)
Scheme_Object* scheme_rtcall_sss_s(const char *who, int src_type, prim_sss_s f, Scheme_Object* g287, Scheme_Object* g288, Scheme_Object* g289)
XFORM_SKIP_PROC
{
Scheme_Future_Thread_State *fts = scheme_future_thread_state;
@ -690,9 +690,9 @@
future->time_of_request = tm;
future->source_of_request = who;
future->source_type = src_type;
future->arg_s0 = g121;
future->arg_s1 = g122;
future->arg_s2 = g123;
future->arg_s0 = g287;
future->arg_s1 = g288;
future->arg_s2 = g289;
future_do_runtimecall(fts, (void*)f, 0, 1, 0);
fts->thread = scheme_current_thread;
@ -727,7 +727,7 @@
}
void scheme_rtcall_iS_v(const char *who, int src_type, prim_iS_v f, int g124, Scheme_Object** g125)
void scheme_rtcall_iS_v(const char *who, int src_type, prim_iS_v f, int g290, Scheme_Object** g291)
XFORM_SKIP_PROC
{
Scheme_Future_Thread_State *fts = scheme_future_thread_state;
@ -742,8 +742,8 @@
future->time_of_request = tm;
future->source_of_request = who;
future->source_type = src_type;
future->arg_i0 = g124;
future->arg_S1 = g125;
future->arg_i0 = g290;
future->arg_S1 = g291;
future_do_runtimecall(fts, (void*)f, 0, 1, 0);
fts->thread = scheme_current_thread;

56
racket/src/racket/src/jit_ts_protos.h
View File

@ -1,87 +1,87 @@
#define SIG_siS_s 11
typedef Scheme_Object* (*prim_siS_s)(Scheme_Object*, int, Scheme_Object**);
Scheme_Object* scheme_rtcall_siS_s(const char *who, int src_type, prim_siS_s f, Scheme_Object* g183, int g184, Scheme_Object** g185);
Scheme_Object* scheme_rtcall_siS_s(const char *who, int src_type, prim_siS_s f, Scheme_Object* g349, int g350, Scheme_Object** g351);
#define SIG_iSs_s 12
typedef Scheme_Object* (*prim_iSs_s)(int, Scheme_Object**, Scheme_Object*);
Scheme_Object* scheme_rtcall_iSs_s(const char *who, int src_type, prim_iSs_s f, int g186, Scheme_Object** g187, Scheme_Object* g188);
Scheme_Object* scheme_rtcall_iSs_s(const char *who, int src_type, prim_iSs_s f, int g352, Scheme_Object** g353, Scheme_Object* g354);
#define SIG_s_s 13
typedef Scheme_Object* (*prim_s_s)(Scheme_Object*);
Scheme_Object* scheme_rtcall_s_s(const char *who, int src_type, prim_s_s f, Scheme_Object* g189);
Scheme_Object* scheme_rtcall_s_s(const char *who, int src_type, prim_s_s f, Scheme_Object* g355);
#define SIG_n_s 14
typedef Scheme_Object* (*prim_n_s)(Scheme_Native_Closure_Data*);
Scheme_Object* scheme_rtcall_n_s(const char *who, int src_type, prim_n_s f, Scheme_Native_Closure_Data* g190);
typedef Scheme_Object* (*prim_n_s)(Scheme_Native_Lambda*);
Scheme_Object* scheme_rtcall_n_s(const char *who, int src_type, prim_n_s f, Scheme_Native_Lambda* g356);
#define SIG__s 15
typedef Scheme_Object* (*prim__s)();
Scheme_Object* scheme_rtcall__s(const char *who, int src_type, prim__s f );
#define SIG_ss_s 16
typedef Scheme_Object* (*prim_ss_s)(Scheme_Object*, Scheme_Object*);
Scheme_Object* scheme_rtcall_ss_s(const char *who, int src_type, prim_ss_s f, Scheme_Object* g191, Scheme_Object* g192);
Scheme_Object* scheme_rtcall_ss_s(const char *who, int src_type, prim_ss_s f, Scheme_Object* g357, Scheme_Object* g358);
#define SIG_ssi_s 17
typedef Scheme_Object* (*prim_ssi_s)(Scheme_Object*, Scheme_Object*, int);
Scheme_Object* scheme_rtcall_ssi_s(const char *who, int src_type, prim_ssi_s f, Scheme_Object* g193, Scheme_Object* g194, int g195);
Scheme_Object* scheme_rtcall_ssi_s(const char *who, int src_type, prim_ssi_s f, Scheme_Object* g359, Scheme_Object* g360, int g361);
#define SIG_tt_s 18
typedef Scheme_Object* (*prim_tt_s)(const Scheme_Object*, const Scheme_Object*);
Scheme_Object* scheme_rtcall_tt_s(const char *who, int src_type, prim_tt_s f, const Scheme_Object* g196, const Scheme_Object* g197);
Scheme_Object* scheme_rtcall_tt_s(const char *who, int src_type, prim_tt_s f, const Scheme_Object* g362, const Scheme_Object* g363);
#define SIG_ss_m 19
typedef MZ_MARK_STACK_TYPE (*prim_ss_m)(Scheme_Object*, Scheme_Object*);
MZ_MARK_STACK_TYPE scheme_rtcall_ss_m(const char *who, int src_type, prim_ss_m f, Scheme_Object* g198, Scheme_Object* g199);
MZ_MARK_STACK_TYPE scheme_rtcall_ss_m(const char *who, int src_type, prim_ss_m f, Scheme_Object* g364, Scheme_Object* g365);
#define SIG_Sl_s 20
typedef Scheme_Object* (*prim_Sl_s)(Scheme_Object**, intptr_t);
Scheme_Object* scheme_rtcall_Sl_s(const char *who, int src_type, prim_Sl_s f, Scheme_Object** g200, intptr_t g201);
Scheme_Object* scheme_rtcall_Sl_s(const char *who, int src_type, prim_Sl_s f, Scheme_Object** g366, intptr_t g367);
#define SIG_l_s 21
typedef Scheme_Object* (*prim_l_s)(intptr_t);
Scheme_Object* scheme_rtcall_l_s(const char *who, int src_type, prim_l_s f, intptr_t g202);
Scheme_Object* scheme_rtcall_l_s(const char *who, int src_type, prim_l_s f, intptr_t g368);
#define SIG_bsi_v 22
typedef void (*prim_bsi_v)(Scheme_Bucket*, Scheme_Object*, int);
void scheme_rtcall_bsi_v(const char *who, int src_type, prim_bsi_v f, Scheme_Bucket* g203, Scheme_Object* g204, int g205);
void scheme_rtcall_bsi_v(const char *who, int src_type, prim_bsi_v f, Scheme_Bucket* g369, Scheme_Object* g370, int g371);
#define SIG_iiS_v 23
typedef void (*prim_iiS_v)(int, int, Scheme_Object**);
void scheme_rtcall_iiS_v(const char *who, int src_type, prim_iiS_v f, int g206, int g207, Scheme_Object** g208);
void scheme_rtcall_iiS_v(const char *who, int src_type, prim_iiS_v f, int g372, int g373, Scheme_Object** g374);
#define SIG_ss_v 24
typedef void (*prim_ss_v)(Scheme_Object*, Scheme_Object*);
void scheme_rtcall_ss_v(const char *who, int src_type, prim_ss_v f, Scheme_Object* g209, Scheme_Object* g210);
void scheme_rtcall_ss_v(const char *who, int src_type, prim_ss_v f, Scheme_Object* g375, Scheme_Object* g376);
#define SIG_b_v 25
typedef void (*prim_b_v)(Scheme_Bucket*);
void scheme_rtcall_b_v(const char *who, int src_type, prim_b_v f, Scheme_Bucket* g211);
void scheme_rtcall_b_v(const char *who, int src_type, prim_b_v f, Scheme_Bucket* g377);
#define SIG_sl_s 26
typedef Scheme_Object* (*prim_sl_s)(Scheme_Object*, intptr_t);
Scheme_Object* scheme_rtcall_sl_s(const char *who, int src_type, prim_sl_s f, Scheme_Object* g212, intptr_t g213);
Scheme_Object* scheme_rtcall_sl_s(const char *who, int src_type, prim_sl_s f, Scheme_Object* g378, intptr_t g379);
#define SIG_iS_s 27
typedef Scheme_Object* (*prim_iS_s)(int, Scheme_Object**);
Scheme_Object* scheme_rtcall_iS_s(const char *who, int src_type, prim_iS_s f, int g214, Scheme_Object** g215);
Scheme_Object* scheme_rtcall_iS_s(const char *who, int src_type, prim_iS_s f, int g380, Scheme_Object** g381);
#define SIG_S_s 28
typedef Scheme_Object* (*prim_S_s)(Scheme_Object**);
Scheme_Object* scheme_rtcall_S_s(const char *who, int src_type, prim_S_s f, Scheme_Object** g216);
Scheme_Object* scheme_rtcall_S_s(const char *who, int src_type, prim_S_s f, Scheme_Object** g382);
#define SIG_s_v 29
typedef void (*prim_s_v)(Scheme_Object*);
void scheme_rtcall_s_v(const char *who, int src_type, prim_s_v f, Scheme_Object* g217);
void scheme_rtcall_s_v(const char *who, int src_type, prim_s_v f, Scheme_Object* g383);
#define SIG_iSi_s 30
typedef Scheme_Object* (*prim_iSi_s)(int, Scheme_Object**, int);
Scheme_Object* scheme_rtcall_iSi_s(const char *who, int src_type, prim_iSi_s f, int g218, Scheme_Object** g219, int g220);
Scheme_Object* scheme_rtcall_iSi_s(const char *who, int src_type, prim_iSi_s f, int g384, Scheme_Object** g385, int g386);
#define SIG_siS_v 31
typedef void (*prim_siS_v)(Scheme_Object*, int, Scheme_Object**);
void scheme_rtcall_siS_v(const char *who, int src_type, prim_siS_v f, Scheme_Object* g221, int g222, Scheme_Object** g223);
void scheme_rtcall_siS_v(const char *who, int src_type, prim_siS_v f, Scheme_Object* g387, int g388, Scheme_Object** g389);
#define SIG_z_p 32
typedef void* (*prim_z_p)(size_t);
void* scheme_rtcall_z_p(const char *who, int src_type, prim_z_p f, size_t g224);
void* scheme_rtcall_z_p(const char *who, int src_type, prim_z_p f, size_t g390);
#define SIG_si_s 33
typedef Scheme_Object* (*prim_si_s)(Scheme_Object*, int);
Scheme_Object* scheme_rtcall_si_s(const char *who, int src_type, prim_si_s f, Scheme_Object* g225, int g226);
Scheme_Object* scheme_rtcall_si_s(const char *who, int src_type, prim_si_s f, Scheme_Object* g391, int g392);
#define SIG_sis_v 34
typedef void (*prim_sis_v)(Scheme_Object*, int, Scheme_Object*);
void scheme_rtcall_sis_v(const char *who, int src_type, prim_sis_v f, Scheme_Object* g227, int g228, Scheme_Object* g229);
void scheme_rtcall_sis_v(const char *who, int src_type, prim_sis_v f, Scheme_Object* g393, int g394, Scheme_Object* g395);
#define SIG_ss_i 35
typedef int (*prim_ss_i)(Scheme_Object*, Scheme_Object*);
int scheme_rtcall_ss_i(const char *who, int src_type, prim_ss_i f, Scheme_Object* g230, Scheme_Object* g231);
int scheme_rtcall_ss_i(const char *who, int src_type, prim_ss_i f, Scheme_Object* g396, Scheme_Object* g397);
#define SIG_iSp_v 36
typedef void (*prim_iSp_v)(int, Scheme_Object**, void*);
void scheme_rtcall_iSp_v(const char *who, int src_type, prim_iSp_v f, int g232, Scheme_Object** g233, void* g234);
void scheme_rtcall_iSp_v(const char *who, int src_type, prim_iSp_v f, int g398, Scheme_Object** g399, void* g400);
#define SIG_sss_s 37
typedef Scheme_Object* (*prim_sss_s)(Scheme_Object*, Scheme_Object*, Scheme_Object*);
Scheme_Object* scheme_rtcall_sss_s(const char *who, int src_type, prim_sss_s f, Scheme_Object* g235, Scheme_Object* g236, Scheme_Object* g237);
Scheme_Object* scheme_rtcall_sss_s(const char *who, int src_type, prim_sss_s f, Scheme_Object* g401, Scheme_Object* g402, Scheme_Object* g403);
#define SIG__v 38
typedef void (*prim__v)();
void scheme_rtcall__v(const char *who, int src_type, prim__v f );
#define SIG_iS_v 39
typedef void (*prim_iS_v)(int, Scheme_Object**);
void scheme_rtcall_iS_v(const char *who, int src_type, prim_iS_v f, int g238, Scheme_Object** g239);
void scheme_rtcall_iS_v(const char *who, int src_type, prim_iS_v f, int g404, Scheme_Object** g405);

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

@ -44,7 +44,7 @@ case SIG_n_s:
{
prim_n_s f = (prim_n_s)future->prim_func;
GC_CAN_IGNORE Scheme_Object* retval;
JIT_TS_LOCALIZE(Scheme_Native_Closure_Data*, arg_n0);
JIT_TS_LOCALIZE(Scheme_Native_Lambda*, arg_n0);
future->arg_n0 = NULL;

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

@ -2224,7 +2224,7 @@ int scheme_generate_nary_arith(mz_jit_state *jitter, Scheme_App_Rec *app,
use_fx = 0;
if (trigger_arg == i)
trigger_arg++;
} else if (SCHEME_TYPE(v) >= _scheme_compiled_values_types_) {
} else if (SCHEME_TYPE(v) >= _scheme_ir_values_types_) {
use_fx = 0;
mzSET_USE_FL(use_fl = 0);
}

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

@ -28,7 +28,7 @@
#include "jit.h"
#ifdef USE_FLONUM_UNBOXING
static int generate_argument_boxing(mz_jit_state *jitter, Scheme_Closure_Data *data,
static int generate_argument_boxing(mz_jit_state *jitter, Scheme_Lambda *lam,
int num_rands, int args_already_in_place,
int offset, int direct_flostack_offset,
int save_reg,
@ -393,13 +393,13 @@ static const int direct_arg_regs[] = { JIT_V1, JIT_R1, JIT_R0 };
int scheme_generate_tail_call(mz_jit_state *jitter, int num_rands, int direct_native, int need_set_rs,
int is_inline, Scheme_Native_Closure *direct_to_code, jit_direct_arg *direct_args,
Scheme_Closure_Data *direct_data)
Scheme_Lambda *direct_lam)
/* Proc is in V1 unless direct_to_code, args are at RUNSTACK.
If num_rands < 0, then argc is in LOCAL2 and arguments are already below RUNSTACK_BASE.
If direct_native == 2, then some arguments are already in place (shallower in the runstack
than the arguments to move).
If direct_args, then R0, R1, V1 hold arguments.
If direct data in unboxing mode, slow path needs to box flonum arguments; num_rands
If direct lam in unboxing mode, slow path needs to box flonum arguments; num_rands
must be >= 0 */
{
int i, r2_has_runstack = 0;
@ -425,7 +425,7 @@ int scheme_generate_tail_call(mz_jit_state *jitter, int num_rands, int direct_na
/* Right kind of function. Extract data and check stack depth: */
if (!direct_to_code) {
jit_ldxi_p(JIT_R0, JIT_V1, &((Scheme_Native_Closure *)0x0)->code);
jit_ldxi_i(JIT_R2, JIT_R0, &((Scheme_Native_Closure_Data *)0x0)->max_let_depth);
jit_ldxi_i(JIT_R2, JIT_R0, &((Scheme_Native_Lambda *)0x0)->max_let_depth);
mz_tl_ldi_p(JIT_R1, tl_MZ_RUNSTACK_START);
jit_subr_ul(JIT_R1, JIT_RUNSTACK, JIT_R1);
ref4 = jit_bltr_ul(jit_forward(), JIT_R1, JIT_R2);
@ -492,9 +492,9 @@ int scheme_generate_tail_call(mz_jit_state *jitter, int num_rands, int direct_na
jit_movr_p(JIT_R2, JIT_V1);
r2_has_runstack = 0;
if (direct_native) {
jit_ldxi_p(JIT_V1, JIT_R0, &((Scheme_Native_Closure_Data *)0x0)->u.tail_code);
jit_ldxi_p(JIT_V1, JIT_R0, &((Scheme_Native_Lambda *)0x0)->u.tail_code);
} else {
jit_ldxi_p(JIT_V1, JIT_R0, &((Scheme_Native_Closure_Data *)0x0)->arity_code);
jit_ldxi_p(JIT_V1, JIT_R0, &((Scheme_Native_Lambda *)0x0)->arity_code);
}
jit_movr_p(JIT_R0, JIT_R2);
}
@ -553,12 +553,12 @@ int scheme_generate_tail_call(mz_jit_state *jitter, int num_rands, int direct_na
mz_patch_branch(ref4);
CHECK_LIMIT();
#ifdef USE_FLONUM_UNBOXING
if (direct_data) {
if (SCHEME_CLOSURE_DATA_FLAGS(direct_data) & CLOS_HAS_TYPED_ARGS) {
if (direct_lam) {
if (SCHEME_LAMBDA_FLAGS(direct_lam) & LAMBDA_HAS_TYPED_ARGS) {
/* Need to box flonum arguments. Flonums are currently in the place where
the target function expects them unpacked from arguments. We need to save
JIT_V1. */
generate_argument_boxing(jitter, direct_data,
generate_argument_boxing(jitter, direct_lam,
num_rands, 0,
0, 0,
JIT_V1,
@ -861,7 +861,7 @@ int scheme_generate_non_tail_call(mz_jit_state *jitter, int num_rands, int direc
/* Before inlined native, check max let depth */
if (!nontail_self) {
jit_ldxi_p(JIT_R2, JIT_V1, &((Scheme_Native_Closure *)0x0)->code);
jit_ldxi_i(JIT_R2, JIT_R2, &((Scheme_Native_Closure_Data *)0x0)->max_let_depth);
jit_ldxi_i(JIT_R2, JIT_R2, &((Scheme_Native_Lambda *)0x0)->max_let_depth);
}
mz_tl_ldi_p(JIT_R1, tl_MZ_RUNSTACK_START);
jit_subr_ul(JIT_R1, JIT_RUNSTACK, JIT_R1);
@ -947,9 +947,9 @@ int scheme_generate_non_tail_call(mz_jit_state *jitter, int num_rands, int direc
if (!nontail_self) {
jit_ldxi_p(JIT_V1, JIT_R0, &((Scheme_Native_Closure *)0x0)->code);
if (direct_native) {
jit_ldxi_p(JIT_V1, JIT_V1, &((Scheme_Native_Closure_Data *)0x0)->u.tail_code);
jit_ldxi_p(JIT_V1, JIT_V1, &((Scheme_Native_Lambda *)0x0)->u.tail_code);
} else {
jit_ldxi_p(JIT_V1, JIT_V1, &((Scheme_Native_Closure_Data *)0x0)->arity_code);
jit_ldxi_p(JIT_V1, JIT_V1, &((Scheme_Native_Lambda *)0x0)->arity_code);
if (need_set_rs) {
/* In case arity check fails, need to update runstack now: */
JIT_UPDATE_THREAD_RSPTR();
@ -1174,7 +1174,7 @@ int scheme_generate_non_tail_call(mz_jit_state *jitter, int num_rands, int direc
}
#ifdef USE_FLONUM_UNBOXING
static int generate_argument_boxing(mz_jit_state *jitter, Scheme_Closure_Data *data,
static int generate_argument_boxing(mz_jit_state *jitter, Scheme_Lambda *lam,
int num_rands, int args_already_in_place,
int offset, int direct_flostack_offset,
int save_reg,
@ -1187,8 +1187,8 @@ static int generate_argument_boxing(mz_jit_state *jitter, Scheme_Closure_Data *d
arg_tmp_offset = offset - direct_flostack_offset;
for (i = num_rands; i--; ) {
int extfl;
extfl = CLOSURE_ARGUMENT_IS_EXTFLONUM(data, i + args_already_in_place);
if (extfl || CLOSURE_ARGUMENT_IS_FLONUM(data, i + args_already_in_place)) {
extfl = CLOSURE_ARGUMENT_IS_EXTFLONUM(lam, i + args_already_in_place);
if (extfl || CLOSURE_ARGUMENT_IS_FLONUM(lam, i + args_already_in_place)) {
rand = (alt_rands
? alt_rands[i+1+args_already_in_place]
: (app
@ -1299,11 +1299,11 @@ static int generate_self_tail_call(Scheme_Object *rator, mz_jit_state *jitter, i
int already_loaded = (i == num_rands - 1);
#ifdef USE_FLONUM_UNBOXING
int is_flonum, already_unboxed = 0, extfl = 0;
if ((SCHEME_CLOSURE_DATA_FLAGS(jitter->self_data) & CLOS_HAS_TYPED_ARGS)
&& (CLOSURE_ARGUMENT_IS_FLONUM(jitter->self_data, i + args_already_in_place)
|| CLOSURE_ARGUMENT_IS_EXTFLONUM(jitter->self_data, i + args_already_in_place))) {
if ((SCHEME_LAMBDA_FLAGS(jitter->self_lam) & LAMBDA_HAS_TYPED_ARGS)
&& (CLOSURE_ARGUMENT_IS_FLONUM(jitter->self_lam, i + args_already_in_place)
|| CLOSURE_ARGUMENT_IS_EXTFLONUM(jitter->self_lam, i + args_already_in_place))) {
is_flonum = 1;
extfl = CLOSURE_ARGUMENT_IS_EXTFLONUM(jitter->self_data, i + args_already_in_place);
extfl = CLOSURE_ARGUMENT_IS_EXTFLONUM(jitter->self_lam, i + args_already_in_place);
rand = (alt_rands
? alt_rands[i+1+args_already_in_place]
: app->args[i+1+args_already_in_place]);
@ -1357,8 +1357,8 @@ static int generate_self_tail_call(Scheme_Object *rator, mz_jit_state *jitter, i
#ifdef USE_FLONUM_UNBOXING
/* Need to box any arguments that we have only in flonum form */
if (SCHEME_CLOSURE_DATA_FLAGS(jitter->self_data) & CLOS_HAS_TYPED_ARGS) {
generate_argument_boxing(jitter, jitter->self_data,
if (SCHEME_LAMBDA_FLAGS(jitter->self_lam) & LAMBDA_HAS_TYPED_ARGS) {
generate_argument_boxing(jitter, jitter->self_lam,
num_rands, args_already_in_place,
offset, direct_flostack_offset,
JIT_R0,
@ -1367,21 +1367,21 @@ static int generate_self_tail_call(Scheme_Object *rator, mz_jit_state *jitter, i
/* Arguments already in place may also need to be boxed. */
arg_tmp_offset = jitter->self_restart_offset;
for (i = jitter->self_data->closure_size; i--; ) {
for (i = jitter->self_lam->closure_size; i--; ) {
/* Skip over flonums unpacked from the closure. I think this never
happens, because I think that a self-call with already-in-place
flonum arguments will only happen when the closure is empty. */
if (CLOSURE_CONTENT_IS_FLONUM(jitter->self_data, i))
if (CLOSURE_CONTENT_IS_FLONUM(jitter->self_lam, i))
arg_tmp_offset -= sizeof(double);
else if (CLOSURE_CONTENT_IS_EXTFLONUM(jitter->self_data, i))
else if (CLOSURE_CONTENT_IS_EXTFLONUM(jitter->self_lam, i))
arg_tmp_offset -= 2*sizeof(double);
}
for (i = 0; i < args_already_in_place; i++) {
if (CLOSURE_ARGUMENT_IS_FLONUM(jitter->self_data, i)
|| CLOSURE_ARGUMENT_IS_EXTFLONUM(jitter->self_data, i)) {
if (CLOSURE_ARGUMENT_IS_FLONUM(jitter->self_lam, i)
|| CLOSURE_ARGUMENT_IS_EXTFLONUM(jitter->self_lam, i)) {
GC_CAN_IGNORE jit_insn *iref;
int extfl USED_ONLY_IF_LONG_DOUBLE;
extfl = CLOSURE_ARGUMENT_IS_EXTFLONUM(jitter->self_data, i);
extfl = CLOSURE_ARGUMENT_IS_EXTFLONUM(jitter->self_lam, i);
mz_pushr_p(JIT_R0);
mz_ld_runstack_base_alt(JIT_R2);
jit_subi_p(JIT_R2, JIT_RUNSTACK_BASE_OR_ALT(JIT_R2), WORDS_TO_BYTES(num_rands + args_already_in_place));
@ -1717,7 +1717,7 @@ static int generate_fp_argument_shift(int direct_flostack_offset, mz_jit_state *
static int generate_call_path_with_unboxes(mz_jit_state *jitter, int direct_flostack_offset, void *unboxed_code,
GC_CAN_IGNORE jit_insn **_refdone,
int num_rands, Scheme_Closure_Data *direct_data, Scheme_Object *rator)
int num_rands, Scheme_Lambda *direct_lam, Scheme_Object *rator)
{
GC_CAN_IGNORE jit_insn *refdone, *refgo, *refcopy;
int i, k, offset;
@ -1753,11 +1753,11 @@ static int generate_call_path_with_unboxes(mz_jit_state *jitter, int direct_flos
/* box arguments for slow path */
for (i = 0, k = 0; i < num_rands; i++) {
if ((SCHEME_CLOSURE_DATA_FLAGS(direct_data) & CLOS_HAS_TYPED_ARGS)
&& (CLOSURE_ARGUMENT_IS_FLONUM(direct_data, i)
|| CLOSURE_ARGUMENT_IS_EXTFLONUM(direct_data, i))) {
if ((SCHEME_LAMBDA_FLAGS(direct_lam) & LAMBDA_HAS_TYPED_ARGS)
&& (CLOSURE_ARGUMENT_IS_FLONUM(direct_lam, i)
|| CLOSURE_ARGUMENT_IS_EXTFLONUM(direct_lam, i))) {
int extfl;
extfl = CLOSURE_ARGUMENT_IS_EXTFLONUM(direct_data, i);
extfl = CLOSURE_ARGUMENT_IS_EXTFLONUM(direct_lam, i);
offset = jitter->flostack_offset - k;
offset = JIT_FRAME_FLOSTACK_OFFSET - offset;
@ -1788,7 +1788,7 @@ int scheme_generate_app(Scheme_App_Rec *app, Scheme_Object **alt_rands, int num_
Scheme_Native_Closure *inline_direct_native = NULL;
int almost_inline_direct_native = 0;
#ifdef USE_FLONUM_UNBOXING
Scheme_Closure_Data *direct_data = NULL;
Scheme_Lambda *direct_lam = NULL;
#endif
int direct_flostack_offset = 0, unboxed_non_tail_args = 0;
jit_direct_arg *inline_direct_args = NULL;
@ -1812,7 +1812,7 @@ int scheme_generate_app(Scheme_App_Rec *app, Scheme_Object **alt_rands, int num_
&& (scheme_is_noncm(rator, jitter, 0, 0)
|| is_noncm_hash_ref(rator, num_rands, app)
/* It's also ok to directly call `values' if multiple values are ok: */
|| (multi_ok && SAME_OBJ(rator, scheme_values_func))))
|| (multi_ok && SAME_OBJ(rator, scheme_values_proc))))
direct_prim = 1;
else {
reorder_ok = 1;
@ -1880,13 +1880,13 @@ int scheme_generate_app(Scheme_App_Rec *app, Scheme_Object **alt_rands, int num_
direct_native = can_direct_native(rator, num_rands, &extract_case);
reorder_ok = 1;
} else if (SAME_TYPE(t, scheme_closure_type)) {
Scheme_Closure_Data *data;
data = ((Scheme_Closure *)rator)->code;
if ((data->num_params == num_rands)
&& !(SCHEME_CLOSURE_DATA_FLAGS(data) & CLOS_HAS_REST)) {
Scheme_Lambda *lam;
lam = ((Scheme_Closure *)rator)->code;
if ((lam->num_params == num_rands)
&& !(SCHEME_LAMBDA_FLAGS(lam) & LAMBDA_HAS_REST)) {
direct_native = 1;
if (SAME_OBJ(data->u.jit_clone, jitter->self_data)
if (SAME_OBJ(lam->u.jit_clone, jitter->self_lam)
&& (num_rands < MAX_SHARED_CALL_RANDS)) {
if (is_tail)
direct_self = 1;
@ -1903,7 +1903,7 @@ int scheme_generate_app(Scheme_App_Rec *app, Scheme_Object **alt_rands, int num_
for this function --- only works if we can JIT the target
of the call. */
Scheme_Native_Closure *nc;
nc = (Scheme_Native_Closure *)scheme_jit_closure((Scheme_Object *)data, NULL);
nc = (Scheme_Native_Closure *)scheme_jit_closure((Scheme_Object *)lam, NULL);
if (nc->code->start_code == scheme_on_demand_jit_code) {
if (nc->code->arity_code != sjc.in_progress_on_demand_jit_arity_code) {
scheme_on_demand_generate_lambda(nc, 0, NULL, 0);
@ -1916,12 +1916,12 @@ int scheme_generate_app(Scheme_App_Rec *app, Scheme_Object **alt_rands, int num_
jitter->max_tail_depth = nc->code->max_let_depth;
inline_direct_native = nc;
#ifdef USE_FLONUM_UNBOXING
direct_data = data;
direct_lam = lam;
#endif
} else {
if (num_rands < MAX_SHARED_CALL_RANDS) {
#ifdef USE_FLONUM_UNBOXING
direct_data = data;
direct_lam = lam;
#endif
unboxed_non_tail_args = 1;
}
@ -1932,7 +1932,7 @@ int scheme_generate_app(Scheme_App_Rec *app, Scheme_Object **alt_rands, int num_
and a runstack-space check, but we can still handle unboxed
arguments. */
#ifdef USE_FLONUM_UNBOXING
direct_data = data;
direct_lam = lam;
#endif
almost_inline_direct_native = 1;
}
@ -1962,8 +1962,8 @@ int scheme_generate_app(Scheme_App_Rec *app, Scheme_Object **alt_rands, int num_
/* Direct native tail with same number of args as just received? */
if (direct_native && is_tail && num_rands && !almost_inline_direct_native
&& (num_rands == jitter->self_data->num_params)
&& !(SCHEME_CLOSURE_DATA_FLAGS(jitter->self_data) & CLOS_HAS_REST)) {
&& (num_rands == jitter->self_lam->num_params)
&& !(SCHEME_LAMBDA_FLAGS(jitter->self_lam) & LAMBDA_HAS_REST)) {
/* Check whether the actual arguments refer to Scheme-stack
locations that will be filled with argument values; that
is, check how many arguments are already in place for
@ -2078,22 +2078,22 @@ int scheme_generate_app(Scheme_App_Rec *app, Scheme_Object **alt_rands, int num_
#ifdef USE_FLONUM_UNBOXING
if (direct_self && is_tail)
direct_data = jitter->self_data;
direct_lam = jitter->self_lam;
#endif
#ifdef JIT_PRECISE_GC
FOR_LOG(if (direct_data) { LOG_IT((" [typed]\n")); } )
FOR_LOG(if (direct_lam) { LOG_IT((" [typed]\n")); } )
#endif
#ifdef USE_FLONUM_UNBOXING
/* we want to push flonums into local storage in reverse order
of evaluation, so make a pass to create space: */
if (direct_data
&& (SCHEME_CLOSURE_DATA_FLAGS(direct_data) & CLOS_HAS_TYPED_ARGS)) {
if (direct_lam
&& (SCHEME_LAMBDA_FLAGS(direct_lam) & LAMBDA_HAS_TYPED_ARGS)) {
for (i = num_rands; i--; ) {
int extfl;
extfl = CLOSURE_ARGUMENT_IS_EXTFLONUM(direct_data, i+args_already_in_place);
if (extfl || CLOSURE_ARGUMENT_IS_FLONUM(direct_data, i+args_already_in_place)) {
extfl = CLOSURE_ARGUMENT_IS_EXTFLONUM(direct_lam, i+args_already_in_place);
if (extfl || CLOSURE_ARGUMENT_IS_FLONUM(direct_lam, i+args_already_in_place)) {
/* make space: */
scheme_generate_flonum_local_unboxing(jitter, 0, 1, extfl);
CHECK_LIMIT();
@ -2113,13 +2113,13 @@ int scheme_generate_app(Scheme_App_Rec *app, Scheme_Object **alt_rands, int num_
need_safety = 0;
}
#ifdef USE_FLONUM_UNBOXING
if (direct_data
&& (SCHEME_CLOSURE_DATA_FLAGS(direct_data) & CLOS_HAS_TYPED_ARGS)
&& (CLOSURE_ARGUMENT_IS_FLONUM(direct_data, i+args_already_in_place)
|| CLOSURE_ARGUMENT_IS_EXTFLONUM(direct_data, i+args_already_in_place))) {
if (direct_lam
&& (SCHEME_LAMBDA_FLAGS(direct_lam) & LAMBDA_HAS_TYPED_ARGS)
&& (CLOSURE_ARGUMENT_IS_FLONUM(direct_lam, i+args_already_in_place)
|| CLOSURE_ARGUMENT_IS_EXTFLONUM(direct_lam, i+args_already_in_place))) {
int directly;
int extfl;
extfl = CLOSURE_ARGUMENT_IS_EXTFLONUM(direct_data, i+args_already_in_place);
extfl = CLOSURE_ARGUMENT_IS_EXTFLONUM(direct_lam, i+args_already_in_place);
jitter->unbox++;
MZ_FPUSEL_STMT_ONLY(extfl, jitter->unbox_extflonum++);
if (scheme_can_unbox_inline(arg, 5, JIT_FPUSEL_FPR_NUM(extfl)-1, 0, extfl))
@ -2284,7 +2284,7 @@ int scheme_generate_app(Scheme_App_Rec *app, Scheme_Object **alt_rands, int num_
scheme_generate_tail_call(jitter, num_rands, direct_native, jitter->need_set_rs, 1,
inline_direct_native, inline_direct_args,
#ifdef USE_FLONUM_UNBOXING
almost_inline_direct_native ? direct_data : NULL
almost_inline_direct_native ? direct_lam : NULL
#else
NULL
#endif
@ -2355,7 +2355,7 @@ int scheme_generate_app(Scheme_App_Rec *app, Scheme_Object **alt_rands, int num_
#ifdef USE_FLONUM_UNBOXING
if (unboxed_code) {
generate_call_path_with_unboxes(jitter, direct_flostack_offset, unboxed_code, &refdone,
num_rands, direct_data, rator);
num_rands, direct_lam, rator);
CHECK_LIMIT();
}
#endif

20
racket/src/racket/src/jitcommon.c
View File

@ -218,7 +218,7 @@ static int common0(mz_jit_state *jitter, void *_data)
mz_push_threadlocal(in);
jit_movi_i(JIT_R1, -1);
jit_ldxi_p(JIT_V1, JIT_R0, &((Scheme_Native_Closure *)0x0)->code);
jit_ldxi_p(JIT_V1, JIT_V1, &((Scheme_Native_Closure_Data *)0x0)->arity_code);
jit_ldxi_p(JIT_V1, JIT_V1, &((Scheme_Native_Lambda *)0x0)->arity_code);
jit_jmpr(JIT_V1); /* leads to a jit_ret() that assumes NATIVE_ARG_COUNT arguments */
CHECK_LIMIT();
@ -238,7 +238,7 @@ static int common0(mz_jit_state *jitter, void *_data)
jit_movi_i(JIT_R1, -1);
(void)jit_movi_p(JIT_R2, 0x0);
jit_ldxi_p(JIT_V1, JIT_R0, &((Scheme_Native_Closure *)0x0)->code);
jit_ldxi_p(JIT_V1, JIT_V1, &((Scheme_Native_Closure_Data *)0x0)->arity_code);
jit_ldxi_p(JIT_V1, JIT_V1, &((Scheme_Native_Lambda *)0x0)->arity_code);
jit_jmpr(JIT_V1); /* leads to a jit_ret() that assumes NATIVE_ARG_COUNT arguments */
CHECK_LIMIT();
@ -806,7 +806,7 @@ static int common2(mz_jit_state *jitter, void *_data)
/* Also, check that the runstack is big enough with the revised
max_let_depth. */
jit_ldxi_p(JIT_V1, JIT_R0, &((Scheme_Native_Closure *)0x0)->code);
jit_ldxi_i(JIT_V1, JIT_V1, &((Scheme_Native_Closure_Data *)0x0)->max_let_depth);
jit_ldxi_i(JIT_V1, JIT_V1, &((Scheme_Native_Lambda *)0x0)->max_let_depth);
mz_set_local_p(JIT_R2, JIT_LOCAL2);
mz_tl_ldi_p(JIT_R2, tl_MZ_RUNSTACK_START);
jit_subr_ul(JIT_R2, JIT_RUNSTACK, JIT_R2);
@ -822,7 +822,7 @@ static int common2(mz_jit_state *jitter, void *_data)
mz_st_runstack_base_alt(JIT_V1);
/* Extract function and jump: */
jit_ldxi_p(JIT_V1, JIT_R0, &((Scheme_Native_Closure *)0x0)->code);
jit_ldxi_p(JIT_V1, JIT_V1, &((Scheme_Native_Closure_Data *)0x0)->arity_code);
jit_ldxi_p(JIT_V1, JIT_V1, &((Scheme_Native_Lambda *)0x0)->arity_code);
jit_jmpr(JIT_V1);
CHECK_LIMIT();
/* Slower path (non-tail) when argv != runstack. */
@ -3173,9 +3173,9 @@ static int common10(mz_jit_state *jitter, void *_data)
/* native: */
mz_patch_branch(ref_nc);
jit_ldxi_p(JIT_V1, JIT_R0, &((Scheme_Native_Closure *)0x0)->code);
jit_ldxi_i(JIT_R2, JIT_V1, &((Scheme_Native_Closure_Data *)0x0)->closure_size);
jit_ldxi_i(JIT_R2, JIT_V1, &((Scheme_Native_Lambda *)0x0)->closure_size);
(void)jit_blti_i(refslow, JIT_R2, 0); /* case lambda */
jit_ldxi_p(JIT_R2, JIT_V1, &((Scheme_Native_Closure_Data *)0x0)->start_code);
jit_ldxi_p(JIT_R2, JIT_V1, &((Scheme_Native_Lambda *)0x0)->start_code);
/* patchable_movi_p doesn't depend on actual address, which might change size: */
(void)jit_patchable_movi_p(JIT_V1, scheme_on_demand_jit_code);
ref_nc = jit_beqr_p(jit_forward(), JIT_R2, JIT_V1); /* not yet JITted? */
@ -3196,11 +3196,11 @@ static int common10(mz_jit_state *jitter, void *_data)
/* not-yet-JITted native: */
mz_patch_branch(ref_nc);
jit_ldxi_p(JIT_V1, JIT_R0, &((Scheme_Native_Closure *)0x0)->code);
jit_ldxi_p(JIT_R0, JIT_V1, &((Scheme_Native_Closure_Data *)0x0)->u2.orig_code);
jit_ldxi_p(JIT_R0, JIT_V1, &((Scheme_Native_Lambda *)0x0)->u2.orig_code);
jit_rshi_l(JIT_V1, JIT_R1, 1);
jit_ldxi_i(JIT_R2, JIT_R0, &((Scheme_Closure_Data *)0x0)->num_params);
jit_ldxi_s(JIT_R0, JIT_R0, &SCHEME_CLOSURE_DATA_FLAGS(((Scheme_Closure_Data *)0x0)));
ref_nc = jit_bmsi_i(jit_forward(), JIT_R0, CLOS_HAS_REST);
jit_ldxi_i(JIT_R2, JIT_R0, &((Scheme_Lambda *)0x0)->num_params);
jit_ldxi_s(JIT_R0, JIT_R0, &SCHEME_LAMBDA_FLAGS(((Scheme_Lambda *)0x0)));
ref_nc = jit_bmsi_i(jit_forward(), JIT_R0, LAMBDA_HAS_REST);
(void)jit_bner_i(refno, JIT_V1, JIT_R2);
(void)jit_movi_p(JIT_R0, scheme_true);
mz_epilog(JIT_R2);

30
racket/src/racket/src/jitprep.c
View File

@ -302,11 +302,11 @@ static Scheme_Object *define_values_jit(Scheme_Object *data)
{
Scheme_Object *orig = SCHEME_VEC_ELS(data)[0], *naya;
if (SAME_TYPE(SCHEME_TYPE(orig), scheme_unclosed_procedure_type)
if (SAME_TYPE(SCHEME_TYPE(orig), scheme_lambda_type)
&& (SCHEME_VEC_SIZE(data) == 2))
naya = scheme_jit_closure(orig, SCHEME_VEC_ELS(data)[1]);
else if (SAME_TYPE(SCHEME_TYPE(orig), scheme_inline_variant_type)
&& SAME_TYPE(SCHEME_TYPE(SCHEME_VEC_ELS(orig)[0]), scheme_unclosed_procedure_type)
&& SAME_TYPE(SCHEME_TYPE(SCHEME_VEC_ELS(orig)[0]), scheme_lambda_type)
&& (SCHEME_VEC_SIZE(data) == 2)) {
naya = scheme_jit_closure(SCHEME_VEC_ELS(orig)[0], SCHEME_VEC_ELS(data)[1]);
if (!SAME_OBJ(naya, SCHEME_VEC_ELS(orig)[0]))
@ -409,7 +409,7 @@ Scheme_Object *scheme_case_lambda_jit(Scheme_Object *expr)
if (!seqin->native_code) {
Scheme_Case_Lambda *seqout;
Scheme_Native_Closure_Data *ndata;
Scheme_Native_Lambda *ndata;
Scheme_Object *val, *name;
int i, cnt, size, all_closed = 1;
@ -431,8 +431,8 @@ Scheme_Object *scheme_case_lambda_jit(Scheme_Object *expr)
val = (Scheme_Object *)((Scheme_Closure *)val)->code;
seqout->array[i] = val;
}
((Scheme_Closure_Data *)val)->name = name;
if (((Scheme_Closure_Data *)val)->closure_size)
((Scheme_Lambda *)val)->name = name;
if (((Scheme_Lambda *)val)->closure_size)
all_closed = 0;
}
@ -448,7 +448,7 @@ Scheme_Object *scheme_case_lambda_jit(Scheme_Object *expr)
for (i = 0; i < cnt; i++) {
val = seqout->array[i];
if (!SCHEME_PROCP(val)) {
val = scheme_make_native_closure(((Scheme_Closure_Data *)val)->u.native_code);
val = scheme_make_native_closure(((Scheme_Lambda *)val)->u.native_code);
}
nc->vals[i] = val;
}
@ -461,10 +461,10 @@ Scheme_Object *scheme_case_lambda_jit(Scheme_Object *expr)
for (i = 0; i < cnt; i++) {
val = seqout->array[i];
if (!SCHEME_PROCP(val)) {
Scheme_Closure_Data *data;
data = MALLOC_ONE_TAGGED(Scheme_Closure_Data);
memcpy(data, val, sizeof(Scheme_Closure_Data));
data->code = NULL;
Scheme_Lambda *data;
data = MALLOC_ONE_TAGGED(Scheme_Lambda);
memcpy(data, val, sizeof(Scheme_Lambda));
data->body = NULL;
seqout->array[i] = (Scheme_Object *)data;
}
}
@ -548,7 +548,7 @@ Scheme_Object *scheme_jit_closure(Scheme_Object *code, Scheme_Object *context)
for JIT compilation. */
{
#ifdef MZ_USE_JIT
Scheme_Closure_Data *data = (Scheme_Closure_Data *)code, *data2;
Scheme_Lambda *data = (Scheme_Lambda *)code, *data2;
/* We need to cache clones to support multiple references
to a zero-sized closure in bytecode. We need either a clone
@ -561,10 +561,10 @@ Scheme_Object *scheme_jit_closure(Scheme_Object *code, Scheme_Object *context)
data2 = NULL;
if (!data2) {
Scheme_Native_Closure_Data *ndata;
Scheme_Native_Lambda *ndata;
data2 = MALLOC_ONE_TAGGED(Scheme_Closure_Data);
memcpy(data2, code, sizeof(Scheme_Closure_Data));
data2 = MALLOC_ONE_TAGGED(Scheme_Lambda);
memcpy(data2, code, sizeof(Scheme_Lambda));
data2->context = context;
@ -607,7 +607,7 @@ Scheme_Object *scheme_jit_expr(Scheme_Object *expr)
return jit_branch(expr);
case scheme_with_cont_mark_type:
return jit_wcm(expr);
case scheme_unclosed_procedure_type:
case scheme_lambda_type:
return scheme_jit_closure(expr, NULL);
case scheme_let_value_type:
return jit_let_value(expr);

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

@ -676,7 +676,7 @@ void scheme_jit_now(Scheme_Object *f)
{
if (SAME_TYPE(SCHEME_TYPE(f), scheme_native_closure_type)) {
Scheme_Native_Closure *nc;
Scheme_Native_Closure_Data *ncd;
Scheme_Native_Lambda *ncd;
nc = (Scheme_Native_Closure*)f;
ncd = nc->code;

4
racket/src/racket/src/jitstate.c
View File

@ -58,7 +58,7 @@ int scheme_mz_retain_it(mz_jit_state *jitter, void *v)
jitter->retain_start[jitter->retained] = v;
#ifdef JIT_PRECISE_GC
/* We just change an array that is marked indirectly for GC
via a Scheme_Native_Closure_Data. Write to that record
via a Scheme_Native_Lambda. Write to that record
so that a minor GC will trace it and therefore trace
the reatined array: */
if (jitter->retaining_data) {
@ -180,7 +180,7 @@ void *scheme_generate_one(mz_jit_state *old_jitter,
void *data,
int gcable,
void *save_ptr,
Scheme_Native_Closure_Data *ndata)
Scheme_Native_Lambda *ndata)
/* The given generate() function is called at least twice: once to gather
the size of the generated code (at a temporary location), and again
to generate the final code at its final location. The size of the

180
racket/src/racket/src/letrec_check.c
View File

@ -158,7 +158,7 @@ typedef struct Scheme_Deferred_Expr {
int done;
/* the expression that has been deferred */
Scheme_Closure_Data *expr;
Scheme_Lambda *expr;
/* the frame that existed when the expr was deferred */
Letrec_Check_Frame *frame;
@ -175,8 +175,8 @@ static Letrec_Check_Frame *init_letrec_check_frame(int frame_type, int subexpr,
mzshort count,
Letrec_Check_Frame *prev,
Letrec_Check_Frame *share_with,
Scheme_Let_Header *head,
Scheme_Closure_Data *data)
Scheme_IR_Let_Header *head,
Scheme_Lambda *lam)
{
Scheme_Deferred_Expr **chain;
Letrec_Check_Frame *frame;
@ -194,20 +194,20 @@ static Letrec_Check_Frame *init_letrec_check_frame(int frame_type, int subexpr,
frame->next = prev;
if (head) {
Scheme_Compiled_Let_Value *clv = (Scheme_Compiled_Let_Value *)head->body;
Scheme_IR_Let_Value *irlv = (Scheme_IR_Let_Value *)head->body;
pos = 0;
for (i = head->num_clauses; i--; clv = (Scheme_Compiled_Let_Value *)clv->body) {
for (j = 0; j < clv->count; j++) {
clv->vars[j]->mode = SCHEME_VAR_MODE_LETREC_CHECK;
clv->vars[j]->letrec_check.frame = frame;
clv->vars[j]->letrec_check.frame_pos = pos++;
for (i = head->num_clauses; i--; irlv = (Scheme_IR_Let_Value *)irlv->body) {
for (j = 0; j < irlv->count; j++) {
irlv->vars[j]->mode = SCHEME_VAR_MODE_LETREC_CHECK;
irlv->vars[j]->letrec_check.frame = frame;
irlv->vars[j]->letrec_check.frame_pos = pos++;
}
}
} else if (data) {
for (j = data->num_params; j--; ) {
((Closure_Info *)data->closure_map)->vars[j]->mode = SCHEME_VAR_MODE_LETREC_CHECK;
((Closure_Info *)data->closure_map)->vars[j]->letrec_check.frame = frame;
((Closure_Info *)data->closure_map)->vars[j]->letrec_check.frame_pos = j;
} else if (lam) {
for (j = lam->num_params; j--; ) {
lam->ir_info->vars[j]->mode = SCHEME_VAR_MODE_LETREC_CHECK;
lam->ir_info->vars[j]->letrec_check.frame = frame;
lam->ir_info->vars[j]->letrec_check.frame_pos = j;
}
}
@ -270,7 +270,7 @@ static Letrec_Check_Frame *get_nearest_rhs(Letrec_Check_Frame *frame)
/* returns the frame that was created when pos was created, and
changes pos to be relative to that frame */
static Letrec_Check_Frame *get_relative_frame(int *pos, Scheme_Compiled_Local *var)
static Letrec_Check_Frame *get_relative_frame(int *pos, Scheme_IR_Local *var)
{
*pos = var->letrec_check.frame_pos;
return var->letrec_check.frame;
@ -294,7 +294,7 @@ static void update_frame(Letrec_Check_Frame *outer, Letrec_Check_Frame *inner,
}
/* creates a deferred expression "closure" by closing over the frame */
static Scheme_Deferred_Expr *make_deferred_expr_closure(Scheme_Closure_Data *expr, Letrec_Check_Frame *frame)
static Scheme_Deferred_Expr *make_deferred_expr_closure(Scheme_Lambda *expr, Letrec_Check_Frame *frame)
{
Scheme_Deferred_Expr *clos;
@ -312,9 +312,9 @@ static Scheme_Deferred_Expr *make_deferred_expr_closure(Scheme_Closure_Data *exp
static Scheme_Object *letrec_check_expr(Scheme_Object *, Letrec_Check_Frame *, Scheme_Object *);
static void letrec_check_lets_resume(Letrec_Check_Frame *frame, Scheme_Let_Header *head)
static void letrec_check_lets_resume(Letrec_Check_Frame *frame, Scheme_IR_Let_Header *head)
{
Scheme_Compiled_Let_Value *clv;
Scheme_IR_Let_Value *irlv;
Scheme_Object *body;
int i, j, k;
int was_checked;
@ -327,20 +327,20 @@ static void letrec_check_lets_resume(Letrec_Check_Frame *frame, Scheme_Let_Heade
variable is not used in application position */
k = head->count;
for (i = head->num_clauses; i--;) {
clv = (Scheme_Compiled_Let_Value *) body;
k -= clv->count;
for (j = 0; j < clv->count; j++) {
irlv = (Scheme_IR_Let_Value *) body;
k -= irlv->count;
for (j = 0; j < irlv->count; j++) {
was_checked = (frame->ref[k + j] & LET_CHECKED);
if (was_checked)
clv->vars[j]->non_app_count = clv->vars[j]->use_count;
irlv->vars[j]->non_app_count = irlv->vars[j]->use_count;
}
body = clv->body;
body = irlv->body;
}
}
}
/* records that we have seen a reference to loc */
static Scheme_Object *record_checked(Scheme_Compiled_Local *loc, Letrec_Check_Frame *frame)
static Scheme_Object *record_checked(Scheme_IR_Local *loc, Letrec_Check_Frame *frame)
{
int position;
@ -354,7 +354,7 @@ static Scheme_Object *letrec_check_local(Scheme_Object *o, Letrec_Check_Frame *f
Scheme_Object *pos)
{
Letrec_Check_Frame *in_frame;
Scheme_Compiled_Local *loc = (Scheme_Compiled_Local *)o;
Scheme_IR_Local *loc = (Scheme_IR_Local *)o;
int in_position;
in_frame = get_relative_frame(&in_position, loc);
@ -555,26 +555,26 @@ static Scheme_Object *letrec_check_wcm(Scheme_Object *o, Letrec_Check_Frame *fra
return o;
}
static Scheme_Object *letrec_check_closure_compilation(Scheme_Object *o, Letrec_Check_Frame *frame, Scheme_Object *pos)
static Scheme_Object *letrec_check_lambda(Scheme_Object *o, Letrec_Check_Frame *frame, Scheme_Object *pos)
{
Scheme_Closure_Data *data;
Scheme_Lambda *lam;
Letrec_Check_Frame *new_frame;
Scheme_Object *val;
int num_params;
data = (Scheme_Closure_Data *)o;
lam = (Scheme_Lambda *)o;
/* if we have not entered a letrec, pos will be false */
if (SCHEME_FALSEP(pos)) {
num_params = data->num_params;
num_params = lam->num_params;
new_frame = init_letrec_check_frame(FRAME_TYPE_CLOSURE, LET_BODY_EXPR,
num_params, frame, NULL,
NULL, data);
NULL, lam);
SCHEME_ASSERT(num_params >= 0, "lambda has negative arguments what do");
val = letrec_check_expr(data->code, new_frame, pos);
data->code = val;
val = letrec_check_expr(lam->body, new_frame, pos);
lam->body = val;
} else {
/* we can defer this lambda because it is not inside an
application! hurray! */
@ -588,7 +588,7 @@ static Scheme_Object *letrec_check_closure_compilation(Scheme_Object *o, Letrec_
appeared in, and update the frame where the binding lives
(which may be an enclosing frame) */
outer_frame = get_nearest_rhs(frame);
clos = make_deferred_expr_closure(data, frame);
clos = make_deferred_expr_closure(lam, frame);
while (SCHEME_INTP(pos) || SCHEME_PAIRP(pos)) {
int position;
@ -614,12 +614,12 @@ static Scheme_Object *letrec_check_closure_compilation(Scheme_Object *o, Letrec_
static void letrec_check_deferred_expr(Scheme_Object *o)
{
Scheme_Deferred_Expr *clos;
Scheme_Closure_Data *data;
Scheme_Lambda *lam;
Letrec_Check_Frame *inner, *new_frame;
Scheme_Object *val;
int num_params;
/* gets the closed over data from clos, which will always be a
/* gets the closed over lam from clos, which will always be a
deferred expression that contains a closure */
clos = (Scheme_Deferred_Expr *)o;
@ -630,25 +630,25 @@ static void letrec_check_deferred_expr(Scheme_Object *o)
SCHEME_ASSERT(SAME_TYPE(SCHEME_TYPE(clos), scheme_deferred_expr_type),
"letrec_check_deferred_expr: clos is not a scheme_deferred_expr");
data = (Scheme_Closure_Data *)clos->expr;
SCHEME_ASSERT(SAME_TYPE(SCHEME_TYPE(data), scheme_compiled_unclosed_procedure_type),
lam = (Scheme_Lambda *)clos->expr;
SCHEME_ASSERT(SAME_TYPE(SCHEME_TYPE(lam), scheme_ir_lambda_type),
"deferred expression does not contain a lambda");
inner = clos->frame;
num_params = data->num_params;
num_params = lam->num_params;
new_frame = init_letrec_check_frame(FRAME_TYPE_CLOSURE, LET_BODY_EXPR,
num_params, inner, NULL,
NULL, data);
NULL, lam);
val = letrec_check_expr(data->code, new_frame, scheme_false);
data->code = val;
val = letrec_check_expr(lam->body, new_frame, scheme_false);
lam->body = val;
}
static void clean_dead_deferred_expr(Scheme_Deferred_Expr *clos)
{
Scheme_Closure_Data *data;
Scheme_Lambda *lam;
/* We keep a global chain of all deferred expression. A deferred
expression that is never forced is a function that is never
@ -660,12 +660,12 @@ static void clean_dead_deferred_expr(Scheme_Deferred_Expr *clos)
"letrec_check_deferred_expr: clos is not a scheme_deferred_expr");
if (!clos->done) {
data = (Scheme_Closure_Data *)clos->expr;
SCHEME_ASSERT(SAME_TYPE(SCHEME_TYPE(data), scheme_compiled_unclosed_procedure_type),
lam = (Scheme_Lambda *)clos->expr;
SCHEME_ASSERT(SAME_TYPE(SCHEME_TYPE(lam), scheme_ir_lambda_type),
"deferred expression does not contain a lambda");
/* Since this deferral was never done, it's dead code. */
data->code = scheme_void;
lam->body = scheme_void;
clos->done = 1;
}
@ -692,14 +692,14 @@ static void process_deferred_bindings(Letrec_Check_Frame *frame, int position)
static Scheme_Object *letrec_check_lets(Scheme_Object *o, Letrec_Check_Frame *old_frame, Scheme_Object *pos)
{
Letrec_Check_Frame *frame, *body_frame;
Scheme_Compiled_Let_Value *clv;
Scheme_IR_Let_Value *irlv;
Scheme_Object *body, *val;
int i, j, k;
/* gets the information out of our header about the number of
total clauses, the number of total bindings, and whether or not
this let is recursive */
Scheme_Let_Header *head = (Scheme_Let_Header *)o;
Scheme_IR_Let_Header *head = (Scheme_IR_Let_Header *)o;
/* number of clauses in the let */
int num_clauses = head->num_clauses;
@ -731,12 +731,12 @@ static Scheme_Object *letrec_check_lets(Scheme_Object *o, Letrec_Check_Frame *ol
k = 0;
/* loops through every right hand side */
clv = NULL;
irlv = NULL;
for (i = num_clauses; i--;) {
clv = (Scheme_Compiled_Let_Value *)body;
irlv = (Scheme_IR_Let_Value *)body;
if (clv->count == 0) {
val = letrec_check_expr(clv->value, frame,
if (irlv->count == 0) {
val = letrec_check_expr(irlv->value, frame,
/* deferred closures get attached to no variables,
which is sensible because the closure will not
be reachable: */
@ -744,7 +744,7 @@ static Scheme_Object *letrec_check_lets(Scheme_Object *o, Letrec_Check_Frame *ol
} else {
Scheme_Object *new_pos;
if (clv->count == 1) {
if (irlv->count == 1) {
/* any deferred closure on the right-hand side gets attached to the
variable on the left-hand side: */
new_pos = scheme_make_integer(k);
@ -755,25 +755,25 @@ static Scheme_Object *letrec_check_lets(Scheme_Object *o, Letrec_Check_Frame *ol
variables in that case */
int sub;
new_pos = scheme_null;
for (sub = clv->count; sub--; ) {
for (sub = irlv->count; sub--; ) {
new_pos = scheme_make_pair(scheme_make_integer(k+sub), new_pos);
}
}
val = letrec_check_expr(clv->value, frame, new_pos);
val = letrec_check_expr(irlv->value, frame, new_pos);
}
if (frame_type == FRAME_TYPE_LETREC) {
for (j = 0; j < clv->count; j++) {
for (j = 0; j < irlv->count; j++) {
frame->ref[j + k] |= LET_READY;
}
}
k += clv->count;
k += irlv->count;
clv->value = val;
irlv->value = val;
body = clv->body;
body = irlv->body;
}
/* the body variant of the frame shares the `ref`, etc., arrays with
@ -790,7 +790,7 @@ static Scheme_Object *letrec_check_lets(Scheme_Object *o, Letrec_Check_Frame *ol
let had bindings, otherwise, the let header should point to the
new body */
if (num_clauses > 0)
clv->body = val;
irlv->body = val;
else
head->body = val;
@ -801,27 +801,27 @@ static Scheme_Object *letrec_check_lets(Scheme_Object *o, Letrec_Check_Frame *ol
/* note to future self: the length of define_values is sometimes 1,
and you definitely don't want to look inside if that's the case */
static Scheme_Object *letrec_check_define_values(Scheme_Object *data, Letrec_Check_Frame *frame, Scheme_Object *pos)
static Scheme_Object *letrec_check_define_values(Scheme_Object *lam, Letrec_Check_Frame *frame, Scheme_Object *pos)
{
if (SCHEME_VEC_SIZE(data) <= 1)
return data;
if (SCHEME_VEC_SIZE(lam) <= 1)
return lam;
else {
Scheme_Object *vars = SCHEME_VEC_ELS(data)[0];
Scheme_Object *val = SCHEME_VEC_ELS(data)[1];
Scheme_Object *vars = SCHEME_VEC_ELS(lam)[0];
Scheme_Object *val = SCHEME_VEC_ELS(lam)[1];
SCHEME_ASSERT(SCHEME_PAIRP(vars) || SCHEME_NULLP(vars),
"letrec_check_define_values: processing resolved code");
val = letrec_check_expr(val, frame, pos);
SCHEME_VEC_ELS(data)[1] = val;
SCHEME_VEC_ELS(lam)[1] = val;
}
return data;
return lam;
}
static Scheme_Object *letrec_check_ref(Scheme_Object *data, Letrec_Check_Frame *frame, Wrapped_Lhs *lhs)
static Scheme_Object *letrec_check_ref(Scheme_Object *lam, Letrec_Check_Frame *frame, Wrapped_Lhs *lhs)
{
return data;
return lam;
}
static Scheme_Object *letrec_check_set(Scheme_Object *o, Letrec_Check_Frame *frame, Scheme_Object *pos)
@ -839,12 +839,12 @@ static Scheme_Object *letrec_check_set(Scheme_Object *o, Letrec_Check_Frame *fra
val = letrec_check_expr(val, frame, rhs_pos);
sb->val = val;
if (SAME_TYPE(SCHEME_TYPE(sb->var), scheme_compiled_local_type)) {
if (SAME_TYPE(SCHEME_TYPE(sb->var), scheme_ir_local_type)) {
/* We may need to insert a definedness check before the assignment */
Letrec_Check_Frame *in_frame;
int position;
in_frame = get_relative_frame(&position, (Scheme_Compiled_Local *)sb->var);
in_frame = get_relative_frame(&position, (Scheme_IR_Local *)sb->var);
if (in_frame->ref
&& !(in_frame->ref[position] & LET_READY)) {
@ -853,7 +853,7 @@ static Scheme_Object *letrec_check_set(Scheme_Object *o, Letrec_Check_Frame *fra
Scheme_Object *name;
Scheme_Sequence *seq;
name = record_checked((Scheme_Compiled_Local *)sb->var, frame);
name = record_checked((Scheme_IR_Local *)sb->var, frame);
app3 = MALLOC_ONE_TAGGED(Scheme_App3_Rec);
app3->iso.so.type = scheme_application3_type;
@ -874,22 +874,22 @@ static Scheme_Object *letrec_check_set(Scheme_Object *o, Letrec_Check_Frame *fra
return o;
}
static Scheme_Object *letrec_check_define_syntaxes(Scheme_Object *data, Letrec_Check_Frame *frame, Scheme_Object *pos)
static Scheme_Object *letrec_check_define_syntaxes(Scheme_Object *lam, Letrec_Check_Frame *frame, Scheme_Object *pos)
{
Scheme_Object *val;
val = SCHEME_VEC_ELS(data)[3];
val = SCHEME_VEC_ELS(lam)[3];
val = letrec_check_expr(val, frame, pos);
SCHEME_VEC_ELS(data)[3] = val;
SCHEME_VEC_ELS(lam)[3] = val;
return data;
return lam;
}
static Scheme_Object *letrec_check_begin_for_syntax(Scheme_Object *data, Letrec_Check_Frame *frame, Scheme_Object *pos)
static Scheme_Object *letrec_check_begin_for_syntax(Scheme_Object *lam, Letrec_Check_Frame *frame, Scheme_Object *pos)
{
Scheme_Object *l, *a, *val;
l = SCHEME_VEC_ELS(data)[2];
l = SCHEME_VEC_ELS(lam)[2];
while (!SCHEME_NULLP(l)) {
a = SCHEME_CAR(l);
@ -898,7 +898,7 @@ static Scheme_Object *letrec_check_begin_for_syntax(Scheme_Object *data, Letrec_
l = SCHEME_CDR(l);
}
return data;
return lam;
}
static Scheme_Object *letrec_check_case_lambda(Scheme_Object *o, Letrec_Check_Frame *frame, Scheme_Object *pos)
@ -935,20 +935,20 @@ static Scheme_Object *letrec_check_begin0(Scheme_Object *o, Letrec_Check_Frame *
return o;
}
static Scheme_Object *letrec_check_apply_values(Scheme_Object *data, Letrec_Check_Frame *frame, Scheme_Object *pos)
static Scheme_Object *letrec_check_apply_values(Scheme_Object *lam, Letrec_Check_Frame *frame, Scheme_Object *pos)
{
Scheme_Object *f, *e;
f = SCHEME_PTR1_VAL(data);
e = SCHEME_PTR2_VAL(data);
f = SCHEME_PTR1_VAL(lam);
e = SCHEME_PTR2_VAL(lam);
f = letrec_check_expr(f, frame, pos);
e = letrec_check_expr(e, frame, pos);
SCHEME_PTR1_VAL(data) = f;
SCHEME_PTR2_VAL(data) = e;
SCHEME_PTR1_VAL(lam) = f;
SCHEME_PTR2_VAL(lam) = e;
return data;
return lam;
}
static Scheme_Object *letrec_check_module(Scheme_Object *o, Letrec_Check_Frame *frame, Scheme_Object *pos)
@ -1024,7 +1024,7 @@ static Scheme_Object *letrec_check_expr(Scheme_Object *expr, Letrec_Check_Frame
SCHEME_USE_FUEL(1);
switch (type) {
case scheme_compiled_local_type:
case scheme_ir_local_type:
return letrec_check_local(expr, frame, pos);
case scheme_application_type:
return letrec_check_application(expr, frame, pos);
@ -1039,13 +1039,13 @@ static Scheme_Object *letrec_check_expr(Scheme_Object *expr, Letrec_Check_Frame
return letrec_check_branch(expr, frame, pos);
case scheme_with_cont_mark_type:
return letrec_check_wcm(expr, frame, pos);
case scheme_compiled_unclosed_procedure_type:
return letrec_check_closure_compilation(expr, frame, pos);
case scheme_compiled_let_void_type:
case scheme_ir_lambda_type:
return letrec_check_lambda(expr, frame, pos);
case scheme_ir_let_void_type:
return letrec_check_lets(expr, frame, pos);
case scheme_compiled_toplevel_type: /* var ref to a top level */
case scheme_ir_toplevel_type: /* var ref to a top level */
return expr;
case scheme_compiled_quote_syntax_type:
case scheme_ir_quote_syntax_type:
return expr;
case scheme_variable_type:
case scheme_module_variable_type:

54
racket/src/racket/src/marshal.c
View File

@ -85,8 +85,8 @@ static Scheme_Object *read_local_unbox(Scheme_Object *obj);
static Scheme_Object *write_resolve_prefix(Scheme_Object *obj);
static Scheme_Object *read_resolve_prefix(Scheme_Object *obj);
static Scheme_Object *write_compiled_closure(Scheme_Object *obj);
static Scheme_Object *read_compiled_closure(Scheme_Object *obj);
static Scheme_Object *write_lambda(Scheme_Object *obj);
static Scheme_Object *read_lambda(Scheme_Object *obj);
static Scheme_Object *write_module(Scheme_Object *obj);
static Scheme_Object *read_module(Scheme_Object *obj);
@ -150,10 +150,8 @@ void scheme_init_marshal(Scheme_Env *env)
scheme_install_type_writer(scheme_compilation_top_type, write_top);
scheme_install_type_reader(scheme_compilation_top_type, read_top);
scheme_install_type_writer(scheme_unclosed_procedure_type,
write_compiled_closure);
scheme_install_type_reader(scheme_unclosed_procedure_type,
read_compiled_closure);
scheme_install_type_writer(scheme_lambda_type, write_lambda);
scheme_install_type_reader(scheme_lambda_type, read_lambda);
scheme_install_type_writer(scheme_toplevel_type, write_toplevel);
scheme_install_type_reader(scheme_toplevel_type, read_toplevel);
@ -397,7 +395,7 @@ static Scheme_Object *read_case_lambda(Scheme_Object *obj)
a = SCHEME_CAR(s);
cl->array[i] = a;
if (!SCHEME_PROCP(a)) {
if (!SAME_TYPE(SCHEME_TYPE(a), scheme_unclosed_procedure_type))
if (!SAME_TYPE(SCHEME_TYPE(a), scheme_lambda_type))
return NULL;
all_closed = 0;
}
@ -785,31 +783,31 @@ static Scheme_Object *closure_marshal_name(Scheme_Object *name)
return name;
}
static Scheme_Object *write_compiled_closure(Scheme_Object *obj)
static Scheme_Object *write_lambda(Scheme_Object *obj)
{
Scheme_Closure_Data *data;
Scheme_Lambda *data;
Scheme_Object *name, *l, *code, *ds, *tl_map;
int svec_size, pos;
Scheme_Marshal_Tables *mt;
data = (Scheme_Closure_Data *)obj;
data = (Scheme_Lambda *)obj;
name = closure_marshal_name(data->name);
svec_size = data->closure_size;
if (SCHEME_CLOSURE_DATA_FLAGS(data) & CLOS_HAS_TYPED_ARGS) {
if (SCHEME_LAMBDA_FLAGS(data) & LAMBDA_HAS_TYPED_ARGS) {
svec_size += scheme_boxmap_size(data->num_params + data->closure_size);
{
int k, mv;
for (k = data->num_params + data->closure_size; --k; ) {
mv = scheme_boxmap_get(data->closure_map, k, data->closure_size);
if (mv > (CLOS_TYPE_TYPE_OFFSET + SCHEME_MAX_LOCAL_TYPE))
if (mv > (LAMBDA_TYPE_TYPE_OFFSET + SCHEME_MAX_LOCAL_TYPE))
scheme_signal_error("internal error: inconsistent closure/argument type");
}
}
}
if (SCHEME_RPAIRP(data->code)) {
if (SCHEME_RPAIRP(data->body)) {
/* This can happen if loaded bytecode is printed out and the procedure
body has never been needed before.
It's also possible in non-JIT mode if an empty closure is embedded
@ -820,7 +818,7 @@ static Scheme_Object *write_compiled_closure(Scheme_Object *obj)
/* If the body is simple enough, write it directly.
Otherwise, create a delay indirection so that the body
is loaded on demand. */
code = data->code;
code = data->body;
switch (SCHEME_TYPE(code)) {
case scheme_toplevel_type:
case scheme_local_type:
@ -868,10 +866,10 @@ static Scheme_Object *write_compiled_closure(Scheme_Object *obj)
ds = mt->cdata_map[pos];
if (ds) {
ds = SCHEME_PTR_VAL(ds);
if (SAME_OBJ(data->code, ds))
if (SAME_OBJ(data->body, ds))
break;
if (SAME_TYPE(scheme_quote_compilation_type, SCHEME_TYPE(ds)))
if (SAME_OBJ(data->code, SCHEME_PTR_VAL(ds)))
if (SAME_OBJ(data->body, SCHEME_PTR_VAL(ds)))
break;
}
pos += 256;
@ -886,7 +884,7 @@ static Scheme_Object *write_compiled_closure(Scheme_Object *obj)
if (mt->pass)
scheme_signal_error("broken closure-data table\n");
code = scheme_protect_quote(data->code);
code = scheme_protect_quote(data->body);
ds = scheme_alloc_small_object();
ds->type = scheme_delay_syntax_type;
@ -927,11 +925,11 @@ static Scheme_Object *write_compiled_closure(Scheme_Object *obj)
data->closure_map),
ds);
if (SCHEME_CLOSURE_DATA_FLAGS(data) & CLOS_HAS_TYPED_ARGS)
if (SCHEME_LAMBDA_FLAGS(data) & LAMBDA_HAS_TYPED_ARGS)
l = CONS(scheme_make_integer(data->closure_size),
l);
return CONS(scheme_make_integer(SCHEME_CLOSURE_DATA_FLAGS(data) & 0x7F),
return CONS(scheme_make_integer(SCHEME_LAMBDA_FLAGS(data) & 0x7F),
CONS(scheme_make_integer(data->num_params),
CONS(scheme_make_integer(data->max_let_depth),
CONS(tl_map,
@ -939,22 +937,22 @@ static Scheme_Object *write_compiled_closure(Scheme_Object *obj)
l)))));
}
static Scheme_Object *read_compiled_closure(Scheme_Object *obj)
static Scheme_Object *read_lambda(Scheme_Object *obj)
{
Scheme_Closure_Data *data;
Scheme_Lambda *data;
Scheme_Object *v, *tl_map;
#define BAD_CC "bad compiled closure"
#define X_SCHEME_ASSERT(x, y)
data = (Scheme_Closure_Data *)scheme_malloc_tagged(sizeof(Scheme_Closure_Data));
data = (Scheme_Lambda *)scheme_malloc_tagged(sizeof(Scheme_Lambda));
data->iso.so.type = scheme_unclosed_procedure_type;
data->iso.so.type = scheme_lambda_type;
if (!SCHEME_PAIRP(obj)) return NULL;
v = SCHEME_CAR(obj);
obj = SCHEME_CDR(obj);
SCHEME_CLOSURE_DATA_FLAGS(data) = (short)(SCHEME_INT_VAL(v));
SCHEME_LAMBDA_FLAGS(data) = (short)(SCHEME_INT_VAL(v));
if (!SCHEME_PAIRP(obj)) return NULL;
v = SCHEME_CAR(obj);
@ -1005,7 +1003,7 @@ static Scheme_Object *read_compiled_closure(Scheme_Object *obj)
obj = SCHEME_CDR(obj);
/* v is an svector or an integer... */
if (SCHEME_CLOSURE_DATA_FLAGS(data) & CLOS_HAS_TYPED_ARGS) {
if (SCHEME_LAMBDA_FLAGS(data) & LAMBDA_HAS_TYPED_ARGS) {
if (!SCHEME_INTP(v)) return NULL;
data->closure_size = SCHEME_INT_VAL(v);
@ -1014,14 +1012,14 @@ static Scheme_Object *read_compiled_closure(Scheme_Object *obj)
obj = SCHEME_CDR(obj);
}
data->code = obj;
data->body = obj;
if (!SAME_TYPE(scheme_svector_type, SCHEME_TYPE(v))) return NULL;
if (!(SCHEME_CLOSURE_DATA_FLAGS(data) & CLOS_HAS_TYPED_ARGS))
if (!(SCHEME_LAMBDA_FLAGS(data) & LAMBDA_HAS_TYPED_ARGS))
data->closure_size = SCHEME_SVEC_LEN(v);
if ((SCHEME_CLOSURE_DATA_FLAGS(data) & CLOS_HAS_TYPED_ARGS))
if ((SCHEME_LAMBDA_FLAGS(data) & LAMBDA_HAS_TYPED_ARGS))
if (data->closure_size + scheme_boxmap_size(data->closure_size + data->num_params) != SCHEME_SVEC_LEN(v))
return NULL;

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

@ -84,17 +84,17 @@ static Scheme_Object *resolved_module_path_name(int argc, Scheme_Object *argv[])
static Scheme_Object *module_export_protected_p(int argc, Scheme_Object **argv);
/* syntax */
static Scheme_Object *module_syntax(Scheme_Object *form, Scheme_Comp_Env *env, Scheme_Compile_Info *rec, int drec);
static Scheme_Object *module_compile(Scheme_Object *form, Scheme_Comp_Env *env, Scheme_Compile_Info *rec, int drec);
static Scheme_Object *module_expand(Scheme_Object *form, Scheme_Comp_Env *env, Scheme_Expand_Info *erec, int drec);
static Scheme_Object *modulestar_syntax(Scheme_Object *form, Scheme_Comp_Env *env, Scheme_Compile_Info *rec, int drec);
static Scheme_Object *modulestar_compile(Scheme_Object *form, Scheme_Comp_Env *env, Scheme_Compile_Info *rec, int drec);
static Scheme_Object *modulestar_expand(Scheme_Object *form, Scheme_Comp_Env *env, Scheme_Expand_Info *erec, int drec);
static Scheme_Object *module_begin_syntax(Scheme_Object *form, Scheme_Comp_Env *env, Scheme_Compile_Info *rec, int drec);
static Scheme_Object *module_begin_compile(Scheme_Object *form, Scheme_Comp_Env *env, Scheme_Compile_Info *rec, int drec);
static Scheme_Object *module_begin_expand(Scheme_Object *form, Scheme_Comp_Env *env, Scheme_Expand_Info *erec, int drec);
static Scheme_Object *declare_syntax(Scheme_Object *form, Scheme_Comp_Env *env, Scheme_Compile_Info *rec, int drec);
static Scheme_Object *declare_compile(Scheme_Object *form, Scheme_Comp_Env *env, Scheme_Compile_Info *rec, int drec);
static Scheme_Object *declare_expand(Scheme_Object *form, Scheme_Comp_Env *env, Scheme_Expand_Info *erec, int drec);
static Scheme_Object *require_syntax(Scheme_Object *form, Scheme_Comp_Env *env, Scheme_Compile_Info *rec, int drec);
static Scheme_Object *require_compile(Scheme_Object *form, Scheme_Comp_Env *env, Scheme_Compile_Info *rec, int drec);
static Scheme_Object *require_expand(Scheme_Object *form, Scheme_Comp_Env *env, Scheme_Expand_Info *erec, int drec);
static Scheme_Object *provide_syntax(Scheme_Object *form, Scheme_Comp_Env *env, Scheme_Compile_Info *rec, int drec);
static Scheme_Object *provide_compile(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_Module *module_load(Scheme_Object *modname, Scheme_Env *env, const char *who);
@ -378,34 +378,34 @@ static void qsort_provides(Scheme_Object **exs, Scheme_Object **exsns, Scheme_Ob
void scheme_init_module(Scheme_Env *env)
{
scheme_add_global_keyword("module",
scheme_make_compiled_syntax(module_syntax,
module_expand),
scheme_make_primitive_syntax(module_compile,
module_expand),
env);
scheme_add_global_keyword("module*",
scheme_make_compiled_syntax(modulestar_syntax,
modulestar_expand),
scheme_make_primitive_syntax(modulestar_compile,
modulestar_expand),
env);
REGISTER_SO(modbeg_syntax);
modbeg_syntax = scheme_make_compiled_syntax(module_begin_syntax,
module_begin_expand);
modbeg_syntax = scheme_make_primitive_syntax(module_begin_compile,
module_begin_expand);
scheme_add_global_keyword("#%module-begin",
modbeg_syntax,
env);
scheme_add_global_keyword("#%declare",
scheme_make_compiled_syntax(declare_syntax,
declare_expand),
scheme_make_primitive_syntax(declare_compile,
declare_expand),
env);
scheme_add_global_keyword("#%require",
scheme_make_compiled_syntax(require_syntax,
require_expand),
scheme_make_primitive_syntax(require_compile,
require_expand),
env);
scheme_add_global_keyword("#%provide",
scheme_make_compiled_syntax(provide_syntax,
provide_expand),
scheme_make_primitive_syntax(provide_compile,
provide_expand),
env);
#ifdef MZ_USE_PLACES
@ -4347,7 +4347,7 @@ static int is_procedure_expression(Scheme_Object *e)
t = SCHEME_TYPE(e);
return ((t == scheme_unclosed_procedure_type)
return ((t == scheme_lambda_type)
|| (t == scheme_case_lambda_sequence_type));
}
@ -4432,7 +4432,7 @@ static void setup_accessible_table(Scheme_Module *m)
might leave bindings out of the `toplevels' table. */
} else {
if (SCHEME_VEC_SIZE(form) == 2) {
if (scheme_compiled_duplicate_ok(SCHEME_VEC_ELS(form)[0], 1)) {
if (scheme_ir_duplicate_ok(SCHEME_VEC_ELS(form)[0], 1)) {
/* record simple constant from cross-module propagation: */
v = scheme_make_pair(v, SCHEME_VEC_ELS(form)[0]);
} else if (SAME_TYPE(SCHEME_TYPE(SCHEME_VEC_ELS(form)[0]), scheme_inline_variant_type)) {
@ -5892,7 +5892,7 @@ static int needs_prompt(Scheme_Object *e)
return 0;
switch (t) {
case scheme_unclosed_procedure_type:
case scheme_lambda_type:
case scheme_toplevel_type:
case scheme_local_type:
case scheme_local_unbox_type:
@ -6364,7 +6364,7 @@ static int is_simple_expr(Scheme_Object *v)
Scheme_Type t;
t = SCHEME_TYPE(v);
if (SAME_TYPE(t, scheme_unclosed_procedure_type))
if (SAME_TYPE(t, scheme_lambda_type))
return 1;
return 0;
@ -7538,7 +7538,7 @@ static Scheme_Object *do_module(Scheme_Object *form, Scheme_Comp_Env *env,
}
static Scheme_Object *
module_syntax(Scheme_Object *form, Scheme_Comp_Env *env, Scheme_Compile_Info *rec, int drec)
module_compile(Scheme_Object *form, Scheme_Comp_Env *env, Scheme_Compile_Info *rec, int drec)
{
return do_module(form, env, rec, drec, scheme_null, scheme_null, 0,
NULL, scheme_make_integer(0));
@ -7552,7 +7552,7 @@ module_expand(Scheme_Object *form, Scheme_Comp_Env *env, Scheme_Expand_Info *ere
}
static Scheme_Object *
modulestar_syntax(Scheme_Object *form, Scheme_Comp_Env *env, Scheme_Compile_Info *rec, int drec)
modulestar_compile(Scheme_Object *form, Scheme_Comp_Env *env, Scheme_Compile_Info *rec, int drec)
{
scheme_wrong_syntax(NULL, NULL, form, "illegal use (not in a module top-level)");
return NULL;
@ -7561,7 +7561,7 @@ modulestar_syntax(Scheme_Object *form, Scheme_Comp_Env *env, Scheme_Compile_Info
static Scheme_Object *
modulestar_expand(Scheme_Object *form, Scheme_Comp_Env *env, Scheme_Expand_Info *erec, int drec)
{
return modulestar_syntax(form, env, erec, drec);
return modulestar_compile(form, env, erec, drec);
}
/* For mzc: */
@ -10088,7 +10088,7 @@ static void install_stops(Scheme_Comp_Env *xenv, int phase, Scheme_Object **_beg
}
static Scheme_Object *
module_begin_syntax(Scheme_Object *form, Scheme_Comp_Env *env, Scheme_Compile_Info *rec, int drec)
module_begin_compile(Scheme_Object *form, Scheme_Comp_Env *env, Scheme_Compile_Info *rec, int drec)
{
return do_module_begin(form, env, rec, drec);
}
@ -12726,7 +12726,7 @@ static Scheme_Object *do_require(Scheme_Object *form, Scheme_Comp_Env *env,
}
static Scheme_Object *
require_syntax(Scheme_Object *form, Scheme_Comp_Env *env, Scheme_Compile_Info *rec, int drec)
require_compile(Scheme_Object *form, Scheme_Comp_Env *env, Scheme_Compile_Info *rec, int drec)
{
return do_require(form, env, rec, drec);
}
@ -12759,7 +12759,7 @@ Scheme_Object *scheme_toplevel_require_for_expand(Scheme_Object *module_path,
/**********************************************************************/
static Scheme_Object *
provide_syntax(Scheme_Object *form, Scheme_Comp_Env *env, Scheme_Compile_Info *rec, int drec)
provide_compile(Scheme_Object *form, Scheme_Comp_Env *env, Scheme_Compile_Info *rec, int drec)
{
scheme_wrong_syntax(NULL, NULL, form, "not in module body");
return NULL;
@ -12774,7 +12774,7 @@ provide_expand(Scheme_Object *form, Scheme_Comp_Env *env, Scheme_Expand_Info *er
}
static Scheme_Object *
declare_syntax(Scheme_Object *form, Scheme_Comp_Env *env, Scheme_Compile_Info *rec, int drec)
declare_compile(Scheme_Object *form, Scheme_Comp_Env *env, Scheme_Compile_Info *rec, int drec)
{
scheme_wrong_syntax(NULL, NULL, form, "not in module body");
return NULL;

46
racket/src/racket/src/mzmark_compile.inc
View File

@ -1,2 +1,48 @@
/* >>>> Generated by mkmark.rkt from mzmarksrc.c <<<< */
static int mark_ir_lambda_info_SIZE(void *p, struct NewGC *gc) {
#ifndef GC_NO_SIZE_NEEDED_FROM_PROCS
gcBYTES_TO_WORDS(sizeof(Scheme_IR_Lambda_Info));
#else
return 0;
#endif
}
static int mark_ir_lambda_info_MARK(void *p, struct NewGC *gc) {
#ifndef GC_NO_MARK_PROCEDURE_NEEDED
Scheme_IR_Lambda_Info *i = (Scheme_IR_Lambda_Info *)p;
gcMARK2(i->base_closure, gc);
gcMARK2(i->vars, gc);
gcMARK2(i->local_type_map, gc);
# ifdef GC_NO_SIZE_NEEDED_FROM_PROCS
return 0;
# else
return
gcBYTES_TO_WORDS(sizeof(Scheme_IR_Lambda_Info));
# endif
#endif
}
static int mark_ir_lambda_info_FIXUP(void *p, struct NewGC *gc) {
#ifndef GC_NO_FIXUP_PROCEDURE_NEEDED
Scheme_IR_Lambda_Info *i = (Scheme_IR_Lambda_Info *)p;
gcFIXUP2(i->base_closure, gc);
gcFIXUP2(i->vars, gc);
gcFIXUP2(i->local_type_map, gc);
# ifdef GC_NO_SIZE_NEEDED_FROM_PROCS
return 0;
# else
return
gcBYTES_TO_WORDS(sizeof(Scheme_IR_Lambda_Info));
# endif
#endif
}
#define mark_ir_lambda_info_IS_ATOMIC 0
#define mark_ir_lambda_info_IS_CONST_SIZE 1

46
racket/src/racket/src/mzmark_fun.inc
View File

@ -1,51 +1,5 @@
/* >>>> Generated by mkmark.rkt from mzmarksrc.c <<<< */
static int mark_closure_info_SIZE(void *p, struct NewGC *gc) {
#ifndef GC_NO_SIZE_NEEDED_FROM_PROCS
gcBYTES_TO_WORDS(sizeof(Closure_Info));
#else
return 0;
#endif
}
static int mark_closure_info_MARK(void *p, struct NewGC *gc) {
#ifndef GC_NO_MARK_PROCEDURE_NEEDED
Closure_Info *i = (Closure_Info *)p;
gcMARK2(i->base_closure, gc);
gcMARK2(i->vars, gc);
gcMARK2(i->local_type_map, gc);
# ifdef GC_NO_SIZE_NEEDED_FROM_PROCS
return 0;
# else
return
gcBYTES_TO_WORDS(sizeof(Closure_Info));
# endif
#endif
}
static int mark_closure_info_FIXUP(void *p, struct NewGC *gc) {
#ifndef GC_NO_FIXUP_PROCEDURE_NEEDED
Closure_Info *i = (Closure_Info *)p;
gcFIXUP2(i->base_closure, gc);
gcFIXUP2(i->vars, gc);
gcFIXUP2(i->local_type_map, gc);
# ifdef GC_NO_SIZE_NEEDED_FROM_PROCS
return 0;
# else
return
gcBYTES_TO_WORDS(sizeof(Closure_Info));
# endif
#endif
}
#define mark_closure_info_IS_ATOMIC 0
#define mark_closure_info_IS_CONST_SIZE 1
static int mark_dyn_wind_cell_SIZE(void *p, struct NewGC *gc) {
#ifndef GC_NO_SIZE_NEEDED_FROM_PROCS
gcBYTES_TO_WORDS(sizeof(Scheme_Dynamic_Wind_List));

32
racket/src/racket/src/mzmark_jit.inc
View File

@ -3,7 +3,7 @@
static int native_closure_SIZE(void *p, struct NewGC *gc) {
#ifndef GC_NO_SIZE_NEEDED_FROM_PROCS
Scheme_Native_Closure *c = (Scheme_Native_Closure *)p;
int closure_size = ((Scheme_Native_Closure_Data *)GC_resolve2(c->code, gc))->closure_size;
int closure_size = ((Scheme_Native_Lambda *)GC_resolve2(c->code, gc))->closure_size;
if (closure_size < 0) {
closure_size = -(closure_size + 1);
@ -19,7 +19,7 @@ static int native_closure_SIZE(void *p, struct NewGC *gc) {
static int native_closure_MARK(void *p, struct NewGC *gc) {
#ifndef GC_NO_MARK_PROCEDURE_NEEDED
Scheme_Native_Closure *c = (Scheme_Native_Closure *)p;
int closure_size = ((Scheme_Native_Closure_Data *)GC_resolve2(c->code, gc))->closure_size;
int closure_size = ((Scheme_Native_Lambda *)GC_resolve2(c->code, gc))->closure_size;
if (closure_size < 0) {
closure_size = -(closure_size + 1);
@ -27,7 +27,7 @@ static int native_closure_MARK(void *p, struct NewGC *gc) {
{
int i = closure_size;
# define CLOSURE_DATA_TYPE Scheme_Native_Closure_Data
# define CLOSURE_DATA_TYPE Scheme_Native_Lambda
# include "mzclpf_decl.inc"
gcMARK2(c->code, gc);
@ -54,7 +54,7 @@ static int native_closure_MARK(void *p, struct NewGC *gc) {
static int native_closure_FIXUP(void *p, struct NewGC *gc) {
#ifndef GC_NO_FIXUP_PROCEDURE_NEEDED
Scheme_Native_Closure *c = (Scheme_Native_Closure *)p;
int closure_size = ((Scheme_Native_Closure_Data *)GC_resolve2(c->code, gc))->closure_size;
int closure_size = ((Scheme_Native_Lambda *)GC_resolve2(c->code, gc))->closure_size;
if (closure_size < 0) {
closure_size = -(closure_size + 1);
@ -97,7 +97,7 @@ static int mark_jit_state_MARK(void *p, struct NewGC *gc) {
#ifndef GC_NO_MARK_PROCEDURE_NEEDED
mz_jit_state *j = (mz_jit_state *)p;
gcMARK2(j->mappings, gc);
gcMARK2(j->self_data, gc);
gcMARK2(j->self_lam, gc);
gcMARK2(j->example_argv, gc);
gcMARK2(j->nc, gc);
gcMARK2(j->retaining_data, gc);
@ -116,7 +116,7 @@ static int mark_jit_state_FIXUP(void *p, struct NewGC *gc) {
#ifndef GC_NO_FIXUP_PROCEDURE_NEEDED
mz_jit_state *j = (mz_jit_state *)p;
gcFIXUP2(j->mappings, gc);
gcFIXUP2(j->self_data, gc);
gcFIXUP2(j->self_lam, gc);
gcFIXUP2(j->example_argv, gc);
gcFIXUP2(j->nc, gc);
gcFIXUP2(j->retaining_data, gc);
@ -137,7 +137,7 @@ static int mark_jit_state_FIXUP(void *p, struct NewGC *gc) {
static int native_unclosed_proc_SIZE(void *p, struct NewGC *gc) {
#ifndef GC_NO_SIZE_NEEDED_FROM_PROCS
gcBYTES_TO_WORDS(sizeof(Scheme_Native_Closure_Data));
gcBYTES_TO_WORDS(sizeof(Scheme_Native_Lambda));
#else
return 0;
#endif
@ -145,7 +145,7 @@ static int native_unclosed_proc_SIZE(void *p, struct NewGC *gc) {
static int native_unclosed_proc_MARK(void *p, struct NewGC *gc) {
#ifndef GC_NO_MARK_PROCEDURE_NEEDED
Scheme_Native_Closure_Data *d = (Scheme_Native_Closure_Data *)p;
Scheme_Native_Lambda *d = (Scheme_Native_Lambda *)p;
int i;
gcMARK2(d->u2.name, gc);
@ -164,14 +164,14 @@ static int native_unclosed_proc_MARK(void *p, struct NewGC *gc) {
return 0;
# else
return
gcBYTES_TO_WORDS(sizeof(Scheme_Native_Closure_Data));
gcBYTES_TO_WORDS(sizeof(Scheme_Native_Lambda));
# endif
#endif
}
static int native_unclosed_proc_FIXUP(void *p, struct NewGC *gc) {
#ifndef GC_NO_FIXUP_PROCEDURE_NEEDED
Scheme_Native_Closure_Data *d = (Scheme_Native_Closure_Data *)p;
Scheme_Native_Lambda *d = (Scheme_Native_Lambda *)p;
int i;
gcFIXUP2(d->u2.name, gc);
@ -190,7 +190,7 @@ static int native_unclosed_proc_FIXUP(void *p, struct NewGC *gc) {
return 0;
# else
return
gcBYTES_TO_WORDS(sizeof(Scheme_Native_Closure_Data));
gcBYTES_TO_WORDS(sizeof(Scheme_Native_Lambda));
# endif
#endif
}
@ -201,7 +201,7 @@ static int native_unclosed_proc_FIXUP(void *p, struct NewGC *gc) {
static int native_unclosed_proc_plus_case_SIZE(void *p, struct NewGC *gc) {
#ifndef GC_NO_SIZE_NEEDED_FROM_PROCS
gcBYTES_TO_WORDS(sizeof(Scheme_Native_Closure_Data_Plus_Case));
gcBYTES_TO_WORDS(sizeof(Scheme_Native_Lambda_Plus_Case));
#else
return 0;
#endif
@ -209,7 +209,7 @@ static int native_unclosed_proc_plus_case_SIZE(void *p, struct NewGC *gc) {
static int native_unclosed_proc_plus_case_MARK(void *p, struct NewGC *gc) {
#ifndef GC_NO_MARK_PROCEDURE_NEEDED
Scheme_Native_Closure_Data_Plus_Case *d = (Scheme_Native_Closure_Data_Plus_Case *)p;
Scheme_Native_Lambda_Plus_Case *d = (Scheme_Native_Lambda_Plus_Case *)p;
native_unclosed_proc_MARK(p, gc);
gcMARK2(d->case_lam, gc);
@ -218,14 +218,14 @@ static int native_unclosed_proc_plus_case_MARK(void *p, struct NewGC *gc) {
return 0;
# else
return
gcBYTES_TO_WORDS(sizeof(Scheme_Native_Closure_Data_Plus_Case));
gcBYTES_TO_WORDS(sizeof(Scheme_Native_Lambda_Plus_Case));
# endif
#endif
}
static int native_unclosed_proc_plus_case_FIXUP(void *p, struct NewGC *gc) {
#ifndef GC_NO_FIXUP_PROCEDURE_NEEDED
Scheme_Native_Closure_Data_Plus_Case *d = (Scheme_Native_Closure_Data_Plus_Case *)p;
Scheme_Native_Lambda_Plus_Case *d = (Scheme_Native_Lambda_Plus_Case *)p;
native_unclosed_proc_FIXUP(p, gc);
gcFIXUP2(d->case_lam, gc);
@ -234,7 +234,7 @@ static int native_unclosed_proc_plus_case_FIXUP(void *p, struct NewGC *gc) {
return 0;
# else
return
gcBYTES_TO_WORDS(sizeof(Scheme_Native_Closure_Data_Plus_Case));
gcBYTES_TO_WORDS(sizeof(Scheme_Native_Lambda_Plus_Case));
# endif
#endif
}

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

@ -673,7 +673,7 @@ static int branch_rec_FIXUP(void *p, struct NewGC *gc) {
static int unclosed_proc_SIZE(void *p, struct NewGC *gc) {
#ifndef GC_NO_SIZE_NEEDED_FROM_PROCS
gcBYTES_TO_WORDS(sizeof(Scheme_Closure_Data));
gcBYTES_TO_WORDS(sizeof(Scheme_Lambda));
#else
return 0;
#endif
@ -681,11 +681,11 @@ static int unclosed_proc_SIZE(void *p, struct NewGC *gc) {
static int unclosed_proc_MARK(void *p, struct NewGC *gc) {
#ifndef GC_NO_MARK_PROCEDURE_NEEDED
Scheme_Closure_Data *d = (Scheme_Closure_Data *)p;
Scheme_Lambda *d = (Scheme_Lambda *)p;
gcMARK2(d->name, gc);
gcMARK2(d->code, gc);
gcMARK2(d->closure_map, gc);
gcMARK2(d->body, gc);
gcMARK2(d->closure_map, gc); /* covers `ir_info` */
gcMARK2(d->tl_map, gc);
#ifdef MZ_USE_JIT
gcMARK2(d->u.native_code, gc);
@ -696,18 +696,18 @@ static int unclosed_proc_MARK(void *p, struct NewGC *gc) {
return 0;
# else
return
gcBYTES_TO_WORDS(sizeof(Scheme_Closure_Data));
gcBYTES_TO_WORDS(sizeof(Scheme_Lambda));
# endif
#endif
}
static int unclosed_proc_FIXUP(void *p, struct NewGC *gc) {
#ifndef GC_NO_FIXUP_PROCEDURE_NEEDED
Scheme_Closure_Data *d = (Scheme_Closure_Data *)p;
Scheme_Lambda *d = (Scheme_Lambda *)p;
gcFIXUP2(d->name, gc);
gcFIXUP2(d->code, gc);
gcFIXUP2(d->closure_map, gc);
gcFIXUP2(d->body, gc);
gcFIXUP2(d->closure_map, gc); /* covers `ir_info` */
gcFIXUP2(d->tl_map, gc);
#ifdef MZ_USE_JIT
gcFIXUP2(d->u.native_code, gc);
@ -718,7 +718,7 @@ static int unclosed_proc_FIXUP(void *p, struct NewGC *gc) {
return 0;
# else
return
gcBYTES_TO_WORDS(sizeof(Scheme_Closure_Data));
gcBYTES_TO_WORDS(sizeof(Scheme_Lambda));
# endif
#endif
}
@ -947,17 +947,17 @@ static int with_cont_mark_FIXUP(void *p, struct NewGC *gc) {
#define with_cont_mark_IS_CONST_SIZE 1
static int comp_local_SIZE(void *p, struct NewGC *gc) {
static int ir_local_SIZE(void *p, struct NewGC *gc) {
#ifndef GC_NO_SIZE_NEEDED_FROM_PROCS
gcBYTES_TO_WORDS(sizeof(Scheme_Compiled_Local));
gcBYTES_TO_WORDS(sizeof(Scheme_IR_Local));
#else
return 0;
#endif
}
static int comp_local_MARK(void *p, struct NewGC *gc) {
static int ir_local_MARK(void *p, struct NewGC *gc) {
#ifndef GC_NO_MARK_PROCEDURE_NEEDED
Scheme_Compiled_Local *var = (Scheme_Compiled_Local *)p;
Scheme_IR_Local *var = (Scheme_IR_Local *)p;
gcMARK2(var->name, gc);
switch (var->mode) {
@ -979,14 +979,14 @@ static int comp_local_MARK(void *p, struct NewGC *gc) {
return 0;
# else
return
gcBYTES_TO_WORDS(sizeof(Scheme_Compiled_Local));
gcBYTES_TO_WORDS(sizeof(Scheme_IR_Local));
# endif
#endif
}
static int comp_local_FIXUP(void *p, struct NewGC *gc) {
static int ir_local_FIXUP(void *p, struct NewGC *gc) {
#ifndef GC_NO_FIXUP_PROCEDURE_NEEDED
Scheme_Compiled_Local *var = (Scheme_Compiled_Local *)p;
Scheme_IR_Local *var = (Scheme_IR_Local *)p;
gcFIXUP2(var->name, gc);
switch (var->mode) {
@ -1008,26 +1008,26 @@ static int comp_local_FIXUP(void *p, struct NewGC *gc) {
return 0;
# else
return
gcBYTES_TO_WORDS(sizeof(Scheme_Compiled_Local));
gcBYTES_TO_WORDS(sizeof(Scheme_IR_Local));
# endif
#endif
}
#define comp_local_IS_ATOMIC 0
#define comp_local_IS_CONST_SIZE 1
#define ir_local_IS_ATOMIC 0
#define ir_local_IS_CONST_SIZE 1
static int comp_let_value_SIZE(void *p, struct NewGC *gc) {
static int ir_let_value_SIZE(void *p, struct NewGC *gc) {
#ifndef GC_NO_SIZE_NEEDED_FROM_PROCS
gcBYTES_TO_WORDS(sizeof(Scheme_Compiled_Let_Value));
gcBYTES_TO_WORDS(sizeof(Scheme_IR_Let_Value));
#else
return 0;
#endif
}
static int comp_let_value_MARK(void *p, struct NewGC *gc) {
static int ir_let_value_MARK(void *p, struct NewGC *gc) {
#ifndef GC_NO_MARK_PROCEDURE_NEEDED
Scheme_Compiled_Let_Value *c = (Scheme_Compiled_Let_Value *)p;
Scheme_IR_Let_Value *c = (Scheme_IR_Let_Value *)p;
gcMARK2(c->value, gc);
gcMARK2(c->body, gc);
@ -1037,14 +1037,14 @@ static int comp_let_value_MARK(void *p, struct NewGC *gc) {
return 0;
# else
return
gcBYTES_TO_WORDS(sizeof(Scheme_Compiled_Let_Value));
gcBYTES_TO_WORDS(sizeof(Scheme_IR_Let_Value));
# endif
#endif
}
static int comp_let_value_FIXUP(void *p, struct NewGC *gc) {
static int ir_let_value_FIXUP(void *p, struct NewGC *gc) {
#ifndef GC_NO_FIXUP_PROCEDURE_NEEDED
Scheme_Compiled_Let_Value *c = (Scheme_Compiled_Let_Value *)p;
Scheme_IR_Let_Value *c = (Scheme_IR_Let_Value *)p;
gcFIXUP2(c->value, gc);
gcFIXUP2(c->body, gc);
@ -1054,18 +1054,18 @@ static int comp_let_value_FIXUP(void *p, struct NewGC *gc) {
return 0;
# else
return
gcBYTES_TO_WORDS(sizeof(Scheme_Compiled_Let_Value));
gcBYTES_TO_WORDS(sizeof(Scheme_IR_Let_Value));
# endif
#endif
}
#define comp_let_value_IS_ATOMIC 0
#define comp_let_value_IS_CONST_SIZE 1
#define ir_let_value_IS_ATOMIC 0
#define ir_let_value_IS_CONST_SIZE 1
static int let_header_SIZE(void *p, struct NewGC *gc) {
#ifndef GC_NO_SIZE_NEEDED_FROM_PROCS
gcBYTES_TO_WORDS(sizeof(Scheme_Let_Header));
gcBYTES_TO_WORDS(sizeof(Scheme_IR_Let_Header));
#else
return 0;
#endif
@ -1073,7 +1073,7 @@ static int let_header_SIZE(void *p, struct NewGC *gc) {
static int let_header_MARK(void *p, struct NewGC *gc) {
#ifndef GC_NO_MARK_PROCEDURE_NEEDED
Scheme_Let_Header *h = (Scheme_Let_Header *)p;
Scheme_IR_Let_Header *h = (Scheme_IR_Let_Header *)p;
gcMARK2(h->body, gc);
@ -1081,14 +1081,14 @@ static int let_header_MARK(void *p, struct NewGC *gc) {
return 0;
# else
return
gcBYTES_TO_WORDS(sizeof(Scheme_Let_Header));
gcBYTES_TO_WORDS(sizeof(Scheme_IR_Let_Header));
# endif
#endif
}
static int let_header_FIXUP(void *p, struct NewGC *gc) {
#ifndef GC_NO_FIXUP_PROCEDURE_NEEDED
Scheme_Let_Header *h = (Scheme_Let_Header *)p;
Scheme_IR_Let_Header *h = (Scheme_IR_Let_Header *)p;
gcFIXUP2(h->body, gc);
@ -1096,7 +1096,7 @@ static int let_header_FIXUP(void *p, struct NewGC *gc) {
return 0;
# else
return
gcBYTES_TO_WORDS(sizeof(Scheme_Let_Header));
gcBYTES_TO_WORDS(sizeof(Scheme_IR_Let_Header));
# endif
#endif
}
@ -1296,7 +1296,7 @@ static int scm_closure_SIZE(void *p, struct NewGC *gc) {
#ifndef GC_NO_SIZE_NEEDED_FROM_PROCS
Scheme_Closure *c = (Scheme_Closure *)p;
int closure_size = (c->code
? ((Scheme_Closure_Data *)GC_resolve2(c->code, gc))->closure_size
? ((Scheme_Lambda *)GC_resolve2(c->code, gc))->closure_size
: 0);
gcBYTES_TO_WORDS((sizeof(Scheme_Closure)
@ -1310,12 +1310,12 @@ static int scm_closure_MARK(void *p, struct NewGC *gc) {
#ifndef GC_NO_MARK_PROCEDURE_NEEDED
Scheme_Closure *c = (Scheme_Closure *)p;
int closure_size = (c->code
? ((Scheme_Closure_Data *)GC_resolve2(c->code, gc))->closure_size
? ((Scheme_Lambda *)GC_resolve2(c->code, gc))->closure_size
: 0);
int i = closure_size;
# define CLOSURE_DATA_TYPE Scheme_Closure_Data
# define CLOSURE_DATA_TYPE Scheme_Lambda
# include "mzclpf_decl.inc"
gcMARK2(c->code, gc);
@ -1342,7 +1342,7 @@ static int scm_closure_FIXUP(void *p, struct NewGC *gc) {
#ifndef GC_NO_FIXUP_PROCEDURE_NEEDED
Scheme_Closure *c = (Scheme_Closure *)p;
int closure_size = (c->code
? ((Scheme_Closure_Data *)GC_resolve2(c->code, gc))->closure_size
? ((Scheme_Lambda *)GC_resolve2(c->code, gc))->closure_size
: 0);

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

@ -158,11 +158,11 @@ branch_rec {
unclosed_proc {
mark:
Scheme_Closure_Data *d = (Scheme_Closure_Data *)p;
Scheme_Lambda *d = (Scheme_Lambda *)p;
gcMARK2(d->name, gc);
gcMARK2(d->code, gc);
gcMARK2(d->closure_map, gc);
gcMARK2(d->body, gc);
gcMARK2(d->closure_map, gc); /* covers `ir_info` */
gcMARK2(d->tl_map, gc);
#ifdef MZ_USE_JIT
gcMARK2(d->u.native_code, gc);
@ -170,7 +170,7 @@ unclosed_proc {
#endif
size:
gcBYTES_TO_WORDS(sizeof(Scheme_Closure_Data));
gcBYTES_TO_WORDS(sizeof(Scheme_Lambda));
}
let_value {
@ -228,9 +228,9 @@ with_cont_mark {
gcBYTES_TO_WORDS(sizeof(Scheme_With_Continuation_Mark));
}
comp_local {
ir_local {
mark:
Scheme_Compiled_Local *var = (Scheme_Compiled_Local *)p;
Scheme_IR_Local *var = (Scheme_IR_Local *)p;
gcMARK2(var->name, gc);
switch (var->mode) {
@ -249,29 +249,29 @@ comp_local {
}
size:
gcBYTES_TO_WORDS(sizeof(Scheme_Compiled_Local));
gcBYTES_TO_WORDS(sizeof(Scheme_IR_Local));
}
comp_let_value {
ir_let_value {
mark:
Scheme_Compiled_Let_Value *c = (Scheme_Compiled_Let_Value *)p;
Scheme_IR_Let_Value *c = (Scheme_IR_Let_Value *)p;
gcMARK2(c->value, gc);
gcMARK2(c->body, gc);
gcMARK2(c->vars, gc);
size:
gcBYTES_TO_WORDS(sizeof(Scheme_Compiled_Let_Value));
gcBYTES_TO_WORDS(sizeof(Scheme_IR_Let_Value));
}
let_header {
mark:
Scheme_Let_Header *h = (Scheme_Let_Header *)p;
Scheme_IR_Let_Header *h = (Scheme_IR_Let_Header *)p;
gcMARK2(h->body, gc);
size:
gcBYTES_TO_WORDS(sizeof(Scheme_Let_Header));
gcBYTES_TO_WORDS(sizeof(Scheme_IR_Let_Header));
}
set_bang {
@ -331,14 +331,14 @@ closed_prim_proc {
scm_closure {
Scheme_Closure *c = (Scheme_Closure *)p;
int closure_size = (c->code
? ((Scheme_Closure_Data *)GC_resolve2(c->code, gc))->closure_size
? ((Scheme_Lambda *)GC_resolve2(c->code, gc))->closure_size
: 0);
mark:
int i = closure_size;
START_MARK_ONLY;
# define CLOSURE_DATA_TYPE Scheme_Closure_Data
# define CLOSURE_DATA_TYPE Scheme_Lambda
# include "mzclpf_decl.inc"
END_MARK_ONLY;
@ -1471,18 +1471,6 @@ END validate;
START fun;
mark_closure_info {
mark:
Closure_Info *i = (Closure_Info *)p;
gcMARK2(i->base_closure, gc);
gcMARK2(i->vars, gc);
gcMARK2(i->local_type_map, gc);
size:
gcBYTES_TO_WORDS(sizeof(Closure_Info));
}
mark_dyn_wind_cell {
mark:
Scheme_Dynamic_Wind_List *l = (Scheme_Dynamic_Wind_List *)p;
@ -2268,6 +2256,18 @@ END struct;
START compile;
mark_ir_lambda_info {
mark:
Scheme_IR_Lambda_Info *i = (Scheme_IR_Lambda_Info *)p;
gcMARK2(i->base_closure, gc);
gcMARK2(i->vars, gc);
gcMARK2(i->local_type_map, gc);
size:
gcBYTES_TO_WORDS(sizeof(Scheme_IR_Lambda_Info));
}
END compile;
/**********************************************************************/
@ -2464,7 +2464,7 @@ START jit;
native_closure {
Scheme_Native_Closure *c = (Scheme_Native_Closure *)p;
int closure_size = ((Scheme_Native_Closure_Data *)GC_resolve2(c->code, gc))->closure_size;
int closure_size = ((Scheme_Native_Lambda *)GC_resolve2(c->code, gc))->closure_size;
if (closure_size < 0) {
closure_size = -(closure_size + 1);
@ -2474,7 +2474,7 @@ native_closure {
{
int i = closure_size;
START_MARK_ONLY;
# define CLOSURE_DATA_TYPE Scheme_Native_Closure_Data
# define CLOSURE_DATA_TYPE Scheme_Native_Lambda
# include "mzclpf_decl.inc"
END_MARK_ONLY;
@ -2502,7 +2502,7 @@ mark_jit_state {
mark:
mz_jit_state *j = (mz_jit_state *)p;
gcMARK2(j->mappings, gc);
gcMARK2(j->self_data, gc);
gcMARK2(j->self_lam, gc);
gcMARK2(j->example_argv, gc);
gcMARK2(j->nc, gc);
gcMARK2(j->retaining_data, gc);
@ -2514,7 +2514,7 @@ mark_jit_state {
native_unclosed_proc {
mark:
Scheme_Native_Closure_Data *d = (Scheme_Native_Closure_Data *)p;
Scheme_Native_Lambda *d = (Scheme_Native_Lambda *)p;
int i;
gcMARK2(d->u2.name, gc);
@ -2530,18 +2530,18 @@ native_unclosed_proc {
gcMARK2(d->eq_key, gc);
size:
gcBYTES_TO_WORDS(sizeof(Scheme_Native_Closure_Data));
gcBYTES_TO_WORDS(sizeof(Scheme_Native_Lambda));
}
native_unclosed_proc_plus_case {
mark:
Scheme_Native_Closure_Data_Plus_Case *d = (Scheme_Native_Closure_Data_Plus_Case *)p;
Scheme_Native_Lambda_Plus_Case *d = (Scheme_Native_Lambda_Plus_Case *)p;
native_unclosed_proc_MARK(p, gc);
gcMARK2(d->case_lam, gc);
size:
gcBYTES_TO_WORDS(sizeof(Scheme_Native_Closure_Data_Plus_Case));
gcBYTES_TO_WORDS(sizeof(Scheme_Native_Lambda_Plus_Case));
}
END jit;

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

File diff suppressed because it is too large Load Diff

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

@ -2775,7 +2775,7 @@ print(Scheme_Object *obj, int notdisplay, int compact, Scheme_Hash_Table *ht,
} else {
print_compact(pp, CPT_CLOSURE);
print_symtab_set(pp, mt, obj);
print((Scheme_Object *)SCHEME_COMPILED_CLOS_CODE(closure), notdisplay, compact, ht, mt, pp);
print((Scheme_Object *)SCHEME_CLOSURE_CODE(closure), notdisplay, compact, ht, mt, pp);
}
compact = 1;
done = 1;

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

File diff suppressed because it is too large Load Diff

26
racket/src/racket/src/salloc.c
View File

@ -2023,7 +2023,7 @@ static void print_tagged_value(const char *prefix,
scheme_check_print_is_obj = check_home;
{
if (SCHEME_TYPE(v) > _scheme_compiled_values_types_) {
if (SCHEME_TYPE(v) > _scheme_ir_values_types_) {
sprintf(hashstr, "{%" PRIdPTR "}", scheme_hash_key(v));
hash_code = hashstr;
}
@ -2913,13 +2913,13 @@ intptr_t scheme_count_memory(Scheme_Object *root, Scheme_Hash_Table *ht)
#endif
}
break;
case scheme_unclosed_procedure_type:
case scheme_compiled_unclosed_procedure_type:
case scheme_lambda_type:
case scheme_ir_lambda_type:
{
Scheme_Closure_Data *data =
(Scheme_Closure_Data *)root;
Scheme_Lambda *data =
(Scheme_Lambda *)root;
s = sizeof(Scheme_Closure_Data);
s = sizeof(Scheme_Lambda);
s += data->closure_size * sizeof(mzshort);
#if FORCE_KNOWN_SUBPARTS
e = COUNT(data->code);
@ -2936,11 +2936,11 @@ intptr_t scheme_count_memory(Scheme_Object *root, Scheme_Hash_Table *ht)
#endif
}
break;
case scheme_compiled_let_value_type:
case scheme_ir_let_value_type:
{
Scheme_Compiled_Let_Value *let = (Scheme_Compiled_Let_Value *)root;
Scheme_IR_Let_Value *let = (Scheme_IR_Let_Value *)root;
s = sizeof(Scheme_Compiled_Let_Value);
s = sizeof(Scheme_IR_Let_Value);
#if FORCE_KNOWN_SUBPARTS
e = COUNT(let->value) + COUNT(let->body);
#endif
@ -2956,7 +2956,7 @@ intptr_t scheme_count_memory(Scheme_Object *root, Scheme_Hash_Table *ht)
#endif
}
break;
case scheme_compiled_let_void_type:
case scheme_ir_let_void_type:
{
Scheme_Let_Header *let = (Scheme_Let_Header *)root;
@ -3040,11 +3040,11 @@ intptr_t scheme_count_memory(Scheme_Object *root, Scheme_Hash_Table *ht)
break;
case scheme_closure_type:
{
Scheme_Closure_Data *data;
Scheme_Lambda *data;
Scheme_Object **vals;
data = SCHEME_COMPILED_CLOS_CODE(root);
vals = SCHEME_COMPILED_CLOS_ENV(root);
data = SCHEME_CLOSURE_CODE(root);
vals = SCHEME_CLOSURE_ENV(root);
s += (data->closure_size * sizeof(Scheme_Object *));
#if FORCE_KNOWN_SUBPARTS

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

@ -453,7 +453,7 @@ extern Scheme_Object *scheme_fixnum_p_proc;
extern Scheme_Object *scheme_flonum_p_proc;
extern Scheme_Object *scheme_extflonum_p_proc;
extern Scheme_Object *scheme_apply_proc;
extern Scheme_Object *scheme_values_func;
extern Scheme_Object *scheme_values_proc;
extern Scheme_Object *scheme_procedure_p_proc;
extern Scheme_Object *scheme_procedure_arity_includes_proc;
extern Scheme_Object *scheme_procedure_specialize_proc;
@ -516,10 +516,10 @@ extern Scheme_Object *scheme_define_values_syntax, *scheme_define_syntaxes_synta
extern Scheme_Object *scheme_lambda_syntax;
extern Scheme_Object *scheme_begin_syntax;
extern Scheme_Object *scheme_not_prim;
extern Scheme_Object *scheme_eq_prim;
extern Scheme_Object *scheme_eqv_prim;
extern Scheme_Object *scheme_equal_prim;
extern Scheme_Object *scheme_not_proc;
extern Scheme_Object *scheme_eq_proc;
extern Scheme_Object *scheme_eqv_proc;
extern Scheme_Object *scheme_equal_proc;
extern Scheme_Object *scheme_def_exit_proc;
@ -1459,12 +1459,12 @@ Scheme_Object *scheme_top_introduce(Scheme_Object *form, Scheme_Env *genv);
/* syntax run-time structures */
/*========================================================================*/
/* A Scheme_Compiled_Local record represents a local variable,
/* A Scheme_IR_Local record represents a local variable,
both the binding and references to that binding. When inlining
of other transformations duplicate a variable, a new instance
is allocated to represent a separate variable. Different passes
in the comiler store different information about the variable. */
typedef struct Scheme_Compiled_Local
typedef struct Scheme_IR_Local
{
Scheme_Object so;
@ -1552,9 +1552,9 @@ typedef struct Scheme_Compiled_Local
Scheme_Object *lifted;
} resolve;
};
} Scheme_Compiled_Local;
} Scheme_IR_Local;
#define SCHEME_VAR(v) ((Scheme_Compiled_Local *)v)
#define SCHEME_VAR(v) ((Scheme_IR_Local *)v)
#define SCHEME_USE_COUNT_INF 7
@ -1620,34 +1620,34 @@ typedef struct {
} Scheme_Compilation_Top;
/* A `let' or `letrec' form is compiled to the intermediate
format (used during the optimization pass) as a Scheme_Let_Header
with a chain of Scheme_Compiled_Let_Value records as its body,
where there's one Scheme_Compiled_Let_Value for each binding
format (used during the optimization pass) as a Scheme_IR_Let_Header
with a chain of Scheme_IR_Let_Value records as its body,
where there's one Scheme_IR_Let_Value for each binding
clause. The body of the `let...' form is the body of the innermost
Scheme_Compiled_Let_Value record.
Scheme_IR_Let_Value record.
*/
typedef struct Scheme_Let_Header {
typedef struct Scheme_IR_Let_Header {
Scheme_Inclhash_Object iso; /* keyex used for recursive */
mzshort count; /* total number of bindings */
mzshort num_clauses; /* number of binding clauses */
Scheme_Object *body;
} Scheme_Let_Header;
} Scheme_IR_Let_Header;
#define SCHEME_LET_FLAGS(lh) MZ_OPT_HASH_KEY(&lh->iso)
#define SCHEME_LET_RECURSIVE 0x1
typedef struct Scheme_Compiled_Let_Value {
typedef struct Scheme_IR_Let_Value {
Scheme_Inclhash_Object iso; /* keyex used for set-starting */
mzshort count;
Scheme_Object *value;
Scheme_Object *body;
Scheme_Compiled_Local **vars;
} Scheme_Compiled_Let_Value;
Scheme_IR_Local **vars;
} Scheme_IR_Let_Value;
#define SCHEME_CLV_FLAGS(clv) MZ_OPT_HASH_KEY(&(clv)->iso)
#define SCHEME_CLV_NO_GROUP_LATER_USES 0x1
#define SCHEME_CLV_NO_GROUP_USES 0x2
#define SCHEME_IRLV_FLAGS(irlv) MZ_OPT_HASH_KEY(&(irlv)->iso)
#define SCHEME_IRLV_NO_GROUP_LATER_USES 0x1
#define SCHEME_IRLV_NO_GROUP_USES 0x2
typedef struct {
Scheme_Object so;
@ -1770,11 +1770,11 @@ typedef struct {
mzshort count;
Scheme_Object *name; /* see note below */
#ifdef MZ_USE_JIT
struct Scheme_Native_Closure_Data *native_code; /* generated by lightning */
struct Scheme_Native_Lambda *native_code; /* generated by lightning */
#endif
Scheme_Object *array[mzFLEX_ARRAY_DECL];
} Scheme_Case_Lambda;
/* If count is not 0, then check array[0] for CLOS_IS_METHOD.
/* If count is not 0, then check array[0] for LAMBDA_IS_METHOD.
Otherwise, name is a boxed symbol (or #f) to indicate a method. */
#define scheme_make_prim_w_arity2(f, n, mina, maxa, minr, maxr) \
@ -2769,7 +2769,7 @@ typedef struct Scheme_Comp_Env
Scheme_Object **bindings; /* symbols */
Scheme_Object **vals; /* compile-time values */
Scheme_Object **shadower_deltas;
Scheme_Compiled_Local **vars;
Scheme_IR_Local **vars;
int *use;
int max_use, any_use;
@ -2795,16 +2795,16 @@ typedef struct Scheme_Comp_Env
struct Scheme_Comp_Env *next;
} Scheme_Comp_Env;
#define CLOS_HAS_REST 1
#define CLOS_HAS_TYPED_ARGS 2
#define CLOS_PRESERVES_MARKS 4
#define CLOS_NEED_REST_CLEAR 8
#define CLOS_IS_METHOD 16
#define CLOS_SINGLE_RESULT 32
#define CLOS_RESULT_TENTATIVE 64
#define CLOS_VALIDATED 128
#define CLOS_SFS 256
/* BITS 8-15 (overlaps CLOS_SFS) used by write_compiled_closure() */
#define LAMBDA_HAS_REST 1
#define LAMBDA_HAS_TYPED_ARGS 2
#define LAMBDA_PRESERVES_MARKS 4
#define LAMBDA_NEED_REST_CLEAR 8
#define LAMBDA_IS_METHOD 16
#define LAMBDA_SINGLE_RESULT 32
#define LAMBDA_RESULT_TENTATIVE 64
#define LAMBDA_VALIDATED 128
#define LAMBDA_SFS 256
/* BITS 8-15 (overlaps LAMBDA_SFS) used by write_lambda() */
typedef struct Scheme_Compile_Expand_Info
{
@ -2843,16 +2843,16 @@ typedef struct Resolve_Prefix
typedef struct Resolve_Info Resolve_Info;
/* Closure_Info is used to store extra closure information
/* Scheme_IR_Lambda_Info is used to store extra closure information
before a closure mapping is resolved. */
typedef struct {
MZTAG_IF_REQUIRED
Scheme_Hash_Table *base_closure;
Scheme_Compiled_Local **vars;
Scheme_IR_Local **vars;
char *local_type_map; /* determined by callers; NULL when has_tymap set => no local types */
char has_tl, has_tymap, has_nonleaf;
int body_size, body_psize;
} Closure_Info;
} Scheme_IR_Lambda_Info;
typedef struct Optimize_Info Optimize_Info;
@ -2866,36 +2866,39 @@ typedef struct Scheme_Object *
typedef struct CPort Mz_CPort;
typedef struct Scheme_Closure_Data
typedef struct Scheme_Lambda
{
Scheme_Inclhash_Object iso; /* keyex used for flags */
mzshort num_params; /* includes collecting arg if has_rest */
mzshort max_let_depth;
mzshort closure_size; /* the number of closed-over variables */
mzshort *closure_map; /* actually a Closure_Info* until resolved;
contains closure_size elements mapping closed-over var to stack positions.
union {
Scheme_IR_Lambda_Info *ir_info; /* used until resolve pass */
mzshort *closure_map; /* after resolve pass:
contains closure_size elements mapping closed-over var to stack positions.
If CLOS_HAS_TYPED_ARGS, that array is followed by bit array with
CLOS_TYPE_BITS_PER_ARG bits per args then per closed-over
If LAMBDA_HAS_TYPED_ARGS, that array is followed by bit array with
LAMBDA_TYPE_BITS_PER_ARG bits per args then per closed-over
total size = closure_size + (closure_size + num_params) * CLOS_TYPE_BITS_PER_ARG */
Scheme_Object *code;
total size = closure_size + (closure_size + num_params) * LAMBDA_TYPE_BITS_PER_ARG */
};
Scheme_Object *body;
Scheme_Object *name; /* name or (vector name src line col pos span generated?) */
void *tl_map; /* fixnum or bit array (as array of `int's) indicating which globals+lifts in prefix are used */
#ifdef MZ_USE_JIT
union {
struct Scheme_Closure_Data *jit_clone;
struct Scheme_Native_Closure_Data *native_code; /* generated by lightning */
struct Scheme_Lambda *jit_clone;
struct Scheme_Native_Lambda *native_code; /* generated by lightning */
} u;
Scheme_Object *context; /* e.g., a letrec that binds the closure */
#endif
} Scheme_Closure_Data;
} Scheme_Lambda;
#define SCHEME_CLOSURE_DATA_FLAGS(obj) MZ_OPT_HASH_KEY(&(obj)->iso)
#define SCHEME_LAMBDA_FLAGS(obj) MZ_OPT_HASH_KEY(&(obj)->iso)
#define CLOS_TYPE_BITS_PER_ARG 4
#define CLOS_TYPE_BOXED 1
#define CLOS_TYPE_TYPE_OFFSET 1
#define LAMBDA_TYPE_BITS_PER_ARG 4
#define LAMBDA_TYPE_BOXED 1
#define LAMBDA_TYPE_TYPE_OFFSET 1
XFORM_NONGCING void scheme_boxmap_set(mzshort *boxmap, int j, int bit, int delta);
XFORM_NONGCING int scheme_boxmap_get(mzshort *boxmap, int j, int delta);
@ -2905,16 +2908,16 @@ int scheme_has_method_property(Scheme_Object *code);
typedef struct Scheme_Closure {
Scheme_Object so;
Scheme_Closure_Data *code;
Scheme_Lambda *code;
Scheme_Object *vals[mzFLEX_ARRAY_DECL];
} Scheme_Closure;
#define SCHEME_COMPILED_CLOS_CODE(c) ((Scheme_Closure *)c)->code
#define SCHEME_COMPILED_CLOS_ENV(c) ((Scheme_Closure *)c)->vals
#define SCHEME_CLOSURE_CODE(c) ((Scheme_Closure *)c)->code
#define SCHEME_CLOSURE_ENV(c) ((Scheme_Closure *)c)->vals
#define ZERO_SIZED_CLOSUREP(closure) !(closure->code->closure_size)
typedef struct Scheme_Native_Closure_Data {
typedef struct Scheme_Native_Lambda {
Scheme_Inclhash_Object iso; /* type tag only set when needed, but
flags always needed */
Scheme_Native_Proc *start_code; /* When not yet JITted, this is = to
@ -2929,7 +2932,7 @@ typedef struct Scheme_Native_Closure_Data {
case-lambda, and the number of cases is
(-closure-size)-1 */
union {
struct Scheme_Closure_Data *orig_code; /* For not-yet-JITted
struct Scheme_Lambda *orig_code; /* For not-yet-JITted
non-case-lambda */
Scheme_Object *name;
} u2;
@ -2943,9 +2946,9 @@ typedef struct Scheme_Native_Closure_Data {
void *retain_code;
#endif
void *eq_key; /* for `procedure-closure-contents-eq?` */
} Scheme_Native_Closure_Data;
} Scheme_Native_Lambda;
#define SCHEME_NATIVE_CLOSURE_DATA_FLAGS(obj) MZ_OPT_HASH_KEY(&(obj)->iso)
#define SCHEME_NATIVE_LAMBDA_FLAGS(obj) MZ_OPT_HASH_KEY(&(obj)->iso)
/* This flag is set pre-JIT: */
#define NATIVE_SPECIALIZED 0x1
@ -2953,12 +2956,12 @@ typedef struct Scheme_Native_Closure_Data {
typedef struct {
Scheme_Object so;
Scheme_Native_Closure_Data *code;
Scheme_Native_Lambda *code;
Scheme_Object *vals[mzFLEX_ARRAY_DECL];
} Scheme_Native_Closure;
Scheme_Native_Closure_Data *scheme_generate_lambda(Scheme_Closure_Data *obj, int drop_code,
Scheme_Native_Closure_Data *case_lam);
Scheme_Native_Lambda *scheme_generate_lambda(Scheme_Lambda *obj, int drop_code,
Scheme_Native_Lambda *case_lam);
typedef struct Scheme_Current_LWC {
/* !! All of these fields are treated as atomic by the GC !! */
@ -3136,15 +3139,15 @@ Scheme_Object *scheme_make_closure(Scheme_Thread *p,
int close);
Scheme_Closure *scheme_malloc_empty_closure(void);
Scheme_Object *scheme_make_native_closure(Scheme_Native_Closure_Data *code);
Scheme_Object *scheme_make_native_case_closure(Scheme_Native_Closure_Data *code);
Scheme_Object *scheme_make_native_closure(Scheme_Native_Lambda *code);
Scheme_Object *scheme_make_native_case_closure(Scheme_Native_Lambda *code);
void scheme_reset_app2_eval_type(Scheme_App2_Rec *app);
void scheme_reset_app3_eval_type(Scheme_App3_Rec *app);
Scheme_Native_Closure_Data *scheme_generate_case_lambda(Scheme_Case_Lambda *cl);
Scheme_Native_Lambda *scheme_generate_case_lambda(Scheme_Case_Lambda *cl);
void scheme_delay_load_closure(Scheme_Closure_Data *data);
void scheme_delay_load_closure(Scheme_Lambda *data);
Scheme_Object *scheme_intdef_bind_identifiers(Scheme_Object *intdef);
@ -3233,8 +3236,8 @@ Scheme_Object *scheme_optimize_apply_values(Scheme_Object *f, Scheme_Object *e,
int e_single_result,
int context);
int scheme_compiled_duplicate_ok(Scheme_Object *o, int cross_mod);
int scheme_compiled_propagate_ok(Scheme_Object *o, Optimize_Info *info);
int scheme_ir_duplicate_ok(Scheme_Object *o, int cross_mod);
int scheme_ir_propagate_ok(Scheme_Object *o, Optimize_Info *info);
int scheme_is_statically_proc(Scheme_Object *value, Optimize_Info *info);
Scheme_Object *scheme_make_noninline_proc(Scheme_Object *e);
@ -3245,7 +3248,7 @@ Scheme_Object *scheme_unresolve_top(Scheme_Object *, Comp_Prefix **);
int scheme_check_leaf_rator(Scheme_Object *le, int *_flags);
int scheme_is_compiled_procedure(Scheme_Object *o, int can_be_closed, int can_be_liftable);
int scheme_is_ir_lambda(Scheme_Object *o, int can_be_closed, int can_be_liftable);
Scheme_Object *scheme_resolve_lets(Scheme_Object *form, Resolve_Info *info);
@ -3272,8 +3275,8 @@ Scheme_Object *scheme_toplevel_to_flagged_toplevel(Scheme_Object *tl, int flags)
int scheme_expr_produces_local_type(Scheme_Object *expr, int *_involves_k_cross);
Scheme_Object *scheme_make_compiled_syntax(Scheme_Syntax *syntax,
Scheme_Syntax_Expander *exp);
Scheme_Object *scheme_make_primitive_syntax(Scheme_Syntax *syntax,
Scheme_Syntax_Expander *exp);
Scheme_Object *scheme_compile_expr(Scheme_Object *form, Scheme_Comp_Env *env,
Scheme_Compile_Info *rec, int drec);
@ -3340,7 +3343,7 @@ int scheme_env_check_reset_any_use(Scheme_Comp_Env *frame);
int scheme_env_max_use_above(Scheme_Comp_Env *frame, int pos);
void scheme_mark_all_use(Scheme_Comp_Env *frame);
void scheme_env_make_variables(Scheme_Comp_Env *frame);
void scheme_set_compilation_variables(Scheme_Comp_Env *frame, Scheme_Compiled_Local **vars,
void scheme_set_compilation_variables(Scheme_Comp_Env *frame, Scheme_IR_Local **vars,
int pos, int count);
/* flags reported by scheme_resolve_info_flags */
@ -4601,7 +4604,7 @@ void scheme_place_check_memory_use();
void scheme_clear_place_ifs_stack();
Scheme_Object **scheme_extract_sorted_keys(Scheme_Object *ht);
void scheme_sort_resolve_compiled_local_array(Scheme_Compiled_Local **a, intptr_t count);
void scheme_sort_resolve_ir_local_array(Scheme_IR_Local **a, intptr_t count);
#ifdef MZ_USE_PLACES
Scheme_Object *scheme_place_make_async_channel();

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

@ -222,7 +222,7 @@ static void sfs_note_app(SFS_Info *info, Scheme_Object *rator, int flags)
if (!info->tail_pos) {
if (flags & APPN_FLAG_IMMED)
return;
if (SAME_OBJ(scheme_values_func, rator))
if (SAME_OBJ(scheme_values_proc, rator))
/* no need to clear for app of `values' */
return;
if (SCHEME_PRIMP(rator)) {
@ -1013,7 +1013,7 @@ case_lambda_sfs(Scheme_Object *expr, SFS_Info *info)
}
le = cseq->array[0];
}
if (!SAME_TYPE(SCHEME_TYPE(le), scheme_unclosed_procedure_type)
if (!SAME_TYPE(SCHEME_TYPE(le), scheme_lambda_type)
&& !SAME_TYPE(SCHEME_TYPE(le), scheme_closure_type)) {
scheme_signal_error("internal error: not a lambda for case-lambda: %d",
SCHEME_TYPE(le));
@ -1155,7 +1155,7 @@ static Scheme_Object *begin_for_syntax_sfs(Scheme_Object *data, SFS_Info *info)
static Scheme_Object *sfs_closure(Scheme_Object *expr, SFS_Info *info, int self_pos)
{
Scheme_Closure_Data *data = (Scheme_Closure_Data *)expr;
Scheme_Lambda *data = (Scheme_Lambda *)expr;
Scheme_Object *code;
int i, size, has_tl = 0;
@ -1195,8 +1195,8 @@ static Scheme_Object *sfs_closure(Scheme_Object *expr, SFS_Info *info, int self_
return scheme_sfs_add_clears(expr, clears, 0);
}
if (!(SCHEME_CLOSURE_DATA_FLAGS(data) & CLOS_SFS)) {
SCHEME_CLOSURE_DATA_FLAGS(data) |= CLOS_SFS;
if (!(SCHEME_LAMBDA_FLAGS(data) & LAMBDA_SFS)) {
SCHEME_LAMBDA_FLAGS(data) |= LAMBDA_SFS;
info = scheme_new_sfs_info(data->max_let_depth);
scheme_sfs_push(info, data->closure_size + data->num_params, 1);
@ -1215,7 +1215,7 @@ static Scheme_Object *sfs_closure(Scheme_Object *expr, SFS_Info *info, int self_
}
/* Never clear typed arguments or typed closure elements: */
if (SCHEME_CLOSURE_DATA_FLAGS(data) & CLOS_HAS_TYPED_ARGS) {
if (SCHEME_LAMBDA_FLAGS(data) & LAMBDA_HAS_TYPED_ARGS) {
int delta, size, ct, j, pos;
mzshort *map;
delta = data->closure_size;
@ -1223,7 +1223,7 @@ static Scheme_Object *sfs_closure(Scheme_Object *expr, SFS_Info *info, int self_
map = data->closure_map;
for (j = 0; j < size; j++) {
ct = scheme_boxmap_get(map, j, delta);
if (ct > CLOS_TYPE_TYPE_OFFSET) {
if (ct > LAMBDA_TYPE_TYPE_OFFSET) {
if (j < data->num_params)
pos = info->stackpos + delta + j;
else
@ -1233,7 +1233,7 @@ static Scheme_Object *sfs_closure(Scheme_Object *expr, SFS_Info *info, int self_
}
}
code = scheme_sfs(data->code, info, data->max_let_depth);
code = scheme_sfs(data->body, info, data->max_let_depth);
/* If any arguments go unused, and if there's a non-tail,
non-immediate call in the body, then we flush the
@ -1257,11 +1257,11 @@ static Scheme_Object *sfs_closure(Scheme_Object *expr, SFS_Info *info, int self_
if (SCHEME_PAIRP(clears))
code = scheme_sfs_add_clears(code, clears, 1);
if (SCHEME_CLOSURE_DATA_FLAGS(data) & CLOS_HAS_REST)
SCHEME_CLOSURE_DATA_FLAGS(data) |= CLOS_NEED_REST_CLEAR;
if (SCHEME_LAMBDA_FLAGS(data) & LAMBDA_HAS_REST)
SCHEME_LAMBDA_FLAGS(data) |= LAMBDA_NEED_REST_CLEAR;
}
data->code = code;
data->body = code;
}
return expr;
@ -1388,7 +1388,7 @@ Scheme_Object *scheme_sfs_expr(Scheme_Object *expr, SFS_Info *info, int closure_
case scheme_with_cont_mark_type:
expr = sfs_wcm(expr, info);
break;
case scheme_unclosed_procedure_type:
case scheme_lambda_type:
expr = sfs_closure(expr, info, closure_self_pos);
break;
case scheme_let_value_type:
@ -1411,11 +1411,11 @@ Scheme_Object *scheme_sfs_expr(Scheme_Object *expr, SFS_Info *info, int closure_
code = sfs_closure((Scheme_Object *)c->code, info, closure_self_pos);
if (SAME_TYPE(SCHEME_TYPE(code), scheme_begin0_sequence_type)) {
Scheme_Sequence *seq = (Scheme_Sequence *)code;
c->code = (Scheme_Closure_Data *)seq->array[0];
c->code = (Scheme_Lambda *)seq->array[0];
seq->array[0] = expr;
expr = code;
} else {
c->code = (Scheme_Closure_Data *)code;
c->code = (Scheme_Lambda *)code;
}
}
}

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

@ -10,7 +10,7 @@ enum {
scheme_application3_type, /* 5 */
scheme_sequence_type, /* 6 */
scheme_branch_type, /* 7 */
scheme_unclosed_procedure_type, /* 8 */
scheme_lambda_type, /* 8 */
scheme_let_value_type, /* 9 */
scheme_let_void_type, /* 10 */
scheme_letrec_type, /* 11 */
@ -35,13 +35,13 @@ enum {
_scheme_values_types_, /* All following types are values */
/* intermediate compiled: */
scheme_compiled_local_type, /* 30 */
scheme_compiled_unclosed_procedure_type,/* 31 */
scheme_compiled_let_value_type, /* 32 */
scheme_compiled_let_void_type, /* 33 */
scheme_compiled_toplevel_type, /* 34 */
scheme_compiled_quote_syntax_type, /* 35 */
/* intermediate compiled variants (as seen by optimizer): */
scheme_ir_local_type, /* 30 */
scheme_ir_lambda_type, /* 31 */
scheme_ir_let_value_type, /* 32 */
scheme_ir_let_void_type, /* 33 */
scheme_ir_toplevel_type, /* 34 */
scheme_ir_quote_syntax_type, /* 35 */
scheme_quote_compilation_type, /* used while writing, only */
@ -49,7 +49,7 @@ enum {
scheme_variable_type, /* 37 */
scheme_module_variable_type, /* link replaces with scheme_variable_type */
_scheme_compiled_values_types_, /* 39 */
_scheme_ir_values_types_, /* 39 */
/* procedure types */
scheme_prim_type, /* 40 */
@ -97,7 +97,7 @@ enum {
scheme_true_type, /* 73 */
scheme_false_type, /* 74 */
scheme_void_type, /* 75 */
scheme_syntax_compiler_type, /* 76 */
scheme_primitive_syntax_type, /* 76 */
scheme_macro_type, /* 77 */
scheme_box_type, /* 78 */
scheme_thread_type, /* 79 */
@ -237,7 +237,7 @@ enum {
scheme_rt_cont_mark, /* 209 */
scheme_rt_saved_stack, /* 210 */
scheme_rt_reply_item, /* 211 */
scheme_rt_closure_info, /* 212 */
scheme_rt_ir_lambda_info, /* 212 */
scheme_rt_overflow, /* 213 */
scheme_rt_overflow_jmp, /* 214 */
scheme_rt_meta_cont, /* 215 */

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

@ -5860,14 +5860,14 @@ static void sort_number_array(Scheme_Object **a, intptr_t count)
static int compare_vars_at_resolve(const void *_a, const void *_b)
{
Scheme_Compiled_Local *a = *(Scheme_Compiled_Local **)_a;
Scheme_Compiled_Local *b = *(Scheme_Compiled_Local **)_b;
Scheme_IR_Local *a = *(Scheme_IR_Local **)_a;
Scheme_IR_Local *b = *(Scheme_IR_Local **)_b;
return a->resolve.lex_depth - b->resolve.lex_depth;
}
void scheme_sort_resolve_compiled_local_array(Scheme_Compiled_Local **a, intptr_t count)
void scheme_sort_resolve_ir_local_array(Scheme_IR_Local **a, intptr_t count)
{
my_qsort(a, count, sizeof(Scheme_Compiled_Local *), compare_vars_at_resolve);
my_qsort(a, count, sizeof(Scheme_IR_Local *), compare_vars_at_resolve);
}
static Scheme_Object *drop_export_registries(Scheme_Object *shifts)

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

@ -2720,8 +2720,8 @@ static void do_swap_thread()
Scheme_Closure_Func f;
for (l = thread_swap_callbacks; SCHEME_RPAIRP(l); l = SCHEME_CDR(l)) {
o = SCHEME_CAR(l);
f = SCHEME_CLOS_FUNC(o);
o = SCHEME_CLOS_DATA(o);
f = SCHEME_RAW_CLOS_FUNC(o);
o = SCHEME_RAW_CLOS_DATA(o);
f(o);
}
}
@ -2759,8 +2759,8 @@ static void do_swap_thread()
Scheme_Closure_Func f;
for (l = thread_swap_out_callbacks; SCHEME_RPAIRP(l); l = SCHEME_CDR(l)) {
o = SCHEME_CAR(l);
f = SCHEME_CLOS_FUNC(o);
o = SCHEME_CLOS_DATA(o);
f = SCHEME_RAW_CLOS_FUNC(o);
o = SCHEME_RAW_CLOS_DATA(o);
f(o);
}
}
@ -3056,8 +3056,8 @@ static void start_child(Scheme_Thread * volatile child,
Scheme_Closure_Func f;
for (l = thread_swap_callbacks; SCHEME_RPAIRP(l); l = SCHEME_CDR(l)) {
o = SCHEME_CAR(l);
f = SCHEME_CLOS_FUNC(o);
o = SCHEME_CLOS_DATA(o);
f = SCHEME_RAW_CLOS_FUNC(o);
o = SCHEME_RAW_CLOS_DATA(o);
f(o);
}
}

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

@ -116,8 +116,8 @@ scheme_init_type ()
set_name(scheme_application_type, "<application-code>");
set_name(scheme_application2_type, "<unary-application-code>");
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_ir_lambda_type, "<procedure-semi-code>");
set_name(scheme_lambda_type, "<procedure-code>");
set_name(scheme_branch_type, "<branch-code>");
set_name(scheme_sequence_type, "<sequence-code>");
set_name(scheme_with_cont_mark_type, "<with-continuation-mark-code>");
@ -140,11 +140,11 @@ scheme_init_type ()
set_name(scheme_let_value_type, "<let-value-code>");
set_name(scheme_let_void_type, "<let-void-code>");
set_name(scheme_compiled_local_type, "<local-semi-code>");
set_name(scheme_compiled_let_value_type, "<let-value-semi-code>");
set_name(scheme_compiled_let_void_type, "<let-void-semi-code>");
set_name(scheme_compiled_toplevel_type, "<variable-semi-code>");
set_name(scheme_compiled_quote_syntax_type, "<quote-syntax-semi-code>");
set_name(scheme_ir_local_type, "<local-semi-code>");
set_name(scheme_ir_let_value_type, "<let-value-semi-code>");
set_name(scheme_ir_let_void_type, "<let-void-semi-code>");
set_name(scheme_ir_toplevel_type, "<variable-semi-code>");
set_name(scheme_ir_quote_syntax_type, "<quote-syntax-semi-code>");
set_name(scheme_letrec_type, "<letrec-code>");
set_name(scheme_let_one_type, "<let-one-code>");
set_name(scheme_quote_compilation_type, "<quote-code>");
@ -187,7 +187,7 @@ scheme_init_type ()
#endif
set_name(scheme_symbol_type, "<symbol>");
set_name(scheme_keyword_type, "<keyword>");
set_name(scheme_syntax_compiler_type, "<syntax-compiler>");
set_name(scheme_primitive_syntax_type, "<primitive-syntax>");
set_name(scheme_macro_type, "<macro>");
set_name(scheme_vector_type, "<vector>");
set_name(scheme_flvector_type, "<flvector>");
@ -314,7 +314,7 @@ scheme_init_type ()
set_name(scheme_fsemaphore_type, "<fsemaphore>");
set_name(_scheme_values_types_, "<resurrected>");
set_name(_scheme_compiled_values_types_, "<internal>");
set_name(_scheme_ir_values_types_, "<internal>");
set_name(scheme_place_type, "<place>");
set_name(scheme_place_async_channel_type, "<place-half-channel>");
@ -562,7 +562,7 @@ void scheme_register_traversers(void)
GC_REG_TRAV(scheme_application3_type, app3_rec);
GC_REG_TRAV(scheme_sequence_type, seq_rec);
GC_REG_TRAV(scheme_branch_type, branch_rec);
GC_REG_TRAV(scheme_unclosed_procedure_type, unclosed_proc);
GC_REG_TRAV(scheme_lambda_type, unclosed_proc);
GC_REG_TRAV(scheme_let_value_type, let_value);
GC_REG_TRAV(scheme_let_void_type, let_void);
GC_REG_TRAV(scheme_letrec_type, letrec);
@ -589,16 +589,16 @@ void scheme_register_traversers(void)
GC_REG_TRAV(_scheme_values_types_, bad_trav);
GC_REG_TRAV(scheme_compiled_unclosed_procedure_type, unclosed_proc);
GC_REG_TRAV(scheme_compiled_local_type, comp_local);
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_toplevel_type, toplevel_obj);
GC_REG_TRAV(scheme_compiled_quote_syntax_type, local_obj);
GC_REG_TRAV(scheme_ir_lambda_type, unclosed_proc);
GC_REG_TRAV(scheme_ir_local_type, ir_local);
GC_REG_TRAV(scheme_ir_let_value_type, ir_let_value);
GC_REG_TRAV(scheme_ir_let_void_type, let_header);
GC_REG_TRAV(scheme_ir_toplevel_type, toplevel_obj);
GC_REG_TRAV(scheme_ir_quote_syntax_type, local_obj);
GC_REG_TRAV(scheme_quote_compilation_type, small_object);
GC_REG_TRAV(_scheme_compiled_values_types_, bad_trav);
GC_REG_TRAV(_scheme_ir_values_types_, bad_trav);
GC_REG_TRAV(scheme_prefix_type, prefix_val);
GC_REG_TRAV(scheme_resolve_prefix_type, resolve_prefix_val);
@ -655,7 +655,7 @@ void scheme_register_traversers(void)
GC_REG_TRAV(scheme_true_type, small_atomic_obj);
GC_REG_TRAV(scheme_false_type, small_atomic_obj);
GC_REG_TRAV(scheme_void_type, small_atomic_obj);
GC_REG_TRAV(scheme_syntax_compiler_type, syntax_compiler);
GC_REG_TRAV(scheme_primitive_syntax_type, syntax_compiler);
GC_REG_TRAV(scheme_macro_type, small_object);
GC_REG_TRAV(scheme_box_type, small_object);
GC_REG_TRAV(scheme_thread_type, thread_val);

106
racket/src/racket/src/validate.c
View File

@ -31,8 +31,8 @@
where the abstract values are "not available", "value", "boxed
value", "syntax object", or "global array". */
/* FIXME: validation doesn't check CLOS_SINGLE_RESULT or
CLOS_PRESERVES_MARKS. (Maybe check them in the JIT pass?) */
/* FIXME: validation doesn't check LAMBDA_SINGLE_RESULT or
LAMBDA_PRESERVES_MARKS. (Maybe check them in the JIT pass?) */
static int validate_expr(Mz_CPort *port, Scheme_Object *expr,
char *stack, Validate_TLS tls,
@ -320,7 +320,7 @@ static int define_values_validate(Scheme_Object *data, Mz_CPort *port,
/* It's a lift. Check whether it needs to take reference arguments
and/or install reference info. */
Scheme_Object *app_rator;
Scheme_Closure_Data *data = NULL;
Scheme_Lambda *data = NULL;
int tp = pos - (num_toplevels + num_stxes + (num_stxes ? 1 : 0));
mzshort *a, *new_a = NULL;
@ -333,10 +333,10 @@ static int define_values_validate(Scheme_Object *data, Mz_CPort *port,
app_rator = val;
while (1) {
if (SAME_TYPE(SCHEME_TYPE(app_rator), scheme_closure_type)) {
data = SCHEME_COMPILED_CLOS_CODE(app_rator);
data = SCHEME_CLOSURE_CODE(app_rator);
break;
} else if (SAME_TYPE(SCHEME_TYPE(app_rator), scheme_unclosed_procedure_type)) {
data = (Scheme_Closure_Data *)app_rator;
} else if (SAME_TYPE(SCHEME_TYPE(app_rator), scheme_lambda_type)) {
data = (Scheme_Lambda *)app_rator;
break;
} else if (SAME_TYPE(SCHEME_TYPE(app_rator), scheme_toplevel_type)) {
/* Record an indirection */
@ -353,16 +353,16 @@ static int define_values_validate(Scheme_Object *data, Mz_CPort *port,
}
}
if (data) {
if (SCHEME_CLOSURE_DATA_FLAGS(data) & CLOS_HAS_TYPED_ARGS) {
if (SCHEME_LAMBDA_FLAGS(data) & LAMBDA_HAS_TYPED_ARGS) {
int sz;
sz = data->num_params;
new_a = MALLOC_N_ATOMIC(mzshort, (sz + 2));
new_a[0] = -sz;
new_a[sz+1] = !!(SCHEME_CLOSURE_DATA_FLAGS(data) & CLOS_HAS_REST);
new_a[sz+1] = !!(SCHEME_LAMBDA_FLAGS(data) & LAMBDA_HAS_REST);
for (i = 0; i < sz; i++) {
int ct;
ct = scheme_boxmap_get(data->closure_map, i, data->closure_size);
if (ct == CLOS_TYPE_BOXED)
if (ct == LAMBDA_TYPE_BOXED)
new_a[i + 1] = 1;
else
new_a[i + 1] = 0;
@ -597,7 +597,7 @@ static void case_lambda_validate(Scheme_Object *data, Mz_CPort *port, char *stac
for (i = 0; i < seq->count; i++) {
e = seq->array[i];
if (!SAME_TYPE(SCHEME_TYPE(e), scheme_unclosed_procedure_type)
if (!SAME_TYPE(SCHEME_TYPE(e), scheme_lambda_type)
&& !SAME_TYPE(SCHEME_TYPE(e), scheme_closure_type))
scheme_ill_formed_code(port);
validate_expr(port, e, stack, tls, depth, letlimit, delta,
@ -799,16 +799,16 @@ int validate_rator_wants_box(Scheme_Object *app_rator, int pos,
Validate_TLS tls,
int num_toplevels, int num_stxes, int num_lifts, void *tl_use_map)
{
Scheme_Closure_Data *data = NULL;
Scheme_Lambda *data = NULL;
Scheme_Type ty;
while (1) {
ty = SCHEME_TYPE(app_rator);
if (SAME_TYPE(ty, scheme_closure_type)) {
data = SCHEME_COMPILED_CLOS_CODE(app_rator);
data = SCHEME_CLOSURE_CODE(app_rator);
break;
} else if (SAME_TYPE(ty, scheme_unclosed_procedure_type)) {
data = (Scheme_Closure_Data *)app_rator;
} else if (SAME_TYPE(ty, scheme_lambda_type)) {
data = (Scheme_Lambda *)app_rator;
break;
} else if (SAME_TYPE(ty, scheme_toplevel_type)) {
int p;
@ -876,11 +876,11 @@ int validate_rator_wants_box(Scheme_Object *app_rator, int pos,
return 0;
}
if (SCHEME_CLOSURE_DATA_FLAGS(data) & CLOS_HAS_TYPED_ARGS) {
if (SCHEME_LAMBDA_FLAGS(data) & LAMBDA_HAS_TYPED_ARGS) {
if (pos < data->num_params) {
int ct;
ct = scheme_boxmap_get(data->closure_map, pos, data->closure_size);
if (ct == CLOS_TYPE_BOXED)
if (ct == LAMBDA_TYPE_BOXED)
return 1;
}
}
@ -903,7 +903,7 @@ void scheme_validate_closure(Mz_CPort *port, Scheme_Object *expr,
mzshort *tl_state, mzshort tl_timestamp,
int self_pos_in_closure, Scheme_Hash_Tree *procs)
{
Scheme_Closure_Data *data = (Scheme_Closure_Data *)expr;
Scheme_Lambda *data = (Scheme_Lambda *)expr;
int i, sz, cnt, base, base2;
char *new_stack;
struct Validate_Clearing *vc;
@ -918,7 +918,7 @@ void scheme_validate_closure(Mz_CPort *port, Scheme_Object *expr,
cnt = data->num_params;
base = sz - cnt;
if (SCHEME_CLOSURE_DATA_FLAGS(data) & CLOS_HAS_TYPED_ARGS) {
if (SCHEME_LAMBDA_FLAGS(data) & LAMBDA_HAS_TYPED_ARGS) {
base2 = data->closure_size;
for (i = 0; i < cnt; i++) {
new_stack[base + i] = closure_stack[base2 + i];
@ -973,7 +973,7 @@ void scheme_validate_closure(Mz_CPort *port, Scheme_Object *expr,
tl_use_map = data->tl_map;
}
validate_expr(port, data->code, new_stack, tls, sz, sz, base,
validate_expr(port, data->body, new_stack, tls, sz, sz, base,
num_toplevels, num_stxes, num_lifts, tl_use_map,
tl_state, tl_timestamp,
NULL, 0, 0, vc, 1, 0, procs, -1, NULL);
@ -986,22 +986,22 @@ static Scheme_Hash_Tree *as_nonempty_procs(Scheme_Hash_Tree *procs)
return procs;
}
static void validate_unclosed_procedure(Mz_CPort *port, Scheme_Object *expr,
char *stack, Validate_TLS tls,
int depth, int delta,
int num_toplevels, int num_stxes, int num_lifts, void *tl_use_map,
mzshort *tl_state, mzshort tl_timestamp,
Scheme_Object *app_rator, int proc_with_refs_ok,
int self_pos, Scheme_Hash_Tree *procs)
static void validate_lambda(Mz_CPort *port, Scheme_Object *expr,
char *stack, Validate_TLS tls,
int depth, int delta,
int num_toplevels, int num_stxes, int num_lifts, void *tl_use_map,
mzshort *tl_state, mzshort tl_timestamp,
Scheme_Object *app_rator, int proc_with_refs_ok,
int self_pos, Scheme_Hash_Tree *procs)
{
Scheme_Closure_Data *data = (Scheme_Closure_Data *)expr;
Scheme_Lambda *data = (Scheme_Lambda *)expr;
int i, cnt, q, p, sz, base, stack_delta, vld, self_pos_in_closure = -1, typed_arg = 0;
mzshort *map;
char *closure_stack;
Scheme_Object *proc;
Scheme_Hash_Tree *new_procs = NULL;
if (SCHEME_CLOSURE_DATA_FLAGS(data) & CLOS_HAS_TYPED_ARGS) {
if (SCHEME_LAMBDA_FLAGS(data) & LAMBDA_HAS_TYPED_ARGS) {
sz = data->closure_size + data->num_params;
} else {
sz = data->closure_size;
@ -1013,19 +1013,19 @@ static void validate_unclosed_procedure(Mz_CPort *port, Scheme_Object *expr,
else
closure_stack = NULL;
if (SCHEME_CLOSURE_DATA_FLAGS(data) & CLOS_HAS_TYPED_ARGS) {
if (SCHEME_LAMBDA_FLAGS(data) & LAMBDA_HAS_TYPED_ARGS) {
cnt = data->num_params;
base = sz - cnt;
for (i = 0; i < cnt; i++) {
int ct;
ct = scheme_boxmap_get(map, i, data->closure_size);
if (ct == CLOS_TYPE_BOXED) {
if (ct == LAMBDA_TYPE_BOXED) {
vld = VALID_BOX;
typed_arg = 1;
} else if (ct) {
if ((ct - CLOS_TYPE_TYPE_OFFSET) > SCHEME_MAX_LOCAL_TYPE)
if ((ct - LAMBDA_TYPE_TYPE_OFFSET) > SCHEME_MAX_LOCAL_TYPE)
scheme_ill_formed_code(port);
vld = (VALID_TYPED + (ct - CLOS_TYPE_TYPE_OFFSET));
vld = (VALID_TYPED + (ct - LAMBDA_TYPE_TYPE_OFFSET));
typed_arg = 1;
} else
vld = VALID_VAL;
@ -1052,14 +1052,14 @@ static void validate_unclosed_procedure(Mz_CPort *port, Scheme_Object *expr,
else if (vld == VALID_BOX_NOCLEAR)
vld = VALID_BOX;
if (SCHEME_CLOSURE_DATA_FLAGS(data) & CLOS_HAS_TYPED_ARGS) {
if (SCHEME_LAMBDA_FLAGS(data) & LAMBDA_HAS_TYPED_ARGS) {
int pos = data->num_params + i;
int ct;
ct = scheme_boxmap_get(map, pos, data->closure_size);
if (ct == CLOS_TYPE_BOXED)
if (ct == LAMBDA_TYPE_BOXED)
scheme_ill_formed_code(port);
if (ct > CLOS_TYPE_TYPE_OFFSET) {
if (vld != (VALID_TYPED + (ct - CLOS_TYPE_TYPE_OFFSET)))
if (ct > LAMBDA_TYPE_TYPE_OFFSET) {
if (vld != (VALID_TYPED + (ct - LAMBDA_TYPE_TYPE_OFFSET)))
vld = VALID_NOT;
} else if (vld > VALID_TYPED)
vld = VALID_NOT;
@ -1085,11 +1085,11 @@ static void validate_unclosed_procedure(Mz_CPort *port, Scheme_Object *expr,
tl_timestamp++; /* closure delays use; needed for self-use <= check */
if (SCHEME_RPAIRP(data->code)) {
if (SCHEME_RPAIRP(data->body)) {
/* Delay validation */
Scheme_Object *vec;
vec = scheme_make_vector(11, NULL);
SCHEME_VEC_ELS(vec)[0] = SCHEME_CAR(data->code);
SCHEME_VEC_ELS(vec)[0] = SCHEME_CAR(data->body);
SCHEME_VEC_ELS(vec)[1] = (Scheme_Object *)closure_stack;
SCHEME_VEC_ELS(vec)[2] = (Scheme_Object *)tls;
SCHEME_VEC_ELS(vec)[3] = scheme_make_integer(num_toplevels);
@ -1100,7 +1100,7 @@ static void validate_unclosed_procedure(Mz_CPort *port, Scheme_Object *expr,
SCHEME_VEC_ELS(vec)[8] = tl_use_map ? tl_use_map : scheme_false;
SCHEME_VEC_ELS(vec)[9] = tl_state ? (Scheme_Object *)tl_state : scheme_false;
SCHEME_VEC_ELS(vec)[10] = scheme_make_integer(tl_timestamp);
SCHEME_CAR(data->code) = vec;
SCHEME_CAR(data->body) = vec;
} else
scheme_validate_closure(port, expr, closure_stack, tls,
num_toplevels, num_stxes, num_lifts, tl_use_map,
@ -1771,10 +1771,10 @@ static int validate_expr(Mz_CPort *port, Scheme_Object *expr,
result = validate_join_const(result, expected_results);
}
break;
case scheme_unclosed_procedure_type:
case scheme_lambda_type:
{
no_typed(need_local_type, port);
validate_unclosed_procedure(port, expr, stack, tls, depth, delta,
validate_lambda(port, expr, stack, tls, depth, delta,
num_toplevels, num_stxes, num_lifts, tl_use_map,
tl_state, tl_timestamp,
app_rator, proc_with_refs_ok, -1, procs);
@ -1847,7 +1847,7 @@ static int validate_expr(Mz_CPort *port, Scheme_Object *expr,
case scheme_letrec_type:
{
Scheme_Letrec *l = (Scheme_Letrec *)expr;
Scheme_Closure_Data *data;
Scheme_Lambda *data;
int i, c;
c = l->count;
@ -1856,7 +1856,7 @@ static int validate_expr(Mz_CPort *port, Scheme_Object *expr,
scheme_ill_formed_code(port);
for (i = 0; i < c; i++) {
if (!SAME_TYPE(SCHEME_TYPE(l->procs[i]), scheme_unclosed_procedure_type))
if (!SAME_TYPE(SCHEME_TYPE(l->procs[i]), scheme_lambda_type))
scheme_ill_formed_code(port);
}
@ -1866,8 +1866,8 @@ static int validate_expr(Mz_CPort *port, Scheme_Object *expr,
scheme_ill_formed_code(port);
#endif
stack[delta + i] = VALID_VAL;
data = (Scheme_Closure_Data *)l->procs[i];
if (SCHEME_CLOSURE_DATA_FLAGS(data) & CLOS_HAS_TYPED_ARGS) {
data = (Scheme_Lambda *)l->procs[i];
if (SCHEME_LAMBDA_FLAGS(data) & LAMBDA_HAS_TYPED_ARGS) {
/* If any arguments (as opposed to closure slots) are typed, then
add the procedure to `procs': */
int j;
@ -1884,7 +1884,7 @@ static int validate_expr(Mz_CPort *port, Scheme_Object *expr,
}
for (i = 0; i < c; i++) {
validate_unclosed_procedure(port, l->procs[i], stack, tls, depth, delta,
validate_lambda(port, l->procs[i], stack, tls, depth, delta,
num_toplevels, num_stxes, num_lifts, tl_use_map,
tl_state, tl_timestamp,
NULL, 1, i, procs);
@ -2053,7 +2053,7 @@ static int validate_expr(Mz_CPort *port, Scheme_Object *expr,
result_ignored, vc, tailpos, procs);
result = validate_join_const(result, expected_results);
break;
case scheme_compiled_local_type:
case scheme_ir_local_type:
{
scheme_ill_formed_code(port);
}
@ -2066,15 +2066,15 @@ static int validate_expr(Mz_CPort *port, Scheme_Object *expr,
/* If the closure is not empty, then it must be from 3-D code
(where PLT_VALIDATE_COMPILE is set), and validation is not
our responsibility here: */
&& (SCHEME_COMPILED_CLOS_CODE(expr)->closure_size == 0)) {
Scheme_Closure_Data *data;
&& (SCHEME_CLOSURE_CODE(expr)->closure_size == 0)) {
Scheme_Lambda *data;
no_typed(need_local_type, port);
expr = (Scheme_Object *)SCHEME_COMPILED_CLOS_CODE(expr);
data = (Scheme_Closure_Data *)expr;
if (SCHEME_CLOSURE_DATA_FLAGS(data) & CLOS_VALIDATED) {
expr = (Scheme_Object *)SCHEME_CLOSURE_CODE(expr);
data = (Scheme_Lambda *)expr;
if (SCHEME_LAMBDA_FLAGS(data) & LAMBDA_VALIDATED) {
/* Done with this one. */
} else {
SCHEME_CLOSURE_DATA_FLAGS(data) |= CLOS_VALIDATED;
SCHEME_LAMBDA_FLAGS(data) |= LAMBDA_VALIDATED;
did_one = 0;
goto top;
}