*
*   
*     OUTPUT FLOATING POINT VALUE POINTED TO BY HL
*     RETURN POINTER TO FIRST CHAR OF RESULT STRING IN HL
*     AND SIZE OF RESULT STRING IN B
*   
*   
FPOUT PUSH H
 MVI A,4
 STA COMCNT  IN CASE COMMAS ARE REQUIRED
 XRA A
 STA EFRMF  THIS VALUE SAYS NOT
 LDA CFORM  LOAD FLOATING POINT FORMAT
 CPI 'I'  INTEGER
 JZ IFORM
 CPI '#'
 JZ FREE
 CPI 'E'
 JZ EFORM
*   
*  MUST BE 'F' FORMAT
FF LDA CWIDTH
 CALL FFORM
*   
*  NOW SEE ABOUT OPTIONAL '+' AND '$'
FP1 POP H  POINTER TO VALUE
 LDA COPT
 PUSH PSW  OPTION WORD WILL BE NEEDED LATER
 ANI 40Q
 JZ FP2  JUMP IF '+' NOT DESIRED
 DCX H  POINT TO SIGN
 MOV A,M  SIGN BYTE
 ORA A
 MVI A,'+'
 CZ LFP  PUT ON PLUS IF POSITIVE COEFFICIENT
*   
FP2 POP PSW  OPTION WORD
 RAR .  MOV RIGHT BIT TO CARRY
 MVI A,'$'
 CC LFP
 LHLD RESTA
*   
*  NOW SEE IF WANT TO DO SPECIAL FREE FORMAT STUFF
*   
 LDA CFORM
 CPI  '#'
 JNZ FP4
*   
FP3 INX H
 MOV A,M
 CPI ' '
 JZ FP3
 CPI '+'
 JZ FP4
 CPI '-'
 JZ FP4
 CPI '$'
 JZ FP4
 DCX H  ADD ONE LEADING SPACE BEFORE THE APPEARENT DIGIT
*   
*  NOW COUNT CHARACTERS IN RESULT SRING TO B REGISTER
FP4 MVI B,0
 MOV D,H
 MOV E,L
*   
FP41 LDAX D
 CPI '"'
 RZ 
 INR B
 INX D
 JMP FP41
