*******************************************************************************
*				   HC11FP				      *
*									      *
*			       Copyright 1986				      *
*				     by					      *
*			       Gordon Doughman				      *
*									      *
*	The source code for this floating point package for the MC68HC11      *
*	may be freely distributed under the rules of public domain. However   *
*	it is a copyrighted work and as such may not be sold as a product     *
*	or be included as part of a product for sale without the express      *
*	permission of the author. Any object code produced by the source      *
*	code may be included as part of a product for sale.		      *
*									      *
*	If there are any questions or comments about the floating point	      *
*	package please feel free to contact me.				      *
*									      *
*			       Gordon Doughman				      *
*			       Motorola Semiconductor			      *
*			       3490 South Dixie Drive			      *
*			       Dayton, OH  45439			      *
*			       (513) 294-2231				      *
*									      *
*******************************************************************************
*									      *
*				  MATH11				      *
*									      *
*		   Revisions to FP11 floating point code		      *
*		   Modifications Copyright 1988, Scott Wagner		      *
*									      *
*	 The following improvements have been made to the HC11FP code:	      *
*		1) Execution time and stack space requirements of the basic   *
*		   arithmetic operations (+-*/) have been reduced.	      *
*		2) The efficiency of the trigonometric functions has been     *
*		   improved.						      *
*		3) New functions FLTATAN, FLTLN, FLTLGT, FLTETOX, FLT10TX     *
*		   and FLTXTOY have been added.				      *
*		4) The polynomial expansion routine POLYNOM is available to   *
*		   evaluate series of arbitrary order.	The coefficient table *
*		   supplied by the user determines the polynomial order.      *
*		5) All floating point numbers are now stored in memory in the *
*		   IEEE floating point format for compatibility with other    *
*		   compilers.						      *
*		6) All functions now signal errors by setting the Carry bit.  *
*		   If Carry is clear on return, contents of ACCA are	      *
*		   indeterminate; if carry is set, error code is in acca.     *
*		7) For compatibility with error returns, FLTCMP returns Z=1   *
*		   if FPACC1 == FPACC2, Z=0 if FPACC1 != FPACC2, and N=1 if   *
*		   FPACC1 < FPACC2, N=0 if FPACC1 >= FPACC2.  Note that this  *
*		   changes the conditional branch instructions following      *
*		   calls to FLTCMP in the routines in this package which use  *
*		   the FLTCMP routine.					      *
*									      *
*	 These modifications to the HC11FP package are provided under the     *
*	 rules of public domain stated above.  Please direct comments about   *
*	 these modifications to:					      *
*					Scott Wagner			      *
*					Rochester Instrument Systems	      *
*					255 North Union Street		      *
*					Rochester, New York 14605	      *
*									      *
*******************************************************************************
*
*		REVISION HISTORY:
*	1.0	02-11-88	Release to public domain of enhancements to
*				Gordon Doughman's 68HC11 FP package.  S. Wagner
*	1.1	07-07-88	Corrected errors/anomalies in FLTCMP.  Made
*				error returns more consistent.	S. Wagner
*	1.2	07-22-88	Corrected two digit exponent pointer error and
*				mantissa conversion overflow error in ASCFLT.
*				Addition involving zero or arguments with large
*				exponent difference now returns no error and
*				ACCA clear.  ASCFLT accepts 'E' or 'e' as
*				exponent delimiter.  S. Wagner
*	1.3	09-21-88	Corrected error in storage format - storage is
*				now true IEEE floating point format. Added new
*				functions FLTABS (absolute value), FLTSGN
*				(signum function), FLTMIN (negative). S. Wagner
*	1.4	04-07-91	Added support for 32-bit integers:
*				FLT2LNG and SLNG2FLT by Randy Sargent and
*				Fred Martin

*
* These are now defined in pcode.h.  Randy Sargent Sun Jan 27 23:10:38 1991
*

*OVFERR	 EQU	6	    ; floating point overflow error
*UNFERR	 EQU	7	    ; floating point underflow error
*DIV0ERR	 EQU	8	    ; division by 0 error
*TOLGSMER EQU	9	    ; number too large or small to convert to int.
*NSQRTERR EQU	10	    ; tried to take the square root of negative # 
*TAN90ERR EQU	11	    ; tangent of 90 degrees attempted
*LNNEGERR EQU	12	    ; log or ln of negative number or 0
ACOSERR	 EQU	13	    ; arc cosine not implemented
ASINERR	 EQU	14	    ; arc sine not implemented
FLTFMTER EQU	15	    ; floating point format error in ascflt
*
*
******************************************************************************
*									     *
*			 ASCII TO FLOATING POINT ROUTINE		     *
*									     *
*	This routine will accept most any ASCII floating point format	     *
*	and return a 32-bit floating point number.  The following are	     *
*	some examples of legal ASCII floating point numbers.		     *
*									     *
*	20.095								     *
*	0.125								     *
*	7.2984E10							     *
*	167.824E5							     *
*	5.9357E-7							     *
*	500								     *
*									     *
*	The floating point number returned is in "FPACC1".		     *
*									     *
*									     *
*	The exponent is biased by 127 to facilitate floating point	     *
*	comparisons.  A pointer to the ASCII string is passed to the	     *
*	routine in the X-register.					     *
*									     *
*									     *
******************************************************************************
*
*
*
*	 LOCAL VARIABLES (ON STACK POINTED TO BY Y)
*
EXPSIGN	 EQU	0	     ; exponent sign (0=+, ff=-).
PWR10EXP EQU	1	     ; power 10 exponent.
*
*
*	 ORG	$C000	     ; (test for evb)
*
ASCFLT	 EQU	*
	 PSHX		     ; save pointer to ascii string.
	 JSR	PSHFPAC2     ; save fpacc2.
	 LDX	#0	     ; push zeros on stack to initialize locals.
	 PSHX		     ; allocate 2 bytes for locals.
	 STX	FPACC1EX     ; clear fpacc1.
	 STX	FPACC1EX+2
	 CLR	MANTSGN1     ; make the mantissa sign positive initially.
	 TSY		     ; point to locals.
	 LDX	6,Y	     ; get pointer to ascii string.
ASCFLT1	 LDAA	0,X	     ; get 1st character in string.
	 JSR	NUMERIC	     ; is it a number.
	 BCS	ASCFLT4	     ; yes. go process it.
*
*	 LEADING MINUS SIGN ENCOUNTERED?
*
ASCFLT2	 CMPA	#'-'	     ; no. is it a minus sign?
	 BNE	ASCFLT3	     ; no. go check for decimal point.
	 COM	MANTSGN1     ; yes. set mantissa sign. leading minus before?
	 INX		     ; point to next character.
	 LDAA	0,X	     ; get it.
	 JSR	NUMERIC	     ; is it a number?
	 BCS	ASCFLT4	     ; yes. go process it.
*
*	 LEADING DECIMAL POINT?
*

ASCFLT3	 CMPA	#'.'	     ; is it a decimal point?
	 BNE	ASCFLT5	     ; no. format error.
	 INX		     ; yes. point to next character.
	 LDAA	0,X	     ; get it.
	 JSR	NUMERIC	     ; must have at least one digit after d.p.
	 BCC	ASCFLT5	     ; go report error.
	 JMP	ASCFLT11     ; go build fraction.
*
*	 FLOATING POINT FORMAT ERROR
*
ASCFLT5	 INS		     ; de-allocate locals.
	 INS
	 JSR	PULFPAC2     ; restore fpacc2.
	 PULX		     ; get pointer to terminating character in string.
	 LDAA	#FLTFMTER    ; format error.
	 SEC		     ; set error flag.
	 RTS
*
*	 PRE DECIMAL POINT MANTISSA BUILD
*
ASCFLT4	 LDAA	0,X
	 JSR	NUMERIC
	 BCC	ASCFLT10
	 JSR	ADDNXTD
	 INX
	 BCC	ASCFLT4
*
*	 PRE DECIMAL POINT MANTISSA OVERFLOW
*
ASCFLT6	 INC	FPACC1EX     ; inc for each digit encountered prior to d.p.
	 LDAA	0,X	     ; get next character.
	 INX		     ; point to next.
	 JSR	NUMERIC	     ; is it s digit?
	 BCS	ASCFLT6	     ; yes. keep building power 10 mantissa.
	 CMPA	#'.'	     ; no. is it a decimal point?
	 BNE	ASCFLT7	     ; no. go check for the exponent.
*
*	 ANY FRACTIONAL DIGITS ARE NOT SIGNIFIGANT
*
ASCFLT8	 LDAA	0,X	     ; get the next character.
	 JSR	NUMERIC	     ; is it a digit?
	 BCC	ASCFLT7	     ; no. go check for an exponent.
	 INX		     ; point to the next character.
	 BRA	ASCFLT8	     ; flush remaining digits.
ASCFLT7	 CMPA	#'E'	     ; no. is it the exponent?
	 BEQ	ASCFLT13     ; yes. go process it.
	 CMPA	#'e'	     ; is it the exponent?
	 BEQ	ASCFLT13     ; yes. go process it.
	 JMP	FINISH	     ; no. go finish the conversion.
*
*	 PROCESS THE EXPONENT
*
ASCFLT13 INX		     ; point to next character.
	 LDAA	0,X	     ; get the next character.
	 JSR	NUMERIC	     ; see if it's a digit.
	 BCS	ASCFLT9	     ; yes. get the exponent.
	 CMPA	#'-'	     ; no. is it a minus sign?
	 BEQ	ASCFLT15     ; yes. go flag a negative exponent.
	 CMPA	#'+'	     ; no. is it a plus sign?
	 BEQ	ASCFLT16     ; yes. just ignore it.
	 BRA	ASCFLT5	     ; no. format error.
ASCFLT15 COM	EXPSIGN,Y    ; flag a negative exponent. is it 1st?
ASCFLT16 INX		     ; point to next character.
	 LDAA	0,X	     ; get next character.
	 JSR	NUMERIC	     ; is it a number?
	 BCC	ASCFLT5	     ; no. format error.
ASCFLT9	 SUBA	#$30	     ; make it binary.
	 STAA	PWR10EXP,Y   ; build the power 10 exponent.
	 INX		     ; point to next character.
	 LDAA	0,X	     ; get it.
	 JSR	NUMERIC	     ; is it numeric?
	 BCC	ASCFLT14     ; no. go finish up the conversion.
	 LDAB	PWR10EXP,Y   ; yes. get previous digit.
	 LSLB		     ; mult. by 2.
	 LSLB		     ; now by 4.
	 ADDB	PWR10EXP,Y   ; by 5.
	 LSLB		     ; by 10.
	 SUBA	#$30	     ; make second digit binary.
	 ABA		     ; add it to first digit.
	 STAA	PWR10EXP,Y
	 INX		     ; point to character following exponent
	 CMPA	#38	     ; is the exponent out of range?
	 BHI	ASCFLT5	     ; yes. report error.
ASCFLT14 LDAA	PWR10EXP,Y   ; get power 10 exponent.
	 TST	EXPSIGN,Y    ; was it negative?
	 BPL	ASCFLT12     ; no. go add it to built 10 pwr exponent.
	 NEGA
ASCFLT12 ADDA	FPACC1EX     ; final total pwr 10 exponent.
	 STAA	FPACC1EX     ; save result.
	 BRA	FINISH	     ; go finish up conversion.
*
*	 PRE-DECIMAL POINT NON-DIGIT FOUND, IS IT A DECIMAL POINT?
*
ASCFLT10 CMPA	#'.'	     ; is it a decimal point?
	 BNE	ASCFLT7	     ; no. go check for the exponent.
	 INX		     ; yes. point to next character.
*
*	 POST DECIMAL POINT PROCESSING
*
ASCFLT11 LDAA	0,X	     ; get next character.
	 JSR	NUMERIC	     ; is it numeric?
	 BCC	ASCFLT7	     ; no. go check for exponent.
	 BSR	ADDNXTD	     ; yes. add in the digit.
	 INX		     ; point to the next character.
	 BCS	ASCFLT8	     ; if over flow, flush remaining digits.
	 DEC	FPACC1EX     ; adjust the 10 power exponent.
	 BRA	ASCFLT11     ; process all fractional digits.
