;;
;;	LAST MODIFICATION: DECEMBER 21, 1979
;;

;;
;;	FLOATING POINT REALFROMFLOAT
;;
FINPUSH4 MACRO
	INX H
	INX	H
	INX	H
	MOV	B,M
	DCX	H
	MOV	C,M
	PUSH	B
	DCX	H
	MOV	B,M
	DCX	H
	MOV	C,M
	PUSH	B
	ENDM

FINSTORE MACRO
	POP	B
	POP	D
	POP	H
	MOV	M,C
	INX	H
	MOV	M,B
	INX	H
	MOV	M,E
	INX	H
	MOV	M,D
	DCX	H
	DCX	H
	DCX	H
	XCHG
	ENDM


realfromfloat	macro
;;
;;	ADATA AND ACTRL ARE NOW VARIABLES
;;	AND THE COMPILER USES SELF MODIFYING CODE
;;	VIN AND VOUT ARE NOW MACROS WHICH USE ADATA AND ACTRL
;;	FROM THE P2DATA AREA
;;
;;	THIS IS TO SIMPLIFY MOVING THE COMPILER FROM SYSTEM TO SYSTEM
;;
;;	NOW THE USER HAS ONLY TO PATCH TWO WELL KNOWN LOCATIONS
;;	TO ADAPT THE 9511 ROUTINES TO HIS/HER MACHINE
;;
;;	MODIFICATIONS MADE BY MGL ON NOVEMBER 29 ,1979


;;
;;
;;	FLTIN
;;
;;PARAMETERS: DE CONTAINS THE POINTER TO THE REAL NUMBER
;;	     HL POINTS TO THE LENGTH BYTE+2.
;;	     FIRST CHARACTER IS IN C-REG
;;
FLTIN:  
;;	
	SHLD  CMPTR	;;SAVE PTR TO REAL IN CMPTR
	PUSH D		;;SAVE PTR TO REAL
	LXI H,DTAREA	;;CLEAR DATA AREA
	MVI B,DTALEN
	CALL CLEAR
	XCHG		;;CLEAR RESULT
	MVI B,4
	CALL CLEAR
;;
;;	IF CHAR = + OR -, SIGN = CHAR. READ NEXT CHAR.
;;
	LXI H,SIGN
	CALL CKSIGN
	MOV A,C
	POP D		;;RESTORE DESTINATION POINTER
	PUSH D		;;RESTORE D ON STACK
	CALL GTINT	;;READ INTEGER PORTION
	CPI 1
	JZ FIABORT
;;
;;	IF INTEGER PORTION OVERFLOWS, LSD'S ARE IGNORED,
;;	BUT CNT2 SHOWS HOW MANY DIGITS WERE SCANNED
;;	AFTER OVERFFOW OCCURRED.  THE DECIMAL EXPONENT
;;	MUST BE ADJUSTED BY THIS NUMBER
;;
	LDA CNT2
	STA EXP1
;;
;;	READ FRACTION PART IF PRESENT
;;
	MOV A,C		;;A=CHARACTER
	CPI '.'		;;DECIMAL POINT?
	JNZ FIN10	;;NO.
	CALL NXCHR	;;READ 1ST DIG. OF FRACTION
	CALL GTINT	;;READ FRACTION
	CPI 1		;;ILLEGAL CHAR?
	JZ FIABORT	;;YES. ABORT.
;;
;;	X IS NOW AN INTEGER THAT REPRESENTS THE
;;	FRACTION DIGITS CONCATENATED ONTO THE INTEGER
;;	DIGITS. EXP MUST BE ADJUSTED BY SUBTRACTING
;;	THE NUMBER OF DIGITS READ BEFORE OVERFFOW.
;;
	LDA EXP1	;;EXP1=EXP1-CNT1
	LXI H,CNT1
	SUB M
	STA EXP1
;;
;;	THE NUMBER READ SO FAR = X * 10**EXP1.
;;
FIN10:	XRA A		;;CLEAR ERCODE
	STA ERCODE
	PUSH B
	PUSH D
	XCHG
	INX H
	MOV D,M
	INX H
	MOV E,M
	INX H
	MOV C,M
	POP H
	PUSH H
	CALL FLOAT3
	POP D
	POP B
;;
;;	LOOK FOR E FIELD
;;
	MOV A,C		;;A=CHAR.
	CPI 'E'
	JNZ FIN30	;;NO E FIELD
	CALL NXCHR
	LXI H,SEXP	;;LOOK FOR SIGN OF EXP
	CALL CKSIGN
