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

fix detection of flonum primitives when the JIT cannot inline

Browse Source
This commit is contained in:
Matthew Flatt 2010-06-11 04:18:39 -04:00
parent 0b55de2e6e
commit 1e1202d6f2
5 changed files with 107 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -640,12 +640,17 @@ typedef struct Scheme_Offset_Cptr
#define SCHEME_PRIM_STRUCT_TYPE_INDEXED_SETTER (128 | 256)
#define SCHEME_PRIM_TYPE_PARAMETER 64
#define SCHEME_PRIM_TYPE_STRUCT_PROP_GETTER (64 | 128)
/* combinations still available: 64|256, 64|128|256 */
#define SCHEME_PRIM_SOMETIMES_INLINED (64 | 256)
/* combination still available: 64|128|256 */
#define SCHEME_PRIM_IS_STRUCT_PROC (SCHEME_PRIM_IS_STRUCT_INDEXED_GETTER | SCHEME_PRIM_IS_STRUCT_PRED | SCHEME_PRIM_IS_STRUCT_OTHER)
#define SCHEME_PRIM_PROC_FLAGS(x) (((Scheme_Prim_Proc_Header *)x)->flags)
#define SCHEME_PRIM_IS_SOMETIMES_INLINED(rator) \
(((SCHEME_PRIM_PROC_FLAGS(rator) & SCHEME_PRIM_OTHER_TYPE_MASK) == SCHEME_PRIM_SOMETIMES_INLINED) \
|| (SCHEME_PRIM_PROC_FLAGS(rator) & (SCHEME_PRIM_IS_UNARY_INLINED | SCHEME_PRIM_IS_BINARY_INLINED)))
typedef struct Scheme_Object *(Scheme_Prim)(int argc, Scheme_Object *argv[]);
typedef struct Scheme_Object *(Scheme_Primitive_Closure_Proc)(int argc, struct Scheme_Object *argv[], Scheme_Object *p);

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