*
*
*
ADDNXTD	 LDAA	FPACC1MN     ; get upper 8 bits.
	 STAA	FPACC2MN     ; copy into fpac2.
	 LDD	FPACC1MN+1   ; get lower 16 bits of mantissa.
	 STD	FPACC2MN+1   ; copy into fpacc2.
	 LSLD		     ; mult. by 2.
	 ROL	FPACC1MN     ; overflow?
	 BCS	ADDNXTD1     ; yes. don't add the digit in.
	 LSLD		     ; mult by 4.
	 ROL	FPACC1MN     ; overflow?
	 BCS	ADDNXTD1     ; yes. don't add the digit in.
	 ADDD	FPACC2MN+1   ; by 5.
	 PSHA		     ; save a.
	 LDAA	FPACC1MN     ; get upper 8 bits.
	 ADCA	FPACC2MN     ; add in upper 8 bits, carry from lower 16 bits.
	 STAA	FPACC1MN     ; save it.
	 PULA		     ; restore a.
	 BCS	ADDNXTD1     ; overflow? if so don't add it in.
	 LSLD		     ; by 10.
	 ROL	FPACC1MN
	 STD	FPACC1MN+1   ; save the lower 16 bits.
	 BCS	ADDNXTD1     ; overflow? if so don't add it in.
	 LDAB	0,X	     ; get current digit.
	 SUBB	#$30	     ; make it binary.
	 CLRA		     ; 16-bit.
	 ADDD	FPACC1MN+1   ; add it in to total.
	 STD	FPACC1MN+1   ; save the result.
	 LDAA	FPACC1MN     ; get upper 8 bits.
	 ADCA	#0	     ; add in possible carry. overflow?
	 BCS	ADDNXTD1     ; yes. copy old mantissa from fpacc2.
	 STAA	FPACC1MN     ; no. everything ok.
	 RTS
ADDNXTD1 LDD	FPACC2MN+1   ; restore the original mantissa because
	 STD	FPACC1MN+1   ; of overflow.
	 LDAA	FPACC2MN
	 STAA	FPACC1MN
	 RTS
*
*
*
*	 NOW FINISH UP CONVERSION BY MULTIPLYING THE RESULTANT MANTISSA
*	 BY 10 FOR EACH POSITIVE POWER OF 10 EXPONENT RECIEVED OR BY .1
*	 (DIVIDE BY 10) FOR EACH NEGATIVE POWER OF 10 EXPONENT RECIEVED.
*
*
FINISH	 EQU	*
	 STX	6,Y	     ; save pointer to terminating character in string.
	 LDX	#FPACC1EX    ; point to fpacc1.
	 JSR	CHCK0	     ; see if the number is zero.
	 BEQ	FINISH3	     ; quit if it is.
	 LDAA	FPACC1EX     ; get the power 10 exponent.
	 STAA	PWR10EXP,Y   ; save it.
	 LDAA	#$7E+24	     ; set up initial exponent (# of bits + bias).
	 STAA	FPACC1EX
	 JSR	FPNORM	     ; go normalize the mantissa.
	 TST	PWR10EXP,Y   ; is the power 10 exponent positive or zero?
	 BEQ	FINISH3	     ; it's zero, we're done.
	 BPL	FINISH1	     ; it's positive multiply by 10.
	 LDX	#CONSTP1     ; no. get constant .1 (divide by 10).
	 JSR	GETFPAC2     ; get constant into fpacc2.
	 NEG	PWR10EXP,Y   ; make the power 10 exponent positive.
	 BRA	FINISH2	     ; go do the multiplies.
FINISH1	 LDX	#CONST10     ; get constant '10' to multiply by.
	 JSR	GETFPAC2     ; get constant into fpacc2.
FINISH2	 JSR	FLTMUL	     ; go multiply fpacc1 by fpacc2, result in fpacc1.
	 DEC	PWR10EXP,Y   ; decrement the power 10 exponent.
	 BNE	FINISH2	     ; go check to see if we're done.
FINISH3	 INS		     ; de-allocate locals.
	 INS
	 JSR	PULFPAC2     ; restore fpacc2.
	 PULX		     ; get pointer to terminating character in string.
	 RTS
*
*
NUMERIC	 EQU	*
	 CMPA	#'0'	     ; is it less than an ascii 0?
	 BLO	NUMERIC1     ; yes. not numeric.
	 CMPA	#'9'	     ; is it greater than an ascii 9?
	 BHI	NUMERIC1     ; yes. not numeric.
	 SEC		     ; it was numeric. set the carry.
	 RTS
NUMERIC1 CLC		     ; non-numeric character. clear the carry.
	 RTS
*
FPNORM	 EQU	*
	 LDX	#FPACC1EX    ; point to fpacc1.
	 BSR	CHCK0	     ; check to see if it's 0.
	 BEQ	FPNORM3	     ; yes. just return.
	 TST	FPACC1MN     ; is the number already normalized?
	 BMI	FPNORM3	     ; yes. just return..
FPNORM1	 LDD	FPACC1MN+1   ; get the lower 16 bits of the mantissa.
FPNORM2	 DEC	FPACC1EX     ; decrement the exponent for each shift.
	 BEQ	FPNORM4	     ; exponent went to 0. underflow.
	 LSLD		     ; shift the lower 16 bits.
	 ROL	FPACC1MN     ; rotate the upper 8 bits. number normalized?
	 BPL	FPNORM2	     ; no. keep shifting to the left.
	 STD	FPACC1MN+1   ; put the lower 16 bits back into fpacc1.
FPNORM3	 CLC		     ; show no errors.
	 RTS
FPNORM4	 SEC		     ; flag error.
	 RTS
*
CHCK0	 EQU	*	     ; checks for zero in fpacc pointed to by x.
	 PSHB		     ; save d.
	 PSHA
	 LDD	0,X	     ; get fpacc exponent & high 8 bits.
	 BNE	CHCK01	     ; not zero. return.
	 LDD	2,X	     ; check lower 16 bits.
CHCK01	 PULA		     ; restore d.
	 PULB
	 RTS
*
CONSTP1	 FCB	$3D,$CC,$CC,$CD		; 0.1 decimal
CONST10	 FCB	$41,$20,$00,$00		; 10.0 decimal
*
*
FLTMOD	 EQU	*	     ; floating point modulus
	 JSR	FLTDIV	     ; do division
	 JSR	PSHFPAC2     ; save argument
	 JSR	INTFRAC	     ; find fractional part
	 JSR	PULFPAC2     ; recover argument
*			     ; fall through to multiply
*
******************************************************************************
*									     *
*		       FPMULT: FLOATING POINT MULTIPLY			     *
*									     *
*	THIS FLOATING POINT MULTIPLY ROUTINE MULTIPLIES "FPACC1" BY	     *
*	"FPACC2" AND PLACES THE RESULT IN TO FPACC1. FPACC2 REMAINS	     *
*	UNCHANGED.							     *
*			   WORST CASE = 480 CYCLES = 240 US @ 2MHZ	     *
*									     *
******************************************************************************
*
*
FLTMUL	 EQU	*
	 TST	FPACC1EX     ; check to see if fpacc1 is zero.
	 BEQ	FPMULT3	     ; it is. answer is 0.
	 TST	FPACC2EX     ; check to see if fpacc2 is zero.
	 BNE	FPMULT8	     ; it is not. go do multiply
FPMULT3	 LDD	#0	     ; zero result
	 STAA	MANTSGN1
	 STD	FPACC1EX
	 STD	FPACC1MN+1
	 RTS
FPMULT8	 LDAA	MANTSGN1     ; get fpacc1 exponent.
	 EORA	MANTSGN2     ; set the sign of the result.
	 STAA	MANTSGN1     ; save the sign of the result.
	 LDAA	FPACC1EX     ; get fpacc1 exponent.
	 ADDA	FPACC2EX     ; add it to fpacc2 exponent.
	 BPL	FPMULT1	     ; if result is minus and
	 BCC	FPMULT2	     ; the carry is set then:
RTNMAX	 LDAA	#OVFERR	     ; overflow error.
RTNDIV0	 LDX	#$FFFF	     ; maximum magnitude result
	 BRA	FPMULT7	     ; do it and return.
FPMULT1	 BCS	FPMULT2	     ; if result is plus & the carry is set then all ok
RTNZERO	 LDAA	#UNFERR	     ; else underflow error occured.
	 LDX	#0	     ; zero result
	 STX	FPACC1MN+2   ; this clears mantsgn1 byte
FPMULT7	 STX	FPACC1EX
	 STX	FPACC1MN+1
	 SEC		     ; flag error.
	 RTS
FPMULT2	 ADDA	#$82	     ; add bias back in that we lost.
	 STAA	FPACC1EX     ; save the new exponent.
	 LDX	#0
	 PSHX		     ; create partial product register and counter.
	 PSHX
	 TSX		     ; point to the variables.
	 JSR	UMULT	     ; go multiply the "integer" mantissas.
	 TST	0,X	     ; does result need to be normalized?
	 BMI	FPMROUND     ; no - go round result
	 ROL	3,X	     ; first normalize result
	 ROL	2,X
	 ROL	1,X
	 ROL	0,X
	 DEC	FPACC1EX     ; now decrement exponent
FPMROUND TST	3,X	     ; check msb of byte 4 (to be discarded later)
	 BPL	FPMULT4	     ; no rounding necessary
	 LDAA	2,X	     ; round lsb up
	 INCA		     ; increment result lsb
	 STAA	2,X	     ; put lsb back
	 BNE	FPMULT4	     ; if no carry to result bytes 1 and 2
	 LDAB	#1	     ; set d register to 1 (acca is already 0)
	 ADDD	0,X	     ; increment bytes 1 and 2
	 BCC	FPMULT5	     ; no overflow from bytes 1 and 2
	 RORA		     ; result changes from $7fffff to $800000
	 INC	FPACC1EX     ; exponent incremented (back to where it was)
FPMULT5	 STD	0,X	     ; put bytes 1 and 2 back
FPMULT4	 PULX		     ; retrieve bytes 1 and 2
	 STX	FPACC1MN     ; store in mantissa high bytes
	 PULA		     ; retrieve byte 3 (lsb)
	 STAA	FPACC1MN+2   ; store in mantissa low byte
	 INS		     ; discard byte 4
	 TST	FPACC1EX     ; was there an underflow error?
	 BEQ	RTNZERO	     ; yes. return error.
	 CLRB		     ; show no errors.
	 RTS
*
*
UMULT	 EQU	*
	 LDAA	FPACC2MN+2   ; get multiplier lsb
	 LDAB	FPACC1MN+2   ; get multiplicand lsb
	 MUL
	 STAA	1,X	     ; temporarily save result msb; discard lsb (byte 6)
	 LDAA	FPACC2MN+1   ; get multiplier nsb
	 LDAB	FPACC1MN+2   ; get multiplicand lsb
	 MUL
	 ADDD	0,X	     ; add in last partial result
	 STD	0,X	     ; temporarily save result
	 LDAA	FPACC2MN+2   ; get multiplier lsb
	 LDAB	FPACC1MN+1   ; get multiplicand nsb
	 MUL
	 ADDD	0,X	     ; add in last partial result
	 STAA	3,X	    ; save partial product byte 4; discard lsb (byte 5)
	 BCC	UMULT1	     ; if no carry out to product byte 3
	 INC	2,X	     ; carry to product byte 3
UMULT1	 CLR	0,X	     ; zero product bytes 1 & 2 (used for temp. storage)
	 CLR	1,X
	 LDAA	FPACC2MN     ; get multiplier msb
	 LDAB	FPACC1MN+2   ; get multiplicand lsb
	 MUL
	 ADDD	2,X	     ; add in last partial result
	 STD	2,X	     ; save in partial product bytes 3 and 4
REMCOMP	 LDAA	FPACC2MN+1   ; get multiplier nsb
	 LDAB	FPACC1MN+1   ; get multiplicand nsb
	 MUL
	 ADDD	2,X	     ; add in last partial result
	 STD	2,X	     ; save in partial product bytes 3 and 4
	 BCC	UMULT2	     ; if no carry out to product byte 2
	 INC	1,X	     ; carry to product byte 2
UMULT2	 LDAA	FPACC2MN+2   ; get multiplier lsb
	 LDAB	FPACC1MN     ; get multiplicand msb
	 MUL
	 ADDD	2,X	     ; add in last partial result
	 STD	2,X	     ; save in partial product bytes 3 and 4
	 BCC	UMULT3	     ; if no carry out to product byte 2
	 INC	1,X	     ; carry to product byte 2
UMULT3	 LDAA	FPACC2MN     ; get multiplier msb
	 LDAB	FPACC1MN+1   ; get multiplicand nsb
	 MUL
	 ADDD	1,X	     ; add in last partial result
	 STD	1,X	     ; save in partial product bytes 2 and 3
	 BCC	UMULT4	     ; if no carry out to product byte 1
	 INC	0,X	     ; carry to product byte 1
