aboutsummaryrefslogtreecommitdiffstats
path: root/scl.c
diff options
context:
space:
mode:
Diffstat (limited to 'scl.c')
-rw-r--r--scl.c749
1 files changed, 412 insertions, 337 deletions
diff --git a/scl.c b/scl.c
index 2858989..9fe779f 100644
--- a/scl.c
+++ b/scl.c
@@ -56,7 +56,7 @@ static int apx_log10 P((double x));
static double lpow10 P((double x, int n));
static sizet idbl2str P((double f, char *a));
static sizet iflo2str P((SCM flt, char *str));
-static void add1 P((double f, double *fsum));
+static void safe_add_1 P((double f, double *fsum));
static long scm_twos_power P((SCM n));
static char s_makrect[] = "make-rectangular", s_makpolar[] = "make-polar",
@@ -72,7 +72,7 @@ SCM sys_protects[NUM_PROTECTS];
sizet num_protects = NUM_PROTECTS;
char s_inexactp[] = "inexact?";
-static char s_zerop[] = "zero?",
+static char s_zerop[] = "zero?", s_abs[] = "abs",
s_positivep[] = "positive?", s_negativep[] = "negative?";
static char s_lessp[] = "<", s_grp[] = ">";
static char s_leqp[] = "<=", s_greqp[] = ">=";
@@ -88,7 +88,7 @@ static char s_str2list[] = "string->list";
static char s_st_copy[] = "string-copy", s_st_fill[] = "string-fill!";
static char s_vect2list[] = "vector->list", s_ve_fill[] = "vector-fill!";
static char s_intexpt[] = "integer-expt";
-
+static char str_inf0[] = "inf.0";
/*** NUMBERS -> STRINGS ***/
#ifdef FLOATS
@@ -114,11 +114,11 @@ static int apx_log10(x)
double x;
{
int expt;
- double frac = frexp(x, &expt);
+ frexp(x, &expt);
expt -= 1;
if (expt >= 0)
return (int)(expt * llog2);
- return -((int)( -expt * llog2));
+ return -((int)(-expt * llog2));
}
static double p10[] = {1.0, 1e1, 1e2, 1e3, 1e4, 1e5, 1e6, 1e7};
@@ -146,8 +146,21 @@ int inf2str(f, a)
{
sizet ch = 0;
if (f < 0.0) a[ch++] = '-';
- a[ch++] = (f != f) ? '0' : '1';
- a[ch++] = '/'; a[ch++] = '0';
+ else if (f > 0.0) a[ch++] = '+';
+ else {
+ a[ch++] = '0'; a[ch++] = '/'; a[ch++] = '0';
+ return ch;
+ }
+ while (str_inf0[ch - 1]) {
+ a[ch] = str_inf0[ch - 1];
+ ch++;
+ }
+/* # ifdef COMPACT_INFINITY_NOTATION */
+/* else a[ch++] = '0'; */
+/* # else */
+/* a[ch++] = (f != f) ? '0' : '1'; */
+/* # endif */
+/* a[ch++] = '/'; a[ch++] = '0'; */
return ch;
}
@@ -260,12 +273,12 @@ static sizet iflo2str(flt, str)
{
sizet i;
# ifdef SINGLES
- if SINGP(flt) i = idbl2str(FLO(flt), str);
+ if (SINGP(flt)) i = idbl2str(FLO(flt), str);
else
# endif
i = idbl2str(REAL(flt), str);
if (scm_narn==flt) return i;
- if CPLXP(flt) {
+ if (CPLXP(flt)) {
if (!(0 > IMAG(flt))) str[i++] = '+';
i += idbl2str(IMAG(flt), &str[i]);
str[i++] = 'i';
@@ -313,10 +326,10 @@ static SCM big2str(b, radix)
sizet i = NUMDIGS(t);
sizet j = radix==16 ? (BITSPERDIG*i)/4+2
: radix >= 10 ? (BITSPERDIG*i*241L)/800+2
- : (BITSPERDIG*i)+2;
+ : (BITSPERDIG*i)+2;
sizet k = 0;
sizet radct = 0;
- sizet ch; /* jeh */
+ sizet ch; /* jeh */
BIGDIG radpow = 1, radmod = 0;
SCM ss = makstr((long)j);
char *s = CHARS(ss), c;
@@ -335,7 +348,7 @@ static SCM big2str(b, radix)
c = radmod % radix; radmod /= radix; k--;
s[--j] = c < 10 ? c + '0' : c + 'a' - 10;
}
- ch = s[0]=='-' ? 1 : 0; /* jeh */
+ ch = s[0]=='-' ? 1 : 0; /* jeh */
if (ch < j) { /* jeh */
for(i = j;j < LENGTH(ss);j++) s[ch+j-i] = s[j]; /* jeh */
resizuve(ss, (SCM)MAKINUM(ch+LENGTH(ss)-i)); /* jeh */
@@ -346,17 +359,17 @@ static SCM big2str(b, radix)
SCM number2string(x, radix)
SCM x, radix;
{
- if UNBNDP(radix) radix=MAKINUM(10L);
+ if (UNBNDP(radix)) radix=MAKINUM(10L);
else ASRTER(INUMP(radix), radix, ARG2, s_number2string);
#ifdef FLOATS
- if NINUMP(x) {
+ if (NINUMP(x)) {
char num_buf[FLOBUFLEN];
# ifdef BIGDIG
ASRTGO(NIMP(x), badx);
- if BIGP(x) return big2str(x, (unsigned int)INUM(radix));
+ if (BIGP(x)) return big2str(x, (unsigned int)INUM(radix));
# ifndef RECKLESS
if (!(INEXP(x)))
- badx: wta(x, (char *)ARG1, s_number2string);
+ badx: wta(x, (char *)ARG1, s_number2string);
# endif
# else
ASRTER(NIMP(x) && INEXP(x), x, ARG1, s_number2string);
@@ -365,7 +378,7 @@ SCM number2string(x, radix)
}
#else
# ifdef BIGDIG
- if NINUMP(x) {
+ if (NINUMP(x)) {
ASRTER(NIMP(x) && BIGP(x), x, ARG1, s_number2string);
return big2str(x, (unsigned int)INUM(radix));
}
@@ -453,7 +466,7 @@ SCM istr2int(str, len, radix)
t2 = c;
moretodo:
while(k < blen) {
-/* printf("k = %d, blen = %d, t2 = %ld, ds[k] = %d\n", k, blen, t2, ds[k]);*/
+/* printf("k = %d, blen = %d, t2 = %ld, ds[k] = %d\n", k, blen, t2, ds[k]);*/
t2 += ds[k]*radix;
ds[k++] = BIGLO(t2);
t2 = BIGDN(t2);
@@ -466,7 +479,7 @@ SCM istr2int(str, len, radix)
}
} while (i < len);
if (blen * BITSPERDIG/CHAR_BIT <= sizeof(SCM))
- if INUMP(res = big2inum(res, blen)) return res;
+ if (INUMP(res = big2inum(res, blen))) return res;
if (j==blen) return res;
return adjbig(res, blen);
}
@@ -532,7 +545,7 @@ static long scm_twos_power(n)
long d, c = 0;
int d4;
# ifdef BIGDIG
- if NINUMP(n) {
+ if (NINUMP(n)) {
BIGDIG *ds;
int i = 0;
ds = BDIGITS(n);
@@ -558,7 +571,7 @@ SCM istr2flo(str, len, radix)
register long radix;
{
register int c, i = 0;
- double lead_sgn;
+ double lead_sgn = 0.0;
double res = 0.0, tmp = 0.0;
int flg = 0;
int point = 0;
@@ -569,15 +582,27 @@ SCM istr2flo(str, len, radix)
switch (*str) { /* leading sign */
case '-': lead_sgn = -1.0; i++; break;
case '+': lead_sgn = 1.0; i++; break;
- default : lead_sgn = 0.0;
}
if (i==len) return BOOL_F; /* bad if lone `+' or `-' */
+# ifdef FLOATS
+ if (6==len && ('+'==str[0] || '-'==str[0]))
+ if (0==strcmp(str_inf0, &str[1]))
+ return makdbl(1./0. * ('+'==str[0] ? 1 : -1), 0.0);
+# endif
+
if (str[i]=='i' || str[i]=='I') { /* handle `+i' and `-i' */
if (lead_sgn==0.0) return BOOL_F; /* must have leading sign */
if (++i < len) return BOOL_F; /* `i' not last character */
return makdbl(0.0, lead_sgn);
}
+ /* # ifdef COMPACT_INFINITY_NOTATION */
+ if (0.0 != lead_sgn && str[i]=='/') {
+ res = 1;
+ flg = 1;
+ goto out1;
+ }
+ /* # endif */
do { /* check initial digits */
switch (c = str[i]) {
case DIGITS:
@@ -637,7 +662,7 @@ SCM istr2flo(str, len, radix)
}
}
out2:
-/* if (tmp==0.0) return BOOL_F; /\* `slash zero' not allowed *\/ */
+ /* if (tmp==0.0) return BOOL_F; /\* `slash zero' not allowed *\/ */
if (i < len)
while (str[i]=='#') { /* optional sharps */
tmp *= radix;
@@ -686,9 +711,9 @@ SCM istr2flo(str, len, radix)
switch (c = str[i]) {
case DIGITS:
expon = expon*10 + c-'0';
-/* if (expon > MAXEXP) */
-/* if (1==expsgn || expon > (MAXEXP + dblprec + 1)) */
-/* return BOOL_F; /\* exponent too large *\/ */
+ /* if (expon > MAXEXP) */
+ /* if (1==expsgn || expon > (MAXEXP + dblprec + 1)) */
+ /* return BOOL_F; /\* exponent too large *\/ */
break;
default:
goto out4;
@@ -706,7 +731,7 @@ SCM istr2flo(str, len, radix)
# ifdef _UNICOS
while (point++) res *= 0.1;
# else
- while (point++) res /= 10.0;
+ while (point++) res /= 10.0;
# endif
done:
@@ -726,7 +751,7 @@ SCM istr2flo(str, len, radix)
case '@': { /* polar input for complex number */
/* get a `real' for angle */
second = istr2flo(&str[i], (long)(len-i), radix);
- if IMP(second) return BOOL_F;
+ if (IMP(second)) return BOOL_F;
if (!(INEXP(second))) return BOOL_F; /* not `real' */
if (CPLXP(second)) return BOOL_F; /* not `real' */
tmp = REALPART(second);
@@ -741,7 +766,7 @@ SCM istr2flo(str, len, radix)
if (i==(len-1)) return makdbl(res, lead_sgn);
/* get a `ureal' for complex part */
second = istr2flo(&str[i], (long)((len-i)-1), radix);
- if IMP(second) return BOOL_F;
+ if (IMP(second)) return BOOL_F;
if (!(INEXP(second))) return BOOL_F; /* not `ureal' */
if (CPLXP(second)) return BOOL_F; /* not `ureal' */
tmp = REALPART(second);
@@ -780,7 +805,7 @@ SCM istring2number(str, len, radix)
return istr2int(&str[i], len-i, radix);
case 0:
res = istr2int(&str[i], len-i, radix);
- if NFALSEP(res) return res;
+ if (NFALSEP(res)) return res;
#ifdef FLOATS
case 2: return istr2flo(&str[i], len-i, radix);
#endif
@@ -792,7 +817,7 @@ SCM istring2number(str, len, radix)
SCM string2number(str, radix)
SCM str, radix;
{
- if UNBNDP(radix) radix=MAKINUM(10L);
+ if (UNBNDP(radix)) radix=MAKINUM(10L);
else ASRTER(INUMP(radix), radix, ARG2, s_str2number);
ASRTER(NIMP(str) && STRINGP(str), str, ARG1, s_str2number);
return istring2number(CHARS(str), LENGTH(str), INUM(radix));
@@ -807,8 +832,8 @@ SCM makdbl (x, y)
if ((y==0.0) && (x==0.0)) return flo0;
# ifndef _MSC_VER
# ifndef SINGLESONLY
- if ((y != y) || (x != x) || (y==(2 * y) && y != 0.0)) return scm_narn;
- if ((x==(2 * x)) && (x != 0.0) && (y != 0.0)) return scm_narn;
+ if ((y != y) || (x != x) || (y==(2 * y) && (y != 0.0))) return scm_narn;
+ if ((x==(2 * x)) && (x != 0.0)) y = 0.0;
# endif
# endif
DEFER_INTS;
@@ -844,13 +869,13 @@ SCM eqv(x, y)
SCM x, y;
{
if (x==y) return BOOL_T;
- if IMP(x) return BOOL_F;
- if IMP(y) return BOOL_F;
+ if (IMP(x)) return BOOL_F;
+ if (IMP(y)) return BOOL_F;
/* this ensures that types and length are the same. */
if (CAR(x) != CAR(y)) return BOOL_F;
- if NUMP(x) {
+ if (NUMP(x)) {
# ifdef BIGDIG
- if BIGP(x) return (0==bigcomp(x, y)) ? BOOL_T : BOOL_F;
+ if (BIGP(x)) return (0==bigcomp(x, y)) ? BOOL_T : BOOL_F;
# endif
# ifdef FLOATS
return floequal(x, y);
@@ -863,7 +888,7 @@ SCM x, lst;
{
for(;NIMP(lst);lst = CDR(lst)) {
ASRTGO(CONSP(lst), badlst);
- if NFALSEP(eqv(CAR(lst), x)) return lst;
+ if (NFALSEP(eqv(CAR(lst), x))) return lst;
}
# ifndef RECKLESS
if (!(NULLP(lst)))
@@ -879,7 +904,7 @@ SCM x, alist;
ASRTGO(CONSP(alist), badlst);
tmp = CAR(alist);
ASRTGO(NIMP(tmp) && CONSP(tmp), badlst);
- if NFALSEP(eqv(CAR(tmp), x)) return tmp;
+ if (NFALSEP(eqv(CAR(tmp), x))) return tmp;
}
# ifndef RECKLESS
if (!(NULLP(alist)))
@@ -957,7 +982,7 @@ static SCM vector_equal(x, y)
{
long i;
for(i = LENGTH(x)-1;i >= 0;i--)
- if FALSEP(equal(VELTS(x)[i], VELTS(y)[i])) return BOOL_F;
+ if (FALSEP(equal(VELTS(x)[i], VELTS(y)[i]))) return BOOL_F;
return BOOL_T;
}
#ifdef BIGDIG
@@ -983,41 +1008,41 @@ SCM equal(x, y)
{
CHECK_STACK;
tailrecurse: POLL;
- if (x==y) return BOOL_T;
- if IMP(x) return BOOL_F;
- if IMP(y) return BOOL_F;
- if (CONSP(x) && CONSP(y)) {
- if FALSEP(equal(CAR(x), CAR(y))) return BOOL_F;
- x = CDR(x);
- y = CDR(y);
- goto tailrecurse;
- }
- /* this ensures that types and length are the same. */
- if (CAR(x) != CAR(y)) return BOOL_F;
- switch (TYP7(x)) {
- default: return BOOL_F;
- case tc7_string: return st_equal(x, y);
- case tc7_vector: return vector_equal(x, y);
- case tc7_smob: {
- int i = SMOBNUM(x);
- if (!(i < numsmob)) return BOOL_F;
- if (smobs[i].equalp) return (smobs[i].equalp)(x, y);
- else return BOOL_F;
- }
- case tc7_bvect:
- case tc7_uvect: case tc7_ivect: case tc7_svect:
- case tc7_fvect: case tc7_cvect: case tc7_dvect: {
- SCM (*pred)() = smobs[0x0ff & (tc16_array>>8)].equalp;
- if (pred) return (*pred)(x, y);
- else return BOOL_F;
- }
- }
+ if (x==y) return BOOL_T;
+ if (IMP(x)) return BOOL_F;
+ if (IMP(y)) return BOOL_F;
+ if (CONSP(x) && CONSP(y)) {
+ if (FALSEP(equal(CAR(x), CAR(y)))) return BOOL_F;
+ x = CDR(x);
+ y = CDR(y);
+ goto tailrecurse;
+ }
+ /* this ensures that types and length are the same. */
+ if (CAR(x) != CAR(y)) return BOOL_F;
+ switch (TYP7(x)) {
+ default: return BOOL_F;
+ case tc7_string: return st_equal(x, y);
+ case tc7_vector: return vector_equal(x, y);
+ case tc7_smob: {
+ int i = SMOBNUM(x);
+ if (!(i < numsmob)) return BOOL_F;
+ if (smobs[i].equalp) return (smobs[i].equalp)(x, y);
+ else return BOOL_F;
+ }
+ case tc7_bvect:
+ case tc7_uvect: case tc7_ivect: case tc7_svect:
+ case tc7_fvect: case tc7_cvect: case tc7_dvect: {
+ SCM (*pred)() = smobs[0x0ff & (tc16_array>>8)].equalp;
+ if (pred) return (*pred)(x, y);
+ else return BOOL_F;
+ }
+ }
}
SCM numberp(obj)
SCM obj;
{
- if INUMP(obj) return BOOL_T;
+ if (INUMP(obj)) return BOOL_T;
#ifdef FLOATS
if (NIMP(obj) && NUMP(obj)) return BOOL_T;
#else
@@ -1061,26 +1086,26 @@ int scm_bigdblcomp(b, d)
SCM realp(x)
SCM x;
{
- if INUMP(x) return BOOL_T;
- if IMP(x) return BOOL_F;
- if REALP(x) return BOOL_T;
+ if (INUMP(x)) return BOOL_T;
+ if (IMP(x)) return BOOL_F;
+ if (REALP(x)) return BOOL_T;
# ifdef BIGDIG
- if BIGP(x) return BOOL_T;
+ if (BIGP(x)) return BOOL_T;
# endif
return BOOL_F;
}
SCM scm_rationalp(x)
SCM x;
{
- if INUMP(x) return BOOL_T;
- if IMP(x) return BOOL_F;
- if REALP(x) {
+ if (INUMP(x)) return BOOL_T;
+ if (IMP(x)) return BOOL_F;
+ if (REALP(x)) {
float y = REALPART(x);
if (y==2*y && y != 0.0) return BOOL_F;
return BOOL_T;
}
# ifdef BIGDIG
- if BIGP(x) return BOOL_T;
+ if (BIGP(x)) return BOOL_T;
# endif
return BOOL_F;
}
@@ -1088,13 +1113,13 @@ SCM intp(x)
SCM x;
{
double r;
- if INUMP(x) return BOOL_T;
- if IMP(x) return BOOL_F;
+ if (INUMP(x)) return BOOL_T;
+ if (IMP(x)) return BOOL_F;
# ifdef BIGDIG
- if BIGP(x) return BOOL_T;
+ if (BIGP(x)) return BOOL_T;
# endif
if (!INEXP(x)) return BOOL_F;
- if CPLXP(x) return BOOL_F;
+ if (CPLXP(x)) return BOOL_F;
r = REALPART(x);
if (r != floor(r)) return BOOL_F;
if (r==2*r && r != 0.0) return BOOL_F;
@@ -1116,16 +1141,16 @@ SCM eqp(x, y)
{
#ifdef FLOATS
SCM t;
- if NINUMP(x) {
+ if (NINUMP(x)) {
# ifdef BIGDIG
# ifndef RECKLESS
if (!(NIMP(x)))
- badx: wta(x, (char *)ARG1, s_eqp);
+ badx: wta(x, (char *)ARG1, s_eqp);
# endif
- if BIGP(x) {
- if INUMP(y) return BOOL_F;
+ if (BIGP(x)) {
+ if (INUMP(y)) return BOOL_F;
ASRTGO(NIMP(y), bady);
- if BIGP(y) return (0==bigcomp(x, y)) ? BOOL_T : BOOL_F;
+ if (BIGP(y)) return (0==bigcomp(x, y)) ? BOOL_T : BOOL_F;
ASRTGO(INEXP(y), bady);
bigreal:
return (REALP(y) && (0==scm_bigdblcomp(x, REALPART(y)))) ?
@@ -1135,10 +1160,10 @@ SCM eqp(x, y)
# else
ASRTER(NIMP(x) && INEXP(x), x, ARG1, s_eqp);
# endif
- if INUMP(y) {t = x; x = y; y = t; goto realint;}
+ if (INUMP(y)) {t = x; x = y; y = t; goto realint;}
# ifdef BIGDIG
ASRTGO(NIMP(y), bady);
- if BIGP(y) {t = x; x = y; y = t; goto bigreal;}
+ if (BIGP(y)) {t = x; x = y; y = t; goto bigreal;}
ASRTGO(INEXP(y), bady);
# else
ASRTGO(NIMP(y) && INEXP(y), bady);
@@ -1146,18 +1171,18 @@ SCM eqp(x, y)
if (x==y) return BOOL_T;
return floequal(x, y);
}
- if NINUMP(y) {
+ if (NINUMP(y)) {
# ifdef BIGDIG
ASRTGO(NIMP(y), bady);
- if BIGP(y) return BOOL_F;
+ if (BIGP(y)) return BOOL_F;
# ifndef RECKLESS
if (!(INEXP(y)))
- bady: wta(y, (char *)ARG2, s_eqp);
+ bady: wta(y, (char *)ARG2, s_eqp);
# endif
# else
# ifndef RECKLESS
if (!(NIMP(y) && INEXP(y)))
- bady: wta(y, (char *)ARG2, s_eqp);
+ bady: wta(y, (char *)ARG2, s_eqp);
# endif
# endif
realint:
@@ -1165,16 +1190,16 @@ SCM eqp(x, y)
}
#else
# ifdef BIGDIG
- if NINUMP(x) {
+ if (NINUMP(x)) {
ASRTER(NIMP(x) && BIGP(x), x, ARG1, s_eqp);
- if INUMP(y) return BOOL_F;
+ if (INUMP(y)) return BOOL_F;
ASRTGO(NIMP(y) && BIGP(y), bady);
return (0==bigcomp(x, y)) ? BOOL_T : BOOL_F;
}
- if NINUMP(y) {
+ if (NINUMP(y)) {
# ifndef RECKLESS
if (!(NIMP(y) && BIGP(y)))
- bady: wta(y, (char *)ARG2, s_eqp);
+ bady: wta(y, (char *)ARG2, s_eqp);
# endif
return BOOL_F;
}
@@ -1189,16 +1214,16 @@ SCM lessp(x, y)
SCM x, y;
{
#ifdef FLOATS
- if NINUMP(x) {
+ if (NINUMP(x)) {
# ifdef BIGDIG
# ifndef RECKLESS
if (!(NIMP(x)))
- badx: wta(x, (char *)ARG1, s_lessp);
+ badx: wta(x, (char *)ARG1, s_lessp);
# endif
- if BIGP(x) {
- if INUMP(y) return BIGSIGN(x) ? BOOL_T : BOOL_F;
+ if (BIGP(x)) {
+ if (INUMP(y)) return BIGSIGN(x) ? BOOL_T : BOOL_F;
ASRTGO(NIMP(y), bady);
- if BIGP(y) return (1==bigcomp(x, y)) ? BOOL_T : BOOL_F;
+ if (BIGP(y)) return (1==bigcomp(x, y)) ? BOOL_T : BOOL_F;
ASRTGO(REALP(y), bady);
return (1==scm_bigdblcomp(x, REALPART(y))) ? BOOL_T : BOOL_F;
}
@@ -1206,44 +1231,44 @@ SCM lessp(x, y)
# else
ASRTER(NIMP(x) && REALP(x), x, ARG1, s_lessp);
# endif
- if INUMP(y) return (REALPART(x) < ((double)INUM(y))) ? BOOL_T : BOOL_F;
+ if (INUMP(y)) return (REALPART(x) < ((double)INUM(y))) ? BOOL_T : BOOL_F;
# ifdef BIGDIG
ASRTGO(NIMP(y), bady);
- if BIGP(y) return (-1==scm_bigdblcomp(y, REALPART(x))) ? BOOL_T : BOOL_F;
+ if (BIGP(y)) return (-1==scm_bigdblcomp(y, REALPART(x))) ? BOOL_T : BOOL_F;
ASRTGO(REALP(y), bady);
# else
ASRTGO(NIMP(y) && REALP(y), bady);
# endif
return (REALPART(x) < REALPART(y)) ? BOOL_T : BOOL_F;
}
- if NINUMP(y) {
+ if (NINUMP(y)) {
# ifdef BIGDIG
ASRTGO(NIMP(y), bady);
- if BIGP(y) return BIGSIGN(y) ? BOOL_F : BOOL_T;
+ if (BIGP(y)) return BIGSIGN(y) ? BOOL_F : BOOL_T;
# ifndef RECKLESS
if (!(REALP(y)))
- bady: wta(y, (char *)ARG2, s_lessp);
+ bady: wta(y, (char *)ARG2, s_lessp);
# endif
# else
# ifndef RECKLESS
if (!(NIMP(y) && REALP(y)))
- bady: wta(y, (char *)ARG2, s_lessp);
+ bady: wta(y, (char *)ARG2, s_lessp);
# endif
# endif
return (((double)INUM(x)) < REALPART(y)) ? BOOL_T : BOOL_F;
}
#else
# ifdef BIGDIG
- if NINUMP(x) {
+ if (NINUMP(x)) {
ASRTER(NIMP(x) && BIGP(x), x, ARG1, s_lessp);
- if INUMP(y) return BIGSIGN(x) ? BOOL_T : BOOL_F;
+ if (INUMP(y)) return BIGSIGN(x) ? BOOL_T : BOOL_F;
ASRTGO(NIMP(y) && BIGP(y), bady);
return (1==bigcomp(x, y)) ? BOOL_T : BOOL_F;
}
- if NINUMP(y) {
+ if (NINUMP(y)) {
# ifndef RECKLESS
if (!(NIMP(y) && BIGP(y)))
- bady: wta(y, (char *)ARG2, s_lessp);
+ bady: wta(y, (char *)ARG2, s_lessp);
# endif
return BIGSIGN(y) ? BOOL_F : BOOL_T;
}
@@ -1273,10 +1298,10 @@ SCM zerop(z)
SCM z;
{
#ifdef FLOATS
- if NINUMP(z) {
+ if (NINUMP(z)) {
# ifdef BIGDIG
ASRTGO(NIMP(z), badz);
- if BIGP(z) return BOOL_F;
+ if (BIGP(z)) return BOOL_F;
# ifndef RECKLESS
if (!(INEXP(z)))
badz: wta(z, (char *)ARG1, s_zerop);
@@ -1288,7 +1313,7 @@ SCM zerop(z)
}
#else
# ifdef BIGDIG
- if NINUMP(z) {
+ if (NINUMP(z)) {
ASRTER(NIMP(z) && BIGP(z), z, ARG1, s_zerop);
return BOOL_F;
}
@@ -1302,10 +1327,10 @@ SCM positivep(x)
SCM x;
{
#ifdef FLOATS
- if NINUMP(x) {
+ if (NINUMP(x)) {
# ifdef BIGDIG
ASRTGO(NIMP(x), badx);
- if BIGP(x) return TYP16(x)==tc16_bigpos ? BOOL_T : BOOL_F;
+ if (BIGP(x)) return TYP16(x)==tc16_bigpos ? BOOL_T : BOOL_F;
# ifndef RECKLESS
if (!(REALP(x)))
badx: wta(x, (char *)ARG1, s_positivep);
@@ -1317,7 +1342,7 @@ SCM positivep(x)
}
#else
# ifdef BIGDIG
- if NINUMP(x) {
+ if (NINUMP(x)) {
ASRTER(NIMP(x) && BIGP(x), x, ARG1, s_positivep);
return TYP16(x)==tc16_bigpos ? BOOL_T : BOOL_F;
}
@@ -1331,10 +1356,10 @@ SCM negativep(x)
SCM x;
{
#ifdef FLOATS
- if NINUMP(x) {
+ if (NINUMP(x)) {
# ifdef BIGDIG
ASRTGO(NIMP(x), badx);
- if BIGP(x) return TYP16(x)==tc16_bigpos ? BOOL_F : BOOL_T;
+ if (BIGP(x)) return TYP16(x)==tc16_bigpos ? BOOL_F : BOOL_T;
# ifndef RECKLESS
if (!(REALP(x)))
badx: wta(x, (char *)ARG1, s_negativep);
@@ -1346,7 +1371,7 @@ SCM negativep(x)
}
#else
# ifdef BIGDIG
- if NINUMP(x) {
+ if (NINUMP(x)) {
ASRTER(NIMP(x) && BIGP(x), x, ARG1, s_negativep);
return (TYP16(x)==tc16_bigneg) ? BOOL_T : BOOL_F;
}
@@ -1365,21 +1390,21 @@ SCM lmax(x, y)
SCM t;
double z;
#endif
- if UNBNDP(y) {
+ if (UNBNDP(y)) {
#ifndef RECKLESS
if (!(NUMBERP(x)))
- badx: wta(x, (char *)ARG1, s_max);
+ badx: wta(x, (char *)ARG1, s_max);
#endif
return x;
}
#ifdef FLOATS
- if NINUMP(x) {
+ if (NINUMP(x)) {
# ifdef BIGDIG
ASRTGO(NIMP(x), badx);
- if BIGP(x) {
- if INUMP(y) return BIGSIGN(x) ? y : x;
+ if (BIGP(x)) {
+ if (INUMP(y)) return BIGSIGN(x) ? y : x;
ASRTGO(NIMP(y), bady);
- if BIGP(y) return (1==bigcomp(x, y)) ? y : x;
+ if (BIGP(y)) return (1==bigcomp(x, y)) ? y : x;
ASRTGO(REALP(y), bady);
big_dbl:
if (-1 != scm_bigdblcomp(x, REALPART(y))) return y;
@@ -1391,10 +1416,10 @@ SCM lmax(x, y)
# else
ASRTER(NIMP(x) && REALP(x), x, ARG1, s_max);
# endif
- if INUMP(y) return (REALPART(x) < (z = INUM(y))) ? makdbl(z, 0.0) : x;
+ if (INUMP(y)) return (REALPART(x) < (z = INUM(y))) ? makdbl(z, 0.0) : x;
# ifdef BIGDIG
ASRTGO(NIMP(y), bady);
- if BIGP(y) {
+ if (BIGP(y)) {
t = y; y = x; x = t; goto big_dbl;
}
ASRTGO(REALP(y), bady);
@@ -1403,34 +1428,34 @@ SCM lmax(x, y)
# endif
return (REALPART(x) < REALPART(y)) ? y : x;
}
- if NINUMP(y) {
+ if (NINUMP(y)) {
# ifdef BIGDIG
ASRTGO(NIMP(y), bady);
- if BIGP(y) return BIGSIGN(y) ? x : y;
+ if (BIGP(y)) return BIGSIGN(y) ? x : y;
# ifndef RECKLESS
if (!(REALP(y)))
- bady: wta(y, (char *)ARG2, s_max);
+ bady: wta(y, (char *)ARG2, s_max);
# endif
# else
# ifndef RECKLESS
if (!(NIMP(y) && REALP(y)))
- bady: wta(y, (char *)ARG2, s_max);
+ bady: wta(y, (char *)ARG2, s_max);
# endif
# endif
return ((z = INUM(x)) < REALPART(y)) ? y : makdbl(z, 0.0);
}
#else
# ifdef BIGDIG
- if NINUMP(x) {
+ if (NINUMP(x)) {
ASRTER(NIMP(x) && BIGP(x), x, ARG1, s_max);
- if INUMP(y) return BIGSIGN(x) ? y : x;
+ if (INUMP(y)) return BIGSIGN(x) ? y : x;
ASRTGO(NIMP(y) && BIGP(y), bady);
return (1==bigcomp(x, y)) ? y : x;
}
- if NINUMP(y) {
+ if (NINUMP(y)) {
# ifndef RECKLESS
if (!(NIMP(y) && BIGP(y)))
- bady: wta(y, (char *)ARG2, s_max);
+ bady: wta(y, (char *)ARG2, s_max);
# endif
return BIGSIGN(y) ? x : y;
}
@@ -1449,21 +1474,21 @@ SCM lmin(x, y)
SCM t;
double z;
#endif
- if UNBNDP(y) {
+ if (UNBNDP(y)) {
#ifndef RECKLESS
if (!(NUMBERP(x)))
- badx: wta(x, (char *)ARG1, s_min);
+ badx: wta(x, (char *)ARG1, s_min);
#endif
return x;
}
#ifdef FLOATS
- if NINUMP(x) {
+ if (NINUMP(x)) {
# ifdef BIGDIG
ASRTGO(NIMP(x), badx);
- if BIGP(x) {
- if INUMP(y) return BIGSIGN(x) ? x : y;
+ if (BIGP(x)) {
+ if (INUMP(y)) return BIGSIGN(x) ? x : y;
ASRTGO(NIMP(y), bady);
- if BIGP(y) return (-1==bigcomp(x, y)) ? y : x;
+ if (BIGP(y)) return (-1==bigcomp(x, y)) ? y : x;
ASRTGO(REALP(y), bady);
big_dbl:
if (1 != scm_bigdblcomp(x, REALPART(y))) return y;
@@ -1475,10 +1500,10 @@ SCM lmin(x, y)
# else
ASRTER(NIMP(x) && REALP(x), x, ARG1, s_min);
# endif
- if INUMP(y) return (REALPART(x) > (z = INUM(y))) ? makdbl(z, 0.0) : x;
+ if (INUMP(y)) return (REALPART(x) > (z = INUM(y))) ? makdbl(z, 0.0) : x;
# ifdef BIGDIG
ASRTGO(NIMP(y), bady);
- if BIGP(y) {
+ if (BIGP(y)) {
t = y; y = x; x = t; goto big_dbl;
}
ASRTGO(REALP(y), bady);
@@ -1487,34 +1512,34 @@ SCM lmin(x, y)
# endif
return (REALPART(x) > REALPART(y)) ? y : x;
}
- if NINUMP(y) {
+ if (NINUMP(y)) {
# ifdef BIGDIG
ASRTGO(NIMP(y), bady);
- if BIGP(y) return BIGSIGN(y) ? y : x;
+ if (BIGP(y)) return BIGSIGN(y) ? y : x;
# ifndef RECKLESS
if (!(REALP(y)))
- bady: wta(y, (char *)ARG2, s_min);
+ bady: wta(y, (char *)ARG2, s_min);
# endif
# else
# ifndef RECKLESS
if (!(NIMP(y) && REALP(y)))
- bady: wta(y, (char *)ARG2, s_min);
+ bady: wta(y, (char *)ARG2, s_min);
# endif
# endif
return ((z = INUM(x)) > REALPART(y)) ? y : makdbl(z, 0.0);
}
#else
# ifdef BIGDIG
- if NINUMP(x) {
+ if (NINUMP(x)) {
ASRTER(NIMP(x) && BIGP(x), x, ARG1, s_min);
- if INUMP(y) return BIGSIGN(x) ? x : y;
+ if (INUMP(y)) return BIGSIGN(x) ? x : y;
ASRTGO(NIMP(y) && BIGP(y), bady);
return (-1==bigcomp(x, y)) ? y : x;
}
- if NINUMP(y) {
+ if (NINUMP(y)) {
# ifndef RECKLESS
if (!(NIMP(y) && BIGP(y)))
- bady: wta(y, (char *)ARG2, s_min);
+ bady: wta(y, (char *)ARG2, s_min);
# endif
return BIGSIGN(y) ? y : x;
}
@@ -1529,23 +1554,23 @@ SCM lmin(x, y)
SCM sum(x, y)
SCM x, y;
{
- if UNBNDP(y) {
- if UNBNDP(x) return INUM0;
+ if (UNBNDP(y)) {
+ if (UNBNDP(x)) return INUM0;
#ifndef RECKLESS
if (!(NUMBERP(x)))
- badx: wta(x, (char *)ARG1, s_sum);
+ badx: wta(x, (char *)ARG1, s_sum);
#endif
return x;
}
#ifdef FLOATS
- if NINUMP(x) {
+ if (NINUMP(x)) {
SCM t;
# ifdef BIGDIG
ASRTGO(NIMP(x), badx);
- if BIGP(x) {
- if INUMP(y) {t = x; x = y; y = t; goto intbig;}
+ if (BIGP(x)) {
+ if (INUMP(y)) {t = x; x = y; y = t; goto intbig;}
ASRTGO(NIMP(y), bady);
- if BIGP(y) {
+ if (BIGP(y)) {
if (NUMDIGS(x) > NUMDIGS(y)) {t = x; x = y; y = t;}
return addbig(BDIGITS(x), NUMDIGS(x), BIGSIGN(x), y, 0);
}
@@ -1556,30 +1581,32 @@ SCM sum(x, y)
# else
ASRTGO(NIMP(x) && INEXP(x), badx);
# endif
- if INUMP(y) {t = x; x = y; y = t; goto intreal;}
+ if (INUMP(y)) {t = x; x = y; y = t; goto intreal;}
# ifdef BIGDIG
ASRTGO(NIMP(y), bady);
- if BIGP(y) {t = x; x = y; y = t; goto bigreal;}
+ if (BIGP(y)) {t = x; x = y; y = t; goto bigreal;}
# ifndef RECKLESS
else if (!(INEXP(y)))
- bady: wta(y, (char *)ARG2, s_sum);
+ bady: wta(y, (char *)ARG2, s_sum);
# endif
# else
# ifndef RECKLESS
if (!(NIMP(y) && INEXP(y)))
- bady: wta(y, (char *)ARG2, s_sum);
+ bady: wta(y, (char *)ARG2, s_sum);
# endif
# endif
- { double i = 0.0;
- if CPLXP(x) i = IMAG(x);
- if CPLXP(y) i += IMAG(y);
- return makdbl(REALPART(x)+REALPART(y), i); }
+ {
+ double i = 0.0;
+ if (CPLXP(x)) i = IMAG(x);
+ if (CPLXP(y)) i += IMAG(y);
+ return makdbl(REALPART(x)+REALPART(y), i);
+ }
}
- if NINUMP(y) {
+ if (NINUMP(y)) {
# ifdef BIGDIG
ASRTGO(NIMP(y), bady);
- if BIGP(y)
- intbig: {
+ if (BIGP(y))
+ intbig: {
# ifndef DIGSTOOBIG
long z = pseudolong(INUM(x));
return addbig((BIGDIG *)&z, DIGSPERLONG, (x < 0) ? 0x0100 : 0, y, 0);
@@ -1597,23 +1624,23 @@ SCM sum(x, y)
}
#else
# ifdef BIGDIG
- if NINUMP(x) {
+ if (NINUMP(x)) {
SCM t;
ASRTGO(NIMP(x) && BIGP(x), badx);
- if INUMP(y) {t = x; x = y; y = t; goto intbig;}
+ if (INUMP(y)) {t = x; x = y; y = t; goto intbig;}
ASRTGO(NIMP(y) && BIGP(y), bady);
if (NUMDIGS(x) > NUMDIGS(y)) {t = x; x = y; y = t;}
return addbig(BDIGITS(x), NUMDIGS(x), BIGSIGN(x), y, 0);
}
- if NINUMP(y) {
+ if (NINUMP(y)) {
# ifndef RECKLESS
if (!(NIMP(y) && BIGP(y)))
- bady: wta(y, (char *)ARG2, s_sum);
+ bady: wta(y, (char *)ARG2, s_sum);
# endif
- intbig: {
+ intbig: {
# ifndef DIGSTOOBIG
long z = pseudolong(INUM(x));
- return addbig(&z, DIGSPERLONG, (x < 0) ? 0x0100 : 0, y, 0);
+ return addbig((BIGDIG *)&z, DIGSPERLONG, (x < 0) ? 0x0100 : 0, y, 0);
# else
BIGDIG zdigs[DIGSPERLONG];
longdigs(INUM(x), zdigs);
@@ -1627,7 +1654,7 @@ SCM sum(x, y)
# endif
#endif
x = INUM(x)+INUM(y);
- if FIXABLE(x) return MAKINUM(x);
+ if (FIXABLE(x)) return MAKINUM(x);
#ifdef BIGDIG
return long2big(x);
#else
@@ -1643,14 +1670,14 @@ SCM difference(x, y)
SCM x, y;
{
#ifdef FLOATS
- if NINUMP(x) {
+ if (NINUMP(x)) {
# ifndef RECKLESS
if (!(NIMP(x)))
- badx: wta(x, (char *)ARG1, s_difference);
+ badx: wta(x, (char *)ARG1, s_difference);
# endif
- if UNBNDP(y) {
+ if (UNBNDP(y)) {
# ifdef BIGDIG
- if BIGP(x) {
+ if (BIGP(x)) {
x = copybig(x, !BIGSIGN(x));
return NUMDIGS(x) * BITSPERDIG/CHAR_BIT <= sizeof(SCM) ?
big2inum(x, NUMDIGS(x)) : x;
@@ -1659,36 +1686,36 @@ SCM difference(x, y)
ASRTGO(INEXP(x), badx);
return makdbl(-REALPART(x), CPLXP(x)?-IMAG(x):0.0);
}
- if INUMP(y) return sum(x, MAKINUM(-INUM(y)));
+ if (INUMP(y)) return sum(x, MAKINUM(-INUM(y)));
# ifdef BIGDIG
ASRTGO(NIMP(y), bady);
- if BIGP(x) {
- if BIGP(y) return (NUMDIGS(x) < NUMDIGS(y)) ?
- addbig(BDIGITS(x), NUMDIGS(x), BIGSIGN(x), y, 0x0100) :
- addbig(BDIGITS(y), NUMDIGS(y), BIGSIGN(y) ^ 0x0100, x, 0);
+ if (BIGP(x)) {
+ if (BIGP(y)) return (NUMDIGS(x) < NUMDIGS(y)) ?
+ addbig(BDIGITS(x), NUMDIGS(x), BIGSIGN(x), y, 0x0100) :
+ addbig(BDIGITS(y), NUMDIGS(y), BIGSIGN(y) ^ 0x0100, x, 0);
ASRTGO(INEXP(y), bady);
return makdbl(big2dbl(x)-REALPART(y), CPLXP(y)?-IMAG(y):0.0);
}
ASRTGO(INEXP(x), badx);
- if BIGP(y) return makdbl(REALPART(x)-big2dbl(y), CPLXP(x)?IMAG(x):0.0);
+ if (BIGP(y)) return makdbl(REALPART(x)-big2dbl(y), CPLXP(x)?IMAG(x):0.0);
ASRTGO(INEXP(y), bady);
# else
ASRTGO(INEXP(x), badx);
ASRTGO(NIMP(y) && INEXP(y), bady);
# endif
- if CPLXP(x) {
- if CPLXP(y)
+ if (CPLXP(x)) {
+ if (CPLXP(y))
return makdbl(REAL(x)-REAL(y), IMAG(x)-IMAG(y));
else
return makdbl(REAL(x)-REALPART(y), IMAG(x));
}
return makdbl(REALPART(x)-REALPART(y), CPLXP(y)?-IMAG(y):0.0);
}
- if UNBNDP(y) {x = -INUM(x); goto checkx;}
- if NINUMP(y) {
+ if (UNBNDP(y)) {x = -INUM(x); goto checkx;}
+ if (NINUMP(y)) {
# ifdef BIGDIG
ASRTGO(NIMP(y), bady);
- if BIGP(y) {
+ if (BIGP(y)) {
# ifndef DIGSTOOBIG
long z = pseudolong(INUM(x));
return addbig((BIGDIG *)&z, DIGSPERLONG, (x < 0) ? 0x0100 : 0, y, 0x0100);
@@ -1700,29 +1727,29 @@ SCM difference(x, y)
}
# ifndef RECKLESS
if (!(INEXP(y)))
- bady: wta(y, (char *)ARG2, s_difference);
+ bady: wta(y, (char *)ARG2, s_difference);
# endif
# else
# ifndef RECKLESS
if (!(NIMP(y) && INEXP(y)))
- bady: wta(y, (char *)ARG2, s_difference);
+ bady: wta(y, (char *)ARG2, s_difference);
# endif
# endif
return makdbl(INUM(x)-REALPART(y), CPLXP(y)?-IMAG(y):0.0);
}
#else
# ifdef BIGDIG
- if NINUMP(x) {
+ if (NINUMP(x)) {
ASRTER(NIMP(x) && BIGP(x), x, ARG1, s_difference);
- if UNBNDP(y) {
+ if (UNBNDP(y)) {
x = copybig(x, !BIGSIGN(x));
return NUMDIGS(x) * BITSPERDIG/CHAR_BIT <= sizeof(SCM) ?
- big2inum(x, NUMDIGS(x)) : x;
+ big2inum(x, NUMDIGS(x)) : x;
}
- if INUMP(y) {
+ if (INUMP(y)) {
# ifndef DIGSTOOBIG
long z = pseudolong(INUM(y));
- return addbig(&z, DIGSPERLONG, (y < 0) ? 0 : 0x0100, x, 0);
+ return addbig((BIGDIG *)&z, DIGSPERLONG, (y < 0) ? 0 : 0x0100, x, 0);
# else
BIGDIG zdigs[DIGSPERLONG];
longdigs(INUM(x), zdigs);
@@ -1731,19 +1758,19 @@ SCM difference(x, y)
}
ASRTGO(NIMP(y) && BIGP(y), bady);
return (NUMDIGS(x) < NUMDIGS(y)) ?
- addbig(BDIGITS(x), NUMDIGS(x), BIGSIGN(x), y, 0x0100) :
- addbig(BDIGITS(y), NUMDIGS(y), BIGSIGN(y) ^ 0x0100, x, 0);
+ addbig(BDIGITS(x), NUMDIGS(x), BIGSIGN(x), y, 0x0100) :
+ addbig(BDIGITS(y), NUMDIGS(y), BIGSIGN(y) ^ 0x0100, x, 0);
}
- if UNBNDP(y) {x = -INUM(x); goto checkx;}
- if NINUMP(y) {
+ if (UNBNDP(y)) {x = -INUM(x); goto checkx;}
+ if (NINUMP(y)) {
# ifndef RECKLESS
if (!(NIMP(y) && BIGP(y)))
- bady: wta(y, (char *)ARG2, s_difference);
+ bady: wta(y, (char *)ARG2, s_difference);
# endif
{
# ifndef DIGSTOOBIG
long z = pseudolong(INUM(x));
- return addbig(&z, DIGSPERLONG, (x < 0) ? 0x0100 : 0, y, 0x0100);
+ return addbig((BIGDIG *)&z, DIGSPERLONG, (x < 0) ? 0x0100 : 0, y, 0x0100);
# else
BIGDIG zdigs[DIGSPERLONG];
longdigs(INUM(x), zdigs);
@@ -1753,13 +1780,13 @@ SCM difference(x, y)
}
# else
ASRTER(INUMP(x), x, ARG1, s_difference);
- if UNBNDP(y) {x = -INUM(x); goto checkx;}
+ if (UNBNDP(y)) {x = -INUM(x); goto checkx;}
ASRTER(INUMP(y), y, ARG2, s_difference);
# endif
#endif
x = INUM(x)-INUM(y);
checkx:
- if FIXABLE(x) return MAKINUM(x);
+ if (FIXABLE(x)) return MAKINUM(x);
#ifdef BIGDIG
return long2big(x);
#else
@@ -1774,24 +1801,24 @@ SCM difference(x, y)
SCM product(x, y)
SCM x, y;
{
- if UNBNDP(y) {
- if UNBNDP(x) return MAKINUM(1L);
+ if (UNBNDP(y)) {
+ if (UNBNDP(x)) return MAKINUM(1L);
#ifndef RECKLESS
if (!(NUMBERP(x)))
- badx: wta(x, (char *)ARG1, s_product);
+ badx: wta(x, (char *)ARG1, s_product);
#endif
return x;
}
#ifdef FLOATS
- if NINUMP(x) {
+ if (NINUMP(x)) {
SCM t;
# ifdef BIGDIG
ASRTGO(NIMP(x), badx);
- if BIGP(x) {
- if INUMP(y) {t = x; x = y; y = t; goto intbig;}
+ if (BIGP(x)) {
+ if (INUMP(y)) {t = x; x = y; y = t; goto intbig;}
ASRTGO(NIMP(y), bady);
- if BIGP(y) return mulbig(BDIGITS(x), NUMDIGS(x), BDIGITS(y), NUMDIGS(y),
- BIGSIGN(x) ^ BIGSIGN(y));
+ if (BIGP(y)) return mulbig(BDIGITS(x), NUMDIGS(x), BDIGITS(y), NUMDIGS(y),
+ BIGSIGN(x) ^ BIGSIGN(y));
ASRTGO(INEXP(y), bady);
bigreal:
return bigdblop('*', x, REALPART(y), CPLXP(y) ? IMAG(y) : 0.0);
@@ -1800,22 +1827,22 @@ SCM product(x, y)
# else
ASRTGO(NIMP(x) && INEXP(x), badx);
# endif
- if INUMP(y) {t = x; x = y; y = t; goto intreal;}
+ if (INUMP(y)) {t = x; x = y; y = t; goto intreal;}
# ifdef BIGDIG
ASRTGO(NIMP(y), bady);
- if BIGP(y) {t = x; x = y; y = t; goto bigreal;}
+ if (BIGP(y)) {t = x; x = y; y = t; goto bigreal;}
# ifndef RECKLESS
else if (!(INEXP(y)))
- bady: wta(y, (char *)ARG2, s_product);
+ bady: wta(y, (char *)ARG2, s_product);
# endif
# else
# ifndef RECKLESS
if (!(NIMP(y) && INEXP(y)))
- bady: wta(y, (char *)ARG2, s_product);
+ bady: wta(y, (char *)ARG2, s_product);
# endif
# endif
- if CPLXP(x) {
- if CPLXP(y)
+ if (CPLXP(x)) {
+ if (CPLXP(y))
return makdbl(REAL(x)*REAL(y)-IMAG(x)*IMAG(y),
REAL(x)*IMAG(y)+IMAG(x)*REAL(y));
else
@@ -1824,23 +1851,23 @@ SCM product(x, y)
return makdbl(REALPART(x)*REALPART(y),
CPLXP(y)?REALPART(x)*IMAG(y):0.0);
}
- if NINUMP(y) {
+ if (NINUMP(y)) {
# ifdef BIGDIG
ASRTGO(NIMP(y), bady);
- if BIGP(y) {
+ if (BIGP(y)) {
intbig: if (INUM0==x) return x; if (MAKINUM(1L)==x) return y;
- {
+ {
# ifndef DIGSTOOBIG
- long z = pseudolong(INUM(x));
- return mulbig((BIGDIG *)&z, DIGSPERLONG, BDIGITS(y), NUMDIGS(y),
- BIGSIGN(y) ? (x>0) : (x<0));
+ long z = pseudolong(INUM(x));
+ return mulbig((BIGDIG *)&z, DIGSPERLONG, BDIGITS(y), NUMDIGS(y),
+ BIGSIGN(y) ? (x>0) : (x<0));
# else
- BIGDIG zdigs[DIGSPERLONG];
- longdigs(INUM(x), zdigs);
- return mulbig(zdigs, DIGSPERLONG, BDIGITS(y), NUMDIGS(y),
- BIGSIGN(y) ? (x>0) : (x<0));
+ BIGDIG zdigs[DIGSPERLONG];
+ longdigs(INUM(x), zdigs);
+ return mulbig(zdigs, DIGSPERLONG, BDIGITS(y), NUMDIGS(y),
+ BIGSIGN(y) ? (x>0) : (x<0));
# endif
- }
+ }
}
ASRTGO(INEXP(y), bady);
# else
@@ -1850,31 +1877,31 @@ SCM product(x, y)
}
#else
# ifdef BIGDIG
- if NINUMP(x) {
+ if (NINUMP(x)) {
ASRTGO(NIMP(x) && BIGP(x), badx);
- if INUMP(y) {SCM t = x; x = y; y = t; goto intbig;}
+ if (INUMP(y)) {SCM t = x; x = y; y = t; goto intbig;}
ASRTGO(NIMP(y) && BIGP(y), bady);
return mulbig(BDIGITS(x), NUMDIGS(x), BDIGITS(y), NUMDIGS(y),
BIGSIGN(x) ^ BIGSIGN(y));
}
- if NINUMP(y) {
+ if (NINUMP(y)) {
# ifndef RECKLESS
if (!(NIMP(y) && BIGP(y)))
- bady: wta(y, (char *)ARG2, s_product);
+ bady: wta(y, (char *)ARG2, s_product);
# endif
intbig: if (INUM0==x) return x; if (MAKINUM(1L)==x) return y;
- {
+ {
# ifndef DIGSTOOBIG
- long z = pseudolong(INUM(x));
- return mulbig(&z, DIGSPERLONG, BDIGITS(y), NUMDIGS(y),
- BIGSIGN(y) ? (x>0) : (x<0));
+ long z = pseudolong(INUM(x));
+ return mulbig((BIGDIG *)&z, DIGSPERLONG, BDIGITS(y), NUMDIGS(y),
+ BIGSIGN(y) ? (x>0) : (x<0));
# else
- BIGDIG zdigs[DIGSPERLONG];
- longdigs(INUM(x), zdigs);
- return mulbig(zdigs, DIGSPERLONG, BDIGITS(y), NUMDIGS(y),
- BIGSIGN(y) ? (x>0) : (x<0));
+ BIGDIG zdigs[DIGSPERLONG];
+ longdigs(INUM(x), zdigs);
+ return mulbig(zdigs, DIGSPERLONG, BDIGITS(y), NUMDIGS(y),
+ BIGSIGN(y) ? (x>0) : (x<0));
# endif
- }
+ }
}
# else
ASRTGO(INUMP(x), badx);
@@ -1890,7 +1917,8 @@ SCM product(x, y)
y = MAKINUM(k);
if (k != INUM(y) || k/i != j)
#ifdef BIGDIG
- { int sgn = (i < 0) ^ (j < 0);
+ {
+ int sgn = (i < 0) ^ (j < 0);
# ifndef DIGSTOOBIG
i = pseudolong(i);
j = pseudolong(j);
@@ -1919,24 +1947,24 @@ SCM divide(x, y)
{
#ifdef FLOATS
double d, r, i, a;
- if NINUMP(x) {
+ if (NINUMP(x)) {
# ifndef RECKLESS
if (!(NIMP(x)))
- badx: wta(x, (char *)ARG1, s_divide);
+ badx: wta(x, (char *)ARG1, s_divide);
# endif
- if UNBNDP(y) {
+ if (UNBNDP(y)) {
# ifdef BIGDIG
- if BIGP(x) return makdbl(1.0/big2dbl(x), 0.0);
+ if (BIGP(x)) return makdbl(1.0/big2dbl(x), 0.0);
# endif
ASRTGO(INEXP(x), badx);
- if REALP(x) return makdbl(1.0/REALPART(x), 0.0);
+ if (REALP(x)) return makdbl(1.0/REALPART(x), 0.0);
r = REAL(x); i = IMAG(x); d = r*r+i*i;
return makdbl(r/d, -i/d);
}
# ifdef BIGDIG
- if BIGP(x) {
+ if (BIGP(x)) {
SCM z;
- if INUMP(y) {
+ if (INUMP(y)) {
z = INUM(y);
ASRTER(z, y, OVFLOW, s_divide);
if (1==z) return x;
@@ -1951,15 +1979,17 @@ SCM divide(x, y)
z = divbigbig(BDIGITS(x), NUMDIGS(x), (BIGDIG *)&z, DIGSPERLONG,
BIGSIGN(x) ? (y>0) : (y<0), 3);
# else
- { BIGDIG zdigs[DIGSPERLONG];
+ {
+ BIGDIG zdigs[DIGSPERLONG];
longdigs(z, zdigs);
z = divbigbig(BDIGITS(x), NUMDIGS(x), zdigs, DIGSPERLONG,
- BIGSIGN(x) ? (y>0) : (y<0), 3);}
+ BIGSIGN(x) ? (y>0) : (y<0), 3);
+ }
# endif
return z ? z : bigdblop('/', x, INUM(y), 0.0);
}
ASRTGO(NIMP(y), bady);
- if BIGP(y) {
+ if (BIGP(y)) {
z = divbigbig(BDIGITS(x), NUMDIGS(x), BDIGITS(y), NUMDIGS(y),
BIGSIGN(x) ^ BIGSIGN(y), 3);
return z ? z : inex_divbigbig(x, y);
@@ -1969,42 +1999,42 @@ SCM divide(x, y)
}
# endif
ASRTGO(INEXP(x), badx);
- if INUMP(y) {d = INUM(y); goto basic_div;}
+ if (INUMP(y)) {d = INUM(y); goto basic_div;}
# ifdef BIGDIG
ASRTGO(NIMP(y), bady);
- if BIGP(y) return bigdblop('\\', y, REALPART(x), CPLXP(x) ? IMAG(x) : 0.0);
+ if (BIGP(y)) return bigdblop('\\', y, REALPART(x), CPLXP(x) ? IMAG(x) : 0.0);
ASRTGO(INEXP(y), bady);
# else
ASRTGO(NIMP(y) && INEXP(y), bady);
# endif
- if REALP(y) {
+ if (REALP(y)) {
d = REALPART(y);
basic_div: return makdbl(REALPART(x)/d, CPLXP(x)?IMAG(x)/d:0.0);
}
a = REALPART(x);
- if REALP(x) goto complex_div;
+ if (REALP(x)) goto complex_div;
r = REAL(y); i = IMAG(y); d = r*r+i*i;
return makdbl((a*r+IMAG(x)*i)/d, (IMAG(x)*r-a*i)/d);
}
- if UNBNDP(y) {
+ if (UNBNDP(y)) {
if ((MAKINUM(1L)==x) || (MAKINUM(-1L)==x)) return x;
return makdbl(1.0/((double)INUM(x)), 0.0);
}
- if NINUMP(y) {
+ if (NINUMP(y)) {
# ifdef BIGDIG
ASRTGO(NIMP(y), bady);
- if BIGP(y) return bigdblop('\\', y, INUM(x), 0.0);
+ if (BIGP(y)) return bigdblop('\\', y, INUM(x), 0.0);
# ifndef RECKLESS
if (!(INEXP(y)))
- bady: wta(y, (char *)ARG2, s_divide);
+ bady: wta(y, (char *)ARG2, s_divide);
# endif
# else
# ifndef RECKLESS
if (!(NIMP(y) && INEXP(y)))
- bady: wta(y, (char *)ARG2, s_divide);
+ bady: wta(y, (char *)ARG2, s_divide);
# endif
# endif
- if REALP(y) return makdbl(INUM(x)/REALPART(y), 0.0);
+ if (REALP(y)) return makdbl(INUM(x)/REALPART(y), 0.0);
a = INUM(x);
complex_div:
r = REAL(y); i = IMAG(y); d = r*r+i*i;
@@ -2012,11 +2042,11 @@ SCM divide(x, y)
}
#else
# ifdef BIGDIG
- if NINUMP(x) {
+ if (NINUMP(x)) {
SCM z;
ASRTER(NIMP(x) && BIGP(x), x, ARG1, s_divide);
- if UNBNDP(y) goto ov;
- if INUMP(y) {
+ if (UNBNDP(y)) goto ov;
+ if (INUMP(y)) {
z = INUM(y);
if (!z) goto ov;
if (1==z) return x;
@@ -2028,13 +2058,15 @@ SCM divide(x, y)
}
# ifndef DIGSTOOBIG
z = pseudolong(z);
- z = divbigbig(BDIGITS(x), NUMDIGS(x), &z, DIGSPERLONG,
+ z = divbigbig(BDIGITS(x), NUMDIGS(x), (BIGDIG *)&z, DIGSPERLONG,
BIGSIGN(x) ? (y>0) : (y<0), 3);
# else
- { BIGDIG zdigs[DIGSPERLONG];
+ {
+ BIGDIG zdigs[DIGSPERLONG];
longdigs(z, zdigs);
z = divbigbig(BDIGITS(x), NUMDIGS(x), zdigs, DIGSPERLONG,
- BIGSIGN(x) ? (y>0) : (y<0), 3);}
+ BIGSIGN(x) ? (y>0) : (y<0), 3);
+ }
# endif
} else {
ASRTGO(NIMP(y) && BIGP(y), bady);
@@ -2044,20 +2076,20 @@ SCM divide(x, y)
if (!z) goto ov;
return z;
}
- if UNBNDP(y) {
+ if (UNBNDP(y)) {
if ((MAKINUM(1L)==x) || (MAKINUM(-1L)==x)) return x;
goto ov;
}
- if NINUMP(y) {
+ if (NINUMP(y)) {
# ifndef RECKLESS
if (!(NIMP(y) && BIGP(y)))
- bady: wta(y, (char *)ARG2, s_divide);
+ bady: wta(y, (char *)ARG2, s_divide);
# endif
goto ov;
}
# else
ASRTER(INUMP(x), x, ARG1, s_divide);
- if UNBNDP(y) {
+ if (UNBNDP(y)) {
if ((MAKINUM(1L)==x) || (MAKINUM(-1L)==x)) return x;
goto ov;
}
@@ -2068,7 +2100,7 @@ SCM divide(x, y)
long z = INUM(y);
if ((0==z) || INUM(x)%z) goto ov;
z = INUM(x)/z;
- if FIXABLE(z) return MAKINUM(z);
+ if (FIXABLE(z)) return MAKINUM(z);
#ifdef BIGDIG
return long2big(z);
#endif
@@ -2088,17 +2120,16 @@ SCM scm_intexpt(z1, z2)
#ifdef FLOATS
double dacc, dz1;
#endif
-#ifdef BIGDIG
- if (INUM0==z1 || acc==z1) return z1;
- else if (MAKINUM(-1L)==z1) return BOOL_F==evenp(z2)?z1:acc;
-#endif
+ if (INUM0==z2) return sum(acc, product(z1, INUM0));
ASRTER(INUMP(z2), z2, ARG2, s_intexpt);
+ if (acc==z1) return z1;
+ if (MAKINUM(-1L)==z1) return BOOL_F==evenp(z2)?z1:acc;
z2 = INUM(z2);
if (z2 < 0) {
z2 = -z2;
recip = 1; /* z1 = divide(z1, UNDEFINED); */
}
- if INUMP(z1) {
+ if (INUMP(z1)) {
long tmp, iacc = 1, iz1 = INUM(z1);
#ifdef FLOATS
if (recip) { dz1 = iz1; goto flocase; }
@@ -2142,7 +2173,7 @@ SCM scm_intexpt(z1, z2)
}
ASRTER(NIMP(z1), z1, ARG1, s_intexpt);
#ifdef FLOATS
- if REALP(z1) {
+ if (REALP(z1)) {
dz1 = REALPART(z1);
flocase:
dacc = 1.0;
@@ -2168,25 +2199,27 @@ SCM scm_intexpt(z1, z2)
}
#ifdef FLOATS
-double lasinh(x)
+# ifndef HAVE_ATANH
+double asinh(x)
double x;
{
return log(x+sqrt(x*x+1));
}
-double lacosh(x)
+double acosh(x)
double x;
{
return log(x+sqrt(x*x-1));
}
-double latanh(x)
+double atanh(x)
double x;
{
return 0.5*log((1+x)/(1-x));
}
+# endif
-double ltrunc(x)
+double scm_truncate(x)
double x;
{
if (x < 0.0) return -floor(-x);
@@ -2210,36 +2243,38 @@ void two_doubles(z1, z2, sstring, xy)
char *sstring;
struct dpair *xy;
{
- if INUMP(z1) xy->x = INUM(z1);
+ if (INUMP(z1)) xy->x = INUM(z1);
else {
# ifdef BIGDIG
ASRTGO(NIMP(z1), badz1);
- if BIGP(z1) xy->x = big2dbl(z1);
+ if (BIGP(z1)) xy->x = big2dbl(z1);
else {
# ifndef RECKLESS
if (!(REALP(z1)))
- badz1: wta(z1, (char *)ARG1, sstring);
+ badz1: wta(z1, (char *)ARG1, sstring);
# endif
xy->x = REALPART(z1);}
# else
{ASRTER(NIMP(z1) && REALP(z1), z1, ARG1, sstring);
- xy->x = REALPART(z1);}
+ xy->x = REALPART(z1);}
# endif
}
- if INUMP(z2) xy->y = INUM(z2);
+ if (INUMP(z2)) xy->y = INUM(z2);
else {
# ifdef BIGDIG
ASRTGO(NIMP(z2), badz2);
- if BIGP(z2) xy->y = big2dbl(z2);
+ if (BIGP(z2)) xy->y = big2dbl(z2);
else {
# ifndef RECKLESS
if (!(REALP(z2)))
- badz2: wta(z2, (char *)ARG2, sstring);
+ badz2: wta(z2, (char *)ARG2, sstring);
# endif
xy->y = REALPART(z2);}
# else
- {ASRTER(NIMP(z2) && REALP(z2), z2, ARG2, sstring);
- xy->y = REALPART(z2);}
+ {
+ ASRTER(NIMP(z2) && REALP(z2), z2, ARG2, sstring);
+ xy->y = REALPART(z2);
+ }
# endif
}
}
@@ -2276,53 +2311,63 @@ SCM makpolar(z1, z2)
SCM real_part(z)
SCM z;
{
- if NINUMP(z) {
+ if (NINUMP(z)) {
# ifdef BIGDIG
ASRTGO(NIMP(z), badz);
- if BIGP(z) return z;
+ if (BIGP(z)) return z;
# ifndef RECKLESS
if (!(INEXP(z)))
- badz: wta(z, (char *)ARG1, s_real_part);
+ badz: wta(z, (char *)ARG1, s_real_part);
# endif
# else
ASRTER(NIMP(z) && INEXP(z), z, ARG1, s_real_part);
# endif
- if CPLXP(z) return makdbl(REAL(z), 0.0);
+ if (CPLXP(z)) return makdbl(REAL(z), 0.0);
}
return z;
}
SCM imag_part(z)
SCM z;
{
- if INUMP(z) return INUM0;
+ if (INUMP(z)) return INUM0;
# ifdef BIGDIG
ASRTGO(NIMP(z), badz);
- if BIGP(z) return INUM0;
+ if (BIGP(z)) return INUM0;
# ifndef RECKLESS
if (!(INEXP(z)))
- badz: wta(z, (char *)ARG1, s_imag_part);
+ badz: wta(z, (char *)ARG1, s_imag_part);
# endif
# else
ASRTER(NIMP(z) && INEXP(z), z, ARG1, s_imag_part);
# endif
- if CPLXP(z) return makdbl(IMAG(z), 0.0);
+ if (CPLXP(z)) return makdbl(IMAG(z), 0.0);
return flo0;
}
-SCM magnitude(z)
+
+SCM scm_abs(z)
SCM z;
{
- if INUMP(z) return absval(z);
+ if (INUMP(z)) return scm_iabs(z);
+ ASRTGO(NIMP(z), badz);
# ifdef BIGDIG
+ if (BIGP(z)) return scm_iabs(z);
+# endif
+ if (!REALP(z))
+ badz: wta(z, (char *)ARG1, s_abs);
+ return makdbl(fabs(REALPART(z)), 0.0);
+}
+
+SCM scm_magnitude(z)
+ SCM z;
+{
+ if (INUMP(z)) return scm_iabs(z);
ASRTGO(NIMP(z), badz);
- if BIGP(z) return absval(z);
-# ifndef RECKLESS
- if (!(INEXP(z)))
- badz: wta(z, (char *)ARG1, s_magnitude);
-# endif
-# else
- ASRTER(NIMP(z) && INEXP(z), z, ARG1, s_magnitude);
+# ifdef BIGDIG
+ if (BIGP(z)) return scm_iabs(z);
# endif
- if CPLXP(z)
+ if (!INEXP(z))
+ badz: wta(z, (char *)ARG1, s_magnitude);
+ if (CPLXP(z))
{
double i = IMAG(z), r = REAL(z);
return makdbl(sqrt(i*i+r*r), 0.0);
@@ -2334,10 +2379,10 @@ SCM angle(z)
SCM z;
{
double x, y = 0.0;
- if INUMP(z) {x = (z>=INUM0) ? 1.0 : -1.0; goto do_angle;}
+ if (INUMP(z)) {x = (z>=INUM0) ? 1.0 : -1.0; goto do_angle;}
# ifdef BIGDIG
ASRTGO(NIMP(z), badz);
- if BIGP(z) {x = (TYP16(z)==tc16_bigpos) ? 1.0 : -1.0; goto do_angle;}
+ if (BIGP(z)) {x = (TYP16(z)==tc16_bigpos) ? 1.0 : -1.0; goto do_angle;}
# ifndef RECKLESS
if (!(INEXP(z))) {
badz: wta(z, (char *)ARG1, s_angle);}
@@ -2345,7 +2390,7 @@ SCM angle(z)
# else
ASRTER(NIMP(z) && INEXP(z), z, ARG1, s_angle);
# endif
- if REALP(z) {x = REALPART(z); goto do_angle;}
+ if (REALP(z)) {x = REALPART(z); goto do_angle;}
x = REAL(z); y = IMAG(z);
do_angle:
return makdbl(atan2(y, x), 0.0);
@@ -2355,21 +2400,21 @@ do_angle:
SCM ex2in(z)
SCM z;
{
- if INUMP(z) return makdbl((double)INUM(z), 0.0);
+ if (INUMP(z)) return makdbl((double)INUM(z), 0.0);
ASRTGO(NIMP(z), badz);
- if INEXP(z) return z;
+ if (INEXP(z)) return z;
# ifdef BIGDIG
- if BIGP(z) return makdbl(big2dbl(z), 0.0);
+ if (BIGP(z)) return makdbl(big2dbl(z), 0.0);
# endif
badz: wta(z, (char *)ARG1, s_ex2in);
}
SCM in2ex(z)
SCM z;
{
- if INUMP(z) return z;
+ if (INUMP(z)) return z;
# ifdef BIGDIG
ASRTGO(NIMP(z), badz);
- if BIGP(z) return z;
+ if (BIGP(z)) return z;
# ifndef RECKLESS
if (!(REALP(z)))
badz: wta(z, (char *)ARG1, s_in2ex);
@@ -2400,11 +2445,38 @@ static char s_trunc[] = "truncate";
SCM numident(x)
SCM x;
{
+# ifdef BIGDIG
+ ASRTER(INUMP(x) || (NIMP(x) && BIGP(x)), x, ARG1, s_trunc);
+# else
ASRTER(INUMP(x), x, ARG1, s_trunc);
+# endif
return x;
}
#endif /* FLOATS */
+SCM scm_iabs(x)
+ SCM x;
+{
+#ifdef BIGDIG
+ if (NINUMP(x)) {
+ ASRTER(NIMP(x) && BIGP(x), x, ARG1, s_abs);
+ if (TYP16(x)==tc16_bigpos) return x;
+ return copybig(x, 0);
+ }
+#else
+ ASRTER(INUMP(x), x, ARG1, s_abs);
+#endif
+ if (INUM(x) >= 0) return x;
+ x = -INUM(x);
+ if (!POSFIXABLE(x))
+#ifdef BIGDIG
+ return long2big(x);
+#else
+ wta(MAKINUM(-x), (char *)OVFLOW, s_abs);
+#endif
+ return MAKINUM(x);
+}
+
#ifdef BIGDIG
# ifdef FLOATS
SCM dbl2big(d)
@@ -2584,7 +2656,7 @@ unsigned long hasher(obj, n, d)
case 2: case 6: /* INUMP(obj) */
return INUM(obj) % n;
case 4:
- if ICHRP(obj)
+ if (ICHRP(obj))
return (unsigned)(downcase[ICHR(obj)]) % n;
switch ((int) obj) {
#ifndef SICP
@@ -2607,11 +2679,11 @@ unsigned long hasher(obj, n, d)
default: return 263 % n;
#ifdef FLOATS
case tc16_flo:
- if REALP(obj) {
+ if (REALP(obj)) {
double r = REALPART(obj);
if (floor(r)==r) {
obj = in2ex(obj);
- if IMP(obj) return INUM(obj) % n;
+ if (IMP(obj)) return INUM(obj) % n;
goto bighash;
}
}
@@ -2664,7 +2736,7 @@ SCM hashv(obj, n)
SCM n;
{
ASRTER(INUMP(n) && 0 <= n, n, ARG2, s_hashv);
- if ICHRP(obj) return MAKINUM((unsigned)(downcase[ICHR(obj)]) % INUM(n));
+ if (ICHRP(obj)) return MAKINUM((unsigned)(downcase[ICHR(obj)]) % INUM(n));
if (NIMP(obj) && NUMP(obj)) return MAKINUM(hasher(obj, INUM(n), 10));
else return MAKINUM(obj % INUM(n));
}
@@ -2687,10 +2759,11 @@ static iproc subr1s[] = {
{"integer?", intp},
{s_real_part, real_part},
{s_imag_part, imag_part},
- {s_magnitude, magnitude},
+ {s_magnitude, scm_magnitude},
{s_angle, angle},
{s_in2ex, in2ex},
{s_ex2in, ex2in},
+ {s_abs, scm_abs},
# ifdef BIGDIG
{s_dfloat_parts, scm_dfloat_parts},
# endif
@@ -2703,6 +2776,7 @@ static iproc subr1s[] = {
{"ceiling", numident},
{s_trunc, numident},
{"round", numident},
+ {s_abs, scm_iabs},
#endif
{s_zerop, zerop},
{s_positivep, positivep},
@@ -2772,7 +2846,7 @@ static iproc rpsubrs[] = {
static dblproc cxrs[] = {
{"floor", floor},
{"ceiling", ceil},
- {"truncate", ltrunc},
+ {"truncate", scm_truncate},
{"round", scm_round},
{"$sqrt", sqrt},
{"$abs", fabs},
@@ -2788,14 +2862,14 @@ static dblproc cxrs[] = {
{"$sinh", sinh},
{"$cosh", cosh},
{"$tanh", tanh},
- {"$asinh", lasinh},
- {"$acosh", lacosh},
- {"$atanh", latanh},
+ {"$asinh", asinh},
+ {"$acosh", acosh},
+ {"$atanh", atanh},
{0, 0}};
#endif
#ifdef FLOATS
-static void add1(f, fsum)
+static void safe_add_1(f, fsum)
double f, *fsum;
{
*fsum = f + 1.0;
@@ -2836,11 +2910,11 @@ void init_scl()
# else
{ /* determine floating point precision */
double f = 0.1;
- double fsum = 1.0+f;
+ volatile double fsum = 1.0+f;
while (fsum != 1.0) {
f /= 10.0;
if (++dblprec > 20) break;
- add1(f, &fsum);
+ safe_add_1(f, &fsum);
}
dblprec = dblprec-1;
}
@@ -2849,11 +2923,12 @@ void init_scl()
dbl_mant_dig = DBL_MANT_DIG;
# else
{ /* means we #defined it. */
- double fsum = 0.0, eps = 1.0;
+ volatile double fsum = 0.0;
+ double eps = 1.0;
int i = 0;
while (fsum != 1.0) {
eps = 0.5 * eps;
- add1(eps, &fsum);
+ safe_add_1(eps, &fsum);
i++;
}
dbl_mant_dig = i;
generated by cgit v1.2.3 (git 2.39.1) at 2024-04-27 11:37:17 +0000