* 
* 
* 
* 
* 
* 
* 
* 
* 
* 
* 
* 
* 
* 
* 
* 
      SKP 
*         SELECT CODE SCREEN TEST 
* 
ZBIO4 LDB Z.10      START WITH LOWEST ADDRESS 
ZB40  LDA USSC      GET SELECT CODE 
      AND Z.77
      CPB A         IS IT THE CH? 
      JMP Z.CLF+1   YES - SKIP TEST 
      LDA Z.STF     SET UP
      AND ZIOM
      IOR B           STF INSTRUCTION 
      STA Z.STF     PUT IT IN PLACE 
      LDA Z.CLF     SET UP
      AND ZIOM
      IOR B         CLF INSTRUCTION 
      STA Z.CLF     PUT IT IN LINE
ZBS41 CLF CH        CLEAR CHANNEL FLAG
Z.STF STF CH        EXECUTE STF CH INSTRUCTION
ZBS42 SFC CH        TEST CHANNEL FLAG 
      JMP ZB41
Z.CLF CLF CH        CLEAR TEST FLAG 
      CPB Z.77      IS TEST FINISHED? 
      JMP ZBIO5     YES 
      INB           NO
      JMP ZB40        DO NEXT CHANNEL 
* 
ZBE11 ASC 14,E011 STF  XX SET CARD FLAG// 
* 
ZB41  STB ZBTMP     SAVE NUMBER 
      LDA B         CONVERT CH FOR MESSAGE
      JSB ZN2AO 
      STA ZBE11+5 
      LDA ZBTMP     RETRIEVE NUMBER 
E011  JSB ERMS,I    E011
      DEF ZBE11 
* 
* 
* 
* 
* 
      SKP 
*         CHECK INTERRUPT & HOLD OFF
* 
ZBIO5 JSB ZTCJI 
      DEF ZBI5
      CLA           SET UP
      STA ZBF5        FLAGS 
      STA ZBI5        FOR TEST
      STA ZBTMP 
ZBS51 STC CH        TURN ON 
ZBS52 STF CH          CARD
      STF INTP      AND INTERRUPTS
      STC 1         * 
      STF 1         * 
      CLC 1         * 
      CLF 1         *  NO INTERRUPT 
      JMP *+1,I     *  SHOULD OCCURR
      DEF *+1       *  HERE 
      JSB *+1,I     * 
      DEF *+1       * 
ZBF5  NOP           * 
      ISZ ZBTMP     INT. SHOULD BE HERE 
      ISZ ZBTMP 
      CLF INTP      TURN I/O SYSTEM OFF 
      LDA ZBI5      DID IT INTERRUPT? 
      SZA 
      JMP *+4 
E014  JSB ERMS,I    E014 NO INT 
      DEF ZBE14 
      JMP ZBIO6     ABORT REST OF SECTION 
      LDA ZBTMP     CHECK FOR CORRECT INTERRUPT 
      CPA Z.2       ? 
      JMP *+3 
E026  JSB ERMS,I    E026 INT EXECUTION ERROR
      DEF ZBE26 
ZBS53 CLF CH        TURN OFF CH FLAG
      JMP ZBIO6     GO TO NEXT SECTION
* 
ZBD5  DEF ZBF5-1
ZBD5A DEF ZBF5+1
* 
ZBE12 ASC 16,E012 INT DURING HOLD OFF INSTR/
ZBE13 ASC 12,E013 SECOND INT OCURRED/ 
ZBE14 ASC 06,E014 NO INT/ 
ZBE15 ASC 12,E015 INT RTN ADDR ERROR/ 
ZBE26 ASC 13,E026 INT EXECUTION ERROR/
* 
* 
* 
* 
      SKP 
ZBI5  NOP 
      CLF INTP      TURN I/O SYSTEM OFF 
      LDA ZBD5      CHECK TO SEE IF ALL 
      CPA ZBF5          INSTRUCTION COMPLETED 
      JMP *+3       YES 
E012  JSB ERMS,I    E012 INT DURING HOLD OFF
      DEF ZBE12 
      LDA ZBD5A     CHECK RETURN ADDRESS
      LDB CPTO      IF 210X 
      SSB           ADD ONE 
      INA 
      CPA ZBI5
      JMP ZBI5A 
