;FINOUT 10/10/80
;XYBASIC Interpreter Source Module
;Copyright (C) 1978, 1979, 1980 by Mark Williams Company, Chicago
;floating point input/output routines

	if	float and (not f9511) and (not fpbcd)

;CONSTANTS
FPONE:	DW   81H, 0		;FLOATING POINT 1.
FPTEN:	DB   84H, 20H, 0, 0	;FLOATING POINT 10.
FPRND:	DB   6CH, 6H, 37H, 0BCH	;FLOATING POINT ROUNDER .000 000 5


;FLOATING POINT INPUT
FINP:	MOV  E,M	;1ST CHARACTER OF STRING
	CALL SVAD	;SET CHARACTER ADDR,PNT FLG,EXP
	INX  H		;TO ADDR THE VALUE SIGN
	MVI  M,80H	;SET VALUE SIGN POSITIVE
	LXI  H,ACCE	;TO ADDR THE ACC EXPONENT
	MOV  M,D	;SET ACC TO ZERO
	LDA  TEMP	;FETCH DESIRED VALUE SIGN
	ORA  A
	MOV  A,E	;1ST CHARACTER
	JZ  INP2	;IF POSITIVE DESIRED
	LXI  H,TMP3	;TO ADDR THE VALUE SIGN
	MOV  M,D	;SET VALUE SIGN NEGATIVE
;ANALYZE THE NEXT CHARACTER IN THE STRING
INP2:	MVI  B,0	;DIGIT 2ND WORD OR DECIMAL EXPONENT
	CPI  '.'	;COMPARE TO DECIMAL POINT
	JZ   INP3	;IF DECIMAL POINT
	CPI  'E'	;COMPARE TO EXPONENTIATION SIGN
	JZ   INP4	;IF EXPONENTIATION
	cpi  'E'+20H
	jz   inp4	;allow lower case e in case untokenized
	SUI  '0'	;SUBTRACT ASCII BIAS
	CPI  0AH	;SET CARRY IF CHARACTER IS VALID DIGIT
	JNC  INP8	;IF CHARACTER IS NOT A VALID DIGIT
	STA  TMP4	;SAVE THE CURRENT DIGIT
	LXI  H,FPTEN	;TO ADDR FLOATING POINT 10
	CALL FMUL	;MULTIPLY BY TEN
	LXI  H,VALE	;TO ADDR THE VALUE
	CALL FSTOR	;STORE OLD VALUE TIMES 10
	INX  H		;TO ADDR THE CURRENT DIGIT
	MOV  A,M	;CURRENT DIGIT
	MVI  B,0	;CLEAR 2ND WORD OF DIGIT
	MOV  C,B	;CLEAR 3RD WORD OF DIGIT
	MOV  D,B	;CLEAR 4TH WORD OF DIGIT
	MVI  E,08	;INDICATE DIGIT IS IN REGISTER A
	CALL FFLOT	;CONVERT DIGIT TO FLOATING POINT
	LXI  H,VALE	;TO ADDR THE VALUE
	CALL FADD	;ADD OLD VALUE TIMES 10
	LXI  H,TMP2	;TO ADDR THE DECIMAL POINT FLAG
	MOV  A,M	;DECIMAL POINT FLAG
	ANA  A		;SET CONTROL BITS
	JZ   INP1	;IF NO DECIMAL POINT ENCOUNTERED
	DCX  H		;TO ADDR THE INPUT EXPONENT
	DCR  M		;DECREMENT THE INPUT EXPONENT
INP1:	CALL CHAD	;GET ADDR OF NEXT CHARACTER
	MOV  A,M	;NEXT CHAR
	JMP  INP2	;TO PROCESS NEXT CHARACTER
INP3:	LXI  H,TMP2	;TO ADDR THE DECIMAL POINT FLAG
	XRA  M		;ZERO IF FLAG SET
	MOV  M,A	;SET DECIMAL POINT FLAG
	JNZ  INP1	;IF FLAG NOT ALREADY SET
	LHLD ADRL	;READDRESS THE INPUT STRING
	JMP  INP8	;IF 2ND DECIMAL POINT

