AppleIIAsm-Collection/disks/disk5_strings/T.STRINGS.LIB

*
         JMP   STRINGSX
*
*-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=*
*                              *
* STRINGS ROUTINE LIBRARY      *
*                              *
* AUTHOR:  NATHAN RIGGS        *
* CONTACT: NATHAN.RIGGS@       *
*          OUTLOOK.COM         *
*                              *
* VERSION:   0.2.0             *
* DATE:      30-OCT-2018       *
* ASSEMBLER: MERLIN 8 PRO      *
* OS:        DOS 3.3           *
* LICENSE:   APACHE 2.0        *
*                              *
* THIS IS A STANDARD LIBRARY   *
* FOR STRING MANIPULATION.     *
*                              *
*------------------------------*
*                              *
* LIST OF ROUTINES             *
*                              *
* STRCOMP : STRING COMPARE     *
* STRCAT : CONCATENATE STRING  *
* PRNSTR : PRINT STRING        *
* NUM2STR : NUMBER TO STRING   *
* STR2NUM : STRING TO NUMBER   *
*                              *
*=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-*
*
*``````````````````````````````*
* STRCMP ::     STRING COMPARE *
*-                            -*
* COMPARE TWO STRINGS AND      *
* DETERMINE IF THEY ARE        *
* IDENTICAL; IF NOT, DETERMINE *
* WHICH IS THE SHORTEST AND    *
* WHICH IS THE LONGEST.        *
*                              *
* Z FLAG = 1 IF IDENTICAL      *
* Z FLAG = 0 IF NOT            *
* CARRY = 1 IF STR2 > STR1 LEN *
* CARRY = 0 IF STR1 > STR2 LEN *
*-                            -*
* CLOBBERS:                    *
*                              *
* FLAGS:  ????----  REG: AXYM  *
*-                            -*
* CYCLES: ???                  *
* SIZE:                        *
*-                            -*
* USAGE:                       *
*                              *
*   LDA #>STR1                 *
*   PHA                        *
*   LDA #<STR1                 *
*   PHA                        *
*   LDA #>STR2                 *
*   PHA                        *
*   LDA #<STR2                 *
*   PHA                        *
*   JSR STRCMP                 *
*                              *
* STR1 STR "STRING1 "          *
* STR2 STR "ZTRING2"           *
*-                            -*
* ENTRY                        *
*                              *
* TOP OF STACK                 *
*                              *
* LOW BYTE OF RETURN ADDRESS   *
* HI BYTE OF RETURN ADDRESS    *
* STRING 2 ADDRESS LOW BYTE    *
* STRING 2 ADDRESS HI BYTE     *
* STRING 1 ADDRESS LOW BYTE    *
* STRING 1 ADDRESS HI BYTE     *
*-                            -*
* EXIT                         *
*                              *
* TOP OF STACK                 *
*                              *
* LOW BYTE OF RETURN ADDRESS   *
* HI BYTE OF RETURN ADDRESS    *
*                              *
* .Y = LENGTH OF STRING 2      *
* .X = LENGTH OF STRING 1      *
* .A = CLOBBERED; TRASH        *
*-                            -*
* ADAPTED FROM LEVANTHAL AND   *
* WINTHROP'S /6502 ASSEMBLY    *
* LANGUAGE ROUTINES/. MAY NOT  *
* FALL UNDER APACHE 2.0 UNTIL  *
* SUBSTANTIALLY ALTERED.       *
*,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,*
*
STRCMP
*
** SAVE RETURN ADDRESS
*
         PLA
         STA   RETADR
         PLA
         STA   RETADR+1
*
** GET PARAMETERS
*
         PLA
         STA   ADDR2
         PLA
         STA   ADDR2+1
         PLA
         STA   ADDR1
         PLA
         STA   ADDR1+1
*
         LDY   #0
         LDA   (ADDR1),Y  ; GET LENGTH OF STRING 1
         CMP   (ADDR2),Y
         BCC   :BEGCMP    ; IF STRING 2 IS SHORTER THEN
         LDA   (ADDR2),Y  ; USE ITS LENGTH INSTEAD
