*M*  DEVDMP  -  DEVICE DUMP STANDALONE UTILITY PROGRAM
*P*  NAME:  DEVDMP
*P*
*P*  PURPOSE:  THE DEVDMP PROCESSOR PRODUCES A DEVICE COPY
*P*            OF THE RAD OR PACK.  THAT IS, INDIVIDUAL SECTORS
*P*            ARE COPIED TO TAPE IN THE ORDER THAT THEY ACTUALLY OCCUR.
*P*
*P*            DEVDMP IS USEFUL FOR SAVING/RESTORING THE SYSTEM
*P*            SWAPPER OR A FILE DEVICE WHEN IT IS NECCESSARY TO USE
*P*            SUCH A DEVICE FOR PREVENTIVE MAINTENANCE.  THIS ALLOWS
*P*            FOR A QUICK RELOAD OF THE SYSTEM WITHOUT A LENGTHY
*P*            FILE RESTORE PROCESS.
         PCC       0
         SYSTEM    UTS
         SYSTEM    BPM
         TITLE    'PROCS AND EQUATES USED BY PROGRAM'
*                                                                       DTD00010
**                PROCEDURES AND COMS                                   DTD00010
*                                                                       DTD00010
         SPACE    2
*
*                 PROCEDURE TO MANIPULATE BITS.
*                 CALLED BY:
*        SETBIT   LOCATION,BIT,BIT     SETS SPECIFIED BIT(S) IN WORD
*        OFFBIT   LOCATION,BIT,BIT     RESETS SPECIFIED BIT(S) IN WORD
*        FLIPBIT  LOCATION,BIT,BIT     INVERTS SPECIFIED BIT(S) IN WORD
*        TESTBIT  LOCATION,DESTINATION,BIT BIT  TEST FOR ONES IN THE
*                                      SPECIFIED BIT(S)
*                 WHERE: LOCATION   IS SYMBOLIC ADDRESS OF WORD
*                        DESTINATION IS ADDRESS TO BRANCH TO IF ANY OF
*                                    THE SPECIFIED BITS CONTAIN A 1 BIT
*                        BIT        IS THE BIT NUMBER OF THE BITS TO BE
*                                   TESTED. 0-31 ARE VALID BIT NUMBERS.
*                                   ANY NUMBER OF BITS MAY BE SPECIFIED.
*
SETBIT   CNAME    848,1,1,73
OFFBIT   CNAME    848,1,1,75
FLIPBIT  CNAME    848,1,1,72
TESTBIT  CNAME    1684,2,2,49
         PROC
         LOCAL    B,I,C,D
LF       EQU      %
B        SET      0
I        DO       NUM(AF)-NAME(3)
C        SET      B|(1**(31-AF(I+NAME(3))))
B        SET      C
         FIN
         DO       NAME(4)=75
D        SET      ~C
         ELSE
D        SET      C
         FIN
         LW,+CF(2) AF(1)
         GEN,8,4,20  NAME(4),CF(2),L(D&X'FFFFFFFF')
         DO       NAME(1)=848
         GEN,12,20 NAME(1)|CF(2),AF(NAME(2))
         ELSE
         GEN,12,20 NAME(1),AF(NAME(2))
         FIN
         PEND
*                COM  TO SET CONDITION CODES AND PUSH,PULL,STORE OR
*                LOAD MULTIPLE REGISTERS
*                 CALLED BY.
*        PUSHREG  NUMBER OF REGS,1ST REG,STACK POINTER (PSM)
*        PULLREG  NUMBER OF REGS,1ST REG,STACK POINTER (PLM)
*        STOREM   NUMBER OF REGS,1ST REG,ADDRESS       (STM)
*        LOADM    NUMBER OF REGS,1ST REG,ADDRESS       (LM)
PUSHREG  COM,8,4,16,4,8,4,20  2,2,AF(1),0,11,AF(2),AF(3)
PULLREG  COM,8,4,16,4,8,4,20  2,2,AF(1),0,10,AF(2),AF(3)
STOREM   COM,8,4,16,4,8,4,20  2,2,AF(1),0,43,AF(2),AF(3)
LOADM    COM,8,4,16,4,8,4,20  2,2,AF(1),0,42,AF(2),AF(3)
*
*
*                COM TO GENERATE I/O COMMAND DOUBLE WORDS. CALLED BY.
*
*        IOPCW    ORDER CODE,DATA ADDRESS(WORD),FLAGS,COUNT
*
IOPCW    CNAME                                                          DTD00010
         PROC                                                           DTD00010
         ERROR,15,NUM(AF)<4 'LESS THAN 4 FIELDS SPECIFIED'
         ERROR,15,NUM(AF)>4 'MORE THAN 4 FIELDS SPECIFIED'
         DO       NUM(AF)=4                                             DTD00010
         BOUND    8                                                     DTD00010
LF       GEN,8,24,8,24  AF(1),BA(AF(2)),AF(3),AF(4)                     DTD00010
         ELSE                                                           DTD00010
         FIN                                                            DTD00010
         PEND                                                           DTD00010
IOREQ    COM,8,4,20   AF(1),AF(2),AF(3)
XXX      COM,8,24 AF(1),AF(2)
*
**                PROCEDURE FOR TIO'S
*
TIONEW   CNAME
         PROC
LF       EQU      %
         LI,R10   X'30'
         TIO,R0   AF
         BDR,R10  %
         BCS,M12  %-3
         PEND
*
*        WAIT FOR OPERATOR TO CLEAR WAIT
*
OPACTION CNAME
         PROC
         DISABLE
         LI,R6     X'1000'          ARM & DISABLE
         WD,R6     X'1300'          COUNTER 4 PULSE
         WAIT      0
         LI,R6     4144             ARM & ENABLE
         WD,R6     4608             ALL INTERRUPTS
         PEND
*
NODEIS   COM,32    WA(AF)
RETURNTO COM,32    WA(AF)
         PAGE                                                           DTD00010
*                                                                       DTD00000
**                EQUATES                                               DTD00000
*                                                                       DTD00000
R0       EQU      0                 GENERAL REGISTERS                   DTD00000
RO       EQU      0
R1       EQU      1                                                     DTD00000
R2       EQU      2                                                     DTD00000
R3       EQU      3                                                     DTD00000
R4       EQU      4                                                     DTD00000
R5       EQU      5                                                     DTD00000
R6       EQU      6                                                     DTD00000
R7       EQU      7                                                     DTD00000
R8       EQU      8                                                     DTD00000
R9       EQU      9                                                     DTD00000
R10      EQU      10                                                    DTD00000
R11      EQU      11                                                    DTD00000
R12      EQU      12                                                    DTD00000
R13      EQU      13                                                    DTD00000
R14      EQU      14                                                    DTD00000
R15      EQU      15                                                    DTD00000
BSR      EQU      0                 I/O ORDERS                          DTD00000
RD1      EQU      1                                                     DTD00000
RD2      EQU      2                                                     DTD00000
WRT1     EQU      3                                                     DTD00000
WRT2     EQU      4                                                     DTD00000
WTE      EQU      5                                                     DTD00000
SET0     EQU      6                                                     DTD
REW      EQU      7                                                     DTD
ERG      EQU      8                                                     DTD
FSF      EQU      9                                                     DTD
WTM      EQU      10                                                    DTD
FSR      EQU      11
CHK1     EQU      0                                                     DTD
CHK2     EQU      7                                                     DTD
NOCYL    EQU      202
NOCYL70  EQU      412               7270-7275
NOTRK    EQU      20                7242-7260-7270(7275 HAS 19)
T        EQU      4                 GENERAL                             DTD
D        EQU      5                                                     DTD
ALLOW    EQU       39
NOALLOW  EQU      55
KEYBOARD EQU      1                                                     DTD
X1       EQU      1                 INDEX REGISTERS                     DTD
X2       EQU      2                                                     DTD
X3       EQU      3                                                     DTD
X4       EQU      4                                                     DTD
X5       EQU      5                                                     DTD
X6       EQU      6                                                     DTD
X7       EQU      7                                                     DTD
M1       EQU      1                                                     DTD
M2       EQU      2                                                     DTD
M3       EQU      3                                                     DTD
M4       EQU      4                                                     DTD
M8       EQU      8                                                     DTD
M11      EQU      11                                                    DTD
M12      EQU      12                                                    DTD
M14      EQU      14                                                    DTD
HDR1TDV  EQU      X'1E2'
HDR2TDV  EQU      X'1E1'
         TITLE    'PROGRAM CONTROL WORD  ---INDICATE--- '
*        BIT    0 *
*               1  *  JOB SWITCH. WHEN '0000' A COPY COMMAND IS
*               2  *  OUTSTANDING.  WHEN '0001' A RESTORE COMMAND IS
*               3 *   OUTSTANDING.
*                 MEANING WHEN =1.
*               4 TAPE READ TO BUFFER 1 IN PROGRESS.
*               5 TAPE READ TO BUFFER 2 IN PROGRESS.
*               6 TAPE WRITE FROM BUFFER 1 IN PROGRESS.
*               7 TAPE WRITE FROM BUFFER 2 IN PROGRESS.
*               8 DISC OPERATION USING BUFFER 1.
*               9 DISC OPERATION USING BUFFER 2.
*              10 USE LP FOR MSGES
*              11 END OF COMMAND INPUT RECEIVED.
*              12 CONTINUATION CHARACTER IN COMMAND INPUT STRING.
*              13 OPERATOR REQUESTED BOOT AFTER END OF RUN
*              14 KEY-IN ERROR DETECTED.
*              15 PROCESSING FLAWED TRACK
*              16 ACCEPT NEW DISC ADDRESSES DURING RESTORE/COMPARE
*              17 EOF ON TAPE DETECTED.
*              18 A 'DC' COMMAND STRING HAS BEEN KEYED-IN.
*              19 PROGRAM AND BOOT HAVE BEEN WRITTEN ON TAPE
*              20 CURRENT COMMAND HAS COMPLETED
*              21 COMMAND INPUT IS TO COME FROM THE CARD READER
*              22 TAPE ERROR RECOVERY IN PROGRESS
*              23 CHECK WRITE IN PROGRESS
*              24 EXECUTING I/O CAL1,6
*              25 DISC/TAPE I/O OVERLAP IS POSSIBLE
*              26 DATE HAS BEEN ENTERED
*              27 TAPE ERROR RECOVERY FOR BOOT/PGM/DIR
*              28 BOOT-WRITE IN PROGRESS
*              29 DIRECTORY-WRITE IN PROGRESS
*              30 A RAD MODEL NUMBER HAS BEEN KEYED-IN.
*              31 A JOB COMMAND (COPY OR RESTORE) HAS BEEN KEYED-IN.
*
         TITLE    'INITILIZE SYSTEM FOR RUN'
*        ORG       X'A064'          PAST TABLES AREA SO PGM CAN
*                                   BE RUN UNDER EXEC DELTA
LOAD2    EQU      %                                                   DTD
         LW,R1    X55               INITILIZE
         STW,R1   X'55'             COIUNTER 4
         LI,R1    0                 ZERO CLOCK COUNTER
         STW,R1   TIME
BEGIN    LI,R1    0
         STW,R1   IND
         LW,R1  X'26'               IF RESTART DONT RESET
         CW,R1    RGO               DATE INDICATOR WE HAVE ALREADY
         BNE      BEGIN1
         SETBIT   IND,26            SET    DATE ENTERED
BEGIN1   LPSD,M11 START             SET INITIAL PSD
PROG     EQU      %
         LW,R1    RGO               ALLOW RESET AND RUN
         STW,R1   X'26'
         TIO,0    *TYPEDEV          CHECK IF TELETYPE ADDR VALID
         BCR,8    %+5               B IV VALID
         BCR,4    %+4               B IF VALID
         WAIT                       NOT VALID , ACCEPT NEW ADDR IN R0
         STW,R0   TYPEDEV           STORE NEW ADDR
         B        %-5               VERIFY NEW ADDR
         LI,R1    4144              ARM AND
         WD,R1    4608              ENABLE INTERRUPTS
         LCI      12      INITILIZE-         TRAPS
         LM,R1    X40
         LCI      4
         STM,R1   64                X'40',X'41',X'42' AND X'43'
         STW,R5   70                X'46'
         LCI      2
         STM,R6   72                X'48' AND X'49'
         STW,R9   86                X'56'
         LCI      3
         STM,R10  91                X'5B',X'5C' AND X'5D'
         LOADM    4,2,BREP          SRT UP DISC
         STOREM   4,2,BUF2CW1       BUFFER 2
         LI,R2    X'15'             GET 'NL' CHARACTER
         LI,R3    -1
         STB,R2   BLANK,R3          STORE 'NL' IN INPUT AREA
         BAL,R15  PRESET            INITILIZE DEFAULT OPTIONS           DTD
         LI,R6    BA(MSGX1)         GET ADDR OF MSG TO BE TYPED         DTD
         BAL,R15  COMTYPE           GO TYPE MSG                         DTD
         PAGE
*
* SET UP BUFFER AND BYTE COUNT FOR THE ROS,R/W DOWNLOADS
*
* 3-WD HEADER IN FRONT OF MPC F/W
*    1: # BYTES IN ROS LOAD
*    2: # BYTES IN R/W LOAD
*    3: DISPLACEMENT IN SIGMA/560 WORDS TO R/W LOAD
*
         REF      MPC9310:
         PUSHREG  4,3,SUBSTACK
         BCS,M2   STKERROR
         LI,R6    CALCEND
CALCSIZ  LW,R5    MM24              BYTE ADDR MASK
         LI,R4    BA(MPC9310:+3)    ROS BUF
         STS,R4   ROS:LD+4
         LW,R4    MPC9310:          ROS SIZ
         STS,R4   ROS:LD+5
*
         LW,R4    MPC9310:+2        WORD DISP TO R/W BUF
         SLS,R4   2                 BYTE  "   "   "   "
         AI,R4    BA(MPC9310:+3)    R/W BUF
         STW,R4   R3                SAV FOR PGMSIZ CALCULATION
         STS,R4   RW:LD+4
         LW,R4    MPC9310:+1        R/W SIZ
         STS,R4   RW:LD+5
*
* CALCULATE PROGRAM SIZE FOR BOOTABLE VERSION ONTO TAPE
*
*        PGMSIZ = BA(PGMEND) - BA(PGMBEG) + 500
*        PGMBEG = LOAD2
*        BA(PGMEND) = R/W BUF + R/W SIZ
*
         AW,R4    R3                C(R4)=BA(PGMEND)
         AI,R4    -BA(LOAD2)+500         -BA(PGMBEG)+500
         STW,R4   PGMSIZ
*
* CALCULATE PROGRAM SIZE IN BLOCKS FOR DUMP ONTO TAPE
*
*        NBLOX = (PGMSIZ+BLOCKSIZ-1) / BLOCKSIZ
*
         LW,R3    PGMSIZ            PROGRAM SIZE (BYTES)
         AI,R3    3
         SLS,R3   -2                   "      "  (WORDS)
         AI,R3    BLOCKSIZ-1
         DW,R3    =BLOCKSIZ         C(R3)=# BLOCKS IN PGM
         STW,R3   NBLOX
         LW,R4    NBLOX
         LW,R5    MM20              MASK FOR DATA FIELD OF IMMED INSTR
         STS,R4   MTBOOT            'LI,R1' INSTR OF BOOTSTRAP REC
         B        *R6
CALCEND  EQU      %
         PULLREG  4,3,SUBSTACK
*
         LI,R6     0
         STW,R6    CALLINGX         START OFF CLEANLY
         STW,R6    LASTZAP
         STW,R6    MPCTAPE
         PAGE
         TESTBIT  IND,BYDATE,26
         LI,R6    BA(MSGDATE)       MSG ADDR
         BAL,R15  COMTYPE           TYPE 'ENTER DATE--'
         BAL,R15  COMREAD           ACCEPT TYPE-IN
         SETBIT   IND,26            SET    DATE ENTERED
         LD,R2    INPUT             GET KEY-IN
         STD,R2   SAVEDATE          STORE
         STD,R2   DTEHOLD           FOR USE
BYDATE   EQU      %
         LI,R6    BA(MSGX2)         GET ADDR OF MSG TO BE TYPED         DTD
         BAL,R15  COMTYPE           GO TYPE MSG                         DTD
         TITLE    'COMMAND SCANNER'
CONTPRMS EQU      %
         TESTBIT  INDICATE,KARD1,21 BRANCH IF CARD READER INPUT
         BAL,R15  COMREAD           USE TELE TYPE TO GET COMMDS
CONT1    EQU      %
*                                                                       DTD
*                 BEGIN DECODING PARAMETERS                             DTD
*                                                                       DTD
         OFFBIT   INDICATE,11,12    RESET COMMD FLAGS
         LI,X1    0                 SCAN FOR POSSIBLE 'CANCEL' (EOM)
         STW,X1    DENSAV           NO DENSITY YET SPECIFIED
         LB,R2    INPUT             SPECIAL TEST TO DETECT NEW LINE
         CI,R2    21                CHARACTER IN 1ST KEY-IN PSN.
         BE       END               BRANCH IF SO
SCAN     LB,R2    INPUT,X1          GET 1 CHARACTER
         CI,R2    21                TEST FOR TERM OF TYPE-IN  (X'15')
         BE       SETUP-1           BRANCH IF YES
         CI,R2    64                TEST FOR BLANK
         BE       FIND3             BRANCH IF BLANK
SCAN1    EQU      %
         AI,X1    1                 INCREMENT INDEX
         B        SCAN              SCAN ENTIRE TYPE-IN
         LI,X1    0
SETUP    BAL,R15  BLNKWRK           CLEAR WORK AREA
         TESTBIT  INDICATE,END,11   TEST FOR END CHAR RECEIVED
         TESTBIT  INDICATE,CONTPRMS,12 TEST FOR CONTINUE CHAR RECEIVED
SETUPCHR LI,X4    0
         LB,R2    INPUT,X1          GET 1 CHARACTER
         CI,R2    C','              TEST FOR COMMD SEPARATOR  (COMMA)
         BE       FIND              BRANCH IF SO
         CI,R2    ';'               TEST FOR CONT CHAR
         BE       FIND1             YES-BRANCH
         CI,R2    21                TEST FOR NL (END TYPE-IN) CHARACTER
         BE       FIND2             YES-BRANCH
         CI,R2    64                TEST FOR BLANK
         BE       FIND2
         STB,R2   WORK,X4           STORE CHARACTER IN WORK AREA
         AI,X4    1                 INCREMENT
         AI,X1    1                 INDEXES
         B        SETUPCHR+1        MOVE COMMD TILL DELIMITER DETECTED
FIND1    SETBIT   INDICATE,12       SET CONTINUE CHAR RECEIVED
         B        FIND              GO DECODE COMMD
FIND2    SETBIT   INDICATE,11       SET END OF KEY-IN RECEIVED
         B        FIND              GO DECODE COMMD
FIND3    EQU      %
         TESTBIT  INDICATE,FIND4,21 BRANCH IF CARD INPUT
         B        SCAN1             INPUT IS FROM TELE-TYPE
FIND4    EQU      %
         CI,X1    0                 TEST FOR BLANK CARD
         BE       END                 BRANCH IF SO
         LI,X4    7                 GET INDEX
         STB,X1   LOGCW,X4          STORE IN COMMD AS BYTE CNT
         LI,R0    DA(LOGCW)         COMMD ADDR
         SIO,R0   *TYPEDEV          TYPE COMMD FROM CARD RDR
         BIOSNS   %-1
         TIO,R0   *TYPEDEV          WAIT FOR TYPE TO FIN
         BCS,M4   %-1
         LI,X1    0                 CLEAR INDEX
         B        CR                PROVIDE CARRIAGE RETURN
CR       LI,R6    BA(CRMSG)         PROVIDE
         BAL,R15  COMTYPE           DOUBLE CARRIAGE
         B        SETUP             RETURN TO SCAN NEXT COMMD
         TITLE    'FUNCTION DECODER'
FIND     EQU      %
         STW,X1   X1SAV             SAVE SCAN POINTER
         LH,R2    INPUT             GET 1ST HALF-WORD OF 1ST COMMD
         CI,R2    X'FC3D9'          TEST FOR CARD INPUT
         BE       KARDA             BRANCH IF SO
         LB,R2    WORK              GET 1ST DIGIT OF THIS COMMD
         CI,R2    C'C'              TEST FOR -C- COPY OR COMP           DTD
         BE       COPYCOMP          BRANCH IF SO                        DTD
         CI,R2    C'D'              TEST FOR -D- DT OR DC               DTD
         BE       DDISCRIM          BRANCH IF SO                        DTD
         CI,R2    C'R'              TEST FOR -R-  RAW OR REST           DTD
         BE       RESTRTN           BRANCH IF SO
         CI,R2     C'X'             COULD BE 'XT' (MPC TAPE) OR
*                                            'X'  (NEW DISC)
         BE        XENTERED
         CI,R2    C'M'              TEST FOR -M-  MT                    DTD
         BE       DECODETP          BRANCH IF SO                        DTD
         CI,R2    C'#'              TEST FOR -#-  #7202                 DTD
         BE       SETMODEL          BRANCH IF SO                        DTD
         CI,R2    C'P'              TEST FOR PRINT DIRECTORY COMMD
         BE       PNTDIR            BRANCH IF SO
         CI,R2    'E'               TEST FOR :
         BE       TRIG%CP           BR IF HE WANTS CP RTNS
         CI,R2    'G'
         BE       MARK%GRP          BR IF END OF GROUP
         CI,R2    'B'
         BE       SET%BOOT          BR IF BOOT COMMD
         B        GPARAM            INVALID COMMAND
XENTERED LH,R2     WORK             FIRST 2 CHARS OF PARAM
         CI,R2     X'FE7E3'         TEST FOR -XT-
         BNE       NEWDCX
         LI,R2    1
         STW,R2    MPCTAPE          SET FLAG FOR XT
         B         DECODETP1
COPYCOMP LH,R2    WORK              TEST
         CI,R2    X'FC3D6'          FOR COPY
         BE       COPYRTN           BRANCH IF SO                        DTD
         CI,R2    X'FC3D4'          FOR CMPR
         BE       COMPARE           BRANCH IF SO
         B        GPARAM            INVALID SKIP                        DTD
COPYRTN  OFFBIT   INDICATE,1,2,3    SET  SWITCH FOR COPY CMMD
         SETBIT   INDICATE,31       INDICATE JOB RECEIVED
         B        NR1
TRIG%CP  LI,R15   16
         WD,R15   X'1700'           TRIGGER CP
         B        NR1               GET NEXT PARAM
*
SET%BOOT EQU    %
         SETBIT   INDICATE,13       SET AUTO BOOT
         LI,R6    BA(WORK)+2        SET PTR TO DEV ADDR
         LI,R1    4
         BAL,R15  CPTOHEX           CONVERT TO HEX
         STW,R9   BOOTDEV           STORE
         B        NR1               GET NEXT COMMAND
COMPARE  OFFBIT   INDICATE,1,2,3
         SETBIT   INDICATE,2,31
         B        NR1               GET NEXT COMMAND
NEWDCX   EQU      %
         SETBIT   IND,16            SET TO ACCEPT NEW DISC ADDR'S
         B        NR1               GET NEXT COMMAND
RESTRTN  EQU      %
         OFFBIT   INDICATE,1,2,3    CLEAR SWITCH
         SETBIT   INDICATE,3,31     TURN ON -JOB RECEIVED AND RESTORE-
NR1      EQU      %
         LW,X1    X1SAV             RETRIEVE SCAN POINTER
         AI,X1    1
         B        SETUP             GO GET NEXT PARAM                   DTD
KARDA    EQU      %                 SET UP FOR CARD INPUT
         OFFBIT   INDICATE,11,12    IGNORE END OR CONTINUE CHARACTERS
         SETBIT   INDICATE,21       SET CARD INPUT SWITCH
         LI,R6    BA(INPUT)+2       SET PTR TO DEV ADDR
         LB,R2    0,R6
         CI,R2    C'A'              CHECK IF ADDR ENTERED
         BL       KADEF             NO   FIND DEFAULT
         LI,R1    4
         BAL,R15  CPTOHEX           CONVERT TO HEX
         STW,R9   CARDDEV
         B        CONTPRMS
KADEF    EQU      %
         LW,R0    X'25'             GET BOOT DEV ADDR
         CI,R0    X'80'             CHECK IF MULTI-DEV CONTROLLER
         BANZ     CONTPRMS          YES - USE  03
         STW,R0   CARDDEV           NO USE BOOT DEV
         B        CONTPRMS
DDISCRIM LH,R2    WORK              GET 1ST 2 CHARACTERS                DTD
         CI,R2    X'FC4C3'          TEST FOR DC
         BE       SETDC             BRANCH IF SO                        DTD
         CI,R2    X'FC4D5'          IS THHS A 560 DEVICE
         BE       SETDN             BRANCH IF YES
         B        GPARAM            INVALID PARAM BRANCH                DTD
*
         OPEN     M1,M2,M3,M4,M11
SETMODEL EQU      %
         LI,R2    0
         LI,R5    3
         LB,R4    WORK,X5           GET
         STB,R4   R3                TWO
         SLD,R2   8                 LOW
         LB,R4    WORK+1            ORDER
         STB,R4   R3                DIGITS
         SLD,R2   8                 OF MODEL NBR
         CI,R2    '12'              TEST FOR #7212
         BE       M11
         CI,R2    '14'              TEST FOR 3214
         BE       MM14
         CI,R2    '32'              TEST FOR #7232
         BE       M21
         CI,R2    '02'              TEST FOR #7202
         BE       M2
         CI,R2    '03'              TEST FOR #7203
         BE       M3
         CI,R2    '04'              TEST FOR #7204
         BE       M4
         CI,R2     '42'         TEST FOR PAK
         BE       M42
         CI,R2    '60'              7260
         BE       M60               YUP
         CI,R2    '70'              7270
         BE       M70               YUP
         CI,R2    '75'              7275
         BE       M75               YUP
         CI,R2    '77'              TEST FOR 3275
         BE       M77
         CI,R2    '82'              TEST FOR 3282
         BE       M82
         B        GPARAM            INVALID BRANCH
M2       LW,R0    M7202MSK          STORE CURRENT MODEL NUMBER
STORERO  STW,R0   MODEL
         SETBIT INDICATE,30
         B        NR1
M3       LW,R0    M7203MSK
         B        STORERO
M4       LW,R0    M7204MSK
         B        STORERO
M11      LW,R0    M7211MSK
         B        STORERO
MM14     LW,R0    M3214MSK
         B        STORERO
M21      LW,R0    M7221MSK
         B        STORERO
M42      LW,R0    M7242MSK
         B        STORERO
M60      LW,R0    M7260MSK
         B        STORERO
M70      LW,R0    M7270MSK
         B        STORERO
M75      LW,R0    M7275MSK
         B        STORERO
M77      LW,R0    M3277MSK
         B        STORERO
M82      LW,RO    M3282MSK
         B        STORERO
         CLOSE    M1,M2,M3,M4,M11
MARK%GRP EQU      %                 END OF GROUP PUSH MODEL NUMBER
         TESTBIT  INDICATE,OK30,30  BR IF MODEL NBR ENTERED
         LI,R6    BA(NOMODMSG)
         B        %MER
OK30     TESTBIT  INDICATE,OK18,18  BR IF DC ADR ENTERED
         LI,R6    BA(NODMSG)
%MER     BAL,R15  COMTYPE
         B        BYDATE            FORGET COMMDS
OK18     LI,R0    0
         XW,R0    MODEL
         PSW,R0   JOBSTACK          PLACE IN JOB STACK
         OFFBIT   INDICATE,18,30    RESET MODEL AND DC ENTERED
         B        NR1               CONTINUE
SETDC    EQU      %
         PUSHREG  0,0,SUBSTACK      SAVE 16 REGS
         BCS,M2   STKERROR          *TEST*
         LI,R2    0
         STW,R2   DXCNT             CLEAR SWITCH
          LI,X1     2              SET INDEX BEYOND 'DC'
         LI,R6    BA(WORK)+2        SET PTR TO ADDR
         LI,R1    4
         BAL,R15  CPTOHEX           CONVERT TO HEX
         STW,R9   INTERM            STORE
         CI,R9    X'80'             TEST FOR SHARED CONTROLLER
          BAZ       GP1            BAD NEWS IF NOT
         TIO,0    *R9               DONT PUT THIS DISC IN STACK
         BCS,12   AA1               IF UN AVAILABLE
         PSW,R9   JOBSTACK          SAVE DISC ADDR
         MTW,1     DXCNT             SET DISC UNIT PUSHED
A1       EQU      %
         LB,R8    0,R6
         CI,R8    C' '
         BNE      CX
         B        DX
SETDN    EQU      %
         PUSHREG  0,0,SUBSTACK      SAVE REGISTERS
         BCS,M2   STKERROR
         LW,R2    DENSW
         CI,R2    0                 DOES MT PRECEED DN CMMND
         BLE      DEV001            BRANCH IF NO
         LI,R2    0
         STW,R2   DENSW             RESET DENSITY SWITCH
         B        DEV005
DEV001   LI,R6    BA(TYP001)        GET BA OF MESSAGE
         BAL,R15  COMTYPE           TYPE MT MUST PRECEED DN
         PULLREG  0,0,SUBSTACK
         B        GPARAM+4          RETYPE CMMND
DEV005   EQU      %
         LI,R6    BA(WORK)+2        POINT TO BA OF CHARACTER
         LI,R1    2                 SET NO OF CHARACTERS
         BAL,R15  CPTOHEX           CONVERT TO HEX
         CI,R9    X'80'             CHECK FOR 800 BPI
         BNE      DEV010
         AI,R6    1                 INCREMENT CHAR COUNT
         BAL,R7    XTORNOT
         LI,R0     SET800           SET MPC DRIVE @800 BPI
         LI,R0    DA(M800CW)        GET CCW FOR 800 BPI
         B        DEV015            GO SET MODE TO 800 BPI
DEV010   CI,R9    X'16'             CHECK FOR 1600 BPI
         BNE      GP2
         AI,R6    2
         BAL,R7    XTORNOT
         LI,R0     SET1600          SET MPC DRIVE @1600 BPI
         LI,R0    DA(M1600CW)
DEV015   STW,R0    DENSAV           REMEMBER IT FOR MULTI-REEL DUMPS
         IOREQ     T,SET0,DIE
         PULLREG  0,0,SUBSTACK      RESTORE REGISTERS
         B        NR1
