SW9511	MACRO
;;
;;	LAST MODIFICATION MADE 24-DEC-79
;;


	LOCAL	TRUE,FALSE
FALSE	EQU	0
TRUE	EQU	NOT FALSE
;;
;;	USED FOR SOFTWARE FLOATING POINT FOR PASCAL/MT RUN-TIME
;;
;;
;;
;;
;;
;;
;;
;;	JUMP TABLE LOCATED AT START FOR CONVIENENCE
;;
;;
SWRADD:	JMP	FPRADD		;;FLOATING ADD
;;
SWRSUB:	JMP	FPRSUB		;;FLOATING SUBTRACT
;;
SWRMUL:	JMP	FPRMUL		;;FLOATING MULTIPLY
;;
SWRDIV:	JMP	FPRDIV		;;FLOATING DIVIDE
;;
SWRSQRT: JMP	FPRSQR		;;SQUARE ROOT
;;
;;
RFIX:	JMP	FPFIX		;;GO DIRECTLY TO MATH PAK ROUTINE
;;
RFLT:	JMP	FLOAT2		;;   DITTO
;;
;;
;;
;;
FPRADD:
	CALL	FPSETP
	CALL	FLOATADD
	CALL	FPCLNP
	RET
;;
;;
FPRSUB:
	CALL	FPSETP
	CALL	FPSUB
	CALL	FPCLNP
	RET
;;
;;
FPRMUL:
	CALL	FPSETP
	CALL	FLOATMULT
	CALL	FPCLNP
	RET 
;;
;;
FPRDIV:
	CALL	FPSETP
	CALL	FLOATDIV
	CALL	FPCLNP
	RET
;;
;;
;;	SUBR TO SET UP DATA FOR MATH PAK ROUTINES
;;
FPSETP:
	POP	D	;;DE=RTN ADR TO CALLERR OF FPSETP SUBR
	POP	B	;;BC=RTN ADR OF CALLER OF RXXX SUBR
	POP	H	;;L=EXP OF TOS     H=MANT(HIGH) OF TOS
	SHLD	TOS	;;PLACE ARGU ON SIMULATED 9511 WORK STACK
	POP	H	;;HL=REST OF 1ST ARGU
	SHLD	TOS2
	POP	H	;;HL=1ST 2 BYTES OF 2ND ARGU
	SHLD	NOS
	POP	H
	SHLD	NOS2	;;SIMULATED 9511 STACK IS NOW LOADED
;;
	PUSH	B	;;TOP OF SYS STACK=RTN ADR OF RXXX CALLER
;;
	XCHG
	PCHL		;;RTN TO CALL OF THIS SUBR
;;
;;
;;
;;	SUBR TO PUT RESULT IN FORM FOR CALLING ROUTINES
;;
FPCLNP:
	POP	D	;;DE=RTN ADR TO CALL OF FPCLNP SUBR
	POP	B	;;BC=RRTN ADR TO CALLER OF RXXX SUUBR
;;
	LHLD	TOS2	;;GET MIDDLE AND LOWER OF MANT OF RESULT
	PUSH	H	;;PUT ON SYS STACK FOR RXXX CALLER
	LHLD	TOS
	PUSH	H	;;TOP 4 BYTES OF SYS STACK NOW HAVE FLPT RRESULT
;;
	PUSH	B	;;TOP OF SYSSTACK = RTN ADR OF RXXX CALLER
;;
	XCHG
	PCHL		;;RTN TO CALL OF THIS SUBR
;;
;;
;;
;;
;;
;;
;;
;;
;;
;;
FPNSUB:	EQU	14	;;NUMBER OF NESTING LEVELS FOR INTERP SUBRS
;;
;;
FPMSTK:	EQU	FALSE	;;INDICATOR FOR USE OF INTERNAL STACK FOR 
			;;FP ARITH OPERATIONS. IF TRUE AN INTERNAL STACK
			;;WILL BE ALLOCATED IN RAM. IF FALSE THE SYSTEM
			;;STACK  WILL BE USED.
;;
FPTRNF:	EQU	FALSE	;;TRANSCENDENTAL FLAG IF TRUE
;;			 THESE FUNCTIONS ARE INCLUDED
;;
;;
;;
;;
;;
;;
;;
;;
;;
;;
;;	THESE SUBROUTINES PERFORM FLOATING POINT ADD AND SUBTRACT IN
;;	AMD-9511 FORMAT.
;;
;;
;;
;;	CSEG
;;
;;
;;
;;	PUBLIC	FLOATADD,FPSUB,FPSUBS
;;
;;
;;
FPSUBS:	STC		;;SET SPECIAL MODE FLAG = TRUE
	JMP	FPSUB1
;;
;;
FPSUB:	XRA	A	;; SET SPECIAL MODE FLAG (CARRY BIT) = FALSE
FPSUB1:	PUSH	PSW	;;SAVE
	CALL	FPEQZR	;;ON RET HL=TOS
	JZ	FLOATADD1	;;JMP IF TOS =0   DONT COMPL IT
	MOV	A,M
	XRI	80H
	MOV	M,A	;;COMPL SIGN OF TOS
	JMP	FLOATADD1	;;THEN DO AN ADD
;;
;;
;;
FLOATADD:	XRA	A	;;SET SPECIAL MODE FLAG FALSE
	PUSH	PSW
FLOATADD1:	LHLD	NOS
	MOV	A,L
	ORA	H	;;A=BITS OF EXP+HIGH BITS OF MANT
	JNZ	ADD20	;;JMP IF NOS NOT ZERO
;;   IF NOS=0 DONT DO ACTUAL ARITHMETIC
	POP	PSW	;;GET SPECIAL MODE FLAG
	JNC	FPPOP	;;JMP IF NOT SPECIAL MODE AND RET FROM THAT SUBR
;;			 TOS IS ANSWER
	LXI	H,TOS
