LEX    'MCURSOR'* A LEX file to facilitate array index manipulations.
        ID     #EC      * J.Elhay, 8/3/88
        MSG    0        * This statement is intended for 2-D arrays and waits
        POLL   0        * in low power sleep for a key. It responds only to
        ENTRY  mcurs    * the cursor keys and endline.
        CHAR   #D       * A statement, generally usable
        KEY    'MCURS'  * Syntax: MCURS <riv>,<civ>,<b>,<u1>,<u2> where
        TOKEN  131      * riv & civ are row & col. index variables, b is min.
        ENDTXT          * value & u1,u2 are row & col. upper bounds.
FIXDC   EQU    #05493   * FIX decompile
VARP    EQU    #0350E   * variable parse
NTOKEN  EQU    #0493B   * output next token #
SYNTXe  EQU    #02E2B   * syntax error exit
FIXP    EQU    #02A6E   * FIX parse
NUMCK   EQU    #0369D   * number check parse, O/P comma token if present
COMCK+  EQU    #032AE   * comma check parse
EXPEXC  EQU    #0F186   * expression execute, evaluate
RNDAHX  EQU    #136CB   * pop, test, round & convert to HEX integer
CSLC5   EQU    #1B435   * 5 left circular shifts of register C
CSRC5   EQU    #1B41B   * 5 right circular shifts of C
SLEEP   EQU    #006C2   * light sleep
CKSREQ  EQU    #00721   * check for service requests(ext. keybd.,clock,etc)
POPBUF  EQU    #010EE   * pop key from keybuffer
DEST    EQU    #0F7B0   * save variable destination information for STORE
TBLJMC  EQU    #02426   * indexed table jump using predicate in C(0)
HDFLT   EQU    #1B31B   * HEX to floating point conversion
STORE   EQU    #0F5F8   * store val. on stack & in A(W) to variable
NXTSTM  EQU    #08A48   * statement exit
ARGERR  EQU    #0BF19   * invalid argument error exit
MCURSd  GOVLNG FIXDC    * decompile for this statement
MCURSp  GOSBVL VARP     * parse for this statement
        GONC   Syntxe   * 1st item must be a variable
        GOSBVL NTOKEN   * O/P next token
        GOSUB  Comck+   * is it a comma?
        GONC   Syntxe   * no
        GOSBVL VARP     * yes, 2nd item must also be a variable
        GONC   Syntxe
        GOSBVL NTOKEN   * O/P next token
        GOSUB  Comck+   * a comma?
        GONC   Syntxe
        GOSBVL NUMCK    * a number?
        GOSUB  Comck+   * a comma?
        GOSBVL NUMCK    * another number?
        GOSUB  Comck+   * another comma?
        GOC    fixp     * FIXP takes care of the rest
Syntxe  GOVLNG SYNTXe
fixp    GOVLNG FIXP     * all OK now.
Comck+  GOVLNG COMCK+
Expexc  GOVLNG EXPEXC
Rndahx  GOVLNG RNDAHX
Cslc5   GOVLNG CSLC5
Csrc5   GOVLNG CSRC5
        REL(5) MCURSd
        REL(5) MCURSp
mcurs   SETHEX          * SLEEP needs HEX mode on entry
        CD0EX           * save D0
        D0=C
        R3=C            * in R3
Sleep   GOSBVL SLEEP    * now wait for key
        GONC   KEY      * a key was pressed
        GOSBVL CKSREQ   * service request?
        GOTO   Sleep    * attend to it and back to sleep
KEY     GOSBVL POPBUF   * pop key from buffer
        C=0    W        * clear C
        P=     0        * load from nib 0
        LCHEX  #26      * ENDLINE key# is 38
        ?B#C   B        * not endline?
        GOYES  ALTER    * determine what key was pressed
        C=R3            * was endline, exit with variables unchanged
        D0=C            * after restoring D0
        GOTO   nxtstm
ALTER   A=0    A        * A will be used as a counter to obtain predicate
        LCHEX  #A09F302FA3A23332* each byte represents a valid key
LOOP    ?B=C   B        * compare popped key with C(B)
        GOYES  ON       * match found, leave loop
        A=A+1  A        * increment predicate
        CSR    W        * move byte to look at next byte in C
        CSR    W
        ?C#0   B        * any more bytes?
        GOYES  LOOP     * loop back
        GOTO   Sleep    * no match found, wait for another key
ON      D1=(5) #2F98B   * this is RESERVED RAM
        DAT1=A 1        * save the predicate there
        C=R3            * recover D0's value
        D0=C            * and restore it
        GOSUB  Expexc   * 1st variable (row)
        GOSBVL DEST     * save dest. info.
        D0=D0+ 2        * past comma
        GOSUB  Expexc   * 2nd variable (column)
        CD1EX           * save D1
        R0=C            * in R0
        D1=(5) #2F98B   * fetch predicate
        P=     0
        A=DAT1 1        * put into A(0)
        C=R0            * restore D1
        D1=C
        LC(1)  4        * predicate <4 for rows
        ?A<C   P        * is it <4?
        GOYES  NOTJ     * do not change dest. info.
        GOSBVL DEST     * column variable will be changed
