         DEF      RCVCTL:
RCVCTL:  EQU      %
         SYSTEM TP:TPO              RMC TP 4-22-74
         SYSTEM LP:TPOQ             RMC TP 4-22-74
CNM      EQU      1                 RMC TP 4-22-74
         SYSTEM   UTS
         OPEN     PUSH,PULL
         TITLE   'UTS RECOVERY :RCVCTL,TYIN-OUT,RD-WRRAD,CK-SWRAD'
*
*                 BODY OF RECOVERY ROUTINE. THIS MODULE DIRECTS THE
*                 COURSE OF THE RECOVERY. IT ALSO MAKE GO/NOGO DECISIONS
*                 AND COMMUNICATES WITH OPERATER AND USERS.
*
*                 BPM/BTM RECOVERY  DOUG HEYING
*                 UTS MODS PAT CRISMAN
*
         REF      SAVSYM1
         DEF      XPSDNO,XPSD46
         DEF      RCVCTL
         DEF      TYIN
         DEF      TYOUT,HEXCVT,RCBUF
         DEF      TRCVRAD
         DEF      NORCVR
         REF      SGRAN,BGRAN,CURGRAN,FGRAN1,CURBUF
         REF      FGRAN2,FGRAN3,ERBLOCK,BUF1,BUF2
         DEF      NRCVRX
         REF      R:CHKDA
         SREF     COD:LPC,COCTERM,COCOTV,MODE2,CO:STAT
         REF      INCRDA
         REF      RCVRAD
         REF      SCANCFU
         REF      DATE,TIME,MB:SDI,RDDISK1,M:SWAPD
         REF      RCVDMP,TAPDMP,TSTUSR,SV1,SVDNDEV,MVEBUF
         REF      RCVRT
         REF      CYCUSRS
         REF      SYSLIM
         REF      TSTHGP,SAVHGP
         REF      SYMFILS
         REF      SAVSYM
         REF      MAPFLG
         SREF     RBLIMSIX,RBLIMSZ,RB:FLAG,LIPBIT,ACTBIT,DUPBIT,BPBIT
         SREF     2780BIT
         REF      R:DCT1
         REF      DCTSIZ,DCT2,CIT1,IOQ7,DCT4,IOQ4,IOQ9,IOQ8,IOQ12
         REF      DCT3
         REF      X560CUCL,X560CUCLL
         REF      WRRAD2,IOQ2
         REF      RCVCODE
         REF      BOOTENT
         REF      RECOVER0
         REF      :B9,:B560
         REF      TRAPSAVE
         REF      TB:FLGS
         PCC      0
PUSH     CNAME    X'0B'
PULL     CNAME    X'0A'
         PROC
LF       EQU      %
TMP      SET      -2
         DO       NUM(AF)>1
         DO       AF(1)<16
         LCI      AF(1)
         ELSE
         LCI      0
         FIN
TMP      SET      0
         FIN
         GEN,8,4,20 NAME+TMP,AF(NUM(AF)),R:TSTACK
         PEND
         SREF     COC
         SREF     COCMESS
         SREF     LCOC
         REF      RRBG10,RELFDA,R:TSTACK
         SREF     HASPBIT
         REF      J:ASSIGN
         REF      BGRCFU,LASTCFU
         REF      WRDISK1,SAVEREGS  TP RECOVERY WRITES TO QUEUE FILE
         REF      DCT1,DCT16,DCT23
         GENREFS
         REF      HGP
         REF      PPCHK
*************************************************************
NO%PRIVATE%DISK   EQU   1           REMOVE WHEN PRIVATE DISK IS CHK'D OUT
*************************************************************
         PAGE
*
*                 PARAMETERS USED IN RECOVERY CONTROL
*
TY       EQU      1
         PAGE
         REF      SUABORT
         B        SUABORT           SINGLE USER ABORT ENTRY
RCVCTL   EQU      %                 MUST BE AT BEGIN - ENTERED HERE.
         LI,5     238               NUMBER OF POSSIBLE INTERRUPTS
         LI,2     BDR%
         LW,3     RCUNMAP           RP 0 AND NO MAP
         LPSD,X'A' 2                CLEAR ALL POSSIBLE INTERRUPTS
BDR%     BDR,5    %-1
         LW,0     XPSDNO            L/RECOVERY'S XPSD FOR .40
         XW,0     X'40'             SWAP WITH CURRENT CONTENTS OF .40
         LW,1     XPSD46            GO TO NORCVR IF WATCHDOG TIMER
         XW,1     X'46'             SWAP OLD AND NEW XPSD'S
         STD,0    TRAPSAVE          SAVE OLD XPSDS
         LI,1     0
         STW,1    MAPFLG
         STW,1    X'2A'             INDICATE RECOVERY TO GHOST1
         LI,1     X'FFFF'
         WD,1     X'1100'           DISARM OVERRIDE,IO,CLOCK GROUPS
         LW,0     RCVRAD            SAVE RCVRAD ADDRESSES
         STW,0    TRCVRAD
*
*                                   CONVERT R:DCT1 TO DEVICE ADDRESSES
*
         LI,R4    2                 BYTE POSITION FOR CHANNEL
         LI,R1    DCTSIZ            NUMBER OF DCT ENTRIES
KRD10    LH,R2    R:DCT1,R1         ADDRESS WITH EBCDIC CHANNEL
         BIF,X560 KRD11             B/ ON 560
         AI,R2    -'A'**8           CONVERT CHANNEL ON SIGMA
         B        KRD13
KRD11    LB,R3    R2,R4             GET EBCDIC CHANNEL ON 560
         LI,R5    0
X560LOOP CB,R3    X560CUCL,R5
         BE       KRD12             DEVELOP CHANNEL BY TABLE
         AI,R5    1
         CI,R5    X560CUCLL
         BLE      X560LOOP
         B        NORCVR            ERROR EBCDIC NOT IN TABLE
KRD12    STB,R5   R2,R4             PUT IN CHANNEL NUMBER
KRD13    STH,R2   R:DCT1,R1         PUT BACK R:DCT1 WITH CHANNEL NO.
         BDR,R1   KRD10             CHANGE ALL OF R:DCT1
         LH,0     RCVCODE           L/RECOVERY CODE
         CI,R0    X'89'             CRASH CODE 89 FROM ALLYCAT
         BNE      %+3               NO
         LW,D4    =X'0B000000'      YES-INDICATE HGPRECON
         BAL,SR4  SV1               GO-PUT HGPRECON CODE IN REC BUF
         CI,0     X'404'            C/CODE W/.404 (ZAP CODE, FROM SSS)
         BNE      %+3               BNE
         AI,0     X'40000'          +.40000
         STW,0    X'2A'
         LW,0     RCVCODE           L/RECOVERY CODE & SUBCODE
         BAL,11   HEXCVT
         LI,1     1
         STH,2    MSFTW+4,1         S/RECOVERY CODE IN MESSAGE
         INT,3    3                 CLEAR LH OF R3
         SLS,3    8                 SHIFT LEFT 1 BYTE
         OR,3     ='-'**24+X'15'    OR IN HYPHEN AND CR
         STW,3    MSFTW+5           S/SUBCODE IN MESSAGE
         LI,4     M0
         LH,0     RCVCODE           L/RECOVER CODE
         CI,0     -1
         BL       REASON            UNKNOWN REASON
         BNE      %+3               NOT OPERATOR RECOVERY
         MTH,1    X'2A'             INDICATE OPERATOR RECOVERY TO GHOST1
         B        REASON+1
         LI,4     MSFTW             SOFTWARE CHECK
         CI,0     X'FF'
         BLE      %+2               KNOWN RECOVER CODE