ADD21:	MOV	B,M	;;GET EXP INTO B FOR FPCMP OPCODE PROCESSOR
	INX	H
	MOV	C,M	;;GET HIGH BITS OF MANT FOR SAME REASON
	RET			;;ALL DONE
ADD20:	CALL	FPEQZR
	JNZ	ADD00	;;JMP IF TOS NOT ZERO
;;  IF TOS=0 DONT DO ACTUAL ARITHMETIC
	POP	PSW	;;GET SPECIAL MODE FLAG
	JNC	FPPOPP	;;JMP IF NOT SPECIAL MOD AND RETURN FROM THAT SUBR
;;			 NOS IS ANSWER
	LXI	H,NOS
	JMP	ADD21	;;DO STUFF FOR SPECIAL MODE
ADD00:	CALL	EXPS2	;;ON RETURN A=EXP OF NOS    B=EXP OF TOS
	SUB	B	;;A HAS DIFFERENCE OF EXP'S . THISWILL BE THE SHIFT CNT
	PUSH	PSW	;;SAVE
	LXI	H,TOS
	JM	ADD01	;;JMP IF TOS>NOS
	LXI	H,NOS
ADD01:	MOV	A,M	;;HL HAS ADR OF LARGER VALUE  SAVE IT
	POP	B
	PUSH 	PSW
	PUSH	B	;;SAVE EXP DIFFERENCE IN RIGHT ORDER ON STACK
	CALL	ADDS1	;;ON RET   BCDE = MANT IN 2' COMPL FORM OF LARGER VALUE
	POP	PSW	;;GET EXP DIFFERENCE
	PUSH	B
	PUSH	D	;;SAVE SO CAN ADD IT TO OTHER MANTISSA
	PUSH	PSW	;;SAVE EXP DIFFERENCE AGAIN
	LXI	H,NOS
	JM	ADD02	;;JMP IF TOS>NOS
	LXI	H,TOS
ADD02:	CALL	ADDS1	;;ON RETURN BCDE = MANT IN 2'S COMPL FORM OF SMALLER
	POP	PSW	;;GET EXP DIFFERENCE  I.E. SHIFT COUNT
	JP	ADD12	;;JMP IF DIFF IS NEG
	CMA		;;* MAKE DIFF POS
	INR	A	;;*
ADD12:	MOV	L,A	;;L WILL BE SHIFT COUNT
	CPI	24D
	JP	ADD06	;;JMP IF SMALLER IS TOO SMALL TO HAVE EFFECT ON LARGER
	ORA	A
	JZ	ADD03	;;JMP IF EXP'S ARE EQUAL   NO SHIFT REQUIRED
;;
ADD04:	MOV	A,B	;;*
	ORA	A	;;*
	JP	ADD05	;;* PERFORM 32 BIT RIGHT SHIFT WITH SIGN EXTENSION
	STC		;;*
ADD05:	CALL	ADSHRC	;;*
	DCR	L	
	JNZ	ADD04
;;
ADD03:	XCHG		;;HL HAS LOWER 16 BITS 
	POP	D	;;DE HAS LOWER 16 BITS OF OTHER VALUE
	DAD	D
	XCHG		;;DE HAS LOWER 16 BITS OF SUM
	MOV	H,B
	MOV	L,C	;;HL HAS UPPER 16 BITS
	POP	B	;;GETUPPER 16 BITS OF TOHER VALUE
	JNC	ADD07	;;JMP IF NO CARRY OUT OF LOWER 16 BITS OF SUM
	INX	B	;;CARRY OUT OF LOW BITS ADD INTO HIGH BITS
ADD07:	DAD	B	;;HLDE HAVE 32 BIT SUM
	MOV	B,H
	MOV	C,L	;;BCDE NOW HAVE 32 BIT SUM
;;
	MOV	A,B
	ANI	80H	;;LEAVE SIGN BIT OF SUM
	MOV	H,A	;;SAVE
	CM	ADDCMP	;;MAKE SUM POS IF CAME OUT NEGATIVE
	XRA	A
	MOV	L,A	;;SET EXP INCR COUNT FOR 24 BIT RESULT
	ORA	B	;;SEE IF ANY BITS IN B
	JZ	ADD09	;;JMP IF RESULT CONTAINED IN ONLY 24 BITS
	CALL	ADSHRC	;;RESULT IS 25 BITS MAKE INTO 24 BITS SIZE
	INR	L	;;EXP INCR VALUE
ADD09:	MOV	B,C
	MOV	A,C
	ORA	D
	ORA	E
	JZ	ADD13	;;JMP IF RESULT ENTIRELY ZERO
;;
	MOV	A,C
ADD11:	ANI	80H	;;CHECK FOR NORMALIZED RESULT
	JNZ	ADD10	;;JMP IF NORMALIZED
	DCR	L	;;NOT NORMALIZED YET DECR EXP COUNT
	MOV	A,E	;;*
	RAL		;;*
	MOV	E,A	;;*
	MOV	A,D	;;*
	RAL		;;* 24 BIT LEFT SHIFT
	MOV	D,A	;;*
	MOV	A,C	;;*
	RAL		;;*
	MOV	C,A	;;*
	JMP	ADD11
;;
ADD10:	POP	PSW	;;GET EXP OF LARGER VALUE INTO A
	ADD	L	;;ADD IN EXP INCR VALUE
	ANI	7FH	;;LEAVE EXP PORTION
	ORA	H	;;PUT IN SIGN BIT OF RESULT
	MOV	B,A	;;BCDE CONTAIL RESULT IN FLPT FORMAT
;;
;;
ADD08:
	IF	FPMSTK
	LHLD	FPUSTK	
	SPHL		;;RESTORE STACK PT OF CALLER  THIS WAS SET UP BY
;;			 EXPS2 SUBR
	ENDIF
;;
	POP	PSW	;;GET SPECIAL MODE FLAG
	RC		;;ALL DONE NOW IF CALLED IN SPECIAL MODE