@ -2997,7 +2997,7 @@ int scheme_wants_flonum_arguments(Scheme_Object *rator, int argpos, int rotate_m
|| (rotate_mode && IS_NAMED_PRIM(rator, "unsafe-flvector-ref"))
|| (rotate_mode && IS_NAMED_PRIM(rator, "unsafe-fx->fl")))
return 1;
} else if (SCHEME_PRIM_PROC_FLAGS(rator) & SCHEME_PRIM_IS_UNARY_INLINED) {
} else if (SCHEME_PRIM_IS_SOMETIMES_INLINED(rator)) {
if (!rotate_mode) {
if (IS_NAMED_PRIM(rator, "flabs")
|| IS_NAMED_PRIM(rator, "flsqrt")
@ -3015,7 +3015,7 @@ int scheme_wants_flonum_arguments(Scheme_Object *rator, int argpos, int rotate_m
|| IS_NAMED_PRIM(rator, "flexp"))
return 1;
}
} else if (SCHEME_PRIM_PROC_FLAGS(rator) & SCHEME_PRIM_IS_BINARY_INLINED) {
} else if (SCHEME_PRIM_IS_SOMETIMES_INLINED(rator)) {
if (!rotate_mode) {
if (IS_NAMED_PRIM(rator, "fl+")
|| IS_NAMED_PRIM(rator, "fl-")
@ -3029,7 +3029,7 @@ int scheme_wants_flonum_arguments(Scheme_Object *rator, int argpos, int rotate_m
|| IS_NAMED_PRIM(rator, "flmax"))
return 1;
}
} else if (SCHEME_PRIM_PROC_FLAGS(rator) & SCHEME_PRIM_IS_NARY_INLINED) {
} else if (SCHEME_PRIM_IS_SOMETIMES_INLINED(rator)) {
if ((rotate_mode || (argpos == 2))
&& IS_NAMED_PRIM(rator, "unsafe-flvector-set!"))
return 1;
@ -3068,7 +3068,7 @@ static int produces_unboxed(Scheme_Object *rator, int *non_fl_args, int argc, in
if (non_fl_args) *non_fl_args = 1;
return 1;
}
} else if ((argc == 1) && (SCHEME_PRIM_PROC_FLAGS(rator) & SCHEME_PRIM_IS_UNARY_INLINED)) {
} 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")
@ -3088,7 +3088,7 @@ static int produces_unboxed(Scheme_Object *rator, int *non_fl_args, int argc, in
if (non_fl_args) *non_fl_args = 1;
return 1;
}
} else if ((argc ==2) && (SCHEME_PRIM_PROC_FLAGS(rator) & SCHEME_PRIM_IS_BINARY_INLINED)) {
} 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+")

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

@ -166,31 +166,43 @@ void scheme_init_flfxnum_numarith(Scheme_Env *env)
p = scheme_make_folding_prim(fl_plus, "fl+", 2, 2, 1);
if (scheme_can_inline_fp_op())
SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_IS_BINARY_INLINED;
else
SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_SOMETIMES_INLINED;
scheme_add_global_constant("fl+", p, env);
p = scheme_make_folding_prim(fl_minus, "fl-", 2, 2, 1);
if (scheme_can_inline_fp_op())
SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_IS_BINARY_INLINED;
else
SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_SOMETIMES_INLINED;
scheme_add_global_constant("fl-", p, env);
p = scheme_make_folding_prim(fl_mult, "fl*", 2, 2, 1);
if (scheme_can_inline_fp_op())
SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_IS_BINARY_INLINED;
else
SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_SOMETIMES_INLINED;
scheme_add_global_constant("fl*", p, env);
p = scheme_make_folding_prim(fl_div, "fl/", 2, 2, 1);
if (scheme_can_inline_fp_op())
SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_IS_BINARY_INLINED;
else
SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_SOMETIMES_INLINED;
scheme_add_global_constant("fl/", p, env);
p = scheme_make_folding_prim(fl_abs, "flabs", 1, 1, 1);
if (scheme_can_inline_fp_op())
SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_IS_UNARY_INLINED;
else
SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_SOMETIMES_INLINED;
scheme_add_global_constant("flabs", p, env);
p = scheme_make_folding_prim(fl_sqrt, "flsqrt", 1, 1, 1);
if (scheme_can_inline_fp_op() && SQRT_MACHINE_CODE_AVAILABLE)
SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_IS_UNARY_INLINED;
else
SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_SOMETIMES_INLINED;
scheme_add_global_constant("flsqrt", p, env);
}
@ -237,36 +249,48 @@ void scheme_init_unsafe_numarith(Scheme_Env *env)
p = scheme_make_folding_prim(unsafe_fl_plus, "unsafe-fl+", 2, 2, 1);
if (scheme_can_inline_fp_op())
SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_IS_BINARY_INLINED;
else
SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_SOMETIMES_INLINED;
SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_IS_UNSAFE_FUNCTIONAL;
scheme_add_global_constant("unsafe-fl+", p, env);
p = scheme_make_folding_prim(unsafe_fl_minus, "unsafe-fl-", 2, 2, 1);
if (scheme_can_inline_fp_op())
SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_IS_BINARY_INLINED;
else
SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_SOMETIMES_INLINED;
SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_IS_UNSAFE_FUNCTIONAL;
scheme_add_global_constant("unsafe-fl-", p, env);
p = scheme_make_folding_prim(unsafe_fl_mult, "unsafe-fl*", 2, 2, 1);
if (scheme_can_inline_fp_op())
SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_IS_BINARY_INLINED;
else
SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_SOMETIMES_INLINED;
SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_IS_UNSAFE_FUNCTIONAL;
scheme_add_global_constant("unsafe-fl*", p, env);
p = scheme_make_folding_prim(unsafe_fl_div, "unsafe-fl/", 2, 2, 1);
if (scheme_can_inline_fp_op())
SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_IS_BINARY_INLINED;
else
SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_SOMETIMES_INLINED;
SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_IS_UNSAFE_FUNCTIONAL;
scheme_add_global_constant("unsafe-fl/", p, env);
p = scheme_make_folding_prim(unsafe_fl_abs, "unsafe-flabs", 1, 1, 1);
if (scheme_can_inline_fp_op())
SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_IS_UNARY_INLINED;
else
SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_SOMETIMES_INLINED;
SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_IS_UNSAFE_FUNCTIONAL;
scheme_add_global_constant("unsafe-flabs", p, env);
p = scheme_make_folding_prim(unsafe_fl_sqrt, "unsafe-flsqrt", 1, 1, 1);
if (scheme_can_inline_fp_op() && SQRT_MACHINE_CODE_AVAILABLE)
SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_IS_UNARY_INLINED;
else
SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_SOMETIMES_INLINED;
SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_IS_UNSAFE_FUNCTIONAL;
scheme_add_global_constant("unsafe-flsqrt", p, env);
}

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