UMULT4	 LDAA	FPACC2MN+1   ; get multiplier nsb
	 LDAB	FPACC1MN     ; get multiplicand msb
	 MUL
	 ADDD	1,X	     ; add in last partial result
	 STD	1,X	     ; save in partial product bytes 2 and 3
	 BCC	UMULT5	     ; if no carry out to product byte 1
	 INC	0,X	     ; carry to product byte 1
UMULT5	 LDAA	FPACC2MN     ; get multiplier msb
	 LDAB	FPACC1MN     ; get multiplicand msb
	 MUL
	 ADDD	0,X	     ; add in last partial result
	 STD	0,X	     ; save in partial product bytes 2 and 3
	 RTS
*
*
*
******************************************************************************
*									     *
*		    FLOATING POINT TO INTEGER CONVERSION		     *
*									     *
*	 THE SUBROUTINE FLT2INT WILL PERFORM  FLOATING POINT TO INTEGER	     *
*	 CONVERSION.  THE FLOATING POINT NUMBER IF POSITIVE, WILL BE	     *
*	 CONVERTED TO AN UNSIGNED 16 BIT INTEGER ( 0 <= X <= 65535 ), AND    *
*	 THE N FLAG WILL BE CLEARED.  IF NEGATIVE, THE FLOATING POINT NUMBER *
*	 WILL BE CONVERTED TO A SIGNED 16-BIT (TWOS COMPLEMENT) INTEGER	     *
*	 (-32768 <= X <= -1), AND THE N FLAG WILL BE SET.  THE CONVERTED     *
*	 INTEGER IS RETURNED IN THE DOUBLE ACCUMULATOR D.  TRUNCATION IS     *
*	 ALWAYS TOWARD ZERO, AND THE FRACTIONAL PART OF THE ARGUMENT IS	     *
*	 DISCARDED.  IF THE ARGUMENT IS TOO LARGE OR TOO SMALL, THE CARRY    *
*	 FLAG IS SET AND THE ERROR CODE IS RETURNED IN ACCA.		     *
*									     *
*	 THE SUBROUTINE FLTROUND IS SIMILAR TO FLT2INT EXCEPT THAT IT ROUNDS *
*	 TO THE NEAREST INTEGER INSTEAD OF TRUNCATING THE FRACTIONAL PART.   *
*									     *
******************************************************************************
*
*
*
FLTROUND EQU	*
	 JSR	PSHFPAC2	     ; save fpacc2
	 LDX	#CONSTP5	     ; point to constant 0.5
	 JSR	GETFPAC2	     ; put it into fpacc2
	 TST	MANTSGN1	     ; check for negative argument
	 BEQ	FLTROU1		     ; argument positive - add +0.5
	 COM	MANTSGN2	     ; argument negative - add -0.5
FLTROU1	 JSR	FLTADD		     ; add 0.5 to round
	 JSR	PULFPAC2	     ; restore fpacc2 - fall through to flt2int
*
FLT2INT	 EQU	*
	 CLRA		     ; zero upper byte of d
	 LDAB	FPACC1EX     ; get exponent
	 CMPB	#$7F	     ; check for integral part
	 BHS	FLT2INT1     ; if integral part
	 CLRB		     ; no integral part
	 BRA	FLT2INT4     ; return zero
FLT2INT1 COMB		     ; compute number of shifts required ...
	 ADDD	#$FF90	     ; ... to generate result
	 BLE	FLT2INTE     ; error if > 65535
	 XGDX		     ; save shift counter in x
	 LDD	FPACC1MN     ; get significant part of mantissa
	 BRA	FLT2INT3     ; go do shifting
FLT2INT2 LSRD		     ; shift result
FLT2INT3 DEX		     ; decrement shift counter
	 BNE	FLT2INT2     ; if not done shifting yet
	 TST	MANTSGN1     ; check for positive argument
	 BPL	FLT2INT4     ; if positive, we are done
	 COMA		     ; complement result
	 COMB
	 ADDD	#1	     ; add 1 for twos complement
	 BPL	FLT2INTE     ; if negative result < -32768
FLT2INT4 CLC		     ; no errors
	 RTS
FLT2INTE LDAA	#TOLGSMER    ; number too large or too small
	 SEC		     ; flag error
	 RTS

******************************************************************************
*									     *
*		    FLOATING POINT TO LONG CONVERSION			     *
*									     *
*									     *
*	returns m.s. word in D, l.s. word in srhi and srhi+1.		     *
*									     *
******************************************************************************
*
*
*

FLT2LNG  EQU	*
	 LDD	#0
	 STD	srhi
	 CLRA		     ; zero upper byte of d
	 LDAB	FPACC1EX     ; get exponent
	 CMPB	#$7F	     ; check for integral part
	 BHS	FLT2LNG1     ; exponent is >= 0
	 CLRB
	 BRA	FLT2LNG4     ; if # is less than 1, return 0
FLT2LNG1 COMB		     ; compute number of shifts required ...
	 ADDD	#$FFA0	     ; ... to generate result
	 BLE	FLT2LNGE     ; error if > 65535
	 XGDX		     ; save shift counter in x
	 LDAA	FPACC1MN+2   ; get ls byte of mantissa
	 CLRB
	 STD	srhi
	 LDD	FPACC1MN     ; get significant part of mantissa
	 BRA	FLT2LNG3     ; go do shifting
FLT2LNG2 LSRD		     ; shift result
	 ROR	srhi
	 ROR	srhi+1
FLT2LNG3 DEX		     ; decrement shift counter
	 BNE	FLT2LNG2     ; if not done shifting yet
	 TST	MANTSGN1     ; check for positive argument
	 BPL	FLT2LNG4     ; if positive, we are done
	 COM	srhi	     ; complement result
	 COM	srhi+1
	 COMA
	 COMB
	 LDX	srhi
	 INX
	 STX	srhi
	 BNE	FLT2LNG4
	 ADDD	#1	     ; add 1 for twos complement
	 BPL	FLT2LNGE     ; if negative result < -32768
FLT2LNG4 CLC		     ; no errors
	 RTS
FLT2LNGE LDAA	#TOLGSMER    ; number too large or too small
	 SEC		     ; flag error
	 RTS
*
*
******************************************************************************
*									     *
*     SEPARATE A FLOATING POINT NUMBER INTO INTEGER AND FRACTIONAL PARTS     *
*									     *
*	 THIS SUBROUTINE SEPARATES THE FLOATING POINT NUMBER IN FPACC1 INTO  *
*	 INTEGER AND FRACTIONAL PARTS.	THE FRACTIONAL PART IS RETURNED IN   *
*	 FPACC1, AND THE INTEGER PART IS RETURNED IN FPACC2.		     *
*									     *
******************************************************************************
*
INTFRAC	 EQU	*
	 JSR	TFR1TO2		     ; save argument in fpacc2
	 LDX	#FPACC2MN+2	     ; point to mantissa ls byte
	 LDAA	FPACC2EX	     ; get exponent
	 SUBA	#$97		     ; remove bias + 2^24
	 BPL	FLTSUB		     ; argument is large integer
	 LDAB	#$03		     ; do this 3 times, maximum
INTFRAC1 ADDA	#$08		     ; increase exponent
	 BPL	INTFRAC2	     ; if in range
	 CLR	0,X		     ; clear byte
	 DEX			     ; point to next most significant byte
	 DECB			     ; decrement counter
	 BNE	INTFRAC1	     ; if count not zero
	 CLR	0,X		     ; clear exponent for number less than 1
	 RTS
INTFRAC2 LDAB	#$80		     ; set up mask
INTFRAC3 DECA			     ; decrement counter
	 BMI	INTFRAC4	     ; counter < 0
	 ASRB			     ; shift next bit in mask
	 BRA	INTFRAC3	     ; keep going till counter runs out
INTFRAC4 ANDB	0,X		     ; mask mantissa byte
	 STAB	0,X		     ; save mantissa byte
*			     ; fall through to subtract for fraction part
*
*
*
******************************************************************************
*									     *
*		      FLOATING POINT SUBTRACT SUBROUTINE		     *
*									     *
*	THIS SUBROUTINE PERFORMS FLOATING POINT SUBTRACTION ( FPACC1-FPACC2) *
*	BY INVERTING THE SIGN OF FPACC2 AND THEN CALLING FLTADD SINCE	     *
*	FLTADD PERFORMS COMPLETE SIGNED ADDITION.  UPON RETURNING FROM	     *
*	FLTADD THE SIGN OF FPACC2 IS AGAIN INVERTED TO LEAVE IT UNCHANGED    *
*	FROM ITS ORIGINAL VALUE.					     *
*									     *
*			   WORSE CASE = 601 CYCLES = 301 US @ 2MHZ	     *
*									     *
******************************************************************************
*
*
FLTSUB	 EQU	*
	 BSR	FLTSUB1	     ; invert sign.
	 BSR	FLTADD	     ; go do floating point add.
FLTSUB1	 LDAA	MANTSGN2     ; get fpacc2 mantissa sign.
	 EORA	#$FF	     ; invert the sign.
	 STAA	MANTSGN2     ; put back.
	 RTS
*
*
*
******************************************************************************
*									     *
*			FLOATING POINT ADDITION				     *
*									     *
*	THIS SUBROUTINE PERFORMS FLOATING POINT ADDITION OF THE TWO NUMBERS  *
*	IN FPACC1 AND FPACC2.  THE RESULT OF THE ADDITION IS PLACED IN	     *
*	FPACC1 WHILE FPACC2 REMAINS UNCHANGED.	THIS SUBROUTINE PERFORMS     *
*	FULL SIGNED ADDITION SO EITHER NUMBER MAY BE OF THE SAME OR OPPOSITE *
*	SIGN.								     *
*			   WORSE CASE = 563 CYCLES = 282 US @ 2MHZ	     *
*									     *
******************************************************************************
*
*
FLTADD	 EQU	*
	 LDAA	FPACC1EX     ; load fp1 exponent
	 BNE	FLTADD1	     ; if not zero
TFR2TO1	 LDD	FPACC2EX     ; get fpacc2 exponent & high 8 bit of mantissa.
	 STD	FPACC1EX     ; put it in fpacc1.
	 LDD	FPACC2MN+1   ; get fpacc2 low 16 bits of mantissa.
	 STD	FPACC1MN+1   ; put it in fpacc1.
	 LDAA	MANTSGN2     ; transfer the sign.
	 STAA	MANTSGN1
FLTADDR	 CLRB		     ; no errors.
	 RTS
FLTADD1	 TST	FPACC2EX     ; check fp2 exponent
	 BEQ	FLTADDR	     ; return if zero
	 LDAB	MANTSGN1     ; load sign from 1
	 EORB	MANTSGN2     ; decide to add or subtract
	 SUBA	FPACC2EX     ; compare exponents
	 BCS	FLTADD2	     ; if fpacc2 > fpacc1
	 CMPA	#24	     ; if fpacc1 >> fpacc2
	 BHI	FLTADDR	     ; return underflow
	 PSHY		     ; save y register
	 PSHA		     ; save shift counter
	 LDX	#FPACC2MN    ; addend to be denormalized pointed to by x
	 LDY	#FPACC1MN    ; addend to be left normalized pointed to by y
	 BRA	FLTADD3	     ; go do normalization
FLTADD2	 NEGA		     ; change sign of a for shift counter
	 CMPA	#24	     ; if fpacc2 >> fpacc1
	 BHI	TFR2TO1	     ; put fpacc2 into fpacc1 and return
	 PSHY		     ; save y register
	 PSHA		     ; save shift counter
	 LDAA	FPACC2EX     ; load exponent from 2
	 STAA	FPACC1EX     ; ... and transfer it to 1
	 LDAA	MANTSGN2     ; load sign from 2
	 STAA	MANTSGN1     ; ... and transfer it to 1
	 LDX	#FPACC1MN    ; addend to be denormalized pointed to by x
	 LDY	#FPACC2MN    ; addend to be left normalized pointed to by y