REASON   EQU      %
         LI,4     MNTH              UNKNOWN
         BAL,11   TYOUT             LOG RCVRY REASON
         BAL,11   INCRDA            INCREMENT RCVRAD TWICE TO LEAVE
         BAL,11   INCRDA               ROOM FOR BUFFER
         LW,0     NRCVRX            SET UP FOR ERRORS IN RECOVERY
         STW,0    RECOVER0          MODIFY RECOVERY IN BOOTSUBR
         LI,4     RELOGM            TELL USERS TO STAND BY
         BAL,11   COCOUT
         BAL,11   RBOUT             TELL WORK STATIONS TO STAND BY
         BAL,11   TPCHECK           VERIFY TPP AND FLAG TP ACTIVE
         LH,11    DATE              SET UP DATE AND TIME OUTPUT
         STW,11   M0
         LI,11    X'1140'
         STH,11   M0                 MM
         LW,10    DATE
         LI,11    '//'
         STH,11   10
         SCS,10   8
         STW,10   M0+1              /DD/
         LW,11    DATE+1
         SCS,11   16
         STW,11   M0+2              YY
         LW,10    TIME
         LW,11    CRCOL
         SCD,10   16
         SCS,11   8
         SCD,10   40
         STW,10   M0+3              HH:MM CR
         STW,11   M0+4
         LI,4     M0
         BAL,11   TYOUT             DATE AND TIME OUT
         BAL,11   TSTUSR            SYSTEM SPECIFIC - ARE USER TBLS REAS
         INT,11   X'2A'             IF SHUTDOWN,DONT DUMP
         BDR,11   %+2
         BAL,11   RCVDMP            SYSTEM SPECIFIC
         BAL,11   TSTHGP            CHECK ALLOCAT STACKS
         BAL,SR4  IOQFLUSH          GO-WRITE OUT QEUED I/O
         BAL,11   RCVRT             SAVE REAL-TIME PAGES
         LW,R10   TPACTIVE          IS TP GENNED AND ACTIVE
         BEZ      NOTP              NOPE
         BAL,R11  TPBLOCKS          WRITE QUEUE FILE BUFS TO DISK
NOTP     EQU      %
         BAL,R11  TPJRNLCLS         CLOSE ALL COMMON JOURNALS
         BAL,11   SAVSYM            GO-SAVE SYMBIONT TABLES
         BAL,11   CYCUSRS           CYCLE BATCH AND TERMINAL USERS
NRCVRX   EQU      %
         B        NORCVR            ERROR RETURN
         BAL,SR4  SCANCFU           CHECK FOR ACTIVE CFUS
*
*        CHECK ALL ERRLOG DISK ADDRESSES
*
         LW,8     SGRAN
         BEZ      %+3
         BAL,11   R:CHKDA
         BCR,15   BADERLOG1
         LW,8     BGRAN
         BEZ      %+3
         BAL,11   R:CHKDA
         BCR,15   BADERLOG1
         LW,8     CURGRAN
         BEZ      %+3
         BAL,11   R:CHKDA
         BCR,15   BADERLOG2
         LW,8     FGRAN1
         BEZ      %+3
         BAL,11   R:CHKDA
         BCR,15   BADERLOG2         FGRAN1 DA NO GOOD
         LW,SR1   FGRAN2
         BEZ      %+3
         BAL,SR4  R:CHKDA
         BCR,15   BADERLOG2         FGRAN2 DA NO GOOD
         LW,SR1   FGRAN3
         BEZ      %+3
         BAL,SR4  R:CHKDA
         BCS,15   ERLOGOK
BADERLOG2 LI,8    0
         STW,8    FGRAN1
         STW,SR1  FGRAN2
         STW,SR1  FGRAN3
         STW,8    CURGRAN
         B        ERLOGOK
BADERLOG1 LI,8    0
         STW,8    SGRAN
         STW,8    BGRAN
         B        BADERLOG2
ERLOGOK  EQU      %
         BAL,11   SVDNDEV           SYSTEM SPECIFIC - DOWN DEVICES ETC.
         LW,15    SGRAN             SAVE PARTIAL ERROR LOG AND POINTERS
         BAL,11   SV1
         LW,15    BGRAN             SAVE
         BAL,11   SV1
         LW,15    CURGRAN               ALL OF
         BAL,11   SV1
         LW,15    FGRAN1                       THE
         BAL,11   SV1
         LW,D4    FGRAN2
         BAL,SR4  SV1               SAVE FGRAN2
         LW,D4    FGRAN3
         BAL,SR4  SV1               SAVE FGRAN3
         LW,D4    ERBLOCK
         BAL,SR4  SV1               SAVE ERBLOCK
         LW,15    CURBUF                           POINTERS
         CI,D4    BUF1
         BE       %+4               LEGAL VALUE
         CI,D4    BUF2
         BE       %+2               LEGAL VALUE
         LI,D4    BUF1              SET AT BUF1 IF CLBBERED
         BAL,11   SV1
         LW,10    15                AND CONTENTS OF CURRENT BUFFER.
         AI,10    64
         LI,7     -66
         LW,15    *10,7
         BAL,11   SV1
         BIR,7    %-2
         LW,15    ERCODE
         BAL,11   SV1
         BAL,11   SYSLIM            SAVE ALL SYSTEM LIMITS
         BAL,11   SYMFILS           TAKE CARE OF IN/OUT ACTIVE SYMS.
         DO1      CNM
         BAL,11   SAVCOC
         BAL,11   SAVHGP
         BAL,11   SAVSYM1           GO-SAVE SYMB GHOST COMM BUF
         LI,15    COC               SEE IF NON-COC SYSTEM
         BEZ      RECON5            B/NO COC
         LI,7     16                SAVE COC MESSAGE (ADMINISTRATIVE)
         LW,15    COCMESS-1,7
         BAL,11   SV1
         BDR,7    %-2
         LW,D4    ADMCODE           ADMINISTRATIVE MESSAGE CODE
         BAL,SR4  SV1               GO-SAVE ADMINITRATIVE MESSAGE
RECON5   EQU      %
         LI,15    0                 TRUNCATE GRAN RELEASE BUF
         BAL,11   RRBG10
         LW,15    RELFDA
         BEZ      RECON10           NO GRANULES RELEASED
         BAL,11   SV1               SAVE FDA
         LW,15    FDACODE
         BAL,11   SV1
RECON10  EQU      %
         BAL,11   MVEBUF            MOVE RECOVERY BUF TO CORE-1
*                 NOWSIMULATE ANORMAL RAD BOOT.
         LW,D4    X'2A'             SAVE FLAG OVER BOOT
         LI,R1    DCTSIZ            HALT ALL SYSGEN DEVICES
KRD8     LC       DCT3,R1           DEVICE PARTITIONED OUT
         BCS,2    KRD9              YES-DO NOT HALT
         LH,R2    DCT1,R1           DEVICE ADDRESS
         :HIO,0   *R2               HALT THE DEVICE
KRD9     BDR,R1   KRD8              LOOK AT ALL DCTX
*
         LI,R3    88                BYTES IN BOOTSTRAP
         LI,R4    X'2A'             LOCATION FOR BOOTSTRAP
         LB,SR1   MB:SDI            DCTX OF SWAPPER
         SLS,SR1  16                DA OF ZERO ON SWAPPER
         BAL,SR4  RDDISK1           GO-READ BOOTSTRAP
         B        NORCVR            ERROR RETURN
         STW,D4   X'2A'             RESTORE FLAG
         LW,R1    M:SWAPD           ADDRESS OF BOOT DEVICE
         STW,1    X'25'
         LI,1     14                # OF EXTERNAL INTERRUPT GROUPS
         LI,5     -1
         WD,5     X'110F'           DISARM ALL EXTERNAL INTERRUPTS
         MTW,-1   %-1
         BDR,1    %-2
         B        BOOTENT
ADMCODE  GEN,8,24 2,16              ADMINITRATIVE MESSAGE CODE
ERCODE   GEN,8,24 1,74
FDACODE  GEN,8,24 X'D',1            GRANULE BUFFER FDA CODE
         BOUND    8
