! ----------------------------------------------------------------------------
! FP: Core of floating point library
!
! Supplied for use with Inform 6 Serial number 020326
! Release 1/2
! (c) Kevin Bracey 2002
! but freely usable (see manuals)
! ----------------------------------------------------------------------------
[ fpclassifyx x
s h l e;
s = x-->0;
h = x-->1;
l = x-->2;
e = s & $07FF;
if (e == $07FF)
{
if ((h|l) == 0)
x = FP_INFINITYM;
else if (h & $4000)
return FP_NANQ;
else
return FP_NANS;
}
else if ((h|l) == 0)
x = FP_ZEROM;
else if (h >= 0)
x = FP_SUBNORMALM;
else
x = FP_NORMALM;
[ _Denorm h l s
w b t1 grs;
!print "Denormalising ", (hex) h, (hex) l, " by ", s, " bits^";
@log_shift s 0-4 -> w; ! words to shift
b = s & $F; ! bits to shift (0-15)
! Can't guarantee that x << 16 == 0, so must skirt around that case
if (b ~= 0)
{
t1 = 16 - b;
b = -b;
@log_shift l t1 -> grs; ! bottom b bits of l into grs
@log_shift l b -> l; ! shift l down b bits
@log_shift h t1 -> t1; ! bottom b bits of h into l
l = l | t1;
@log_shift h b -> h; ! shift h down b bits
}
if (w == 1 || w >= 3)
{
if (grs) grs = 1;
grs = l | grs;
l = h;
h = 0;
}
if (w >= 2)
{
if (grs || l) grs = 1;
grs = h | grs;
l = 0;
h = 0;
}
! Normalise extended precision number - deals with weird zeros, unnormalised
! operands and infinities properly. Useful for coercing the result of _Promote
! back into something suitable for user (eg trap handler) consumption.
! Assumes the parameter is representable in standard extended format without
! rounding (eg was originally a user-supplied standard or extended number).
[ _fnrmx dest OP
sex mhi mlo exp;
sex = OP-->0 & $87FF; ! strip out nasty bits (just in case)
mhi = OP-->1;
mlo = OP-->2;
exp = sex & $07FF;
@copy_table OP dest 6;
if (exp == $7FF) ! NaNs and infinities OK
{
dest-->1 = mhi & $7FFF; ! but ensure J clear
return;
}
if ((mhi|mlo)==0) ! Check for zeros
{
dest-->0 = sex & $8000; ! Ensure exponent is 0
return;
}
if (mhi < 0) ! Already normalised
return;
! Normalise it
OP = _Normalise(exp, mhi, mlo);
exp = OP-->0;
mhi = OP-->1;
mlo = OP-->2;
! If subnormal, denormalise again
if (exp < 0)
{
OP = _Denorm(mhi, mlo, -exp);
mhi = OP-->0;
mlo = OP-->1;
exp = 0;
}
if (_rounding == 0) _rounding = activefenv.rounding;
switch (_rounding)
{
FE_TONEAREST:
if (RNDgrs < 0) ! round (top) bit set
{
if (RNDgrs ~= $8000) ! sticky bits set
dir = 1;
else ! halfway case
{
if (RNDdir < 0 || (RNDdir == 0 && (RNDmlo & lsb)))
dir = 1;
else
dir = -1;
}
}
else if (RNDgrs > 0)
dir = -1;
FE_DOWNWARD:
if (RNDgrs)
dir = -(RNDsgn+1); ! = +32767 or -1
FE_UPWARD:
if (RNDgrs)
dir = RNDsgn + 1; ! = -32767 or +1
FE_TOWARDZERO:
if (RNDgrs)
dir = -1;
}
if (dir > 0)
{
RNDmlo = RNDmlo + lsb;
if (RNDmlo == 0)
{
if (++RNDmhi == $0) ! Mantissa overflow
{
RNDmhi = $8000;
RNDexp++;
}
}
}
! Update rounding so far
if (dir) RNDdir = dir;
_fpscratch-->0 = RNDmhi;
_fpscratch-->1 = RNDmlo;
_fpscratch-->2 = RNDexp;
_fpscratch-->3 = dir; ! direction of this rounding
_fpscratch-->4 = RNDdir;
return _fpscratch;
];
[ _ReturnResult sex mhi mlo
tmp tmp2;
if (_precision == FE_FMT_X)
{
_dest-->0 = sex;
_dest-->1 = mhi;
_dest-->2 = mlo;
}
else
{
! Simple narrowing - input should be either:
! a) finite with exponent biased for single, unnormalised if necessary
! b) infinity/NaN with exponent = $7FFF
tmp = sex & $FF;
@log_shift tmp 7 -> tmp;
mhi = mhi & $7FFF;
@log_shift mhi 0-8 -> tmp2;
_dest-->0 = (sex & $8000) | tmp | tmp2;
@log_shift mhi 8 -> mhi;
@log_shift mlo 0-8 -> mlo;
_dest-->1 = mhi | mlo;
}
];
! "Exact", normalised result provided, as extended number split into 5 parts.
! Round it to destination precision, then check for over/underflow.
! Denormalise if necessary, and store.
[ _RoundResult RNDsgn RNDexp RNDmhi RNDmlo RNDgrs RNDdir
ExpMin ExpMax BiasAdjust
res;
if (RNDdir ~= 0)
{
if (fpstatus & INXE)
activefenv.inx_handler(_dest, _precision, _op, _rounding);
else
fpstatus = fpstatus | FE_INEXACT;
}
];
! Fast, non-excepting promotion of a number from single to extended
! for internal use. Subnormal numbers will be left unnormalised,
! zeros will have unusual exponents.
[ _Promote OP
sex mhi mlo exp;
sex = OP-->0;
mlo = OP-->1;
! Work out sign
RNDsgn = (OP1sex & $8000) + (OP2sex & $8000);
if (Qmhi == $7FF || Qmlo == $7FF)
{
if (Qmlo ~= $7FF)
{
! Infinity / x
! Return correctly signed infinity
_ReturnResult(RNDsgn | $07FF);
}
else if (Qmhi ~= $7FF)
{
! x / Infinity
! Return correctly signed zero
_ReturnResult(RNDsgn);
}
else
{
! Infinity / Infinity
_RaiseIVO(InvReason_InfDivInf, OP1sex, OP1mhi, OP1mlo,
OP2sex, OP2mhi, OP2mlo);
}
return;
}
if ((OP1mhi|OP1mlo)==0)
{
if ((OP2mhi|OP2mlo)==0)
! Zero / Zero
_RaiseIVO(InvReason_0Div0, OP1sex, OP1mhi, OP1mlo,
OP2sex, OP2mhi, OP2mlo);
else
! Zero / X
_ReturnResult(RNDsgn);
return;
}
if ((OP2mhi|OP2mlo)==0)
{
! X / 0
_RaiseDVZ(OP1sex, OP1mhi, OP1mlo, OP2sex);
return;
}
if (OP1mhi >= 0)
{
c = _Normalise(Qmhi, OP1mhi, OP1mlo);
Qmhi = c-->0;
OP1mhi = c-->1;
OP1mlo = c-->2;
}
if (OP2mhi >= 0)
{
c = _Normalise(Qmlo, OP2mhi, OP2mlo);
Qmlo = c-->0;
OP2mhi = c-->1;
OP2mlo = c-->2;
}
! A basic long division algorithm.
! (Qmhi,Qmmi,Qmlo) will be the quotient
! (c,OP1mhi,OP1mlo) is the dividend (c using 1 bit only)
if (_precision == FE_FMT_S)
reqbits = 24 + 2; ! + 2 for guard + round
else
reqbits = 32 + 2;
! If first operand is infinity, invalid operation
if (OP1exp == $7FF)
{
! Inf % X
_RaiseIVO(InvReason_InfRemX, OP1sex, OP1mhi, OP1mlo,
OP2sex, OP2mhi, OP2mlo);
return;
}
else if (OP1mhi >= 0)
{
! If first operand is 0, return that 0.
if ((OP1mhi|OP1mlo)==0 && (OP2mhi|OP2mlo)~=0)
{
_RoundResult(OP1sex & $8000);
return;
}
! Find how many significant digits we have after the decimal point
for (sig=8: sig>0: sig--)
{
if (_fpscratch->sig ~= '0') break;
}
++sig;
.reposition;
! Decide what the first and last digits we want are
switch (activefenv.printmode)
{
FE_PRINT_E:
first = 0;
dp = 1;
last = activefenv.printprecision;
wantexp = true;
FE_PRINT_F:
if (exp >= 0) first = 0; else first = exp;
dp = 1+exp;
last = activefenv.printprecision + exp;
wantexp = false;
FE_PRINT_G:
tmp = activefenv.printprecision;
if (tmp<=0) tmp=1;
if (exp < -4 || exp >= tmp)
{
first = 0;
dp = 1;
last = tmp-1;
if (last > sig-1) last = sig-1;
wantexp = true;
}
else
{
if (exp >= 0) first = 0; else first = exp;
dp = 1+exp;
last = tmp-1;
if (last > sig-1 && last > dp-1)
{
if (sig > dp)
last = sig-1;
else
last = dp-1;
}
wantexp = false;
}
}
!print "first=", first, " last=", last, " sig=", sig, " dp=", dp; new_line;
if (last < sig-1)
{
! trailing (non-zero) digits beyond last one we're printing
! we need to round again
i = _fpscratch->(last+1);
sig = last+1;
tmp = 0;
switch (fegetround())
{
FE_TONEAREST:
if (i > '5' ||
(i == '5' && sig > (last+2)) ||
(i == '5' && (_fpscratch->last & 1)))
tmp = 1;
FE_UPWARD:
tmp = 1;
FE_TOWARDZERO:
if (sxm < 0) tmp = 1;
}
if (tmp)
{
! Round up - add one, looping to do carries
for (i=last: i>=0: i--)
{
if (++(_fpscratch->i) == '9'+1)
{
_fpscratch->i = '0';
sig = i;
}
else
break;
}
if (i<0)
{
! Whoops - rounded right up
_fpscratch->0 = '1';
sig = 1;
exp++;
}
}
else
{
! Round down - just check trailing zeros again
for (i=last: i>=1: i--)
{
if (_fpscratch->i == '0')
sig = i;
else
break;
}
}
! Think again about what we're printing
jump reposition;
}
! XXX should we print -0?
if (sxm < 0) print (char) '-';
for (i=first: i<=last: i++)
{
if (i==dp)
print (char) '.';
if (i>=0 && i<sig)
print (char) _fpscratch->i;
else
print (char) '0';
}
if (wantexp)
{
print (char) 'E', exp;
}
];
Array _X_Ten --> $0402 $A000 $0000;
! Table look-up of powers of ten up to 10^45.
[ _GetPowerOfTen dest power rnd
a b c n s;
n = power;
s = 0;
! Halve n until it is in the range of the table
while (n > 13)
{
@log_shift n 0-1 -> n;
++s;
}
! Table of powers of ten - contains all exactly representable powers
switch (n)
{
0: a = $03FF; b = $8000;
1: a = $0402; b = $A000;
2: a = $0405; b = $C800;
3: a = $0408; b = $FA00;
4: a = $040C; b = $9C40;
5: a = $040F; b = $C350;
6: a = $0412; b = $F424;
7: a = $0416; b = $9896; c = $8000;
8: a = $0419; b = $BEBC; c = $2000;
9: a = $041C; b = $EE6B; c = $2800;
10: a = $0420; b = $9502; c = $F900;
11: a = $0423; b = $BA43; c = $B740;
12: a = $0426; b = $E8D4; c = $A510;
13: a = $042A; b = $9184; c = $E72A;
}
dest-->0 = a;
dest-->1 = b;
dest-->2 = c;
while (s > 0)
{
! Square result so far
fmulx(dest, dest, dest, rnd);
! Check next bit of power
--s;
@sub 0 s -> sp;
@log_shift power sp -> n;
if (n & 1)
fmulx(dest, dest, _X_Ten, rnd);
}
];
sex = (sex & $8000) | $0FF0;
if (mhi) sex = sex | $0008;
mhi = mhi & $3FFF;
!print "Rearranging InfNaN: ", (hex)mhi, (hex)mlo; new_line;
! Infinity/NaN
! Should trap signalling NaNs - currently caught by fstox()
!
! We do actually convert the bits of the NaN (or indeed infinity) into
! BCD. We are actually converting a single-precision NaN, and don't
! want the bottom 8 bits. So it's a conversion of 22 bits -> 7 digits.
@log_shift mlo 0-8 -> sp;
@log_shift mhi 8 -> sp;
@or sp sp -> mlo;
@log_shift mhi 0-8 -> mhi;
!print "Rearranged InfNaN: ", (hex)mhi, (hex)mlo; new_line;
! Oh gawd, don't ask. This is a binary->decimal
! conversion of (mhi,mlo) -> (dhi,dlo). Each step of
! the loop divides (mhi,mlo) by ten, by using an approximation
! 1/10 = 4/5 * 1/8 ~= $0.CCCCCCCC * 1/8
! m = $0.CCCCCCCC * i is approximated by j = i - (i>>2), k = j + (j>>4),
! l = k + (k>>8), m = l + (l>>16)
! This approvidation gives i DIV 10 <= (m>>3) <= i DIV 10 + 15, and
! we just check the remainder at the end.
! This is hard
! Binary -> decimal conversion. We only provide single-precision conversions,
! as required by the standard, using extended precision to make it work.
!
! The destination format is BCD: $SEEM $MMMM $MMMM representing
! <+/->M.MMMMMMMM x 10^(<+/->EE), M and E being BCD, top bit of S being the
! sign of the number, next bit of S being the sign of the exponent.
[ fstop dst tmp rnd ! tmp = src
sex mhi mlo exp arith tmp2 tmp3 tmp4
inexact digits grs c;
fstox(_workF0, tmp, 1);
sex = _workF0-->0;
mhi = _workF0-->1;
mlo = _workF0-->2;
exp = sex & $07FF;
if ((mhi | mlo) == 0)
{
sex = sex & $8000;
jump done;
}
! Now have a normalised (originally single precision) number, in
! extended form. exp is in the range 1-23+(1023-127) to +254+(1023-127)
! = $36A to $47E. We now add one to the exponent (so the mantissa
! lies within [1/2 .. 1), and remove the bias.
arith = exp - 1023 + 1;
! arith is now in the range [-148 .. +128]. We need to
! make it a decimal exponent. This needs a logarithm, but we'll start off
! with an approximation that can only be off by +1.
!
! We know:
!
! 2^(arith-1) <= value < 2^arith
!
! Taking base-10 logarithms:
!
! (arith-1)*log(2) <= log(value) < arith*log(2)
!
! Let log2lo and log2hi be slightly too low and high approximations to log(2).
!
! if (arith > 0): (arith-1)*log2lo <= log(value) < arith*log2hi
! if (arith <= 0): (arith-1)*log2hi <= log(value) < arith*log2lo
!
! Let D = log2hi-log2lo:
!
! if (arith > 0)
! arith*log2hi - arith*D - log2lo <= log(value) < arith*log2hi
! if (arith <= 0)
! arith*log2lo - (-arith*D) - log2hi <= log(value) < arith*log2lo
!
! Then, provided that log2lo and log2hi are such that (128*D+log2lo) <= 1
! and (148*D+log2hi) <= 1:
!
! if (arith > 0)
! floor(arith*log2hi) - 1 <= floor(log(value)) <= floor(arith*log2hi)
! if (arith <= 0)
! floor(arith*log2lo) - 1 <= floor(log(value)) <= floor(arith*log2lo)
!
! Which gives us the desired bounds.
!
! The conditions are satisfied as long as D <= 2^(-8), but we want as
! much accuracy as we can get without overflowing a 16-bit multiplication.
! We can afford to set D to 2^(-9) giving us 8 bits of accuracy in log2,
! and 7 bits of accuracy in arith, leading to a 15-bit result.
!
! So we choose log2lo = 154 * 2^(-9) = ~ 0.30078 (log(2) = ~0.30103)
! log2hi = 155 * 2^(-9) = ~ 0.30273
if (arith > 0)
tmp2 = 155; ! 2^9 * log2hi
else
tmp2 = 154; ! 2^9 * log2lo
tmp2 = arith * tmp2;
@art_shift tmp2 0-9 -> arith;
!print "approximate exponent=", arith; new_line;
! Now arith-1 <= floor(log(value)) = base-10 exponent <= arith
if (arith >= 0)
{
tmp = arith;
if (arith == 0)
jump expadjustdone;
}
else
tmp = -arith;
! We now need to multiply the original value by 10^(-arith) to get
! the correct decimal mantissa.
! We'll use some FP - remember status, and disable exceptions
tmp2 = fpstatus;
! If the mantissa is <1, decrement the arith exponent, and proceed
! to "multiply by ten", otherwise extract the first digit.
exp = 0;
tmp2 = 0;
if (mhi & $F000)
jump extract_digit;
--arith;
! Stage one - three words to go, accumulating into two words
do
{
! First multiply by 2
mhi = mhi + mhi; if (mlo < 0) ++mhi;
mlo = mlo + mlo; if (grs < 0) ++mlo;
grs = grs + grs;
! Then by five - work out (mhi,mlo,grs)*4 + (mhi,mlo,grs)
@log_shift grs 2 -> tmp3;
@log_shift grs 0-14 -> sp;
@log_shift mlo 2 -> sp;
@or sp sp -> tmp4;
@log_shift mlo 0-14 -> sp;
@log_shift mhi 2 -> sp;
@or sp sp -> tmp;
grs = grs + tmp3;
c = _UCmp(grs, tmp3) < 0;
tmp3 = mlo + tmp4 + c;
c = (mlo < 0 && tmp4 < 0) ||
(mlo < 0 && tmp3 >= 0) ||
(tmp4 < 0 && tmp3 >= 0);
mlo = tmp3;
mhi = mhi + tmp + c;
.extract_digit;
! The integer part of the number is the next digit. Move it up into
! exp, and decrement the digit count.
@log_shift tmp2 4 -> sp;
@log_shift exp 0-12 -> sp;
@or sp sp -> tmp2;
@log_shift exp 4 -> sp;
@log_shift mhi 0-12 -> sp;
@or sp sp -> exp;
mhi = mhi & $0FFF;
--digits;
} until (grs==0);
tmp = 0;
! Second loop - two words to process in (mhi,mlo) - accumulating
! into (tmp,tmp2,exp).
do
{
! Multiply by 2 then 5, as before
mhi = mhi + mhi; if (mlo < 0) ++mhi;
mlo = mlo + mlo;
@log_shift mlo 0-14 -> sp;
@log_shift mlo 2 -> tmp3;
mlo = mlo + tmp3;
c = _UCmp(mlo, tmp3) < 0;
@log_shift mhi 2 -> sp;
@or sp sp -> tmp3;
mhi = mhi + tmp3 + c;
! Get final inexactitude. In practice, this doesn't work very well,
! as there are many exact cases where the two errors cancel each other
! out.
inexact = inexact | mhi | mlo;
@log_shift mhi 0-11 -> c; ! Round bit
mhi = (mhi & $07FF) | mlo; ! Sticky bits
!if (inexact || c || mhi)
!{
! if (inexact) print "Inexact ";
! if (c) print "Round ";
! if (mhi) print "Sticky ";
! new_line;
!}
mlo = 0; ! round up flag
switch (rnd)
{
FE_TONEAREST:
if (c)
if (mhi || (exp & 1))
mlo = 1;
FE_UPWARD:
if (sex >= 0 && (c | mhi))
mlo = 1;
FE_DOWNWARD:
if (sex < 0 && (c | mhi))
mlo = 1;
}
if (inexact)
{
if (fpstatus & INXE)
activefenv.inx_handler(dst, FE_FMT_P, FE_OP_DEC, fegetround());
else
fpstatus = fpstatus | FE_INEXACT;
}
];
! Accumulate n BCD digits from the top of src into (dest-->0,dest-->1)
[ _readdigits dest src n
hi lo tmp c;
hi = dest-->0;
lo = dest-->1;
do
{
! First multiply by 10
hi = hi + hi; if (lo < 0) ++hi;
lo = lo + lo;
@log_shift lo 0-14 -> sp;
@log_shift lo 2 -> tmp;
lo = lo + tmp;
c = _UCmp(lo, tmp) < 0;
@log_shift hi 2 -> sp;
@or sp sp -> tmp;
hi = hi + tmp + c;
! Then add in the new digit
@log_shift src 0-12 -> tmp;
lo = lo + tmp;
if (_UCmp(lo, tmp) < 0) ++hi;
@log_shift src 4 -> src;
}
until (--n == 0);
dest-->0 = hi;
dest-->1 = lo;
];
[ _fptos_naninf dest sex mhi mlo rnd;
!print "_fptos_naninf(", (hex) sex, (hex) mhi, (hex) mlo; print ")^";
if ((mhi | mlo | (sex & $F)) == 0)
{
! Infinity
sex = (sex & $8000) | $7F80;
jump done;
}
! Check quiet / signalling NaN
! (we don't trigger signalling NaNs until converted, as we're
! supposed to supply the trap handler in extended form. Is this
! sensible?)
@test sex $0008 ?~sig;
@or sex $0040 -> sex;
.sig;
sex = (sex & $8040) | $7F80;
! Pull out the bottom 7 digits only - all we care about for NaNs
_fpscratch-->0 = 0;
_fpscratch-->1 = 0;
@log_shift mhi 4 -> mhi;
_readdigits(_fpscratch, mhi, 3);
_readdigits(_fpscratch, mlo, 4);
! (mhi,mlo) = value for NaN. Could be 24 bits if unusual - knock back to
! 22, and then we're all ready
mhi = _fpscratch-->0;
mlo = _fpscratch-->1;
!print "Read digits: ", (hex) mhi, (hex) mlo; new_line;
mhi = mhi & $003F;
sex = sex | mhi;
if ((sex & $0040)==0)
{
! We now trigger the NaN.
_dest = dest;
_precision = FE_FMT_S;
_op = FE_OP_DEC;
_rounding = rnd;
_RaiseIVO(InvReason_SigNaN, sex, mhi, mlo);
return;
}
.done;
dest-->0 = sex;
dest-->1 = mlo;
];
! Short cut for zero
if ((mhi|mlo)==0)
{
dest-->0 = sex & $8000;
dest-->1 = 0;
return;
}
if (sex & $4000)
arith = -arith;
! Adjust because we've got a 9 digit integer, not 1.8 digit decimal
arith = arith - 8;
! Want to convert (mhi,mlo) into an extended precision number
! Need to normalise. We know (mhi,mlo)< 10^9 < 2^30
sex = sex & $8000;
sex = sex + 1023 + 31;
while (mhi >= 0)
{
mhi = mhi + mhi; if (mlo < 0) ++mhi;
mlo = mlo + mlo;
--sex;
}
! Now just need to multiply by 10^arith. |arith| <= 99, so overflow
! isn't possible (we're spared because we refuse to do binary<->decimal
! on extended precision).
! Convert ZSCII string to single. len is length of string (will
! not read beyond this). Returns number of characters consumed.
[ strtof dest str len
c hex sign had_dot num_ok dhi dmi dlo exp cnt exp2 negexp;
! print "strtof($", (hex) dest, ",$", (hex) str, ",", len, ")^";
if (len>=0) c = str->(cnt++);
while (len>0 && c==' ')
if (--len>0) c = str->(cnt++);
if (len>0 && (c=='+' || c=='-'))
{
if (c=='-') sign = $8000;
if (--len>0) c = str->(cnt++);
}
if (len>0) switch (c)
{
'$': hex = 1; if (--len>0) c = str->(cnt++);
'n','N': return _strtof_nan(dest, str, cnt, len, sign);
'i','I': return _strtof_inf(dest, str, cnt, len, sign);
}
while (len > 0)
{
!print "Got '", (char) c, "'^";
if (c=='.' && ~~had_dot)
had_dot=true;
else if ((c>='0' && c<='9') ||
(hex && ((c>='a' && c<='f') || (c>='A' && c<='F'))))
{
num_ok=true;
if (c<='9') c=c-'0';
else if (c<='F') c=c-'A'+10;
else c=c-'a'+10;
if (dhi==0)
{
@log_shift dmi 0-12 -> dhi;
@log_shift dmi 4 -> sp;
@log_shift dlo 0-12 -> sp;
@or sp sp -> dmi;
@log_shift dlo 4 -> sp;
@or sp c -> dlo;
if (had_dot) --exp;
}
else
{
if (hex && c ~= '0') dlo = dlo | 1;
if (~~had_dot) ++exp;
}
}
else
break;
if (--len>0) c = str->(cnt++);
}
if (hex) exp = exp * 4;
if (len>0 && num_ok &&
(c=='e' || c=='E' || (hex && (c=='p' || c=='P'))))
{
num_ok=false;
if (--len>0)
{
c = str->(cnt++);
if (c=='-' || c=='+')
{
if (c=='-') negexp = true;
if (--len>0) c = str->(cnt++);
}
while (len>0 && c>='0' && c<='9')
{
num_ok=true;
exp2 = exp2*10 + c-'0';
if (--len>0) c = str->(cnt++);
}
if (negexp)
exp = exp-exp2;
else
exp = exp+exp2;
}
}
if (len>0) cnt--;
if (~~num_ok)
{
dest-->0=$0000;
dest-->1=$0000;
return 0;
}
!print (hex) dhi, (hex) dmi, (hex) dlo, " E", exp; new_line;
if ((dhi|dmi|dlo)==0)
{
dest-->0=sign; ! Do we want signed zero input? Why not?
dest-->1=$0000;
}
else
{
if ((dhi|dmi)==0)
{
dmi = dlo;
dlo = 0;
if (hex) exp=exp-16; else exp=exp-4;
}
! print (hex) dhi, (hex) dmi, (hex) dlo, " E", exp; new_line;
if (hex)
{
exp=exp+31+16+1023;
while (dhi == 0)
{
dhi = dmi;
dmi = dlo;
dlo = 0;
exp = exp - 16;
}
while (dhi >= 0)
{
dhi = dhi+dhi; if (dmi < 0) dhi++;
dmi = dmi+dmi; if (dlo < 0) dmi++;
dlo = dlo+dlo;
exp--;
}
