The STOR.I include file resides on the Kyan Pascal 2.x Utilities Disk 1.
- FUNCTION STRTOREAL(VAR CONVSTRING:STRING20):REAL;
Source Code
FUNCTION STRTOREAL(VAR CONVSTRING:STRING20):REAL;
VAR RESULT:REAL;
BEGIN
#A
STX _T
LDX #$80
LDY #21
LDA (_SP),Y
STA _T+1
INY
LDA (_SP),Y
STA _T+2
LDA #0
STA _T+3 ;EXPONANT
STA _T+4 ;SIGN BYTE
STA _T+5 ;SIG DIGIT
INC _T+5
STA _T+6 ;. FOUND FLAG
STA _T+7 ;COUNTS LEADING ZEROES
LDY #5
STR1 STA (_SP),Y
INY
CPY #13
BNE STR1
TAY
STR2 LDA (_T+1),Y ;SCAN STRING FOR FIRST 1..9 OR .
CMP #'-
BEQ STRNEG
CMP #'.
BEQ STRDEC
CMP #'1
BCC STR2A
CMP #'9+1
BCC STR3B
STR2A INY
CPY #20
BNE STR2
BEQ STR99
STRNEG LDA _T+4
EOR #$80
STA _T+4
JMP STR2A
STRDEC LDA _T+4
ORA #$40 ;NEG EXPONANT
STA _T+4
STX _T+6 ;FLAG DEC FOUND
INC _T+3 ;START EXP AT -1
BNE STR5 ;ALWAYS
STR3B DEC _T+3
STRMAIN EQU *
JSR STR20 ;INSERT DIGIT IN A @ _T+5 POSITION
STR5 INY
CPY #20
BCS STR99
LDA (_T+1),Y
CMP #'.
BNE STR6
STX _T+6
BEQ STR5 ;ALWAYS
STR6 CMP #'0
BCC STR5
CMP #'9+1
BCC STRMAIN
BCS STR5
STR99 LDA _T+3 ;EXPONANT
LDY #5+7
STA (_SP),Y
LSR _T+4
LSR _T+4
LDY #5
LDA (_SP),Y ;FIRST BYTE
AND #15
ORA _T+4
STA (_SP),Y ;PUT SIGNS IN UPPER NIBBLE
LDX _T
#
STRTOREAL := RESULT
END;
#A
STR20 EQU * ;INSERT DIGIT AND ADJUST EXPONANT
CMP #'0
BNE STR25
BIT _T+4 ;IS EXP MINUS?
BVC STR25 ;NO
BIT _T+7
BMI STR25
SED
INC _T+3
CLD
RTS
STR25 BIT _T+4
BVS STR24
BIT _T+6
BMI STR24 ;SKIP INC IF . ALREADY FOUND
STR23 SED
INC _T+3
CLD
STR24 STX _T+7
STY _T+10 ;SCRATCH SPACE
PHA
LDA _T+5
INC _T+5
CLC
ROR
PHP
CLC
ADC #5 ;ADD STACK OFFSET
TAY
PLP
PLA
BCC STR21 ;IF C=0 USE HI NIBBLE
AND #15
STR22 ORA (_SP),Y
STA (_SP),Y
LDY _T+10
RTS
STR21 EQU * ;USE HI NIBBLE
AND #15
ASL
ASL
ASL
ASL
JMP STR22
#
No comments:
Post a Comment