E015  JSB ERMS,I    E015 INT RTN ADDR ERROR 
      DEF ZBE15 
      JMP ZBIO6 
ZBI5A JSB ZTCJI     SET SECOND INT TRAP 
      DEF ZBT5
      STF INTP      TURN I/O SYSTEM ON
      JMP ZBI5,I    CONTINUE TEST 
* 
* 
ZBT5  NOP 
      CLF INTP      TURN I/O SYSTEM OFF 
E013  JSB ERMS,I    E013 SECOND INT OCURRED 
      DEF ZBE13 
* 
* 
* 
* 
* 
      SKP 
*         CLC CH AND  CLC 0 
* 
ZBIO6 JSB ZTCJI     SET JSB INSTRUCTION 
      DEF ZBI61 
ZBS61 STC CH        SET CH CONTROL
ZBS62 STF CH        SET CH FLAG 
      STF INTP      TURN ON INTERRUPTS
ZBS63 CLC CH        CLEAR CH CONTROL
      NOP           GIVE IT A CHANCE
      NOP 
      CLF INTP      TURN INTS OFF 
ZB60  JSB ZTCJI     SET JSB INSTRUCTION 
      DEF ZBI62 
ZBS64 CLF CH        CLEAR CH FLAG 
ZBS65 STC CH        SET CH CONTROL
ZBS66 STF CH        SET CH FLAG 
      STF INTP      TURN ON INTS
      CLC INTP      CLEAR I/O SYSTEM
      NOP           GIVE IT A CHANCE
      NOP 
      CLF INTP      TURN OFF INTS 
      JMP ZBIO7 
* 
* 
ZBI61 NOP 
      CLF INTP      TURN OFF INTS 
E016  JSB ERMS,I    E016 CLC CH ERROR 
      DEF ZBE16 
      JMP ZB60
* 
ZBI62 NOP 
      CLF INTP      TURN OFF INTS 
E017  JSB ERMS,I    E017 CLC 0 ERROR
      DEF ZBE17 
      JMP ZBIO7 
* 
ZBE16 ASC 9,E016 CLC CH ERROR/
ZBE17 ASC 9,E017 CLC 0 ERROR/ 
* 
* 
* 
* 
* 
      SKP 
*         EXTERNAL & INTERNAL PRESET TEST 
* 
ZBIO7 LDB ZS812     CHECK TO SUPPRESS 
      JSB SWRT,I    ? 
      JMP H025      YES - SKIP PRESET TEST
H024  JSB MSGC,I    TELL OPERATOR 
      DEF ZBM24     PRESS PRESET
* 
ZBS71 CLF CH        CLEAR CH FLAG 
      STF INTP      TURN ON INTS
      JSB ZTCJI     SET TRAP CELL JSB INSTRUCTION 
      DEF ZBI70 
      HLT 24B       WAIT FOR OPERATOR 
      CLA,INA       SET UP FLAGS FOR TESTS
      SFS INTP      CHECK INTP FLAG 
      CLA           NOT SET SO CLEAR FLAG 
      RAL           MOVE TO NEXT FLAG 
      CLF INTP      TURN OFF ONTPS
ZBS72 SFS CH        CHECK CHANNEL FLAG
      INA           NOT SET SO FLAG IT
      RAL           MOVE TO NEXT FLAG 
      LIB 0         CHECK I/O BUSS
      SZB           SHOULD BE ZERO
      INA           NOT SO FLAG IT
      RAL           MOVE TO NEXT FLAG 
      STF INTP      CHECK CONTROL ON CARD 
      NOP           GIVE IT A CHANCE
      NOP 
      CLF INTP      TURN OFF INTPS
* 
* 
* 
* 
* 
* 
* 
* 
* 
* 
* 
* 
* 
* 
* 
* 
* 
* 
* 
* 
* 
* 
* 
      SKP 
ZB70  SLA,RSS       CHECK FOR ERRORS
      JMP *+3 
E022  JSB ERMS,I    E022 DID NOT CLEAR CONTROL
      DEF ZBE22 
      RAR 
      SLA,RSS 
      JMP *+3 
