conservatory
/
elk
4
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

* Fixed the bignum/double comparisons. 

git-svn-id: svn://svn.zoy.org/elk/trunk@192 55e467fa-43c5-0310-a8a2-de718669efc6
This commit is contained in:
sam 2003-09-26 09:11:20 +00:00
parent 3099835542
commit 95803f0eec
2 changed files with 31 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
BUGS
View File

@ -36,4 +36,10 @@ Generational/Incremental Garbage Collector
o The percentage displayed at the end of a GC run is sometimes wrong. o The percentage displayed at the end of a GC run is sometimes wrong.
o Almost no Unix commands work under Win32, and they are badly disabled. Other bugs
Almost no Unix commands work under Win32, and they are badly disabled.
bignum/double comparisons are not perfect, see scm's scm_bigdblcomp
for a better implementation.

36
src/math.c
View File

@ -475,7 +475,8 @@ Object P_Inexact_To_Exact (Object n) {
/*NOTREACHED*/ /*NOTREACHED*/
} }
#define General_Generic_Predicate(prim,op,bigop) Object prim (Object x) {\ #define General_Generic_Predicate(prim,op,bigop)\
Object prim (Object x) {\
register int ret;\ register int ret;\
Check_Number (x);\ Check_Number (x);\
switch (TYPE(x)) {\ switch (TYPE(x)) {\
@ -525,7 +526,8 @@ Object P_Oddp (Object x) {
return EQ(tmp,True) ? False : True; return EQ(tmp,True) ? False : True;
} }
#define General_Generic_Compare(name,op,bigop) int name (Object x, Object y) {\ #define General_Generic_Compare(name,op)\
int Generic_##name (Object x, Object y) {\
Object b; register int ret;\ Object b; register int ret;\
GC_Node;\ GC_Node;\
\ \
@ -539,7 +541,7 @@ Object P_Oddp (Object x) {
case T_Bignum:\ case T_Bignum:\
GC_Link (y);\ GC_Link (y);\
b = Integer_To_Bignum (FIXNUM(x));\ b = Integer_To_Bignum (FIXNUM(x));\
ret = bigop (b, y);\ ret = Bignum_##name (b, y);\
GC_Unlink;\ GC_Unlink;\
return ret;\ return ret;\
default: /* Just to avoid compiler warnings */\ default: /* Just to avoid compiler warnings */\
@ -552,7 +554,12 @@ Object P_Oddp (Object x) {
case T_Flonum:\ case T_Flonum:\
return FLONUM(x)->val op FLONUM(y)->val;\ return FLONUM(x)->val op FLONUM(y)->val;\
case T_Bignum:\ case T_Bignum:\
return FLONUM(x)->val op Bignum_To_Double (y);\ GC_Link(y);\
b = Double_To_Bignum(FLONUM(x)->val);\
ret = Bignum_##name (b, y);\
GC_Unlink;\
return ret;\
/*return FLONUM(x)->val op Bignum_To_Double (y);*/\
default: /* Just to avoid compiler warnings */\ default: /* Just to avoid compiler warnings */\
return 0;\ return 0;\
}\ }\
@ -561,13 +568,18 @@ Object P_Oddp (Object x) {
case T_Fixnum:\ case T_Fixnum:\
GC_Link (x);\ GC_Link (x);\
b = Integer_To_Bignum (FIXNUM(y));\ b = Integer_To_Bignum (FIXNUM(y));\
ret = bigop (x, b);\ ret = Bignum_##name (x, b);\
GC_Unlink;\ GC_Unlink;\
return ret;\ return ret;\
case T_Flonum:\ case T_Flonum:\
return Bignum_To_Double (x) op FLONUM(y)->val;\ GC_Link(x);\
b = Double_To_Bignum(FLONUM(y)->val);\
ret = Bignum_##name (x, b);\
GC_Unlink;\
return ret;\
/*return Bignum_To_Double (x) op FLONUM(y)->val;*/\
case T_Bignum:\ case T_Bignum:\
return bigop (x, y);\ return Bignum_##name (x, y);\
default: /* Just to avoid compiler warnings */\ default: /* Just to avoid compiler warnings */\
return 0;\ return 0;\
}\ }\
@ -577,11 +589,11 @@ Object P_Oddp (Object x) {
/*NOTREACHED*/ /* ...but lint never sees it */\ /*NOTREACHED*/ /* ...but lint never sees it */\
} }
General_Generic_Compare (Generic_Equal, ==, Bignum_Equal) General_Generic_Compare (Equal, ==)
General_Generic_Compare (Generic_Less, <, Bignum_Less) General_Generic_Compare (Less, <)
General_Generic_Compare (Generic_Greater, >, Bignum_Greater) General_Generic_Compare (Greater, >)
General_Generic_Compare (Generic_Eq_Less, <=, Bignum_Eq_Less) General_Generic_Compare (Eq_Less, <=)
General_Generic_Compare (Generic_Eq_Greater, >=, Bignum_Eq_Greater) General_Generic_Compare (Eq_Greater, >=)
Object General_Compare (int argc, Object *argv, register int (*op)()) { Object General_Compare (int argc, Object *argv, register int (*op)()) {
register int i; register int i;