DWXPSD   DATA     0,0,NORCVR        RECOVERY HAS TRAPED
RCUNMAP  GEN,8,1,6,1,13,1,2  7,:B9,0,:B9,0,:B560,0
XPSDNO   XPSD,0   DWXPSD            XPSD FOR TRAP 40
WDTXPSD  :PSD     RES,(IA,WDX),INH
WDX      MTW,1    WDTXPSD
         MTW,1    WDTXPSD           IGNORE WATCHDOG
         LPSD,1   WDTXPSD
XPSD46   XPSD,0   WDTXPSD           XPSD FOR TRAP 46
         PAGE
*
*                 SUBROUTINES
*
*                 TEXTC MESSAGE ADDRESS IN R4
*                 OUTPUT TO TY
TYOUT    PUSH     5
         LB,5     *4
         SLS,4    2
         AW,4     LPTYORD
         STD,4    LPTYDWD
         LI,0     DA(LPTYDWD)
         INT,5    X'2A'             NOTYPE IF SHUTDOWN
         BDR,5    TYOUT1
         :SIO,0   TY
         :TIO,0   TY
         BCS,12   :A
TYOUT1   EQU      %
         PULL     5
         B        *11
*                 INPUT FROM TY ONE BYTE - RETURN IT IN 0.
TYIN     LI,0     DA(TYINC)
         :SIO,0   TY
         :TIO,0   TY
         BCS,12   :A
         LB,0     LPTYDWD
         B        *11
*                 OUTPUT TO ALL USERS
COCOUT   LI,1     COC               SEE IF NON-COC SYSTEM
         BEZ      *11               B/NO COC
         INT,R3   X'2A'
         BDR,R3   *SR4              NOTYPE IF SHUTDOWN
         LI,1     0
COCOUT0  EQU      %
         AI,1     1
         LI,R6    LCOC+1            NUMBER OF COCS
COCOUT1  LI,D1    X'F0'
         AND,D1   CO:STAT-1,R6      DIO ADDRESS
         AI,D1    X'3005'           TRANSMIT DATA FUNCTION
         LD,R2    COD:LPC-2,R6      LOGICAL LINE RANGE THIS COC
COCOUT2  LW,SR2   R3                HIGHEST LOGICAL LINE THIS COC
         SW,SR2   R2                PHYSICAL LINE THIS COC
         LB,R5    COCTERM,R3        TRANSLATE TABLE INDEX
         LH,SR1   COCOTV,R5         TRANSLATE TABLE ADDRESS
         LB,R7    *R4,R1            EBCDIC CHAR
         LC       MODE2,R3          2741 TYPE TERMINAL
         BCS,1    2741TRNS          YES-TRANSLATE FOR 2741
         LB,R7    ASCII,R7          NO-TRANSLATE INTO ASCII WITH PARITY
COCOUT5  SLS,R7   8
         AW,R7    SR2               PUT IN PHYSICAL LINE NUMBER
         WD,R7    *D1               TRANSMIT CHAR
COCOUT4  AI,R3    -1                DEC LOGICAL LINE NUMBER
         CW,R3    R2                MORE LOGICAL LINES THIS COC
         BGE      COCOUT2           YES-TRANSMIT TO ALL LINES THIS COC
         BDR,R6   COCOUT1           TRANSMIT TO ALL COCS
         LI,2     72000             DELAY
         BDR,2    %
         CB,1     *4
         BL       COCOUT0           ARE WE DONE
         LI,R6    LCOC+1            L/# OF COCS
COCOUT3  LI,D1    X'F0'             L/MASK FOR DIO ADR
         AND,D1   CO:STAT-1,R6      G/DIO ADR
         AI,D1    X'300E'           STOP TRANSMIT FUNCTION
         LI,R3    63                L/MAX LINE# ON A COC
         WD,R3    *D1               STOP TRANSMIT
         BDR,R3   %-1               BDR/PROCESS NEXT LINE
         WD,R3    *D1               STOP TRANSMIT ON LINE 0
         BDR,R6   COCOUT3           BDR/PROCESS NEXT COC
         B        *11
*
2741TRNS CI,R7    X'0D'             CR
         BNE      %+3               NO
         LI,R7    X'6D'             YES-TRANSMIT 'NEW LINE'
         B        COCOUT5
         CI,R7    X'15'             LF
         BNE      %+3               NO
         LI,R7    X'1C'             YES-TRANSMIT 'UPPER CASE SHIFT'
         B        COCOUT5
         AND,SR1  =X'FFFF'
         CI,SR1   X'4000'           TRANSLATE TABLE ADDRESS LEGAL
         BGE      COCOUT4           NO-SKIP TRANSMITTING CHAR
         LB,R7    *SR1,R7           YES-TRANSLATE USING CORRECT TABLE
         AND,R7   =X'3F'            TAKE OFF ANY CONTROL BITS
         SCS,R7   32
         BOD      %+2
         AI,R7    X'40'             MAKE ODD PARITY
         B        COCOUT5
*                 CONVERT HEX TO EBCDIC FOR OUTPUT
*                 INPUT IN 0, OUTPUT IN 2,3
HEXCVT   LI,4     -8
         LI,1     0
         SCD,0    4
         LB,1     HEXCHRS,1
         STB,1    4,4
         BIR,4    HEXCVT+1
         B        *11
HEXCHRS  TEXT     '0123456789ABCDEF'
         PAGE
RBOUT    EQU      %                 TELL WORK STATIONS TO STAND-BY
         INT,5    X'2A'
         BDR,5    *11               NO TYPE OUT IF SHUT DOWN
         LI,2     RBLIMSIX          INITIAL WORK STATION DCTX
         LI,5     -RBLIMSZ
         BEZ      *11               RETURN IF NO WORK STATIONS IN SYSTEM
RBOUT1   LW,6     RB:FLAG+RBLIMSIX+RBLIMSZ,5
         CI,6     LIPBIT+ACTBIT     WORK STATION CONNECTED
         BAZ      RBOUT2            NO
         LH,1     R:DCT1,2          RB DEVICE ADDRESS
         CI,6     DUPBIT
         BAZ      %+2
         AI,1     1                 GET CORRECT CHANNEL
         CW,R6    HASPBIT           HASP BIT ON
         BAZ      RBOUT3            NO
         LI,R0    DA(RBCOM3)
         B        RBOUT2-1          DISCONNECT SIO
RBOUT3   EQU      %
         CW,R6    2780BIT           2780 BIT ON
         BAZ      RBOUT4            NO
         LI,R0    DA(RBCOM4)
         B        RBOUT2-1          ISSUE SIO FOR RE-DIAL MESSAGE
RBOUT4   EQU      %
         LI,0     DA(RBCOM1)
         CW,6     BPBIT             BLOCK PROTECT SET
         BAZ      %+2               NO-USE MES1
         LI,0     DA(RBCOM2)        DA COMMAND FOR WORK STATION
         :SIO,0   *1
RBOUT2   AI,2     1                 INC DCTX
         BIR,5    RBOUT1
         B        *11
         TITLE    'TP RECOVERY * TPCHECK'
************************************************************************
*        TRANSACTION PROCESSING ROUTINES
*
*        TPCHECK VERIFIES THAT TP IS GENNED INTO THE SYSTEM.  NO FURTHER
*        ACTION IS TAKEN IF IT IS NOT.  IF THE TTP TABLE IS PRESENT, IT
*        IS CHECKED FOR INTEGRITY; IF THE TTP TABLE IS DESTROYED, THEN
*        THE QUEUE WILL HAVE TO BE RECONSTRUCTED BEFORE TP CAN BE RE-
*        STARTED.  IF THE TTP IS PRESENT AND IN GOOD SHAPE, THEN TP
*        RECOVERY IS CONSIDERABLY SHORTER IN LATER  STAGES.
*                 ENTRY POINT: TPCHECK
*                 INPUT:  TTP RESIDENT TABLE
*                         CFU TABLES
*                         R11 = RETURN ADDRESS
*
*                 OUTPUT: TPACTIVE = 1  IF TP IS GENNED AND TTP IS OK
*                                       TO USE
*                         TPACTIVE = 0  IF TP IS NOT GENNED OR TTP HAS
*                                       BEEN DESTROYED.
*
*                 NO REGISTERS ARE CHANGED BY TPCHECK
*                 SUBROUTINES USED: TYOUT, R:CHKDA
************************************************************************
TPCHECK  EQU      %
*
         PUSH     1,R11