FLTADD3	 TBA		     ; put add/subtract flag byte in both a and b
	 PSHA		     ; create 3 byte stack workspace set to $00 for ...
	 PSHA		     ; ... addition and $ff for subtraction.
	 PSHA
	 EORA	0,X	     ; load mantissa msb; complement if subtraction
	 PSHA		     ; put in stack workspace
	 TBA		     ; put add/subtract flag into a again
	 EORA	1,X	     ; load mantissa nsb; complement if subtraction
	 PSHA		     ; put in stack workspace
	 TBA		     ; put add/subtract flag into a again
	 EORA	2,X	     ; load mantissa lsb; complement if subtraction
	 PSHA		     ; put in stack workspace
	 TSX		     ; put pointer to workspace in x
	 LDAA	6,X	     ; get shift counter
	 STAB	6,X	     ; save add/subtract flag
	 TAB		     ; b register will be byte displacement counter
	 ANDA	#$07	     ; remove byte displacement from a
	 INCA		     ; pre-increment shift counter
	 ANDB	#$18	     ; remove shift displacement from b
	 LSRB		     ; right justify byte displacement counter
	 LSRB
	 LSRB
	 ABX		     ; do byte displacement by adding to pointer
	 LDAB	3,X	    ; load add/subtract flag (ok since flag in 4 bytes)
FLTADD4	 DECA		     ; decrement byte shift counter
	 BEQ	FLTADD5	     ; if done shifting
	 RORB		     ; shift add/subtract flag into carry
	 ROR	2,X	     ; shift mantissa msb
	 ROR	1,X	     ; shift mantissa nsb
	 ROR	0,X	     ; shift mantissa lsb
	 BRA	FLTADD4	     ; go around again
FLTADD5	 RORB		     ; shift add/subtract flag into carry
	 LDAA	2,Y	     ; load normalized addend lsb
	 ADCA	0,X	     ; add in denormalized addend lsb
	 STAA	FPACC1MN+2   ; store normalized sum lsb
	 LDAA	1,Y	     ; load normalized addend nsb
	 ADCA	1,X	     ; add in denormalized addend nsb
	 STAA	FPACC1MN+1   ; store normalized sum nsb
	 LDAA	0,Y	     ; load normalized addend nsb
	 ADCA	2,X	     ; add in denormalized addend nsb
	 STAA	FPACC1MN     ; store normalized sum msb
	 TSX		     ; restore workspace pointer
	 LDAA	6,X	     ; get back add/subtract flag
	 BMI	FLTADD6	     ; operation was subtraction
	 BCC	FLTADD7	     ; if add and no carry, do nothing
	 ROR	FPACC1MN     ; carry was set; rotate to normalize overflow
	 ROR	FPACC1MN+1
	 ROR	FPACC1MN+2
	 INC	FPACC1EX     ; now increment exponent to accomodate shift
	 BNE	FLTADD7	     ; successful completion
	 LDD	#RTNMAX	     ; overflow - return maximum number
	 BRA	FLTADD11
FLTADD6	 BCS	FLTADD8	     ; no sign change
	 COM	MANTSGN1     ; change sign of result
	 NEG	FPACC1MN+2   ; change sign of lsb
	 BCC	FLTADD12     ; if lsb was zero
	 INC	FPACC1MN+1   ; carry from lsb
	 BNE	FLTADD12     ; if nsb not zero
	 INC	FPACC1MN     ; carry from nsb
FLTADD12 NEG	FPACC1MN+1   ; change sign of nsb
	 BCC	FLTADD13     ; if nsb was zero
	 INC	FPACC1MN     ; carry from nsb
FLTADD13 NEG	FPACC1MN     ; change sign of msb
FLTADD8	 TST	FPACC1MN     ; is mantissa normalized?
	 BMI	FLTADD7	     ; yes - done
	 BNE	FLTADD9	     ; do bit shift
	 LDAA	FPACC1EX     ; decrement exponent by 8 for byte shift
	 SUBA	#8
	 BLS	FLTADD10     ; if underflow
	 STAA	FPACC1EX     ; replace decremented exponent
	 LDD	FPACC1MN+1   ; do byte shift
	 BEQ	FLTADD10     ; if result mantissa is zero
	 CLR	FPACC1MN+2   ; clear byte 3
	 STD	FPACC1MN     ; store bytes 1 and 2
	 BRA	FLTADD8
FLTADD9	 DEC	FPACC1EX     ; decrement exponent to accomodate shift
	 BEQ	FLTADD10     ; if underflow
	 LSL	FPACC1MN+2   ; do bit shift
	 ROL	FPACC1MN+1
	 ROL	FPACC1MN
	 BPL	FLTADD9
FLTADD7	 LDY	7,X	     ; pull y from stack
	 LDAB	#9	     ; restore stack - add 7 to x (stack base)
	 ABX		     ; do addition
	 TXS		     ; new stack base (effectively pulled stack)
	 CLRB		     ; no errors
	 RTS
*
FLTADD10 LDD	#RTNZERO     ; underflow - return zero
FLTADD11 LDY	7,X	     ; pull y from stack
	 STD	7,X	     ; put return address on stack
	 LDAB	#7	     ; restore stack - add 5 to x (stack base)
	 ABX		     ; do addition
	 TXS		     ; new stack base (effectively pulled stack)
	 RTS
*
*
*
******************************************************************************
*									     *
*			  FLOATING POINT DIVIDE				     *
*									     *
*	 THIS SUBROUTINE PERFORMS SIGNED FLOATING POINT DIVIDE. THE	     *
*	 OPERATION PERFORMED IS FPACC1/FPACC2.	THE DIVISOR (FPACC2) IS LEFT *
*	 UNALTERED AND THE ANSWER IS PLACED IN FPACC1.	THERE ARE SEVERAL    *
*	 ERROR CONDITIONS THAT CAN BE RETURNED BY THIS ROUTINE.	 THEY ARE:   *
*	 A) DIVISION BY ZERO.  B) OVERFLOW.  C) UNDERFLOW.  AS WITH ALL	     *
*	 OTHER ROUTINES, AN ERROR IS INDICATED BY THE CARRY BEING SET AND    *
*	 THE ERROR CODE BEING IN THE A-REG.				     *
*									     *
*			   WORSE CASE = 495 CYCLES = 248 US @ 2MHZ	     *
*									     *
******************************************************************************
*
*
FLTDIV	 EQU	*
	 LDAA	MANTSGN2     ; get fpacc2 mantissa sign.
	 EORA	MANTSGN1     ; set the sign of the result.
	 STAA	MANTSGN1     ; save the result.
	 TST	FPACC2EX     ; is the divisor 0?
	 BNE	FLTDIV1	     ; no. go see if the dividend is zero.
	 LDAA	#DIV0ERR     ; yes. return a divide by zero error.
	 JMP	RTNDIV0	     ; flag error and return.
FLTDIV1	 TST	FPACC1EX     ; is the dividend 0?
	 BNE	FLTDIV2	     ; no. go perform the divide.
	 CLRB		     ; yes. answer is zero. no errors.
	 CLR	MANTSGN1     ; sign of zero is positive.
	 RTS
FLTDIV2	 LDAA	FPACC1EX     ; now compute exponent - get numerator exponent
	 SUBA	FPACC2EX     ; subtract denominator exponent
	 BHS	FLTDIV8	     ; if carry clear, result must be positive
	 BMI	FLTDIV6	     ; result in range
	 JMP	RTNZERO	     ; underflow - return zero
FLTDIV8	 BMI	FLTDIV7	     ; overflow - return max. number
FLTDIV6	 ADDA	#$7E	     ; put back exponent bias
	 STAA	FPACC1EX     ; store corrected quotient exponent
	 LDD	FPACC1MN    ; to do divide, numerator mantissa must be less ...
	 SUBD	FPACC2MN     ; ... than denominator mantissa.
	 BMI	FLTDIV3	   ; branch if numerator less than denominator mantissa
	 BNE	FLTDIV4	     ; test lsbs only if numerator = denominator
	 LDAA	FPACC1MN+2   ; check lsbs since bytes 1 and 2 of ...
	 SUBA	FPACC2MN+2   ; numerator and denominator are same.
	 BMI	FLTDIV3	   ; branch if numerator less than denominator mantissa
FLTDIV4	 LDD	FPACC1MN    ; divide numerator by 2 so it is smaller than denom
	 LSRD		     ; shift to divide bytes 1 and  2
	 ROR	FPACC1MN+2   ; shift byte 3
	 STD	FPACC1MN     ; put bytes 1 and 2 back
	 INC	FPACC1EX     ; now increment exponent
	 BNE	FLTDIV3	     ; check for overflow
FLTDIV7	 JMP	RTNMAX	     ; return maximum magnitude number
FLTDIV3	 LDD	FPACC1MN     ; get partial numerator
	 LDX	FPACC2MN     ; get partial denominator
	 INX		     ; partial quotient must be less than full quotient
	 BNE	FLTDIV5	     ; if x register rolled over, we blew it ...
	 DEX		     ; ... so restore x register to where it was
FLTDIV5	 FDIV		     ; compute partial quotient
	 PSHY		     ; save y register
	 LDY	FPACC1MN     ; temporary storage for numerator
	 STX	FPACC1MN     ; partial quotient to multiply by denominator
	 PSHX		     ; save partial quotient
	 LDX	#0	     ; set up work space on the stack.
	 PSHX
	 PSHX
	 TSX		     ; set up pointer to work space.
	 LDAA	FPACC2MN+2   ; multiply denominator ls byte ...
	 LDAB	FPACC1MN+1   ; ... by numerator ls byte
	 MUL
	 STAA	3,X	     ; save partial result on stack
	 JSR	REMCOMP	     ; jump into floating multiply to finish operation
	 STY	FPACC1MN     ; restore numerator
	 LDD	FPACC1MN+1   ; move numerator bytes 2 and 3 to d
	 SUBD	1,X	   ; subtract to compute remainder (assume byte 1 same)
	 LDX	FPACC2MN     ; load denominator
	 FDIV		     ; divide remainder by denominator
	 STX	FPACC1MN+1   ; store second partial product
	 CLR	FPACC1MN     ; ms byte of second partial product is zero
	 PULX		     ; scrap stack workspace
	 PULX
	 PULA		     ; retrieve first partial product
	 PULB
	 PULY		     ; retrieve y register
	 ADDD	FPACC1MN     ; add to second partial product to get quotient
	 STD	FPACC1MN     ; save quotient in floating accumulator
	 CLRB		     ; no errors
	 RTS
*
*
*
******************************************************************************
*									     *
*		 FLOATING POINT TO ASCII CONVERSION SUBROUTINE		     *
*									     *
*	 THIS SUBROUTINE PERFORMS FLOATING POINT TO ASCII CONVERSION OF	     *
*	 THE NUMBER IN FPACC1.	THE ASCII STRING IS PLACED IN A BUFFER	     *
*	 POINTED TO BY THE X INDEX REGISTER.  THE BUFFER MUST BE AT LEAST    *
*	 14 BYTES LONG TO CONTAIN THE ASCII CONVERSION.	 THE RESULTING	     *
*	 ASCII STRING IS TERMINATED BY A ZERO (0) BYTE.	 UPON EXIT THE	     *
*	 X INDEX REGISTER WILL BE POINTING TO THE FIRST CHARACTER OF THE     *
*	 STRING.  FPACC1 AND FPACC2 WILL REMAIN UNCHANGED.		     *
*									     *
******************************************************************************
*
*
FLTASC	 EQU	*
	 PSHX		     ; save the pointer to the string buffer.
	 LDX	#FPACC1EX    ; point to fpacc1.
	 JSR	CHCK0	     ; is fpacc1 0?
	 BNE	FLTASC1	     ; no. go convert the number.
	 PULX		     ; restore pointer.
	 LDD	#$3000	     ; get ascii character + terminating byte.
	 STD	0,X	     ; put it in the buffer.
	 RTS
FLTASC1	 LDX	FPACC1EX     ; save fpacc1.
	 PSHX
	 LDX	FPACC1MN+1
	 PSHX
	 LDAA	MANTSGN1
	 PSHA
	 JSR	PSHFPAC2     ; save fpacc2.
	 LDX	#0
	 PSHX		     ; allocate locals.
	 PSHX
	 PSHX		     ; save space for string buffer pointer.
	 TSY		     ; point to locals.
	 LDX	15,Y	     ; get pointer from stack.
	 LDAA	#$20	    ; put a space in the buffer if number not negative.
	 TST	MANTSGN1     ; is it negative?
	 BEQ	FLTASC2	     ; no. go put space.
	 CLR	MANTSGN1     ; make number positive for rest of conversion.
	 LDAA	#'-'	     ; yes. put minus sign in buffer.
FLTASC2	 STAA	0,X
	 INX		     ; point to next location.
	 STX	0,Y	     ; save pointer.
