mirror of
https://github.com/SEPPDROID/Digital-Research-Source-Code.git
synced 2025-10-23 00:14:25 +00:00
Upload
Digital Research
This commit is contained in:
103
CPM OPERATING SYSTEMS/CPM 68K/1.0X SOURCES/v101/c/libf/atof.c
Normal file
103
CPM OPERATING SYSTEMS/CPM 68K/1.0X SOURCES/v101/c/libf/atof.c
Normal file
@@ -0,0 +1,103 @@
|
||||
/*
|
||||
Copyright 1982
|
||||
Alcyon Corporation
|
||||
8716 Production Ave.
|
||||
San Diego, Ca. 92121
|
||||
*/
|
||||
|
||||
/*char *version "@(#) atof - dec 29, 1982"; */
|
||||
|
||||
/*
|
||||
* Ascii String to FFP Floating Point Routine :
|
||||
* FFP Standard Single Precision Representation Floating Point
|
||||
*
|
||||
* float
|
||||
* atof(buf)
|
||||
* char *buf;
|
||||
*
|
||||
* No more than 9 significant digits are allowed in single precision.
|
||||
* Largest positive number is 3.4 * 10^18 and the smallest positive
|
||||
* number is 1.2 * 10^-20.
|
||||
* Rely's on the fact that a long and a float are both 32 bits.
|
||||
*/
|
||||
|
||||
#define EXPSIZ 4
|
||||
#define FRACSIZ 20
|
||||
|
||||
long fptoffp();
|
||||
float strbin();
|
||||
float power10();
|
||||
|
||||
long
|
||||
atof(buf)
|
||||
char *buf;
|
||||
{
|
||||
char ibuf[FRACSIZ], ebuf[EXPSIZ];
|
||||
register char *ip, *ep;
|
||||
long ffp;
|
||||
int dp, esign, isign, ebin, places;
|
||||
float ibin, fp;
|
||||
|
||||
ip = &ibuf; ep = &ebuf; dp = 0; places = 0L;
|
||||
while (*buf == ' ' || *buf == '\t') /* ignore white spaces */
|
||||
buf++;
|
||||
isign = (*buf == '-');
|
||||
if (*buf == '-' || *buf == '+')
|
||||
buf++;
|
||||
while (*buf && *buf != 'e' && *buf != 'E') {
|
||||
if (*buf == '.')
|
||||
dp++;
|
||||
else { /* digit seen */
|
||||
*ip++ = *buf;
|
||||
if (dp)
|
||||
places++;
|
||||
}
|
||||
buf++;
|
||||
}
|
||||
*ip = 0;
|
||||
if (*buf == 'e' || *buf == 'E') { /* exponent string */
|
||||
buf++;
|
||||
esign = (*buf == '-');
|
||||
if (*buf == '-' || *buf == '+')
|
||||
buf++;
|
||||
while (*buf) /* get exponent string */
|
||||
*ep++ = *buf++;
|
||||
}
|
||||
*ep = 0;
|
||||
ibin = strbin(ibuf);
|
||||
ebin = atoi(ebuf);
|
||||
places = (esign) ? -ebin - places : ebin - places;
|
||||
fp = ibin * power10(places);
|
||||
ffp = fptoffp(fp);
|
||||
if (isign) /* negative float */
|
||||
ffp =| 0x80;
|
||||
return( ffp );
|
||||
}
|
||||
|
||||
float
|
||||
power10(pwr) /* 10^pwr */
|
||||
int pwr;
|
||||
{
|
||||
float f;
|
||||
|
||||
if (pwr < 0) /* negative power */
|
||||
for (f = 1.0; pwr < 0; pwr++)
|
||||
f = f / 10.0;
|
||||
else /* positive power */
|
||||
for (f = 1.0; pwr > 0; pwr--)
|
||||
f = f * 10.0;
|
||||
return(f);
|
||||
}
|
||||
|
||||
float
|
||||
strbin(p) /* decimal string => binary long */
|
||||
char *p;
|
||||
{
|
||||
float f;
|
||||
|
||||
for (f = 0.0; *p >= '0' && *p <= '9'; p++) {
|
||||
f = f * 10.0;
|
||||
f = f + (*p - '0');
|
||||
}
|
||||
return(f);
|
||||
}
|
||||
@@ -0,0 +1,41 @@
|
||||
/bin/c68 -f -c -L atof.c
|
||||
/bin/c68 -f -c -L ceil.c
|
||||
/bin/c68 -f -c -L etoa.c
|
||||
/bin/as68 -f -u -L/bin/c68 -c -L fabs.c
|
||||
/bin/as68 -u -Lffpabs.s
|
||||
/bin/as68 -u -Lffpadd.s
|
||||
/bin/as68 -f -u -L/bin/c68 -c -L ffpcmp.s
|
||||
/bin/as68 -f -u -L/bin/c68 -c -L ffpcpyrt.s
|
||||
/bin/as68 -u -Lffpdiv.s
|
||||
/bin/as68 -u -Lffpexp.s
|
||||
/bin/as68 -u -Lffphthet.s
|
||||
/bin/as68 -u -Lffplog.s
|
||||
/bin/as68 -u -Lffpmul2.s
|
||||
/bin/as68 -u -Lffppwr.s
|
||||
/bin/as68 -u -Lffpsin.s
|
||||
/bin/as68 -u -Lffpsqrt.s
|
||||
/bin/as68 -u -Lffptheta.s
|
||||
/bin/as68 -u -Lffptnorm.s
|
||||
/bin/c68 -f -c -L ffptof.c
|
||||
/bin/c68 -f -c -L floor.c
|
||||
/bin/c68 -f -c -L fmod.c
|
||||
/bin/as68 -u -Lfpadd.s
|
||||
/bin/as68 -f -u -L/bin/c68 -c -L fpcmp.s
|
||||
/bin/as68 -f -u -L/bin/c68 -c -L fpcos.s
|
||||
/bin/as68 -u -Lfpdiv.s
|
||||
/bin/as68 -u -Lfpexp.s
|
||||
/bin/as68 -u -Lfpftol.s
|
||||
/bin/as68 -u -Lfplog.s
|
||||
/bin/as68 -u -Lfpltof.s
|
||||
/bin/as68 -u -Lfpmul.s
|
||||
/bin/as68 -u -Lfpneg.s
|
||||
/bin/as68 -u -Lfppwr.s
|
||||
/bin/c68 -f -c -L fprintf.c
|
||||
/bin/as68 -u -Lfpsin.s
|
||||
/bin/as68 -u -Lfpsqrt.s
|
||||
/bin/as68 -u -Lfpsub.s
|
||||
/bin/c68 -f -c -L ftoa.c
|
||||
/bin/c68 -f -c -L ftoffp.c
|
||||
/bin/c68 -f -c -L ftol.c
|
||||
/bin/c68 -f -c -L ltof.c
|
||||
/bin/c68 -f -c -L printf.c
|
||||
@@ -0,0 +1,26 @@
|
||||
/*
|
||||
Copyright 1983
|
||||
Alcyon Corporation
|
||||
8716 Production Ave.
|
||||
San Diego, Ca. 92121
|
||||
*/
|
||||
|
||||
/*char *version "@(#) ceil - Feb 11, 1983";*/
|
||||
|
||||
/* ceil - returns the smallest integer (as a double precision
|
||||
number) not greater than x. */
|
||||
|
||||
double
|
||||
ceil(x)
|
||||
double x;
|
||||
{
|
||||
register long i;
|
||||
double retval;
|
||||
|
||||
if( x > 0 )
|
||||
x += 0.999999999999;
|
||||
i = x;
|
||||
retval = i;
|
||||
return( retval );
|
||||
}
|
||||
|
||||
@@ -0,0 +1,13 @@
|
||||
$ del ATOF.lis;*
|
||||
$ del CEIL.lis;*
|
||||
$ del ETOA.lis;*
|
||||
$ del FABS.lis;*
|
||||
$ del FFPTOF.lis;*
|
||||
$ del FLOOR.lis;*
|
||||
$ del FMOD.lis;*
|
||||
$ del FPRINTF.lis;*
|
||||
$ del FTOA.lis;*
|
||||
$ del FTOFFP.lis;*
|
||||
$ del FTOL.lis;*
|
||||
$ del LTOF.lis;*
|
||||
$ del PRINTF.lis;*
|
||||
@@ -0,0 +1,41 @@
|
||||
vax ATOF.C r
|
||||
vax CEIL.C r
|
||||
vax ETOA.C r
|
||||
vax FABS.C r
|
||||
vax FFPTOF.C r
|
||||
vax FLOOR.C r
|
||||
vax FMOD.C r
|
||||
vax FTOA.C r
|
||||
vax FTOFFP.C r
|
||||
vax FTOL.C r
|
||||
vax LTOF.C r
|
||||
vax FFPABS.S r
|
||||
vax FFPADD.S r
|
||||
vax FFPCMP.S r
|
||||
vax FFPCPYRT.S r
|
||||
vax FFPDIV.S r
|
||||
vax FFPEXP.S r
|
||||
vax FFPHTHET.S r
|
||||
vax FFPLOG.S r
|
||||
vax FFPMUL2.S r
|
||||
vax FFPPWR.S r
|
||||
vax FFPSIN.S r
|
||||
vax FFPSQRT.S r
|
||||
vax FFPTHETA.S r
|
||||
vax FFPTNORM.S r
|
||||
vax FPADD.S r
|
||||
vax FPCMP.S r
|
||||
vax FPCOS.S r
|
||||
vax FPDIV.S r
|
||||
vax FPEXP.S r
|
||||
vax FPFTOL.S r
|
||||
vax FPLOG.S r
|
||||
vax FPLTOF.S r
|
||||
vax FPMUL.S r
|
||||
vax FPNEG.S r
|
||||
vax FPPWR.S r
|
||||
vax FPSIN.S r
|
||||
vax FPSQRT.S r
|
||||
vax FPSUB.S r
|
||||
vax MAKE.SUB r
|
||||
vax REAR.SUB r
|
||||
@@ -0,0 +1,41 @@
|
||||
vax b:ATOF.C $frants
|
||||
vax b:CEIL.C $frants
|
||||
vax b:ETOA.C $frants
|
||||
vax b:FABS.C $frants
|
||||
vax b:FFPTOF.C $frants
|
||||
vax b:FLOOR.C $frants
|
||||
vax b:FMOD.C $frants
|
||||
vax b:FTOA.C $frants
|
||||
vax b:FTOFFP.C $frants
|
||||
vax b:FTOL.C $frants
|
||||
vax b:LTOF.C $frants
|
||||
vax b:FFPABS.S $frants
|
||||
vax b:FFPADD.S $frants
|
||||
vax b:FFPCMP.S $frants
|
||||
vax b:FFPCPYRT.S $frants
|
||||
vax b:FFPDIV.S $frants
|
||||
vax b:FFPEXP.S $frants
|
||||
vax b:FFPHTHET.S $frants
|
||||
vax b:FFPLOG.S $frants
|
||||
vax b:FFPMUL2.S $frants
|
||||
vax b:FFPPWR.S $frants
|
||||
vax b:FFPSIN.S $frants
|
||||
vax b:FFPSQRT.S $frants
|
||||
vax b:FFPTHETA.S $frants
|
||||
vax b:FFPTNORM.S $frants
|
||||
vax b:FPADD.S $frants
|
||||
vax b:FPCMP.S $frants
|
||||
vax b:FPCOS.S $frants
|
||||
vax b:FPDIV.S $frants
|
||||
vax b:FPEXP.S $frants
|
||||
vax b:FPFTOL.S $frants
|
||||
vax b:FPLOG.S $frants
|
||||
vax b:FPLTOF.S $frants
|
||||
vax b:FPMUL.S $frants
|
||||
vax b:FPNEG.S $frants
|
||||
vax b:FPPWR.S $frants
|
||||
vax b:FPSIN.S $frants
|
||||
vax b:FPSQRT.S $frants
|
||||
vax b:FPSUB.S $frants
|
||||
vax b:MAKE.SUB $frants
|
||||
vax b:REAR.SUB $frants
|
||||
@@ -0,0 +1,81 @@
|
||||
/*
|
||||
Copyright 1982
|
||||
Alcyon Corporation
|
||||
8716 Production Ave.
|
||||
San Diego, Ca. 92121
|
||||
*/
|
||||
|
||||
/*char *version "@(#) etoa - jan 24, 1982"; */
|
||||
|
||||
/*
|
||||
* FFP Floating Point to Ascii String Conversion Routine :
|
||||
* FFP Standard Single Precision Representation Floating Point
|
||||
*
|
||||
* char *
|
||||
* etoa(f,buf,prec)
|
||||
* float f;
|
||||
* char *buf;
|
||||
* int prec;
|
||||
*
|
||||
* No more than 9 decimal digits are allowed in single precision.
|
||||
* Largest positive number is 3.4 * 10^18 and the smallest positive
|
||||
* number is 1.2 * 10^-20.
|
||||
* Rely's on the fact that a long and a float are both 32 bits.
|
||||
*/
|
||||
|
||||
#define BIAS 127L
|
||||
|
||||
float ffptof();
|
||||
|
||||
char *
|
||||
etoa(fl,buf,prec)
|
||||
long fl; /* ffp formatted float */
|
||||
char *buf;
|
||||
int prec;
|
||||
{
|
||||
register char *bp;
|
||||
register int exp, digit;
|
||||
float f;
|
||||
|
||||
prec = (prec <= 0) ? 1 : (prec <= 9) ? prec : 9;
|
||||
bp = buf;
|
||||
f = ffptof(fl); /* get floating point value */
|
||||
if (f < 0.0) { /* negative float */
|
||||
*bp++ = '-';
|
||||
f = -f; /* make it positive */
|
||||
}
|
||||
if (f == 0.0) {
|
||||
*bp++ = '0'; *bp++ = '.';
|
||||
while (prec--)
|
||||
*bp++ = '0';
|
||||
*bp++ = 'e'; *bp++ = '0'; *bp++ = '0'; *bp = 0;
|
||||
return(buf);
|
||||
}
|
||||
for (exp=0; f < 1.0; f = f * 10.0) /* get negative exp */
|
||||
exp--;
|
||||
for ( ; f >= 1.0; f = f / 10.0) /* 0.XXXXXXE00 * 10^exp */
|
||||
exp++;
|
||||
|
||||
exp--; /* for one explicit digit */
|
||||
f = f * 10.0;
|
||||
digit = f; /* get one digit */
|
||||
f = f - digit;
|
||||
*bp++ = digit + '0';
|
||||
*bp++ = '.';
|
||||
while(prec-- > 0) { /* get prec. decimal places */
|
||||
f = f * 10.0;
|
||||
digit = f;
|
||||
f = f - digit;
|
||||
*bp++ = digit + '0';
|
||||
}
|
||||
*bp++ = 'e';
|
||||
if (exp < 0) {
|
||||
exp = -exp;
|
||||
*bp++ = '-';
|
||||
}
|
||||
*bp++ = (exp / 10) + '0';
|
||||
*bp++ = (exp % 10) + '0';
|
||||
*bp = 0;
|
||||
return(buf);
|
||||
}
|
||||
|
||||
@@ -0,0 +1,27 @@
|
||||
/*
|
||||
Copyright 1982
|
||||
Alcyon Corporation
|
||||
8716 Production Ave.
|
||||
San Diego, Ca. 92121
|
||||
*/
|
||||
|
||||
/*char *version "@(#) fabs - jan 11, 1983";*/
|
||||
|
||||
/*
|
||||
* Floating Point Absolute :
|
||||
* Fast Floating Point Package
|
||||
*
|
||||
* double
|
||||
* fabs(farg)
|
||||
* double farg;
|
||||
*
|
||||
* Returns : absolute Floating point number
|
||||
*/
|
||||
|
||||
long
|
||||
fabs(f)
|
||||
long f;
|
||||
{
|
||||
f = f & 0xffffff7f; /* turn off sign bit */
|
||||
return(f);
|
||||
}
|
||||
@@ -0,0 +1,68 @@
|
||||
ttl fast floating point abs/neg (ffpabs/ffpneg)
|
||||
***************************************
|
||||
* (c) copyright 1981 by motorola inc. *
|
||||
***************************************
|
||||
|
||||
*************************************************************
|
||||
* ffpabs *
|
||||
* fast floating point absolute value *
|
||||
* *
|
||||
* input: d7 - fast floating point argument *
|
||||
* *
|
||||
* output: d7 - fast floating point absolute value result *
|
||||
* *
|
||||
* condition codes: *
|
||||
* n - cleared *
|
||||
* z - set if result is zero *
|
||||
* v - cleared *
|
||||
* c - undefined *
|
||||
* x - undefined *
|
||||
* *
|
||||
* all registers transparent *
|
||||
* *
|
||||
*************************************************************
|
||||
page
|
||||
ffpabs idnt 1,1 ffp abs/neg
|
||||
|
||||
xdef ffpabs fast floating point absolute value
|
||||
|
||||
xref ffpcpyrt copyright notice
|
||||
|
||||
section 9
|
||||
|
||||
******************************
|
||||
* absolute value entry point *
|
||||
******************************
|
||||
ffpabs and.b #$7f,d7 clear the sign bit
|
||||
rts and return to the caller
|
||||
page
|
||||
*************************************************************
|
||||
* ffpneg *
|
||||
* fast floating point negate *
|
||||
* *
|
||||
* input: d7 - fast floating point argument *
|
||||
* *
|
||||
* output: d7 - fast floating point negated result *
|
||||
* *
|
||||
* condition codes: *
|
||||
* n - set if result is negative *
|
||||
* z - set if result is zero *
|
||||
* v - cleared *
|
||||
* c - undefined *
|
||||
* x - undefined *
|
||||
* *
|
||||
* all registers transparent *
|
||||
* *
|
||||
*************************************************************
|
||||
page
|
||||
xdef ffpneg fast floating point negate
|
||||
|
||||
**********************
|
||||
* negate entry point *
|
||||
**********************
|
||||
ffpneg tst.b d7 ? is argument a zero
|
||||
beq.s ffprtn return if so
|
||||
eor.b #$80,d7 invert the sign bit
|
||||
ffprtn rts and return to caller
|
||||
|
||||
end
|
||||
210
CPM OPERATING SYSTEMS/CPM 68K/1.0X SOURCES/v101/c/libf/ffpadd.s
Normal file
210
CPM OPERATING SYSTEMS/CPM 68K/1.0X SOURCES/v101/c/libf/ffpadd.s
Normal file
@@ -0,0 +1,210 @@
|
||||
ttl fast floating point add/subtract (ffpadd/ffpsub)
|
||||
***************************************
|
||||
* (c) copyright 1980 by motorola inc. *
|
||||
***************************************
|
||||
|
||||
*************************************************************
|
||||
* ffpadd/ffpsub *
|
||||
* fast floating point add/subtract *
|
||||
* *
|
||||
* ffpadd/ffpsub - fast floating point add and subtract *
|
||||
* *
|
||||
* input: *
|
||||
* ffpadd *
|
||||
* d6 - floating point addend *
|
||||
* d7 - floating point adder *
|
||||
* ffpsub *
|
||||
* d6 - floating point subtrahend *
|
||||
* d7 - floating point minuend *
|
||||
* *
|
||||
* output: *
|
||||
* d7 - floating point add result *
|
||||
* *
|
||||
* condition codes: *
|
||||
* n - result is negative *
|
||||
* z - result is zero *
|
||||
* v - overflow has occured *
|
||||
* c - undefined *
|
||||
* x - undefined *
|
||||
* *
|
||||
* registers d3 thru d5 are volatile *
|
||||
* *
|
||||
* code size: 228 bytes stack work area: 0 bytes *
|
||||
* *
|
||||
* notes: *
|
||||
* 1) addend/subtrahend unaltered (d6). *
|
||||
* 2) underflow returns zero and is unflagged. *
|
||||
* 3) overflow returns the highest value with the *
|
||||
* correct sign and the 'v' bit set in the ccr. *
|
||||
* *
|
||||
* time: (8 mhz no wait states assumed) *
|
||||
* *
|
||||
* composite average 20.625 microseconds *
|
||||
* *
|
||||
* add: arg1=0 7.75 microseconds *
|
||||
* arg2=0 5.25 microseconds *
|
||||
* *
|
||||
* like signs 14.50 - 26.00 microseconds *
|
||||
* average 18.00 microseconds *
|
||||
* unlike signs 20.13 - 54.38 microceconds *
|
||||
* average 22.00 microseconds *
|
||||
* *
|
||||
* subtract: arg1=0 4.25 microseconds *
|
||||
* arg2=0 9.88 microseconds *
|
||||
* *
|
||||
* like signs 15.75 - 27.25 microseconds *
|
||||
* average 19.25 microseconds *
|
||||
* unlike signs 21.38 - 55.63 microseconds *
|
||||
* average 23.25 microseconds *
|
||||
* *
|
||||
*************************************************************
|
||||
page
|
||||
ffpadd idnt 1,1 ffp add/subtract
|
||||
|
||||
xdef ffpadd,ffpsub entry points
|
||||
xref ffpcpyrt copyright notice
|
||||
|
||||
section 9
|
||||
|
||||
************************
|
||||
* subtract entry point *
|
||||
************************
|
||||
ffpsub move.b d6,d4 test arg1
|
||||
beq.s fpart2 return arg2 if arg1 zero
|
||||
eor.b #$80,d4 invert copied sign of arg1
|
||||
bmi.s fpami1 branch arg1 minus
|
||||
* + arg1
|
||||
move.b d7,d5 copy and test arg2
|
||||
bmi.s fpams branch arg2 minus
|
||||
bne.s fpals branch positive not zero
|
||||
bra.s fpart1 return arg1 since arg2 is zero
|
||||
|
||||
*******************
|
||||
* add entry point *
|
||||
*******************
|
||||
ffpadd move.b d6,d4 test argument1
|
||||
bmi.s fpami1 branch if arg1 minus
|
||||
beq.s fpart2 return arg2 if zero
|
||||
|
||||
* + arg1
|
||||
move.b d7,d5 test argument2
|
||||
bmi.s fpams branch if mixed signs
|
||||
beq.s fpart1 zero so return argument1
|
||||
|
||||
* +arg1 +arg2
|
||||
* -arg1 -arg2
|
||||
fpals sub.b d4,d5 test exponent magnitudes
|
||||
bmi.s fpa2lt branch arg1 greater
|
||||
move.b d7,d4 setup stronger s+exp in d4
|
||||
|
||||
* arg1exp <= arg2exp
|
||||
cmp.b #24,d5 overbearing size
|
||||
bcc.s fpart2 branch yes, return arg2
|
||||
move.l d6,d3 copy arg1
|
||||
clr.b d3 clean off sign+exponent
|
||||
lsr.l d5,d3 shift to same magnitude
|
||||
move.b #$80,d7 force carry if lsb-1 on
|
||||
add.l d3,d7 add arguments
|
||||
bcs.s fpa2gc branch if carry produced
|
||||
fparsr move.b d4,d7 restore sign/exponent
|
||||
rts return to caller
|
||||
|
||||
* add same sign overflow normalization
|
||||
fpa2gc roxr.l #1,d7 shift carry back into result
|
||||
add.b #1,d4 add one to exponent
|
||||
bvs.s fpa2os branch overflow
|
||||
bcc.s fparsr branch if no exponent overflow
|
||||
fpa2os moveq #-1,d7 create all ones
|
||||
sub.b #1,d4 back to highest exponent+sign
|
||||
move.b d4,d7 replace in result
|
||||
* or.b #$02,ccr show overflow occurred
|
||||
dc.l $003c0002 ****assembler error****
|
||||
rts return to caller
|
||||
|
||||
* return argument1
|
||||
fpart1 move.l d6,d7 move in as result
|
||||
move.b d4,d7 move in prepared sign+exponent
|
||||
rts return to caller
|
||||
|
||||
* return argument2
|
||||
fpart2 tst.b d7 test for returned value
|
||||
rts return to caller
|
||||
|
||||
* -arg1exp > -arg2exp
|
||||
* +arg1exp > +arg2exp
|
||||
fpa2lt cmp.b #-24,d5 ? arguments within range
|
||||
ble.s fpart1 nope, return larger
|
||||
neg.b d5 change difference to positive
|
||||
move.l d6,d3 setup larger value
|
||||
clr.b d7 clean off sign+exponent
|
||||
lsr.l d5,d7 shift to same magnitude
|
||||
move.b #$80,d3 force carry if lsb-1 on
|
||||
add.l d3,d7 add arguments
|
||||
bcs.s fpa2gc branch if carry produced
|
||||
move.b d4,d7 restore sign/exponent
|
||||
rts return to caller
|
||||
|
||||
* -arg1
|
||||
fpami1 move.b d7,d5 test arg2's sign
|
||||
bmi.s fpals branch for like signs
|
||||
beq.s fpart1 if zero return argument1
|
||||
|
||||
* -arg1 +arg2
|
||||
* +arg1 -arg2
|
||||
fpams moveq #-128,d3 create a carry mask ($80)
|
||||
eor.b d3,d5 strip sign off arg2 s+exp copy
|
||||
sub.b d4,d5 compare magnitudes
|
||||
beq.s fpaeq branch equal magnitudes
|
||||
bmi.s fpatlt branch if arg1 larger
|
||||
* arg1 <= arg2
|
||||
cmp.b #24,d5 compare magnitude difference
|
||||
bcc.s fpart2 branch arg2 much bigger
|
||||
move.b d7,d4 arg2 s+exp dominates
|
||||
move.b d3,d7 setup carry on arg2
|
||||
move.l d6,d3 copy arg1
|
||||
fpamss clr.b d3 clear extraneous bits
|
||||
lsr.l d5,d3 adjust for magnitude
|
||||
sub.l d3,d7 subtract smaller from larger
|
||||
bmi.s fparsr return final result if no overflow
|
||||
|
||||
* mixed signs normalize
|
||||
fpanor move.b d4,d5 save correct sign
|
||||
fpanrm clr.b d7 clear subtract residue
|
||||
sub.b #1,d4 make up for first shift
|
||||
cmp.l #$00007fff,d7 ? small enough for swap
|
||||
bhi.s fpaxqn branch nope
|
||||
swap.w d7 shift left 16 bits real fast
|
||||
sub.b #16,d4 make up for 16 bit shift
|
||||
fpaxqn add.l d7,d7 shift up one bit
|
||||
dbmi d4,fpaxqn decrement and branch if positive
|
||||
eor.b d4,d5 ? same sign
|
||||
bmi.s fpazro branch underflow to zero
|
||||
move.b d4,d7 restore sign/exponent
|
||||
beq.s fpazro return zero if exponent underflowed
|
||||
rts return to caller
|
||||
|
||||
* exponent underflowed - return zero
|
||||
fpazro moveq.l #0,d7 create a true zero
|
||||
rts return to caller
|
||||
|
||||
* arg1 > arg2
|
||||
fpatlt cmp.b #-24,d5 ? arg1 >> arg2
|
||||
ble.s fpart1 return it if so
|
||||
neg.b d5 absolutize difference
|
||||
move.l d7,d3 move arg2 as lower value
|
||||
move.l d6,d7 set up arg1 as high
|
||||
move.b #$80,d7 setup rounding bit
|
||||
bra.s fpamss perform the addition
|
||||
|
||||
* equal magnitudes
|
||||
fpaeq move.b d7,d5 save arg1 sign
|
||||
exg.l d5,d4 swap arg2 with arg1 s+exp
|
||||
move.b d6,d7 insure same low byte
|
||||
sub.l d6,d7 obtain difference
|
||||
beq.s fpazro return zero if identical
|
||||
bpl.s fpanor branch if arg2 bigger
|
||||
neg.l d7 correct difference to positive
|
||||
move.b d5,d4 use arg2's sign + exponent
|
||||
bra.s fpanrm and go normalize
|
||||
|
||||
end
|
||||
@@ -0,0 +1,83 @@
|
||||
ttl fast floating point cmp/tst (ffpcmp/ffptst)
|
||||
***************************************
|
||||
* (c) copyright 1981 by motorola inc. *
|
||||
***************************************
|
||||
|
||||
*************************************************************
|
||||
* ffpcmp *
|
||||
* fast floating point compare *
|
||||
* *
|
||||
* input: d6 - fast floating point argument (source) *
|
||||
* d7 - fast floating point argument (destination) *
|
||||
* *
|
||||
* output: condition code reflecting the following branches *
|
||||
* for the result of comparing the destination *
|
||||
* minus the source: *
|
||||
* *
|
||||
* gt - destination greater *
|
||||
* ge - destination greater or equal to *
|
||||
* eq - destination equal *
|
||||
* ne - destination not equal *
|
||||
* lt - destination less than *
|
||||
* le - destination less than or equal to *
|
||||
* *
|
||||
* condition codes: *
|
||||
* n - cleared *
|
||||
* z - set if result is zero *
|
||||
* v - cleared *
|
||||
* c - undefined *
|
||||
* x - undefined *
|
||||
* *
|
||||
* all registers transparent *
|
||||
* *
|
||||
*************************************************************
|
||||
page
|
||||
ffpcmp idnt 1,1 ffp cmp/tst
|
||||
|
||||
xdef ffpcmp fast floating point compare
|
||||
|
||||
xref ffpcpyrt copyright notice
|
||||
|
||||
section 9
|
||||
|
||||
***********************
|
||||
* compare entry point *
|
||||
***********************
|
||||
ffpcmp cmp.b d6,d7 compare sign and exponent only first
|
||||
bne.s ffpcrtn return if that is sufficient
|
||||
cmp.l d6,d7 no, compare full longwords then
|
||||
ffpcrtn rts and return to the caller
|
||||
page
|
||||
*************************************************************
|
||||
* ffptst *
|
||||
* fast floating point test *
|
||||
* *
|
||||
* input: d7 - fast floating point argument *
|
||||
* *
|
||||
* output: condition codes set for the following branches: *
|
||||
* *
|
||||
* eq - argument equals zero *
|
||||
* ne - argument not equal zero *
|
||||
* pl - argument is positive (includes zero)*
|
||||
* mi - argument is negative *
|
||||
* *
|
||||
* condition codes: *
|
||||
* n - set if result is negative *
|
||||
* z - set if result is zero *
|
||||
* v - cleared *
|
||||
* c - undefined *
|
||||
* x - undefined *
|
||||
* *
|
||||
* all registers transparent *
|
||||
* *
|
||||
*************************************************************
|
||||
page
|
||||
xdef ffptst fast floating point test
|
||||
|
||||
********************
|
||||
* test entry point *
|
||||
********************
|
||||
ffptst tst.b d7 return tested condition code
|
||||
rts to caller
|
||||
|
||||
end
|
||||
@@ -0,0 +1,29 @@
|
||||
ttl mc68343 fast floating point copyright notice (ffpcpyrt)
|
||||
ffpcpyrt idnt 1,1 ffp copyright notice
|
||||
|
||||
*************************************
|
||||
* ffp library copyright notice stub *
|
||||
* *
|
||||
* this module is included by all *
|
||||
* link edits with the ffplib.ro *
|
||||
* library to protect motorola's *
|
||||
* copyright status. *
|
||||
* *
|
||||
* code: 67 bytes *
|
||||
* *
|
||||
* note: this module must reside *
|
||||
* last in the library as it is *
|
||||
* referenced by all other mc68343 *
|
||||
* modules. *
|
||||
*************************************
|
||||
|
||||
section 9
|
||||
|
||||
xdef ffpcpyrt
|
||||
|
||||
|
||||
ffpcpyrt equ *
|
||||
dc.b 'mc68343 floating point firmware '
|
||||
dc.b '(c) copyright 1981 by motorola inc.'
|
||||
|
||||
end
|
||||
166
CPM OPERATING SYSTEMS/CPM 68K/1.0X SOURCES/v101/c/libf/ffpdiv.s
Normal file
166
CPM OPERATING SYSTEMS/CPM 68K/1.0X SOURCES/v101/c/libf/ffpdiv.s
Normal file
@@ -0,0 +1,166 @@
|
||||
ttl fast floating point divide (ffpdiv)
|
||||
*****************************************
|
||||
* (c) copyright 1980 by motorola inc. *
|
||||
*****************************************
|
||||
|
||||
********************************************
|
||||
* ffpdiv subroutine *
|
||||
* *
|
||||
* input: *
|
||||
* d6 - floating point divisor *
|
||||
* d7 - floating point dividend *
|
||||
* *
|
||||
* output: *
|
||||
* d7 - floating point quotient *
|
||||
* *
|
||||
* condition codes: *
|
||||
* n - set if result negative *
|
||||
* z - set if result zero *
|
||||
* v - set if result overflowed *
|
||||
* c - undefined *
|
||||
* x - undefined *
|
||||
* *
|
||||
* registers d3 thru d5 volatile *
|
||||
* *
|
||||
* code: 150 bytes stack work: 0 bytes *
|
||||
* *
|
||||
* notes: *
|
||||
* 1) divisor is unaltered (d6). *
|
||||
* 2) underflows return zero without *
|
||||
* any indicators set. *
|
||||
* 3) overflows return the highest value *
|
||||
* with the proper sign and the 'v' *
|
||||
* bit set in the ccr. *
|
||||
* 4) if a divide by zero is attempted *
|
||||
* the divide by zero exception trap *
|
||||
* is forced by this code with the *
|
||||
* original arguments intact. if the *
|
||||
* exception returns with the denom- *
|
||||
* inator altered the divide operation *
|
||||
* continues, otherwise an overflow *
|
||||
* is forced with the proper sign. *
|
||||
* the floating divide by zero can be *
|
||||
* distinguished from true zero divide *
|
||||
* by the fact that it is an immediate *
|
||||
* zero dividing into register d7. *
|
||||
* *
|
||||
* time: (8 mhz no wait states assumed) *
|
||||
* dividend zero 5.250 microseconds *
|
||||
* minimum time others 72.750 microseconds *
|
||||
* maximum time others 85.000 microseconds *
|
||||
* average others 76.687 microseconds *
|
||||
* *
|
||||
********************************************
|
||||
page
|
||||
ffpdiv idnt 1,1 ffp divide
|
||||
|
||||
xdef ffpdiv entry point
|
||||
xref ffpcpyrt copyright notice
|
||||
|
||||
section 9
|
||||
|
||||
* divide by zero exit
|
||||
fpddzr divu.w #0,d7 **force divide by zero **
|
||||
|
||||
* if the exception returns with altered denominator - continue divide
|
||||
tst.l d6 ? exception alter the zero
|
||||
bne.s ffpdiv branch if so to continue
|
||||
* setup maximum number for divide overflow
|
||||
fpdovf or.l #$ffffff7f,d7 maximize with proper sign
|
||||
tst.b d7 set condition code for sign
|
||||
* or.w #$02,ccr set overflow bit
|
||||
dc.l $003c0002 ******sick assembler******
|
||||
fpdrtn rts return to caller
|
||||
|
||||
* over or underflow detected
|
||||
fpdov2 swap.w d6 restore arg1
|
||||
swap.w d7 restore arg2 for sign
|
||||
fpdovfs eor.b d6,d7 setup correct sign
|
||||
bra.s fpdovf and enter overflow handling
|
||||
fpdouf bmi.s fpdovfs branch if overflow
|
||||
fpdund move.l #0,d7 underflow to zero
|
||||
rts and return to caller
|
||||
|
||||
***************
|
||||
* entry point *
|
||||
***************
|
||||
|
||||
* first subtract exponents
|
||||
ffpdiv move.b d6,d5 copy arg1 (divisor)
|
||||
beq.s fpddzr branch if divide by zero
|
||||
move.l d7,d4 copy arg2 (dividend)
|
||||
beq.s fpdrtn return zero if dividend zero
|
||||
moveq #-128,d3 setup sign mask
|
||||
add.w d5,d5 isolate arg1 sign from exponent
|
||||
add.w d4,d4 isolate arg2 sign from exponent
|
||||
eor.b d3,d5 adjust arg1 exponent to binary
|
||||
eor.b d3,d4 adjust arg2 exponent to binary
|
||||
sub.b d5,d4 subtract exponents
|
||||
bvs.s fpdouf branch if overflow/underflow
|
||||
clr.b d7 clear arg2 s+exp
|
||||
swap.w d7 prepare high 16 bit compare
|
||||
swap.w d6 against arg1 and arg2
|
||||
cmp.w d6,d7 ? check if overflow will occur
|
||||
bmi.s fpdnov branch if not
|
||||
* adjust for fixed point divide overflow
|
||||
add.b #2,d4 adjust exponent up one
|
||||
bvs.s fpdov2 branch overflow here
|
||||
ror.l #1,d7 shift down by power of two
|
||||
fpdnov swap.w d7 correct arg2
|
||||
move.b d3,d5 move $80 into d5.b
|
||||
eor.w d5,d4 create sign and absolutize exponent
|
||||
lsr.w #1,d4 d4.b now has sign+exponent of result
|
||||
|
||||
* now divide just using 16 bits into 24
|
||||
move.l d7,d3 copy arg1 for initial divide
|
||||
divu.w d6,d3 obtain test quotient
|
||||
move.w d3,d5 save test quotient
|
||||
|
||||
* now multiply 16-bit divide result times full 24 bit divisor and compare
|
||||
* with the dividend. multiplying back out with the full 24-bits allows
|
||||
* us to see if the result was too large due to the 8 missing divisor bits
|
||||
* used in the hardware divide. the result can only be too large by 1 unit.
|
||||
mulu.w d6,d3 high divisor x quotient
|
||||
sub.l d3,d7 d7=partial subtraction
|
||||
swap.w d7 to low divisor
|
||||
swap.w d6 rebuild arg1 to normal
|
||||
move.w d6,d3 setup arg1 for product
|
||||
clr.b d3 zero low byte
|
||||
mulu.w d5,d3 find remaining product
|
||||
sub.l d3,d7 now have full subtraction
|
||||
bcc.s fpdqok branch first 16 bits correct
|
||||
|
||||
* estimate too high, decrement quotient by one
|
||||
move.l d6,d3 rebuild divisor
|
||||
clr.b d3 reverse halves
|
||||
add.l d3,d7 add another divisor
|
||||
sub.w #1,d5 decrement quotient
|
||||
|
||||
* compute last 8 bits with another divide. the exact remainder from the
|
||||
* multiply and compare above is divided again by a 16-bit only divisor.
|
||||
* however, this time we require only 9 bits of accuracy in the result
|
||||
* (8 to make 24 bits total and 1 extra bit for rounding purposes) and this
|
||||
* divide always returns a precision of at least 9 bits.
|
||||
fpdqok move.l d6,d3 copy arg1 again
|
||||
swap.w d3 first 16 bits divisor in d3.w
|
||||
clr.w d7 into first 16 bits of dividend
|
||||
divu.w d3,d7 obtain final 16 bit result
|
||||
swap.w d5 first 16 quotient to high half
|
||||
bmi.s fpdisn branch if normalized
|
||||
* rare occurrance - unnormalized
|
||||
* happends when mantissa arg1 < arg2 and they differ only in last 8 bits
|
||||
move.w d7,d5 insert low word of quotient
|
||||
add.l d5,d5 shift mantissa left one
|
||||
sub.b #1,d4 adjust exponent down (cannot zero)
|
||||
move.w d5,d7 cancel next instruction
|
||||
|
||||
* rebuild our final result and return
|
||||
fpdisn move.w d7,d5 append next 16 bits
|
||||
add.l #$80,d5 round to 24 bits (cannot overflow)
|
||||
move.l d5,d7 return in d7
|
||||
move.b d4,d7 finish result with sign+exponent
|
||||
beq.s fpdund underflow if zero exponent
|
||||
rts return result to caller
|
||||
|
||||
|
||||
end
|
||||
203
CPM OPERATING SYSTEMS/CPM 68K/1.0X SOURCES/v101/c/libf/ffpexp.s
Normal file
203
CPM OPERATING SYSTEMS/CPM 68K/1.0X SOURCES/v101/c/libf/ffpexp.s
Normal file
@@ -0,0 +1,203 @@
|
||||
ttl fast floating point exponent (ffpexp)
|
||||
***************************************
|
||||
* (c) copyright 1981 by motorola inc. *
|
||||
***************************************
|
||||
|
||||
*************************************************
|
||||
* ffpexp *
|
||||
* fast floating point exponent *
|
||||
* *
|
||||
* input: d7 - input argument *
|
||||
* *
|
||||
* output: d7 - exponential result *
|
||||
* *
|
||||
* all other registers are transparent *
|
||||
* *
|
||||
* code size: 256 bytes stack work: 34 bytes *
|
||||
* *
|
||||
* condition codes: *
|
||||
* z - set if result in d7 is zero *
|
||||
* n - cleared *
|
||||
* v - set if overlow occurred *
|
||||
* c - undefined *
|
||||
* x - undefined *
|
||||
* *
|
||||
* *
|
||||
* notes: *
|
||||
* 1) an overflow returns the largest *
|
||||
* magnitude number. *
|
||||
* 2) spot checks show at least 6.8 digit *
|
||||
* accuracy for all abs(arg) < 30. *
|
||||
* *
|
||||
* time: (8mhz no wait states assumed) *
|
||||
* *
|
||||
* 488 microseconds *
|
||||
* *
|
||||
* logic: 1) find n = int(arg/ln 2). this is *
|
||||
* added to the mantissa at the end.*
|
||||
* 3) reduce argument to range by *
|
||||
* finding arg = mod(arg, ln 2). *
|
||||
* 4) derive exp(arg) with cordic loop.*
|
||||
* 5) add n to exponent giving result. *
|
||||
* *
|
||||
*************************************************
|
||||
page
|
||||
ffpexp idnt 1,2 ffp exp
|
||||
|
||||
opt pcs
|
||||
|
||||
section 9
|
||||
|
||||
xdef ffpexp entry point
|
||||
|
||||
xref ffphthet hypertangent table
|
||||
|
||||
xref ffpmul2,ffpsub arithmetic primitives
|
||||
xref ffptnorm transcendental normalize routine
|
||||
xref ffpcpyrt copyright stub
|
||||
|
||||
ln2 equ $b1721840 ln 2 (base e) .693147180
|
||||
ln2inv equ $b8aa3b41 inverse of ln 2 (base e) 1.44269504
|
||||
cnjkhinv equ $9a8f4441 floating conjugate of k inverse
|
||||
* corrected for the extra convergence
|
||||
* during shifts for 4 and 13
|
||||
kfctseed equ $26a3d100 k cordic seed
|
||||
|
||||
|
||||
* overflow - return zero or highest value and "v" bit
|
||||
fpeovflw move.w (sp)+,d6 load sign word and work off stack
|
||||
tst.b d6 ? was argument negative
|
||||
bpl.s fpovnzro no, continue
|
||||
move.l #0,d7 return a zero
|
||||
bra.s fpovrtn as result is too small
|
||||
fpovnzro move.l #-1,d7 set all zeroes
|
||||
lsr.b #1,d7 zero sign bit
|
||||
* or.b #$02,ccr set overflow bit
|
||||
dc.l $003c0002 ***assembler error***
|
||||
fpovrtn movem.l (sp)+,d1-d6/a0 restore registers
|
||||
rts return to caller
|
||||
|
||||
* return one for zero argument
|
||||
ffpe1 move.l #$80000041,d7 return a true one
|
||||
lea 7*4+2(sp),sp ignore stack saves
|
||||
tst.b d7 set condition code properly
|
||||
rts return to caller
|
||||
|
||||
**************
|
||||
* exp entry *
|
||||
**************
|
||||
|
||||
* save work registers and insure positive argument
|
||||
ffpexp movem.l d1-d6/a0,-(sp) save all work registers
|
||||
move.w d7,-(sp) save sign in low order byte for later
|
||||
beq.s ffpe1 return a true one for zero exponent
|
||||
and.b #$7f,d7 take absolute value
|
||||
|
||||
* divide by log 2 base e for partial result
|
||||
fpepos move.l d7,d2 save original argument
|
||||
move.l #ln2inv,d6 load inverse to multiply (faster)
|
||||
bsr ffpmul2 obtain division thru multiply
|
||||
bvs fpeovflw branch if too large
|
||||
* convert quotient to both fixed and float integer
|
||||
move.b d7,d5 copy exponent over
|
||||
move.b d7,d6 copy exponent over
|
||||
sub.b #64+32,d5 find non-fractional precision
|
||||
neg.b d5 make positive
|
||||
cmp.b #24,d5 ? insure not too large
|
||||
ble.s fpeovflw branch too large
|
||||
cmp.b #32,d5 ? test upper range
|
||||
bge.s fpesml branch less than one
|
||||
lsr.l d5,d7 shift to integer
|
||||
move.b d7,(sp) place adjusted exponent with sign byte
|
||||
lsl.l d5,d7 back to normal without fraction
|
||||
move.b d6,d7 re-insert sign+exponent
|
||||
move.l #ln2,d6 multiply by ln2 to find residue
|
||||
bsr ffpmul2 multiply back out
|
||||
move.l d7,d6 setup to subtract multiple of ln 2
|
||||
move.l d2,d7 move argument in
|
||||
bsr ffpsub find remainder of ln 2 divide
|
||||
move.l d7,d2 copy float argument
|
||||
bra.s fpeadj adjust to fixed
|
||||
|
||||
* multiple less than one
|
||||
fpesml clr.b (sp) default initial multiply to zero
|
||||
move.l d2,d7 back to original argument
|
||||
|
||||
* convert argument to binary(31,29) precision
|
||||
fpeadj clr.b d7 clear sign and exponent
|
||||
sub.b #64+3,d2 obtain shift value
|
||||
neg.b d2 for 2 non-fraction bits
|
||||
cmp.b #31,d2 insure not too small
|
||||
bls.s fpeshf branch to shift if ok
|
||||
move.l #0,d7 force to zero
|
||||
fpeshf lsr.l d2,d7 convert to fixed point
|
||||
|
||||
*****************************************
|
||||
* cordic calculation registers: *
|
||||
* d1 - loop count a0 - table pointer *
|
||||
* d2 - shift count *
|
||||
* d3 - y' d5 - y *
|
||||
* d4 - x' d6 - x *
|
||||
* d7 - test argument *
|
||||
*****************************************
|
||||
|
||||
* input within range, now start cordic setup
|
||||
fpecom move.l #0,d5 y=0
|
||||
move.l #kfctseed,d6 x=1 with jkhinverse factored out
|
||||
lea ffphthet,a0 point to hperbolic tangent table
|
||||
move.l #0,d2 prime shift counter
|
||||
|
||||
* perform cordic loop repeating shifts 4 and 13 to guarantee convergence
|
||||
* (ref. "a unified algorithm for elementary functions" j.s.walther
|
||||
* pg. 380 spring joint computer conference 1971)
|
||||
move.l #3,d1 do shifts 1 thru 4
|
||||
bsr.s cordic first cordic loops
|
||||
sub.l #4,a0 redo table entry
|
||||
sub.w #1,d2 redo shift count
|
||||
move.l #9,d1 do four through 13
|
||||
bsr.s cordic second cordic loops
|
||||
sub.l #4,a0 back to entry 13
|
||||
sub.w #1,d2 redo shift for 13
|
||||
move.l #10,d1 now 13 through 23
|
||||
bsr.s cordic and finish up
|
||||
|
||||
* now finalize the result
|
||||
tst.b 1(sp) test original sign
|
||||
bpl.s fsepos branch positive argument
|
||||
neg.l d5 change y for subtraction
|
||||
neg.b (sp) negate adjusted exponent to subtract
|
||||
fsepos add.l d5,d6 add or subtract y to/from x
|
||||
bsr ffptnorm float x
|
||||
move.l d6,d7 setup result
|
||||
* add ln2 factor integer to the exponent
|
||||
add.b (sp),d7 add to exponent
|
||||
bmi fpeovflw branch if too large
|
||||
beq fpeovflw branch if too small
|
||||
add.l #2,sp rid work data off stack
|
||||
movem.l (sp)+,d1-d6/a0 restore registers
|
||||
rts return to caller
|
||||
|
||||
*************************
|
||||
* cordic loop subroutine*
|
||||
*************************
|
||||
cordic add.w #1,d2 increment shift count
|
||||
move.l d5,d3 copy y
|
||||
move.l d6,d4 copy x
|
||||
asr.l d2,d3 shift for y'
|
||||
asr.l d2,d4 shift for x'
|
||||
tst.l d7 test arg value
|
||||
bmi.s febmi branch minus test
|
||||
add.l d4,d5 y=y+x'
|
||||
add.l d3,d6 x=x+y'
|
||||
sub.l (a0)+,d7 arg=arg-table(n)
|
||||
dbra d1,cordic loop until done
|
||||
rts return
|
||||
|
||||
febmi sub.l d4,d5 y=y-x'
|
||||
sub.l d3,d6 x=x-y'
|
||||
add.l (a0)+,d7 arg=arg+table(n)
|
||||
dbra d1,cordic loop until done
|
||||
rts return
|
||||
|
||||
|
||||
end
|
||||
@@ -0,0 +1,48 @@
|
||||
ttl fast floating point cordic hyperbolic table (ffphthet)
|
||||
ffphthet idnt 1,1 ffp inverse hyperbolic table
|
||||
|
||||
***************************************
|
||||
* (c) copyright 1981 by motorola inc. *
|
||||
***************************************
|
||||
|
||||
section 9
|
||||
|
||||
xdef ffphthet external definition
|
||||
|
||||
*********************************************************
|
||||
* inverse hyperbolic tangent table for cordic *
|
||||
* *
|
||||
* the following table is used during cordic *
|
||||
* transcendental evaluations for log and exp. it has *
|
||||
* inverse hyperbolic tangent for 2**-n where n ranges *
|
||||
* from 1 to 24. the format is binary(31,29) *
|
||||
* precision (i.e. the binary point is assumed between *
|
||||
* bits 27 and 28 with three leading non-fraction bits.) *
|
||||
*********************************************************
|
||||
|
||||
ffphthet dc.l $8c9f53d0>>3 harctan(2**-1) .549306144
|
||||
dc.l $4162bbe8>>3 harctan(2**-2) .255412812
|
||||
dc.l $202b1238>>3 harctan(2**-3)
|
||||
dc.l $10055888>>3 harctan(2**-4)
|
||||
dc.l $0800aac0>>3 harctan(2**-5)
|
||||
dc.l $04001550>>3 harctan(2**-6)
|
||||
dc.l $020002a8>>3 harctan(2**-7)
|
||||
dc.l $01000050>>3 harctan(2**-8)
|
||||
dc.l $00800008>>3 harctan(2**-9)
|
||||
dc.l $00400000>>3 harctan(2**-10)
|
||||
dc.l $00200000>>3 harctan(2**-11)
|
||||
dc.l $00100000>>3 harctan(2**-12)
|
||||
dc.l $00080000>>3 harctan(2**-13)
|
||||
dc.l $00040000>>3 harctan(2**-14)
|
||||
dc.l $00020000>>3 harctan(2**-15)
|
||||
dc.l $00010000>>3 harctan(2**-16)
|
||||
dc.l $00008000>>3 harctan(2**-17)
|
||||
dc.l $00004000>>3 harctan(2**-18)
|
||||
dc.l $00002000>>3 harctan(2**-19)
|
||||
dc.l $00001000>>3 harctan(2**-20)
|
||||
dc.l $00000800>>3 harctan(2**-21)
|
||||
dc.l $00000400>>3 harctan(2**-22)
|
||||
dc.l $00000200>>3 harctan(2**-23)
|
||||
dc.l $00000100>>3 harctan(2**-24)
|
||||
|
||||
end
|
||||
161
CPM OPERATING SYSTEMS/CPM 68K/1.0X SOURCES/v101/c/libf/ffplog.s
Normal file
161
CPM OPERATING SYSTEMS/CPM 68K/1.0X SOURCES/v101/c/libf/ffplog.s
Normal file
@@ -0,0 +1,161 @@
|
||||
ttl fast floating point log (ffplog)
|
||||
***************************************
|
||||
* (c) copyright 1981 by motorola inc. *
|
||||
***************************************
|
||||
|
||||
*************************************************
|
||||
* ffplog *
|
||||
* fast floating point logorithm *
|
||||
* *
|
||||
* input: d7 - input argument *
|
||||
* *
|
||||
* output: d7 - logorithmic result to base e *
|
||||
* *
|
||||
* all other registers totally transparent *
|
||||
* *
|
||||
* code size: 184 bytes stack work: 38 bytes *
|
||||
* *
|
||||
* condition codes: *
|
||||
* z - set if the result is zero *
|
||||
* n - set if result in is negative *
|
||||
* v - set if invalid negative argument *
|
||||
* or zero argument *
|
||||
* c - undefined *
|
||||
* x - undefined *
|
||||
* *
|
||||
* *
|
||||
* notes: *
|
||||
* 1) spot checks show errors bounded by *
|
||||
* 5 x 10**-8. *
|
||||
* 2) negative arguments are illegal and cause*
|
||||
* the "v" bit to be set and the absolute *
|
||||
* value used instead. *
|
||||
* 3) a zero argument returns the largest *
|
||||
* negative value possible with the "v" bit*
|
||||
* set. *
|
||||
* *
|
||||
* time: (8mhz no wait states assumed) *
|
||||
* *
|
||||
* times are very data sensitive with *
|
||||
* samples ranging from 170 to 556 *
|
||||
* microseconds *
|
||||
* *
|
||||
*************************************************
|
||||
page
|
||||
ffplog idnt 1,2 ffp log
|
||||
|
||||
opt pcs
|
||||
section 9
|
||||
|
||||
xdef ffplog entry point
|
||||
|
||||
xref ffphthet hypertangent table
|
||||
xref ffpadd,ffpdiv,ffpsub,ffpmul2 arithmetic primitives
|
||||
xref ffptnorm transcendental normalize routine
|
||||
xref ffpcpyrt copyright stub
|
||||
|
||||
fpone equ $80000041 floating value for one
|
||||
log2 equ $b1721840 log(2) = .6931471805
|
||||
|
||||
**************
|
||||
* log entry *
|
||||
**************
|
||||
|
||||
* insure argument positive
|
||||
ffplog tst.b d7 ? test sign
|
||||
beq.s fplzro branch argument zero
|
||||
bpl.s fplok branch alright
|
||||
|
||||
* argument is negative - use the absolute value and set the "v" bit
|
||||
and.b #$7f,d7 take absolute value
|
||||
bsr.s fplok find log(abs(x))
|
||||
*psetv or.b #$02,ccr set overflow bit
|
||||
fpsetv dc.l $003c0002 ***assembler error***
|
||||
rts return to caller
|
||||
|
||||
* argument is zero - return largest negative number with "v" bit
|
||||
fplzro move.l #-1,d7 return largest negative
|
||||
bra fpsetv return with "v" bit set
|
||||
|
||||
* save work registers and strip exponent off
|
||||
fplok movem.l d1-d6/a0,-(sp) save all work registers
|
||||
move.b d7,-(sp) save original exponent
|
||||
move.b #64+1,d7 force between 1 and 2
|
||||
move.l #fpone,d6 load up a one
|
||||
move.l d7,d2 copy argument
|
||||
bsr ffpadd create arg+1
|
||||
exg.l d7,d2 swap result with argument
|
||||
bsr ffpsub create arg-1
|
||||
move.l d2,d6 prepare for divide
|
||||
bsr ffpdiv result is (arg-1)/(arg+1)
|
||||
beq.s fplnocr zero so cordic not needed
|
||||
* convert to bin(31,29) precision
|
||||
sub.b #64+3,d7 adjust exponent
|
||||
neg.b d7 for shift necessary
|
||||
cmp.b #31,d7 ? insure not too small
|
||||
bls.s fplshf no, go shift
|
||||
move.l #0,d7 force to zero
|
||||
fplshf lsr.l d7,d7 shift to bin(31,29) precision
|
||||
|
||||
*****************************************
|
||||
* cordic calculation registers: *
|
||||
* d1 - loop count a0 - table pointer *
|
||||
* d2 - shift count *
|
||||
* d3 - y' d5 - y *
|
||||
* d4 - x' d6 - z *
|
||||
* d7 - x *
|
||||
*****************************************
|
||||
|
||||
move.l #0,d6 z=0
|
||||
move.l #1<<29,d5 y=1
|
||||
lea ffphthet,a0 to inverse hyperbolic tangent table
|
||||
move.l #22,d1 loop 23 times
|
||||
move.l #1,d2 prime shift counter
|
||||
bra.s cordic enter cordic loop
|
||||
|
||||
* cordic loop
|
||||
fplpls asr.l d2,d4 shift(x')
|
||||
sub.l d4,d5 y = y - x'
|
||||
add.l (a0),d6 z = z + hypertan(i)
|
||||
cordic move.l d7,d4 x' = x
|
||||
move.l d5,d3 y' = y
|
||||
asr.l d2,d3 shift(y')
|
||||
fplnlp sub.l d3,d7 x = x - y'
|
||||
bpl.s fplpls branch negative
|
||||
move.l d4,d7 restore x
|
||||
add.l #4,a0 to next table entry
|
||||
add.b #1,d2 increment shift count
|
||||
lsr.l #1,d3 shift(y')
|
||||
dbra d1,fplnlp and loop until done
|
||||
|
||||
* now convert to float and add exponent*log(2) for final result
|
||||
move.l #0,d7 default zero if too small
|
||||
bsr ffptnorm float z
|
||||
beq.s fplnocr branch if too small
|
||||
add.b #1,d6 times two
|
||||
move.l d6,d7 setup in d7 in case exp=0
|
||||
fplnocr move.l d7,d2 save result
|
||||
move.l #0,d6 prepare original exponent load
|
||||
move.b (sp)+,d6 load it back
|
||||
sub.b #64+1,d6 convert exponent to binary
|
||||
beq.s fplzpr branch zero partial here
|
||||
move.b d6,d1 save sign byte
|
||||
bpl.s fplpos branch positive value
|
||||
neg.b d6 force positive
|
||||
fplpos ror.l #8,d6 prepare to convert to integer
|
||||
move.l #$47,d5 setup exponent mask
|
||||
fplnorm add.l d6,d6 shift to left
|
||||
dbmi d5,fplnorm exp-1 and branch if not normalized
|
||||
move.b d5,d6 fix in exponent
|
||||
and.b #$80,d1 extract sign
|
||||
or.b d1,d6 insert sign in
|
||||
move.l #log2,d7 multiply exponent by log(2)
|
||||
bsr ffpmul2 multiply d6 and d7
|
||||
move.l d2,d6 now add cordic result
|
||||
bsr ffpadd for final answer
|
||||
|
||||
fplzpr movem.l (sp)+,d1-d6/a0 restore registers
|
||||
rts return to caller
|
||||
|
||||
|
||||
end
|
||||
132
CPM OPERATING SYSTEMS/CPM 68K/1.0X SOURCES/v101/c/libf/ffpmul2.s
Normal file
132
CPM OPERATING SYSTEMS/CPM 68K/1.0X SOURCES/v101/c/libf/ffpmul2.s
Normal file
@@ -0,0 +1,132 @@
|
||||
ttl fast floating point precise multiply (ffpmul2)
|
||||
*******************************************
|
||||
* (c) copyright 1980 by motorola inc. *
|
||||
*******************************************
|
||||
|
||||
********************************************
|
||||
* ffpmul2 subroutine *
|
||||
* *
|
||||
* this module is the second of the *
|
||||
* multiply routines. it is 18% slower *
|
||||
* but provides the highest accuracy *
|
||||
* possible. the error is exactly .5 *
|
||||
* least significant bit versus an error *
|
||||
* in the high-speed default routine of *
|
||||
* .50390625 least significant bit due *
|
||||
* to truncation. *
|
||||
* *
|
||||
* input: *
|
||||
* d6 - floating point multiplier *
|
||||
* d7 - floating point multiplican *
|
||||
* *
|
||||
* output: *
|
||||
* d7 - floating point result *
|
||||
* *
|
||||
* registers d3 thru d5 are volatile *
|
||||
* *
|
||||
* condition codes: *
|
||||
* n - set if result negative *
|
||||
* z - set if result is zero *
|
||||
* v - set if overflow occurred *
|
||||
* c - undefined *
|
||||
* x - undefined *
|
||||
* *
|
||||
* code: 134 bytes stack work: 0 bytes *
|
||||
* *
|
||||
* notes: *
|
||||
* 1) multipier unaltered (d6). *
|
||||
* 2) underflows return zero with no *
|
||||
* indicator set. *
|
||||
* 3) overflows will return the maximum *
|
||||
* value with the proper sign and the *
|
||||
* 'v' bit set in the ccr. *
|
||||
* *
|
||||
* times: (8mhz no wait states assumed) *
|
||||
* arg1 zero 5.750 microseconds *
|
||||
* arg2 zero 3.750 microseconds *
|
||||
* minimum time others 45.750 microseconds *
|
||||
* maximum time others 61.500 microseconds *
|
||||
* average others 52.875 microseconds *
|
||||
* *
|
||||
********************************************
|
||||
page
|
||||
ffpmul2 idnt 1,1 ffp high-precision multiply
|
||||
|
||||
xdef ffpmul2 entry point
|
||||
xref ffpcpyrt copyright notice
|
||||
|
||||
section 9
|
||||
|
||||
|
||||
* ffpmul2 subroutine entry point
|
||||
ffpmul2 move.b d7,d5 prepare sign/exponent work 4
|
||||
beq.s ffmrtn return if result already zero 8/10
|
||||
move.b d6,d4 copy arg1 sign/exponent 4
|
||||
beq.s ffmrt0 return zero if arg1=0 8/10
|
||||
add.w d5,d5 shift left by one 4
|
||||
add.w d4,d4 shift left by one 4
|
||||
moveq #-128,d3 prepare exponent modifier ($80) 4
|
||||
eor.b d3,d4 adjust arg1 exponent to binary 4
|
||||
eor.b d3,d5 adjust arg2 exponent to binary 4
|
||||
add.b d4,d5 add exponents 4
|
||||
bvs.s ffmouf branch if overflow/underflow 8/10
|
||||
move.b d3,d4 overlay $80 constant into d4 4
|
||||
eor.w d4,d5 d5 now has sign and exponent 4
|
||||
ror.w #1,d5 move to low 8 bits 8
|
||||
swap.w d5 save final s+exp in high word 4
|
||||
move.w d6,d5 copy arg1 low byte 4
|
||||
clr.b d7 clear s+exp out of arg2 4
|
||||
clr.b d5 clear s+exp out of arg1 low byte 4
|
||||
move.w d5,d4 prepare arg1lowb for multiply 4
|
||||
mulu.w d7,d4 d4 = arg2lowb x arg1lowb 38-54 (46)
|
||||
swap.w d4 place result in low word 4
|
||||
move.l d7,d3 copy arg2 4
|
||||
swap.w d3 to arg2highw 4
|
||||
mulu.w d5,d3 d3 = arg1lowb x arg2highw 38-54 (46)
|
||||
add.l d3,d4 d4 = partial product (no carry) 8
|
||||
swap.w d6 to arg1 high two bytes 4
|
||||
move.l d6,d3 copy arg1highw over 4
|
||||
mulu.w d7,d3 d3 = arg2lowb x arg1highw 38-54 (46)
|
||||
add.l d3,d4 d4 = partial product 8
|
||||
clr.w d4 clear low end runoff 4
|
||||
addx.b d4,d4 shift in carry if any 4
|
||||
swap.w d4 put carry into high word 4
|
||||
swap.w d7 now top of arg2 4
|
||||
mulu.w d6,d7 d7 = arg1highw x arg2highw 40-70 (54)
|
||||
swap.w d6 restore arg1 4
|
||||
swap.w d5 restore s+exp to low word
|
||||
add.l d4,d7 add partial products 8
|
||||
bpl ffmnor branch if must normalize 8/10
|
||||
add.l #$80,d7 round up (cannot overflow) 16
|
||||
move.b d5,d7 insert sign and exponent 4
|
||||
beq.s ffmrt0 return zero if zero exponent 8/10
|
||||
ffmrtn rts return to caller 16
|
||||
|
||||
* must normalize result
|
||||
ffmnor sub.b #1,d5 bump exponent down by one 4
|
||||
bvs.s ffmrt0 return zero if underflow 8/10
|
||||
bcs.s ffmrt0 return zero if sign inverted 8/10
|
||||
moveq #$40,d4 rounding factor 4
|
||||
add.l d4,d7 add in rounding factor 8
|
||||
add.l d7,d7 shift to normalize 8
|
||||
bcc.s ffmcln return normalized number 8/10
|
||||
roxr.l #1,d7 rounding forced carry in top bit 10
|
||||
add.b #1,d5 undo normalize attempt 4
|
||||
ffmcln move.b d5,d7 insert sign and exponent 4
|
||||
beq.s ffmrt0 return zero if exponent zero 8/10
|
||||
rts return to caller 16
|
||||
|
||||
* arg1 zero
|
||||
ffmrt0 move.l #0,d7 return zero 4
|
||||
rts return to caller 16
|
||||
|
||||
* overflow or underflow exponent
|
||||
ffmouf bpl.s ffmrt0 branch if underflow to give zero 8/10
|
||||
eor.b d6,d7 calculate proper sign 4
|
||||
or.l #$ffffff7f,d7 force highest value possible 16
|
||||
tst.b d7 set sign in return code
|
||||
* ori.b #$02,ccr set overflow bit
|
||||
dc.l $003c0002 ****sick assembler**** 20
|
||||
rts return to caller 16
|
||||
|
||||
end
|
||||
@@ -0,0 +1,79 @@
|
||||
ttl fast floating point power (ffppwr)
|
||||
***************************************
|
||||
* (c) copyright 1981 by motorola inc. *
|
||||
***************************************
|
||||
|
||||
*************************************************
|
||||
* ffppwr *
|
||||
* fast floating point power function *
|
||||
* *
|
||||
* input: d6 - floating point exponent value *
|
||||
* d7 - floating point argument value *
|
||||
* *
|
||||
* output: d7 - result of the value taken to *
|
||||
* the power specified *
|
||||
* *
|
||||
* all registers but d7 are transparent *
|
||||
* *
|
||||
* code size: 36 bytes stack work: 42 bytes *
|
||||
* *
|
||||
* calls subroutines: ffplog, ffpexp and ffpmul2 *
|
||||
* *
|
||||
* condition codes: *
|
||||
* z - set if the result is zero *
|
||||
* n - cleared *
|
||||
* v - set if overflow occurred or base *
|
||||
* value argument was negative *
|
||||
* c - undefined *
|
||||
* x - undefined *
|
||||
* *
|
||||
* notes: *
|
||||
* 1) a negative base value will force the use*
|
||||
* if its absolute value. the "v" bit will*
|
||||
* be set upon function return. *
|
||||
* 2) if the result overflows then the *
|
||||
* maximum size value is returned with the *
|
||||
* "v" bit set in the condition code. *
|
||||
* 3) spot checks show at least six digit *
|
||||
* precision for 80 percent of the cases. *
|
||||
* *
|
||||
* time: (8mhz no wait states assumed) *
|
||||
* *
|
||||
* the timing is very data sensitive with *
|
||||
* test samples ranging from 720 to *
|
||||
* 1206 microseconds *
|
||||
* *
|
||||
*************************************************
|
||||
page
|
||||
ffppwr idnt 1,1 ffp power
|
||||
|
||||
opt pcs
|
||||
|
||||
section 9
|
||||
|
||||
xdef ffppwr entry point
|
||||
|
||||
xref ffplog,ffpexp exponent and log functions
|
||||
xref ffpmul2 multiply function
|
||||
xref ffpcpyrt copyright stub
|
||||
|
||||
*****************
|
||||
* power entry *
|
||||
*****************
|
||||
|
||||
* take the logorithm of the base value
|
||||
ffppwr tst.b d7 ? negative base value
|
||||
bpl.s fpppos branch positive
|
||||
and.b #$7f,d7 take absolute value
|
||||
bsr.s fpppos find result using that
|
||||
* or.b #$02,ccr force "v" bit on for negative argument
|
||||
dc.l $003c0002 *****assembler error*****
|
||||
rts return to caller
|
||||
|
||||
fpppos bsr ffplog find log of the number to be used
|
||||
movem.l d3-d5,-(sp) save multiply work registers
|
||||
bsr ffpmul2 multiply by the exponent
|
||||
movem.l (sp)+,d3-d5 restore multiply work registers
|
||||
* if overflowed, ffpexp will set "v" bit and return desired result anyway
|
||||
bra ffpexp result is exponent
|
||||
|
||||
281
CPM OPERATING SYSTEMS/CPM 68K/1.0X SOURCES/v101/c/libf/ffpsin.s
Normal file
281
CPM OPERATING SYSTEMS/CPM 68K/1.0X SOURCES/v101/c/libf/ffpsin.s
Normal file
@@ -0,0 +1,281 @@
|
||||
ttl ffp sine cosine tangent (ffpsin/ffpcos/ffptan/ffpsincs)
|
||||
***************************************
|
||||
* (c) copyright 1981 by motorola inc. *
|
||||
***************************************
|
||||
|
||||
*************************************************
|
||||
* ffpsin ffpcos ffptan ffpsincs *
|
||||
* fast floating point sine/cosine/tangent *
|
||||
* *
|
||||
* input: d7 - input argument (radian) *
|
||||
* *
|
||||
* output: d7 - function result *
|
||||
* (ffpsincs also returns d6) *
|
||||
* *
|
||||
* all other registers totally transparent *
|
||||
* *
|
||||
* code size: 334 bytes stack work: 38 bytes *
|
||||
* *
|
||||
* condition codes: *
|
||||
* z - set if result in d7 is zero *
|
||||
* n - set if result in d7 is negative *
|
||||
* c - undefined *
|
||||
* v - set if result is meaningless *
|
||||
* (input magnitude too large) *
|
||||
* x - undefined *
|
||||
* *
|
||||
* functions: *
|
||||
* ffpsin - sine result *
|
||||
* ffpcos - cosine result *
|
||||
* ffptan - tangent result *
|
||||
* ffpsincs - both sine and cosine *
|
||||
* d6 - sin, d7 - cosine *
|
||||
* *
|
||||
* notes: *
|
||||
* 1) input values are in radians. *
|
||||
* 2) function ffpsincs returns both sine *
|
||||
* and cosine twice as fast as calculating *
|
||||
* the two functions independently for *
|
||||
* the same value. this is handy for *
|
||||
* graphics processing. *
|
||||
* 2) input arguments larger than two pi *
|
||||
* suffer reduced precision. the larger *
|
||||
* the argument, the smaller the precision.*
|
||||
* excessively large arguments which have *
|
||||
* less than 5 bits of precision are *
|
||||
* returned unchanged with the "v" bit set.*
|
||||
* 3) for tangent angles of infinite value *
|
||||
* the largest possible positive number *
|
||||
* is returned ($ffffff7f). this still *
|
||||
* gives results well within single *
|
||||
* precision calculation. *
|
||||
* 4) spot checks show errors bounded by *
|
||||
* 4 x 10**-7 but for arguments close to *
|
||||
* pi/2 intervals where 10**-5 is seen. *
|
||||
* *
|
||||
* time: (8mhz no wait states and argument *
|
||||
* assumed within +-pi) *
|
||||
* *
|
||||
* ffpsin 413 microseconds *
|
||||
* ffpcos 409 microseconds *
|
||||
* ffptan 501 microseconds *
|
||||
* ffpsincs 420 microseconds *
|
||||
*************************************************
|
||||
page
|
||||
ffpsin idnt 1,2 ffp sine cosine tangent
|
||||
|
||||
opt pcs
|
||||
|
||||
section 9
|
||||
|
||||
xdef ffpsin,ffpcos,ffptan,ffpsincs entry points
|
||||
|
||||
xref ffptheta inverse tangent table
|
||||
|
||||
xref ffpmul2,ffpdiv,ffpsub multiply, divide and subtract
|
||||
xref ffptnorm transcendental normalize routine
|
||||
xref ffpcpyrt copyright stub
|
||||
|
||||
pi equ $c90fdb42 floating constant pi
|
||||
fixedpi equ $c90fdaa2 pi skeleton to 32 bits precision
|
||||
inv2pi equ $a2f9833e inverse of two-pi
|
||||
kinv equ $9b74ee40 floating k inverse
|
||||
nkfact equ $ec916240 negative k inverse
|
||||
|
||||
********************************************
|
||||
* entry for returning both sine and cosine *
|
||||
********************************************
|
||||
ffpsincs move.w #-2,-(sp) flag both sine and cosine wanted
|
||||
bra.s fpscom enter common code
|
||||
|
||||
**********************
|
||||
* tangent entry point*
|
||||
**********************
|
||||
ffptan move.w #-1,-(sp) flag tangent with minus value
|
||||
bra.s fpschl check very small values
|
||||
|
||||
**************************
|
||||
* cosine only entry point*
|
||||
**************************
|
||||
ffpcos move.w #1,-(sp) flag cosine with positive value
|
||||
bra.s fpscom enter common code
|
||||
|
||||
* negative sine/tangent small value check
|
||||
fpschm cmp.b #$80+$40-8,d7 ? less or same as -2**-9
|
||||
bhi.s fpscom continue if not too small
|
||||
* return argument
|
||||
fpsrti add.l #2,sp rid internal parameter
|
||||
tst.b d7 set condition codes
|
||||
rts return to caller
|
||||
|
||||
************************
|
||||
* sine only entry point*
|
||||
************************
|
||||
ffpsin clr.w -(sp) flag sine with zero
|
||||
* sine and tangent values < 2**-9 return identities
|
||||
fpschl tst.b d7 test sign
|
||||
bmi.s fpschm branch minus
|
||||
cmp.b #$40-8,d7 ? less or same than 2**-9
|
||||
bls.s fpsrti return identity
|
||||
|
||||
* save registers and insure input within + or - pi range
|
||||
fpscom movem.l d1-d6/a0,-(sp) save all work registers
|
||||
move.l d7,d2 copy input over
|
||||
add.b d7,d7 rid sign bit
|
||||
cmp.b #(64+5)<<1,d7 ? abs(arg) < 2**6 (32)
|
||||
bls.s fpsnlr branch yes, not too large
|
||||
* argument is too large to subtract to within range
|
||||
cmp.b #(64+20)<<1,d7 ? test excessive size (>2**20)
|
||||
bls.s fpsgpr no, go ahead and use
|
||||
* error - argument so large result has no precision
|
||||
* or.b #$02,ccr force v bit on
|
||||
dc.l $003c0002 *****assembler error*****
|
||||
movem.l (sp)+,d1-d6/a0 restore registers
|
||||
add.l #2,sp clean internal argument off stack
|
||||
rts return to caller
|
||||
|
||||
* we must find mod(arg,twopi) since argument is too large for subtractions
|
||||
fpsgpr move.l #inv2pi,d6 load up 2*pi inverse constant
|
||||
move.l d2,d7 copy over input argument
|
||||
bsr ffpmul2 divide by 2pi (via multiply inverse)
|
||||
* convert quotient to float integer
|
||||
move.b d7,d5 copy exponent over
|
||||
and.b #$7f,d5 rid sign from exponent
|
||||
sub.b #64+24,d5 find fractional precision
|
||||
neg.b d5 make positive
|
||||
move.l #-1,d4 setup mask of all ones
|
||||
clr.b d4 start zeroes at low byte
|
||||
lsl.l d5,d4 shift zeroes into fractional part
|
||||
or.b #$ff,d4 do not remove sign and exponent
|
||||
and.l d4,d7 strip fractional bits entirely
|
||||
move.l #pi+1,d6 load up 2*pi constant
|
||||
bsr ffpmul2 multiply back out
|
||||
move.l d7,d6 setup to subtract multiple of twopi
|
||||
move.l d2,d7 move argument in
|
||||
bsr ffpsub find remainder of twopi divide
|
||||
move.l d7,d2 use it as new input argument
|
||||
|
||||
* convert argument to binary(31,26) precision for reduction within +-pi
|
||||
fpsnlr move.l #fixedpi>>4,d4 load pi
|
||||
move.l d2,d7 copy float argument
|
||||
clr.b d7 clear sign and exponent
|
||||
tst.b d2 test sign
|
||||
bmi.s fpsnmi branch negative
|
||||
sub.b #64+6,d2 obtain shift value
|
||||
neg.b d2 for 5 bit non-fraction bits
|
||||
cmp.b #31,d2 ? very small number
|
||||
bls.s fpssh1 no, go ahead and shift
|
||||
move.l #0,d7 force to zero
|
||||
fpssh1 lsr.l d2,d7 convert to fixed point
|
||||
* force to +pi or below
|
||||
fpspck cmp.l d4,d7 ? greater than pi
|
||||
ble.s fpsckm branch not
|
||||
sub.l d4,d7 subtract
|
||||
sub.l d4,d7 . twopi
|
||||
bra.s fpspck and check again
|
||||
|
||||
fpsnmi sub.b #$80+64+6,d2 rid sign and get shift value
|
||||
neg.b d2 for 5 non-fractional bits
|
||||
cmp.b #31,d2 ? very small number
|
||||
bls.s fpssh2 no, go ahead and shift
|
||||
move.l #0,d7 force to zero
|
||||
fpssh2 lsr.l d2,d7 convert to fixed point
|
||||
neg.l d7 make negative
|
||||
neg.l d4 make -pi
|
||||
* force to -pi or above
|
||||
fpsnck cmp.l d4,d7 ? less than -pi
|
||||
bge.s fpsckm branch not
|
||||
sub.l d4,d7 add
|
||||
sub.l d4,d7 . twopi
|
||||
bra.s fpsnck and check again
|
||||
|
||||
*****************************************
|
||||
* cordic calculation registers: *
|
||||
* d1 - loop count a0 - table pointer *
|
||||
* d2 - shift count *
|
||||
* d3 - x' d5 - x *
|
||||
* d4 - y' d6 - y *
|
||||
* d7 - test argument *
|
||||
*****************************************
|
||||
|
||||
* input within range, now start cordic setup
|
||||
fpsckm move.l #0,d5 x=0
|
||||
move.l #nkfact,d6 y=negative inverse k factor seed
|
||||
move.l #fixedpi>>2,d4 setup fixed pi/2 constant
|
||||
asl.l #3,d7 now to binary(31,29) precision
|
||||
bmi.s fpsap2 branch if minus to add pi/2
|
||||
neg.l d6 y=positive inverse k factor seed
|
||||
neg.l d4 subtract pi/2 for positive argument
|
||||
fpsap2 add.l d4,d7 add constant
|
||||
lea ffptheta,a0 load arctangent table
|
||||
move.l #23,d1 loop 24 times
|
||||
move.l #-1,d2 prime shift counter
|
||||
* cordic loop
|
||||
fsinlp add.w #1,d2 increment shift count
|
||||
move.l d5,d3 copy x
|
||||
move.l d6,d4 copy y
|
||||
asr.l d2,d3 shift for x'
|
||||
asr.l d2,d4 shift for y'
|
||||
tst.l d7 test arg value
|
||||
bmi.s fsbmi branch minus test
|
||||
sub.l d4,d5 x=x-y'
|
||||
add.l d3,d6 y=y+x'
|
||||
sub.l (a0)+,d7 arg=arg-table(n)
|
||||
dbra d1,fsinlp loop until done
|
||||
bra.s fscom enter common code
|
||||
fsbmi add.l d4,d5 x=x+y'
|
||||
sub.l d3,d6 y=y-x'
|
||||
add.l (a0)+,d7 arg=arg+table(n)
|
||||
dbra d1,fsinlp loop until done
|
||||
|
||||
* now split up tangent and ffpsincs from sine and cosine
|
||||
fscom move.w 7*4(sp),d1 reload internal parameter
|
||||
bpl.s fssincos branch for sine or cosine
|
||||
|
||||
add.b #1,d1 see if was -1 for tangent
|
||||
bne.s fsdual no, must be both sin and cosine
|
||||
* tangent finish
|
||||
bsr.s fsfloat float y (sin)
|
||||
move.l d6,d7 setup for divide into
|
||||
move.l d5,d6 prepare x
|
||||
bsr.s fsfloat float x (cos)
|
||||
beq.s fstinf branch infinite result
|
||||
bsr ffpdiv tangent = sin/cos
|
||||
fsinfrt movem.l (sp)+,d1-d6/a0 restore registers
|
||||
add.l #2,sp delete internal parameter
|
||||
rts return to caller
|
||||
* tangent is infinite. return maximum positive number.
|
||||
fstinf move.l #$ffffff7f,d7 largest ffp number
|
||||
bra.s fsinfrt and clean up
|
||||
|
||||
* sine and cosine
|
||||
fssincos beq.s fssine branch if sine
|
||||
move.l d5,d6 use x for cosine
|
||||
fssine bsr.s fsfloat convert to float
|
||||
move.l d6,d7 return result
|
||||
tst.b d7 and condition code test
|
||||
movem.l (sp)+,d1-d6/a0 restore registers
|
||||
add.l #2,sp delete internal parameter
|
||||
rts return to caller
|
||||
|
||||
* both sine and cosine
|
||||
fsdual move.l d5,-(sp) save cosine derivitive
|
||||
bsr.s fsfloat convert sine derivitive to float
|
||||
move.l d6,6*4(sp) place sine into saved d6
|
||||
move.l (sp)+,d6 restore cosine derivitive
|
||||
bra.s fssine and continue restoring sine on the sly
|
||||
|
||||
* fsfloat - float internal precision but truncate to zero if < 2**-21
|
||||
fsfloat move.l d6,d4 copy internal precision value
|
||||
bmi.s fsfneg branch negative
|
||||
cmp.l #$000000ff,d6 ? test magnitude
|
||||
bhi ffptnorm normalize if not too small
|
||||
fsfzro move.l #0,d6 return a zero
|
||||
rts return to caller
|
||||
fsfneg asr.l #8,d4 see if all ones bits 8-31
|
||||
add.l #1,d4 ? goes to zero
|
||||
bne ffptnorm normalize if not too small
|
||||
bra.s fsfzro return zero
|
||||
|
||||
|
||||
end
|
||||
112
CPM OPERATING SYSTEMS/CPM 68K/1.0X SOURCES/v101/c/libf/ffpsqrt.s
Normal file
112
CPM OPERATING SYSTEMS/CPM 68K/1.0X SOURCES/v101/c/libf/ffpsqrt.s
Normal file
@@ -0,0 +1,112 @@
|
||||
ttl fast floating point square root (ffpsqrt)
|
||||
*******************************************
|
||||
* (c) copyright 1981 by motorola inc. *
|
||||
*******************************************
|
||||
|
||||
********************************************
|
||||
* ffpsqrt subroutine *
|
||||
* *
|
||||
* input: *
|
||||
* d7 - floating point argument *
|
||||
* *
|
||||
* output: *
|
||||
* d7 - floating point square root *
|
||||
* *
|
||||
* condition codes: *
|
||||
* *
|
||||
* n - cleared *
|
||||
* z - set if result is zero *
|
||||
* v - set if argument was negative*
|
||||
* c - cleared *
|
||||
* x - undefined *
|
||||
* *
|
||||
* registers d3 thru d6 are volatile *
|
||||
* *
|
||||
* code: 194 bytes stack work: 4 bytes *
|
||||
* *
|
||||
* notes: *
|
||||
* 1) no overflows or underflows can *
|
||||
* occur. *
|
||||
* 2) a negative argument causes the *
|
||||
* absolute value to be used and the *
|
||||
* "v" bit set to indicate that a *
|
||||
* negative square root was attempted. *
|
||||
* *
|
||||
* times: *
|
||||
* argument zero 3.50 microseconds *
|
||||
* minimum time > 0 187.50 microseconds *
|
||||
* average time > 0 193.75 microseconds *
|
||||
* maximum time > 0 200.00 microseconds *
|
||||
********************************************
|
||||
page
|
||||
ffpsqrt idnt 1,1 ffp square root
|
||||
|
||||
section 9
|
||||
|
||||
xdef ffpsqrt entry point
|
||||
xref ffpcpyrt copyright notice
|
||||
|
||||
* negative argument handler
|
||||
fpsinv and.b #$7f,d7 take absolute value
|
||||
bsr.s ffpsqrt find sqrt(abs(x))
|
||||
* or.b $02,ccr set "v" bit
|
||||
dc.l $003c0002 **assembler error**
|
||||
rts return to caller
|
||||
|
||||
*********************
|
||||
* square root entry *
|
||||
*********************
|
||||
ffpsqrt move.b d7,d3 copy s+exponent over
|
||||
beq.s fpsrtn return zero if zero argument
|
||||
bmi.s fpsinv negative, reject with special condition codes
|
||||
lsr.b #1,d3 divide exponent by two
|
||||
bcc.s fpseven branch exponent was even
|
||||
add.b #1,d3 adjust odd values up by one
|
||||
lsr.l #1,d7 offset odd exponent's mantissa one bit
|
||||
fpseven add.b #$20,d3 renormalize exponent
|
||||
swap.w d3 save result s+exp for final move
|
||||
move.w #23,d3 setup loop for 24 bit generation
|
||||
lsr.l #7,d7 prepare first test value
|
||||
move.l d7,d4 d4 - previous value during loop
|
||||
move.l d7,d5 d5 - new test value during loop
|
||||
move.l a0,d6 save address register
|
||||
lea fpstbl(pc),a0 load table address
|
||||
move.l #$00800000,d7 d7 - initial result (must be a one)
|
||||
sub.l d7,d4 preset old value in case zero bit next
|
||||
sub.l #$01200000,d5 combine first loop calculations
|
||||
bra.s fpsent go enter loop calculations
|
||||
|
||||
* square root calculation
|
||||
* this is an optimized scheme for the recursive square root algorithm:
|
||||
*
|
||||
* step n+1:
|
||||
* test value <= .0 0 0 r r r 0 1 then generate a one in result r
|
||||
* n 2 1 n 2 1 else a zero in result r n+1
|
||||
* n+1
|
||||
* precalculations are done such that the entry is midway into step 2
|
||||
|
||||
fpsone bset d3,d7 insert a one into this position
|
||||
move.l d5,d4 update new test value
|
||||
fpszero add.l d4,d4 multiply test result by two
|
||||
move.l d4,d5 copy in case next bit zero
|
||||
sub.l (a0)+,d5 subtract the '01' ending pattern
|
||||
sub.l d7,d5 subtract result bits collected so far
|
||||
fpsent dbmi d3,fpsone branch if a one generated in the result
|
||||
dbpl d3,fpszero branch if a zero generated
|
||||
|
||||
* all 24 bits calculated. now test result of 25th bit
|
||||
bls.s fpsfin branch next bit zero, no rounding
|
||||
add.l #1,d7 round up (cannot overflow)
|
||||
fpsfin lsl.l #8,d7 normalize result
|
||||
move.l d6,a0 restore address register
|
||||
swap.w d3 restore s+exp save
|
||||
move.b d3,d7 move in final sign+exponent
|
||||
fpsrtn rts return to caller
|
||||
|
||||
* table to furnish '01' shifts during the algorithm loop
|
||||
fpstbl dc.l 1<<20,1<<19,1<<18,1<<17,1<<16,1<<15
|
||||
dc.l 1<<14,1<<13,1<<12,1<<11,1<<10,1<<9,1<<8
|
||||
dc.l 1<<7,1<<6,1<<5,1<<4,1<<3,1<<2,1<<1,1<<0
|
||||
dc.l 0,0
|
||||
|
||||
end
|
||||
@@ -0,0 +1,50 @@
|
||||
ttl arctangent cordic table - ffptheta
|
||||
ffptheta idnt 1,1 ffp arctangent table
|
||||
***************************************
|
||||
* (c) copyright 1981 by motorola inc. *
|
||||
***************************************
|
||||
|
||||
section 9
|
||||
|
||||
xdef ffptheta external definition
|
||||
|
||||
*********************************************************
|
||||
* arctangent table for cordic *
|
||||
* *
|
||||
* the following table is used during cordic *
|
||||
* transcendental evaluations for sine, cosine, and *
|
||||
* tangent and represents arctangent values 2**-n where *
|
||||
* n ranges from 0 to 24. the format is binary(31,29) *
|
||||
* precision (i.e. the binary point is between bits *
|
||||
* 28 and 27 giving two leading non-fraction bits.) *
|
||||
*********************************************************
|
||||
|
||||
ffptheta dc.l $c90fdaa2>>3 arctan(2**0)
|
||||
dc.l $76b19c15>>3 arctan(2**-1)
|
||||
dc.l $3eb6ebf2>>3 arctan(2**-2)
|
||||
dc.l $1fd5ba9a>>3 arctan(2**-3)
|
||||
dc.l $0ffaaddb>>3 arctan(2**-4)
|
||||
dc.l $07ff556e>>3 arctan(2**-5)
|
||||
dc.l $03ffeaab>>3 arctan(2**-6)
|
||||
dc.l $01fffd55>>3 arctan(2**-7)
|
||||
dc.l $00ffffaa>>3 arctan(2**-8)
|
||||
dc.l $007ffff5>>3 arctan(2**-9)
|
||||
dc.l $003ffffe>>3 arctan(2**-10)
|
||||
dc.l $001fffff>>3 arctan(2**-11)
|
||||
dc.l $000fffff>>3 arctan(2**-12)
|
||||
dc.l $0007ffff>>3 arctan(2**-13)
|
||||
dc.l $0003ffff>>3 arctan(2**-14)
|
||||
dc.l $0001ffff>>3 arctan(2**-15)
|
||||
dc.l $0000ffff>>3 arctan(2**-16)
|
||||
dc.l $00007fff>>3 arctan(2**-17)
|
||||
dc.l $00003fff>>3 arctan(2**-18)
|
||||
dc.l $00001fff>>3 arctan(2**-19)
|
||||
dc.l $00000fff>>3 arctan(2**-20)
|
||||
dc.l $000007ff>>3 arctan(2**-21)
|
||||
dc.l $000003ff>>3 arctan(2**-22)
|
||||
dc.l $000001ff>>3 arctan(2**-23)
|
||||
dc.l $000000ff>>3 arctan(2**-24)
|
||||
dc.l $0000007f>>3 arctan(2**-25)
|
||||
dc.l $0000003f>>3 arctan(2**-26)
|
||||
|
||||
end
|
||||
@@ -0,0 +1,51 @@
|
||||
ttl ffp transcendental normalize internal routine (ffptnorm)
|
||||
ffptnorm idnt 1,2 ffp transcendental internal normalize
|
||||
|
||||
xdef ffptnorm
|
||||
section 9
|
||||
|
||||
***************************************
|
||||
* (c) copyright 1981 by motorola inc. *
|
||||
***************************************
|
||||
|
||||
******************************
|
||||
* ffptnorm *
|
||||
* normalize bin(29,31) value *
|
||||
* and convert to float *
|
||||
* *
|
||||
* input: d6 - internal fixed *
|
||||
* output: d6 - ffp float *
|
||||
* cc - reflect value *
|
||||
* notes: *
|
||||
* 1) d4 is destroyed. *
|
||||
* *
|
||||
* time: (8mhz no wait state) *
|
||||
* zero 4.0 microsec. *
|
||||
* avg else 17.0 microsec. *
|
||||
* *
|
||||
******************************
|
||||
|
||||
|
||||
ffptnorm move.l #$42,d4 setup initial exponent
|
||||
tst.l d6 test for non-negative
|
||||
beq.s fsfrtn return if zero
|
||||
bpl.s fsfpls branch is >= 0
|
||||
neg.l d6 absolutize input
|
||||
move.b #$c2,d4 setup initial negative exponent
|
||||
fsfpls cmp.l #$00007fff,d6 test for a small number
|
||||
bhi.s fsfcont branch if not small
|
||||
swap.w d6 swap halves
|
||||
sub.b #16,d4 offset by 16 shifts
|
||||
fsfcont add.l d6,d6 shift another bit
|
||||
dbmi d4,fsfcont shift left until normalized
|
||||
tst.b d6 ? should we round up
|
||||
bpl.s fsfnrm no, branch rounded
|
||||
add.l #$100,d6 round up
|
||||
bcc.s fsfnrm branch no overflow
|
||||
roxr.l #1,d6 adjust back for bit in 31
|
||||
add.b #1,d4 make up for last shift right
|
||||
fsfnrm move.b d4,d6 insert sign+exponent
|
||||
fsfrtn rts return to caller
|
||||
|
||||
|
||||
end
|
||||
@@ -0,0 +1,48 @@
|
||||
/*
|
||||
Copyright 1982
|
||||
Alcyon Corporation
|
||||
8716 Production Ave.
|
||||
San Diego, Ca. 92121
|
||||
*/
|
||||
|
||||
/*char *version "@(#) _ffptof - Feb 1, 1983"; */
|
||||
|
||||
/*
|
||||
* FFP Floating Point Representation to Internal Representation :
|
||||
* FFP Standard Single Precision Representation Floating Point
|
||||
*
|
||||
* float
|
||||
* ffptof(lf)
|
||||
* long lf;
|
||||
*
|
||||
* Largest positive number is 3.4 * 10^18 and the smallest positive
|
||||
* number is 1.2 * 10^-20.
|
||||
* Rely's on the fact that a long and a float are both 32 bits.
|
||||
*/
|
||||
|
||||
float
|
||||
ffptof(lf)
|
||||
long lf;
|
||||
{
|
||||
register int exp, count, fsign;
|
||||
float f;
|
||||
|
||||
if (lf == 0L)
|
||||
return(0.0);
|
||||
fsign = (lf & 0x80);
|
||||
exp = (lf & 0x7f) - 0x40;
|
||||
lf = (lf>>8) & 0xffffff; /* 24 bits of fraction */
|
||||
f = lf;
|
||||
f = f / 16777216.0; /* 2 ^ 24 */
|
||||
while (exp < 0) { /* negative exp : 2^-? */
|
||||
f = f / 2.0;
|
||||
exp++;
|
||||
}
|
||||
while (exp > 0) { /* positive exp : 2^+? */
|
||||
f = f * 2.0;
|
||||
exp--;
|
||||
}
|
||||
if (fsign)
|
||||
f = -f;
|
||||
return(f);
|
||||
}
|
||||
@@ -0,0 +1,26 @@
|
||||
/*
|
||||
Copyright 1983
|
||||
Alcyon Corporation
|
||||
8716 Production Ave.
|
||||
San Diego, Ca. 92121
|
||||
*/
|
||||
|
||||
/*char *version "@(#) floor - Feb 11, 1983";
|
||||
|
||||
/* floor - returns the largest integer (as a double precision
|
||||
number) not greater than x. */
|
||||
|
||||
double
|
||||
floor(x)
|
||||
double x;
|
||||
{
|
||||
register long i;
|
||||
double retval;
|
||||
|
||||
if ( x < 0 )
|
||||
x -= 0.99999999999999;
|
||||
i = x;
|
||||
retval = i;
|
||||
return( retval );
|
||||
}
|
||||
|
||||
@@ -0,0 +1,34 @@
|
||||
/*
|
||||
Copyright 1983
|
||||
Alcyon Corporation
|
||||
8716 Production Ave.
|
||||
San Diego, Ca. 92121
|
||||
*/
|
||||
|
||||
/*char *version "@(#) fmod - Feb 11, 1983";
|
||||
|
||||
/* fmod - returns the number f such that x = iy + f, and
|
||||
0 <= f <= y. */
|
||||
|
||||
double
|
||||
fmod(x,y)
|
||||
double x;
|
||||
double y;
|
||||
{
|
||||
double z;
|
||||
double retval;
|
||||
register long i;
|
||||
double fabs();
|
||||
double absx;
|
||||
double absy;
|
||||
|
||||
absx = fabs(x);
|
||||
absy = fabs(y);
|
||||
for(z = absx; z - absy >= 0. ; z -= absy)
|
||||
;
|
||||
i = z;
|
||||
if( x < 0.0 )
|
||||
i *= -1;
|
||||
retval = i;
|
||||
return( retval );
|
||||
}
|
||||
@@ -0,0 +1,26 @@
|
||||
*
|
||||
* Floating Point Addition :
|
||||
* Front End to FFP Floating Point Package.
|
||||
*
|
||||
* double
|
||||
* fpadd(addend,adder)
|
||||
* double addend, adder;
|
||||
*
|
||||
* Returns : Sum of two floating point numbers
|
||||
*
|
||||
.globl fpadd
|
||||
.globl _fpadd
|
||||
.globl ffpadd
|
||||
.text
|
||||
fpadd:
|
||||
_fpadd:
|
||||
~~fpadd:
|
||||
link r14,#-4
|
||||
movem.l d3-d7,-(sp)
|
||||
move.l 8(r14),r7
|
||||
move.l 12(r14),r6
|
||||
jsr ffpadd
|
||||
move.l r7,r0
|
||||
movem.l (sp)+,d3-d7
|
||||
unlk r14
|
||||
rts
|
||||
@@ -0,0 +1,25 @@
|
||||
*
|
||||
* Floating Point Compare :
|
||||
* Front End to FFP Floating Point Package.
|
||||
*
|
||||
* int
|
||||
* fpcmp(source,dest)
|
||||
* double source, dest;
|
||||
*
|
||||
* Returns : Condition codes based on Floating Point Compare
|
||||
*
|
||||
.globl fpcmp
|
||||
.globl _fpcmp
|
||||
.globl ffpcmp
|
||||
.text
|
||||
fpcmp:
|
||||
_fpcmp:
|
||||
~~fpcmp:
|
||||
link r14,#-4
|
||||
movem.l d3-d7,-(sp)
|
||||
move.l 8(r14),r7
|
||||
move.l 12(r14),r6
|
||||
jsr ffpcmp
|
||||
movem.l (sp)+,d3-d7
|
||||
unlk r14
|
||||
rts
|
||||
@@ -0,0 +1,26 @@
|
||||
*
|
||||
* Floating Point Cosine :
|
||||
* Front End to FFP Floating Point Package.
|
||||
*
|
||||
* double
|
||||
* cos(farg)
|
||||
* double farg;
|
||||
*
|
||||
* Input : in radians
|
||||
* Returns : cosine of Floating point number
|
||||
*
|
||||
.globl cos
|
||||
.globl _cos
|
||||
.globl ffpcos
|
||||
.text
|
||||
cos:
|
||||
_cos:
|
||||
~~cos:
|
||||
link r14,#-4
|
||||
movem.l d3-d7,-(sp)
|
||||
move.l 8(r14),r7
|
||||
jsr ffpcos
|
||||
move.l r7,r0
|
||||
movem.l (sp)+,d3-d7
|
||||
unlk r14
|
||||
rts
|
||||
@@ -0,0 +1,26 @@
|
||||
*
|
||||
* Floating Point Division :
|
||||
* Front End to FFP Floating Point Package.
|
||||
*
|
||||
* double
|
||||
* fpdiv(divisor,dividend)
|
||||
* double divisor, dividend;
|
||||
*
|
||||
* Return : Floating Point Quotient
|
||||
*
|
||||
.globl fpdiv
|
||||
.globl _fpdiv
|
||||
.globl ffpdiv
|
||||
.text
|
||||
fpdiv:
|
||||
_fpdiv:
|
||||
~~fpdiv:
|
||||
link r14,#-4
|
||||
movem.l d3-d7,-(sp)
|
||||
move.l 8(r14),r7
|
||||
move.l 12(r14),r6
|
||||
jsr ffpdiv
|
||||
move.l r7,r0
|
||||
movem.l (sp)+,d3-d7
|
||||
unlk r14
|
||||
rts
|
||||
@@ -0,0 +1,25 @@
|
||||
*
|
||||
* Floating Point Exponent :
|
||||
* Front End to FFP Floating Point Package.
|
||||
*
|
||||
* double
|
||||
* exp(x)
|
||||
* double x;
|
||||
*
|
||||
* Returns : e ^ x (where e = 2.718...)
|
||||
*
|
||||
.globl exp
|
||||
.globl _exp
|
||||
.globl ffpexp
|
||||
.text
|
||||
exp:
|
||||
_exp:
|
||||
~~exp:
|
||||
link r14,#-4
|
||||
movem.l d7,-(sp)
|
||||
move.l 8(r14),r7
|
||||
jsr ffpexp
|
||||
move.l r7,r0
|
||||
movem.l (sp)+,d7
|
||||
unlk r14
|
||||
rts
|
||||
@@ -0,0 +1,27 @@
|
||||
*
|
||||
* Floating Point Float to Long Routine :
|
||||
* Front End to FFP Floating Point Package.
|
||||
*
|
||||
* long
|
||||
* fpftol(fparg)
|
||||
* double fparg;
|
||||
*
|
||||
* Condition Codes : V bit signifies Overflow
|
||||
*
|
||||
* Return : Fixed Point representation of Floating Point Number
|
||||
*
|
||||
.globl fpftol
|
||||
.globl _fpftol
|
||||
.globl ffpfpi
|
||||
.text
|
||||
fpftol:
|
||||
_fpftol:
|
||||
~~fpftol:
|
||||
link r14,#-4
|
||||
movem.l d3-d7,-(sp)
|
||||
move.l 8(r14),r7
|
||||
jsr ffpfpi
|
||||
move.l r7,r0
|
||||
movem.l (sp)+,d3-d7
|
||||
unlk r14
|
||||
rts
|
||||
@@ -0,0 +1,25 @@
|
||||
*
|
||||
* Floating Point Logarithm :
|
||||
* Front End to FFP Floating Point Package.
|
||||
*
|
||||
* double
|
||||
* log(x)
|
||||
* double x;
|
||||
*
|
||||
* Returns : the floating point logarithm
|
||||
*
|
||||
.globl log
|
||||
.globl _log
|
||||
.globl ffplog
|
||||
.text
|
||||
log:
|
||||
_log:
|
||||
~~log:
|
||||
link r14,#-4
|
||||
movem.l d7,-(sp)
|
||||
move.l 8(r14),r7
|
||||
jsr ffplog
|
||||
move.l r7,r0
|
||||
movem.l (sp)+,d7
|
||||
unlk r14
|
||||
rts
|
||||
@@ -0,0 +1,25 @@
|
||||
*
|
||||
* Floating Point Long to Float Routine :
|
||||
* Front End to FFP Floating Point Package.
|
||||
*
|
||||
* double
|
||||
* fpltof(larg)
|
||||
* long larg;
|
||||
*
|
||||
* Return : Floating Point representation of Long Fixed point integer
|
||||
*
|
||||
.globl fpltof
|
||||
.globl _fpltof
|
||||
.globl ffpifp
|
||||
.text
|
||||
fpltof:
|
||||
_fpltof:
|
||||
~~fpltof:
|
||||
link r14,#-4
|
||||
movem.l d3-d7,-(sp)
|
||||
move.l 8(r14),r7
|
||||
jsr ffpifp
|
||||
move.l r7,r0
|
||||
movem.l (sp)+,d3-d7
|
||||
unlk r14
|
||||
rts
|
||||
@@ -0,0 +1,30 @@
|
||||
*
|
||||
* Floating Point Multiplication :
|
||||
* Front End to FFP Floating Point Package.
|
||||
*
|
||||
* double
|
||||
* fpmul(multiplier,multiplicand)
|
||||
* double multiplier, multiplicand;
|
||||
*
|
||||
* Return : Result of Floating Point Multiply
|
||||
*
|
||||
.globl fpmul
|
||||
.globl _fpmul
|
||||
.globl fpmult
|
||||
.globl _fpmult
|
||||
.globl ffpmul2
|
||||
.text
|
||||
fpmult:
|
||||
_fpmult:
|
||||
fpmul:
|
||||
_fpmul:
|
||||
~~fpmul:
|
||||
link r14,#-4
|
||||
movem.l d3-d7,-(sp)
|
||||
move.l 8(r14),r7
|
||||
move.l 12(r14),r6
|
||||
jsr ffpmul2
|
||||
move.l r7,r0
|
||||
movem.l (sp)+,d3-d7
|
||||
unlk r14
|
||||
rts
|
||||
@@ -0,0 +1,25 @@
|
||||
*
|
||||
* Floating Point Negation :
|
||||
* Front End to FFP Floating Point Package.
|
||||
*
|
||||
* double
|
||||
* fpneg(farg)
|
||||
* double farg;
|
||||
*
|
||||
* Returns : negated Floating point number
|
||||
*
|
||||
.globl fpneg
|
||||
.globl _fpneg
|
||||
.globl ffpneg
|
||||
.text
|
||||
fpneg:
|
||||
_fpneg:
|
||||
~~fpneg:
|
||||
link r14,#-4
|
||||
movem.l d3-d7,-(sp)
|
||||
move.l 8(r14),r7
|
||||
jsr ffpneg
|
||||
move.l r7,r0
|
||||
movem.l (sp)+,d3-d7
|
||||
unlk r14
|
||||
rts
|
||||
@@ -0,0 +1,26 @@
|
||||
*
|
||||
* Floating Point Power :
|
||||
* Front End to FFP Floating Point Package.
|
||||
*
|
||||
* double
|
||||
* pow(x,y)
|
||||
* double x, y;
|
||||
*
|
||||
* Returns : x ^ y
|
||||
*
|
||||
.globl pow
|
||||
.globl _pow
|
||||
.globl ffppwr
|
||||
.text
|
||||
pow:
|
||||
_pow:
|
||||
~~pow:
|
||||
link r14,#-4
|
||||
movem.l d3-d7,-(sp)
|
||||
move.l 8(r14),r7
|
||||
move.l 12(r14),r6
|
||||
jsr ffppwr
|
||||
move.l r7,r0
|
||||
movem.l (sp)+,d3-d7
|
||||
unlk r14
|
||||
rts
|
||||
@@ -0,0 +1,26 @@
|
||||
*
|
||||
* Floating Point Sine :
|
||||
* Front End to FFP Floating Point Package.
|
||||
*
|
||||
* double
|
||||
* sin(farg)
|
||||
* double farg;
|
||||
*
|
||||
* Input : in radians
|
||||
* Returns : sine of Floating point number
|
||||
*
|
||||
.globl sin
|
||||
.globl _sin
|
||||
.globl ffpsin
|
||||
.text
|
||||
sin:
|
||||
_sin:
|
||||
~~sin:
|
||||
link r14,#-4
|
||||
movem.l d3-d7,-(sp)
|
||||
move.l 8(r14),r7
|
||||
jsr ffpsin
|
||||
move.l r7,r0
|
||||
movem.l (sp)+,d3-d7
|
||||
unlk r14
|
||||
rts
|
||||
@@ -0,0 +1,26 @@
|
||||
*
|
||||
* Floating Point Square Root :
|
||||
* Front End to FFP Floating Point Package.
|
||||
*
|
||||
* double
|
||||
* sqrt(farg)
|
||||
* double farg;
|
||||
*
|
||||
* Input : in radians
|
||||
* Returns : square root of Floating point number
|
||||
*
|
||||
.globl sqrt
|
||||
.globl _sqrt
|
||||
.globl ffpsqrt
|
||||
.text
|
||||
sqrt:
|
||||
_sqrt:
|
||||
~~sqrt:
|
||||
link r14,#-4
|
||||
movem.l d3-d7,-(sp)
|
||||
move.l 8(r14),r7
|
||||
jsr ffpsqrt
|
||||
move.l r7,r0
|
||||
movem.l (sp)+,d3-d7
|
||||
unlk r14
|
||||
rts
|
||||
@@ -0,0 +1,26 @@
|
||||
*
|
||||
* Floating Point Subtraction :
|
||||
* Front End to FFP Floating Point Package.
|
||||
*
|
||||
* double
|
||||
* fpsub(subtrahend,minuend)
|
||||
* double subtrahend, minuend;
|
||||
*
|
||||
* Returns : Floating point subtraction result
|
||||
*
|
||||
.globl fpsub
|
||||
.globl _fpsub
|
||||
.globl ffpsub
|
||||
.text
|
||||
fpsub:
|
||||
_fpsub:
|
||||
~~fpsub:
|
||||
link r14,#-4
|
||||
movem.l d3-d7,-(sp)
|
||||
move.l 8(r14),r7
|
||||
move.l 12(r14),r6
|
||||
jsr ffpsub
|
||||
move.l r7,r0
|
||||
movem.l (sp)+,d3-d7
|
||||
unlk r14
|
||||
rts
|
||||
@@ -0,0 +1,79 @@
|
||||
/*
|
||||
Copyright 1982
|
||||
Alcyon Corporation
|
||||
8716 Production Ave.
|
||||
San Diego, Ca. 92121
|
||||
*/
|
||||
|
||||
/*char *version "@(#) ftoa - jan 24, 1982"; */
|
||||
|
||||
/*
|
||||
* FFP Floating Point to Ascii String Conversion Routine :
|
||||
* FFP Standard Single Precision Representation Floating Point
|
||||
*
|
||||
* char *
|
||||
* ftoa(f,buf,prec)
|
||||
* float f;
|
||||
* char *buf;
|
||||
* int prec;
|
||||
*
|
||||
* No more than 9 decimal digits are allowed in single precision.
|
||||
* Largest positive number is 3.4 * 10^33 and the smallest positive
|
||||
* number is 1.2 * 10^-38.
|
||||
* Rely's on the fact that a long and a float are both 32 bits.
|
||||
*/
|
||||
|
||||
#define BIAS 127L
|
||||
|
||||
float ffptof();
|
||||
|
||||
char *
|
||||
ftoa(fl,buf,prec)
|
||||
long fl; /* ffp formatted float */
|
||||
char *buf;
|
||||
int prec;
|
||||
{
|
||||
register char *bp;
|
||||
register int exp, digit;
|
||||
float f;
|
||||
|
||||
prec = (prec <= 0) ? 1 : (prec <= 9) ? prec : 9;
|
||||
bp = buf;
|
||||
f = ffptof(fl); /* get floating point value */
|
||||
if (f < 0.0) { /* negative float */
|
||||
*bp++ = '-';
|
||||
f = -f; /* make it positive */
|
||||
}
|
||||
if (f == 0.0) {
|
||||
*bp++ = '0'; *bp++ = '.';
|
||||
while (prec--)
|
||||
*bp++ = '0';
|
||||
*bp = 0;
|
||||
return(buf);
|
||||
}
|
||||
for (exp=0; f < 1.0; f = f * 10.0) /* get negative exp */
|
||||
exp--;
|
||||
for ( ; f >= 1.0; f = f / 10.0) /* 0.XXXXXXE00 * 10^exp */
|
||||
exp++;
|
||||
|
||||
if (exp<=0) /* one significant digit */
|
||||
*bp++ = '0';
|
||||
for ( ; exp>0; exp--) { /* get significant digits */
|
||||
f = f * 10.0;
|
||||
digit = f; /* get one digit */
|
||||
f = f - digit;
|
||||
*bp++ = digit + '0';
|
||||
}
|
||||
*bp++ = '.';
|
||||
for( ; exp<0 && prec; prec--, exp++) /* exp < 0 ? */
|
||||
*bp++ = '0';
|
||||
while(prec-- > 0) {
|
||||
f = f * 10.0;
|
||||
digit = f; /* get one digit */
|
||||
f = f - digit;
|
||||
*bp++ = digit + '0';
|
||||
}
|
||||
*bp = 0;
|
||||
return(buf);
|
||||
}
|
||||
|
||||
@@ -0,0 +1,49 @@
|
||||
/*
|
||||
Copyright 1982
|
||||
Alcyon Corporation
|
||||
8716 Production Ave.
|
||||
San Diego, Ca. 92121
|
||||
*/
|
||||
|
||||
/*char *version "@(#) fptoffp - Feb 1, 1983"; */
|
||||
|
||||
/*
|
||||
* Floating Point to FFP Floating Point Routine :
|
||||
* FFP Standard Single Precision Representation Floating Point
|
||||
*
|
||||
* long
|
||||
* fptoffp(f)
|
||||
* float f;
|
||||
*
|
||||
* Rely's on the fact that a long and a float are both 32 bits.
|
||||
*/
|
||||
|
||||
long
|
||||
fptoffp(f) /* convert current machine float to ffp rep */
|
||||
float f; /* unsigned input, guaranteed positive */
|
||||
{
|
||||
register int exp, count, sign;
|
||||
long l;
|
||||
|
||||
if (f == 0.0)
|
||||
return(0L);
|
||||
if (f < 0.0) {
|
||||
f = -f;
|
||||
sign = 1;
|
||||
}
|
||||
else
|
||||
sign = 0;
|
||||
exp = 0L;
|
||||
for( ; f >= 1.0; f = f / 2.0)
|
||||
exp++;
|
||||
for( ; f < 0.5; f = f * 2.0)
|
||||
exp--;
|
||||
f = f * 16777216.0; /* 2 ^ 24 */
|
||||
l = f;
|
||||
l =<< 8;
|
||||
exp =+ 0x40;
|
||||
l =| (exp & 0x7f);
|
||||
if (sign)
|
||||
l =| 0x80;
|
||||
return(l);
|
||||
}
|
||||
@@ -0,0 +1,43 @@
|
||||
/*
|
||||
Copyright 1982
|
||||
Alcyon Corporation
|
||||
8716 Production Ave.
|
||||
San Diego, Ca. 92121
|
||||
*/
|
||||
|
||||
/* char *version "@(#) ftol - Feb 1, 1983"; */
|
||||
|
||||
/*
|
||||
* Floating Point Float to Long Routine :
|
||||
* Front End to IEEE Floating Point Package.
|
||||
*
|
||||
* long
|
||||
* fpftol(fparg)
|
||||
* double fparg;
|
||||
*
|
||||
* Return : Fixed Point representation of Floating Point Number
|
||||
*/
|
||||
|
||||
long
|
||||
fpftol(f)
|
||||
long f;
|
||||
{
|
||||
register long l;
|
||||
register int exp, sign;
|
||||
|
||||
exp = (f & 0x7f) - 0x40;
|
||||
if (f == 0L || exp < 0) /* underflow or 0 */
|
||||
return(0L);
|
||||
sign = (f & 0x80);
|
||||
if (exp > 31) /* overflow */
|
||||
return( (sign) ? 0x80000000 : 0x7fffffff);
|
||||
l = (f>>8) & 0xffffff;
|
||||
exp =- 24;
|
||||
for( ; exp < 0 ; exp++)
|
||||
l =>> 1;
|
||||
for( ; exp > 0; exp--)
|
||||
l =<< 1;
|
||||
if (sign)
|
||||
l = -l;
|
||||
return(l);
|
||||
}
|
||||
@@ -0,0 +1,47 @@
|
||||
/*
|
||||
Copyright 1982
|
||||
Alcyon Corporation
|
||||
8716 Production Ave.
|
||||
San Diego, Ca. 92121
|
||||
*/
|
||||
|
||||
/*char *version "@(#) fpltof - Feb 1, 1983"; */
|
||||
|
||||
/*
|
||||
* Floating Point Long to Float Routine :
|
||||
* Front End to FFP Floating Point Package.
|
||||
*
|
||||
* double
|
||||
* fpltof(larg)
|
||||
* long larg;
|
||||
*
|
||||
* Return : Floating Point representation of Long Fixed point integer
|
||||
*/
|
||||
|
||||
long
|
||||
fpltof(l)
|
||||
long l;
|
||||
{
|
||||
register long exp;
|
||||
register int sign;
|
||||
|
||||
if (l < 0L) { /* signed ?? */
|
||||
sign = 1;
|
||||
l = -l;
|
||||
}
|
||||
else
|
||||
sign = 0;
|
||||
if (l == 0L)
|
||||
return(0L);
|
||||
exp = 24L;
|
||||
for( ; l & 0x7f000000; exp++) /* something in upper 7 bits */
|
||||
l =>> 1;
|
||||
for( ; !(l & 0x00800000); exp--) /* get mantissa : .F */
|
||||
l =<< 1;
|
||||
l =<< 8; /* mantissa (.F) into top 24 bits */
|
||||
exp =+ 0x40;
|
||||
l =| (exp & 0x7f);
|
||||
if (sign)
|
||||
l =| 0x80;
|
||||
return(l);
|
||||
}
|
||||
133
CPM OPERATING SYSTEMS/CPM 68K/1.0X SOURCES/v101/c/libf/make.sub
Normal file
133
CPM OPERATING SYSTEMS/CPM 68K/1.0X SOURCES/v101/c/libf/make.sub
Normal file
@@ -0,0 +1,133 @@
|
||||
pip d:=e:as68symb.dat[g0
|
||||
|
||||
|
||||
$1cp68 ATOF.c $1x.i
|
||||
$1c068 $1x.i $1x.ic $1x.st -f
|
||||
$1c168 $1x.ic ATOF.s -LD
|
||||
era $1x.i
|
||||
era $1x.ic
|
||||
era $1x.st
|
||||
$1as68 -f $1 -l -u ATOF.s
|
||||
era ATOF.s
|
||||
|
||||
$1cp68 CEIL.c $1x.i
|
||||
$1c068 $1x.i $1x.ic $1x.st -f
|
||||
$1c168 $1x.ic CEIL.s -LD
|
||||
era $1x.i
|
||||
era $1x.ic
|
||||
era $1x.st
|
||||
$1as68 -f $1 -l -u CEIL.s
|
||||
era CEIL.s
|
||||
|
||||
$1cp68 ETOA.c $1x.i
|
||||
$1c068 $1x.i $1x.ic $1x.st -f
|
||||
$1c168 $1x.ic ETOA.s -LD
|
||||
era $1x.i
|
||||
era $1x.ic
|
||||
era $1x.st
|
||||
$1as68 -f $1 -l -u ETOA.s
|
||||
era ETOA.s
|
||||
|
||||
$1cp68 FABS.c $1x.i
|
||||
$1c068 $1x.i $1x.ic $1x.st -f
|
||||
$1c168 $1x.ic FABS.s -LD
|
||||
era $1x.i
|
||||
era $1x.ic
|
||||
era $1x.st
|
||||
$1as68 -f $1 -l -u FABS.s
|
||||
era FABS.s
|
||||
|
||||
$1cp68 FFPTOF.c $1x.i
|
||||
$1c068 $1x.i $1x.ic $1x.st -f
|
||||
$1c168 $1x.ic FFPTOF.s -LD
|
||||
era $1x.i
|
||||
era $1x.ic
|
||||
era $1x.st
|
||||
$1as68 -f $1 -l -u FFPTOF.s
|
||||
era FFPTOF.s
|
||||
|
||||
$1cp68 FLOOR.c $1x.i
|
||||
$1c068 $1x.i $1x.ic $1x.st -f
|
||||
$1c168 $1x.ic FLOOR.s -LD
|
||||
era $1x.i
|
||||
era $1x.ic
|
||||
era $1x.st
|
||||
$1as68 -f $1 -l -u FLOOR.s
|
||||
era FLOOR.s
|
||||
|
||||
$1cp68 FMOD.c $1x.i
|
||||
$1c068 $1x.i $1x.ic $1x.st -f
|
||||
$1c168 $1x.ic FMOD.s -LD
|
||||
era $1x.i
|
||||
era $1x.ic
|
||||
era $1x.st
|
||||
$1as68 -f $1 -l -u FMOD.s
|
||||
era FMOD.s
|
||||
|
||||
$1cp68 FTOA.c $1x.i
|
||||
$1c068 $1x.i $1x.ic $1x.st -f
|
||||
$1c168 $1x.ic FTOA.s -LD
|
||||
era $1x.i
|
||||
era $1x.ic
|
||||
era $1x.st
|
||||
$1as68 -f $1 -l -u FTOA.s
|
||||
era FTOA.s
|
||||
|
||||
$1cp68 FTOFFP.c $1x.i
|
||||
$1c068 $1x.i $1x.ic $1x.st -f
|
||||
$1c168 $1x.ic FTOFFP.s -LD
|
||||
era $1x.i
|
||||
era $1x.ic
|
||||
era $1x.st
|
||||
$1as68 -f $1 -l -u FTOFFP.s
|
||||
era FTOFFP.s
|
||||
|
||||
$1cp68 FTOL.c $1x.i
|
||||
$1c068 $1x.i $1x.ic $1x.st -f
|
||||
$1c168 $1x.ic FTOL.s -LD
|
||||
era $1x.i
|
||||
era $1x.ic
|
||||
era $1x.st
|
||||
$1as68 -f $1 -l -u FTOL.s
|
||||
era FTOL.s
|
||||
|
||||
$1cp68 LTOF.c $1x.i
|
||||
$1c068 $1x.i $1x.ic $1x.st -f
|
||||
$1c168 $1x.ic LTOF.s -LD
|
||||
era $1x.i
|
||||
era $1x.ic
|
||||
era $1x.st
|
||||
$1as68 -f $1 -l -u LTOF.s
|
||||
era LTOF.s
|
||||
|
||||
|
||||
$1as68 -f $1 -l FFPABS.S
|
||||
$1as68 -f $1 -l FFPADD.S
|
||||
$1as68 -f $1 -l FFPCMP.S
|
||||
$1as68 -f $1 -l FFPCPYRT.S
|
||||
$1as68 -f $1 -l FFPDIV.S
|
||||
$1as68 -f $1 -l FFPEXP.S
|
||||
$1as68 -f $1 -l FFPHTHET.S
|
||||
$1as68 -f $1 -l FFPLOG.S
|
||||
$1as68 -f $1 -l FFPMUL2.S
|
||||
$1as68 -f $1 -l FFPPWR.S
|
||||
$1as68 -f $1 -l FFPSIN.S
|
||||
$1as68 -f $1 -l FFPSQRT.S
|
||||
$1as68 -f $1 -l FFPTHETA.S
|
||||
$1as68 -f $1 -l FFPTNORM.S
|
||||
$1as68 -f $1 -l FPADD.S
|
||||
$1as68 -f $1 -l FPCMP.S
|
||||
$1as68 -f $1 -l FPCOS.S
|
||||
$1as68 -f $1 -l FPDIV.S
|
||||
$1as68 -f $1 -l FPEXP.S
|
||||
$1as68 -f $1 -l FPFTOL.S
|
||||
$1as68 -f $1 -l FPLOG.S
|
||||
$1as68 -f $1 -l FPLTOF.S
|
||||
$1as68 -f $1 -l FPMUL.S
|
||||
$1as68 -f $1 -l FPNEG.S
|
||||
$1as68 -f $1 -l FPPWR.S
|
||||
$1as68 -f $1 -l FPSIN.S
|
||||
$1as68 -f $1 -l FPSQRT.S
|
||||
$1as68 -f $1 -l FPSUB.S
|
||||
|
||||
rear $1
|
||||
@@ -0,0 +1,133 @@
|
||||
pip d:=as68symb.dat[g0
|
||||
|
||||
|
||||
cp68 ATOF.c x.i
|
||||
c068 x.i x.ic x.st -f
|
||||
c168 x.ic ATOF.s -LD
|
||||
era x.i
|
||||
era x.ic
|
||||
era x.st
|
||||
as68 -l -u ATOF.s
|
||||
era ATOF.s
|
||||
|
||||
cp68 CEIL.c x.i
|
||||
c068 x.i x.ic x.st -f
|
||||
c168 x.ic CEIL.s -LD
|
||||
era x.i
|
||||
era x.ic
|
||||
era x.st
|
||||
as68 -l -u CEIL.s
|
||||
era CEIL.s
|
||||
|
||||
cp68 ETOA.c x.i
|
||||
c068 x.i x.ic x.st -f
|
||||
c168 x.ic ETOA.s -LD
|
||||
era x.i
|
||||
era x.ic
|
||||
era x.st
|
||||
as68 -l -u ETOA.s
|
||||
era ETOA.s
|
||||
|
||||
cp68 FABS.c x.i
|
||||
c068 x.i x.ic x.st -f
|
||||
c168 x.ic FABS.s -LD
|
||||
era x.i
|
||||
era x.ic
|
||||
era x.st
|
||||
as68 -l -u FABS.s
|
||||
era FABS.s
|
||||
|
||||
cp68 FFPTOF.c x.i
|
||||
c068 x.i x.ic x.st -f
|
||||
c168 x.ic FFPTOF.s -LD
|
||||
era x.i
|
||||
era x.ic
|
||||
era x.st
|
||||
as68 -l -u FFPTOF.s
|
||||
era FFPTOF.s
|
||||
|
||||
cp68 FLOOR.c x.i
|
||||
c068 x.i x.ic x.st -f
|
||||
c168 x.ic FLOOR.s -LD
|
||||
era x.i
|
||||
era x.ic
|
||||
era x.st
|
||||
as68 -l -u FLOOR.s
|
||||
era FLOOR.s
|
||||
|
||||
cp68 FMOD.c x.i
|
||||
c068 x.i x.ic x.st -f
|
||||
c168 x.ic FMOD.s -LD
|
||||
era x.i
|
||||
era x.ic
|
||||
era x.st
|
||||
as68 -l -u FMOD.s
|
||||
era FMOD.s
|
||||
|
||||
cp68 FTOA.c x.i
|
||||
c068 x.i x.ic x.st -f
|
||||
c168 x.ic FTOA.s -LD
|
||||
era x.i
|
||||
era x.ic
|
||||
era x.st
|
||||
as68 -l -u FTOA.s
|
||||
era FTOA.s
|
||||
|
||||
cp68 FTOFFP.c x.i
|
||||
c068 x.i x.ic x.st -f
|
||||
c168 x.ic FTOFFP.s -LD
|
||||
era x.i
|
||||
era x.ic
|
||||
era x.st
|
||||
as68 -l -u FTOFFP.s
|
||||
era FTOFFP.s
|
||||
|
||||
cp68 FTOL.c x.i
|
||||
c068 x.i x.ic x.st -f
|
||||
c168 x.ic FTOL.s -LD
|
||||
era x.i
|
||||
era x.ic
|
||||
era x.st
|
||||
as68 -l -u FTOL.s
|
||||
era FTOL.s
|
||||
|
||||
cp68 LTOF.c x.i
|
||||
c068 x.i x.ic x.st -f
|
||||
c168 x.ic LTOF.s -LD
|
||||
era x.i
|
||||
era x.ic
|
||||
era x.st
|
||||
as68 -l -u LTOF.s
|
||||
era LTOF.s
|
||||
|
||||
|
||||
as68 -l FFPABS.S
|
||||
as68 -l FFPADD.S
|
||||
as68 -l FFPCMP.S
|
||||
as68 -l FFPCPYRT.S
|
||||
as68 -l FFPDIV.S
|
||||
as68 -l FFPEXP.S
|
||||
as68 -l FFPHTHET.S
|
||||
as68 -l FFPLOG.S
|
||||
as68 -l FFPMUL2.S
|
||||
as68 -l FFPPWR.S
|
||||
as68 -l FFPSIN.S
|
||||
as68 -l FFPSQRT.S
|
||||
as68 -l FFPTHETA.S
|
||||
as68 -l FFPTNORM.S
|
||||
as68 -l FPADD.S
|
||||
as68 -l FPCMP.S
|
||||
as68 -l FPCOS.S
|
||||
as68 -l FPDIV.S
|
||||
as68 -l FPEXP.S
|
||||
as68 -l FPFTOL.S
|
||||
as68 -l FPLOG.S
|
||||
as68 -l FPLTOF.S
|
||||
as68 -l FPMUL.S
|
||||
as68 -l FPNEG.S
|
||||
as68 -l FPPWR.S
|
||||
as68 -l FPSIN.S
|
||||
as68 -l FPSQRT.S
|
||||
as68 -l FPSUB.S
|
||||
|
||||
rear
|
||||
@@ -0,0 +1,43 @@
|
||||
$ set def [steve.cpm68k.c.libf]
|
||||
$ set noon
|
||||
$ cc68 ATOF
|
||||
$ cc68 CEIL
|
||||
$ cc68 ETOA
|
||||
$ cc68 FABS
|
||||
$ cc68 FFPTOF
|
||||
$ cc68 FLOOR
|
||||
$ cc68 FMOD
|
||||
$ cc68 FPRINTF
|
||||
$ cc68 FTOA
|
||||
$ cc68 FTOFFP
|
||||
$ cc68 FTOL
|
||||
$ cc68 LTOF
|
||||
$ cc68 PRINTF
|
||||
$ as68 -l -p FFPABS.S >FFPABS.LIS
|
||||
$ as68 -l -p FFPADD.S >FFPADD.LIS
|
||||
$ as68 -l -p FFPCMP.S >FFPCMP.LIS
|
||||
$ as68 -l -p FFPCPYRT.S >FFPCPYRT.LIS
|
||||
$ as68 -l -p FFPDIV.S >FFPDIV.LIS
|
||||
$ as68 -l -p FFPEXP.S >FFPEXP.LIS
|
||||
$ as68 -l -p FFPHTHET.S >FFPHTHET.LIS
|
||||
$ as68 -l -p FFPLOG.S >FFPLOG.LIS
|
||||
$ as68 -l -p FFPMUL2.S >FFPMUL2.LIS
|
||||
$ as68 -l -p FFPPWR.S >FFPPWR.LIS
|
||||
$ as68 -l -p FFPSIN.S >FFPSIN.LIS
|
||||
$ as68 -l -p FFPSQRT.S >FFPSQRT.LIS
|
||||
$ as68 -l -p FFPTHETA.S >FFPTHETA.LIS
|
||||
$ as68 -l -p FFPTNORM.S >FFPTNORM.LIS
|
||||
$ as68 -l -p FPADD.S >FPADD.LIS
|
||||
$ as68 -l -p FPCMP.S >FPCMP.LIS
|
||||
$ as68 -l -p FPCOS.S >FPCOS.LIS
|
||||
$ as68 -l -p FPDIV.S >FPDIV.LIS
|
||||
$ as68 -l -p FPEXP.S >FPEXP.LIS
|
||||
$ as68 -l -p FPFTOL.S >FPFTOL.LIS
|
||||
$ as68 -l -p FPLOG.S >FPLOG.LIS
|
||||
$ as68 -l -p FPLTOF.S >FPLTOF.LIS
|
||||
$ as68 -l -p FPMUL.S >FPMUL.LIS
|
||||
$ as68 -l -p FPNEG.S >FPNEG.LIS
|
||||
$ as68 -l -p FPPWR.S >FPPWR.LIS
|
||||
$ as68 -l -p FPSIN.S >FPSIN.LIS
|
||||
$ as68 -l -p FPSQRT.S >FPSQRT.LIS
|
||||
$ as68 -l -p FPSUB.S >FPSUB.LIS
|
||||
@@ -0,0 +1,36 @@
|
||||
CC = c68
|
||||
AS = as68
|
||||
CFLAGS = -L -f
|
||||
AFLAGS = -u -L
|
||||
OBJS = atof.o ceil.o etoa.o fprintf.o ftoa.o ftoffp.o ftol.o ltof.o printf.o
|
||||
OBJ2 = ffptof.o floor.o fmod.o fabs.o
|
||||
|
||||
init: ${OBJS} ${OBJ2} ${OBJ3}
|
||||
${AS} ${AFLAGS} ffpabs.s
|
||||
${AS} ${AFLAGS} ffpadd.s
|
||||
${AS} ${AFLAGS} ffpcmp.s
|
||||
${AS} ${AFLAGS} ffpcpyrt.s
|
||||
${AS} ${AFLAGS} ffpdiv.s
|
||||
${AS} ${AFLAGS} ffpexp.s
|
||||
${AS} ${AFLAGS} ffphthet.s
|
||||
${AS} ${AFLAGS} ffplog.s
|
||||
${AS} ${AFLAGS} ffpmul2.s
|
||||
${AS} ${AFLAGS} ffppwr.s
|
||||
${AS} ${AFLAGS} ffpsin.s
|
||||
${AS} ${AFLAGS} ffpsqrt.s
|
||||
${AS} ${AFLAGS} ffptheta.s
|
||||
${AS} ${AFLAGS} ffptnorm.s
|
||||
${AS} ${AFLAGS} fpadd.s
|
||||
${AS} ${AFLAGS} fpcmp.s
|
||||
${AS} ${AFLAGS} fpcos.s
|
||||
${AS} ${AFLAGS} fpdiv.s
|
||||
${AS} ${AFLAGS} fpexp.s
|
||||
${AS} ${AFLAGS} fpftol.s
|
||||
${AS} ${AFLAGS} fplog.s
|
||||
${AS} ${AFLAGS} fpltof.s
|
||||
${AS} ${AFLAGS} fpmul.s
|
||||
${AS} ${AFLAGS} fpneg.s
|
||||
${AS} ${AFLAGS} fppwr.s
|
||||
${AS} ${AFLAGS} fpsin.s
|
||||
${AS} ${AFLAGS} fpsqrt.s
|
||||
${AS} ${AFLAGS} fpsub.s
|
||||
@@ -0,0 +1,43 @@
|
||||
rm libF.a
|
||||
ar68 -rv libF.a \
|
||||
printf.o \
|
||||
fprintf.o \
|
||||
ftoa.o \
|
||||
etoa.o \
|
||||
atof.o \
|
||||
ffptof.o \
|
||||
ftoffp.o \
|
||||
fabs.o \
|
||||
floor.o \
|
||||
ceil.o \
|
||||
fmod.o \
|
||||
fpadd.o \
|
||||
fpcmp.o \
|
||||
fpdiv.o \
|
||||
fpcos.o \
|
||||
fppwr.o \
|
||||
fpsin.o \
|
||||
fpsqrt.o \
|
||||
fpexp.o \
|
||||
fplog.o \
|
||||
ltof.o \
|
||||
ftol.o \
|
||||
fpmul.o \
|
||||
fpneg.o \
|
||||
fpsub.o \
|
||||
ffppwr.o \
|
||||
ffpsin.o \
|
||||
ffpsqrt.o \
|
||||
ffpabs.o \
|
||||
ffpadd.o \
|
||||
ffpcmp.o \
|
||||
ffpdiv.o \
|
||||
ffpexp.o \
|
||||
ffplog.o \
|
||||
ffpmul2.o \
|
||||
ffptheta.o \
|
||||
ffptnorm.o \
|
||||
ffphthet.o \
|
||||
ffpcpyrt.o
|
||||
|
||||
ls -l libF.a /lib/libF.a
|
||||
@@ -0,0 +1,39 @@
|
||||
$ num
|
||||
ATOF.C
|
||||
ATOF.lst
|
||||
$ num
|
||||
CEIL.C
|
||||
CEIL.lst
|
||||
$ num
|
||||
ETOA.C
|
||||
ETOA.lst
|
||||
$ num
|
||||
FABS.C
|
||||
FABS.lst
|
||||
$ num
|
||||
FFPTOF.C
|
||||
FFPTOF.lst
|
||||
$ num
|
||||
FLOOR.C
|
||||
FLOOR.lst
|
||||
$ num
|
||||
FMOD.C
|
||||
FMOD.lst
|
||||
$ num
|
||||
FPRINTF.C
|
||||
FPRINTF.lst
|
||||
$ num
|
||||
FTOA.C
|
||||
FTOA.lst
|
||||
$ num
|
||||
FTOFFP.C
|
||||
FTOFFP.lst
|
||||
$ num
|
||||
FTOL.C
|
||||
FTOL.lst
|
||||
$ num
|
||||
LTOF.C
|
||||
LTOF.lst
|
||||
$ num
|
||||
PRINTF.C
|
||||
PRINTF.lst
|
||||
@@ -0,0 +1,8 @@
|
||||
$ set noon
|
||||
$ del lib:libF.a;*
|
||||
$ ar68 rv lib:libF.a ftoa.o etoa.o atof.o ffptof.o ftoffp.o fabs.o floor.o
|
||||
$ ar68 rv lib:libF.a ceil.o fmod.o fpadd.o fpcmp.o fpdiv.o fpcos.o fppwr.o
|
||||
$ ar68 rv lib:libF.a fpsin.o fpsqrt.o fpexp.o fplog.o ltof.o ftol.o fpmul.o
|
||||
$ ar68 rv lib:libF.a fpneg.o fpsub.o ffppwr.o ffpsin.o ffpsqrt.o ffpabs.o
|
||||
$ ar68 rv lib:libF.a ffpadd.o ffpcmp.o ffpdiv.o ffpexp.o ffplog.o ffpmul2.o
|
||||
$ ar68 rv lib:libF.a ffptheta.o ffptnorm.o ffphthet.o ffpcpyrt.o
|
||||
@@ -0,0 +1,22 @@
|
||||
era libf.a
|
||||
$1ar68 rvf $1 libF.a ftoa.o etoa.o atof.o ffptof.o ftoffp.o fabs.o floor.o
|
||||
$1ar68 rvf $1 libF.a ceil.o fmod.o fpadd.o fpcmp.o fpdiv.o fpcos.o fppwr.o
|
||||
$1ar68 rvf $1 libF.a fpsin.o fpsqrt.o fpexp.o fplog.o ltof.o ftol.o fpmul.o
|
||||
$1ar68 rvf $1 libF.a fpneg.o fpsub.o ffppwr.o ffpsin.o ffpsqrt.o ffpabs.o
|
||||
$1ar68 rvf $1 libF.a ffpadd.o ffpcmp.o ffpdiv.o ffpexp.o ffplog.o ffpmul2.o
|
||||
$1ar68 rvf $1 libF.a ffptheta.o ffptnorm.o ffphthet.o ffpcpyrt.o
|
||||
|
||||
user 8!make
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
@@ -0,0 +1,7 @@
|
||||
era libf.a
|
||||
$1ar68 rvf $1 libF.a ftoa.o etoa.o atof.o ffptof.o ftoffp.o fabs.o floor.o
|
||||
$1ar68 rvf $1 libF.a ceil.o fmod.o fpadd.o fpcmp.o fpdiv.o fpcos.o fppwr.o
|
||||
$1ar68 rvf $1 libF.a fpsin.o fpsqrt.o fpexp.o fplog.o ltof.o ftol.o fpmul.o
|
||||
$1ar68 rvf $1 libF.a fpneg.o fpsub.o ffppwr.o ffpsin.o ffpsqrt.o ffpabs.o
|
||||
$1ar68 rvf $1 libF.a ffpadd.o ffpcmp.o ffpdiv.o ffpexp.o ffplog.o ffpmul2.o
|
||||
$1ar68 rvf $1 libF.a ffptheta.o ffptnorm.o ffphthet.o ffpcpyrt.o
|
||||
@@ -0,0 +1,44 @@
|
||||
$ set noon
|
||||
$ vsend ATOF.C
|
||||
$ vsend CEIL.C
|
||||
$ vsend ETOA.C
|
||||
$ vsend FABS.C
|
||||
$ vsend FFPTOF.C
|
||||
$ vsend FLOOR.C
|
||||
$ vsend FMOD.C
|
||||
$ vsend FPRINTF.C
|
||||
$ vsend FTOA.C
|
||||
$ vsend FTOFFP.C
|
||||
$ vsend FTOL.C
|
||||
$ vsend LTOF.C
|
||||
$ vsend PRINTF.C
|
||||
$ vsend FFPABS.S
|
||||
$ vsend FFPADD.S
|
||||
$ vsend FFPCMP.S
|
||||
$ vsend FFPCPYRT.S
|
||||
$ vsend FFPDIV.S
|
||||
$ vsend FFPEXP.S
|
||||
$ vsend FFPHTHET.S
|
||||
$ vsend FFPLOG.S
|
||||
$ vsend FFPMUL2.S
|
||||
$ vsend FFPPWR.S
|
||||
$ vsend FFPSIN.S
|
||||
$ vsend FFPSQRT.S
|
||||
$ vsend FFPTHETA.S
|
||||
$ vsend FFPTNORM.S
|
||||
$ vsend FPADD.S
|
||||
$ vsend FPCMP.S
|
||||
$ vsend FPCOS.S
|
||||
$ vsend FPDIV.S
|
||||
$ vsend FPEXP.S
|
||||
$ vsend FPFTOL.S
|
||||
$ vsend FPLOG.S
|
||||
$ vsend FPLTOF.S
|
||||
$ vsend FPMUL.S
|
||||
$ vsend FPNEG.S
|
||||
$ vsend FPPWR.S
|
||||
$ vsend FPSIN.S
|
||||
$ vsend FPSQRT.S
|
||||
$ vsend FPSUB.S
|
||||
$ vsend MAKE.SUB
|
||||
$ vsend REAR.SUB
|
||||
Reference in New Issue
Block a user