*
** COMPARE THE STRINGS THROUGH THE
** LENGTH OF THE SHORTER STRING
*
:BEGCMP
         TAX              ; X IS LENGTH OF SHORTER STRING
         BEQ   :TSTLEN    ; BR IF LENGTH IS 0
         LDY   #1         ; POINT AT FIRST CHAR OF STRINGS
:CMPLP
         LDA   (ADDR1),Y
         CMP   (ADDR2),Y
         BNE   :EXIT      ; BR IF CHARS NOT EQUAL
                          ; Z,C WILL BE PROPERLY SET
                          ; OR CLEARED
                          ; ELSE
         INY              ; NEXT CHAR
         DEX              ; DECREMENT COUNTER
         BNE   :CMPLP     ; CONTINUE UNTIL ALL BYTES PAIRED
*
* THE 2 STRINGS ARE EQUAL TO LENGTH OF THE SHORTER
* SO USE LENGTHS AS BASIS FOR SETTING THE FLAGS
*
:TSTLEN
         LDY   #0         ; COMPARE LENGTHS
         LDA   (ADDR1),Y
         CMP   (ADDR2),Y  ; SET OR CLEAR THE FLAGS
*
** Z FLAG = 1 IF STRINGS IDENTICAL
** Z FLAG = 0 IF NOT IDENTICAL
** CARRY = 0 IF STR2 LENGTH > STR1 LENGTH
** CARRY = 1 IF STR1 LENGTH >= STR2 LENGTH
*
:EXIT
*
** RESTORE RETURN ADDRESS
*
         LDA   RETADR+1
         PHA
         LDA   RETADR
         PHA
*
         LDY   #0
         LDA   (ADDR1),Y  ; GET STR1 LENGTH
         TAX              ; RETURN IN X
         LDA   (ADDR2),Y  ; STR2 LENGTH
         TAY              ; RETURN IN Y
*
         RTS
*
*``````````````````````````````*
* STRCAT :: STRING CONCATENATE *
*-                            -*
* CONCATENATE TWO STRINGS INTO *
* A SINGLE STRING STORE WHERE  *
* THE FIRST STRING IS LOCATED. *
* ADDITIONALLY COPIES CONCAT'D *
* STRING TO [RETURN].          *
*-                            -*
* CLOBBERS:                    *
*                              *
* FLAGS:  ????----  REG: AXYM  *
*-                            -*
* CYCLES: ???                  *
* SIZE:                        *
*-                            -*
* USAGE:                       *
*                              *
*   LDA #>CATSTR               *
*   PHA                        *
*   LDA #<CATSTR               *
*   PHA                        *
*   LDA #>CATSTR2              *
*   PHA                        *
*   LDA #<CATSTR2              *
*   PHA                        *
*   LDA #7 ; MAX SIZE OF CAT   *
*   PHA                        *
*   JSR STRCAT                 *
*                              *
* CATSTR  STR "ABC"            *
* BLANK   STR "    "           *
* CATSTR2 STR "DEF"            *
*-                            -*
* ENTRY                        *
*                              *
* TOP OF STACK                 *
*                              *
* LOW BYTE OF RETURN ADDRESS   *
* HI BYTE OF RETURN ADDRESS    *
* MAXIMUM LENGTH OF CONCAT STR *
* LOW BYTE OF STR2 ADDRESS     *
* HIGH BYTE OF STR2 ADDRESS    *
* LOW BYTE OF STR1 ADDRESS     *
* HIGH BYTE OF STR1 ADDRESS    *
*-                            -*
* EXIT                         *
*                              *
* TOP OF STACK                 *
*                              *
* LOW BYTE OF RETURN ADDRESS   *
* HI BYTE OF RETURN ADDRESS    *
*                              *
* .Y = CLOBBERED; TRASH        *
* .X = LENGTH OF FINAL STRING  *
* .A = 1 IF OVERFLOW, 0 IF NO  *
* [RETURN] = CONCAT'D STRING   *
* [RETLEN] = LENGTH OF NEW STR *
*-                            -*
* ADAPTED FROM LEVANTHAL AND   *
* WINTHROP'S /6502 ASSEMBLY    *
* LANGUAGE ROUTINES/.          *
*,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,*
*
STRCAT
*
** SAVE RETURN ADDRESS
*
         PLA
         STA   RETADR
         PLA
         STA   RETADR+1