FLTASC5	 LDX	#N9999999    ; point to constant 9999999.
	 JSR	GETFPAC2     ; get into fpacc2.
	 JSR	FLTCMP	     ; compare the numbers. is fpacc1 > 9999999?
	 BGT	FLTASC3	     ; yes. go divide fpacc1 by 10.
	 LDX	#P9999999    ; point to constant 999999.9
	 JSR	GETFPAC2     ; move it into fpacc2.
	 JSR	FLTCMP	     ; compare numbers. is fpacc1 > 999999.9?
	 BGT	FLTASC4	     ; yes. go continue the conversion.
	 DEC	2,Y	     ; decrement the mult./div. count.
	 LDX	#CONST10     ; no. multiply by 10. point to constant.
FLTASC6	 JSR	GETFPAC2     ; move it into fpacc2.
	 JSR	FLTMUL
	 BRA	FLTASC5	     ; go do compare again.
FLTASC3	 INC	2,Y	     ; increment the mult./div. count.
	 LDX	#CONSTP1     ; point to constant ".1".
	 BRA	FLTASC6	     ; go divide fpacc1 by 10.
FLTASC4	 LDX	#CONSTP5     ; point to constant of ".5".
	 JSR	GETFPAC2     ; move it into fpacc2.
	 JSR	FLTADD	     ; add .5 to number in fpacc1 to round it.
	 LDAB	FPACC1EX     ; get fpacc1 exponent.
	 SUBB	#$7F	     ; take out bias.
	 NEGB		     ; make it negative.
	 ADDB	#23	     ; add in the number of mantissa bits -1.
	 BRA	FLTASC17     ; go check to see if we need to shift at all.
FLTASC7	 LSR	FPACC1MN     ; shift mantissa to the right by the result (make
	 ROR	FPACC1MN+1   ; the number an integer).
	 ROR	FPACC1MN+2
	 DECB		     ; done shifting?
FLTASC17 BNE	FLTASC7	     ; no. keep going.
	 LDAA	#1	     ; get initial value of "digits after d.p." count.
	 STAA	3,Y	     ; initialize it.
	 LDAA	2,Y	     ; get decimal exponent.
	 ADDA	#8	     ; add the number of decimal +1 to the exponent.
*			     ; was the original number > 9999999?
	 BMI	FLTASC8	     ; yes. must be represented in scientific notation.
	 CMPA	#8	     ; was the original number < 1?
	 BHS	FLTASC8	     ; yes. must be represented in scientific notation.
	 DECA		     ; no. number can be represented in 7 digits.
	 STAA	3,Y	     ; make the decimal exponent the digit count before
*			     ; the decimal point.
	 LDAA	#2	     ; setup to zero the decimal exponent.
FLTASC8	 SUBA	#2	     ; subtract 2 from the decimal exponent.
	 STAA	2,Y	     ; save the decimal exponent.
	 TST	3,Y	     ; does the number have an integer part? (exp. >0)
	 BGT	FLTASC9	     ; yes. go put it out.9
	 LDAA	#'.'	     ; no. get decimal point.
	 LDX	0,Y	     ; get pointer to buffer.
	 STAA	0,X	     ; put the decimal point in the buffer.
	 INX		     ; point to next buffer location.
	 TST	3,Y	     ; is the digit count till exponent =0?
	 BEQ	FLTASC18     ; no. number is <.1
	 LDAA	#'0'	     ; yes. format number as .0xxxxxxx
	 STAA	0,X	     ; put the 0 in the buffer.
	 INX		     ; point to the next location.
FLTASC18 STX	0,Y	     ; save new pointer value.
FLTASC9	 LDX	#DECDIG	     ; point to the table of decimal digits.
	 LDAA	#7	     ; initialize the the number of digits count.
	 STAA	5,Y
FLTASC10 CLR	4,Y	     ; clear the decimal digit accumulator.
FLTASC11 LDD	FPACC1MN+1   ; get lower 16 bits of mantissa.
	 SUBD	1,X	     ; subtract lower 16 bits of constant.
	 STD	FPACC1MN+1   ; save result.
	 LDAA	FPACC1MN     ; get upper 8 bits.
	 SBCA	0,X	     ; subtract upper 8 bits.
	 STAA	FPACC1MN     ; save result. underflow?
	 BCS	FLTASC12     ; yes. go add decimal number back in.
	 INC	4,Y	     ; add 1 to decimal number.
	 BRA	FLTASC11     ; try another subtraction.
FLTASC12 LDD	FPACC1MN+1   ; get fpacc1 mantissa low 16 bits.
	 ADDD	1,X	     ; add low 16 bits back in.
	 STD	FPACC1MN+1   ; save the result.
	 LDAA	FPACC1MN     ; get high 8 bits.
	 ADCA	0,X	     ; add in high 8 bits of constant.
	 STAA	FPACC1MN     ; save result.
	 LDAA	4,Y	     ; get digit.
	 ADDA	#$30	     ; make it ascii.
	 PSHX		     ; save pointer to constants.
	 LDX	0,Y	     ; get pointer to buffer.
	 STAA	0,X	     ; put digit in buffer.
	 INX		     ; point to next buffer location.
	 DEC	3,Y	     ; should we put a decimal point in the buffer yet?
	 BNE	FLTASC16     ; no. continue the conversion.
	 LDAA	#'.'	     ; yes. get decimal point.
	 STAA	0,X	     ; put it in the buffer.
	 INX		     ; point to the next buffer location.
FLTASC16 STX	0,Y	     ; save updated pointer.
	 PULX		     ; restore pointer to constants.
	 INX		     ; point to next constant.
	 INX
	 INX
	 DEC	5,Y	     ; done yet?
	 BNE	FLTASC10     ; no. continue conversion of "mantissa".
	 LDX	0,Y	     ; yes. point to buffer string buffer.
FLTASC13 DEX		     ; point to last character put in the buffer.
	 LDAA	0,X	     ; get it.
	 CMPA	#$30	     ; was it an ascii 0?
	 BEQ	FLTASC13     ; yes. remove trailing zeros.
	 INX		     ; point to next available location in buffer.
	 LDAB	2,Y	     ; do we need to put out an exponent?
	 BEQ	FLTASC15     ; no. we're done.
	 LDAA	#'E'	     ; yes. put an 'e' in the buffer.
	 STAA	0,X
	 INX		     ; point to next buffer location.
	 LDAA	#'+'	     ; assume exponent is positive.
	 STAA	0,X	     ; put plus sign in the buffer.
	 TSTB		     ; is it really minus?
	 BPL	FLTASC14     ; no. is's ok as is.
	 NEGB		     ; yes. make it positive.
	 LDAA	#'-'	     ; put the minus sign in the buffer.
	 STAA	0,X
FLTASC14 INX		     ; point to next buffer location.
	 STX	0,Y	     ; save pointer to string buffer.
	 CLRA		     ; set up for divide.
	 LDX	#10	     ; divide decimal exponent by 10.
	 IDIV
	 PSHB		     ; save remainder.
	 XGDX		     ; put quotient in d.
	 ADDB	#$30	     ; make it ascii.
	 LDX	0,Y	     ; get pointer.
	 STAB	0,X	     ; put number in buffer.
	 INX		     ; point to next location.
	 PULB		     ; get second digit.
	 ADDB	#$30	     ; make it ascii.
	 STAB	0,X	     ; put it in the buffer.
	 INX		     ; point to next location.
FLTASC15 CLR	0,X	     ; terminate string with a zero byte.
	 PULX		     ; clear locals from stack.
	 PULX
	 PULX
	 JSR	PULFPAC2     ; restore fpacc2.
	 PULA
	 STAA	MANTSGN1
	 PULX		     ; restore fpacc1.
	 STX	FPACC1MN+1
	 PULX
	 STX	FPACC1EX
	 PULX		     ; point to the start of the ascii string.
	 RTS
*
*
DECDIG	 EQU	*
	 FCB	$0F,$42,$40  ; decimal 1,000,000
	 FCB	$01,$86,$A0  ; decimal	 100,000
	 FCB	$00,$27,$10  ; decimal	  10,000
	 FCB	$00,$03,$E8  ; decimal	   1,000
	 FCB	$00,$00,$64  ; decimal	     100
	 FCB	$00,$00,$0A  ; decimal	      10
	 FCB	$00,$00,$01  ; decimal	       1
*
*
P9999999 EQU	*	     ; constant 999999.9
	 FCB	$49,$74,$23,$FE
*
N9999999 EQU	*	     ; constant 9999999.
	 FCB	$4B,$18,$96,$7F
*
*
*
******************************************************************************
*									     *
*		 FLOATING POINT COMPARE SUBROUTINE			     *
*									     *
*	 THIS SUBROUTINE PERFORMS FLOATING POINT COMPARISON OF THE ARGUMENTS *
*	 IN FPACC1 AND FPACC2.	THE ROUTINE RETURNS Z = 1 IF FPACC1 = FPACC2 *
*	 AND Z = 0 OTHERWISE; n = 1 if fpacc1 < fpacc2 and n = 0 otherwise;  *
*	 C = 0, AND V = 0 IN THE CONDITION CODE REGISTER.  THE RESULTS OF    *
*	 THIS COMPARISON MAY BE TESTED WITH THE TWOS COMPLEMENT SIGNED	     *
*	 NUMBER CONDITIONAL BRANCH INSTRUCTIONS BLE, BLT, BEQ, BNE, BGT, AND *
*	 BGE.  FPACC1 AND FPACC2 WILL REMAIN UNCHANGED.			     *
*									     *
******************************************************************************
*
*
FLTCMP	 EQU	*
	 LDAA	MANTSGN2     ; is fpacc2 negative?
	 BPL	FLTCMP2	     ; no. continue with compare.
	 LDAB	MANTSGN1     ; is fpacc1 negative?
	 BPL	FLTCMP2	     ; no. continue with compare.
	 LDD	FPACC2EX     ; yes. both are negative so compare must be done
	 CPD	FPACC1EX     ; backwards. are they equal so far?
	 BNE	FLTCMP1	     ; no. return with condition codes set.
	 LDD	FPACC2MN+1   ; yes. compare lower 16 bits of mantissas.
	 CPD	FPACC1MN+1
	 BRA	FLTCMP1
FLTCMP2	 CMPA	MANTSGN1     ; both positive?
	 BNE	FLTCMP1	     ; no. return with condition codes set.
	 LDD	FPACC1EX     ; get fpacc1 exponent & upper 8 bits of mantissa.
	 CPD	FPACC2EX     ; same as fpacc2?
	 BNE	FLTCMP1	     ; no. return with condition codes set.
	 LDD	FPACC1MN+1   ; get fpacc1 lower 16 bits of mantissa.
	 CPD	FPACC2MN+1   ; compare with fpacc2 lower 16 bits of mantissa.
FLTCMP1	 TPA		     ; get condition codes so we can manipulate bits
	 ANDA	#$F4	     ; clear overflow, negative, and carry bits
	 BCC	FLTCMP3	     ; if no carry
	 ORAA	#$08	     ; set negative bit
FLTCMP3	 TAP		     ; put condition codes back
	 RTS
*
*
*
******************************************************************************
*									     *
*		      UNSIGNED INTEGER TO FLOATING POINT		     *
*									     *
*	 THIS SUBROUTINE PERFORMS "UNSIGNED" INTEGER TO FLOATING POINT	     *
*	 CONVERSION OF A 16 BIT WORD.  THE 16 BIT INTEGER MUST BE IN THE     *
*	 DOUBLE ACCUMULATOR D.	THE RESULTING FLOATING POINT NUMBER IS	     *
*	 RETURNED IN FPACC1.						     *
*									     *
******************************************************************************
*
*
UINT2FLT EQU	*
	 LDX	#$008E	     ; load sign and exponent
SINTFLT1 ADDD	#0	     ; check for zero and check normalization
	 BNE	UINTFLT2     ; not zero
	 JMP	RTNZERO	     ; zero - return floating zero
UINTFLT1 DEX		     ; decrement exponent
	 LSLD		     ; multiply mantissa by 2
UINTFLT2 BPL	UINTFLT1     ; keep going if not normalized
	 STD	FPACC1MN     ; save mantissa
	 CLR	FPACC1MN+2   ; mantissa lsb is always zero
	 XGDX		     ; get sign and exponent bytes
	 STAA	MANTSGN1     ; save sign byte
	 STAB	FPACC1EX     ; save exponent byte
	 CLRB		     ; no errors.
	 RTS