A1GX     EQU      %
         LI,R6    BA(MSGX7)         TYPE--
         BAL,R15  COMTYPE           DISC UNIT UNAVAILABLE -ONDD
         BAL,R15  PRTHEX
         STW,R11   WORK
         LI,R6    BA(WORKT)+3
         BAL,R15  COMTYPE
         TIONEW   *TYPEDEV
         STOREM   3,R2,WORK
         B        *R14
AA1      PUSHREG  0,R0,SUBSTACK
         LOADM    3,R2,WORK
         BAL,R14    A1GX
         PULLREG  0,R0,SUBSTACK
         B        A1                CONTINUE
GX1      PUSHREG  0,R0,SUBSTACK
         LW,R5    R6
         LOADM    3,R2,WORK
          BAL,R14  A1GX
         PULLREG  0,0,SUBSTACK
         B        GX                CONTINUE
CX       AI,X1    1                 BUMP INDEX PAST -
         LI,R1    4
         BAL,R15  CPTOHEX           CONVERT TO HEX
         LW,R5    R9
         CW,R5    INTERM            TEST FOR FROM LARGER THAN TO
         BL       GP1               BRANCH IF SO
         LW,R6    R5                TEST FOR GREATER
         SW,R6    INTERM            THAN
         CI,R6    15                15 RADS
         BGE      GP1               BRANCH IF SO
         LW,R6    INTERM            GET BEGIN ADDR
GX       AI,R6    1                 INCREMENT
         CW,R6    R5                TEST FOR LAST ADDR IN STACK
         BG       DX                BRANCH IF SO
         TIO,0    *R6               DONT PUT THIS DISC IN STACK
         BCS,12   GX1               IF UNAVAILABLE
         PSW,R6   JOBSTACK          PUSH THIS ADDR IN STACK
         MTW,1    DXCNT             SET DISC UNIT PUSHED
         B        GX                GO INCREMENT ADDR
GP1      EQU      %
         LW,R1    GP1DC             PLACE 'DC  ' IN ERROR MSG
         STW,R1   WORK              FOR TYPING
         B        %+3
GP2      LW,R1    GP2DN
         STW,R1   WORK
         PULLREG  0,0,SUBSTACK      RESTORE REGS
         B        GPARAM            GO TYPE ERROR MSG
DX       EQU      %
         LW,R2    DXCNT
         BEZ      BYDX              BRANCH IF NO DISC PUSHED IN STACK
         SETBIT   INDICATE,18       SET 'DC' ENTERED
         LW,R6    STACK1+2          GET FIRST DISC ADDR IN STACK
         STW,R6   DISCDEV           STORE AS CURRENT DISC DEV.
BYDX     EQU      %
         PULLREG  0,0,SUBSTACK      RESTORE REGS
         B        NR1
DECODETP LI,R2     0
         STW,R2    MPCTAPE          SET FLAG FOR REG 9T DRIVE
         LH,R2     WORK             GET 1ST 2 CHARS OF PARAM
         CI,R2    X'FD4E3'          TEST FOR -MT-
         BNE      GPARAM            BRANCH IF INVALID
DECODETP1 EQU      %
         LI,R6    X'FF'
         STW,R6   DENSW             SET DENSITY SWITCH
         LI,R6    BA(WORK)+2
         LI,R1    4
         BAL,R15  CPTOHEX
         STW,R9   TAPEDEV
         MTW,0     MPCTAPE          IS IT XT
         BEZ       NR1              S: NO..EXIT
*                                   F: YES..DOWNLOAD F/W
* NOW THAT WE'RE SURE IT'S AN MPC TAPE DRIVE AND
* WE'VE CALCULATED ITS ADDRESS, LET'S DOWNLOAD F/W TO IT
*
         PUSHREG   5,13,SUBSTACK    SAVE REGS FOR INSURANCE
         BCS,M2    STKERROR
         LCI       8                XTPOS 0-2: BOT , E-O-R , TM
         STCF      XTPOS            SET TO ->  ON    OFF     OFF
         LW,R1     TAPEDEV
         BAL,R14   MPCDWNLD         DOWNLOAD THE F/W TO MPC
         PULLREG   5,13,SUBSTACK
         B        NR1               EXIT                                DTD
PNTDIR   PUSHREG  0,0,SUBSTACK      SAVE REGS
         BCS,M2   STKERROR          ***TEST**BRANCH IF PUSH ABORTED
         BAL,R15   DIR%READ         READ DIRECTORY IN FROM TAPE
         LI,R6    BA(DIRMSG1)       MSG ADDR
         BAL,R15  COMTYPE           TYPE 'DIRECTORY OF CONTENTS'
         LI,R6    BA(DIRMSG2)
         BAL,R15  COMTYPE           TYPE 'TAPE CREATED--MM/DD/YY'
         LI,R6    BA(CNTDIR)+3      MSG ADDR
         BAL,R15  COMTYPE           TYPE DATE PORTION OF ABOVE MSG
PWRD     PLW,R9   DIRSTACK          PULL WORD FROM STACK
         BCS,M2   DIRCOM            BRANCH IF LAST WORD PULLED
         LW,R9    R9                TEST FOR MODEL NBR FLAG
         BCS,1    PRT%MOD           BR IF MODEL NBR
         BAL,R15  PRTHEX            CONVERT RAD UNIT ADDRESS FOR TYPING
         LI,R6    1
         STW,R11  DIRMSG5,R6        STORE CONVERTED ADDR IN MSG
         LI,R6    BA(DIRMSG5)       TYPE
         BAL,R15  COMTYPE           ADDR
         TIONEW   *TYPEDEV
         B        PWRD              BRANCH TO TYPE NEXT JOB
PRT%MOD  EQU      %
         LI,R6    5
         STH,R9   DIRMSG4,X6        MODEL NBR TO MSG
         LI,R6    BA(DIRMSG4)
         BAL,R15  COMTYPE           TYPE
         B        PWRD              CONTINUE
DIRCOM   PULLREG  0,0,SUBSTACK      RESTORE REGS
         AI,X1    1                 INCREMENT PAST COMMA
         B        CR                RETURN
KARD1    EQU      %
         TESTBIT  INDICATE,BEGIN,11  ABORT IF ERROR ON CARD
         TIO,R1   *CARDDEV          TEST CARD READER
         BCS,4    DEADCR            BRANCH IF NOT AVAIL
         LC       R1                GET STATUS BITS 0-3 FOR TEST
         BCS,4    DEADCR            BRANCH IF BUSY
         BCR,1    DEADCR            BRANCH IF MANUAL
*                                   NOTE-2120 CARD READER RESETS TO
*                                   MANUAL MODE WHEN BUSY
         LI,R0    DA(RDCOMMD)       COMMD
         SIO,R0   *CARDDEV          READ
         BIOSNS   KARD1             BRANCH IF START RAD
KARD3    TIO,R1   *CARDDEV
         TESTBIT  R1,KARD3,1        BRANCH IF READER BUSY
         B        CONT1             GO DECODE THIS CARD
DEADCR   EQU      %
         OFFBIT   INDICATE,21       RESET CARD INPUT
         LI,R6    BA(MSGBCR)
         BAL,R15  COMTYPE           TYPE 'CR BAD'
         B        BYDATE
END      TESTBIT  INDICATE,ENDER,14 BRANCH IF KEY-IN ERROR
         B        GOEND             NO ERRORS BRANCH
ENDER    OFFBIT   INDICATE,14       TURN OFF KEY-IN ERROR
         B        CONTPRMS          GET NEW PARAM
GOEND    EQU      %
         LW,R0    INDICATE
         CI,R0    1
         BCR,4    GOEND2            BR IF JOB NOT RECEIVED
         LI,R0    0
         MSP,R0   JOBSTACK          TEST FOR NO DC OR # KEY-IN
         BCS,1    STACK%EMPTY       BR IF SO
         LW,R1    *JOBSTACK         TEST FOR # NOT YET PUSHED
         BLZ      SET04             BR IF NO MODEL
* WE HAVE DISC IN JOBSTACK AND MODEL NBR AT LOCATION MODEL
MOD%NOW  XW,R0    MODEL             CLEAR MODEL AND GET KEY-IN
         BEZ      SET04
         PSW,R0   JOBSTACK          SET IN STACK
         B        JOBTAB            GO RUN
STACK%EMPTY  EQU  %
         LW,R1    DISCDEV           SET DISC DEFAULT IN STACK
         PSW,R1   JOBSTACK
SET04    EQU      %
         LW,R0    MODEL
         BNEZ     MOD%NOW+1
         LW,0     M7204MSK          NO MODEL SUPPLIED
         B        MOD%NOW+1         USE DEFAULT
GOEND2   EQU      %
         TESTBIT  INDICATE,BEGIN,21 BRANCH IF CARD READER IS INPUT
         B        BYDATE            GO GET JOB (COPY,COMP OR REST)
JOBTAB   EQU      %
         LW,R2    TIME
         STW,R2   PRETIME
         LB,X2    INDICATE          GET JOB CODE FROM INDICATE
         SLS,X2   -4                SHIFT TO LSD
         B        JOBTABLE,X2       BRANCH TO JOB TABLE
JOBTABLE EQU      %
         B        JOBDT             EXIT FOR COPY
         B        JOBREST                    RESTORE
         B        JOBREST           COMPARE
         PAGE
         TITLE     'DOWNLOAD F/W TO MPC'
MPCDWNLD EQU      %
         LI,R15   NTRIES
MPCDWN1  HIO,0    *R1               HALT THE MPC
         LI,R0    XRESET            RESET IOCD
         IOREQ     T,SET0,MPCBAD    RESET THE MPC
         LI,R13    500000
         BDR,R13   %                LONG DELAY TO INSURE IOC
*
         LI,R0    ROS:LD            ROS
         IOREQ     T,SET0,MPCBAD    WRITE ROS MEMORY
         IOREQ     T,WTE,MPCBAD     WAIT FOR IOC
         TIO,R13   *R1
         TESTBIT   R13,MPCBAD,4     DEVICE UNUSUAL END
*
         LI,R0    RW:LD             R/W
         IOREQ     T,SET0,MPCBAD    WRITE R/W MEMORY
         IOREQ     T,WTE,MPCBAD     WAIT FOR IOC
         TIO,R13   *R1
         TESTBIT   R13,MPCBAD,4     DEVICE UNUSUAL END
*
         LI,R13    500000
         BDR,R13   %                WAIT FOR CONTROLLER-READY
         IOREQ     T,REW,DIE        CAN'T ISSUE A SET DENSITY AT
         IOREQ     T,WTE,DIE        OTHER THAN LOAD POINT
*
         LI,R0     SET800
         LW,R2     DENSAV           DID USER SPEC 'DN' OPTION?
         BEZ       SETDENS          S: NOPE..
         CI,R2     DA(M800CW)       F: YUP..WHICH?
         BE        SETDENS             800 BPI
         LI,R0     SET1600            1600 BPI
SETDENS  EQU       %
         IOREQ     T,SET0,DIE
         IOREQ     T,WTE,DIE
         B         *R14             RETURN    NORMALLY
*
MPCBAD   EQU      %
         BDR,R15  MPCDWN1
*        AT THIS POINT, AN ERROR CONDITION EXISTS WHICH
*        PERSEVERED AFTER 10 RETRIES...
*        OC GETS ERROR MSG, CPU WAITS, OPERATOR CAN
*        THEN TURN ON MPC, CLEAR WAIT AND ALL IS WELL...
*        IF IT WAS A REAL ERR, IT'LL REAPPEAR
*
MPCERR   EQU       %
         LI,R6     BA(CANTXLD)      ' CANT LOAD MPC'
         BAL,R15   MSG
         B         ABORT
CANTXLD  TEXTC     ' CANT LOAD MPC'
*
         TITLE    'CALL PSD AND ENTRY POINTS'
****                                                                    DTD
*  ***            CALL DIRECTOR                                         DTD
****                                                                    DTD
         BOUND    8
C1OLDPSD DATA,8   0                                                     DTD
C1NEWPSD GEN,8,7,17,8,24  7,0,CALL1,5,0
C2OLDPSD DATA,8   0                                                     DTD
C2NEWPSD GEN,8,7,17,8,24  7,0,CALL2,5,0
         SPACE    2                                                     DTD
*                 BRANCH TABLE FOR CALL 1 FUNCTIONS                     DTD
CALL1    EQU      %
         B       T:BSR        0     BACKSPACE RECORD
         B       T:RD1        1     READ TAPE TO BUFFER 1
         B       T:RD2        2     READ TAPE TO BUFFER 2
         B       T:WRT1       3     WRITE TAPE FROM BUFFER 1
         B       T:WRT2       4     WRITE TAPE FROM BUFFER 2
         B       T:WTE        5     WAIT FOR TAPE COMPLETION
         B       T:SET0       6     DO COMMAND LIST POINTED TO THRU R0
         B       T:REW        7     REWIND TAPE
         B       T:ERG        8     SET ERASE
         B       T:FSF        9     FORWARD SPACE FILE
         B       T:WTM       10     WRITE TAPE MARK
         B       T:FSR       11     FORWARD SPACE RECORD
         SPACE    3                                                     DTD
*                 BRANCH TABLE FOR CALL 2 FUNCTIONS                     DTD
CALL2    EQU      %
         B       D:CHK1       0     CHECKWRITE BUFFER 1
         B       D:RD1        1     READ DISC TO BUFFER 1
         B       D:RD2        2     READ DISC TO BUFFER 2
         B       D:WRT1       3     WRITE DISC FROM BUFFER 1
         B       D:WRT2       4     WRITE DISC FROM BUFFER 2
         B       D:WTE        5     WAIT FOR DISC COMPLETION
         B       D:SET0       6     DO COMMAND LIST POINTED TO THRU R0
         B       D:CHK2       7     CHECKWRITE BUFFER 2
         TITLE    'CALL 1 ROUTINES. TAPE OPERATIONS'
T:SET0   EQU     %
         STW,R0    SET0:NODE
         BAL,R7    FORKIFXT
SET0:NODE RES      1
         RETURNTO FREEDEV
         LW,R7    *C1OLDPSD         SAVE
         STW,R7   TAPEREC           ERROR RETURN ADDR
         MTW,M1   C1OLDPSD          INCREMENT RETURN
         B        RWCOMSIO          GO INSSUE COMMAND
T:BSR    EQU     %
         BAL,R7    FORKIFXT
         NODEIS   XBSR
         RETURNTO FREEDEV
         BAL,R15  RTNTIO            TEST STATUS
         LI,R0    DA(BSRCW)         GET COMMND ADDR                     DTD
         B        COMSIO            GO ISSUE COMMND                     DTD
T:FSR    EQU     %
         BAL,R7    FORKIFXT
         NODEIS   XFSR
         RETURNTO FREEDEV
         BAL,R15  RTNTIO            TEST STATUS
         LI,R0    DA(FSRCW)         GET COMMD ADDR
         B        COMSIO            GO ISSUE COMMD
T:REW    EQU     %
         BAL,R7    FORKIFXT
         NODEIS   RON
         RETURNTO FREEDEV
         BAL,R15  RTNTIO            TEST STATUS
         TDV,R13  *TAPEDEV          GET TAPE POSITION                   DTD
         TESTBIT  R13,CAL1RET,5     BRANCH IF TAPE AT LOAD POINT
         LI,R0    DA(REWCW)         GET COMMD ADDR
         B        COMSIO            TAPE NOT AT L.P. REWIND ON LINE     DTD
T:ERG    EQU     %
         BAL,R15  RTNTIO            TEST STATUS
         LI,R0    DA(ERGCW)         COMMD ADDR
         B        COMSIO            GO ISSUE COMMD                      DTD
T:FSF    EQU     %
         BAL,R7    FORKIFXT
         NODEIS   XFSF
         RETURNTO FREEDEV
         BAL,R15  RTNTIO            TEST STATUS
         LI,R0    DA(FSFCW)         COMMD ADDR                          DTD
         B        COMSIO            ISSURE COMMD                        DTD
T:WTM    EQU     %
         BAL,R7    FORKIFXT
         NODEIS   TM
         RETURNTO FREEDEV
         BAL,R15  RTNTIO            TEST STATUS
         LI,R0    DA(WTMCW)         COMMD ADDR                          DTD
         B        COMSIO            ISSUE COMMD                         DTD
T:WTE    EQU     %
         PUSHREG   1,15,SUBSTACK
         MTW,0     MPCTAPE
         BEZ       %+3
         LW,R15    CALLINGX
         BNEZ      %-1              LOOP SOLID TILL LAST NODE DONE
         BAL,R15  RTNTIO            TEST STATUS
         TDV,R11  *TAPEDEV          GET TDV STATUS
         PULLREG   1,15,SUBSTACK
CAL1RET  LPSD,0   C1OLDPSD          RETURN
T:RD1    EQU     %
         BAL,R7   FORKIFXT
         NODEIS   READBUF1
         RETURNTO FREEDEV
         LW,R7    *C1OLDPSD         GET ERROR RECOVERY RTN ADDR FROM CAL
         STW,R7   TAPEREC           SAVE
         BAL,R15  RTNTIO            GET TAPE STATUS
         SETBIT   INDICATE,4        SET READ TO BUFFER 1 IN PROGRESS
         LI,R0    DA(RDBUF1CW)      COMMD ADDR                          DTD
         B        RWCOMSIO          GO ISSUE SIO                        DTD
T:RD2    EQU     %
         BAL,R7   FORKIFXT
         NODEIS   READBUF2
         RETURNTO FREEDEV
         LW,R7    *C1OLDPSD         GET ERROR RECOVERY RTN ADDR FROM CAL
         STW,R7   TAPEREC           SAVE
         BAL,R15  RTNTIO            GET TAPE STATUS
         SETBIT   INDICATE,5        SET READ TO BUFFER 2 IN PROGRESS
         LI,R0    DA(RDBUF2CW)      COMMD ADDR                          DTD
         B        RWCOMSIO          GO ISSUE SIO                        DTD
T:WRT1   EQU     %
         BAL,R7   FORKIFXT
         NODEIS   RITEBUF1
         RETURNTO FREEDEV
          LW,R7     *C1OLDPSD      GET ERR RETURN ADDR
          STW,R7    TAPEREC           FROM CAL1-OLD-PSD
          BAL,R15   RTNTIO         ...THEN GET DEVICE STATUS
         TDV,R11  *TAPEDEV          GET TDV STATUS
         TESTBIT  R11,NEWREEL,6     BRANCH IS END-OF-REEL
         SETBIT   INDICATE,6        SET WRITE FROM BUFFER 1 IN PROGRESS
         LI,R0    DA(WRTB1CW)       COMMD ADDR
         B        RWCOMSIO          GO ISSUE SIO
T:WRT2   EQU     %
         BAL,R7   FORKIFXT
         NODEIS   RITEBUF2
         RETURNTO FREEDEV
          LW,R7     *C1OLDPSD      GET ERR RETURN ADDR
          STW,R7    TAPEREC           FROM CAL1-OLD-PSD
          BAL,R15   RTNTIO         ...THEN GET DEVICE STATUS
         TDV,R11  *TAPEDEV          GET TDV STATUS
         TESTBIT  R11,NEWREEL,6     BRANCH IF END-OF-REEL
         SETBIT   INDICATE,7        SET WRITE FROM BUFFER 2 IN PROGRESS
         LI,R0    DA(WRTB2CW)       COMMD ADDR
         B        RWCOMSIO          GO ISSUE SIO
*
NEWREEL  LI,R0    DA(WTMCW)         GET WRITE TM COMMD
         SIO,R0   *TAPEDEV          WRITE 1 TAPE MARK
         TIONEW   *TAPEDEV
         LI,R0    DA(EORCW)         GET TRAILER LAB COMMD
         SIO,R0   *TAPEDEV          WRITE '!!EOR
         TIONEW   *TAPEDEV
         LI,R0    DA(WTMCW)         WRITE TAPE MARK COMMD
         LI,R7    -2                SET TO WRITE 2 TAPE MARKS
NEWSIO   SIO,R0   *TAPEDEV          WRITE TAPE MARK
         TIONEW   *TAPEDEV
         BIR,R7   NEWSIO            WRITE TAPE MARK TWICE
         LI,R0    DA(OFFLINE)
         SIO,R0   *TAPEDEV          REWIND THIS TAPE OFF LINE
NEWREEL1 EQU      %
         LI,R6    BA(MSGY4)         MSG ADDRESS
         BAL,R15  COMTYPE           TYPE 'END OF REEL. ASSIGN NEW TAPE'
         BAL,R15  COMREAD           ACCEPT NEW TAPE ASSIGNMENT
         LI,R6    BA(INPUT)         SET PTR TO INPUT
         LB,R0    0,R6              EXAMINE FIRST CHAR
         CI,R0    C'M'              CHECK FOR MTXXX
         BNE       %+4              S: NOT -MT- KEYIN
* IF ONLY DEVICE ADDRESS IS KEYED-IN, TAPE DRIVE TYPE (WHETHER MPC
* OR NOT) IS ASSUMED UNCHANGED FROM PREVIOUS DRIVE
         LI,R15    0                F: -MT- SO
         STW,R15   MPCTAPE             SET FLAG TO REG 9T
         B         ADJ              PTR -> DEV ADDR
         CI,R0     C'X'             COULD BE XT REASSIGNMENT
         BNE       NOADJ            S: NO..ADDR BEGINS COL 1
         LI,R15    1
         STW,R15   MPCTAPE          SET FLAG FOR XT
ADJ      AI,R6     2                ADJ PTR PAST 'MT'/'XT'
NOADJ    EQU       %
         LI,R1    4
         BAL,R15  CPTOHEX           CONVERT TO HEX
         STW,R9   TAPEDEV           STORE
         MTW,0    MPCTAPE
         BEZ      DONTLOAD
* IF NEW MPC TAPE DRIVE HAS BEEN ENTERED..DOWNLOAD F/W TO IT
         PUSHREG   5,13,SUBSTACK    INSURANCE
         BCS,M2   STKERROR
         LD,R0     C1OLDPSD         MPCDWNLD CLOBBERS IT SO SAVE..
         AI,R0     -1               ADJUST TO POINT TO CAL1
         STD,R0    C1OLDSAV
         LCI       8                XTPOS 0-2: BOT , E-O-R , TM
         STCF      XTPOS            SET TO ->  ON    OFF     OFF
         LW,R1     TAPEDEV
         BAL,R14   MPCDWNLD         DOWNLOADS F/W TO MPC
         PULLREG   5,13,SUBSTACK    RESTORE REGS
DONTLOAD EQU      %
         MTW,-1   C1OLDPSD          DECREMENT RETURN TO POINT TO CAL1
         OFFBIT   IND,25                 TURN OVERLAP OFF
         LW,R0    TAPEDEV           CHECK IF TAPE AND
         LI,R1    X'1F00'            DISC ARE ON THE
         CS,R0    DISCDEV             SAME IOP
         BE       NEWTP
         SETBIT   IND,25            NO - SET OVERLAP ON
NEWTP    EQU     %
         BAL,R7    XTORNOT
         B         XREISSUE
         LW,R0     DENSAV           WAS A DENSITY SPECIFIED?
         BEZ       %+2              S: NO..DON'T SET ANY.
         SIO,R0    *TAPEDEV         F: Y..SET NEW REEL TO SAME DENS
         TDV,R5   *TAPEDEV          GET DEVICE STATUS
         TESTBIT  R5,REISSUE,5      BRANCH IF AT LOAD POINT
         LI,R0    DA(REWCW)         REWIND COMMD
         B        COMSIO            BRANCH TO REWIND NEW TAPE
XREISSUE PULLREG   0,0,SUBSTACK
         LPSD,0    C1OLDSAV
REISSUE  EQU      %
         LPSD,0   C1OLDPSD          RETURN TO CAL1
         TITLE    'CALL 2 ROUTINES. DISC OPERATIONS'
*                                   DISC ROUTINES
*
D:CHK1   EQU     %
         TESTBIT  INDICATE,WRT1ACK,8,9 BRANCH IF DISC BUSY
         SETBIT   INDICATE,8,23     SET BUFFER 1 BUSY & CHK-WRT
         LW,R0    BUF1WRD4
         STW,R0   DISCDEV           PLACE DISC ADDR IN DEV TABLE
         LW,R0    %+4               GET ORDER AND DATA ADDRESS
         STW,R0   BUF1CW2           STORE IN COMMD LIST
         LI,R0    DA(BUF1CW1)       ADDR OF COMMD LIST
         B        %+2
         GEN,8,24 5,BA(BUF1DATA)    CHECK-WRITE BUFFER 1
         STW,R0   CWSAV             SAVE R0
         B        DISC              GO ISSUE SIO
WRT1ACK  EQU      %
         LI,R2    D:CHK1            SET RETURN TO RETRY
         B        DISCWAIT
D:CHK2   EQU     %
         TESTBIT  INDICATE,WRT2ACK,8,9  BRANCH IF DISC BUSY
         SETBIT   INDICATE,9,23     SET BUFFER 2 BUSY & CHK-WRT
         LW,R0    BUF2WRD4
         STW,R0   DISCDEV           PLACE DISC ADDR IN DEV TABLE
         LW,R0    %+4               GET ORDER AND DATA ADDRESS
         STW,R0   BUF2CW2           STORE IN COMMD LIST
         LI,R0    DA(BUF2CW1)       ADDR COMMAND LIST
         B        %+2
         GEN,8,24  5,BA(BUF2DATA)   CHECK-WRITE BUFFER 2
         STW,R0   CWSAV             SAVE R0
         B        DISC              GO ISSUE SIO
WRT2ACK  EQU      %
         LI,R2    D:CHK2            SET RETURN TO RETRY
         B        DISCWAIT
D:RD1    EQU     %
         TESTBIT  INDICATE,RDISC1,8,9 BRANCH IF DISC BUSY
         SETBIT   INDICATE,8        SET DISC BUSY
         LW,R0    %+4               GET ORDER CODE AND DATA ADDR
         STW,R0   BUF1CW2           STORE IN COMMD LIST
         LI,R0    DA(BUF1CW1)       ADDR OF COMMD LIST
         B        %+2
         GEN,8,24  18,BA(BUF1DATA)    READ RAD INTO BUFFER 1
         STW,R0   CWSAV             SAVE R0
         B        DISC              GO ISSUE SIO
RDISC1   EQU      %
         LI,R2    D:RD1             SET RETURN TO RETRY
         B        DISCWAIT
D:RD2    EQU     %
         TESTBIT  INDICATE,RDISC2,8,9  BRANCH IF DISC BUST
         SETBIT   INDICATE,9        SET DISC BUSY
         LW,R0    %+4               GET ORDER CODE AND DATA ADDR
         STW,R0   BUF2CW2           STORE IN COMMAND LIST
         LI,R0    DA(BUF2CW1)       ADDR OF COMMD LIST
         B        %+2
         GEN,8,24  18,BA(BUF2DATA)   READ RAD INTO BUFFER 2
         STW,R0   CWSAV             SAVE R0
         B        DISC              GO ISSUE SIO
RDISC2   EQU      %
         LI,R2    D:RD2             SET RETURN TO RETRY
         B        DISCWAIT
D:WRT1   EQU     %
         TESTBIT  INDICATE,WRT1A,8,9 BRANCH IF DISC BUSY
         SETBIT   INDICATE,8          SET DISC BUSY
         LW,R0    BUF1WRD4
         STW,R0   DISCDEV
         LW,R0    %+4               GET ORDER CODE AND DATA ADDR
         STW,R0   BUF1CW2           STORE IN COMMD LIST
         LI,R0    DA(BUF1CW1)       ADDR OF COMMD LIST
         B        %+2
         GEN,8,24  1,BA(BUF1DATA)   WRITE FROM BUFFER 1
         STW,R0   CWSAV             SAVE R0
         B        DISC              GO ISSUE SIO
WRT1A    EQU      %
         LI,R2    D:WRT1            SET RETURN TO RETRY
         B        DISCWAIT          GO WAIT FOR DISC TO FREE UP
D:WRT2   EQU     %
         TESTBIT  INDICATE,WRT2A,8,9  BRANCH IF DISC BUSY
         SETBIT   INDICATE,9          SET DISC BUSY
         LW,R0    BUF2WRD4
         STW,R0   DISCDEV
         LW,R0    %+4               GET ORDER CODE AND DATA ADDR
         STW,R0   BUF2CW2           STORE IN COMMD LIST
         LI,R0    DA(BUF2CW1)       ADDR OF COMMD LIST
         B        %+2
         GEN,8,24  1,BA(BUF2DATA)   WRITE FROM BUFFER 2
         STW,R0   CWSAV             SAVE R0
         B        DISC              GO ISSUE SIO
WRT2A    EQU      %
         LI,R2    D:WRT2            SET RETURN TO RETRY
         B        DISCWAIT          GO WAIT FOR DISC TO TERM
D:WTE    EQU     %
WTEDSK   EQU      %                 WAIT FOR DISC TO TERM
         TESTBIT  INDICATE,WTEDSK1,8,9  BRANCH IF DISC BUSY
         MTW,M1   C2OLDPSD          INCREMENT RETURN
         LPSD,0   C2OLDPSD          NO--DISC FREE RETURN
WTEDSK1  LI,R2    WA(WTEDSK)        DISC BUSY SET RETURN FOR NEW TEST
DISCWAIT EQU      %                 WAIT FOR DISC INTERRUPT
          WD,R0     ALLOW
         WAIT     0
TIO:     LI,R13    X'30'
         BDR,R13   %
         TIO,R13  *DISCDEV
         BCS,12   TIO:              BR TO WAIT IF BSY
         B        *R2               RETURN
*
D:SET0   EQU     %
DISC     EQU      %                 PERFORM DESIRED OPERATION
         LW,R9    DISCDEV
         CW,R9    RDISC
         BNE      TYPDV
         LW,R9    DDEV
         STW,R9   DISCDEV
DVP1     EQU     %
         LW,R0    CWSAV             RESTORE R0
         LW,R3    *C2OLDPSD         GET ERROR RECOVERY ADDR
         STW,R3   DISCREC           SAVE RECOVERY ADDR
         SIO,R0   *DISCDEV          ISSUE ORDER
         BCS,M4   TSTBSYD           TEST FOR NO ADDRESS RECOGINITION
         BCR,M12  GOODDISC          EXIT IF GOOD START
         BCS,M8   BUSYY1            WAIT IF SELECTOR IOP BYSY