;PROCESS DECIMAL EXPONENT
INP4:	CALL CHAD	;GET ADDR OF NEXT CHARACTER
	MOV  A,M	;NEXT CHARACTER OF STRING
	mvi  e,0	;possible exponent sign (-) to E
	CPI  MINT	;COMPARE TO MINUS CHARACTER
	JZ   INP5	;IF MINUS SIGN
	cpi  '-'
	jz   inp5	;allow untokenized minus
	mov  e,a	;else sign positive (nonzero) to E
	CPI  PLUST	;COMPARE TO PLUS CHARACTER
	jz   inp5	;plus
	cpi  '+'	;check for untoenized plus
	JNZ  INP6	;IF NOT PLUS SIGN
INP5:	INX  H		;TO ADDR THE NEXT CHARACTER
	MOV  A,M	;NEXT CHARACTER OF STRING
INP6:	SUI  '0'	;SUBTRACT ASCII BIAS
	JZ   INP5	;IGNORE LEADING ZERO ON EXPONENT
	MVI  B,0	;POSSIBLE DECIMAL EXPONENT
	CPI  0AH	;SET CARRY IF A DECIMAL DIGIT
	JNC  INP8	;IF NOT A DECIMAL DIGIT
	MOV  B,A	;DECIMAL EXPONENT EQUAL DIGIT
	INX  H		;TO ADDR THE NEXT CHARACTER
	MOV  A,M	;NEXT CHARACTER OF STRING
	SUI  '0'	;SUBTRACT ASCII BIAS
	CPI  0AH	;SET CARRY IF A DECIMAL DIGIT
	JNC  INP7	;IF NOT A DECIMAL DIGIT
	INX  H		;ADDRESS NEXT CHAR
	MOV  C,A	;LSD OF DECIMAL EXPONENT
	MOV  A,M	;FETCH NEXT
	SUI  '0'	;SUBTRACT ASCII BIAS
	CPI  0AH
	JC   INPOV	;THREE DIGITS, SCAN REMAINING AND RETURN 0 OR OV
	MOV  A,B	;MSD OF DECIMAL EXPONENT
;FORM COMPLETE DECIMAL EXPONENT
	ADD  A		;2*MSD
	ADD  A		;4*MSD
	ADD  B		;5*MSD
	ADD  A		;10*MSD
	ADD  C		;10*MSD + LSD
	MOV  B,A	;DECIMAL EXPONENT
INP7:	MOV  A,E	;SIGN OF DECIMAL EXPONENT
	ANA  A		;SET CONTROL BITS
	JNZ  INP8	;IF SIGN POSITIVE
	SUB  B		;COMPLEMENT DECIMAL EXPONENT
	MOV  B,A	;DECIMAL EXPONENT
INP8:	SHLD TEXTP
	LXI  H,TMP3	;TO ADDR THE INPUT SIGN
	MOV  C,M	;INPUT SIGN
	LXI  H,ACCS	;TO ADDR THE ACC SIGN
	MOV  M,C	;ACC SIGN
	MOV  A,B	;DECIMAL EXPONENT

;CONVERT DECIMAL EXPONENT TO BINARY
INP9:	LXI  H,TMP1	;TO ADDR THE DECIMAL EXPONENT
	ADD  M		;ADJUST DECIMAL EXPONENT
	JZ   FTEST	;IF DECIMAL EXPONENT IS ZERO
	MOV  M,A	;CURRENT DECIMAL EXPONENT
	LXI  H,FPTEN	;TO ADDR FLOATING POINT 10
	JP   INP10	;IF MULTIPLY REQUIRED
	CALL FDIV	;DIVIDE BY 10
	MVI  A,1	;TO INCREMENT THE DECIMAL EXPONENT
	JMP  INP9	;TO TEST FOR COMPLETION
INP10:	CALL FMUL	;MULTIPLY BY 10
	MVI  A,-1	;TO DECREMENT THE DECIMAL EXPONENT
	JNC  INP9	;TO TEST FOR COMPLETION
	JMP  FOVER	;OV ERROR ON OVERFLOW AND RETURN FPMAX
INPOV:	INX  H
	MOV  A,M
	SUI  '0'
	CPI  0AH
	JC   INPOV	;SCAN REMAINING EXPONENT DIGITS
	SHLD TEXTP	;RESET TEXTP TO FIRST NONDIGIT
	MOV  A,E	;SIGN OF DECIMAL EXPONENT
	ORA  A
	JZ  FZRO	;LARGE NEGATIVE EXPONENT, RETURN 0.
	JMP  FOVER	;POSITIVE, ISSUE FLOATING OVERFLOW ERROR