NOTJ    D0=D0+ 2        * past comma
        GOSUB  Expexc   * evaluate b
        D0=D0+ 2
        GOSUB  Expexc   * evaluate u1
        D0=D0+ 2
        GOSUB  Expexc   * evaluate u2
        GONC   ARGS     * BET; exit from EXPEXC is with carry clear
Err     GOVLNG ARGERR
ARGS    GOSUB  Rndahx   * pop u2
        GONC   Err      * no negatives
        R1=A            * save in R1
        D1=D1+ 16       * move to next parameter
        GOSUB  Rndahx   * pop u1
        GONC   Err
        R0=A            * save in R0
        D1=D1+ 16
        GOSUB  Rndahx   * pop b
        GONC   Err
        C=R1            * collect u2
        GOSUB  Cslc5    * shift to C(9,5)
        C=A    A        * b in C(A)
        R1=C            * R1 now contains u2 & b
        C=R0            * collect u1
        GOSUB  Cslc5    * shift to C(9,5)
        C=A    A        * b in C(A)
        R0=C            * R0 now contains u1 & b
        D1=D1+ 16
        GOSUB  Rndahx   * pop column variable's value
        GONC   Err
        R3=A            * save in R3
        D1=D1+ 16
        GOSUB  Rndahx   * pop row variable's value
        GONC   Err
        R2=A            * save in R2
        C=R0            * calculate (max-min+1) for rows
        B=C    A
        GOSUB  Csrc5
        C=C-B  A
        C=C+1  A
        D=C    A        * save in D
        C=R1            * calculate (max-min+1) for columns
        GOSUB  Csrc5
        C=C-B  A
        C=C+1  A
        B=C    A        * save in B
        AD1EX           * save D1 in A
        D1=(5) #2F98B   * to collect predicate
        P=     0
        C=0    W
        C=DAT1 P        * in C(0)
        AD1EX           * and restore D1
        GOSBVL TBLJMC   * indexed table jump predicated on C(0)
        REL(3) I-1      * C(0)=0, decrement row var.
        REL(3) I+1      * C(0)=1, increment row var.
        REL(3) MIN      * C(0)=2, set row var. to b
        REL(3) MAXI     * C(0)=3, set row var. to u1
        REL(3) J-1      * C(0)=4, decrement col var.
        REL(3) J+1      * C(0)=5, increment col var.
        REL(3) MIN      * C(0)=6, set col var. to b
        REL(3) MAXJ     * C(0)=7, set col var. to u2
MIN     A=R0            * R0(A) contains b
        GOTO   OUT      * finish
MAXI    C=R0            * R0(9,5) contains u1
        GOTO   OUTI     * make use of common code
MAXJ    C=R1            * R1(9,5) contains u2
OUTI    GOSUB  Csrc5    * shift u to C(A)
        A=C    A        * copy to A(A)
        GOTO   OUT      * and finish
I+1     C=R0            * collect u1
        GOSUB  Csrc5
        A=R2            * and current index value for rows
        A=A+1  A        * increment current value
        ?C>=A  A        * is it less than u1?
        GOYES  OUT1     * yes, we can finish
        C=D    A        * no, wrap around
        A=A-C  A        * by deducting (max-min+1)
OUT1    GOTO   OUT      * then leave
I-1     A=R2            * collect u1
        ?A#0   A        * this is to avoid C(A)=FFFFF when b=0
        GOYES  NOT0I    * not 0, skip
        C=D    A        * wrap around first
        A=A+C  A
NOT0I   A=A-1  A        * decrement current index value for rows
        C=R0            * collect b
        ?C<=A  A        * is b less?
        GOYES  OUT2     * then we can leave
        C=D    A        * otherwise wrap around
        A=A+C  A        * again
OUT2    GOTO   OUT
J+1     C=R1            * collect u2
        GOSUB  Csrc5
        A=R3            * and current col index value
        A=A+1  A        * increment
        ?C>=A  A        * less than u2?
        GOYES  OUT3     * OK, leave
        A=A-B  A        * wrap
OUT3    GOTO   OUT
J-1     A=R3            * A(A) is current col index value
        ?A#0   A        * is it 0?
        GOYES  NOT0J    * no
        A=A+B  A        * yes, wrap first
NOT0J   A=A-1  A        * decrement
        C=R1            * collect b
        ?C<=A  A        * is b less?
        GOYES  OUT      * yes, finish
        A=A+B  A        * no, wrap
OUT     GOSBVL HDFLT    * A(A) HEX integer to A(W) floating point
        DAT1=A W        * write to MATHSTACK
        GOSBVL STORE    * store value in appropriate index variable
nxtstm  GOVLNG NXTSTM   * and finally exit.