Commit 9581e8ac authored by Anton Ertl's avatar Anton Ertl

replaced ecvt_r-based REPRESENT with snprintf-based one

parent 3e7e1d07
......@@ -529,6 +529,7 @@ struct Cellpair parse_white(Char *c_addr1, UCell u1);
Cell rename_file(Char *c_addr1, UCell u1, Char *c_addr2, UCell u2);
struct Cellquad read_line(Char *c_addr, UCell u1, FILE *wfileid);
struct Cellpair file_status(Char *c_addr, UCell u);
struct Cellpair represent(Float r, Address c_addr, UCell u, Cell *np);
Cell to_float(Char *c_addr, UCell u, Float *r_p, Char dot);
Float v_star(Float *f_addr1, Cell nstride1, Float *f_addr2, Cell nstride2, UCell ucount);
void faxpy(Float ra, Float *f_x, Cell nstridex, Float *f_y, Cell nstridey, UCell ucount);
......
......@@ -594,6 +594,63 @@ struct Cellpair file_status(Char *c_addr, UCell u)
return r;
}
static void repstr(Address s, Address t, UCell u)
{
UCell slen = strlen(s);
if (slen>u)
slen = u;
memcpy(t,s,slen);
memset(t+slen,' ',u-slen);
}
struct Cellpair represent(Float r, Address c_addr, UCell u, Cell *np)
{
Cell ok, sign, decpt;
struct Cellpair fs;
Address s;
Address t;
Char buf[u+8]; /* extra chars: .e-9999\0 */
if (isnan(r)) {
sign = 0;
decpt = 0;
ok = 0;
repstr("NaN",c_addr,u);
} else {
sign = FLAG(r<0);
if (isinf(r)) {
decpt=0;
ok = 0;
if (r<0 && u>0) {
*c_addr++ = '-';
u--;
}
repstr("infinity",c_addr,u);
} else {
ok = -1;
r = fabs(r);
snprintf(buf,u+8,"%.*e",r,u-1);
for (s=buf, t=c_addr;; s++) {
char c = *s;
if ('0'<=c && c<='9')
*t++ = c;
else if (c != '.')
break;
}
/* fprintf(stderr,"r=%.*e, t=%p, c_addr=%p, u=%ld\n",r,u-1,t,c_addr,u);*/
assert(t == c_addr+u);
assert(*s == 'e');
s++;
if (*s == '+')
s++;
decpt = atoi(s)+1;
}
}
*np = decpt;
fs.n1 = sign;
fs.n2 = ok;
return fs;
}
Cell to_float(Char *c_addr, UCell u, Float *rp, Char dot)
{
/* convertible string := <significand>[<exponent>]
......
......@@ -2589,33 +2589,9 @@ else
r3 = r2;
represent ( r c_addr u -- n f1 f2 ) float
char sig[0x40];
size_t siglen;
int flag;
int decpt;
if (isnan(r)) {
flag=0;
decpt=0;
strncpy(sig, "nan", 0x3f); /* normalize nan output */
} else {
#ifdef HAVE_QECVT_R
qecvt_r(r, u, &decpt, &flag, sig, 0x3f);
#else
ecvt_r(r, u, &decpt, &flag, sig, 0x3f);
#endif
}
n=(r==0. ? 1 : decpt);
flag=signbit(r); /* not all ecvt()s do this as desired */
f1=FLAG(flag!=0);
f2=FLAG(isdigit((unsigned)(sig[0]))!=0);
siglen=strlen((char *)sig);
if (siglen>u) /* happens in glibc-2.1.3 if 999.. is rounded up */
siglen=u;
if (!f2) /* workaround Cygwin trailing 0s for Inf and Nan */
for (; sig[siglen-1]=='0'; siglen--);
;
memmove(c_addr,sig,siglen);
memset(c_addr+siglen,f2?'0':' ',u-siglen);
struct Cellpair fs = represent(r, c_addr, u, &n);
f1 = fs.n1;
f2 = fs.n2;
>float ( c_addr u -- f:... flag ) float to_float
""Actual stack effect: ( c_addr u -- r t | f ). Attempt to convert the
......
......@@ -257,7 +257,7 @@ What message and/or values does Division by Zero produce?
Trying to compute 1 / 0 produces ...inf
Trying to compute 0 / 0 produces ...nan
Trying to compute 0 / 0 produces ...NaN
Diagnosis resumes after milestone Number 220
Page: 10
......
Markdown is supported
0%
or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment