LEX 'INC3ASM'
*
*  4 Character Name Increment Routine
*  By Ronald B Johnson
*  String Function which increments a 4 character string
*     e.g. 12C4 + 122 = 13E6
*     Requires 4 char string and positive increment (<10000)
*     Returns new 4 char string, or null string if error
*
*  Version 11  9/8/84
*
    TITLE STRING INCREMENT ROUTINE
    ID #5E
    MSG 0
    POLL 0
EXPR   EQU #0F23C
FNRTN1 EQU #0F216
POP1S  EQU #0BD38
POP1N  EQU #0BD1C
    ENTRY START
    CHAR #F function
    KEY 'AINC$'
    TOKEN 1
    ENDTXT
    STITLE Start of Program
    NIBHEX  8 2nd parameter number
    NIBHEX  4 1st parameter string
    NIBHEX 22 2 parameters required
START
    GOSBVL POP1N pop INCR to A
* test positive increment
    ?A#0 S
    GOYES INCERR
*  Test exponent range (negative or >3 invalid)
    P= 0
    LCHEX 003
    ?A>C X 
    GOYES INCERR
*  Test if integer
    LCHEX D compute position of msd of fraction
    SETHEX
    C=C-A P
    P=C 0
    B=A X save exponent
    A=0 X
    ?A#0 WP
    GOYES INCERR
    A=B X restore exponent
    GOTO EXPINC
INCERR
    C=0 W
    P= 0
    LCHEX F null string
    GOVLNG FNRTN1
EXPINC
    ?A=0 W   increment = zero ?
    GOYES ORIGST
    P= 0
    LCHEX 03 need exp = 3 to right just increment
SLOOP
    ?A=C B  are we fully shifted to right?
    GOYES SHFDON
    ASR M
    A=A+1 B incr exp 
    GOTO SLOOP
SHFDON
*  create 4 byte increment field in 0 to 7 of C
    C=A W  copy to c to work on
    P= 7
    C=0 WP  clear byte increments
    P=C 11 move LS nib to LS byte
    C=P  0
    P=C 12
    C=P  2
    P=C 13
    C=P  4
    P=C 14 move MSD
    C=P  6
    GOTO STRING
ORIGST
    D1=D1+ 16 
    GOVLNG EXPR
    STITLE  String Load
*  LOAD STRING
STRING
    B=C W  move increment to B
    D1=D1+ 16 move stack pointer to string
    SETHEX
    GOSBVL POP1S
    P= 0
    LCHEX 00008
    ?A#C A length must be 8 nibs (4 bytes)
    GOYES INCERR
    A=DAT1 8
    STITLE Perform the Computation
    P= 15  set up loop counter in S field of C
    LCHEX 4
    CLRST
*   Status Register bits used as follows:
*    0: carry from prev
*    1: prev was number
*    2: prev was alpha
*    3: prev was space
MLOOP
    P= 0
    LCASC ' '
    ?A=C B
    GOYES ISSPC
    LCASC '0'
    ?A>=C B
    GOYES MAYNUM
    GOTO INCERR  invalid char
MAYNUM LCASC '9'
    ?A<=C B
    GOYES ISNUM
    LCASC 'A'
    ?A>=C B
    GOYES MAYALF
    GOTO INCERR  invalid char
MAYALF LCASC 'Z'
    ?A<=C B
    GOYES ISALF
    GOTO INCERR INVALID CHAR
ISSPC
    ?ST=0 0 no carry ?
    GOYES SPCNC
    ?ST=1 1
    GOYES SPCNUM
    LCHEX 40 set to char before 'A'
    A=C B
    GOTO ISALF
SPCNUM LCASC '0'
    A=C B
    GOTO ISNUM
SPCNC ?B=0 B is the incr = 0 ?
    GOYES SPCSPC
    ?ST=1 3 was prev a space?
    GOYES INCER2
    GOTO SPCNUM
SPCSPC CLRST
    ST=1 3
    GOTO NEXT
ISNUM
    ?ST=0 0
    GOYES NUMNC
    ?ST=1 2 can't carry from alpha
    GOYES INCER2
    A=A+1 B  carry
NUMNC A=A+B B  add the increment
    CLRST
    LCASC '9'
    ?A<=C B check overflow
    GOYES NNC
    LCHEX 0A
    A=A-C B subtract 10
    ST=1 0 set carry
NNC ST=1 1 set number
    GOTO NEXT
INCER2
    GOTO INCERR too far away for goyes
ISALF
    ?ST=0 0
    GOYES ALFNC
    ?ST=1 1  carry from number?
    GOYES INCER2
    A=A+1 B carry
ALFNC A=A+B B increment
    CLRST
    LCASC 'Z'
    ?A<=C B test overflow
    GOYES ANC
    LCHEX 1A (26)
    A=A-C B
    ST=1 0 set carry
ANC ST=1 2 set alpha
    STITLE End of Main Loop
NEXT
    ASRC
    ASRC shift string one byte
    BSRC
    BSRC shift increments one byte
    C=C-1 S decrement loop counter
    ?C=0 S
    GOYES DONE
    GOTO MLOOP
DONE
    ?ST=1 0 was there a carry from 4th field?
    GOYES INCER2
*   rotate string back 4 bytes
    ASLC
    ASLC
    ASLC
    ASLC
    ASLC
    ASLC
    ASLC
    ASLC
    DAT1=A 8  write string to stack
    D1=D1- 16 decrement stack pointer
    C=0 W
    LCHEX 80F eight nib string
    DAT1=C W  write string header to stack
    GOVLNG EXPR return to BASIC
    END