*   
*   
*   
*   
*   F FORMAT SUBROUTINE
*   EXPECTS WIDTH IN ACC, VALUE PTR IN HL
*   SET CARRY ON FAILURE TO FIT INTO FIELD
*   RETURN PTR TO FIRST CHAR OF RESULT IN HL
*   ALSO, EPOINT POINTS TO LAST NON-BLANK DIGIT OF RESULT (
*   
FFORM SHLD VALUE
 MOV B,A  REMEMBER WIDTH
*   
*  INIT THE OUTPUT BUFFER
 LXI H,EOBUF
 MVI M,'"'
 LDA CFRACT
 ORA A
*   
FF1 JZ FF2
 DCX H
 MVI M,'0'
 DCR B
 DCR A
 JMP FF1
*   
FF2 DCX H
 DCR B
 MVI M,'.'
 SHLD DPOINT  THIS VALUE USED BY  E EFORMAT LOGIC TO CHECK
 SHLD EPOINT
 SHLD RESTP  THIS VALUE USED BY LFP
*   
FF3 CMP B  A IS ZERO FROM FF1
 JZ FF4
 DCR B
 DCX H
 MVI M,' '
 JMP FF3
*   
FF4 SHLD RESTA  RESULT ADDRESS
 DCX H
 MVI M,'!'  MARKER FOR BEGINNING OF VALUE (FOR LFP)
 LHLD VALUE
 MOV A,M
 ORA A
 JZ FF82  GO REMOVE TRAILING ZEROES
 SUI 201Q  UNBIAS
 JC FF9  D-CASE (ENTIRE VALUE TO RIGHT OF DPOINT)
 INR A  CORRECT FOR BIAS GLITCH (SHOULD HAVE SUBTRACTED 10
 MOV B,A  REMEMBER EXPONENT VALUE
 MOV C,A
 SUI FPNIB
 JC FF7  C-CASE (VALUE OVERLAPS THE DP)
*   
*  ZERO FILL BETWEEN DP AND LSB OF VALUE
 JZ FF6
 MOV C,A
*   
FF5 MVI A,'0'
 CALL LFPD
 DCR C
 JNZ FF5
*   
FF6 MVI B,FPNIB
 MOV C,B  THIS VALUE CAUSES ONLY ZEROES TO BE PUT TO RIGHT
*   
*  B HAS INDEX OF NEXT DIGIT TO BE WRITTEN TO THE LEFT
FF7 INR C  ADVANCE C FOR USE LATER (INDEX OF FIRST DIGIT TO
*   
FF71 CALL GFD  GET DIGIT
 CALL LFPD
 DCR B
 JNZ FF71
*   
*    C HAS DIGIT INDEX IN VALUE
*    LOOP TERMINATES WHEN RFPD EXITS TO FF81 OR FF82
*   
FF80 MOV B,C
*   
FF8 CALL GFD  GET THE DIGIT
 CALL RFPD
 INR B
 JMP FF8
*   
*    COME HERE FROM RFPD IF ROUNDING REQUIRED
*    H HAS POINTER TO THE '"' CHARACTER
*   
FF81 DCX H
 MOV A,M
 CPI '.'
 JZ FF81
 CPI ','
 JZ FF81
 CPI '!'+1
 JC FF811
*   
*  MUST BE A DIGIT, SO INCREMENT IT
 INR A
 MOV M,A
 CPI '9'+1
 JNZ FF82  CARRY NO PROPOGATED
 MVI M,'0'
 JMP FF81
*   
*  COME HERE IF BLANK OR '!' ENCOUNTERED WHEN PROPOGATING CAR
FF8111 LDA EFRMF  THIS FLAG FOR E FORMAT
 ORA A
 JZ FF812  JUMP IF NOT E FORMAT
*   
*  CONVERT TO 1.00 AND BUMP EXPONENT
 INX H  POINT TO CHARACTER PRECEDING DP
 MVI M,'1'
 ADI 1  BUMP EXPONENT SET CARRY FOR OVERFLOW
 JC FOERR  EXPONENT OVERFLOW (COEFFICIENT SIGN HAS BEEN RE
 STAX D
 JMP FF82  DONE ROUNDING
*   
*  HERE IT WAS NOT E FORMAT
FF812 MVI A,'1'
 CALL LFPD
*   
*  REMOVE TRAILING ZEROES IF REQUIRED
FF82 LXI H,EOBUF-1
 LDA CFORM  TRIALING ZEROES REMOVED IN FREE FORMAT
 CPI '#'
 JZ FF83
 LDA COPT
 ORA A
 JP FF84  JUMP IF TRAILING ZEROES WANTED
*   
FF83 MOV A,M
 CPI '0'
 JNZ FF831
 MVI M,' '
 DCX H
 JMP FF83
*   
FF831 LDA CFORM  IF FREE FORMAT, MOVE UP THE "
 CPI '#'
 JNZ FF84
 INX H
 MVI M,'"'
 DCX H
*   
*  CHECK FOR SPECIAL CASE OF ZERO VALUE
FF84 LDA CFORM  CK FOR FREE FORM
 CPI '#'
 JNZ FF84B
 SHLD EPOINT  FOR FREE FORMAT
*   
FF84B MOV A,M  HL HAS POINTER TO LAST NON-BLANK CHARACTER
 CPI '.'
 JNZ FF85
 DCX H
 MOV A,M
 CPI ' '
 JZ FF841
 CPI '!'
 JNZ FF85
 INX H
 INX H
 MVI M,'0'
 JMP FF85
*   
FF841 MVI A,'0'
 CALL LFPD
*   
*  NOW PUT ON '-' IF NEEDED
FF85 LHLD VALUE
 DCX H  POINT TO SIGN
 MOV A,M
 ORA A
 MVI A,'-'
 CNZ LFP  PUT ON '-' IF NEGATIVE VALUE
 LHLD RESTA
 RET
*   
*    D CASE
*    WRITE ZEROES AFTER DPOINT
*   
FF9 CMA  THE ACC HAD 1'S COMPLEMENT OF EXPONENT MAGNITUDE
 ORA A  SET Z IN CASE OF ZERO
 MOV B,A
 MVI C,1  NEEDED AT FF8 (DIGIT TO PRINT NEXT
*   
FF91 JZ FF80
 MVI A,'0'
 CALL RFPD  WILL EXIT IF FIELD FILLS UP
 DCR B
 JMP FF91
*   
*    ADD CHARACTER TO LEFT OF INTEGER (FOR FPOUT)
*    SET CARRY IF OUT OF ROOM
*    CHARACTER EXPECTED IN ACC
*    PRESERVE BC
*   
LFPD PUSH PSW  ENTER HERE IF DIGIT
 LDA COPT
 ANI 100Q  TEST IF COMMAS REQUIRED
 JZ LFP1  NOT DESIRED
 LXI H,COMCNT
 DCR M
 JNZ LFP1
*   
*  COMMA MUST BE WRITTEN
 MVI M,3
 MVI A,','
 CALL LFP
*   
LFP1 POP PSW
*   
LFP LHLD RESTP
 DCX H
 MOV D,A
 MOV A,M
 CPI '!'
 JZ FOERR
 SHLD RESTP
 MOV M,D
 RET
*   
*    ADD  DIGIT TO RIGHT END OF FP STRING (FPOUT)
*    CHARACTER IN ACC
*    IF CHARACTER BEYOND FIELD, GO TO FF81 IF ROUNDING
*    REQUIRED, ELSE GOTO FF83
*    PRESERVE BC
*   
RFPD LHLD EPOINT
 INX H
 MOV D,A
 MOV A,M
 CPI '"'
 JZ RFPD1
 SHLD EPOINT
 MOV M,D
 RET
*   
*  HERE ENCOUNTERED END OF FIELD
RFPD1 POP PSW  CLEAN OFF RETURN LINK
 MOV A,D
 CPI '5'
 JC FF82
 JMP FF81  ROUND
*   
*    GET BTH DIGIT FROM FP VALUE
*    PRESERVE BC, RETURN '0' IF B>PREC
*   
GFD MVI A,FPNIB
 MOV D,A  SAVE IT IN D
 CMP B  CHECK FOR INDEX > PREC
 MVI A,'0'
 RC 
 MOV A,B
 DCR A
 SUB D  ACC NOW HAS INDEX-PREC-1
 RAR  DIVIDE BY 2, LOW ORDER BIT TO CARRY (CARRY WAS SET)
 MOV E,A
 MVI D,377Q
 PUSH PSW  CARRY BIT SAYS WHETHER DIGIT IN LEFT OR RIGHT
 LHLD VALUE
 DCX D  ACCOUNT FOR SIGN BYTE
 DAD D
 POP PSW
 MOV A,M  THE BYTE WITH THE DIGIT
 JC GFD1
 RAR
 RAR
 RAR
 RAR
*   
GFD1 ANI 17Q
 ADI '0'
 RET
*   
*   
*    FREE FORM CONVERT
*   
*   
FREE PUSH H
 LXI H,FPNIB*256+WMAX  SET UP CWIDTH AND CFRACT
 SHLD CWIDTH
 POP H
 MOV A,M
 ORA A
 JZ IFRM1
 CPI 200Q+FPNIB+1
 JNC EFORM  EXPONENT TOO BIG FOR IFORM OR FFORM
*   
*  NOW WE KNOW EXPONENT IS LEE THAN 200Q+FPNIB+1
 PUSH H
 DCX H  PASS SIGN BYTE
 MOV B,A
*   
FR1 INR B  BUMP COUNT (INITIALLY EXPONENT VALUE)
 DCX H  MOV HL TO LAST UNCHECKED BYTE OF COEFFICIENT
 MOV A,M
 ANI 17Q  MASK DOWN TO RIGHT DIGIT
 JNZ FR2  JUMP IF NO MORE ZEROES
 INR B
 MOV A,M
 ORA A
 JZ FR1  LOOP IF LEFT DIGIT ALSO A ZERO
*   
*  NOW WE HAVE INCREASED EXPONENT (IN B) BY NUMBER OF
*  TRAILING ZEROS
*   
FR2 POP H
 MOV A,B
 CPI 200Q+1
 JC EFORM  JUMP IF STILL WON'T FIT
 CALL ITEST
 JNZ FF  JUMP IF NOT INTEGER
 JMP IFRM1  ENTER IFORM
*   
*   
*     I FORMAT CONVERT
*   
*   
IFORM CALL ITEST  PRESERVES HL
 JNZ FOERR  JUMP IF WAS NOT INTEGER
*   
IFRM1 XRA A
 STA CFRACT
 LDA CWIDTH
 INR A  MAKE ROOM FOR THE DPOINT
 CALL FFORM
 MVI A,'"'
 STA EOBUF-1  SHORTEN THE RESULT BY 1 (REMOVING THE  DECIM
 JMP FP1
*   
*   
*   
*   
*     E FORMAT CONVERT
*
*
EFORM MOV A,M  EXPONENT OF VALUE
 STA EXP  SAVE IT
 MVI M,81H  SET FOR SCIENTIFIC NOTATION
 LDA CWIDTH
 SUI 5  LEAVE ROOM FOR EXPONENT
 CALL FFORM  (EXPONENT MAY BE ADJUSTED HERE.)
*
 LDA EXP  PUT THE EXP OF RESULT IN DE FOR POSSIBLE ADJUSTMENT.
 MOV E,A  EXPONENT IS ONLY 1 BYTE.
 MVI D,0  SO HIGH BYTE IS 0.
*
 LHLD DPOINT  POINTER TO DECIMAL POINT IN RESULT
 DCX H
 DCX H  DECREMENT POINTER TWO
 MOV A,M  WE ARE CHECKING FOR OVERFLOW FROM SCIENTIFIC NOT
 CPI '1'
 JNZ EF3  JUMP IF NO OVERFLOW
*
*  HERE HAD OVERFLOW, SO BUMP EXPONENT AND MOVE THE SIGN
 DCX H  POINTS TO SIGN (IF '-')
 MOV A,M
 MVI M,' '
 INX H
 MOV M,A  MOV OVER THE SIGN (OR ' ')
 INX H
 SHLD RESTP
 MVI M,'1'  OVERWRITE THE 0 WITH 1
 INX D  BUMP EXPONENT
*
EF3 LHLD EPOINT
 MOV A,M  SEE IF LAST NON-BLANK WAS A '.'
 CPI '.'
 JZ EF0  SKIP OVER INX IF IT WAS
 INX H
*
EF0 MVI M,'E'
 INX H
 MVI B,'+'
 MOV A,E  TEST THE EXPONENT.
 ORA D  TEST IT FOR 0
 JZ EF1  JUMP IF ZERO CASE
 MOV A,E  GET BACK THE REAL EXPONENT.
 MVI D,0  THE NEXT SUBTRACT WOULD HAVE MADE D 0 (IF 16-BIT SUB).
 SUI 81H  SUBTRACT OFF BIAS+1
 JP EF1  JUMP IF POSITIVE (NON-NEG) EXPONENT
*
*  HERE WAS NEGATIVE EXPONENT
 MVI B,'-'
 CMA
 INR A  TWO'S COMPLEMENT
*
EF1 MOV M,B  SIGN CHARACTER
 INX H
 MOV E,A  LOW ORDER EXPONENT VALUE
*
EF2 XCHG .  EXPONENT TO HL
 MVI A,' '  A=' ' FOR LEADING BLANKS
 CALL CNS3  ADD THREE DIGIT EXPONENT TO STRING
 MVI A,'"'  STRING TERMINATOR
 STAX D
 JMP FP1
*
*     CONVERT TEXT TO FLOATING POINT NUMBER
*     DE=CHARACTER POINTER TO FIRST CHARACTER
*     HL=RESULT ADDRESS
*     RETURNS UPDATED POINTER IN DE (PAST TERMINATOR,
*        WITH TERMINATOR IN A)
*   
FPIN  XRA A
 STA CSIGN
 STA ESIGN  EXPONENT SIGN
 MVI A,80H
 STA EXP  EXPONENT VALUE
 MVI A,-FPNIB-1
 STA PUTFL  FLAG FOR THE PUT SUBROUTINE
 DCX D
FPINQ INX D
 LDAX D  FIRST CHARACTER
 CPI ' '
 JZ FPINQ  SKIP SPACES
 CPI '+'
 JZ FPIN1
 CPI PLSRW
 JZ FPIN1
 CPI MINRW
 JZ FPIN0
 CPI '-'
 JNZ FPIN2
*   
FPIN0 MVI A,1
 STA CSIGN
*   
FPIN1 INX D  INCREMENT POINTER PAST THE SIGN CHARACTER
*   
FPIN2 SHLD RESTA  ADDRESS OF RESULT
 MVI A,FPBYT
 DCX H  ACCOUNT FOR SIGN AND EXP BYTES
*   
FPIN3 DCX H
 MVI M,0
 DCR A
 JNZ FPIN3
 SHLD RESTP
 XCHG
 SHLD STRPT  STRING  POINTER ADDRESS
 CALL GNC1
 JC FIS21  WAS DIGIT
 CPI '.'
 JNZ FIFAIL
*   
*     DP CAME FIRST, MAKE SURE AT LEAST ONE DIGIT FOLLOWS
*   
 CALL GNC1
 JC FIS41
*   
FIFAIL STC
 RET
*   
*     HAVE DP, NO SD YET
*   
FIS4  LXI H,EXP
 DCR M
 JZ FIFAIL  WENT TO ZERO, UNDERFLOW
*   
FIS40 CALL GNC
*   
FIS41 JZ FIS4  HAVE A ZERO SO DECREMENT EXPONENT AND GET NE
 JC FIS60  MUST BE A SD
 CPI 'E'
 JZ FIS7
*   
*     GET HERE MEANS WE MUST HAVE A ZERO RESULT
*   
FIZERO XRA A
 STA CSIGN  CAN'T HAVE NEG ZERO!
 JMP FIDN2
*   
*     EAT LEADING ZEROS, IF THERE ARE ANY
*   
FIS2  CALL GNC
*   
FIS21 JZ FIS2
 JC FIS5
 CPI '.'
 JZ FIS40
 JMP FIZERO
*   
*     HAVE SD BEFORE DP
*   
FIS5  CALL PUTD
 LXI H,EXP
 MOV A,M
 ADI 1  FOR THE CARRY
 MOV M,A
 JC FIFAIL  > 127, OVERFLOW
 CALL GNC
 JC FIS5
 CPI '.'
 JZ FIS6
 CPI 'E'
 JZ FIS7
*   
*     HERE WE ARE DONE, SO PUT THE NUMBER TOGETHER
*   
FIDN  XRA A  EXPONENT VALUE IF NO 'E'
*   
FIDN1 LXI H,EXP
 ADD M
 JC FIFAIL  OVERFLOW
 JZ FIFAIL  UNDERFLOW
*   
FIDN2 LHLD RESTA
 ORA A  CLEAR CARRY FOR A GOOD RETURN
 MOV M,A  PLACE EXP
 LDA CSIGN
 DCX H
 MOV M,A  PLACE SIGN
 LHLD STRPT
 XCHG .  POINTER BACK TO DE
 LDA TERMC
 MOV B,A
 RET .  CARRY IS CLEAR
*   
*     HERE WE HAVE A SD AND A DP
*   
FIS6  CALL GNC
 JNC FIS61
*   
FIS60 CALL PUTD
 JMP FIS6
*   
FIS61 CPI 'E'
 JNZ FIDN
*   
*     HERE WE HAVE NZ COEF AND 'E'
*   
FIS7 CALL GNC
 JC FIS81
 CPI '+'
 JZ FIS8
 CPI PLSRW
 JZ FIS8
 CPI '-'
 JZ FIS71
 CPI  MINRW
 JNZ FIFAIL
*   
FIS71 STA ESIGN  PUTS NON-ZERO VALUE IN ESIGN
*   
*     NOW GET THE EXPONENT MAGNITUDE
*   
FIS8  CALL GNC  GET FIRST DIGIT
 JNC FIFAIL  COMPLAIN IF NO FIRST DIGIT
*   
FIS81 MOV E,A  SAVE IN E IN CASE OF MUL10
 MVI D,0
*   
FIS99 CALL GNC  SEE IF ANOTHER DIGIT
 JNC FIS82
 CALL MUL10
 JC FIFAIL  WAY TOO BIG!
 JMP FIS99  MUL10 MAY EXIT IF NUMERIC OVERFLOW
*   
FIS82 LXI H,-127  TEST SIZE OF EXPONENT
 DAD D
 JC FIFAIL  TOO BIG!
 LDA ESIGN  TEST SIGN
 ORA A
 MOV A,E  GET EXP
 JZ FIDN1  DONE, PACK AND LEAVE
 CMA
 INR A  TWO'S COMP
 LXI H,EXP
 ADD M
 JNC FIFAIL  UNDERFLOW
 JZ FIFAIL  UNDERFLOW
 JMP FIDN2
*   
*     SPECIAL GET CHARACTER ROUTINE FOR FPIN
*     EXPEXTS POINTER IN STRPT
*     IF DIGIT, SETS CARRY AND CLEANS TO 4 BITS (Z SET IF 0)
*   
GNC LHLD STRPT
GNC1 MOV A,M
 STA TERMC
 INX H
 CPI ' '  IGNORE SPACES
 JZ GNC1
 SHLD STRPT
 CPI '9'+1
 RNC
 CPI '0'
 CMC
 RNC
 ANI 17Q
 STC
 RET
*   
*     ROUTINE FOR FPIN TO PUT NEXT DIGIT IN RESULT
*     CLEAN DIGIT IS IN ACC
*     SCALAR PUTFL HAS COUNT OF DIGITS ALREADY PUT, SO IF TOO BI
*     THEN DIGIT IS NOT PUT (THE PREC + 1 DIGIT IS USED TO ROUND
*   
PUTD MOV B,A
 LXI H,PUTFL
 INR M
 MOV A,M  LOAD COUNT TO ACC
 LHLD RESTP  POINTER TO CURRENT BYTE IN VALUE
 JZ PUTD1  ROUNDING DIGIT
 RP .  WE ARE BEYOND ROUNDING DIGIT IF POSITIVE
 RRC
 JC PUTR
*   
*     HERE WE WANT TO PUT DIGIT IN LEFT NIBBLE
*   
 MOV A,B
 RLC
 RLC
 RLC
 RLC
 MOV M,A
 RET
*   
*     HERE PUT DIGIT INTO RIGHT NIBBLE
*   
PUTR  MOV A,M
 ORA B
 MOV M,A
 INX H
 SHLD RESTP
 RET
*   
*     CAME HERE IF ROUNDING DIGIT
*   
PUTD1 MOV A,B  ROUNDING DIGIT TO ACC
 CPI 5
 RC 
 DCX H
 MVI C,FPBYT
*   
BUMP MVI A,1
 ADD M
 DAA
 MOV M,A
 JNC PUTD90
 DCX H
 DCR C
 JNZ BUMP
*   
PUTD90 RNC .  RETURN IF CARRY NOT PROPOGATED WHOLE DISTANCE
*   
*     HERE MUST CHANGE TO 1.0000000, HL HAS MSB-1
*   
 INX H
 MVI M,1*16+0
 LXI H,EXP
 MOV A,M  BUMP EXPONENT
 ADI 1  FOR THE CARRY
 MOV M,A
 JC FIFAIL  OVERFLOW IF > 127 (REMEMBER BIAS?)
 RET
*   
*   
*   
*     FORMATTED OUTPUT STORAGE
*       MUST APPEAR TOGETHER IN THIS ORDER
*   
COPT DS 1
CFORM DS 1
CWIDTH DS 1
CFRAC DS 1
*   
DOPT DS 1
DFORM DS 1
DWIDTH DS 1
DFRAC DS 1
*   
EFRMF DS 1
*   
*     FLOATING INPUT STORAGE
*   
ESIGN DS 1
CSIGN DS 1
TERMC DS 1
PUTFL DS 1
RESTA DS 2
RESTP DS 2
STRPT DS 2
*   
*     FLOATING OUTPUT STORAGE
*   
DPOINT DS 2
EPOINT DS 2
COMCNT DS 1
VALUE DS 2
*   
*