*
** GET PARAMETERS
*
         PLA
         STA   :MLEN      ; MAXIMUM CONCAT LENGTH
*
         PLA
         STA   ADDR2      ; STRING 1 ADDRESS
         PLA              ; IN ZERO PAGE
         STA   ADDR2+1
         PLA
         STA   ADDR1      ; STRING 2 ADDRESS
         PLA              ; IN ZERO PAGE
         STA   ADDR1+1
*
** DETERMINE WHERE TO START
*
         LDY   #0
         LDA   (ADDR1),Y  ; GET CUR LGTH OF S1, STORE
         STA   :S1LEN
         STA   :S1IND
         INC   :S1IND     ; START CONCAT AT END OF S1
         LDA   (ADDR2),Y  ; GET LENGTH OF S2, STORE
         STA   :S2LEN
         LDA   #1
         STA   :S2IND     ; START CONCAT AT BEGIN OF S2
*
** DETERMINE NUMBER OF CHAR
*
         LDA   :S2LEN     ; GET S2 LENGTH
         CLC
         ADC   :S1LEN     ; ADD TO LENGTH OF S1
         STA   :S3LEN     ; STORE CONCAT LENGTH
         BCS   :TOOLONG   ; BR IF LENGTH > 255
         CMP   :MLEN      ; CHECK AGAINST MAX LENGTH
         BEQ   :LENOK     ; BR IF LENGTH < MAX
         BCC   :LENOK
*
** RESULTING STRING WILL BE TOO LONG SO
** INDICATE A STRING OVERFLOW, __SOVF = 0FF
** SET NUMBER OF CHARS TO CONCAT = MLEN - S1LEN
** SET LENGTH OF STRING 1 TO MAX LENGTH
*
:TOOLONG
         LDA   #$0FF
         STA   :SOVF      ; INDICATE OVERFLOW
         LDA   :MLEN
         SEC
         SBC   :S1LEN
         BCC   :EXIT
                          ; EXIT IF MLEN < S1LEN
         STA   :SCNT      ; ORIG STR WAS TOO LONG
         LDA   :MLEN
         STA   :S1LEN     ; SET STR1 LENGTH TO MAX
         JMP   :DOCAT
*
** RESULTING LENGTH DOES NOT EXCEED MAX
** LENGTH OF STRING 1 = S1LEN + S2LEN
** INDICATE NO OVERFLOW, __SOVF = 0
** SET NUM OF CHARS TO CONCAT TO LENGTH OF STR 2
*
:LENOK
         STA   :S1LEN
         LDA   #0         ; SAVE SUM OF 2 LENGTHS
         STA   :SOVF      ; INDICATE NO OVERFLOW
         LDA   :S2LEN
         STA   :SCNT      ; COUNT = LENGTH OF STRING 2
*
** CONCAT STRINGS
*
:DOCAT
         LDA   :SCNT
         BEQ   :EXIT      ; EXIT IF NO BYTES LEFT
*
:CATLP
         LDY   :S2IND
         LDA   (ADDR2),Y  ; GET NEXT BYTE FROM S2
         LDY   :S1IND
         STA   (ADDR1),Y  ; MOVE IT TO END OF STR 1
         INC   :S1IND     ;INC STRING 1 INDEX
         INC   :S2IND     ; INC STRING 2 INDEX
         DEC   :SCNT      ; DECREMENT COUNTER
         BNE   :CATLP     ; CONT UNTIL __SCNT = 0