;;
;;	E MUST BE FOLLOWED BY A DIGIT
;;
	MOV A,C
	CALL VALDIG
	JC FIN20	;;VALID DIGIT
;;
;;	ILLEGAL CHAR IN EXP.
;;
	MVI A,1
	STA ERCODE
	JMP FIABORT
;;
FIN20:	LXI D,EXP	;;RESULT OF GTINT TO EXP
	CALL GTINT
	LDA ERCODE	;;ABORT IF ANY ERROR
	ORA A
	JNZ FIABORT
;;
;;	IF SEXP = '-', EXP = -EXP
;;
	LDA SEXP
	CPI '-'
	JNZ FIN30	;;POS EXP
	LXI D,EXP
	LDA EXP+3
	CMA
	INR A
	STA EXP+3

;;
;;	ADJUST EXP FOR DECIMAL POINT OF INTG
;;
FIN30:	LXI D,EXP
	LXI H,EXP1
	CALL ADDQS	;;EXP=EXP+EXP1
;;
;;	IF EXP > 18, OVERFLOW
;;
	XCHG		;;HL = EXP
	LDA EXP+3
	MOV B,A
	MVI A,18
	SUB B
	JM FIOVFL

;;
;;	IF EXP < -18, UNDERFLOW
;;
	CPI 36
	JP FIUFL


;;
;;	MULTIPLY OR DIVIDE DIGITS BY POWER OF 10.
;;	(SINCE -32 < EXP < 32, WE CAN USE JUST
;;	TH LAST BYTE OF EXP.)
;;
	LDA EXP+3	;;SAVE SIGN OF EXP
	ORA A		;;AND STATUS
	PUSH PSW
;;
;;	SET A = ABS(EXP)
;;
	JP FIN40
	CMA		;;COMPLEMENT A
	INR A		;;NEGATE A
;;
;;	USE A AS AN INDEX INTO TABLE OF POWERS OF 10
;;
FIN40:	LXI H,PWR10
	CALL TINDEX	;;HL = HL + 4*A
	POP PSW		;;GET SIGN OF EXP
	POP D		;;ADR OF RESULT
	PUSH D
	XCHG
	FINPUSH4
	XCHG
	FINPUSH4
	JM FIN50	;;NEG EXP
;;
;;	POSITIVE EXP. MULTIPLY BY POWER OF 10
;;
	CALL SWRMUL	;;TOS * NOS
	FINSTORE
	PUSH D		;; PUT IT BACK ON STACK FOR FIN70
	JMP FIN60

;;
;;	OVERFLOW
;;
FIOVFL:	MVI A,2
	LXI H,FLMAX	;;SET X=MAX FLT. PT. #
	JMP FIU10	;;SHARE PART OF UNDERFLOW CODE
;;
;;	NEGATIVE EXP. DIVIDE BY POWER OF 10
;;
FIN50:	CALL SWRDIV
	FINSTORE
	PUSH D
;;
;;	ADJUST SIGN BIT
;;
FIN60:	MVI B,0
	LDA SIGN
	CPI '-'
	JNZ FIN70	;;POSITIVE
	MVI B,80H	;;NEGATIVE
FIN70:	POP D		;;ADR OF RESULT
	PUSH D
	LDAX D		;;SIGN, EXP BYTE
	ORA B		;;OR IN SIGN BIT
	STAX D
FIABORT: LDA ERCODE
	POP D
	RET
;;
;;	UNDERFLOW
;;
FIUFL:	MVI A,3
	LXI H,ZERO	;;SET X=0
;;
;;	CODE SHARED BY OVERFLOW ROUTINE
;;
FIU10:	STA ERCODE
	POP D		;;ADR OF X
	CALL COPY4	;;COPY 4 BYTE & RETURN
	STC		;;SET CARRTY TO INDICATE ERROR
	LDA  ERCODE	;;GET ERCODE BACK
	RET		;;RETURN TO CALLER