*
*
*
******************************************************************************
*									     *
*		       SIGNED INTEGER TO FLOATING POINT			     *
*									     *
*	 THIS ROUTINE WORKS JUST LIKE THE UNSIGNED INTEGER TO FLOATING	     *
*	 POINT ROUTINE EXCEPT THE THE 16 BIT INTEGER IN THE DOUBLE ACCUM-    *
*	 ULATOR D IS CONSIDERED TO BE IN TWO'S COMPLEMENT FORMAT.  THIS	     *
*	 WILL RETURN A FLOATING POINT NUMBER IN THE RANGE -32768 TO +32767.  *
*									     *
******************************************************************************
*
*
SINT2FLT EQU	*
	 TSTA		     ; check for negative integer
	 BPL	UINT2FLT     ; number is positive - treat it like unsigned
	 COMA		     ; take twos complement to make positive
	 COMB
	 ADDD	#1
	 LDX	#$FF8E	     ; load sign and exponent
	 BRA	SINTFLT1     ; continue with conversion

*
*
*
******************************************************************************
*									     *
*		      UNSIGNED LONG TO FLOATING POINT		             *
*									     *
*	 This subroutine performs "unsigned" long to floating point	     *
*	 conversion of a 32 bit word.  The 32 bit long must be in the        *
*	 double accumulator D and "srhi". Resulting floating point number is *
*	 returned in FPACC1.						     *
*									     *
******************************************************************************
*
*
ULNG2FLT EQU	*
	 LDX	#$009E	     ; load sign and exponent
SLNGFLT1 ADDD	#0	     ; check for zero and check normalization
	 BNE	ULNGFLT2     ; not zero
	 LDY	srhi
	 BNE	ULNGFLT2     ; not zero
	 JMP	RTNZERO	     ; zero - return floating zero
ULNGFLT1 DEX		     ; decrement exponent
	 LSL	srhi+1
	 ROL	srhi
	 ROLB
	 ROLA		     ; multiply mantissa by 2
ULNGFLT2 BPL	ULNGFLT1     ; keep going if not normalized
	 STD	FPACC1MN     ; save mantissa
	 LDAA	srhi
	 STAA	FPACC1MN+2   ; mantissa lsb
	 XGDX		     ; get sign and exponent bytes
	 STAA	MANTSGN1     ; save sign byte
	 STAB	FPACC1EX     ; save exponent byte
	 CLRB		     ; no errors.
	 RTS
*
*
*
******************************************************************************
*									     *
*		       SIGNED LONG TO FLOATING POINT			     *
*									     *
*	 THIS ROUTINE WORKS JUST LIKE THE UNSIGNED LONG TO FLOATING	     *
*	 POINT ROUTINE EXCEPT THE 32 BIT LONG IN THE DOUBLE ACCUM-           *
*	 ULATOR D AND SRHI IS CONSIDERED TO BE IN TWO'S COMPLEMENT FORMAT.   *
*									     *
******************************************************************************
*
*
SLNG2FLT EQU	*
	 TSTA		     ; check for negative integer
	 BPL	ULNG2FLT     ; number is positive - treat it like unsigned
	 COM	srhi	     ; complement result
	 COM	srhi+1
	 COMA
	 COMB
	 LDX	srhi
	 INX
	 STX	srhi
	 BNE	SLNGFLT2
	 ADDD	#1	     ; add 1 for twos complement
SLNGFLT2
	 LDX	#$FF9E	     ; load sign and exponent
	 BRA	SLNGFLT1     ; continue with conversion

*
*
*
******************************************************************************
*									     *
*			  SQUARE ROOT SUBROUTINE			     *
*									     *
*	 THIS ROUTINE IS USED TO CALCULATE THE SQUARE ROOT OF THE FLOATING   *
*	 POINT NUMBER IN FPACC1.  IF THE NUMBER IN FPACC1 IS NEGATIVE AN     *
*	 ERROR IS RETURNED.						     *
*									     *
*			   WORSE CASE = 16354 CYCLES = 8177 US @ 2MHZ	     *
*									     *
******************************************************************************
*
*
FLTSQR	 EQU	*
	 LDX	#FPACC1EX    ; point to fpacc1.
	 JSR	CHCK0	     ; is it zero?
	 BNE	FLTSQR1	     ; no. check for negative.
	 RTS
FLTSQR1	 TST	MANTSGN1     ; is the number negative?
	 BPL	FLTSQR2	     ; no. go take its square root.
	 LDAA	#NSQRTERR    ; yes. error.
	 SEC		     ; flag error.
	 RTS
FLTSQR2	 JSR	PSHFPAC2     ; save fpacc2.
	 LDAA	#4	     ; get iteration loop count.
	 PSHA		     ; save it on the stack.
	 LDX	FPACC1MN+1   ; save initial number.
	 PSHX
	 LDX	FPACC1EX
	 PSHX
	 TSY		     ; point to it.
	 BSR	TFR1TO2	     ; transfer fpacc1 to fpacc2.
	 LDAA	FPACC2EX     ; get fpacc1 exponent.
	 SUBA	#$7E	     ; remove bias from exponent.
	 INCA		    ; compensate for odd exponents (gives closer guess)
	 BPL	FLTSQR3	     ; if number >1 divide exponent by 2 & add bias.
	 LSRA		     ; if <1 just divide it by 2.
	 BRA	FLTSQR4	     ; go calculate the square root.
FLTSQR3	 LSRA		     ; divide exponent by 2.
	 ADDA	#$7E	     ; add bias back in.
FLTSQR4	 STAA	FPACC2EX     ; save exponent/2.
FLTSQR5	 JSR	FLTDIV	     ; divide the original number by the guess.
	 JSR	FLTADD	     ; add the "guess" to the quotient.
	 DEC	FPACC1EX     ; divide the result by 2 to produce a new guess.
	 BSR	TFR1TO2	     ; put the new guess into fpacc2.
	 LDD	0,Y	     ; get the original number.
	 STD	FPACC1EX     ; put it back in fpacc1.
	 LDD	2,Y	     ; get mantissa lower 16 bits.
	 STD	FPACC1MN+1
	 DEC	4,Y	     ; been through the loop 4 times?
	 BNE	FLTSQR5	     ; no. keep going.
	 LDD	FPACC2EX     ; the final guess is the answer.
	 STD	FPACC1EX     ; put it in fpacc1.
	 LDD	FPACC2MN+1
	 STD	FPACC1MN+1
	 PULX		     ; get rid of original number.
	 PULX
	 INS		     ; get rid of loop count variable.
	 JSR	PULFPAC2     ; restore fpacc2.
	 CLRB		     ; no errors.
	 RTS
*
*
TFR1TO2	 EQU	*
	 LDD	FPACC1EX     ; get fpacc1 exponent & high 8 bit of mantissa.
	 STD	FPACC2EX     ; put it in fpacc2.
	 LDD	FPACC1MN+1   ; get fpacc1 low 16 bits of mantissa.
	 STD	FPACC2MN+1   ; put it in fpacc2.
	 LDAA	MANTSGN1     ; transfer the sign.
	 STAA	MANTSGN2
	 RTS
*
*
*
******************************************************************************
*									     *
*			 FLOATING POINT EXP(X) AND 10^X			     *
*									     *
******************************************************************************
*
*
FLT10TX	 EQU	*
	 JSR	PSHFPAC2     ; save fpacc2
	 LDX	#N1DLN10     ; point to 1/ln(10)
	 JSR	GETFPAC2     ; put it in fpacc2
	 JSR	FLTDIV	     ; compute log base 10
	 JSR	PULFPAC2     ; restore fpacc2
FLTETOX	 EQU	*
	 LDD	FPACC1EX     ; get argument exponent and mantissa msb
	 CPD	#$85B3	     ; check for argument in range (< 89.0)
	 BMI	FLTETOX1     ; in range
	 TST	MANTSGN1     ; check for negative argument
	 BNE	FLTETOX0     ; negative argument - underflow
	 JMP	RTNMAX	     ; overflow
FLTETOX0 JMP	RTNZERO	     ; underflow
FLTETOX1 JSR	PSHFPAC2     ; save fpacc2
	 LDAA	MANTSGN1     ; save sign of argument for later
	 PSHA
	 CLR	MANTSGN1     ; work with positive argument
	 JSR	INTFRAC	     ; separate it into integral and fractional parts
	 LDD	FPACC2EX     ; get exponent of integer in a; mantissa in b
	 BEQ	FLTETOX6     ; if no integral part of argument
	 SUBA	#$86	     ; set up shift counter
FLTETOX5 LSRB		     ; shift to denormalize integer
	 INCA		     ; increment counter
	 BNE	FLTETOX5     ; if not finished shifting
FLTETOX6 INCB		     ; integral part of arg becomes iteration counter
	 PSHB		     ; save integral part for now
	 LDX	#ETOXTBL     ; point to coefficient table
	 JSR	POLYNOM	     ; evaluate fractional part of e^x
	 LDX	#NCONSTE     ; point to constant e (2.71828)
	 JSR	GETFPAC2     ; put it into fpacc2
	 BRA	FLTETOX2     ; go do multiplication iteration
FLTETOX3 JSR	FLTMUL	     ; multiply result by e
FLTETOX2 TSX		     ; get back pointer to iteration counter
	 DEC	0,X	     ; decrement iteration counter
	 BNE	FLTETOX3     ; if iteration counter not zero, keep going
	 PULA		     ; discard iteration counter
	 PULA		     ; retrieve sign of original argument
	 TSTA		     ; was it positive?
	 BPL	FLTETOX4     ; yes - done
FLTRCP1	 JSR	TFR1TO2	     ; take reciprocal of result - move it to fpacc2
	 LDX	#ONE	     ; point to constant 1.0
	 JSR	GETFPAC1     ; put it in fpacc1
	 JSR	FLTDIV	     ; take reciprocal
FLTETOX4 JSR	PULFPAC2     ; restore fpacc2
	 CLRB		     ; no errors
	 RTS
*
FLTRECIP EQU	*
	 JSR	PSHFPAC2     ; save fpacc2
	 BRA	FLTRCP1	     ; do reciprocal
*
NCONSTE	 FCB	$40,$2D,$F8,$54
*
ETOXTBL	 EQU	*
	 FCB	$36,$38,$EF,$1D		; +(1/9!)
	 FCB	$37,$D0,$0D,$01		; +(1/8!)
	 FCB	$39,$50,$0D,$01		; +(1/7!)
	 FCB	$3A,$B6,$0B,$61		; +(1/6!)
	 FCB	$3C,$08,$88,$89		; +(1/5!)
	 FCB	$3D,$2A,$AA,$AB		; +(1/4!)
	 FCB	$3E,$2A,$AA,$AB		; +(1/3!)
CONSTP5	 FCB	$3F,$00,$00,$00		; +(1/2!)
	 FCB	$3F,$80,$00,$00		; +(1/1!)
	 FCB	$3F,$80,$00,$00		; +(1/0!)
	 FCB	$FF
*
*
******************************************************************************
*									     *
*			 FLOATING POINT X ^ Y				     *
*									     *
*	 X IS IN FPACC1, Y IS IN FPACC2					     *
*									     *
******************************************************************************
*
*
FLTXTOY	 EQU	*
	 JSR	FLTLN
	 JSR	FLTMUL
	 JMP	FLTETOX
*
*
*
******************************************************************************
*									     *
*			 FLOATING POINT NATURAL LOG AND LOG BASE 10	     *
*									     *
******************************************************************************
*
*
FLTLGT	 EQU	*
	 BSR	FLTLN	     ; first find natural log
	 JSR	PSHFPAC2     ; save fpacc2
	 LDX	#N1DLN10     ; point to 1/ln(10)
	 JSR	GETFPAC2     ; put it in fpacc2
	 JSR	FLTMUL	     ; compute log base 10
	 JSR	PULFPAC2     ; restore fpacc2
	 CLRB		     ; no errors
	 RTS
*
FLTLN	 EQU	*
	 LDAA	MANTSGN1     ; check for negative
	 BEQ	LN1	     ; not negative
LN0	 LDAA	#LNNEGERR    ; negative or zero argument return
	 SEC		     ; signal error
	 RTS
LN1	 LDAA	FPACC1EX     ; check for zero
	 BEQ	LN0	     ; zero - return error
	 JSR	PSHFPAC2     ; save accumulator 2
	 PSHX		   ; create stack storage space for intermediate result
	 PSHX
	 TSX		     ; create pointer to intermediate result
	 JSR	PUTFPAC1     ; save argument
	 CLRA		     ; get exponent of argument into d to convert ...
	 LDAB	FPACC1EX     ; ... to floating point.
	 SUBB	#$7F	   ; convert exponent from excess 127 to 2's complement
	 BPL	LN2	     ; if exponent is positive, no need to extend sign
	 COMA		     ; extend sign through msb of d register
