NEW
  AUTO 3,1
*--------------------------------------
TABLE1 .EQ $BE00-48
TABLE2 .EQ $BE00-32
TABLE3 .EQ $BE00-16
*--------------------------------
DIR.AC
       JSR GNNB     GET NEXT NON-BLANK FOR DELIMITER
       BCS .8       ...ERROR
       STA DLIM     IN CASE IT IS A DELIMITER
       EOR #'0'
       BEQ .9       ...INITIAL STRING
       CMP #4
       BCC .10
*---GET NEXT CHAR OF STRING------
.2     JSR GNC      GET NEXT CHAR TO ENCODE
       BCS .8       ...ERROR
       CMP DLIM
       BEQ .7       ...END OF STRING
*---SEARCH TABLE 1---------------
       LDY #15
.3     CMP TABLE1,Y
       BEQ .6       ...FOUND IT
       DEY
       BNE .3
*---SEARCH TABLE 2---------------
       JSR OUTPUT.NYBBLE.Y
       LDY #15
.4     CMP TABLE2,Y
       BEQ .6       ...FOUND IT
       DEY
       BNE .4
*---SEARCH TABLE 3---------------
       JSR OUTPUT.NYBBLE.Y
       LDY #15
.5     CMP TABLE3,Y
       BEQ .6       ...FOUND IT
       DEY
       BNE .5
*---NOT IN ANY TABLE-------------
       JSR OUTPUT.NYBBLE.Y
       PHA
       LSR
       LSR
       LSR
       LSR
       TAY
       JSR OUTPUT.NYBBLE.Y
       PLA
       AND #$0F
       TAY
*---OUTPUT TABLE INDEX-----------
.6     JSR OUTPUT.NYBBLE.Y
*---NEXT CHAR--------------------
       JMP .2
*---END OF STRING----------------
.9     STA NYBBLE.FLAG
.7     RTS
*---ERROR------------------------
.8     JMP ERBA
*---READ NEW CODING TABLES-------
.10    SBC #0       CHANGE TO 0,1,2
       ASL          *16
       ASL
       ASL
       ASL
       TAX
       JSR GNC
       BCS .7       ...NO STRING
       STA DLIM
.11    JSR GNC      ...ALLOW LOWER CASE
       BCS .8       ...ERROR
       CMP DLIM
       BEQ .7       ...END OF STRING
       INX
       CPX #48
       BCS .8       ...GONE TOO FAR
       STA TABLE1,X
       BCC .11      ...ALWAYS
*--------------------------------
OUTPUT.NYBBLE.Y
       PHA          SAVE A-REG
       TYA
       LSR NYBBLE.FLAG
       BCS .1       ...IT WAS = $01
       ASL          ...IT WAS = $00
       ASL
       ASL
       ASL
       STA BYTE
       INC NYBBLE.FLAG
       PLA
       RTS
.1     ORA BYTE
       JSR EMIT
       PLA
       RTS
*--------------------------------------
MAN
SAVE usr/src/scmasm.30/scmasm.s.acdir
LOAD usr/src/scmasm.30/scmasm.s
ASM