repairs to extflonum changes

This commit is contained in:
Matthew Flatt 2013-01-29 05:53:05 -07:00
parent 74986a42e3
commit 28493dcc88
6 changed files with 25 additions and 20 deletions

View File

@ -285,8 +285,8 @@
(define module-type-num 26)
(define inline-variants-type-num 27)
(define variable-type-num 35)
(define prefix-type-num 113)
(define free-id-info-type-num 162)
(define prefix-type-num 114)
(define free-id-info-type-num 164)
(define-syntax define-enum
(syntax-rules ()

View File

@ -2470,8 +2470,8 @@ int scheme_generate_inlined_binary(mz_jit_state *jitter, Scheme_App3_Rec *app, i
ref_f3 = jit_bner_i(jit_forward(), JIT_R2, JIT_V1);
/* check in range of type treated by eqv: */
ref_f4 = jit_blti_i(jit_forward(), JIT_R2, scheme_char_type);
ref_f5 = jit_bgti_i(jit_forward(), JIT_R2, scheme_complex_type);
ref_f4 = jit_blti_i(jit_forward(), JIT_R2, scheme_integer_type);
ref_f5 = jit_bgti_i(jit_forward(), JIT_R2, scheme_char_type);
CHECK_LIMIT();
/* in range of interesting types, so break out the generic comparison */

View File

@ -170,7 +170,6 @@ READ_ONLY static Scheme_Object *kernel_modidx;
READ_ONLY static Scheme_Module *kernel;
READ_ONLY static Scheme_Object *flfxnum_modname;
READ_ONLY static Scheme_Object *extfl_modname;
READ_ONLY static Scheme_Object *extfl_unsafe_modname;
READ_ONLY static Scheme_Object *futures_modname;
READ_ONLY static Scheme_Object *unsafe_modname;

View File

@ -443,9 +443,9 @@ void scheme_init_extfl_unsafe_numcomp(Scheme_Env *env)
p = scheme_make_folding_prim(unsafe_extfl_eq, "unsafe-extfl=", 2, 2, 1);
if (MZ_LONG_DOUBLE_AND(scheme_can_inline_fp_comp()))
SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_IS_BINARY_INLINED;
flags = SCHEME_PRIM_IS_BINARY_INLINED;
else
SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_SOMETIMES_INLINED;
flags = SCHEME_PRIM_SOMETIMES_INLINED;
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(flags
| SCHEME_PRIM_IS_UNSAFE_FUNCTIONAL
| SCHEME_PRIM_WANTS_EXTFLONUM_BOTH);
@ -453,9 +453,9 @@ void scheme_init_extfl_unsafe_numcomp(Scheme_Env *env)
p = scheme_make_folding_prim(unsafe_extfl_lt, "unsafe-extfl<", 2, 2, 1);
if (MZ_LONG_DOUBLE_AND(scheme_can_inline_fp_comp()))
SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_IS_BINARY_INLINED;
flags = SCHEME_PRIM_IS_BINARY_INLINED;
else
SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_SOMETIMES_INLINED;
flags = SCHEME_PRIM_SOMETIMES_INLINED;
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(flags
| SCHEME_PRIM_IS_UNSAFE_FUNCTIONAL
| SCHEME_PRIM_WANTS_EXTFLONUM_BOTH);
@ -463,9 +463,9 @@ void scheme_init_extfl_unsafe_numcomp(Scheme_Env *env)
p = scheme_make_folding_prim(unsafe_extfl_gt, "unsafe-extfl>", 2, 2, 1);
if (MZ_LONG_DOUBLE_AND(scheme_can_inline_fp_comp()))
SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_IS_BINARY_INLINED;
flags = SCHEME_PRIM_IS_BINARY_INLINED;
else
SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_SOMETIMES_INLINED;
flags = SCHEME_PRIM_SOMETIMES_INLINED;
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(flags
| SCHEME_PRIM_IS_UNSAFE_FUNCTIONAL
| SCHEME_PRIM_WANTS_EXTFLONUM_BOTH);
@ -473,9 +473,9 @@ void scheme_init_extfl_unsafe_numcomp(Scheme_Env *env)
p = scheme_make_folding_prim(unsafe_extfl_lt_eq, "unsafe-extfl<=", 2, 2, 1);
if (MZ_LONG_DOUBLE_AND(scheme_can_inline_fp_comp()))
SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_IS_BINARY_INLINED;
flags = SCHEME_PRIM_IS_BINARY_INLINED;
else
SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_SOMETIMES_INLINED;
flags = SCHEME_PRIM_SOMETIMES_INLINED;
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(flags
| SCHEME_PRIM_IS_UNSAFE_FUNCTIONAL
| SCHEME_PRIM_WANTS_EXTFLONUM_BOTH);
@ -483,9 +483,9 @@ void scheme_init_extfl_unsafe_numcomp(Scheme_Env *env)
p = scheme_make_folding_prim(unsafe_extfl_gt_eq, "unsafe-extfl>=", 2, 2, 1);
if (MZ_LONG_DOUBLE_AND(scheme_can_inline_fp_comp()))
SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_IS_BINARY_INLINED;
flags = SCHEME_PRIM_IS_BINARY_INLINED;
else
SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_SOMETIMES_INLINED;
flags = SCHEME_PRIM_SOMETIMES_INLINED;
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(flags
| SCHEME_PRIM_IS_UNSAFE_FUNCTIONAL
| SCHEME_PRIM_WANTS_EXTFLONUM_BOTH);
@ -493,9 +493,9 @@ void scheme_init_extfl_unsafe_numcomp(Scheme_Env *env)
p = scheme_make_folding_prim(unsafe_extfl_min, "unsafe-extflmin", 2, 2, 1);
if (MZ_LONG_DOUBLE_AND(scheme_can_inline_fp_op()))
SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_IS_BINARY_INLINED;
flags = SCHEME_PRIM_IS_BINARY_INLINED;
else
SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_SOMETIMES_INLINED;
flags = SCHEME_PRIM_SOMETIMES_INLINED;
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(flags
| SCHEME_PRIM_IS_UNSAFE_FUNCTIONAL
| SCHEME_PRIM_PRODUCES_EXTFLONUM
@ -504,9 +504,9 @@ void scheme_init_extfl_unsafe_numcomp(Scheme_Env *env)
p = scheme_make_folding_prim(unsafe_extfl_max, "unsafe-extflmax", 2, 2, 1);
if (MZ_LONG_DOUBLE_AND(scheme_can_inline_fp_op()))
SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_IS_BINARY_INLINED;
flags = SCHEME_PRIM_IS_BINARY_INLINED;
else
SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_SOMETIMES_INLINED;
flags = SCHEME_PRIM_SOMETIMES_INLINED;
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(flags
| SCHEME_PRIM_IS_UNSAFE_FUNCTIONAL
| SCHEME_PRIM_PRODUCES_EXTFLONUM

View File

@ -169,6 +169,8 @@ static Scheme_Object *writable_struct_subs(Scheme_Object *s, int for_write, Prin
(SCHEME_PAIRP(obj) \
|| SCHEME_MUTABLE_PAIRP(obj) \
|| SCHEME_CHAPERONE_VECTORP(obj) \
|| SCHEME_FLVECTORP(obj) \
|| SCHEME_FXVECTORP(obj) \
|| (qk(pp->print_box, 1) && SCHEME_CHAPERONE_BOXP(obj)) \
|| (qk(pp->print_struct \
&& SCHEME_CHAPERONE_STRUCTP(obj) \
@ -534,6 +536,8 @@ static int check_cycles(Scheme_Object *obj, int for_write, Scheme_Hash_Table *ht
|| SCHEME_MUTABLE_PAIRP(obj)
|| (pp->print_box && SCHEME_CHAPERONE_BOXP(obj))
|| SCHEME_CHAPERONE_VECTORP(obj)
|| SCHEME_FLVECTORP(obj)
|| SCHEME_FXVECTORP(obj)
|| (SCHEME_CHAPERONE_STRUCTP(obj)
&& ((pp->print_struct
&& PRINTABLE_STRUCT(obj, pp))

View File

@ -73,8 +73,10 @@ enum {
scheme_double_type, /* 53 */
scheme_complex_type, /* 54 */
/* other values */
/* other eqv?-able values (must be with numbers) */
scheme_char_type, /* 55 */
/* other values */
scheme_long_double_type, /* 56 */
scheme_char_string_type, /* 57 */
scheme_byte_string_type, /* 58 */