4.3BSD/usr/contrib/B/src/bint/b1nuC.c
/* Copyright (c) Stichting Mathematisch Centrum, Amsterdam, 1985. */
/*
$Header: b1nuC.c,v 1.4 85/08/22 16:50:36 timo Exp $
*/
#include <ctype.h>
#include "b.h"
#include "b0con.h"
#include "b0fea.h"
#include "b1obj.h"
#include "b1mem.h"
#include "b1num.h"
#include "b2syn.h" /* temporary until numconst is fixed */
char *sprintf(); /* OS */
extern value tento();
extern integer int_tento();
#define EXPDIGITS 10 /* Extra positions to allow for exponent part */
/* -- must be larger than tenlogBASE */
#define MAXDIGITS (MAXNUMDIG-1) /* Max precision for fixed/floating numbers */
#define CONVBUFSIZE (MAXDIGITS+4)
/* Maximum number of digits to print in integer notation */
/* (4 is the size of 'e+00' added by sprintf) */
/* Convert an integer to a C character string.
The character string is overwritten on each next call.
It assumes BASE is a power of 10. */
Hidden char *convint(v) register integer v; {
static char *buffer, shortbuffer[tenlogBASE+3];
static char fmt[10];
register char *cp;
register int i;
bool neg = No;
if (IsSmallInt(v)) {
sprintf(shortbuffer, "%d", SmallIntVal(v));
return shortbuffer;
}
if (Digit(v, Length(v)-1) < 0) {
neg = Yes;
v = int_neg(v);
}
if (buffer) freemem(buffer);
buffer = getmem((unsigned)(Length(v)*tenlogBASE + 1 + neg));
cp = buffer;
if (neg) *cp++ = '-';
sprintf(cp, "%d", Msd(v));
if (!IsSmallInt(v)) {
if (!*fmt) sprintf(fmt, "%%0%dd", tenlogBASE);
while (*cp) ++cp;
for (i = Length(v)-2; i >= 0; --i, cp += tenlogBASE)
sprintf(cp, fmt, Digit(v, i));
if (neg) release((value) v);
}
return buffer;
}
#ifdef EXT_RANGE
/* This is terrible. But never mind, it'll all change (sometimes). */
Hidden bool hugenumber(v) value v; {
bool huge;
real w = (real) approximate(v);
huge = Expo(w) > Maxexpo || Expo(w) < Minexpo && Frac(w) != 0;
release((value)w);
return huge;
}
Hidden string convapp(v) value v; {
value absv, tenlogv, expo, tentoexpo, frac;
static char buf[100];
char fmt[15];
int precision;
double fracval, expoval, i;
absv = absval(v);
tenlogv = log2((value)int_10, absv), release(absv);
expo = floorf(tenlogv), release(tenlogv);
expoval = numval(expo), release(expo);
if (expoval*tenlogBASE >= Maxintlet || expoval*tenlogBASE <= -Maxintlet) {
expo = (value) mk_approx(expoval, 0.0);
tentoexpo = power((value)int_10, expo), release(expo);
}
else
tentoexpo = tento((int)expoval);
frac = quot(v, tentoexpo), release(tentoexpo);
fracval = numval(frac), release(frac);
while (fabs(fracval) >= 10) fracval /= 10, ++expoval;
while (fabs(fracval) < 1) fracval *= 10, --expoval;
precision = MAXDIGITS;
i = expoval < 0 ? -expoval : expoval;
while (i >= 10 && precision > 2) --precision, i /= 10;
/* Loose precision for large exponents! */
/* :-( But keep some too! )-: */
sprintf(fmt, "%%.%dlgE%%s%%2.0lf", precision);
sprintf(buf, fmt, fracval, expoval >= 0 ? "+" : "", expoval);
return buf;
}
#endif EXT_RANGE
/* Convert a numeric value to a C character string.
The character string is overwritten on each next call. */
Visible string convnum(v) register value v; {
static char convbuf[3+CONVBUFSIZE+EXPDIGITS];
/* 3 extra for things (sign, 0.) to be stuck on front of it */
static char fmt[10];
char *bufstart = convbuf+3;
register char *cp = bufstart;
double x;
if (Integral(v)) return convint((integer)v);
#ifdef EXT_RANGE
if (hugenumber(v)) return convapp(v);
#endif
/* Reasonably-sized reals and rationals are treated alike.
However, not-too-large rationals resulting from
'n round x' are transformed to f-format. */
x = numval(v);
if (!*fmt) sprintf(fmt, "%%.%dlg", MAXDIGITS);
sprintf(bufstart, fmt, x);
for (cp = bufstart; *cp != '\0'; ++cp)
if (*cp == 'e') { /* change sprintf's 'e' to 'E' */
*cp = 'E';
break;
}
#ifdef IBMPC
if (*cp != 'E') {
/* Delete trailing zeros after decimal pt; don't rely on %g */
for (cp = bufstart; *cp != '\0' && *cp != '.'; ++cp)
;
if (*cp == '.') {
char *ep;
for (; *cp != '\0' && *cp != 'E'; ++cp)
;
ep = cp;
while (*--cp == '0')
;
if (++cp < ep) {
while (*ep != '\0')
*cp++ = *ep++;
*cp = '\0';
}
}
}
#endif IBMPC
if (Rational(v) && Roundsize(v) > 0 && *cp != 'E') {
int i = Roundsize(v);
int j = 1;
/* Counts digits allowed beyond MAXDIGITS, 1 for '.' */
for (cp = bufstart; *cp == '0'; ++cp)
++j; /* Allow a trailing zero for each leading zero */
for (; *cp != '\0' && *cp != '.'; ++cp)
; /* Find '.' or end of string */
if (*cp == '\0') {
*cp = '.'; /* Append '.' if not found */
*++cp = '\0';
}
else {
while (*++cp == '0')
/* Allow more precision if leading zeros */
++j, --i;
while (*cp != '\0')
--i, ++cp; /* Find last digit */
}
/* Append extra zeros (but don't show more precision
than sprintf can!) */
while (--i >= 0 && cp < bufstart+MAXDIGITS+j)
*cp++ = '0';
*cp = '\0'; /* Append new terminating null byte */
}
return bufstart;
}
/* Convert a string to a number (assume it's syntactically correct!).
Pointers to the first and last+1 characters are given.
Again, BASE must be a power of 10.
********** NEW **********
If E_EXACT is defined, all numbers input are made exact, even if
E-notation is used.
********** WARNING **********
This routine must be fixed, because it accesses the source buffer
and it shouldn't because it's in the wrong place in the hierarchy
*/
Visible value numconst(text, end) register txptr text, end; {
register txptr tp;
register int numdigs, fraclen;
integer a;
register digit accu;
value c;
if (Char(text) == 'E') a = int_1;
else {
while (text<end && Char(text)=='0') ++text; /* Skip leading zeros */
for (tp = text; tp<end && isdigit(Char(tp)); ++tp)
; /* Count integral digits */
numdigs = tp-text;
fraclen = 0;
if (tp<end && Char(tp)=='.') {
++tp;
for (; tp<end && isdigit(Char(tp)); ++tp)
++fraclen; /* Count fractional digits */
numdigs += fraclen;
}
a = (integer) grab_num((numdigs+tenlogBASE-1) / tenlogBASE);
if (!a) return Vnil; /* Recovered error */
accu = 0;
/* Integer part: */
for (; text<end && isdigit(Char(text)); ++text) {
accu = accu*10 + Char(text)-'0';
--numdigs;
if (numdigs%tenlogBASE == 0) {
Digit(a, numdigs/tenlogBASE) = accu;
accu = 0;
}
}
/* Fraction: */
if (text < end && Char(text) == '.') {
++text;
for (; text<end && isdigit(Char(text)); ++text) {
accu = accu*10 + Char(text)-'0';
--numdigs;
if (numdigs%tenlogBASE == 0) {
Digit(a, numdigs/tenlogBASE) = accu;
accu = 0;
}
}
}
if (numdigs != 0) syserr(MESS(800, "numconst: can't happen"));
a = int_canon(a);
}
/* Exponent: */
if (text >= end || Char(text) != 'E') {
integer b = int_tento(fraclen);
c = mk_exact(a, b, fraclen);
release((value) b);
}
else {
double expo = 0;
int sign = 1;
value b;
++text;
if (text < end) {
if (Char(text) == '+') ++text;
else if (Char(text) == '-') {
++text;
sign = -1;
}
}
for (; text<end && isdigit(Char(text)); ++text) {
expo = expo*10 + Char(text)-'0';
if (expo > Maxint) {
error(MESS(801, "excessive exponent in E-notation"));
expo = 0;
break;
}
}
b = tento((int)expo * sign - fraclen);
#ifndef E_EXACT
/* Make approximate number if E-notation used */
c = approximate(b);
release(b);
b = c;
#endif
if (a == int_1) c = b;
else c = prod((value)a, b), release(b);
}
release((value) a);
return c;
}
/*
* printnum(f, v) writes a number v on file f in such a way that it
* can be read back identically, assuming integral powers of ~2 can be
* computed exactly. (This is necessary for the permanent environment.)
*/
Visible Procedure printnum(f, v) FILE *f; value v; {
if (Approximate(v)) {
#ifdef PRINT_APPROX
if (Frac((real)v) == 0) fprintf(f, "~0");
else {
static char fmt[25];
if (!*fmt)
sprintf(fmt, "%%.%dlgE0*~2**%%.0lf", MAXDIGITS+2);
fprintf(f, fmt, Frac((real)v), Expo((real)v));
}
return;
#else
fputc('~', f);
#endif
}
if (Rational(v) && Denominator((rational)v) != int_1) {
int i = Roundsize(v);
fputs(convnum((value)Numerator((rational)v)), f);
if (i > 0 && i <= MAXDIGITS) {
/* The assumption here is that in u/v, the Roundsize
of the result is the sum of that of the operands. */
putc('.', f);
do putc('0', f); while (--i > 0);
}
putc('/', f);
v = (value) Denominator((rational)v);
}
fputs(convnum(v), f);
}