;FLOATING POINT OUTPUT
;The contents of the FACC is not preserved
FOUT:	LXI  H,BUFAD-1	;USE BUFAD TO STORE CONVERTED VALUE
	CALL SVAD	;SET CHARACTER ADDRESS, DIGIT COUNT, DECIMAL EXPONENT
	CALL FTEST	;LOAD ACC TO REGISTERS
	LXI  H,VALE	;TO ADDR THE ACC SAVE AREA
	CALL FSTOR	;REGISTER STORE

;OUTPUT SIGN CHARACTER
	CALL CHAD	;GET ADDR OF CHARACTER
	MVI  M,' '	;STORE SPACE CHARACTER
	ANA  A		;SET CONTROL BITS
	JZ   OUT3	;IF ACC IS ZERO
	MOV  E,A	;ACC EXPONENT
	MOV  A,B	;ACC SIGN AND 1ST FRACTION
	ANA  A		;SET CONTROL BITS
	MOV  A,E	;ACC EXPONENT
	JP   OUT0	;IF ACC IS POSITIVE
	MVI  M,'-'	;CHANGE SIGN TO MINUS
;CHECK IF ACCUMULATOR IN RANGE .01 TO 1 TO ALLOW .01
OUT0:	CPI  7AH	;COMPARE TO .01 EXPONENT
	JC   OUT1	;TOO SMALL, SCALE NORMALLY
	CPI  81H
	JC   OUT5	;SKIP SCALING IF BETWEEN .01 AND 1
;SCALE ACCUMULATOR TO 0.1 TO 1.0 RANGE
OUT1:	CPI  7EH	;COMPARE TO SMALL EXPONENT
OUT2:	LXI  H,FPTEN	;TO ADDR FLOATING POINT 10
	JC   OUT4	;IF EXPONENT TOO SMALL
	CPI  81H	;COMPARE TO LARGE EXPONENT
	JC   OUT5	;IF EXPONENT NOT TOO LARGE
	CALL FDIV	;DIVIDE BY 10
OUT3:	LXI  H,TMP2	;TO ADDR THE DECIMAL EXPONENT
	INR  M		;INCREMENT DECIMAL EXPONENT
	JMP  OUT2	;TO TEST FOR SCALING COMPLETE
OUT4:	CALL FMUL	;MULTIPLY BY 10
	LXI  H,TMP2	;TO ADDR THE DECIMAL EXPONENT
	DCR  M		;DECREMENT DECIMAL EXPONENT
	JMP  OUT1	;TO TEST FOR SCALING COMPLETE

;ROUND THE VALUE BY ADDING 0.000 000 5
OUT5:	CALL FABS	;MAKE ACC POSITIVE
	LXI  H,FPRND	;TO ADDR THE ROUNDER
	CALL FADD	;ADD THE ROUNDER
	CPI  81H	;CHECK FOR OVERFLOW
	JNC  OUT2	;IF EXPONENT TOO LARGE

;SET DIGIT COUNTS
	LXI  H,TMP2	;TO ADDR THE DECIMAL EXPONENT
	MOV  A,M	;DECIMAL EXPONENT
	MOV  E,A	;DIGITS BEFORE DECIMAL EXPONENT
	CPI  7		;COMPARE TO LARGE EXPONENT
	JC   OUT6	;IF EXPONENT IN RANGE
	MVI  E,1	;DIGITS BEFORE DECIMAL EXPONENT
OUT6:	SUB  E		;ADJUST DECIMAL EXPONENT
	MOV  M,A	;DECIMAL EXPONENT
	MVI  A,6	;TOTAL NUMBER OF DIGITS
	SUB  E		;DIGITS AFTER DECIMAL POINT
	INX  H		;TO ADDR THE 2ND DIGIT COUNT
	MOV  M,A	;DIGITS AFTER DECIMAL POINT
	DCR  E		;DECREMENT THE DIGIT COUNT
	MOV  A,E	;DIGITS BEFORE THE DECIMAL POINT

;OUTPUT SIGNIFICANT DIGITS
OUT7:	LXI  H,TMP1	;TO ADDR THE DIGIT COUNT
	ADD  M		;ADJUST THE DIGIT COUNT
	MOV  M,A	;NEW DIGIT COUNT
	JM   OUT8	;IF COUNT RUN OUT
	LXI  H,FPTEN	;TO ADDR FLOATING POINT 10
	CALL FMUL	;MULTIPLY BY 10
	MVI  E,8	;TO PLACE DIGIT IN REGISTER 'A'
	CALL FFIX	;CONVERT TO FIXED FORMAT
	CALL CHAD	;GET CHARACTER ADDRESS
	ADI  '0'	;ADD ASCII BIAS
	MOV  M,A	;OUTPUT DECIMAL DIGIT
	XRA  A		;CLEAR CURRENT DIGIT
	MVI  E,8	;BINARY SCALING FACTOR
	CALL FFLOT	;RESTORE VALUE MINUS DIGIT
	MVI  A,-1	;TO ADJUST THE DIGIT COUNT
	JMP  OUT7	;LOOP FOR NEXT DIGIT