*
:EXIT
*
** UPDATE STRING1 LENGTH
*
         LDA   :S1LEN
         LDY   #0
         STA   (ADDR1),Y
         LDA   :SOVF
         ROR   A
*
** RESTORE RETURN ADDRESS
*
         LDA   RETADR+1
         PHA
         LDA   RETADR
         PHA
*
** COPY TO [RETURN]
*
         LDY   #0
         LDA   (ADDR1),Y  ; LENGTH OF STRING
         STA   RETLEN
         LDA   #1
:RLP
         LDA   (ADDR1),Y
         STA   RETURN,Y
         CPY   RETLEN
         INY
         BNE   :RLP
         LDA   RETLEN
         LDY   #0
         STA   (ADDR1),Y
*
         LDX   :S3LEN     ; RETURN FINAL LENGTH
*
         RTS
*
** DATA
*
:S3LEN   DS    1
:S1LEN   DS    1
:S1IND   DS    1
:S2LEN   DS    1
:S2IND   DS    1
:MLEN    DS    1
:SCNT    DS    1
:SOVF    DS    1
*
*``````````````````````````````*
* PRNSTR :: PRINT INDEXED STR  *
*-                            -*
* PRINT A STRING WITH LENGTH   *
* THAT PRECEDES START OF STR   *
*-                            -*
* CLOBBERS:                    *
*                              *
* FLAGS:  ????----  REG: AXYM  *
*-                            -*
* CYCLES: ???                  *
* SIZE:                        *
*-                            -*
* USAGE:                       *
*                              *
*   LDA #>STR ; STRING ADDRESS *
*   PHA                        *
*   LDA #<STR                  *
*   PHA                        *
*   JSR PRNSTR                 *
*-                            -*
* ENTRY                        *
*                              *
* TOP OF STACK                 *
*                              *
* LOW BYTE OF RETURN ADDRESS   *
* HI BYTE OF RETURN ADDRESS    *
* LOW BYTE OF STRING ADDRESS   *
* HIGH BYTE OF STRING ADDRESS  *
*-                            -*
* EXIT                         *
*                              *
* TOP OF STACK                 *
*                              *
* LOW BYTE OF RETURN ADDRESS   *
* HI BYTE OF RETURN ADDRESS    *
*                              *
* .Y = LOW BYTE STRING ADDR    *
* .X = HI BYTE STRING ADDR     *
* .A = STRING LENGTH           *
*,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,*
*
PRNSTR
*
** SAVE RETURN ADDRESS
*
         PLA
         STA   RETADR
         PLA
         STA   RETADR+1
*
** GET PARAMETERS
*
         PLA
         STA   ADDR1      ; ADDRESS OF STRING
         PLA
         STA   ADDR1+1
*
         LDY   #0
         LDA   (ADDR1),Y  ; GET STRING LENGTH
         STA   :S1LEN
:LP
         INY
         LDA   (ADDR1),Y  ; GET CHARACTER
         JSR   SCOUT1     ; PRINT CHARACTER TO SCREEN
         CPY   :S1LEN     ; IF Y < LENGTH
         BNE   :LP
                          ; LOOP; ELSE
         LDY   #0
         LDA   (ADDR1),Y
*
** RESTORE RETURN ADDRESS
*
         LDA   RETADR+1
         PHA
         LDA   RETADR
         PHA
*
         LDY   #0
         LDA   (ADDR1),Y  ; STRING LENGTH IN A
         LDY   ADDR1
         LDX   ADDR1+1    ; ADDRESS IN Y,X
*
         RTS