LN2	 JSR	SINT2FLT     ; do integer to floating point conversion
	 LDX	#NLN2	     ; point to constant ln(2)
	 JSR	GETFPAC2     ; put it into fpacc2
	 JSR	FLTMUL	     ; now have part of answer dependent on exponent
	 TSX		     ; get back temporary storage pointer
	 JSR	GETFPAC2     ; load original argument
	 JSR	PUTFPAC1     ; save partial result
	 LDAA	#$7F	     ; since we have log of exponent, take log of ...
	 STAA	FPACC2EX     ; ... mantissa with zero exponent.
	 PSHX		     ; create storage space for mantissa
	 PSHX
	 TSX		     ; get pointer to new storage
	 JSR	PUTFPAC2     ; save mantissa (m)
	 LDX	#ONE	     ; point to constant one
	 JSR	GETFPAC1     ; put it into fpacc1
	 JSR	FLTADD	     ; (m+1)
	 TSX		     ; get mantissa pointer back
	 JSR	GETFPAC2     ; (m)
	 JSR	PUTFPAC1     ; (m+1)
	 LDX	#MONE	     ; point to constant minus one
	 JSR	GETFPAC1     ; put it into fpacc1
	 JSR	FLTADD	     ; (m-1)
	 TSX		     ; get pointer to (m+1)
	 JSR	GETFPAC2     ; put it into fpacc2
	 JSR	FLTDIV	     ; (m-1)/(m+1)
	 TSX		     ; point to temporary storage
	 JSR	PUTFPAC1     ; save power series variable
	 JSR	TFR1TO2	     ; put power series variable into fpacc2
	 JSR	FLTMUL	     ; square it
	 LDX	#LNTBL	     ; pointer to polynomial coefficients
	 JSR	POLYNOM	     ; compute power series result
	 TSX		     ; get pointer to (m-1)/(m+1)
	 JSR	GETFPAC2     ; put in fpacc2
	 JSR	FLTMUL	     ; multiply to get log of mantissa
	 PULX		     ; discard (m-1)/(m+1)
	 PULX
	 TSX		     ; get pointer to log of exponent
	 JSR	GETFPAC2     ; put in fpacc2
	 JSR	FLTADD	     ; add to get complete log result
	 PULX		     ; discard log of exponent
	 PULX
	 JSR	PULFPAC2     ; restore fpacc2
	 CLRB		     ; no errors
	 RTS
*
*
LNTBL	 EQU	*
	 FCB	$3E,$1D,$89,$D9		; 2/13
	 FCB	$3E,$3A,$2E,$8C		; 2/11
	 FCB	$3E,$63,$8E,$39		; 2/9
	 FCB	$3E,$92,$49,$25		; 2/7
	 FCB	$3E,$CC,$CC,$CD		; 2/5
	 FCB	$3F,$2A,$AA,$AB		; 2/3
	 FCB	$40,$00,$00,$00		; 2/1
	 FCB	$FF			; end of table
*
MONE	 FCB	$BF,$80,$00,$00		; -1.0
*
NLN2	 FCB	$3F,$31,$72,$18		; ln(2)
*
N1DLN10	 FCB	$3E,$DE,$5B,$D9		; 1/ln(10)
*
*
******************************************************************************
*									     *
*			 FLOATING POINT ARC SINE			     *
*			 FLOATING POINT ARC COSINE			     *
*			 FLOATING POINT ARC TANGENT			     *
*									     *
******************************************************************************
*
*
FLTASIN	 EQU	*
	 LDAA	#ASINERR     ; arc sine not implemented
	 SEC
	 RTS
FLTACOS	 EQU	*
	 LDAA	#ACOSERR     ; arc cosine not implemented
	 SEC
	 RTS
FLTATAN	 EQU	*
	 JSR	PSHFPAC2     ; save fpacc2
	 LDAA	MANTSGN1     ; get sign of argument
	 PSHA		     ; save it for result
	 CLR	MANTSGN1     ; work with positive number (for compare)
	 LDX	#ONE	     ; point to floating point constant 1.0
	 JSR	GETFPAC2     ; put it on stack
	 JSR	FLTCMP	     ; check for argument greater than 1.0
	 BLE	FLTATAN1     ; if <= 1.0
	 JSR	FLTRECIP     ; take reciprocal of argument
	 LDAA	#$FF	     ; indicate > 1.0
	 BRA	FLTATAN2     ; continue
FLTATAN1 CLRA		     ; indicate <= 1.0
FLTATAN2 PSHA		     ; save on stack
	 PSHX		     ; create stack space for argument
	 PSHX
	 TSX		     ; point to storage space
	 JSR	PUTFPAC1     ; put argument on stack
	 JSR	TFR1TO2	     ; put power series variable into fpacc2
	 JSR	FLTMUL	     ; square it
	 LDX	#ATANTBL     ; point to arc tangent table
	 JSR	POLYNOM	     ; compute arc tangent
	 TSX		     ; get pointer to argument
	 JSR	GETFPAC2     ; put in fpacc2
	 JSR	FLTMUL	     ; multiply to get result
	 PULX		     ; discard argument
	 PULX
	 PULA		     ; find out if argument was > 1.0
	 TSTA
	 BEQ	FLTATAN3     ; no - leave result alone
	 LDX	#PIOV2	     ; yes - subtract it from pi/2
	 JSR	GETFPAC2     ; put pi/2 on stack
	 COM	MANTSGN1     ; make result negative
	 JSR	FLTADD	     ; do subtraction
FLTATAN3 JSR	RAD2DEG	     ; convert to degrees
	 PULA		     ; retrieve original sign
	 STAA	MANTSGN1     ; put it in result
	 JSR	PULFPAC2     ; retrieve fpacc2
	 CLRB		     ; no errors
	 RTS
*
PIOV2	 FCB	$3F,$C9,$0F,$DB	     ; 1.5707963
*
ATANTBL	 EQU	*
	 FCB	$BC,$E2,$DD,$1B		; -1/19 + fudge factor
	 FCB	$3D,$70,$F0,$F1		; 1/17
	 FCB	$BD,$88,$88,$89		; -1/15
	 FCB	$3D,$9D,$89,$D9		; 1/13
	 FCB	$BD,$BA,$2E,$8C		; -1/11
	 FCB	$3D,$E3,$8E,$39		; 1/9
	 FCB	$BE,$12,$49,$25		; -1/7
	 FCB	$3E,$4C,$CC,$CD		; 1/5
	 FCB	$BE,$AA,$AA,$AB		; -1/3
	 FCB	$3F,$80,$00,$00		; 1/1
	 FCB	$FF			; end of table
*
*
*
******************************************************************************
*									     *
*			 FLOATING POINT SINE & COSINE			     *
*									     *
******************************************************************************
*
*
FLTSIN	 EQU	*
	 JSR	PSHFPAC2     ; save floating accumulator
	 CLRA		     ; operation is sine, result is positive
	 BRA	SIN0	     ; continue
*
FLTCOS	 EQU	*
	 JSR	PSHFPAC2     ; save floating accumulator
	 LDAA	#$F0	     ; operation is cosine, result is positive
SIN0	 PSHA		     ; save operation/sign flag
	 LDX	#N360	     ; point to floating point constant 360.0
	 JSR	GETFPAC2     ; put it into fp acc 2
	 BRA	SIN1	     ; check for negative argument
SIN2	 JSR	FLTADD	     ; add 360 and try again
SIN1	 LDAA	MANTSGN1     ; is argument negative?
	 BNE	SIN2	     ; yes - must be made positive
	 BRA	SIN3	     ; check for argument > 360.0
SIN4	 JSR	FLTSUB	     ; subtract 360 and try again
SIN3	 JSR	FLTCMP	     ; is argument > 360?
	 BGT	SIN4	     ; yes - must be less than 360
	 BSR	ANGRED	     ; if 180 < arg < 360, arg = 360 - arg ...
	 BCC	SIN5	     ; ... and change sign if sin function.
	 TSX		     ; get back operation/sign flag
	 LDAA	0,X	     ; are we doing sine?
	 BMI	SIN5	     ; no - go do next reduction
	 EORA	#$0F	     ; yes - sine is negative in quads 3 and 4
	 STAA	0,X	     ; put operation/sign flag back
SIN5	 BSR	ANGRED	     ; if 90 < arg < 180, arg = 180 - arg ...
	 BCC	SIN6	     ; ... and change sign if cos function.
	 TSX		     ; get back operation/sign flag
	 LDAA	0,X	     ; are we doing cosine?
	 BPL	SIN6	     ; no - go do next reduction
	 EORA	#$0F	     ; yes - cosine is negative in quads 2 and 3
	 STAA	0,X	     ; put operation/sign flag back
SIN6	 BSR	ANGRED	     ; if 45 < arg < 90, arg = 90 - arg ...
	 BCC	SIN7	     ; ... and change operation sin <=> cos.
	 TSX		     ; get back operation/sign flag
	 LDAA	0,X
	 EORA	#$F0	     ; change sine to cosine; cosine to sine
	 STAA	0,X	     ; put operation/sign flag back
SIN7	 LDX	#NPID180     ; point to floating point constant pi/180
	 JSR	GETFPAC2     ; load into floating accumulator 2
	 JSR	FLTMUL	     ; do degrees to radians conversion
	 JSR	TFR1TO2	     ; copy argument into fpacc2
	 JSR	FLTMUL	     ; compute argument^2
	 PSHX		     ; create storage space for argument
	 PSHX
	 TSX		     ; get pointer to storage
	 JSR	PUTFPAC2     ; save argument
	 LDAA	4,X	     ; are we doing sine?
	 BPL	SIN8	     ; yes - load sine table pointer
	 LDX	#COSTBL	     ; no - load cosine table pointer
	 BRA	SIN85
SIN8	 LDX	#SINTBL	     ; load sine table pointer
SIN85	 JSR	POLYNOM	     ; go do taylor expansion
	 TSX
	 LDAA	4,X	     ; get back operation/sign flag
	 ASRA		     ; check for negative
	 BCC	SIN9	     ; if positive, leave result alone
	 COM	MANTSGN1     ; if negative, complement sign
SIN9	 TSTA		     ; check sine/cosine flag
	 BMI	SIN10	     ; if cosine, we are finished
	 JSR	GETFPAC2     ; get argument back
	 JSR	FLTMUL	     ; final computation for sine
SIN10	 PULX		     ; discard stack temporaries
	 PULX
	 INS
	 JSR	PULFPAC2     ; recover floating accumulator
	 CLRB		     ; no errors
	 RTS		     ; done
*
*
ANGRED	 EQU	*
	 DEC	FPACC2EX     ; make n/2 for compare
	 JSR	FLTCMP	     ; is acc1 > n/2?
	 BGT	ANGRED1	     ; yes - reduce it
	 CLC		     ; no reduction
	 RTS
ANGRED1	 INC	FPACC2EX     ; recover n
	 COM	MANTSGN1     ; make acc1 negative
	 JSR	FLTADD	     ; acc1 = -acc1 + n
	 DEC	FPACC2EX     ; back to n/2
	 SEC		     ; signal reduction
	 RTS
*
*
*
*
FLTINT	 EQU	*
	 JSR	INTFRAC	   ; do separation into integer and fractional parts
*			   ; fall through to exchange integer part into fpacc1
EXG1AND2 EQU	*
	 LDD	FPACC1EX
	 LDX	FPACC2EX
	 STD	FPACC2EX
	 STX	FPACC1EX
	 LDD	FPACC1MN+1
	 LDX	FPACC2MN+1
	 STD	FPACC2MN+1
	 STX	FPACC1MN+1
	 LDAA	MANTSGN1
	 LDAB	MANTSGN2
	 STAA	MANTSGN2
	 STAB	MANTSGN1
	 CLRB
	 RTS
*
*
SINTBL	 EQU	*
	 FCB	$36,$38,$EF,$1D		; +(1/9!)
	 FCB	$B9,$50,$0D,$01		; -(1/7!)
	 FCB	$3C,$08,$88,$89		; +(1/5!)
	 FCB	$BE,$2A,$AA,$AB		; -(1/3!)
ONE	 FCB	$3F,$80,$00,$00		; +(1/1!)
	 FCB	$FF
