ASMB,A,B,L    ***** HP 1000  L/XL-SERIES DIAG. DESIGN LANGUAGE *****
      HED *         DIAGNOSTIC DESIGN LANGUAGE (DDL L/XL) 
      ORG 0 
      OCT 0         BLOCK COUNT FOR PROM
      OCT 20000     TRANSFER COUNT FOR PROM 
*  **************************************************************** 
*  * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980.  ALL RIGHTS      * 
*  * RESERVED.  NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED,       * 
*  * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT * 
*  * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY.        * 
*  **************************************************************** 
* 
*    SOURCE:  24397-18003   DATE CODE 2040
* 
*    BINARY:  24397-16003 
* 
*    MANUAL:  24397-90003 
* 
*    PROGMR:  MIKE WINTERS
* 
      ORG 2 
      JMP *+1,I     COLD START
      DEF START 
      NOP           UPDATED TO JSB PFAR 
      JSB .PRTY,I   PARITY ERROR INTERRUPT
      SUP 
A     EQU 0 
B     EQU 1 
INTP  EQU 0 
      SKP 
* 
*         THE FOLLOWING ARE THE PROGRAM 
*         COMMANDS (SYSTEM CONTROL) 
*         ONLY THE FIRST TWO CHRS ARE REQUIRED
*         THE REST WILL BE IGNORED TO THE FIRST SPACE 
* 
* 
*         LIST SOURCE STATEMENT FILE
*         LI X Y    CONSOLE= CONSOLE
*         SA N X Y  SAVE FILE ON CARTRIDGE TAPE 
* 
*         X Y = FIRST AND LAST LINE NUMBERS (X ONLY THEN ONLY X)
*               DEFAULT 1 AND 32767 
*         N = 1 = LEFT DRIVE  2 = RIGHT DRIVE  3 = SCREEN 
* 
*         DELETE FILE 
*         DE (ONLY) CLEAR ALL THE SOURCE STATEMENT FILE 
*         DE X Y
*            X Y = FIRST AND LAST LINE NUMBERS (X ONLY THEN ONLY X) 
* 
* 
*         RUN SOURCE STATEMENT FILE 
*         RU (ONLY) START EXECUTION AT FIRST LINE 
*         RU X      START EXECUTION AT LINE NO. X - IF X = A NUMBER 
*                   OR START AT PRGM  X - IF X = AN ALPHA CHARACTER 
* 
*         LOAD A FILE FROM CARTRIDGE TAPE 
*         LO N
*            N = 1 = LEFT DRIVE 
*                2 = RIGHT DRIVE
*                3 = SCREEN (264X ONLY) 
* 
*         BYE  EXECUTES A HALT 77B  OR CONTINUES TO NEXT PROGRAM
*              IF SEQUENTIAL LOADING
* 
*         RENUMBER STATEMENT FILE 
*         RE N
*            N = SPACING BETWEEN STATEMENTS (DEFAULT IS 10) 
* 
*         EDIT A STATEMENT IN THE FILE
*         ED N
*            N = LINE NUMBER TO BE EDITED 
* 
*         SIZE PRINTS THE SIZE OF THE STATEMENT FILE IN WORDS USED
*         SI
* 
*         PROGRAM PRINTS ALL PRGM STATEMENT LINES 
*         PR
* 
*         MAP  PRINTS ALL MAP REGISTERSERROR MESSAGES 
*         MAP R P   CHANGE A REGISTER 
*                   R = REGISTER NO. (100-177 EXCEPT 140) 
*                   P = PAGE NUMBER 'STFE' TO 377 
*                   R ONLY 0= MAPS OFF  (140=0) -1=MAPS ON (140=-1) 
      SKP 
*     THESE CONSTANTS ARE ALSO USED BY THE USER I O ROUTINES
* 
      ORG 200B
IODTS EQU * 
.0    OCT 0 
.1    OCT 1 
.2    OCT 2 
.3    OCT 3 
.4    OCT 4 
.5    OCT 5 
.6    OCT 6 
.7    OCT 7 
.10   OCT 10
.11   OCT 11
.12   OCT 12
.13   OCT 13
.14   OCT 14
.15   OCT 15
.16   OCT 16
.17   OCT 17
.20   OCT 20
.21   OCT 21
.22   OCT 22
.23   OCT 23
.24   OCT 24
.25   OCT 25
.26   OCT 26
.27   OCT 27
.30   OCT 30
.31   OCT 31
.36   OCT 36
.37   OCT 37
.40   OCT 40
.53   OCT 53
.55   OCT 55
.60   OCT 60
.61   OCT 61
.6412 OCT 6412
.77   OCT 77
.100  OCT 100 
.140  OCT 140 
.177  OCT 177 
.200  OCT 200 
.240  OCT 240 
.377  OCT 377 
.1777 OCT 1777
.7777 OCT 7777
.7.4  OCT 70000 
      SKP 
.M1   OCT -1
.M2   OCT -2
.M3   OCT -3
.M4   OCT -4
.M5   OCT -5
.M10  OCT -10 
.M32  OCT -32 
.M40  OCT -40 
.M72  OCT -72 
.M77  OCT -100
.M101 OCT -101
.M107 OCT -107
.M136 OCT -136
.M4K  OCT -10000
.M2K  OCT -4000 
M7.3  OCT 137777
M7.43 OCT 143777
BIT15 OCT 100000
BIT14 OCT 40000 
BIT13 OCT 20000 
BIT12 OCT 10000 
BIT11 OCT 04000 
BIT10 OCT 02000 
BIT9  OCT 01000 
BIT6  EQU .100  
DM100 DEC -100
DM72  DEC -72 
DM54  DEC -54 
DM52  DEC -52 
DM48  DEC -48 
DM40  DEC -40 
DM17  DEC -17 
DM16  DEC -16 
DM10  DEC -10 
DM6   DEC -6
DM5   EQU .M5 
DM4   EQU .M4 
D5    EQU .5
D10   EQU .12 
D54   DEC 54
D72   DEC 72
D100  DEC 100 
* 
ALT0  OCT 052525
* 
      SKP 
AC    OCT 103 
AD    OCT 104 
AF    OCT 106 
AS    OCT 123 
AIOR  OCT 72
AXOR  OCT 73
A!    OCT 41
A$    OCT 44
A%    OCT 45
A&    OCT 46
A@    EQU BIT6
LAROW OCT 137 
AEQU  OCT 75
AGTH  OCT 76
ALTH  OCT 74
AEGTH OCT 37075 
AELTH OCT 36075 
A#    EQU * 
ANEQ  OCT 43
AADD  EQU .53 
ASUB  EQU .55 
A.    EQU * 
AAND  OCT 56
ASTRK EQU * 
AMPY  OCT 52
ADIV  OCT 57
AA    OCT 101 
AB    OCT 102 
ADE   ASC 1,DE
ASA   ASC 1,SA
APR   ASC 1,PR
ALI   ASC 1,LI
ARU   ASC 1,RU
ACO   ASC 1,CO
AST   ASC 1,ST
ANO   ASC 1,NO
ALO   ASC 1,LO
AYE   ASC 1,YE
ABY   ASC 1,BY
ASI   ASC 1,SI
AED   ASC 1,ED
ARE   ASC 1,RE
AMA   ASC 1,MA
A/    EQU ADIV
A.I   EQU .11 
A.T   EQU .24 
A.C   EQU .3
A.R   EQU .22 
A.S   EQU .23 
      SKP 
FC.CM OCT 54
FC.LP OCT 50
FC.RP OCT 51
FC.SL EQU A/
FC.QT OCT 42
FC.A  EQU AA
FC.AT EQU A@
FC.&  EQU A&
FC.H  OCT 110 
FC.K  OCT 113 
FC.I  OCT 111 
FC.B  EQU AB
FC.X  OCT 130 
IODTE EQU * 
      SKP 
VARA  DEF *-100B
A2Z   BSS 26        VARIABLES A TO Z
BFA2Z BSS 52        BUFFERS A TO Z
BFTBA DEF BFA2Z-2 
DATAP DEF DATA      DATA ARRAY
DATAM DEC -512
ERRMP DEF ERRMT     ERROR MESSAGE  TABLE
* 
IRQ   DEF IRQ.      *LINK 
.FMT  DEF FMTR      *LINK 
FMT   DEF P2FMT     *LINK 
FMT.  DEF FMTC      *LINK 
.DVIO DEF DVIO      *LINK 
.FNCR DEF FNCRU     *LINK 
.FNSY DEF FNCSY     *LINK 
.CFI  DEF CFI       *LINK 
.CDN  DEF CDN       *LINK 
.CON  DEF CON       *LINK 
.CHN  DEF CHN       *LINK 
.CVDC DEF CVDEC     *LINK 
.CVOC DEF CVOCT     *LINK 
.CMT  DEF CMTSY     *LINK 
.CPR  DEF CPRAM     *LINK 
.GPR  DEF GPRAM     *LINK 
.PPR  DEF PPRAM     *LINK 
.PRU  DEF PRU       *LINK 
.RUN  DEF RUN       *LINK 
.PRST DEF PRSTM     *LINK 
.PLN  DEF PLN       *LINK 
.RENM DEF RENM      *LINK 
.MVW  DEF MWORD     *LINK 
.PRMI DEF PRMIR     *LINK 
.PRMP DEF PRMP      *LINK 
.WTRU DEF WATRU     *LINK 
.BFRU DEF BUFRU     *LINK 
.PINT DEF PINT      *LINK 
.WFI  DEF WFI       *LINK 
.IOPC DEF IOPC      *LINK 
.IOA  DEF IOA       *LINK 
.IOB  DEF IOB       *LINK 
.IOC  DEF IOC       *LINK 
.IOD  DEF IOD       *LINK 
.INT  NOP           *LINK 
.PFAR DEF PFAR      *LINK 
.PRTY DEF PRTY      *LINK 
.OK?  DEF OK?       *LINK 
      SKP 
JSBI  JSB *+1,I     INTERRUPT ROUTINE 
      DEF INT 
JSBI. JSB .INT,I
JPFAR JSB .PFAR,I 
JPTY  JSB .PRTY,I 
RSS   RSS 
CNSC  OCT 20
ALSC  OCT 24
STTBD DEF STTBL     STATEMENT TABLE 
IOPDF DEF IOP       IO PROGRAM TABLE
STFE  NOP           END OF STATEMENT FILE 
FWAMA DEF FWAM+2
      DEF FWAM+2
LWAMA OCT 77677 
      OCT 77677 
WCMSK OCT 1777
MXLN  DEC 32767 
CRLF  ASC 2,(/) 
      SKP 
BUFRC NOP 
BUFRA NOP 
BUFRP NOP 
IOPAP NOP 
IOPSA NOP 
IOPEN NOP 
IDTBP DEF IDTBL     INTERFACE IDENTIFICATION TABLE
TMPD  DEF TMP 
CRSA  NOP 
BUFA  DEF BUF+BUF 
BUFE  ABS -BUFE.-BUFE.
STBFD DEF *+1 
STBF  BSS 31
TMPA  NOP 
TMPB  NOP 
TMP   OCT 0,0,0,0,0 
SC    NOP 
CVN   NOP 
IOSC  NOP 
DVN   NOP 
CULN  OCT 0         CURRENT LINE NUMBER 
FCN   NOP 
LIC   NOP 
TMRC  NOP 
AFLG  NOP 
BFLG  NOP 
PFLG  NOP 
LEDS  NOP 
GSCFL NOP 
HOODF NOP 
* 
FMTS  NOP 
FMTSR NOP 
FSR   NOP 
FCR   NOP 
SDFP  NOP 
SIFF  NOP 
NWDS  NOP 
NWD   NOP 
NWCS  NOP 
NWC   NOP 
SPCF  NOP 
NFG   NOP 
FMTBP DEF BUF+BUF 
      SKP 
*         BUFFER TO A REG.
* 
BUF2A NOP 
      CLE,ERB       E _ UPPER/LOWER FLAG
      LDA B,I       2 CHR TO A REG
      SEZ,RSS       UPPER OR LOWER? 
      ALF,ALF       UPPER 
      AND .377      MASK UNWANTED CHARACTERS
      JMP BUF2A,I   RETURN
* 
*         ADD A REG TO BUFFER 
* 
A2BUF NOP 
      AND .377      MASK UPPER BYTE FOR PROTECTION
      STA A2BC      SAVE CHARACTER
      SLB,INB         OPPSITE 
      ADB .M2           CHARACTER 
      JSB BUF2A 
      ALF,ALF 
      IOR A2BC      ADD NEW CHARACTER 
      SEZ           SHOULD IT BE SWAPPED
      ALF,ALF       YES 
      STA B,I       STORE IT
      LDA A2BC      RESTORE CHARACTER 
      JMP A2BUF,I 
A2BC  NOP 
* 
*         GET A CHARACTER FROM BUFFER 
* 
GETC  NOP 
      LDB GETP      PICK UP BYTE ADDRESS
      JSB BUF2A     LOAD THE CHARACTER
      ISZ GETP      MOVE TO NEXT BYTE 
      JMP GETC,I    RETURN
GETP  NOP 
* 
*         PUT A CHARACTER IN BUFFER 
* 
PUTC  NOP 
      LDB PUTP      PICK UP BYTE ADDRESS
      JSB A2BUF     PACK CHARACTER IN BUFFER
      ISZ PUTP      MOVE TO NEXT BYTE 
      JMP PUTC,I    RETURN
PUTP  NOP 
* 
*         GET A BYTE
* 
GETB  NOP 
      LDB GETP      GET BYTE
      JSB BUF2A        FROM BUFFER
      CPA .15       IS IT A EOB 
      JMP GETB,I    YES RETURN P+1
      ISZ GETP      NO - MOVE UP ONE
      ISZ GETB      NO
      JMP GETB,I    RETURN P+2
      SKP 
*         CHECK A REG. = ASCII LETTER (101-132) 
* 
LTCK  NOP 
      LDB A         SAVE CHARACTER
      ADB .M101     IS
      SSB 
      JMP LTCK,I        IT
      ADB .M32             A
      SSB                    LETTER 
      ISZ LTCK
      JMP LTCK,I
* 
*         CHECK A REG = ASCII NUMBER (60-72)
* 
DGCK  NOP 
      STA TMPA      SAVE CHARACTER
      ADA .M72      IS
      SSA,RSS          IT 
      JMP *+4           A 
      ADA .12            DIGIT
      SSA,RSS 
      ISZ DGCK      YES RETURN P+2
      LDB A         SAVE NUMBER VALUE 
      LDA TMPA      RESTORE A REG 
      JMP DGCK,I    RETURN
* 
*         OCTAL NUMBER CHECK
* 
ONCK  NOP 
      JSB DGCK      FIRST IS IT A DIGIT?
      JMP ONCK,I    NO
      RBR,RBR 
      RBR 
      SLB           IS IT > 7?
      JMP ONCK,I    YES 
      RBL,RBL 
      RBL 
      ISZ ONCK      ADJUST GOOD RETURN
      JMP ONCK,I
* 
CFEQU  NOP
      JSB GETB      CHECK FOR CHANGE
      JMP CFEQU,I    END OF BUFFER NO CHANGE
      CPA AEQU      IS IT AN EQUAL SIGN?
      ISZ CFEQU      YES RETURN P+2 
      JMP CFEQU,I   NO RETURN P+1 
      SKP 
*         1 MILLISECOND TIMER 
TMR   NOP           ENTRY 1 MILLSEC CLOCK 
      CMA,INA       NEGATE TIME WANTED
      LDB TMRC
      INB,SZB 
      JMP *-1 
      INA,SZA       IS THERE MORE TIME WANTED 
      JMP *-4       YES 
      LDA TMR       GET RETURN ADDRESS
      STB TMR       INDICATE OUT OF TIMER 
      JMP A,I       RETURN TO CALLER
* 
IOTMR NOP 
      CMA,INA       NEGATE TIME WANTED
      LDB TMRC      GET 1 MILL TIME COUNT 
      INB,SZB 
      JMP *-1 
      INA,SZA 
      JMP *-4 
      JMP IOTMR,I 
* 
*         INTERRUPT PROCESSOR 
INT   NOP 
      CLF 0         TURN OFF INTERRUPTS 
      STA INTSA     SAVE A REG. 
      STB INTSB       AND B REG.
      LIB 4B        GET INTERRUPTING SELECT CODE
      ADB INTLP 
      LDA B,I 
      IOR BIT15     ADD FLAG BIT
      STA B,I 
      ISZ INTF      SET INTERRUPT FLAG
      LDA 140B      TURN MAPS ON IF NECESSARY 
      SZA 
      STC 11B 
      JMP *+1 
      LDA TMR       WAS PROGRAM IN TIMER??
      SZA           ??
      JMP *+5       YES - THEN ABORT TIMER
      LDA INTSA     NO - RESTORE A REG. 
      LDB INTSB       AND B REG.
      STF 0         TURN ON INTERRUPTS
      JMP INT,I     CONTINUE
      CLB 
      STB TMR       CLEAR TIMER FLAG
      CCB           INDICATE IT WAS INTERRUPTED 
      STF 0         TURN ON INTERRUPTS
      JMP A,I       RETURN TO TIMER 
INTF  NOP 
INTSC NOP 
INTLN NOP 
INTSA NOP 
INTSB NOP 
INTLP DEF INTLT 
      SKP 
*         INPUT ERROR 
* 
INPE  JSB WHAT
      JMP IRQ,I 
* 
*         !?
* 
WHAT  NOP 
      JSB .FMT,I
      DEF WHATM 
      CLA 
      JSB FMT.,I
      JMP WHAT,I
WHATM ASC 03,("!?") 
      SPC 3 
*         RUNNING ERROR 
* 
ERR   NOP 
      CLF 0         INSURE INTERRUPTS ARE OFF 
      STA .STOP     SAVE ERROR NUMBER 
      JSB .FMT,I    ERROR NUMBER
      DEF ERRM,I
      LDA .STOP 
      JSB FMT,I 
      CLA           OUTPUT TO CONSOLE 
      JSB FMT.,I
      LDA .STOP     CHECK IF STOP TYPE
      SSA 
      JMP ERR,I     NO RETURN TO CALLER 
      LDA ERRMP     GET POINTER TO TABLE
      ADA .STOP     ADD ERROR NUMBER
      LDA A,I       GET MESSAGE ADDRESS 
      STA *+2 
      JSB .FMT,I    OUTPUT MESSAGE
      NOP 
ERRFM CLA           TO THE CONSOLE
      JSB FMT.,I
      LDA .STOP     SET ERROR NUMBER FOR DISPLAY
      IOR BIT6      
      ALF,ALF 
      IOR .21     INDICATE EXECUTION ERROR
      JMP STOP. 
      SKP 
*         STOP ALL EXECUTION
* 
.STOP NOP 
      LDA .177      SET NORMAL STOP 
      ALF,ALF 
      IOR .21 
STOP. CLF 0         INSURE INTERRUPTS ARE OFF 
      LDB JPFAR     RESTORE TRAP
      STB 4 
      LDB JPTY  
      STB 5 
      CLB 
      LIB 3,C       CHECK FOR A FRONT PANEL 
      SZB 
      JMP STOP1     THERE IS SO USE IT
      LDB A         SAVE A REG
      JSB DSPLY     PUT IT OUT TO THE LEDS (DDL PORTION)
      LDA B         RESTORE A REG 
      ALF,ALF 
      JSB DSPLY     NOW SUBSECTION
      LDA B 
      JMP *-5 
STOP1 LDA .20       INDICATE IN CONSOLE INPUT MODE
      OTA 1 
      LDA CULN      WAS I IN EXECUTION
      SZA,RSS       ? 
      JMP STOP0     NO
      JSB .FMT,I    OUTPUT LINE NUMBER
      DEF STPLN,I 
      LDA CULN
      JSB FMT,I 
      CCA           CHECK GOSB TABLE
      ADA STBF
      CPA STBFD     ANY ENTRYS? 
      JMP *+5       NO
      LDB A,I       YES GET NUMBER
      INB 
      LDA B,I 
      JSB FMT,I     PUT IN OUTPUT BUFFER
STOP0 CLA           OUTPUT
      STA CULN
      JSB .FMT,I       STOP MESSAGE 
      DEF STPM
      CLA           OUTPUT IT TO THE CONSOLE
      JSB FMT.,I
      CLC 11B 
      LDA 140B      CHECK MAPS
      SZA 
      STC 11B 
      JMP IRQ,I 
      SKP 
DSPLY NOP 
      OTA 1 
      ISZ A 
      JMP *-1 
      ISZ A 
      JMP *-1 
      ISZ A 
      JMP *-1 
      ISZ A 
      JMP *-1 
      JMP DSPLY,I 
* 
ERRM  ASC 07,("ERROR"XI3X)
STPLN ASC 08,("LINE"2(XI5)X)
STPM  ASC 05,("STOP"/)
* 
STOP  NOP 
      JSB DVSSG     SAVE CURRENT GLOBAL REGISTER STATUS 
      CLA           CHECK IF THERE IS A VCP 
      LIA 3,C 
      SZA,RSS 
      JMP STOPX     NO THEN SKIP CHECK
      LIA 1         CHECK FOR ALTERNATE CONSOLE 
      ALF,SLA 
      JMP STOPX     IF IT IS THEN NO STOP 
      LDA CNSC      IT'S TERMINAL 
      OTA 2,C       TURN ON GLOBAL REGISTER 
      SFS DR        FLAG SET YET? 
STOPX ISZ STOP      NO
      LDA DVSVA 
      JSB DVRSG     RESET GLOBAL REGISTER 
      JMP STOP,I    RETURN
      SKP 
      SKP 
*     THIS ROUTINE SERVICES PARITY ERRORS 
*     IF IT'S AN ERROR ON A FETCH THEN NOT RECOVERABLE
*     IF IT'S AN ERROR ON DATA BELOW I/O ROUTINE AREA THEN
*        IT'S ALSO NOT RECOVERABLE. 
PRTY  NOP 
      CLC 4         INHIBIT ALL INTERRUPTS
      STA PRTYA     SAVE A AND B REGISTERS
      STB PRTYB 
      LIA 5         GET ADDRESS OF ERRROR 
      CLC 0,C       RESET MACHINE 
      STA PRTYS     SAVE FOR MESSAGE
      SSA           IS THIS A FETCH INSTRUCTION?
      JMP PRTYH     YES THEN NON RECOVERABLE
      CMA,INA       CHECK IF BELOW DAA
      ADA .IOA
      SSA,RSS 
      JMP PRTYH     IT WAS SO NOT RECOVERABLE 
      CLA,INA       SET INCASE NO CONSOLE 
      JSB PRTYC     CHECK IF THERE IS A CONSOLE 
      JSB .FMT,I    OK TO RECOVER AND 
      DEF PRTYM       REPORT ERROR
      LDA PRTYS     INDICATE ADDRESS OF ERROR 
      JSB FMT,I 
      CLA           REPORT TO CONSOLE 
      JSB FMT.,I
      JSB .STOP     NOW STOP
* 
PRTYH CLA           INDICATE NOT RECOVERABLE
      JSB PRTYC     CHECK FOR CONSOLE 
      LDA PRTYS     DISPLAY ADDRESS OF ERROR
      LDB PRTY      AND INSTRUCTION THAT CAUSED IT
      HLT 25B       DISPLAY IT
      LDA PRTYA     NOW DISPLAY A + B REG.
      LDB PRTYB 
      HLT 65B 
      JMP PRTYH     LOOP
* 
PRTYC NOP 
      CLB 
      LIB 3,C 
      SZB 
      JMP PRTYC,I   THERE IS A CONSOLE
      IOR BIT6      NOT SO DISPLAY IT 
      ALF,ALF 
      IOR .25 
      JMP STOP. 
* 
PRTYA NOP 
PRTYB NOP 
PRTYS NOP 
PRTYM ASC 11,("PARITY AT LOC. "K6/) 
      SKP 
*     SAVE GLOBAL REGISTER
* 
DVSSG NOP 
      STA DVSVA     SAVE A REG. 
      LIA 2         GET CONTENTS
      SFS 2         CHECK IF ON 
      IOR BIT15 
      STA DVSVG     SAVE THE STATUS 
      STF 2 
      CLA           DIABLE DIAGNOSE MODE
      OTA 2 
      LDA DVSVA     RESTORE A REG.
      JMP DVSSG,I 
* 
DVSVA NOP 
DVSVG NOP 
* 
DVRSG NOP 
      STA DVSVA     SAVE A REGISTR
      LDA DVSVG     GET GLOBAL REG STATUS 
      OTA 2,C       OUTPUT AND ENABLE IT
      SSA,RSS       ON OR OFF?
      STF 2         OFF 
      LDA DVSVA     RESTORE A REG.
      JMP DVRSG,I   RETURN
* 
*     TURN ON OR OFF INTERRUPTS 
* 
I?OF  NOP 
      OCT 103300    CHECK AND CLEAR INTERRUPT FLAG  (SFS 0,C) 
      JMP *+5 
      STA I?SA      SAVE A REG. 
      CLA           SET INTS ON 
      STA I?FL
      JMP *+4 
      STA I?SA
      CCA 
      JMP *-4 
      CLC 11B       TURN OFF MAPS 
      LDA I?SA      RESTOR A REGISTER 
      JMP I?OF,I    RETURN
* 
I?ON  NOP 
      LDA 140B      CHECK MAPS ON 
      SZA 
      STC 11B       THERE ON
      ISZ I?FL      ARE INTS ON 
      STF 0         YES SET FLAG
      JMP I?ON,I    RETURN
* 
I?SA  NOP 
I?FL  NOP 
      SKP 
*         FIND A LINE NUMBER
* 
FNDLN NOP 
      STA TMPA      SAVE LINE NUMBER
      CLA           CLEAR NUMBER COUNT
      STA FNDLC 
      LDB FWAMA     SET START OF STATEMENT FILE 
FNDL0 STB FNDLA     SAVE ADDRESS
      LDA B,I       GET LINE #
      SZA,RSS       IS IT END OF FILE?
      JMP FNDLN,I   YES - RETURN P+1
      ISZ FNDLC     COUNT STATEMENT 
      INB           MOVE TO LINE NUMBER 
      LDA B,I 
      LDB FNDLA     RESTOR B
      CMA,INA       MAKE IT NEG 
      ADA TMPA      WHEN NEW NUMBER IS ADDED
      SZA           IF IT'S 0 THEY ARE EQUAL
      JMP *+3 
      ISZ FNDLN     AND LINE FOUND
      JMP FNDLN,I   RETURN P+2
      SSA           IF IT'S STILL NEG THEN
      JMP FNDLN,I   THEN NUMBER IS OVER NEW LINE
      LDA B,I       GET WORD
      ALF,RAL 
      AND .37 
      ADB A         ADD COUNT TO MOVE TO NEXT LINE
      JMP FNDL0     CONTINUE SEARCH 
* 
FNDLA NOP 
FNDLC NOP 
* 
*         GET LINE NUMBER AND CHECK IT
* 
GTLN  NOP 
      JSB .CDN,I    GET LINE NUMBER 
      JMP GTLN,I    NO NUMBER 
      SSA,RSS       NOT NEG.
      SZA,RSS       OR ZERO 
      JMP GTLN,I
      CPA STBF+1    DON'T ALLOW SAME LINE NUMBER
      JMP GTLN,I
      ISZ GTLN
      JMP GTLN,I    RETURN
      SKP 
*         FILE PARAMETER STORE
* 
FPS   NOP 
      JSB .CPR,I    CONVER PARAMETER
      JMP FPS,I     NO PARAMETER
      STA TMP,I 
      ISZ TMP 
      STB TMP,I 
      ISZ TMP 
      ISZ FPS       RETURN P+2
      JMP FPS,I 
* 
*         FILE PARAMETER GET
* 
FPG   NOP 
      ADB CRSA
      LDA B,I 
      INB 
      LDB B,I 
      JSB .GPR,I
      JMP FPG,I 
* 
*         FILE PARAMETER LIST 
* 
FPL   NOP 
      LDA TMP,I 
      ISZ TMP 
      LDB TMP,I 
      ISZ TMP 
      JSB .PPR,I    PRINT IT
      JMP FPL,I     RETURN
* 
BUF   BSS 129 
BUFE. EQU *-1 
EOP0  EQU 2000B-*   THIS WILL GUARANTEE NO OVER FLOW OF PAGE 0
      SKP 
      ORG 2000B 
*     COLD START UP 
* 
* 
START CLC INTP,C    TURN ALL I-O OFF
      STA AFLG      SAVE DEVICE TYPE
      STB BFLG      AND ASCII STRING POINTER
      CLB           SET UP RUN DISPLAY ON LEDS
      SSA           IF MANUAL USE FILE NO. 0
      JMP *+4       IT'S MANUAL 
      OTA 2,C       NO AUTO  USE FILE NUMBER ON LOAD INTERFACE
      LIB 25B 
      ADB .M1       DECREMENT FILE NUMBER 
      LDA B 
      AND .77 
      IOR BIT6      ADD SUBSECTION
      ALF,ALF       PUT IT IN UPPER HALF
      IOR .20       INDICATE DDL
      STA LEDS      PUT IT IN STORAGE 
      CLA           CLEAR POWER FAIL FLAG 
      STA PFLG
      LDB JPFAR     SET POWER FAIL RESTART JSB IN 4 
      SFS 4         FIRST HAS POWER FAILED
      JMP *-1       YES LET IT GO DOWN
      STB 4         NO SO SET LOCATION 4
      JMP UP        START UP
* 
*     POWER FAIL AUTO RESTART 
* 
PFAR  NOP 
      SFC 4B        CHECK IF POWER CAME UP AGAIN
      JMP UP        YES START UP
      CCA           INDICATE POWER FAIL INTERRUPT 
      STA PFLG      SET FLAG
      SFS 4         WAIT FOR IT TO GO DOWN
      JMP *-1 
      JMP UP        START UP
* 
      SKP 
UP    STC 4         INSURE POWER FAIL INTERRUPTS
      LDA .20       INDICATE DDL ON PROCESSOR LEDS
      OTA 1 
      LDB LWAMA+1   DETERMINE MEMORY SIZE 
UP0   LDA ARU       USE ANY PATTERN 
      STA B,I       TRY LAST ADDRESS
      CPA B,I       GET DATA BACK 
      JMP UP1       DATA CAME BACK SO CONTINUE
      ADB .M4K      NO MOVE DOWN 4K 
      STB LWAMA     SAVE ADDRESS
      SSB,RSS       DID IT GO NEGATIVE? 
      JMP UP0       NO CHECK FOR NEXT BLOCK 
      HLT 0         INDICATE NO MEMORY
      JMP *-1 