;;
	LXI	H,TOS
	MOV	M,B
	INX	H
	MOV	M,C
	INX	H
	MOV	M,D
	INX	H
	MOV	M,E	;;SAVE RESULT
	CALL	FPPOP	;;POP UP REST OF FLPT WORK STACK
	RET		;;ALL DONE
;;
;;
ADD06:	POP	D	;;LARGER VAL WAS TOO MUCH LARGER  - JUST USE
;;			 LARGER VAL AS RESULT

	POP	B	;;BCDE = MANT IN 2'S COMPL FORM  (32 BIT)
	MOV	A,B
	ORA	A
	CM	ADDCMP	;; MAK POS IF NEG  ( THE MANT SIGN BIT IS STILL IN THE
;;			 EXP BYTE WHICH IS POP'ED NEXT )

	POP	PSW
	MOV	B,A	;;MOVE ORIGINAL EXP BYTE INTO RESULT AREA
	JMP	ADD08
;;
;;
ADD13:	POP	PSW	;;ADJUST STACK SO CAN JOIN OTHER CODE
	JMP	ADD08
;;
;;
;;
;;
ADDS1:	MOV	A,M	;;THIS SUBR RETURN THE MANTISSA OF THE FLPT VALUE
;;	              POINTED AT BY HL IN REG'S BCDE (B=HIGH BITS, E=LOW BITS)
;;			 THE 32 BIT MANT VALUE IS IN 2'S COMLP FROM.
;;
	INX	H
	MOV	C,M
	INX	H
	MOV	D,M
	INX	H
	MOV	E,M	;;CDE HAVE MANT
	MVI	B,0	;;B HAS UPPER BITS
	ORA	A
	CM	ADDCMP	;;MAKE 2'S COMPL NEG VALUE IF MANT IS NEG
	RET
;;
;;
;;
ADDCMP:	MOV	A,E	;;THIS SUBR FORMS THE 32 BIT 2'S COMPL OF BCDE
	CMA
	ADI	1
	MOV	E,A
	MOV	A,D
	CMA
	ACI	0
	MOV	D,A
	MOV	A,C
	CMA
	ACI	0
	MOV	C,A
	MOV	A,B
	CMA
	ACI	0
	MOV	B,A
	RET
;;
;;
;;
ADSHRC:	MOV	A,B	;; THIS SUBR PERFORMS A RIGHT SHIFT OF THE 32 BIT
;;			  QUANTITY IN BCDE. THE CARRY BIT FROM THE CALLER IS
;;			  SHIFTED INTO THE HIGH END OF B.
	RAR
	MOV	B,A
	MOV	A,C
	RAR
	MOV	C,A
	MOV	A,D
	RAR
	MOV	D,A
	MOV	A,E
	RAR	
	MOV	E,A
	RET
;;
;;
;;
;;
;;
;;
;;
;;
;;
;;
;;	THIS SUBROUTINE PERFORMS A FLOATING POINT (AMD-9511 FORMAT)
;;	MULTIPLY. TOS IS MULTIPLIED BY NOS,THE RESULT IS PALCED IN NOS, AND
;;	THE FLOATING POINT WORK STACK IS POP'ED.
;;
;;
;;	THE MANTISSA OF THE MULTIPLIER IS PLACED ONE BIT AT A TIME IN
;;	THE STACK AS THE CARRY BIT OF THE PSW. THE MULTIPLICAND MANTISSA IS
;;	IN REG'S D, B, AND C (HIGH, MIDDLE, LOW ORDER).
;;	THE PRODUCT IS ACCUMULATED IN REG'S E, H, AND L.
;;
;;
;;
;;
;;
;;	CSEG
;;
;;
;;	PUBLIC	FLOATMULT,EXPS2,EXPS1,MUL15
;;
;;
;;
FLOATMULT:	CALL	EXPS2	;;GET BOTH EXPONENTS AND PLAY WITH THEM A BIT
	ADD	B	;;B HAS 8 BIT 2'S COMPL EXP OF PRODUCT
	PUSH	PSW	;;SAVE PARTIAL EXP BYTE
;;
;;
;;	ALL DONE WITH EXP  NOW PUT MULTIPLIER ONTO STACK ONE BIT AT A TIME
;;
	MVI	C,8D	;;LOOP COUNTER
	MOV	B,C
	LDA	NOS3	;;GET LOW BITS OF MULPITLIER MANTISSA
MUL01:	RAR		;;SHIFT BIT OF MANT INTO CARRY BIT
	PUSH	PSW	;;SAVE BIT OF MANT AS CARRY BIT IN PSW
	DCR	B
	JNZ	MUL01	;;DO ALL 8 LOW BITS OF MANT
	MOV	B,C
	LDA	NOS2	;;GET MIDDLE BITS OF MULTIPLIER MANT
MUL02:	RAR
	PUSH	PSW
	DCR	B
	JNZ	MUL02	;;DO ALL 8 MIDDLE BITS OF MANT
	DCR	C	;;SET LOOP COUNTER TO 7 (SEVEN)
	LDA	NOS1	;;GET UPPER BITS OF MULTIPLIER MANT
MUL03:	RAR
	PUSH	PSW
	DCR	C
	JNZ	MUL03	;;DO LOWER 7 BIT OF UPPER 8 BITS OF MANT
;;			 THE HIGHEST BIT MUST BE A 1 (ONE)
	ANI	1	;;THIS SHOULD BE HIGHEST BIT OF MANT
	JZ	XMUL16	;;JMP IF MULTIPLIER ZERO OR NOT NORMALIZED
;;
	MVI	A,0FFH	;;MINUS ONE
	STA	FPTEMP	;;SET CARRY OUT OF 24TH BIT PLACE FLAG TO FALSE
;;
;;	BITS OF MULTIPLIER ARE NOW ON STACK AS CARRY BITS
;;	NOW LOAD UP REGS WITH MULTIPLICAND MANT AND PRODUCT ACCUM
;;
	LXI	H,TOS1
	MOV	D,M	;;D HAS UPPER BITS OF MULTIPLICAND MANTISSA
	XRA	D	;;A HAD ALL ONE'S
	JM	XMUL16	;;JMP IF MULTIPLICAND ZERO OR NOT NORMALIZED
	INX	H
	MOV	B,M	;;B HAS MIDDLE BITS OF MULTIPLICAND MANT
	INX	H
	MOV	C,M	;;C HAS LOWER BITS OF MULTIPLICAND MANT
;;
	MOV	E,D	;;*
	MOV	H,B	;;* PRODUCT ACCUM = MULTIPLICAND MANT
	MOV	L,C	;;*
;;
;;
MUL05:	XRA	A	;;CLEAR CARRY BIT
	MOV	A,D	;;*
	RAR		;;*
	MOV	D,A	;;*
	MOV	A,B	;;*
	RAR		;;*  MULTIPLICAND=MULTIPLICAND/2
	MOV	B,A	;;*
	MOV	A,C	;;*
	RAR		;;*
	MOV	C,A	;;*
	ORA	B
	ORA	D
	JZ	MUL08	;;JMP IF DONE  I.E. MULTIPLICAND HAS BEEN SHIFTED
;;			 24 TIMES
;;
	POP	PSW	;;GET A BIT FROM MULTIPLIER
	JNC	MUL05	;;JMP IF BIT WAS ZER0
	DAD	B	;;*
	MOV	A,D	;;*  ADD CURRENT VALUE OF MULTIPLICAND INTO
	ADC	E	;;* PRODUCT ACCUMULATOR REGS
	MOV	E,A	;;*
	JNC	MUL05	;;JMP IF NO CARRY OUT OF 24 TH BIT PLACE
	XRA	A
	STA	FPTEMP	;;SET CARRY OUT OF 24TH BIT PLACE FLAG TO TRUE
	JMP	MUL05	;; AGAIN
;;
;;
;;	PRODUCT MANTISSA IS IN E, H, L AND MAGICALLY IS NORMALIZED ALREADY
;;
MUL08:	MOV	C,L
	MOV	D,H	;;E, D, AND C  NOW HAVE MANTISSA OF PRODUCT
	LXI	H,FPTEMP
	ORA	M	;;CHECK CARRY OUT FLAG  (NOTE - A MUST BE ZERO )
	JNZ	MUL09	;;JMP IF FLAG=FALSE  I.E.  PROD MANT IS OKAY AS IS
	STC
	MOV	A,E	;;*
	RAR		;;*
	MOV	E,A	;;*
	MOV	A,D	;;*
	RAR		;;*  PUT CARRIED OUT BIT BACK INTO HIGH BIT OF PROD
	MOV	D,A	;;*
	MOV	A,C	;;*
	RAR		;;*
	MOV	C,A	;;*
MUL09:	POP	PSW	;; GET PARTIAL EXP BYTE INTO A
	ADD	M	;;ADJUST EXP IF NECESSARY
	ANI	7FH	;;MAKE EXP INTI 7 BIT 2'S COMPL
	MOV	B,A	;;SAVE
	LDA	NOS	;;GET EXP OF MULTIPLIER
	INR	L	;;HL NOW POINTS AT 1ST BYTE OF TOS
	XRA	M	;;HIGH BIT OF A IS SIGN OF MANTISSA OF PRODUCT
	ANI	80H
	ORA	B	;;A NOW HAS COMPLETED EXPONENT OF THE PRODUCT
MUL10:	MOV	M,A	;;SAVE IN FINAL RESTING PLACE
	INR	L
	MOV	M,E
	INR	L
	MOV	M,D
	INR	L
	MOV	M,C	;;COMPLETE PRODUCT IS NOW SAVED IN FINAL RESTING PLACE
	CALL	FPPOP
;;
;;
	IF	FPMSTK
	LHLD	FPUSTK
	SPHL		;;RESTORE CALLER'S STACK POINTER
	ENDIF
;;
	RET		;;THAT'S ALL FOLKS
;;
XMUL16:	MVI	C,23D	;;COME HERE IF MULTILPIER OR 
;;			MULTILPICAND IS ZERO
MUL17:	POP	PSW	;;REMOVE STUF PUT ON STACK
	DCR	C
	JNZ	MUL17	;;JMP TIL CLEAN UP STACK
;;
MUL15:	POP	PSW	
;;ONE LAST STACK CLEAN UP - ALSO COME HERE FROM FLOATDIV
	XRA	A	;;*
	MOV	E,A	;;*
	MOV	D,A	;;*
	MOV	C,A	;;*  SET PRODUCT (OR DIVIDEND) =0
	LXI	H,TOS	;;PLACE TO PUT IT
	JMP	MUL10
;;
EXPS2:
	IF	FPMSTK
	POP	D	;;THIS SUBR SAVES THE CALLER'S SP AND SETS UP
;;		 SP FOR THE SPECIAL STACK USED BY FLOATMULT AND FLOATDIV
;;			 IT THE GETS BOTH EXPONENTS  
;;
;;			 DE=RET ADR OF CALL TO EXPS2. THE USER SP NOW POINTS
;;		 AT THE RET ADR OF THE CALLER OF FLOATMULT OR FLOATDIV.
;;
	LXI	H,0	
	DI
	DAD	SP	;;HL=CALLER'S SP
	SHLD	FPUSTK	;;SAVE
	LXI	SP,FPMDST	;;SET UP SP FOR OWN USE
	EI
	ENDIF
;;
	LDA	TOS
	CALL	EXPS1
	MOV	B,A
	LDA	NOS
	CALL	EXPS1
;;
	IF	FPMSTK
	XCHG		;;HL HAS RET ADR OF CALL TO EXPS2 SUBR
	PCHL
	ENDIF
;;
	IF	FPMSTK XOR 1
	RET
	ENDIF
;;
;;
;;
EXPS1:	ANI	7FH ;;SIGN EXTEND 7 BIT 2'S COMPL VALUE TO AN 8 BIT 2'S COMPL
	MOV	C,A
	ANI	40H
	MOV	A,C
	RZ
	ORI	80H
	RET
;;
;;
;;
;;
;;
;;
;;
;;
;;
;;
;;	THIS SUBROUTINE PERFORMS A FLOATING POINT (AMD9511 FORMAT) DIVIDE.
;;	NOS IS DIVIDED BY TOS, THE RESULT IS PLACED IN NOS, AND THE
;;	FLOATING POINT WORK STACK IS POP'ED. APPROXIMATELY 52D BYTES OF
;;	SYSTEM STACK SPACE ARE USED.
;;
;;	NOS / TOS       BCD / EHL
;;
;;
;;
;;	BCD REG'S HOLD THE DIVIDEND
;;	EHL REG'S HOLD THE DIVISOR
;;
;;
;;
;;
;;
;;	CSEG
;;
;;	PUBLIC	FLOATDIV
;;
;;
;;
FLOATDIV:	CALL	EXPS2	;;BUILD NEW EXP WITHOUT MANT SIGN BIT
	SUB	B	;;EXP OF DIVIDEND-EXP OF DIVISOR
	PUSH	PSW	;;SAVE PARTIAL EXP  ON STACK
	LXI	H,NOS3	;;GET MANTISSAS FROM NOS AND TOS
;;
	MOV	D,M
	DCX	H
	MOV	C,M
	DCX	H
	MOV	B,M
	LHLD	TOS2	;;HL=MIDDLE AND UPPER BITS BUT IN WRONG REG'S FOR ME
	MOV	A,H
	MOV	H,L
	MOV	L,A		;;HL ARE IN CORRECT ORDER
	LDA	TOS1		;;A=UPPER BITS OF TOS MANT
	MOV	E,A		;;BCD= MANT OF NOS      EHL=MANTISSA OF TOS
	ORA	A
	JP	DIV99	;;JMP IF ZERO DIVISOR OR NOT NORMALIZED
	MOV	A,B
	ORA	A
	JP	MUL15	;;JMP IF DIVIDEND ZERO OR NOT NORMALIZED
;;
DIV09:	MOV	A,B
	SUB	E	;;COMPARE UPPER BITS OF MANT
	JC	DIV01	;;JMP IF DIVIDEND<DIVISOR
	JNZ	DIV02	;;JMP IF DIVIDEND>DIVISOR
	MOV	A,C
	SUB	H	;;COMPARE MIDDLE BITS OF MANT
	JC	DIV01	;;JMP IF DIVIDEND<DIVISOR
	JNZ	DIV02	;;JMP IF DIVIDEND >DIVISOR
	MOV	A,D
	SUB	L	;;COMPARE LOWER BITS OF MANT
	JC	DIV01	;;JMP IF DIVIDEND<DIVISOR
DIV02:	MOV	A,D	;;DIVISOR WENT INTO DIVIDEND SO SUBTRACT IT OUT
	SUB	L
	MOV	D,A
	MOV	A,C
	SBB	H
	MOV	C,A
	MOV	A,B
	SBB	E
	MOV	B,A	;;NEW DIVIDEND IS IN EHL
	XRA	A	;;CLEAR CARRY SO NEXT INSTR WILL SET IT
DIV01:	CMC		;;THE CARRY IS IS THE BIT OF THE QUOTIENT
	PUSH	PSW	;;SAVE BIT OF QUOTIENT ON STACK
	XRA	A
	MOV	A,E	;;*
	RAR		;;*
	MOV	E,A	;;*
	MOV	A,H	;;*	DIVISOR=DIVISOR/2
	RAR		;;*
	MOV	H,A	;;*
	MOV	A,L	;;*
	RAR		;;*
	MOV	L,A	;;*
	ORA	H
	ORA	E
	JNZ	DIV09	;; JMP IF DIVISOR NOT ZERO YET
;;
	MVI	C,8D	;;LOOP COUNT TO BUILD QUOTIENT
;;
;;
;;		BITS OF QUOTIENT ARE NOW ON STACK LOWEST BIT FIRST
;;
;;
	MOV	B,C
DIV06:	POP	PSW	;;GET BIT OF QUOT INTO CARRY
	MOV	A,L
	RAR
	MOV	L,A
	DCR	B
	JNZ	DIV06
	MOV	B,C
DIV12:	POP	PSW
	MOV	A,H
	RAR	
	MOV	H,A
	DCR	B
	JNZ	DIV12
DIV14:	POP	PSW
	MOV	A,E
	RAR	
	MOV	E,A
	DCR	C
	JNZ	DIV14
;;
	MVI	B,1
	ORA	A
	JM	DIV05	;;JMP IF QUOTIENT NORMALIZED ALREADY
	MVI	B,0
	MOV	A,L	;;*
	RAL		;;*
	MOV	L,A	;;*
	MOV	A,H	;;*
	RAL		;;*	NORMALIZE MANT OF QUOTIENT
	MOV	H,A	;;*
	MOV	A,E	;;*
	RAL		;;*
	MOV	E,A	;;*
DIV05:	POP	PSW	;;GET PARTIAL EXP AND SIGN INTO A
	ADD	B	
	ANI	7FH	;;A HAS EXP VALUE MOD 2**7
	MOV	C,A	;;SAVE FOR LATER USE TO BUILD COMPLETE EXP BYTE
	PUSH	H	;;SAVE LOWER HALF OF QUOTIENT
	LXI	H,TOS
	LDA	NOS	;;GET EXP BYTE
	XRA	M	;;SING BIT OF A IS SIGN OF QUOTIENT
	ANI	80H
	ORA	C	;; A NOW HAS COMPLETE EXP BYTE FOR QUOTIENT
DIV999:	MOV	M,A	;;	SAVE RESULT ON FP STACK
	INX	H
	MOV	M,E	;;INSERT MANT HIGH
	POP	D
	INX	H
	MOV	M,D	;;INSERT MANT MIDDLE
	INX	H
	MOV	M,E	;;INSERT MANT LOW
	CALL	FPPOP	;;POP UP FLPT WORK STACK
;;
;;
	IF	FPMSTK
	LHLD	FPUSTK
	SPHL		;;RESTORE CALLER'S STACK PT
	ENDIF
;;
	RET		;;THAT'S ALL FOLKS
;;
;;
;;
DIV99:			;;COME HERE IF DIVIDE BY ZERO

	IF	FPMSTK
	LHLD	FPUSTK
	SPHL		;;RESTORE CALLER'S SP
	ENDIF
;;
;;	DONT TAKE EXIT HANDLE INTERNALLY
;;
	MVI	A,34H	;;EXP BYTE	MAKE ANSWER VERY LARGE
	MVI	E,80H	;;MANT
	LXI	H,0	;;REST OF MANT
	XTHL		;;SAVE HL ON STACK IN PLACE OF GARBAGE THAT
;;			 WAS THERE FROM SET UP.
	LXI	H,TOS	;;PLACE TO SAVE ANSWER
	JMP	DIV999	;;GO JOIN OTHER CODE IN NORMAL, -PROCESSING
;;
;;
;;
;;
;;
;;
;;	THIS MODULE CONTAINS FIX AND FLOAT SUBROUTINES FOR USE BY THE
;;	FLOATING POINT INTERPRETER AND GENERAL ASSMBY LANG USERS
;;
;;
;;
;;
;;
;;	PUBLIC	FPFLOT,FLOAT2,FLOAT3
;;	PUBLIC	FPFIX,FIX
;;
;;
;;	CSEG
;;
;;
;;
;;
;;	FLOAT A FIXED POINT VALUE SUBROUTINES
;;
;;
;;	FPFLOT - USED BY THE INTERPRETER  DATA COMES FROM TOS AND
;;		 GOES BACK INTO TOS
;;
;;
;;	FLOAT2 - I/P    HL=ADR TO PLACE 4 BYTE FLOATING POINT FORMAT RESULT
;;			DE= 16 BIT FIXED PT VALUE TO FLOAT
;;
;;
;;	FLOAT3 - I/P 	HL=ADR TO PLACE FL PT FORMAT DATA
;;			DEC = 24 BIT FIXED PT VALUE TO FLOAT
;;				 D=UPPER BITS
;;				 E=MIDDLE BITS
;;				 C=LOWER BITS
;;
;;
;;
;;
;;
FPFLOT:	LXI	H,TOS1	;;COME HER FROM INTEWRPRETER
	MOV	E,M
	DCX	H
	MOV	D,M	;;DE=DATA TO FLOAT - HL =PLACE TO STORE
;;
FLOAT2:	MVI	B,16D	;;GENERAL ENTRY  B HAS LOOP COUNT FOR 16 BIT CONV
	XRA	A
	MOV	C,A	;;C HAS LOWER 8 BITS OF 24 BIT VALUE
FPFL05:	ORA	D
	JP	FPFL01	;;JMP IF FIXD VAL IS POSITIVE
	MOV	A,B	;;VAL IS NEG MAKE POS
	ORI	80H
	MOV	B,A	;;PUT NEG MANT BIT INTO EXP BUILD AREA
	MOV	A,C
	CMA
	ADI	1
	MOV	C,A
	MOV	A,E
	CMA
	ACI	0
	MOV	E,A
	MOV	A,D
	CMA
	ACI	0
	MOV	D,A	;;DEC NOW HAVE POSITIVE VALUE
FPFL01:	ORA	E	;;A=D=UPPER BITS OF FIXED VALUE
	ORA	C
	JZ	FPFL02	;;JMP IF FIXED VALUE IS COMPLETELY ZERO
FPFL03:	DCR	B	;;DECR EXP AND CLEAR CARRY
	MOV	A,C	;;*
	RAL		;;*
	MOV	C,A	;;*
	MOV	A,E	;;*
	RAL		;;*	24 BIT LEFT SHIFT
	MOV	E,A	;;*
	MOV	A,D	;;*
	RAL		;;*
	MOV	D,A	;;*
	ORA	A
	JP	FPFL03	;;JMP IF VALUE NOT NORMALIZED YET
;;
;;	ALL DONE  NOW STORE IT
;;
FPFL04:	MOV	M,B
	INX	H
	MOV	M,D
	INX	H
	MOV	M,E
	INX	H
	MOV	M,C	
	RET		;;THAT'S ALL FOLKS
;;
;;
FPFL02:	MOV	B,A	;;SET EXP TO ZERO TOO
	JMP	FPFL04
;;
;;
FLOAT3:	MVI	B,24D	;;SET EXP FOR 24 BIT VALUE
	XRA	A
	JMP	FPFL05	;;GO JOIN REST OF CODE
;;
;;
;;
;;
;;	FIX A FLOATING POINT VALUE SUBROUTINES
;;
;;
;;		FPFIX - USED BY THE INTERPRETER. DATA COMES FROM AND GOES
;;			BACK INTO TOS.
;;
;;
;;	FIX   - I/P	HL=ADR OF FLOATING PT FORMAT VAL TO BE CONVERTED
;;
;;		O/P	CDE=FIXED PT RESULT
;;			  C=UPPER BITS
;;			  D=MIDDLE BITS
;;			  E=LOWER BITS
;;
;;
;;
;;
;;
;;
FPFIX:	LXI	H,TOS	;;COME HERE FROM INTERPRETER
	XRA	A	;;CLEAR CARRY AS FLAG
	JMP	FPFX01
;;
FIX:	STC		;;SET CARRY THIS IS USED AS A FLAG TO DETERMINE
;;			 HOW A RETURN WILL BE MADE
;;
FPFX01:	MOV	A,M	;;A HAS EXP BYTE
	PUSH	PSW	;;SAVE EXP AND CARRY FLAG
	MOV	B,A
	ANI	40H	;;LEAVE SIGN OF EXP
	JNZ	FPFX02	;;JMP IF VALUE < 0
	MOV	A,B	;;GET COMPLETE EXP AGAIN
	ANI	7FH	;;LEAVE EXP   MUST BE POS
	JZ	FPFX02	;;JMP IF VALUE < 0
	SUI	24D	;;*
	CMA		;;*
	INR	A	;;* A=24-A
	JM	FPFX03	;;JMP IF VALUE TOO LARGE FOR 24 BITS FIXED PT
	JZ	FPFX03	;;DITTO
;;
;;	VALUE IS OKAY TO CONVERT
;;
	MOV	B,A	;;B HAS SHIFT COUNT COMPUTED ABOVE
	INX	H	;;POINT AT HIGH BITS OF MANTISSA
	MOV	C,M
	INX	H
	MOV	D,M
	INX	H
	MOV	E,M	;;CDE HAVE MANTISSA
;;
FPFX04:	XRA	A	;;CLEAR CAYRRY
	MOV	A,C	;;*
	RAR		;;*
	MOV	C,A	;;*
	MOV	A,D	;;*
	RAR		;;*RIGHT SHIFT 1 BIT
	MOV	D,A	;;*
	MOV	A,E	;;*
	RAR		;;*
	MOV	E,A	;;*
	DCR	B	;;   DECR LOOP COUNT
	JNZ	FPFX04	;;JMP IF NOT DONE YET
;;
FPFX06:	POP	PSW
	PUSH	PSW	;;GET AND SAVE AGAIN EXP BYT AND RET FLAG
	ANI	80H	;;LEAVE SIGN BIT OF MANTISSA
	JZ	FPFX05	;;JMP IF MANTISSA IS POS
;;
;;	MANTISSA IS NEG   HAVE TO 2'S COMPL VALUE
;;
	MOV	A,E	;;*
	CMA		;;*
	ADI	1	;;*
	MOV	E,A	;;*
	MOV	A,D	;;*
	CMA		;;*
	ACI	0	;;*  FORM 24 BIT 2'S COMPL OF VALUE
	MOV	D,A	;;*
	MOV	A,C	;;*
	CMA		;;*
	ACI	0	;;*
	MOV	C,A	;;*
;;
FPFX05:	POP	PSW	;;GET RET FLAG IN CARRY BIT
	RC		;; ALL DONE IF GENERAL ENTRY WAS CALLED
;;
;;	INTERP CALLED SO HAVE TO SAVE VAL IN TOS
;;
	DCX	H
	DCX	H
	MOV	M,E	;;PUT IN LOW BITS
	DCX	H
	MOV	M,D	;;PUT IN HIGH BITS   INTRP ONLY USES 16 BIT FIXED PT
;;
	RET
;;
;;
FPFX02:	XRA	A	;;FLPT VAL WAS < 0  SO MAKE RESULT = 0
	MOV	E,A
	MOV	D,A
	MOV	C,A
	INX	H
	INX	H
	INX	H	;;PUT POINTER UP SO CAN JOIN OTHER CODE
	JMP	FPFX05
;;
;;
FPFX03:	MVI	C,7FH	;;FLPT VAL WAS TOO LARGE IN MAGNITUDE
;;			 SO SET RESULT TO VERY BIG  POS OR NEG VAL
	MOV	D,C
	MVI	E,0FFH
	INX	H
	INX	H
	INX	H	;;SET POINTER SO CAN JOIN OTHER CODE
	JMP	FPFX06
;;
;;
;;
;;
;;
;;
;;
;;
;;
;;
;;	THIS MODULE CONTAINS ALL RAM DEFINITIONS FOR THE FLOATING POINT
;;	INTERPRETER. SOME COMMON SUBRS ALSO RESIDE HERE.
;;
;;
;;
;;
;;	PUBLIC	TOS,TOS1,TOS2,TOS3,NOS,NOS1,NOS2,NOS3
;;	PUBLIC  ROS,ROS1,ROS2,ROS3,LLOS,LLOS1,LLOS2,LLOS3
;;	PUBLIC	FPPOP,FPPOPP,FPTEMP
;;      	PUBLIC	FPADR,FPOINT,FPPUSH,FPMOVE
;;	PUBLIC	FPSSTK,FPSRSK,INDEX1,INDEX2,INDEX3
;;	PUBLIC	FPFLAG,FPCARY,FPTMP1,FPTMP2,FPTMP3
;;	PUBLIC	FPERFL,FPEREX
;;
	IF	FPMSTK
;;	PUBLIC	FPUSTK,FPMDST
	ENDIF
;;
;;
;;
;;
;;	CSEG
;;
;;
FPPOPP:	LHLD	NOS	;;FULL FP STACK POP
	SHLD	TOS
	LHLD	NOS2
	SHLD	TOS2
;;
;;	FALL INTO FPPOP SUBR
;;
	IF	FPTRNF		;;ASMB IF INCL TRANSCEN FUNCT'S
;;
FPPOP:	LHLD	ROS	;;POP LAST 3 STACK ELEMENTS
	SHLD	NOS
	LHLD	ROS2
	SHLD	NOS2
;;
	LHLD	LLOS
	SHLD	ROS
	LHLD	LLOS2
	SHLD	ROS2
;;
	RET
;;
	ENDIF
;;
;;
	IF	FPTRNF XOR 0FFFFH	;;ASMB IF DO NOT INCL TRANSCEN FUNCT'S
;;
FPPOP:	MVI	C,8
	LXI	H,ROS	;;SOURCE ADR
	LXI	D,NOS	;;DEST ADR
	JMP	FPMOV1	;;GOTO MOVE SUBR TO PUSH DATA   WILL RET FROM THERE
;;
	ENDIF
;;
;;
	IF	FPTRNF		;;ASMB IF INCL TRANSCEND FUNCT'S
;;
FPPUSH:	LHLD	ROS2	;;PUSH DOWN FP WORK STACK SUBR
	SHLD	LLOS2
	LHLD	ROS
	SHLD	LLOS
	LHLD	NOS2
	SHLD	ROS2
	LHLD	NOS	
	SHLD	ROS
	LHLD	TOS2
	SHLD	NOS2
	LHLD	TOS
	SHLD	NOS
;;
	RET
;;
	ENDIF
;;
;;
	IF	FPTRNF XOR 0FFFFH	;;ASMB IF DO NOT INCL TRANSCEND FUNCT'AS
;;
FPPUSH:	MVI	C,12	;;LOOP COUNT
	LXI	H,ROS3		;;SOURCE ADR
	LXI	D,LLOS3		;;DEST ADR
FPPSH1:	MOV	A,M
	STAX 	D
	DCX	H
	DCX	D
	DCR	C
	JNZ	FPPSH1
	RET
;;
	ENDIF
;;
;;
;;
;;
;;
FPMOVE:	MVI	C,4	;;SUBR TO MOVE 4 BYTES  HL=SOURCE DE=DEST
FPMOV1:	MOV	A,M
	STAX	D
	INX	H
	INX	D
	DCR	C
	JNZ	FPMOV1
	RET
;;
;;
FPEQZR:
	LXI	H,TOS1	;;COMMON SUBR TO DETERMINE IF TOS=0
;;			 Z FLAG = TRUE IF TOS=0
;;			 ON RETN HL=ADR OF TOS
	MOV	A,M
	DCX	H
	ORA	M
	RET
;;
;;	SQUARE ROOT ROUTINE
;;
;;	ORIGINALLY WRITTEN BY RAY KLEIN
;;
FPRSQR:

	POP	B
	POP	H
	POP	D	;;BC=RET,LHED=REAL
	PUSH	B

	MOV	A,L	;;GET EXP
	CALL	EXPS1	;;A=8 BIT EXP ONLY IN 2'S COMPL
	RAR		;;/2
	PUSH	PSW	;SAVE NEW EXP AND NODD EVEN FLAG IN CARRY

	MVI	L,0
	SHLD	NOS	;;LHED=M IN RANGE .5 TO 1.0

	XCHG
	SHLD	NOS2	;;PUT M IN FLPT WRK STK

	PUSH	D
	PUSH	H	;;ALSO PUT ON SYSTEM STACK

	LXI	H,9700H
	SHLD	TOS
	LXI	H,0DE14H
	SHLD	TOS2	;; TOS = .59016206

	CALL	FLOATMULT
	CALL	FPPUSH		;;NOS=.59016206 * M

	LXI	H,0D57FH
	SHLD	TOS
	LXI	H,056A9H
	SHLD	TOS2	;; TOS = .41730759
	CALL	FLOATADD

	MVI	A,3
	STA	FPTMP1	;;SET UP LOOP COUNTER

FPSQ01:

	LHLD	TOS
	SHLD	ROS
	LHLD	TOS2
	SHLD	ROS2
	POP	H
	POP	D
	SHLD	NOS2
	XCHG
	SHLD	NOS	;;SET UP FOR GUESSING

	PUSH	H
	PUSH	D
	CALL	FLOATDIV
	CALL	FLOATADD
	CALL	FPDIV2

	LXI	H,FPTMP1
	DCR	M
	JNZ	FPSQ01

	POP	H
	POP	H	;;FLUSH SYS STK

	POP	PSW		;;A=NEW EXP
	STA	TOS
	JNC	FPSQ02

	LXI	H,0B501H	;;IF ODD THEN * SQRT(2)
	SHLD	NOS
	LXI	H,0F204H
	SHLD	NOS2
	CALL	FLOATMULT

FPSQ02:
	POP	D
	LHLD	TOS2
	PUSH	H
	LHLD	TOS
	PUSH	H		;;PUT RESULT ON SYSTEM STACK

	XCHG			;;GET RET ADDR INTO HL
	PCHL

;;
;;	FAST DIVIDE TOS BY 2 (USED BY FPRSQR)
;;
FPDIV2:
	CALL	FPEQZR
	RZ			;;IF ZERO THEN EXIT

	MOV	A,M
	MOV	B,A
	CALL	EXPS1
	DCR	A		;;THIS IS THE DIVIDE
	ANI	07FH		;;IGNORE MANT. SIGN
	MOV	C,A		;;SAVE IT
	MOV	A,B		;;A=ORIG EXP BYTE
	ANI	80H		;;GET MANT. SIGN
	ORA	C		;;PUT WITH NEW EXPONENT
	MOV	M,A		;;AND WE ARE DONE
	RET

;;
;;	END OF ROMABLE CODE
;;
	ENDM

SW9511DATA MACRO
;;
;;
;;
;;
;;
;;	DSEG
;;
;;
FPTEMP:	DS	1	;;TEMP WORK AREA   MUST BE BYTE PRECEDING TOS
;;
;;
TOS:	DS	1	;;TOP OF FLPT STACK  (EXP)
TOS1:	DS	1	;;	MANT HIGH
TOS2:	DS	1	;;	MANT MIDDLE
TOS3:	DS	1	;;	MANT LOW
;;
NOS:	DS	1	;;NEXT ON STACK
NOS1:	DS	1
NOS2:	DS	1
NOS3:	DS	1
;;
ROS:	DS	1	;;REST OF STACK
ROS1:	DS	1
ROS2:	DS	1
ROS3:	DS	1
;;
LLOS:	DS	1	;;LAST MEMBER OF STACK
LLOS1:	DS	1
LLOS2:	DS	1
LLOS3:	DS	1	;;END OF STACK
;;
;;	FPTMP1 - SAME AS LLOS3 (USED ONLY BY SQRT)
;;	BECAUSE SQRT DOES NOT USE LLOS
FPTMP1	EQU	LLOS3
	ENDM