     *
     *         IBM 1401 Tiny Basic
     *              Paul Laughton
     *              paul@laughton.com
     *
     *         This code is open source. It is available to anyone for any pupose.
     *
     *         Rev 02 February 8, 2015
     *
               ORG  1
     CARD      EQU  1
               DS   80                 CARD READ AREA
               ORG  87
     X1        DS   3                  INDEX REGISTER 1
               ORG  92
     X2        DS   3                  INDEX REGISTER 2
               ORG  97
     X3        DS   3                  INDEX REGISTER 3
     *
     LINE      ORG  100
     *
     SWA       EQU  199
     PRA       EQU  201
               DS   132                PRINT AREA
     *
     *         LINE NUMBER TABLE
     *
               ORG  333
     LTBL      DA   100X6,X1
     LNO            1,3                LINE NUMBR
     LADR           4,6                ADR OF LINE TOKENS
     *
     *         NUMERIC VALUE STORAGE TABLE
     *         EACH ENTRY HOLD 10 DIGIT NUMBER
     *         FIRST 27 ENTRIES HOLD VALUES
     *         FOR VARIABLES A - Z.
     *         THE NEXT 70 ENTRIES HOLD
     *         NUMERIC CONSTANT VALUES
     *
     NVT       DA   98X10,X1
     NVTE           1,10
     *
     *         STRING VARIBLE TABLE
     *         EACH ENTRY HOLDS A DISPLACEMENT
     *         INTO THE STRING TABLE
     *
     *         THE INITIAL VALUE FOR A STRING
     *         VARIABLE IS A DEFAULT 1 CHAR
     *         STRING
     *
     *         FIRST 27 FOR A$ - Z$
     *         REMAINING ENTRIES FOR LITERALS
     *
     SVT       DA   98X3,X2            A$-Z$ PLUS 2 FOR ! AND +
     SVTE           1,3
     *
     *         STRING TABLE
     *         HOLDS STRINGS
     *         EACH STRING STARTS WITH A 2 DIGIT
     *         CHARACTER COUNT FOLLOWED BY THE STRING
     *
     *   TSVAL(XXX)
     *          |    | A$
     *          |--->| B$ (XXX) <SVTE>
     *               | C$   |
     *                      |----|
     *                           |
     *                          CCSS...SS <ST>
     *
     ST        EQU  *                  START OF STRING TABLE
     STDEF     DCW  01                 THE DEFAULT STRING
               DCW  @X@
               ORG  *+980
     *
     *         DATA TABLE
     *
     * WILL HAVE TSVAL OR TNVAL TOKENS
     *
     DATA      EQU  *
               ORG  *+500
     NADATA    DCW  000                INDEX TO NEXT AVAIL
     NRDATA    DCW  000                INDEX TO NEXT TO READ
               DCW  0
     *
     *         PROGRAM TOKEN AREA
     *
     PTA       EQU  *                  AREA IS 1000 CHARS PLUS
               ORG  *+1100             A 100 CHAR BUFFER ZONE
     *
     ILT       DCW  000                LINE TABLE INDEX
     INCT      DCW  269                NEXT AVAILABLE CONSTANT
     INSL      DCW  081                NEXT STRING LITERAL
     IPTA      DCW  000                PROG TOKEN INDEX
     PIPTA     DCW  000                PREVIOUS IPTA
     ISTNXT    DCW  003                NEXT AVAILABLE STRING INDEX
     *
     *         COMMAND TABLE
     *
     *
     *                                 <token><value>
     *`                                TOKEN VALUE IS INDEX
     *                                 FROM THEAD TO PARSE ADR
     *
     THEAD     DCW  3                  SIZE OF WORD
               DCW  @LET@              THE WORD
               DCW  PLET               PARSE ADR
               DCW  XLET               EXECUTE ADR
     *
               DCW  2
               DCW  @IF@
               DCW  PIF
               DCW  XIF
     *
               DCW  3
     CREM      DCW  @REM@
               DCW  PREM
               DCW  XREM
     *
               DCW  3
               DCW  @FOR@
               DCW  PFOR
               DCW  XFOR
     *
               DCW  4
               DCW  @NEXT@
               DCW  PNEXT
               DCW  XNEXT
     *
               DCW  4
               DCW  @GOTO@
               DCW  PGOTO
               DCW  XGOTO
     *
               DCW  5
               DCW  @GOSUB@
               DCW  PGOSUB
               DCW  XGOSUB
     *
               DCW  6
               DCW  @RETURN@
               DCW  PRTN
               DCW  XRTN
     *
               DCW  5
               DCW  @PRINT@
               DCW  PPRINT
               DCW  XPRINT
     *
               DCW  4
               DCW  @READ@
               DCW  PREAD
               DCW  XREAD
     *
               DCW  4
               DCW  @DATA@
               DCW  PDATA
               DCW  XDATA
     *
               DCW  3
               DCW  @END@
               DCW  PEND
               DCW  XEND
     *
     TTAIL     DCW  @X@                 END MARKER
     *
     *
     *
     *
     TCMND     DCW  1                TOKEN FOR COMMAND
     TNVAL     DCW  2                NUMERIC VALUE
     TSVAL     DCW  3                STRING VALUE
     TSOP      DCW  4                STRING OPERATOR
     TSSUBS    DCW  5                SUBSTRING FOLLOWS
     TNUMOP    DCW  6                NUMERIC OPERATOR
     *
     *         OPEATORS
     *
     *
     *         NUMERIC OPERATOR TABLE
     *         A NUMERIC TOKEN IS FOLLOWED
     *         BY THE DISPLACEMENT INTO THIS TABLE
     *         FROM OTS TO TOKEN CHARACTER
     *
     OTS       DCW  @%@                CHARACTER (END OF EXP)
               DCW  0                  PRIORITY
               DCW  XEOE               EXECUTE ADR
     *
               DCW  @,@                ANOTHER EOE, 005
               DCW  0
               DCW  XEOE
     *
               DCW  @*@                MULTIPLY, 010
               DCW  3
               DCW  XMUL
     *
               DCW  @/@                DIVIDE, 015
               DCW  3
               DCW  XDIV
     *
     CPLUS     DCW  @(@                PLUS, 020
               DCW  2                  NOTE: ( WITH GET TRANSFORMED
               DCW  XPLUS              TO +
     *
               DCW  @-@                MINUS, 025
               DCW  2
               DCW  XMINUS
     *
               DCW  @<@                LESS THAN, 030
               DCW  1
               DCW  XLT
     *
               DCW  @=@                LOGICAL EQUAL, 035
               DCW  1
               DCW  XEQU
     *
               DCW  @>@                GREATER THAN, 040
               DCW  1
               DCW  XGT
     *
               DCW  @(@                LEFT PAREN, 045
               DCW  0
               DCW  000
     *
               DCW  @+@                CONCAT OP, 50
               DCW  2
               DCW  XCCAT
     *
               DCW  @-@                UNARY MINUS, OP, 55
               DCW  5
               DCW  XUMNUS
     *
     OPEND     DCW  @:@                END OF TABLE
     OLPRN     DCW  045                LEFT PAREN INDEX
     OUMNUS    DCW  055                UNARY MINUS
     OPEOE     DCW  010                EOE OP INDEX = 10
     OLTI      DCW  030                INDEX FOR <
     OEQI      DCW  035                INDEX FOR =
     OGTI      DCW  040                INDEX FOR >
     OCCAT     DCW  050                CONCAT INDEX
     CLT       DCW  @.LT.@
     CEQ       DCW  @.EQ.@
     CGT       DCW  @.GT.@
     *
     *         VECTOR ADRESSES
     *
     ATALPH    DCW  TALPH
     ASLIT     DCW  SLIT
     ATNUM     DCW  TNUM
     AINXP     DCW  INEXP
     ANEXP     DCW  NEXP
     ANV       DCW  NV
     ANOP      DCW  NOP
     AXEOE     DCW  XEOE
     AEXEP     DCW  EXEP
     AUMNUS    DCW  XUMNUS
     *
     ASEXP     DCW  SEXP
     ASS1      DCW  SS1
     ASV       DCW  SV
     AXEESE    DCW  XEESE
     AXCCAT    DCW  XCCAT
     AESEXP    DCW  ESEXP
     *
     *         MISC STUFF
     *
     ZERO      DCW  @0000000000@
     CREG      DCW  000
     CMINUS    DCW  @-@
     CZ        DCW  @Z@
     SQUOTE    DCW  @'@
     BLANK     DCW  @ @
     CDOT      DCW  @.@
     CT        DCW  @T@
     CASN      DCW  @=@
     CCOM      DCW  @,@
     CLPRN     DCW  @(@
     CRPRN     DCW  @)@
     C$        DCW  @$@
     MINUS1    DCW  @00!@
     N269      DCW  269
     N81       DCW  081
     N79       DCW  79
     N026      DCW  026
     N11       DCW  11
     N10       DCW  10
     N9        DCW  9
     N7        DCW  7
     N6        DCW  6
     N5        DCW  5
     N004      DCW  004
     N4        DCW  4
     N003      DCW  003
     N3        DCW  3
     N002      DCW  002
     N2        DCW  2
     N001      DCW  001
     N1        DCW  1
     N00       DCW  00
     N0        DCW  0
     *
     *         FLAGS
     *
     ECP       DCW  0                  END CARD PROCESSED
     ERROR     DCW  0                  PARSING OR EXE ERROR
     *
     *         START OF PROGRAM
     *
     REVMSG    DCW  @**** IBM 1401 TINY BASIC, VERSION 02 *****@
     *
     START     NOP
               CC   1                 UNCOMMENT FOR REAL 1401
               LCA  REVMSG,PRA+45      PRINT REVISION MESSAGE
               W
               CS   299
     *
     *         INITIALIZE
     *
               LCA  CREG,ILT          LINE TABLE INDEX
               LCA  N269,INCT          NEXT AVAIL NUM CONST
               LCA  N81,INSL           STRING STRING LITERAL TABLE INDEX
               LCA  N003,ISTNXT        NEXT STRING INDEX
               LCA  CREG,IPTA          PROG TOKENS INDEX
               LCA  CREG,PIPTA         PREVIOUS TOKEN INDEX
               LCA  N0,ERROR           SET NO ERRORS
               LCA  N0,ECP             SET NOT PROCESSED END CARD
               LCA  CREG,FNSTOS        FOR/NEXT TOP OF STACK
               LCA  CREG,GSSTOS        GOSUB TOP OF STACK INDEX
               LCA  CREG,NADATA        NEXT AVAIL DATA
               LCA  CREG,NRDATA        NEXT READ DATA
               MZ   CT,CPLUS           CREATE A + CHAR
               SW   CARD
     *
     *         READ CARD LOOP
     *
     NEXTR     R                       READ NEXT PROGRAM CARD
               LCA  CARD+80,PRA+81     MOVE CARD TO PRINT AREA
               W                       AND PRINT THE CARD
               CS   299                CLEAR PRINT AREA
     *
               B    BLANKS             GO REMOVE BLANKS
     *
               LCA  CREG,J_TOS         CLEAR JSR STACK
               LCA  CREG,O_TOS         CLEAR OPERATOR TOS
               B    PARSE              AND THE PARSE THE LINE
               BCE  PDONE,ECP,1        IF END CARD PROCESSED, EXECUTE PROGRAM
               B    NOEC,A             IF READER EMPTY, ERROR
               B    NEXTR              GET NEXT CARD
     *
     NOEC      B    ER1                PR NO END CARD MESSAGE
               B    TRYAGN             TELL EM TRY AGAIN
     *
     PDONE     C    N0,ERROR           IF NO ERRORS
               BE   EXEC               EXECUTE PROGRAM
     *
     TRYAGN    B    ER5                ELSE PRINT MESSAGE
               H    START              AND WAIT FOR RESTART
     *
     *
     *         ************* EXECUTE PROGRAM *************
     *
     LOOPCK    DCW  000
     EXEC      LCA  CREG,LOOPCK
               LCA  CREG,ENLN          INITIALIZE NEXT LINE INDEX
               LCA  N0,ECP             SET NOT ZERO WHEN END EXECUTED
     *
     EX_NXT    BSS  E_KILL,B          KILL PROGRAM IF SS1 ON
     *
               A    N001,LOOPCK        LOOP CHECK FOR
               C    LOOPCK,@999@       SIMULATOR
               BE   E_KILL
     *
               LCA  ENLN,X1
               LCA  LADR+X1,X3         GET START OF LINE TOKEN
               LCA  LNO,CLNO           SAVE EXECUTING LINE NUMBER
               SBR  X1,6+X1            PRE-ADVANCE TO NEXT LINE
               LCA  X1,ENLN
     *
               SW   PTA+1+X3
               MCW  PTA+3+X3,J_TO      GET THE EXEC ADR
               SBR  X3,4+X3            INCREMENT TOKEN COUNTER
               B    J_JSR              GO EXEC TOKEN
     *
               BU   EX_FIN              BRANCH IF FAIL
               C    N0,ECP             BR IF END
               BE   EX_NXT             NOT EXCUTED
     *
     EX_FIN    H    START             FINISHED
     *
     E_KILL    B    ER12               PRINT STOP MESSAG
               B    EX_FIN             AND STOP
     *
     ENLN      DCW  000                EX NEXT LINE INDEX
     CLNO      DCW  000                CURRENTLY EXECUTING LINE NO
     *
     *         REMOVE BLANKS FROM INPUT CARD
     *         AND
     *         SET CHARACTER COUNT
     *
     BLANKS    NOP
               SBR  B_RTS+3
               LCA  CREG,X1            CARD FROM INDEX
               LCA  CREG,X2            CARD TO INDEX
               CS   199
               SW   LINE
     *
     B_0       C    CARD+X1,BLANK      NEXT CARD CHAR A BLANK
               BU   B_1                BRANCH IF NOT BLANK
     *
               SBR  X1,1+X1            MOVE TO NEXT CHAR
               C    X1,N79             IF ALL CHARS,
               BE   B_DONE             DONE
               B    B_0                ELSE GO FOR NEXT CHAR
     *
     B_1       C    CARD+X1,SQUOTE        START OF LITERAL?
               BE   B_LIT              BRANCH IF LITERAL
     *
     B_2       MZ   CARD+X1,LINE+X2    MOVE SINGLE CHAR
               MN   CARD+X1,LINE+X2
     *
     B_2A      SBR  X1,1+X1            INCREMENT REGISTER
               SBR  X2,1+X2
               B    B_0                ELSE FOR NEXT CHAR
     *
     B_LIT     LCA  SQUOTE,LINE+X2        MOVE ' TO LINE
               SBR  X1,1+X1            INCREMENT OVER CARD @
     *
               SBR  X2,2+X2            INC LINE INDEX OVER
               LCA  N00,B_LCC              CLEAR LIT CHAR COUNT
               LCA  N00,LINE+X2        @ + LENTH
               LCA  X2,B_LI            SAVE INDEX TO LINE INDEX
               SBR  X2,1+X2
               SW   LINE+X2
     *
     B_LIT1    MZ   CARD+X1,LINE+X2    MOVE SINGLE CHAR
               MN   CARD+X1,LINE+X2
               A    N1,B_LCC           INCREMENT CHAR COUNT
               SBR  X1,1+X1            INCREMENT CARD INDEX
               SBR  X2,1+X2            INCREMENT LINE INDEX
     *
               C    CARD+X1,SQUOTE     NEXT AN ENDING ' SIGN
               BU   B_LIT1             KEEP LOOKING IF NOT
     *
               SBR  X1,1+X1            SKIP OVER ENDING @
               LCA  B_LI,X3            GET INDEX TO COUNT
               LCA  B_LCC,LINE+X3      MOVE COUNT
     *
               B    B_0                ELSE CONTINUE AS NORMAL
     *
     *
     B_DONE    LCA  OTS,LINE+X2       SET END MARKER
               CW   LINE+X2
     B_RTS     B    0000
     *
     B_LI      DCW  000                SAVED X2 LENGTH INDEX
     B_LCC     DCW  00
     *
     *         ****************PARSE A LINE*************
     *
     *         START BY ADDING CARD TO LINE NUMBER TABLE
     *         TABLE HAS TWO ENTRIES:
     *           LINE NUMBER, FIRST LINE TOKEN INDEX
     *
     PARSE     SBR  P_RTS+3
     *
               C    IPTA,PIPTA           IF TOKEN INDEX
               BE   P_A
               BL   P_A                  HAS WRAPPED AROUND
               B    ER14                 REPORT OUT OF MEMORY
               B    TRYAGN               AND QUIT
     *
     P_A       C    LINE+2,CREG        BR IF NOT A LINE NUMBER
               BH   P_0
     *
               C    LINE+5,CREM        IF REM
               BE   P_RTS              SKIP IT
     *
               LCA  ILT,X1             X1= LINE TABLE INDEX
               C    CREG,X1            BRANCH IF FIRST ENTRY
               BE   P_1
     *
               C    LNO-6,LINE&2       IF NEW LINE NO > PREVIOUS
               BH   P_1                CONTINUE
     *
     P_0       B    ER2                ELSE SIGNAL ERROR
               B    P_RTS              RETURN
     *
     P_1       LCA  LINE+2,LNO         MOVE LINE NUMBER
               LCA  IPTA,LADR          MOVE NEXT PROG TOKEN INDEX
               A    N6,ILT             INCREMENT TO NEXT ILT ENTRY
     *
     *         FIND THE COMMAND
     *
     *                                 X2 INDEXES THE TOKEN TABLE
               LCA  CREG,X2            ZERO IT AND
     *
     PNXT      ZA   THEAD+X2,X1        MOVE LETTER COUNT TO X1
               MZ   ZERO,X1            CLEAR ZONE BITS
               A    X1,X2              ADD LETTER COUNT TO X2
               C    LINE+2+X1,THEAD+X2  FOUND COMMAND?
               BE   P2                 BRANCH IF FOUND
     *
               A    N7,X2              SKIP TO NEXT LETTER COUNT
               C    TTAIL,THEAD+X2     AT END OF TOKENS
               BE   PCNF               COMMAND NOT FOUND
               B    PNXT               GO TEST NEXT
     *
     PCNF      B    ER3                PRINT COMMAND NOT FOUND
               B    NEXTR              READ NEXT CARD
     *         COMMAND FOUND
     *
     *         X1 = COMMAND LETTER COUNT
     *         X2 = INDEX OF END OF COMMAND WORD IN TOKEN TABLE
     *
     P2        SBR  X1,3+X1            X1 NOW FIRST CHAR PAST COMMAND
               LCA  IPTA,X3            GET INDEX TO NEXT TOKEN CHAR
               LCA  TCMND,PTA+X3
               LCA  THEAD+6+X2,PTA+3+X3   SET TOKEN EXEC ADR AS TOKEN VALUE
               A    N4,IPTA            INCREMENT TO NEXT TOKEN
     *
               SBR  X2,3+X2            GET THE COMMAND PARSE ADR
               MCW  THEAD+X2,PCMD+3    AND GOTO PARSE IT
     PCMD      B    000                JUMPS TO PARSER FOR THE COMMAND
     *
     *         UPON ENTRY,
     *         X1=NEXT LINE CHARACTER
     *         IPTA=NEXT AVAILABLE PROGRAM TOKEN
     *

     *
     *         PARSE LET
     * LET <nv>=<nexp> | <sv>=<sexp>
     *
     PLET      NOP
               MCW  ANV,J_TO           <nv> ?
               B    J_JSR
               BU   PL_STR
     *
               C    LINE+X1,CASN       = ?
               BU   P_ERR
               SBR  X1,1+X1
     *
               MCW  AINXP,J_TO
               B    J_JSR
               BU   P_ERR             BR IF FAIL
     *
               B    P_RTS
     *
     PL_STR    NOP
               LCA  N0,J_ERR           CLEAR JSR ERROR
               MCW  ASV,J_TO           <sv> ?
               B    J_JSR
               BU   P_ERR              RETURN IF NOT ERROR
     *
               C    LINE+X1,CASN       = ?
               BU   P_ERR
               SBR  X1,1+X1
     *                                 <sexp> ?
               LCA  N0,J_ERR           CLEAR JSR ERROR
               MCW  ASEXP,J_TO
               B    J_JSR
               BU   P_ERR              BR IF FAIL
     *
               C    LINE+X1,CDOT
               BE   P_ERR
     *
               B    P_RTS              ELSE DONE
     *
     *
     *         PARSE IF
     * IF <nexp> THEN GOTO <nexp>
     * IF <nexp>,<nexp>|<sexp><lop><sexp>,<nexp>
     *
     PIF       NOP
               MCW  AINXP,J_TO         <nexp>?
               B    J_JSR
               BU   PF_STR             IF NOT, MAYBE STRING
     *
     PFCNXP    NOP                     PARSE , <nexp>
               C    LINE+X1,CCOM       , ?
               BU   P_ERR
               SBR  X1,1+X1
     *
     PFNEXP    NOP                     PARSE A FINAL <nexp>
               MCW  AINXP,J_TO
               B    J_JSR
               BU   P_ERR
     *
               B    P_RTS              ALL IS GOOD
     *
     PF_STR    LCA  N0,J_ERR           CLEAR JSR ERROR
               MCW  ASEXP,J_TO         <sexp>?
               B    J_JSR
               BU   P_ERR                IF FAIL, RETURN FAIL
     *                                 LOGICAL OPS MUST FOLLOW
               LCA  OLTI,X3            <?
               C    LINE+3+X1,CLT
               BE   PF_SC
               LCA  OEQI,X3
               C    LINE+3+X1,CEQ      =
               BE   PF_SC
               LCA  OGTI,X3
               C    LINE+3+X1,CGT      >
               BE   PF_SC
               LCA  N1,J_ERR           IF NONE OF THE ABOVE,
               B    P_ERR              THEN RETURN ERROR
     *
     PF_SC     LCA  X3,PF_OPI          SAVE LOGICAL OPERATOR
               SBR  X1,4+X1            SKIP OVER OPERATOR
     *
               MCW  ASEXP,J_TO         <sexp>?
               B    J_JSR
               BU   P_ERR              IF FAIL, RETURN FAIL
     *
               LCA  IPTA,X2            SET OPERATOR AS
               LCA  TNUMOP,PTA+X2      POST FIXE
               LCA  PF_OPI,PTA+3+X2
               SBR  X2,4+X2            NEXT TOKEN CHAR
               LCA  X2,IPTA
               B    PFCNXP             NOW, GO THE GOTO PART
     *
     PF_OPI    DCW  000                LOGICAL OPERATOR INDEX
     *
     *         PARSE REM
     *
     PREM      B    P_RTS               NOTHING TO PARSE
     *
     *         PARSE FOR
     * FOR <nv>=<nexp> TO <nexp> STEP <nexp>
     * FOR <nv>=<nexp>,<nexp>,<nexp>
     *
     PFOR      NOP
               MCW  ANV,J_TO           <nv> ?
               B    J_JSR
               BU   P_ERR
     *
               C    LINE+X1,CASN       = ?
               BU   P_ERR
               SBR  X1,1+X1
     *
               MCW  AINXP,J_TO         START VALUE
               B    J_JSR
               BU   P_ERR             BR IF FAIL
     *
               C    LINE+X1,CCOM       , ?
               BU   P_ERR
               SBR  X1,1+X1
     *
               MCW  AINXP,J_TO         LIMIT
               B    J_JSR
               BU   P_ERR
     *
               B    PFCNXP             STEP <nexp>
     *
     *         PARSE NEXT
     *
     PNEXT     B    P_RTS               NOTHING TO PARSE
     *
     *         PARSE GOTO
     * GOTO <nexp>
     *
     PGOTO     NOP
               B    PFNEXP              <nexp> ?
     *
     *         PARSE GOSUB
     * GOSUB   <nexp>
     PGOSUB    NOP
               B    PFNEXP             <nexp>
     *
     *         PARSE RETURN
     *
     PRTN      B    P_RTS               NOTHING TO PARSE
     *
     *         PARSE PRINT
     *
     PPRINT    NOP
               MCW  ASEXP,J_TO
               B    J_JSR
               BU   P_ERR              BR IF FAIL

     *
     *         PARSE READ
     *
     PREAD     C    LINE+X1,OTS        BR IF AT END OF LINE
               BE   P_RTS
     *
     PREAD1    BWZ  P_ERR,LINE+X1,2     INSURE CHAR NOT NUMBER
     *
               MCW  ANV,J_TO           <nv>
               B    J_JSR
               BU   PR_1
               BE   PRNXT              BR IF <nv>
     *
     PR_1      LCA  N0,J_ERR           CLEAR ERROR CODE
               MCW  ASV,J_TO           <sv>
               B    J_JSR
               BU   P_ERR              SYNTAX ERROR IF NOT
     *
     PRNXT     C    LINE+X1,OTS        IF AT END OF LINE
               BE   P_RTS              RETURN
     *
               C    LINE+X1,CCOM       IF NOT COMMA
               BU   P_ERR              THEN SYNTAX ERROR
               SBR  X1,1+X1            SKIP OVER COMMA
               B    PREAD1             AND GET NEXT VALUE
     *
     *         PARSE DATA
     *
     PDATA     C    LINE+X1,OTS        BR IF AT END OF LINE
               BE   P_RTS
     *
     PDATA1    LCA  IPTA,DSIPTA        SAVE TOKEN START
               MCW  ATNUM,J_TO         NUMBER?
               B    J_JSR
               BU   PD_SLT             IF NOT, TRY STRING LITERAL
     *
               LCA  DSIPTA,X3          MOVE TOKEN FROM
               LCA  NADATA,X2          PROGRAM TOKEN AREA
               LCA  PTA+X3,DATA+X2    TO DATA AREA
               LCA  PTA+3+X3,DATA+3+X2   3 CHAR VALUE
               SBR  X2,4+X2
               LCA  X2,NADATA          SAVE NEW DATA INDEX
               LCA  DSIPTA,IPTA        RESTORE IPTA
               B    PDNXT              LOOK FOR NEXT VALUE
     *
     PD_SLT    C    LINE+X1,SQUOTE     STRING LITERAL
               BU   P_ERR              SYNTAX ERROR IF NOT
     *
               LCA  N0,J_ERR           CLEAR JSR ERR
     *
               MCW  ASLIT,J_TO         <slit>?
               B    J_JSR
               BU   P_ERR              SYN ERROR IF NOT
     *
               LCA  DSIPTA,X3          MOVE TOKEN FROM
               LCA  NADATA,X2          PROGRAM TOKEN AREA
               LCA  PTA+X3,DATA+X2    TO DATA AREA
               LCA  PTA+3+X3,DATA+3+X2   3 CHAR VALUE
               SBR  X2,4+X2
               LCA  X2,NADATA          SAVE NEW DATA INDEX
               LCA  DSIPTA,IPTA        RESTORE IPTA
     *
     PDNXT     C    LINE+X1,OTS        IF AT END OF LINE
               BE   P_RTS              RETURN
     *
               C    LINE+X1,CCOM       IF NOT COMMA
               BU   P_ERR              THEN SYNTAX ERROR
               SBR  X1,1+X1            SKIP OVER COMMA
               B    PDATA1             AND GET NEXT VALUE
     *
     DSIPTA    DCW  000                SAVES IPTA
     *
     *         PARSE END CARD
     *
     PEND      NOP
               LCA  ILT,X1             SET MINUS 1 LINE NO
               LCA  MINUS1,LNO+X1      AS END OF TABLE MARKER
               LCA  XEND,LNO+3+X1
               LCA  N1,ECP             SIGNAL LAST CARD PROCESSED
               B    P_RTS              DONE PARSING END
     *
     P_ERR     B    ER4               SYNTAX ERROR
     P_RTS     B    000
     *
     *         PARSE A NUMERIC EXPRESSION
     *         ASSUMES X1 POINTS TO NEXT CARD CHAR
     *         ASSUMES X2 POINTS TO NEXT TOKEN SLOT
     *
     * <nexp> := (<nexp>)<nop> | <nv> <nop>
     * <nop> := ")"|<op><nexp>|<T>
     * <nv> := <nvar>|<ncon>
     * <nvar> := A|B...Y|Z
     * <ncon> : = 1|2..9|0<ncon>
     * <op> := +|-|*|/|<|>|=
     *
     *
     * <nexp>
     * if tos == <T>
     *         rts+
     * if c == "("
     *         push (
     *         c++
     *         jsr <nexp>
     *         jmp <nop>
     * jsr <nv>
     *         if + jmp <nop>
     *         else rts-
     *
     INEXP     LCA  CREG,O_TOS         CLEAR STACK
     *
     NEXP      NOP
     *
     NE_1      C    LINE+X1,CMINUS
               BU   NE_1A
     *
               LCA  O_TOS,X3            GET TOS
               SBR  X3,3+X3             INCREMENT
               LCA  OUMNUS,O_STCK+X3     PUSH LEFT PAREN
               LCA  X3,O_TOS            SAVE NEW TOS
               SBR  X1,1+X1            INCREMENT CARD CHAR INDEX
               MCW  ANEXP,J_TO         <nexp>
               B    J_JSR
               B    J_RTS                <nop>

     NE_1A     C    LINE+X1,CLPRN       NEXT CHAR A LEFT PAREN
               BU   NE_2                BR IF NOT
               LCA  O_TOS,X3            GET TOS
               SBR  X3,3+X3             INCREMENT
               LCA  OLPRN,O_STCK+X3     PUSH LEFT PAREN
               LCA  X3,O_TOS            SAVE NEW TOS
               SBR  X1,1+X1            INCREMENT CARD CHAR INDEX
               MCW  ANEXP,J_TO         <nexp>
               B    J_JSR
               BU   NE_3               BR IF FAIL
               B    NOP                <nop>
     *
     NE_2      MCW  ANV,J_TO           <nv>
               B    J_JSR
               BU   NE_3               FAIL ?
               B    NOP                ELSE <nop>
     NE_3      B    J_RTS              RETURN WITH ERROR
     *
     * <nv>
     *         <talph>
     *              if +
     *                 if c+1 == "$"
     *                    rts -
     *                 create token
     *                  ++src ptr
     *                 rts+
     *         <tnum>
     *              if -
     *                 rts-
     *              create token
     *              ++src ptr
     *              rts+
     *
     NV        NOP
               MCW  ATALPH,J_TO        IF NEXT CHAR A-Z
               B    J_JSR
               BU   TNUM               THEN IS IT A NUMBER?
     *
               C    LINE+1+X1,C$         IF ALPHA, IS NEXT CHAR == $
               BU   NV_A1              IF NOT, THEN OK
     *
               LCA  N1,J_ERR           ELSE FAIL
               B    J_RTS              RETURN
     *
     NV_A1     SBR  X1,1+X1            GOOD ALPHA CHAR
               LCA  IPTA,X3            GET NEXT TOKEN INDEX
               LCA  TNVAL,PTA+X3       TOKEN IS NUM VALUE
               LCA  TA_NDX,PTA+3+X3    MOVE NV TABLE INDEX
               LCA  TA_NDX,X2          CLEAR VALUE TO ZERO
               LCA  ZERO,NVTE+X2
               A    N4,IPTA            INCREMENT TOKEN INDEX
               B    J_RTS              RETURN
     *
     *         TEST FOR AN ALPHA VARIABLE
     *              IF VALID, TA_NDX WILL
     *              CONTAIN INDEX INTO VNT
     *
     TALPH     NOP
               SW   TA_NUM-2           RE-ESTABLISH WORD MARKS
               CW   TA_NUM-1
               LCA  CREG,TA_NUM        CLEAR NUMBER
               MN   LINE+X1,TA_NUM     GET THE NUMBER PORTION
               C    TA_001,TA_NUM
               BL   TA_NO
               BWZ  TA_NO,LINE+X1,2    BR IF NOT A OR B BITS
               BWZ  TA_1,LINE+X1,B     BR IF A AND B BITS
               A    TA_9,TA_NUM        ADD 9 TO TO NUMBER
               BWZ  TA_1,LINE+X1,K     BR IF B BUT NOT A
               A    TA_9,TA_NUM        ADD 9 TO NUMBER
     TA_1      S    N1,TA_NUM
               MZ   N0,TA_NUM
     *
     *                                 TA_NUM NOW 0 TO 26
     *
               C    LINE+1+X1,C$       IF STRING VAR
               BU   TA_N               BRANCH
               SW   TA_NUM+1             ELSE SET WM FOR STRING
               B    J_RTS              AND RETURN
     *
     TA_N      CW   TA_NUM+1           CLEAR WM FOR STRING
               SW   TA_NUM-1           SET WM SUCH THAT
     *                                 TA_NUM IS
     *                                 NOW INDEX INTO VNT
               B    J_RTS              DONE
     *
     TA_NO     LCA  N1,J_ERR           ERROR RETURN
               B    J_RTS
     TA_NUM    DCW  000                NUMBER PORTION OF CHARACTER
     TA_NDX    DC   0                  INDEX IN NVT
     TA_001    DCW  001
     TA_9      DCW  009
     *
     *         TEST FOR NUMBER
     *         X1 = INDEX TO NEXT CARD CHAR
     *
     TNUM      LCA  ZERO,TN_NH         CLEAR
               CW   TN_NH+1
               LCA  CREG,X2            SET DIGIT COUNT == 0
     TN_NXT    C    LINE+X1,CLPRN      BR IF CHAR (
               BE   TN_FK
               BWZ  TN_1,LINE+X1,2     BR IF CHAR IS NUMBER
     *
     TN_FK     C    CREG,X2            DID WE FIND ANY CHARS
               BU   TN_2               BR IF YES
     TN_NO     LCA  N1,J_ERR           SET FAIL
               B    J_RTS              RETURN
     *
     TN_2      C    X2,N0              DONE 9 SHIFTS
               BE   TN_FIN             BR IF 9
               SBR  X2,1+X2            INCREMENT DIGIT COUNT
               LCA  TN_NUM-1,TN_NUM    SHIFT AGAIN
               B    TN_2               AND LOOP
     *
     TN_FIN    SW   TN_NH+1            SET WM FOR 10 CHAR NUM
               LCA  IPTA,X3            GET NEXT TOKEN INDEX
               LCA  TNVAL,PTA+X3       TOKEN IS NUM VAR
               LCA  INCT,PTA+3+X3      MOVE NEXT ENTRY INDEX
               LCA  INCT,X2            GET THAT INDEX
               LCA  TN_NUM,NVTE+X2      MOVE THE VALUE
               A    N10,INCT           MOVE TO NEXT NV ENTRY
               A    N4,IPTA            INCREMENT TOKEN INDEX
               LCA  N0,J_ERR           NOT FAIL
               B    J_RTS              RETURN
     *
     TN_1      MN   LINE+X1,TN_NH+1+X2
               SBR  X1,1+X1            INCREMENT TO NEXT CHAR
               SBR  X2,1+X2            INCREMENT DIGIT COUNT
               B    TN_NXT             GO TEST NEXT CHAR
     *
     TN_NH     DCW  @0000000000@
     TN_NUM    DC   @0000000000@
     *
     * <nop> := <op><nexp>|<T>
     * if char == ")"
     *         pull ops to token area until "("
     *         ++src ptr
     *         save new tos
     *         save new IPTA
     *         jsr <nexp>
     * <findop>
     *         if fail
     *           rts-
     *         else grab token and priority
     *         while tos_op_pr > new_op_pr
     *               pull tos_op
     *         push new_op
     *         ++src ptr
     *         rts+
     * else rts-
     *
     NOP       C    N1,OSTR            IN STRING EXPRESSION
               BU   NO_A               BR IF NOT
               C    CREG,O_TOS          IS STACK EMPTY
               BE   NO_EOE             BR IF EMPTY
     *                                 HAVE A UNARY MINUS OPERATOR
               LCA  AUMNUS,FN_OEA      SET OP EXECUTE ADR
               LCA  IPTA,X2            X2=NEXT TOKEN INDEX
               LCA  TNUMOP,PTA+X2       SET NUM TOKEN
               LCA  FN_OEA,PTA+3+X2    VALUE = OP EXECUTE ADR
               SBR  X2,4+X2            INCRMENT TOKEN INDEX
               LCA  X2,IPTA            SAVE TOKEN INDEX
     *
               B    NO_EOE
     *
     NO_A      C    LINE+X1,CLPRN      IS THIS A (
               BE   NO_NO              BR IF NOT
     *
     NO_0      LCA  IPTA,X2            X2=NEXT TOKEN INDEX
               LCA  O_TOS,X3           X3=TOS INDEX
               C    LINE+X1,CRPRN      CHAR =")"
               BU   FINDOP             BR IF NOT
     *                                 PAREN PULL LOOP
     NO_1      C    CREG,X3            BR IF STACK EMPTY
               BE   NO_NO
               C    O_STCK+X3,OLPRN     "(" ?
               BU   NO_2               BR IF NOT
     *
               S    N3,X3              DECREMENT TOS
               MZ   ZERO,X3
               LCA  X3,O_TOS
               SBR  X1,1+X1            INCREMENT LINE PTR
               LCA  X2,IPTA            SAVE TOKEN POINTER
               B    J_RTS
     *
     NO_2      LCA  X2,IPTA            TEMP SAVE X2
               LCA  O_STCK+X3,X2       GET OP INDEX
               LCA  OTS+4+X2,FN_OEA    GRAB THE EXECUTE ADR
               LCA  IPTA,X2            RESTSORE X2
               LCA  TNUMOP,PTA+X2       SET TOKEN TYPE
               LCA  FN_OEA,PTA+3+X2    VALUE = OP EXECUTE ADR
               SBR  X2,4+X2            INCREMENT TOKEN INDEX
               S    N3,X3              DECREMENT TOS
               MZ   ZERO,X3
               C    CREG,X3            IF STACK EMPTY
               BE   NO_NO              THEN NO { FOUND
               B    NO_1               ELSE LOOP
     *
     *         FIND OP IN TABLE
     *
     FINDOP    NOP
     *
               LCA  OLTI,X3            SPECIAL CASE OPS
               C    LINE+3+X1,CLT      <
               BE   FN_SC
               LCA  OEQI,X3
               C    LINE+3+X1,CEQ      =
               BE   FN_SC
               LCA  OGTI,X3
               C    LINE+3+X1,CGT      >
               BU   FN_REG
     *
     FN_SC     SBR  X1,3+X1            INCREMENT MINUS 1
               B    FN_FND             WE FOUND A SPECIAL CASE
     *
     FN_REG    LCA  CREG,X3            X3=0
     *
     FN_1      C    OTS+X3,OPEND       BR IF NOT AT
               BE   NO_NO              END OF TABLE
     *
     FN_2      NOP
               C    LINE+X1,OTS+X3     BR IF
               BE   FN_FND             OP FOUND
               SBR  X3,5+X3            ELSE INCREMENT
               B    FN_1               AND TRY NEXT
     *
     FN_FND    LCA  OTS+1+X3,FN_PRI    SAVE NEW OP PRI
               LCA  X3,FN_TOK          AND NEW OP INDEX
     *
               LCA  O_TOS,X3           GET TOS INDEX
     FN_PUL    C    CREG,X3            IF STACK IS EMPTY
               BE   NO_PSH             PUSH NEW OP
     *
               LCA  O_STCK+X3,X2       GET STACK OP INDEX
               C    OTS+1+X2,FN_PRI    TOS PR : NOP PR
               BH   NO_PSH
     *                                 PULL OP
               LCA  OTS+4+X2,FN_OEA    GRAB OP EXECUTE ADR
               LCA  IPTA,X2            X2=NEXT TOKEN INDEX
               LCA  TNUMOP,PTA+X2       SET NUM TOKEN
               LCA  FN_OEA,PTA+3+X2    VALUE = OP EXECUTE ADR
               SBR  X2,4+X2            INCRMENT TOKEN INDEX
               LCA  X2,IPTA            SAVE TOKEN INDEX
               C    CREG,X3            STACK EMPTY
               BE   NO_NO              BR IF NOT
               S    N3,X3              DECREMENT STACK INDEX
               MZ   ZERO,X3
               B    FN_PUL             NEXT
     *
     NO_PSH    C    FN_TOK,OPEOE       WAS TOKEN EOE (, OR .)
               BH   NO_EOE             BR IF YES, DONT INC LINE PTR
     *
               SBR  X3,3+X3            PUSH NEW OP
               LCA  FN_TOK,O_STCK+X3
     *
     NO_FIN    LCA  X3,O_TOS           SAVE NEW TOS
               SBR  X1,1+X1            INCREMENT TO NEXT CHAR
               MCW  ANEXP,J_TO         AND DO
               B    J_JSR              <nexp>
               B    J_RTS              RETURN
     *
     NO_EOE    LCA  IPTA,X2            X2=NEXT TOKEN INDEX
               LCA  TNUMOP,PTA+X2       SET NUM TOKEN
               LCA  AXEOE,PTA+3+X2     VALUE = EOE EXECUTE ADR
               SBR  X2,4+X2            INCRMENT TOKEN INDEX
               LCA  X2,IPTA            SAVE TOKEN INDEX
               B    J_RTS              DONE
     *
     NO_NO     C    N1,OSTR            SUBSTRING )?
               BE   NO_EOE             SET EOE IF YES
     *
     NO_NO1    LCA  N1,J_ERR           RETURN FAIL
               B    J_RTS
     *
     FN_OEA    DCW  000
     SVVVT     DCW  000
     FN_TOK    DCW  000                NEW TOKEN VALUE
     FN_PRI    DCW  1                  NEW TOKEN PRIORITY
     *
     O_TOS     DCW  000                OPT TOP OF STACK INDEX
     O_STCK    DA   10X3,X3            OPERATOR STACK
     *
     *         STRING EXPRESSION
     * <sexp> := <string><sop>
     * <string> := <ss1>|<ss1>(<nexp>,<nexp>)
     * <ss1> := <slit>|<nexp>|<sv>
     * <sv>:= A$...Z$
     * <slit>:=' XXX '
     * <sop> := +<sexp>|<T>
     *
     * SEXP
     *  ENTERED WITH X1 = NEXT LINE CHAR
     *
     OSTR      DCW  0                  1 = PROCESSING STRING EXPRESSION
     *
     SEXP      MCW  ASS1,J_TO          <ss1>?
               B    J_JSR
               BU   J_RTS              IF NOT, FAIL
     *
               C    LINE+X1,CLPRN      (?
               BU   SXOP               BR IF NO SUBSTRING
     *
               LCA  IPTA,X3            SET SUBSTRING
               LCA  TSSUBS,PTA+X3      FOLLOWS TOKEN
               SBR  X3,1+X3
               LCA  X3,IPTA
     *
               SBR  X1,1+X1            INCREMENT OVER (
               LCA  N0,OSTR
               MCW  AINXP,J_TO
               B    J_JSR
               BU   J_RTS              IF NOT, FAIL
     *
               C    LINE+X1,CCOM       COMMA?
               BU   SEXPF              BAD SYNTAX
     *
               SBR  X1,1+X1            INCREMENT OVER ,
               LCA  N1,OSTR
               MCW  AINXP,J_TO
               B    J_JSR
               LCA  N0,OSTR
               BU   J_RTS              IF NOT, FAIL
     *
               C    LINE+X1,CRPRN      )?
               BU   SEXPF              IF NOT FAIL
               SBR  X1,1+X1
     *
     SXOP      B    SOP                <sop>
     *
     SEXPF     LCA  N1,J_ERR
               B    J_RTS              RETURN FAIL
     *
     * <sop> := <t>|+ <sexp>
     *
     SOP       C    LINE+X1,OTS        AT END OF STMT
               BE   SOP_1              BR IF NOT
               C    LINE+X1,CCOM       MAYBE A COMMA?
               BE   SOP_1
               C    LINE+X1,CDOT       START OF LOGICAL OPERATOR?
               BU   SOP_TP             BR IF NOT
     SOP_1     LCA  IPTA,X3            SET TOKENS
               LCA  TSOP,PTA+X3        STRING OP TOKEN
               LCA  AXEESE,PTA+3+X3    XESOE EXECUTE ADR
               SBR  X3,4+X3            INCREMENT
               LCA  X3,IPTA
               B    J_RTS
     *
     SOP_TP    C    LINE+X1,CPLUS       IS IT A +
               BU   SEXPF              FAIL IF NOT
               LCA  IPTA,X3            SET TOPENS
               LCA  TSOP,PTA+X3        STRING OP TOKEN
               LCA  AXCCAT,PTA+3+X3    CONCAT OP
               SBR  X3,4+X3            INCREMENT
               LCA  X3,IPTA
               SBR  X1,1+X1
               B    SEXP              GO <sexp>
     *
     * <sv> = A$.....Z$
     *
     *
     SV        MCW  ATALPH,J_TO
               B    J_JSR
               BU   J_RTS                BR IF FAIL
     *
               C    LINE+1+X1,C$       $ ?
               BE   SV_1
               LCA  N1,J_ERR           IF NOT,
               B    J_RTS              ERROR RETURN
     *
     SV_1      SBR  X1,2+X1            SKIP OVER A$
               LCA  TA_NUM,X2          NUM = 0-26
               A    TA_NUM,X2          MULTIPLY BY 3
               A    TA_NUM,X2          FOR SVT INDEX
     *
               LCA  CREG,SVTE+X2       SET DEFAULT STRING
               LCA  IPTA,X3            NEXT TOKEN
               LCA  TSVAL,PTA+X3       SET TOKEN TYPE
               LCA  X2,PTA+3+X3        SET TOKEN VALUE
               SBR  X3,4+X3
               LCA  X3,IPTA
     *
               B    J_RTS              DONE
     *
     * <ss1>:=<slit>|<nexp>|<sv>
     *
     SS1       C    LINE+X1,SQUOTE     '?
               BU   SS_SV              IF NOT, TRY <sv>
     *
     *         <slit>
     *
     SLIT      LCA  INSL,X3            NEXT SVT INDEX
               LCA  X3,SINSL           SAVE FOR TOKEN
               LCA  ISTNXT,SVTE+X3     SET ST INDEX
               SBR  X3,3+X3            INCREMENT
               LCA  X3,INSL
     *
               SBR  X1,1+X1            INCREMENT OVER '
               LCA  CREG,X2            INSURE X2 CLEAR
               LCA  LINE+1+X1,X2       GET CHAR COUNT
               SBR  X1,1+X1            INCREMENT OVER COUNT
     *
               LCA  ISTNXT,X3          INDEX TO NEXT ST CHAR
               SBR  X3,2+X3
               LCA  X2,ST+X3           SET COUNT INTO ST
               CW   X2-1
     *
               A    X2,X3              ADD COUNT TO INDEXES
               A    X2,X1              AND
               LCA  LINE+X1,ST+X3      MOVE THE LITERAL
               SBR  X1,1+X1            NEXT LINE CHAR
               LCA  X3,ISTNXT          SAVE NEW ST INDEX
     *
               LCA  IPTA,X3            NEXT PTA
               LCA  TSVAL,PTA+X3       SET STRING VALUE TOKEN
               LCA  SINSL,PTA+3+X3     AND SVT INDEX
               SBR  X3,4+X3            INCREMENT INDEX
               LCA  X3,IPTA            AND SAVE IT
     *
               B    J_RTS              RETURN
     *
     SS_SV     LCA  N0,J_ERR           CLEAR JSR ERROR
               MCW  ASV,J_TO           <sv>
               B    J_JSR
               BE   J_RTS              RETURN PASS
     *
               LCA  N1,OSTR
               MCW  AINXP,J_TO        <nexp>
               B    J_JSR
               LCA  N0,OSTR
               B    J_RTS              RETURN IF <nexp>

     SINSL     DCW  000                INDEX INTO SVT
     *
     *         EXECUTE COMMANDS
     *
     XLET      NOP                     LET
               LCA  PTA+3+X3,XL_ASN    GET ASSIGN VALUE INDEX
               C    PTA+X3,TSVAL       BR IF THIS IS A
               BE   XSLET              STRING ASSIGNMENT
     *
               SBR  X3,4+X3            INCREMENT TO NEXT TOKEN
               MCW  AEXEP,J_TO         EVALUATE EXPRESSION
               B    J_JSR
     *
               LCA  XL_ASN,X1          EXPRESSION RESULT
               LCA  EE_NV1,NVTE+X1     TO NVT
               B    J_RTS              DONE
     *
     XL_ASN    DCW  000
     *
     XSLET     SBR  X3,4+X3            INCREMENT TO NEXT TOKEN
               CS   299                CLEAR STRING WORK AREA
               SW   SWA
               LCA  N00,SWA+1          SET CHAR COUNT = 0
               LCA  CREG,SWAI          SET START OF WORK AREA
               LCA  CREG,ISWAI         AND INITIAL SWA (COUNT)
               MCW  AESEXP,J_TO        EXECUTE THE STRING EXPRESSION
               B    J_JSR
     *
               LCA  XL_ASN,X2           ASSIGN NEXT ST CHAR INDEX
               LCA  ISTNXT,SVTE+X2     TO THE VARIABLE
     *
               LCA  X3,IPTA            PRESERVE X3
               LCA  N001,X2
               LCA  SWA+X2,ESLCNT       GRAB COUNT FROM SWA
               SBR  X2,1+X2
               LCA  CREG,X1            X1 = CHAR MOVE COUNTER
               LCA  ISTNXT,X3          X2 = CHAR MOVE INDEX
               LCA  ESLCNT,ST+2+X3     MOVE COUNT TO ST
               SW   ST+3+X3
               SBR  X3,2+X3            INCREMENT
     *
     ESL_1     MZ   SWA+X2,ST+1+X3       MOVE CHAR BY CHAR
               MN   SWA+X2,ST+1+X3
               SBR  X2,1+X2            INCREMENT
               SBR  X3,1+X3
               SBR  X1,1+X1
               C    X1,ESLCNT          IF NOT MOVED ALL CHARS
               BU   ESL_1              LOOP
     *
               LCA  X3,ISTNXT          SAVE NEXT ST CHAR INDEX
               LCA  IPTA,X3            RESTORE X3
     *
               B    J_RTS              DONE
     *
     ESLCNT    DCW  00
     *
     XIF       C    PTA+X3,TSVAL      BRANCH IF THIS IS A
               BE   XSIF               STRING COMPARE
     *
               MCW  AEXEP,J_TO         EVALUATE EXPRESSION
               B    J_JSR
     *
               C    ZERO,EE_NV1        IF FALSE,

               BE   J_RTS              CONTINUE TO NEXT LINE
               B    GTLINE             ELSE GOTO DESIGNATED LINE
     *
     XSIF      SW   SWA
               LCA  N00,SWA+1          SET CHAR COUNT = 0
               LCA  CREG,SWAI
               LCA  CREG,ISWAI         AND INITIAL SWA (COUNT)
               MCW  AESEXP,J_TO        EVALUATE THE LEFT SIDE
               B    J_JSR
     *
               LCA  SWAI,X1            INDEX TO NEXT SWA CHAR
               SBR  X1,2+X1
               LCA  X1,XSIFS1
               LCA  N00,SWA+1+X1       APPEND RIGHT STRING
               LCA  X1,SWAI           AFTER LEFT STRING
               LCA  X1,ISWAI
               MCW  AESEXP,J_TO        EVALUATE THE LEFT SIDE
               B    J_JSR
     *
               LCA  XSIFS1,X1          DO THE COMPARE
               LCA  SWAI,X2
               C    SWA-1+X1,SWA+1+X2
     *                                 BRANCH ON RESULTS
               BL   SFSCLT             <
               BE   SFSCEQ             =
     *
               C    PTA+3+X3,OLTI      >
               B    XSIFR
     *
     SFSCLT    C    PTA+3+X3,OGTI      COMPARE RESULT WITH REQUESTED
               B    XSIFR
     SFSCEQ    C    PTA+3+X3,OEQI
     *
     XSIFR     SBR  X3,4+x3            INCREMENT TOKEN
               BU   J_RTS              IF NOT REQUESTED, RETURN
               B    GTLINE             ELSE GOTO
     *
     XSIFS1    DCW  000                INDEX TO STRING 1
     XFSC      DCW  0                  STRING COMPARE FLAG
     *
     XREM      B    J_RTS              REM
     *
     XFOR      LCA  FNSTOS,X2
     *
               C    X2,FNMXST          IF STACK OVERFLOW
               BU   XF_1
               B    ER13               STOP
               B    J_RTS
     *
     XF_1      LCA  ENLN,FNNLI+X2      LINE AFTER FOR
     *
               LCA  PTA+3+X3,FNASN+X2  ASSIGN NV INDEX
     *
               SBR  X3,4+X3            INCREMENT TO NEXT TOKEN
               MCW  AEXEP,J_TO         EVALUATE EXPRESSION
               B    J_JSR              FOR START VALUE
     *
               LCA  FNSTOS,X2
               LCA  FNASN+X2,X1        PUT RESULT INTO NVT
               LCA  EE_NV1,NVTE+X1     TO NVT
     *
               MCW  AEXEP,J_TO         LIMIT EXPRESSION
               B    J_JSR
               LCA  FNSTOS,X2
               LCA  EE_NV1,FNLMT+X2
     *
               MCW  AEXEP,J_TO         STEP EXPRESSION
               B    J_JSR
               LCA  FNSTOS,X2
               LCA  EE_NV1,FNSTP+X2
     *
               SBR  X2,26+X2            INCREMENT TOS
               LCA  X2,FNSTOS
     *
               B    J_RTS              DONE
     *
     FNSTOS    DCW  000
     FNMXST    DCW  260                MAX STACK INDEX
     FNSTCK    DA   10X26,X2            FOR/NEXT STACK
     FNNLI          1,3                LINE INDEX AFTER FOR
     FNASN          3,6                THE ASSIGN TO VAR
     FNLMT          6,16                LIMIT
     FNSTP          16,26                STEP
     *
     XNEXT     C    CREG,FNSTOS        IF STACK EMPY
               BE   FN_BAD             ERROR
     *
               LCA  FNSTOS,X2          GET TOS INDEX
               S    N026,X2              DECREMENT
               MZ   ZERO,X2
     *
               LCA  FNASN+X2,X1        GET NV INDEX
               A    FNSTP+X2,NVTE+X1   ADD STEP TO NV
               BWZ  FN_1B,NVTE+X1,K    IF VAR NOT NEG
               MZ   ZERO,NVTE+X1       FIX THE DAMN ZONE
     FN_1B     BWZ  FNDTST,FNSTP+X2,K  IF STEP NEG, DO DEC TEST
     *                                 ELSE DO INC TEST
               BWZ  FN_2A,NVTE+X1,K     IF VAR NEG, SEE IF LIMIT NEG
     *
     *         TEST INCREMENT WITH NON NEG VAR AND LIMIT
     *
     FN_1A     C    NVTE+X1,FNLMT+X2   IF NOT OVER LIMIT
               BH   FNCONT             CONTINUE
               BE   FNCONT
               B    FNDONE             ELSE DONE LOOPING
     *
     FN_2A     BWZ  FN_3,FNLMT+X2,K    BR IF LIMIT ALSO NEGATIVE
               B    FN_1A              DO THE TEST
     *
     *         TEST INCREMENT WITH NEG VAR AND LIMIT
     *
     FN_3      C    NVTE+X1,FNLMT+X2   IF NOT OVER LIMIT
               BH   FNCONT             CONTINUE
               BE   FNCONT
               B    FNDONE             ELSE DONE LOOPING
     *
     FNDTST    BWZ  FN_3B,NVTE+X1,K     BR IF VAR NEG
     *
     *         TEST DECREMENT WITH NON NEG VAR AND LIMIT
     *
     FN_3A     C    NVTE+X1,FNLMT+X2   IF NOT OVER LIMIT
               BL   FNCONT             CONTINUE
               BE   FNCONT
               B    FNDONE             ELSE DONE LOOPING
     *
     FN_3B     BWZ  FN_4,FNLMT+X2,K
               B    FN_3A
     *
     *         TEST DECREMENT WITH NEG VAR AND LIMIT
     *
     FN_4      C    NVTE+X1,FNLMT+X2   IF NOT OVER LIMIT
               BH   FNCONT             CONTINUE
               BE   FNCONT
               B    FNDONE             ELSE DONE LOOPING
     *
     FNDONE    LCA  X2,FNSTOS          ELSE SAVE NEW TOS
               B    J_RTS              EX NEXT STMT AFTER NEXT
     *
     FNCONT    LCA  FNNLI,ENLN         NEXT STMT IS STMT AFTER FOR
               B    J_RTS              DONE
     *
     FN_BAD    B    ER8
               B    J_RTS
     *
     XGOTO     B    GTLINE             GOTO
     *
     XGOSUB    LCA  GSSTOS,X2          PUSH NEXT LINE INDEX
     *
               C    X2,GSSMAX          IF STACK OVERFLOW
               BU   XGS_1
               B    ER13                ERROR
               B    J_RTS
     *
     XGS_1     LCA  ENLN,GSSLTI+X2     ONTO GOSUB STACK
               SBR  X2,3+X2            INCREMENT STACK INDEX
               LCA  X2,GSSTOS
               B    GTLINE             NOW GOTO THE LINE
     *
     XRTN      C    CREG,GSSTOS        BR IF STACK NOT EMPTY
               BU   XR_1
               B    ER7                RETURN WITHOUT GOSUB
     *
     XR_1      LCA  GSSTOS,X2          DECREMENT TOS
               S    N3,X2
               MZ   ZERO,X2
               LCA  X2,GSSTOS
     *
               LCA  GSSLTI+X2,ENLN     SET NEXT EX LINE INDED
               B    J_RTS              AND DONE.
     *
     GSSMAX    DCW  030                MAX STACK INDEX
     GSSTOS    DCW  000
     GSSTCK    DA   10X3,X2
     GSSLTI         1,3
     GTLINE    MCW  AEXEP,J_TO         EVALUATE EXPRESSION
               B    J_JSR
               MCW  EE_NV1,GO_LNO      SET A THREE DIGIT LINE NUMBER
     *
               LCA  CREG,X1            START AT TOP OF TABLE
     *
     GTNXTL    C    X1,ILT             BR AT END OF TABLE
               BE   GTLNF
               C    GO_LNO,LNO+X1      BR IF AT THE RIGHT LINE
               BE   GTLFND
               BH   GTLNF              BR IF IF NOT FOUND
               SBR  X1,6+X1            INCREMENT TO NEXT LINE
               B    GTNXTL             AND TRY IT
     *
     GTLFND    LCA  X1,ENLN            SET NEXT LINE TO EXECUTE
               B    J_RTS
     *
     GTLNF     B    ER6                LINE NOT FOUND
               B    J_RTS
     GO_LNO    DCW  000

     XPRINT    NOP
               CS   299                CLEAR STRING WORK AREA
               SW   SWA
               LCA  N00,SWA+1          SET CHAR COUNT = 0
               LCA  CREG,SWAI
               LCA  SWAI,ISWAI
               MCW  AESEXP,J_TO        EXECUTE THE STRING EXPRESSION
               B    J_JSR
               W
               B    J_RTS
     *
     XREAD     C    NRDATA,NADATA      INSURE DATA AVAILABLE
               BU   XR1
               B    ER10
               B    J_RTS
     *
     XR1       LCA  NRDATA,X1
               C    DATA+X1,PTA+X3   INSURE SAME TYPE
               BE   XR2
               B    ER11
               B    J_RTS
     *
     XR2       C    DATA+X1,TNVAL    BRANCH IF NOT NUMBER
               BU   XR_S
     *
               LCA  DATA+3+X1,XDIND    NVT INDEX OF DATA VALUE
               LCA  PTA+3+X3,X2        NVT INDEX OF VAR VALUE
               LCA  XDIND,X1
     *
               LCA  NVTE+X1,NVTE+X2    MOVE THE VALUE
               B    XRNXT
     *
     XR_S      C    DATA+X1,TSVAL    IF NOT STRING TOKEN
               BU   J_RTS              THEN DONE
     *
               LCA  DATA+3+X1,XDIND    NVT INDEX OF DATA VALUE
               LCA  PTA+3+X3,X2        NVT INDEX OF VAR VALUE
               LCA  XDIND,X1
     *
               LCA  SVTE+X1,SVTE+X2    MOVE THE VALUE
               B    XRNXT
     *
     XRNXT     SBR  X3,4+X3             NEXT TOKEN
               A    N4,NRDATA           NEXT DATA
     *
               C    PTA+X3,TCMND      NEXT TOKEN A COMMAND
               BE   J_RTS              MEANS WE ARE DONE
     *
               B    XREAD              ELSE READ NEXT
     *
     XDIND     DCW  000
     XDATA     B    J_RTS
     *
     XEND      LCA  N1,ECP             END
               B    J_RTS
     *
     XEOE      H    START                  SHOULD NOT GET EXECUTED
     *
     XMUL      LCA  EE_NV2,M_Y         *
               LCA  EE_NV1,M_X
               B    M_MULT
               LCA  M_PROD,EE_NV1
               B    J_RTS
     *
     XDIV      LCA   EE_NV2,D_Y         \
               LCA   EE_NV1,D_X
               B    D_DIV
               LCA  D_QUOT,EE_NV1
               LCA  D_REM,EE_NV2
               B    J_RTS
     *
     XPLUS     A    EE_NV2,EE_NV1
               B    J_RTS
     *
     XMINUS    S    EE_NV2,EE_NV1      MINUS
               B    J_RTS
     *
     XUMNUS    LCA  ZERO,EE_NV1       UNARY MINUS
               S    EE_NV2,EE_NV1
               B    J_RTS
     *
     XLT       BWZ  XLTN1,EE_NV2,K     BR IF V2 IS NEGATIVE
     XLT_1     C    EE_NV2,EE_NV1      < FOR NON-NEGATIVE PAIR
               LCA  ZERO,EE_NV1
               BE   J_RTS
               BH   J_RTS
               A    N1,EE_NV1
               B    J_RTS
     *
     XLTN1     BWZ  XLTN2,EE_NV1,K       BR IF V1 IS NEGATIVE
               B    XLT_1
     *
     XLTN2     C    EE_NV2,EE_NV1      < FOR NEGATIVE PAIR
               LCA  ZERO,EE_NV1
               BE   J_RTS
               BL   J_RTS
               A    N1,EE_NV1
               B    J_RTS
     *

     XEQU      NOP                     =
               C    EE_NV2,EE_NV1
               LCA  ZERO,EE_NV1
               BU   J_RTS
               A    N1,EE_NV1
               B    J_RTS

     XGT       BWZ  XGTN1,EE_NV2,K     BR IF V2 IS NEGATIVE
     XGT_1     C    EE_NV2,EE_NV1      > FOR NON-NEGATIVE PAIR
               LCA  ZERO,EE_NV1
               BE   J_RTS
               BL   J_RTS
               A    N1,EE_NV1
               B    J_RTS
     *
     XGTN1     BWZ  XGTN2,EE_NV1,K       BR IF V1 IS NEGATIVE
               B    XLT_1
     *
     XGTN2     C    EE_NV2,EE_NV1      > FOR NEGATIVE PAIR
               LCA  ZERO,EE_NV1
               BE   J_RTS
               BH   J_RTS
               A    N1,EE_NV1
               B    J_RTS
     *
     *         EXECUTE EXPRESSION
     *         X3 = TOKEN INDEX
     *
     EXEP      LCA  CREG,EE_TOS        ZERO TOS
     *
     EXP_1     C    PTA+X3,TNVAL       <nv> ?
               BE   EE_PSH
               C    PTA+X3,TNUMOP       <op> ?
               BE   EE_OP
     *
     EXP_E1    H    START             PROGRAM ERROR
     *
     EE_PSH    LCA  PTA+3+X3,X1        X1=NVT INDEX
               LCA  EE_TOS,X2
               LCA  NVTE+X1,EESENT+X2    NUMBER VALUE -> STACK
               SBR  X2,10+X2           INCREMENT TOS
               LCA  X2,EE_TOS
               SBR  X3,4+X3            INCREMENT TO NEXT TOKEN
               B    EXP_1              LOOP WHILE <nv>
     *
     EE_OP     MCW  PTA+3+X3,J_TO      OP EXECUTE CODE
               SBR  X3,4+x3            INCREMENT TO NEXT TOKEN
     *
               C    J_TO,AXEOE         BR IF
               BE   EE_FIN             END OF EXPRESSION
     *
     EE1       LCA  EE_TOS,X2
               S    N10,X2
               MZ   ZERO,X2
               LCA  EESENT+X2,EE_NV2    PULL FIRST <nv>s
     *
               C    J_TO,AUMNUS        BR NOT OP UNARY MINUS
               BE   EE2
     *
               S    N10,X2             PULL SECOND OP
               MZ   ZERO,X2
               LCA  EESENT+X2,EE_NV1
     *
     EE2       LCA  X2,EE_TOS          SAVE NEW TOS
               B    J_JSR              EXECUTE OPERATOR
               BU   B_RTS              IF FAIL, RETURN
     *                                 RESULT IN NV1
               BWZ  EENF,EE_NV1,K      IF NOT MINUS, FIX + ZONE
               MZ   ZERO,EE_NV1
     *
     EENF      LCA  EE_TOS,X2
               LCA  EE_NV1,EESENT+X2   PUSH NV1 ONTO STACK
               SBR  X2,10+X2
               LCA  X2,EE_TOS
               B    EXP_1              TEST NEXT TOKEN
     *
     EE_FIN    C    EE_TOS,N10         STACK SHOULD HAVE ONE VALUE
               BU   EXP_E2             RETURN: EE_NV1 HAS VALUE
               LCA  CREG,X2
               LCA  EESENT+X2,EE_NV1
               B    J_RTS
     *
     EXP_E2    H    START             PRGRAM FAIL
     *
     EE_TOS    DCW  000                TOP OF STACK
     EE_NV1    DCW  @0000000000@       NUMERIC VALUE 1
     EE_NV2    DCW  @0000000000@       NUMERIC VALUE 2
     EESTK     DA   10X10,X2
     EESENT         1,10
     *
     *         STRING EXECUTIONS
     *
     *
     XCCAT     B    ESEXP             CONCAT NEXT STRING
     *
     XEESE     B    J_RTS              END OF STRING EXPRESSION
     *
     ESEXP     NOP
               C    PTA+X3,TSVAL       IS TOKEN STRING VALUE
               BU   ESXNE              IF NOT, THEN NUMERIC EXPRESSION
               LCA  PTA+3+X3,X2        GET INDEX TO SVTE
               SBR  X3,4+X3            INCREMENT TOKEN INDEX
     *
               LCA  X2,ESSVTI          SAVE INDEX TO SVTE
     *
               LCA  SVTE+X2,X1         X1 = INDEX INTO ST
               LCA  ST+2+X1,SSLN         GET SOURCE STRING COUNT
               LCA  SSLN,SMSL          SET AS MOVE STRING LENGTH
               SBR  X1,3+X1            INCREMENT TO START OF STRING
               LCA  X1,SSTI            SAVE SOURCE STRING INDEX
               LCA  SSTI,SMSSTI         SET AS MOVE STRING INDEX
     *
     ES_2      C    PTA+X3,TSSUBS      SUBSTRING FOLLOW?
               BU   ES_MS0             IF NOT, BRANCH
     *
     *         SUBSTRING PROCESSING
     *
               SBR  X3,1+X3            SKIP OVER TOKEN
               MCW  AEXEP,J_TO         EXECUTE EXPRESSION
               B    J_JSR
               MCW  EE_NV1,SMSSTI      SAVE AS MOVE START
     *
               MCW  AEXEP,J_TO         EXECUTE EXPRESSION
               B    J_JSR
               MCW  EE_NV1,SMSL        SAVE AS MOVE LENGTH
     *
               C    N001,SMSSTI        TEST START <= 0
               BL   ESSER
     *
               C    N001,SMSL          TEST LENGTH <=0
               BL   ESSER
     *
               S    N001,SMSSTI        DECREMENT START BY 1
               MZ   ZERO,SMSSTI
               LCA  SMSSTI,X1          IS MOVE START
               A    SMSL,X1            PLUS LENGTH
               C    X1,SSLN            >= SOURCE LENGTH
               BE   ESS_1
               BH   ESS_1
               B    ESSER              ERROR IF NO
     *
     ESS_1     A    SSTI,SMSSTI        ADD SOURCE INDEX TO START
               B    ES_MS0             AND DO THE MOVE
     *
     ESSER     B    ER9                SUBSTRING ERROR
               B    J_RTS
     *
     ESXNE     MCW  AEXEP,J_TO         EXECUTE EXPRESSION
               B    J_JSR
               LCA  ISTNXT,X1          USING ST AS WORK AREA.
               LCA  ESNEEW,ST+13+X1    MOVE EDIT WORD
               SW   ST+3+X1            SET WM FOR COUNT
               MCE  EE_NV1,ST+13+X1    MOVE AND EDIT
               SW   ST+3+X1
     *
               LCA  N11,SSLN           SET THE LENGTHS
               LCA  SSLN,SMSL
               SBR  X1,3+X1
               LCA  X1,SSTI           AND THE INDEXES
               LCA  SSTI,SMSSTI
               B    ES_2

     *              @NN1234567890-@
     ESNEEW    DCW  @11        0 -@
     *
     *   STRING EXECUTION VARIABLES
     *
     ESSVTI    DCW  000                INDEX INTO SVT
     SSLN      DCW  00                 SOURCE STRING LENGTH
     SSTI      DCW  000                SOURCE STRING INDEX
     *
     SMSL      DCW  00                 MOVE STRING LENGTH
     SMSSTI    DCW  000                MOVE STRING INDEX
     *
     SWAI      DCW  000                STRING WORK AREA INDEX
     ISWAI     DCW  000                INITIAL SWA INDEX
     *
     *   MOVE STRING FROM SOURCE TO WORK AREA
     *
     ES_MS0    NOP
               LCA  X3,IPTA            SAVE TOKEN INDEX
               LCA  ISWAI,X3           GET COUNT PTR
     ES_MS1    A    SMSL,SWA+1+X3      ADD MOVE COUNT TO DEST STRING
               SW   SWA+2+X3
     *
               LCA  SWAI,X3            GET NEXT MOVE CHAR INDEX
     *
               LCA  CREG,X1            X1 = MOVE COUNTER
               LCA  SMSSTI,X2          X2 = SOURCE STRING INDEX
     *         LCA  SWAI,X3            X3 = WORK AREA INDEX
     *
     ES_MS2    MZ   ST+X2,SWA+2+X3       MOVE CHAR BY CHAR
               MN   ST+X2,SWA+2+X3
               SBR  X1,1+X1            INCREMENT INDEXES
               SBR  X2,1+X2
               SBR  X3,1+X3
               C    X1,SMSL            IF NOT MOVED ALL CHARS
               BU   ES_MS2             CONTINUE
     *
               LCA  X3,SWAI            SAVE NEW WORK AREA INDEX
               LCA  IPTA,X3            RESTORE TOKEN INDEX
     *
               MCW  PTA+3+X3,ES_EOP+3
               CW   ES_EOP+1
               SBR  X3,4+X3
     ES_EOP    B    000
     *
     *         ERRORS
     *
     ER1       SBR  ERTN+3            NO END CARD
               LCA  STARS,PRA+6
               LCA  EM1,PRA+80
               B    ERTN_2
     EM1       DCW  @NO END CARD@
     *
     ER2       SBR  ERTN+3            NEW LINE NOT > LAST
               CS   299
               LCA  STARS,PRA+6
               LCA  EM2,PRA+80
               B    ERTN_2
     EM2       DCW  @THIS LINE NUMBER LESS THAN PREVIOUS@
     *
     ER3       SBR  ERTN+3           INVALID COMMAND
               CS   299
               LCA  STARS,PRA+6
               LCA  EM3,PRA+80
               B    ERTN_2
     EM3       DCW  @INVALID COMMAND@
     *
     ER4       SBR  ERTN+3            SYNTAX ERROR
               CS   299
               LCA  STARS,PRA+6
               LCA  EM4,PRA+80
               B    ERTN_2
     EM4       DCW  @SYNTAX ERROR@
     *
     ER5       SBR  ERTN+3            TRY AGAIN
               CS   299
               LCA  STARS,PRA+6
               LCA  EM5,PRA+80
               B    ERTN_2
     EM5       DCW  @FIX ERRORS AND TRY AGAIN@
     *
     ER6       SBR  ERTN+3            GOTO LINE NOT FOUND
               CS   299
               MCW  EE_NV1,EM6B       SET GT LINE NO
               LCA  EM6A,PRA+27
               LCA  EM6B,PRA+30
               LCA  EM6C,PRA+40
               B    ERTN_1
     EM6A      DCW  @ LINE NUMBER @
     EM6B      DCW   000
     EM6C      DCW  @ NOT FOUND@
     *
     ER7       SBR  ERTN+3
               CS   299
               LCA  EM7,PRA+35         RETURN WITHOUT GOSUB
               B    ERTN_1
     EM7       DCW  @ RETURN WITHOUT GOSUB@
     *
     ER8       SBR  ERTN+3             NEXT WITHOUT FOR
               CS   299
               LCA  EM8,PRA+32
               B    ERTN_1
     EM8       DCW  @ NEXT WITHOUT FOR@
     *
     ER9       SBR  ERTN+3
               CS   299
               LCA  EM9,PRA+42
               B    ERTN_1
     EM9       DCW  @ INVALID SUBSTRING PARAMETER@
     *
     ER10      SBR  ERTN+3
               CS   299
               LCA  EM10,PRA+28
               B    ERTN_1
     EM10      DCW  @ ALL DATA READ@
     *
     ER11      SBR  ERTN+3
               CS   299
               LCA  EM11,PRA+34
               B    ERTN_1
     EM11      DCW  @ READ/DATA NOT SAME@
     *
     ER12      SBR  ERTN+3
               CS   299
               LCA  EM12,PRA+35
               B    ERTN_1
     EM12      DCW  @ STOPPED BY OPERATOR@
     *
     ER13      SBR  ERTN+3
               CS   299
               LCA  EM13,PRA+30
               B    ERTN_1
     EM13      DCW  @ STACK OVERFLOW@
     *
     ER14      SBR  ERTN+3
               CS   299
               LCA  EM14,PRA+27
               B    ERTN_1
     EM14      DCW  @ OUT OF MEMORY@
     *
     ERTN_1    LCA  XLINE, PRA+10      SET AT LINE NO
               LCA  CLNO,ELNO          MESSAGE
               LCA  ELNO,PRA+13
               LCA  N1,J_ERR
     *
     ERTN_2    W                       PRINT MSG
               CS   299                CLEAR PRINT AREA
               LCA  N1,ERROR           FLAG ERROR
     ERTN      B    000
     *
     XLINE     DCW  @*AT LINE: @
     ELNO      DCW  000                NOTE: MESSAGE START AT 14
     STARS     DCW  @*****@
     *
     *         JUMP TO SUBROUTINE
     *         USED FOR RECURSIVE CALLS
     *         PUT JUMP_TO ADDR IN J_TO
     *
     J_JSR     SBR  J_RTN              TEMP STORE OF RTN ADR
               LCA  X1,J_X1            PRESERVE X1
               A    N3,J_TOS           INCREMENT TOS
               LCA  J_TOS,X1           AND LOAD IT INTO X1
     *
               C    X1,J_MAXS          IF STACK OVERFLOW
               BU   J_1
               B    ER13               PRINT ERROR MESSAGE
               B    EX_FIN             AND STOP EVERYTHING
     *
     J_1       LCA  J_RTN,J_SENT       MOVE RETURN ADR TO STACK
               LCA  J_X1,X1            RESTORE X1
               LCA  N0,J_ERR           SET NO ERROR
     J_TO      EQU  *+4
               B    000                GO TO THE SUBROUTINE
     J_RTN     DCW  000
     *
     *         RETURN FROM SUBROUTINE
     *         IF RETURNING AN ERROR CONDITION
     *         SET J_ERR TO NOT ZERO
     *         RTS WILL COMPARE TO SET A CONDITION CODE
     *
     J_RTS     C    CREG,J_TOS        INSURE STACK NOT EMPTY
               BU   J_R1
     J_HALT    H    START
     *
     J_R1      LCA  X1,J_X1            PRESERVE X1
               LCA  J_TOS,X1           MOVE TOS TO X1
               S    N3,J_TOS           DECREMENT TOS
               MZ   N3+1,J_TOS         CLEAR THE &%! ZONE
               MCW  J_SENT,J_RTN1+3    PULL RETURN TO ADR
               LCA  J_X1,X1            RESTORE X1
               C    N0,J_ERR           SET CONDITION CODE
     J_RTN1    B    000                RETURN TO CALLER
     *
               DCW  @XX@
     J_ERR     DCW  0                  ERROR IF 1
     J_X1      DCW  000
     J_TOS     DCW  000
     J_MAXS    DCW  060                MAX STACK SIZE
     J_STK     DA   20X3,X1
     J_SENT         1,3
     *
     *
     *              ************* MULTIPLY SUBROUTINE ************
     *
     *
     * M_X = MULTIPLICAND, 10 CHAR
     * M_Y = MULTIPLYER, 10 CHAR
     * M_PROD = PRODUCT, LEAST SIGNIFICANT 10 CHARS
     * PRODUCT SIGN WILL BE CORRECT
     *
     M_MULT    NOP
               SBR  M_SR1+3
               CW   M_PROD-9            CLEAR ANY PREVIOUS WM
     *
     *         ****** PREPARE FOR PROPER SIGN *********
     *
               MZ   M_Y,M_YZN            SAVE Y ZONE
               MZ   M_ZERO,M_Y           SET Y POSITIVE
               MZ   M_X,M_XZN            SAVE X ZONE
               MZ   M_ZERO,M_X           MAKE X POSITIVE
     *
               BSS  M_NMUL,F             SSF ON, NOT MACHINE MULTIPLY
     *
     *         ******** DO MACHINE MULTIPLY ************
     *
               LCA  M_Y,M_HPRD+9          MOVE Y TO UPPER HALF
               M    M_X,M_PROD            MACHINE MULTIPLY
     *
     *         ******** SET PRODUCT SIGN ***************
     *
     M_SIGN    NOP
               SW   M_PROD-9              SET PRODUCT 10 CHAR WM
               C    M_XZN,M_MNUS          IF X IS  MINUS
               BE   M_FIXY                LEAVE ZONE BITS ALONE
               MZ   M_ZERO,M_XZN          ELSE STRIP AB BITS FROM IT
     M_FIXY    C    M_YZN,M_MNUS          IF Y IS MINUS
               BE   M_SS                  LEAVE ZONE BITS ALONE
               MZ   M_ZERO,M_YZN          ELSE STRIP AB BIT FROM IT
     *
     M_SS      MZ   M_ZERO,M_PROD         SET PRODUCT POSTIVE
               C    M_YZN,M_XZN           IF Z AND Y ZONE MATCH, POSTIVE
               BE   M_SR1
               MZ   M_MNUS,M_PROD         ELSE NEGATIVE

     *                                    DONE
     M_SR1     B    0000                  RETURN
     *
     *              @1234567890
     M_X       DCW  #10                MULTIPLICAND
     M_Y       DCW  #10                MULTIPLYER
               DCW  @XX@                MARKER
     M_HPRD    DCW  #10
               DC   #10                PRODUCT, UPPER HALF
     M_PROD    DC   #10                PRODUCT, LOWER HALF
               DCW  @XX@                MARKER
     *
     *              NON MACHINE MULTIPLY
     *
     M_NMUL    SBR  M_SR2+3             SAVE RETURN ADR
     *
               LCA  M_ZERO,M_PROD       CLEAR PRODUCT AREA
               ZA   M_Y,M_HPRD          MOVE Y TO UPPER AREA
     *
     M_ZTST    BCE  M_TWM,M_HPRD,0        TEST FOR TRUE ZERO
               BCE  M_TWM,M_HPRD,?        IF TRUE ZERO
               BCE  M_TWM,M_HPRD,         IF TRUE ZERO
     *
               A    M_X,M_PROD-9          ADD X TO PRODUCT
               S    M_ONE,M_HPRD        DECREMENT COUNTER
               B    M_ZTST              TEST FOR TENS
     *
     M_TWM     BW   M_SR2,M_HPRD        IF AT M_CNTR WM, DONE
               LCA  M_PROD-1,M_PROD       SHIFT PRODUCT RIGHT
               B    M_ZTST              GO TEST FOR TENS
     *
     M_SR2     B    0000                  RETURN
     *
               DCW  @0000000000@
               DC   @0000000000@
     M_ZERO    DC   @0000000000@
     M_ONE     DCW  1
     M_MNUS    DCW  -0
     M_YZN     DCW  0
     M_XZN     DCW  0
               DCW  @X@
     M_CNTR    DCW  #12
               DCW  @X@                MARKER
     *
     *         ****************** DIVIDE SUBROUTINE **********************
     * DIVIDEND = D_X
     * DIVSOR = D_Y
     * QUOTION = D_QUOT
     * REMAINDER = D_REM
     *
     * ALL FIELDS ARE 10 CHARCTERS
     *
     D_DIV     NOP
               SBR  D_RTS+3            SET RTS ADR
               LCA  X1,D_SVX1          SAVE X1 FOR RESTORE
               LCA  X1,D_SVX2          SAVE X2 FOR RESTORE
     *
     *         DO SOFTWARE DIVIDE
     *
     *
     *
     *         SAVE SIGNS AND MAKE X AND Y UNSIGNED
     *
               MZ   D_X,D_XZN
               MZ   D_ZERO,D_X
               MZ   D_Y,D_YZN
               MZ   D_ZERO,D_Y
     *
     *        LEFT JUSTIFY DIVISOR AND DIVIDEND
     *
     *                                 LEFT JUSTIFY DIVISOR
               SW   D_Y+1
               CW   D_Y+1
               LCA  D_ZERO-7,X2        X2=DIVISOR DIGIT COUNT
     *                                 SHIFT Y INTO VSOR
     D_VSSR    C    D_ZERO,D_Y         UNTIL Y IS ZERO
               BE   D_VND              THEN DO SAME FOR DIVIDEND
               SBR  X2,1+X2            ADD ONE TO DIGIT COUNT
               MZ   D_ZERO,D_Y         CLEAR ZONES
               LCA  D_VSOR-1,D_VSOR    SHIFT ONE CHAR RIGHT
               B    D_VSSR             UNTI DONE.
     *
     *
     *                                 LEFT JUSTIFY DIVIDEND
     D_VND     SW   D_X+1
               CW   D_X+1
               ZA   D_ZERO,D_DVNC      CLEAR DIVIDEND DIGIT COUNT
     *
     D_VNSR    NOP
               C    D_ZERO,D_X         SHIFT X INTO VEND
               BE   D_BGN              UNTIL X IS ZERO
               A    D_ONE,D_DVNC       ADD ONE TO DIGIT COUNT
               MZ   D_ZERO,D_X         CLEAR ZONE BEFORE SHIFT
               LCA  D_VEND-1,D_VEND    SHIFT ONE CHAR RIGHT
               B    D_VNSR
     *
     *
     *
     D_BGN     NOP                     BEGIN PROCESS
               SW   D_Y+1
               SW   D_X+1
               ZA   D_ZERO,D_QUOT      CLEAR QUOTION
               ZA   D_ZERO,X1          CLEAR X1
               MZ   D_ZERO,X1
               MCW  X2,X1
               ZA   D_ZERO,D_SCNT      CLEAR SUBTRACT COUNTER
               ZA   D_DVNC,D_DGCN      SET DIGIT COUNT DOWN
               S    X1,D_DGCN          DIVIDEND DIGITS - DEVISOR DIGITS
     *

     D_SUB     NOP
               C    D_X+X1,D_Y+X2      IS DIVSOR > DIVIDEND
               BH   D_L1               BRANCH BRANCH IF YES
               A    D_ONE,D_SCNT       ELSE INCREMENT SUBTRACT COUNT
               S    D_Y+X2,D_X+X1      AND SUBTRACT DIVISOR FROM DIVIDEND
               MZ   D_ZERO,D_X+X1      CLEAR ZONE
               B    D_SUB              AND DO AGAIN
     *
     D_L1      NOP
               ZA   D_ZERO,D_WRK       SHIFT QUOTION LEFT ONE DIGIT
               LCA  D_QUOT,D_WRK-1
               MCW  D_WRK,D_QUOT
               A    D_SCNT,D_QUOT      ADD SUBTRACT COUNT TO QUOTE
     *
               S    D_ONE,D_DGCN       DECREMENT DIGIT COUNT
               BM   D_DONE,D_DGCN      IF NOW < ZERO, DONE
     *
               ZA   D_ZERO,D_SCNT      CLEAR SUBTRACT COUNT
               SBR  X1,1+X1            INCREMENT X1
               SBR  X2,1+X2            INCREMENT X2
               CW   D_Y+1
               LCA  D_VSOR-1,D_VSOR    SHIFT DIVISIOR RIGHT ONE
               SW   D_Y+1
     *
               B    D_SUB              NEXT DIGITS
     *
     D_DONE    NOP
               LCA  D_ZERO,D_X         RIGHT JUSTIFY REMAINDER
               CW   D_X+1
     D_JREM    LCA  D_REM-1,D_REM      SHIFT REMAINER RIGHT
               A    D_ONE,D_DVNC       ADD ONE TO DIVIDEND DIGIT COUNT
               MZ   D_ZERO,D_DVNC
               C    D_DVNC,D_TEN      UNTIL IT IS TEN
               BU   D_JREM
               SW   D_X+1
     *
     *                      SET SIGNS
     *
               C    D_XZN,D_MNUS       IF X IS  MINUS
               BE   D_FIXY             LEAVE ZONE BITS ALONE
               MZ   D_ZERO,D_XZN       ELSE STRIP AB BITS FROM IT
     D_FIXY    C    D_YZN,D_MNUS       IF Y IS MINUS
               BE   D_CXY              LEAVE ZONE BITS ALONE
               MZ   D_ZERO,D_YZN       ELSE STRIP AB BIT FROM IT
     *
     D_CXY     C    D_XZN,D_YZN        X=Y
               BE   D_TXZ              BR X,Y ZONES EQUAL
               MZ   D_MNUS,D_QUOT      ELSE SET QUOTION MINUS
     D_TXZ     C    D_XZN,D_ZERO-9     TEST UNSINGED PLUS
               BE   D_RTS
               MZ   D_MNUS,D_REM       ELSE SET REMAINDER MINUS
     D_RTS     B    0000
     *
     *
     *
               DCW  @XX@
     D_QUOT    DCW  #10                QUOTION
               DCW  @X@
     D_X       DCW  #10                X
     D_REM     EQU  D_VEND             VEND IS ALSO REMAINDER
     D_VEND    DCW  #10                DIVIDEND
               DCW  @X@
     D_Y       DCW  #10                Y
     D_VSOR    DCW  #10                DIVSOR
               DCW  @ZZ@
     *
     D_DVNC    DCW  00                 DIVIDEND DIGIT COUNT
     D_DGCN    DCW  00                 DIV DIGIT COUNT DOWN
     D_SCNT    DCW  00                 SUBTRACT COUNT
               DCW  @X@
     D_AB      DCW  @A@                AB ZONES = 1
     D_TEN     DCW  @10@
     D_ONE     DCW  1                  CONSTANT ONE
     D_MNUS    DCW  -0                 MINUS ZONE
     D_ZERO    DCW  @0000000000@       CONSTANT ZERO
               DCW  @X@
     D_WRK     DCW  #11                WORK AREA OF SHIFT LEFT
               DCW  @XXX@
     D_XZN     DCW  0
     D_YZN     DCW  0
     D_SVX1    DCW  000                SAVE X1
     D_SVX2    DCW  000                SAVE X2
     *
               END  START
