LEX    'TESTLEX'
        ID     #5D
        MSG    0
        POLL   0
        ENTRY  KEYWRD
        CHAR   #D
        KEY    'KEYWORD'
        TOKEN  #01
        NIBHEX 1FF
*
* This is a mini-LEX I use to develop statment parse and decompile routines.
* The execution code could initially be KEYWRD GOVLNG NXTSTM. However, a call
* on the CHIRP routine with GOSBVL CHIRP will provide audio feedback to let
* you know parse was successful and that you have begun the execution code.
* I also found it useful to get a visual display of that provides immediate
* feedback about how the execution code selects alternative responses. User
* flags 0-4 are ideal for the purpose.
*
tON     EQU    #000E0
tOFF    EQU    #000E1
MSPARe  EQU    #02E5C
TRACDC  EQU    #052FC
WRDSCN  EQU    #02C2A
ONd     GOVLNG TRACDC   ON/OFF token decompile 
ONp     GOSBVL WRDSCN   ON/OFF token parse
        CON(2) tON
        REL(3) parse
        CON(2) tOFF
        REL(3) parse
        CON(2) 0        end of allowable tokens table
        ST=0   4        neither ON or OFF, so error exit
        GOVLNG MSPARe
parse   RTNCC           parsed ok, end of parse
*
* Typically, look for an existing main frame keyword that uses a syntax similar
* to the one you are creating. See the IDS and/or disassemble a likely routine,
* and make suitable modifications. Start with the parse routine, since you can
* test performance from the keyboard. Then, work on the decompile routine until
* it allows you to decompile program lines. Be sure to test it in multi-
* statment lines, and in conjunction with FOR ... NEXT and IF ... THEN ... ELSE
* structures.
        REL(5) ONd
        REL(5) ONp
KEYWRD  A=DAT0 B        read tON/tOFF token
        CD0EX           save D0 pointer
        RSTK=C
        GOSUB FINDN     go find the address of ON/OFF nibble
        A=A-1  WP
        DAT0=A 1        store either 0 or 1 at nibble, second nibble of token
*                       Nibble=1 means OFF, =0 means ON
        C=RSTK          restore D0
        D0=C
        GOVLNG NXTSTM
FINDN   D0=(5) #2F6E9   flgREG
        RTN
NXTSTM  EQU    #08A48
*****************************************************************
*
* This is what happened when I extended TESTLEX to develop the RSTCOUNT ALL /
* RSTCOUNT <num. expr.> code:
        LEX    'RSTTEST'
        ID     #5D
        MSG    0
        POLL   0
        ENTRY  KEYWRD
        CHAR   #D
        KEY    'RST'
        TOKEN  #02
        NIBHEX 1FF
tALL    EQU    #000F8
MSPARe  EQU    #02E5C
TRACDC  EQU    #052FC
WRDSCN  EQU    #02C2A
R3=D10  EQU    #03526
EXPPAR  EQU    #03FD9
D1C=R3  EQU    #03047
CSRC5   EQU    #1B41B
IVEXPe  EQU    #02E35
*****************************************************************
*
* The ALLp parse routine duplicates NUMCK, except that the invalid numeric
* expression exit is used to try parsing RST ALL. This requires restoring D0
* to entry condition, just as is we had not carried out the EXPression PARse.
*
ALLp    GOSBVL GNXTCR   get first non-blank character in input stream (D1)
        GOSBVL R3=D10   now that we have skipped optional blanks, save D1, D0
        GOSBVL EXPPAR   try to parse an expression
        ?ST=0  3        valid string?
        GOYES  ALLp1    yes, but we do not do strings, use invalid expr. exit
        ?ST=1  0        invalid expression?
        GOYES  ALLp3    yes, invalid. Go try to parse tALL
        GOVLNG RESPTR   Ok, valid numeric expression, restore pointer, done!
ALLp3   GOSBVL D1C=R3   restore pointers, starting with D1
        C=R3            move D0 to C[A]
        D0=C            restore D0. Now, let's try for tALL
        GOSBVL WRDSCN   try to parse as a token...
        CON(2) tALL
        REL(3) parse    if tALL, we are done
        CON(2) 0        end of table
ALLp1   GOSBVL D1C=R3   error exit, restore input pointer so cursor will point
        ST=1   4        to bad text
        GOVLNG IVEXPe   invalid expression parse routine
parse   RTNCC           tALL parsed successfully
*****************************************************************
*
* now, the execution code:
*
        REL(5) ALLd
        REL(5) ALLp
KEYWRD  A=0    A        clear A[A]
        A=DAT0 B        read tALL token, if it is there
        LC(2)  tALL
        ?A#C   B        if not tALL, we process the expression
        GOYES  RSTEXP
        GOSBVL CHIRP    some harmless code to indicate tALL execution
        GOSBVL CHIRP
nxtstm  GOVLNG NXTSTM
eIVARG  LC(4)  #000B
        GOVLNG BSERR
RSTEXP  GOSBVL EXPEXC   since not tALL, evaluate the expression
        GOSBVL POP1R    pop it on the mathstack
        GOSBVL FLTDH    convert to hex in A[A]
        GONC   eIVARG
        LCHEX  000FF    we only allow 0 to 255
        ?A>C   A        do we exceed 255?
        GOYES  eIVARG   yes, invalid argument
        CD0EX           save D0 pointer
        RSTK=C
        GOSUB FINDN     go find the address where information is to be stuffed
        DAT0=A B        store expression value
        C=RSTK          restore D0
        D0=C
        GOTO   nxtstm
FINDN   D0=(5) #2F6E9   flgREG - the flags that display, 0-3
        RTN             (for rapid feedback)
GTEXT1  EQU    #051A5
EOLXC*  EQU    #052EC
FIXDC   EQU    #05493
NXTSTM  EQU    #08A48
FLTDH   EQU    #1B223
RESPTR  EQU    #03172
NUMCK   EQU    #0369D
EXPEXC  EQU    #0F186
POP1R   EQU    #0E8FD
BSERR   EQU    #0939A
*****************************************************************
*
* This code was adapted from PURGDC, which allows PURGE ALL and other
* possibilities.
*
ALLd1   GOSBVL GTEXT1   decompile token if greater than 6A
        GONC   ALLd2    B.E.T.
ALLd    LCHEX  F8       tALL token
        ?C=A   B        if tALL, decompile it
        GOYES  ALLd1    yes, do it!
ALLd2   GOSBVL EOLXC*   if tALL (via ALLd1), we are at end-of-statement,
*                       so we never return, else we go on and
        GOVLNG FIXDC    decompile the numeric expresion
CHIRP   EQU    #0EC5A
GNXTCR  EQU    #03064