*                 CHECK GENERATION OF TP
         LI,R2    TTP
         BEZ      TPCHKRET          IF ADDR OF TP IS 0, NO TP IN SYSTEM
         T,R0,R2   Q:LOCK           Q:LOCK=1 (Q IS UMLOCKED AND BUSY)
         BEZ      TPUNACTV
         T,R0,R2  Q:RCV
         BNEZ     TPERR6            NO ACTION IF RECOVERY IN PROGRESS
*                 CFU LIMIT CHECK
         LI,R2    BGRCFU            USER CFU LOWER LIMIT
         C,R2,R5  Q:CFU             Q:CFU HAS CFU ADR OF TP QUEUE FILE
         BG       TPERR1            Q:CFU IS LESS THAN LOWER LIMIT
         LI,R2    LASTCFU           USER CFU UPPER LIMIT
         C,R2,R5  Q:CFU
         BL       TPERR1            Q:CFU IS BIGGER THAN UPPER LIMIT
*                 DISK ADDRESS CHECK
         GET,R2,R4 Q:CFU
         GET,R8,R4  CFU#FDA,R2      CFU#FDA IS WORD 1 OF CFU
         BAL,R11  R:CHKDA           SEE ROUTINE IN RCVRIO
         BCR,15   TPERR2            CC=0 IF ERROR
*                 PHYSICAL PAGE CHECK
         GET,R2,R4 Q:TPPP           LOAD TP PHYSICAL PAGE CHAIN HEAD
TPPAGCHK   EQU   %
         AND,R2   ADRWORD           MASK OFF CHAINING BIT
         BEZ      TPGRANCK          NO PP'S ALLOCATED
         BAL,R11  PPCHK             GO TO ROUTINE IN CYCUSR
         BEZ      TPERR3            CC=0 FOR UNKNOWN PAGE
         LW,R2    *R2               ON TO NEXT PAGE IN CHAIN
         B        TPPAGCHK
*                 DISK GRANULE ALLOCATION CHECK
TPGRANCK EQU      %
         GET,R2,R4 Q:CONT           CHAIN HEAD OF QUEUE CONTROL BLOCKS
         GET,R2,R4 CONTNAVGRANS,*R2 NO OF DISK GRANULES FOR QUEUE
         GET,R4,R3  Q:CFU           LOAD QUEUE CFU
         C,R2,R5  CFU#CDAM,R4       CFU#CDAM IS WORD 2 OF CFU
         BNE      TPERR4            QUEUE INTERNAL GRAN CNT .NE. CFU CNT
         STW,R2   TP:SAVE:MAX:BLK#
*                 TTP TABLE OK; CHECK FOR TP ACTIVE
         GET,R2,R4  Q:TID           Q:TID = 0 IF TP NOT BUSY OR IN INIT
         BEZ      TPUNACTV
*                 FLAG TP AS ACTIVE
         MTW,1    TPACTIVE
TPCHKRET EQU      %                 RETURN SET UP
         PULL     1,R11
         B        *R11              RETURN TO RECOVERY CONTROL
TPUNACTV LI,R4    TPMES5            TELL OPERATOR NOT TO WORRY
TPTYOUT  EQU      %
         BAL,R11  TYOUT
         B        TPCHKRET
TPERR1   GET,R2,R4  Q:TID           IS TP ACTIVE?
         BEZ      TPUNACTV          NO
         LI,R4    TPMES1
         B        TPTYOUT
TPERR2   LI,R4    TPMES2
         B        TPTYOUT
TPERR3   LI,R4    TPMES3
         B        TPTYOUT
TPERR4   LI,R4    TPMES4
         B        TPTYOUT
TPERR6   LI,R4    TPMES6
         B        TPTYOUT
TPMES1   TEXTC    '
 INVALID Q:CFU ADR IN TTP'
TPBADBLK   LI,R4   TPMES13
         B        TPEREXIT
TPMES13  TEXTC    'BLK NUMBER OUT OF RANGE - UNABLE TO SAVE QUEUE'
TPMES2   TEXTC    '
 INVALID FDA FOR TP QUEUE '
TPMES3   TEXTC    '
 PHYS PAGE BAD IN TTP'
TPMES4   TEXTC    '
 TP GRANULE COUNT BAD '
TPMES5   TEXTC    '
 TP NOT CURRENTLY ACTIVE'
TPMES6   TEXTC    '
 TP ALREADY IN RECOVERY - NO ACTION TAKEN'
         TITLE    'TP RECOVERY * TPBLOCKS'
************************************************************************
*                 TPBLOCKS WRITES IN-CORE QUEUE BLOCKS TO QUEUE DISK
*                 GRANULES ACCORDING TO WHETHER THE WRITE REQUIRED BIT
*                 IS SET.
*
*                 ENTRY POINT: TPBLOCKS
*                 INPUT: TTP TABLE
*                        R11 IS RETURN REGISTER
*                 OUTPUT: NONE
*                 NO REGISTERS ARE DESTROYED
*                 R4 POINTS TO CURRENT BLOCK UNDER PROCESSING
*                 SUBROUTINES USED: WRDISK1, TYOUT
************************************************************************
TPBLOCKS EQU      %
         PUSH     1,R11
         GET,R4,R3  Q:CONT          HEAD OF CHAIN OF Q CONTROL BLKS
         BEZ      NOTPBLKS          NOTHING TO DO IF ZERO
*                 SAVE Q:TID AND Q:OWN FROM TTP IN CONTROL BLK
         GET,R2,R5  Q:TID
         ST,R2,R5   CONTHTID,*R4
         GET,R2,R5  Q:OWN
         ST,R2,R5  CONTUSR,*R4
         SBIT,R1,R5  CONTWRITE,R4   FORCE OUTPUT OF CONTROL BLOCK
TPCNTL1   EQU   %
         LW,R2    R4
         BAL,R11  PPCHK
         BEZ      TPBADPG
         T,R0,R5   CONTWRITE,R4     IS CONTROL BLOCK SET FOR WRITE
         BEZ      TPCNTL2           NO, GO GET NEXT  BLOCK
         GET,R8,R5  CONTBLOCK,R4    ADD BLOCK NUMBER W/IN RANDOM FILE
         BAL,R12  TPOUTPUT          WRITE TO QUEUE FILE
TPCNTL2  GET,R4,R3  CONTCHAIN,*R4   NORMAL RETURN
         BNEZ     TPCNTL1           MORE CONTROL BLOCKS TO FIND
*
         GET,R4,R3  Q:INX           CHAIN HEAD OF QUEUE INDEX BLOCKS
         BEZ      TPDATA0
TPINDX1  EQU      %
         LW,R2    R4
         BAL,11   PPCHK
         BEZ      TPBADPG
         T,R0,R5  INDEXWRITE,R4     IS BLOCK SET FOR WRITE?
         BEZ      TPINDX2           NO - GET NEXT BLOCK
         GET,R8,R5  INDEXBLOCK,*R4  INIT R8 WITH BLOCK #
         BAL,R12  TPOUTPUT
TPINDX2  GET,R4,R3  INDEXCHAIN,*R4  NORMAL RETURN
         BNEZ     TPINDX1           MORE INDEX BLOCKS TO FIND
*
TPDATA0  GET,R4,R3  Q:DATA          CHAIN HEAD, QUEUE DATA BLOCKS
         BEZ      NOTPBLKS