E023  JSB ERMS,I    E023 I/O LINES NOT CLEAR
      DEF ZBE23 
      RAR 
      SLA,RSS 
      JMP *+3 
E020  JSB ERMS,I    E020 FLAG NOT SET 
      DEF ZBE20 
      RAR 
      SLA,RSS 
      JMP *+3 
E021  JSB ERMS,I    E021 DID NOT DIABLE INTS
      DEF ZBE21 
H025  JSB MSGC,I    TELL OPERATOR 
      DEF ZBM25     BASIC I/O IS COMPLETE 
      JMP ZBIO,I    RETURN TO CALLER
* 
ZBI70 NOP           CONTROL FAILED
      CLF INTP      TURN OFF INTPS
      INA 
      JMP ZB70
* 
ZBE20 ASC 17,E020 PRESET(EXT) DID NOT SET FLAG/ 
ZBE21 ASC 19,E021 PRESET(INT) DID NOT DISABLE INTS/ 
ZBE22 ASC 20,E022 PRESET(EXT) DID NOT CLEAR CONTROL/
ZBE23 ASC 21,E023 PRESET(EXT) DID NOT CLEAR I-O LINES/
ZBM24 ASC 17,H024 PRESS PRESET (EXT&INT),RUN/ 
ZBM25 ASC 08,H025 BI-O COMP/
      SKP 
ZBIOD DEF *+1 
      DEF ZBS21 
      DEF ZBS22 
      DEF ZBS23 
      DEF ZBS24 
      DEF ZBS25 
      DEF ZBS26 
      DEF ZBS27 
      DEF ZBS31 
      DEF ZBS32 
      DEF ZBS33 
      DEF ZBS41 
      DEF ZBS42 
      DEF ZBS51 
      DEF ZBS52 
      DEF ZBS53 
      DEF ZBS61 
      DEF ZBS62 
      DEF ZBS63 
      DEF ZBS64 
      DEF ZBS65 
      DEF ZBS66 
      DEF ZBS71 
      DEF ZBS72 
      DEC -1
* 
ZCEND EQU * 
* 
* 
* 
* 
* 
* 
* 
* 
* 
* 
* 
* 
* 
* 
* 
* 
* 
* 
* 
* 
* 
* 
* 
* 
* 
      HED   OPERATOR DESIGN SECTION 
*        OPERATOR DESIGN SECTION
* 
      ORG 4000B 
OPDSN NOP 
      LDA 112B      CHECK FOR CONSOLE DEVICE
      SZA,RSS 
      JMP OPDSN,I   NO SO DONT DO OPDSN 
      JSB .FMT      TELL OP HE'S IN OPDSN 
      DEF MSG1
      LDA SUPA      SET 
      STA PRPLA      LAST STATEMENT ADDRESS 
      CLA           CLEAR 
      STA SUPA,I    SOURCE STATEMENT FILE 
      STA DBC       USER BUFFER 
* 
IRQ   JSB .FMT      OUTPUT @
      DEF .MSG1 
      JSB GIFO      GET INPUT FROM OPERATOR 
      JSB GETB      GET INPUT BLOCK 
      JMP INER      NO INPUT
      SEZ,RSS       IF IT'S ASCII 
      JMP PCMD        IT'S A COMMAND
      STA TMP       SAVE IT 
      SZA,RSS       IF IT'S A ZERO
      JMP INER      THEN IT'S AN ERROR
      SSA           IF NEG THEN ERROR 
      JMP INER
      LDA MXNM      CHECK FOR MAX NUMBER
      CMA 
      ADA TMP 
      SSA,RSS       IF OVER 999 
      JMP INER        THEN ERROR
      JSB GETB      GET STATEMENT TYPE
      JMP DLL       DELETE LINE 
      SEZ           SHOULD BE ASCII 
      JMP INER      NO-SO ERROR 
      SKP 
      JSB FNDST     FIND STATEMENT TYPE 
      JMP INER      NOT FOUND 
      STA SVB 
      STB TMP+1 
      ALF,ALF 