UP1   CCB 
      STB BUF+1 
      CLB 
      OCT 104413    XST CROSS MAP STORE (A ONLY)
      DEF BUF 
      DLD BUF       IF B DID NOT STORE THEN MAPPED
      CPA ARU 
      SZB,RSS 
      JMP *+3       IT DIDN'T 
      LDA BIT15     IT DID SO CHANGE LWAMA
      STA LWAMA 
      LDA STFE      IS THIS A FRESH START?
      SZA 
      JMP UP2       NO
      LDB FWAMA+1   CONVERT MEMORY PROGRAM
      STB FWAMA     RESET STARTING POINTER
      STB STFE      SET END OF FILE 
      STA STFE,I
      JSB IMAP      INITIALIZE MAPS 
UP2   CLA           CLEAR MAP FLAG
      STA 140B
      LDA TBJBD     SET JSB FOR TIME SET UP 
      STA .INT
      LDA JSBI.     SET INSTRUCTION 
      STA 6 
      CLA 
      STC 6,C       START TBG 
      SFS 6         WAIT FOR IT 
      JMP *-1 
      STC 6,C       START IT AGAIN
      STF 0         TURN ON INTERRUPTS
      INA,SZA 
      JMP *-1 
      HLT 0         TBG HAS 
      JMP *-1       FAILED
      SKP 
TBJBD DEF TBI 
TBI   NOP 
      CLF 0         TURN OFF INTERRUPTS 
      CLB 
      STB 6         CLEAR TRAP CELL 
      CLC 6,C       TURN OFF TBG
      DIV D10       DIVIDE BY TEN 
      CMA,INA       MAKE COUNT NEGATIVE 
      STA TMRC
      LDA MXLN      RESET STATEMENT FILE END
      INA 
      JSB FNDLN 
      NOP 
      STB STFE
      CLA           INITIALIZE DRIVER 
      CLB 
      JSB .DVIO,I 
      NOP 
      CLB 
      LDA PFLG      GET POWER FAIL FLAG 
      STB PFLG      CLEAR POWER FAIL FLAG 
      SZA,RSS       WAS THIS A POWER DOWN?
      JMP UP3       NO
      JSB .FMT,I    YES - TELL OPERATOR OF RESTART
      DEF PFMS,I
      CLA 
      JSB FMT.,I
      LDA AFLG      RESTORE LOADER TYPE 
      OTA 3 
      SKP 
UP3   LDA AFLG      WAS THIS AN AUTO RUN SEQUENCE?
      LDB CULN      OR WAS IT RUNNING 
      SSA,RSS 
      JMP UP4       THIS WAS AUTO SO CONTINUE 
      SZB           WAS THE STATEMENT FILE EXECUTING
      JSB .STOP     YES 
      JSB HDRDY     PRINT TITLE AND 'READY' 
      JMP IRQ,I 
UP4   LDB BFLG      CHECK IF ANY STRING 
      SZB 
      LDB B,I 
      SZB,RSS 
      JMP UP5       NO STRING SO AUTO RUN 
      LDA BUFA      YES THEN MOVE TO RUN BUFFER 
      STA PUTP
      LDA BFLG
      RAL 
      STA GETP
      LDB DM40      TRANSFER 20 WORDS  MAX
      STB TMP 
      JSB GETC
      SZA,RSS 
      JMP *+4 
      JSB PUTC
      ISZ TMP 
      JMP *-5 
      LDA .15 
      JSB PUTC
      LDA BUFA
      STA GETP
      CCA           STOP SEQUENTIAL EXECUTION 
      OTA 3 
      STA AFLG
      JMP CMD 
UP5   LDA FWAMA     START WIT FIRST LINE
      CLB,CLE       SET FOR AUTO RUN
      JSB .RUN,I    NOW RUN THE PROGRAM 
EXIT  CLA           CLEAR POWER FAIL RESTART
      STA 4 
      CCA 
      OTA 1         START NEXT LOAD 
      CLC 2         ENABLE ROM
      JSB 1 
      HLT 77B 
      JSB .STOP     RESTART 
* 
PFMS  ASC 15,(/"POWER FAIL AUTO RESTART"/)
      SKP 
*     THIS ROUTINE WILL PRINT THE TITLE 
*     IN THE FIRST LINE OF THE STATEMENT FILE 
*     IF THERE IS A FILE AND IT'S A FMT STATEMENT 
*     THEN PRINTS 'READY' 
* 
HDRDY NOP 
      JSB .FMT,I    DO A CRLF 
      DEF DDLM. 
      CLA 
      JSB FMT.,I
      LDA FWAMA,I   CHECK IS THERE A STATEMENT
      SZA,RSS 
      JMP HDRD.     NO SKIP OUTPUT JUST DO READY
      LDB FWAMA     YES SO CHECK
      LDA B,I                IF IT
      AND WCMSK                 IS A
      IOR STTBD 
      LDA A,I                     FORMAT
      ADB .4        SET FORMAT ADDRESS
      ADB BIT15 
      SZA                           LINE
HDRD. LDB DDLM      NO - SO USE DDL TITLE 
      STB *+2 
      JSB .FMT,I    DO IT 
      NOP 
      CLA           ONLY THE CONSOLE
      JSB FMT.,I
      JSB .FMT,I    OUTPUT READY
      DEF HDRDM,I 
      CLA           TO CONSOLE
      JSB FMT.,I
      JMP HDRDY,I   RETURN
* 
DDLM. ASC 02,(3/) 
DDLM  DEF *+1,I 
      ASC 16,("DIAGNOSTIC DESIGN LANGUAGE"/)
HDRDM ASC 08,("2040 READY"/)
      SKP 
* 
*         INPUT REQUEST 
* 
IRQ.  JSB .FMT,I    OUTPUT PROMPT CHR.
      DEF BEEP
      CLA             TO THE CONSOLE
      JSB FMT.,I
      CLA 
      JSB .CFI,I    CALL FOR INPUT
      LDB GETP      CHECK FIRST 
      JSB BUF2A        CHARACTER
      CPA A#        IS THIS A DATA EQUEST?
      JMP PRMI      YES 
      JSB DGCK      CHECK IF IT'S A NUMBER
      JMP *+4 
      JSB .PRST,I   YES THEN IT'S A STATEMENT 
      JMP INPE
      JMP IRQ,I 
      LDB GETP      GET SECOND CHARACTER
      INB 
      JSB BUF2A 
      CPA .40       IF SPACE
      JMP PRMI        THEN A PARAMETER
      CPA FC.LP     OR IF A LEFT PREN 
      JMP PRMI        THEN A PARAMETER
      CPA .15       OR CARRIAGE RETURN
      JMP PRMI        THEN A PARAMETER
      CPA AEQU      OR EQUAL SIGN?
      JMP PRMI        THEN A PARAMETER
      JMP CMD       IT'S A COMMAND