@ -521,6 +521,8 @@ scheme_init_number (Scheme_Env *env)
1, 1, 1);
if (scheme_can_inline_fp_op())
SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_IS_UNARY_INLINED;
else
SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_SOMETIMES_INLINED;
scheme_add_global_constant("exact->inexact", p, env);
scheme_add_global_constant("inexact->exact",
@ -559,6 +561,8 @@ void scheme_init_flfxnum_number(Scheme_Env *env)
2, 2);
if (scheme_can_inline_fp_op())
SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_IS_BINARY_INLINED;
else
SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_SOMETIMES_INLINED;
scheme_add_global_constant("flvector-ref", p, env);
p = scheme_make_immed_prim(scheme_checked_flvector_set,
@ -570,6 +574,8 @@ void scheme_init_flfxnum_number(Scheme_Env *env)
p = scheme_make_folding_prim(integer_to_fl, "->fl", 1, 1, 1);
if (scheme_can_inline_fp_op())
SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_IS_UNARY_INLINED;
else
SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_SOMETIMES_INLINED;
scheme_add_global_constant("->fl", p, env);
@ -600,67 +606,93 @@ void scheme_init_flfxnum_number(Scheme_Env *env)
p = scheme_make_folding_prim(fx_to_fl, "fx->fl", 1, 1, 1);
if (scheme_can_inline_fp_op())
SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_IS_UNARY_INLINED;
else
SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_SOMETIMES_INLINED;
scheme_add_global_constant("fx->fl", p, env);
p = scheme_make_folding_prim(fl_truncate, "fltruncate", 1, 1, 1);
if (scheme_can_inline_fp_op())
SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_IS_UNARY_INLINED;
else
SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_SOMETIMES_INLINED;
scheme_add_global_constant("fltruncate", p, env);
p = scheme_make_folding_prim(fl_round, "flround", 1, 1, 1);
if (scheme_can_inline_fp_op())
SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_IS_UNARY_INLINED;
else
SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_SOMETIMES_INLINED;
scheme_add_global_constant("flround", p, env);
p = scheme_make_folding_prim(fl_ceiling, "flceiling", 1, 1, 1);
if (scheme_can_inline_fp_op())
SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_IS_UNARY_INLINED;
else
SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_SOMETIMES_INLINED;
scheme_add_global_constant("flceiling", p, env);
p = scheme_make_folding_prim(fl_floor, "flfloor", 1, 1, 1);
if (scheme_can_inline_fp_op())
SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_IS_UNARY_INLINED;
else
SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_SOMETIMES_INLINED;
scheme_add_global_constant("flfloor", p, env);
p = scheme_make_folding_prim(fl_sin, "flsin", 1, 1, 1);
if (scheme_can_inline_fp_op())
SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_IS_UNARY_INLINED;
else
SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_SOMETIMES_INLINED;
scheme_add_global_constant("flsin", p, env);
p = scheme_make_folding_prim(fl_cos, "flcos", 1, 1, 1);
if (scheme_can_inline_fp_op())
SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_IS_UNARY_INLINED;
else
SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_SOMETIMES_INLINED;
scheme_add_global_constant("flcos", p, env);
p = scheme_make_folding_prim(fl_tan, "fltan", 1, 1, 1);
if (scheme_can_inline_fp_op())
SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_IS_UNARY_INLINED;
else
SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_SOMETIMES_INLINED;
scheme_add_global_constant("fltan", p, env);
p = scheme_make_folding_prim(fl_asin, "flasin", 1, 1, 1);
if (scheme_can_inline_fp_op())
SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_IS_UNARY_INLINED;
else
SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_SOMETIMES_INLINED;
scheme_add_global_constant("flasin", p, env);
p = scheme_make_folding_prim(fl_acos, "flacos", 1, 1, 1);
if (scheme_can_inline_fp_op())
SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_IS_UNARY_INLINED;
else
SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_SOMETIMES_INLINED;
scheme_add_global_constant("flacos", p, env);
p = scheme_make_folding_prim(fl_atan, "flatan", 1, 1, 1);
if (scheme_can_inline_fp_op())
SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_IS_UNARY_INLINED;
else
SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_SOMETIMES_INLINED;
scheme_add_global_constant("flatan", p, env);
p = scheme_make_folding_prim(fl_log, "fllog", 1, 1, 1);
if (scheme_can_inline_fp_op())
SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_IS_UNARY_INLINED;
else
SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_SOMETIMES_INLINED;
scheme_add_global_constant("fllog", p, env);
p = scheme_make_folding_prim(fl_exp, "flexp", 1, 1, 1);
if (scheme_can_inline_fp_op())
SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_IS_UNARY_INLINED;
else
SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_SOMETIMES_INLINED;
scheme_add_global_constant("flexp", p, env);
}
@ -701,6 +733,8 @@ void scheme_init_unsafe_number(Scheme_Env *env)
p = scheme_make_folding_prim(unsafe_fx_to_fl, "unsafe-fx->fl", 1, 1, 1);
if (scheme_can_inline_fp_op())
SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_IS_UNARY_INLINED;
else
SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_SOMETIMES_INLINED;
SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_IS_UNSAFE_FUNCTIONAL;
scheme_add_global_constant("unsafe-fx->fl", p, env);
@ -708,6 +742,8 @@ void scheme_init_unsafe_number(Scheme_Env *env)
2, 2);
if (scheme_can_inline_fp_op())
SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_IS_BINARY_INLINED;
else
SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_SOMETIMES_INLINED;
SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_IS_UNSAFE_FUNCTIONAL;
scheme_add_global_constant("unsafe-f64vector-ref", p, env);
@ -715,6 +751,8 @@ void scheme_init_unsafe_number(Scheme_Env *env)
3, 3);
if (scheme_can_inline_fp_op())
SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_IS_NARY_INLINED;
else
SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_SOMETIMES_INLINED;
scheme_add_global_constant("unsafe-f64vector-set!", p, env);
p = scheme_make_immed_prim(unsafe_flvector_length, "unsafe-flvector-length",
@ -727,6 +765,8 @@ void scheme_init_unsafe_number(Scheme_Env *env)
2, 2);
if (scheme_can_inline_fp_op())
SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_IS_BINARY_INLINED;
else
SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_SOMETIMES_INLINED;
SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_IS_UNSAFE_FUNCTIONAL;
scheme_add_global_constant("unsafe-flvector-ref", p, env);

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