TPDATA1  EQU      %
         LW,R2    R4
         BAL,R11  PPCHK
         BEZ      TPBADPG
         T,R0,R5  DATAWRITE,R4      IS DATA BLOCK SET FOR WRITE?
         BEZ      TPDATA2           NO - GET NEXT BLOCK
         GET,R8,R5  DATABLOCK,R4    BLOCK NO IN RANDOM FILE
         BAL,R12  TPOUTPUT          WRITE BLOCK TO QUEUE FILE
TPDATA2  GET,R4,R3  DATACHAIN,*R4   NORMAL RETURN, GET NEXT BLOCK
         BNEZ     TPDATA1
NOTPBLKS EQU      %
         PULL     1,R11
         B        *R11              RETURN
TPBADPG   EQU   %
         LI,R4    TPMES10
         BAL,R11  TYOUT
         B        NOTPBLKS          FORCE PREMATURE RETURN TO CALLER
********
*  TPOUTPUT SETS UP AND WRITES A QUEUE BLOCK IN CORE TO THE QUEUE FILE.
*        IF THE FILE IS ON A PUBLIC DEVICE, THE SECTOR NUMBER IS
*        CALCULATED FROM THE BLOCK NUMBER IN R8; THE DCT INDEX AND FIRST
*        DISK ADDRESS OF THE FILE ARE FOUND IN CFU#FDA AND THE BLOCK IS
*        TRANSFERRED VIA THE ROUTINE WRDISK1 FROM RCVCTL.
*        IF THE FILE IS ON A PRIVATE VOLUME DISK PACK, THE LISTS OF
*        SERIAL NUMBERS AND POINTERS TO THE HGPS OF ALL VOLUMES IN THE
*        ACCOUNT, FOUND VIA THE TTP TABLE, ARE USED ALONG WITH CFU
*        INFORMATION TO CALCULATE THE DCT INDEX AND RELATIVE SECTOR
*        NUMBER ON THE VOLUME ON WHICH THE SPECIFIED BLOCK IS LOCATED.
*        AGAIN, WRDISK1 IS USED TO TRANSFER THE BLOCK TO DISK.
*
*
*        INPUT: R4= PHYSICAL ADR OF START OF IN-CORE BLOCK (MAY BE
*                   CONTROL, INDEX OR DATA BLOCK)
*               R8= RELATIVE BLOCK NUMBER OF BLOCK IN R4 IN QUEUE FILE
*               R12=RETURN ADR
*
*               NOTE R4 AND R12 MAY NOT BE CHANGED IN TPOUTPUT AS THEY
*               ARE USED BY THE CALLING PROGRAM.
*
*        REGISTER SET-UP FOR WRDISK1
*               R3 = SIZE OF BUFFER (CONSTANT 2048 BYTES)
*               R4 = (SAME AS FOR INPUT ABOVE)
*      R6 = ADR OF DCB (SINCE DCTX IS KNOWN, R6 POINTS TO A PHONY DCB
*           OF WHICH WORD 0 = 0. WRDISK1 THUS DOES NOT KNOW OR CARE
*           THAT THE FILE MAY BE ON A PRIVATE VOLUME. )
*      R8 = DISK ADDRESS IN THE FORMAT:
*                HW0 = DCT INDEX
*                HW1 = SECTOR NO.ON VOLUME GIVEN BY DCT INDEX
*
TPOUTPUT EQU        %
         PUSH     1,R12
         CI,R8    0                 CHK FOR SMALLEST BLK #
         BLZ      TPBADBLK          ABORT IF BAD
         CW,R8    TP:SAVE:MAX:BLK#  CHK FOR MAX BLK #
         BGE      TPBADBLK
         GET,R2,R5   Q:CFU
         T,R0,R5    CFU#PRIV,R2     IS QUEUE ON A PRIVATE PACK?
         BEZ        TPPUBLIC        NO
         DO       NO%PRIVATE%DISK=1
         LI,R4    TPMES11
         BAL,R11  TYOUT
         B        NOTPBLKS
         FIN
TPPRIVATE   EQU   %
         GET,R6,R5  Q:SN            PTR TO FILE SERIAL NUMBERS
         STW,R6     TPHGPTEMP       SAVE IT
         GET,R6,R5  Q:NSN           LENGTH OF SERIAL NUMBER LIST
         AW,R6      TPHGPTEMP       R6 NOW POINTS TO HEAD OF HGP PTR LST
         STW,R6     TPHGPTEMP       SAVE HGP POINTER LIST START
         GET,R6,R5  CFU#VNO,*R2     GET VOL # OF 1ST VOL OF QUEUE FILE
         AI,R6    -1                CHANGE 1-INDEXING FOR ACCT VOLS TO ZERO
         STW,R6     TPVNOTEMP       SAVE CFU#VNO, INDEX INTO HGP LIST
         AW,R6      TPHGPTEMP       CALCULATE POSITION OF NEEDED PTR
         LW,R6      *R6             R6 NOW POINTS TO HGP OF PRIMARY VOL
*                                   OF QUEUE FILE.
         LI,R7    HGP#NGC           NUMBER OF GRANULES PER CYLINDER
         LB,R10   *R6,R7
         AW,R10   R10               CONVERT TO # SECTORS / CYLINDER
TPNST    EQU      %
         LW,R7      HGP#NST,R6      GET #SECTORS/TRACK FROM HGP
         LI,R5      #TYPES          # OF TYPES OF DISK/RAD PERIPHS
         LI,R3      TYPES           SET UP FOR SEARCH
TPTYPELOOP EQU      %
         CB,R7      *R3,R5          SEARCH TYPES FOR CORRESPONDING DISK
         BE         TPDCLIM         FOUND A MATCH
         BDR,R5     TPTYPELOOP      NOT YET
         B          TPNOMATCHER
TPDCLIM  EQU        %               R5 IS INDEX INTO DCLIM
         LW,R7      DCLIMS,R5       GET #SECTORS/DEVICE
         SW,R7      R10             SUBTRACT ONE CYLINDER OF SECTORS
*                                   RESERVED FOR ALLOCATION
         LI,R12     0               SET UP FOR DIVIDE
         LW,R13   R8                SET UP FOR DIVISION
         AW,R13   R13               CONVERT RELATIVE BLOCK # TO REL SECTOR
         DW,R12     R7              AFTER DIVISION:
*                                    R12 = REMAINDER; REL SECTOR ON VOL
*                                          BEFORE ACCOUNTING FOR SECTORS
*                                          RESERVED FOR ALLOCATION
*                                    R13 = QUOTIENT; VOL RELATIVE TO
*                                          CFU#VNO WHERE FILE STARTS
         CI,R10   0
         BE       TPPUB2            MORE PUBLIC-SPECIFIC PROCESSING
         AW,R12   R10               ACCOUNT FOR ALLOCATION CYLINDER
         AW,R13     TPVNOTEMP       ADD VNO SO R13 POINTS TO HGP PTR OF
*                                   VOL CONTAINING REQUESTED BLOCK
         XW,R13     R1              GET INDEX INTO INDEX REG
         LW,R7      TPHGPTEMP,R1    GET HGP PTR OF VOLUME
         LI,R6    HGP#DCT           BYTE INDEX OF DCTX
         LB,R6    *R7,R6
*                                   R6 NOW CONTAINS DCTX
TPPRIV2  EQU      %
         LW,R8    R12               RELATIVE SECTOR # TO R8
         STH,R6   R8                DCT INDEX TO R8
         B          TPIOOUT
TPPUB2   EQU      %
*                 R13 = INCREMENT FOR DCTX - DEVICE ON WHICH
*                 BLOCK RESIDES IS DEVICE DCTX + CONTENTS OF R13
         LBYTE,R6  CFU#DCTX,*R2     GET DCTX OF DEVICE ON WHICH FILE SSTARTS
         AW,R6    R13               R6 CONTAINS DCTX OF BLOCK'S DEVICE
         B        TPPRIV2