INPRN AND .177
      CPA AA        IS IT ASCII?
      JMP TAA       YES 
      CPA AI        IS IT INTEGER?
      JMP TAI       YES 
      CPA AK        IS IT OCTAL?
      JMP TAK       YES 
      JMP INPRC-1 
* 
TAA   JSB GETB      GET NEXT BLOCK
      JMP INPRC-1   NO MORE DATA
      SEZ           IS IT ASCII 
      JMP INER      NO - THEN ERROR 
      JMP INPRC     OK
* 
TAI   JSB GETB      GET NEXT BLOCK
      JMP INPRC-1   NO MORE DATA
      SEZ,RSS       IS IT A NUMBER
      JMP INER      NO - THEN ERROR 
      JMP INPRC     OK
* 
TAK   JSB GETB      GET NEXT BLOCK
      JMP INPRC-1   NO MORE DATA
      SEZ,RSS       IS IT A NUMBER
      JMP INER      NO - THEN ERROR 
      LDA B         OK
      JMP INPRC 
      CLA           NO DATA SO MAKE IT ZERO 
* 
INPRC LDB SVB 
      SZB 
      STA TMP+2 
      SZB,RSS 
      STA TMP+3 
      LDA SVB       IS THIS FIRST PRAM
      SZA,RSS       ? 
      JMP *+4 
      CLB 
      STB SVB 
      JMP INPRN 
     SKP
*     PUT STATEMENT IN QUE
* 
SYNTX RSS           (BAY BE OVERLAYED BY JSB) 
      JMP INER
      JSB FNDLN     FIND LINE NUMBER
      JMP INSTR     NOT FOUND 
      ISZ PRPTR     FOUND IT
      LDA TMP+1     JUST REPLACE IT 
      STA PRPTR,I   JUST REPLACE IT 
      LDA TMP+2     JUST REPLACE IT 
      ISZ PRPTR     JUST REPLACE IT 
      STA PRPTR,I   JUST REPLACE IT 
      LDA TMP+3     JUST REPLACE IT 
      ISZ PRPTR     JUST REPLACE IT 
      STA PRPTR,I   JUST REPLACE IT 
      JMP IRQ       ASK FOR MORE
* 
INSTR LDA PRPLA     CHECK 
      ADA .5         TO 
      CMA,INA         SEE IF
      ADA EUPA         QUEUE FULL 
      SSA,RSS       ? 
      JMP .STR      NO - OK STORE IT
      JSB .FMT      YES TELL OPERATOR 
      DEF MSG4
      JMP IRQ 
MSG4  ASC 6,QUEUE FULL/ 
* 
.STR  LDA TMP       MOVE LINE NUMBER
      LDB PRPTR,I   INTO PLACE
      STA PRPTR,I 
      SZA,RSS       IF NUMBER=0 THEN
      JMP SVLA      SAVE LAST ADDRESS 
      STB TMP       ELSE
      ISZ PRPTR     MOVE BLOCK
      LDA TMP+1     IN
      LDB PRPTR,I   TO END
      STA PRPTR,I   OF
      STB TMP+1     PROGRAM 
      ISZ PRPTR 
      LDA TMP+2 
      LDB PRPTR,I 
      STA PRPTR,I 
      STB TMP+2 
      ISZ PRPTR 
      LDA TMP+3 
      LDB PRPTR,I 
      STA PRPTR,I 
      STB TMP+3 
      ISZ PRPTR 
      JMP .STR
      SKP 
*          FIND STATEMENT 
* 
FNDST NOP 
      STA SVA       SAVE TYPE 
      STB SVB       ""
      LDB STTBD     STATEMENT TABLE DEF 
FNDSL LDA B,I 
      CPA .M2       END OF STANDARD TABLE 
      RSS           YES 
      JMP *+3 
      LDB STUD      GET STANDARD USER TABLE 
      JMP FNDSL     TRY IT
      CPA .M1       IS IT THE TERMINATOR
      JMP FNDST,I   YES - NOT FOUND 
      CPA SVA       IS IT THIS CHARACTER
      JMP *+3       YES 
      ADB .4        NO - MOVE TO NEXT STATEMENT 
      JMP FNDSL     AND TRY IT
      INB           MOVE TO SECOND CHARACTERS 
      LDA B,I 
      CPA SVB       DO THESE COMPARE
      JMP *+3       YES 
      ADB .3        NO - MOVE TO NEXT STATEMENT 
      JMP FNDSL     AND TRY IT
      ISZ FNDST     FOUND - ADJUST RETURN 
      INB 
      LDA B,I       RETRIEVE  PARAMETER TYPES 
      INB           AND PROCESSOR POINTER 
      JMP FNDST,I 