@ -151,47 +151,65 @@ void scheme_init_flfxnum_numcomp(Scheme_Env *env)
p = scheme_make_folding_prim(fx_min, "fxmin", 2, 2, 1);
if (scheme_can_inline_fp_comp())
SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_IS_BINARY_INLINED;
else
SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_SOMETIMES_INLINED;
scheme_add_global_constant("fxmin", p, env);
p = scheme_make_folding_prim(fx_max, "fxmax", 2, 2, 1);
if (scheme_can_inline_fp_comp())
SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_IS_BINARY_INLINED;
else
SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_SOMETIMES_INLINED;
scheme_add_global_constant("fxmax", p, env);
p = scheme_make_folding_prim(fl_eq, "fl=", 2, 2, 1);
if (scheme_can_inline_fp_comp())
SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_IS_BINARY_INLINED;
else
SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_SOMETIMES_INLINED;
scheme_add_global_constant("fl=", p, env);
p = scheme_make_folding_prim(fl_lt, "fl<", 2, 2, 1);
if (scheme_can_inline_fp_comp())
SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_IS_BINARY_INLINED;
else
SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_SOMETIMES_INLINED;
scheme_add_global_constant("fl<", p, env);
p = scheme_make_folding_prim(fl_gt, "fl>", 2, 2, 1);
if (scheme_can_inline_fp_comp())
SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_IS_BINARY_INLINED;
else
SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_SOMETIMES_INLINED;
scheme_add_global_constant("fl>", p, env);
p = scheme_make_folding_prim(fl_lt_eq, "fl<=", 2, 2, 1);
if (scheme_can_inline_fp_comp())
SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_IS_BINARY_INLINED;
else
SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_SOMETIMES_INLINED;
scheme_add_global_constant("fl<=", p, env);
p = scheme_make_folding_prim(fl_gt_eq, "fl>=", 2, 2, 1);
if (scheme_can_inline_fp_comp())
SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_IS_BINARY_INLINED;
else
SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_SOMETIMES_INLINED;
scheme_add_global_constant("fl>=", p, env);
p = scheme_make_folding_prim(fl_min, "flmin", 2, 2, 1);
if (scheme_can_inline_fp_op())
SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_IS_BINARY_INLINED;
else
SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_SOMETIMES_INLINED;
scheme_add_global_constant("flmin", p, env);
p = scheme_make_folding_prim(fl_max, "flmax", 2, 2, 1);
if (scheme_can_inline_fp_op())
SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_IS_BINARY_INLINED;
else
SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_SOMETIMES_INLINED;
scheme_add_global_constant("flmax", p, env);
}
@ -237,42 +255,56 @@ void scheme_init_unsafe_numcomp(Scheme_Env *env)
p = scheme_make_folding_prim(unsafe_fl_eq, "unsafe-fl=", 2, 2, 1);
if (scheme_can_inline_fp_comp())
SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_IS_BINARY_INLINED;
else
SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_SOMETIMES_INLINED;
SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_IS_UNSAFE_FUNCTIONAL;
scheme_add_global_constant("unsafe-fl=", p, env);
p = scheme_make_folding_prim(unsafe_fl_lt, "unsafe-fl<", 2, 2, 1);
if (scheme_can_inline_fp_comp())
SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_IS_BINARY_INLINED;
else
SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_SOMETIMES_INLINED;
SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_IS_UNSAFE_FUNCTIONAL;
scheme_add_global_constant("unsafe-fl<", p, env);
p = scheme_make_folding_prim(unsafe_fl_gt, "unsafe-fl>", 2, 2, 1);
if (scheme_can_inline_fp_comp())
SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_IS_BINARY_INLINED;
else
SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_SOMETIMES_INLINED;
SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_IS_UNSAFE_FUNCTIONAL;
scheme_add_global_constant("unsafe-fl>", p, env);
p = scheme_make_folding_prim(unsafe_fl_lt_eq, "unsafe-fl<=", 2, 2, 1);
if (scheme_can_inline_fp_comp())
SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_IS_BINARY_INLINED;
else
SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_SOMETIMES_INLINED;
SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_IS_UNSAFE_FUNCTIONAL;
scheme_add_global_constant("unsafe-fl<=", p, env);
p = scheme_make_folding_prim(unsafe_fl_gt_eq, "unsafe-fl>=", 2, 2, 1);
if (scheme_can_inline_fp_comp())
SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_IS_BINARY_INLINED;
else
SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_SOMETIMES_INLINED;
SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_IS_UNSAFE_FUNCTIONAL;
scheme_add_global_constant("unsafe-fl>=", p, env);
p = scheme_make_folding_prim(unsafe_fl_min, "unsafe-flmin", 2, 2, 1);
if (scheme_can_inline_fp_op())
SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_IS_BINARY_INLINED;
else
SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_SOMETIMES_INLINED;
SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_IS_UNSAFE_FUNCTIONAL;
scheme_add_global_constant("unsafe-flmin", p, env);
p = scheme_make_folding_prim(unsafe_fl_max, "unsafe-flmax", 2, 2, 1);
if (scheme_can_inline_fp_op())
SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_IS_BINARY_INLINED;
else
SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_SOMETIMES_INLINED;
SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_IS_UNSAFE_FUNCTIONAL;
scheme_add_global_constant("unsafe-flmax", p, env);
}