;;
;;
;;	THIS ROUTINE CONCATENATES DIGITS FROM THE
;;	INPUT STRING ONTO THE INTEGER AT M(DE) UNTIL
;;	A NON-DIGIT CHARACTER IS ENCOUNTERED.
;;	IF INTEGER OVERFLOW OCCURS, THE INTEGER IS
;;	RESTORED TO ITS VALUE BEFORE OVERFLOW
;;	AND SCANNING CONTINUES.
;;
;;	IF ERCODE IS NON-ZERO ON ENTRY, THE INTEGER IS
;;	NOT ALTERED, BUT THE SCANNING DOES TAKE PLACE.
;;
;;	INPUT:  C= 1ST CHAR OF INPUT STRING
;;		DE = ADR OF INTEGER
;;		SUBROUTINE NXCHR FURNISHES INPUT CHARS
;;	OUTPUT:	DE = ADR OF INTEGER
;;		CNT1 = # OF DIGITS READ BEFORE OVERFLOW
;;		CNT2 = # OF DIGITS AFTER OVERFLOW
;;		C = 1ST CHAR. AFTER INTEGER
;;		ERCODE = 0 IF NO ERROR
;;			= 1 IF ALPHA CHAR OTHER THAN E
;;			= 2 IF INTEGER OVERFLOW
;;		A = ERCODE
;;	TEMPORARY STORAGE: OLDINT, DIGT
;;
GTINT:	XRA A		;;CLEAR COUNTS
	STA CNT1
	STA CNT2
;;
;;	IF ERR, SCAN OVER DIGITS
;;
	LDA ERCODE
	ORA A
	JNZ GTI30
;;
;;	BEGIN LOOP. EXIT IF NON-DIGIT
GTI10:	MOV A,C
	CALL VALDIG
	JNC GTI30	;;NOT DIGIT. EXIT.
;;
;;	SAVE VALUE OF INTEGER IN OLDINT.
;;
	XCHG
	LXI D,OLDINT
	CALL COPY4
;;
	PUSH B
	PUSH D
	PUSH H
	MVI B,9
GTI10A:
	CALL ADD4
	DCR B
	JNZ GTI10A
	POP H
	POP D
	POP B	
	XCHG

	LDAX D
	ORA A
	JNZ GTI20
	MOV A,C		;;GET CHAR
	SUI '0'		;;CONVERT TO BINARY
	LXI H,DIGT
	MOV M,A
	CALL ADDQS	;;M(DE) = M(DE) + DIGT
	LXI H,CNT1	;;INC. # OF DIGITS BEFORE OVFL
	INR M
	CALL NXCHR
	JMP GTI10	;;REPEAT LOOP
;;	END LOOP
;;
;;	OVERFFOW. RESTORE OLD VALUE & SET ERCODE
;;
GTI20:	MVI A,2
	STA ERCODE
	LXI H,OLDINT
	CALL COPY4
;;
GTI30:	LXI H,CNT2
;;
;;	BEGIN LOOP TO SCAN OVER DIGITS AFTER OVERFLOW
;;
GTI40:	MOV A,C
	CALL VALDIG
	JNC GTI50	;;NOT A DIGIT. EXIT LOOP.
	INR M		;;INC. CNT2
	CALL NXCHR
	JMP GTI40
;;
;;	CHECK FOR ALPHA OTHER THAN E
;;
GTI50:	LXI H,ERCODE
	CALL ALPHA
	JNC GTI60	;;NOT ALPHA. OK.
	CPI 'E'
	JZ GTI60	;;'E', OK
	MVI M,1		;;ILL. CHAR. ERCODE=1
;;
GTI60:	MOV A,M		;;A=ERCODE
	RET

;;*****    EQUATES    ***********************************
;;
CR:	EQU 0DH		;;ASCII CARRIAGE RETURN
LF:	EQU 0AH		;;ASCII LINE FEED
BS:	EQU 08H		;;ASCII BACKSPACE
RUBOUT:	EQU 7FH		;;ASCII RUB OUT
ESC:	EQU 1BH		;;ASCII ESCAPE CHARACTER
SSTAT:	EQU 01000000B	;;APU SIGN BIT
ZSTAT:	EQU 00100000B	;;APU ZERO BIT
ECFIELD: EQU 00011110B	;;ER CODE FIELD OF STAT
;;
;;	APU COMMAND CODES:
;;
DADD:	EQU 2CH
DSUB:	EQU 2DH
DMUL:	EQU 2EH
FADD:	EQU 10H
FDIV:	EQU 13H
FLTS:	EQU 1DH
FLTD:	EQU 1CH
FMUL:	EQU 12H
FSUB:	EQU 11H
PTOF:	EQU 17H
SADD:	EQU 6CH
;;SDIV:	EQU 6FH			;COMMENTED OUT BECAUSE OF SDIV MACRO IN
				;;MATH.LIB
XCHF:	EQU 19H
SQRT:	EQU 01H
FIXS:	EQU 1FH
PUPI:	EQU 1AH
CHSF:	EQU 15H
;;
;;	EQUATES FOR 9511 INTERFACE***
;;
;;
;;