*
** DATA
*
:S1LEN   DS    1
*
*``````````````````````````````*
* NUM2STR :: NUMBER TO STRING  *
*-                            -*
* CONVERTS A 16-BIT NUMBER TO  *
* ITS STRING EQUIVALENT.       *
*-                            -*
* CLOBBERS:                    *
*                              *
* FLAGS:  ????----  REG: AXYM  *
*-                            -*
* CYCLES: ???                  *
* SIZE:                        *
*-                            -*
* USAGE:                       *
*                              *
*   LDA #>11111 ; VALUE TO     *
*   PHA         ; CONVERT      *
*   LDA #<11111                *
*   PHA                        *
*   JSR NUM2STR                *
*-                            -*
* ENTRY                        *
*                              *
* TOP OF STACK                 *
*                              *
* LOW BYTE OF RETURN ADDRESS   *
* HI BYTE OF RETURN ADDRESS    *
* LO BYTE VALUE TO CONVERT     *
* HI BYTE VALUE TO CONVERT     *
*-                            -*
* EXIT                         *
*                              *
* TOP OF STACK                 *
*                              *
* LOW BYTE OF RETURN ADDRESS   *
* HI BYTE OF RETURN ADDRESS    *
*                              *
* .Y = COUNTER; TRASH          *
* .X = COUNTER; TRASH          *
* .A = LOW BYTE OF RET ADDR    *
*                              *
* [RETURN] = STRING VALUE      *
* [RETLEN] = LENGTH OF STRING  *
*-                            -*
* ADAPTED FROM LEVANTHAL AND   *
* WINTHROP'S /6502 ASSEMBLY    *
* LANGUAGE ROUTINES/.          *
*,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,*
*
NUM2STR
*
** SAVE RETURN ADDRESS
*
         PLA
         STA   RETADR
         PLA
         STA   RETADR+1
*
** GET PARAMETERS
*
         PLA
         STA   :VALSTR
         PLA
         STA   :VALSTR+1
*
         STA   :NGFLAG
         BPL   :GETBP     ; BR IF VAL IS POS
         LDA   #0
         SEC
         SBC   :VALSTR
         STA   :VALSTR
         LDA   #0
         SBC   :VALSTR+1
         STA   :VALSTR+1
*
:GETBP
         LDA   #<RETURN
         STA   ADDR1      ; ADDRESS TO STORE STRING
         LDA   #>RETURN+1
         STA   ADDR1+1
         LDA   #0         ; SET BUFFER TO EMPTY
         LDY   #0
         STA   (ADDR1),Y  ; BUFFER(0) = 0
*
** CONVERT VAL TO STRING
*
:CNVERT
*
** VALUE = VALUE DIV 10
** MOD10 = VALUE MOD 10
*
         LDA   #0
         STA   :MOD10
         STA   :MOD10+1
         LDX   #16
         CLC              ; CLEAR CARRY
*
:DVLOOP
         ROL   :VALSTR    ; SHIFT  CARRY INTO DIVBIT 0
         ROL   :VALSTR+1  ; WHICH WILL BE THE QUOTIENT
         ROL   :MOD10     ; + SHIFT DIV AT SAME TIME
         ROL   :MOD10+1
*
** A,Y = DIVIDEND - DIVISOR
*
         SEC
         LDA   :MOD10
         SBC   #10
         TAY              ; SAVE LOWB IN REG Y
         LDA   :MOD10+1
         SBC   #0         ; SUBTRACT CARRY
         BCC   :DECCNT    ; BR IF DEND < DIVISOR
         STY   :MOD10     ; ELSE
         STA   :MOD10+1   ; NXT BIT OF Q IS A ONE AND SET
                          ; DIVIDEND = DEND - DIVISOR
:DECCNT
         DEX
         BNE   :DVLOOP
         ROL   :VALSTR    ; SHIFT IN LAST CARRY FOR Q
         ROL   :VALSTR+1
*
** CONCAT NEXT CHAR
*
:CONCH
         LDA   :MOD10
         CLC
         ADC   #$B0
*
** ADC #'0' ; CONVERT 0..9 TO ASCII 0-9
*
         JSR   :CONCAT
*
** IF VALUE <> 0 THEN CONTINUE
*
         LDA   :VALSTR
         ORA   :VALSTR+1
         BNE   :CNVERT    ; BR IF VALUE != 0