TPPUBLIC EQU        %
         LI,R10   0                 NO ALLOCATION SECTORS ON PUBLIC DEV
         LBYTE,R5 CFU#DCTX,*R2      DCTX FROM CFU
         LH,R6    DCT23,R5          DISPL OF THIS DEVICE HGP FROM HGP DEF
*                 FIRST DEVICE HGP
         AI,R6    HGP               ADD START OF PUBLIC HGPS
         GET,R5   CFU#FDA,*R2       REL SECTOR FOR START OF FILE
         SLS,R5   16                REMOVE DCTX BITS
         SLS,R5   -17               CONVERT TO REAL BLOCK # OF START OF  FILE
         AW,R8    R5                REBIAS FILE TO START OF DEVICE
         B        TPNST             R6 POINTS TO HGP OF PRIMARY PUBLIC DEVICE
*                 CONTAINING QUEUE FILE
*                 R8 HAS BEEN ADJUSTED SUCH THAT ITS CONTENTS ARE
*                 INCREMENTED BY THE DISTANCE OF THE START OF THE
*                 FILE FROM THE START OF THE DEVICE.  THIS GIVES
*                 THE EFFECT OF HAVING THE FILE START AT SECTOR 0.
TPIOOUT  EQU        %
         LI,R5      0
         XW,R5      MAPFLG          SAVE MAPFLG; RESET TO SHOW UNMAPPED
         LI,R3      2048            BLOCK SIZE
         LI,R6      TPPHONYDCB      POINT TO PHONY DCB (WORD 0 = 0)
         BAL,R11    WRDISK1         DO IO
         B          TPWRERR         ERROR RETURN
         XW,R5      MAPFLG          RESTORE MAPFLG
         PULL     1,R12
         B          *R12            RETURN
TPNOMATCHER EQU     %
         LI,R4      TPMES9
*                                   REPORT TO OPERATOR
TPEREXIT EQU      %
         BAL,R11    TYOUT
         PULL     1,R12
         B          NOTPBLKS        RETURN
TPMES10  TEXTC    '
 QUEUE BLOCK NOT IN PHYSICAL PAGE - RECONSTRUCT ';
                  ,'QUEUE'
TPMES9   TEXTC    '
 QUEUE ON UNKNOWN DEVICE - RECONSTRUCT QUEUE'
TPMES11  TEXTC    '
 RESTRICTED - USE OF QUEUE ON PRIVATE DISK - ';
                  ,' RECONSTRUCT QUEUE'
HGP#NST  EQU        2               WORD 2 = # SECTORS/TRACK
HGP#NGC  EQU        7               BYTE 7 = # GRANULES/CYLINDER
HGP#DCT  EQU        5               BYTE 5 = DCT INDEX
TPPHONYDCB DATA     0
TPVNOTEMP  DATA     0
TPHGPTEMP  DATA     0
TP:SAVE:MAX:BLK#   DATA   0
TPWRERR  EQU      %
         XW,R5    MAPFLG            RESTORE MAPFLG
         LI,R4    TPMES7
         B        TPEREXIT
TPMES7   TEXTC    '
 ERR ON DISK - RECONSTRUCT QUEUE NECESSARY'
         TITLE    'TP RECOVERY * TPJRNLCLS'
************************************************************************
*
*                 TPJRNLCLS
*
*                 TPJRNLCLS END PROCESSES ALL COMMON JOURNALS WHICH HAVE
*                 A CFU ASSIGNED.   END PROCESSING  CONSISTS OF WRITING
*                 A TP CRASH RECORD, AN ANS LABELED TAPE SENTINEL AND
*                 AN END-OF-FILE.
*                 IT IS ASSUMED THAT JOURNALIZATION IS ALWAYS TO AN
*                 ANS LABELLED TAPE (FOR THE TIME BEING)
*
*                 ENTRY POINT:  TPJRNLCLS
*                 INPUT:  R11 = RETURN ADDRESS
*                 OUTPUT: NONE
*                 NO  REGISTERS ARE DESTROYED
*
*                 SUBROUTINES USED:
*
*                 FORMAT OF LAST OF JOURNAL AS COMPLETED BY RECOVERY:
*
*              -  PARTIALLY COMPLETED RECORD (STATUS UNKNOWN BECAUSE
*                  RECOVERY POSSIBLY ISSUED HIO IN MIDDLE OF TRANSFER)
*              -  ERASE ORDER (TO ASSURE INTERRECORD GAP)
*              -  CRASH RECORD
*              -  TAPE MARK
*              -  ANS STANDARD EOF1 (80 CHARACTERS)
*              -  TWO TAPE MARKS
************************************************************************
*
TPJRNLCLS EQU     %
*
         PUSH     1,R11
*                 UPDATE CANNED CRASH RECORD WITH CODE AND TIME
         LI,R4    CANNEDREC
         LW,R2    DATE
         ST,R2,R5 JDATE,R4
         LW,R2    TIME
         ST,R2,R5 JTIME,R4
         LW,R2    SAVEREGS+15
         ST,R2,R5 JCRASHCODE,R4
*                 USE CHECKSUM ALGORITHM OF EDMS (ALSO USED BY THE TPC)
*                 SPECIALIZED FOR RCVCTL
         BAL,R11  SPECKSUM
*                 CHECK EACH CFU; IF THE FUNCTION CODE MATCHES CFUCJ,
*                 THEN THE FILE IS A COMMON JOURNAL AND RECOVERY WILL
*                 TRY TO WRITE A CRASH RECORD AND ANS EOF1 LABEL TO IT.
*                 NOTE THAT THIS HAPPENS EVEN FOR COMMON JOURNALS NOT
*                 IN USE BY A TP PROGRAM.
         LI,R3    BGRCFU            CFU LOWER LIMIT
         LI,R8    CFU#CJ
TPCKFUN  C,R8,R6  CFU#FUN,*R3       IS IT A COMMON JOURNAL?
         BE       TPCLS             YES
TPNOCLS  EQU      %
TPNEXTCJ AI,R3    CFU#SIZE          NO - LOOK AT NEXT CFU
         CI,R3    LASTCFU           IS IT THE LAST ONE ?
         BLE      TPCKFUN
TPJRNLFIN EQU     %
*                                   END OF TPJRNLCLS PROCESSING
         PULL     1,R11
         B        *R11
TPCLS    EQU      %
         GET,R4,R6  CFU#TDA1,*R3    GET DCT INDEX
         GET,R6,R2  CFU#TDA0,*R3    LOOK AT BYTE 0 TO TDA
         BNEZ     TPWRT             IF BYTE 0 IS 0 THE JOURNAL IS
         MTW,1    TPDISABLE
*                                   DISABLED
*
*                 UPDATE THE CHANNEL PROGRAMS FOR WRITE
TPWRT    EQU      %
         GET,R1,R2  CFU#SREC,R3     GET BLOCK COUNT FOR EOF1
         AI,R1    1                 ADD 1 FOR CRASH RECORD TO BE WRITTEN
         LI,R2    6                 # OF BYTES TO BE CONVERTED BY CNVDEC
         BAL,R11  CNVDEC
         LI,R6    BLKCNT1
         STH,R8   0,R6
         STW,R9   BLKCNT2
         LI,6     BLK%BUF%1
         STH,R8   0,R6              PREPARE BLOCK COUNT MESSAGE
         STW,R9   BLK%BUF%2
         LD,R6    DCT16,R4
         LI,R5    BLK%BUF%3
         STD,R6   0,R5
         LI,R5    TPIOMNE
         STD,R6   0,R5              INIT ERROR MESSAGE, TOO
         LI,R6    BLK%MES
         XW,R6    R4
         BAL,R11  TYOUT             OUTPUT BLOCK COUNT ON CONSOLE
         MTW,0    TPDISABLE
         BGZ      TPNOJRNL
         XW,R6    R4                RESTORE R4=DCT INDEX
         LH,R6    DCT1,R4           DEVICE PHYSICAL ADDRESS
         STW,R6   TPJRNL