*        WE WILL NEVER FALL THRU THE ABOVE BRANCH TABLE
TSTBSYD  BCR,M8   BUSYY1            FALL THROUGH IF NO ADDR RECOG
         LI,R6    BA(MSGX7)         GET MESSAGE ADDR
         BAL,R15  COMTYPE           TYPE 'DISC UNIT UNAVAILABLE'
         LW,R9    DISCDEV           GET DISC UNIT
         BAL,R15  PRTHEX            ADDRESS
         STW,R11  WORK              CONVERTED
         LI,R6    BA(WORKT)+3       AND
         BAL,R15  COMTYPE           TYPED FOLLOWING MSG
         LI,R6    BA(MSGX6)         GET 2ND MESSAGE ADDR
         BAL,R15  COMTYPE           TYPE 'JOB ABORTED'
         B        BYLABL            ABORT
BUSYY1   BAL,R2   DISCWAIT          GO WAIT FOR BUSY TO CLEAR
         B        DISC              NOW TRY OPERATION
GOODDISC EQU      %
         LW,R0    DISCDEV
         STW,R0   DDEV
         MTW,M1   C2OLDPSD          INCREMENT RETURN
         LPSD,0   C2OLDPSD          RETURN
TYPDV    EQU      %
         STW,R9   RDISC
         LB,R15    IND              IS IT A RESTORE OR COMPARE?
         BEZ       ACOPY            NO..LEAPFROG
*        NOW WE HAVE A NEW DISC ADDRESS
*        CAPTURE THE CORRES MODEL-SPECIFIC INFO TABLE
         PLW,R15   WRKJOBSK         C(R15)=ADDR OF THAT MODEL #'S TBL
         BCS,2     STKERROR         SHOULD HAVE MODEL # FOR EACH DEV
         PUSHREG   11,2,SUBSTACK    SAVE 'EM
         LCI       11
         LM,2      *R15
         STM,2     LOSEEK           PUT TBL IN PLACE
         PULLREG   11,2,SUBSTACK    RESTORE REGS
ACOPY    RES
         TESTBIT  IND,OVRRD,16
         BAL,R15  PRTHEX
         LI,R15    21
         STB,R15   R11
         STW,R11  WORK
         LI,R6    BA(WORKT)+3
         BAL,R15  COMTYPE           TYPE NEW DISC ADDR
OVLP1    EQU      %
         OFFBIT   INDICATE,25           TURN OFF OVERLAP BIT
         LW,R0    TAPEDEV           CHECK IF TAPE AND
         LI,R1    X'1F00'            DISC ARE ON THE
         CS,R0    DISCDEV             SAME IOP
         BE       DVP1
         SETBIT   INDICATE,25       NO - SET OVERLAP BIT
         B        DVP1
OVRRD    EQU      %
         BAL,R15  PRTHEX
         LI,R15   X'15'
         STB,R15  R11
         STW,R11  WORK
         LI,R6    BA(WORKT)+3
         BAL,R15  COMTYPE
         LI,R6    BA(REQDC)
         BAL,R15  COMTYPE
         BAL,R15  COMREAD
         LI,R6    BA(INPUT)
         LI,R1    4
         BAL,R15  CPTOHEX
         STW,R9   DISCDEV
         B        OVLP1
         TITLE    'SUB-ROUTINES'
* *
*   *             SUB-ROUTINE TO NOTIFY OPERATOR OF DEFECTIVE PARAM
* *
GPARAM   EQU      %
         LI,R6    BA(MSGX9)         GET MSG ADDR
         BAL,R15  COMTYPE           TYPE CANNOT DECODE PARAM'
         LI,R6    BA(WORKT)+3       MSG ADDR
         BAL,R15  COMTYPE           TYPE PARAM THAT CANNOT BE DECODED
         SETBIT   INDICATE,14       SET TYPE-IN ERROR
         TIONEW   *TYPEDEV
         AI,X1    1                 BUMP INDEX PAST CURRENT COMMA
         B        CR                GO TO NEXT COMMD
         SPACE    3
* *
*   *             SUB-ROUTINE TO MOVE BLANKS TO WORK AREA
* *
BLNKWRK  EQU      %
         LOADM    3,6,BLANK         GET 3 WORDS OF BLANKS
         STOREM   3,6,WORK          STORE IN WORK AREA
         STOREM   3,6,WORK+3
         STOREM   3,6,WORK+6
         B        *R15              RETURN
         SPACE    3
* *
*   *             SUB-ROUTINE TO CONVERT 4 BYTES OF HEX DIGITS TO 8
*   **            8BYTES OF PRINTABLE EBCDIC. THE 4 BYTES TO CONVERT
*   *             ARE IN REG 9. 8 BYTES OF EBCDIC WILL BE IN R10 & R11
* *
PRTHEX   EQU      %
         PUSHREG  14,12,SUBSTACK
         BCS,M2   STKERROR          *TEST*
         LI,X1    0                 SET
         LI,X2    8                 INDEXES
XD1      LI,R8    0                 CLEAR R8
         SLD,R8   4                 GET MSD FROM R9 INTO R8 LSD
         CI,R8    9                 TEST FOR NUMERIC
         BG       %+2               BRANCH IF A-F
         AI,R8    57                ADD 57 AND 183 IF NUMERIC
         AI,R8    183               ADD 183 FOR ALPHA
         STB,R8   R10,X1            STORE RESULTS IN R10 & R11
         AI,X1    1                 BUMP OUTPUT INDEX
         BDR,X2   XD1               CONVERT 8 DIGITS FOR PRINTING
         STD,R10  WORK
         PULLREG  14,12,SUBSTACK
         B        *R15              RETURN
         TITLE    'SET UP DEFAULT VALUES'
PRESET   EQU      %                 SET DEFAULT OPTIONS + INITILIZE
         LI,R1    4144              ARM & ENABLE
         WD,R1    4608              ALL INTERRUPTS
         LI,R1    0
         STW,R1   BUF1WRD2
         STW,R1   DDEV
         STW,R1   RDISC
         STW,R1   BUF2WRD2          CLEAR SEEK ADDR
         LOADM    11,1,M7204
         STOREM   11,1,LOSEEK       SET TO MOD 7204 RAD
         STW,R1   RETRYTP           ZERO
         STW,R1   TAPECOUT
         STW,R1   DISCOUNT
         STW,R1   DRTRY
         LOADM    2,2,PDISC         SET
         STOREM   2,2,DISCDEV       I/O ADDR
         LW,R2    X'25'             LOOK AT BOOT DEV ADR
         CI,R2    X'80'             CHECK IF MULTI-DEV CONTR
         BAZ      %+2               NO - LEAVE DEFAULT TAPE AT 80
         STW,R2   TAPEDEV           YES - PUT BOOT DEV TO DEFAULT TAPE
         LD,R2    PJOBSTK           SET
         STD,R2   JOBSTACK          JOB STACK
         LD,R2    PWRKSTK           POINTERS
         STD,R2   WRKJOBSK          TO EMPTY STACKS
         LD,R2    ALTSUB
         STD,R2   SUBSTACK
         B        *R15              RETURN
         SPACE    3
         TITLE    'SEEK ADDRESS INCREMENT ROUTINES'
**
* **              SEEK ADDRESS INCREMENT RTN FOR MOD.S 2,3 AND4
**
*                 WHEN THIS ROUTINE IS ENTERED REG 14 CONTAINS ADDR OF
*                 BUFFER THE INCREMENTED ADDR IS TO BE PLACED.
*                 REG. 15 CONTAINS THE RETURN ADDRESS
INC234   EQU      %
         PUSHREG  3,R1,SUBSTACK
         LW,R2    CURRSEEK          GET LAST USED SEEK ADDR
         AW,R2    INCREMNT          INCREMENT
         CW,R2    HISEEK            CHECK IF ALL DISC DONE
         BGE      STOP              YES STOP
         LW,R1    COUNT             NO  SET UP DISC
         LI,R3    X'4E'                 COMMANDS
         B        PSTCNT1
**
* *               SEEK ADDRESS INCREMENT RTN FOR MODEL 7212
*
INC11    EQU      %
         PUSHREG  3,R1,SUBSTACK
         LW,R3    =127*256*256      LOAD MASK
         LW,R2    CURRSEEK          GET LAST USED SEEK
         AW,R2    INCREMNT          INCREMENT
         CS,R2    =82*256*256       TEST IF TRACK OVERFLOW
         BGE      TRKINC            YES
         CW,R2    =(63**23)+(78**16)  CHECK IF ON LAST TAPE RECORD
         BNE      INCCNT            NO  CONTINUE
         LI,R1    4*1024            YES LOAD SHORT COUNT
         B        PSTCNT            CONTINUE
INCCNT   EQU      %
         LW,R1    COUNT             SET UP DISC COMMANDS
PSTCNT   LI,R3    X'1E'
PSTCNT1  STB,R3   R1
         STW,R1   *R14
         AI,R14   1
         STW,R2   CURRSEEK          STORE NEW SEEK ADDR
         STW,R2   *R14
         B        CONT
TRKINC   EQU      %
         AW,R2    =128*256*256-82*256*256   FIX SEEK ADDR
         CW,R2    HISEEK            CHECK IF DISC ALL DONE
         BGE      STOP              YES STOP
         B        INCCNT            NO  CONTINUE
STOP     EQU      %
         SETBIT   IND,20            SET BIT THAT DISC COMPLETED
CONT     PULLREG  3,1,SUBSTACK      RESTORE REGS
         B        *15               RETURN
**
* *               SEEK ADDRESS INCREMENT ROUTINE FOR MODEL 7232
**
INC21    EQU      %
         PUSHREG  3,R1,SUBSTACK
         LW,R2    CURRSEEK          GET LAST USED SEEK
         AW,R2    INCREMNT          INCREMENT
         CW,R2    HISEEK            CHECK IF ALL DISC DONE
         BGE      STOP              YES STOP
         B        INCCNT            NO CONTINUE
*
**  7242 SEEK ADDR INCREMENT ROUTINE
**  ALSO WORKS FOR 7260 AND 7270 AND 7275
*
INC60    EQU      %
INC70    EQU      %
INC75    EQU      %
INC42    EQU      %
INC77    EQU      %
INC82    EQU      %
         PUSHREG  3,R1,SUBSTACK
         LW,R2    CURRSEEK          PICK UP LAST USED SEEK
         LI,R3    255*256           LOAD MASK
         AW,R2    INCREMNT          INCREMENT SEEK
         LW,R1    HISEEK            SPECIAL
         CW,R1    M7275+1           FOR 7275
         BE       INC75X            BECAUSE OF TRACKS/CYL=19
         CW,R1    M3275+1           CHECK FOR DISK 33
         BE       INC77X            BRANCH IF YES
         CW,R1    M3282+1           CHECK FOR DISK 66?
         BE       INC82X            BRANCH IF YES
         CS,R2    =20*256           CHECK IF TRACK OVERFLOW
         BL       INCCNT            NO-EXIT
         AW,R2    =256*256-20*256   FIX SEEK ADDR
INC42X   EQU      %
         CW,R2    HISEEK            CHECK IF THRU
         BL       INCCNT            NOT THRU - CONTINUE
         B        STOP              THRU
INC75X   EQU      %
INC77X   EQU      %
INC82X   EQU      %
         CS,R2    =19*256           CHECK IF TRACK OVERFLOW
         BL       INCCNT            NO-EXIT
         AW,R2    =256*256-19*256   FIX SEEK ADDRESS
         B        INC42X            AND RESUME IN COMMON CODE
         TITLE    'TAPE SUBROUTINES'
*                 TAPE SUB-ROUTINES
*
RTNTIO   EQU      %                 TEST TAPE STATUS
         MTW,M1    C1OLDPSD         INCREMENT RETURN
         PUSHREG  0,0,SUBSTACK      SAVE REGS
         BCS,M2   STKERROR          *TEST*
RTIO     EQU      %
         LI,R10   X'30'
         LI,R13   0
         TIO,R13  *TAPEDEV          ISSUE TIO
         BDR,R10  %
         BCR,M12  TIOOK             BRANCH IF AVAILABLE
         BCS,M8   TSB               BRANCH IF POSSIBLE SIOP BUSY
         BCS,M4   TIOOK             BRANCH IF DEVICE BUSY
TSB      BCR,M4   RTIO              BRANCH IF SOIP IS BUSY
         B        BADTIO            BRANCH--NO ADDR RECOG.
TIOOK    EQU      %
         LB,R7    R13               GET BITS 0-7 FROM TIO REG TO TEST
         CI,R7    128               TEST FOR BUSY OR INTERRUPT PENDING
         BCS,M4   TIOWAIT           BRANCH IF SO
         CI,R7    16                TEST FOR AUTO MODE
         BCS,M4   TIOO              BRANCH IF SO
BADTIO   LI,R6    BA(MSGY2)         MSG ADDR
         BAL,R15  COMTYPE           NOTIFY OPERATOR TAPE NOT AVAILABLE
         LI,R6    4096              DISABLE
         WD,R6    X'1300'           COUNTER 4
TIOWAIT  EQU      %
         WD,R0    ALLOW             ALLOW TAPE TO INTERRUPT
         WAIT     0                 WAIT
         LI,R6    4144              ENABLE
         WD,R6    4608              ALL INTERRUPTS
         B        RTIO              RETRY TIO
TIOO     EQU      %
         TIO,R11  *TAPEDEV          ASSURE TAPE IS FREE
         STW,R11   TIO%STATUS       SAVE LATEST TIO INFO
         BCS,M12  RTIO              BRANCH IF NOT
         PULLREG  0,0,SUBSTACK      RESTORE REGS
         B        *R15              RETURN
COMSIO   EQU      %                 ISSUE COMMD IN REG 0
         STW,R0   TAPER0            SAVE COMMD ADDR.
         SIO,R0   *TAPEDEV
         BIOSNS   %-1               ASSURE GOOD START
         TIONEW   *TAPEDEV
FREEDEV  LPSD,0   C1OLDPSD          RETURN
         SPACE    2
RWCOMSIO LI,R14   RWRET             PRE-HANDLER'S LAST RTN NORMALLY
RWCOMIO  EQU      %                 BUT SOMETIMES, USER SPECIFIES RETURN
         STW,R0   TAPER0            SAVE COMMD ADDR.
         LI,R7    -10               SET DISC CHECKWRITE ERROR COUNT
         STW,R7   CWRTERR            TO -10
         SIO,R7   *TAPEDEV          ISSUE COMMD
         BIOSNS   BTW               BRANCH IF SIO NO GOOD
         BCR,M12  *R14              RETURN IF START SUCCESSFUL
         LI,R6    BA(MSGY2)         MSG ADDR
         BAL,R15  COMTYPE           GO TYPE TAPE UNIT NOT READY
         LI,R6    4096              ARM AND DISABLE
         WD,R6    X'1300'           COUNTER 4
         WAIT     0                 WAIT FOR OPERATOR
         LI,R6    4144              ARM AND ENABLE
         WD,R6    4608              ALL INTERRUPTS
         B        RWCOMSIO
RWRET    LPSD,0   C1OLDPSD          RETURN
TAPER0   DATA     0
BTW      EQU      %
         LB,R7    R7                GET BITS 0-7 IN PSN TO TEST
         CI,R7    128               TEST FOR INTRRUPT PENDING
         BCS,M4   BTWTE             BRANCH IF SO
         LI,R6    96                GET MASK
         AND,R7   R6                CLEAR ALL BITS EXCEPT BITS 1 AND 2
         CI,R7    96                TEST DEVICE BUSY
         BE       BTWTE             BRANCH IF SO
         HIO,R7   *TAPEDEV          HALT TAPE
         B        RWCOMSIO          RETRY
BTWTE    WD,R0    ALLOW             ALL TAPE
         WAIT     0                 TO
         B        RWCOMSIO          RETRY
         TITLE     'MPC TAPE PRE-PROCESSOR ROUTINES'
XTORNOT  EQU       %
         MTW,0     MPCTAPE
         BEZ       1,R7             S: REG 9T..RETURN
XT       EXU       0,R7             F: XT..DO XT'S INSTR
         B         2,R7             RETURN
*
         SPACE    2
FORKIFXT EQU       %
         MTW,0     MPCTAPE
         BEZ       2,R7             S: REG 9T..RETURN
FORKXT   PUSHREG   0,0,SUBSTACK
         BCS,M2    STKERROR
         LW,R15    CALLINGX
         BNEZ      %-1              LOOP SOLID TILL LAST NODE DONE
         BAL,R15   RTNTIO           CALL1 PSD -> NORMAL RETURN
*                                   DO NOTHING TILL DEVICE IS FREE
         LW,R5     1,R7             WHERE TO RETURN
         STW,R5    XTRET
         LW,R5     0,R7             R5 -> DESIRED NODE
         STW,R5    CALLINGX
RETRY    EQU       S:UFV(ENTRNODE)
ENTRNODE EQU       %
         CLM,R5   READ:LIM          ARE WE A SPECIAL READ
         BOL      NOTAREAD          S: NOPE..TRY NEXT TEST
         LI,R8    READ              F: Y..ALL READS THRU CENTRAL NODE
         B        NODE
