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

bytecode compiler: replace table of local types with flags on primitives

Browse Source 
This change makes it easier to annotate more primitives, so functions like
`integer-length' are now annotated as producing a fixnum.
This commit is contained in:
Matthew Flatt 2012-11-17 12:47:29 -07:00
parent c5d3178602
commit 7a8f5f20fc
8 changed files with 272 additions and 279 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -669,9 +669,9 @@ typedef struct Scheme_Offset_Cptr
#define SCHEME_PRIM_OTHER_TYPE_MASK (32 | 64 | 128 | 256)
#define SCHEME_PRIM_IS_METHOD 512
#define SCHEME_PRIM_OPT_INDEX_SIZE 5
#define SCHEME_PRIM_OPT_INDEX_SIZE 6
#define SCHEME_PRIM_OPT_INDEX_SHIFT 10
#define SCHEME_PRIM_OPT_INDEX_MASK (((1 << SCHEME_PRIM_OPT_INDEX_SIZE) - 1) << SCHEME_PRIM_OPT_INDEX_SHIFT)
#define SCHEME_PRIM_OPT_INDEX_MASK ((1 << SCHEME_PRIM_OPT_INDEX_SIZE) - 1)
/* Values with SCHEME_PRIM_OPT_MASK, earlier implies later: */
#define SCHEME_PRIM_OPT_FOLDING 3

90
src/racket/src/numarith.c
View File

@ -136,31 +136,38 @@ void scheme_init_flfxnum_numarith(Scheme_Env *env)
int flags;
p = scheme_make_folding_prim(fx_plus, "fx+", 2, 2, 1);
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_BINARY_INLINED);
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_BINARY_INLINED
| SCHEME_PRIM_PRODUCES_FIXNUM);
scheme_add_global_constant("fx+", p, env);
p = scheme_make_folding_prim(fx_minus, "fx-", 2, 2, 1);
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_BINARY_INLINED);
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_BINARY_INLINED
| SCHEME_PRIM_PRODUCES_FIXNUM);
scheme_add_global_constant("fx-", p, env);
p = scheme_make_folding_prim(fx_mult, "fx*", 2, 2, 1);
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_BINARY_INLINED);
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_BINARY_INLINED
| SCHEME_PRIM_PRODUCES_FIXNUM);
scheme_add_global_constant("fx*", p, env);
p = scheme_make_folding_prim(fx_div, "fxquotient", 2, 2, 1);
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_BINARY_INLINED);
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_BINARY_INLINED
| SCHEME_PRIM_PRODUCES_FIXNUM);
scheme_add_global_constant("fxquotient", p, env);
p = scheme_make_folding_prim(fx_rem, "fxremainder", 2, 2, 1);
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_BINARY_INLINED);
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_BINARY_INLINED
| SCHEME_PRIM_PRODUCES_FIXNUM);
scheme_add_global_constant("fxremainder", p, env);
p = scheme_make_folding_prim(fx_mod, "fxmodulo", 2, 2, 1);
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_BINARY_INLINED);
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_BINARY_INLINED
| SCHEME_PRIM_PRODUCES_FIXNUM);
scheme_add_global_constant("fxmodulo", p, env);
p = scheme_make_folding_prim(fx_abs, "fxabs", 1, 1, 1);
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_UNARY_INLINED);
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_UNARY_INLINED)
| SCHEME_PRIM_PRODUCES_FIXNUM;
scheme_add_global_constant("fxabs", p, env);
p = scheme_make_folding_prim(fl_plus, "fl+", 2, 2, 1);
@ -168,7 +175,9 @@ void scheme_init_flfxnum_numarith(Scheme_Env *env)
flags = SCHEME_PRIM_IS_BINARY_INLINED;
else
flags = SCHEME_PRIM_SOMETIMES_INLINED;
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(flags);
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(flags
| SCHEME_PRIM_PRODUCES_FLONUM
| SCHEME_PRIM_WANTS_FLONUM_BOTH);
scheme_add_global_constant("fl+", p, env);
p = scheme_make_folding_prim(fl_minus, "fl-", 2, 2, 1);
@ -176,7 +185,9 @@ void scheme_init_flfxnum_numarith(Scheme_Env *env)
flags = SCHEME_PRIM_IS_BINARY_INLINED;
else
flags = SCHEME_PRIM_SOMETIMES_INLINED;
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(flags);
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(flags
| SCHEME_PRIM_PRODUCES_FLONUM
| SCHEME_PRIM_WANTS_FLONUM_BOTH);
scheme_add_global_constant("fl-", p, env);
p = scheme_make_folding_prim(fl_mult, "fl*", 2, 2, 1);
@ -184,7 +195,9 @@ void scheme_init_flfxnum_numarith(Scheme_Env *env)
flags = SCHEME_PRIM_IS_BINARY_INLINED;
else
flags = SCHEME_PRIM_SOMETIMES_INLINED;
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(flags);
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(flags
| SCHEME_PRIM_PRODUCES_FLONUM
| SCHEME_PRIM_WANTS_FLONUM_BOTH);
scheme_add_global_constant("fl*", p, env);
p = scheme_make_folding_prim(fl_div, "fl/", 2, 2, 1);
@ -192,7 +205,9 @@ void scheme_init_flfxnum_numarith(Scheme_Env *env)
flags = SCHEME_PRIM_IS_BINARY_INLINED;
else
flags = SCHEME_PRIM_SOMETIMES_INLINED;
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(flags);
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(flags
| SCHEME_PRIM_PRODUCES_FLONUM
| SCHEME_PRIM_WANTS_FLONUM_BOTH);
scheme_add_global_constant("fl/", p, env);
p = scheme_make_folding_prim(fl_abs, "flabs", 1, 1, 1);
@ -200,7 +215,9 @@ void scheme_init_flfxnum_numarith(Scheme_Env *env)
flags = SCHEME_PRIM_IS_UNARY_INLINED;
else
flags = SCHEME_PRIM_SOMETIMES_INLINED;
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(flags);
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(flags
| SCHEME_PRIM_PRODUCES_FLONUM
| SCHEME_PRIM_WANTS_FLONUM_FIRST);
scheme_add_global_constant("flabs", p, env);
p = scheme_make_folding_prim(fl_sqrt, "flsqrt", 1, 1, 1);
@ -208,7 +225,9 @@ void scheme_init_flfxnum_numarith(Scheme_Env *env)
flags = SCHEME_PRIM_IS_UNARY_INLINED;
else
flags = SCHEME_PRIM_SOMETIMES_INLINED;
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(flags);
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(flags
| SCHEME_PRIM_PRODUCES_FLONUM
| SCHEME_PRIM_WANTS_FLONUM_FIRST);
scheme_add_global_constant("flsqrt", p, env);
}
@ -219,37 +238,44 @@ void scheme_init_unsafe_numarith(Scheme_Env *env)
p = scheme_make_folding_prim(unsafe_fx_plus, "unsafe-fx+", 2, 2, 1);
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_BINARY_INLINED
| SCHEME_PRIM_IS_UNSAFE_FUNCTIONAL);
| SCHEME_PRIM_IS_UNSAFE_FUNCTIONAL
| SCHEME_PRIM_PRODUCES_FIXNUM);
scheme_add_global_constant("unsafe-fx+", p, env);
p = scheme_make_folding_prim(unsafe_fx_minus, "unsafe-fx-", 2, 2, 1);
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_BINARY_INLINED
| SCHEME_PRIM_IS_UNSAFE_FUNCTIONAL);
| SCHEME_PRIM_IS_UNSAFE_FUNCTIONAL
| SCHEME_PRIM_PRODUCES_FIXNUM);
scheme_add_global_constant("unsafe-fx-", p, env);
p = scheme_make_folding_prim(unsafe_fx_mult, "unsafe-fx*", 2, 2, 1);
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_BINARY_INLINED
| SCHEME_PRIM_IS_UNSAFE_FUNCTIONAL);
| SCHEME_PRIM_IS_UNSAFE_FUNCTIONAL
| SCHEME_PRIM_PRODUCES_FIXNUM);
scheme_add_global_constant("unsafe-fx*", p, env);
p = scheme_make_folding_prim(unsafe_fx_div, "unsafe-fxquotient", 2, 2, 1);
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_BINARY_INLINED
| SCHEME_PRIM_IS_UNSAFE_FUNCTIONAL);
| SCHEME_PRIM_IS_UNSAFE_FUNCTIONAL
| SCHEME_PRIM_PRODUCES_FIXNUM);
scheme_add_global_constant("unsafe-fxquotient", p, env);
p = scheme_make_folding_prim(unsafe_fx_rem, "unsafe-fxremainder", 2, 2, 1);
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_BINARY_INLINED
| SCHEME_PRIM_IS_UNSAFE_FUNCTIONAL);
| SCHEME_PRIM_IS_UNSAFE_FUNCTIONAL
| SCHEME_PRIM_PRODUCES_FIXNUM);
scheme_add_global_constant("unsafe-fxremainder", p, env);
p = scheme_make_folding_prim(unsafe_fx_mod, "unsafe-fxmodulo", 2, 2, 1);
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_BINARY_INLINED
| SCHEME_PRIM_IS_UNSAFE_FUNCTIONAL);
| SCHEME_PRIM_IS_UNSAFE_FUNCTIONAL
| SCHEME_PRIM_PRODUCES_FIXNUM);
scheme_add_global_constant("unsafe-fxmodulo", p, env);
p = scheme_make_folding_prim(unsafe_fx_abs, "unsafe-fxabs", 1, 1, 1);
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_UNARY_INLINED
| SCHEME_PRIM_IS_UNSAFE_FUNCTIONAL);
| SCHEME_PRIM_IS_UNSAFE_FUNCTIONAL
| SCHEME_PRIM_PRODUCES_FIXNUM);
scheme_add_global_constant("unsafe-fxabs", p, env);
@ -259,7 +285,9 @@ void scheme_init_unsafe_numarith(Scheme_Env *env)
else
flags = SCHEME_PRIM_SOMETIMES_INLINED;
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(flags
| SCHEME_PRIM_IS_UNSAFE_FUNCTIONAL);
| SCHEME_PRIM_IS_UNSAFE_FUNCTIONAL
| SCHEME_PRIM_PRODUCES_FLONUM
| SCHEME_PRIM_WANTS_FLONUM_BOTH);
scheme_add_global_constant("unsafe-fl+", p, env);
p = scheme_make_folding_prim(unsafe_fl_minus, "unsafe-fl-", 2, 2, 1);
@ -268,7 +296,9 @@ void scheme_init_unsafe_numarith(Scheme_Env *env)
else
flags = SCHEME_PRIM_SOMETIMES_INLINED;
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(flags
| SCHEME_PRIM_IS_UNSAFE_FUNCTIONAL);
| SCHEME_PRIM_IS_UNSAFE_FUNCTIONAL
| SCHEME_PRIM_PRODUCES_FLONUM
| SCHEME_PRIM_WANTS_FLONUM_BOTH);
scheme_add_global_constant("unsafe-fl-", p, env);
p = scheme_make_folding_prim(unsafe_fl_mult, "unsafe-fl*", 2, 2, 1);
@ -277,7 +307,9 @@ void scheme_init_unsafe_numarith(Scheme_Env *env)
else
flags = SCHEME_PRIM_SOMETIMES_INLINED;
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(flags
| SCHEME_PRIM_IS_UNSAFE_FUNCTIONAL);
| SCHEME_PRIM_IS_UNSAFE_FUNCTIONAL
| SCHEME_PRIM_PRODUCES_FLONUM
| SCHEME_PRIM_WANTS_FLONUM_BOTH);
scheme_add_global_constant("unsafe-fl*", p, env);
p = scheme_make_folding_prim(unsafe_fl_div, "unsafe-fl/", 2, 2, 1);
@ -286,7 +318,9 @@ void scheme_init_unsafe_numarith(Scheme_Env *env)
else
flags = SCHEME_PRIM_SOMETIMES_INLINED;
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(flags
| SCHEME_PRIM_IS_UNSAFE_FUNCTIONAL);
| SCHEME_PRIM_IS_UNSAFE_FUNCTIONAL
| SCHEME_PRIM_PRODUCES_FLONUM
| SCHEME_PRIM_WANTS_FLONUM_BOTH);
scheme_add_global_constant("unsafe-fl/", p, env);
p = scheme_make_folding_prim(unsafe_fl_abs, "unsafe-flabs", 1, 1, 1);
@ -295,7 +329,9 @@ void scheme_init_unsafe_numarith(Scheme_Env *env)
else
flags = SCHEME_PRIM_SOMETIMES_INLINED;
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(flags
| SCHEME_PRIM_IS_UNSAFE_FUNCTIONAL);
| SCHEME_PRIM_IS_UNSAFE_FUNCTIONAL
| SCHEME_PRIM_PRODUCES_FLONUM
| SCHEME_PRIM_WANTS_FLONUM_FIRST);
scheme_add_global_constant("unsafe-flabs", p, env);
p = scheme_make_folding_prim(unsafe_fl_sqrt, "unsafe-flsqrt", 1, 1, 1);
@ -304,7 +340,9 @@ void scheme_init_unsafe_numarith(Scheme_Env *env)
else
flags = SCHEME_PRIM_SOMETIMES_INLINED;
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(flags
| SCHEME_PRIM_IS_UNSAFE_FUNCTIONAL);
| SCHEME_PRIM_IS_UNSAFE_FUNCTIONAL
| SCHEME_PRIM_PRODUCES_FLONUM
| SCHEME_PRIM_WANTS_FLONUM_FIRST);
scheme_add_global_constant("unsafe-flsqrt", p, env);
}

159
src/racket/src/number.c
View File

@ -451,11 +451,9 @@ scheme_init_number (Scheme_Env *env)
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_BINARY_INLINED);
scheme_add_global_constant("arithmetic-shift", p, env);
scheme_add_global_constant("integer-length",
scheme_make_folding_prim(integer_length,
"integer-length",
1, 1, 1),
env);
p = scheme_make_folding_prim(integer_length, "integer-length", 1, 1, 1);
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_PRODUCES_FIXNUM);
scheme_add_global_constant("integer-length", p, env);
scheme_add_global_constant("gcd",
scheme_make_folding_prim(gcd,
@ -626,7 +624,8 @@ void scheme_init_flfxnum_number(Scheme_Env *env)
GLOBAL_PRIM_W_ARITY("make-shared-flvector", make_shared_flvector, 1, 2, env);
p = scheme_make_immed_prim(flvector_length, "flvector-length", 1, 1);
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_UNARY_INLINED);
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_UNARY_INLINED
| SCHEME_PRIM_PRODUCES_FIXNUM);
scheme_add_global_constant("flvector-length", p, env);
p = scheme_make_immed_prim(scheme_checked_flvector_ref,
@ -636,13 +635,15 @@ void scheme_init_flfxnum_number(Scheme_Env *env)
flags = SCHEME_PRIM_IS_BINARY_INLINED;
else
flags = SCHEME_PRIM_SOMETIMES_INLINED;
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(flags);
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(flags
| SCHEME_PRIM_PRODUCES_FLONUM);
scheme_add_global_constant("flvector-ref", p, env);
p = scheme_make_immed_prim(scheme_checked_flvector_set,
"flvector-set!",
3, 3);
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_NARY_INLINED);
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_NARY_INLINED
| SCHEME_PRIM_WANTS_FLONUM_THIRD);
scheme_add_global_constant("flvector-set!", p, env);
scheme_add_global_constant("fxvector",
@ -665,13 +666,15 @@ void scheme_init_flfxnum_number(Scheme_Env *env)
GLOBAL_PRIM_W_ARITY("make-shared-fxvector", make_shared_fxvector, 1, 2, env);
p = scheme_make_immed_prim(fxvector_length, "fxvector-length", 1, 1);
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_UNARY_INLINED);
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_UNARY_INLINED
| SCHEME_PRIM_PRODUCES_FIXNUM);
scheme_add_global_constant("fxvector-length", p, env);
p = scheme_make_immed_prim(scheme_checked_fxvector_ref,
"fxvector-ref",
2, 2);
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_BINARY_INLINED);
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_BINARY_INLINED
| SCHEME_PRIM_PRODUCES_FIXNUM);
scheme_add_global_constant("fxvector-ref", p, env);
p = scheme_make_immed_prim(scheme_checked_fxvector_set,
@ -698,27 +701,33 @@ void scheme_init_flfxnum_number(Scheme_Env *env)
p = scheme_make_folding_prim(fx_and, "fxand", 2, 2, 1);
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_BINARY_INLINED);
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_BINARY_INLINED
| SCHEME_PRIM_PRODUCES_FIXNUM);
scheme_add_global_constant("fxand", p, env);
p = scheme_make_folding_prim(fx_or, "fxior", 2, 2, 1);
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_BINARY_INLINED);
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_BINARY_INLINED
| SCHEME_PRIM_PRODUCES_FIXNUM);
scheme_add_global_constant("fxior", p, env);
p = scheme_make_folding_prim(fx_xor, "fxxor", 2, 2, 1);
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_BINARY_INLINED);
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_BINARY_INLINED
| SCHEME_PRIM_PRODUCES_FIXNUM);
scheme_add_global_constant("fxxor", p, env);
p = scheme_make_folding_prim(fx_not, "fxnot", 1, 1, 1);
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_UNARY_INLINED);
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_UNARY_INLINED
| SCHEME_PRIM_PRODUCES_FIXNUM);
scheme_add_global_constant("fxnot", p, env);
p = scheme_make_folding_prim(fx_lshift, "fxlshift", 2, 2, 1);
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_BINARY_INLINED);
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_BINARY_INLINED
| SCHEME_PRIM_PRODUCES_FIXNUM);
scheme_add_global_constant("fxlshift", p, env);
p = scheme_make_folding_prim(fx_rshift, "fxrshift", 2, 2, 1);
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_BINARY_INLINED);
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_BINARY_INLINED
| SCHEME_PRIM_PRODUCES_FIXNUM);
scheme_add_global_constant("fxrshift", p, env);
p = scheme_make_folding_prim(fx_to_fl, "fx->fl", 1, 1, 1);
@ -726,7 +735,8 @@ void scheme_init_flfxnum_number(Scheme_Env *env)
flags = SCHEME_PRIM_IS_UNARY_INLINED;
else
flags = SCHEME_PRIM_SOMETIMES_INLINED;
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(flags);
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(flags
| SCHEME_PRIM_PRODUCES_FLONUM);
scheme_add_global_constant("fx->fl", p, env);
p = scheme_make_folding_prim(fl_to_fx, "fl->fx", 1, 1, 1);
@ -734,7 +744,9 @@ void scheme_init_flfxnum_number(Scheme_Env *env)
flags = SCHEME_PRIM_IS_UNARY_INLINED;
else
flags = SCHEME_PRIM_SOMETIMES_INLINED;
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(flags);
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(flags
| SCHEME_PRIM_WANTS_FLONUM_FIRST
| SCHEME_PRIM_PRODUCES_FIXNUM);
scheme_add_global_constant("fl->fx", p, env);
@ -743,7 +755,9 @@ void scheme_init_flfxnum_number(Scheme_Env *env)
flags = SCHEME_PRIM_IS_UNARY_INLINED;
else
flags = SCHEME_PRIM_SOMETIMES_INLINED;
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(flags);
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(flags
| SCHEME_PRIM_WANTS_FLONUM_FIRST
| SCHEME_PRIM_PRODUCES_FLONUM);
scheme_add_global_constant("fltruncate", p, env);
p = scheme_make_folding_prim(fl_round, "flround", 1, 1, 1);
@ -751,7 +765,9 @@ void scheme_init_flfxnum_number(Scheme_Env *env)
flags = SCHEME_PRIM_IS_UNARY_INLINED;
else
flags = SCHEME_PRIM_SOMETIMES_INLINED;
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(flags);
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(flags
| SCHEME_PRIM_WANTS_FLONUM_FIRST
| SCHEME_PRIM_PRODUCES_FLONUM);
scheme_add_global_constant("flround", p, env);
p = scheme_make_folding_prim(fl_ceiling, "flceiling", 1, 1, 1);
@ -759,7 +775,9 @@ void scheme_init_flfxnum_number(Scheme_Env *env)
flags = SCHEME_PRIM_IS_UNARY_INLINED;
else
flags = SCHEME_PRIM_SOMETIMES_INLINED;
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(flags);
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(flags
| SCHEME_PRIM_WANTS_FLONUM_FIRST
| SCHEME_PRIM_PRODUCES_FLONUM);
scheme_add_global_constant("flceiling", p, env);
p = scheme_make_folding_prim(fl_floor, "flfloor", 1, 1, 1);
@ -767,7 +785,9 @@ void scheme_init_flfxnum_number(Scheme_Env *env)
flags = SCHEME_PRIM_IS_UNARY_INLINED;
else
flags = SCHEME_PRIM_SOMETIMES_INLINED;
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(flags);
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(flags
| SCHEME_PRIM_WANTS_FLONUM_FIRST
| SCHEME_PRIM_PRODUCES_FLONUM);
scheme_add_global_constant("flfloor", p, env);
p = scheme_make_folding_prim(fl_sin, "flsin", 1, 1, 1);
@ -775,7 +795,9 @@ void scheme_init_flfxnum_number(Scheme_Env *env)
flags = SCHEME_PRIM_IS_UNARY_INLINED;
else
flags = SCHEME_PRIM_SOMETIMES_INLINED;
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(flags);
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(flags
| SCHEME_PRIM_WANTS_FLONUM_FIRST
| SCHEME_PRIM_PRODUCES_FLONUM);
scheme_add_global_constant("flsin", p, env);
p = scheme_make_folding_prim(fl_cos, "flcos", 1, 1, 1);
@ -783,7 +805,9 @@ void scheme_init_flfxnum_number(Scheme_Env *env)
flags = SCHEME_PRIM_IS_UNARY_INLINED;
else
flags = SCHEME_PRIM_SOMETIMES_INLINED;
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(flags);
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(flags
| SCHEME_PRIM_WANTS_FLONUM_FIRST
| SCHEME_PRIM_PRODUCES_FLONUM);
scheme_add_global_constant("flcos", p, env);
p = scheme_make_folding_prim(fl_tan, "fltan", 1, 1, 1);
@ -791,7 +815,9 @@ void scheme_init_flfxnum_number(Scheme_Env *env)
flags = SCHEME_PRIM_IS_UNARY_INLINED;
else
flags = SCHEME_PRIM_SOMETIMES_INLINED;
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(flags);
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(flags
| SCHEME_PRIM_WANTS_FLONUM_FIRST
| SCHEME_PRIM_PRODUCES_FLONUM);
scheme_add_global_constant("fltan", p, env);
p = scheme_make_folding_prim(fl_asin, "flasin", 1, 1, 1);
@ -799,7 +825,9 @@ void scheme_init_flfxnum_number(Scheme_Env *env)
flags = SCHEME_PRIM_IS_UNARY_INLINED;
else
flags = SCHEME_PRIM_SOMETIMES_INLINED;
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(flags);
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(flags
| SCHEME_PRIM_WANTS_FLONUM_FIRST
| SCHEME_PRIM_PRODUCES_FLONUM);
scheme_add_global_constant("flasin", p, env);
p = scheme_make_folding_prim(fl_acos, "flacos", 1, 1, 1);
@ -807,7 +835,9 @@ void scheme_init_flfxnum_number(Scheme_Env *env)
flags = SCHEME_PRIM_IS_UNARY_INLINED;
else
flags = SCHEME_PRIM_SOMETIMES_INLINED;
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(flags);
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(flags
| SCHEME_PRIM_WANTS_FLONUM_FIRST
| SCHEME_PRIM_PRODUCES_FLONUM);
scheme_add_global_constant("flacos", p, env);
p = scheme_make_folding_prim(fl_atan, "flatan", 1, 1, 1);
@ -815,7 +845,9 @@ void scheme_init_flfxnum_number(Scheme_Env *env)
flags = SCHEME_PRIM_IS_UNARY_INLINED;
else
flags = SCHEME_PRIM_SOMETIMES_INLINED;
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(flags);
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(flags
| SCHEME_PRIM_WANTS_FLONUM_FIRST
| SCHEME_PRIM_PRODUCES_FLONUM);
scheme_add_global_constant("flatan", p, env);
p = scheme_make_folding_prim(fl_log, "fllog", 1, 1, 1);
@ -823,7 +855,9 @@ void scheme_init_flfxnum_number(Scheme_Env *env)
flags = SCHEME_PRIM_IS_UNARY_INLINED;
else
flags = SCHEME_PRIM_SOMETIMES_INLINED;
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(flags);
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(flags
| SCHEME_PRIM_WANTS_FLONUM_FIRST
| SCHEME_PRIM_PRODUCES_FLONUM);
scheme_add_global_constant("fllog", p, env);
p = scheme_make_folding_prim(fl_exp, "flexp", 1, 1, 1);
@ -831,7 +865,9 @@ void scheme_init_flfxnum_number(Scheme_Env *env)
flags = SCHEME_PRIM_IS_UNARY_INLINED;
else
flags = SCHEME_PRIM_SOMETIMES_INLINED;
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(flags);
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(flags
| SCHEME_PRIM_WANTS_FLONUM_FIRST
| SCHEME_PRIM_PRODUCES_FLONUM);
scheme_add_global_constant("flexp", p, env);
p = scheme_make_folding_prim(fl_expt, "flexpt", 2, 2, 1);
@ -839,7 +875,9 @@ void scheme_init_flfxnum_number(Scheme_Env *env)
flags = SCHEME_PRIM_IS_BINARY_INLINED;
else
flags = SCHEME_PRIM_SOMETIMES_INLINED;
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(flags);
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(flags
| SCHEME_PRIM_WANTS_FLONUM_FIRST
| SCHEME_PRIM_PRODUCES_FLONUM);
scheme_add_global_constant("flexpt", p, env);
p = scheme_make_folding_prim(scheme_checked_make_rectangular, "make-flrectangular", 2, 2, 1);
@ -847,11 +885,13 @@ void scheme_init_flfxnum_number(Scheme_Env *env)
scheme_add_global_constant("make-flrectangular", p, env);
p = scheme_make_folding_prim(scheme_checked_real_part, "flreal-part", 1, 1, 1);
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_UNARY_INLINED);
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_UNARY_INLINED
| SCHEME_PRIM_PRODUCES_FLONUM);
scheme_add_global_constant("flreal-part", p, env);
p = scheme_make_folding_prim(scheme_checked_imag_part, "flimag-part", 1, 1, 1);
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_UNARY_INLINED);
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_UNARY_INLINED
| SCHEME_PRIM_PRODUCES_FLONUM);
scheme_add_global_constant("flimag-part", p, env);
}
@ -862,32 +902,38 @@ void scheme_init_unsafe_number(Scheme_Env *env)
p = scheme_make_folding_prim(unsafe_fx_and, "unsafe-fxand", 2, 2, 1);
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_BINARY_INLINED
| SCHEME_PRIM_IS_UNSAFE_FUNCTIONAL);
| SCHEME_PRIM_IS_UNSAFE_FUNCTIONAL
| SCHEME_PRIM_PRODUCES_FIXNUM);
scheme_add_global_constant("unsafe-fxand", p, env);
p = scheme_make_folding_prim(unsafe_fx_or, "unsafe-fxior", 2, 2, 1);
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_BINARY_INLINED
| SCHEME_PRIM_IS_UNSAFE_FUNCTIONAL);
| SCHEME_PRIM_IS_UNSAFE_FUNCTIONAL
| SCHEME_PRIM_PRODUCES_FIXNUM);
scheme_add_global_constant("unsafe-fxior", p, env);
p = scheme_make_folding_prim(unsafe_fx_xor, "unsafe-fxxor", 2, 2, 1);
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_BINARY_INLINED
| SCHEME_PRIM_IS_UNSAFE_FUNCTIONAL);
| SCHEME_PRIM_IS_UNSAFE_FUNCTIONAL
| SCHEME_PRIM_PRODUCES_FIXNUM);
scheme_add_global_constant("unsafe-fxxor", p, env);
p = scheme_make_folding_prim(unsafe_fx_not, "unsafe-fxnot", 1, 1, 1);
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_UNARY_INLINED
| SCHEME_PRIM_IS_UNSAFE_FUNCTIONAL);
| SCHEME_PRIM_IS_UNSAFE_FUNCTIONAL
| SCHEME_PRIM_PRODUCES_FIXNUM);
scheme_add_global_constant("unsafe-fxnot", p, env);
p = scheme_make_folding_prim(unsafe_fx_lshift, "unsafe-fxlshift", 2, 2, 1);
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_BINARY_INLINED
| SCHEME_PRIM_IS_UNSAFE_FUNCTIONAL);
| SCHEME_PRIM_IS_UNSAFE_FUNCTIONAL
| SCHEME_PRIM_PRODUCES_FIXNUM);
scheme_add_global_constant("unsafe-fxlshift", p, env);
p = scheme_make_folding_prim(unsafe_fx_rshift, "unsafe-fxrshift", 2, 2, 1);
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_BINARY_INLINED
| SCHEME_PRIM_IS_UNSAFE_FUNCTIONAL);
| SCHEME_PRIM_IS_UNSAFE_FUNCTIONAL
| SCHEME_PRIM_PRODUCES_FIXNUM);
scheme_add_global_constant("unsafe-fxrshift", p, env);
p = scheme_make_folding_prim(unsafe_fx_to_fl, "unsafe-fx->fl", 1, 1, 1);
@ -895,12 +941,16 @@ void scheme_init_unsafe_number(Scheme_Env *env)
flags = SCHEME_PRIM_IS_UNARY_INLINED;
else
flags = SCHEME_PRIM_SOMETIMES_INLINED;
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(flags | SCHEME_PRIM_IS_UNSAFE_FUNCTIONAL);
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(flags
| SCHEME_PRIM_IS_UNSAFE_FUNCTIONAL
| SCHEME_PRIM_PRODUCES_FLONUM);
scheme_add_global_constant("unsafe-fx->fl", p, env);
p = scheme_make_folding_prim(unsafe_fl_to_fx, "unsafe-fl->fx", 1, 1, 1);
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_UNARY_INLINED
| SCHEME_PRIM_IS_UNSAFE_FUNCTIONAL);
| SCHEME_PRIM_IS_UNSAFE_FUNCTIONAL
| SCHEME_PRIM_WANTS_FLONUM_FIRST
| SCHEME_PRIM_PRODUCES_FIXNUM);
scheme_add_global_constant("unsafe-fl->fx", p, env);
p = scheme_make_immed_prim(fl_ref, "unsafe-f64vector-ref",
@ -911,7 +961,8 @@ void scheme_init_unsafe_number(Scheme_Env *env)
flags = SCHEME_PRIM_SOMETIMES_INLINED;
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(flags
| SCHEME_PRIM_IS_UNSAFE_OMITABLE
| SCHEME_PRIM_IS_OMITABLE);
| SCHEME_PRIM_IS_OMITABLE
| SCHEME_PRIM_PRODUCES_FLONUM);
scheme_add_global_constant("unsafe-f64vector-ref", p, env);
p = scheme_make_immed_prim(fl_set, "unsafe-f64vector-set!",
@ -920,13 +971,15 @@ void scheme_init_unsafe_number(Scheme_Env *env)
flags = SCHEME_PRIM_IS_NARY_INLINED;
else
flags = SCHEME_PRIM_SOMETIMES_INLINED;
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(flags);
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(flags
| SCHEME_PRIM_WANTS_FLONUM_THIRD);
scheme_add_global_constant("unsafe-f64vector-set!", p, env);
p = scheme_make_immed_prim(unsafe_flvector_length, "unsafe-flvector-length",
1, 1);
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_UNARY_INLINED
| SCHEME_PRIM_IS_UNSAFE_FUNCTIONAL);
| SCHEME_PRIM_IS_UNSAFE_FUNCTIONAL
| SCHEME_PRIM_PRODUCES_FIXNUM);
scheme_add_global_constant("unsafe-flvector-length", p, env);
p = scheme_make_immed_prim(unsafe_flvector_ref, "unsafe-flvector-ref",
@ -937,18 +990,21 @@ void scheme_init_unsafe_number(Scheme_Env *env)
flags = SCHEME_PRIM_SOMETIMES_INLINED;
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(flags
| SCHEME_PRIM_IS_UNSAFE_OMITABLE
| SCHEME_PRIM_IS_OMITABLE);
| SCHEME_PRIM_IS_OMITABLE
| SCHEME_PRIM_PRODUCES_FLONUM);
scheme_add_global_constant("unsafe-flvector-ref", p, env);
p = scheme_make_immed_prim(unsafe_flvector_set, "unsafe-flvector-set!",
3, 3);
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_NARY_INLINED);
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_NARY_INLINED
| SCHEME_PRIM_WANTS_FLONUM_THIRD);
scheme_add_global_constant("unsafe-flvector-set!", p, env);
p = scheme_make_immed_prim(unsafe_fxvector_length, "unsafe-fxvector-length",
1, 1);
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_UNARY_INLINED
| SCHEME_PRIM_IS_UNSAFE_FUNCTIONAL);
| SCHEME_PRIM_IS_UNSAFE_FUNCTIONAL
| SCHEME_PRIM_PRODUCES_FIXNUM);
scheme_add_global_constant("unsafe-fxvector-length", p, env);
p = scheme_make_immed_prim(unsafe_fxvector_ref, "unsafe-fxvector-ref",
@ -979,7 +1035,8 @@ void scheme_init_unsafe_number(Scheme_Env *env)
2, 2);
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_BINARY_INLINED
| SCHEME_PRIM_IS_UNSAFE_OMITABLE
| SCHEME_PRIM_IS_OMITABLE);
| SCHEME_PRIM_IS_OMITABLE
| SCHEME_PRIM_PRODUCES_FIXNUM);
scheme_add_global_constant("unsafe-u16vector-ref", p, env);
p = scheme_make_immed_prim(u16_set, "unsafe-u16vector-set!",
@ -994,12 +1051,14 @@ void scheme_init_unsafe_number(Scheme_Env *env)
p = scheme_make_folding_prim(unsafe_flreal_part, "unsafe-flreal-part", 1, 1, 1);
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_UNARY_INLINED
| SCHEME_PRIM_IS_UNSAFE_FUNCTIONAL);
| SCHEME_PRIM_IS_UNSAFE_FUNCTIONAL
| SCHEME_PRIM_PRODUCES_FLONUM);
scheme_add_global_constant("unsafe-flreal-part", p, env);
p = scheme_make_folding_prim(unsafe_flimag_part, "unsafe-flimag-part", 1, 1, 1);
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_UNARY_INLINED
| SCHEME_PRIM_IS_UNSAFE_FUNCTIONAL);
| SCHEME_PRIM_IS_UNSAFE_FUNCTIONAL
| SCHEME_PRIM_PRODUCES_FLONUM);
scheme_add_global_constant("unsafe-flimag-part", p, env);
}

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

@ -154,7 +154,8 @@ void scheme_init_flfxnum_numcomp(Scheme_Env *env)
flags = SCHEME_PRIM_IS_BINARY_INLINED;
else
flags = SCHEME_PRIM_SOMETIMES_INLINED;
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(flags);
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(flags
| SCHEME_PRIM_PRODUCES_FIXNUM);
scheme_add_global_constant("fxmin", p, env);
p = scheme_make_folding_prim(fx_max, "fxmax", 2, 2, 1);
@ -162,7 +163,8 @@ void scheme_init_flfxnum_numcomp(Scheme_Env *env)
flags = SCHEME_PRIM_IS_BINARY_INLINED;
else
flags = SCHEME_PRIM_SOMETIMES_INLINED;
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(flags);
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(flags
| SCHEME_PRIM_PRODUCES_FIXNUM);
scheme_add_global_constant("fxmax", p, env);
@ -171,7 +173,8 @@ void scheme_init_flfxnum_numcomp(Scheme_Env *env)
flags = SCHEME_PRIM_IS_BINARY_INLINED;
else
flags = SCHEME_PRIM_SOMETIMES_INLINED;
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(flags);
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(flags
| SCHEME_PRIM_WANTS_FLONUM_BOTH);
scheme_add_global_constant("fl=", p, env);
p = scheme_make_folding_prim(fl_lt, "fl<", 2, 2, 1);
@ -179,7 +182,8 @@ void scheme_init_flfxnum_numcomp(Scheme_Env *env)
flags = SCHEME_PRIM_IS_BINARY_INLINED;
else
flags = SCHEME_PRIM_SOMETIMES_INLINED;
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(flags);
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(flags
| SCHEME_PRIM_WANTS_FLONUM_BOTH);
scheme_add_global_constant("fl<", p, env);
p = scheme_make_folding_prim(fl_gt, "fl>", 2, 2, 1);
@ -187,7 +191,8 @@ void scheme_init_flfxnum_numcomp(Scheme_Env *env)
flags = SCHEME_PRIM_IS_BINARY_INLINED;
else
flags = SCHEME_PRIM_SOMETIMES_INLINED;
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(flags);
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(flags
| SCHEME_PRIM_WANTS_FLONUM_BOTH);
scheme_add_global_constant("fl>", p, env);
p = scheme_make_folding_prim(fl_lt_eq, "fl<=", 2, 2, 1);
@ -195,7 +200,8 @@ void scheme_init_flfxnum_numcomp(Scheme_Env *env)
flags = SCHEME_PRIM_IS_BINARY_INLINED;
else
flags = SCHEME_PRIM_SOMETIMES_INLINED;
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(flags);
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(flags
| SCHEME_PRIM_WANTS_FLONUM_BOTH);
scheme_add_global_constant("fl<=", p, env);
p = scheme_make_folding_prim(fl_gt_eq, "fl>=", 2, 2, 1);
@ -203,7 +209,8 @@ void scheme_init_flfxnum_numcomp(Scheme_Env *env)
flags = SCHEME_PRIM_IS_BINARY_INLINED;
else
flags = SCHEME_PRIM_SOMETIMES_INLINED;
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(flags);
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(flags
| SCHEME_PRIM_WANTS_FLONUM_BOTH);
scheme_add_global_constant("fl>=", p, env);
p = scheme_make_folding_prim(fl_min, "flmin", 2, 2, 1);
@ -211,7 +218,9 @@ void scheme_init_flfxnum_numcomp(Scheme_Env *env)
flags = SCHEME_PRIM_IS_BINARY_INLINED;
else
flags = SCHEME_PRIM_SOMETIMES_INLINED;
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(flags);
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(flags
| SCHEME_PRIM_PRODUCES_FLONUM
| SCHEME_PRIM_WANTS_FLONUM_BOTH);
scheme_add_global_constant("flmin", p, env);
p = scheme_make_folding_prim(fl_max, "flmax", 2, 2, 1);
@ -219,7 +228,9 @@ void scheme_init_flfxnum_numcomp(Scheme_Env *env)
flags = SCHEME_PRIM_IS_BINARY_INLINED;
else
flags = SCHEME_PRIM_SOMETIMES_INLINED;
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(flags);
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(flags
| SCHEME_PRIM_PRODUCES_FLONUM
| SCHEME_PRIM_WANTS_FLONUM_BOTH);
scheme_add_global_constant("flmax", p, env);
}
@ -255,12 +266,14 @@ void scheme_init_unsafe_numcomp(Scheme_Env *env)
p = scheme_make_folding_prim(unsafe_fx_min, "unsafe-fxmin", 2, 2, 1);
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_BINARY_INLINED
| SCHEME_PRIM_IS_UNSAFE_FUNCTIONAL);
| SCHEME_PRIM_IS_UNSAFE_FUNCTIONAL
| SCHEME_PRIM_PRODUCES_FIXNUM);
scheme_add_global_constant("unsafe-fxmin", p, env);
p = scheme_make_folding_prim(unsafe_fx_max, "unsafe-fxmax", 2, 2, 1);
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_BINARY_INLINED
| SCHEME_PRIM_IS_UNSAFE_FUNCTIONAL);
| SCHEME_PRIM_IS_UNSAFE_FUNCTIONAL
| SCHEME_PRIM_PRODUCES_FIXNUM);
scheme_add_global_constant("unsafe-fxmax", p, env);
p = scheme_make_folding_prim(unsafe_fl_eq, "unsafe-fl=", 2, 2, 1);
@ -269,7 +282,8 @@ void scheme_init_unsafe_numcomp(Scheme_Env *env)
else
flags = SCHEME_PRIM_SOMETIMES_INLINED;
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(flags
| SCHEME_PRIM_IS_UNSAFE_FUNCTIONAL);
| SCHEME_PRIM_IS_UNSAFE_FUNCTIONAL
| SCHEME_PRIM_WANTS_FLONUM_BOTH);
scheme_add_global_constant("unsafe-fl=", p, env);
p = scheme_make_folding_prim(unsafe_fl_lt, "unsafe-fl<", 2, 2, 1);
@ -278,7 +292,8 @@ void scheme_init_unsafe_numcomp(Scheme_Env *env)
else
flags = SCHEME_PRIM_SOMETIMES_INLINED;
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(flags
| SCHEME_PRIM_IS_UNSAFE_FUNCTIONAL);
| SCHEME_PRIM_IS_UNSAFE_FUNCTIONAL
| SCHEME_PRIM_WANTS_FLONUM_BOTH);
scheme_add_global_constant("unsafe-fl<", p, env);
p = scheme_make_folding_prim(unsafe_fl_gt, "unsafe-fl>", 2, 2, 1);
@ -287,7 +302,8 @@ void scheme_init_unsafe_numcomp(Scheme_Env *env)
else
flags = SCHEME_PRIM_SOMETIMES_INLINED;
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(flags
| SCHEME_PRIM_IS_UNSAFE_FUNCTIONAL);
| SCHEME_PRIM_IS_UNSAFE_FUNCTIONAL
| SCHEME_PRIM_WANTS_FLONUM_BOTH);
scheme_add_global_constant("unsafe-fl>", p, env);
p = scheme_make_folding_prim(unsafe_fl_lt_eq, "unsafe-fl<=", 2, 2, 1);
@ -296,7 +312,8 @@ void scheme_init_unsafe_numcomp(Scheme_Env *env)
else
flags = SCHEME_PRIM_SOMETIMES_INLINED;
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(flags
| SCHEME_PRIM_IS_UNSAFE_FUNCTIONAL);
| SCHEME_PRIM_IS_UNSAFE_FUNCTIONAL
| SCHEME_PRIM_WANTS_FLONUM_BOTH);
scheme_add_global_constant("unsafe-fl<=", p, env);
p = scheme_make_folding_prim(unsafe_fl_gt_eq, "unsafe-fl>=", 2, 2, 1);
@ -305,7 +322,8 @@ void scheme_init_unsafe_numcomp(Scheme_Env *env)
else
flags = SCHEME_PRIM_SOMETIMES_INLINED;
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(flags
| SCHEME_PRIM_IS_UNSAFE_FUNCTIONAL);
| SCHEME_PRIM_IS_UNSAFE_FUNCTIONAL
| SCHEME_PRIM_WANTS_FLONUM_BOTH);
scheme_add_global_constant("unsafe-fl>=", p, env);
p = scheme_make_folding_prim(unsafe_fl_min, "unsafe-flmin", 2, 2, 1);
@ -314,7 +332,9 @@ void scheme_init_unsafe_numcomp(Scheme_Env *env)
else
flags = SCHEME_PRIM_SOMETIMES_INLINED;
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(flags
| SCHEME_PRIM_IS_UNSAFE_FUNCTIONAL);
| SCHEME_PRIM_IS_UNSAFE_FUNCTIONAL
| SCHEME_PRIM_PRODUCES_FLONUM
| SCHEME_PRIM_WANTS_FLONUM_BOTH);
scheme_add_global_constant("unsafe-flmin", p, env);
p = scheme_make_folding_prim(unsafe_fl_max, "unsafe-flmax", 2, 2, 1);
@ -323,7 +343,9 @@ void scheme_init_unsafe_numcomp(Scheme_Env *env)
else
flags = SCHEME_PRIM_SOMETIMES_INLINED;
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(flags
| SCHEME_PRIM_IS_UNSAFE_FUNCTIONAL);
| SCHEME_PRIM_IS_UNSAFE_FUNCTIONAL
| SCHEME_PRIM_PRODUCES_FLONUM
| SCHEME_PRIM_WANTS_FLONUM_BOTH);
scheme_add_global_constant("unsafe-flmax", p, env);
}

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

@ -1876,54 +1876,18 @@ static int is_nonmutating_primitive(Scheme_Object *rator, int n)
static int wants_local_type_arguments(Scheme_Object *rator, int argpos)
{
/* See ALWAYS_PREFER_UNBOX_TYPE() for why we don't return SCHEME_LOCAL_TYPE_FIXNUM */
if (SCHEME_PRIMP(rator)) {
if (SCHEME_PRIM_PROC_OPT_FLAGS(rator) & SCHEME_PRIM_IS_UNSAFE_NONMUTATING) {
if (IS_NAMED_PRIM(rator, "unsafe-flabs")
|| IS_NAMED_PRIM(rator, "unsafe-flsqrt")
|| IS_NAMED_PRIM(rator, "unsafe-fl+")
|| IS_NAMED_PRIM(rator, "unsafe-fl-")
|| IS_NAMED_PRIM(rator, "unsafe-fl*")
|| IS_NAMED_PRIM(rator, "unsafe-fl/")
|| IS_NAMED_PRIM(rator, "unsafe-fl<")
|| IS_NAMED_PRIM(rator, "unsafe-fl<=")
|| IS_NAMED_PRIM(rator, "unsafe-fl=")
|| IS_NAMED_PRIM(rator, "unsafe-fl>")
|| IS_NAMED_PRIM(rator, "unsafe-fl>=")
|| IS_NAMED_PRIM(rator, "unsafe-flmin")
|| IS_NAMED_PRIM(rator, "unsafe-flmax")
|| IS_NAMED_PRIM(rator, "unsafe-fl->fx"))
int flags;
flags = SCHEME_PRIM_PROC_OPT_FLAGS(rator);
if (argpos == 0) {
if (flags & SCHEME_PRIM_WANTS_FLONUM_FIRST)
return SCHEME_LOCAL_TYPE_FLONUM;
} else if (SCHEME_PRIM_IS_SOMETIMES_INLINED(rator)) {
if (IS_NAMED_PRIM(rator, "flabs")
|| IS_NAMED_PRIM(rator, "flsqrt")
|| IS_NAMED_PRIM(rator, "fltruncate")
|| IS_NAMED_PRIM(rator, "flround")
|| IS_NAMED_PRIM(rator, "flfloor")
|| IS_NAMED_PRIM(rator, "flceiling")
|| IS_NAMED_PRIM(rator, "flsin")
|| IS_NAMED_PRIM(rator, "flcos")
|| IS_NAMED_PRIM(rator, "fltan")
|| IS_NAMED_PRIM(rator, "flasin")
|| IS_NAMED_PRIM(rator, "flacos")
|| IS_NAMED_PRIM(rator, "flatan")
|| IS_NAMED_PRIM(rator, "fllog")
|| IS_NAMED_PRIM(rator, "flexp")
|| IS_NAMED_PRIM(rator, "flexpt")
|| IS_NAMED_PRIM(rator, "fl+")
|| IS_NAMED_PRIM(rator, "fl-")
|| IS_NAMED_PRIM(rator, "fl*")
|| IS_NAMED_PRIM(rator, "fl/")
|| IS_NAMED_PRIM(rator, "fl<")
|| IS_NAMED_PRIM(rator, "fl<=")
|| IS_NAMED_PRIM(rator, "fl=")
|| IS_NAMED_PRIM(rator, "fl>")
|| IS_NAMED_PRIM(rator, "flmin")
|| IS_NAMED_PRIM(rator, "flmax"))
} else if (argpos == 1) {
if (flags & SCHEME_PRIM_WANTS_FLONUM_SECOND)
return SCHEME_LOCAL_TYPE_FLONUM;
if ((argpos == 2)
&& (IS_NAMED_PRIM(rator, "unsafe-flvector-set!")
|| IS_NAMED_PRIM(rator, "flvector-set!")))
} else if (argpos == 2) {
if (flags & SCHEME_PRIM_WANTS_FLONUM_THIRD)
return SCHEME_LOCAL_TYPE_FLONUM;
}
}
@ -1933,115 +1897,14 @@ static int wants_local_type_arguments(Scheme_Object *rator, int argpos)
static int produces_local_type(Scheme_Object *rator, int argc)
{
if (SCHEME_PRIMP(rator)) {
if (SCHEME_PRIM_PROC_OPT_FLAGS(rator) & SCHEME_PRIM_IS_UNSAFE_NONMUTATING) {
if (((argc == 1)
&& (IS_NAMED_PRIM(rator, "unsafe-flabs")
|| IS_NAMED_PRIM(rator, "unsafe-flsqrt")
|| IS_NAMED_PRIM(rator, "unsafe-flreal-part")
|| IS_NAMED_PRIM(rator, "unsafe-flimag-part")))
|| ((argc == 2)
&& (IS_NAMED_PRIM(rator, "unsafe-fl+")
|| IS_NAMED_PRIM(rator, "unsafe-fl-")
|| IS_NAMED_PRIM(rator, "unsafe-fl*")
|| IS_NAMED_PRIM(rator, "unsafe-fl/")
|| IS_NAMED_PRIM(rator, "unsafe-flmin")
|| IS_NAMED_PRIM(rator, "unsafe-flmax"))))
return SCHEME_LOCAL_TYPE_FLONUM;
if (((argc == 2) && IS_NAMED_PRIM(rator, "unsafe-flvector-ref"))
|| ((argc == 1) && IS_NAMED_PRIM(rator, "unsafe-fx->fl")))
return SCHEME_LOCAL_TYPE_FLONUM;
if (((argc == 1)
&& (IS_NAMED_PRIM(rator, "unsafe-fxabs")
|| IS_NAMED_PRIM(rator, "fxnot")
|| IS_NAMED_PRIM(rator, "unsafe-fl->fx")))
|| ((argc == 2)
&& (IS_NAMED_PRIM(rator, "unsafe-fx+")
|| IS_NAMED_PRIM(rator, "unsafe-fx-")
|| IS_NAMED_PRIM(rator, "unsafe-fx*")
|| IS_NAMED_PRIM(rator, "unsafe-fxquotient")
|| IS_NAMED_PRIM(rator, "unsafe-fxremainder")
|| IS_NAMED_PRIM(rator, "unsafe-fxmodulo")
|| IS_NAMED_PRIM(rator, "unsafe-fxmin")
|| IS_NAMED_PRIM(rator, "unsafe-fxmax")
|| IS_NAMED_PRIM(rator, "fxlshift")
|| IS_NAMED_PRIM(rator, "fxrshift")
|| IS_NAMED_PRIM(rator, "fxior")
|| IS_NAMED_PRIM(rator, "fxand")
|| IS_NAMED_PRIM(rator, "fxxor"))))
return SCHEME_LOCAL_TYPE_FIXNUM;
if (((argc == 2)
&& (IS_NAMED_PRIM(rator, "unsafe-fxvector-ref")
|| IS_NAMED_PRIM(rator, "unsafe-bytes-ref")))
|| ((argc == 1)
&& (IS_NAMED_PRIM(rator, "unsafe-fl->fx")
|| IS_NAMED_PRIM(rator, "unsafe-vector-length")
|| IS_NAMED_PRIM(rator, "unsafe-flvector-length")
|| IS_NAMED_PRIM(rator, "unsafe-fxvector-length")
|| IS_NAMED_PRIM(rator, "unsafe-string-length")
|| IS_NAMED_PRIM(rator, "unsafe-bytes-length"))))
return SCHEME_LOCAL_TYPE_FIXNUM;
} else if ((argc == 1) && SCHEME_PRIM_IS_SOMETIMES_INLINED(rator)) {
if (IS_NAMED_PRIM(rator, "flabs")
|| IS_NAMED_PRIM(rator, "flsqrt")
|| IS_NAMED_PRIM(rator, "fltruncate")
|| IS_NAMED_PRIM(rator, "flround")
|| IS_NAMED_PRIM(rator, "flfloor")
|| IS_NAMED_PRIM(rator, "flceiling")
|| IS_NAMED_PRIM(rator, "flsin")
|| IS_NAMED_PRIM(rator, "flcos")
|| IS_NAMED_PRIM(rator, "fltan")
|| IS_NAMED_PRIM(rator, "flasin")
|| IS_NAMED_PRIM(rator, "flacos")
|| IS_NAMED_PRIM(rator, "flatan")
|| IS_NAMED_PRIM(rator, "fllog")
|| IS_NAMED_PRIM(rator, "flexp")
|| IS_NAMED_PRIM(rator, "flimag-part")
|| IS_NAMED_PRIM(rator, "flreal-part")
|| IS_NAMED_PRIM(rator, "->fl")
|| IS_NAMED_PRIM(rator, "fx->fl"))
return SCHEME_LOCAL_TYPE_FLONUM;
if (IS_NAMED_PRIM(rator, "fxabs")
|| IS_NAMED_PRIM(rator, "fxnot")
|| IS_NAMED_PRIM(rator, "fl->fx")
|| IS_NAMED_PRIM(rator, "vector-length")
|| IS_NAMED_PRIM(rator, "fxvector-length")
|| IS_NAMED_PRIM(rator, "flvector-length")
|| IS_NAMED_PRIM(rator, "string-length")
|| IS_NAMED_PRIM(rator, "bytes-length"))
return SCHEME_LOCAL_TYPE_FIXNUM;
} else if ((argc ==2) && SCHEME_PRIM_IS_SOMETIMES_INLINED(rator)) {
if (IS_NAMED_PRIM(rator, "flabs")
|| IS_NAMED_PRIM(rator, "flsqrt")
|| IS_NAMED_PRIM(rator, "fl+")
|| IS_NAMED_PRIM(rator, "fl-")
|| IS_NAMED_PRIM(rator, "fl*")
|| IS_NAMED_PRIM(rator, "fl/")
|| IS_NAMED_PRIM(rator, "flmin")
|| IS_NAMED_PRIM(rator, "flmax")
|| IS_NAMED_PRIM(rator, "flexpt")
|| IS_NAMED_PRIM(rator, "flvector-ref"))
return SCHEME_LOCAL_TYPE_FLONUM;
if (IS_NAMED_PRIM(rator, "fxabs")
|| IS_NAMED_PRIM(rator, "fx+")
|| IS_NAMED_PRIM(rator, "fx-")
|| IS_NAMED_PRIM(rator, "fx*")
|| IS_NAMED_PRIM(rator, "fxquotient")
|| IS_NAMED_PRIM(rator, "fxremainder")
|| IS_NAMED_PRIM(rator, "fxmodulo")
|| IS_NAMED_PRIM(rator, "fxmin")
|| IS_NAMED_PRIM(rator, "fxmax")
|| IS_NAMED_PRIM(rator, "fxlshift")
|| IS_NAMED_PRIM(rator, "fxrshift")
|| IS_NAMED_PRIM(rator, "fxand")
|| IS_NAMED_PRIM(rator, "fxior")
|| IS_NAMED_PRIM(rator, "fxxor")
|| IS_NAMED_PRIM(rator, "fxvector-ref")
|| IS_NAMED_PRIM(rator, "bytes-ref"))
return SCHEME_LOCAL_TYPE_FIXNUM;
}
if (SCHEME_PRIMP(rator)
&& (argc >= ((Scheme_Primitive_Proc *)rator)->mina)
&& (argc <= ((Scheme_Primitive_Proc *)rator)->mu.maxa)) {
int flags;
flags = SCHEME_PRIM_PROC_OPT_FLAGS(rator);
return SCHEME_PRIM_OPT_TYPE(flags);
}
return 0;
}

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

@ -59,16 +59,25 @@
#define SCHEME_PRIM_IS_UNSAFE_OMITABLE 8
#define SCHEME_PRIM_IS_OMITABLE 16
#define SCHEME_PRIM_IS_UNSAFE_FUNCTIONAL 32
#define SCHEME_PRIM_WANTS_FLONUM_FIRST 64
#define SCHEME_PRIM_WANTS_FLONUM_SECOND 128
#define SCHEME_PRIM_WANTS_FLONUM_THIRD 256
#define SCHEME_PRIM_OPT_TYPE_SHIFT 6
#define SCHEME_PRIM_OPT_TYPE_MASK (SCHEME_MAX_LOCAL_TYPE_MASK << 6)
#define SCHEME_PRIM_OPT_TYPE_SHIFT 9
#define SCHEME_PRIM_OPT_TYPE_MASK (SCHEME_MAX_LOCAL_TYPE_MASK << SCHEME_PRIM_OPT_TYPE_SHIFT)
#define SCHEME_PRIM_OPT_TYPE(x) ((x & SCHEME_PRIM_OPT_TYPE_MASK) >> SCHEME_PRIM_OPT_TYPE_SHIFT)
#define SCHEME_PRIM_PRODUCES_FLONUM (SCHEME_LOCAL_TYPE_FLONUM << SCHEME_PRIM_OPT_TYPE_SHIFT)
#define SCHEME_PRIM_PRODUCES_FIXNUM (SCHEME_LOCAL_TYPE_FIXNUM << SCHEME_PRIM_OPT_TYPE_SHIFT)
#define SCHEME_PRIM_WANTS_FLONUM_BOTH (SCHEME_PRIM_WANTS_FLONUM_FIRST | SCHEME_PRIM_WANTS_FLONUM_SECOND)
extern int scheme_prim_opt_flags[]; /* uses an index from SCHEME_PRIM_OPT_INDEX_MASK */
extern XFORM_NONGCING int scheme_intern_prim_opt_flags(int);
#define SCHEME_PRIM_PROC_OPT_FLAGS(proc) \
scheme_prim_opt_flags[(SCHEME_PRIM_PROC_FLAGS(proc) & SCHEME_PRIM_OPT_INDEX_MASK) \
>> SCHEME_PRIM_OPT_INDEX_SHIFT]
scheme_prim_opt_flags[(SCHEME_PRIM_PROC_FLAGS(proc) >> SCHEME_PRIM_OPT_INDEX_SHIFT) \
& SCHEME_PRIM_OPT_INDEX_MASK]
/*========================================================================*/
/* allocation and GC */

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

@ -417,10 +417,10 @@ scheme_init_string (Scheme_Env *env)
"string",
0, -1),
env);
scheme_add_global_constant("string-length",
scheme_make_folding_prim(string_length,
"string-length",
1, 1, 1),
p = scheme_make_folding_prim(string_length, "string-length", 1, 1, 1);
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_PRODUCES_FIXNUM);
scheme_add_global_constant("string-length", p,
env);
p = scheme_make_immed_prim(scheme_checked_string_ref, "string-ref", 2, 2);
@ -696,14 +696,13 @@ scheme_init_string (Scheme_Env *env)
GLOBAL_PRIM_W_ARITY("make-shared-bytes", make_shared_byte_string, 1, 2, env);
GLOBAL_PRIM_W_ARITY("shared-bytes", shared_byte_string, 0, -1, env);
scheme_add_global_constant("bytes-length",
scheme_make_folding_prim(byte_string_length,
"bytes-length",
1, 1, 1),
env);
p = scheme_make_folding_prim(byte_string_length, "bytes-length", 1, 1, 1);
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_PRODUCES_FIXNUM);
scheme_add_global_constant("bytes-length", p, env);
p = scheme_make_immed_prim(scheme_checked_byte_string_ref, "bytes-ref", 2, 2);
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_BINARY_INLINED);
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_BINARY_INLINED
| SCHEME_PRIM_PRODUCES_FIXNUM);
scheme_add_global_constant("bytes-ref", p, env);
p = scheme_make_immed_prim(scheme_checked_byte_string_set, "bytes-set!", 3, 3);
@ -767,17 +766,14 @@ scheme_init_string (Scheme_Env *env)
1, 1),
env);
p = scheme_make_immed_prim(byte_string_utf8_index, "bytes-utf-8-index", 2, 4);
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_PRODUCES_FIXNUM);
scheme_add_global_constant("bytes-utf-8-index", p, env);
p = scheme_make_immed_prim(byte_string_utf8_length, "bytes-utf-8-length", 1, 4);
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_PRODUCES_FIXNUM);
scheme_add_global_constant("bytes-utf-8-length", p, env);
scheme_add_global_constant("bytes-utf-8-index",
scheme_make_immed_prim(byte_string_utf8_index,
"bytes-utf-8-index",
2, 4),
env);
scheme_add_global_constant("bytes-utf-8-length",
scheme_make_immed_prim(byte_string_utf8_length,
"bytes-utf-8-length",
1, 4),
env);
scheme_add_global_constant("bytes-utf-8-ref",
scheme_make_immed_prim(byte_string_utf8_ref,
"bytes-utf-8-ref",

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

@ -103,7 +103,8 @@ scheme_init_vector (Scheme_Env *env)
scheme_add_global_constant("vector-immutable", p, env);
p = scheme_make_folding_prim(vector_length, "vector-length", 1, 1, 1);
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_UNARY_INLINED);
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_UNARY_INLINED
| SCHEME_PRIM_PRODUCES_FIXNUM);
scheme_add_global_constant("vector-length", p, env);
REGISTER_SO(scheme_vector_ref_proc);
@ -174,13 +175,15 @@ scheme_init_unsafe_vector (Scheme_Env *env)
REGISTER_SO(scheme_unsafe_vector_length_proc);
p = scheme_make_immed_prim(unsafe_vector_len, "unsafe-vector-length", 1, 1);
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_UNARY_INLINED
| SCHEME_PRIM_IS_UNSAFE_FUNCTIONAL);
| SCHEME_PRIM_IS_UNSAFE_FUNCTIONAL
| SCHEME_PRIM_PRODUCES_FIXNUM);
scheme_add_global_constant("unsafe-vector-length", p, env);
scheme_unsafe_vector_length_proc = p;
p = scheme_make_immed_prim(unsafe_vector_star_len, "unsafe-vector*-length", 1, 1);
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_UNARY_INLINED
| SCHEME_PRIM_IS_UNSAFE_FUNCTIONAL);
| SCHEME_PRIM_IS_UNSAFE_FUNCTIONAL
| SCHEME_PRIM_PRODUCES_FIXNUM);
scheme_add_global_constant("unsafe-vector*-length", p, env);
p = scheme_make_immed_prim(unsafe_vector_ref, "unsafe-vector-ref", 2, 2);
@ -225,7 +228,8 @@ scheme_init_unsafe_vector (Scheme_Env *env)
p = scheme_make_immed_prim(unsafe_string_len, "unsafe-string-length", 1, 1);
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_UNARY_INLINED
| SCHEME_PRIM_IS_UNSAFE_FUNCTIONAL);
| SCHEME_PRIM_IS_UNSAFE_FUNCTIONAL
| SCHEME_PRIM_PRODUCES_FIXNUM);
scheme_add_global_constant("unsafe-string-length", p, env);
p = scheme_make_immed_prim(unsafe_string_ref, "unsafe-string-ref", 2, 2);
@ -240,13 +244,15 @@ scheme_init_unsafe_vector (Scheme_Env *env)
p = scheme_make_immed_prim(unsafe_bytes_len, "unsafe-bytes-length", 1, 1);
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_UNARY_INLINED
| SCHEME_PRIM_IS_UNSAFE_FUNCTIONAL);
| SCHEME_PRIM_IS_UNSAFE_FUNCTIONAL
| SCHEME_PRIM_PRODUCES_FIXNUM);
scheme_add_global_constant("unsafe-bytes-length", p, env);
p = scheme_make_immed_prim(unsafe_bytes_ref, "unsafe-bytes-ref", 2, 2);
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_BINARY_INLINED
| SCHEME_PRIM_IS_UNSAFE_OMITABLE
| SCHEME_PRIM_IS_OMITABLE);
| SCHEME_PRIM_IS_OMITABLE
| SCHEME_PRIM_PRODUCES_FIXNUM);
scheme_add_global_constant("unsafe-bytes-ref", p, env);
p = scheme_make_immed_prim(unsafe_bytes_set, "unsafe-bytes-set!", 3, 3);