*
*
COSTBL	 EQU	*
	 FCB	$37,$D0,$0D,$01		; +(1/8!)
	 FCB	$BA,$B6,$0B,$61		; -(1/6!)
	 FCB	$3D,$2A,$AA,$AB		; +(1/4!)
	 FCB	$BF,$00,$00,$00		; -(1/2!)
	 FCB	$3F,$80,$00,$00		; +(1/1!)
	 FCB	$FF
*
*
PI	 FCB	$40,$49,$0F,$DB		; 3.1415927
N360	 FCB	$43,$B4,$00,$00		; 360.0
*
*
*
******************************************************************************
*									     *
*			 FLOATING POINT TANGENT				     *
*									     *
******************************************************************************
*
*
FLTTAN	 EQU	*
	 JSR	PSHFPAC2      ; save fpacc2 on the stack.
	 JSR	TFR1TO2	      ; put a copy of the angle in fpacc2.
	 JSR	FLTCOS	      ; get cosine of the angle.
	 JSR	EXG1AND2      ; put result in fpacc2 & put angle in fpacc1.
	 JSR	FLTSIN	      ; get sin of the angle.
	 JSR	FLTDIV	      ; get tangent of angle by doing sin/cos.
	 BCC	FLTTAN1	      ; if carry clear, answer ok.
	 JSR	PULFPAC2      ; restore fpacc2
	 LDAA	#TAN90ERR     ; get error code in b.
	 SEC		      ; flag error
	 RTS
FLTTAN1	 JSR	PULFPAC2      ; restore fpacc2.
	 CLRB		      ; no errors
	 RTS
*
*
MAXNUM	 EQU	*
	 FCB	$7F,$FF,$FF,$FF		; largest positive number we can have.
*
*
*
******************************************************************************
*									     *
*			       TRIG UTILITIES				     *
*									     *
*	 The routines "DEG2RAD" and "RAD2DEG" are used to convert angles     *
*	 from degrees-to-radians and radians-to-degrees respectively. The    *
*	 routine "GETPI" will place the value of PI into FPACC1. This	     *
*	 routine should be used if the value of PI is needed in calculations *
*	 since it is accurate to the full 24-bits of the mantissa.	     *
*									     *
******************************************************************************
*
*
DEG2RAD	 EQU	*
	 JSR	PSHFPAC2     ; save fpacc2.
	 LDX	#NPID180     ; point to conversion constant pi/180.
DEG2RAD1 JSR	GETFPAC2     ; put it into fpacc2.
	 JSR	FLTMUL	     ; convert degrees to radians.
	 JSR	PULFPAC2     ; restore fpacc2.
	 RTS
*			     ; a "jmp" it will not work.)
*
*
RAD2DEG	 EQU	*
	 JSR	PSHFPAC2     ; save fpacc2.
	 LDX	#N180DPI     ; point to conversion constant 180/pi.
	 BRA	DEG2RAD1     ; go do conversion & return.
*
*
GETPI	 EQU	*
	 LDX	#PI	     ; point to constant "pi".
	 JMP	GETFPAC1     ; put it in fpacc1 and return.
*
*
NPID180	 EQU	*
	 FCB	$3C,$8E,$FA,$31
*
N180DPI	 EQU	*
	 FCB	$42,$65,$2E,$E1
*
*
*
******************************************************************************
*									     *
*	 POLYNOM evaluates a polynomial with constant coefficients.  On	     *
*	 entry, FPACC1 contains the independent variable.  The X register    *
*	 contains a pointer to a table of floating point coefficients,	     *
*	 stored with the highest order coefficient first.  The polynomial    *
*	 is of arbitrary order; evaluation ends when $ff is encountered	     *
*	 after the last (lowest order) coefficient in the coefficient table. *
*									     *
******************************************************************************
*
*
POLYNOM	 EQU	*
	 XGDX		     ; hold coefficient table pointer in d
	 LDX	FPACC1EX     ; save f.p. argument on stack (not memory format!)
	 PSHX
	 LDX	FPACC1MN+1
	 PSHX
	 XGDX		     ; get coefficient table pointer back
	 LDAA	MANTSGN1     ; save f.p. argument sign on stack
	 PSHA
	 PSHX		     ; save coefficient table pointer
	 LDD	#0	     ; clear result accumulator
	 STD	FPACC1EX
	 STD	FPACC1MN+1
	 STD	FPACC1MN+2
	 BRA	POLY1
POLY2	 TSX		     ; get pointer to coefficient table pointer
	 LDAA	2,X	     ; put independent variable into accumulator 2
	 STAA	MANTSGN2
	 LDD	3,X
	 STD	FPACC2MN+1
	 LDD	5,X
	 STD	FPACC2EX
	 JSR	FLTMUL	     ; do multiplication
POLY1	 TSX		     ; get pointer to coefficient table pointer
	 LDX	0,X	     ; get pointer to coefficient table
	 JSR	GETFPAC2     ; put coefficient into accumulator
	 JSR	FLTADD	     ; add to result
	 PULX		     ; get coefficient table pointer off stack
	 LDAB	#4	     ; increment coefficient pointer
	 ABX
	 PSHX		     ; save new coefficient pointer
	 LDAA	0,X	     ; check for end of table
	 COMA		     ; if it was $ff, we are at end
	 BNE	POLY2	     ; not at end - keep going
	 TSX		     ; discard coefficient pointer and argument
	 LDAB	#7	     ; number of bytes to pull off stack
	 ABX		     ; add 7 to stack pointer
	 TXS		     ; put stack pointer back
	 RTS
*
*
*
******************************************************************************
*									     *
*	 The following two subroutines, PSHFPAC2 & PULPFAC2, push FPACC2     *
*	 onto and pull FPACC2 off of the hardware stack respectively.	     *
*	 The number is stored in the "memory format".			     *
*									     *
******************************************************************************
*
*
PSHFPAC2 EQU	*
	 PULX		     ; get the return address off of the stack.
	 PSHX		     ; allocate four bytes of stack space.
	 PSHX
	 XGDX		     ; put the return address in d.
	 TSX		     ; point to the storage area.
	 PSHB		     ; put the return address back on the stack.
	 PSHA
	 JMP	PUTFPAC2     ; go put fpacc2 on the stack & return.
*
*
PULFPAC2 EQU	*
	 TSX		     ; point to the return address.
	 INX		     ; point to the saved number.
	 INX
	 JSR	GETFPAC2     ; restore fpacc2.
	 PULX		     ; get the return address off the stack.
	 INS		     ; remove the number from the stack.
	 INS
	 INS
	 INS
	 JMP	0,X	     ; return.
*
*
*
******************************************************************************
*									     *
*			    GETFPACx SUBROUTINE				     *
*									     *
*	The GETFPAC1 and GETFPAC2 subroutines get a floating point number    *
*	stored in memory and put it into either FPACC1 or FPACC2 in a format *
*	that is expected by all the floating point math routines. These	     *
*	routines convert the IEEE binary floating point format to the format *
*	required by the math routines.	The IEEE format converted by these   *
*	routines is shown below:					     *
*									     *
*	31 30_______23 22_____________________0				     *
*	s   exponent	      mantissa					     *
*									     *
*	The exponent is biased by 127 to facilitate floating point	     *
*	comparisons.  The sign bit is 0 for positive numbers and 1	     *
*	for negative numbers.  The mantissa is stored in hidden bit	     *
*	normalized format so that 24 bits of precision can be obtained.	     *
*	Since a normalized floating point number always has its most	     *
*	significant bit set, we can use the 24th bit to hold the exponent    *
*	LSB.  This allows us to get 24 bits of precision in the mantissa     *
*	and store the entire number in just 4 bytes.  The format required by *
*	the math routines uses a seperate byte for the sign, therfore each   *
*	floating point accumulator requires five bytes.			     *
*									     *
******************************************************************************
*
*
RETONE	 LDX	#ONE	     ; point to constant 1.0
GETFPAC1 EQU	*
	 CLR	MANTSGN1     ; set up for positive number.
	 LDD	2,X	     ; get low 16-bits of the mantissa.
	 STD	FPACC1MN+1   ; put in fpacc1.
	 LDD	0,X	     ; get the exponent & high byte of the mantissa
	 LSLD		     ; shift sign into carry; exponent into acca
	 BCC	GETFP11	     ; if number is positive, skip setting the sign byte
	 COM	MANTSGN1     ; set sign to negative.
GETFP11	 STAA	FPACC1EX     ; store exponent; check for zero
	 BEQ	GETFP12	     ; if number is zero, don't set mantissa msb
	 SEC		     ; set carry to shift into mantissa msb
	 RORB		     ; normalized mantissa now in b
GETFP12	 STAB	FPACC1MN     ; put in fpacc1.
	 CLRB		     ; no errors.
	 RTS
*
*
GETFPAC2 EQU	*
	 CLR	MANTSGN2     ; set up for positive number.
	 LDD	2,X	     ; get low 16-bits of the mantissa.
	 STD	FPACC2MN+1   ; put in fpacc2.
	 LDD	0,X	     ; get the exponent & high byte of the mantissa
	 LSLD		     ; shift sign into carry; exponent into acca
	 BCC	GETFP21	    ; if number is positive, skip setting the sign byte
	 COM	MANTSGN2     ; set sign to negative.
GETFP21	 STAA	FPACC2EX     ; store exponent; check for zero
	 BEQ	GETFP22	     ; if number is zero, don't set mantissa msb
	 SEC		     ; set carry to shift into mantissa msb
	 RORB		     ; normalized mantissa now in b
GETFP22	 STAB	FPACC2MN     ; put in fpacc2.
	 RTS
*
*
*
******************************************************************************
*									     *
*			 PUTFPACx SUBROUTINE				     *
*									     *
*	These two subroutines perform to opposite function of GETFPAC1 and   *
*	GETFPAC2. Again, these routines are used to convert from the	     *
*	internal format used by the floating point package to the IEEE	     *
*	floating point format. See the GETFPAC1 and GETFPAC2, documentation  *
*	for a description of the IEEE format.				     *
*									     *
******************************************************************************
*
*
PUTFPAC1 EQU	*
	 LDD	FPACC1MN+1 ; get l.s. 16 bits of the mantissa.
	 STD	2,X	   ; save it
	 LDD	FPACC1EX   ; get fpacc1 exponent & upper 8 bits of mant.
	 LSLB		   ; drop mantissa msb (implied), also make accb < $ff
	 CMPB	MANTSGN1   ; sign bit into carry. (b-$ff => c set; b-0 =>c clr)
	 RORA		   ; now acca has sign:exponent[7-1]; exponent[0] => c
	 RORB		   ; now accb has exponent[0]:mantissa[22-16]
	 STD	0,X	   ; save it in memory
	 RTS
*
*
PUTFPAC2 EQU	*
	 LDD	FPACC2MN+1 ; get l.s. 16 bits of the mantissa.
	 STD	2,X	   ; save it
	 LDD	FPACC2EX   ; get fpacc2 exponent & upper 8 bits of mant.
	 LSLB		   ; drop mantissa msb (implied), also make accb < $ff
	 CMPB	MANTSGN2   ; sign bit into carry. (b-$ff => c set; b-0 =>c clr)
	 RORA		   ; now acca has sign:exponent[7-1]; exponent[0] => c
	 RORB		   ; now accb has exponent[0]:mantissa[22-16]
	 STD	0,X	   ; save it in memory
	 RTS
*
FLTABS	 EQU	*
	 CLR	MANTSGN1     ; take absolute value
	 CLRB		     ; return proper condition code
	 RTS
*
FLTSGN	 EQU	*
	 TST	FPACC1MN     ; check for zero
	 BEQ	FLTSGNZ	     ; do nothing if zero
	 LDD	#$7F80	     ; mantissa/exponent is 1.000
	 STD	FPACC1EX     ; save exponent and mantissa high byte
FLTSGNZ	 CLRA		     ; mid byte is zero
	 CLRB		     ; low byte is zero
	 STD	FPACC1MN+1   ; save mantissa low bytes
	 RTS
*
FLTMIN	 EQU	*
	 TST	FPACC1MN     ; check for zero
	 BEQ	FLTMINZ	     ; do nothing if zero
	 COM	MANTSGN1     ; change sign
FLTMINZ	 CLRB		     ; condition code 0
	 RTS
*
ion constant 180/pi.
	 BRA	DEG2RAD1     ; go do conversion & return.
*
*
GETPI	 EQU	*
	 LDX	#PI	     ; point to constant "pi".
	 JMP	GETFPAC1     ; put it in fpacc1 and return.