NOTAREAD CLM,R5   RITE:LIM          TEST FOR SPECIAL READS
*                                   (DOESN'T INCLUDE RITE PGM)
         BOL      NODE              S: N..ENTER CALLING NODE
         LI,R8    RITE              F: Y..ROUTE THIS RITE THRU CENTRAL NODE
NODE     EQU       %
         STW,R5    CURRENTX
         LB,R7     *R5              'PRE' BYTE
         B         PREBOT,R7
*
PREBOT   EQU       %
*
PRE:DWNLD EQU     %
         LI,R11    0
         STW,R11   CALLINGX         NODES THAT WON'T GENERATE IOP
*                                   INTERRUPTS FOR POST HANDLER
*                                   MUST RESET CALLINGX IN PRE HANDLER.
         B        XEQIO+1           IF U DONT WANT DEV # IN IDCW
*
PRE:ROF  EQU       %
         LI,R11    0
         STW,R11   CALLINGX         DONT WANT TO HANG UP TILL THIS NODE THRU
         B         XEQIO
*
PRE:RON     EQU    %
PRE:DENSREW EQU    %
         MTW,1     XPCTDINT         DEV INT SIGNALS NODE COMPLETION
         B         XEQIO            SO EXPECT ONE TO COME IN.
*
BUFNKNT  EQU      %
         STW,R6    BUFFER
         STW,R7    NBYTES
         LW,R5    R8                SAVED CENTRAL NODE
         B        ENTRNODE          ALL READS/RITES GO THRU CENTRAL NODE
*
PRERDWRT EQU       %
         LW,R6     BUFFER           WA(BUF)
         SLS,R6    2                BA(BUF)
         LW,R7     MM20             MASK FOR BYTE ADDRESSES
         STS,R6    4,R5             PUT BUF ADDR INTO CLIST
         LW,R6     NBYTES           BYTE COUNT
         STS,R6    5,R5             STORE # BYTES INTO CLIST
         B         XEQIO
*
PRE:RDBF1 EQU      %
         SETBIT   IND,4             READ TO BUFFER 1 IN PROGRESS
PRE:BUF1 LI,R6     BUF1WRD1
         LI,R7     BUF1SIZ
         B         BUFNKNT
*
PRE:RTBF1 EQU     %
         LC       XTPOS             CC 1-3: BOT,E-O-R,TM
         BCS,4    XNEWREEL          S: NO MORE RITES ON THIS REEL..
         SETBIT   IND,6             F: SET WRITE FROM BUFFER 1 IN PROGRESS
         B        PRE:BUF1
*
PRE:RDBF2 EQU      %
         SETBIT   IND,5             READ TO BUFFER 2 IN PROGRESS
PRE:BUF2 LI,R6     BUF2WRD1
         LI,R7     BUF2SIZ
         B         BUFNKNT
*
PRE:RTBF2 EQU     %
         LC       XTPOS             CC 1-3: BOT,E-O-R,TM
         BCS,4    XNEWREEL          S: NO MORE RITES ON THIS REEL..
         SETBIT   IND,7             F: SET WRITE FROM BUFFER 2 IN PROGRESS
         B        PRE:BUF2
XNEWREEL EQU      %
         LI,R7     0
         STW,R7    CALLINGX
         BAL,R7   FORKXT
         NODEIS   TM
         RETURNTO %+1
         BAL,R7   FORKXT
         NODEIS   RITEEOR
         RETURNTO %+1
         BAL,R7   FORKXT
         NODEIS   TM
         RETURNTO %+1
         BAL,R7   FORKXT
         NODEIS   TM
         RETURNTO %+1
         BAL,R7   FORKXT
         NODEIS   ROF               REWIND THIS REEL OFF-LINE
         RETURNTO %+1
         MTW,-5    C1OLDPSD         EACH NODE ABOVE BUMPED CALL1 PSD
         B         NEWREEL1
*
PRE:RDEOF EQU      %
         LI,R6     WORK
         LI,R7     8
         B         BUFNKNT
*
PRE:READC1 EQU     %
         LI,R12    0                RESET CORR RD FLG IN SWITCH
         XW,R12    HOPE4READ        WAS IT CORRECTABLE READ?
         BEZ       SETIDCW          S: N..SETUP PROPER IDCW
         LI,R5     READ             F: Y..RELINK TO READ NODE
         B         ENTRNODE
SETIDCW  EQU       %
         LD,R12    XT:READIDCW
         LI,R10    16                       MAX # RETRIES TO BE ATTEMPTED
         SW,R10    NRETR                -   # RETRIES LEFT
*                                         = # RETRIES ALREADY PERFORMED
         AND,R10   MM3              MOD 8
         SLS,R10   2                SLIDE INTO POSITION
         OR,R12    R10              BLEND IN
         STD,R12   XT:READCIDCW
         B         XEQIO
*
PRE:RTDIR EQU      %
PRE:RDDIR EQU      %
         LI,R6     CNTDIR
         LI,R7     500
         B         BUFNKNT
*
PRE:RTEOF EQU      %
         LI,R6     OEORR
         LI,R7     16
         B         BUFNKNT
*
PRE:RTEOR EQU      %
         LI,R6     OEORF
         LI,R7     16
         B         BUFNKNT
*
PRE:RTBOOT EQU     %
         LI,R6     MTBOOT
         LI,R7     BOOTBYT
         B         BUFNKNT
*
PRE:RTPGM EQU     %
*        Q: WHY IS THIS RITE DIFFERENT FROM ALL OTHER RITES?
*        A: BECAUSE IT MUST CYCLE TO ITSELF A FEW TIMES
         LW,R7    NRECDONE          # BLOCKS ON TAPE ALREADY
         MI,R7    BLOCKSIZ          C(R7)=# WDS OF PGM ON TAPE
         AI,R7    LOAD2                  = NEW BUFF ADDR
         STW,R7   BUFFER
         LI,R6    BLOCKBYT
         STW,R6   NBYTES
         B        PRERDWRT
*
PRE:SET0 EQU       S:UFV(XEQIO)
         TITLE     'MPC TAPE I/O ROUTINES'
*
XEQIO    EQU       %
         BAL,R11   DEVNUM           PUT DEV # INTO IDCWS OF CLIST
         LW,R1     TAPEDEV
         LW,R0     R5
         AI,R0     2                R0 -> CLIST
         SLS,R0    -1               C(R0)=DA(CLIST)
         BAL,R11   XIO
*                                   R5 -> NODE THAT INIT'ED I/O
         STW,R5    REQX             REQX -> "    "      "     "
         LW,R5     MM17             ADDRESS MASK
         LI,R4     0
         LS,R4     C1OLDPSD         R4 -> I/O REQ
         AI,R4     -1
         LS,R4     *R4              R4 -> ERR RET
         STW,R4    SET0:ERR         PRESERVE FOR POST-HANDLER
         PULLREG   0,0,SUBSTACK     RESTORE FROM LAST PUSH (FORKXT/INTERR)
         MTW,0     BACKENTRY        WAS PRE-HANDLER ENTERED FROM POST?
         BEZ       *XTRET           S: N..RETURN W/IN I/O HANDLER
         STW,R11   BACKENTRY        SAVE RECENTLY RESTORED R11
         LI,R11    0
         XW,R11    BACKENTRY        RESET ENTRY-FROM-POST-HANDLER FLAG
         LPSD,M3   BACKENTPSD       JUST AS IF I WAS EXITING POST-HANDLER
*
DEVNUM   EQU       %
         PUSHREG   6,0,SUBSTACK
         BCS,M2    STKERROR
         LW,R1     R5               R1 -> NODE
         AI,R1     2                R1 -> IOCD
         LD,R2     *R1              CAPTURE IOCD
         SLS,R2    -2               C(R2)=WA(IDCW)+STRAY BITS
         AND,R2    MM17                  =WA(IDCW)
         LD,R4     *R2              CAPTURE IDCW
         LW,R0     TAPEDEV
         LW,R1     MM4
         SLD,R0    20
         STS,R0    R4               PUT DEV # INTO IDCW
         STD,R4    *R2              REPLACE IDCW
         PULLREG   6,0,SUBSTACK
         B         *R11             RETURN
         PAGE
XIO      EQU       %
         PUSHREG  0,0,SUBSTACK
         BCS,M2   STKERROR
         LI,R8     10               RETRY COUNT
XIO1     BAL,R15   RTNTIO+1         NEW SIO PATH MUST BE CLEAR
*                                   BUT DONT BUMP PSD IA.
         LCI       0
         SIO,R2    *R1
         STCF      SIO%CC           SAVE CC
         BCR,12    XIO2             S: I/O START SUCCESSFUL
*                                   F: SIO FAILURE
         LI,R6     BA(XNOTOP)       TYPE 'MPC NOT OPERATIONAL'
         HIO,0     *R1              HALT DEVICE
         BDR,R8    XIO1             S: RETRY I/O
*                                   F: EXHAUSTED # RETRIES
         LI,R14    XIO1             RETURN AFTER OPER CLEARS WAIT
         B         MSG:RETR1
*
XIO2     EQU       %
         PULLREG  0,0,SUBSTACK
         B         *R11             RETURN
*
XNOTOP   TEXTC     'MPC NOT OPERATIONAL'
*
*        CALCULATE ACTUAL RECORD SIZE (ARS)
*
SKIPARS  EQU       %                SET UP SKIP REQ BYTE CNT
         LI,R8     X'10000'         ZERO BYTE FIELD TREATED AS MAX
         B         %+2              LEAPFROG
IOARS    EQU       %
         LW,R8     NBYTES           # BYTES REQUESTED
         LD,R10    TDV%STATUS
         AND,R11   MM16             ISOLATE RBC
         SW,R8     R11              REQ CNT - RBC = ARS
         B         *R13             RETURN
         TITLE    'COMMON TYPE/KEYBOARD ROUTINES'
MSG      EQU       %                PRE-EMPT OC TO GET MSG OUT
         HIO,0     *TYPEDEV         HALT THE OC
COMTYPE  PUSHREG  0,0,SUBSTACK      SAVE REGS
         BCS,M2   STKERROR          *TEST*
         TIONEW   *TYPEDEV
         LB,R14   R0,R6             GET TEXT COUNT
         LI,X7    7                 INDEX
         STB,R14  TYPECW,X7         STORE COUNT IN CW
         AI,R6    1                 INCREMENT BYTE ADDR PAST COUNT BYTE
         OR,R6    TYPEORDR          OR IN ORDER CODE
         STW,R6   TYPECW            STORE ORDER CODE AND BYTE ADDR IN CW
         LI,R0    DA(TYPECW)        CW ADDR
         SIO,R0   *TYPEDEV          TYPE MSG
         BIOSNS   %-1
         TIONEW   *TYPEDEV          WAIT FOR COMPLETION
         PULLREG  0,0,SUBSTACK      RESTORE REGS
         B        *R15
COMREAD  EQU      %                 ACCEPT KEY-IN RTN
         PUSHREG  0,0,SUBSTACK
REREAD   EQU      %
         LW,R0    BLANK             GET WRD BLANKS
         LI,R1    0                 SET INDEX
         LI,R2    20                BLANK 2/ WORDS
COMSTW   STW,R0   INPUT,R1          BLANK INPUT AREA
         AI,R1    1
         BDR,R2   COMSTW
         TIONEW   *TYPEDEV
         LI,R0    DA(READCW)        CW ADDR
         SIO,R0   *TYPEDEV          ALLOW OPERATOR TO TYPE
         BCR,M12  %+2               BRANCH ON GOOD START
         B        %-2               GET GOOD START
         TIONEW   *TYPEDEV
         LI,R1    80                SET NO OF CHAR
         LI,R2    BA(INPUT)+79      SET PTR AT END OF LINE
LNSCAN   EQU      %                 SCAN CHAR FOR EOM
         LB,R0    0,R2
         CI,R0    X'08'
         BE       NOIN              BRANCH IF EOM FOUND
         AI,R2    -1
         BDR,R1   LNSCAN            CONTINUE SCAN
LNCHK    EQU      %
         LB,R0    INPUT             CHECK FIRST CHAR
         CI,R0    X'15'             IF NEW-LINE
         BE       NOIN
         PULLREG  0,0,SUBSTACK      RETURN TO
         B        *R15               CALLER
NOIN     EQU      %                 NO CHAR RECEIVED
         LI,R6    BA(NOINP)          GIVE  ?  PROMPT
         BAL,R15  COMTYPE             AND TRY
         B        REREAD               AGAIN
         TITLE     'ROUTINE TO READ DIRECTORY IN'
DIR%READ EQU       %
         STW,R15   RET              SAVE RETURN
         SETBIT   INDICATE,24,19    INDICATE DIRECT. IN CORE, & SET0
         IOREQ    T,REW,0           REWIND TAPE
         IOREQ     T,FSF,DIE        SPACE AFTER BOOT,PGM,DIR,TM
         IOREQ     T,BSR,DIE        POSIT BEFORE TM
         IOREQ     T,BSR,DIE        POSIT BEFORE DIRECTORY REC
PDRD     EQU       %
         BAL,R7    XTORNOT
         LI,R0     READDIR          SET0 NODE IF XT
         LI,R0    DA(RDDIR)         CW ADDR TO READ DIRECTORY
         IOREQ    T,SET0,PDRTRY     READ DIRECTORY
         IOREQ    T,WTE,PDRTRY      WAIT FOR END ACTION
         IOREQ    T,FSR,0           SPACE OVER TM
         OFFBIT   INDICATE,24
         B         *RET             RETURN
PDRTRY   EQU      %
* IF XT, UNRECOV TAPE ERROR
         MTW,0     MPCTAPE
         BNEZ      DIE
         LI,R0    DA(SENSECW)
         IOREQ    T,SET0            SENSE
         IOREQ    T,BSR,0
         LI,R0    DA(SETCORR)
         IOREQ    T,SET0,0          SET CORRECTION
         B        PDRD              GO RETRY
RET      RES       1                RETURN CELL FOR SEVERAL ROUTINES
         TITLE    'CALCULATE ADDR OF MODEL INFO TABLE'
GETMODEL EQU      %
         STW,R15  RET               SAVE RETURN
         LI,R15   M7202
         CW,R2    M7202MSK
         BE       *RET              7202
         LI,R15   M7203
         CW,R2    M7203MSK
         BE       *RET              7203
         LI,R15   M7204
         CW,R2    M7204MSK
         BE       *RET              7204
         LI,R15   M7211
         CW,R2    M7211MSK
         BE       *RET              7212
         LI,R15   M3214
         CW,R2    M3214MSK
         BE       *RET              3214
         LI,R15   M7221
         CW,R2    M7221MSK
         BE       *RET              7232
         LI,R15   M7242
         CW,R2    M7242MSK
         BE       *RET              7242
         LI,R15   M7260
         CW,R2    M7260MSK
         BE       *RET              7260
         LI,R15   M7270
         CW,R2    M7270MSK
         BE       *RET              7270
         LI,R15   M7275
         CW,R2    M7275MSK
         BE       *RET              7275
         LI,R15   M3275
         CW,R2    M3277MSK          3275
         BE       *RET
         LI,R15   M3282
         CW,R2    M3282MSK          3282
         BE       *RET
         LI,R6    BA(MSG::002)
         BAL,R15  COMTYPE
         B        ENDJOBS
         B        *RET
         TITLE    'WRITE PROGRAM AND BOOT TO TAPE'
WRTBOOT  EQU      %
         STW,R15  BOOTRET           SAVE RETURN
         SETBIT   INDICATE,24       CAL1,6 IN USE
         IOREQ    T,REW,0           REWIND TAPE
TY1      EQU      %
*
         MTW,0     MPCTAPE          IF XT..POST-HANDLER'LL
         BNEZ      WRT%OK           GIVE PROTECTED MSG
*
RR       EQU      15
         TDV,RR   *TAPEDEV
         LC       RR
         BCS,4    WRT%OK            BR IF WRITE PERMITTED
         LI,R6    BA(MSGXX)         TYPE 'TAPE WRITE PROTECTED'
         LI,R14    %-4
         B         MSG:RETR1
WRT%OK   EQU      %
          SETBIT    INDICATE,28    SET BOOT-WRT BIT
         LI,R6     -3040            DON'T ZAP CNTDIR,STACK1
         LI,R7     0
         STW,R7    BUF1DATA+3080,R6
         STW,R7    BUF2DATA+3080,R6
         BIR,R6    %-2
         LI,R9    NTRIES*3          # TRIES ON WHOLE TAPE ROOT
         MTW,0     MPCTAPE
         BEZ       WRT%OK1
         LI,R0     RITEBOOT
         IOREQ     T,SET0,DIE
         IOREQ     T,WTE,DIE
         LI,R0     RITEPGM
         IOREQ    T,SET0,DIE
         IOREQ    T,WTE,DIE
         B         WRT%OK2
REW%WRT  IOREQ    T,REW,REW%WRT
         BDR,R9   WRT%OK1
         B        BOOTER3           UNRECOVERABLE ERR DOING BOOT RECS
WRT%OK1  EQU       %
         LI,R0    DA(BOOTRITE)
         IOREQ    T,SET0,REW%WRT
         IOREQ    T,WTE,REW%WRT
         LW,R7    MM24
         LI,R6    BA(LOAD2)
         STS,R6   PGMRITE
         LI,R6    BLOCKBYT
         STS,R6   PGMRITE+1
         LW,R8    NBLOX             # BLOCKS TO GET WRITTEN OUT
         LI,R0    DA(PGMRITE)
         IOREQ    T,SET0,REW%WRT
         IOREQ    T,WTE,REW%WRT
         LI,R6     BLOCKBYT
         AWM,R6   PGMRITE
         BDR,R8   %-5
WRT%OK2  EQU       %
          OFFBIT    INDICATE,4,5,6,7   RESET BOOT-WRT
          OFFBIT    INDICATE,22,24,27,28   & CAL1,6 BITS
         B        *BOOTRET          RETURN
BTDIRERR  RES       0
          TESTBIT   INDICATE,BOOTER1,27  CK FOR RETRY
          SETBIT    INDICATE,27    TN ONERROR INDICATOR
BOOTER1   RES       0
          LI,R6     1              CK FOR  MAX TRIES
          AW,R6     RETRYTP        BUMP RETRY CT
          CI,R6     8
          BE        BOOTER3        ...BRANCH IF TRIED OUT
          STW,R6    RETRYTP        SAVE COUNT
          IOREQ     T,BSR,0        BACKSPACE
          IOREQ     T,ERG,0        SET ERASE
          TESTBIT   INDICATE,TY1,28
          TESTBIT   INDICATE,DIRXTY,29
          LI,R6     BA(MSGY5)
          BAL,R15   COMTYPE
          B         BYLABL
BOOTER3   RES       0
          LI,R6     BA(MSGX4)
          BAL,R15   COMTYPE
          LI,R6     BA(MSG::001)
          BAL,R15   COMTYPE
          B         ENDJOBS
WRTDIR   EQU      %
         STW,R15  BOOTRET           SAVE REG 15
         SETBIT   INDICATE,24       CAL1,6 IN USE
         LI,R1    8
         STW,R1   CNTDIR
         LD,R2    DTEHOLD           PUT DATE
         STD,R2   DATEDIR           IN DIRECTORY
          SETBIT    INDICATE,29    SET DIR-WRT BIT
         BAL,R7    XTORNOT
         LI,R0     RITEDIR          SET0 NODE IF XT
         LI,R0    DA(WRDIRTRY)
DIRXTY   EQU      %
          IOREQ     T,SET0,BTDIRERR
          IOREQ     T,WTE,BTDIRERR
         IOREQ    T,WTM,0
          OFFBIT    INDICATE,4,5,6,7  RESET DIR-WRT
          OFFBIT    INDICATE,22,24,27,29   & CAL1,6 BITS
         B        *BOOTRET          RETURN
         PAGE
************************************************************************
*  THE FOLLOWING IS THE DEVDMP TAPE BOOTSTRAP
************************************************************************
         BOUND    8
MTBOOT   EQU      %
A        ASECT
         ORG      MTBOOT            KEEP ORIGINAL ORIGIN
         LOC      A+X'2A'           SET ADDR = '2A'
BOOT     EQU      %
         LI,1     0                 SET BY PGM TO 'LI,1 NBLOX'
         LI,2     BLOCKBYT
BLOOP    LI,4     10                # OF RETRIES
         LI,0     DA(MTCDW)         CDW ADDRESS
SIO:     SIO,0    *37
         TIO,3    *37
         BCS,12   %-1
         CW,3     ERRMSK
         BANZ     RETRI
         AWM,2    MTCDW             TO READ NEXT REC PAST THIS ONE
         BDR,1    BLOOP
         B        LOAD2             START EXECUTION THERE
RETRI    LI,0     DA(MTCDW)+1
         BDR,4    SIO:
         B        %                 HANG IF UNRECOVERABLE ERR
         BOUND    8
MTCDW    EQU      %
         GEN,8,24 2,BA(LOAD2)       READ
         DATA     BLOCKBYT          RECORD BYTE COUNT
         GEN,8,24 X'4B',0           TO RE-READ, FIRST BACKSPACE REC
         DATA,1   X'20',0,0,0
         GEN,8,24 X'8',DA(MTCDW)    READ AGAIN
ERRMSK   DATA     X'6EFE0000'
BOOTSIZ  EQU      WA(%)-WA(BOOT)
BOOTBYT  EQU      BA(%)-BA(BOOT)
BLOCKSIZ EQU      1024              1K SEGMENTS
BLOCKBYT EQU      BLOCKSIZ*4
************************************************************************
         TITLE    'CONVERT 1 WORD OF HEX TO PRINTABLE DECIMAL'
         USECT    MTBOOT
         ORG      MTBOOT+BOOTSIZ+2
PRTDEC   EQU      %
         PUSHREG  3,2,SUBSTACK
         LI,R2    7                 SET INDEX TO STORE IN BYTE 7
         LI,R3    8                 EXECUTE 8 TIMES
         LI,R4    0                 CLEAR REMAINDE REG
DECX     DW,R4    TEN               DIVIDE BY 10 (CONVERT TO BASE 10)
         AI,R4    240               SET EBCDIC ZONE (F)
         STB,R4   DBLWRD,X2         STORE IN OUTPUT
         LI,R4    0                 CLEAR REMAINDER
         AI,X2    -1                REDUCE OUTPUT INDEX
         CW,R5    R4                TEST FOR ZERO QUOTENT
         BE       PAD               GO PAD HI-ORDER PSNS WITH BLANKS
         BDR,R3   DECX              CONVERT UP TO 8 OUTPUT DIGITS
         PULLREG  3,2,SUBSTACK
         B        *R15              RETURN
PAD      EQU      %
         AI,R3    -1                REDUCE PASS COUNT
         LI,R4    64                GET BLANK PAD CHARACTER
PAD1     STB,R4   DBLWRD,X2         STORE IN NEXT AVAILABLE OUTPUT PSN
         AI,X2    -1                DECREMENT OUTPUT INDEX
         BDR,R3   PAD1              PAD ALL HI-ORDER PSNS
         PULLREG  3,2,SUBSTACK
         B        *R15              RETURN
         TITLE    'INTERRUPT DECODER'
INTERR   EQU      %                 ACCEPT I/O INTERRUPTS
         PUSHREG  0,0,SUBSTACK
         AIO,R1   0                 ACCEPT INTERRUPT
         BCS,M8   FALTINTR          BRANCH IF NO INTERRUPT PRESENT
         STCF     CCHOLD            SAVE CONDITION CODE
         STW,R1   R1SAVE            SAVE INTERRUPT
         LI,R3    X'3FFF'
         LS,R3    R1SAVE            LOAD INTERUPT DEVICE ONLY
         CW,R3    DISCDEV           TEST FOR DISC INTERRUPT
         BE       DISCHAND
         BAL,R7    XTORNOT
         LI,R3     X'FF0'           IF XT, CORRECT CONTROLLER SUFFICIENT
         LI,R3     X'FFF'           ELSE, NEED COMPLETE DEVICE ADDR MATCH
         LW,R2     R1SAVE
         CS,R2     TAPEDEV          TEST FOR TAPE INTERRUPT
         BNE       FALTINTR         BAD INTERRUPT
* TAPE INTERRUPT .. GO OFF TO CONTROLLER-TYPE DEPENDANT POST-HANDLER
         STW,R1    R1SAVET          SAVE TAPE INT FOR DEBUGGING PORPOISES
         MTW,0     MPCTAPE
         BEZ       TAPEHAND         S: IT'S REG 9T
         B         XTHAND              IT'S XT
EXITOK   EQU       %
         LI,R3     0
         STW,R3    CALLINGX
         STW,R3    DENSBAD
LPSDRET  PULLREG  0,0,SUBSTACK
         LPSD,M3  IOINTOLD          RETURN
CCHOLD   DATA     0                 CONDITION CODE SAVE AREA
R1SAVE   DATA     0
R1SAVED  DATA     0                 LAST DISC INTERRUPT
R1SAVET  DATA     0                 LAST TAPE INTERRUPT
R2SAVE   DATA     0                 REGISTER 2 SAVE AREA
R12SAV   DATA     0                 REGISTER 12 SAVE AREA
         TITLE     'MPC TAPE POST-PROCESSOR ROUTINES'
         PAGE
XTHAND   EQU      %                 MPC TAPE CLEAN UP ENTRY POINT
*
         LW,R5     REQX             R5 -> NODE TO WHOM I/O INT BELONGS
         LW,R11    AIO%STATUS
         BLZ       DEVINT           DEVICE INTERRUPT OCCURRED
         OFFBIT    XTPOS,0,2        DEFAULT IS TAPE OFF BOT & NOT AT TM
*
*        SIMULATE IOSERCK IN FINDING NON DEVICE DEPENDANT ERRORS
*
*
*     GENERAL ERROR TESTING (NON DEVICE DEPENDANT)
*
*        AN ERROR CONDITION WILL BE DEFINED AS ANY ONE OF
*        THE FOLLOWING CONDITIONS:
*
*        AIO CC 1 NOT ZERO
*        TDV CC 1 NOT ZERO
*
*        AIO STATUS BIT 9 SET
*
*        TDV STATUS BIT 9,10,11,12,13,14 OR 15 SET
*
         LW,R6     AIO%STATUS
         SCS,R6    16               RIGHT ALIGN STATUS
         TIO,R11   *TAPEDEV
         STW,R11   TIO%STATUS
         LCI      0
         TDV,R10   *TAPEDEV
         STCF      TDV%CC
         STD,R10   TDV%STATUS
         LH,R10    R11              GET TDV STATUS RT-ALIGNED
         STH,R6    R10              COMPOSE AIO/TDV STATUS INFO
         LC        AIO%CC
         BCS,8     ERROR
         LC        TDV%CC
         CW,R10    =X'0040007F'
         BCS,12    ERROR
*
*        AT THIS POINT, NO GENERAL ERRORS IN LAST I/O
*        OPERATION WERE DETECTED
*
         LB,R6    AIO%STATUS        DEVICE STATUS BYTE FROM AIO
         AND,R6   MM6               MPC SUB STATUS FIELD
         LD,R8    TDV%STATUS        TDV STATUS
         LB,R7    R9                DEVICE STATUS BYTE
         AND,R7   =X'6F'            REMOVE INIT INTERRUPT AND STRAY BIT
         AI,R7    -X'20'            CHECK OPI SET
         BEZ      MAJSTAT:0         OPI SET AND MAJOR STATUS ZERO
*
         CI,R7    X'E0'
         BANZ     ERROR             TDV0-2, NOT 001
         AND,R7   MM4               MPC MAJOR STATUS
         LB,R7    MAJ:STAT,R7       GET MAJOR STATUS VECTOR
         BEZ      XSTOP             NO SUCH MAJOR STATUS
         AI,R7    ERR               POINT TO MINOR STATUS VECTOR
         LB,R4    *R7,R6            MINOR STATUS VECTOR
         EXU      ACTIONS,R4        AND GO.
*
ACTIONS  B        XSTOP             SERIOUS ERROR..CAN'T CONTINUE
         B        OPER              KEYIN REQUIRED
         B        ERROR             RETRY SEQUENCE
         B        WPROTECT          TAPE IS WRITE PROTECTED
         B        BLANKTAP          25' OF BLANK TAPE READ
         B        EOT               EOT REFLECTOR CROSSED
         B        EOF               TM READ
         B        USERERR           BAD SEQUENCE BY CALLER
         B        BOT               UNEXPECTED BOT HIT
         B        DENSITY           CANT READ BECAUSE OF BAD DENSITY
         B        MBOT              MULTIPLE BOT REFLECTORS ON TAPE
         B        CORRERR           CORRECTABLE READ ERROR ON TAPE
*
*        COMES HERE ON DEVICE INTERRUPT
*
DEVINT   EQU       %                R11= AIO STATUS
         MTW,0     XPCTDINT         ARE WE EXPECTING COMPANY?
         BEZ       LPSDRET          S: NOPE..
         LI,R3     X'FFF'           F: Y..IS IT RIGHT DEVICE
         LS,R3     AIO%STATUS       R3= DEV ADDR
         CW,R3     TAPEDEV
         BNE       LPSDRET          NOPE
         LC        R11              MUST BE REW COMPL & READY
         BCR,4+1   POSTRETRY        NO..RETRY
         MTW,-1    XPCTDINT         NOT EXPECTING ANY LONGER.
         B         READY            ALL IS OK..NORMAL NODE COMPLETION
*
*        COMES HERE ON NORMAL I/O COMPLETION
*
MAJSTAT:0 EQU      %                C(R6)=SUB STATUS
         CI,R6     2                BOT?
         BAZ       READY            S: NOPE..
         SETBIT    XTPOS,0          F: YUP...
READY    EQU       %                R5 -> NODE
         LI,R4     1
         LB,R4     *R5,R4           'POSTN' BYTE
         B         POSTNBOT,R4      AND GO.
*
*        COME HERE IF ERROR WAS GENERATED BY LAST I/O OP
*
ERROR    EQU       %                R5 -> CURRENT NODE
         MTW,1    TAPECOUT          ANOTHER TAPE ERROR
         LD,R8     TDV%STATUS
         LC        R9               DID TAPE MOVE?
         BCS,8     POSTRETRY        S: NO..RETRY SAME I/O OP
*
*        ERROR WITH TAPE MOTION HAS OCCURRED
*
MOV%VIOL LI,R6     2
         LB,R6     *R5,R6           L/ 'POSTE' BYTE
         B         POSTEBOT,R6      AND GO.
*
*
*
DENSITY  EQU       %
         STW,R5    REDOX            REDO THIS NODE AFTER CORRECT DENS SET
         MTW,1     DENSBAD          BUMP # TIMES DENSITY REJECTED
         LI,R5     DENSREW
         B         POSTENTRY        REWIND TO CHANGE DENSITY
*
BLANKTAP EQU       %
         MTW,1    TAPECOUT          ANOTHER TAPE ERROR
         LI,R6     BA(BLANKMES)     '25 FT BLANK TAPE READ'
         B         MSG:RETRY
BLANKMES TEXTC     ' 25FT. BLANK TAPE READ'
*
MBOT     EQU       %
         MTW,1    TAPECOUT          ANOTHER TAPE ERROR
         LI,R6     BA(MBOTMES)      ' MULTIPLE BOT MARKERS'
         B         MSG:RETRY
MBOTMES  TEXTC     ' MULTIPLE BOT MARKERS'
*
EOT      EQU       %                END OF TAPE REFLECTOR CROSSED
         SETBIT    XTPOS,1
         CI,R6     X'1F'            C(R6)=MPC SUB-STATUS FIELD
         BAZ       READY            S: NO ERRORS
         MTW,1    TAPECOUT          ANOTHER TAPE ERROR
         CI,R6     3                F: SOME ERROR..
*                                      WAS IT BIT DETECTED DURING ERASE
         BAZ       POSTRETRY        S: N..RETRY
         B         XSTOP            F: Y..'UNRECOV TP ERR' MSG, DIE
*
BOT      EQU       %                AT LOAD POINT, R5 -> CURR NODE
         LCI       8                XTPOS 0-2: BOT , E-O-R , TM
         STCF      XTPOS            SET TO ->  ON    OFF     OFF
         CI,R5     RITEC1           WAS ERROR IN 1ST REC ON TAPE
         BNE       READY            S: N..PROCESS 'POSTN' CODE
BOT1     LI,R6     BA(STRIPMES)     F: Y..'STRIP TAPE' MSG
         LW,R5     CALLINGX         RETRY ORIGINAL NODE
         LI,R14    POSTENTRY
         B         MSG:RETR1
STRIPMES TEXTC     ' STRIP TAPE..'
*
EOF      EQU       %                TAPE MARK ENCOUNTERED
         SETBIT    XTPOS,2          TM BIT SET
         LW,R15    REQX             NODE THAT INIT'ED I/O
         CI,R15    READ
         BNE       READY            S: PROCESS 'POSTN' CODE
*        UNEXPECTED TM ON READ..TIME FOR NEW REEL
*        PUT DEV #S IN NECESS IDCWS AND GO
         LI,R11    0
         STW,R11   CALLINGX         SET END FOR READ THAT HIT TM
         LI,R5     FAKENODE         XREOF'S NODE
         BAL,R11   DEVNUM
         LI,R5     ROF
         BAL,R11   DEVNUM
         B         TPEOF+1
*
WPROTECT EQU       %                NO WRITE RING ON TAPE
         LI,R6     BA(MSGXX)        'WRITE PROTECTED'
         B         MSG:RETRY
*
CORRERR  EQU       %                CORRECTABLE READ ERROR OCCURRED
         MTW,1    TAPECOUT          ANOTHER TAPE ERROR
         MTW,1     HOPE4READ        SET CORR RD FLAG
         B         FLINK
*
USERERR  EQU       S:UFV(XSTOP)     SHOULDST NE'ER OCCUR
*
OPER     EQU       %
         MTW,1    TAPECOUT          ANOTHER TAPE ERROR
         LI,R6     BA(MSGERR)       'DRIVE ERROR'
         LW,R14    CALLINGX
         BNEZ      MSG:RETRY
         LI,R14    LPSDRET
         B         MSG:RETR1
MSGERR   TEXTC     'MPC TAPE DRIVE ERROR'
*
POSTNBOT EQU       %
*
*        CODE TO BE ENTERED UPON NORMAL COMPLETION OF A NODE'S I/O
*
POSTN:RITEC4 EQU   %
POSTN:READC  EQU   %
POSTN:RITEC  EQU   %
POSTN:TMC    EQU   %
POSTN:RITEC5 EQU   %
POSTN:RITEC6 EQU   %
*
FLINK    EQU       %
         LW,R5     1,R5             R5 -> FLINK NODE
         B         POSTENTRY
POSTN:BSR    EQU   %
POSTN:ROF    EQU   %
POSTN:TM     EQU   %
POSTN:ERS    EQU   %
POSTN:TMC1   EQU   %
POSTN:FSF    EQU   %
POSTN:FSR    EQU   %
POSTN:BSF    EQU   %
POSTN:SET0   EQU   %
             B     EXITOK           CANT 'EQU' BECAUSE OF BYTE DISPLACEMENT
*
POSTN:RON EQU      %
         LCI       8                XTPOS 0-2: BOT , E-O-R , TM
         STCF      XTPOS            SET TO ->  ON    OFF     OFF
         B         EXITOK
*
POSTN:1600   EQU   %
POSTN:800    EQU   %
         LW,R6     CALLINGX
         CLM,R6    DENS:LIM
         BIL       EXITOK
         LW,R5     REDOX            RECONNECT TO ORIGINAL I/O REQ
         B         POSTENTRY
*
*
POSTN:READC1 EQU   %
POSTN:READ EQU     %
         OFFBIT    IND,4,5          RESET 'READ IN PROGRESS' BITS
         B         EXITOK
*
POSTN:RITE EQU     %
         OFFBIT    IND,6,7          RESET 'WRITE IN PROGRESS' BITS
         B         EXITOK
*
POSTN:RITEC1 EQU   %
         LC        XTPOS            CC 1-3: BOT,E-O-R,TM
         BCS,8     BOT1             S: BOT..STRIP TAPE
*                                   F: CALCULATE # ERASES TO DO
         BAL,R13   IOARS            GET ARS
         LW,R9     R8               C(R9)=ARS OF CURR REC (BYTES/REC)
         LI,R7     2800             C(R7)=# BYTES/3.5" OF 800 BPI TAPE
         DW,R9     R7               C(R9)=APPROX RECSIZ IN 3.5" UNITS
         AI,R9     2                INSURE COMPLETE ERASE (TRUNC,GAPS)
         LW,R7     NRITES           L/ # WRITES ATTEMPTED THIS REC
         AI,R7     1                FOR ORIGINAL BAD WRITE
         MW,R9     R7               EACH SUCCESSIVE RE-WRITE ATTEMPT
*                                   ERASES TO 'PASSOVER' PREV BAD WRITE,
*                                   SO # ERASES INCREASES ARITHMETICALLY
         STW,R9    ERASE            DO THIS MANY ERASES..
         B         FLINK
*
POSTN:RITEC3 EQU   %                COMES HERE AFTER ERS NODE
         MTW,-1    ERASE            DECREMENT ERASURES COUNT
         BGZ       POSTRETRY        S: ERASE SOME MORE
         B         FLINK            F: DONE ERASING..NEXT STEP, PLZ
*
POSTN:RITEC2 EQU   %                GET ARS OF LAST GOOD REC
POSTN:RITEC7 EQU   %                CHECK THAT ARS MATCHES PREV VALUE
         LC        XTPOS            CC 1-3: BOT,E-O-R,TM
         BCS,2     FLINK            S: TM..NOTHING TO DO
         BAL,R13   SKIPARS          C(R8)=ARS
         XW,R8     LAST1SIZ         R8 = ARS <--> LAST RECSIZ (IF ANY)
         CI,R5     RITEC2           GET ARS OR CHECK ARS?
         BE        FLINK            S: GET ARS..GOT IT SO FLINK
         CW,R8     LAST1SIZ         C/ PREV ARS VS. NEWLY REC'D ARS
         BE        FLINK            S: EQ..KEEP GOING
         B         TOBADTP          F: NE..DIE
*
POSTN:RITEC8 EQU   %                CHECK THAT REWRITE ARS MATCHES REQ CNT
         BAL,R13   SKIPARS          C(R8)=ARS
         CW,R8     NBYTES           C/ ARS OF RE-WRT VS. REQ CNT
         BE        CHECKPGM         S: EQ..REC WRITTEN OK..
*                                   F: NE..RE-WRT ATTEMPT FAILED
         MTW,1     NRITES           TREAT IT AS ANOTHER BAD WRITE
         MTW,-1    NRETR            DECREMENT # RETRIES LEFT
         BGZ       FLINK            S: RETRY WRITE ERROR CORRECTION SEQ
         B         ABORT            F: NONE..DIE
CHECKPGM LW,R5    CALLINGX          ORIGINAL NODE
         B         READY            WOULDA GONE THERE HAD 1ST WRITE GONE OK
*
POSTN:DENSREW EQU  %
         LCI       8                XTPOS 0-2: BOT , E-O-R , TM
         STCF      XTPOS            SET TO ->  ON    OFF     OFF
         LW,R6     DENSBAD          # OF DENSITY REJECTIONS
         EXU       DEVTAB-1,R6      EITHER 800 BPI/1600 BPI/DIE
         B         POSTENTRY
DEVTAB   EQU       %
         LI,R5     SET1600          1ST TIME..TRY @ 1600 BPI
         LI,R5     SET800           2ND TIME..TRY @ 800 BPI
         B         DIE              3RD TIME..NO MORE DENSITIES..DIE
*
POSTN:RTPGM EQU   %
         MTW,1    NRECDONE          ANOTHER BLOCK OUT THERE NOW
         LW,R6    NRECDONE
         CW,R6    NBLOX             ARE WE ALL DONE?
         BL       POSTRETRY         S: NOPE..
         LI,R6    0
         STW,R6   NRECDONE
         B        EXITOK
*
POSTEBOT EQU       %
*
*        CODE TO BE EXECUTED UPON ERROR AT COMPLETION
*        OF NODE'S I/O OPERATION
*
POSTE:READ EQU     %                CHECK FOR NOISE RECORD
         LI,R13    16
         STW,R13   NRETR            TWICE FOR EACH IDCW SETTING
         BAL,R13   IOARS            GET REC SIZE
         CI,R11    0                ANY REMAINING BYTES
         BEZ       FLINK            S: N..CAN'T BE NOISE REC
         CI,R8     12               C/ ARS , 12
         BGE       FLINK            S: >= 12..NOT NOISE REC SO
*                                      INITIATE READ CORRECTION SEQ
         B         POSTRETRY        F: < 12..ASSUME NOISE & READ NEXT REC
*
POSTE:RTPGM EQU   S:UFV(POSTE:RITE)
POSTE:RITE EQU     %
         LI,R6     0
         STW,R6    NRITES           # BAD RE-WRITES = 0, SO FAR
         LI,R6     NTRIES
         STW,R6    NRETR            FULL RETRY COUNT
         B         FLINK
*
POSTE:RITEC4 EQU   %
         MTW,1     NRITES           ONE MORE BAD WRITE
POSTE:RITEC8 EQU   %
         MTW,-1    NRETR
         BLEZ      DIE              NO MORE RETRIES REMAINING
         LI,R5     RITEC            RETRY ENTIRE SEQ AGAIN
         B         POSTENTRY
*
POSTE:SET0 EQU     %
         LW,R7     MM17             ADDR FIELD MASK
         LS,R6     SET0:ERR         R6 -> ERR RETURN
         BEZ       EXITOK           S: USER DIDN'T SPECIFY..RETN
         STS,R6    IOINTOLD         F: JAM ERR RET INTO PSD
         B         EXITOK           RETURN
POSTE:BSF    EQU   %
POSTE:BSR    EQU   %
POSTE:ERS    EQU   %
POSTE:FSF    EQU   %
POSTE:FSR    EQU   %
POSTE:READC  EQU   %
POSTE:RITEC  EQU   %
POSTE:RITEC1 EQU   %
POSTE:RITEC2 EQU   %
POSTE:RITEC3 EQU   %
POSTE:RITEC5 EQU   %
POSTE:RITEC6 EQU   %
POSTE:RITEC7 EQU   %
POSTE:TM     EQU   %
POSTE:TMC    EQU   %
POSTE:TMC1   EQU   %
             B     XSTOP
*
POSTE:READC1 EQU   %
         MTW,-1    NRETR            ANOTHER BAD READ - RETRIES LEFT?
         BLEZ      DIE              S: N..UNRECOV READ ERR
         B         FLINK            F: Y..LINK TO READ CORR SEQ
*
POSTE:DENSREW EQU  %
POSTE:ROF    EQU   %
POSTE:RON    EQU   %
POSTE:800    EQU   %
POSTE:1600   EQU   %
             B     POSTRETRY
*
MSG:RETRY LI,R14   POSTRETRY        NORMALLY U RETRY NODE
MSG:RETR1 EQU      %                ENTRY W/ USER SPEC'D RET (W/IN HANDLER)
         BAL,R15   MSG
         LI,R6     BA(RETRYMSG)     ' CLEAR WAIT WHEN READY TO RETRY'
         BAL,R15   MSG
         LI,R6     BA(CRMSG)
         BAL,R15   MSG
         OPACTION
         B         *R14
RETRYMSG TEXTC     ' CLEAR WAIT WHEN READY TO RETRY'
*
*        TO ENTER PRE HANDLER FROM POST HANDLER, CAN'T BRANCH DIRECTLY
*        SET FLAG TO INDICATE ENTRY WAS FROM POST-HANDLER
*
POSTRETRY EQU      %
POSTENTRY EQU      %
         LI,R6     1
         STW,R6    BACKENTRY
         LD,R6     IOINTOLD         BACK ENTRY NEEDS IT OWN PSD
         STD,R6    BACKENTPSD       JUST IN CASE PRE HANDLER IS INTERRUPTED
*        PUSHED REGS WILL BE POPPED AT PRE-HANDLER EXIT
         B         ENTRNODE         A.K.A. RETRY
         TITLE    'TAPE INTERRUPT SERVICING ROUTINES'
TAPEHAND EQU      %                 SERVICE TAPE INTERRUPT
         STW,R1   R1SAVET           SAVE INTERRUPT **FOR DEBUG ONLY**
         TESTBIT  INDICATE,OKTAPE,4,5,6,7,24  BRANCH IF TAPE BUSY
         B        LPSDRET           NO TAPE OPER IN PROGRESS - RETURN
OKTAPE   CW,R1    TPAIO             TEST FOR ERROR
         BCS,M4   TAPERROR          BRANCH IF UNUSUAL END INTERRUPT
TPENDTP  EQU      %
         OFFBIT   INDICATE,4,5,6,7,22 TURN OFF TAPE BUSY & RETRY BITS
         LI,R0    0
         STW,R0   RETRYTP           ZERO TAPE RETRY COUNT
         B        LPSDRET           EXIT
TAPERROR EQU      %                 ERROR RECOVERY
         TESTBIT  INDICATE,TPER22,22 BRANCH IF THIS WAS A RETURY
         MTW,1    TAPECOUT          ADD 1 TO ERROR COUNT
         SETBIT   INDICATE,22       SET RETRY BIT
TPER22   EQU      %
         LW,R5    K1FFFF            GET LOAD SELECTIVE MASK
         LS,R5    TAPEREC           GET ERROR RECOVERY ADDR
         BCR,M3   TAPERRTN          BRANCH IF NO ADDR PROVIDED
         OFFBIT   INDICATE,4,5,6,7,22 TURN OFF TAPE BUSY & RETRY BITS
         B        ABINT             EXIT TO USER ERROR RECOVERY
TAPERRTN EQU      %
         TESTBIT  INDICATE,LPSDRET,24  BRANCH IF CAL1,6
         TDV,R3   *TAPEDEV          GET STATUS
         LB,R6    R3                GET BITS 0-7 FOR TEST
         CI,R6    128
         BCS,4    NORMRTRY
         CI,R6    32
         BCS,M4   TPWRTPR           BRANCH ON WRITE PROTECT VIOLATION
         CI,R6    16
         BCS,M4   TPEOF             BRANCH ON END-OF-FILE
         STW,R2   R2SAVE            SAVE REGISTER 2
         STW,R12  R12SAV            SAVE REGISTER 12
         TDV,R2   *TAPEDEV          GET DEVICE STATUS
         AND,R2   =X'FFFFFF'        ISOLATE CCD ADDRESS
         SLS,R2   3                 GET BYTE ADDRESS
         LB,R12   0,R2              GET ORDER CODE IN R12
         LW,R2    R2SAVE            RESTORE REG 2
         CI,R12   X'02'             IS THIS A READ OPERATION
         BNE      DVD001            BRANCH IF NOT
         CI,R6    8
         BCS,M4   NOCORR            BRANCH ON UNCORRECTABLE READ ERROR
DVD001   EQU      %
         TESTBIT  R3,NORMRTRY,9
         LW,R12   R12SAV            RESTORE REGISTER 12
         CI,R6    2
         BCS,M4   TPEOR             BRANCH ON END OF TAPE -WRITE
*                 ERROR CANNOT BE ISOLATED PREPARE TO ABORT
         LI,R6    8                 GET STATUS LENGTH
         STW,R6   WORKT             STORE. WORK NOW IS A TEXTC COUNT =8
         LW,R9    R1SAVE            GET AIO STAUTS
         LI,R6    BA(MSGY5)         GET MSG ADDR
         BAL,R15  COMTYPE           TYPE 'UNDEFINED I/O ERROR'
         BAL,R15  PRTHEX            CONVERT AIO STATUS FOR PRINTING
         LI,R6    BA(MSGY6)         GET MSG ADDR
         BAL,R15  COMTYPE           TYPE 'AIO STATUS-'
         LI,R6    BA(WORKT)+3       MSG ADDR
         BAL,R15  COMTYPE           TYPE            'XXXXXXXX'
         LI,R6    BA(MSGY7)         GET MSG ADDR
         BAL,R15  COMTYPE           TYPE 'TDV STATUS-'
         LW,R9    R3                GET TDV STATUS
         BAL,R15  PRTHEX            CONVERT FOR PRINTING
         LI,R6    BA(WORKT)+3       MSG ADDR
         BAL,R15  COMTYPE           TYPE            'XXXXXXXX'
         TIO,R9   *TAPEDEV          GET TIO STATUS
         BAL,R15  PRTHEX            CONVERT FOR TYPING
         LI,R6    BA(MSGYA8)        MSG ADDR
         BAL,R15  COMTYPE           TYPE 'TIO STATUS'
         LI,R6    BA(WORKT)+3
         BAL,R15  COMTYPE           TYPE ACTUAL STATUS
         LI,R6    BA(MSGX6)         GET MSG ADDR
         BAL,R15  COMTYPE           TYPE 'JOB ABORTED'
         LI,R6    4                 RESTORE COUNT OF 4
         STW,R6   WORKT             TO WORK FIELD
         B        BYLABL            ABORT
TPWRTPR  LI,R6    BA(MSGY3)         GET MSG ADDR
         MTW,-1   TAPECOUT          WRITE PROTECT VIOLATION NOT ERROR
         BAL,R15  COMTYPE           TYPE 'TAPE UNIT FILE PROT---
         LI,R6    4096              ARM AND DISABLE
         LI,R6    4096+16           COUNTER AND CP
         WD,R6    X'1300'           COUNTER 4
         WAIT     0                 WAIT
         LI,R6    4144              ARM AND ENABLE
         WD,R6    4608              ALL INTERRUPTS
         LW,R0    TAPER0            RESTORE COMMD ADDR.
         B        TPX1              GO RE-ISSUE COMMD
TPEOF    MTW,-1    TAPECOUT         EOF IS NOT TAPE ERROR
         LD,R6     IOINTOLD
         STD,R6    IOINTSAV
         LD,R6     C1OLDPSD
         STD,R6    C1OLDSAV
         BAL,R7    XTORNOT
         LI,R0     DA(XREOF)
         LI,R0     DA(REOFCW)
         SIO,R0   *TAPEDEV          READ TRAILER
         BIOSNS   %-1
         TIONEW   *TAPEDEV
         LB,R5    WORK              TEST FOR END OF REEL
         CI,R5    C'*'              TEST FOR END OF REEL
         BE       NEWREELT          BRANCH IF SO
         SETBIT   INDICATE,17       SET END OF FILE INDICATOR
         OFFBIT   INDICATE,4,5,6,7  SET TAPE NOT BUSY
         LI,R0     0
         STW,R0    CALLINGX         FOR NODE THAT READ TM IN
         B        LPSDRET           RETURN
TPEOR    EQU      %
         MTW,-1   TAPECOUT          END OF REEL IS NOT TAPE ERROR
         B        TPENDTP           GO EXIT
NEWREELT EQU       %
         BAL,R7    XTORNOT
         LI,R0     DA(ROF+2)
         LI,R0    DA(OFFLINE)
         SIO,R0   *TAPEDEV          REWIND THIS TAPE OFF LINE
         LI,R6    BA(MSGY4)         GET MSG ADDR
         BAL,R15  COMTYPE           TYPE 'END OF REEL. ASSIGN NEW TAPE'
         BAL,R15  COMREAD           GET NEW TAPE ADDR
         LI,R6    BA(INPUT)         SET PTR TO INPUT
         LB,R0    0,R6              EXAMINE FIRST BYTE
         CI,R0    C'X'
         BNE      NO%X
         LI,R15   1
         STW,R15  MPCTAPE           SET FLAG FOR 'XT'
         B        ADJ2
NO%X     CI,R0    C'M'              CHECK IF MT ENTERED
         BNE      NOADJ2            S: NOPE..KEEP SAME DRIVE TYPE
         LI,R15   0
         STW,R15  MPCTAPE           SET FLAG FOR REG 9T
ADJ2     AI,R6    2                 ADJUST POINTER PAST 'MT'/'XT'
NOADJ2   EQU      %
         LI,R1    4
         BAL,R15  CPTOHEX           CONVERT TO HEX
         LW,R5    R9
         STW,R5   TAPEDEV           STORE NEW TAPE ADDR FOR USE
         MTW,0     MPCTAPE
         BNEZ      MPCENT
         TDV,R5   *TAPEDEV          GET TAPE STATUS
         BCS,M12  NEWREELT          BRANCH IF NO RECOGINITION
         TESTBIT  R5,NOREWD,5       BRANCH IF AT LOAD POINT
         LI,R0    DA(REWCW)         REWIND
         SIO,R0   *TAPEDEV          NEW
         BIOSNS   %-1               TAPE
         TIONEW   *TAPEDEV
NOREWD   TESTBIT  INDICATE,REDOB1,4   BRANCH IF USING BUFFER 1
         LI,R0    DA(RDBUF2CW)      NO--SET UP FOR READ BUFFER 2
         B        TPX1              PREPARE TO REISSUE COMMD
*
* NOW THAT WE'RE SURE IT'S AN MPC TAPE DRIVE AND
* WE'VE CALCULATED ITS ADDRESS, LET'S DOWNLOAD F/W TO IT
*
MPCENT   LCI       8                XTPOS 0-2: BOT , E-O-R , TM
         STCF      XTPOS            SET TO ->  ON    OFF     OFF
         LPSD,3    XENT1PSD         ARM & ENABLE I/O INT
MPCENT1  EQU       %
         LW,R1     TAPEDEV
         BAL,R14   MPCDWNLD         DOWNLOAD THE F/W TO MPC
         LI,R5     READBUF2
         TESTBIT   IND,RE%READ,4    B/ IF BUFF2 WAS IIP
         LI,R5     READBUF1
RE%READ  LI,R6     1
         STW,R6    BACKENTRY
         LD,R6     IOINTSAV         BACK ENTRY NEEDS ITS OWN PSD
         STD,R6    BACKENTPSD       JUST IN CASE PRE HANDLER IS INTERRUPTED
         LD,R6     C1OLDSAV
         STD,R6    C1OLDPSD
*        PUSHED REGS WILL BE POPPED AT PRE-HANDLER EXIT
         B         ENTRNODE-1       A.K.A. RETRY-1
NOCORR   EQU      %
         LI,R6    1
         AWM,R6   RETRYTP
         SLS,R6   3
         CW,R6    RETRYTP
         BE       TOBADTP
         LI,R0    DA(BSRCW)         BACK SPACE
         SIO,R0   *TAPEDEV          TAPE
         BIOSNS   %-1
         TIONEW   *TAPEDEV
         B        NOCORRA
REDOB1   LI,R0    DA(RDBUF1CW)      SET UP FOR READ BUFFER 1
         B        TPX1              PREPARE TO REISSUE READ
NORMRTRY EQU      %
         LW,R12   R12SAV            RESTORE REGISTER 12
         LI,R6    1                 ADD ONE
         AWM,R6   RETRYTP           TO RETRY COUNT
         SLS,R6   3                 GET COUNT OF 8
         CW,R6    RETRYTP           COMPARE RETRY COUNT TO 8
         BE       TOBADTP           BRANCH IF WE HAVE RETRIED 7 TIMES
         TESTBIT  INDICATE,REWRT,6,7  BRANCH IF WRITE COMMD
         LI,R0    DA(SENSECW)       SET  SENSE
         SIO,R0   *TAPEDEV
         BIOSNS   %-1
         LI,R0    DA(BSRCW)         BACKSPACE TAPE ONE RECORD
         SIO,R0   *TAPEDEV
         BIOSNS   %-1
         TIONEW   *TAPEDEV
         LI,R0    DA(SETCORR)       SET  CORRECTION
         SIO,R0   *TAPEDEV
         BIOSNS   %-1
NOCORRA  TESTBIT  INDICATE,STBUF2,5  BRANCH IF READ WAS BUF 2
         LI,R0    DA(RDBUF1CW)      LOAD R0 FOR READ TO BUFFER 1
         B        TPX1              BRANCH TO PREPARE TO RE-ISSUE READ
STBUF2   LI,R0    DA(RDBUF2CW)      LOAD R0 FOR READ TO BUFFER 2
TPX1     EQU      %                 ISSURE COMMD
         SIO,R0   *TAPEDEV
         BIOSNS   %-1
         B        LPSDRET
ABORT    EQU       S:UFV(TOBADTP)
DIE      EQU       S:UFV(TOBADTP)
XSTOP    EQU       S:UFV(TOBADTP)
TOBADTP  EQU      %                 RETRY COUNT EXPIRED
         LI,R6    BA(MSGX4)         MSG ADDR
         BAL,R15  COMTYPE           TYPE 'UNRECOVERABLE TAPE ERROR
         TESTBIT  INDICATE,BDWRT,6,7 BRANCH IF WRITE OPERATION
         LI,R6    BA(MSGX5)         MSG ADDR
         BAL,R15  COMTYPE           TYPE 'READ OPERATION
         B        TPIODIAG          BRANCH TO TYPE STATUS
BDWRT    LI,R6    BA(MSGX5A)        MSG ADDR
         BAL,R15  COMTYPE           TYPE 'WRITE OPERATION
TPIODIAG LW,R9    R1SAVE            GET AIO STATUS
         BAL,R15  PRTHEX            CONVERT HIO STATUS TO GRAPHIC
         LI,R9    8                 SET MSG LENGTH IN WORK
         STW,R9   WORKT             AREA TO 8 BYTES
         LI,R6    BA(MSGY6)         MSG ADDR
         BAL,R15  COMTYPE           TYPE 'AIO STATUS-'
         LI,R6    BA(WORKT)+3       MSG ADDR
         BAL,R15  COMTYPE           TYPE AIO STATUS
         LI,R6    BA(MSGY7)         MSG ADDR
         BAL,R15  COMTYPE           TYPE 'TDV STATUS-'
         LW,R9    R3                GET TDV STATUS
         BAL,R15  PRTHEX            CONVERT FOR TYPING
         LI,R6    BA(WORKT)+3       MSG ADDR
         BAL,R15  COMTYPE           TYPE TDV STATUS
         TIO,R9   *TAPEDEV          GET TIO STATUS
         LI,R6    BA(MSGYA8)        MSG ADDR
         BAL,R15  COMTYPE           TYPE 'TIO STATUS'
         BAL,R15  PRTHEX            CONVERT TIO STATUS FOR TYPING
         LI,R6    BA(WORKT)+3
         BAL,R15  COMTYPE           TYPE ACTUAL STATUS
         LI,R6    4                 SET WORK AREA
         STW,R6   WORKT             COUNT BACK TO 4
         TESTBIT  IND,URE,4,5
ABTP     EQU      %
         LI,R6    BA(MSGX6)         MSG ADDR
         BAL,R15  COMTYPE           TYPE 'JOB ABORTED'
         B        BYLABL            ABORT
REWRT    EQU      %
         LI,R0    DA(BSRCW)         BACKSPACE TAPE ONE RECORD
         SIO,R0   *TAPEDEV
         BIOSNS   %-1               LOOP IF SIO NOT ACCEPTED
         TIONEW   *TAPEDEV
         LI,R0    DA(ERGCW)         SET
         SIO,R0   *TAPEDEV          ERASE
         BIOSNS   %-1
         TESTBIT  INDICATE,SWRTXB2,7  BRANCH IF WE ARE WRITTING BUF 2
         LI,R0    DA(WRTB1CW)       SET UP TO RE-WRITE BUT 1
         B        TPX1              BRANCH TO ISSUE SIO
SWRTXB2  LI,R0    DA(WRTB2CW)       SET UP TO RE-WRITE BUF 2
         B        TPX1
FALTINTR LI,R6    BA(MSGY8)         MSG ADDR
         BAL,R15  COMTYPE           TYPE 'SPURIOUS INTERRUPT'
         LW,R9    R1                GET AIO REG
         BAL,R15  PRTHEX            CONVERT FOR TYPING
         LOADM     8,0,WORKT
         PUSHREG   8,0,SUBSTACK
         LI,R6    8                 SET MSG
         STW,R6   WORKT             LENGTH TO 8
         LI,R6    BA(WORKT)+3
         BAL,R15  COMTYPE           TYPE CONTENTS OF AIO REG
         LI,R6    4                 SET MSG LENGTH
         STW,R6   WORKT             BACK TO 4
         PULLREG   8,0,SUBSTACK
         STOREM    8,0,WORKT
         B        LPSDRET
URE      EQU      %
         LI,R6    BA(ASMS)
         BAL,R15  COMTYPE
         BAL,R15  COMREAD
         LI,R6    BA(INPUT)
         LB,R0    0,R6
         CI,R0    C'X'
         BE       X1ST
         CI,R0    C'M'
         BNE      NOADJ1
         LI,R15   0
         STW,R15  MPCTAPE           REG 9T
ADJ1     AI,R6    2
NOADJ1   EQU      %
         LI,R1    4
         BAL,R15  CPTOHEX
         CI,R9    0
         BE       ABTP
         CW,R9     TAPEDEV          OLD UNIT # VS. NEW
         BE        LPSDRET          CONTINUE ON SAME UNIT #
         STW,R9    TAPEDEV          NEW UNIT # ENTERED.
         MTW,0     MPCTAPE          IS IT XT
         BNEZ      LPSDRET          S: NO..EXIT
*                                   F: YES..DOWNLOAD F/W
* NOW THAT WE'RE SURE IT'S AN MPC TAPE DRIVE AND
* WE'VE CALCULATED ITS ADDRESS, LET'S DOWNLOAD F/W TO IT
*
         PUSHREG   5,13,SUBSTACK    SAVE REGS FOR INSURANCE
         BCS,M2    STKERROR
         LD,R6     IOINTOLD         MPCDWNLD'LL CLOBBER IT SO SAVE
         STD,R6    IOINTSAV
         LCI       8                XTPOS 0-2: BOT , E-O-R , TM
         STCF      XTPOS            SET TO ->  ON    OFF     OFF
         LW,R1     TAPEDEV
         BAL,R14   MPCDWNLD         DOWNLOAD THE F/W TO MPC
         LD,R6     IOINTSAV         RESTORE POST-HANDLER'S PSD
         STD,R6    IOINTOLD
         PULLREG   5,13,SUBSTACK
         B        LPSDRET
*
X1ST     AI,R6    1
         LB,R0    0,R6
         AI,R6    -1
         CI,R0    C'T'
         BNE      ABTP              JUST 'X' ENTERED
         LI,R15   1
         STW,R15  MPCTAPE           FLAG SET FOR 'XT'
         B         ADJ1
*
*
         TITLE    'DISC INTERRUPT SERVICING ROUTINES'
DISCHAND EQU      %                 SERVICE DISC INTERRUPTS
         STW,R1   R1SAVED           SAVE INTERRUPT **FOR DEBUG ONLY**
         TESTBIT  INDICATE,OKDISC,8,9  BRANCH IF DISC BUSY
         B        LPSDRET           NO-RETURN AND IGNORE INTERRUPT
OKDISC   EQU      %
         TDV,R3   *R1
         CW,R3    =1**30            TEST IF FLAW BIT OF TDV IS SET
         BANZ     FLAWHANDLER       YES
         OFFBIT   IND,15
FLAWSKIP EQU      %
         TESTBIT  IND,BF1,8
         STW,R3   HDR2TDV           STORE TDV IN BUF 2 SLOT
         B        BF
BF1      EQU      %
         STW,R3   HDR1TDV
BF       EQU      %
         LCF      CCHOLD
         BCS,M4   DISCERRO
         OFFBIT   INDICATE,8,9,23   SET DISC NOT BUSY
         LI,R0    0
         STW,R0   DRTRY             ZERO DISC RETRY COUNT
         B        LPSDRET           EXIT
DISCERRO EQU      %                 ERROR RECOVERY
         LW,R5    K1FFFF            GET LOAD SELECTIVE MASK
         LS,R5    DISCREC           GET ERROR RECOVERY ADDR
         BCR,M3   DISCERTN          BRANCH IF NO ADDR PROVIDED
         OFFBIT   INDICATE,8,9,23   SET DISC NOT BUSY
         LW,R7    DRTRY             GET RETRY COUNT
         BCS,2    EXI1              BRANCH IF NOT ZERO
         MTW,1    DISCOUNT          ADD 1 TO TOTAL ERRORS
EXI1     EQU      %
         AI,R7    1                 BUMP COUNT
         CI,R7    8                 THIS LAST TRY
         BE       DSTATUS           GO TYPE ERROR MSG
         STW,R7   DRTRY             STORE NEW RETRY COUNT
         B        ABINT             EXIT TO USER ERROR RECOVERY
DISCERTN EQU      %
         LB,R6    R3                GET BITS 0-7 FOR TEST
         CI,R6    128
         BCS,M4   RUNDISC           BRANCH ON OVER RUN
         CI,R6    32
         BCS,M4   NOSECT            BRANCH ON INVALID SEEK ADDR
         CI,R6    16
         BCS,M4   WRPRDSC           BRANCH ON WRITE PROTECT VIOLATION
         TESTBIT  R1,RUNDISC,9      BRANCH IF PARITY ERROR
         LI,R6    BA(MSGY5)         MSG ADDR
         BAL,R15  COMTYPE           TYPE 'UNDEFINED I/O ERROR'
DSTATUS  EQU       %
         TESTBIT  INDICATE,ERCHKWRT,23  BRANCH IF CHK-WRT IN PROGRESS
         B        BYA10
ERCHKWRT EQU      %
         LI,R6    BA(MSGYA10)
         BAL,R15  COMTYPE           TYPE '-CHECK WRITE OPERATION'
BYA10    EQU      %
         LW,R9    R1                GET STATUS
         BAL,R15  PRTHEX            CONVERT FOR TYPING
         LI,R6    8                 SET COUNT FOR
         STW,R6   WORKT             MSG TO 8
         LI,R6    BA(MSGY6)         MSG ADDRESS
         BAL,R15  COMTYPE           TYPE 'AIO STATUS-
         LI,R6    BA(WORKT)+3       MSG ADDR
         BAL,R15  COMTYPE           TYPE            'XXXXXXXX'
         LI,R6    BA(MSGYA8)        MSG ADDR
         BAL,R15  COMTYPE           TYPE 'TIO STATUS'
         TIO,R9   *DISCDEV          GET TIO STATUS
         BAL,R15  PRTHEX            CONVERT FOR TYPING
         LI,R6    BA(WORKT)+3
         BAL,R15  COMTYPE           TYPE ACTUAL STATUS
         TDV,R3    *DISCDEV
         LI,R6    BA(MSGY7)         MSG ADDR
         BAL,R15  COMTYPE           TYPE 'TDV STATUS-'
         LW,R9    R3                GET TDV STATUS
         BAL,R15  PRTHEX            CONVERT FOR TYPING
         LI,R6    BA(WORKT)+3       MSG ADDR
         BAL,R15  COMTYPE           TYPE TDV STATUS
         LI,R6    4                 RESET WORK AREA
         STW,R6   WORKT             COUNT TO 4
         LI,R6    BA(MSGX6)         MSG ADDR
         BAL,R15  COMTYPE           TYPE 'JOB ABORTED
         B        BYLABL            ABORT
RUNDISC  EQU      %
         TESTBIT  INDICATE,ADDCNTR,23  DONT COUNT CHECK-WRITE ERRORS
         LW,R6    DRTRY             GET RETRY COUNT
         BCS,M2   ADDCNTR           BRANCH IF RETRY COUNT GREATER THAB 0
         MTW,M1   DISCOUNT          BO RETRY COUNT ADD 1 TO TOTAL ERRORS
ADDCNTR  EQU      %
         MTW,M1   DRTRY             *             RETRY COUNT
         LW,R6    DRTRY             TEST FOR
         CI,R6    8                 RETRY COUNT = 8
         BE       DDONE             BRANCH WHEN WE HAVE RETIRED 7 TIMES
         TESTBIT  INDICATE,DOBUF2,9 BRANCH IF WE ARE USING BUFFER 2
         LI,R0    DA(BUF1CW1)       SET TO USE BUFFER 1
         B        DSCGO             GO ISSUE ORDER
DOBUF2   LI,R0    DA(BUF2CW1)       SET TO USE BUFFER 2
DSCGO    SIO,R0   *DISCDEV          REISSUE ORDER
         BIOSNS   %-1               ASSURE GOOD START
         B        LPSDRET           RETURN
DDONE    LI,R6    BA(MSGX8)         MSG ADDR
         BAL,R15  COMTYPE           TYPE 'UNRECOVERABLE ERROR ONDISC
         LB,R7     IND
         SLS,R7    -4               C(R2)=0:COPY/1:RESTORE/2:COMPARE
         CI,R7     0
         BNEZ      DSTATUS          ONLY CONTINUE ON A COPY (DISC->TAPE)
         TDV,R2    *DISCDEV         C(R2)=DA(IOCD)  C(R3,HW#1)=RBC
         AND,R3    MM16             ISOLATE RBC
*        CALCULATE SECTOR # (REL. TO 0) IN THIS IOCD THAT GAVE ERROR
*        NOTE THAT THE TDV REPORTS THE ERROR AFTER THE PROBLEM SECTOR
         BAL,R15   ANLZIOCD         R10: WA(BAD BUF)    R11:WA(BUF END)
         STW,R10   ZAPBUF
         LW,R15    MM24
         LW,R14    R10
         SLS,R14   2                C(R14)=BA(BUF BEG)
         STS,R14   ZAPCW+2          JAM INTO ZAPPING CLIST
         BAL,R14   ZEROIT
         STW,R6    ZAPSEEK
         XW,R6     LASTZAP
         CW,R6     LASTZAP          SECTOR STILL BAD AFTER ZAP?
         BE        STILLBAD         YES.
         STW,R13   DRTRY            ZAP RETRY COUNT
         LI,R0     DA(ZAPCW)
         SIO,R0    *DISCDEV
         BIOSNS    %-1              INSURE A GOOD START
         LW,R9     ZAPSEEK
         BAL,R15   PRTHEX           CONVERT LAST SEEK FOR TYPING
         STW,R10   ZAPMSG+5         PUT SEEK ADDR IN MSG
         STW,R11   ZAPMSG+6
         LI,R6     BA(ZAPMSG)       MSG ADDR
         BAL,R15   COMTYPE          PRINT 'BAD SECTOR AT XXXXXXXX ;
         B         ADDCNTR+1        GO REISSUE ORDER
STILLBAD RD,0      0                SENSE SWITCH 4?
         BCR,1     DSTATUS          DOWN: ABORT
*                                   UP: SKIP BAD SECTORS,INFO
         AI,R2     1                NEXT IOCD IN CLIST
         LD,R6     0,R2             CAPTURE IT
         LC        R7               SCAN FOR LAST IOCD IN CLIST (CC NOT SET)
         BCR,1     %-3              NOT YET-REPEAT
         LI,R3     0                GOT IT-SET RBC=0
         BAL,R15   ANLZIOCD
         LW,R10    ZAPBUF
         BAL,R14   ZEROIT           ZERO OUT ENTIRE BAD BUFFER
         LW,R9     ZAPSEEK          FIRST SEEK ADDR LOST
         BAL,R15   PRTHEX
         STW,R10   LOSTMSG+7
         STW,R11   LOSTMSG+8
         LW,R9     R6
         BAL,R15   PRTHEX           LAST SEEK ADDR LOST
         STW,R10   LOSTMSG+11
         STW,R11   LOSTMSG+12
         LI,R6     BA(LOSTMSG)
         LI,R15    BF+2             AFTER MSG, EXIT W/O REISSUING CMND
         B         MSG              REPORT RANGE OF SKIPPED SECTORS
ANLZIOCD LD,R6     0,R2             CAPTURE 'READ 1' IOCD
         AND,R7    MM16             ISOLATE REQ BYTE CNT
         LW,R11    MM24
         LI,R10    0
         LS,R10    R6               C(R10)=BA(BUF BEG)
         LW,R11    R10
         AW,R11    R7               C(R11)=BA(BUF END+1)
         SLD,R10   -2               BOTH GET THE CORRES WA'S
         AI,R11    -1               C(R11)=WA(END)  C(R10)=WA(BEG)
         AI,R2     -1               PREV IOCD (ITS SEEK)
         LD,R8     0,R2             CAPTURE IOCD
         LB,R6     R8               C(R6)=ORDER CODE
         CI,R6     X'03'            IS IT SEEK?
         BNE       DSTATUS          NO..DIE.
         LW,R5     MM24             YES..CAPTURE SEEK ADDR LAST SOUGHT
         LS,R5     R8               C(R5)=DA(SEEK ADDR)
         SLS,R5    -2               C(R5)=WA( "    "  )
         LW,R6     *R5              C(R5)=SEEK ADDR
         SW,R7     R3               C(R7)=# BYTES DONE
         SLS,R7    -10              C(R7)=DONE/(256*4)
         AI,R7     -1                R7-->REL. SECTOR # THAT'S BAD
         LW,R9     R7               SECTOR #
         MI,R9     256              # WDS / SECTOR
         AW,R10    R9               C(R10)=WA(BAD BUF BEG)
         S,R7      *SECTSHFT        SHIFT INTO PLACE IN SEEK FORMAT
         LW,R9     SECTMASK         MASK DELINEATING SECTOR FIELD
         LI,R8     0
         LS,R8     R6               C(R8)=SECTOR FIELD OF LAST SEEK
         AW,R8     R7               C(R8)=WOULD-BE FAULTY SECTOR
         CW,R8     SECTMAX          HAVE I OVERRUN TRACK?
         BL        %+4              NO.
         SW,R8     SECTMAX          YES-CORRECT FOR 1-TRACK OVERRUN
         AW,R6     INCHEAD          BUMP TRACK/BAND # IN SEEK
         B         %-4              TEST AGAIN.
         STS,R8    R6               JAM SECTOR FIELD INTO SEEK
         B         *R15             RETURN
*
*        BAL,R14 ZEROIT ... R10:BEG R11:END
*
ZEROIT   LI,R13    0
         CW,R10    R11
         BG        *R14             THRU-RETURN
         STW,R13   *R10
         AI,R10    1
         B         %-4
NOSECT   LI,R6    BA(MSGY9)         MSG ADDR
         BAL,R15  COMTYPE           TYPE 'INVALID SECTOR ADDR'
         TESTBIT  INDICATE,DKSEC1,8  BRANCH IF BUF 1 IN USE
         LW,R9    BUF2WRD2          GET SEEK ADDR
ABTNOSEC BAL,R15  PRTHEX            CONVERT TO PRINTABLE GRAPHICS
         STW,R10  WORK              STORE RESULT FOR TYPING
         LI,R6    BA(WORKT)+3       MSG ADDR
         BAL,R15  COMTYPE           TYPE SEEK ADDR
         LI,R6    BA(MSGX6)         ABORT MSG ADDR
         BAL,R15  COMTYPE           TYPE 'JOB ABORTED'
         B        BYLABL            ABORT
DKSEC1   LW,R9    BUF1WRD2          GET SEEK
         B        ABTNOSEC          BRANCH TO NOTIFY OPERATOR
WRPRDSC  LI,R6    BA(MSGY10)        MSG ADDR
         BAL,R15  COMTYPE           TYPE 'RAD WRITE PROTECTED. CLEAR WAI
         TESTBIT  INDICATE,WRD1,8    BRANCH IF BUF 1 IN USE
         LI,R0    DA(BUF2CW1)       SET R0 FOR REISSUE BUFFER 2 COMMDS
         LW,R9    BUF2WRD2          GET SEEK ADDR
WRABT    BAL,R15  PRTHEX            CONVERT FOR PRINTING
         STW,R10  WORK              STORE RESULT
         STW,R0   BOOTRET           SAVE R0
         LI,R6    BA(WORKT)+3       ADDR OF MSG
         BAL,R15  COMTYPE           TYPE SEEK ADDR
         LI,R6    4096              ARM AND DISABLE
         WD,R6    X'1300'           COUNTER 4
         WAIT     0                 WAIT
         LI,R6    4144              ARM AND ENABLE
         WD,R6    4608              ALL INTERRUPTS
         LW,R0    BOOTRET           RESTORE R0
         SIO,R0   *DISCDEV          RE-ISSUE CW
         BIOSNS   %-1
         B        LPSDRET           RETURN
WRD1     LI,R0    DA(BUF1CW1)       SET R0 FOR REISSUE BUFFER 1 COMMDS
         LW,R9    BUF1WRD2          GET SEEK ADDR
         B        WRABT             GO DECODE
         TITLE    'ABNORMAL INTERRUPT EXIT ROUTINE'
ABINT    EQU      %                 EXIT TO ERROR RECOVERY
         LB,R3    IOINTOLD
         STB,R3   R5                CC TO PSD
         STW,R5   IOINTOLD          STORE IN I/O OLD PSD
         B        LPSDRET
FLAWHANDLER EQU  %
         TESTBIT  IND,FLAWSKIP,15
         SETBIT   IND,15
         LD,R0    IOINTOLD          GET IO INT PSD
         PUSHREG  2,0,SUBSTACK      STORE IN STACK
         LPSD,M3  FLLPSD            CLEAR IO INT LEVEL
FLLPSDX  EQU     %
         TESTBIT  IND,FLAW2,9       CHECK IF FLAW WAS BUFFER 2
FLAW1    EQU     %                  NO
         LW,R1    =X'00FFFFFF'      LOAD MASK
         LI,R0    BA(BUF1WRD2)      SET UP
         STS,R0   CWHDRR             FLAW I/O
         STS,R0   CWHDRRX
         LI,R0    BA(BUF1DATA)        COMMAND
         LB,R3    BUF1CW1+2               PREVIOUS
FLAW     EQU      %
* IF NOT 7242 OR 7270, USE ALTERNATE ROUTINE (FLAW60).
         LW,R1    INCREMNT
         CW,R1    M7242+4
         BNE      FLAW60
*
         STB,R3   R0                       OPERATION
         STW,R0   BUFCMDLST+2          LISTS
         AI,R0    6*1024                FOR BUFFER 1,
         STW,R0   BUFCMDLST+6            REPEAT OF
         LI,R0    DA(CWHDRR)        SET UP TO READ HEADER
         SIO,R0   *DISCDEV
         BIOSNS   %-1
         TIONEW   *DISCDEV
         LI,R1    BA(HDRDATA1)
         LI,R2    BA(FLSEEK1)+1
         LB,R0    0,R1              CHECK IF FIRST TRACK FLAWED
         BEZ      NOFL1         NO
         AI,R1    5             YES LOAD ALTERNATE
         BAL,R14  LDFL               TO SEEK
FL2CK    EQU     %
         LI,R1    BA(HDRDATA2)
         LI,R2    BA(FLSEEK2)+1
         LB,R0    0,R1              CHECK IF SECOND TRACK FLAWED
         BEZ      NOFL2         NO
         AI,R1    5             YES LOAD ALTERNATE
         BAL,R14  LDFL               TO SEEK
FLCOMP   EQU     %
         LI,R0    DA(BUFCMDLST)
         WD,0     NOALLOW           INHIBIT INTERUPTS
         SIO,R0   *DISCDEV          REPEAT USER I/O REQUEST
         BIOSNS   %-1
         PULLREG  2,0,SUBSTACK      GET USER PSD
         STD,R0   LPSDLOC
         PULLREG  0,0,SUBSTACK      PULL REGS
         LPSD,0   LPSDLOC           RETURN TO USER
FLAW2    EQU     %                  FLAW WAS BUFFER 2
         LW,R1    =X'00FFFFFF'      LOAD MASK
         LI,R0    BA(BUF2WRD2)      SET UP
         STS,R0   CWHDRR             FLAW I/O
         LI,R0    BA(BUF2DATA)        COMMAND
         LB,R3    BUF2CW1+2            LISTS
         B        FLAW
NOFL1    EQU     %
         AI,R1    2                 NO FLAW ON FIRST TRACK
         BAL,R14  LDFL               USE ORIGINAL SEEK
         B        FL2CK
NOFL2    EQU     %
         AI,R1    2                 NO FLAW ON SECOND TRACK
         BAL,R14  LDFL               USE ORIGINAL SEEK
         B        FLCOMP
LDFL     EQU     %
         LW,R0    HISEEK            SPECIAL FOR
         CW,R0    M7242+1           7270 AND 7275
         BNE      LDFLX             BECAUSE #CYL=412
         LB,R0    0,X1
         CI,R0    NOCYL
         BGE      FLAERR            ALT CYL OUT OF RANGE
         STB,R0   0,X2
         AI,X1    1
         AI,X2    1
         LB,R0    0,X1
         CI,R0    NOTRK
         BGE      FLAERR            ALT TRACK OUT OF RANGE
         STB,R0   0,X2
         B        *R14
LDFLX    EQU      %                 GET ALT. SEEK FOR 7270/7275
         LB,R0    0,X1              ALT CYL(LOW 8 BITS)
         AI,X1    1
         LB,R3    0,X1              ALT TRACK (AND HIGH BIT OF CYL)
         CI,R3    X'80'             HIGH ORDER BIT OF ALT CYL
         BAZ      %+3               NOT SET
         AND,R3   =X'7F'            SET- TURN IT OFF
         OR,R0    =X'100'           AND SET IT WHERE IT BELONGS
         CI,R0    NOCYL70           ALT CYL IN RANGE
         BGE      FLAERR            NO-ERROR
         SLS,X2   -1                CHANGE TO HALFWORD INDEX
         STH,R0   0,X2              ALT CYL
         LW,R0    M7275+4           SEE IF 7275
         CW,R0    INCREMNT
         BE       %+3               B/ ITS 7275
         CI,R3    NOTRK             7270-20 TRACKS PER CYL
         B        %+2
         CI,R3    NOTRK-1           7275-ONLY 19 TRACKS/CYL
         BGE      FLAERR            ALT TRACK OUT OF RANGE
         SLS,R3   8                 SHIFT INTO PLACE
         AI,X2    1
         STH,R3   0,X2
         B        *14
FLAW60   EQU      %                 ALT. ROUTINE FOR NON-7242 TYPES
         STB,R3   R0                ORDER(READ OR WRITE)
         STW,R0   BUFCMDLSTX+2      IOCD(WORD 1)
         LI,R0    DA(CWHDRRX)       SET UP TO READ HEADER
         SIO,R0   *DISCDEV
         BIOSNS   %-1
         TIONEW   *DISCDEV
         LI,R1    BA(HDRDATA1)
         LI,R2    BA(FLSEEK1)+1
         LB,R0    0,R1              SEE IF TRACK IS REALLY FLAWED
         BEZ      FLAERR            NO-ERROR
         AI,R1    5
         BAL,R14  LDFL              SET UP ALT. SEEK
         LI,R0    DA(BUFCMDLSTX)    REPEAT USER REQUEST USING ALT SEEK
         B        FLCOMP+1
         TITLE    'END-OF-JOB ROUTINE'
ENDJOBS  EQU      %                 END-OF-JOB ROUTINE
BYLABL   EQU      %
         LI,R1    4144              ARM & ENABLE &RESET INHIBITS
         WD,R1    4608              FOR
         WD,R0    ALLOW             ALL INTERRUPTS
         TESTBIT  INDICATE,BYLAB,2,3  DONT WRITE TAPE MARKS ONE RESTORE
*                                    AND COMPARE JOBS
         IOREQ    T,WTM,0      COPY-WRITE-- TAPE MARK
         BAL,R7    XTORNOT
         LI,R0     RITEEOF          SET0 NODE IF XT
         LI,R0    DA(EORWRT)             -- END OF FILE LABEL
         IOREQ    T,SET0,0                -- AND
         IOREQ    T,WTM,0                -- DOUBLE
         IOREQ    T,WTM,0                -- TAPE MARKS
BYLAB    EQU       %
         BAL,R7    XTORNOT
         LI,R0     RON              SET0 NODE FOR XT
         LI,R0     DA(REWCW)        REWIND TAPE
         IOREQ    T,SET0,0
         LW,R9    BUF1WRD2          FIND LAST SEEK ADDR USED
         CW,R9    BUF2WRD2
         BG       USE1              BRANCH IF BUF 1 SEEK HI
         LW,R9    BUF2WRD2          BUF 2 WAS LAST USED
USE1     EQU      %                 REG 9 HAS LAST USED SEEK ADDR
         BAL,R15  PRTHEX            CONVERT LAST SEEK FOR TYPING
         LI,R6    BA(MSGYA9)        MSG ADDR
         BAL,R15  COMTYPE           PRINT 'LAST USED SEEK ADDR-'
         LI,R6    8
         STW,R6   WORKT             SET TEXTC FOR 8 BYTES
         LI,R6    BA(WORKT)+3       DATA ADDR
         BAL,R15  COMTYPE           TYPE ACTUAL SEEK ADDR
         LI,R6    4
         STW,R6   WORKT             SET TEXTC TO J BYTES
          PAGE
*
*  PRINT ERROR MESSAGES IF ANY
*  BEFORE GIVING ACCOUNTING INFORMATION
*
           LW,R9     TAPECOUT       GET TAPE ERROR COUNT
         BAL,R15  PRTHEX            CONVERT FOR TYPING
         STW,R11  MSGTPER1          STORE IN MESSAGE
         LI,R6    BA(MSGTPER)       TYPE 'TOTAL TAPE ERRORS XXXX
         BAL,R15  COMTYPE
         LW,R9    DISCOUNT
         BAL,R15  PRTHEX            CONVERT FOR TYPING
         STW,R11  MSGDCER1          STORE IN MSG
         LI,R6    BA(MSGDCER)       TYPE
         BAL,R15  COMTYPE           'TOTAL DISC ERRORS XXXX
          PAGE
         LW,R5    TIME              GET CURRENT TIME
         SW,R5    PRETIME           SUBTRACT TIME JOB STARTED
         LI,R4    0                 TIME IS IN MILLI-SECONDS
         DW,R4    THOUSAND          GET TOTAL SECONDS
         LI,R4    0
         DW,R4    SIXTY             GET MINUTES AND SECONDS
         BAL,R15  PRTDEC            CONVERT TO PRINTABLE DECIMAL
         LI,R1    7                 STORE
         LI,R2    3                 MINUTES
STWMIN1  LB,R3    DBLWRD,R1         IN
         STB,R3   JT1,R2            OUT PUT
         AI,R1    -1                MESSAGE
         BDR,R2   STWMIN1           FOR TYPING
         LW,R5    R4                PUT SECONDS IN R5
         BAL,R15  PRTDEC            CONVERT TO PRINTABLE DECIMAL
         LI,R3    3                 PLACE
         LI,R2    1                 SECONDS
         LH,R4    DBLWRD,R3         INTO
         STH,R4   JT2,R2            MESSAGE
         LI,R6    BA(JBTIME)-1      FOR PRINTING
         BAL,R15  COMTYPE           TYPE
         LW,R5    TIME              GET CURRENT COUNTER 4. THIS IS
         LI,R4    0                 TIME IN MILLI-SECONDS SINCE PROGRAM
         DW,R4    THOUSAND          WAS BOOTED.
         LI,R4    0                 THIS IS TYPED AS
         DW,R4    SIXTY             TOTAL COMPUTER
         BAL,R15  PRTDEC            TIME
         LI,R1    7
         LI,R2    3
STWMIN2  LB,R3    DBLWRD,R1
         STB,R3   ACC1,R2
         AI,R1    -1
         BDR,R2   STWMIN2
         LW,R5    R4
         BAL,R15  PRTDEC
         LI,R3    3
         LI,R2    1
         LH,R4    DBLWRD,R3
         STH,R4   ACC2,R2
         LI,R6    BA(ACCTIME)-1
         BAL,R15  COMTYPE
         TESTBIT  INDICATE,BOOTDC,13
         B        BEGIN
BOOTDC   DISABLE
         HIO,0     *BOOTDEV
         LW,R0     BOOTDEV
         STW,R0    X'25'
         LI,R1     14
         LI,R5     -1
         WD,R5     X'110F'          DISARM ALL EXT INTERRUPTS
         MTW,-1    %-1
         BDR,1     %-2
         LI,R2     -X'500'+8        CLEAR CORE BELOW .A000 EXC REGS
         STD,R1    X'A000',R2
         BIR,R2    %-1
         LI,R0     DA(AUTO)
         SIO,0    *BOOTDEV
         TIONEW   *BOOTDEV
         B        X'2A'
STKERROR LI,R6    BA(STKMSG)        *TEST*
         BAL,R15  COMTYPE           *
         TIONEW   *TYPEDEV
STKMSG   TEXTC    '
STACK OVERFLOW FORCE TRAP'
         TITLE     'MPC TAPE PRE-PROCESSOR I/O TABLE'
*                  N O D E
*
*        ************************************
*        *  PRE   * POST N * POST E *///////*
*        ************************************
*        *   F L I N K    N O D E           *
*        ************************************
*        *   I O C D ' S   (TILL N C C )    *
*        *=  =  =  =  =  =  =  =  =  =  = = *
*        *                                  *
*        ************************************
*        *         I  D  C  W  '  S         *
*        *=  =  =  =  =  =  =  =  =  =  = = *
*        *                                  *
*        ************************************
*
*        IDCW PICTURE
*
*0       *6        *12      *18  *21 * 22 * 23 *24           *30-->63
*--------*---------*--------*----*---*----*----*-------------*---->
*        *         *        *    *   *    *    *             *    >
* DEVICE * DEVICE  * MBZ    * 7  * M * C  * M  * CHANNEL     * S  >
* INST   * ADDRESS * FIELD  *    * A * O  * A  * INST        * P  >
* FIELD  * FIELD   * AREA   *    * S * N  * R  * FIELD       * I  >
*        *         *        *    * K * T  * K  *             * L  >
*        *         *        *    *   *    *    *             *    >
*--------*---------*--------*----*---*----*----*-------------*---->
*
:NODE    CNAME
         PROC
LF       EQU       %
         DO        AF(1)=0
         DATA,1    0
         ELSE
         DATA,1    AF(1)-PREBOT
         FIN
         DO        AF(2)=0
         DATA,1    0
         ELSE
         DATA,1    AF(2)-POSTNBOT
         FIN
         DO        AF(3)=0
         DATA,1    0
         ELSE
         DATA,1    AF(3)-POSTEBOT
         FIN
         DATA,1    0                PAD WORD
         BOUND     4                INSURANCE
         DATA      WA(AF(4))
         PEND
SKIP     EQU      1                 SKIP FLAG
CC       EQU      X'2E'             COMMAND CHAIN
NCC      EQU      X'1E'             INTERRUPT AT CHANNEL END
DINT     EQU      X'0E'             WAIT FOR DEVICE INTERRUPT ONLY
*                                   ICE NOT SET HERE
*
:IOCDX   CNAME
         PROC
         BOUND    8
LF       GEN,8,24,8,4,20            AF(1),BA(AF(2)),AF(3),8,AF(4)
         PEND
*
:IDCW    CNAME
         PROC
         BOUND    8
LF       SET      %
         GEN,6,6,6,3,1,1,1,6,6,28    AF(1),;  DEVICE COMMAND
                                         0,;  DEVICE ADDRESS
                                         0,;  MBZ
                                         7,;  MUST BE ALL ONES
                                         0,;  MASK FIELD
                                     AF(2),;  CONTINUE BIT
                                         0,;  MARK BIT
                                     AF(3),;  CHANNEL INSTRUCTION
                                     AF(4),;  PRECORD COUNT
                                         0    SPILL FOR SIGMA D/W
         PEND
         PAGE
         BOUND     8
*
*        MPC TAPE I/O TABLE
*
XTIOTBL  EQU       %
         SPACE     1
** BACKSPACE TAPE ONE FILE
         SPACE     1
BSF      :NODE     XEQIO,POSTN:BSF,POSTE:BSF,BSF
         :IOCDX    3,XT:BSFIDCW,NCC,5
XT:BSFIDCW EQU %
         :IDCW     X'27',0,2           OCTAL'47'
         SPACE     1
** BACKSPACE FILE ONE RECORD
         SPACE     1
XBSR     :NODE     XEQIO,POSTN:BSR,POSTE:BSR,BSR
         :IOCDX    3,XT:BSRIDCW,NCC,5
XT:BSRIDCW EQU     %
         :IDCW     X'26',0,2,1         OCTAL'46'
         SPACE     1
** REWIND TAPE UNIT ON-LINE FOR DENSITY CHANGE
         SPACE     1
DENSREW  :NODE     PRE:DENSREW,POSTN:DENSREW,POSTE:DENSREW
         :IOCDX    3,XT:RONIDCW,DINT,5
         SPACE     1
** ERASE TAPE
         SPACE     1
ERS      :NODE     XEQIO,POSTN:ERS,POSTE:ERS
         :IOCDX    3,XT:ERSIDCW,NCC,5
XT:ERSIDCW EQU     %
         :IDCW     X'2C',0,2           OCTAL'54'
         SPACE     1
** FORWARD SPACE TAPE ONE FILE
         SPACE     1
XFSF     :NODE     XEQIO,POSTN:FSF,POSTE:FSF,FSF
         :IOCDX    3,XT:FSFIDCW,NCC,5
XT:FSFIDCW EQU     %
         :IDCW     X'25',0,2           OCTAL'45'
         SPACE     1
** FORWARD SPACE FILE ONE RECORD
         SPACE     1
XFSR     :NODE     XEQIO,POSTN:FSR,POSTE:FSR,FSR
         :IOCDX    3,XT:FSRIDCW,NCC,5
XT:FSRIDCW EQU     %
         :IDCW     X'24',0,2,1         OCTAL'44'
         SPACE     1
** READ RECORD FROM TAPE
         SPACE     1
READ     :NODE     PRERDWRT,POSTN:READ,POSTE:READ,READC
         :IOCDX    3,XT:READIDCW,CC,5
         :IOCDX    2,,NCC
XT:READIDCW EQU    %
         :IDCW     X'03',0,X'10'       OCTAL'03'
         SPACE     1
** WRITE PROGRAM ONTO TAPE
         SPACE     1
RITEPGM  :NODE     PRE:RTPGM,POSTN:RTPGM,POSTE:RTPGM,RITEC
         :IOCDX    3,XT:RITEIDCW,CC,5
         :IOCDX    1,,NCC
         SPACE     1
** WRITE RECORD ONTO TAPE
         SPACE     1
RITE     :NODE     PRERDWRT,POSTN:RITE,POSTE:RITE,RITEC
         :IOCDX    3,XT:RITEIDCW,CC,5
         :IOCDX    1,,NCC
XT:RITEIDCW EQU    %
         :IDCW     X'0B'               OCTAL'13'
         SPACE     1
** REWIND TAPE UNIT OFF-LINE
         SPACE     1
ROF      :NODE     PRE:ROF,POSTN:ROF,POSTE:ROF
         :IOCDX    3,XT:ROFIDCW,DINT,5
XT:ROFIDCW EQU     %
         :IDCW     X'3A',0,2           OCTAL'72'
         SPACE     1
** REWIND TAPE UNIT ON-LINE
         SPACE     1
RON      :NODE     PRE:RON,POSTN:RON,POSTE:RON
         :IOCDX    3,XT:RONIDCW,DINT,5
XT:RONIDCW EQU     %
         :IDCW     X'38',0,2           OCTAL'70'
         SPACE     1
** SET TAPE DENSITY @ 800 BPI
         SPACE     1
SET800   :NODE     XEQIO,POSTN:800,POSTE:800
         :IOCDX    3,XT:800IDCW,NCC,5
XT:800IDCW EQU     %
         :IDCW     X'30',0,2           OCTAL'60'
         SPACE     1
** SET TAPE DENSITY @ 1600 BPI
         SPACE     1
SET1600  :NODE     XEQIO,POSTN:1600,POSTE:1600
         :IOCDX    3,XT:1600IDCW,NCC,5
XT:1600IDCW EQU    %
         :IDCW     X'35',0,2           OCTAL'65'
         SPACE     1
** WRITE TAPE MARK
         SPACE     1
TM       :NODE     XEQIO,POSTN:TM,POSTE:TM,TMC
         :IOCDX    3,XT:TMIDCW,NCC,5
XT:TMIDCW EQU      %
         :IDCW     X'2D',0,2           OCTAL'55'
         SPACE     1
*
*        FORWARD READ ERROR CORRECTION SEQUENCE
*
         SPACE     1
** BACKSPACE OVER BAD READ
         SPACE     1
READC    :NODE     XEQIO,POSTN:READC,POSTE:READC,READC1
         :IOCDX    3,XT:BSRIDCW,NCC,5
         SPACE     1
** RE-READ THE RECORD
         SPACE     1
READC1   :NODE     PRERDWRT,POSTN:READC1,POSTE:READC1,READC
         :IOCDX    3,XT:READCIDCW,CC,5
         :IOCDX    2,,NCC
XT:READCIDCW EQU   %
         :IDCW     X'03',0,X'10'       OCTAL'03'
         SPACE     1
*
*        WRITE TAPE ERROR CORRECTION SEQUENCE
*
         SPACE     1
** BACKSPACE OVER BAD WRITE
         SPACE     1
RITEC    :NODE     XEQIO,POSTN:RITEC,POSTE:RITEC,RITEC1
         :IOCDX    3,XT:BSRIDCW,NCC,5
         SPACE     1
** BACKSPACE OVER LAST GOOD RECORD
         SPACE     1
RITEC1   :NODE     XEQIO,POSTN:RITEC1,POSTE:RITEC1,RITEC2
         :IOCDX    3,XT:BSRIDCW,NCC,5
         SPACE     1
** GET BYTE COUNT OF LAST GOOD WRITTEN RECORD
         SPACE     1
RITEC2   :NODE     XEQIO,POSTN:RITEC2,POSTE:RITEC2,RITEC3
         :IOCDX    3,XT:READIDCW,CC,5
         :IOCDX    2,0,NCC+SKIP
         SPACE     1
** ERASE TAPE
         SPACE     1
RITEC3   :NODE     XEQIO,POSTN:RITEC3,POSTE:RITEC3,RITEC4
         :IOCDX    3,XT:ERSIDCW,NCC,5
         SPACE     1
** RE-WRITE RECORD
         SPACE     1
RITEC4   :NODE     PRERDWRT,POSTN:RITEC4,POSTE:RITEC4,RITEC5
         :IOCDX    3,XT:RITEIDCW,CC,5
         :IOCDX    1,0,NCC,2
** BACKSPACE OVER RE-WRITE
         SPACE     1
RITEC5   :NODE     XEQIO,POSTN:RITEC5,POSTE:RITEC5,RITEC6
         :IOCDX    3,XT:BSRIDCW,NCC,5
         SPACE     1
** BACKSPACE OVER LAST GOOD WRITTEN RECORD
         SPACE     1
RITEC6   :NODE     XEQIO,POSTN:RITEC6,POSTE:RITEC6,RITEC7
         :IOCDX    3,XT:BSRIDCW,NCC,5
         SPACE     1
** CHECK BYTE COUNT OF LAST GOOD REC
         SPACE     1
RITEC7   :NODE     XEQIO,POSTN:RITEC7,POSTE:RITEC7,RITEC8
         :IOCDX    3,XT:READIDCW,CC,5
         :IOCDX    2,0,NCC+SKIP
         SPACE     1
** CHECK BYTE COUNT OF RE-WRITTEN REC
         SPACE     1
RITEC8   :NODE     XEQIO,POSTN:RITEC8,POSTE:RITEC8,RITEC
         :IOCDX    3,XT:READIDCW,CC,5
         :IOCDX    2,0,NCC+SKIP
         SPACE     1
*
*        TAPE MARK ERROR CORRECTION SEQUENCE
*
         SPACE     1
** BACKSPACE OVER BAD TAPE MARK
         SPACE     1
TMC      :NODE     XEQIO,POSTN:TMC,POSTE:TMC,TMC1
         :IOCDX    3,XT:BSRIDCW,NCC,5
         SPACE     1
** ERASE TAPE WHERE BAD TM IS
         SPACE     1
TMC1     :NODE     XEQIO,POSTN:TMC1,POSTE:TMC1,TM
         :IOCDX    3,XT:ERSIDCW,NCC,5
SET0:BEG EQU       %                SET0 NODES START HERE
         SPACE     1
** DOWNLOAD THE ROS MEMORY ON THE MPC
         SPACE     1
ROS:LD   :NODE     PRE:DWNLD,POSTN:SET0,POSTE:SET0
         IOPCW     3,BA(ROSIDCW),X'28',5
         IOPCW     1,0,X'08',0
ROSIDCW  DATA      X'20003800',0
         SPACE     1
** DOWNLOAD THE R/W MEM OF THE MPC
         SPACE     1
RW:LD    :NODE     PRE:DWNLD,POSTN:SET0,POSTE:SET0
         IOPCW     3,BA(RWIDCW),X'28',5
         IOPCW     1,0,X'08',0
RWIDCW   DATA      X'24003800',0
         SPACE     1
** RESET THE MPC
         SPACE     1
XRESET   :NODE     PRE:DWNLD,POSTN:SET0,POSTE:SET0
         IOPCW     7,,0,1
READ:BEG EQU      %                 SPECIAL READS START HERE
         SPACE     1
** READ REC INTO BUFFER 1
         SPACE     1
READBUF1 :NODE     PRE:RDBF1,0,0,READC
         SPACE     1
** READ REC INTO BUFFER 2
         SPACE     1
READBUF2 :NODE     PRE:RDBF2,0,0,READC
         SPACE     1
** READ TRAILER FROM TAPE
         SPACE     1
READEOF  :NODE     PRE:RDEOF,0,0,READC
         SPACE     1
** READ DIRECTORY FROM TAPE
         SPACE     1
READDIR  :NODE     PRE:RDDIR,0,0,READC
         SPACE     1
READ:END EQU      %                 SPECIAL READS END HERE
         SPACE     1
         RES       2                SO THAT READ:END ~= RITE:BEG
         SPACE     1
RITE:BEG EQU      %                 SPECIAL RITES START HERE
*                                   W/ THE EXCEPTION OF RITE PG,
** WRITE REC FROM BUFFER 1 ONTO TAPE
         SPACE     1
RITEBUF1 :NODE     PRE:RTBF1,POSTN:RITE,0,RITEC
         SPACE     1
** WRITE REC FROM BUFFER 2 ONTO TAPE
         SPACE     1
RITEBUF2 :NODE     PRE:RTBF2,POSTN:RITE,0,RITEC
         SPACE     1
** WRITE DIRECTORY ONTO TAPE
         SPACE     1
RITEDIR  :NODE     PRE:RTDIR,POSTN:RITE,0,RITEC
         SPACE     1
** WRITE END-OF-FILE    (' EOF            ')
         SPACE     1
RITEEOF  :NODE     PRE:RTEOF,POSTN:RITE,0,RITEC
         SPACE     1
** WRITE END-OF-REEL    ('*EOR            ')
         SPACE     1
RITEEOR  :NODE     PRE:RTEOR,POSTN:RITE,0,RITEC
         SPACE     1
** WRITE BOOTSTRAP RECORD ONTO TAPE
         SPACE     1
RITEBOOT :NODE     PRE:RTBOOT,POSTN:RITE,0,RITEC
RITE:END EQU      %                 SPECIAL RITES END HERE
         SPACE     1
** READ IN TRAILER REC (EITHER '*EOR' OR ' EOF')
         SPACE     1
FAKENODE :NODE     0,0,0,0
XREOF    :IOCDX    3,XT:READIDCW,CC,5
         :IOCDX    2,WORK,DINT,8
         TITLE     'MPC TAPE POST-PROCESSOR TABLES'
:GNVCT   COM,8    AF-ERR
*
MAJ:STAT EQU      %                 MAJOR STATUS VECTOR
         DATA,1   0                 (READY)
         :GNVCT   DEVBUSY           1 - DEVICE BUSY
         :GNVCT   DEVATTN           2 - DEVICE ATTENTION
         :GNVCT   DEVDALRT          3 - DEVICE DATA ALERT
         :GNVCT   ENDOFILE          4 - END OF FILE
         :GNVCT   CMDREJ            5 - COMMAND REJECT
         :GNVCT   ERR               6
         :GNVCT   ERR               7
         :GNVCT   ERR               8
         :GNVCT   ERR               9
         :GNVCT   MDEVATTN          A - MPC DEVICE ATTENTION
         :GNVCT   MDEVDLRT          B - MPC DEVICE DATA ALERT
         :GNVCT   ERR               C
         :GNVCT   MPCMDREJ          D - MPC COMMAND REJECT
         :GNVCT   ERR               E
         :GNVCT   ERR               F
         BOUND    4
         PAGE
         LOCAL    STOP,OPER,ERROR,WPROTECT,BLANKTAP,EOT,EOF,USERERR,;
                  BOT,DENSITY,MBOT,CORRERR
*
STOP      EQU      0
STOPP    EQU       0
OPER     EQU      1
ERROR    EQU      2
WPROTECT EQU      3
BLANKTAP EQU      4
EOT      EQU      5
EOF      EQU      6
USERERR  EQU      7
BOT      EQU      8
DENSITY  EQU      9
MBOT     EQU      10
CORRERR  EQU      11
         PAGE
:GENDAT  CNAME
         PROC
         LIST     0
         DO       AF(1)>0
         DO1      AF(1)-P%-1
         DATA,1   STOPP             W/IN PROC META PICKS UP GLOBAL SYMBOL
         FIN
         LIST     1
         DATA,1   AF(2)
P%       SET      AF(1)
         PEND
*
         PAGE
ERR      EQU      %-1
DEVBUSY  EQU      %                 0001  DEVICE BUSY
         :GENDAT  0,STOP            FILL OUT
         :GENDAT  1,ERROR           IN REWIND
         :GENDAT  2,ERROR           ALTERNATE CHANNEL IN CONTROL
         :GENDAT  4,OPER            DEVICE LOADING
         :GENDAT  X'20',ERROR       DEVICE RESERVED
         :GENDAT  X'3F',STOP        FILL OUT
DEVATTN  EQU      %                 0010  DEVICE ATTENTION
         :GENDAT  0,STOP            FILL OUT
         :GENDAT  1,WPROTECT        WRITE PROTECTED
         :GENDAT  2,OPER            NO SUCH DRIVE
         :GENDAT  4,OPER            DRIVE IN STANBY
         :GENDAT  5,WPROTECT
         :GENDAT  8,OPER            DRIVE CHECK(DEVICE FAULT)
         :GENDAT  9,WPROTECT
         :GENDAT  X'C',OPER
         :GENDAT  X'D',WPROTECT
         :GENDAT  X'10',OPER        BLANK TAPE ON WRITE
         :GENDAT  X'14',OPER
         :GENDAT  X'15',OPER
         :GENDAT  X'18',OPER
         :GENDAT  X'19',OPER
         :GENDAT  X'1C',OPER
         :GENDAT  X'1D',OPER
         :GENDAT  X'3F',STOP        FILL OUT
DEVDALRT EQU      %                 0011  DEVICE DATA ALERT
         :GENDAT  0,STOP            FILL OUT
         :GENDAT  1,ERROR           TRANSFER TIMING ALERT
         :GENDAT  2,BLANKTAP        BLANK TAPE ON READ
         :GENDAT  3,STOP            BIT DETECTED DURING ERASE
         :GENDAT  4,ERROR           TRANSMISSION PARITY ALERT(DROP OUT)
         :GENDAT  7,STOP            BIT DETECTED DURING ERASE
         :GENDAT  8,ERROR           LATERAL PARITY ALERT
         :GENDAT  X'B',STOP         BIT DETECTED DURING ERASE
         :GENDAT  X'C',ERROR
         :GENDAT  X'F',STOP         BIT DETECTED DURING ERASE
         :GENDAT  X'10',ERROR       LONGITUDINAL PARITY ALERT
         :GENDAT  X'13',STOP        BIT DETECTED DURING ERASE
         :GENDAT  X'14',ERROR
         :GENDAT  X'17',STOP        BIT DETECTED DURING ERASE
         :GENDAT  X'18',ERROR
         :GENDAT  X'1B',STOP        BIT DETECTED DURING ERASE
         :GENDAT  X'1C',ERROR
         :GENDAT  X'1F',STOP        BIT DETECTED DURING ERASE
I        DO       X'1F'
         :GENDAT  X'1F'+I,EOT       END OF TAPE
         FIN
         :GENDAT  X'3F',STOP        INCOMPATIBLE CHAR.
ENDOFILE EQU      %                 0100  END OF FILE
I        DO       X'40'
         :GENDAT  I-1,EOF           END OF FILE
         FIN
CMDREJ   EQU      %                 0101  COMMAND REJECT
         :GENDAT  0,USERERR         INVALID DENSITY
         :GENDAT  1,ERROR           INVALID OPERATION CODE
         :GENDAT  2,ERROR           INVALID DEVICE CODE
         :GENDAT  3,ERROR
         :GENDAT  4,ERROR           INVALID IDCW PARITY
         :GENDAT  5,ERROR
         :GENDAT  6,ERROR
         :GENDAT  7,ERROR
         :GENDAT  8,BOT             UNEXPECTED BOT
         :GENDAT  X'10',USERERR     FORWARD READ AFTER WRITE
         :GENDAT  X'20',ERROR       NINE TRACK ERROR
         :GENDAT  X'3F',STOP        FILL OUT
MDEVATTN EQU      %                 1010  MPC DEVICE ATTENTION
         :GENDAT  0,STOP            FILL OUT
         :GENDAT  1,OPER            CONFIGURATION SWITCH ERROR
         :GENDAT  2,OPER            MULTIPLE DEVICES
         :GENDAT  3,OPER            ILLEGAL DEVICE ID NUMBER
         :GENDAT  8,DENSITY         INCOMPATIBLE MODE
         :GENDAT  X'C',OPER         TCA MALFUNCTION
         :GENDAT  X'D',OPER
         :GENDAT  X'E',OPER
         :GENDAT  X'F',OPER
         :GENDAT  X'10',OPER        MTH MALFUNCTION
         :GENDAT  X'11',MBOT        MULTIPLE BOT
         :GENDAT  X'3F',STOP        FILL OUT
MDEVDLRT EQU      %                 1011  MPC DEVICE DATA ALERT
         :GENDAT  0,STOP            FILL OUT
         :GENDAT  1,ERROR           TRANSMISSION PARITY ALERT
         :GENDAT  2,ERROR           INCONSISTANT COMMAND
         :GENDAT  3,ERROR           SUM CHECK ERROR
         :GENDAT  4,ERROR           BYTE LOCKED OUT
         :GENDAT  8,ERROR           PE-BURST WRITE ERROR
         :GENDAT  9,ERROR           PREAMBLE ERROR
         :GENDAT  X'10',ERROR       MULTI-TRACK ERROR
         :GENDAT  X'11',ERROR       SKEW ERROR
         :GENDAT  X'12',ERROR       POSTAMBLE ERROR
         :GENDAT  X'13',CORRERR     NRZI CCC ERROR(CORRECTABLE)
         :GENDAT  X'14',ERROR       CODE ALERT
         :GENDAT  X'20',ERROR       MARGINAL CONDITION
         :GENDAT  X'3F',STOP        FILL OUT
MPCMDREJ EQU      %                 1101  MPC COMMAND REJECT
         :GENDAT  0,STOP            FILL OUT
         :GENDAT  1,ERROR           ILLEGAL PROCEDURE
         :GENDAT  2,ERROR           ILLEGAL LC NUMBER
         :GENDAT  3,ERROR           ILLEGAL SUSPENDED LC NUMBER
         :GENDAT  4,ERROR           CONTINUE BIT NOT SET
         :GENDAT  X'3F',STOP        FILL OUT
         LOCAL
         TITLE    'DOUBLE WORD CONSTANTS'
***
*  *              CONSTANTS
***
         BOUND    8
IOINTOLD DATA,8   0
IONEWPSP GEN,8,7,17,8,24  7,0,INTERR,7,0
CPOLDPSD DATA,8   0
CPNEWPSD GEN,8,7,17,8,24   7,0,CPMRTN,7,0
REOFCW   IOPCW    2,WORK,0,8
RDBUF1CW IOPCW    2,BUF1WRD1,X'1E',12304  READ TAPE INTO BUFFER  1
RDBUF2CW IOPCW    2,BUF2WRD1,X'1E',12304  *    *    *    *       2
WRTB1CW  IOPCW    1,BUF1WRD1,X'1E',12304  WRITE TAPE FROM BUFFER 1
WRTB2CW  IOPCW    1,BUF2WRD1,X'1E',12304  *    *    *    *       2
LPCDWT   IOPCW    1,WORK,0,0
REWCW    IOPCW    51,REWCW,0,1
OFFLINE  IOPCW    35,BSRCW,0,1      REWIND OFF LINE ORDER
ERGCW    IOPCW    99,ERGCW,0,1
BSRCW    IOPCW    75,BSRCW,00,1
SENSECW  IOPCW    4,SENSEDTA,0,1
SETCORR  IOPCW    3,SENSEDTA,0,1
WTMCW    IOPCW    115,WTMCW,0,1
START    GEN,8,24,8,24     7,PROG,0,0
TIMEUP   DATA,8   0
         GEN,8,24,8,24  7,XTME,7,0
ERRORPSD DATA,8   0
         GEN,8,24,8,24  7,DUMP,7,0
FSFCW    IOPCW    83,FSFCW,0,1
FSRCW    IOPCW    67,FSRCW,0,1
EORCW    IOPCW    1,OEORF,0,16
RDDIR    IOPCW    2,CNTDIR,14,500
WRDIRTRY IOPCW    1,CNTDIR,14,500
EORWRT   IOPCW    1,OEORR,0,16
RDCOMMD  IOPCW    6,INPUT,0,80
AUTO     IOPCW     3,ZERO,X'22',4   CARRIAGE RESTORE
         IOPCW     2,X'A8',2,88     READ BOOTSTRAP INTO X'2A'
LOGCW    IOPCW    5,INPUT,0,0
TYPECW   IOPCW    5,TYPECW,0,1
READCW   IOPCW    134,INPUT,0,50
BOOTRITE IOPCW    1,MTBOOT,14,BOOTBYT
PGMRITE  IOPCW    1,0,14,0
M800CW   IOPCW    X'0B',MOD800,0,1
MOD800   GEN,8,24  X'48',0
M1600CW  IOPCW    X'0B',MOD1600,0,1
MOD1600  GEN,8,24  X'88',0
DENSW    DATA     0
DJOBSW   DATA     0
         BOUND    8
SUBSTACK DATA     REGSTACK,X'80808000'
ALTSUB   DATA     REGSTACK,X'80808000'
BUFCMDLST   EQU  %
         XXX      X'03',BA(FLSEEK1)
         XXX      X'22',4
         XXX      X'12',BA(BUF1DATA)
         XXX      X'2E',6*1024
         XXX      X'03',BA(FLSEEK2)
         XXX      X'22',4
         XXX      X'12',BA(BUF1DATA)+6*1024
         XXX      X'1E',6*1024
BUFCMDLSTX XXX    3,BA(FLSEEK1)
         XXX      X'22',4
         XXX      X'12',BA(BUF1DATA)
         XXX      X'1E',11*1024
CWHDRR   EQU     %
         XXX      X'03',BA(BUF1WRD2)
         XXX      X'22',4
         XXX      X'0A',BA(HDRDATA1) READ HEADER
         XXX      X'0E',2*6*8
CWHDRRX  XXX      3,BA(BUF1WRD1)
         XXX      X'22',4
         XXX      X'0A',BA(HDRDATA1)  READ HEADER
         XXX      X'0E',11*8
LPSDLOC  RES      2
FLLPSD   EQU     %
         XXX      X'7',FLLPSDX
         XXX      0,0
FLSEEK1  DATA     0
FLSEEK2  DATA     0
HDRDATA1 RES,1    6*8
HDRDATA2 RES,1    6*8
OEORR    TEXT     ' EOF            '
OEORF    TEXT     '*EOR            '
SAVEDATE DATA,8   0
DTEHOLD  DATA,8   0
         BOUND    8
REGSTACK EQU      %
*        ZERO     STACK
         LIST     0
         DO1      X'80'
         DATA     0
         LIST     1
         RES      1
WORKT    DATA     4
WORK     DATA     0,0,0
         DATA     0,0,0,0,0,0
DBLWRD   EQU      WORK
RETRYTP  DATA     0
JOBSTACK DATA     STACK1
         GEN,4,12,4,12   8,30,8,0
WRKJOBSK DATA     STACK2
         GEN,4,12,4,12   8,30,8,0
PJOBSTK  DATA     STACK1
         GEN,4,12,4,12   8,30,8,0
PWRKSTK  DATA     STACK2
         GEN,4,12,4,12   8,30,8,0
         BOUND    8
STACK2   EQU      %
         DO       30
         DATA     0
         FIN
         TITLE    'WORD CONSTANTS'
XTME     LPSD,M3  TIMEUP
LOSEEK   DATA     0
HISEEK   DATA     X'1FFF0000'
COUNT    DATA     11520
FIRSTSEK DATA     0
INCREMNT DATA     32**16
COUNTSEC DATA     360
INCSEK   DATA     INC234
SECTSHFT DATA      16
SECTMASK DATA      X'F'**16
SECTMAX  DATA      16**16
INCHEAD  DATA      1**(16+4)
M7202    DATA     0,X'07FF0000',32*360,0,32*256*256,360,INC234
         DATA      16,X'F'**16,16**16,1**(16+4)
M7203    DATA     0,X'0FFF0000',32*360,0,32*256*256,360,INC234
         DATA      16,X'F'**16,16**16,1**(16+4)
M7204    DATA     0,X'1FFF0000',32*360,0,32*256*256,360,INC234
         DATA      16,X'F'**16,16**16,1**(16+4)
M7211    DATA     0,(63**23)+(81**16),12*1024,0,12*256*256,1024,INC11
         DATA      16,X'7F'**16,82**16,1**(16+7)
M7221    DATA     0,X'1FFB0000',12*1024,0,16*256*256,1024,INC21
         DATA      16,X'F'**16,12**16,1**(16+4)
M7242    DATA     0,(199**16)+(19**8),12*1024,0,2**8,1024,INC42
         DATA      0,X'7'**0,6**0,1**8
M7260    DATA     0,(199**16)+(19**8),11*1024,0,1**8,1024,INC60
         DATA      0,X'F'**0,11**0,1**8
M7270    DATA     0,(399**16)+(19**8),12*1024,0,2**8,1024,INC70
         DATA      0,X'7'**0,6**0,1**8
M7275    DATA     0,(399**16)+(18**8),11*1024,0,1**8,1024,INC75
         DATA      0,X'F'**0,11**0,1**8
M3275    DATA     0,(403**16)+(18**8),12*1024,0,1**8,1024,INC77
         DATA      0,X'F'**0,12**0,1**8
M3282    DATA     0,(807**16)+(18**8),12*1024,0,1**8,1024,INC82
         DATA      0,X'F'**0,12**0,1**8
M3214    DATA     0,(255**20)+(10**16),11*1024,0,16*256*256,1024,INC21
         DATA      0,X'F'**0,12**0,1**8
ZERO     DATA     0
RDISC    DATA     0
X1SAV    RES      1
IND      EQU     %
INDICATE DATA,4   0                 PROGRAM STATUS INDICATOR
BOOTDEV  DATA     0
CURRSEEK RES      1
CWRTERR  DATA     0
INTERM   DATA     0
X40      XPSD,0   ERRORPSD
X41      XPSD,0   ERRORPSD
X42      XPSD,0   ERRORPSD
X43      XPSD,0   ERRORPSD
X46      XPSD,0   ERRORPSD
X48      XPSD,4   C1OLDPSD          6
X49      XPSD,4   C2OLDPSD
X55      MTW,2    TIME              9
X56      XPSD,0   ERRORPSD
X5B      XPSD,0   TIMEUP
X5C      XPSD,0   IOINTOLD
X5D      XPSD,0   CPOLDPSD
TIME     DATA     0
TAPEREC  DATA     0
DISCREC  DATA     0
TAPECOUT DATA     0
SENSEDTA DATA     0
DISCOUNT DATA     0
DRTRY    DATA     0
DISCDEV  DATA     0
TAPEDEV  DATA     0
TYPEDEV  DATA     KEYBOARD
CARDDEV  DATA     3
PRINTDEV DATA     2
THOUSAND DATA     1000
SIXTY    DATA     60
CRMSG    DATA     X'02151500'
M7202MSK DATA     '0202'
M7203MSK DATA     '0303'
M7204MSK DATA     '0404'
M7211MSK DATA     '1212'
M3214MSK DATA     '1414'
M7221MSK DATA     '3232'
M7242MSK DATA     '4242'
M7260MSK DATA     '6060'            7260
M7270MSK DATA     '7070'            7270
M7275MSK DATA     '7575'            7275
M3277MSK DATA     '7777'
M3282MSK DATA     '8282'
MODEL    DATA     0
GP1DC    DATA     'DCXX'
GP2DN    DATA     'DNXX'
DXCNT    DATA     0
CWSAV    DATA     0
DDEV     DATA     0
PDISC    DATA     240,128
PRETIME  DATA     0
LSTSEEK  DATA     X'1F80'
BOOTRET  DATA     0
TEN      DATA     10
TPAIO    DATA     X'B8480000'
BREP     IOPCW     3,BUF2WRD2,34,4
         DATA     0
         DATA     X'1E000000'
RGO      B        LOAD2
TYPEORDR GEN,8,24  5,0
         BOUND    8                 DBLWD BOUNDARY
BACKENTPSD RES     2
XENT1PSD GEN,8,7,17,8,24      7,0,MPCENT1,5,0
C1OLDSAV RES       2
IOINTSAV EQU       C1OLDSAV
READ:LIM DATA     READ:BEG,READ:END RANGE OF SPECIAL READ NODES
RITE:LIM DATA     RITE:BEG,RITE:END   "   "     "    RITE   "
DENS:LIM DATA     SET800,SET1600
TDV%STATUS RES     2
SET0:ERR DATA      0                USER SPEC'D ERR RET FOR SET0
REQX     DATA      0                NODE THAT INITIATED I/O IN PROGRESS
TIO%STATUS DATA    0
AIO%STATUS EQU     R1SAVE
AIO%CC   EQU       CCHOLD
SIO%CC   RES       1
TDV%CC   RES       1
MPCTAPE  DATA      0
BUFFER   RES       1
NBYTES   RES       1
LAST1SIZ DATA      0                PRESERVED SIZE OF LAST GOOD REC
XTRET    DATA      0
CURRENTX DATA      0                NODE CURRENTLY AT (PRE-PROCESSOR)
CALLINGX DATA      0                PRESERVES USER'S ORIGINAL I/O REQ
REDOX    RES       1
XTPOS    DATA      0                BITS 0-2: BOT,E-O-R,TM
ERASE    DATA      0                # ERASURES TO BE DONE
NTRIES   EQU      10                # RETRIES FOR EACH ERR COND
NRETR    DATA      0                # RETRIES LEFT
DENSAV   DATA      0                DENSITY FOR 'COPY' FUNCTION
DENSBAD  DATA      0                # DENSITY REJECTS
HOPE4READ DATA     0                CORRECTABLE READ FLAG
NRITES   DATA      0                # BAD WRITES SO FAR THIS REC
NBLOX    DATA      0                # BLOCKS PROGRAM OCCUPIES
NRECDONE DATA      0                # BLOCKS ALREADY DUMPED ONTO TAPE
PGMSIZ   DATA     0
BACKENTRY DATA     0
XPCTDINT DATA      0
MM3      DATA      X'7'             LAST 3 BITS SET
MM4      DATA      X'F'              "   4   "   "
MM6      DATA      X'3F'             "   6   "   "
MM16     DATA      X'FFFF'           "  16   "   "
MM17     DATA      X'1FFFF'          "  17   "   "
MM20     DATA      X'FFFFF'          "  20   "   "
MM24     DATA      X'FFFFFF'         "  24   "   "
         BOUND     8
ZAPCW    IOPCW     X'03',ZAPSEEK,X'2E',4
         IOPCW     X'01',0,X'0E',X'400'  WRITE OUT SECTOR OF 0'S
ZAPBUF   RES       1
ZAPSEEK  DATA      0
LASTZAP  DATA      0                LAST SECTOR THAT WAS ZAPPED
         TITLE    'TEXT AND TYPE OUT MESSAGES'
MSGX1    TEXTC    '
SYSTEM SAVE/RESTORE    VERSION    '
         ORG      %-1
         TEXT      ' B00'
MSGX2    TEXTC    '
KEY-IN COMMANDS
'
MSGX4    TEXTC    '
UNRECOVERABLE TAPE ERROR'
MSGX5    TEXTC    ' - READ OPERATION'
MSGX5A   TEXTC    ' - WRITE OPERATION'
MSGX6    TEXTC    '
  -ABORT***'
MSGX7    TEXTC    '
DISC UNIT UNAVAILABLE -'
MSGX8    TEXTC    '
UNRECOVERABLE ERROR ON DISC'
MSGX9    TEXTC    '
CANNOT DECODE COMMAND '
         BOUND    8
INPUT    EQU      %
         DO       20
         TEXT     '    '
         FIN
BLANK    TEXT     '            '
DIRMSG1  TEXTC    '
DIRECTORY OF CONTENTS'
DIRMSG2  TEXTC    '
TAPE CREATED--'
DIRMSG4  TEXTC    '
MODEL 7200 RAD(S)'
DIRMSG5  TEXTC    '
  00F0'
MSGDATE  TEXTC    '
KEY IN DATE. (DD MM YY)- '
REQDC    TEXTC    '  WILL BE REPLACED BY  ? '
NOINP    DATA,1   2,X'15',C'?',0
ASMS     TEXTC    '
 ASSIGN NEW TAPE UNIT NUMBER '
MSGY2    TEXTC    '
TAPE UNIT NOT READY. CLEAR WAIT WHEN READY'
MSGY3    TEXTC    '
TAPE UNIT WRITE PROTECTED. CLEAR WAIT WHEN READY'
MSGY4    TEXTC    '
END OF REEL. ASSIGN NEW TAPE-- (NDD)'
MSGY5    TEXTC    '
UNDEFINED I/O ERROR'
MSGY6    TEXTC    '
AIO STATUS-'
MSGY7    TEXTC    '
TDV STATUS-'
MSGY8    TEXTC    '
SPURIOUS INTERRUPT-- '
MSGY9    TEXTC    '
INVALID SECTOR ADDR -'
MSGYA8   TEXTC    '
TIO STATUS-'
MSGYA9   TEXTC    '
LAST USED SEEK ADDR-- '
MSGYA10  TEXTC    ' -CHECK WRITE OPERATION'
MSGY10   TEXTC    '
RAD WRITE PROTECTED. CLEAR WAIT WHEN READY -'
         DATA     44
JBTIME   TEXT     '
TIME FOR THIS JOB  '
JT1      TEXT     ' 000 MINUTES'
JT2      TEXT     '  00 SECONDS'
         DATA     44
ACCTIME  TEXT     '
TOTAL COMPUTER TIME'
ACC1     TEXT     ' 000 MINUTES'
ACC2     TEXT     '  00 SECONDS'
MSGTPER  TEXTC    '
TOTAL TAPE ERRORS      '
MSGBCR   TEXTC    '
CR BAD'
MSG::001 TEXTC    ' -WHILE WRITING BOOT RECORDS'
MSG::002 TEXTC    '
UNABLE TO RECOGNIZE DISC TYPE'
MSGTPER1 EQU      MSGTPER+5
MSGXX    TEXTC    'TAPE WRITE PROTECTED'
MSGDCER  TEXTC    '
TOTAL DISC ERRORS      '
MSGDCER1 EQU      MSGDCER+5
NOMODMSG TEXTC    'ABORT--NO MODEL NBR BEFORE GROUP'
NODMSG   TEXTC    'ABORT--NO DISC ADR BEFORE GROUP'
MSG421   TEXTC    '
ERROR READING HDRS'
TYP001   TEXTC    '
MT MUST PRECEED DN IN CMMND LIST
'
ZAPMSG   TEXTC     ' ... BAD SECTOR AT XXXXXXXX ; ZEROED'
LOSTMSG  TEXTC     ' AGAIN ...  SECTORS LOST:  XXXXXXXX  THRU  YYYYYYYY'
         TITLE    'COPY ROUTINE ---DISC TO TAPE'
JOBDT    EQU      %
         OFFBIT   IND,16,19
         LD,R2    JOBSTACK          MOVE STACK POINTER OUT TO DIRECTORY
         STD,R2   DIRSTACK          TO BE WRITTEN ON TAPE
         LI,R2    0
         STW,2    MODEL
MVETABLE EQU      %                 REVERSE JOBS IN STACK SO THEY WILL
         PLW,R2   JOBSTACK          BE EXECUTED IN EXACTLY THE SAME
         BCS,2    STRE:LST          BR ON LAST DEV.
         LW,R2    R2                TEST FOR MODEL NBR
         BLZ      SAVE%M            BR TO SAVE MOD NBR
         PSW,R2   WRKJOBSK          LOOP THIS RTN TILL STACK
         B        MVETABLE          EMPTY
         SPACE    2
SAVE%M   XW,R2    MODEL             STORE NEW MODEL & PICK UP LST
         BEZ      MVETABLE          BR IF ZERO
         PSW,R2   WRKJOBSK          SAVE MODEL NBR
         B        MVETABLE          CONTINUE MOVE
STRE:LST LW,R2    MODEL
         PSW,R2   WRKJOBSK          SAVE IN STACK
         LI,R2    0
         STW,R2   MODEL
         PLW,R2   WRKJOBSK          GET MODEL NBR FROM STACK
BK42     EQU      %
         BAL,R15   GETMODEL         ADDR OF MULTIPLE BACK IN R15
         LCI       11
         LM,2      *R15
         STM,2     LOSEEK           PLACE FACTOR TABLE IN PLACE
         LW,R2    DJOBSW            IS THIS A RESTORE FUNC
         BEZ      JOBDTGO1          BRANCH IF NO
         LI,R2    0
         STW,R2   DJOBSW            RESET RESTORE FUNC FLAG
         B        JOBRES01
JOBDTGO1 EQU      %
         OFFBIT   INDICATE,20       RESET END SWITCH
         PLW,R2   WRKJOBSK          GET WORD FROM WORKING JOB STACK
         BCS,2    ENDJOBS           END IF STACK EMPTY
         LW,R2    R2
         BCR,2    BK42
         STW,R2   DISCDEV           STORE WORD AS DISC ADDR
         OFFBIT   IND,25                TURN OFF OVERLAP BIT
         LW,R0     TAPEDEV          CHECK IF TAPE AND
         LI,R1    X'1F00'            DISC ARE ON THE
         CS,R0     DISCDEV            SAME IOP
         BE       JOBDTGO
         SETBIT   IND,25            NO - SET OVERLAP BIT
         B        JOBDTGO
JOBSCH   EQU      %
         TESTBIT  INDICATE,SCH1,4,5,6,7,8,9  BRANCH IF I/O BUSY
         B        JOBDTGO1
SCH1     EQU      %                 CLEAR I/O INTERRUPTS
         WAIT     0
         B        JOBSCH
JOBDTGO  EQU      %
         TESTBIT  INDICATE,ONTAPE,19
         BAL,R15  WRTBOOT           WRITE PROG TO TAPE
         BAL,R15  WRTDIR            WRITE DIRECTORY TO TAPE
         SETBIT   INDICATE,19       SET INDICATOR FOR PROG ON TAPE
ONTAPE   EQU      %
         LI,R1    0                 SET CURRETN SEEK TO ZERO
         LW,R2    DISCDEV           SET UP CURRENT
         STW,R2   BUF1WRD4          DISC ADDRESS
         STW,R2   BUF2WRD4          IN BUFFERS
         STW,R1   BUF1WRD3          CLEAR MODEL
         STW,R1   BUF2WRD3          NBR INDICATOR
         LW,R2    FIRSTSEK
         STW,R2   CURRSEEK
         STW,R2   BUF1WRD2
         LW,R2    COUNT             SET COUNT
         LI,X3    1
         STH,R2   BUF1WRD1,X3       STORE IN OUTPUT
DTTE     EQU      %
         IOREQ    D,RD1,0           READ DISC INTO BUFFER 1
         IOREQ    D,WTE,0           WAIT FOR TERM
         IOREQ    T,WRT1,0          WRITE TAPE FROM 1
         TESTBIT  IND,DTTF,25       NO WAIT IF OVERLAP
         IOREQ    T,WTE,0           WAIT
DTTF     EQU      %
         LI,R14   BUF2WRD1          SET UP TO INCREMENT DISC SEEK
         BAL,R15  *INCSEK           INCREMENT
         TESTBIT  IND,JOBSCH,20     CHECK IF DISC THRU
         IOREQ    D,RD2,0           READ DISC TO 2
         IOREQ    D,WTE,0           WAIT
         IOREQ    T,WRT2,0          WRITE TAPE FROM 2
         TESTBIT  IND,DTTH,25       NO WAIT IF OVER LAP
         IOREQ    T,WTE,0           WAIT
DTTH     EQU      %
         LI,R14   BUF1WRD1          SET UP TO INCREMENT DISC SEEK
         BAL,R15  *INCSEK           INCREMENT
         TESTBIT  IND,JOBSCH,20     CHECK IF DISC THRU
         B        DTTE              LOOP BACK
FLAERR   EQU     %
TYPE%1   LI,R6    BA(MSG421)
         BAL,R15  COMTYPE           TYPE 'ERROR READING HDRS
         LI,R6    BA(MSGX6)
         BAL,R15  COMTYPE           TYPE '***ABORT
         B        ENDJOBS
         TITLE    'RESTORE ROUTINE ---TAPE TO DISC'
*****                                                             ******
*    *                                                           *     *
********          RESTORE TAPE TO DISC                          ********
*    *                                                           *     *
*****                                                             ******
JOBREST  EQU      %
         LI,R2    X'FF'
         STW,R2   DJOBSW            SET JOB RESTORE FLAG
         B        MVETABLE-2        GO SET CNTL TABLE
JOBRES01 EQU      %
         IOREQ    T,REW,0           REWIND AND POSITION
         PLW,R15   WRKJOBSK         EMPTY JOB STACK
         BCR,2     %-1
         BAL,R15   DIR%READ         READ DIRECTORY FROM TAPE
STKNEXT  PLW,R1    DIRSTACK
         BCS,2     STKTHRU
         LW,R1     R1               MODEL # OR DEV ADDR?
         BLZ       %+3              MODEL #
         PSW,R2    WRKJOBSK         DEV ADDR, SO PUSH ITS MULTIPLE'S ADDRDR
         B         STKNEXT          GET NEXT
         LW,R2     R1               SET NEW MODEL #
         BAL,R15   GETMODEL         R15->THAT MODEL'S INFO MULTIPLE
         LW,R2     R15
         B         STKNEXT          GET NEXT
STKTHRU  EQU       %                CONTINUE
         OFFBIT   IND,17
         OFFBIT   IND,25                TURN OFF OVERLAP BIT
         IOREQ    T,RD1,0           READ TAPE TO 1
         IOREQ    T,WTE,0           WAIT
         LW,R2    TAPEDEV           CHECK IF TAPE AND
         LI,R3    X'1F00'            DISC ARE ON THE
         CS,R2    BUF1WRD4            SAME IOP
         BE       TTD
         SETBIT   IND,25            NO - SET OVERLAP BIT
TTD      EQU      %             RESTORE TAPE TO DISC
         TESTBIT  IND,CMPRTN,2      TEST IF COMPARE OR RESTORE
TTDE     EQU      %
         TESTBIT  IND,ENDJOBS,17    TEST FOR EOF FROM TAPE
         IOREQ    D,WRT1,0          WRITE DISC FROM 1
*        SENSE SWITCH 1 UP ---> AUTOMATIC CHECK-WRITE VERIFICATION
         RD,0      0
         BCR,8     %+2
         IOREQ     D,CHK1,0
         TESTBIT  IND,TTDF,25       NO WAIT IF OVERLAP
         IOREQ    D,WTE,0           WAIT
TTDF     EQU      %
         IOREQ    T,RD2,0           READ TAPE TO 2
         IOREQ    T,WTE,0           WAIT
         TESTBIT  IND,ENDJOBS,17    TEST FOR EOF FROM TAPE
         IOREQ    D,WRT2,0          WRITE DISC FROM 2
*        SENSE SWITCH 1 UP ---> AUTOMATIC CHECK-WRITE VERIFICATION
         RD,0      0
         BCR,8     %+2
         IOREQ     D,CHK2,0
         TESTBIT  IND,TTDH,25       NO WAIT IF OVERLAP
         IOREQ    D,WTE,0           WAIT
TTDH     EQU      %
         IOREQ    T,RD1,0           READ TAPE TO 1
         IOREQ    T,WTE,0           WAIT
         B        TTDE              LOOP BACK
         TITLE    'COMPARE ROUTINE --- TAPE TO DISC'
*
*        COMPARE ROUTINE  (CMPR)
*
CMPRTN   EQU      %
TCDA     EQU      %
         TESTBIT  IND,ENDJOBS,17    TEST FOR EOF ON TAPE
         IOREQ    T,RD2,0           READ TAPE TO 2
         TESTBIT  IND,TCDB,25       NO WAIT IF OVERLAP
         IOREQ    T,WTE,0           WAIT
TCDB     EQU      %
         IOREQ    D,CHK1,TCD1       CHECKWRITE DISC AGAINST 1
         IOREQ    D,WTE,TCD1        WAIT
         IOREQ    T,WTE,0           WAIT FOR TAPE
         TESTBIT  IND,ENDJOBS,17    TEST FOR EOF ON TAPE
         IOREQ    T,RD1,0           READ TAPE TO 1
         TESTBIT  IND,TCDD,25       NO WAIT IF OVERLAP
         IOREQ    T,WTE,0           WAIT
TCDD     EQU      %
         IOREQ    D,CHK2,TCD2       CHECKWRITE DISC AGAINST 2
         IOREQ    D,WTE,TCD2        WAIT
         B        TCDA              LOOP BACK
TCD1     EQU      %
         MTW,1    CWRTERR           COUNT CHECKWRITE ERROR
         BLZ      TCDB               CONTINUE IF LESS THAN 10
         B        CMPR%02             ERROR IF 10
TCD2     EQU      %
         MTW,1    CWRTERR           COUNT CHECKWRITE ERROR
         BLZ      TCDD               CONTINUE IF LESS THAN 10
         B        CMPR%02             ERROR IF 10
CMPR%02   RES       0
          LI,R6     BA(CMPR%03)
          LI,R15    ENDJOBS        TYPE CHECK-WRITE ERROR MESSAGE
          B         COMTYPE        AND EXIT TO ENJOB ROUTINE
CMPR%03   TEXTC     '

*** CHECK-WRITE ERROR...VERIFICATION ABORTED ***'
         TITLE    'CONTROL PANEL ROUTINES'
****
*   *             ENTRY FROM INTERRUPT AT CONSOLE
****                                               CONTROL PANEL MONITOR
CPMRTN   STOREM   0,0,CPSAVER
         LOADM    4,R10,PI          PLACE REASON FOR DUMP ON
         STOREM   4,R10,PIP         HEADING LINE
CPHERE   EQU      %
         HIO,R0   *TYPEDEV
         BAL,R15  CPTYPE
         BAL,R15  CPREAD
         LI,R6    BA(CPINPUT)+1     SET PTR TO SECOND CHARACTER
         LB,R1    CPINPUT
         CI,R1    C'D'              CHECK FOR DUMP
         BE       DMPRTN
         CI,R1    C'P'              CHECK FOR PRINT
         BE       DMPRTN
         CI,R1    C'L'              CHECK FOR LPXXX
         BE       CPLORTN
         LOADM    0,0,CPSAVER
         LPSD,M3  CPOLDPSD
****
*   *             ENTRY ON ILLEGAL TRAP
****
DUMP     EQU      %
         STOREM   0,0,CPSAVER       SAVE REGS
         LI,R0    DA(TYPDMP)
         HIO,R0   *TYPEDEV
         SIO,R0   *TYPEDEV          TYPE ERROR MSG
         BIOSNS   %-1
         LW,R9    ERRORPSD          GET TRAPPED PSD AND CONVERT IT FOR
         BAL,R15  TOPRINT           PRINTING ON THE CONSOLE TELE-TYPE
         STOREM   2,R10,ERRMSG1A    AND ON THE HEADING LINE OF THE
         STOREM   2,R10,PIP         POST MORTEM DUMP
         LW,R9    ERRORPSD+1
         BAL,R15  TOPRINT
         STOREM   2,R10,ERRMSG1B
         STOREM   2,R10,PIP+2
         LI,R6    BA(ERRMSG1)+2
         BAL,R15  COMTYPE           GO TYPE TRAP PSD
         TIONEW   *TYPEDEV
         LI,R1    BYLABL            SET UP FOR RETURN TO THE
         STW,R1   CPOLDPSD          END OF JOB ROUTINE
         B        CPHERE            GO TO MONITOR
         TITLE    'POST MORTEM DUMP ROUTINE'
*
*
**
* *               POST MORTEM DUMP REQUEST -DMP-
**
DMPRTN   EQU      %
         LB,R0    0,R6
         AI,R6    1
         CI,R0    C' '              CHECK FOR DELIMITER
         BLE      CPDNXT            DELIMITER FOUND
         B        DMPRTN            CONTINUE SEARCH
CPDNXT   EQU      %
         LB,R0    0,R6
         CI,R0    C' '              CHECK FOR DELIMITER
         BLE      CPCOUNT
         CI,R0    C'A'              CHECK FOR 'A'
         BE       CHKALL             CHECK FOR ALL
         B        DUMPX             USE SUPPLIED LIMITS
CPCOUNT  EQU      %
         AI,R6    1
         CI,R6    BA(CPINPUT)+15    CHECK IF ALL BUFFER CHECKED
         BLE      CPDNXT            NO - CONTINUE
         B        DMPALL            YES - NO LIMITS , DUMP ALL
CHKALL   EQU      %
         AI,R6    1
         LB,R0    0,R6              LOAD CHAR AFTER 'A'
         AI,R6    -1
         CI,R0    C'L'              CHECK IF IT IS AN L
         BNE      DUMPX             NO , ASSUME HEX LIMITS SUPPLIED
DMPALL   EQU      %
         LI,R14   ENDLAB            YES-GET HI-CORDE ADDR
         STW,R14  CPEND             STORE IN HI-LIMIT
         LI,R14   32                GET LO-CORE LIMIT
         STW,R14  CPBEG             STORE IN BEGIN ADDR
         B        CPGO              GO DUMP THIS AREA OF CORE
DUMPX    EQU      %                 USER HAS PROVIDED DUMP LIMITS.
         LI,R1    8                 SET CHAR CNT TO 8
         BAL,R15  CPTOHEX           CONVERT LO LIMIT
         STW,R9   CPBEG             STORE
         LI,R1    8                 SET CHAR CNT TO 8
         BAL,R15  CPTOHEX           CONVERT TO BINARY
         STW,R9   CPEND             SET THIS VALUE AS HI-LIMIT
         LW,R14   CPBEG             SET POINTER TO LO-LIMIT
CPGO     EQU      %                 BEGIN DUMP
         OFFBIT   EORSW,1           TURN OFF DUPLICATE LINE SWITCH
         LW,R6    CPZEROS           GET WORD ' 000'
         STW,R6   PGNBR+1           STORE AS PAGE NUMBER IN HEADING LINE
         BAL,R13  SKIPER            EJECT PAPER AND PRINT HEADING
         LW,R9    CPREGS            GET WORD 'REGS' FOR LABEL ON LISTING
         STW,R9   CPADDR1           STORE 'REGS' INADDR COLUMN OF
         STW,R9   CPADDR2           DUMP
         LI,R5    8                 COUNT FOR 8 REGS ON LINE
         LI,X6    0                 INPUT INDEX TO 0
         LI,X7    0                 OUTPUT INDEX TO 0
CPRO     EQU      %                 DUMP REGS 0-7.
         LW,R9    CPSAVER,X6        GET REGISTER
         BAL,R15  TOPRINT           CONVERT FOR PRINTING
         LCI      2
         STM,R10  CPDATA1+1,X7      PLACE ON PRINT LINE 'BUFFER 1'
         AI,X6    1                 STEP TO NEXT REG
         AI,X7    3                 GO TO NEXT COLUMN ON DUMP    *OUTPUT
         BDR,R5   CPRO              CONVERT  8 REGS
         BAL,R15  CPRINT1           PRINT LINE 1 FROM BUFFER 1
*
         LI,R5    8                 DUMP 8 MORE REGS
         LI,X7    0                 OUTPUT INDEX TO 0
CPR1     EQU      %                 DUMP REGS  8-15
         LW,R9    CPSAVER,X6        GET REGISTER
         BAL,R15  TOPRINT           CONVERT FOR PRINTING
         LCI      2
         STM,R10  CPDATA2+1,X7      PLACE ON PRINT LINE 'BUFFER 2'
         AI,X6    1                 STEP TO NEXT REG             * INPUT
         AI,X7    3                 GO TO NEXT COLUMN ON DUMP    *OUTPUT
         BDR,R5   CPR1              CONVERT 8 REGS
         BAL,R15  CPRINT2           PRINT LINE 2 FROM BUFFER 2
*
CPLINE1  EQU      %                 BEGIN MEMORY DUMP
         LI,R5    8                 8 WORDS PER LINE
         LI,X7    0                 OUTPUT INDEX IO0
         LW,R9    R14               GET ADDR FOR THIS LINE
         BAL,R15  TOPRINT           CONVERT FOR PRINTING
         STW,R11  CPADDR1           STORE IN ADDR COLUMN
CPLINE1A EQU      %                 SET UP PRINT LINE IN BUFFER 1
         LW,R9    *R14              GET 1 WORD TO CONVT
         BAL,R15  TOPRINT           CONVERT
         LCI      2
         STM,R10  CPDATA1+1,X7      STORE IN PRINT LINE
         AI,X7    3                 BUMP--OUTPUT INDEX
         AI,R14   1                       INPUT INDEX
         CW,R14   CPEND             ARE WE AT HI-LIMIT
         BCS,M2   CPDONE1           BRANCH IF SO
         BDR,R5   CPLINE1A          PUT 8 WORDS IN LINE
         BAL,R15  CPRINT1           GO PRINT THIS LINE
         LI,R5    8                 SET FOR 8 WORDS PER LINE
         LI,X7    0                 OUTPUT INDEX
         LW,R9    R14               GET CURRENT ADDR
         BAL,R15  TOPRINT           CONVERT
         STW,R11  CPADDR2           STORE IN ADDR COLUMN OF PRINT LINE
*                          SET UP LINE IN BUFFER 2
CPLINE2  EQU      %
         LW,R9    *R14              GET WORD OF DATA
         BAL,R15  TOPRINT           CONVERT FOR PRINTING
         LCI      2
         STM,R10  CPDATA2+1,X7      STORE IN PRINT LINE
         AI,X7    3                 BUMP--OUTPUT INDEX
         AI,R14   1                       INPUT
         CW,R14   CPEND             ARE WE AT HI-LIMIT
         BCS,M2   CPDONE2           BRANCH IF SO
         BDR,R5   CPLINE2           PUT 8 WORDS ON PRINT LINE
         BAL,R15  CPRINT2           GO PRINT THIS LINE
         B        CPLINE1           GO SET UP A LINE IN BUFFER 1
*                 COME HERE WHEN HI-LIMIT REACHED AND WE ARE USING
*                 BUFFER 1. WE WILL BLANK FILL ANY UNUSED PRINT POSITION
*                           IN THE LINE.
CPDONE1  EQU      %
         LOADM    2,R10,CPBLANKS    GET BLANKS
CPD1A    LCI      2
         STM,R10  CPDATA1+1,X7      STORE BLANKS IN NEXT 8 PSN'S
         AI,X7    3
         BDR,R5   CPD1A             FILL LINE
         BAL,R15  CPRINT1           GO PRINT LINE
         B        TSTDONE
*                 COME HERE WHEN HI-LIMIT REACHED AN WE ARE USING
*                 BUFFER 2. WE WILL BLANK FILL ANY UNUSED PRINT POSITION
*                 IN THE LINE.
CPDONE2  EQU      %
         LOADM    2,R10,CPBLANKS    GET BLANKS
CPD2A    EQU      %
         LCI      2
         STM,R10  CPDATA2+1,X7      STORE BLANKS IN NEXT 8 PSN'S
         AI,X7    3
         BDR,R5   CPD2A             FILL COMPLETE LINE
         BAL,R15  CPRINT2           NOW GO PRINT THIS LINE
TSTDONE  TESTBIT  EORSW,HOME,1      WAS LAST ADDR PRINTED
         B        CPHERE            GO TO MONITOR
HOME     BAL,15   EORSME            GO PRINT HI-LIMIT LINE
         B        CPHERE            GO TO MONITOR
         TITLE    'ASSIGN PRINTER AND LINES/PAGE ROUTINES'
*
*
****
*   *             SET PRINTER ADDR REQUEST -LO-
****
CPLORTN  EQU      %
         LI,R6    BA(CPINPUT)+2     SET PTR TO NEW ADDR
         LI,R1    4
         BAL,R15  CPTOHEX           CONVERT TO HEX
         STW,R9   PRINTDEV          STORE
         B        CPHERE            GO TO MONITOR
         TITLE    'DATA CONVERSION SUBROUTINES'
*
*
*
TOPRINT  EQU      %                 CONVERT BINARY FOR PRINTING (EBCDIS)
*                       AT ENTRY  R9 BINARY NUMBER TO CONVERT
*                        AT EXIT
*                          R10 & R11 EBCDIC EQUIVALENT
         LI,X1    0                 INDEX
         LI,X2    8                 COUNT OF DIGITS TO OUTPUT
TOPRINT1 EQU      %                 BEGIN CONVERSION
         LI,R8    0                 CLEAR WORK REG
         SLD,R8   4                 GET HI-ORDER DIGIT FROM R9
         CI,R8    9                 TEST FOR ALPHA (A-F)
         BG       %+2               YES-BRANCH
         AI,R8    57                NO--ADD EXTRA FACTO FOR NUMERIC
         AI,R8    183               ADD ALPHA FACTOR
         STB,R8   R10,X1            STORE DIGIT IN OUTPUT REG
         AI,X1    1                 STEP INDEX
         BDR,X2   TOPRINT1          CONVERT 8 DIGITS
         B        *R15              RETURN
*
*
*
CPTOHEX  EQU      %                 CONVERT FROM EBCDIC TO BINARY
*                       AT ENTRY  R1 DIGIT COUNT
*                                 R6 ADDRESS OF DIGIT
*                       AT EXIT
*                                 R9 RIGHT JUSTIFIED BINARY NBR
         LI,R5    8                 SET DIGITS NOT CONVERTED
         LI,R9    0                 PRESET RESULT TO  ZERO
CPPH     EQU      %
         LB,R8    0,R6              GET NEXT CHARACTER
         CI,R8    C'-'              TEST FOR - FIELD DELIMITER
         BE       CPPHO6
         CI,R8    C' '              CHECK FOR BLANK DELIMITER
         BE       CPPHO6
         CI,R8    C','              TEST FOR , FIELD DELIMITER
         BE       CPPHO6
         CI,R8    X'15'             TEST FOR  NEW-LINE  FIELD DELIMITER
         BE       CPPHO6
         CI,R8    C'.'              TEST FOR . FIELD DELIMITER
         BE       CPPHX
         CI,R8    240               TEST FOR NUMERIC
         BGE      %+2               BRANCH IF DIGIT (0-9)
         AI,R8    X'A'-C'A'         CONVERT TO HEX
         SCS,R8   -4                MOVE DIGIT
         SCD,R8   4                  INTO LO END OF R9
         AI,R5    -1                DECREMENT DIGITS NOT CONVERTED
         AI,R6    1                 INCREMENT CHARACTER POINTER
         BDR,R1   CPPH              CONTINUE PROCESSING
         B        *R15              RETURN
CPPHO    EQU      %
         CI,R5    8                 CHECK IF ANY DIGITS PROCESSED
         BE       CPPHD             NO- RESTART
         B        *R15              RETURN
CPPHX    EQU      %
         AI,R6    1                 INCREMENT CHARACTER POINTER
         LB,R8    0,R6              PICK UP NEXT CHARACTER
         CI,R6    C'.'              CHECK FOR MORE  PERIODS
         BE       CPPHX             YES
         B        CPPHO             NO MORE
CPPHO6   EQU      %
         AI,R6    1                 INCREMENT CHARACTER POINTER
         B        CPPHO
CPPHD    EQU      %
         BDR,R1   CPPH
         B        *R15              RETURN
*
*
         TITLE    'TELE-TYPE SUBROUTINES'
*
CPREAD   EQU      %                 READ TELE TYPE
         STOREM   4,1,CPRDX1        SAVE REGS
         LOADM    4,1,CPBLANKS      BLANK
         STOREM   4,1,CPINPUT       KEY-IN AREA
         LOADM    4,1,CPRDX1        RESTORE REGS
         TIONEW   *TYPEDEV
         LI,R0    DA(CPREDCW)
         SIO,R0   *TYPEDEV          READ TELETYPE
         BIOSNS   %-1
         TIONEW   *TYPEDEV
         B        *R15              RETURN
CPTYPE   EQU      %                 TYPE PROMPT CHARACTER 'CP'
         TIONEW   *TYPEDEV
         LI,R0    DA(CPTYPCP)
         SIO,R0   *TYPEDEV
         BIOSNS   %-1
         B        *R15
         TITLE    'PRINTER SUBROUTINES'
*
*
CPRINT1  EQU      %                 PRINT LINE FROM BUFFER 1
         LI,R0    DA(CPLN1)
         B        CPRINT1A
CPRINT2  EQU      %                 PRINT LINE FROM BUFFER 2
         LI,R0    DA(CPLN2)
CPRINT1A EQU      %                 PREPARE TO PRINT
         STW,R0   CPSR0             SAVE COMMD LIST ADDR
         LW,R13   LINCT             GET CURRENT LINE COUNT
LINES    EQU      %
         CI,R13   35                TEST FOR FULL PAGE
         BL       CPRNT             NO--GO PRINT
         BAL,R13  SKIPER            YES-GO ADVANCE PAPER AND PRINT HDR
CPRNT    EQU      %
         STOREM   3,R1,CPRDX1       SAVE REGS
         TIONEW   *PRINTDEV
         LI,X2    0                 INDEX TO 0
         LI,R3    23                WORD COUNT TO 23
EORLOOP  EQU      %                 EXCLUSIVE OR BUFFER 1 AND 2 TOGETHER
*                                   TO TEST FOR IDENTICAL LINES
         LW,R1    CPDATA1+1,X2      GET WORD FROM BUFFER 1
         EOR,R1   CPDATA2+1,X2      TEST IT AGAINST BUFFER 2
         BCS,M3   EORPRT            BRANCH IF NO MATCH
         AI,X2    1                 INCREMENT INDEX
         BDR,R3   EORLOOP           TEST 23 WORDS
         SETBIT   EORSW,1           INDICATE IDENTICAL LINES HAVE BEEN
*                                   DETECTED
         LOADM    3,1,CPRDX1        RESTORE REGS
         B        *R15              RETURN WITHOUT PRINTING THIS LINE
*
EORPRT   EQU      %                 BUFFERS NOT IDENTICAL PRINT
         TESTBIT  EORSW,EORSME,1    BRANCH IF WE HAVE SKIPPED IDENTICAL
*                                   LINES.
EOROK    EQU      %                 READY TO PRINT LINE
         LW,R0    CPSR0             RESTORE R0
         TIONEW   *PRINTDEV
         SIO,R0   *PRINTDEV         PRINT DATA LINE
         BIOSNS   %-1
         MTW,1    LINCT             ADD 1 TO LINE COUNT
         LOADM    3,1,CPRDX1        RESOTRE REGS
         B        *R15              RETURN
*
EORSME   EQU      %                 COME HERE TO PRINT 'SAME' LINE
         LI,R0    DA(EORSKP)        COMMD ADDR
         SIO,R0   *PRINTDEV         PRINT '***SAME AS ABOVE****'
         BIOSNS   %-1
         OFFBIT   EORSW,1           TURN OFF DUPLICATE LINE SWITCH
         MTW,1    LINCT             ADD 1 TO LINE COUNT
         B        EOROK             GO PRINT LINE
*
*
*
SKIPER   EQU      %                 ADVANCE PAPER & MAINTAIN PG NBR
         STOREM   2,7,CPRDX1        SAVE REGS
         LI,X7    7                 INDEX
         LI,R11   3                 COUNT
CPLABEL1 EQU      %
         LB,R8    PGNBR,X7          GET LO-ORDER DIGIT OF PAGE NBR
         AI,R8    1                 ADD 1
         CI,R8    250               TEST FOR GREATER THAN 9
         BE       CPLABEL2          YES-BRANCH TO INCREMENT 10TH PSN
         STB,R8   PGNBR,X7          NO--STORE INCREMENTED DIGIT BACK
         B        CPLABEL3          GO PREPARE TO ADVANCE PAPER
CPLABEL2 EQU      %                 ZERO DIGIT AND MOVE NEXT HI-ORDER
         LI,R8    240               EBCDIC 0
         STB,R8   PGNBR,X7          STORE
         AI,X7    -1                STEP TO NEXT HI-ORDER DIGIT
         BDR,R11  CPLABEL1          INCREMENT UP TO 3 DIGIT NBR
         LW,R8    CPZEROS           RESET PAGE COUNT TO ZERO
         STW,R8   PGNBR+1           AFTER 999
         B        SKIPER            GO INCREMENT
CPLABEL3 EQU      %                 ADVANCE PAPER
         TIONEW   *PRINTDEV
         LI,R0    DA(FORMAT)
         LOADM    2,7,DTEHOLD       SET DATE IN HEADER
         STOREM   2,7,CPPRTDTE
         SIO,R0   *PRINTDEV         ADVANCE PAPER AND PRINT HEADER
         LI,R8    0
         STW,R8   LINCT             ZERO LINE COUNT FOR NEW PAGE
         LOADM    2,7,CPRDX1        RESTORE REGS
         B        *R13              RETURN
         TITLE    'LITERALS, MESSAGES, WORK AREAS AND I/O COMMANDS'
*
**                LITERALS, MESSAGES AND WORK AREAS
*
CPLN1    IOPCW    1,CPADDR1,0,124
CPLN2    IOPCW    1,CPADDR2,0,124
CPREDCW  IOPCW    134,CPINPUT,0,20
CPTYPCP  IOPCW    5,CPCW,0,3
FORMAT   IOPCW    5,PGNBR,0,44
TYPDMP   IOPCW    5,DMPMSG,0,16
EORSKP   IOPCW    1,SME,0,32
CPINPUT  DATA,16  0                 KEY-IN ARE FOR MONITOR -CP-
LITERALS RES      256
*
K1FFFF   DATA     X'0001FFFF'       LOAD SELECTIVE MASK TO GET ADR
CPCW     TEXT     '
CP'             PROMPT CHARACTERS
EORSW    DATA     0                 SWITCH BYTE
LINCT    DATA     0                 LINES PER PAGE COUNTER
CPZEROS  TEXT     ' 000'            INITIAL PAGE NBR
CPSR0    DATA     0                 R3 SAVE ARE FOR PRINT ROUTINE
CPBEG    DATA     0                 LO-LIMIT FOR POST MORTEM
CPEND    DATA     0                 HI-LIMIT FOR POST MORTEM
CPSAVER  EQU      %                 REGISTER SAVE AREA FOR
         DO       16                PANEL INTERRUPTS AND
         DATA     0                 ILLEGAL TRAPS
         FIN
CPREGS   TEXT     'REGS'
CPBLANKS TEXT     '                '
PI       TEXT     'PANEL INTERRUPT '
DMPMSG   TEXT     '
ERROR DUMP CORE'
SME      TEXT     '****** SAME AS ABOVE LINE ******'
CPRDX1   DATA,16  0                 TEMPORARY REGISTER STORAGE
ERRMSG1  DATA,1   0,0,17,21
ERRMSG1A TEXT     '        '
ERRMSG1B TEXT     '        '
PGNBR    TEXT     '1PG# 000        '
CPPRTDTE TEXT     '            '
PIP      TEXT     '                '
*                 PRINT BUFFER LINE 1
CPADDR1  TEXT     '    '
CPDATA1  EQU      %
         DO       15
         TEXT     '        '
         FIN
CPADDR2  TEXT     '    '
CPDATA2  EQU      %
         DO       15
         TEXT     '        '
         FIN
         BOUND    8
BUF1CW1  IOPCW     3,BUF1WRD2,34,4
BUF1CW2  DATA     0
BUF1WRD1 GEN,8,24   78,0
BUF1WRD2 DATA     0
BUF1WRD3 DATA     0
BUF1WRD4 DATA     0
BUF1DATA EQU      %
         ORG      %+3080
BUF1SIZ  EQU       12304
*                 BUFFER 1 IS USED AS A WORK AREA FOR READ/WRITE OF
*                 DIRECTORY OF CONTENTS.
*                 THE FOLLOWING EQUATES ARE USED FOR THIS PURPOSE.
*                 THESE EQUATES PROVIDE THE FOLLOWING CORE MAP--
*
*        BOUND    4
*CNTDIR  DATA,1   0,0,0,21
*DATEDIR DATA,8   0
*DIRSTACK DATA    STACK1
*        GEN,4,12,4,12  8,100,8,0
*STACK1  RES      100
*
CNTDIR   EQU      BUF1DATA+2
DATEDIR  EQU      BUF1DATA+3
DIRSTACK EQU      BUF1DATA+5
STACK1   EQU      BUF1DATA+7
         BOUND    8
BUF2CW1  IOPCW    3,BUF2WRD2,36,2
BUF2CW2  DATA     0
BUF2WRD1 GEN,8,24   76,0
BUF2WRD2 DATA     0
BUF2WRD3 DATA     0
BUF2WRD4 DATA     0
BUF2DATA EQU      %
         ORG      %+3080
BUF2SIZ  EQU       12304
ENDLAB   EQU      %
         PAGE
         DEF      GENBOOT
*
*        THIS SECTION IS USEFUL WHEN GENERATING A NEW DEVDMP TAPE.
*        ONCE A NEW DEVDMP VERSION IS PRODUCED - !LYNX THE BO
*        TOGETHER WITH THE 'FIRMLDR'-PRODUCED LM CONTAINING THE
*        MOST RECENT VERSION OF THE MPC TAPE FIRMWARE ... AND RUN.
*        IT IS DESIGNED TO RUN UNDER CP-V, AS A USER JOB, USING THE
*        USUAL MONITOR REQUEST CALS FOR ITS I/O.
*        IT IS ADDITIONALLY RECOMMENDED THAT !PCL BE USED IN READING
*        THE GENERATED TAPE - INSURING ITS READABILITY AND THAT
*        THE RECORD SIZES OF THE BOOTABLE VERSION OF DEVDMP ARE CORRECT
*            88 BYTES FOR THE BOOTSTRAP REC
*          4096 BYTES FOR EACH 1K BLOCK OF PROGRAM
*        (THIS IS THE BEST TEST OF BOOTABILITY SHORT OF
*        AN ACTUAL ATTEMPTED BOOT.)
*
*
GENBOOT  EQU      %
         BAL,R6   CALCSIZ           CALCULATE PGMSIZ, NBLOX
         LI,R6     -3080            ZERO OUT MY BIG BUFFERS
         LI,R7     0
         STW,R7    BUF1DATA+3080,R6
         STW,R7    BUF2DATA+3080,R6
         BIR,R6    %-2
         M:MESSAGE (MESS,8TMOUNT)   NOTIFY OP
         M:OPEN   F:BOOT,(OUT),(SAVE)
         M:REW    F:BOOT
         M:WRITE  F:BOOT,(BUF,MTBOOT),(SIZE,BOOTBYT),(WAIT)
         LW,R4    NBLOX
         LI,R5    WA(LOAD2)          STARTING BUFF ADDR
RITEM    M:WRITE  F:BOOT,(BUF,*R5),(SIZE,BLOCKBYT),(WAIT)
         AI,R5    BLOCKSIZ
         BDR,R4   RITEM
         M:CLOSE  F:BOOT,(REM)
GENBYE   M:EXIT
8TMOUNT  TEXTC    'MOUNT ANY TAPE FOR ''BOOT''',;
                  'TO BECOME NEW DEVDMP MASTER TAPE'
F:BOOT   DSECT    2
F:BOOT   M:DCB    (DEVICE,'9T'),(SN,'BOOT'),(OUT),(SAVE),(TRIES,10)
         ORG      LITERALS
         END       GENBOOT