* 
* 
*         FIND LINE NUMBER IN QUE =TMP
* 
FNDLN NOP 
      LDB SUPA      START AT FIRST STATEMENT
      STB PRPTR 
      LDA B,I 
      SZA,RSS       IF ZERO 
      JMP FNDLN,I     THEN NOT FOUND
      CMA,INA       ADD THE TWO 
      ADA TMP         NUMBERS 
      SZA,RSS       IF EQUAL
      JMP *+5         THEN FOUND
      SSA           IF IT GOES NEG. 
      JMP FNDLN,I     THEN NOT FOUND
      ADB .4        TRY NEXT STATEMENT
      JMP FNDLN+2 
      ISZ FNDLN 
      JMP FNDLN,I 
     SKP
*         GET INFORMATION FROM OPERATOR 
* 
GIFO  NOP 
      LDA .D72      INPUT COUNT 
      LDB IBUFD 
      JSB SLIN,I    GET INPUT FROM OPERATOR 
      SZA,RSS       WAS THERE ANY INPUT 
      JMP *-4       NO - SO ASK AGAIN 
      CPA .D72      DO I NEED A CR-LF?
      RSS 
      JMP *+4       NO
      CLA           YES 
      JSB SLOP,I
      LDA .D72      RESTORE COUNT 
      LDB IBUFD     * 
      RBL           * 
      STB IBUFP     *  ADD CR TO
      ADB A         * 
      LDA .15       *    END OF BUFFER
      JSB A2BUF     * 
      JMP GIFO,I    RETURN TO CALLER
* 
* 
* 
* 
* 
* 
* 
* 
* 
* 
      SKP 
*          GET A CHARACTER FROM INPUT BUFFER
* 
GETC  NOP 
      LDB IBUFP 
      JSB BUF2A 
      CPA .15       IF CR RETURN P+1
      JMP GETC,I    YES 
      ISZ IBUFP     MOVE POINTER TO NEXT CHARACTER
      ISZ GETC      ADJUS GOOD RETURN P+2 
      JMP GETC,I    RETURN
* 
* 
BUF2A NOP 
      CLE,ERB       E _ UPPER LOWER FLAG
      LDA B,I       2CHR TO AREG
      SEZ,RSS       UPPER OR LOWER? 
      ALF,ALF       UPPER 
      AND .177      MASK UNWANTED CHARACTER 
      JMP BUF2A,I   RETURN. 
* 
* 
A2BUF NOP 
      STA GETC      SAVE CHARACTER
      SLB,INB         OPPSITE 
      ADB .M2           CHARACTER 
      JSB BUF2A 
      ALF,ALF 
      IOR GETC      ADD NEW CHARACTER 
      SEZ           SHOULD IT BE SWAPPED? 
      ALF,ALF       YES 
      STA B,I       STORE IT
      JMP A2BUF,I 
* 
* 
PUTC  NOP 
      AND .177      MASK UPPER BITS 
      SZA,RSS       IF IT'S ZERO
      JMP PUTC,I    DON'T PUT IN BUFFER 
      LDB IBUFP     GET ADDRESS 
      JSB A2BUF     PUT CHATACTER IN BUFFER 
      ISZ IBUFP     MOVE TO NEXT CHARACTER
      JMP PUTC,I    RETURN TO CALLER
* 
* 
* 
* 
* 
      SKP 