*                 FOR DISK JOURNALIZATION IMPLEMENT USE OF A
*                 DIFFERENT CHANNEL PROGRAM FOR THE DISK, DELETING
*                 THE ANS TRAILER AND THE TAPE MARKS
         LI,R0    DA(TPCJDATACHN)
         SIO,0    *TPJRNL
         BCR,12   TPDOTIO           CONTINUE IF SIO WAS ACCEPTED
         B        TPNOGO            REPORT UNABLE TO DO IO
TPDOTIO  EQU      %
         LI,R6    200
TPIOLOOP LI,R5    1000
         BDR,R5   %
         TIO,0    *TPJRNL
         BCR,12   TPNEXTCJ
         BDR,R6   TPIOLOOP
*                 ANNOUNCE I/O NOT ACCEPTED
TPNOGO   EQU      %
         LI,R4    TPMES8
TPNOGO1   EQU     %
         BAL,R11  TYOUT
        MTW,-1   TPDISABLE
         B        TPNEXTCJ          ON TO NEXT CFU
TPNOJRNL EQU      %
         LI,R4    TPMES12
         B        TPNOGO1
SPECKSUM EQU      %                 CALCULTE THE CHECKSUM OF CANNEDREC
         LI,R7    6                 INIT INDEX REGISTER
         LW,R13   CANNEDREC         INITIALIZE ACCUMULATOR
         LI,R12   0
         LI,R14   0
SPECK1   EQU      %
         LW,R15   CANNEDREC,R7      ADD NEXT WORD
         AD,R12   R14
         BDR,R7   SPECK1
         LW,R15   R12
         LI,R12   0
         AD,R12   R14
         LW,R15   R12
         AD,R12   R14
         STW,R13  CANNEDREC+6       STORE CALCULATED CHECKSUM
         B        *R11              RETURN
*
CNVDEC   EQU      %                 CONVERT BINARY TO DECIMAL EBCDIC
*                 R1=VALUE TO BE CONVERTED
*                 R2=# OF POSITIONS TO BE CONVERTED
*                 R8 AND R9= CONVERTED VALUE UPON EXIT
*        THIS ROUTINE COURTESY OF ALAN RAMACHER
         LI,R0    0
         DW,R0    XA                DIVIDE BY 10
         AI,R0    '0'               DIGIT TO EBCDIC
         SLD,R8   -8                MAKE ROOM
         STB,R0   R8
         BDR,R2   CNVDEC
         SLD,8    -16               KLUDGE SHIFT 2 BYTES FOR ALIGNMENT
         B        *R11
XA       DATA     10
ADRWORD   DATA   X'0001FFFF'
         BOUND    8
TPMES8   TEXTC    '
 RECOVERY * JOURNAL END IMPOSSIBLE ON MMMMMMMM'
TPIOMNE   EQU   DA(%)-1
TPMES12  TEXTC    '
 JOURNAL ON ABOVE DEVICE IS DISABLED  '
BLK%MES  TEXTC    '
XXXXXX  ANS BLOCKS ON MMMMMMMM'
BLK%BUF%1  EQU  HA(BLK%MES)+1
BLK%BUF%2  EQU  WA(BLK%MES)+1
BLK%BUF%3  EQU  DA(BLK%MES)+3
CANNEDCNT  EQU    28                LENGTH OF CANNED REC IN BYTES
         BOUND    8
TPCJDATACHN EQU   %
         GEN,8,24 X'63',0              ERASE ORDER
         GEN,8,24 X'20',0
         GEN,8,24 X'01',BA(CANNEDREC)  WRITE CRASH RECORD
         GEN,8,24 X'20',CANNEDCNT
         GEN,8,24 X'73',0              TAPE MARK
         GEN,8,24 X'20',0
         GEN,8,24 X'01',BA(ANSEOF1)    ANS EOF1 RECORD
         GEN,8,24 X'20',80
         GEN,8,24 X'73',0              TAPE MARK
         GEN,8,24 X'20',0
         GEN,8,24 X'73',0              TAPE MARK
         GEN,8,24 0,0
         DATA     0
         DATA     0
DCLIMS   EQU      %-1
         DATA     8192              7204
         DATA     6144              7232
         DATA     5248              7212
         DATA     24000             7242
         DATA     200*20*11         7260
#TYPES   EQU      5
*
TYPES    DATA,1   0                 DUMMY
         DATA,1   16                7204
         DATA,1   12                7232
         DATA,1   82                7212
         DATA,1   6                 7242
         DATA,1   11                7260
         BOUND    8
CANNEDREC GEN,8,8,16 0,X'12',28     CANNED CRASH RECORD
         DO1      6
         DATA     0
ANSEOF1  TEXT     'EOF1'
*                 FIRST PART OF RECORD NOT LISTED - CONTAINS 50 X'40'
         LIST     0
         DO1      50
         DATA,1   X'40'
         LIST     1
         DO1      6
         DATA,1   X'F0'             DCB BLOCK COUNT
BLKCNT1  EQU      HA(%)-3
BLKCNT2  EQU      WA(%-1)
*                 LAST PART OF RECORD NOT LISTED - CONTAINS 20 X'40'
         LIST     0
         DO1      20
         DATA,1   X'40'
         LIST     1
         TITLE    '                '
         BOUND    8
RBCOM1   GEN,8,24 1,BA(RBTEXT1)     ORDER,ADDRESS
         GEN,8,24 0,43              FLAGS,COUNT
RBCOM2   GEN,8,24 1,BA(RBTEXT2)
         GEN,8,24 0,43
RBCOM3   GEN,8,24 1,BA(RBTEXT3)
         GEN,8,24 0,116
RBCOM4   GEN,8,24 1,BA(RBTEXT4)
         GEN,8,24 0,39
RBTEXT1  DATA     X'16161616',X'0120028C',X'2A2A2A2A',X'2A524543'
         DATA     X'4FD64552',X'D920D3C1'
         DATA     X'D9D320D3',X'54C1CEC4',X'20C2D92A',X'2A2A2A2A'
         DATA     X'19835800'
RBTEXT2  DATA     X'16161616',X'01B0028C',X'2A2A2A2A',X'2A524543'
         DATA     X'4FD64552',X'D920D3C1'
         DATA     X'D9D320D3',X'54C1CEC4',X'20C2D92A',X'2A2A2A2A'
         DATA     X'1983C800'
RBTEXT3  DATA     X'32323232'
         DATA     X'100290BF'
         DATA     X'FF9180DF'
         DATA     X'00070707'
         TEXT     '***RECOVERY SAYS RE-DIAL'
         DATA     X'5C5C5C00'
         DATA     X'94B1DB5C'
         TEXT     '**RECOVERY SAYS RE-DIAL*'
         DATA     X'5C5C0092'
         DATA     X'80DF0007'
         DATA     X'07075C5C'
         TEXT     '*RECOVERY SAYS RE-DIAL**'
         DATA     X'5C000010'
         DATA     X'268075FF'
RBTEXT4  DATA     X'32323232'
         DATA     X'0227C15C'
         TEXT     '**RECOVERY SAYS RE-DIAL*'
         DATA     X'5C5C1903',X'EE90FF00'
         DO       CNM
         SPACE    50*CNM
*
*        SAVE NECESSARY COC TABLES, IN PARTICULAR, MODE5
*        WHOSE LENGTH IS LNOL
*
         SREF     LNOL,MODE5
SAVCOC   STS,11   SAVCOC90          SET RETURN ADDRESS
         LI,R11   COC               CHECK FOR A COC SYSTEM
         BEZ      SAVCOC90          NOPE NOT COC    RMC 8-6-74
         LI,1     LNOL-1
         LB,15    MODE5,1
         BAL,11   SV1
         AI,1     -1
         BGEZ     %-3
         LW,15    SAVCOCCTL
         BAL,11   SV1
SAVCOC90 B        0
SAVCOCCTL GEN,8,24 X'12',LNOL
         FIN
         PAGE