* 
BEEP  ASC 01,("     BELL + >
      OCT 3476
      ASC 01,") 
* 
*         PARAMETER INTERROGATION 
* 
PRMI  EQU * 
      JSB PRMIR     PROCESS REQUEST 
      JMP INPE      NO GOOD 
      JMP IRQ,I 
      SKP 
*     PRINT OR CHANGE A PARAMETER 
* 
PRMIR NOP 
      JSB CPRAM     CONVERT PARAMETER 
      JMP PRMIR,I   NO DATA 
      STA TMP 
      STB TMP+1 
      JSB CFEQU      CHECK FOR EQUAL SIGN 
      JMP PRMIB     NO CHANGE IS THERE A SECOND CHARACTER 
      JSB CPRAM     GET NEXT PARAMETER
      JMP PRMIR,I   NO DATA 
      STA TMP+2     SAVE
      STB TMP+3       NEW CONTENTS
      CLA           USE CONSOLE NUMBER
      JSB PRMP      PRINT OLD CONTENTS
      LDA TMP+2     WAS 
      AND .177         NEW CONTENTS 
      SZA           VALID?
      JMP PRMI.+2 
      LDA TMP       YES 
      LDB TMP+1 
      JSB GPRAM     GET PARAM ADDRESS 
      LDA TMP+3 
      STA B,I 
PRMI. CLA           PRINT NEW CONTENTS
      JSB PRMP
      ISZ PRMIR     ADJUST RETURN 
      JMP PRMIR,I   RETURN
* 
PRMIB JSB CPRAM     CHECK IF THERE IS ANOTHER PARAMETER 
      JMP PRMI.     NO JUST ONE 
      STA TMP+2     YES - SAVE IT 
      STB TMP+3 
      CPA TMP       ARE THE TWO THE SAME
      RSS 
      JMP PRMIR,I   NO THEN INPUT ERROR 
      CPA A#        DATA REQUEST? 
      JMP *+4       YES 
      RAL,SLA       NO - THEN IS IT A BUFFER AND
      SSA           IS IT A VRIABLE?
      JMP PRMIR,I   NO INPUT ERROR
      LDA TMP+2     CHECK IF SECOND IS IN LIMITS
      JSB GPRAM 
PRMBL CLA           OK PRINT IT 
      JSB PRMP
      ISZ TMP+1 
      LDA TMP+1 
      CMA 
      ADA TMP+3 
      SSA           IS THAT ALL?
      JMP PRMI.     YES 
      JMP PRMBL     LOOP AND DO NEXT LOCATION 
      SKP 
PRMP  NOP 
      STA PRMDV     SAVE PRINT DEVICE 
      LDA TMP       SAVE A
      LDB TMP+1 
      JSB PPRAM     PRINT PARAMETER 
      JSB .FMT,I    AND 
      DEF PRMPM       CONTENTS
      LDA TMP 
      LDB TMP+1 
      JSB GPRAM 
      STA PRMPT 
      JSB FMT,I     DECIMAL 
      LDA PRMPT 
      JSB FMT,I     HEX 
      LDA PRMPT 
      JSB FMT,I     OCTAL 
      LDA PRMPT 
      RAL 
      STA PRMPR     SAVE BINARY 
      AND .1
      JSB FMT,I     BINARY
      JSB PRMPB 
      JSB PRMPB 
      JSB PRMPB 
      JSB PRMPB 
      JSB PRMPB 
      LDA PRMPT 
      ALF,ALF 
      AND .377
      JSB FMT,I     UPPER BYTE
      LDA PRMPT 
      AND .377
      JSB FMT,I     LOWER BYTE
      LDA PRMPT 
      ALF,ALF 
      JSB PRMPR     ASCII CHARACTER UPPER 
      LDA PRMPT 
      JSB PRMPR     ASCII CHARACTER LOWER 
      LDA PRMDV     GET DEVICE NUMBER 
      JSB FMT.,I
      JSB STOP
      JSB .STOP 
      JMP PRMP,I    RETURN
      SKP 
PRMPB NOP 
      LDA PRMPR     GET NUMBER
      RAL,RAL 
      RAL 
      STA PRMPR 
      AND .7
      JSB FMT,I 
      JMP PRMPB,I 
* 
PRMPR NOP 
      AND .177
      STA B         CHECK IF PRINTABLE
      ADB .M40
      SSB 
      LDA .40 
      ADB .M136 
      SSB,RSS 
      LDA .40 
      JSB FMT,I 
      JMP PRMPR,I 
* 
PRMPT NOP 
PRMDV NOP 
PRMPM ASC 15,(" = "I6XXH4XXK6XXB1,5(":"B3)X 
      ASC 10,XK3XK3XX"("A1A1")"/) 
        SKP 
*         PROCESS A COMMAND 
* 
CMD   JSB GETB      GET 
      JMP INPE
      ALF,ALF 
      STA TMPA      FIRST 2 
      JSB GETB
      JMP INPE      INPUT ERROR 
      IOR TMPA         CHARACTERS 
      STA TMPA
CMD0  JSB GETB      MOVE OVER SPACES
      LDA .40       END OF BUFFER FAKE SPACE
      CPA .40 
      JMP CMD1
      JSB LTCK      IS IT A LETTER? 
      JMP INPE      NO THEN ERROR 
      JMP CMD0
CMD1  CLC 11B     TURN OFF MAPS 
      JMP *+1 
      LDA TMPA
      CPA ALI       LIST FILE?
      JSB .PLI,I    YES 
      CPA ASA       SAVE FILE?
      JSB .PSV,I    YES 
      CPA ADE       DELETE FILE?
      JSB PDL       YES 
      CPA ALO       LOAD FILE?
      JSB PLD       YES 
      CPA ARU       RUN PROGRAM?
      JSB PRU       YES 
      CPA ABY       EXIT OPDSIGN? 
      JMP EXIT      YES 
      CPA AED       EDIT LINE?
      JSB .EDIT,I   YES 
      CPA ARE       RENUMBER LINES? 
      JSB .RENM,I   YES 
      CPA ASI       SIZE REQUEST? 
      JSB .SIZE,I   YES 
      CPA APR       PROGRAM LISTING 
      JSB .PROG,I   YES 
      CPA AMA       IS THIS A MAP REQUEST?
      JSB .MAP,I    YES 
      LDB 140B      RESET MAPS
      SZB 
      STC 11B       TURN THEM BACK ON 
      SZA,RSS       IF A = 0 THEN PROCESSED 
      JMP IRQ,I     OK
      JMP INPE      ERROR 
* 
.PLI  DEF PLI       *LINK 
.PSV  DEF PSV       *LINK 
.PROG DEF PROG      *LINK 
.EDIT DEF EDIT      *LINK 
.MAP  DEF MAP       *LINK 
.SIZE DEF SIZE      *LINK 
      SKP 
*     CLEAR FILE
* 
PDL   NOP 
      LDB GETP      CHECK IF IT'S A SECTION 
      JSB BUF2A 
      CPA .15 
      JMP PDL.      NO SO CLEAR ALL OF FILE 
      JSB .CDN,I    GET STARTING LINE 
      JMP PDLE      NO NUMBER SO ERROR
      STA TMP+1     SAVE STARTING NUMBER
      JSB FNDLN     FIND IT 
      JMP PDLE      NOT FOUND 
      STB TMP       OK
      JSB .CDN,I    GET LAST LINE 
      LDA TMP+1     NO NUMBER SO USE ONLY ONE 
      JSB FNDLN     FIND IT 
      JMP PDLE      NOT FOUND 
      LDA B,I 
      ALF,RAL 
      AND .37 
      ADB A 
      STB TMP+1 
      CMB,INB 
      ADB TMP 
      SSB,RSS       IS FIRST < LAST 
      JMP PDLE      NO
      JSB .OK?,I    OK TO DELETE? 
      LDB STFE
      LDA TMP+1,I   FROM
      STA TMP,I     TO
      CPB TMP+1 
      JMP *+4       YES 
      ISZ TMP 
      ISZ TMP+1 
      JMP *-6 
      LDA TMP 
      STA STFE      YES 
      CLA 
      JMP PDL,I 
PDL.  JSB .OK?,I    OK TO DELETE? 
      LDA FWAMA+1 
      STA FWAMA 
      STA STFE
      CLA 
      STA STFE,I
      JMP PDL,I 
PDLE  CCA 
      JMP PDL,I 
      SKP 
*         STORE FILE FROM DEVICE
* 
PLD   NOP 
      JSB .CDN,I    GET DEVICE NUMBER 
      CLA,INA       USE DEFAULT LEFT DRIVE
      STA PLDDN     SAVE DEVICE NUMBER
PLD0  JSB .CFI,I    GET INPUT 
      SZA,RSS       ANY INPUT?
      JMP PLD2      NO
PLD1  STA PLDNC     SAVE COUNT
      SSA,RSS       EOT?
      JMP *+4 
      JSB HDRDY     PRINT TITLE AND READY 
      CLA 
      JMP PLD,I     YES RETURN
      JSB .PRST,I   PROCESS STATEMENT 
      JMP PLDE      ERROR 
PLD2  LDA PLDDN     INPUT AGAIN 
      JMP PLD0
* 
PLDE  CLA           OUTPUT LINE FOR OPERATOR
      LDB PLDNC 
      JSB .DVIO,I 
      DEF BUF 
      JSB WHAT      ASK !?
      JSB .FMT,I
      DEF BEEP
      CLA 
      JSB FMT.,I
      CLA 
      JSB .CFI,I
      JMP PLD1      TRY AGAIN 
* 
PLDNC NOP 
PLDDN NOP 
      SKP 
*         RUN PROCESSOR 
* 
PRU   NOP 
      JSB .CDN,I    GET STARTING LINE NUMBER
      JMP PRU1      NOT FURNISHED 
      JSB FNDLN     YES FIND THE LINE 
      JMP PRUE      NO FOUND
      LDA B         SAVE LINE ADDRESS 
      CLB           NO PROGRAM NAME 
      JMP PRU3+1
PRUE  CCA           ERROR RETURN
      JMP PRU,I 
PRU1  JSB GETB      CHECK FOR PROGRAM NAME
      JMP PRU2
      CPA .40       IS IT STILL A SPACE?
      JMP *-3       YES 
      JSB LTCK      NOW CHECK FOR A LETTER
      JMP PRU4      NO SO TRY AUTO RUN
      LDB A         PUT LETTER IN B REG.
      JMP PRU3
PRU2  CLB 
PRU3  LDA FWAMA     START AT BEGINNING
      CCE           NOT AUTO RUN
PRUR  JSB RUN 
      JMP PRU,I 
PRU4  CPA A!        IS THIS AUTO RUN? 
      CLB,CLE,RSS   YES 
      JMP PRUE      NO THEN ERROR 
      LDA FWAMA     SET STARTING ADDRESS
      JMP PRUR      NOW DO IT 
* 
RUN   NOP 
      STA CRSA      SAVE STARTING ADDRESS 
      STB CULN      SAVE PROGRAM NAME 
      LDB .20       SET PROCESSOR LEDS
      OTB 1 
      LDB IDTBP     SET POINTER TO TABLE
      LDA DM48      MAX ALLOWABLE SELECT CODES
      STA TMP 
      CLA 
      STA B,I       CLEAR FIRST ENTRY 
      SEZ           IS THIS AUTO
      JMP RUN1      NO SO SKIP TABLE
      CLC 0,C       TURN OFF THE WORLD
      CLA,INA       DIAGNOSE MODE 1 
      OTA 2 
RUN0  CLA 
      LIA 2 
      STA B,I 
      INB 
      STA B,I       CLEAR LAST ENTRY
      ISZ TMP       DONE? 
      JMP RUN0      NO
      SKP 
RUN1  CLA           CLEAR ALL TRAP CELLS
      OTA 2         TURN OFF DIAGNOSE MODE
      LDB .6
      STA B,I 
      CPB .77 
      JMP *+3 
      INB 
      JMP *-4 
      STA INTSC 
      STA INTF
      LDB INTLP     CLEAR INTERRUPT LINE NO. TABLE
      LDA B,I 
      CPA .M1       END OF TABLE? 
      JMP *+5       YES 
      CLA 
      STA B,I 
      INB 
      JMP *-6 
      CLA           CLEAR 
      STA GSCFL        GTSC LOOP FLAG 
      STA HOODF        HOOD FLAG
      JSB .IOPC,I      AND I O PROGRAMS 
      CLA,INA 
      JSB .IOPC,I 
      LDA .2
      JSB .IOPC,I 
      LDA .3
      JSB .IOPC,I 
      LDA STBFD     CLEAR GO SUB POINTER
      INA 
      STA STBF
      LDB BFTBA     CLEAR ALL BUFFER
      ADB .2          ALLOCATIONS 
      STB TMP 
      LDB DM52
      CLA 
      STA TMP,I 
      ISZ TMP 
      INB,SZB       ALL CLEARED?
      JMP *-3       NO
* 
      JSB IMAP      INITIALIZE MAPS 
      SKP 
      LDB DATAP     SET PARAMETERS OF INTEREST
      ADB BIT9
      ADB .M1       IN THE LAST DATA PARAMETERS 
      LDA DATAP     DATA STARTING ADDRESS 
      STA B,I 
      ADB .M1 
      LDA AFLG      START UP FLAG 
      STA B,I 
      ADB .M1 
      LDA BFLG
      STA B,I 
      ADB .M1 
      LDA LWAMA     LAST WORD OF MEMORY 
      STA B,I 
      ADB .M1 
      LDA STFE      STATEMENT FILE END
      STA B,I 
      ADB .M1 
      LDA VARA      SET VARABLES STARTING ADDRESS 
      ADA AA
      STA B,I 
      ADB .M1 
      LDA .IOA      STATING ADDRESS OF IO ROUTINES
      STA B,I 
      ADB .M1 
      LDA TMRC      1 MILL. TIME COUNT
      STA B,I 
      ADB .M1 
      CLA           CLEAR RUN STRING PARAMETERS 
      STA B,I 
      ADB .M1 
      STA B,I 
      ADB .M1 
      STA B,I 
      ADB .M1 
      STA B,I 
      STB TMP       SAVE ADDRESS OF #500
      LDA .M4       SET COUNT 
      STA TMP+1 
      LDA IDTBP,I   CHECK IF AUTOMATIC
      SZA,RSS 
      JSB .CPR,I    CONVERT INPUT 
      JMP *+6       NO MORE SO RUN
      JSB .GPR,I    GET ITS DATA
      STA TMP,I     PUT IT IN PLACE 
      ISZ TMP 
      ISZ TMP+1 
      JMP *-6 
      SKP 
      LDA FWAMA     SET TO SEARCH FOR NEW ALLOCATIONS 
      STA TMP 
      LDA LWAMA     GET LAST WORD OF MEMORY 
      STA BUFRP     SET BUFFER POINTER
RUN2  LDA TMP,I 
      SZA,RSS       END OF FILE?
      JMP RUN3      YES - SET INFO PARAMETERS 
      AND WCMSK     MASK OFF WORD COUNT 
      IOR STTBD     ADD BASE POINTER
      CPA RGT       GOTO? 
      JSB RGTS      YES 
      CPA RGS       GOSUB?
      JSB RGTS      YES 
      CPA RYE       YES?
      JSB RGTS      YES 
      CPA RPG       PROGRAM IDENTIFY? 
      JSB RPGR      YES 
      LDA TMP,I 
      ALF,RAL 
      AND .37 
      ADA TMP 
      STA TMP 
      JMP RUN2      DO NEXT LINE
* 
*     INITIALIZE MAPS 
* 
IMAP  NOP 
      CLA           INITIALIZE MAPS 
      LDB .100
      STA B,I       * 
      INA           * 
      INB           *   PROGRAM MAPS
      CPB .140      * 
      JMP *+2       * 
      JMP *-5 
      CLA           * 
      STA B,I       * 
      INB           *   DMA I/O MAPS
      CPB .200      * 
      JMP IMAP,I    * 
      JMP *-4       * 
      SKP 
*         PROGRAM NAME IDENTIFY 
* 
RPGR  NOP 
      LDA CULN      WAS A PROGRAM SPECIFIED 
      SZA,RSS       ??
      JMP RPGR,I    NO SO FORGET IT 
      LDB TMP       YES SO GET FIRST CHR OF PRGM STMT 
      ADB .4
      LDA B,I       GET WORD
      ALF,ALF       GET UPPER BYTE
      AND .177      MASK OFF OTHER BYTE 
      CPA CULN      IS THIS THE PROGRAM 
      JMP *+2 
      JMP RPGR,I    NOT THIS ONE - RETURN 
      LDA TMP       THIS IS IT
      STA CRSA      SET THIS LINE NUMBER
      JSB .PLN,I    PRINT PROGRAM 
      LDA CRSA      RESTOR TMP
      STA TMP 
      CLA 
      STA CULN      CLEAR LINE NUMBER 
      JMP RPGR,I    RETURN
* 
*         GOTO GOSUB YES LINE LOOKUP
* 
RGTS  NOP 
      LDB TMP       GET LINE NUMBER 
      ADB .2
      LDA B,I 
      JSB FNDLN     FIND IT 
      CLB           NOT FOUND 
      LDA TMP       PUT ADD. IN PLACE 
      ADA .3
      STB A,I 
      CLA 
      JMP RGTS,I
* 
RGT   DEF RGT.
RGS   DEF RGS.
RYE   DEF RYE.
RPG   DEF RPG.
      SKP 
RUN3  LDA CULN      CHECK IF PROGRAM NAME WAS PROCESSED 
      SZA 
      JMP PRUE      NO SO ERROR 
* 
      LDA DM100     SET COUNTER FOR 100 LINES 
      STA RGTS      SAVE AS COUNTER 
RUNL  ISZ RGTS      COUNT THIS ONE
      JMP *+6 
      LDA LEDS      TIME TO CHANGE LEDS 
      ALF,ALF 
      STA LEDS
      OTA 1         
      JMP RUNL-2    RESET COUNTER 
* 
      LDB CRSA      GET EXECUTE POINTER 
      LDA B,I 
      SZA           END OF FILE?
      JMP RUNL0 
      STA CULN      CLEAR LINE NUMBER 
      LDB .20       RESET LEDS
      OTB 1 
      CLF 0         INSURE INTERRUPTS ARE OFF 
      JMP RUN,I     YES EXIT
RUNL0 AND WCMSK     GET RUN PROCESSOR POINTER 
      IOR STTBD 
      INB 
      LDB B,I       GET LINE NUMBER 
      STB CULN
      LDA A,I 
      SZA           SKIP IF NO PROCESSOR
      JSB A,I       GO DO IT
      CLB 
      LDA B 
      SZB           CHANGE LINES? 
      JMP *+5       YES 
      LDA CRSA,I    NO GET NEXT LINE
      ALF,RAL 
      AND .37 
      ADA CRSA
      STA CRSA
      CLB           IF LAST INSTRUCTION 
      LDA IOSC        WAS AN IO INSTRUCTION 
      STB IOSC          THEN ALLOW ONE MORE INSTRUCTION 
      SZA                 BEFORE CHECKING INTERRUPTS
      JMP RUNL
      LDA INTF      ANY INTERRUPTS
      SZA           ? 
      JSB .PINT,I   YES 
      JMP RUNL      NOW CONTINUE
      SKP 
*         PARAMETER 
* 
* 
*         CONSTANT - ANY NUMBER 
*                   +32567 TO -32568 DECIMAL
*                   0 _ 177777 OCTAL
*                   0 _ FFFF HEX
* 
*         VARIABLE - ANY ALPHA CHARACTER   A TO Z 
*                    DATA - ANY #N  WHERE N= 0 TO 511 
* 
*         BUFFER - ANY ALPHA CHARACTER WITH 
*                   PARENTHESIS 
*                   A(...) TO Z(...)
* 
*                   ... = ANY NUMBER
*                   ... = ANY VARIABLE
* 
* 
*         JSB CPRAM CONVERT A PRAMETER
*                   NO MORE DATA
*         .         NORMAL RETURN 
*                   A + B = PRAM DEF
* 
* 
*         LDA PARAM 
*         LDB DEF 
*         JSB GPRAM GET PARAM ETER
*         .         NORMAL RETURN 
*                   A = PARAMETER 
*                   B = ADDRESS 
* 
* 
*         LDA PARAM 
*         LDB DEF 
*         JSB PPRAM LIST PARAMETER
*         .         NORAML RETURN 
      SKP 
*     PARAMETER DISCRIPTION 
* 
* 
*     111111
*     5432109876543210
*    ****************** 
*    *00XXX00000000000*  A
*    ******************  CONSTANT 
*    *     NUMBER     *  B
*    ******************     13= OCTAL  12= ASCII  11= HEX 
* 
*    ****************** 
*    *00000000VARIABLE*  A                    # = DATA
*    ******************  VARIABLE A B C ... Z 
*    *      BLANK     *  B                    DATA POSITION 
*    ****************** 
* 
*    ****************** 
*    *10000000VARIABLE*  A
*    ******************  BUFFER - CONSTANT A(123) 
*    *     NUMBER     *  B
*    ****************** 
* 
*    ****************** 
*    *11000000VARIABLE*  A
*    ******************  BUFFER - VARIABLE A(X) 
*    *    VARIABLE    *  B        A(!) = BUFFER STARTING ADDRESS
*    ****************** 
      SKP 
*              CONVERT A PARAMETER
* 
CPRAM NOP 
      JSB .CDN,I    TRY CONVERSION FOR CONSTANT 
      JMP CPR0      NOPE
      LDB A         OK
      CLA           INDICATE CONSTANT 
CPREX ISZ CPRAM     RETURN
      JMP CPRAM,I   P+2 
* 
CPR0  JSB GETB
      JMP CPRAM,I   NO MORE DATA
      CPA .40       SKIP SPACES 
      JMP *-3 
      CPA A$        ASCII EQU INPUT 
      JMP CPRA      YES 
      CPA A@        IS IT OCTAL INPUT?
      JMP CPRO      YES 
      CPA A&        HEX INPUT?
      JMP CPRH      YES 
      CPA A#        DATA AREA 
      JMP CPRD      YES 
      JSB LTCK      LETTER CHECK
      JMP CPRE      NOT A LETTER SO ERROR 
      STA GPRAM     SAVE CHARACTER
      LDB GETP
      JSB BUF2A 
      CPA FC.LP     HOW ABOUT A BUFFER
      RSS 
      JMP CPRV      NO JUST A VARIABLE
      ISZ GETP      MOVE PAST PREN
      JSB GETB
      JMP CPRE      GET WHAT INSIDE PRENS 
      JSB DGCK      IS IT A NUMBER
      JMP CPRBV     NO
      JSB .CVDC,I   CONVERT NUMBER
      SZA,RSS       ZERO NOT ALLOWED
      JMP CPRE
CPRBE JSB GETB      INSURE LAST CHARACTER IS RIGHT PREN 
      JMP CPRE      NO SO ERROR 
      CPA FC.RP     MUST BE RIGHT PAREN 
      RSS 
      JMP CPRE      NO SO ERROR 
      LDA GPRAM     GET BUFFER LABEL
      IOR BIT15     SET BUFFER FLAG 
      LDB CVN       GET CONSTANT LOCATION 
      JMP CPREX     RETURN P+2
      SKP 
CPRBV CPA A!        IS IT BUFFER ADDRESS
      JMP *+3       YES 
      JSB LTCK      CHECK IT'S A LETTER 
      JMP CPRE      NO SO ERROR 
      STA CVN       SAVE VARIABLE 
      LDA GPRAM     SET VARIABLE FLAG 
      IOR BIT14 
      STA GPRAM 
      JMP CPRBE 
* 
CPRV  LDA GPRAM     RETRIEVE VARIABLE 
      CLB 
      JMP CPREX     RETURN P+2
* 
CPRO  JSB .CON,I    CONVERT OCT NUMBER
      JMP CPRE
      LDB A 
      LDA BIT13     INDICATE OCTAL INPUT
      JMP CPREX 
* 
CPRA  JSB GETB      GET NEXT CHR
      JMP CPRE
      STA CVN       SAVE IT 
      LDA BIT12     INDICATE INPUT AS ASCII 
      LDB CVN 
      JMP CPREX 
* 
CPRE  CCA 
      JMP CPRAM,I   ERROR RETURN
* 
CPRH  JSB .CHN,I    CONVERT HEX NUMBER
      JMP CPRE      NO DATA 
      LDB A         CHANGE HANDS
      LDA BIT11     INDICATE HEX NUMBER 
      JMP CPREX     RETURN
* 
CPRD  JSB .CDN,I
      JMP CPRE      NO NUMBER 
      LDB A 
      ADA DATAM     CHECK LIMIT 
      SSA,RSS 
      JMP CPRE      OVER THE LIMIT
      LDA A#
      JMP CPREX     GOOD
      SKP 
*              GET A PARAMETER
* 
GPRAM NOP 
      SSA           IS IT A BUFFER? 
      JMP GBFPR     YES - GET BUFFER PARAMETER
      AND .177      NO - ELIMINATE UPPER BITS 
      SZA           IS IT A VARIABLE OR CONSTANT? 
      JMP *+4 
      LDA B         CONSTANT
      CLB           INDICATE NO ADDRESS 
      JMP GPRAM,I   RETURN
      CPA A#        DATA AREA 
      JMP GPRD      YES 
      LDB A         VARIABLE - BREG TO ADDRESS
      ADB VARA      ADD ADDRESS OF VARIABLES
      LDA B,I       GET CONTENTS
      JMP GPRAM,I   RETURN
GBFPR CLE,ELA 
      SSA,RSS       IS IT BUFFER VARIABLE?
      JMP *+3       NO
      CPB A!        IS IT A BUFFER ADDRESS? 
      JMP GBFAD     YES 
      SSA           VARIABLE ADDRESS? 
      ADB VARA      YES ADD ADDRESS OF VARIABLES
      SSA           VARIABLE BUFFER ADDRESS?
      LDB B,I       YES -GET IT 
      SSB,RSS       IF NUMBER IS NEG. 
      JMP *+3 
      LDA .7        THEN ERROR
      JSB ERR 
      AND .77       MASK UPPER BIT
      STA TMPA      SAVE BUFFER LABEL 
      LDA BFTBA     * 
      ADA TMPA      * 
      LDA A,I       * 
      SZA           IS BUFFER DEFINED 
      JMP *+3       YES 
GBFPE LDA .11       NO REPORT IT
      JSB ERR 
      ADA B         * 
      SZB,RSS       ZERO NOT ALLOWED
      JMP *+3 
      SKP 
      SSA           * 
      JMP *+3       * 
      LDA .10       NOT WITHIN BOUNDRIES OF BUFFER
      JSB ERR       REPORT ERROR
      LDA BFTBA     OK GET
      ADA TMPA
      INA 
      ADB A,I       ADDRESS 
      ADB .M1 
      LDA B,I       AND CONTENTS
      JMP GPRAM,I   RETURN
GBFAD AND .77       MASK UPPER BITS 
      ADA BFTBA     ADD BUFFER TABLE ADDRESS
      INA           MOVE PAST COUNT TO ADDRESS
      LDA A,I       GET THE ADDRESS 
      SZA,RSS       IS THERE A BUFFER DEFINED?
      JMP GBFPE     NO
      CLB           INDICATE NO STORE POINT 
      JMP GPRAM,I   RETURN
* 
GPRD  ADB DATAP     ADD POINTER 
      LDA B,I       GET DATA
      JMP GPRAM,I   RETURN
      SKP 
*         PRINT A PRAMETER
* 
PPRAM NOP 
      STA TMPA      SAVE A
      STB TMPB        AND B 
      SSA           IS THIS A BUFFER? 
      JMP PPRMB     YES 
      CPA A#        IS IT DATA
      JMP PPRMD     YES 
      AND .177
      SZA           IS IT A VARIABLE? 
      JMP PPRMV     YES 
      LDA TMPA
      RAL,RAL 
      SSA,RSS       IS IT OCTAL?
      JMP *+3 
      JSB PPRMO     YES OUTPUT IT 
      DEF PPRM1 
      RAL 
      SSA,RSS       IS IT ASCII?
      JMP *+3 
      JSB PPRMO     YES OUTPUT IT 
      DEF PPRM2 
      RAL 
      SSA,RSS       IS IT HEX?
      JMP *+3 
      JSB PPRMO     YES OUTPUT IT 
      DEF PPRM6 
      JSB PPRMO     NEITHER JUST A CONSTANT 
      DEF PPRM0 
PPRMV STA TMPB
      JSB PPRMO     OUTPUT A VARIABLE 
      DEF PPRM3 
PPRMB AND .177      PUT LABLE IN
      ALF,ALF         FORMAT
      IOR FC.LP 
      STA PPRM4+1 
      STA PPRM5+1 
      LDA TMPA
      RAL 
      SSA           IS IT A VARIABLE BUFFER 
      JMP *+3 
      JSB PPRMO     NO
      DEF PPRM4 
      JSB PPRMO     YES 
      DEF PPRM5 
PPRMD JSB PPRMO     OUTPUT DATA 
      DEF PPRM7 
      SKP 
PPRMO NOP 
      LDA PPRMO,I   GET POINTER 
      STA *+2 
      JSB .FMT,I    START OUTPUT
      NOP 
      LDA TMPB
      JSB FMT,I 
      JMP PPRAM,I   RETURN TO CALLER
* 
PPRM0 ASC 03,(%I6X) 
PPRM1 ASC 05,("@"%@6X)
PPRM2 ASC 04,("$"A1X) 
PPRM3 ASC 03,(A1X)
PPRM4 ASC 07,("X("%I5")"X)
PPRM5 ASC 06,("X("A1")"X) 
PPRM6 ASC 05,("&"%H4X)
PPRM7 ASC 05,("#"%I3X)
      SKP 
*     STATEMENTS     (LN = LINE NUMBER) 
* 
*     PROGRAM CONTROL 
* 
*     LN  REM  <ANY ASCII STRING> 
*     LN  PRGM X +ANY ASCII STRING
*     LN  GOTO LN 
*     LN  GOSB LN 
*     LN  RTN 
*     LN  CFS 
*     LN  STOP  X    X=DATA FOR LEDS IF NO VCP  
*     LN  GTSC  @13500  S 
*     LN  HOOD
*     LN  WAIT
*     LN  DLY  TIME 
* 
*     DATA MANIPULATION 
* 
*     LN  BFMP  R  P
*     LN  IOMP  R  P
*               WHERE R=REGISTER  AND P=PAGE
*     LN  BUF  A(#) B(#) C(#) ... Z(#)  (#=MAX BUF SIZE)
*     LN  IBP  C(1) C(10) XX
*         WHERE XX =      R1/R0  ROTATING 1 OR 0
*                         C1/C2  CYCLIC ASCII 64 OR 128 
*                         IP/ID  INCREMENT PROGRESSIVE OR DIGRESSIVE
*                         AH/AV  ALTERNATING HOR. OR VERTICAL 
*                         CL/CC  CLEAR OR CLEAR &COMPPLEMENT
*                         CM     COMPLEMENT CONTENTS
*                         PA/UA LN  PACKED/UNPACKED ASCII STRING
*     LN  CPBF A(1) B(1) COUNT MASK 
*     LN  LET  X=(FUNCTION) 
*     LN  SKIF X><=#(FUNCTION)
*     FUNCTION = A+B-C*D/E OR A(1)-B+C(23)/D(12)
* 
*     MESSAGES  IN/OUT
* 
*     LN  INPT A(1) B Z      CONSOLE
*     LN  CTRL C J H(I)      LEFT CARTRIDGE TAPE
*     LN  CTRR K L M(N)      RIGHT CARTRIDGE TAPE 
*     LN  YES? LN 
*     LN  PRNT 300 A B(12)   CONSOLE
*     LN  CTWL C L O         LEFT CARTRIDGE TAPE
*     LN  CTWR F K L         RIGHT CARTRIDGE TAPE 
*     LN  FMT  (I6XX"EXAMPLE"XI4/)
      SKP 
*     I/O CONTROL 
* 
*     LN  LIA  @10 A(1)    **LIAC = ALSO CLEAR FLAG 
*     LN  OTA  @10 A(1)    **OTAC = ALSO CLEAR FLAG 
*     LN  SFC  @10
*     LN  SFS  @10
*     LN  STF  @10
*     LN  CLF  @10
*     LN  STC  @10         **STCC = ALSO CLEAR FLAG 
*     LN  CLC  @10         **CLCC = ALSO CLEAR FLAG 
*     LN  INT  @10 200     **OR LETTER OF I O ROUTINE FOR DIRECT JSB
*     LN  WFI  @10 1000 
* 
*     IO ROUTINES 
* 
*     THERE ARE FOUR (A,B,C,D) IO ROUTINES
*     TO CREATE AN INSTRUCTION
*     LN  IOA  LDA X   GET PRAMETER 
*     LN  IOA  STA Z
*     ETC.
* 
*     TO EXECUTE IO ROUTINE 
*     LN  IORA
* 
*     TO CLEAR IO ROUTINE 
*     LN  IOCA
* 
*     ALL MRG SRG ASG ARE AVAILABLE 
*     PLUS I/O INSTRUCTIONS 
      SKP 
*     STATEMENT FILE LAYOUT 
* 
*     ********************* 
*     *                   *  BITS 0-9 = STATEMENT TABLE N0. 4 
*     * WC / RUN TBL PTR  * 
*     *                   *  BITS 11-15 = NUMBER OF WORDS 
*     ********************* 
*     *                   * 
*     *    LINE NUMBER    * 
*     *                   * 
*     ********************* 
*     *                   * 
*     *      WORD 3       * 
*     *                   * 
*     ********************* 
*     $                   $ 
*     ********************* 
*     *                   * 
*     *      WORD N       *  N NOT GREATER THAN 31
*     *                   * 
*     ********************* 
* 
      SKP 
*         PROCESS STATEMENT 
* 
      ORG 4000B 
PRSTM NOP 
      JSB .CDN,I    CONVERT NUMBER
      JMP PRSTM,I   NOT A NUMBER SO ERROR 
      SSA,RSS       CANT BE NEGATIVE
      SZA,RSS       ZERO IS NOT ALLOWED 
      JMP PRSTM,I 
      STA STBF+1    SAVE LINE NUMBER
      LDA MXLN
      CMA 
      ADA STBF+1
      SSA,RSS       IS LN OVER THE MAX
      JMP PRSTM,I   YES - SO ERROR
      LDA .M4       SET FOR FOUR CHARACTERS 
      STA TMPA      AND SAVE IT 
      LDB TMPD      MOVE LABEL TO 
      RBL           MAKE NEW LOCATION BYTE ADDRESS
      STB PUTP
      JSB GETB      GET A BYTE FROM BUFFER
      JMP STDL      DELETE THE LINE 
      CPA .40       CHECK FOR SPACE 
      JMP *-3 
      JMP *+3 
      JSB GETB
      LDA .40       IF BUF EMPTY USE SPACE
      JSB PUTC
      ISZ TMPA      FINISHED? 
      JMP *-4       NO
      JSB GETB      YES SO CHECK NEXT CHR 
      JMP STP.0-2   (IF BUFFER EMPTY SKIP CHECK)
      CPA .40       IS IT 
      JMP *-3       YES TRY NEXT ONE
      CCA           NO  BACK UP POINTER ONE 
      ADA GETP
      STA GETP
      LDA STTBD     SET UP FOR STATEMENT TABLE
      STA TMPA      SEARCH
STP.0 LDA TMPA,I
      CPA .M1       END OF TABLE? 
      JMP PRSTM,I   YES - SO ERROR
      ISZ TMPA
      LDB TMPA,I
      ISZ TMPA
      CPA TMP       FIRST OK
      JMP *+5       YES 
STP.1 ISZ TMPA      NEITHER 
      ISZ TMPA      MOVE TO NEXT ONE
      ISZ TMPA
      JMP STP.0     TRY IT
      CPB TMP+1     SECOND OK 
      RSS           YES 
      JMP STP.1     NO
      SKP 
      LDB TMPA,I    GET SYNTAX POINTER
      ISZ TMPA
      LDA TMPA      SAVE RUN POINTER
      AND WCMSK 
      STA STBF
      LDA STBFD     SET POINTER FOR SYNTAX
      ADA .2
      STA TMP 
      CLA 
      SZB,RSS 
      JMP *+3       SKIP IF NO SYNTAX PROCESSOR 
      JSB B,I       GO TO SYNTAX PROCESSOR
      JMP PRSTM,I   ERROR RETURN
      ADA .2
      ALF,ALF 
      ALF,RAR       ADD WORD COUNT
      IOR STBF        TO
      STA STBF         RUN POINTER
      LDA STBF+1      LINE NUMBER 
      JSB FNDLN     TRY TO FIND IT
      SZA,RSS       END OF BUFFER?
      JMP *+3       YES 
      CLB 
      JMP STP.2 
      LDA FNDLA,I   GET OLD COUNT 
      ALF,RAL 
      AND .37 
      CMA,INA 
      STA B 
STP.2 LDA STBF      GET NEW COUNT 
      ALF,RAL 
      AND .37 
      ADA B         DETERMINE DIFFERENTIAL
      LDB FNDLA     ADJUST
      JSB .MVW,I      AREA
      LDA STBF      MOVE NEW LINE IN
      ALF,RAL 
      AND .37 
      CMA,INA 
      STA TMPA
      LDA STBFD 
      STA TMPB
      LDA TMPB,I
      STA FNDLA,I 
      ISZ FNDLA 
      ISZ TMPB
      ISZ TMPA
      JMP *-5 
      JMP STP.E     RETURN P+2
      SKP 
*     DELETE A LINE 
* 
STDL  JSB .OK?,I    OK TO DELETE? 
      LDA STBF+1
      JSB FNDLN     FIND LINE IN FILE 
      JMP STP.E     NOT FOUND SO FORGET IT
      LDA B,I 
      ALF,RAL 
      AND .37 
      CMA,INA 
      JSB .MVW,I    CLOSE UP AREA 
* 
* 
* 
*     SET PROM COUNT AND ADDRESS
* 
STP.E LDA FWAMA 
      CMA,INA 
      ADA STFE
      CMA,INA 
      AND .M2K
      IOR .2
      LDB FWAMA 
      ADB .M2 
      STA B,I 
      LDA FWAMA 
      INB 
      STA B,I 
* 
      ISZ PRSTM 
      JMP PRSTM,I 
      SKP 
* 
* 
OK?   NOP 
      JSB .FMT,I    ASK IF OK 
      DEF OK?M
      CLA 
      JSB FMT.,I
      CLA 
      JSB .CFI,I    GET ANSWER
      SZA,RSS 
      JMP OK?,I     YES RETURN
      LDA BUF       GET CHRS
      CPA AYE       IS IT YES?
      JMP OK?,I     YES  RETURN 
      JSB .FMT,I    INDICATE ABORT
      DEF AB?M
      CLA 
      JSB FMT.,I
      JMP IRQ,I     NO ABORT OPERATION
* 
OK?M  ASC 04,("OK?")
AB?M  ASC 05,("ABORT"/) 
* 
SIZE  NOP 
      JSB .FMT,I    START FORMAT
      DEF SIZM      POINT TO FORMAT STRING
      LDA MXLN      GET NUMBER OF LINES 
      INA 
      JSB FNDLN 
      NOP 
      LDA FNDLC 
      JSB FMT,I     OUTPUT NUMBER OF LINES
      LDA FWAMA     GET START OF STATEMENT FILE 
      CMA,INA       SUBTRACT IT FORM
      ADA STFE      END OF STATEMENT FILE 
      JSB FMT,I     PIT IT IN THE STRING
      CLA 
      JSB FMT.,I    OUT PUT STRING
      CLA           GOOD RESULTS
      JMP SIZE,I    RETURN
* 
SIZM  ASC 17,(I6" LINES AND "I6" WORDS USED"/)
      SKP 
*     RENUMBER COMMAND
*     THIS COMMAND WILL RENUMBER THE STATEMENT FILE 
*     USING THE SPACING SPECIFIED OR DEFAULT TO 10
* 
RENM  NOP 
      JSB .CDN,I    GET SPACING 
      LDA D10       DEFAULT TO 10 
      SZA           CAN'T BE SERO 
      SSA             OR NEGATIVE 
      JMP RENME 
      STA TMP       SAVE SPACING
      JSB .CDN,I    NOW GET OFFSET
      CLA           ZERO IF NOT SUPPLIED
      SSA           CANT BE NEGATIVE
      JMP RENME     IT WAS
      STA TMP+2     SAVE OFFSET 
      LDA MXLN      GET NUMBER OF STATEMENTS
      INA 
      JSB FNDLN 
      NOP 
      LDA FNDLC     WILL IT OVER FLOW?
      MPY TMP 
      SSA,RSS       ? 
      SZB 
      JMP RENME     YES SO ERROR
      ADA TMP+2     ADD OFFSET
      SSA           IF NEGATIVE THEN ERROR
      JMP RENME     IT WAS
* 
      JSB .OK?,I    ASK IF IT'S OK
      SKP 
      LDA FWAMA     START WITH FIRST STATEMENT
RENM0 STA CRSA      SET POINTER 
      LDA A,I       GET POINTER TO STATEMENT
      SZA,RSS       END OF FILE?
      JMP RENM2     YES  RE SEQUENCE FILE 
      AND WCMSK     ELIMINATE WORD COUNT
      IOR STTBD 
      CPA RE.GT     IS IT GOTO? 
      JMP REGSY     YES 
      CPA RE.GS     IS IT GOSUB?
      JMP REGSY     YES 
      CPA RE.YS     IS IT YES?
      JMP REGSY     YES 
      CPA RE.IT     IS IT INTERRUPT?
      JMP REINT     YES 
      CPA RE.IP     IS IT INITIALIZE BUFFER PATTERN 
      JMP REIBP     YES 
      CPA RE.PT     IS IT PRINT?
      JMP REPNT     YES 
      CPA RE.CL     IS IT CTWL? 
      JMP REPNT     YES 
      CPA RE.CR     IS IT CTWR? 
      JMP REPNT     YES 
* 
RENM1 LDA CRSA,I    NONE SO MOVE TO TEXT STATEMENT
      ALF,RAL 
      AND .37 
      ADA CRSA
      JMP RENM0       AND DO IT 
RENME CCA 
      JMP RENM,I    RETURN WITH ERROR 
      SKP 
REGSY LDB .2        POINT TO LOCATION IN FILE 
RENMX ADB CRSA
      STB TMP+1     SAVE ADDRESS
      LDA B,I       GET NUMBER
      JSB FNDLN     FIND IT 
      JMP RENM1     SKIP UPDATE IF NO NUMBER
      LDA FNDLC     GET COUNT 
      MPY TMP       SET NEW NUMBER
      ADA TMP+2     ADD OFFSET
      STA TMP+1,I   OVER WRITE THE OLD ONE
      JMP RENM1     DO NEXT LINE
REINT LDB .4        POINT TO LINE NUMBER
      JMP RENMX     AND CHANGE IT 
REIBP LDB .7
      ADB CRSA      CHECK IF IT'S A NUMBER ONLY 
      LDA B,I 
      SZA 
      JMP RENM1     IT ISN'T SO SKIP UPDATE 
      LDB .10 
      JMP RENMX     OK DO IT
REPNT LDB .3
      ADB CRSA
      LDA B,I 
      SZA,RSS 
      JMP RENM1 
      JMP RENMX+1 
* 
RENM2 LDA FWAMA     RENUMBER FILE 
      STA CRSA
      LDA TMP 
      STA TMP+1 
RENM3 LDB CRSA
      LDA B,I       CHECK IF END OF FILE
      SZA,RSS 
      JMP RENM,I    YES RETURN
      INB 
      LDA TMP+1 
      ADA TMP+2     ADD OFFSET
      STA B,I       PUT NEW NUMBER IN FILE
      LDA TMP+1 
      ADA TMP 
      STA TMP+1     MOVE TO NEXT NUMBER 
      LDA CRSA,I
      ALF,RAL 
      AND .37 
      ADA CRSA
      STA CRSA
      JMP RENM3 
* 
RE.GT DEF RGT.
RE.GS DEF RGS.
RE.YS DEF RYE.
RE.IT DEF RIT.
RE.IP DEF RIP.
RE.PT DEF RPT.
RE.CL DEF RCWL. 
RE.CR DEF RCWR. 
      SPC 3 
*     PROGRAM - LIST ALL PROGRAM STATEMENTS 
* 
PROG  NOP 
      LDA FWAMA     START AT BEGINNING
      STA CRSA
      LDA CRSA,I
      SZA,RSS       ANYTHING IN THE FILE
      JMP PROG,I
      AND WCMSK     GET POINTER 
      IOR STTBD     ADD OFFSET ADDRESS
      CPA PRRPG     IS THIS A PROGRAM STATEMENT 
      JSB .PLN,I    YES SO PRINT IT 
      LDA CRSA,I    GET COUNT FOR 
      ALF,RAL       NEXT LINE 
      AND .37       COUNT ONLY
      ADA CRSA
      JMP PROG+2    OK LOOP ON IT.
* 
PRRPG DEF RPG.
      SKP 
*     EDIT  COMMAND 
*     THIS COMMAND WILL OUTPUT THE REQUESTED LINE 
*     AND SAVE THE BUFFER THEN ASK FOR INPUT OF THE EDIT LINE 
*     FROM THE EDIT LINE A NEW LINE BUILT IN THE BUFFER AREA
* 
*     THE STANDARD EDIT COMMANDS ARE USED 
*                   / - RETAIN SAME CHARACTER 
*               CTL S - INSERT FOLLOWING CHARACTERS 
*               CTL I -   "       "          "
*               CTL R - REPLACE FOLLOWING CHARACTERS
*               CTL T - TRUNCKATE REST OF LINE
*               CTL C - CLEAR FOLLOWING CHARACTERS
* 
EDIT  NOP 
      JSB .CDN,I    GET LINE NUMBER 
      JMP EDIE      NO NUMBER SO ERROR
      JSB FNDLN     FINE LINE NUMBER
      JMP EDIE      NO LINE SO ERROR
      STB CRSA      SAVE POINTER
      JSB .PLN,I    PRINT THE LINE NUMBER 
* 
      LDA DM40      SET TO SAVE OUTPUT BUFFER 
      STA TMP 
      LDA BUFA      GET BUFFER POINTER
      CLE,ERA       MAKE ADDRESS
      STA TMP+1 
      LDB SBUFA     GET SAVE BUFFER 
      LDA TMP+1,I   TRANSFER DATA 
      STA B,I 
      INB 
      ISZ TMP+1 
      ISZ TMP       DONE
      JMP *-5       NO
* 
EDI.J CLA           GET EDIT LINE 
      LDB DM72
      JSB .DVIO,I 
TBUFA DEF TBUF
      SZA,RSS       ANY INPUT 
      JMP EDIT,I    NO THEN JUST RETURN 
      LDB TBUFA 
      CLE,ELB 
      ADB A 
      LDA .15       PUT TERMINATOR IN BUFFER
      JSB A2BUF 
      LDA TBUFA     SET GET POINTER 
      CLE,ELA       MAKE IT BYTE
      STA GETP
      LDA BUFA      SET NEW BUFFER POINTER
      STA PUTP
      LDA SBUFA     SET SAVE BUFFER POINTER 
      CLE,ELA       MAKE IT BYTE
      STA TMP 
      SKP 
EDI.R JSB EDIGB     GET A BYTE AND CHECK IT 
      STA TMP+1     SAVE CHARACTER
      LDB TMP       GET A CHR FROM SAVE BUFFER
      JSB BUF2A 
      CPA .15       END OF BUFFER 
      JMP EDI.1     YES 
      ISZ TMP       MOVE TO NEXT CHR
EDI.0 LDB TMP+1     CHECK PREVIOUS CHR
      CPB A/        LEAVE IT? 
      RSS 
      LDA B         YES 
      JSB PUTC
      JMP EDI.R     TRY NEXT ONE
EDI.1 LDA .40       USE SPACE 
      JMP EDI.0 
* 
EDI.I JSB EDIGB     GET NEXT CHARACTER
      JSB PUTC      PUT IT IN BUFFER
      JMP *-2 
* 
EDI.C JSB EDIGB     GET NEXT CHARACTER
      LDB TMP       CHECK IF END OF BUFFER
      JSB BUF2A 
      CPA .15       END OF BUFFER?
      JMP EDI.C     YES SKP ADDRESS ADJUST
      ISZ TMP 
      JMP EDI.C 
* 
EDI.T LDA .15       ADD TERMINATOR TO BUFFER
      JSB PUTC
      LDA BUFA      NOW PROCESS LINE
      STA GETP
      JSB .PRST,I 
EDIE  CCA,RSS       ERROR IN PROCESSING 
      CLA 
      JMP EDIT,I    DONE
* 
EDI.X LDB TMP       CHECK IF ANY MORE IN SAVE BUFFER
      JSB BUF2A 
      CPA .15       END 
      JMP EDI.T     YES 
      JSB PUTC      NO ADD CHR TO BUFFER
      ISZ TMP 
      JMP EDI.X     TRY NEXT ONE
      SKP 
EDIGB NOP 
      JSB GETB      GET NEXT BYTE 
      JMP EDI.X     NO MORE DATA COPY REST OF SBUF
      CPA A.R       REPLACE CHARACTER?
      JMP EDI.R     YES 
      CPA A.I       INSERT CHARACTER? 
      JMP EDI.I     YES 
      CPA A.S       INSERT CHARACTER? 
      JMP EDI.I     YES 
      CPA A.C       CLEAR CHARACTERS? 
      JMP EDI.C     YES 
      CPA A.T       TRUNCATE REST OF LINE?
      JMP EDI.T     YES 
      JMP EDIGB,I   NONE SO RETURN WITH CHARACTER 
* 
SBUFA DEF SBUF
SBUFC NOP 
* 
      SKP 
*     THIS ROUTINE ENABLES THE OPERATOR TO
*     EXAMINE OR CHANGE MAPS FORM THE CONSOLE 
*     MAP R P   WHERE R = LOCATION REGISTER (100-177) 
*                     P = PAGE NUMBER (40-377)
*                     R=0 MAPS OFF (140=0)
*                     R=-1 MAPS ON (140=-1) 
* 
MAP   NOP 
      CLC 11B       TURN OFF MAPS FOR OPERATION 
      JMP *+1       DO IT 
      JSB .CON,I    GET MAP REGISTER
      JMP MAPL      NO DATA SO LIST REGISTERS 
      STA TMP       SAVE REGISTER 
      SZA           MAP OFF 
      JMP *+3       NO
      STA 140B      YES SO TURN MAPS OFF
      JMP MAPEX     RETURN
      CMA,SZA       MAP ON
      JMP MAP0      NO THEN IT'S  A REGISTER
      CCA           YES SO TURN MAPS ON 
      STA 140B      AND SET FLAG
MAPEX CLA,RSS 
      CCA 
      LDB 140B      ON OR OFF 
      SZB 
      STC 11B       ON
      JMP MAP,I 
* 
MAPL  LDA .100      SET STARTING MAP
      STA TMP 
MAPL0 LDA .M4 
      STA TMP+1     SET COUNT 
      LDB TMP 
      CPB .200      END OF MAPS?
      JMP MAPEX     YES RETURN
      JSB .FMT,I    SET UP FORMATTER
      DEF MAPM
MAPL1 LDA TMP       OUTPUT MAP REGISTER 
      JSB FMT,I 
      LDA TMP,I     GET MAP CONTENTS
      JSB FMT,I 
      ISZ TMP 
      ISZ TMP+1     DONE 4
      JMP MAPL1     NO
      CLA           OUTPUT TO TERMINAL
      JSB FMT.,I
      JMP MAPL0     TRY NEXT ONE
* 
MAPM ASC 08,(4(K3"="K6XX)/) 
      SKP 
MAP0  LDA STFE      SET LOWEST PAGE NUMBER
      ALF 
      RAL,RAL 
      AND .77 
      CMA 
      STA TMP+2 
      JSB .CON,I    GET PAGE NUMBER 
      JMP MAPEX+1   NO PAGE SO ERROR
      STA TMP+1     SAVE IT 
      SZA,RSS       IF ZERO THEN OK 
      JMP *+4 
      ADA TMP+2     CANT BE LESS THAN STFE
      SSA 
      JMP MAPEX+1   IS WAS
      LDA TMP       NOW CHECK REG NO. 
      CPA .140      CANT BE FLAG REG. 
      JMP MAPEX+1   IT IS SO ERROR
      ADA .M77      CANT BE LESS THAN 100 
      SSA 
      JMP MAPEX+1   IT WAS SO ERROR 
      CMA,INA 
      ADA .40       IF GREATER THAN 40 THEN 
      SSA 
      JMP MAP1      IT MUST BE DMA
      LDA TMP       CHECK NOT LESS THAN STFE
      ADA TMP+2 
      ADA .M77
      SSA 
      JMP MAPEX+1 
      LDA TMP 
      AND .77       SET FOR CLEAR 
      LDB TMP+1 
      SZB 
      LDA TMP+1 
      STA TMP,I 
      JMP MAPEX 
MAP1  LDA TMP+1 
      STA TMP,I 
      JMP MAPEX 
      SKP 
*     ERROR MESSAGE TABLE 
* 
ERRMT DEF ERM00 
      DEF ERM01 
      DEF ERM02 
      DEF ERM03 
      DEF ERM04 
      DEF ERM05 
      DEF ERM06 
      DEF ERM07 
      DEF ERM08 
      DEF ERM09 
      DEF ERM10 
      DEF ERM11 
      DEF ERM12 
      DEF ERM13 
      DEF ERM14 
      DEF ERM15 
      DEF ERM16 
      DEF ERM17 
      DEF ERM18 
      DEF ERM19 
      DEF ERM20 
      DEF ERM21 
      DEF ERM22 
      DEF ERM23 
* 
ERM00 ASC 13,("= STATEMENT FILE FULL"/) 
ERM01 ASC 14,("= LINE NUMBER NOT FOUND"/) 
ERM02 ASC 18,("= GOSB OVERFLOW (MORE THAN 24)"/)
ERM03 ASC 19,("= RTN TO WHAT LINE (NO GOSB LINE)"/) 
ERM04 ASC 17,("= INPUT CALL WITH NO CONSOLE"/)
ERM05 ASC 18,("= 'LETC' MATHEMATICAL OVERFLOW"/)
ERM06 ASC 13,("= WRITE ERROR TO CTU"/)
ERM07 ASC 13,("= NEG BUFFER REQUEST"/)
ERM08 ASC 19,("= REQUEST OUT OF LIMITS OF BUFFER"/) 
ERM09 ASC 13,("= BUFFER NOT DEFINED"/)
ERM10 ASC 14,("= DOUBLY DEFINED BUFFER"/) 
ERM11 ASC 19,("= NOT ENOUGH ROOM FOR ALL BUFFERS"/) 
ERM12 ASC 14,("= NO FORMAT LINE NUMBER"/) 
ERM13 ASC 18,("= INITIALIZE BOUNDRIES IN ERROR"/) 
ERM14 ASC 17,("= COMPARE COUNT ZERO OR NEG"/) 
ERM15 ASC 12,("= SELECT CODE > 77"/)
ERM16 ASC 12,("= BAD FORMAT ERROR"/)
ERM17 ASC 17,("= INT CAUSED GOSB OVERFLOW"/)
ERM18 ASC 13,("= NO ASC LINE NUMBER"/)
ERM19 ASC 11,("= ILLEGAL REQUEST"/) 
ERM20 ASC 13,("= DS DRIVER TIME-OUT"/)
ERM21 ASC 16,("= MAP REQUEST OUT OF LIMITS"/) 
ERM22 ASC 19,("= JMP INST. IN I/O OUT OF LIMITS"/)
ERM23 ASC 19,("= I/O FULL INSTRUCTION NOT ADDED"/)
      SKP 
*         STATEMENT LIST
* 
PLI   NOP 
      CLA           CONSOLE OUTPUT
      JSB PLFR
      JMP PLI,I 
* 
PSV   NOP 
      JSB .CDN,I    GET DEVICE NUMBER 
      CLA,INA       USE DEFAULT LEFT DRIVE
      JSB PLFR
      JMP PSV,I 
* 
PLFR  NOP 
      STA DVN       SAVE DEVICE NUMBER
      JSB .CDN,I    GET STARTING NUMBER 
      CLA           IF NO NUMBER USE 0
      STA TMP+1     SAVE IF ONLY ONE NUMBER 
      JSB FNDLN     FIND FIRST LINE NUMBER
      NOP 
      STB CRSA      SAVE POINTER
      JSB .CDN,I    GET ENDING LINE NUMBER
      LDA TMP+1     NO NUMBER SO USE FIRST
      SZA,RSS       WAS IT DEFAULTED? 
      LDA MXLN      USE 1999 IF FIRST WAS DEFAULT 
      CMA           MAKE IT NEGATIVE
      STA TMP+1     SAVE IT 
PLFL  LDA CRSA,I
      SZA,RSS       IF ZERO END OF BUFFER 
      JMP PLFR,I    RETURN
      LDB CRSA      ISOLATE LINE NUMBER 
      INB 
      LDA B,I 
      LDB A         CHECK IF LAST NUMBER
      ADB TMP+1 
      SSB 
      JMP *+3 
      CLA 
      JMP PLFR,I    YES RETURN
      JSB .PLN,I    PRINT LINE
      LDA CRSA,I    MOVE TO NEXT LINE 
      ALF,RAL 
      AND .37 
      ADA CRSA
      STA CRSA
      JSB STOP      CHECK OPERATOR INTERRUPT
      JSB .STOP 
      JMP PLFL      NO SO CONTINUE
      SKP 
*     PRINT A SINGLE LINE POINTED TO BY CRSA
* 
PLN   NOP 
      JSB .FMT,I    OUTPUT LINE NUMBER AND STATEMENT LABLE
      DEF LSTM
      LDB CRSA      GET LINE NUMBER 
      INB 
      LDA B,I 
      JSB FMT,I 
      LDA CRSA,I    OUTPUT STATEMENT LABLE
      AND WCMSK 
      IOR STTBD 
      LDB A 
      INB 
      LDA B,I 
      STA TMP+2     SAVE LIST POINTER 
      ADB .M4 
      LDA B,I 
      INB 
      STB TMP+3 
      JSB FMT,I 
      LDA TMP+3,I 
      JSB FMT,I 
      LDA CRSA      SET POINTER FOR LIST ROUTINES 
      ADA .2
      STA TMP 
      LDA TMP+2     GET LIST PROCESSOR
      SZA           SKIP IF NO LIST PROCESSOR 
      JSB A,I 
      JSB .FMT,I    DO CRLF 
      DEF CRLF
      LDA DVN       GET DEVICE NUMBER 
      JSB FMT.,I    PRINT IT AND RESET BUFFER 
      JMP PLN,I     RETURN TO CALLER
* 
LSTM  ASC 05,(I5X2A2X)
      SKP 
*         MOVE WORDS
*         LDA <NUMBER OF WORDS> 
*         LDB <ADDRESS OF LAST WORD>
*         JSB MWORD 
* 
MWORD NOP 
      SZA,RSS       IS THERE ANY MOVE?
      JMP MWORD,I   NO RETURN 
      STA TMPA      SAVE COUNT
      SSA           IS IT A POSITIVE OR NEG MOVE? 
      JMP MWDN      NEG 
      ADA STFE      CHECK IF THERE WILL BE ROOM 
      CMA,INA 
      STA TMPB      SV RESULT 
      LDA LWAMA     GET LAST WORD OF MEMORY 
      ADA TMPB
      SSA,RSS       ? 
      JMP *+3       OK
      CLA           NO - TELL OPERATOR
      JSB ERR       "STATEMENT FILE FULL
      LDA STFE
      STA TMPB
      ADA TMPA
      STA TMPA
      STA STFE
MWDL  LDA TMPB,I
      STA TMPA,I
      CPB TMPB
      JMP MWORD,I   FINISHED EXIT 
      CCA 
      ADA TMPA
      STA TMPA
      CCA 
      ADA TMPB
      STA TMPB
      JMP MWDL
* 
MWDN  LDA B,I       DETERMINE 
      ALF,RAL         FROM
      AND .37 
      ADB A 
      STB TMPB
      ADB TMPA      SET TO
      STB TMPA      ADDRESS 
      LDB STFE      GET LAST ADDRESS
MWDNL LDA TMPB,I
      STA TMPA,I
      CPB TMPB      FINISHED
      JMP *+4 
      ISZ TMPB
      ISZ TMPA
      JMP MWDNL 
      LDA TMPA      SET END OF FILE ADDRESS 
      STA STFE
      JMP MWORD,I   RETURN
      SKP 
*     BUFFER SYNTAX 
* 
      ORG 6000B 
BUFSY NOP 
      LDA DM10      ALLOW ONLY 10 PER LINE
      STA STBF+2
      ISZ TMP 
BUFSN JSB FPS       FILE PARAMETER STORE
      JMP BUFSE     NO MORE CHECK FOR ERROR 
      SSA,RSS       IS IT A BUFFER DISCRIPTION
      JMP BUFSY,I   NO- SO ERROR
      RAL 
      SSA           MUST BE A NUMBER
      JMP BUFSY,I   NO SO ERROR 
      LDA STBF+2    OVER TEN INPUTS 
      SZA,RSS       ? 
      JMP BUFSY,I   YES 
      INA           OK COUNT IT 
      STA STBF+2
      JMP BUFSN     AND DO NEXT ONE 
* 
BUFSE CPA .15       IS IT END OF BUFFER 
      ISZ BUFSY     YES 
      LDA D10       DETERMINE INPUT COUNT 
      ADA STBF+2
      CMA,INA 
      STA STBF+2
      CMA,INA 
      RAL           DOUBLE COUNT
      INA           ADD COUNT 
      JMP BUFSY,I   RETURN
      SKP 
BUFRU NOP 
      LDA CRSA      GET NUMBER OF BUFFERS 
      ADA .2
      LDB A,I 
      INA           AND ADDRESS 
      STA BUFRA     SAVE THEM 
      STB BUFRC 
      SZB,RSS       IF NO BUFFER PARAMETERS THEN
      JMP BUFCL       CLEAR ALL BUFFER ALLOCATIONS
BUFRL LDA BUFRA,I   HAS IT BEEN DEFINED 
      AND .37 
      RAL 
      ADA BFTBA 
      LDB A,I 
      SZB,RSS       ? 
      JMP *+3 
      LDA .12       YES SO ERROR
      JSB ERR 
      ISZ BUFRA     NO
      LDB BUFRA,I   GET COUNT 
      ISZ BUFRA 
      CMB           NEGATE IT 
      STB A,I 
      INB 
      ADB BUFRP     DETERMINE ADDRESS 
      INA 
      STB A,I 
      STB BUFRP 
      CMB           STILL ROOM
      ADB STFE
      SSB           ? 
      JMP *+3 
      LDA .13       NO
      JSB ERR       SO ERROR
      ISZ BUFRC     DONE WITH THIS STATEMENT
      JMP BUFRL     NO
      CLA 
      JMP BUFRU,I   YES 
* 
BUFCL LDB BFTBA     CLEAR BUFFER ALLOCATIONS
      ADB .2
      STB BUFRA 
      LDB DM52      ALL OF THEM 
      CLA 
      STA BUFRA,I 
      ISZ BUFRA 
      INB,SZB 
      JMP *-3 
      LDB LWAMA     RESET BUFFER LAST ADDRESS 
      STB BUFRP 
      JMP BUFRU,I   RETURN
      SKP 
*     BUFFER DEF LIST 
* 
BUFLI NOP 
      LDA TMP,I     GET INPUT COUNT 
      ISZ TMP 
      STA LIC       SAVE COUNT
      SZA,RSS       IS THERE ANY BUFFERS DEFINED? 
      JMP BUFLI,I   NO THEN RETURN
BUFL0 JSB FPL       FILE PARAMETER LIST 
      ISZ LIC       DONE? 
      JMP BUFL0     NO
      JMP BUFLI,I   YES  RETURN 
      SKP 
*         COMMENT (REMARK) PROCESSORS 
* 
CMTSY NOP 
      LDA STBFD     SET ADDRESS 
      ADA .4
      RAL 
      STA PUTP
      LDA DM54      SET MAX 
      STA STBF+3       NUMBER OF CHARACTERS 
      JSB GETB      MOVE ASCII STRING TO FILE 
      JMP *+4         END OF BUFFER 
      JSB PUTC      NO ADD CHR TO FILE
      ISZ STBF+3    ADD COUNT FOR EACH CHARACTER
      JMP *-4 
      LDA D54       SET COUNT 
      ADA STBF+3      TO
      STA STBF+3        BE POSITIVE 
      SLA           MAKE IT AN EVEN NUMBER
      INA 
      RAR           BYTE COUNT TO WORD COUNT
      ADA .2        ADD TWO FOR ASCII COUNT 
      ISZ CMTSY     ADJUST RETURN 
      JMP CMTSY,I   RETURN P+2
* 
*         COMMENT LIST
* 
CMTLI NOP 
      JSB .FMT,I    START OUTPUT OF BUFFER
      DEF CMTFM 
      ISZ TMP 
      LDA TMP,I     GET BYTE COUNT
      CMA,INA       MAKE IT NEG.
      STA CMTSY     SAVE COUNT
      SZA,RSS       CHECK FOR ANY CHARACTERS
      JMP CMTLI,I   NONE SO RETURN
      ISZ TMP 
      LDB TMP       GET ADDRESS 
      CLE,ELB       MAKE IT BYTE ADDRESS
      STB TMP 
CMTLL LDB TMP       GET BYTE ADDRESS
      JSB BUF2A 
      JSB FMT,I     TRANSFER BYTE 
      ISZ TMP       MOVE TO NEXT BYTE 
      ISZ CMTSY     ALL DONE? 
      JMP CMTLL     NO
      JMP CMTLI,I   YES RETURN TO CALLER
* 
CMTFM ASC 02,(A1) 
      SKP 
*         GOTO GOSB SYNTAX
* 
GTSSY NOP 
      JSB GTLN      GET LINE NUMBER 
      JMP GTSSY,I 
      STA STBF+2    OK
      LDA .2        LEAVE ROOM FOR ADDRESS
      ISZ GTSSY 
      JMP GTSSY,I 
* 
*         GOTO AND GOSB LIST
* 
GTSLI NOP 
      CLA 
      LDB TMP,I     GET LINE NUMBER 
      JSB .PPR,I    OUTPUT IT 
      JMP GTSLI,I 
* 
*         GOTO RUN PROCESSOR
* 
GTORU NOP 
      LDA CRSA      GET 
      STA IOSC      SET HOLD OFF FLAG 
      ADA .3        NEW LINE NUMBER 
      LDB A,I 
      SZB,RSS       WAS IT FOUND? 
      JMP *+3 
      ISZ GTORU     RETURN FOR NEW LINE 
      JMP GTORU,I 
      CLA,INA       REPORT NOT FOUND
      JSB ERR 
* 
*         GOSUB RUN PROCESSOR 
* 
GSBRU NOP 
      LDA STBFD     CHECK 
      STA IOSC      (SET HOLD OFF FLAG) 
      CMA,INA 
      ADA STBF          NOT OVER
      INA 
      ADA .M32              24
      SSA 
      JMP *+3 
      LDA .2        REPORT GOSB OVER FLOW 
      JSB ERR 
      LDA CRSA,I    SET RETURN POINTER
      ALF,RAL 
      AND .37 
      ADA CRSA
      STA STBF,I
      ISZ STBF
      LDA GSBRU 
      STA GTORU 
      JMP GTORU+1   CHANGE LINES
      SKP 
*     RETURN SYNTAX PROCESSOR 
* 
RTNSY NOP 
      JSB FPS       GET INCREMENT NUMBER
      JMP *+4       NOT FURNISHED 
      LDA .2        TWO LOCATIONS USED
      ISZ RTNSY     GOOD RETURN 
      JMP RTNSY,I 
      CLA 
      STA TMP,I     CLEAR NUMBER
      ISZ TMP 
      STA TMP,I 
      JMP RTNSY+3 
* 
*         RETURN RUN PROCESSOR
* 
RTNRU NOP 
      LDB .2        GET RETURN NUMBER 
      JSB FPG 
      CMA 
      STA RTNSY     SAVE COUNT
      CCA           ANY GOSBS?
      ADA STBF
      CPA STBFD 
      RSS           NO
      JMP *+3 
      LDA .3        REPORT AS ERROR 
      JSB ERR 
      LDB A,I       YES GET RETURN LINE 
      CCA           MO E POINTER BACK 
      ADA STBF
      STA STBF
RTNRN ISZ RTNSY     MOVE UP ONE?
      JMP *+3       YES 
      ISZ RTNRU 
      JMP RTNRU,I 
      LDA B,I       GET STATEMENT COUNT 
      SZA,RSS       WAS IT THE END? 
      JMP RTNRN+2   YES 
      ALF,RAL 
      AND .37 
      ADB A 
      JMP RTNRN 
* 
RTNLI NOP 
      LDB TMP 
      LDA B,I 
      INB 
      IOR B,I 
      SZA           WAS THERE A NUMBER
      JSB FPL       YES 
      JMP RTNLI,I 
      SKP 
*     STOP STATEMENT RUN PROCESSOR
* 
RUSTP NOP 
      LDB .2        GET STOP LED DISPLAY
      JSB FPG 
      SZA           IF ZERO THEN I/O
      JMP STOP.     NOT I O SO USE DATA FOR DISPLAY 
      LIA 2         I/O SO GET GLOBAL REGISTER
      IOR BIT6      INCLUDE SUBSECTION FLAG 
      ALF,ALF       PUT IN UPPER HALF 
      IOR .23       INDICATE I/O DIAGNOSTIC 
      JMP STOP. 
* 
*     CHECK FOR STOP
* 
RUCFS NOP 
      JSB STOP
      JSB .STOP 
      JMP RUCFS,I 
      SPC 3 
*     GET SELECT CODE SYNTAX
* 
GSCSY NOP 
      JSB FPS       STORE INTERFACE I.D.
      JMP GSCSY,I   NOT FURNISHED SO ERROR
      AND M7.43     INSURE IT IS A NUMBER ONLY
      SZA 
      JMP GSCSY,I   NOT SO ERROR
      JSB FPS       STORE SELECT CODE PARAMETER 
      JMP GSCSY,I   NOT FURNISHED SO ERROR
      AND M7.43     INSURE IT IS NOT A NUMBER 
      SZA,RSS 
      JMP GSCSY,I   NOT SO ERROR
      LDA .4        USED 4 LOCATIONS
      ISZ GSCSY     ADJUST RETURN 
      JMP GSCSY,I   AND RETURN
* 
GSCLI NOP 
      JSB FPL 
      JSB FPL 
      JMP GSCLI,I 
      SKP 
*     GET SELECT CODE RUN PROCESSOR 
* 
GSCRU NOP 
      LDB .2        GET I.D. NUMBER 
      JSB FPG 
      STA GSCLI     SAVE IT 
      LDB .4        GET SELECT CODE PARAMETER 
      JSB FPG 
      STB GSCSY     SAVE ADDRESS POINTER
      LDB GSCFL     GET LOOP FLAG 
      SZB,RSS       DONT OUTPUT PAS COMPLETE IF LOOP
      SZA,RSS       OR IF THE FIRST TIME THROUGH
      JMP GSCR. 
      JSB .FMT,I    OUTPUT PASS COMPLETE
      DEF GSCPM 
      CLA           TO THE CONSOLE
      JSB FMT.,I
GSCR. LDA IDTBP,I   CHECK IF AUTOMATIC
      SZA 
      JMP GSCR2     YES 
      LDA GSCSY,I   CHECK IF SELECT CODE ALREADY ENTERED
      LDB GSCFL     AND IF LOOP FLAG SET
      SZA 
      SZB,RSS 
      JMP GSCR0     NO ON BOTH
      LDA GSCX      RESTORE PREVIOUS SELECT CODE
      STA GSCSY,I 
      JSB .FMT,I    OUTPUT PASS COUNT 
      DEF GSCPC 
      LDA GSCFL     GET PASS COUNT
      JSB FMT,I 
      CLA           USE CONSOLE 
      JSB FMT.,I
      ISZ GSCFL 
      RSS 
      ISZ GSCFL 
      JSB RUCFS     NOW CHECK FOR STOP
      JMP GSCRU,I   AND CONTINUE
* 
GSCPM ASC 09,("PASS COMPLETE"/) 
GSCPC ASC 07,("PASS "%I6/)
      SKP 
*     MANUAL MODE 
* 
GSCR0 JSB .FMT,I    NO ASK FOR SELECT CODE THEN 
      DEF GSCM0     POINTER TO MESSAGE
      CLA 
      STA GSCFL     CLEAR LOOP FLAG 
      JSB FMT.,I
      CLA 
      JSB .CFI,I    CALL FOR INPUT
      LDB GSCSY,I   CHECK IF THERE WAS ONE
      SZA           DID HE ENTER ONE? 
      JMP GSCR1     YES 
      SZB,RSS       NO IS THERE ONE ALREADY?
      JMP GSCR0     NO
      LDA GSCX      YES RESTORE SELECT CODE 
      STA GSCSY,I      AND
      CLA,INA       SET LOOP FLAG (AND PASS 1)
      STA GSCFL 
      JMP GSCRU,I   YES SO CONTINUE 
GSCR1 JSB .CON,I    CONVERT OCTAL INPUT 
      JMP GSCR0     NO NUMBER SO ERROR
      SZA,RSS       IF NUMBER IS ZERO 
      JMP GSCRX     THEN EXIT 
      STA B         SAVE NUMBER 
      CPA .M1       IS THIS THE END?
      JMP *+8       YES 
      AND .M77      CHECK NOT OVER 77 
      SZA 
      JMP GSCR0     IT WAS SO TRY AGAIN 
      LDA B         CHECK NOT LESS THAN 20
      AND DM16
      SZA,RSS 
      JMP GSCR0     IT WAS SO TRY AGAIN 
      STB GSCSY,I   IT'S OK - PUT IT IN PARAMETER 
      STB GSCX      SAVE FOR LOOP 
      JMP GSCRU,I   CONTINUE
* 
GSCM0 ASC 11,("INPUT SELECT CODE ") 
      SKP 
*     AUTOMATIC RUN 
* 
GSCR2 LDB IDTBP     GET POINTER TO TABLE
      LDA B,I       GET A SELECT CODE 
      CPA .M1       ALREADY DONE? 
      JMP GSCR3     YEP 
      SZA,RSS       END OF TABLE? 
      JMP GSCRE     YES END OF DIAGNOSTIC 
      AND .M77      CHECK ID  
      CPA GSCLI     IS THIS ONE OK
      JMP GSCR4     YEP 
GSCR3 INB 
      JMP GSCR2+1   TRY NEXT ONE
* 
GSCR4 LDA B,I 
      AND .77       SC ONLY 
      STA GSCSY,I   PUT IT IN PARAMETER 
      STA GSCX      SAVE FOR LOOP 
      CCA 
      STA B,I       INDICATE IT'S DONE
      JSB .FMT,I    PRINT SELECT CODE UNDER TEST
      DEF GSCM1 
      LDA GSCSY,I 
      JSB FMT,I 
      CLA 
      JSB FMT.,I
      JMP GSCRU,I 
* 
GSCM1 ASC 16,("SELECT CODE "K2" UNDER TEST"/) 
      SPC 2 
*     END OF DIAGNOSTIC 
* 
GSCRE LDA GSCSY,I   CHECK IF CALL BACK WHEN DONE
      CPA .M1       ??
      JMP GSCRU,I   YEP  LEAVE SELECT CODE -1 
      JSB .FMT,I    END OF DIAG 
      DEF GSCM2 
      CLA 
      JSB FMT.,I
GSCRX LDB STFE      POINT TO END OF PROGRAM 
      ISZ GSCRU     CHANGE LINES
      JMP GSCRU,I 
* 
GSCM2 ASC 12,("DIAGNOSTIC COMPLETE"/) 
* 
GSCX  NOP           SAVE SC FOR LOOP
IDTBL BSS 49        I.D. TABLE
      SKP 
*     HOOD CHECK RUN PROCESSOR
* 
HODRU NOP 
      CLA           CHECK IF FRONT PANEL IS THERE 
      LIA 3,C 
      SZA 
      JMP HODR0     YES 
HODRE CCA           NO SO SKIP LINE 
      STA HOODF     SET HOOD FLAG 
      LDA CRSA,I
      ALF,RAL 
      AND .37 
      ADA CRSA
      STA CRSA
      JMP HODRU,I 
* 
HODR0 LDA IDTBP,I   CHECK IF AUTOMATIC
      SZA 
      JMP HODRU,I   YES NO HOOD 
      LDA GSCFL     CHECK LOOP FLAG 
      LDB HOODF     AND HOOD
      SZA,RSS 
      JMP HODR1     NO SO ASK FOR HOOD
      SZB           YES SO CHECK HOOD 
      JMP HODRE 
      JMP HODRU,I 
HODR1 JSB .FMT,I
      DEF HODM0 
      CLA 
      STA HOODF     CLEAR HOOD FLAG 
      JSB FMT.,I
      CLA 
      JSB .CFI,I
      SZA,RSS 
      JMP HODR1 
      LDA BUF 
      CPA AYE 
      JMP HODRE 
      CPA ANO 
      JMP HODRU,I 
      JMP HODR1 
* 
HODM0 ASC 10,("HOOD INSTALLED? ") 
      SKP 
*         WAIT RUN PROCESSOR
* 
WATRU NOP 
      JSB .FMT,I
      DEF WAITM 
      LDA CULN      WITH CURRENT LINE NUMBER
      JSB FMT,I 
      CLA           TO CONSOLE
      JSB FMT.,I
WTRU  JSB .FMT,I    OUTPUT ASTRISK
      DEF WSYBL 
      CLA             TO THE CONSOLE
      JSB FMT.,I
      CLA 
      JSB .CFI,I    CALL FOR INPUT
      LDA BUF 
      CPA ACO       CONTINUE
      JMP WATRU,I   YES 
      CPA AST       STOP? 
      JMP STOP0     YES 
      JSB .PRMI,I   MUST BE A PARAMETER 
      JSB WHAT      NOT !?
      JMP WTRU
* 
WSYBL ASC 1,("      BELL + *
      OCT 3452
      ASC 1,")
      OCT 177777
* 
WAITM ASC 06,(I5X"WAIT"/) 
      SKP 
*         DELAY SYNTAX
* 
DLYSY NOP 
      JSB FPS       CONVERT PARAMETER 
      JMP DLYSY,I   NO PARAMETER
      LDA .2
      ISZ DLYSY 
      JMP DLYSY,I   RETURN P+2
* 
*         DELAY RUN PROCESSOR 
* 
DLYRU NOP 
      LDB .2
      JSB FPG       FILE PARAMETER GET
      SSA           IF NEGATIVE COUNT THEN
      CMA,INA         MAKE IT POSITIVE
      SZA,RSS       IF ZERO THEN SKIP TIMER 
      JMP DLYRU,I 
      LDB STF0      CHECK INTERRUPTS
      OCT 103300    SFS 0,C 
      CLB 
      STB *+4 
      LDB INTF      NOW CHECK IF PENDING INTERRUPT
      SZB 
      JMP *+4 
      NOP 
      JSB TMR       GO TO TIMER 
      JMP DLYRU,I 
      LDB *-3       IF INTS ARE OFF DO DELAY
      SZB,RSS 
      JMP *-4 
STF0  STF 0         RESTOR INTERRUPTS 
      JMP DLYRU,I 
* 
*         DELAY LIST
* 
DLYLI NOP 
      JSB FPL       FILE PARAMETER LIST 
      JMP DLYLI,I 
      SKP 
*         INPUT SYNTAX
* 
INPSY NOP 
      CLA 
      LDB INPSY     GET RETURN ADDRESS
      JSB INNSY     USE CONSOLE 
CRLSY NOP 
      CLA,INA 
      LDB CRLSY     GET RETURN ADDRESS
      JSB INNSY     USE LEFT CARTRIDGE TAPE 
CRRSY NOP 
      LDA .2
      LDB CRRSY     GET RETURN ADDRESS
      JSB INNSY     USE RIGHT CARTIDGE TAPE 
INSSY NOP 
      LDA .3
      LDB INSSY     GET RETURN ADDRESS
      JSB INNSY     USE SCREEN
* 
INNSY NOP 
      STB INNSY     SAVE RETURN ADDRESS 
      STA STBF+2    SAVE DEVICE NUMBER
      ISZ TMP 
      LDA .M10      ALLOW ONLY 8  PARAMETERS TO BE INPUT
      STA STBF+3
      ISZ TMP 
INNSN JSB GETB      CHECK FIRST CHARACTER 
      JMP INNSE     NO DATA 
      CPA .40       SKIP SPACES 
      JMP *-3 
      CPA A&        HEX INPUT?
      JMP *+6       YES 
      CPA A$        ASCII INPUT?
      JMP *+4       YES 
      CPA A@        OCTAL INPUT?
      JMP *+2       YES 
      CLA           NONE
      STA TMP,I     SAVE TYPE 
      ISZ TMP 
      LDB GETP      STEP BACK ONE 
      ADB .M1 
      SZA,RSS       NONE? 
      STB GETP      MOVE BACK CHARACTER 
      JSB FPS       FILE PARAMETER STORE
      JMP INNSE     NO MORE CHECK FOR ERROR 
      AND M7.43     CHECK IT ISN'T A NUMBER 
      SZA,RSS 
      JMP INNSY,I   IT WEAS SO ERROR
      LDA STBF+3    OVER EIGHT INPUTS?
      SZA,RSS 
      JMP INNSY,I   YES 
      INA           OK COUNT IT 
      STA STBF+3
      JMP INNSN     AND DO NEXT ONE 
      SKP 
INNSE LDB STBF+3    THERE MUST BE AN INPUT PARAMETER
      CPB .M10      ? 
      JMP INNSY,I   NO SO ERROR 
      CPA .15       IS IT END OF BUFFER?
      ISZ INNSY     YES ADJUST RETURN TO P+2
      LDA .10       DETERMINE COUNT 
      ADA STBF+3
      CMA,INA 
      STA STBF+3
      CMA,INA 
      STA B 
      RAL           DOUBLE COUNT
      ADA B         TRIPLE COUNT
      ADA .2        ADD COUNT AND DEVICE
      JMP INNSY,I   RETURN
      SKP 
*         INPUT RUN PROCESSOR 
* 
INNRU NOP 
      LDA CRSA      GET DEVICE
      ADA .2
      LDB A,I           NUMBER
      STB TMP 
      INA 
      LDB A,I       AND NUMBER OF PARAMETERS
      STB TMP+1     SAVE COUNT
      STB TMP+3 
      INA 
      STA TMP+2     AND ADDRESS 
      STA TMP+4 
      LDA TMP       OK GET INPUT
INNR0 JSB .CFI,I
      STA INNRC 
INNRN LDB A         SAVE A
      STA INNRT     AND AS A NUMBER 
      LDA TMP+2,I   GET TYPE OF INPUT 
      ISZ TMP+2 
      CPA A$        ASCII INPUT?
      JMP INNAS     YES 
      SSB           EOF?
      JMP INNRS+1   YES JUST PUT NEG IN DATA
      CPA A&        HEX INPUT?
      JMP INNHD     YES 
      CPA A@        OCTAL INPUT?
      JMP *+4       YES 
      JSB .CDN,I    NO CONVERT TO DECIMAL 
      JMP INNRE     NOT A NUMBER
      JMP INNRS     OK
      JSB .CON,I    CONVERT TO OCTAL
      JMP INNRE     NOT A NUMBER
INNRS STA INNRT     SAVE IT 
      LDA TMP+2,I 
      ISZ TMP+2 
      LDB TMP+2,I 
      ISZ TMP+2 
      JSB .GPR,I
      LDA INNRT 
      STA B,I 
INNR1 LDA INNRC     RESTOR INPUT COUNT
      ISZ TMP+1     DONE? 
      JMP INNRN     NO
      JMP INNRU,I   YES 
* 
INNHD JSB .CHN,I    CONVERT HEX NUMBER
      JMP INNRE     NO NUMBER OR DATA 
      JMP INNRS     OK
      SKP 
INNAS LDA TMP+2     GET PARAMETER 
      LDA A,I 
      SSA           IS IT A BUFFER? 
      JMP *+6       YES 
      SSB           EOF?
      JMP INNRS     YES USE NEG ONE 
      JSB GETB      GET A CHARACTER 
      NOP           ALLOW EOB TO BE USED
      JMP INNRS 
      LDB TMP+2     GET PARAMETER 
      LDA B,I 
      INB           MOVE TO SECOND PART OF PARAMETER
      LDB B,I       GET IT
      JSB .GPR,I    GET THE ADDRESS 
      STB INNRA     SAVE IT 
      LDA TMP+2,I 
      RAL,CLE,ELA   ELIMINATE VARIABLE
      RAR,RAR 
      CLB,INB       GET FIRST LOCATION
      ISZ TMP+2     MOVE PAST IT
      ISZ TMP+2 
      JSB .GPR,I
      STB INNRA+1 
      LDA INNRT     CHECK EOF 
      SSA 
      JMP INNR1-1   YES USE NEG ONE 
INNAB JSB GETB      GET A CHARACTER 
      NOP           NO MORE DATA
      ALF,ALF       PUT IT IN UPPER HALF
      STA INNRA+1,I 
      JSB GETB      GET NEXT CHR
      NOP           NO MORE DATA
      IOR INNRA+1,I 
      STA INNRA+1,I 
      LDA INNRA+1   CHECK IF FILLED 
      CPA INNRA     ??
      JMP INNR1     YES 
      ISZ INNRA+1   NO MOVE TO NEXT LOCATION
      JMP INNAB     DO MORE 
      SKP 
INNRE CLB 
      STB INNRT     CLEAR INPUT 
      SZA           NO INPUT NUMBER 
      CPA .15       END OF BUFFER?
      JMP INNRS+1   YES CLEAR THE REST OF THE DATA
      LDA TMP       IS IT THE CONSOLE 
      SZA,RSS       ? 
      JMP *+5       YES 
      CLA 
      LDB INNRC 
      JSB .DVIO,I 
      DEF BUF 
      JSB WHAT
      LDA TMP+3 
      STA TMP+1 
      LDA TMP+4 
      STA TMP+2 
      CLA 
      JMP INNR0 
INNRC NOP 
INNRT NOP 
INNRA NOP 
      NOP 
* 
*         INPUT LIST
* 
INNLI NOP 
      ISZ TMP 
      LDB TMP,I     GET PARM COUNT
      ISZ TMP       SKIP DEVICE NUMBER
      STB LIC       SAVE IT 
INNL0 JSB .FMT,I
      DEF INNFM 
      LDA TMP,I     GET TYPE
      ISZ TMP 
      SZA           SKIP OUTPUT IF NONE 
      JSB FMT,I 
      JSB FPL       FILE PARAMETER LIST 
      ISZ LIC       DONE? 
      JMP INNL0     NO
      JMP INNLI,I   YES 
* 
INNFM ASC 2,(A1)
      SKP 
*         YES?  RUN PROCESSOR 
* 
YESRU NOP 
      CLA 
      JSB .CFI,I    CALL FOR INPUT
      LDA BUF       CHECK IT
      CPA AYE       YES 
      JMP *+5       CHANGE LINES
      CPA ANO       NO
      JMP YESRU,I   CONTINUE
      JSB WHAT      NEITHER ASK WHAT
      JMP YESRU+1   TRY AGAIN 
* 
      LDA YESRU 
      STA GTORU 
      JMP GTORU+1 
      SKP 
*         MESSAGE SYNTAX
* 
PNTSY NOP 
      CLA 
      LDB PNTSY     GET RETURN ADDRESS
      JSB MSGSY     OUTPUT TO CONSOLE 
* 
CWLSY NOP 
      CLA,INA 
      LDB CWLSY     GET RETURN ADDRESS
      JSB MSGSY     OUTPUT TO LEFT CARTRIDGE TAPE 
* 
CWRSY NOP 
      LDA .2
      LDB CWRSY     GET RETURN ADDRESS
      JSB MSGSY     OUTPUT TO RIGHT CARTRIDGE TAPE
* 
MSGSY NOP 
      STB MSGSY     SAVE RETURN ADDRESS 
      STA STBF+2    SAVE DEVICE NUMBER
      ISZ TMP 
      JSB GTLN      GET LINE NUMBER OF FORMAT 
      CLA           PARAMETERS ONLY 
      STA STBF+3    OK
      ISZ TMP 
      LDA DM10      SET MAX OF 10 PARAMS
      STA STBF+4
      ISZ TMP 
MSGSN JSB FPS       FILE PARAMETER STORE
      JMP MSGSE     NO PARAMETERS 
      LDA STBF+4    OVER TEN INPUTS 
      SZA,RSS       ? 
      JMP MSGSY,I   YES 
      INA           OK COUNT IT 
      STA STBF+4
      JMP MSGSN 
* 
MSGSE CPA .15       IS IT THE END OF THE BUFFER 
      ISZ MSGSY 
      LDA D10       DETERMINE COUNT 
      ADA STBF+4
      CMA,INA 
      STA STBF+4
      CMA,INA 
      RAL           DOUBLE COUNT
      ADA .3        ADD COUNT, DEVICE AND LINE NUMBER 
      JMP MSGSY,I 
      SKP 
*         MESSAGE RUN PROCESSOR 
* 
MSGRU NOP 
      LDA CRSA      GET 
      ADA .2
      LDB A,I 
      STB MSGDV     DEVICE
      INA 
      LDB A,I       FORMAT LINE NUMBER
      INA 
      STA TMP+1 
      SZB,RSS       IS THERE A FORMAT?
      JMP PRMRU     NO JUST PRINT PARAMETERS
      LDA B 
      JSB FNDLN     FIND LINE NUMBER
      RSS           NOT FOUND 
      JMP *+3 
      LDA .14       REPORT IT 
      JSB ERR 
      LDA B,I       CHECK IF CMT FMT OR REM 
      AND WCMSK 
      IOR STTBD 
      LDA A,I 
      SZA 
      JMP *-7 
      ADB .4
      STB *+2 
      JSB .FMT,I
      NOP 
      LDB TMP+1,I   PARAM 
      ISZ TMP+1 
      SZB,RSS       IS THERE ANY
      JMP MSGRX     NO
      STB TMP 
      STA MSGFC     SAVE REPEAT COUNT 
      SKP 
MSGRA LDA TMP+1,I   GET PARAMETER 
      ISZ TMP+1 
      LDB TMP+1,I 
      ISZ TMP+1 
      SSA,RSS       IS IT A BUFFER
      JMP MSGRB     NOP 
      RAL 
      SSA,RSS       VARIABLE OR FIXED?
      JMP *+3       FIXED 
      ADB VARA      VARIABLE SO FIX IT
      LDB B,I 
      RAR           MOVE A BACK 
      AND M7.3      MASK OFF VARIABLE BIT 
MSGRB STA MSGSA     SAVE IT 
      STB MSGSB 
MSGRC JSB .GPR,I    GET BUFFER CONTENT
      JSB FMT,I     PASS IT TO FORMATTER
      ISZ MSGFC     ANY REPEATS?
      RSS 
      JMP MSGRD     NO
      LDA MSGSA     GET PARAMETER 
      SSA,RSS       IS IT A BUFFER? 
      JMP MSGRD+1   NO
      ISZ MSGSB     YES MOVE TO NEXT LOCATION 
      LDB MSGSB 
      JMP MSGRC     USE IT
MSGRD STA MSGFC     SAVE REPEAT COUNT 
      ISZ TMP       DONE? 
      JMP MSGRA     NOP 
MSGRX LDA MSGDV     YES GET DEVICE NUMBER 
      JSB FMT.,I    TERMINATE FORMAT
      JSB STOP      WAS A KEY STRUCK? 
      JSB .STOP     YES 
      JMP MSGRU,I   RETURN
* 
MSGSA NOP 
MSGSB NOP 
MSGFC NOP 
MSGDV NOP 
      SKP 
PRMRU STA MSGSA     SAVE POINTER
      LDB A,I       GET COUNT 
      SZB,RSS 
      JMP PRMR1     NO PARAMETERS SO CRLF 
      ISZ MSGSA     MOVE TO PARAMETERS
      STB MSGFC     SAVE COUNT
PRMR0 LDA MSGSA,I 
      ISZ MSGSA 
      LDB MSGSA,I 
      ISZ MSGSA 
      STA TMP 
      STB TMP+1 
      LDA MSGDV     GET DEVICE NUMBER 
      JSB .PRMP,I   PRINT PARAMETER 
      ISZ MSGFC     DONE? 
      JMP PRMR0 
      JMP MSGRU,I 
* 
PRMR1 JSB .FMT,I
      DEF PRMCR 
      LDA MSGDV     GET DEVICE NUMBER 
      JSB FMT.,I
      JMP MSGRU,I 
* 
PRMCR ASC 02,(/)
* 
*         MESSAGE LIST
* 
MSGLI NOP 
      ISZ TMP 
      CLA 
      LDB TMP,I     OUTPUT LINE NUMBER
      ISZ TMP 
      SZB           IF NO LINE THEN PARAMETERS
      JSB .PPR,I
      LDB TMP,I     GET NUMBER OF PARAMETERS
      ISZ TMP 
      STB LIC 
      SZB,RSS       IS THERE ANY
      JMP MSGLI,I   NO
MSGL0 JSB FPL       FILE PARAMETER LIST 
      ISZ LIC       DONE? 
      JMP MSGL0     NO
      JMP MSGLI,I   YES 
      SKP 
*         INITIALIZE BUFFER PATTERN SYNTAX
* 
      ORG 10000B
IBPSY NOP 
      JSB FPS       FILE PARAMETER STORE
      JMP IBPSY,I   NO BUFFER 
      SSA,RSS       MUST BE A BUFFER
      JMP IBPSY,I   NOT 
      JSB FPS       NEXT
      JMP IBPSY,I 
      SSA,RSS 
      JMP IBPSY,I 
      AND .177      CHECK THAT BOTH ARE THE SAME
      STA B 
      LDA STBF+2
      AND .177
      CPA B         ? 
      RSS 
      JMP IBPSY,I   NO
      JSB GETB      GET TYPE OF PATTERN 
      JMP IBPSY,I   NO DATA TYPE
      CPA .40       IF SPACE SKIP IT
      JMP *-3 
      ALF,ALF 
      STA TMP,I 
      JSB GETB      GET SECOND CHARACTER
      JMP IBPSY,I 
      IOR TMP,I 
      STA TMP,I 
      ISZ TMP 
      LDB IBPPT     SEARCH FOR IT 
      STB IBPRU 
      CCB 
IBPSL CPB IBPRU,I 
      JMP IBPSY,I   NOT FOUND 
      CPA IBPRU,I 
      JMP *+4       FOUND IT
      ISZ IBPRU     MOVE TO NEXT ONE
      ISZ IBPRU     IN TABLE
      JMP IBPSL     TRY IT
      CLA 
      STA STBF+7    CLEAR PARAMETER 
      STA STBF+8
      JSB FPS 
      NOP 
      LDA .7
      ISZ IBPSY 
      JMP IBPSY,I   RETURN P+2
* 
      SKP 
*         INITIALIZE BUFFER PATTERN RUN PROCESSOR 
* 
IBPRU NOP 
      LDB .2        GET STARTING ADDRESS
      JSB FPG       FILE PARAMETER GET
      STB TMP 
      LDB .4        GET ENDING ADDRESS
      JSB FPG       FILE PARAMETER GET
      STB TMP+1 
      CMB           STARTING > ENDING 
      ADB TMP 
      SSB           ? 
      JMP *+3 
      LDA .15       NO   SO ERROR 
      JSB ERR 
      LDA CRSA      OK GET PATTERN TYPE 
      ADA .6
      LDA A,I 
      LDB IBPPT     SET FPR PATTERN 
      CPA B,I 
      JMP *+4 
      INB 
      INB 
      JMP *-4 
      INB 
      LDA B,I 
      LDB TMP+1 
      JMP A,I 
* 
IBPS  NOP 
      STA TMP,I 
      LDB TMP 
      CPB TMP+1 
      JMP IBPRU,I 
      ISZ TMP 
      JMP IBPS,I
      SKP 
IBPPT DEF *+1 
* 
      ASC 1,R1      ROTATING 1
      DEF IBPR1 
* 
      ASC 1,R0      ROTATING 0
      DEF IBPR0 
* 
      ASC 1,C1      CYCLIC ASCII 64 
      DEF IBPC1 
* 
      ASC 1,C2      CYCLIC ASCII 128
      DEF IBPC2 
* 
      ASC 1,IN      INCREMENT PROGRESSIVE 
      DEF IBPIP 
* 
      ASC 1,DE      DECREMENT 
      DEF IBPID 
* 
      ASC 1,AH      ALTERNATING  101010 
      DEF IBPAH     HORIZONTAL   010101 
* 
      ASC 1,AV      ALTERNATING  111111 
      DEF IBPAV     VERTICAL     000000 
* 
      ASC 1,CL      CLEAR BUFFER
      DEF IBPCL 
* 
      ASC 1,CC      CLEAR AND COMPLEMENT
      DEF IBPCC 
* 
      ASC 1,CM      COMPLEMENT
      DEF IBPCM 
* 
      ASC 1,PA      PACKED ASCII
      DEF IBPPA 
* 
      ASC 1,UA      UNPACKED ASCII
      DEF IBPUA 
* 
      DEC -1
      SKP 
IBPR0 CLA,INA,RSS   ROTATING 0
IBPR1 CLA,INA,RSS   ROTATING 1
      CMA 
      JSB IBPS
      RAL 
      JMP *-2 
* 
IBPC1 LDA .40       CYCLIC ASCII 64 
      JSB IBPS
      INA 
      CPA .140      LOOP
      LDA .40       YES 
      JMP *-4 
* 
IBPC2 LDA .40       CYCLIC ASCII 128
      JSB IBPS
      INA 
      CPA .240      LOOP
      LDA .40 
      JMP *-4 
* 
IBPIP LDB .7        INCREMENT PROGRESSIVE 
      JSB FPG       GET STARTING NUMBER 
      JSB IBPS
      INA 
      JMP *-2 
* 
IBPID LDB .7        INCREMENT DIGRESSIVE
      JSB FPG       GET STARTING NUMBER 
      SZA 
      JSB IBPS
      ADA .M1 
      JMP *-2 
      SKP 
IBPAH LDA *+2       ALTERNATING HORIZONTAL
      JMP IBPR1+2 
      OCT 52525 
* 
IBPAV CLA           ALTERNATING VERTICAL
      JSB IBPS
      CMA 
      JMP *-2 
* 
IBPCL LDB .7        CLEAR BUFFER
      JSB FPG 
      JSB IBPS
      JMP *-1 
* 
IBPCC CCA           CLEAR AND COMPLEMENT
      JSB IBPS
      JMP *-1 
* 
IBPCM LDA TMP,I     COMPLEMENT
      CMA 
      JSB IBPS
      JMP *-3 
      SKP 
IBPUA CLA,RSS       SET FOR PACKED ASCII
IBPPA LDA RSS        OR UNPACKED
      STA IBPAF 
      LDB .7        GET LINE NUMBER 
      JSB FPG 
      SSA           CANT BE NEG.
      JMP *+4       IT WAS
      JSB FNDLN     FIND LINE NUMBER
      RSS 
      JMP *+3       FOUND 
      LDA .22       NOT FOUND SO ERROR
      JSB ERR 
      LDA B,I 
      AND WCMSK 
      IOR STTBD 
      LDA A,I 
      SZA           IS THIS AN ASC STMT?
      JMP *-7       NOT CMTSY 
      ADB .3        GET COUNT 
      LDA B,I 
      CMA,INA       MAKE COUNT NEG. 
      STA IBPCT     SAVE  COUNT 
      STA IBPCT+1 
      INB           MOVE TO STARTING ADDRESS
      CLE,ELB       MAKE ADDRESS TO BYTE
      STB IBPAD 
      STB IBPAD+1 
IBPAL LDB IBPAD     GET ADDRESS 
      JSB BUF2A 
      STA TMP,I 
      JSB IBPAC     CHECK FOR END OF STRING 
IBPAF NOP 
      JMP *+8 
      LDB IBPAD 
      JSB BUF2A 
      ALF,ALF 
      IOR TMP,I 
      ALF,ALF 
      STA TMP,I 
      JSB IBPAC     CHECK FOR END OF STRING 
      LDB TMP+1 
      CPB TMP 
      JMP IBPRU,I 
      ISZ TMP 
      JMP IBPAL 
      SKP 
IBPAC NOP 
      ISZ IBPAD 
      ISZ IBPCT     DONE
      JMP IBPAC,I   NO
      LDA IBPCT+1   YES RESTORE POINTERS
      STA IBPCT 
      LDA IBPAD+1 
      STA IBPAD 
      JMP IBPAC,I 
IBPAD NOP 
      NOP 
IBPCT NOP 
      NOP 
      SPC 4 
*         INITIALIZE BUFFER PATTERN LIST
* 
IBPLI NOP 
      JSB FPL       FILE PARAMETER LIST 
      JSB FPL       FILE PARAMETER LIST 
      JSB .FMT,I    OUTPUT THE PATTERN
      DEF IBPLM 
      LDA TMP,I 
      JSB FMT,I     TYPE
      ISZ TMP 
      LDB TMP       AND PARAMETER 
      LDA B,I 
      INB 
      IOR B,I 
      SZA 
      JSB FPL       THERE IS ONE SO LIST IT 
      JMP IBPLI,I   RETURN
* 
IBPLM ASC 03,(XA2X) 
      SKP 
*         COMPARE BUFFER SYNTAX 
* 
CPBSY NOP 
      JSB FPS       FILE PARAMETER STORE
      JMP CPBSY,I   NO PARAMETER
      SSA,RSS       MUST BE A BUFFER
      JMP CPBSY,I   NOT 
      JSB FPS       FILE PARAMETER STORE
      JMP CPBSY,I   NOT 
      SSA,RSS       MUST BE A BUFFER
      JMP CPBSY,I   NOT 
      JSB FPS       COUNT 
      JMP CPBSY,I 
      JSB FPS       MASK
      JMP CPBSY,I   NOT FURNISHED 
      LDA .10       8 LOCATIONS 
      ISZ CPBSY     GOOD RETURN 
      JMP CPBSY,I 
      SKP 
*         COMPARE BUFFER RUN PROCESSOR
* 
CPBRU NOP 
      LDB .2
      JSB FPG       GET STARTING ADDRESS FIRST BUFFER 
      STB TMP 
      LDB .4
      JSB FPG       GET STARTING ADDRESS SEC BUFFER 
      STB TMP+1 
      LDB .6
      JSB FPG       GET COUNT 
      SSA           CAN'T BE NEG
      JMP *+3 
      SZA                OR ZERO
      JMP *+3 
CPBRE LDA .16       COUNT ERROR 
      JSB ERR 
      ADA .M1 
      STA TMP+2 
      LDB .2        CHECK FIRST PARM LIMIT
      JSB CPBCR 
      LDB .4        CHECK SECOND LIMIT
      JSB CPBCR 
      LDB .10 
      JSB FPG       GET MASK
      CMA 
      STA TMP+3 
CPBL0 LDA TMP,I     GET FIRST 
      AND TMP+3     MASK IT 
      STA B         SAVE IT 
      LDA TMP+1,I   GET SECOND
      AND TMP+3     MASK IT 
      CPA B         DO THEY COMPARE 
      RSS 
      JMP CPBRU,I   NO DO NEXT LINE 
      ISZ TMP       YES DO NEXT WORD
      ISZ TMP+1 
      LDA TMP+2     CHECK IF DONE 
      ADA .M1 
      STA TMP+2 
      INA,SZA       ? 
      JMP CPBL0     NO
      LDA CRSA,I    YES COMPARE OK
      ALF,RAL       MOVE OVER ONE LINE
      AND .37 
      ADA CRSA
      STA CRSA
      JMP CPBRU,I   RETURN
      SKP 
CPBCR NOP 
      ADB CRSA
      LDA B,I 
      INB 
      LDB B,I 
      RAL 
      SSA,RSS 
      JMP *+5 
      CPB A!        BUFFER ADDRESS
      JMP CPBRE     THEN BUFFER ERROR 
      ADB VARA
      LDB B,I 
      RAR 
      ADB TMP+2 
      AND M7.3
      JSB .GPR,I
      JMP CPBCR,I 
* 
*         COMPARE BUFFER LIST 
* 
CPBLI NOP 
      JSB FPL       BUFFER 1
      JSB FPL       BUFFER 2
      JSB FPL       COUNT 
      JSB FPL       MASK
      JMP CPBLI,I   RETURN
      SKP 
*         LET SYNTAX
* 
LETSY NOP 
      JSB FNCOP     GET OPERAND 
      JMP LETSY,I   NO OPERAND
      CPA AEQU      IS IT AN EQUAL SIGN 
      RSS 
      JMP LETSY,I   NO
      CCE           ALLOW COMMAS
      JSB .FNSY,I   CHECK FUNCTION
      JMP LETSY,I 
      ISZ LETSY 
      JMP LETSY,I 
* 
*         LET RUN PROCESSOR 
* 
LTCRU NOP 
      JSB LETPR     SET UP PARAMETER
      LDA SOS       DO OVERFLOW CHECK 
      LDB LTCRU     SET RETURN ADDRESS
      STB LETRU 
      JMP LETRU+3 
* 
LETRU NOP 
      JSB LETPR     SET UP PARAMETER
      CLA           DON'T CHECK FOR OVERFLOW
      JSB .FNCR,I   PROCESS FUNCTION
      LDA TMP       REPLACE OLD 
      STA LETAD,I   WITH NEW
      LDA TMP+1     LAST PARAMETER? 
      SZA,RSS       ??
      JMP LETRU,I   YEP 
      ISZ LETSB     NO MOVE TO NEXT LOCATION
      LDA LETSA     GET PARAMETER 
      LDB LETSB 
      JSB .GPR,I    GET CONTENT 
      STB LETAD     SAVE ADDRESS
      LDB FCN       DO NEXT LOCATION
      JMP FNCRN-2 
      SKP 
LETPR NOP 
      LDB .2        GET PARAMETER 
      ADB CRSA
      LDA B,I       FROM FILE 
      INB 
      LDB B,I 
      SSA,RSS       IS IT A BUFFER
      JMP *+8       NO JUST A VARIABLE
      RAL           IS IT A VARIABLE BUFFER?
      SSA,RSS       ??
      JMP *+3       NO
      ADB VARA      YES 
      LDB B,I       GET VARIABLE NUMBER 
      RAR 
      AND M7.3      ELIMINATE VARIABLE BIT
      STA LETSA     SAVE PARAMETER
      STB LETSB 
      JSB .GPR,I    GET CONTENT 
      STB LETAD     SAVE ADDRESS
      JMP LETPR,I   RETURN
LETSA NOP 
LETSB NOP 
LETAD NOP 
      SKP 
*         FUNCTION OPERAND
* 
FNCOP NOP 
      JSB FPS       GET OPERAND 
      JMP FNCOP,I   NO DATA 
      LDB FNCJP     SET FOR COMMA CHECK IF
      SSA,RSS       IT'S A BUFFER 
      CLB           IT'S NOT SO DONT ALLOW COMMAS 
      STB FNCJI     PUT IT IN PLACE 
      JSB GETB      GET TYPE OF OPERATION 
      JMP FNCOP,I 
      CPA .40       SKIP SPACES 
      JMP *-3 
      STA TMP,I 
      CPA AEQU      CHECK IF IT'S AN = SIGN 
      RSS 
      JMP FNCP0     NO CONTINUE 
      LDB GETP      CHECK NEXT CHARACTER
      JSB BUF2A     GET IT FROM BUFFER
      CPA AGTH      IS A > SIGN?
      JMP *+4       YES 
      CPA ALTH      IS A < SIGN?
      RSS           YES 
      JMP FNCP0     NEITHER SO SKIP THE SAVE
      ISZ GETP      MOVE PAST CHARACTER 
      ALF,ALF       PUT IT IN UPPER HALF
      IOR TMP,I     INCLUDE = SIGN
      STA TMP,I     PUT BOTH BACK 
FNCP0 LDA TMP,I 
      ISZ TMP 
      ISZ FNCOP 
      JMP FNCOP,I 
      SKP 
*         SKIF SYNTAX 
* 
SKISY NOP 
      JSB FNCOP     GET OPERAND 
      JMP SKISY,I 
      CPA AEQU      CHECK IF VALID
      JMP SKIS0     OK
      CPA AGTH      GREATER THAN >
      JMP SKIS0     OK
      CPA ALTH      LESS THAN < 
      JMP SKIS0     OK
      CPA ANEQ      NOT EQUAL 
      JMP SKIS0     OK
      CPA AEGTH     =>
      JMP SKIS0     OK
      CPA AELTH     =<
      JMP SKIS0     OK
      JMP SKISY,I   NONE SO ERROR 
* 
SKIS0 CLE           NO COMMAS ALLOWED 
      JSB .FNSY,I   CHECK FUNCTION
      JMP SKISY,I   ERROR 
      ISZ SKISY     OK
      JMP SKISY,I 
* 
*         SKIF RUN PROCESSOR
* 
SKIRU NOP 
      CLA           NO OVERFLOW CHECK 
      JSB .FNCR,I   PROCESS FUNCTION
      LDB .2        GET THE PARAMETER 
      JSB FPG 
      LDB CRSA      GET REQUEST 
      ADB .4
      LDB B,I 
      CPB AGTH      GREATER THAN
      JMP SKIRG     YES 
      CPB ALTH      LESS THAN 
      JMP SKIRL     YES 
      CPB ANEQ      NOT EQUAL 
      JMP SKIRN     YES 
      CPA TMP       ARE THEY EQUAL? 
      JMP SKIRS     YES THEN SKIP 
      CPB AEQU      =?
      JMP SKIRU,I   YES AND THEY WERN'T = SO DON'T SKIP 
      CPB AEGTH     =>? 
      JMP SKIRG+2   YES 
      CPB AELTH     =<? 
      JMP SKIRL+2 
      SKP 
SKIRS LDA CRSA,I    SKIP NEXT LINE
      ALF,RAL 
      AND .37 
      ADA CRSA
      STA CRSA
      JMP SKIRU,I 
* 
SKIRG CPA TMP       ARE THEY EQUAL? 
      JMP SKIRU,I   YES SO NO SKIP
      STA B         SAVE FIRST PARAMETER
      XOR TMP       DETERMINE IF DIFFERENT SIGNS
      SSA,RSS       DIFFERENT?
      JMP *+4       NO
      SSB           YES WHICH WAS POSITIVE
      JMP SKIRU,I   FIRST WAS SO NOT GREATER
      JMP SKIRS     SECOND SO SKIP
      CMB,INB       SAME SIGN SO SUBTRACT 
      ADB TMP 
      SSB 
      JMP SKIRS 
      JMP SKIRU,I 
* 
SKIRL CPA TMP       IF EQUAL
      JMP SKIRU,I   THEN DON'T SKIP 
      STA B         SAVE FIRST PARAMETER
      XOR TMP       DETERMINE IF DIFFERENT SIGNS
      SSA,RSS       DIFFERENT?
      JMP *+4       NO
      SSB           WHICH WAS POSITIVE
      JMP SKIRS     FIRST WAS SO SKIP 
      JMP SKIRU,I   SECOND WAS SO DON'T SKIP
      CMB,INB 
      ADB TMP 
      SSB 
      JMP SKIRU,I 
      JMP SKIRS 
SKIRN CPA TMP       NOT EQUAL 
      JMP SKIRU,I   EQUAL SO DON'T SKIP 
      JMP SKIRS     NOT EQUAL SO SKIP 
      SKP 
*         FUNCTION SYNTAX 
* 
FNCSY NOP 
      CLA,SEZ,RSS   ANY COMMAS ALLOWED? 
      STA FNCJI     NO
      LDA .M10      SET FOR MAX OF 8
      STA TMP+1 
      JSB FPS       FILE PARAMETER STORE
      JMP FNCSY,I 
      JSB GETB      GET OPERATION 
      JMP FNCS1 
      CPA .40       SKIP SPACES 
      JMP *-3 
      STA TMP,I     PUT IT IN BUFFER
      ISZ TMP 
      CPA AADD      + 
FNCJP JMP FNCS0     YES 
      CPA AAND      . (AND) 
      JMP FNCS0     YES 
      CPA ASUB      - 
      JMP FNCS0     YES 
      CPA AMPY      * 
      JMP FNCS0     YES 
      CPA ADIV      / 
      JMP FNCS0     YES 
      CPA AIOR      : (IOR) 
      JMP FNCS0     YES 
      CPA AXOR      ; (XOR) 
      JMP FNCS0     YES 
      CPA FC.CM     , 
FNCJI JMP FNCS0     YES 
      JMP FNCSY,I   NONE SO ERROR 
* 
FNCS0 ISZ TMP+1     FULL? 
      JMP FNCSY+5   NO
      JMP FNCSY,I   YES 
* 
FNCS1 LDA STBFD     GET INPUT 
      ADA .2        COUNT 
      CMA,INA 
      ADA TMP 
      ISZ FNCSY     RETURN P+2
      JMP FNCSY,I 
      SKP 
*         FUNCTION RUN
* 
FNCRU NOP 
      STA FNCOC     SET OVERFLOW CHECK
      LDA CRSA,I    SET ENDING ADDRESS
      ALF,RAL 
      AND .37 
      ADA CRSA
      STA TMP+2 
      LDB .5        GET FIRST PARAMETER 
      STB FCN 
      JSB FPG 
      STA TMP       SAVE VARIABLE 
FNCRN LDA FCN       MOVE TO OPERATION 
      ADA .2
      STA FCN 
      ADA CRSA      CHECK IF END OF LIST
      CLB           CLEAR OPERATION 
      STB TMP+1 
      CPA TMP+2 
      JMP FNCRU,I   YES - EXIT
      ISZ FCN       MOVE TO NEXT VARIABLE 
      LDA A,I 
      STA TMP+1     SAVE OPERATION
      LDB FCN       GET NEXT VARIABLE 
      JSB FPG       A=VARIABLE
      CLO 
      LDB TMP+1     RETRIEVE OPERATION
      CPB AADD      + (ADD) 
      JMP FADD      YES 
      CPB AAND      . (AND) 
      JMP FAND      YES 
      CPB ASUB      - (SUBTRACT)
      JMP FSUB      YES 
      CPB AMPY      * (MULTIPLY)
      JMP FMPY      YES 
      CPB ADIV      / (DIVIDE)
      JMP FDIV      YES 
      CPB AIOR      : (IOR) 
      JMP FIOR      YES 
      CPB AXOR      ; (XOR) 
      JMP FXOR      YES 
      CPB FC.CM     , (REPEAT OPERATOPN)
      JMP FNCRU,I   YES 
      SKP 
* 
FMPY  MPY TMP 
      SZB,RSS 
      JMP FADD+1
      CPB .M1 
      SSA,RSS 
      STO 
      JMP FADD+1
* 
FDIV  LDB TMP 
      STA TMP 
      RRR 16        SWAP REGISTERS
      CPB .1        IS IT A SIMPLE ONE
      JMP FADD+1    YES 
      CLB 
      SSA 
      CCB 
      DIV TMP 
      JMP FADD+1
* 
FIOR  IOR TMP       DO AN INCLUSIVE OR
      JMP FADD+1
* 
FXOR  XOR TMP       DO AN EXCLUSIVE OR
      JMP FADD+1
* 
FAND  AND TMP       DO AND OPERATION
      JMP FADD+1
* 
FSUB  CMA,INA 
FADD  ADA TMP       ADD THE TWO PARAMETERS
      STA TMP 
FNCOC SOS           CHECK FOR OVERFLOW ERROR
      JMP FNCRN     NO DO NEXT OPERATION
      LDA .5        YES REPORT IT ERROR 5 
      JSB ERR 
* 
SOS   SOS 
      SKP 
*         FUNCTION LIST 
* 
FNCLI NOP 
      LDA CRSA,I    GET ENDING ADDRESS
      ALF,RAL 
      AND .37 
      ADA CRSA
      STA LIC 
FNCL0 LDA TMP,I     OUTPUT
      ISZ TMP       PARAMETER 
      LDB TMP,I 
      ISZ TMP 
      JSB .PPR,I
      LDA TMP 
      CPA LIC 
      JMP FNCLI,I   YES 
      CCB           PUT CHR IN BUFFER 
      ADB FMTBP 
      LDA TMP,I 
      JSB A2BUF 
      LDA TMP,I     CHECK FOR SECOND CHR
      ISZ TMP 
      ALF,ALF 
      AND .377
      SZA,RSS 
      JMP FNCL0     NONE
      LDB FMTBP 
      JSB A2BUF 
      ISZ FMTBP 
      JMP FNCL0     DO NEXT ONE 
      SKP 
*         LIA & LIAC  SYNTAX
*         OTA & OTAC  SYNTAX
* 
LOSY  NOP 
      JSB FPS       SELECT CODE STORE 
      JMP LOSY,I    NO SELECT CODE
      JSB FPS       PARAMETER 
      JMP LOSY,I    NONE
      LDA .4        INDICATE 4 LOCATIONS
      ISZ LOSY
      JMP LOSY,I
* 
*         RUN 
* 
LIOT  NOP 
      JSB IOCSC     GET SELECT CODE 
      IOR LIOT,I    ADD INSTRUCTION 
      STA *+3       PUT IT IN LINE
      LDB .4
      JSB FPG       GET PARAMETER 
      NOP           *** 
      STA B,I       PUT PARAMETER IN PLACE
      ISZ LIOT      RETURN P+2
      JMP LIOT,I
* 
* 
LI1RU NOP 
      JSB LIOT      DO INSTRUCTION
      LIA 0 
      JMP LI1RU,I 
* 
* 
LI2RU NOP 
      JSB LIOT      DO INSTRUCTION
      LIA 0,C 
      JMP LI2RU,I 
* 
*         LIST
* 
LOLI  NOP 
      JSB FPL       OUTPUT SELECT CODE
      JSB FPL       OUTPUT PARAMETER
      JMP LOLI,I
      SKP 
*         OTA & OTAC  RUN 
* 
OT1RU NOP 
      JSB LIOT
      OTA 0 
      JMP OT1RU,I 
* 
OT2RU NOP 
      JSB LIOT
      OTA 0,C 
      JMP OT2RU,I 
* 
* 
IOCSC NOP           GET SELECT CODE AND CHECK IT
      LDB .2
      STB IOSC      (SET HOLDOFF  FLAG) 
      JSB FPG 
      STA B 
      AND .M77      CAN'T BE
      SZA,RSS           OVER 77 OCTAL 
      JMP *+3 
IOCSE LDA .17 
      JSB ERR 
      LDA B 
      JMP IOCSC,I   RETURN
* 
IOCSX NOP           CHECK NOT UNDER 4 
      ADA .M4 
      SSA 
      JMP IOCSE     IT IS SO ERROR
      LDA B         RESTOR A
      JMP IOCSX,I   RETURN
      SKP 
*         SFC  SFS  STF  CLF  STC  STCC  CLC  CLCC
*                   SYNTAX
* 
IOCSY NOP 
      JSB FPS       SELECT CODE 
      JMP IOCSY,I 
      LDA .2
      ISZ IOCSY 
      JMP IOCSY,I 
* 
* 
*         LIST
* 
IOCLI NOP 
      JSB FPL       OUTPUT SELECT CODE
      JMP IOCLI,I 
      SKP 
*         RUN 
* 
* 
IOCRU NOP 
      JSB IOCSC     GET SELECT CODE 
      IOR IOCRU,I   ADD I/O INSTRUCTION 
      ISZ IOCRU 
      CCB           CHECK FOR MAPS
      CPA STC11     ON
      STB 140B      YES 
      CLB 
      CPA CLC11     OFF 
      STB 140B      YES 
      CPA CLC0      RESET 
      JMP CLCX      YEP 
      CPA CLC0C 
      JMP CLCX      YEP 
      STA *+2 
      CLA 
      NOP 
      JMP IOCRU,I 
      JMP *+1       INCASE OF MAPS
      LDA CRSA,I    IF SKIP MOVE UP ONE LINE
      ALF,RAL 
      AND .37 
      ADA CRSA
      STA CRSA
      JMP IOCRU,I 
* 
STC11 STC 11B 
CLC11 CLC 11B 
* 
CLCX  CLC 0,C 
      LDB INTLP     CLEAR INTERRUPT TABLE FLAGS 
      LDA B,I       
      CPA .M1       END OF TABLE
      JMP *+4       YES 
      ELA,CLE,ERA   NO CLEAR BIT 15 
      INB 
      JMP *-5 
      CLA 
      STA INTF      CLEAR INTERRUPT FLAG
      STA 140B      AND MAPS
      JMP IOCRU,I   RETURN
      SKP 
* 
SFSRU NOP 
      JSB IOCRU 
      SFS 0 
      JMP SFSRU,I 
* 
SFCRU NOP 
      JSB IOCRU 
      SFC 0 
      JMP SFCRU,I 
* 
STFRU NOP 
      JSB IOCRU 
      STF 0 
      JMP STFRU,I 
* 
CLFRU NOP 
      JSB IOCRU 
      CLF 0 
      JMP CLFRU,I 
* 
STCRU NOP 
      JSB IOCRU 
      STC 0 
      JMP STCRU,I 
* 
STCCR NOP 
      JSB IOCRU 
      STC 0,C 
      JMP STCCR,I 
* 
CLCRU NOP 
      JSB IOCRU 
CLC0  CLC 0 
      JMP CLCRU,I 
* 
CLCCR NOP 
      JSB IOCRU 
CLC0C CLC 0,C 
      JMP CLCCR,I 
      SKP 
*         WAIT FOR INTERRUPT
* 
WFIRU NOP 
      JSB IOCSC     GET SELECT CODE 
      JSB IOCSX     CHECK NOT UNDER 6 
      STA SC        SAVE SELECT CODE
      LDB .4        GET TIME ALLOWED
      JSB FPG       FILE PARAMETER GET
      LDB A 
      LDA SC
      JSB WFI       GO WAIT 
      JMP WFIRU,I   TIMED OUT DONT SKIP 
      LDA CRSA,I    OK SKIP 
      ALF,RAL 
      AND .37 
      ADA CRSA
      STA CRSA
      JMP WFIRU,I   RETURN
      SKP 
WFI   NOP 
      STA SC        SET SELECT CODE 
      STB WFITC     SAVE TIME ALLOWANCE 
      JSB DVSSG     SAVE GLOBAL REG.
      LDB SC,I      SAVE CURRENT CONTENTS 
      STB TMP          TRAP CELL
      IOR SFCRU+2 
      STA WFIF
      CLA 
      STA WFIRX     DONT CHANGE INTERRUPTS IF FLAG SET
      LDA WFITC 
      CMA,INA       MAKE NEG IF FLAG SET
WFIF  NOP           EXIT IF FLAG ALREADY SET
      JMP WFIR+2
      LDA JSBI.     SET JSB IN TRAP CELL
      STA SC,I
      LDA WFID
      STA .INT
      LDA CLFRU+2 
      SFC 0         LEAVE INTERRUPTS ON?
      LDA *+3       YES 
      STA WFIRX 
      LDA WFITC     GET TIME ALLOWED
      STF 0 
      JSB TMR       GO WAIT FOR IT
      CLF 0         TIMED OUT DONT SKIP 
WFI0  LDB TMP       RESTORE ORIGINAL TRAP CELL
      STB SC,I
      CLA           CLEAR TBF FLAG
      STA TMR 
      LDB WFITC 
      JSB DVRSG     RESTORE GLOBAL REG. 
WFIRX NOP           RESTORE INTERRUPT SYSTEM
      JMP WFI,I 
WFIR  NOP 
      CLF 0         TURN OFF INTERRUPTS 
      ISZ WFI       ADJUST RETURN 
      JMP WFI0      CONTINUE
WFID  DEF WFIR
WFITC NOP 
      SKP 
*         INT  SYNTAX 
* 
INTSY NOP 
      JSB FPS       GET SELECT CODE 
      JMP INTSY,I   NO SELECT CODE
      JSB GTLN      GET LINE NUMBER 
      JMP INTS1     NOT A NUMBER SO TRY LETTER
INTS0 STA TMP,I 
      LDA .3
      ISZ INTSY 
      JMP INTSY,I 
INTS1 SZA,RSS       IF ZERO THEN OK 
      JMP INTS0 
      JSB GETB      GET CHARACTER 
      JMP INTSY,I   NO DATA SO ERROR
      CPA .40       SKIP SPACES 
      JMP *-3 
      JSB LTCK      MUST BE A LETTER
      JMP INTSY,I   NOT SO ERROR
      CPA AA
      JMP INTS2     OK
      CPA AB
      JMP INTS2 
      CPA AC
      JMP INTS2 
      CPA AD
      RSS 
      JMP INTSY,I   NOT CORECT CHR
INTS2 ADA .M1       DECREMENT IT
      IOR BIT15     ADD FLAG BIT
      JMP INTS0     PUT IT IN PLACE 
      SKP 
*         INT  RUN
* 
INTRU NOP 
      JSB IOCSC     GET NEW SELECT CODE 
      JSB IOCSX     CHECK NOT UNDER 4 
      STA INTSC 
      LDB CRSA      GET INTERRUPT LINE NUMBER 
      ADB .4
      LDA B,I 
      SZA           CLEAR OR SET? 
      JMP INTR0 
      LDB INTLP     CLEAR TABLE 
      ADB INTSC 
      STA B,I 
      LDB INTSC 
      CPB .4        CHECK FOR 4 & 5 
      LDA JPFAR 
      CPB .5
      LDA JPTY  
      STA INTSC,I   CLEAR 
      JMP INTRU,I   RETURN
INTR0 SSA           IS THIS A DIRECT JUMP 
      JMP INTR1     YES 
      JSB FNDLN     N0 -GET LINE ADDRESS
      JMP INTRE     NO LINE NUMBER
      LDA INTLP     SET LINE NUMBER 
      ADA INTSC 
      STB A,I 
      LDA JSBI      SET JSB IN TRAP CELL
      STA INTSC,I 
      JMP INTRU,I 
INTR1 AND .3        USE ONLY LOWER BITS 
      ADA JIOR      MAKE JSB INSTRUCTION
      STA INTSC,I   PUT IT IN PLACE 
      JMP INTRU,I 
* 
JIOR  JSB .IOA,I
* 
INTRE CLA,INA 
      JSB ERR 
* 
INTLT REP 8         INTERRUPT LINE TABLE
      OCT 0,0,0,0,0,0,0,0 
      DEC -1        TERMINATOR
      SKP 
PINT  NOP 
      OCT 103300    SFS 0,C IF INTS ARE OFF SKIP CHECK
      JMP PINT,I
      LDB INTLP     GET POINTER TO TABLE
      LDA B,I       GET LINE NUMBER + FLAG
      SSA           IS FLAG SET?
      JMP *+3       YES 
      INB           NO MOVE TO NEXT ONE 
      JMP *-4 
      CPA .M1       END OF TABLE? 
      JMP PINTX     YES - NO FLAGS
      ELA,CLE,ERA   CLEAR FLAG
      STA B,I 
      STA INTLN 
      INB 
      LDA B,I       CHECK FOR ANY OTHERS
      SSA,RSS 
      JMP *-3 
      CPA .M1       END OF TABLE? 
      JMP *+2       YES CLEAR INTERRUPT FLAG
      JMP *+3       NO LEAVE INTERRUPT FLAG SET 
      CLA           CLEAR 
      STA INTF      INTERRUPT FLAG
      LDA STBFD     CHECK GOSUB 
      CMA,INA        NOT OVERFLOWED 
      ADA STBF
      INA 
      ADA .M32            24 MAX
      SSA           ? 
      JMP *+3 
      LDA .21       YES TELL OPERATOR 
      JSB ERR 
      LDA CRSA      ADD NEXT LINE TO
      STA STBF,I      GOSUB TABLE 
      ISZ STBF
      LDA INTLN     GO TO INTERRUPT LINE
      STA CRSA
PINTX STF 0         RESTORE INTERRUPTS
      JMP PINT,I
* 
*         INT  LIST 
INTLI NOP 
      JSB FPL       LIST SELECT CODE
      LDB TMP,I 
      SSB           I/O ROUTINE 
      JMP INTL1     YES 
      CLA 
INTL0 JSB .PPR,I    AND LINE NUMBER 
      JMP INTLI,I 
INTL1 ELB,CLE,ERB   CLEAR BIT 15
      INB           ADD ONE TO MAKE LETTER
      LDA B         MAKE PARAMETER
      CLB 
      JMP INTL0     PRINT IT
      SKP 
*     MAP REGISTERS SYNTAX CHECK
* 
      ORG 12000B
MAPSY NOP 
      JSB FPS       PUT IT IN FILE
      JMP MAPSY,I   NO REGTISTER SO ERROR 
      JSB FPS       PUT PAGE IN FILE
      JMP MAPSY,I   NO PAGE SO ERROR
      LDA .4        SET FOUR LOCATIONS USED 
      ISZ MAPSY     ALL'S OK RETURN NO ERROR
      JMP MAPSY,I 
* 
*     LIST MAPS 
* 
MAPLI NOP 
      JSB FPL       REG.
      JSB FPL       PAGE
      JMP MAPLI,I 
      SKP 
*     MAP RUN ROUTINE 
* 
MAPRU NOP 
      LDA STFE      SET LOWEST PAGE NUMBER ALLOWED
      ALF 
      RAL,RAL 
      AND .77 
      INA           MOVE TO NEXT PAGE 
      IOR .100
      CMA,INA 
      STA BFMRC     SAVE IT 
      ADA .100      MAPE PAGE OUT OF IT 
      STA MAPX
      LDB .2        GET MAP REF. FROM FILE
      JSB FPG 
      STA MAPSY     SAVE IT 
      CPA .140      IS IT THE FLAG? 
      JMP MAPER     YES THEN ERROR
      CMA,INA       CHECK WHICH IT IS 
      ADA .140
      SSA,RSS       IF LESS THAN 140 BFMAP
      JMP BFMP      YES 
* 
      JSB MAPCK     CHECK AND SAVE DMA MAP REGISTER 
      OCT -141          STARTING REGISTER 
      OCT -200          ENDING REGISTER 
      LDA MAPLI     GET MAP CONTENT 
      JMP MAPRX     AND EXIT
* 
BFMP  JSB MAPCK     GET AND CHECK MAP REGISTER
BFMRC OCT 0         MINIMUM PAGE
      OCT -140      MAXIMUM PAGE
      SZA           IS THIS A RESET 
      JMP MAPRX     NO THEN CHECK AND SET 
      LDA MAPSY     GET MAP ADDRESS 
      AND .77       MASK OFF LOCATION BIT 
      JMP MAPRX     RETURN
      LDA MAPLI     GET PAGE
MAPRX STA MAPSY,I 
      JSB I?ON      RESTOR MAPS AND INTS
      JMP MAPRU,I 
      SKP 
* 
* 
MAPER LDA .30 
      JSB ERR       REPORT MAP ERROR
* 
*     GET AND CHECK MAP REGISTER
* 
MAPCK NOP 
      JSB I?OF      TURN MAPS OFF FOR THIS OPERATION
      LDA MAPSY     SAVE IT 
      ADA MAPCK,I   CHECK IF ABOVE LOWER LIMIT
      SSA 
      JMP MAPER     NOT SO ERROR
      ISZ MAPCK     MOVE TO UPPER LIMIT 
      LDA MAPSY     RESTOR MAP
      ADA MAPCK,I 
      SSA,RSS 
      JMP MAPER 
      ISZ MAPCK 
      LDB .4        GET PAGE NUMBER 
      JSB FPG 
      STA MAPLI 
      SZA,RSS       IF CLEAR SKIP CHECK 
      JMP MAPCK,I     
      ADA MAPX      CHECK NOT UNDER STFE
      SSA 
      JMP MAPER     IT WAS
      LDA MAPLI     RESTORE A 
      JMP MAPCK,I 
* 
MAPX  NOP 
      SKP 
*     I/O PROGRAM CLEAR 
* 
IOPCA NOP 
      CLA 
      JSB IOPC
      JMP IOPCA,I 
* 
IOPCB NOP 
      CLA,INA 
      JSB IOPC
      JMP IOPCB,I 
* 
IOPCC NOP 
      LDA .2
      JSB IOPC
      JMP IOPCC,I 
* 
IOPCD NOP 
      LDA .3
      JSB IOPC
      JMP IOPCD,I 
* 
* 
IOPC  NOP 
      RAL,RAL       MPY NUMBER BY 4 
      ADA IOPDF     ADD POINTER TO TABLE
      LDB A,I 
      INA 
      STB A,I 
      INA           GET RETURN JMP
      LDA A,I 
      STA B,I 
      LDA DM100 
      INA 
      INB 
      STA TMP 
      CLA 
      STA B,I 
      INB 
      ISZ TMP 
      JMP *-3 
      JMP IOPC,I
      SKP 
*         INPUT CALLS 
* 
*         CLA            INPUT FROM CONSOLE 
*         JSB CFI        CALL FOR INPUT 
*         .              NORMAL RETURN
* 
*         JSB CDN        CONVERT A DECIMAL NUMBER 
*     OR
*         JSB CON        CONVERT AN OCTAL NUMBER
*         .              P+1 ERROR RETURN 
*                        A = O = NO DATA
*                         A = -1 = NOT A NUMBER 
*                        P+2 NORMAL RETURN
*                        A = CONVERTED NUMBER 
* 
*              INPUT FROM A DEVICE TO BUFFER
* 
CFI   NOP 
      STA DVN       SAVE DEVICE NUMBER
CFI0  LDB DM72      GET BUFFER SIZE 
      JSB .DVIO,I 
      DEF BUF 
      SSA           END OF TAPE?
      JMP CFI,I     YES RETURN
      STA TMPA
      CPA D72       IF 72 CHR INPUT 
      JSB CFIRL     DO A CR-LF
      LDA .15       ADD CR TO END OF BUFFER 
      LDB BUFA
      ADB TMPA
      JSB A2BUF 
      LDB BUFA      ESTABLISH POINTER 
      STB GETP
      LDA DVN       CHECK IF CONSOLE
      SZA 
      JMP *+4       NO SKIP STOP CHECK
      JSB BUF2A 
      CPA .23       CNTL S MEANS STOP 
      JSB .STOP 
      LDA TMPA
      JMP CFI,I 
* 
CFIRL NOP 
      LDA DVN       GET DEVICE NUMBER 
      SZA           OUTPUT ONLY IF CONSOLE
      JMP CFIRL,I   NOT SO EXIT 
      LDB .2
      JSB .DVIO,I 
      DEF *+2 
      JMP CFIRL,I   RETURN
      OCT 6412
      SKP 
*              CONVERT DECIMAL NUMBER 
CDN   NOP 
      JSB CIN 
      JSB .CVDC,I 
* 
*              CONVERT OCTAL NUMBER 
CON   NOP 
      JSB CIN 
      JSB .CVOC,I 
* 
CIN   NOP 
      LDA CIN,I     RETRIEVE
      STA CIN0      CONVERSION TYPE 
      LDA CIN       SET 
      ADA .M2       RETURN
      LDA A,I       ADDRESS 
      STA CIN 
      LDB RSS       CLEAR 
      STB CINN      NEG FLAG
      LDB GETP      SAVE BUFFER POINTER 
      STB CDN 
CIN.  JSB GETB      GET FIRST CHARACTER 
      JMP CIN1+1
      JSB DGCK      IS IT A DIGIT?
      JMP CINC      NO
CIN0  JSB .CVDC,I   CONVERT IT
      LDB GETP      CHECK 
      JSB BUF2A 
      JSB DGCK      NEXT CHR IS NOT A DIGIT 
      JMP *+6 
CIN1  CCA,RSS       ERROR - NOT A NUMBER
      CLA           NO DATA 
      LDB CDN       RESTORE BUFFER ADDRESS
      STB GETP
      JMP CIN,I     RETURN P+1
      LDA CVN       GET CONVERTED NUMBER
CINN  RSS           NOP = NEG 
      CMA,INA 
      ISZ CIN 
      JMP CIN,I     RETURN P+2
CINC  CPA .55       IS IT A NEG SIGN
      JMP *+6 
      CPA .53       IS IT A PLUS SIGN?
      JMP CIN.      YES 
      CPA .40 
      JMP CIN.
      JMP CIN1      NO - THEN ERROR 
      CLB 
      STB CINN      MAKE NUMBER NEG WHEN CONVERTED
      JSB GETB      GET NEXT CHARACTER
      JMP CIN1      NO MORE DATA
      JSB DGCK      IT MUST BE A DIGIT
      JMP CIN1      NO -SO ERROR
      JMP CIN0      OK CONVERT IT 
      SKP 
*     CONVERT HEX NUMBER
* 
CHN   NOP 
      LDA GETP      SAVE BUFFER POINTER 
      STA CDN 
      CLA           CLEAR NUMBER
      STA CVN 
      LDA DM4       SET MAX CHR COUNT 
      STA CON 
CHN0  JSB GETB      GET A CHARACTER 
      JMP CHNX      NO DATA 
      JSB DGCK      IS IT A DIGIT?
      JMP CHN1      NO CHECK FOR CHR A TO F 
CHN0. ADB CVN       YES - ADD IT TO NUMBER
      BLF           MOVE IT UP
      STB CVN       AND KEEP IT 
      ISZ CON       DONE 4 DIGITS?
      JMP CHN0      NO - THEN DO ANOTHER
CHNX  ISZ CHN       ADJUST RETURN 
      LDA CVN       GET NUMBER
      ALF,ALF       PUT IN RIGHT PLACE
      ALF 
      JMP CHN,I     RETURN P+2
* 
CHN1  CPA .40       IS IT A SPACE?
      RSS 
      JMP CHN2      NO
      LDB CON       YES 
      CPB DM4       FIRST DIGIT?
      JMP CHN0      YES - SKIP IT 
CHN1. CCA           NO
      ADA GETP       BACK SPACE POINTER 
      STA GETP
      JMP CHNX      RETURN P+2 WITH NUMBER
* 
CHN2  ADA .M107     IS IT A-F?
      SSA,RSS 
      JMP CHN1.     NO
      ADA .6
      SSA 
      JMP CHN1.     NO
      ADA .12       YES 
      LDB A         CHANGE HANDS
      JMP CHN0.     ADD IT TO NUMBER
      SKP 
*         CONVERT ASCII INTEGER (DECIMAL) TO BINARY 
* 
CVDEC NOP 
      CLB           CLEAR 
      STB CVN          NUMBER 
CVD0  JSB DGCK      CHECK IF IT'S A NUMBER
      JMP CVD1      NO
      LDA CVN       * 
      CLE,ELA       * 
      SSA           * 
      JMP CVD1      * 
      ADB A         *  CONVERT TO 
      SSA           * 
      JMP CVD1      * 
      CLE,ELA       *   BINARY
      SSA           * 
      JMP CVD1      * 
      CLE,ELA       * 
      SSA           * 
      JMP CVD1      * 
      ADA B         * 
      SSA           * 
      JMP CVD1      * 
      STA CVN       * 
      JSB GETC      GET NEXT CHARACTER
      JMP CVD0      NO
CVD1  CCB           YES MOVE POINTER
      ADB GETP        BACK ONE
      STB GETP
      LDA CVN       RETRIEVE NUMBER 
      JMP CVDEC,I   RETURN
      SKP 
*         CONVERT ASCII OCTAL TO BINARY 
* 
CVOCT NOP 
      CLB 
      STB CVN       CLEAR NUMBER
CVO0  JSB ONCK      CHECK IF IT'S AN OCTAL NUMBER 
      JMP CVO1      NO
      LDA CVN       * 
      CLE,ELA       * 
      SEZ           * 
      JMP CVO1      * 
      ELA,CLE       * 
      SEZ           * 
      JMP CVO1      * 
      CLE,ELA       * 
      SEZ           * 
      JMP CVO1      * 
      ADA B         *      BINARY 
      STA CVN       * 
      JSB GETC      GET NEXT CHARACTER
      JMP CVO0      NO
CVO1  CCB           YES - MOVE POINTER
      ADB GETP          BACK ONE
      STB GETP
      LDA CVN       GET NUMBER
      JMP CVOCT,I   RETURN
      SKP 
*         FORMATTED OUTPUT
* 
*         CLA            OUTPUT TO CONSOLE
*         JSB .FMT,I
*         DEF FMTS       FORMAT ASCII STRING
* 
*         LDA DATA       DATA REQUIRED BY FORMAT
*         JSB FMT,I      GIVE IT TO FORMATTER 
*         JSB FMT.,I     TERMINATE FMTR AND OUTPUT BUFFER 
* 
* 
* 
*         FORMAT ASCII STRING CHARACTERS
*         (  REPEAT FORMAT START
*         )  REPEAT FORMAT END
*         ,  SEPARATOR
*         "" DELINEATE ASCII STRING 
*         /  CARRIAGE RETURN LINE FEED
*         K  OCTAL NUMBER (@ SUPRESS ZEROS) 
*         H  HEX NUMBER  (& SUPRESS ZEROS)
*         I  INTEGER (DECIMAL) NUMBER 
*         A  ASCII CHARACTERS  (OR AB FOR ASCII BUFFER) 
*         B  BINARY NUMBER (LEADING ZEROS NOT SUPP) 
*         X  ASCII SPACE
*         RKN 
*         R = REPEAT OPERATION
*         N = NUMBER OF CHARACTERS
*         FOR I,K,AND @ MAX 6 
*         FOR B  MAX 16 
*         FOR A  MAX 2
*         % SUPPRESS LEADING SPACES ON NEXT NUMBER
      SPC 1 
*         START FORMAT OUTPUT 
* 
FMTR  NOP           ENTRY 
      LDA FMTR,I    GET FORMAT ADDRESS
      LDB BUFA      GET BUFFER STARTING ADDRESS 
      SSA           SHOULD IT BE RESET??
      STB FMTBP     YES 
      CLE,ELA       CONVERT TO BYTE ADDRESS 
      STA GETP      SAVE IT 
      INA 
      STA FMTS      AND FORMAT STARTING ADDRESS 
      STA FMTSR     ALSO FOR FORMAT STRING REPEAT 
      ISZ FMTR
      LDA FMTR
      STA P2FMT     SAVE RETURN ADDRESS 
      CLA           CLEAR 
      STA FSR         FORMAT STRING REPEAT
      STA SIFF      STAY IN FORMAT FLAG 
      JMP FMT1-1
      SKP 
FMT0  NOP 
      ISZ FCR       REPEAT FORMAT CHARACTER 
      JMP FMT0,I    YES 
      CCA 
FMT1  STA FCR       NO - SET FORMAT CHARACTER REPEAT
      CLA 
      STA NCPN      CLEAR SUPPRESS FLAG 
      STA INTGN 
      JSB GETC      GET A FORMAT CHARACTER
      CPA A%        SUPRESS NUMBER SPACES 
      JMP SSNS      YES 
      CPA FC.CM     COMMA?
      JMP *-2       YES 
      CPA FC.LP     LEFT PAREN? 
      JMP LPREN     YES 
      CPA FC.RP     RIGHT PAREN?
      JMP RPREN     YES 
      CPA FC.SL     SLASH?
      JMP SLASH     YES 
      CPA FC.QT     QUOTE?
      JMP QUOTE     YES 
      CPA FC.H      HEX?
      JMP HEXL      YES 
      CPA FC.&      &? (HEX)
      JMP HEX       YES 
      CPA FC.A      ASCII?
      JMP ASCII     YES 
      CPA FC.K      OCTAL?
      JMP OCTL      YES 
      CPA FC.AT     @?  (OCTAL) 
      JMP OCTAL     YES 
      CPA FC.I      INTEGER?
      JMP INTGR     YES 
      CPA FC.B      BINARY? 
      JMP BINRY     YES 
      CPA FC.X      SPACE?
      JMP SPACE     YES 
      SPC 1 
      JSB CVFN      CHECK AND CONVERT NUMBER
      DEC -100      NOT GREATER THAN 100
      JMP FMT1      GET NEXT FORMAT CHARACTER 
      SKP 
*         LEFT PAREN
*         FORMAT STRING REPEAT START
* 
LPREN LDA GETP      GET CURRENT POINTER 
      CPA FMTS      IS IT THE START 
      JMP FMT1-1         YES - IGNORE IT
      STA FMTSR     NO - SET REPEAT POINTER 
      LDA FCR       AND REP COUNT 
      STA FSR 
      JMP FMT1-1    GO GET NEXT FORMAT CHARACTER
* 
*         RIGHT PAREN 
*         FORMAT STRING REPEAT
* 
RPREN LDA FSR       IS THERE A REPEAT 
      SZA           ? 
      JMP RPRN0 
      STA SIFF      NO - INSURE EXIT
      LDA FMTS      RESET FORMAT POINTER
      STA GETP
      JSB FMT2P     RETURN TO PROGRAM 
      STA SDFP      SAVE DATA FORM PROGRAM
      CCA           SET STAY IN 
      STA SIFF         FORMATTER FLAG 
      JMP FMT1-1    GET NEXT FORMAT CHARACTER 
* 
RPRN0 LDA FMTSR     GET REPEAT ADDRESS
      ISZ FSR       ANY REPEATS?
      STA GETP      YES 
      JMP FMT1-1    GET NEXT FORMAT CHARACTER 
* 
* 
*         CARRIAGE RETURN LINE FEED 
* 
SLASH LDA .15       ADD CARRIAGE RETURN 
      JSB FC2B
      LDA .12       ADD LINE FEED 
      JSB FC2B
      JSB FMT0      DO NEXT FORMAT CHARACTER
      JMP SLASH     NO - REPEAT 
      SKP 
*         ASCII STRING OUTPUT 
* 
QUOTE JSB GETC      GET CHARACTER FROM STRING 
      CPA FC.QT     IS IT A QUOTE?
      JMP FMT1-1    YES 
      JSB FC2B      PUT CHARACTER IN BUFFER 
      JMP QUOTE     DO NEXT CHARACTER 
* 
*         ADD SPACE TO BUFFER 
* 
SPACE LDA .40       GET ASCII SPACE 
      JSB FC2B      ADD ADD IT TO BUFFER
      JSB FMT0      DO NEXT FORMAT CHARACTER
      JMP SPACE     NO - REPEAT 
* 
*         ASCII CHARACTER FROM PROGRAM
* 
ASCII JSB GETC      GET NEXT FORMAT CHARACTER 
      JSB CVFN      CHECK AND CONVERT NUMBER
      DEC -2        NO GREATER THAN 2 
      CLB 
      SLA,RSS       PACKED OR UNPACKED? 
      LDB RSS       PACKED
      STB ASC.I 
ASC.R JSB FMT2P     GO GET CHARACTERS 
      STA TMPA      SAVE CHARACTER(S) 
ASC.I NOP           SKIP SECOND CHARACTER 
      JMP *+6       YES 
      ALF,ALF         HALF
      AND .177
      SZA           CHECK IF ZERO 
      JSB FC2B      PUT IT IN BUFFER
      LDA TMPA      DO SECOND 
      AND .177
      SZA           CHECK IF ZER0 
      JSB FC2B
      JSB FMT0      DO NEXT FORMAT CHARACTER
      JMP ASC.R     NO - REPEAT 
      SKP 
*         CONVERT  OCTAL  NUMBER
* 
OCTL  LDA DM6       NO GREATER THAN 6 DIGITS
      JSB NCV       GO SET IT UP
      LDB .60       PRINT ALL ZEROS 
      STB SPCF
      JMP *+3 
OCTAL LDA DM6       NO GREATER THAN 6 DIGITS
      JSB NCV       GO SET IT UP
      CLB,INB       SET MASK FOR FIRST CHARACTER
      RAL           ROTATE IT IN
      STA TMPA      SAVE IT 
      AND B         MASK UNWANTED BITS
OCTL0 AND .7        MASK OFF UPPER BITS 
      JSB NCVN      ADD IT TO BUFFER
      LDA TMPA      GET NEXT NUMBER 
      RAL,RAL        ROTATE IT
      RAL              IN 
      STA TMPA      SAVE IT 
      JMP OCTL0 
* 
* 
*         CONVERT A BINARY NUMBER 
* 
BINRY LDA DM16      NO GREATER THAN 16
      JSB NCV 
      LDB .60       PRINT ALL ZEROS 
      STB SPCF
BINY0 ELA 
      STA TMPA
      CLA 
      ELA 
      JSB NCVN
      LDA TMPA
      JMP BINY0 
* 
*         SUPRESS NUMBER SPACING
* 
SSNS  LDA RSS 
      STA NCPN
      STA INTGN 
      JMP FMT1+4
      SKP 
*     CONVERT HEX NUMBER
* 
HEXL  LDA DM4       NO LARGER THAN 4 DIGITS 
      JSB NCV       SET FIELD SIZE
      LDB .60       PRINT ALL ZEROS 
      STB SPCF
      JMP *+3 
HEX   LDA DM4       NO LARGER THAN 4 DIGITS 
      JSB NCV       SET FIELD SIZE
      ALF           POSITION FOR FIRST DIGIT
      STA TMPA      SAVE RESULT 
      AND .17       MASK UPPER DIGITS 
      JSB NCVN      PUT IT IN BUFFER
      LDA TMPA      DO NEXT DIGIT 
      JMP HEX+2 
* 
*         CONVERT A NUMBER
* 
NCV   NOP 
      STA NCVW
      JSB GETC      GET NEXT FORMAT CHARACTER 
      JSB CVFN      CHECK AND CONVERT FORMAT NUMBER 
NCVW  NOP           NO GREATER THAN 
      STA NWCS      SAVE NUMBER WIDTH 
      STB NWDS      SAVE SPACE DOWN NUMBER
NCV0  LDA NWDS      RESTORE COUNT 
      STA NWD 
      LDA NWCS
      STA NWC 
      LDA .40       SET ZERO
      STA SPCF        SUPPRESS
      JSB FMT2P     GO GET NUMBER 
      JMP NCV,I     RETURN FOR CONVERSION 
* 
NCVN  NOP 
      ISZ NWD       ADD IT TO BUFFER
      RSS           NO
      JMP *+4 
      SZA           IS THERE A NUMBER 
      JMP DLSGN     YES - ERROR $$$ 
      JMP NCVN,I    NO - CONVERT NEXT ONE 
      LDB .60       SET 
      SZA             NON ZERO
      STB SPCF          SUPPRESS
      JSB NCPC      PUT CHARACTER IN BUFFER 
      JMP NCVN,I    RETURN FOR MORE 
      SKP 
NCPC  NOP 
      LDB A         B = WORK REG
      ADB DM10      CHECK IF 9 OR LESS
      SSB           IS IT 
      JMP *+4       YES NORMAL CHR
      ADB AA        MAKE IT HEX 
      LDA B         COPY DATA 
      JMP NCPN+1    INSURE IT IS IN BUFFER
      IOR SPCF
      LDB NWC       IS THIS THE LAST NUMBER 
      CPB .M1       ? 
      IOR .60       YES INSURE IT'S A NUMBER
      CPA .40       IS IT A SPACE?
NCPN  NOP           RSS = SUPRESS SPACES
      JSB FC2B
      CCA           SKIP
      STA NWD         WIDTH CHECK 
      ISZ NWC       IS THIS IT
      JMP NCPC,I    NO CONVERT ANOTHER
NCVN. JSB FMT0      GET NEXT CHARACTER
      LDA .40       ADD SPACE FOR REP NUMBER
      JSB FC2B      PUT IT IN BUFFER
      JMP NCV0      NO - REPEAT NUMBER
* 
DLSGN LDA A$        GET $$$ TO INDICATE 
      JSB FC2B         NUMBER OVER FLOW 
      ISZ NWC       ALL FILLED? 
      JMP *-3       NO
      JMP NCVN.     TRY NEXT NUMBER 
      SKP 
*         CONVERT AN INTEGER NUMBER 
* 
INTGR LDA DM6       NO GREATER THAN 6 DIGITS
      JSB NCV       GO SET IT UP
      CLB           CLEAR 
      STB NFG         NEGATIVE FLAG 
      STA TMPA      SAVE NUMBER 
      SSA,RSS       IS IT NEG 
      JMP INTG0     NO
      LDB NWC       CHECK IF COUNT OK 
      CPB .M1 
      JMP DLSGN     NO - ERROR $$$
      CMA,INA       MAKE NUMBER POSITIVE
      SSA           IF STILL NEG
      CLA             CLEAR IT
      STA TMPA        POSITIVE
      LDA .55       SET NEGATIVE
      STA NFG         FLAG
      JMP INTG1     CONVERT NUMBER
INTG0 LDA NWC       CHECK IF - WAS ALLOWED? 
      CPA DM6 
      RSS 
      JMP *+6 
      LDA .40       YES ADD SPACE 
INTGN NOP           SUPPRESS SPACE
      JSB FC2B
      ISZ NWC 
      RSS 
      ISZ NWD 
INTG1 JSB DIV 
      DEC -10000    OUTPUT 10000 CHARACTER
      DEC -1000     OUTPUT  1000 CHARACTER
      DEC -100      OUTPUT   100 CHARACTER
      DEC -10       OUTPUT    10 CHARACTER
      DEC -1        OUTPUT     1 CHARACTER
      SKP 
DIV   NOP           ENTRY 
      LDA TMPA      GET NUMBER
      CLB           CLEAR COUNT 
DIV0  ADA DIV,I     SUBTRACT DIVISOR
      SSA           WAS IT LESS THAN DIVISOR
      JMP DIV1      YES - THEN OUTPUT IT
      INB           NO - INCREMENT THE COUNT
      STA TMPA      AND SAVE COUNT
      JMP DIV0      DO IT AGAIN 
* 
DIV1  STB TMPB      SAVE NUMBER 
      ISZ DIV       MOVE TO NEXT COUNT
      LDA B 
      ISZ NWD       ADD IT TO BUFFER
      RSS           NO
      JMP DIV2
      SZB           IS THERE A NUMBER 
      JMP DLSGN     YES ERROR $$$ 
      JMP DIV+1     DO NEXT NUMBER
* 
DIV2  LDB .60       HAS THERE BEEN A NUMBER 
      CPB SPCF      ? 
      JMP DIV3      YES- IGNORE REST OF CHECKS
      SZA           IS THIS A NUMBER
      STB SPCF      YES CLEAR SPACE FLAG
      LDB NWC 
      CPB .M2       IS THIS THE SECOND FROM LAST? 
      JMP *+3       YES CHECK NEG FLAG
      SZA,RSS       NO - IS IT A NUMBER?
      JMP DIV3      NO - SKIP NEG CHECK 
      LDA NFG 
      SZA,RSS       DO I NEED THE NEG SIGN
      JMP *+3       NO
      JSB FC2B      YES  ADD IT TO BUFFER 
      ISZ NWC         AND COUNT 
      LDA TMPB      GET NUMBER
DIV3  JSB NCPC
      JMP DIV+1 
      SKP 
*         CONVERT  A  NUMBER  FROM  FORMAT  STRING
* 
CVFN  NOP 
      JSB .CVDC,I   CONVERT DECIMAL NUMBER
      LDB A 
      SZB,RSS       IF NUMBER IS ZERO 
      JMP BDFMT       THEN BAD FORMAT 
      ADB .M1 
      ADB CVFN,I    CHECK IT NOT MAX
      SSB,RSS 
      JMP BDFMT     YES BAD FORMAT
      CMA,INA       MAKE CONVERTED NUMBER NEG.
      ISZ CVFN       ADJUST RETURN
      JMP CVFN,I     RETURN 
* 
BDFMT LDA FMTR      CHECK IF ERROR MESSAGE
      CPA ERRAD     IF SO NO ERROR
      JMP .STOP+2   JUST STOP 
      LDA .20       NOT SO BAD FORMAT ERROR 
      JSB ERR 
* 
ERRAD DEF ERRFM 
      SKP 
FMT2P NOP           FORMATTER TO PROGRAM
      LDA FCR       GET REPEAT COUNT
      LDB SIFF      GET FLAG
      SZB,RSS       STAY IN FORMATTER?
      JMP P2FMT,I   NO - RETURN TO PROGRAM
      CLB           YES - BUT CLEAR FLAG
      STB SIFF      FOR NEXT RETURN 
      LDA SDFP      GET DATA IF REP FMT 
      JMP FMT2P,I   GO BACK TO FORMATTER
* 
* 
P2FMT NOP           PROGRAM TO FORMATTER
      STB FMTC      SAVE B-REG. 
      LDB FMTR      CHECK IF THERE IS A 
      SZB,RSS           FORMAT IN PROGRESS
      JMP P2FMT,I   NO
      LDB FMTC      RESTORE B-REG.
      JMP FMT2P,I 
* 
*         FORMAT CHARACTER TO BUFFER
* 
FC2B  NOP 
      LDB FMTBP     PUT CHR IN OUTPUT BUFFER
      ISZ FMTBP 
      JSB A2BUF     PUT CHARACTER IN BUFFER 
      LDB FMTBP     CHECK IF
      ADB BUFE          BUFFER IS 
      SSB,RSS               FULL? 
      JMP BDFMT     YES - BAD FORMAT
      JMP FC2B,I    RETURN
* 
*         FORMAT COMPLETE 
* 
*         JSB FMTC             (JSB FMT.,I) 
* 
FMTC  NOP 
      STA DVN       SAVE DEVICE NUMBER
      JSB FMTX      OUTPUT BUFFER 
      CLA           CLEAR 
      STA FMTR        FORMAT IN PROGRESS
      JMP FMTC,I
* 
FMTX  NOP 
      LDB BUFA      CONVERT BUFFER
      CMB,INB         COUNT 
      ADB FMTBP 
      LDA DVN       GET DEVICE NUMBER 
      JSB .DVIO,I    OUTPUT TO DEVICE 
      DEF BUF       POINTER TO BUFFER 
      LDA BUFA      RESET BUFFER ADDRESS
      STA FMTBP 
      JMP FMTX,I    RETURN
* 
      SKP 
*         DEVICE INPUT/OUTPUT 
* 
*         A = 0     B = + OUTPUT   CONSOLE DEVICE 
*                       - INPUT    CONSOLE DEVICE 
*         A = 1     B = + OUTPUT   LEFT CARTRIDGE TAPE UNIT 
*                       - INPUT 
*         A = 2     B = + OUTPUT   RIGHT CARTRIDGE TAPE UNIT
*                       - INPUT 
*         JSB .DVIO,I    ALL ASCII BUFFERS (PACKED) 
*         DEF <BUFFER ADDRESS>
* 
DR    EQU 30B 
CTL   EQU 31B 
STS   EQU 32B 
* 
DVIO  NOP 
      JSB DVSSG     SAVE CURRENT GLOBAL REGISTER STATUS 
      CCE,SSB,RSS   SET FOR INPUT. IS IT? 
      CMB,CLE,INB   NOT INPUT SO MAKE COUNT NEG.
      STB DVBCW     WORKING BUFFER COUNT
      STB DVBCS     SAVE BUFFER COUNT 
      SZB,RSS 
      CLE           MAKE IT OUTPUT IF NO TRANSFER 
      LDB DVIO,I    GET BUFFER ADDRESS
      ISZ DVIO      ADJUST RETURN ADDRESS 
      SSB           CHECK FOR INDIRECT
      LDB B,I       YES GET IT
      RBL           MAKE IT BYTE ADDRESS
      STB DVBAW     WORKING BUFFER ADDRESS
      STB DVBAS     SAVE BUFFER ADDRESS 
      CLB 
      LIB 3,C       CHECK FOR A RFP 
      SZB 
      JMP *+5       YES SO GO AHEAD 
      CLA,SEZ,RSS   IN OR OUT 
      JMP DVIOR+1   OUT SO IGNORE IT
      LDA .4        INPUT SO ERROR
      JSB ERR 
      LIB 1         CHECK FOR ALTERNATE FRONT PANEL 
      BLF,SLB 
      JMP ALDVR     GO USE ALTERNATE DRIVER 
      SKP 
      LDB CNSC      GET SELECT CODE OF CONSOLE
      OTB 2,C       SET GLOBAL REG. AND ENABLE IT 
      CLC 20B,C     INSURE DMA IS OFF 
      CLC 21B,C 
      LDB DVBCW     CHECK IF ANY TRANSFER 
      SZB,RSS       ? 
      JMP CNILZ     INITIALIZE DRIVER FOR ENQ-ACK 
      SZA,RSS       CONSOLE?
      JMP CN0       YES 
CKEA0 RSS           NOP IF NO ENQ-ACK 
      JMP DVERR 
      CPA .1        LEFT TAPE DRIVE?
      JMP CN1       YES 
      CPA .2        RIGHT TAPE DRIVE? 
      JMP CN1       YES 
      CPA .3        CONSOLE BLOCK MODE? 
      JMP CN1       YES 
      CPA .4        LINE PRINTER? 
      JMP CN1       YES 
DVERR JSB DVRSG     RESTORE GLOBAL REGISTER 
      LDA .23       INDICATE ILLEGAL CALL ERROR 19
      JSB ERR 
* 
DVIOR CCA           NONE SO EOF 
      JSB DVRSG     RESTORE GLOBAL REGISTER STATUS
      JMP DVIO,I    RETURN
* 
CNILZ LDA .5        ASK IF READY (ENQ)
      JSB CNBO      SEND "ENQ"
      LDB CNCWR     RECEIVE NO ECHO 
      OTB CTL 
      STC DR,C
      CLA 
      SFC DR
      JMP CNIZ0 
      ISZ A 
      JMP *-3 
      JMP CNIZ1 
CNIZ0 LIA DR        CHECK FOR "ACK" 
      STC DR,C      CLEAR DATA RECEIVED 
      AND .177      MASK OFF UPPER BYTE 
      CPA .6
      JMP *+2       YES THEN OK 
      JMP CNILZ     NO THEN TRY AGAIN 
      LDA RSS       OK THEN USE ENQ-ACK 
CNIZ1 STA CKEA0     OK TO USE CASSETTES 
      STA CKEA1     AND NORMAL OUTPUT 
      CCE           NOW ENABLE INPUT AND
      JMP CN2       EXIT
      SKP 
CN0   SEZ           IN OR OUT?
      JMP CN0B
CKEA1 RSS           NOP IF NO ENQ-ACK REQUIRED
      JMP CN0A      NOT NECESSARY 
      LDA .5        GET ENQ 
      JSB CNBO      OUTPUT IT 
      JSB CNBI      WAIT FOR RESPONSE 
      STC DR,C      CLEAR DATA RECEIVED FLAG
      CPA .6
      RSS 
      JMP CKEA1 
CN0A  JSB CNOB      OUTPUT
      CLE 
      JMP CN2       PUT INTERFACE IN INPUT MODE 
CN0B  CLA           INPUT WITH ECHO 
      JSB CNIB      INPUT 
      LDA .6412     ADD RETURN LINE FEED
      JSB CNWO      OUTPUT A WORD 
      CCE 
      JMP CN2       RETURN
* 
CN1   IOR AP.0      ADD ASCII CODE FOR NUMBER 
      STA CN1.O     SET OUTPUT DEVICE NUMBER
      STA CN1.I     AND INPUT DEVICE NUMBER 
      SEZ           IN OR OUT?
      JMP CN1I      INPUT 
      JSB CNESC     OUTPUT RECORD COMMAND 
      OCT 15446     "ESC &
CN1.O OCT 70060      P' 0 
      OCT 62127        D' W"
      OCT 0         TERMINATOR
      JSB CNOB      OUTPUT BUFFER 
      LDA .21       SEND "DC1" FOR STATUS RESPONSE
      JSB CNBO
      JSB CNBI      WAIT FOR STATUS 
      STC DR,C      CLEAR DR FLAG 
      CLE 
      CPA AS        PASSED? 
      JMP CN2       YES RETURN
      LDA .6        NO REPORT ERROR 
      JSB ERR 
* 
CN1I  JSB CNESC     OUTPUT READ COMMAND 
      OCT 15446     "ESC &
CN1.I OCT 70060      P' 0 
      OCT 71522     S' R" 
      OCT 0         TERMINATOR
      CCA           INPUT NO ECHO 
      JSB CNIB      INPUT TO BUFFER 
      CCE 
      SKP 
CN2   LDB CNCWR     GET RECEIVE CONTROL WORD (NO ECHO)
      OTB CTL       PUT INTERFACE IN RECEIVE
      CLB,SEZ,RSS   CHECK FOR IN OR OUT 
      LIB STS       OUTPUT SO GET LAST STATUS 
      STC DR,C      ENABLE RECEIVE
      SLB           CHECK IF ANY DATA RECEIVED? 
      STF DR        YES LEAVE FLAG SET
      SEZ,RSS       IF OUTPUT SKIF EOF CHECK
      JMP DVRTN 
      LDA BUF       CHECK FOR EOF 
      ALF,ALF 
      AND .177
      CPA .36       RS? 
      JMP DVIOR     YES 
DVRTN LDA DVBCS     GET TRANSFER COUNT
      CMA,INA 
      ADA DVBCW 
      JMP DVIOR+1   RETURN TO CALLER
AP.0  OCT 70060     P' 0   ASCII
* 
CNESC NOP 
      LDA .5        ASK IF READY
      JSB CNBO      SEND "ENQ"
      JSB CNBI      WAIT FOR "ACK"
      CPA .6
      RSS           OK
      JMP CNESC+1   TRY AGAIN 
CNES0 LDA CNESC,I   GET FIRST CHR 
      ALF,ALF       MOVE TO UPPER BYTE
      AND .177      AND ONLY THE UPPER
      SZA,RSS       END OF STRING?
      JMP CNES1     YES 
      JSB CNBO      NO - OUTPUT THE CHR 
      LDA CNESC,I    GET NEXT CHR 
      AND .177
      SZA,RSS       END OF STRING 
      JMP CNES1     YES 
      JSB CNBO      NO OUTPUT 
      ISZ CNESC     MOVE TO NEXT SET
      JMP CNES0     DO NEXT CHR 
CNES1 ISZ CNESC     MOVE PAST TERMINATOR
      JMP CNESC,I   RETURN
* 
* 
CNOB  NOP 
      LDB DVBAW     GET ADDRESS OF CHARACTER
      JSB BUF2A     GET IT IN THE A REG.
      JSB CNBO      OUTPUT IT 
      ISZ DVBAW     MOVE TO NEXT CHARACTER
      ISZ DVBCW     COUNT CHARACTER 
      JMP CNOB+1
      JMP CNOB,I
      SKP 
CNIB  NOP 
      STA DVFLG     SAVE ECHO FLAG
      LDA .21       RELEASE BUFFER FOR INPUT
      JSB CNBO      OUTPUT "DC1"
CNIB0 LDA DVFLG     GET ECHO FLAG 
      LDB CNCWE     GET ECHO CONTROL
      SZA           ECHO? 
      LDB CNCWR     NO
      JSB CNBIX     GET A CHR 
      AND .177      MASK OFF UNWANTER BITS
      CPA .15       RETURN FOR END OF ENTRY 
      JMP CNIB,I    YES 
      CPA .177      RUBOUT? 
      JMP CNRBT     RESTORE BUFFER
      CPA .10       BACK SPACE
      JMP CNBKS     YES 
      CPA .31       BACK SPACE? 
      JMP CNBKS     YES 
      LDB DVBAW     GET ADDRESS TO STORE IN MEMORY
      JSB A2BUF     PUT CHR IN BUFFER 
      ISZ DVBAW     MOVE ADDRESS UP 
      ISZ DVBCW     MOVE COUNT
      JMP CNIB0      DO NEXT CHARACTER
      JMP CNIB,I
* 
CNRBT LDA .6412     DO A RETURN AND LINE FEED 
      JSB CNWO      OUTPUT WORD 
      LDA DVBCS     RESTORE 
      STA DVBCW      WORKING COUNT
      LDA DVBAS       AND 
      STA DVBAW         ADDRESS 
      JMP CNIB0     CONTINUE
* 
CNBKS LDA DVBAW     GET BUFFER ADDRESS
      CPA DVBAS     BACK TO STARTING ADDRESS? 
      JMP CNRBT 
      ADA .M1       NO BACK UP ONE
      STA DVBAW 
      LDA DVBCW     AND COUNT 
      ADA .M1 
      STA DVBCW 
      JMP CNIB0 
      SKP 
CNWO  NOP 
      STA DVTMP     SAVE WORD 
      ALF,ALF 
      AND .177
      JSB CNBO      OUTPUT UPPER HALF 
      LDA DVTMP     GET WORD AGAIN
      AND .177
      JSB CNBO      AND LOWER HALF
      JMP CNWO,I    RETURN
* 
CNBO  NOP 
      LDB CNCWT     GET TRANSMIT WORD 
      OTB CTL       GIVE IT TO INTERFACE
      OTA DR        GIVE INTERFACE THE CHR
      STC DR,C      START TRANSFER
      SFS DR        WAIT FOR COMPLETION 
      JMP *-1 
      JMP CNBO,I    RETURN
* 
CNBI  NOP 
      LDB CNCWR     RECEIVE CONTROL WORD NO ECHO
      JSB CNBIX 
      JMP CNBI,I
* 
CNBIE NOP 
      LDB CNCWE     RECEIVE CONTROL WORD WITH ECHO
      JSB CNBIX 
      JMP CNBIE,I 
* 
CNBIX NOP 
      OTB CTL       GIVE IT TO INTEFACE 
      STC DR,C      ENABLE INPUT
      SFS DR        WAIT FOR A CHR
      JMP *-1 
      LIA DR
      CLC DR,C
      AND .377
      JMP CNBIX,I   RETURN
* 
DVTMP NOP 
DVFLG NOP 
DVBCW NOP           DEVICE WORKING BUFFER COUNT 
DVBAW NOP           DEVICE WORKING ADDRESS
DVBCS NOP           SAVE BUFFER COUNT 
DVBAS NOP           SAVE BUFFER ADDRESS 
CNCWR OCT 002000    RECEIVE NO ECHO 
CNCWE OCT 006000    RECEIVE WITH ECHO 
CNCWT OCT 001000    TRANSMIT
      SKP 
*     ALTERNATE DRIVER
* 
ALDVR SZA           CONSOLE ONLY OVER ALTERNATE INTERFACE 
      JMP DVERR     NOT CONSOLE SO ERROR
      LDB ALSC      GET ALTERNATE SELECT CODE 
      OTB 2,C       SET GLOBAL REGISTER 
      CLC 20B,C     INSURE DMA IS OFF 
      CLC 21B,C 
      LDA .M4       TRY FOUR TIMES
      STA DVTMP 
ALDV0 LDA ALVCM     DO A VCP MODE TWICE INCASE OF SELF TEST 
      OTA DR
      STC DR,C
      LDA DM16      SET TIME OUT
      SFC DR        WAIT FOR COMPLETION 
      JMP ALDV1 
      ISZ B 
      JMP *-3 
      ISZ A 
      JMP *-5 
      ISZ DVTMP     ENOUGH TIMES
      JMP ALDV0     NO
      CLC 0,C       YES RESET MACHINE AND 
      LDA .24       AND TRY TO REPORT 
      JSB ERR 
ALDV1 LDA ALVCM     TELL IT TO GO INTO VCP MODE 
      JSB ALIO
      LDB DVBCW     CHECK IF ANY TRANSFER 
      SZB,RSS 
      JMP DVRTN     NO JUST SET UP
      SEZ           IN OR OUT 
      JMP *+3 
      JSB ALOB      OUTPUT BUFFER 
      JMP *+2 
      JSB ALIB      INPUT BUFFER
      LDA D100      WAIT TO START TRANSMISSION
      JSB IOTMR 
      JMP DVRTN     RETURN TO CALLER PICK UP INPUT COUNT
      SKP 
ALOB  NOP 
      LDB DVBAW     GET ADDRESS OF CHR
      JSB BUF2A     PUT CHR IN A REG. 
      IOR ALOT      ADD OUT PUT COMMAND 
      JSB ALIO      TELL CARD TO ACT ON IT
      ISZ DVBAW     MOVE TO NEXT CHR
      ISZ DVBCW     AND COUNT CHR - DONE? 
      JMP ALOB+1    NO
      LDA .377      INDICATE NOW IN INPUT REQUEST 
      IOR ALOT      ADD PUT BYTE COMMAND
      JSB ALIO
      LDA .377      ADD RUBOUT TO END 
      IOR ALOT
      JSB ALIO
      LDA ALTR      TELL CARD TO TRANSMITT
      JSB ALIO
      JMP ALOB,I    RETURN
* 
ALIB  NOP 
      LDA ALOT      OFICIALLY REQUEST INPUT 
      JSB ALIO
      LDA .377
      IOR ALOT
      JSB ALIO
      LDA ALTR      TRANSMITT REQUEST 
      JSB ALIO
      LDA ALINR     GET BUFFER
      JSB ALIO
ALIB0 LDA ALINB     GET INPUT REQUEST 
      JSB ALIO      ASK FOR IT
      CPA .15       END OF DATA?0 
      JMP ALIB,I    YES RETURN
      LDB DVBAW     GET ADDRESS FOR CHR 
      JSB A2BUF     PUT IT IN BUFFER
      ISZ DVBAW     MOVE TO NEXT LOCATION 
      ISZ DVBCW     AND COUNT IT - DONE?
      JMP ALIB0     NO DO ANOTHER ONE 
      JMP ALIB,I    YES EXIT
* 
ALIO  NOP 
      OTA DR        OUTPUT COMMAND
      STC DR,C      TELL INTERFACE TO READ IT 
      SFS DR        WAIT FOR IT 
      JMP *-1       TO RESPOND
      LIA DR,C      GET INPUT DATA
      JMP ALIO,I    RETURN
* 
ALOT  OCT 60000     6000 HEX FOR OUTPUT 
ALTR  OCT 60400     6100 HEX FOR TRANSMITT
ALINB OCT 61000     6200 HEX FOR INPUT REQUEST
ALINR OCT 61400     6300 HEX FOR INPUT FRAME
ALVCM OCT 67400     6F00 HEX FOR GO INTO VCP PROGRAM
      SKP 
      ORG 14000B
*     STATEMENT TABLE 
* 
*     ********************* 
*     *                   * 
*     *    G    /   O     *  1
*     *                   * 
*     *********************      4 ASCII CHR. STATEMENT LABLE 
*     *                   * 
*     *    S    /   B     *  2
*     *                   * 
*     ********************* 
*     *                   * 
*     * SYNTAX PROCESSOR  *  3
*     *                   * 
*     ********************* 
*     *                   * 
*     * RUN    PROCESSOR  *  4   ZERO = NO PROCESSOR
*     *                   * 
*     ********************* 
*     *                   * 
*     * LIST   PROCESSOR  *  5
*     *                   * 
*     ********************* 
* 
*     FOR FUTURE CHANGES THIS TABLE MUST NOT
*     BE MOVED FROM THIS ADDRESS SPACE NOR
*     THE SEQUENCE ORDER. THIS IS TO FACILITATE 
*     BACKWARDS COMPATIABLITY TO BINARY PROGRAM THAT
*     ARE IN USE THAT CONTAIN ADDRESSES POINTING
*     INTO THIS TABLE.
      SKP 
STTBL EQU * 
      ASC 2,BUF 
      DEF BUFSY 
      DEF BUFRU 
      DEF BUFLI 
* 
      ASC 2,REM     REMARK
      DEF CMTSY     COMMENT SYNTAX
      NOP           NO RUN PROCESSOR
      DEF CMTLI     COMMENT LIST
* 
      ASC 2,PRGM    PROGRAM MARK
      DEF CMTSY     USE COMMENT SYNTAX
RPG.  NOP           NO RUN PROCESSOR
      DEF CMTLI     COMMENT LIST
* 
      ASC 2,FMT 
      DEF CMTSY     USE CMT 
      NOP 
      DEF CMTLI 
* 
      ASC 2,ASC 
      DEF CMTSY 
      NOP 
      DEF CMTLI 
* 
      ASC 2,GOTO
      DEF GTSSY 
RGT.  DEF GTORU 
      DEF GTSLI 
* 
      ASC 2,GOSB
      DEF GTSSY 
RGS.  DEF GSBRU 
      DEF GTSLI 
* 
      ASC 2,RTN 
      DEF RTNSY 
      DEF RTNRU 
      DEF RTNLI 
* 
      ASC 2,CFS 
      NOP 
      DEF RUCFS 
      NOP 
* 
      ASC 2,STOP
      DEF RTNSY 
      DEF RUSTP 
      DEF RTNLI 
* 
      ASC 2,GTSC
      DEF GSCSY 
      DEF GSCRU 
      DEF GSCLI 
      SKP 
      ASC 2,HOOD
      NOP 
      DEF HODRU 
      NOP 
* 
      ASC 2,WAIT
      NOP 
      DEF WATRU 
      NOP 
* 
      ASC 2,DLY 
      DEF DLYSY 
      DEF DLYRU 
      DEF DLYLI 
* 
* 
      ASC 2,INPT
      DEF INPSY 
      DEF INNRU 
      DEF INNLI 
* 
      ASC 2,CTRL
      DEF CRLSY 
      DEF INNRU 
      DEF INNLI 
* 
      ASC 2,CTRR
      DEF CRRSY 
      DEF INNRU 
      DEF INNLI 
* 
      ASC 2,ISCR
      DEF INSSY 
      DEF INNRU 
      DEF INNLI 
* 
      ASC 2,YES?
      DEF GTSSY 
RYE.  DEF YESRU 
      DEF GTSLI 
* 
      ASC 2,PRNT
      DEF PNTSY 
RPT.  DEF MSGRU 
      DEF MSGLI 
* 
      ASC 2,CTWL
      DEF CWLSY 
RCWL. DEF MSGRU 
      DEF MSGLI 
* 
      ASC 2,CTWR
      DEF CWRSY 
RCWR. DEF MSGRU 
      DEF MSGLI 
      SKP 
      ASC 2,IBP 
      DEF IBPSY 
RIP.  DEF IBPRU 
      DEF IBPLI 
* 
      ASC 2,CPBF
      DEF CPBSY 
      DEF CPBRU 
      DEF CPBLI 
* 
      ASC 2,LET 
      DEF LETSY 
      DEF LETRU 
      DEF FNCLI 
* 
      ASC 2,LETC
      DEF LETSY 
      DEF LTCRU 
      DEF FNCLI 
* 
      ASC 2,SKIF
      DEF SKISY 
      DEF SKIRU 
      DEF FNCLI 
* 
      ASC 2,LIA 
      DEF LOSY
      DEF LI1RU 
      DEF LOLI
* 
      ASC 2,LIAC
      DEF LOSY
      DEF LI2RU 
      DEF LOLI
* 
      ASC 2,OTA 
      DEF LOSY
      DEF OT1RU 
      DEF LOLI
* 
      ASC 2,OTAC
      DEF LOSY
      DEF OT2RU 
      DEF LOLI
      SKP 
      ASC 2,SFS 
      DEF IOCSY 
      DEF SFSRU 
      DEF IOCLI 
* 
      ASC 2,SFC 
      DEF IOCSY 
      DEF SFCRU 
      DEF IOCLI 
* 
      ASC 2,STF 
      DEF IOCSY 
      DEF STFRU 
      DEF IOCLI 
* 
      ASC 2,CLF 
      DEF IOCSY 
      DEF CLFRU 
      DEF IOCLI 
* 
      ASC 2,STC 
      DEF IOCSY 
      DEF STCRU 
      DEF IOCLI 
* 
      ASC 2,STCC
      DEF IOCSY 
      DEF STCCR 
      DEF IOCLI 
* 
      ASC 2,CLC 
      DEF IOCSY 
      DEF CLCRU 
      DEF IOCLI 
* 
      ASC 2,CLCC
      DEF IOCSY 
      DEF CLCCR 
      DEF IOCLI 
* 
      ASC 2,WFI 
      DEF LOSY
      DEF WFIRU 
      DEF LOLI
* 
      ASC 2,INT 
      DEF INTSY 
RIT.  DEF INTRU 
      DEF INTLI 
      SKP 
      ASC 2,IOA 
      DEF IOPSY 
      DEF IOPRA 
      DEF CMTLI 
* 
      ASC 2,IOB 
      DEF IOPSY 
      DEF IOPRB 
      DEF CMTLI 
* 
      ASC 2,IOC 
      DEF IOPSY 
      DEF IOPRC 
      DEF CMTLI 
* 
      ASC 2,IOD 
      DEF IOPSY 
      DEF IOPRD 
      DEF CMTLI 
* 
      ASC 2,IOCA
      NOP 
      DEF IOPCA 
      NOP 
* 
      ASC 2,IOCB
      NOP 
      DEF IOPCB 
      NOP 
* 
      ASC 2,IOCC
      NOP 
      DEF IOPCC 
      NOP 
* 
      ASC 2,IOCD
      NOP 
      DEF IOPCD 
      NOP 
      SKP 
      ASC 2,IORA
      NOP 
      DEF IOA 
      NOP 
* 
      ASC 2,IORB
      NOP 
      DEF IOB 
      NOP 
* 
      ASC 2,IORC
      NOP 
      DEF IOC 
      NOP 
* 
      ASC 2,IORD
      NOP 
      DEF IOD 
      NOP 
* 
      ASC 2,MAP 
      DEF MAPSY 
      DEF MAPRU 
      DEF MAPLI 
* 
      DEC -1
      SKP 
*     I/O PROGRAM SYNTAX
* 
IOPSY NOP 
      LDA GETP      SAVE POINTER TO INPUT BUFFER
      STA TMP+2 
      JSB .CMT,I    STORE INPUT AS A COMMENT
      NOP 
      STA TMP+3     SAVE INPUT COUNT
      LDA TMP+2     RESTORE BUFFER POINTER
      STA GETP
      CLA           DON'T CHECK FOR A - B 
      STA IOABF     AND CLEAR THE FLAG
      JSB IOPCI     GET FIRST 3 CHR'S 
      JMP IOPSY,I   NO INPUT SO ERROR 
      LDB IOPMR     SEARCH MEMORY REFERENCE INSTRUCTIONS
      JSB IOPTS       TABLE 
      JMP IOPN1     NOT FOUND MOVE TO NEXT TYPE 
      STA STBF+2    SAVE INSTRUCTION
      JSB GETB      GET NEXT CHARACTER
      JMP IOPSY,I   NO CHR SO ERROR 
      CPA .40       MUST BE A SPACE 
      JMP *+2       OK
      JMP IOPSY,I   NOT SO ERROR
      LDA STBF+2    GET INSTRUCTION 
      CPA .M1       IS IT OCTAL 
      JMP IOPOC     YES 
      CPA IOJSB     IS IT A JSB?
      JMP IOPJB     YES 
      CPA IOJMP     IS IT A JMP?
      JMP IOPJP     YES 
      JSB GETB      NEITHER SO GET NEXT CHR 
      JMP IOPSY,I   NO CHR SO ERROR 
      JSB LTCK      IS CHR A LETTER?
      JMP IOPN.     NO - CHECK FOR BUFFER OR A-B
      ADA VARA      ADD POINTER TO VARIABLE 
IOPID IOR STBF+2    ADD INSTRUCTION 
      STA STBF+2
      JSB GETB      CHECK FOR INDIRECT
      JMP IOPSX     NO JUST INSTRUCTION 
      CPA .40 
      JMP IOPSX 
      CPA FC.CM     IS IT A COMMA 
      RSS 
      JMP IOPSY,I   NO SO ERROR 
      JSB GETB      GET NEXT CHR
      JMP IOPSY,I   NONE SO ERROR 
      CPA FC.I      IS IT AN I
      RSS 
      JMP IOPSY,I 
      LDA BIT15     YES SET BIT 15
      IOR STBF+2
      SKP 
IOPEX STA STBF+2    PUT IT IN BUFFER
      JSB GETB      GET NEXT CHR
      JMP *+4 
      CPA .40       MUST BE SPACE OR "EOB"
      JMP *+2 
      JMP IOPSY,I   NEITHER SO ERROR
IOPSX LDA TMP+3     GET INPUT COUNT 
      ISZ IOPSY     ADJUST RETURN 
      JMP IOPSY,I   RETURN P+2
      SPC 1 
IOPN. LDB A         SWAP AB 
      CPB A.        OCTAL NUMBER CONSTANT 
      JMP IOP.      YES 
      CPB A#        IS IT LOCATION REQUEST
      JMP IOP#      YES 
      CPB .60       A-REG.REFERENCE 
      JMP IOPID+2   YES 
      ISZ STBF+2
      CPB .61       B-REG. REFERENCE? 
      JMP IOPID+2   YES 
      JMP IOPSY,I   NONE SO ERROR 
* 
IOP.  LDA STBF+2    CHECK IT ISN'T STORE OR ISZ 
      CPA IOSTA 
      JMP IOPSY,I 
      CPA IOSTB 
      JMP IOPSY,I 
      CPA IOISZ 
      JMP IOPSY,I 
      JSB .CON,I    GET OCTAL NUMBER
      JMP IOPSY,I 
      LDB IO.S
      CPA B,I 
      JMP *+5 
      INB 
      CPB IO.E
      JMP IOPSY,I 
      JMP *-5 
      LDA B 
      JMP IOPEX-1 
* 
IO.S  DEF IODTS 
IO.E  DEF IODTE 
* 
*     PROCESS AN OCTAL VALUE
* 
IOPOC JSB .CON,I    CONVERT INPUT 
      JMP IOPSY,I   NO INPUT SO ERROR 
      JMP IOPEX     NOW PUT IT IN PLACE 
      SKP 
IOP#  JSB .CDN,I    GET LOCATION
      JMP IOPSY,I   NOT FURNISHED 
      STA B         SAVE IT 
      ADA DATAM     CHECK NOT OVER THE NUMBER 
      SSA,RSS 
      JMP IOPSY,I   IT WAS
      LDA B 
      LDB STBF+2    CHECK FOR DEF 
      SZB,RSS 
      JMP *+4       YES ADD ADDRESS 
      IOR BIT9      UPPER HALF OF PAGE
      IOR BIT10     CURRENT PAGE
      JMP IOPID 
      IOR DATAP 
      JMP IOPID+1 
* 
IOPJB CLA           DON'T CHECK FOR A-B 
      JSB IOPCI     GET NEXT 3 CHR'S
      JMP IOPSY,I   NO INPUT SO ERROR 
      LDB IOPRL     GET ROUTINE LIST
      JSB IOPTS     FIND REQUESTED ROUTINE
      JMP IOPSY,I   NOT FOUND SO ERROR
      JMP IOPEX     PUT IT IN BUFFER AND RETURN 
* 
IOPJP LDB GETP      GET NEXT CHR
      JSB BUF2A 
      JSB DGCK      IS IT A DIGIT?
      JMP IOPJ0     NO
      JSB .CDN,I    YES - CONVERT NUMBER
      JMP IOPSY,I   NOT A NUMBER
      STA B         SAVE NUMBER 
      ADB DM100     CHECH IF OVER MAX AND 
      SSA,RSS         IT IS POSITIVE
      SSB,RSS 
      JMP IOPSY,I   ERROR 
      JMP IOPEX-1   CONTINUE
IOPJ0 CPA ASTRK     IS IT AN ASTERISK 
      JMP *+2 
      JMP IOPSY,I   NO SO ERROR 
      ISZ GETP      SKIP ASTERISK 
      JSB .CDN,I    CONVERT NUMBER
      JMP IOPSY,I   NOT A NUMBER
      CLE,SSA       IF NEGATIVE 
      CMA,CCE,INA   MAKE POSITIVE AND SET FLAG
      LDB A         CHECK IF OVER MAX 
      ADB DM100 
      SSB,RSS       ??
      JMP IOPSY,I   YES - SO ERROR
      ELA           ADD POS.-NEG. FLAG
      IOR BIT10     ADD RELATIVE FLAG 
      JMP IOPEX-1 
      SKP 
IOPN1 LDB IOPIO     SEARCH I/O INSTRUCTIONS 
      JSB IOPTS       TABLE 
      JMP IOPN2     NOT FOUND SO MOVE TO NEXT TABLE 
      STA STBF+2    SAVE INSTRUCTION
      JSB GETB      GET NEXT CHR
      JMP IOPSY,I   NO CHR SO ERROR 
      CPA .40       MUST BE A SPACE 
      JMP *+2 
      JMP IOPSY,I   NOT SO ERROR
      JSB .CON,I    CONVERT OCTAL NUMBER
      JMP IOPSY,I   NO NUMBER SO ERROR
      STA B         SAVE IT 
      AND .M77      CAN'T BE OVER 77 OCTAL
      SZA 
      JMP IOPSY,I   IT IS SO ERROR
      LDA STBF+2    GET INSTRUCTION 
      IOR B         PUT SC IN 
      STA STBF+2    PUT IT BACK IN PLACE
      JSB GETB      GET NEXT CHR
      JMP IOPEX+1   NO CHR SO INSTRUCTION STANDS
      CPA .40       GOT ONE IT MUST BE A SPACE
      JMP IOPEX+1   SPACE SO INSTRUCTION STANDS 
      CPA FC.CM     IS IT A COMMA?
      JSB GETB      YES GET NEXT CHR
      JMP IOPSY,I   NO CHR SO ERROR 
      CPA AC        IS IT A C?
      RSS 
      JMP IOPSY,I   NO SO ERROR 
      LDA STBF+2    GET INSTRUCTION 
      AND .M77      ELIMINATE SELECT CODE 
      CPA IOSTF 
      JMP IOPSY,I 
      CPA IOCLF 
      JMP IOPSY,I 
      CPA IOSFS 
      JMP IOPSY,I 
      CPA IOSFC 
      JMP IOPSY,I 
      LDA BIT9      GET CLEAR FLAG BIT
      JMP IOPEX-1 
      SKP 
IOPN2 LDA TMP+2     RESTORE POINTER TO
      STA GETP      INPUT BUFFER
      LDA RSS       THIS TIME CHECK FOR A OR B REFERENCE
      JSB IOPCI     GET FIRST THREE AGAIN 
      JMP IOPSY,I   NO INPUT
      LDB IOPAS     SEARCH ALTER SKIP INSTRUCTION 
      JSB IOPTS       TABLE 
      RSS           NOT FOUND THERE 
      JMP *+4 
      LDB IOPSR     TRY SHIFT ROTATE INSTRUCTIONS 
      JSB IOPTS 
      JMP IOPN6     NOT THERE SO TRY LONG SHIFTS
IOPN3 STA STBF+2    SAVE INSTRUCTION
      STB TMP+2     SAVE POINTER IN TABLE 
      JSB GETB      GET NEXT CHR
      JMP IOPN4+3   NO INPUT SO ONLY ONE INSTRUCTION
      CPA .40       IF SPACE ALSO 
      JMP IOPN4     ONLY ONE INSTRUCTION
      CPA FC.CM     IS IT A COMMA?
      RSS 
      JMP IOPSY,I   NO ERROR
      LDA RSS       YES THEN
      JSB IOPCI     GET NEXT 3 CHRS 
      JMP IOPSY     NO INPUT SO ERROR 
      LDB TMP+2     CONTINUE IN TABLE 
IOPN5 JSB IOPTS 
      JMP *+3       CHECK FOR CLE ONLY
      IOR STBF+2    INCLUDE PREVIOUS INSTRUCTION
      JMP IOPN3     TRY AGAIN FOR MORE
* 
      CLB 
      LDA STBF+2    WAS IT CLE ONLY 
      CPA CLEAS     ??
      LDB CLESR     YES 
      CPA SLAAS     NO - HOW ABOUT SLA? 
      LDB SLASR     YEP 
      CPA CSLAS     NO - THEN IT MUST BE CLE,SLA
      LDB CSLSR     YEP 
      SZB,RSS       DID I GET ANY?
      JMP IOPSY,I   NO THEN HE WAS WRONG
      STB STBF+2
      LDB *+2       GET POINTER TO RS INSTRUCTIONS
      JMP IOPN5     TRY THE REST
      DEF SLASR+1 
CSLAS OCT 2110
CSLSR OCT 50
      SKP 
IOPN4 CCA 
      ADA GETP      BACK UP BUFFER POINTER
      STA GETP
      LDA STBF+2    CHECK IF CLE ONLY 
      LDB CLESR     IF SO USE SHIF ROTATE INST
      CPA CLEAS 
      STB STBF+2    YES 
      LDB IOABF     SET A OR B FLAG 
      SZB,RSS       WAS IT DEFINED
      JMP IOPEX+1   NO
      LDA BIT11 
      SSB           YES - DEFINED A OR B ?
      JMP IOPEX-1   B 
      JMP IOPEX+1   A 
* 
* 
IOPN6 LDB IOPLS     SEARCH LONG SHIFTS
      JSB IOPTS       TABLE 
      JMP IOPN7     NOT THERE SO TRY MOP INSTRUCTIONS 
      STA STBF+2    SAVE INSTRUCTION
      JSB GETB      GET NEXT CHR
      JMP IOPSY,I   NO CHR SO ERROR 
      CPA .40       MUST BE A SPACE 
      JMP *+2       OK
      JMP IOPSY,I   WASN'T SO ERROR 
      JSB .CDN,I    OK - CONVERT NUMBER 
      JMP IOPSY,I   NO NUMBER SO ERROR
      SZA,RSS       CAN'T BE ZERO 
      JMP IOPSY,I   IT WAS
      STA B         SAVE NUMBER 
      ADB DM17      SUBTRACT 17 
      SSB,RSS       SHOULD REMAIN NEGATIVE
      JMP IOPSY,I   DIDN'T SO ERROR 
      AND .17       MASK OFF NUMBER 
      IOR STBF+2    ADD INSTRUCTION 
      JMP IOPEX     CHECK NEXT CHR AND EXIT 
* 
IOPN7 LDB IOPMD     CHECK MOP INSTRUCTIONS
      JSB IOPTS 
      JMP IOPSY,I   NOT IN ANY TABLE SO ERROR 
      JMP IOPEX     GOTO IT SO EXIT 
      SKP 
IOPCI NOP 
      STA IOPAB+1   SET TO CHECK FOR A OR B 
      JSB GETB      GET A CHARACTER FROM BUFFER 
      JMP IOPCI,I   NO INPUT
      JSB IOPAB     CHECK FOR A OR B REG
      ALF,ALF       MOVE IT TO UPPER HALF 
      STA TMPA      SAVE IT 
      JSB GETB      GET SECOND CHARACTER
      JMP IOPSY,I   NO INPUT SO ERROR 
      JSB IOPAB     CHECK FOR A OR B REG
      IOR TMPA      ADD FIRST CHR 
      STA TMPA      SAVE THEM BOTH
      JSB GETB      GET THIRD CHARACTER 
      JMP IOPSY,I   NO INPUT SO ERROR 
      JSB IOPAB     CHECK FOR A OR B REG
      ALF,ALF       MOVE IT TO UPPER HALF 
      IOR .40       ADD SPACE 
      STA TMPB      SAVE IT 
      ISZ IOPCI     ADJUST RETURN 
      JMP IOPCI,I   NOW RETURN
* 
* 
IOPAB NOP 
      RSS           NOP IF NO CHECK 
      JMP IOPAB,I 
      CPA AA        IS IT A?
      JMP *+5       YES 
      CPA AB        IS IT B?
      JMP *+2       YES 
      JMP IOPAB,I   NEITHER JUST EXIT 
      CCE,RSS       B 
      CLE           A 
      LDA AA        MAKE IT AN A
      LDB IOABF     HAS IT BEEN DEFINED?
      SZB 
      JMP *+5       YES 
      INB           NO
      RBL,ERB        THEN DEFINE IT 
      STB IOABF 
      JMP IOPAB,I 
      SSB           CAN'T BE BOTH A AND B 
      CME             IN THE SAME LINE
      SEZ 
      JMP IOPSY,I   BOTH SO ERROR 
      JMP IOPAB,I   OK
IOABF NOP 
      SKP 
IOPTS NOP 
      STB TMP+1     SAVE TABLE POINTER
      LDA TMP+1,I   GET FIRST TWO CHAR'S
      ISZ TMP+1     MOVE TO NEXT TWO
      LDB TMP+1,I   GET THEM
      ISZ TMP+1     MOVE TO INSTRUCTION 
      ERB,CLE,ELB   CHANGE LAST CHR TO A SPACE
      SZA,RSS       END OF TABLE? 
      JMP IOPTS,I   YES RETURN P+1
      CPA TMPA      DO THE FIRST TWO COMPARE? 
      JMP *+3       YES 
      ISZ TMP+1     NO SO MOVE TO NEXT INSTRUCTION
      JMP IOPTS+2   AND TRY IT
      CPB TMPB      DO THE SECOND TWO COMAPRE?
      JMP *+2       YES 
      JMP *-4       NO MOVE TO NEXT ONE 
      LDA TMP+1,I   GET INSTRUCTION 
      STA TMPA      AND SAVE IT 
      CCB 
      ADB TMP+1     MOVE TO NEXT VALID INPUT IN TABLE 
      RSS 
      ADB .2
      LDA B,I 
      INB 
      SLA,RSS 
      JMP *-4 
      ADB .M2 
      LDA TMPA
      ISZ IOPTS     ADJUST RETURN 
      JMP IOPTS,I 
      SKP 
IOPRL DEF *+1       INSTRUCTION LIST
      ASC 2,WFI     WAIT FOR INTERRUPT
      JSB .WFI,I
      ASC 2,TMR     1 MS TIMER
      JSB IOTMR 
      ASC 2,RTN     RETURN TO NEXT LINE 
      JMP 0,I 
      ASC 2,IOA     ROUTINE A 
      JSB .IOA,I
      ASC 2,IOB     ROUTINE B 
      JSB .IOB,I
      ASC 2,IOC     ROUTINE C 
      JSB .IOC,I
      ASC 2,IOD     ROUTINE D 
      JSB .IOD,I
      ASC 2,STP 
      JSB .STOP 
      ASC 2,CFS     CHECK FOR STOP
      JSB STOP
      OCT 0,1,0     TERMINATOR
      SKP 
IOPMR DEF *+1 
      ASC 2,DEF 
      OCT 0 
OCTIO ASC 2,OCT 
      DEC -1
      ASC 2,LDA 
      LDA 0 
      ASC 2,LDB 
      LDB 0 
      ASC 2,STA 
IOSTA STA 0 
      ASC 2,STB 
IOSTB STB 0 
      ASC 2,ADA 
      ADA 0 
      ASC 2,ADB 
      ADB 0 
      ASC 2,CPA 
      CPA 0 
      ASC 2,CPB 
      CPB 0 
      ASC 2,ISZ 
IOISZ ISZ 0 
      ASC 2,IOR 
      IOR 0 
      ASC 2,XOR 
      XOR 0 
      ASC 2,AND 
      AND 0 
      ASC 2,JMP 
IOJMP JMP 0 
      ASC 2,JSB 
IOJSB JSB 0 
      OCT 0,1,0     TERMINATOR
      SKP 
IOPIO DEF *+1 
      ASC 2,HLT 
      HLT 0 
      ASC 2,LIA 
      LIA 0 
      ASC 2,LIB 
      LIB 0 
      ASC 2,OTA 
      OTA 0 
      ASC 2,OTB 
      OTB 0 
      ASC 2,MIA 
      MIA 0 
      ASC 2,MIB 
      MIB 0 
      ASC 2,STC 
      STC 0 
      ASC 2,CLC 
      CLC 0 
      ASC 2,STF 
IOSTF STF 0 
      ASC 2,CLF 
IOCLF CLF 0 
      ASC 2,SFS 
IOSFS SFS 0 
      ASC 2,SFC 
IOSFC SFC 0 
      OCT 0,1,0     TERMINATOR
      SKP 
IOPAS DEF *+1 
      ASC 2,CLA 
      OCT 2400
      ASC 2,CMA 
      OCT 3000
      ASC 2,CCA!
      OCT 3400
      ASC 2,SEZ!
      OCT 2040
      ASC 2,CLE 
CLEAS OCT 2100
      ASC 2,CME 
      OCT 2200
      ASC 2,CCE!
      OCT 2300
      ASC 2,SSA!
      OCT 2020
      ASC 2,SLA!
SLAAS OCT 2010
      ASC 2,INA!
      OCT 2004
      ASC 2,SZA!
      OCT 2002
      ASC 2,RSS!
      OCT 2001
      OCT 0,1,0 
      SKP 
IOPSR DEF *+1 
      ASC 2,ALS 
      OCT 1000
      ASC 2,ARS 
      OCT 1100
      ASC 2,RAL 
      OCT 1200
      ASC 2,RAR 
      OCT 1300
      ASC 2,ALR 
      OCT 1400
      ASC 2,ERA 
      OCT 1500
      ASC 2,ELA 
      OCT 1600
      ASC 2,ALF 
      OCT 1700
      ASC 2,CLE!
CLESR OCT 0040
      ASC 2,SLA!
SLASR OCT 0010
      ASC 2,ALS 
      OCT 0020
      ASC 2,ARS 
      OCT 0021
      ASC 2,RAL 
      OCT 0022
      ASC 2,RAR 
      OCT 0023
      ASC 2,ALR 
      OCT 0024
      ASC 2,ERA 
      OCT 0025
      ASC 2,ELA 
      OCT 0026
      ASC 2,ALF!
      OCT 0027
      ASC 2,NOP 
      OCT 0 
      OCT 0,1,0     TERMINATOR
      SKP 
IOPLS DEF *+1 
      ASC 2,ASR 
      ASR 16
      ASC 2,ASL 
      ASL 16
      ASC 2,LSR 
      LSR 16
      ASC 2,LSL 
      LSL 16
      ASC 2,RRR 
      RRR 16
      ASC 2,RRL 
      RRL 16
      OCT 0,1,0 
* 
IOPMD DEF *+1 
      ASC 2,MPY 
      OCT 100200
      ASC 2,DIV 
      OCT 100400
      ASC 2,DLD 
      OCT 104200
      ASC 2,DST 
      OCT 104400
      ASC 2,XLD 
      OCT 104213
      ASC 2,XST 
      OCT 104413
      OCT 0,1,0 
      SKP 
*     IO STORE DURING RUN 
* 
IOPRA NOP 
      CLA           DEF IOA 
      JSB IOPR
      JSB .IOA,I
      JMP IOPRA,I 
* 
IOPRB NOP 
      CLA,INA       DEF IOB 
      JSB IOPR
      JSB .IOB,I
      JMP IOPRB,I 
* 
IOPRC NOP 
      LDA .2        DEF IOC 
      JSB IOPR
      JSB .IOC,I
      JMP IOPRC,I 
* 
IOPRD NOP 
      LDA .3
      JSB IOPR
      JSB .IOD,I
      JMP IOPRD,I 
      SKP 
*     I/O PROGRAM RUN 
* 
IOPR  NOP 
      RAL,RAL       MPY ROUTINE NUMBER BY 4 
      ADA IOPDF     ADD POINTER TO TABLE
      STA IOPSA     STARTING ADDRESS
      INA 
      STA IOPAP     CURRENT ADDRESS 
      INA 
      STA IOPEN     EXIT JMP IOX,I
      LDA IOPSA,I   CHECK IF ANOTHER IS ALLOWED 
      ADA D100
      CPA IOPAP,I 
      JMP *+2 
      JMP *+3 
      LDA .27 
      JSB ERR      NO ROOM
      LDB CRSA      GET INSTRUCTION 
      ADB .2
      LDA B,I 
      STA TMPA      SAVE IT 
      ADB .2          MOVE TO TYPE
      LDB B,I         GET INST
      CPB OCTIO       IS IT OCTAL 
      JMP IOPRS+3     YES STOR IT 
      AND .7.4
      SZA,RSS       IS IT MEM. REF. 
      JMP IOPRS     NO - THEN STORE IT
      LDA TMPA      YES 
      ELA 
      ALF 
      AND .17 
      CPA .5        JMP INSTRUCTION?
      RSS 
      JMP IOPRS     NO THEN STORE IT
      SEZ,RSS       YES - IS IT THE END 
      JMP *+4       NO
      LDA IOPEN,I   YES GET EXIT
      STA TMPA
      JMP IOPRS     STORE IT
      LDA TMPA      NO
      AND BIT10 
      SZA           RLATIVE PAGE
      JMP *+7       YES 
      LDA IOPSA,I   GET STARTING ADDRESS
      AND .1777     GET ON PAGE ADDRESS 
      IOR BIT10     ADD CURRENT PAGE
      ADA TMPA      ADD INSTRUCTION 
      STA TMPA
      JMP IOPRS 
      LDA TMPA      CONVERT RELATIVE PAGE JMP 
      ERA 
      AND .177
      SEZ           *+ OR *-
      CMA,INA       *-
      ADA IOPAP,I 
      LDB A 
      CMB 
      ADB IOPSA,I 
      SSB           OUT OF LIMITS?
      JMP *+3       NO
IOPRE LDA .26       JMP OUT OF LIMITS ERROR 22
      JSB ERR 
      ADB D100
      SSB           OUT OF LIMITS UPPER?
      JMP *-4       YES 
      AND .1777 
      IOR BIT10     ADD CURRENT PAGE
      IOR IOJMP     ADD INSTRUCTION 
      STA TMPA
* 
IOPRS LDA TMPA      STORE INSTRUCTION 
      CPA IOPR,I    CANT BE A JSB TO SELF 
      JMP IOPRE 
      LDB IOPAP,I   GET ADDRESS 
      STA B,I 
      LDA IOPEN,I   SET RETURN JMPS 
      INB 
      STA B,I 
      INB 
      STA B,I 
      ISZ IOPAP,I   MOVE TO NEXT ONE
      ISZ IOPR
      JMP IOPR,I    RETURN
      SKP 
*      I/O PROGRAM TABLE
* 
* 
IOP   EQU * 
      DEF IOA+1 
      DEF IOA+1 
      ABS IOA-16000B+126000B   JMP IOA,I
      NOP 
      DEF IOB+1 
      DEF IOB+1 
      ABS IOB-16000B+126000B      JMP IOB,I 
      NOP 
      DEF IOC+1 
      DEF IOC+1 
      ABS IOC-16000B+126000B      JMP IOC,I 
      NOP 
      DEF IOD+1 
      DEF IOD+1 
      ABS IOD-16000B+126000B      JMP IOD,I 
* 
IOA   EQU 16000B
* 
IOB   EQU IOA+128 
* 
IOC   EQU IOB+128 
* 
IOD   EQU IOC+128 
* 
DATA  EQU 17000B
* 
SBUF  EQU IOA 
TBUF  EQU IOB 
      SPC 2 
      ORG 20000B
FWAM  EQU *         FIRST WORD OF AVAILABLE MEMORY
* 
      END 
                                                                                                                                              