*          GET INPUT BLOCK FROM INPUT BUFFER
* 
GETB  NOP 
      CLA           CLEAR PARAMETERS
      STA AIN 
      STB BIN 
      JSB GETC      GET A CHARACTER 
      JMP GETB,I    NO DATA 
      CPA SPC       CHECK IF IT'S A SPACE 
      JMP GETB,I    YES SKIP IT 
      ISZ GETB      ADJUST RETURN 
      CPA MINUS     IF IT'S NEG SIGN
      JMP NUMIN+1     THEN PROCESS AS A NUMBER
      JSB DGCK      IF IT'S A NUMBER
      JMP NUMIN       THEN PROCESS AS A NUMBER
      CLB 
      STB SVA 
      JSB GETA      CONVERT 2 CHARACTERS
      STA AIN       SAVE IT 
      LDA SVA       CHECK IF SPACE HAS BEEN 
      SZA,RSS       ? 
      JSB GETC      NO GET NEXT CHARACTER 
      LDA SPC       NO DATA USE SPACE 
      CPA SPC       IS IT A SPACE?
      STA SVA       YES SET FLAG
      JSB GETA      CONVERT NEXT 2 CHARACTERS 
      STA BIN       SAVE IT 
      LDA SVA       CHECK FOR SAPC
      SZA           ? 
      JMP *+6 
      JSB GETC      MOVE TO NEXT SPACE
      LDA SPC       NO DATA USE SPACE 
      CPA SPC       SPACE?
      RSS           YES 
      JMP *-4       NO GET NEXT CHARACTER 
      CLE           INDICATE ASCII
      LDA AIN       RETRIEVE CHR
      LDB BIN 
      JMP GETB,I    RETURN
* 
* 
GETA  NOP 
      STA BIN 
      LDA SVA 
      SZA,RSS 
      JSB GETC
      LDA SPC 
      CPA SPC 
      STA SVA 
      ALF,ALF 
      IOR BIN 
      ALF,ALF 
      JMP GETA,I
      SKP 
NUMIN CCB,RSS       INDICATE POSITIVE 
      CLB           INDICATE NEGATIVE 
      STB NFLG      SAVE FLAG 
      ADB IBUFP     MOVE POINTER BACK IF NECESSARY
      CLE,ERB       SET UPPER LOWER FLAG
      CLA           CALL FOR INTEGER
      JSB AS2N,I    CONVERT IT
      STA AIN       SAVE IT 
      LDB NFLG
      ADB IBUFP 
      CLE,ERB 
      CCA           CALL FOR OCTAL
      JSB AS2N,I    CONVERT IT
      STA BIN       SAVE IT 
      LDA AIN       RETRIEVE
      LDB BIN           NUMBERS 
      ISZ NFLG      WAS A NEG ENTERED?
      RSS 
      JMP *+3       NO
      CMA,INA       YES 
      CMB,INB 
      STA AIN       SAVE NUMBER 
      STB BIN 
      JSB GETC      GET NEXT CHARACTER
      LDA SPC       NO DATA USE SPACE 
      CPA SPC       READ TO NEXT SPACE
      RSS 
      JMP *-4       NO MOVE TO NEXT ONE 
      CCE           INDICATE IT'S A NUMBER
      LDA AIN       RETRIEVE PRAMETERS
      LDB BIN 
      JMP GETB,I    RETURN
AIN   NOP 
BIN   NOP 
NFLG  NOP 
* 
*          CHECK IF AREG = DIGIT
* 
DGCK  NOP 
      STA BUF2A     SAVE CHARACTER
      ADA .M60      ADD -60 OCTAL 
      SSA           SHOULD STILL BE POS.? 
      ISZ DGCK      NO - NOT A DIGIT
      ADA .M10      ADD -10 
      SSA,RSS       SHOULD GO NEG?
      ISZ DGCK      NO - ADJUST RETURN
      LDA BUF2A     RETRIEVE CHARACTER
      JMP DGCK,I    RETURN
      SKP 
*                   SELECT FAST OR SLOW OUTPUT DEVICE 
* 
PDVC  NOP 
      LDA JSBSD 
      CPB AP        CHECK IF LINE PRINTER?
      INA           YES 
      LDB 113B      CHECK IF THERE IS A FAST DEVICE 
      SZB,RSS       ? 
      LDA JSBSD     NO
      STA FDF 
      JMP PDVC,I    RETURN
                                                                                                                                                                        