*
:EXIT
         LDA   :NGFLAG
         BPL   :POS       ; BR IF ORIG VAL POS
         LDA   #173       ; ELSE
         JSR   :CONCAT    ; PUT A MINUS SIGN IN FRONT
*
:POS
*
** RESTORE RETURN ADDRESS
*
         LDA   RETADR+1
         PHA
         LDA   RETADR
         PHA
*
         RTS              ; RETURN
*
********************************
* CONCAT SUBROUTINE
********************************
*
:CONCAT
         PHA              ; SAVE CHAR ON STACK
*
** MOVE BUFFER RIGHT ONE CHAR
*
         LDY   #0
         LDA   (ADDR1),Y  ; GET CURRENT LENGTH
         TAY
         BEQ   :EXITMR    ; BR IF LENGTH=0
*
:MVELP
         LDA   (ADDR1),Y  ; GET NEXT CHAR
         INY
         STA   (ADDR1),Y  ; STORE IT
         DEY
         DEY
         BNE   :MVELP     ; CONT UNTIL DONE
*
:EXITMR
         PLA              ; GET CHAR BACK FROM STACK
         LDY   #1
         STA   (ADDR1),Y  ; STORE THE CHAR
         LDY   #0
         LDA   (ADDR1),Y  ; GET LENGTH BYTE
         CLC
         ADC   #1         ; INC LENGTH BY ONE
         STA   (ADDR1),Y  ; UPDATE LENGTH
*
         RTS
*
** DATA
*
:NGFLAG  DS    1
:VALSTR  DS    2
:MOD10   DS    2
*
*``````````````````````````````*
* STR2NUM :: STRING TO NUMBER  *
*-                            -*
* CONVERTS A STRING TO THE     *
* EQUIVALENT 16BIT NUMBER.     *
*-                            -*
* CLOBBERS:                    *
*                              *
* FLAGS:  ????----  REG: AXYM  *
*-                            -*
* CYCLES: ???                  *
* SIZE:                        *
*-                            -*
* USAGE:                       *
*                              *
*   LDA #>$300 ; STRING ADDR   *
*   PHA                        *
*   LDA #<$300                 *
*   PHA                        *
*   JSR STR2NUM                *
*-                            -*
* ENTRY                        *
*                              *
* TOP OF STACK                 *
*                              *
* LOW BYTE OF RETURN ADDRESS   *
* HI BYTE OF RETURN ADDRESS    *
* LO BYTE OF STRING ADDRESS    *
* HI BYTE OF STRING ADDRESS    *
*-                            -*
* EXIT                         *
*                              *
* TOP OF STACK                 *
*                              *
* LOW BYTE OF RETURN ADDRESS   *
* HI BYTE OF RETURN ADDRESS    *
*                              *
* .Y = LO BYTE OF NUMBER       *
* .X = HI BYTE OF NUMBER       *
* .A = LOW BYTE OF RET ADDR    *
*                              *
* [RETURN] = NUMBER VALUE WORD *
* [RETLEN] = 2 (NUM OF BYTES)  *
*-                            -*
* ADAPTED FROM LEVANTHAL AND   *
* WINTHROP'S /6502 ASSEMBLY    *
* LANGUAGE ROUTINES/.          *
*,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,*
*
STR2NUM
*
** SAVE RETURN ADDRESS
*
         PLA
         STA   RETADR
         PLA
         STA   RETADR+1
*
** GET PARAMETERS
*
         PLA
         STA   ADDR1      ; ADRESS OF STRING
         PLA              ; TO CNVERT
         STA   ADDR1+1
*
** INITIALIZE
*
         LDY   #0
         LDA   (ADDR1),Y
         TAX              ; GET LENGITH; TO REGX
         LDA   #1
         STA   :NINDEX    ; INDEX = 1
         LDA   #0
         STA   :NACCUM    ; ACCUM = 0
         STA   :NACCUM+1
         STA   :SNGFLAG   ; SIGN IS POSITIVE