;;
;;	ROUTNE TO DO SOFTWARE 4 BYTE ADD
;;
ADD4:
	PUSH	B
	PUSH	D
	PUSH	H
	LXI	B,3
	DAD	B
	XCHG
	DAD	B
	XCHG
	MVI	B,4
	STC
	CMC
	PUSH	PSW

ADD4A:
	POP	PSW
	LDAX	D
	ADC	M
	PUSH	PSW
	MOV	M,A
	DCX	H
	DCX	D
	DCR	B
	JNZ	ADD4A
	POP	PSW
	POP	H
	POP	D
	POP	B
	RET	
;;
;;

ADDQS:	
	INX D		;;MOVE TO LSD
	INX D
	INX D
	MVI B,3		;;LOOP COUNT
	MOV A,M		;;+ OR -?
	ORA A
	LDAX D
	JM AQS20	;;2ND OPRND NEG.
	ADD M
	STAX D
AQS10:	DCX D
	LDAX D
	ACI 0
	STAX D
	DCR B
	JNZ AQS10	;;REPEAT LOOP
	RET
;;
AQS20:	ADD M
	STAX D
;;
AQS30:	DCX D
	LDAX D
	ACI 0FFH	;;PROPAGATE CARRY
	STAX D
	DCR B
	JNZ AQS30
	RET
;;
;;	IF INPUT CHAR = + OR -S, SET M(HL) = CHAR
;;	AND READ NEXT CHAR.
;;	INPUT:	C = CHAR
;;	HL = DEST. OF CHAR
;;	OUTPUT: M(HL) ALTERED
;;		C = NEXT CHAR
;;	FETCH A CHARACTER INTO C
;;
NXCHR:	CALL	FETCM		;;FETCH FROM COMMAND BUFFER
	MOV	C,A
	RET
;;
FETCM:	PUSH 	H		;;SAVE HL
	LHLD 	CMPTR
	MOV	A,M		;;FETCH BYTE
	INX 	H
	SHLD	CMPTR		;;UPDATE POINTER
	POP	H
	RET
;;
;;
;;
CKSIGN:	MOV A,C
	CPI '+'
	JZ CSG10
	CPI '-'
	RNZ		;;NO SIGN
CSG10:	MOV M,C		;;SAVE SIGN
	JMP NXCHR
;;
;;	CLEAR B BYTES STARTING AT M(HL)
;;	ALTERS A,B, & HL
;;
CLEAR:	MVI M,0
	INX H
	DCR B
	JNZ CLEAR	;;REPEAT LOOP
	RET
;;
;;	COPY 4 BYTES FROM M(HL) TO M(DE)
;;	SAVE HL, DE. ALTERS B
;;
COPY4:	MVI B,4
COPY:	PUSH D
	PUSH H
CPY10:	MOV A,M
	STAX D
	INX H
	INX D
	DCR B
	JNZ CPY10	;;REPEAT LOOP
	POP H
	POP D
	RET
;;
;;	SET CARRY IF A IS AN ALPHA CHAR.
;;
ALPHA:	CPI 'Z'+1
	RNC
	CPI 'A'
	CMC
	RET
;;
;;	SET CARRY IF A IS A VALID ASCII DIGIT.
;;
VALDIG:	CPI '9'+1
	RNC
	CPI '0'
	CMC
	RET
;;

;;	SET HL = HL + 4*A
;;
TINDEX:	RLC
	RLC
	ADD L
	MOV L,A
	RNC
	INR H		;;PROPAGATE CARRY
	RET
;;
;;
;;	LEFT SHIFT THE 4-BYTE # AT M(DE) C TIMES
;;	C MUST BE < 127
;;	ALTERS B,C
;;
LSHQ:	DCR C		;;TEST LOOP COUNT
	RM		;;EXIT LOOP
	CALL LSHQ1	;;SHIFT ONCE
	JMP LSHQ	;;REPEAT LOOP
;;
;;	LEFT SHIFT M(DE) ONCE
;;
LSHQ1:	MVI B,4		;;LOOP COUNT
	INX D
	INX D
	INX D
	XRA A		;;CLEAR CARRY
;;
LSQ10:	LDAX D
	RAL
	STAX D
	DCX D
	DCR B
	JNZ LSQ10
	INX D
	RET
;;

;;	TEST M(DE) = 0. SET Z IF = 0
;;	SAVE DE
;;
TEQ0:	PUSH D		;;SAVE D
	XCHG
	MOV A,M
	INX H
	ORA M
	INX H
	ORA M
	INX H
	ORA M
	XCHG
	POP D
	RET