IOQFLUSH EQU      %
         PUSH     SR4
         LI,R1    DCTSIZ            NUMBER OF DCT ENTRIES
KRD3     LB,R6    DCT2,R1           CHANNEL INDEX FOR DEVICE
         LB,R5    CIT1,R6           IOQ INDEX
         BEZ      KRD4              CHANNEL ALREADY PROCESED
         LI,R0    0
         STB,R0   CIT1,R6           SET THIS CHANNEL PROCESSED
         LI,SR2   IOQ9-IOQ8
KRD2     LB,R2    IOQ7,R5           DCTX FOR QUED DEVICE
         LB,R7    DCT4,R2           TYPE NUMONIC INDEX
         LB,R7    TB:FLGS,R7        DEVICE TYPE FLAGS
         CI,R7    X'C0'             ROTATING DEVICE
         BL       KRD5              NO-NO INTEREST IN THIS DEVICE
KRD1     LB,R7    IOQ4,R5           IOQ FUNCTION CODE
         CI,R7    1                 WRITE FUNCTION CODE
         BNE      KRD5              NO-NO INTEREST IN THIS DEVICE
         LH,R3    IOQ9,R5           NUMBER OF BYTES TO WRITE/NO. CDW
         LW,R4    IOQ8,R5           FLAGS,CLIST OR BUFFER ADDRESS(BYTE)
         LC       R4                FLAGS
         BCS,4    KRD5              NO INTEREST IN SWAPPER I/O
         BCS,8    KRD7              COMMAND LIST PRESENT
         LW,SR1   IOQ12,R5          SEEK ADDRESS
         BAL,SR4  WRRAD2            GO-WRITE QUED FILE REQUEST
         NOP                        IGNORE ERROR
         BDR,SR2  %+2
         B        IOQRTN
KRD5     LB,R5    IOQ2,R5           LINK FORWARD WITHIN THIS CHANNEL
         BNEZ     KRD2              PROCESS NEXT QUED DEVICE IN CHANNEL
KRD4     BDR,R1   KRD3              LOOP THROUGH ALL DEVICES
IOQRTN   PULL     SR4
         B        *SR4
KRD7     AND,R4   =X'FFFF'          DA(CLIST)
         ANLZ,D1  =X'320A0000'+IOQ12    LW  IOQ12,R5  (SEEK ADDRESS)
         SLS,D1   2                 BYTE ADDRESS OF IOQ12 ENTRY
         LI,R7    3                 SEEK ORDER CODE
         STB,R7   D1
         LW,D2    =X'2A000004'      COMMAND CHAIN
         LI,R7    8                 TRANSFER IN CHANNEL ORDER CODE
         LW,D3    R4
         STB,R7   D3                INTO DA(CLIST)
         LI,D4    0
         LCI      4
         STM,D1   RCBUF             PUT SEEK,TIC COMMAND LIST IN RCBUF
         LI,R7    1                 WRITE ORDER CODE
         LI,SR1   X'8A'             FLAGS
KRD6     LD,D3    0,R4              COMMAND DOUBLE WORD
         STB,R7   D3                FILL IN WRITE ORDER
         STB,SR1  D4                FILL IN FLAGE
         STD,D3   0,R4              PUT BACK CDW WITH ORDER AND FLAGS
         AI,R4    1                 INC TO NEXT CDW
         BDR,R3   KRD6              DO ALL CDWS
         AI,R4    -1                POINT TO LAST CDW
         EOR,D4   =X'80000000'      TURN OFF DATA CHAIN BIT
         STD,D3   0,R4              BACK TO CLIST BUFFER
         LI,R0    DA(RCBUF)         COMMAND LIST START
         LH,R7    R:DCT1,R2         DEVICE ADDRESS
         :SIO,0   *R7               START TRANSFERRING BYTES
KRD6A    LI,R0    256
         BDR,R0   %                 WAIT
         :TIO,R0  *R7
         BCS,12   KRD6A             UNTIL TRANSFER COMPLETE
         B        KRD4              LOOP TO NEXT DEVICE
         PAGE
         PAGE
*
CR       EQU      '
'               CARRIAGE RETURN CHARACTER
LF       EQU      '
'               LINE FEED CHARACTER
TC       EQU      ' '               TIMING CHARACTER; RUBOUT
TCS      EQU      TC,TC,TC,TC,TC,TC,TC,TC    TIMING CHARACTERS
BELL     EQU      ' '               BELL
XO       EQU      ' '
*                 DATA - MESSAGES FOR RECOVERY CONTROL
M0       TEXTC    '
OPERATOR RECOVERY
'
MNTH     TEXTC    '
RECOVERY FOR UNKNOWN REASON
'
MSFTW    TEXTC    '
SOFTWARE CHECK  XX-YY '
OPERFAIL TEXTC    '
RECOVERY ERROR -'
FAILMS   TEXTC    CR,LF,TCS,'STAND BY - FOR EXTENDED RECOVERY',CR,LF
LPTYORD  GEN,8,24 5,1
ASCII    DATA     X'818203',X'84090687',X'8805958B',X'C8D8E0F'
         DATA     X'90111293',X'140A9617',X'18999A1B',X'9C1D1E9F'
         DATA     0,X'A0000',0,0
         DATA     0,0,0,0
         DATA     X'A0000000',0,X'5C2E',X'3C282BDB'
         DATA     X'A6000000',0,X'2124',X'AAA9BBDD'
         DATA     X'2DAF0000',0,X'DEAC',X'A55FBE3F'
         DATA     0,0,X'3AA3',X'C027BD22'
         DATA     X'4142C3',X'44C5C647',X'48C90000',0
         DATA     X'CA4BCC',X'4D4ECF50',X'D1D20000',0
         DATA     X'0053D4',X'5556D7D8',X'595A0000',0
         DATA     0,0,0,0
         DATA     X'4142C3',X'44C5C647',X'48C90000',0
         DATA     X'CA4BCC',X'4D4ECF50',X'D1D20000',0
         DATA     X'0053D4',X'5556D7D8',X'595A0000',0
         DATA     X'30B1B233',X'B43536B7',X'B8390000',X'FF'
         BOUND    8
LPTYDWD  RES      2
TYINC    GEN,8,24 6,BA(LPTYDWD)
         DATA     1
NORCVR   EQU      %
         MTW,0    RCVFAIL           BEEN HERE BEFORE
         BNEZ     %                 YES GIVE UP
         MTW,1    RCVFAIL           INDICATE BEEN HERE BEFORE
         LCI      0                 SAVE REGISTER CONTENTS FOR POSSIBLE
         STM,0    REGS                 LATER ANALYSIS
         LI,4     FAILMS            TELL USERS ABOUT PROBLEMS
         BAL,11   COCOUT
         LI,4     OPERFAIL          TELL OPERATOR ABOUT PROBLEMS
         BAL,11   TYOUT
*   PUT ERRLOG BUFFER ON OC
         BAL,11   TAPDMP
         LI,R4    BRKMS             SAVE TAPE
         BAL,SR4  TYOUT
         B        %                 OPERATOR MUST REBOOT
BRKMS    TEXTC    '
RE-BOOT SYSTEM - SAVE DUMP TAPE FOR ANLZ
'
RELOGM   TEXTC XO,CR,LF,TCS,BELL,TC,BELL,'RECOVERY SAYS-STAND BY-',CR,LF
CRCOL    DATA     X'15007A00'
RCVFAIL  DATA     0                 FLAG TO INDICATE IF RECOVERY FAILED
TRCVRAD  DATA     0                 TEMP STORAGE FOR RCVRAD
TPACTIVE DATA     0                 FLAG SET IF TP IS GENNED AND ACTIVE
TPJRNL   DATA     0
TPDISABLE   DATA   0
         BOUND    8
REGS     EQU      %                 NORCVR REGISTER STORAGE
         DO1      16
         DATA     0
RCBUF    RES    2096      INPUT BUFFER
         END      RCVCTL