OUT8:	LXI  H,TMP3	;TO ADDR 2ND DIGIT COUNT
	MOV  A,M	;DIGITS AFTER DECIMAL POINT
	MVI  M,-1	;SET 2ND COUNT NEGATIVE
	ANA  A		;SET CONTROL BITS
	JM   OUT9	;IF 2ND COUNT RAN OUT
	CALL CHAD	;CHARACTER ADDRESS ROUTINE
	MVI  M,'.'	;STORE DECIMAL POINT
	JMP  OUT7	;LOOP FOR NEXT DIGIT
OUT9:	LHLD ADRL	;ADDR THE LAST DIGIT STORED
OUT9A:	MOV  A,M	;FETCH IT
	DCX  H
	CPI  '0'
	JZ   OUT9A	;SUPPRESS TRAILING ZEROS
	CPI  '.'
	JZ  OUT9B	;SUPPRESS TRAILING DECIMAL POINT
	INX  H		;READDRESS LAST DIGIT
OUT9B:	SHLD ADRL	;STORE FUDGED POINTER
	LXI  H,TMP2	;ADDR THE DECIMAL EXPONENT
	MOV  A,M
	ORA  A
	JZ   OUT13	;IF DECIMAL EXPONENT IS ZERO

;OUTPUT DECIMAL EXPONENT
	MVI  B,'+'	;PLUS SIGN
	JP   OUT10	;IF EXPONENT IS POSITIVE
	MVI  B,'-'	;MINUS SIGN
	MOV  C,A	;NEGATIVE EXPONENT
	XRA  A		;ZERO
	SUB  C		;COMPLEMENT THE EXPONENT
OUT10:	MVI  C,'0'-1	;EMBRYO ASCII TENS DIGIT
OUT11:	INR  C		;INCREMENT TENS DIGIT
	SUI  0AH	;REDUCE REMAINDER
	JNC  OUT11	;IF MORE TENS
	ADI  3AH	;RESTORE AND ADD ASCII BIAS
	MOV  D,A	;UNITS DIGIT
	MVI  A,'E'	;EXPONENT SIGN
	CALL CHAD	;GET CHARACTER ADDRESS
	CALL FSTOR	;STORE LAST 4 CHARACTERS
OUT12:	INX  H		;LAST ADDR + 1
	MOV  A,L	;LAST + 1 TO A
	PUSH PSW	;SAVE LAST+1
	LXI  H,VALE	;TO ADDR THE ACC SAVE AREA
	CALL FLOAD	;RESTORE ACC
	POP  PSW	;RESTORE LAST+1
	LXI  D,BUFAD	;FIRST TO DE
	SUB  E		;LAST+1 - FIRST = LENGTH TO A
	MOV  C,A	;AND TO C
	RET

;EXPONENT IS ZERO, DONE
OUT13:	LHLD ADRL	;ADDRESS OF LAST CHAR TO HL
	JMP  OUT12	;AND CONTINUE AS ABOVE

;SAVE THE CHARACTER STRING ADDRESS
SVAD:	MOV  A,L	;CHARACTER STRING WORD
	MOV  B,H	;CHARACTER STRING BANK
	MVI  C,0	;INPUT EXPONENT OR DIGIT COUNT
	MOV  D,C	;DECIMAL POINT FLAG OR DECIMAL EXPONENT
	LXI  H,ADRL	;TO ADDR THE CHARACTER STRING ADDRESS
	JMP  FSTOR	;STORE A, B, C, AND D AND RETURN THRU STR

;OBTAIN THE ADDRESS OF THE NEXT CHARACTER
CHAD:	LHLD ADRL	;TO ADDR THE CHARACTER STRING ADDRESS
	INX  H		;BUMP IT
	SHLD ADRL	;RESTORE IT
	RET		;RETURN TO CALLER

	endif		;end of FLOAT conditional

;end of FINOUT
	PAGE