;;
;;	OUTPUT SIGN CHAR THEN SET X=ABS(X)
;;	INPUT:	A = SIGN
;;		DE = ADR(X)
;;	ALTERS C
;;
OUTSGN:	MVI C,' '	;;SET UP SIGN
	LDAX D		;;A = SGN & EXP
	ORA A		;;TEST SIGN BIT
	JP OSG10	;;POSITIVE
	MVI C,'-'	;;NEGATIVE
;;
OSG10:	ANI 07FH	;;CLEAR SIGN OF MANT.
	STAX D
	JMP OUTCHR	;;OUTPUT SIGN
;;
;;	POP SPU FSYS INYO M(DE) THEN READ
;;	APU STATUS INTO A.
;;	SAVE DE. ALTERS B
;;
;;
;;	PUSH M(DE) & M(HL) INTO APU
;;	SAVE DE, HL. ALTERS B
;;
;;	----------------------------------------
;;
;;	OUTCHR - BUILDS BUFFER DATA FROM AMD OUTPUT
;;
;;	----------------------------------------
OUTCHR: PUSH	PSW
	PUSH	B
	PUSH	D
	PUSH	H
	LHLD	OUTPTR
	MOV	M,C
	INX	H
	SHLD	OUTPTR
	POP	H
	POP	D
	POP	B
	POP	PSW
	RET
;;	---------------------------------------
;;
;;	TABLE OF POWERS OF 10 AND OTHER CONSTANTS
;;
;;	-----------------------------------------
;;	NAME APUTBL
;;
;;
TENTH:	DB 7DH,0CCH,0CCH,0CDH	;;0.1
;;
PWR10:	DB 01H,80H,00H,00H	;;1.
	DB 04H,0A0H,00H,00H	;;10.
	DB 07H,0C8H,00H,00H	;;100.
	DB 0AH,0FAH,00H,00H	;;1000.
	DB 0EH,9CH,40H,00H	;;10000.
	DB 11H,0C3H,50H,00H	;;1.E5
	DB 14H,0F4H,24H,00H	;;1.E6
	DB 18H,98H,96H,80H	;;1.E7
	DB 1BH,0BEH,0BCH,20H	;;1.E8
	DB 1EH,0EEH,6BH,28H	;;1.E9
	DB 22H,95H,02H,0F9H	;;1.E10
	DB 25H,0BAH,43H,0B7H	;;1.E11
	DB 28H,0E8H,0D4H,0A5H	;;1.E12
	DB 2CH,91H,84H,0E7H	;;1.E13
	DB 2FH,0B5H,0E6H,20H	;;1.E14
	DB 32H,0E3H,5FH,0A9H	;;1.E15
	DB 36H,8EH,1BH,0C9H	;;1.E16
	DB 39H,0B1H,0A2H,0BCH	;;1.E17
	DB 3CH,0DEH,0BH,6BH	;;1.E18
;;
FLMAX:	DB 3FH,0FFH,0FFH,0FFH	;;MAXIMUM FLT. PT NUMBER
ZERO:	DB 00H,00H,00H,00H	;;FLT. PT ZERO
HALF:	DB 00H,80H,00H,00H	;;.5
M18:	DB 0FFH,0FFH,0FFH,0EEH	;;FIXED PT -18
P18:	DB 00H,00H,00H,12H	;;FIXED PT +18
ITEN:	DB 00H,00H,00H,0AH	;;FIXED PT +10
	ENDM


CNVDATA	MACRO

;;
;;	=======================================
;;
;;	DATA STORAGE FOR FLOATING PT CONVERSION
;;
;;	=======================================
;;
DTAREA	EQU $
ERCODE:	DS 1
SIGN:	DS 1		;;SIGN OF MANTISSA
SEXP:	DS 1		;;SIGN OF EXPONENT
EXP1:	DS 1
CNT1:	DS 1
CNT2:	DS 1
EXP:	DS 4		;;EXPONENT
OLDINT:	DS 4
DIGT:	DS 1
PWR:	DS 1
PROD:	DS 4		;;TEMP STORAGE FOR X*10**P
LOCLX:	DS 4		;;LOCAL STORAGE FOR X
DTALEN	EQU $-DTAREA
CMPTR	DS 2		;;BUFFER POINTER
RDATA	DS 4
OUTPTR	DS	2	;;USED BY OUTPUT CONVERSION ROUTINE
	ENDM