bammi@dsrgsun.ces.cwru.edu (Jwahar R. Bammi) (11/28/88)
#!/bin/sh
# This is a shell archive, meaning:
# 1. Remove everything above the #!/bin/sh line.
# 2. Save the resulting text in a file.
# 3. Execute the file with /bin/sh (not csh) to create the files:
# Makefile
# README.UPDATE
# dflonum.c
# eprintf.c
# flonum.h
# sflonum.s
# This archive created: Thu Oct 27 21:59:41 1988
# By: Jwahar R. Bammi(Case Western Reserve University)
# Uucp: {decvax,sun,att}!cwjcc!dsrgsun!bammi
# Csnet: bammi@dsrgsun.ces.CWRU.edu
# Arpa: bammi@dsrgsun.ces.CWRU.edu
#
export PATH; PATH=/bin:$PATH
echo shar: extracting "'Makefile'" '(205 characters)'
if test -f 'Makefile'
then
echo shar: over-writing existing file "'Makefile'"
fi
sed 's/^X//' << \SHAR_EOF > 'Makefile'
Xall: lshort llong
X
Xlshort:
X make -f Makefile.16 clean
X make -f Makefile.16
X
Xllong:
X make -f Makefile.32 clean
X make -f Makefile.32
X
Xclean:
X make -f Makefile.16 clean
X make -f Makefile.32 clean
X rm -f core
SHAR_EOF
if test 205 -ne "`wc -c 'Makefile'`"
then
echo shar: error transmitting "'Makefile'" '(should have been 205 characters)'
fi
echo shar: extracting "'README.UPDATE'" '(1709 characters)'
if test -f 'README.UPDATE'
then
echo shar: over-writing existing file "'README.UPDATE'"
fi
sed 's/^X//' << \SHAR_EOF > 'README.UPDATE'
XThis shar file contains all the context diffs and additional files
Xfor GCC minix St library update #1. The context diff are with respect
Xto the GCC minix library distributed with the initial release of
Xgcc v1.30 for minix St. This means that you should have *already* applied
Xa set of diffs that came with that distribution to the origonal library
Xsources that came with minix St, *before* you apply the diffs in this
Xshar file.
X
XAcknowledgements:
X Many thanks to John Denning who contributed the fixed
Xfloating point support routines and to Scott McCauley who initially
Xwrote them. Thanks also to Frans Meulenbroeks and Terrence Holm who
Xhave been regularly sending fixes for the library code to the net.
X
XInstallation:
X
X - please double check that the SRC directory contains the
X library source obtained by applying diffs that came with
X the initial distribution of gcc v1.30 to files from
X /usr/src/lib, and by adding additional files that came
X which came with that distribution.
X
X - copy all the files in this directory to the SRC directory.
X - apply the diffs using Larry Wall's patch program
X patch < lib-updat1.diff
X - edit Makefile.16 and Makefile.32 to adjust $(CROSSDIR)
X - run the following command to build all the library objects
X make -f Makefile.16 to build all the 16 bit integer objects
X make -f Makefile.16 clean to clean them out
X make -f Makefile.32 to build all the 32 bit integer objects
X (alternately you can just hit make, in which case it will use
X Makefile)
X
X Please send your feed-back to:
X--
Xusenet: {decvax,sun}!cwjcc!dsrgsun!bammi jwahar r. bammi
Xcsnet: bammi@dsrgsun.ces.CWRU.edu
Xarpa: bammi@dsrgsun.ces.CWRU.edu
XcompuServe: 71515,155
SHAR_EOF
if test 1709 -ne "`wc -c 'README.UPDATE'`"
then
echo shar: error transmitting "'README.UPDATE'" '(should have been 1709 characters)'
fi
echo shar: extracting "'dflonum.c'" '(18187 characters)'
if test -f 'dflonum.c'
then
echo shar: over-writing existing file "'dflonum.c'"
fi
sed 's/^X//' << \SHAR_EOF > 'dflonum.c'
X/* A working Gnulib68k, thanks to Scott McCauley for the origonal
X version, and John Dunning (jrd@STONY-BROOK.SCRC.Symbolics.COM)
X who got this working.
X
X Please not that only the double float. stuff is picked up from
X here, the other long-int and single float stuff come from
X fixnum.s and sflonum.s (see flonum.h for the appr. #defs).
X ++jrb
X */
X
X/* Subroutines needed by GCC output code for the 68000/20.
X
X Compile using -O flag with gcc.
X Use the -m68000 flag if you have a 68000
X
X This package includes 32 bit integer and 64-bit floating
X point routines.
X
X WARNING: alpha-test version (July 1988) -- probably full of bugs.
X If you find a bug, send bugs reports to jsm@phoenix.princeton.edu,
X or
X
X Scott McCauley
X PPPL P. O. Box 451
X Princeton NJ 08543
X
X Known bugs/features:
X
X 1) Depending on the version of GCC, this may produce a lot of
X warnings about conversion clashes, etc. It should still compile
X as is. Also, there appears to be a bug in the register-allocation
X parts of gcc that makes the compiler sometimes core dump
X or run into an infinite loop. This version works -- if you
X decide to change routines these compiler bugs can bite very hard....
X
X 2) all single-precision gets converted to double precision in the
X math routines (in accordance with K&R), so doing things in
X double precision is faster than single precision....
X
X 3) double precision floating point division may not be accurate to
X the last four or so bits. Most other routines round to the
X lsb.
X
X 4) no support of NaN and Inf
X
X 5) beware of undefined operations: i.e. a float to integer conversion
X when the float is larger than MAXIINT.
X
X */
X
X#include <stdio.h>
X/* #include <math.h> */
X
X#include "flonum.h"
X
X#define umultl _umulsi
X#define multl _mulsi3
X#define udivl _udivsi3
X#define divl _divsi3
X#define ddiv _divdf3
X#define qmult _qmult
X#define dmult _muldf3
X#define dneg _negdf2
X#define dadd _adddf3
X#define dcmp _cmpdf2
X#define dtoul _fixunsdfsi
X#define dtol _fixdfsi
X#define ltod _floatsidf
X
X#if 0 /* see eprintf.c in minix library */
X#ifdef L_eprintf
X#include <stdio.h>
X/* This is used by the `assert' macro. */
Xvoid
X _eprintf (string, line)
Xchar *string;
Xint line;
X{
X fprintf (stderr, string, line);
X}
X#endif
X#endif
X
X#ifdef L_umulsi3
X
X/*_umulsi3 (a, b) unsigned a, b; { return a * b; } */
X
Xunsigned long umultl(a,b)
Xunsigned long a, b;
X{
X register unsigned long d7, d6, d5, d4;
X
X d7 = a;
X d6 = b;
X d5 = d6;
X d4 = d6;
X /* without the next line, gcc may core dump. Gcc sometimes
X gets confused if you have too many registers */
X
X &a; &b;
X
X /*printf("a %u b %u\n", a, b);*/
X
X /* low word */
X MUL(d7, d6);
X SWAP(d5);
X MUL(d7, d5);
X SWAP(d7);
X MUL(d7, d4);
X d4 += d5;
X SWAP(d4);
X d4 &= 0xFFFF0000;
X d4 += d6;
X return(d4);
X}
X#endif
X
X#ifdef L_mulsi3
X/* _mulsi3 (a, b) int a, b; { return a * b; } */
X
Xlong multl(a, b)
Xlong a, b;
X{
X int sign = 0;
X long umultl();
X if ((a ^ b) < 0) sign = 1;
X if (a < 0) a = -a;
X if (b < 0) b = -b;
X /*printf("a is %d b is %d\n", a, b);*/
X if (sign) return(- umultl(a,b));
X else return(umultl(a,b));
X}
X
X#endif
X
X#ifdef L_udivsi3
X/*_udivsi3 (a, b) unsigned a, b; { return a / b; } */
X
X/*
X this routine based on one in the PD forth package for the sun by Mitch Bradley
X */
X
Xunsigned udivl(u, v)
Xregister unsigned long u, v;
X{
X register unsigned short um, ul, vm, vl;
X unsigned long ans;
X unsigned long u1, v1;
X long i;
X long rem;
X
X if (v == 0) {
X /* should cause an exception condition */
X DIV(u, v);
X fprintf(stderr, "division by zero\n");
X }
X if (v > u) return(0);
X
X ul = u; SWAP(u); um = u;
X vl = v; SWAP(v); vm = v;
X if (vm == 0) {
X u = vl; v = um;
X DIV(u, v);
X /* note -- if you delete the next line, gcc goes into
X an infinite loop */
X if (vm) printf("result is %d\n", v);
X vm = v & 0xFFFF; /* dividend is in low word */
X v &= 0xFFFF0000; /* remainder is in high word */
X v += ul;
X DIV(vl, v);
X v &= 0xFFFF; /* dividend is in low word */
X u = vm;
X SWAP(u);
X return(v + u);
X /*ans = ((um / vl) << 16) + ((((um % vl) << 16) + ul) / vl);
X return(ans);*/
X }
X
X if (vl == 0) return(um / vm);
X SWAP(u); SWAP(v);
X if ( (u >> 3) < v) {
X for(i = 0; u >= v; i++, u -= v);
X /*printf("lt 8\n");*/
X return(i);
X }
X u1 = u; v1 = v;
X
X /* scale divisor */
X v1--;
X for(i = 0; ((unsigned) v1) >= 0xFFFF; v1 >>= 1, i++);
X if (++v1 > 0xFFFF) {
X i++; v1 >>=1;
X }
X u1 >>= i;
X /*printf("i is %d, u1 is %x, v1 is %x\n", i, u1, v1);*/
X ans = u1 / v1;
X rem = u - (ans * v);
X if (rem > v) {ans++; rem -= v; }
X if (rem > v) {printf("oops\n");}
X return(ans);
X}
X#endif
X
X#ifdef L_divsi3
X
Xlong divl(a, b)
Xlong a, b;
X{
X int sign = 0;
X if ((a ^ b) < 0) sign = 1;
X if (a < 0) a = -a;
X if (b < 0) b = -b;
X if (sign) return(-udivl(a,b));
X else return(udivl(a,b));
X}
X#endif
X
X#ifdef L_umodsi3
X_umodsi3 (a, b)
Xunsigned a, b;
X{
X /*return a % b;*/
X return (a - ((a/b)*b));
X}
X#endif
X
X#ifdef L_modsi3
X_modsi3 (a, b)
Xint a, b;
X{
X /*return a % b;*/
X return( a - ((a/b) * b));
X}
X#endif
X
X#ifdef L_lshrsi3
X_lshrsi3 (a, b)
Xunsigned a, b;
X{
X return a >> b;
X}
X#endif
X
X#ifdef L_lshlsi3
X_lshlsi3 (a, b)
Xunsigned a, b;
X{
X return a << b;
X}
X#endif
X
X#ifdef L_ashrsi3
X_ashrsi3 (a, b)
Xint a, b;
X{
X return a >> b;
X}
X#endif
X
X#ifdef L_ashlsi3
X_ashlsi3 (a, b)
Xint a, b;
X{
X return a << b;
X}
X#endif
X
X
X/* this divide stuff is hopelessly broken, in addition to being much
X more complicated than in needs to be. The new version's at the
X end of this file */
X
X#if 0
X#ifdef L_divdf3
X
X/*double _divdf3 (a, b) double a, b; { return a / b; } */
X
Xdouble drecip1(f1)
Xdouble f1;
X{
X struct bitdouble *bdp = &f1;
X unsigned m1, m2;
X
X printf("drecip1(%X)", f1);
X if (bdp->exp == 0 ) return(0L);
X if (bdp->mant1 == 0L) {
X bdp->exp = 0x3ff + 0x3ff - bdp->exp;
X bdp->mant2 = 0L;
X return(f1);
X }
X bdp->exp = 0x3ff + 0x3ff - bdp->exp - 1;
X m1 = (0x00100000 + bdp->mant1) >> 5;
X m2 = (0x80000000 / m1);
X /*printf("m1 %x m2 %x\n", m1, m2);*/
X m2 <<= 5;
X m2 &= 0xFFFFF;
X /*printf("exp %x mant %x\n", bdp->exp, m2);*/
X bdp->mant1 = m2;
X bdp->mant2 = 0L;
X printf("drecip1->%X\n", f1);
X return(f1);
X}
X
Xdouble drecip(f)
Xdouble f;
X{
X struct bitdouble *bdp;
X double quotient, remainder;
X
X printf("drecip(%X)", f);
X quotient = drecip1(f);
X remainder = /* 1.0 */ ((double)one) - quotient * f;
X bdp = &remainder;
X for(; bdp->exp > 0x3ca; ) {
X printf("drc: exp=%X ", bdp->exp);
X remainder = /* 1.0 */ ((double)one) - (quotient*f);
X printf("rem=%X ", remainder);
X quotient = quotient + (drecip1(f)*remainder);
X }
X printf("drecip->%X\n", quotient);
X return(quotient);
X}
X
X
Xdouble ddiv(f1, f2)
Xdouble f1, f2;
X{
X return(f1 * drecip(f2));
X}
X#endif
X#endif /* commented out divide routines */
X
X#ifdef L_muldf3
X/*double _muldf3 (a, b) double a, b; { return a * b; } */
Xqmult(m11, m12, m21, m22, p1, p2)
Xunsigned long m11, m12, m21, m22, *p1, *p2;
X{
X/* register unsigned long d2 = m11; */
X register long d2 = m11;
X register unsigned long d3 = m12, d4 = m21, d5 = m22, d6 =0, d7 = 0;
X int i;
X /* guess what happens if you delete the next line.... */
X /* &i; */
X for (i = 0; i < 11; i++) ASL2(d2, d3);
X for (i = 0; i < 9; i++) ASL2(d4, d5);
X
X for (i = 0; i < 64; i++) {
X if (d2 < 0) { ADD2(d4, d5, d6, d7);}
X ASL2(d2, d3);
X ASR2(d4, d5);
X }
X d2 = d6;
X d3 = d7;
X for (i = 0; i < 9; i++) ASR2(d2, d3);
X *p1 = d2; *p2 = d3;
X}
X
Xdouble dmult(f1, f2)
Xdouble f1, f2;
X{
X register unsigned long d2;
X register unsigned d3, d4, d5, d6, d7;
X unsigned long p1, p2;
X
X struct bitdouble
X *bdp1 = (struct bitdouble *)&f1,
X *bdp2 = (struct bitdouble *)&f2;
X int exp1, exp2, i;
X
X exp1 = bdp1->exp; exp2 = bdp2->exp;
X /* check for zero */
X if (! exp1) return(0.0);
X if (! exp2) return(0.0);
X d2 = 0x00100000 + bdp1->mant1;
X d3 = bdp1->mant2;
X d4 = 0x00100000 + bdp2->mant1;
X d5 = bdp2->mant2;
X qmult(d2, d3, d4, d5, &p1, &p2);
X d6 = p1; d7 = p2;
X
X if (d6 & 0x00200000) {
X ASR2(d6, d7);
X exp1++;
X }
X
X if (bdp1->sign == bdp2->sign) bdp1->sign = 0;
X else bdp1->sign = 1;
X bdp1->exp = exp1 + exp2 - 0x3ff;
X bdp1->mant1 = d6;
X bdp1->mant2 = d7;
X return(f1);
X}
X#endif
X
X#ifdef L_negdf2
X/*double _negdf2 (a) double a; { return -a; } */
X
Xdouble dneg(num)
Xdouble num;
X{
X long *i = (long *)#
X *i ^= 0x80000000;
X return(num);
X}
X#endif
X
X#ifdef L_adddf3
X/*double _adddf3 (a, b) double a, b; { return a + b; } */
X
Xdouble dadd(f1, f2)
Xdouble f1, f2;
X{
X
X register long d4, d5, d6, d7;
X struct bitdouble
X *bdp1 = (struct bitdouble *)&f1,
X *bdp2 = (struct bitdouble *)&f2;
X short exp1, exp2, sign1, sign2, howmuch, temp;
X
X exp1 = bdp1->exp; exp2 = bdp2->exp;
X
X /* check for zero */
X if (! exp1) return(f2); if (! exp2) return(f1);
X
X /* align them */
X if (exp1 < exp2) {
X bdp1 = (struct bitdouble *)&f2; bdp2 = (struct bitdouble *)&f1;
X exp1 = bdp1->exp; exp2 = bdp2->exp;
X }
X howmuch = exp1 - exp2;
X if (howmuch > 53) return(f1);
X
X d7 = bdp2->mant1 + 0x00100000;
X d6 = bdp2->mant2;
X
X d5 = bdp1->mant1 + 0x00100000;
X d4 = bdp1->mant2;
X
X for (temp = 0; temp < howmuch; temp++) ASR2(d7, d6);
X
X /* take care of negative signs */
X if (bdp1->sign)
X {
X NEG(d5, d4);
X }
X if (bdp2->sign)
X {
X NEG(d7, d6);
X }
X
X ADD2(d7, d6, d5, d4);
X bdp1 = (struct bitdouble *)&f1;
X
X if (d5 < 0) {
X NEG(d5, d4);
X bdp1->sign = 1;
X } else bdp1->sign = 0;
X
X if (d5 == 0 && d4 == 0) return(0.0);
X
X for(howmuch = 0; d5 >= 0; howmuch++) ASL2(d5, d4);
X
X ASL2(d5, d4);
X for (temp = 0; temp < 12; temp++) ASR2(d5, d4);
X bdp1->mant1 = d5;
X bdp1->mant2 = d4;
X bdp1->exp = exp1 + 11 - howmuch;
X return(f1);
X}
X
X#endif
X
X#ifdef L_subdf3
Xdouble
X _subdf3 (a, b)
Xdouble a, b;
X{
X return a+(-b);
X}
X#endif
X
X#ifdef L_cmpdf2
X/*
X int _cmpdf2 (a, b) double a, b; { if (a > b) return 1;
X else if (a < b) return -1; return 0; }
X */
X
Xint dcmp(f1, f2)
Xdouble f1, f2;
X{
X struct bitdouble *bdp1, *bdp2;
X unsigned int s1, s2;
X bdp1 = (struct bitdouble *)&f1;
X bdp2 = (struct bitdouble *)&f2;
X s1 = bdp1->sign;
X s2 = bdp2->sign;
X if (s1 > s2) return(-1);
X if (s1 < s2) return(1);
X /* if sign of both negative, switch them */
X if (s1 != 0) {
X bdp1 = (struct bitdouble *)&f1;
X bdp2 = (struct bitdouble *)&f2;
X }
X s1 = bdp1->exp;
X s2 = bdp2->exp;
X if (s1 > s2) return(1);
X if (s1 < s2) return(-1);
X /* same exponent -- have to compare mantissa */
X s1 = bdp1->mant1;
X s2 = bdp2->mant1;
X if (s1 > s2) return(1);
X if (s1 < s2) return(-1);
X s1 = bdp1->mant2;
X s2 = bdp2->mant2;
X if (s1 > s2) return(1);
X if (s1 < s2) return(-1);
X return(0); /* the same! */
X}
X#endif
X
X#ifdef L_fixunsdfsi
X/*_fixunsdfsi (a) double a; { return (unsigned int) a; } */
X
X/* #ifdef L_fixdfsi _fixdfsi (a) double a; { return (int) a; } #endif */
X
Xunsigned long dtoul(f)
Xdouble f;
X{
X struct bitdouble *bdp;
X int si, ex, mant1, mant2;
X bdp = (struct bitdouble *)&f;
X si = bdp->sign;
X ex = bdp->exp;
X mant1 = bdp->mant1 + 0x00100000;
X mant2 = bdp->mant2;
X
X /* zero value */
X if (ex == 0) return(0L);
X /* less than 1 */
X if (ex < 0x3ff) return(0L);
X /* less than 0 */
X if (si ) return(0L);
X mant1 <<= 10;
X mant1 += (mant2 >> 22);
X mant1 >>= 30 + (0x3ff - ex);
X return(mant1);
X}
X
Xlong dtol(f)
Xdouble f;
X{
X struct bitdouble *bdp = (struct bitdouble *)&f;
X
X if (bdp->sign) {
X bdp->sign = 0;
X return( - dtoul(f));
X }
X return(dtoul(f));
X}
X#endif
X
X#ifdef L_fixunsdfdi
X
X/*double _fixunsdfdi (a) double a; { union double_di u;
X u.i[LOW] = (unsigned int) a; u.i[HIGH] = 0; return u.d; } */
X#endif
X
X
X#ifdef L_fixdfdi
Xdouble
X _fixdfdi (a)
Xdouble a;
X{
X union double_di u;
X u.i[LOW] = (int) a;
X u.i[HIGH] = (int) a < 0 ? -1 : 0;
X return u.d;
X}
X#endif
X
X#ifdef L_floatsidf
X/* double _floatsidf (a) int a; { return (double) a; } */
X
Xdouble ltod(i)
Xlong i;
X{
X int expo, shift;
X double retval;
X struct bitdouble *bdp = (struct bitdouble *)&retval;
X if (i == 0) {
X long *t = (long *)&retval;
X t[0] = 0L;
X t[1] = 0L;
X return(retval);
X }
X if (i < 0) {
X bdp->sign = 1;
X i = -i;
X } else bdp->sign = 0;
X shift = i;
X for (expo = 0x3ff + 31 ; shift > 0; expo--, shift <<= 1);
X shift <<= 1;
X bdp->exp = expo;
X bdp->mant1 = shift >> 12;
X bdp->mant2 = shift << 20;
X return(retval);
X}
X
X#endif
X
X#ifdef L_floatdidf
X/* ok as is -- will call other routines */
Xdouble
X _floatdidf (u)
Xunion double_di u;
X{
X register double hi
X = ((double) u.i[HIGH]) * (double) 0x10000 * (double) 0x10000;
X register double low = (unsigned int) u.i[LOW];
X return hi + low;
X}
X#endif
X
X#ifdef L_addsf3
XSFVALUE
X _addsf3 (a, b)
Xunion flt_or_int a, b;
X{
X union flt_or_int intify; return INTIFY ((double) a.f + (double) b.f);
X}
X#endif
X
X#ifdef L_negsf2
XSFVALUE
X _negsf2 (a)
Xunion flt_or_int a;
X{
X union flt_or_int intify;
X return INTIFY (-((double) a.f));
X}
X#endif
X
X#ifdef L_subsf3
XSFVALUE
X _subsf3 (a, b)
Xunion flt_or_int a, b;
X{
X union flt_or_int intify;
X return INTIFY (((double) a.f - (double) b.f));
X}
X#endif
X
X#ifdef L_cmpsf2
XSFVALUE
X _cmpsf2 (a, b)
Xunion flt_or_int a, b;
X{
X union flt_or_int intify;
X double a1, b1;
X a1 = a.f; b1 = b.f;
X if ( a1 > b1)
X return 1;
X else if (a1 < b1)
X return -1;
X return 0;
X}
X#endif
X
X#ifdef L_mulsf3
XSFVALUE
X _mulsf3 (a, b)
Xunion flt_or_int a, b;
X{
X union flt_or_int intify;
X return INTIFY (((double) a.f * (double) b.f));
X}
X#endif
X
X#ifdef L_divsf3
XSFVALUE
X _divsf3 (a, b)
Xunion flt_or_int a, b;
X{
X union flt_or_int intify;
X return INTIFY (((double) a.f / (double) b.f));
X}
X#endif
X
X#ifdef L_truncdfsf2
Xfloat dtof(d)
Xdouble d;
X{
X struct bitdouble *bdp = (struct bitdouble *)&d;
X float retval;
X struct bitfloat *bfp = (struct bitfloat *)&retval;
X int tempval;
X
X bfp->sign = bdp->sign;
X if (bdp->exp == 0) return ((float) 0.0);
X bfp->exp = bdp->exp - 0x400 + 0x80;
X tempval = (bdp->mant1 << 4 ) + ((0xF0000000 & bdp->mant2) >> 28);
X /* round */
X tempval++;
X if (tempval == 0x01000000) bfp->exp++;
X bfp->mant = tempval >> 1;
X return(retval);
X}
X
XSFVALUE
X _truncdfsf2 (a)
Xdouble a;
X{
X union flt_or_int intify;
X return INTIFY (dtof(a));
X}
X#endif
X
X#ifdef L_extendsfdf2
Xdouble ftod(f)
Xunion flt_or_int f;
X{
X double retval;
X struct bitfloat *bfp = (struct bitfloat *)&f.f;
X struct bitdouble *bdp = (struct bitdouble *)&retval;
X if (bfp->exp == 0) return(0.0);
X bdp->sign = bfp->sign;
X bdp->exp = 0x400 - 0x80 + bfp->exp;
X bdp->mant1 = bfp->mant >> 3;
X bdp->mant2 = (bfp->mant & 0x7) << 29;
X /*printf("returning %f from extendsfdf2\n", retval);*/
X return(retval);
X}
X
Xdouble
X _extendsfdf2 (a)
Xunion flt_or_int a;
X{
X union flt_or_int intify;
X double retval;
X return (ftod(a));
X}
X#endif
X
X#ifdef L_divdf3
X
X/* new double-float divide routine, by jrd */
X/* thanks jrd !! */
X
Xdouble _divdf3(num, denom)
Xdouble num, denom;
X{
X double local_num = num;
X double local_denom = denom;
X struct bitdouble * num_bdp = (struct bitdouble *)(&local_num);
X struct bitdouble * den_bdp = (struct bitdouble *)(&local_denom);
X short num_exp = num_bdp->exp,
X den_exp = den_bdp->exp;
X short result_sign = 0;
X /* register */ unsigned long num_m1, num_m2, num_m3, num_m4;
X register unsigned long den_m1, den_m2, den_m3, den_m4;
X unsigned long result_mant[2];
X unsigned long result_mask;
X short result_idx;
X
X if ((num_exp == 0) || (den_exp == 0)) /* zzz should really cause trap */
X return(0.0);
X
X /* deal with signs */
X result_sign = result_sign + num_bdp->sign - den_bdp->sign;
X
X /* unpack the numbers */
X num_m1 = num_bdp->mant1 | 0x00100000; /* hidden bit */
X num_m2 = num_bdp->mant2;
X num_m3 = /* ret_kludge(0); */ 0;
X num_m4 = num_m3;
X den_m1 = den_bdp->mant1 | 0x00100000; /* hidden bit */
X den_m2 = den_bdp->mant2;
X den_m3 = /* ret_kludge(0); */ 0;
X den_m4 = den_m3;
X
X#if 0
X /* buy a little extra accuracy by shifting num and denum up 10 bits */
X for (result_idx /* loop counter */ = 0 ; result_idx < 10 ; result_idx++)
X {
X ASL3(num_m1, num_m2, num_m3);
X ASL3(den_m1, den_m2, den_m3);
X }
X#endif
X
X /* hot wire result mask and index */
X result_mask = 0x00100000; /* start at top mantissa bit */
X result_idx = 0; /* of first word */
X result_mant[0] = num_m3;
X result_mant[1] = den_m3;
X
X /* if denom is greater than num here, shift denom right one and dec num expt */
X if (den_m1 < num_m1)
X goto kludge1; /* C is assembly language,
X remember? */
X if (den_m1 > num_m1)
X goto kludge0;
X if (den_m2 <= num_m2) /* first word eq, try 2nd */
X goto kludge1;
X
X kludge0:
X
X num_exp--;
X ASR4(den_m1, den_m2, den_m3, den_m4);
X
X kludge1:
X
X for ( ; result_mask ; )
X {
X /* if num >= den, subtract den from num and set bit in result */
X if (num_m1 > den_m1) goto kludge2;
X if (num_m1 < den_m1) goto kludge3;
X if (num_m2 > den_m2) goto kludge2;
X if (num_m2 < den_m2) goto kludge3;
X if (num_m3 > den_m3) goto kludge2;
X if (num_m3 < den_m3) goto kludge3;
X if (num_m4 < den_m4) goto kludge3;
X
X kludge2:
X result_mant[result_idx] |= result_mask;
X SUB4(den_m1, den_m2, den_m3, den_m4, num_m1, num_m2, num_m3, num_m4);
X kludge3:
X ASR4(den_m1, den_m2, den_m3, den_m4);
X result_mask >>= 1;
X if ((result_mask == 0) && (result_idx == 0))
X {
X result_mask = 0x80000000;
X result_idx++;
X }
X }
X
X /* compute the resultant exponent */
X num_exp = num_exp - den_exp + 0x3FF;
X
X /* reconstruct the result in local_num */
X num_bdp->sign = result_sign;
X num_bdp->exp = num_exp;
X num_bdp->mant1 = result_mant[0] & 0xFFFFF;
X num_bdp->mant2 = result_mant[1];
X
X /* done! */
X return(local_num);
X}
X#endif
SHAR_EOF
if test 18187 -ne "`wc -c 'dflonum.c'`"
then
echo shar: error transmitting "'dflonum.c'" '(should have been 18187 characters)'
fi
echo shar: extracting "'eprintf.c'" '(230 characters)'
if test -f 'eprintf.c'
then
echo shar: over-writing existing file "'eprintf.c'"
fi
sed 's/^X//' << \SHAR_EOF > 'eprintf.c'
X#include <stdio.h>
X/* This is used by the `assert' macro. */
X
X#ifdef __GNUC__
Xvoid
X#endif
X__eprintf (string, line, filename)
X char *string;
X long line;
X char *filename;
X{
X fprintf (stderr, string, line, filename);
X}
SHAR_EOF
if test 230 -ne "`wc -c 'eprintf.c'`"
then
echo shar: error transmitting "'eprintf.c'" '(should have been 230 characters)'
fi
echo shar: extracting "'flonum.h'" '(4078 characters)'
if test -f 'flonum.h'
then
echo shar: over-writing existing file "'flonum.h'"
fi
sed 's/^X//' << \SHAR_EOF > 'flonum.h'
X
X/* Defs and macros for floating point code. This stuff is heavily based
X on Scott McCauley's code, except that this version works :-} */
X
X
X/* These definitions work for machines where an SF value is
X returned in the same register as an int. */
X
X#ifndef SFVALUE
X#define SFVALUE int
X#endif
X
X#ifndef INTIFY
X#define INTIFY(FLOATVAL) (intify.f = (FLOATVAL), intify.i)
X#endif
X
X/* quasi-IEEE floating point number definitions */
X
Xstruct bitfloat {
X unsigned sign : 1;
X unsigned exp : 8;
X unsigned mant : 23;
X};
X
Xstruct bitdouble {
X unsigned sign : 1;
X unsigned exp : 11;
X unsigned mant1 : 20;
X unsigned long mant2;
X};
X
Xunion double_di { double d; int i[2]; };
Xunion flt_or_int { int i; float f; };
X
X#ifdef WORDS_BIG_ENDIAN
X#define HIGH 0
X#define LOW 1
X#else
X#define HIGH 1
X#define LOW 0
X#endif
X
X/* start of symbolic asm definitions */
X
X/* you may have to change the g's to d's if you start getting
X illegal operands from as */
X
X#define MUL(a, b) asm volatile ("mulu %2,%0" : "=d" (b) : "0" (b) , "g" (a))
X#define DIV(a, b) asm volatile ("divu %2,%0" : "=d" (b) : "0" (b) , "g" (a))
X#define SWAP(a) asm volatile ("swap %0" : "=r" (a) : "r" (a) , "r" (a) )
X
X#define ASL2(r1, r2) { asm volatile ("asll #1,%0" : "=d" (r2) : "d" (r2));\
X asm volatile ("roxll #1,%0" : "=d" (r1) : "d" (r1)); }
X#define ASL3(r1, r2, r3) { asm volatile ("asll #1,%0" : "=d" (r3) : "d" (r3));\
X asm volatile ("roxll #1,%0" : "=d" (r2) : "d" (r2));\
X asm volatile ("roxll #1,%0" : "=d" (r1) : "d" (r1)); }
X
X#define ASR2(r1, r2) { asm volatile ("asrl #1,%0" : "=d" (r1) : "d" (r1));\
X asm volatile ("roxrl #1,%0" : "=d" (r2) : "d" (r2)); }
X#define ASR3(r1, r2, r3) { asm volatile ("asrl #1,%0" : "=d" (r1) : "d" (r1));\
X asm volatile ("roxrl #1,%0" : "=d" (r2) : "d" (r2));\
X asm volatile ("roxrl #1,%0" : "=d" (r3) : "d" (r3)); }
X#define ASR4(r1, r2, r3, r4) { asm volatile ("asrl #1,%0" : "=d" (r1) : "d" (r1));\
X asm volatile ("roxrl #1,%0" : "=d" (r2) : "d" (r2));\
X asm volatile ("roxrl #1,%0" : "=d" (r3) : "d" (r3));\
X asm volatile ("roxrl #1,%0" : "=d" (r4) : "d" (r4)); }
X
X#define ADD2(r1, r2, r3, r4) \
X { asm volatile ("addl %2,%0": "=g" (r4) : "0" (r4) , "g" (r2)); \
X asm volatile ("addxl %2,%0": "=g" (r3) : "0" (r3) , "g" (r1)); }
X
X/* y <- y - x */
X#define SUB3(x1, x2, x3, y1, y2, y3) \
X { asm volatile ("subl %2,%0": "=g" (y3) : "g" (y3) , "d" (x3)); \
X asm volatile ("subxl %2,%0": "=g" (y2) : "g" (y2) , "d" (x2));\
X asm volatile ("subxl %2,%0": "=g" (y1) : "g" (y1) , "d" (x1)); }
X
X/* sub4 here is rather complex, as the compiler is overwhelmed by me wanting
X to have 8 data registers allocated for mantissa accumulators. Help it out
X by declaring a temp that it can move stuff in and out of. */
X#define SUB4(x1, x2, x3, x4, y1, y2, y3, y4) \
X { register long temp = y4; \
X asm volatile ("subl %2,%0": "=d" (temp) : "d" (temp) , "d" (x4)); \
X y4 = temp; temp = y3; \
X asm volatile ("subxl %2,%0": "=d" (temp) : "d" (temp) , "d" (x3));\
X y3 = temp; temp = y2; \
X asm volatile ("subxl %2,%0": "=d" (temp) : "d" (temp) , "d" (x2));\
X y2 = temp; temp = y1; \
X asm volatile ("subxl %2,%0": "=d" (temp) : "d" (temp) , "d" (x1));\
X y1 = temp; }
X
X#define NEG(r1, r2) { asm volatile ("negl %0" : "=d" (r2) : "d" (r2)); \
X asm volatile ("negxl %0" : "=d" (r1) : "d" (r1)); }
X
X/* switches for which routines to compile. All the single-float and
Xlong-int arithmetic routines are turned off here, as they were all
Xdone in assembly language last year. */
X
X/*
X#define L_umulsi3
X#define L_mulsi3
X#define L_udivsi3
X#define L_divsi3
X#define L_umodsi3
X#define L_modsi3
X#define L_lshrsi3
X#define L_lshlsi3
X#define L_ashrsi3
X#define L_ashlsi3
X*/
X#define L_divdf3
X#define L_muldf3
X#define L_negdf2
X#define L_adddf3
X#define L_subdf3
X#define L_cmpdf2
X#define L_fixunsdfsi
X#define L_fixunsdfdi
X#define L_fixdfdi
X#define L_floatsidf
X#define L_floatdidf
X/*
X#define L_addsf3
X#define L_negsf2
X#define L_subsf3
X#define L_cmpsf2
X#define L_mulsf3
X#define L_divsf3
X*/
X#define L_truncdfsf2
X#define L_extendsfdf2
X
SHAR_EOF
if test 4078 -ne "`wc -c 'flonum.h'`"
then
echo shar: error transmitting "'flonum.h'" '(should have been 4078 characters)'
fi
echo shar: extracting "'sflonum.s'" '(15211 characters)'
if test -f 'sflonum.s'
then
echo shar: over-writing existing file "'sflonum.s'"
fi
sed 's/^X//' << \SHAR_EOF > 'sflonum.s'
X#
X#
X# Floating point support code. What a crock!
X#
X# A float looks like:
X#
X# |S|E.x.p ... |M.a.n.t.i.s.s.a ... |
X# +-+----------+--------------------+
X#
X# where s is the sign bit, Exp is 8 bits of exponent, interpreted
X# as E + 126, and Mantissa is 23 bits of fraction, with a
X# hidden bit. The point is to the left of the hidden bit.
X# Doubles have another word of mantissa following.
X#
X# All these routines have calling sequences like c routines,
X# ie args on stack in backwards order, return values in d0
X#
X
X# union double_di { double d; int i[2]; };
X# union flt_or_int { int i; float f; };
X#
X## #ifdef L_divdf3
X## double
X## _divdf3 (a, b)
X## double a, b;
X## {
X## return a / b;
X## }
X## #endif
X#.text
X# .even
X#.globl __divdf3
X#__divdf3:
X# movel sp@(12),sp@-
X# movel sp@(8),sp@-
X# jsr __divsf3
X# addql #8,sp
X# clrl d1 | kludge!!!
X# rts | sigh
X##
X## #ifdef L_muldf3
X## double
X## _muldf3 (a, b)
X## double a, b;
X## {
X## return a * b;
X## }
X## #endif
X#
X#.text
X# .even
X#.globl __muldf3
X#__muldf3:
X# movel sp@(12),sp@-
X# movel sp@(8),sp@-
X# jsr __mulsf3
X# addql #8,sp
X# clrl d1 | kludge!!!
X# rts | sigh
X##
X## #ifdef L_negdf2
X## double
X## _negdf2 (a)
X## double a;
X## {
X## return -a;
X## }
X## #endif
X#
X#.text
X# .even
X#.globl __negdf2
X#__negdf2:
X# movel sp@(8),d1 | get a lo
X# movel sp@(4),d0 | get a hi
X# beq negdf2_z | zero, leave it
X# eorl #0x80000000,d0 | twiddle sign
X#negdf2_z:
X# rts
X##
X## #ifdef L_adddf3
X## double
X## _adddf3 (a, b)
X## double a, b;
X## {
X## return a + b;
X## }
X## #endif
X#
X#.text
X# .even
X#.globl __adddf3
X#__adddf3:
X# movel sp@(12),sp@-
X# movel sp@(8),sp@-
X# jsr __addsf3
X# addql #8,sp
X# clrl d1 | kludge!!!
X# rts | sigh
X##
X## #ifdef L_subdf3
X## double
X## _subdf3 (a, b)
X## double a, b;
X## {
X## return a - b;
X## }
X## #endif
X#
X#.text
X# .even
X#.globl __subdf3
X#__subdf3:
X# movel sp@(12),sp@-
X# movel sp@(8),sp@-
X# jsr __subsf3
X# addql #8,sp
X# clrl d1 | kludge!!!
X# rts | sigh
X##
X## #ifdef L_cmpdf2
X## int
X## _cmpdf2 (a, b)
X## double a, b;
X## {
X## if (a > b)
X## return 1;
X## else if (a < b)
X## return -1;
X## return 0;
X## }
X## #endif
X#
X#.text
X# .even
X#.globl __cmpdf2
X#__cmpdf2:
X# movel sp@(4),d0 | get b hi
X# movel sp@(12),d1 | get a hi
X#|
X#| crockery. If both neg and not equal, this algorithm lose. find a better one!
X#|
X# bpl cmpdf2_p
X# tstl d0
X# bpl cmpdf2_p
X# cmpl d1,d0
X# bgt cmpdf2_m
X# blt cmpdf2_1
X# beq cmpdf2_z
X#cmpdf2_p:
X# cmpl d1,d0 | get a hi
X# beq cmpdf2_z | if eq, return 0
X# bgt cmpdf2_1 | if greater, return 1
X#cmpdf2_m:
X# movel #-1,d0 | else return -1
X# rts
X#cmpdf2_z:
X# clrl d0
X# rts
X#cmpdf2_1:
X# movel #1,d0
X# rts | sigh
X##
X## #ifdef L_fixunsdfsi
X## _fixunsdfsi (a)
X## double a;
X## {
X## return (unsigned int) a;
X## }
X## #endif
X#
X#.text
X# .even
X#.globl __fixunsdfsi
X#__fixunsdfsi:
X# clrl d0
X# clrl d1
X# rts | sigh
X##
X## #ifdef L_fixunsdfdi
X## double
X## _fixunsdfdi (a)
X## double a;
X## {
X## union double_di u;
X## u.i[LOW] = (unsigned int) a;
X## u.i[HIGH] = 0;
X## return u.d;
X## }
X## #endif
X#
X#.text
X# .even
X#.globl __fixunsdfdi
X#__fixunsdfdi:
X# clrl d0
X# clrl d1
X# rts | sigh
X##
X## #ifdef L_fixdfsi
X## _fixdfsi (a)
X## double a;
X## {
X## return (int) a;
X## }
X## #endif
X#
X#.text
X# .even
X#.globl __fixdfsi
X#__fixdfsi:
X# link a6,#0
X# movel d2,sp@- | save reg
X# clrl d2 | sign flag
X# movel a6@(8),d0 | get the float
X# beq fixdfsi_ret
X# bpl fixdfsi_1
X# addql #1,d2
X#fixdfsi_1:
X# movel d0,d1 | snag the exp
X# lsrl #7,d1
X# lsrl #8,d1
X# lsrl #8,d1
X# andl #0xFF,d1
X# subl #126,d1
X# andl #0x7FFFFF,d0 | zap cruft
X# orl #0x800000,d0 | put back hidden bit
X#|
X#| at this point the mantissa looks like 2^24 * integer value.
X#| if Exp is 24, we're done. If it's less, we shift right,
X#| else left
X#|
X#fixdfsi_2:
X# cmpl #24,d1
X# beq fixdfsi_4 | we're done
X# bmi fixdfsi_3 | less, shift right
X# lsll #1,d0 | greater, shift it left one
X# subql #1,d1 | and dec exp
X# bra fixdfsi_2
X#fixdfsi_3:
X# lsrl #1,d0 | shift right one
X# addql #1,d1 | and inc exp
X# bra fixdfsi_2
X#fixdfsi_4:
X# tstl d2 | negative?
X# beq fixdfsi_ret
X# negl d0
X#fixdfsi_ret:
X# movel sp@+,d2 | get d2 back
X# unlk a6
X# rts
X##
X## #ifdef L_fixdfdi
X## double
X## _fixdfdi (a)
X## double a;
X## {
X## union double_di u;
X## u.i[LOW] = (int) a;
X## u.i[HIGH] = (int) a < 0 ? -1 : 0;
X## return u.d;
X## }
X## #endif
X#
X#.text
X# .even
X#.globl __fixdfdi
X#__fixdfdi:
X# clrl d0
X# clrl d1
X# rts | sigh
X##
X## #ifdef L_floatsidf
X## double
X## _floatsidf (a)
X## int a;
X## {
X## return (double) a;
X## }
X## #endif
X#
X#.text
X# .even
X#.globl __floatsidf
X#__floatsidf:
X# link a6,#0 | set up frame
X# movel d2,sp@- | save d2; sign flag
X# clrl d2 | not negative yet
X# movel #24,d1 | exponent so far
X# movel a6@(8),d0 | get the int
X# beq floatsidf_ret | zero?
X# bpl floatsidf_1 | pos, it's ok
X# negl d0 | negate it
X# addql #1,d2 | bump sign
X#floatsidf_1:
X#|
X#| normalize right if necessary
X#|
X# cmpl #0xFFFFFF,d0 | too big?
X# ble floatsidf_2 | nope, see if need to slide left
X# addql #1,d1 | bump exp
X# lsrl #1,d0 | and slide mantissa right one
X# bra floatsidf_1
X#floatsidf_2:
X# btst #23,d0 | got a bit up here yet?
X# bne floatsidf_3 | nope, go left
X# subql #1,d1 | dec exp
X# lsll #1,d0 | and slide mantissa left one
X# bra floatsidf_2
X#floatsidf_3:
X#|
X#| now put it all together
X#|
X# andl #0x7FFFFF,d0 | zap hidden bit
X# addl #126,d1 | offset exp
X# andl #0xFF,d1 | trim it
X# lsll #8,d1 | shift up
X# lsll #8,d1
X# lsll #7,d1
X# orl d1,d0 | stuff it in
X# tstl d2 | negative?
X# beq floatsidf_ret
X# orl #0x80000000,d0
X#floatsidf_ret:
X# movel sp@+,d2
X# clrl d1 | ???
X# unlk a6
X# rts | sigh
X##
X## #ifdef L_floatdidf
X## double
X## _floatdidf (u)
X## union double_di u;
X## {
X## register double hi
X## = ((double) u.i[HIGH]) * (double) 0x10000 * (double) 0x10000;
X## register double low = (unsigned int) u.i[LOW];
X## return hi + low;
X## }
X## #endif
X#
X#.text
X# .even
X#.globl __floatdidf
X#__floatdidf:
X# clrl d0
X# clrl d1
X# rts | sigh
X##
X# #define INTIFY(FLOATVAL) (intify.f = (FLOATVAL), intify.i)
X#
X# #ifdef L_addsf3
X# int
X# _addsf3 (a, b)
X# union flt_or_int a, b;
X# {
X# union flt_or_int intify;
X# return INTIFY (a.f + b.f);
X# }
X# #endif
X
X.text
X .even
X.globl __addsf3
X__addsf3:
X link a6,#0 | don't need any locals
X moveml #0x3F00,sp@- | save all data registers
X movel a6@(8),d0 | get a
X beq addsf_ret_b | zero .. just return b
X movel #23,d6 | shift count
X movel d0,d2 | get the exponent
X lsrl d6,d2 | and shift right
X andl #0xFF,d2 | no sign bit
X subl #126,d2 | offset the exponent
X movel a6@(12),d1 | get b
X beq addsf_ret_a
X movel d1,d3 | get the exponent for b
X lsrl d6,d3 | and shift right, with implicit extend
X andl #0xFF,d3 | make sure we didn't get a sign bit
X subl #126,d3 | off set this one too
X
X andl #0x7FFFFF,d0 | mask a for mantissa
X orl #0x800000,d0 | and put in hidden bit
X tstl a6@(8) | test the original value
X bpl addsf_1 | pos, ok
X negl d0 | neg, negate the mantissa
Xaddsf_1:
X andl #0x7FFFFF,d1 | mask b for mantissa
X orl #0x800000,d1 | ditto
X tstl a6@(12) | test ...
X bpl addsf_2
X negl d1 | negate this one
Xaddsf_2:
X cmpl d2,d3 | compare Ea to Eb
X blt addsf_3 | Ea > Eb
X
X movel d3,d5 | get Eb
X subl d2,d5 | subtract Ea
X asrl d5,d0 | yielding count to shift Ma right
X movel d3,d5 | use this as resultant exponent
X bra addsf_4 | and go rejoin common part
Xaddsf_3:
X movel d2,d5 | get Ea
X subl d3,d5 | subtract Eb
X asrl d5,d1 | yielding count to shift Mb right
X movel d2,d5 | use this as resultant exponent
X
Xaddsf_4:
X clrl d7 | zap sign flag
X addl d1,d0 | add Mb to Ma
X
X
X beq addsf_z | zero? ok, go return zero
X bpl addsf_5 | positive? ok, go scale it
X negl d0 | negate Mr
X movel #1,d7 | remember sign
Xaddsf_5:
X btst #24,d0 | carry?
X beq addsf_6 | nope, it's ok as is
X asrl #1,d0 | shift right one
X addql #1,d5 | inc exp
X
X| zzz check for overflow in here someplace
X
Xaddsf_6:
X btst #23,d0 | got a bit in the right place yet?
X bne addsf_7 | yes, we're done
X lsll #1,d0 | shift left one
X subql #1,d5 | dec exponent
X bra addsf_6
Xaddsf_7:
X andl #0x7FFFFF,d0 | zap out hidden bit
X addl #126,d5 | add offset to exp
X andl #0xFF,d5 | zap to 8 bits
X movel #23,d6 | shift count
X lsll d6,d5 | shift the exp up
X orl d5,d0 | stick the exp in
X tstl d7 | negative?
X beq addsf_ret_a
X orl #0x80000000,d0 | yup, negate it
X bra addsf_ret_a
Xaddsf_z:
X clrl d0
X bra addsf_ret_a
Xaddsf_ret_b:
X movel a6@(12),d0
Xaddsf_ret_a:
X moveml sp@+,#0x00FC | snarf back all regs
X unlk a6
X rts | sigh
X#
X# #ifdef L_negsf2
X# int
X# _negsf2 (a)
X# union flt_or_int a;
X# {
X# union flt_or_int intify;
X# return INTIFY (-a.f);
X# }
X# #endif
X
X.text
X .even
X.globl __negsf2
X__negsf2:
X movel sp@(4),d0
X beq negsf2_z
X eorl #0x80000000,d0
Xnegsf2_z:
X rts | sigh
X#
X# #ifdef L_subsf3
X# int
X# _subsf3 (a, b)
X# union flt_or_int a, b;
X# {
X# union flt_or_int intify;
X# return INTIFY (a.f - b.f);
X# }
X# #endif
X
X.text
X .even
X.globl __subsf3
X__subsf3:
X tstl sp@(8) | kludge. just negate b and add
X beq subsf_bz | zero. don't bother
X eorl #0x80000000,sp@(8) | negate it
X jmp __addsf3
Xsubsf_bz:
X movel sp@(4),d0
X rts
X
X#
X# #ifdef L_cmpsf2
X# int
X# _cmpsf2 (a, b)
X# union flt_or_int a, b;
X# {
X# union flt_or_int intify;
X# if (a.f > b.f)
X# return 1;
X# else if (a.f < b.f)
X# return -1;
X# return 0;
X# }
X# #endif
X
X.text
X .even
X.globl __cmpsf2
X__cmpsf2:
X movel sp@(4),d0
X movel sp@(12),d1 | get a hi
X|
X| crockery. If both neg and not equal, this algorithm lose. find a better one!
X|
X bpl cmpsf2_p
X tstl d0
X bpl cmpsf2_p
X cmpl d1,d0
X bgt cmpsf2_m
X blt cmpsf2_1
X beq cmpsf2_z
Xcmpsf2_p:
X cmpl d1,d0
X beq cmpsf2_z
X bgt cmpsf2_1
Xcmpsf2_m:
X movel #-1,d0
X rts
Xcmpsf2_z:
X clrl d0
X rts
Xcmpsf2_1:
X movel #1,d0
X rts | sigh
X#
X# #ifdef L_mulsf3
X# int
X# _mulsf3 (a, b)
X# union flt_or_int a, b;
X# {
X# union flt_or_int intify;
X# return INTIFY (a.f * b.f);
X# }
X# #endif
X
X.text
X .even
X.globl __mulsf3
X__mulsf3:
X|
X| multiply. take the numbers apart. shift each exponent down to
X| 16 bits. unsigned multiply those. shift that down to 24 bits.
X| exponent is Ea + Eb.
X|
X
X link a6,#-8 | 64 bit accum for mult
X moveml #0x3F00,sp@- | save all data registers
X movel a6@(8),d0 | get a
X beq mulsf3_z
X movel a6@(12),d1 | get b
X beq mulsf3_z
X movel #23,d6 | shift count
X movel d0,d2 | get the exponent
X lsrl d6,d2 | and shift right
X andl #0xFF,d2
X subl #126,d2 | offset the exponent
X movel d1,d3 | get the exponent for b
X lsrl d6,d3 | and shift right
X andl #0xFF,d2
X subl #126,d3 | off set this one too
X
X clrl d7 | negative result flag
X andl #0x7FFFFF,d0 | mask a for mantissa
X orl #0x800000,d0 | and put in hidden bit
X tstl a6@(8) | test the original value
X bpl mulsf3_1 | pos, ok
X eorl #1,d7 | remember negative
Xmulsf3_1:
X andl #0x7FFFFF,d1 | mask b for mantissa
X orl #0x800000,d1 | ditto
X tstl a6@(12) | test ...
X bpl mulsf3_2
X eorl #1,d7
Xmulsf3_2:
X| lsrl #8,d1 | shift this one down
X| lsrl #8,d0 | this one too...
X| mulu d1,d0 | do the multiply
X
X| beq mulsf3_ret | zero? ok, just return
X| lsrl #8,d0 | shift right again
X
X|
X| we have mantissas as follows:
X|
X| |...ah...|...al...| |...bh...|...bl...|
X|
X| product is composed as:
X|
X| |....al * bl....|
X| |....al * bh....|
X| |....ah * bl....|
X| |....ah * bh....|
X|
X| then take the 24 bit chunk that's 16 bits in.
X
X movel d0,d4
X andl #0xFFFF,d4 | al
X movel d1,d5
X andl #0xFFFF,d5 | bl
X mulu d5,d4 | that's al * bl
X movel d4,a6@(-4) | into the accum
X clrl a6@(-8) | zap the top part
X
X movel d0,d4
X andl #0xFFFF,d4 | al
X movel d1,d5
X movel #16,d6 | shift count
X lsrl d6,d5 | bh
X mulu d5,d4 | al * bh
X addl d4,a6@(-6)
X
X movel d0,d4
X lsrl d6,d4 | ah
X movel d1,d5
X andl #0xFFFF,d5 | bl
X mulu d5,d4 | ah * bl
X addl d4,a6@(-6)
X
X movel d0,d4
X lsrl d6,d4 | ah
X movel d1,d5
X lsrl d6,d5 | bh
X mulu d5,d4 | ah * bh
X addl d4,a6@(-8)
X
X movel a6@(-6),d0 | get the relevant part
X lsrl #8,d0 | and shift it down
X
Xmulsf3_norm:
X btst #23,d0 | normalized?
X bne mulsf3_ok
X lsll #1,d0
X subql #1,d2
X bra mulsf3_norm
X
Xmulsf3_ok:
X andl #0x7FFFFF,d0 | zap hidden bit
X addl d3,d2 | add Eb to Ea
X addl #126,d2 | fix offset
X andl #0xFF,d2 | whack to 8 bits
X movel #23,d6 | shift count
X lsll d6,d2 | shift up to right place
X orl d2,d0 | shove it in
X tstl d7 | sign neg?
X beq mulsf3_ret
X orl #0x80000000,d0 | set sign bit
X bra mulsf3_ret
Xmulsf3_z:
X clrl d0
Xmulsf3_ret:
X moveml sp@+,#0x00FC | snarf back all regs
X unlk a6
X rts | sigh
X#
X# #ifdef L_divsf3
X# int
X# _divsf3 (a, b)
X# union flt_or_int a, b;
X# {
X# union flt_or_int intify;
X# return INTIFY (a.f / b.f);
X# }
X# #endif
X
X.text
X .even
X.globl __divsf3
X__divsf3:
X|
X| divide. sort of like mult, exc we do shifts and subtracts to
X| do the division of the mantissa. resultant exponent is Ea - Eb.
X|
X
X link a6,#0 | don't need any locals
X moveml #0x3F00,sp@- | save all data registers
X movel a6@(8),d0 | get a
X movel a6@(12),d1 | get b
X movel #23,d6 | shift count
X movel d0,d2 | get the exponent
X lsrl d6,d2 | and shift right
X andl #0xFF,d2
X subl #127,d2 | offset the exponent
X movel d1,d3 | get the exponent for b
X lsrl d6,d3 | and shift right
X andl #0xFF,d3
X subl #127,d3 | off set this one too
X
X clrl d7 | negative result flag
X andl #0x7FFFFF,d0 | mask a for mantissa
X orl #0x800000,d0 | and put in hidden bit
X tstl a6@(8) | test the original value
X bpl divsf3_1 | pos, ok
X eorl #1,d7 | remember negative
Xdivsf3_1:
X andl #0x7FFFFF,d1 | mask b for mantissa
X orl #0x800000,d1 | ditto
X tstl a6@(12) | test ...
X bpl divsf3_2
X eorl #1,d7
Xdivsf3_2:
X|
X| for now, kludge. shift Ma left and Mb right, then do an unsigned divide
X| and shift the result left. Blech
X|
X
X| lsrl #8,d1 | shift this one down
X| lsll #7,d0 | this one up
X| divu d1,d0 | do the divide
X| andl #0xFFFF,d0 | and mask off cruft
X
X| beq divsf3_ret | zero? ok, just return
X| lsll #8,d0 | shift left again
X
X| same sort of trick as long divide, exc it's easier here, cause
X| the numbers (mantissas) are already bit-aligned.
X
X clrl d4 | accumulator
X movel #0x800000,d5 | bit
X lsll #7,d0 | buy a little extra accuracy...
X lsll #7,d1
Xdivsf3_2a:
X cmpl d1,d0 | compare dividend to divisor
X bmi divsf3_2b | nope, no bit here
X orl d5,d4 | put in the bit
X subl d1,d0 | and subtract
Xdivsf3_2b:
X lsrl #1,d1 | slide divisor down
X lsrl #1,d5 | slide bit down
X bne divsf3_2a | and go round again
X movel d4,d0 | leave the result here
X
Xdivsf3_3:
X btst #23,d0 | right place yet?
X bne divsf3_4
X lsll #1,d0
X subql #1,d2
X bra divsf3_3
Xdivsf3_4:
X andl #0x7FFFFF,d0 | zap hidden bit
X subl d3,d2 | sub Eb from Ea
X addl #127,d2 | fix offset
X andl #0xFF,d2 | whack to 8 bits
X lsll d6,d2 | shift up to right place
X orl d2,d0 | shove it in
X tstl d7 | sign neg?
X beq divsf3_ret
X orl #0x80000000,d0 | set sign bit
Xdivsf3_ret:
X moveml sp@+,#0x00FC | snarf back all regs
X unlk a6
X
X rts | sigh
X##
X## #ifdef L_truncdfsf2
X## int
X## _truncdfsf2 (a)
X## double a;
X## {
X## union flt_or_int intify;
X## return INTIFY (a);
X## }
X## #endif
X#
X#.text
X# .even
X#.globl __truncdfsf2
X#__truncdfsf2:
X# movel sp@(4),d0
X# rts
X#
X##
X## #ifdef L_extendsfdf2
X## double
X## _extendsfdf2 (a)
X## union flt_or_int a;
X## {
X## union flt_or_int intify;
X## return a.f;
X## }
X## #endif
X#
X#.text
X# .even
X#.globl __extendsfdf2
X#__extendsfdf2:
X# movel sp@(4),d0
X# clrl d1
X# rts | sigh
X# .even
X#.text
X
SHAR_EOF
if test 15211 -ne "`wc -c 'sflonum.s'`"
then
echo shar: error transmitting "'sflonum.s'" '(should have been 15211 characters)'
fi
# End of shell archive
exit 0
usenet: {decvax,sun}!cwjcc!dsrgsun!bammi jwahar r. bammi
csnet: bammi@dsrgsun.ces.CWRU.edu
arpa: bammi@dsrgsun.ces.CWRU.edu
compuServe: 71515,155