*
** CHECK THAT BUFFER IS NOT ZERO
*
         TXA
         BNE   :INIT1     ; EXIT WITH ACCUM = 0
                          ; IF BUFFER IS EMPTY
         JMP   :EREXIT    ; ERROR EXIT IF NOTHING
                          ; IN BUFFER
:INIT1
         LDY   :NINDEX
         LDA   (ADDR1),Y
         CMP   #173
         BNE   :PLUS      ; BR IF NOT -
         LDA   #$0FF
         STA   :SNGFLAG   ; ELSE SIGN IS NEGATIVE
         INC   :NINDEX
         DEX              ; DECREMENT COUNT
         BEQ   :EREXIT    ; ERROR EXIT IF ONLY
                          ; - IN BUFFER
         JMP   :CNVERT
:PLUS
         CMP   #'+'
         BNE   :CHKDIG    ; START CONVERSION IF 1ST
                          ; CHARACTER IS NOT A +
         INC   :NINDEX
         DEX              ; DEC COUNT; IGNORE + SIGN
         BEQ   :EREXIT    ; ERROR EXIT IF ONLY
                          ; + IN THE BUFFER
:CNVERT
         LDY   :NINDEX
         LDA   (ADDR1),Y
                          ; GET NEXT CHAR
:CHKDIG
         CMP   #$B0       ; "0"
         BMI   :EREXIT    ; ERROR IF NOT A NUMERAL
         CMP   #$BA       ; '9'+1; TECHNICALLY :
         BPL   :EREXIT    ; ERR IF > 9 (NOT NUMERAL)
         PHA              ; PUSH DIGIT TO STACK
*
** VALID DECIMAL DIGIT SO
** ACCUM = ACCUM * 10
**   = * (8+2)
**   = (ACCUM * 8) + (ACCUM * 2)
*
         ASL   :NACCUM
         ROL   :NACCUM+1  ; TIMES 2
         LDA   :NACCUM
         LDY   :NACCUM+1  ; SAVE ACCUM * 2
         ASL   :NACCUM
         ROL   :NACCUM+1
         ASL   :NACCUM
         ROL   :NACCUM+1  ; TIMES 8
         CLC
         ADC   :NACCUM    ; SUM WITH * 2
         STA   :NACCUM
         TYA
         ADC   :NACCUM+1
         STA   :NACCUM+1  ; ACCUM=ACCUM * 10
*
** ADD IN THE NEXT DIGIT
** ACCUM = ACCUM + DIGIT
*
         PLA              ; GET THE DIGIT NACK
         SEC
         SBC   #$B0
         CLC              ; CONVERT STR TO BIN
         ADC   :NACCUM
         STA   :NACCUM
         BCC   :D2B1      ; BRANCH IF NO CARRY TO HBYTE
         INC   :NACCUM+1  ; ELSE INC HIGH BYTE
:D2B1
         INC   :NINDEX    ;INC TO NEXT CHARACTER
         DEX
         BNE   :CNVERT    ; CONTINUE CONVERSION
         LDA   :SNGFLAG
         BPL   :OKEXIT    ; BR IF VAL IS POSITIVE
         LDA   #0         ; ELSE REPLACE WITH -RESULT
         SEC
         SBC   :NACCUM
         STA   :NACCUM
         LDA   #0
         SBC   :NACCUM+1
         STA   :NACCUM+1
*
** GET THE BINARY VALUE AND RETURN
*
:OKEXIT
         CLC
         BCC   :EXIT
:EREXIT
         SEC
:EXIT
*
** RESTORE RETURN ADDRESS
*
         LDA   RETADR+1
         PHA
         LDA   RETADR
         PHA
*
         LDX   :NACCUM+1
         LDY   :NACCUM
         STY   RETURN
         STX   RETURN+1
         LDA   #2
         STA   RETLEN
         LDA   :NINDEX
*
         RTS
*
** DATA
*
:NACCUM  DS    2
:SNGFLAG DS    1
:NINDEX  DS    1
*
STRINGSX
*