*M* RCVCTL MAIN PROGRAM FOR RECOVERY.
*P* NAME: RCVCTL
*P* DESCRIPTION:
*P* SUA: BRANCH DIRECTLY TO SUABORT ENTRY POINT IN CYCUSR.
*P* SCREECH:  CLEAR ALL INTERRUPTS WITH 238 LPSD INSTRUCTIONS.
*P*           SAVE AND POINT TRAP X'40' AND X'46' CELLS INTO RECOVER.
*P*           CONVERT R:DCT1 TABLE FROM EBCDIC TO BINARY.
*P*           TYPE OC AND USER TERMINAL MESSAGES.
*P*           CHECK USER TABLES, IF BAD PRINT OC MESSAGE.
*P*           DUMP CORE TO SWAPPER OR TAPE.
*P*           CHECK ALLOCAT STACK TABLES. SET FLAG IF BAD.
*P*           COMPLETE ANY IOQ ENTIES TO ROTATING (NOT SWAPPER) DEVICES.
*P*           MAKE A LIST OF REAL-TIME PAGES.
*P*           CLOSE OUT TP.
*P*           SAVE SYMBIONT TABLES.
*P*           GO TO CYCUSR TO CLOSE ALL OPEN DCBS AND COOPERATIVE FILES.
*P*           CLOSE ALL OPEN CFU BLOCKS.
*P*           REMEMBER DOWN DEVICES.
*P*           SAVE CURRENT ERROR LOG BLOCK.
*P*           SAVE SYSTEM LIMIT TABLES.
*P*           CLOSE ACTIVE SYMBIONT FILES.
*P*           SAVE DISC ADDRESSES IN ALLOCAT STACKS TO RELEASE.
*P*           SAVE SYMBIONT GHOST COMMUNICATION BUFFERS.
*P*           SAVE COC ADMINITRATIVE MESSAGE.
*P*           SAVE LIST OF GRANULES TO RELEASE.
*P*           SAVE SWAPPER ADDRESSES OF USER JITS AND RECOVERY BUFFER.
*P*           READ SWAPPER BOOT ROUTINE AT X'2A'.
*P*           BRANCH TO BOOTENT.
         DEF      HEXCVT
*,*               ENTRY POINT TO CONVERT A BINARY NUMBER TO
*,*               EBCDIC HEX FORMAT.
         DEF      NORCVR
*,*               ERROR ENTRY POINT TO TAKE DUMP TAPE AND STOP.
         DEF      NRCVRX
*,*               A CELLCONTAINING (B NORCVR).
         DEF      RCBUF
*,*               DATA BUFFER IN RECOVERY.
         DEF      RCVCTL
*,*               DEFED SO RCVRIO CAN DETERMINE IF LOADED WITH
*,*               RECOVER1 OR GHOST1.
         DEF      RCVCTL:
*,*               PATCHING DEF FOR XDELTA.
         DEF      TRCVRAD
*,*               SYSTEM DISK ADDRESS OF RECOVERY BUFFER ON PRIMARY
*,*               SWAPPER.
         DEF      TYIN
*,*               ENTRY TO TYPE ONE CHARACTER FROM TY.
         DEF      TYOUT
*,*               ENTRY TO TYPE TEXTC MESSAGE TO TY.
         DEF      XPSDNO
*,*               X'40' TRAP PSD IN RECOVERY.
         DEF      XPSD46
*,*               X'46' TRAP PSD IN RECOVERY.
         DEF      RCVBIAS           BIAS OF RECOVERY
RCVBIAS  EQU      %
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   SIG7P
UTSPROC  SET      0
S69PROC  SET      1
DISCBPROC SET 1
         SYSTEM   UTS
         OPEN     PUSH,PULL
*
*                 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
         REF      SGRAN,BGRAN,CURGRAN,FGRAN1,CURBUF
         REF      FGRAN2,FGRAN3,ERBLOCK,BUF1,BUF2
         REF      R:CHKDA
         SREF     COD:LPC,COCTERM,COCOTV,MODE2,CO:STAT
         REF      RCVDEF,RCVRDSZ,BUFTSIZ,DCT24
         REF      RCVRAD
         REF      SCANCFU
         REF      DATE,TIME,MB:SDI,RDDISK1,M:SWAPD
         REF      RCVDMP,TAPDMP,TSTUSR,SV1,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      WRRAD2,IOQ2
         REF      RCVCODE
         REF      BOOTENT
         REF      RECOVER0
         REF      TRAPSAVE
         REF      TB:FLGS
         REF      R:DCT23,R:DCT22,DISCLIMS,R:HGP
         REF      RBUFSIZE,IOTBLSIZ,BUFLN
         REF      DCT9
         SREF     DCT26             NON-ZERO IF RBT HOOKED TO FECP
         SREF     COCFLAG
         REF      LMSINST           LOC OF LMS INSTRUCTION IN CYCUSR
         REF      R:DCT24,R:DCT7
         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     LCOC
         REF      RRBG10,RELFDA,R:TSTACK
         SREF     HASPBIT
         SREF     COH:DN
         REF      BGRCFU,ACNCFU
         REF      WRDISK1,SAVEREGS  TP RECOVERY WRITES TO QUEUE FILE
         REF      DCT1,DCT16
         GENREFS
         REF      PPCHK
*************************************************************
NO%PRIVATE%DISK   EQU   1           REMOVE WHEN PRIVATE DISK IS CHK'D OUT
*************************************************************
         TITLE    'RCVCTL - MAIN PROGRAM FOR RECOVERY.'
*
*                 PARAMETERS USED IN RECOVERY CONTROL
*
TY       EQU      1
X54      EQU      X'54'
X5A      EQU      X'5A'
X40      EQU      X'40'
X46      EQU      X'46'
X2A      EQU      X'2A'
         PAGE
         REF      SUABORT
         REF      SUABTFLE,DUMPFILE,SUABORT1,SMAKFLG
         DATA     R:DCT1-RCVBIAS    SO RECONFIG KNOWS ADDRESS
         B        SUABORT           SINGLE USER ABORT ENTRY
*F*      NAME:        RCVCTL
*F*      PURPOSE:     ENTRY POINT FOR SCREECH PROCESSING.
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
         LI,R1    X'FFFF'
         WD,R1    X'1100'           DISARM OVERRIDE,IO,CLOCK GROUPS
         LW,R0    XPSDNO            POINT TRAP 40 INTO RECOVER
         XW,R0    X40
         LW,R1    XPSD46
         XW,R1    X46               POINT TRAP 46 INTO RECOVER
         STD,R0   TRAPSAVE          SAVE 40-46 FOR  ANLZ
         LI,1     0
         STW,1    X'2A'             INDICATE RECOVERY TO GHOST1
         LW,0     RCVRAD            SAVE RCVRAD ADDRESSES
         STW,0    TRCVRAD
         LW,R0    NRCVRX            (B NORCVR)
         STW,R0   RECOVER0          SO CANT RECOVER OVER RECOVER
         LI,R1    RBUFSIZE          NUMBER OF PAGES IN RECOVER BUFFER
         SLS,R1   9                 WORDS IN RECOVER BUFER
         AI,R1    RCVDEF+IOTBLSIZ-1 ADDRESS OF LAST WORD IN RECOVER BUF
         STW,R1   BUFLN             SET UP LAST WORD IN BUFLN
         LW,R1    =X'04000000'
         STW,R1   *BUFLN            SET UP RECOVER BUF CODE WORD
*
         LH,0     RCVCODE           L/RECOVERY CODE
         CI,0     X'404'            C/CODE W/.404 (ZAP CODE, FROM SSS)
         BNE      KRD15             BNE
         LI,R1    RBUFSIZE
         SLS,R1   1                 GRANULES IN RECOVER BUF
         AWM,R1   RCVRAD            MAKE ROOM FOR RECOVER BUF IN ZAP PATH
         LI,R1    0
         STW,R1   SMAKFLG           MUST DO A SYSMAK IN ZAP CASE
         AI,0     X'40000'          +.40000
         STW,0    X'2A'
KRD15    EQU      %
         BAL,R11  COCINT            TELL USERS TO STAND-BY
         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      KRD16             NOT OPERATOR RECOVERY
         LI,R1    0
         STW,R1   SMAKFLG           MUST DO A SYSMAK IN OPERATOR RECOVERY
         MTH,1    X'2A'             INDICATE OPERATOR RECOVERY TO GHOST1
         B        REASON+1
KRD16    EQU      %
         CI,0     X'FF'
         BLE      KRD18             KNOWN RECOVER CODE
REASON   EQU      %
         LI,4     MNTH              UNKNOWN
         BAL,11   TYOUT             LOG RCVRY REASON
KRD18    EQU      %
         :TIO,0   TY
         BCS,12   :A                WAIT FOR TY I/O TO COMPLETE
         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
         LH,R0    RCVCODE           SCREECH CODE
         BLZ      KRD19             OPERATOR RECOVERY
         CI,R0    X'FF'             KNOWN RECOVERY
         BG       KRD19             N0
         LI,R4    0
         STB,R4   M0                ZERO M0 TEXTC COUNT
         LW,R4    =X'12000000'
         AWM,R4   MSFTW             INC CHAR COUNT BY 18
         LI,R4    MSFTW             ADDRESS OF MESSAGE
KRD19    EQU      %
         BAL,11   TYOUT             DATE AND TIME OUT
         BAL,R11  RBOUT             TELL WORK STATIONS TO STAND-BY-
         BAL,R11  TPCHECK           VERIFY TPP AND FLAG TP ACTIVE
         BAL,11   TSTUSR            SYSTEM SPECIFIC - ARE USER TBLS REAS
         INT,11   X'2A'             IF SHUTDOWN,DONT DUMP
         BDR,R11  KRD14
         LI,R11   KRD14             RETURN FROM DUMP TO DUMPFILE
         MTW,0    SUABTFLE          DUMPFILE PRESENT
         BEZ      KRD17             NO-DUMP TO SWAPPER
         MTW,0    DUMPFILE          DUMPFILE BUSY
         BNEZ     KRD17             YES-DUMP TO SWAPPER
         LW,R4    RCVRDSZ           SIZE OF SHARED PROC AREA
         SLS,R4   1                      IN SECTORS
         AWM,R4   RCVRAD            POINT TO USER AREA ON SWAPPER.
         B        SUABORT1          DUMP TO DUMPFILE
KRD17    LI,R0    0
         STW,R0   SMAKFLG           YES-DUMP TO SWAPPER AND SYSMAK
         BAL,11   RCVDMP            SYSTEM SPECIFIC
KRD14    EQU      %
         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,SR1   SGRAN
         BAL,R2   CHKGRAN
         LW,SR1   BGRAN
         BAL,R2   CHKGRAN
         LW,SR1   CURGRAN
         BAL,R2   CHKGRAN
         LW,SR1   FGRAN1
         BAL,R2   CHKGRAN
         LW,SR1   FGRAN2
         BAL,R2   CHKGRAN
         LW,SR1   FGRAN3
         BAL,R2   CHKGRAN
         B        ERLOGOK
*
CHKGRAN  BEZ      0,R2              VALIDATE DISK ADDRESS
         BAL,SR4  R:CHKDA
         BCS,15   0,R2              OK
BADERLOG LI,SR1   0
         STW,SR1  SGRAN             ZAP THE POINTERS
         STW,SR1  BGRAN
         STW,SR1  CURGRAN
         STW,SR1  FGRAN1
         STW,SR1  FGRAN2
         STW,SR1  FGRAN3
*
ERLOGOK  EQU      %
         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,R10   BUFTSIZ           SIZE OF ERRLOG BUFFER
         LI,R7    -BUFTSIZ-1        SAVE ERRLOG BUFFER AND BUFFER-1.
         LW,15    *10,7
         BAL,11   SV1
         BIR,7    %-2
         LW,15    ERCODE
         BAL,11   SV1
*
         BAL,11   SYMFILS           TAKE CARE OF IN/OUT ACTIVE SYMS.
         BAL,11   SAVHGP
         BAL,R11  SYSLIM            SAVE ALL SYSTEM LIMITS
         BAL,11   SAVSYM1           GO-SAVE SYMB GHOST COMM BUF
         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
         LI,R1    800
KRD10    MTW,0    STANDBY           STAND-BY MESSAGE COMPLETE
         BNEZ     KRD11             YES
         LI,R2    9000
         BDR,R2   %
         BDR,R1   KRD10             LOOP UNTILL COMPLETE
         DATA     0                 ERROR-LOOP ON STAND-BY MESS.
KRD11    :TIO,0   TY
         BCS,12   :A                CHECK FOR QUIET TY
*                 NOWSIMULATE ANORMAL RAD BOOT.
         LW,D4    X'2A'             SAVE FLAG OVER BOOT
         LI,R1    DCTSIZ            HALT ALL SYSGEN DEVICES
KRD8     LB,R2    DCT24,R1
         CI,R2    2                 DEVICE RECONFIGURED OUT
         BANZ     KRD9              YES-DO NOT HALT
         LC       DCT3,R1           DEVICE PARTITIONED OUT
         BCR,2    KRD20             NO-HALT IT
         LW,R2    DCT9,R1           YES-SEE IF IN DIAG. OPEN
         LC       R2                DIAG OPEN
         BCR,2    KRD9              NO-DO NOT HALT
KRD20    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
ERCODE   GEN,8,24 1,BUFTSIZ+1+8     CODE WORD FOR ERROR LOG BUFFER
FDACODE  GEN,8,24 X'D',1            GRANULE BUFFER FDA CODE
         BOUND    8
DWXPSD   :PSD     RES,(IA,TRAP40),INH,(RP,COCFLAG)
RCUNMAP  EQU      WDTXPSD+3
XPSDNO   XPSD,8   DWXPSD            XPSD FOR TRAP 40 CELL
WDTXPSD  :PSD     RES,(IA,WDX),INH
WDX      MTW,2    WDTXPSD           INC PSD BY 2-IGNORE WATCHDOG
         LPSD,1   WDTXPSD
XPSD46   XPSD,0   WDTXPSD           XPSD FOR TRAP 46
         PAGE
*F*      NAME:        TYOUT
*F*      PURPOSE: TYPE A MESSAGE ON THE TY.
*F*      DESCRIPTION:
*DO*
*F*
*                 TEXTC MESSAGE ADDRESS IN R4
*                 OUTPUT TO TY
*FIN*
TYOUT    PUSH     5
         INT,R5   X2A
         BDR,R5   TYOUT1            NOTYPE IF ZAP
         :TIO,0   TY
         BCS,12   :A                DELAY FOR PREVIOUS TYPE OUT
         LB,5     *4
         CI,R5    BA(OPERFAIL)-BA(MSFTW)-1 MESAGE CAN NOT EXCEED BUF
         BLE      %+2
         LI,R5    BA(OPERFAIL)-BA(MSFTW)-1 TRUNCATE MESSAGE TO BUF SIZE
         STW,R5   LPTYDWD+1         MESSAGE BYTE SIZE
         AI,R5    1                 * SIMULATE A MBS HERE
         LB,R0    *R4,R5            *
         STB,R0   MSFTW,R5          *
         BDR,5    %-2               *
         LI,0     DA(LPTYDWD)
         :SIO,0   TY
TYOUT1   EQU      %
         PULL     5
         B        *11
*F*      NAME:    TYIN
*F*      PURPOSE: INPUT FROM TY ONE BYTE-RETURN IT IN R0.
TYIN     LI,0     DA(TYINC)
         :TIO,0   TY
         BCS,12   :A                DELAY UNTILL OC QUIET
         :SIO,0   TY
         :TIO,0   TY
         BCS,12   :A
         LB,R0    MSFTW             BYTE FROM OC
         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
         PSW,R11  R:TSTACK          SAVE RETURN
         LI,R1    0                 SET UP CHAR POINTER
KRD12    BAL,R11  COCOUT0           GO TYPE A CHAR.
         LI,R2    72000
         BDR,R2   %                 DELAY
         CB,R1    *R4
         BL       KRD12             TYPE ALL CHARS.
         BAL,R11  COCOUT8           GO DO COC CLEAN-UP
         PLW,R11  R:TSTACK          GET RETURN
         B        *R11              RETURN
         SPACE    3
COCINT   EQU      %                 COC OUT WITH INTERRUPT
         LI,R1    COC
         BEZ      *R11              B/NO COC
         INT,R3   X2A
         BDR,R3   *R11              RETURN ON ZAP
         STS,R11  RTNPSD            SAVE RETURN
         LRP      =X'10'            GO TO RP ONE
         LI,R12   X'3002'           TURN HALF-DUPLEX 'OUTPUT'
         BAL,R11  COCOUT8+1
         LW,R1    MTW54
         STW,R1   X54               SET UP CLOCK3 CELL
         LW,R1    XPSD5A
         STW,R1   X5A               SET CLOCK3 INTERRUPT CELL
         LI,R4    RELOGM            ADDRESS OF STAND-BY MESSAGE
         LI,R1    0                 SET UP CHAR COUNT
         LI,R3    X'2080'
         WD,R3    X'1200'           ARM,ENABLE CLOCK3
COCINT1  CB,R1    *R4
         BE       MESSCOMP          DONE WITH MESSAGE
         BAL,R11  COCOUT0           GO TYPE A CHAR.
         LI,R2    60                120 MS
         STW,R2   TIC               SET UP CLOCK CELL
         LPSD,X'B' RTNPSD           RETURN TO INTERRUPTED CELL
RTNPSD   :PSD     (IA,0),II,EI
         :PSD     (IA,COCINT1),(RP,1),INH
MTW54    MTW,-1   TIC
XPSD5A   XPSD,8   RTNPSD
TIC      DATA     X'7FFFFFFF'
STANDBY  DATA     0                 STAND-BY MESSAGE COMPLETE FLAG
MESSCOMP LI,R3    X'2080'
         WD,R3    X'1100'           TURN OFF CLOCK3
         BAL,R11  COCOUT8           GO DO COC CLEAN UP
         MTW,1    STANDBY           SET STAND-BY MESSAGE COMPLETE FLAG
         LPSD,8   RTNPSD            RETURN TO INTERRUPT
         PAGE
COCOUT0  EQU      %
         AI,1     1
         LI,R6    LCOC+1            NUMBER OF COCS
COCOUT1  LI,R2    -1
         AW,R2    R6                COC NUMBER
         LH,R2    COH:DN,R2         COC IO ADDRESS
         CI,R2    -1                PARTITIONED OUT
         BE       COCOUT6           YES-SKIP THIS COC
         TIO,0    *R2               COC PRESENT
         BCS,X'C' COCOUT6           NO-SKIP THIS COC
         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
         BLEZ     COCOUT4           B/TRANS TBL ADR BAD
         LB,R7    *R4,R1            EBCDIC CHAR
         LB,R7    *R8,R7            L/ASCII OR 2741 CHAR
         LC       MODE2,R3          2741 TYPE TERMINAL
         BCS,1    2741TRNS          YES-TRANSLATE FOR 2741
         SCS,R7   32                CHECK # OF BITS SET IN CHAR
         BEV      %+2               B/EVEN # OF BITS OK
         AI,R7    X'80'             +.80; SET PARITY BIT
COCOUT5  SLS,R7   8
         AW,R7    SR2               PUT IN PHYSICAL LINE NUMBER
         WD,R7    *D1               TRANSMIT CHAR
         NOP                        GET OUT LOOP IF WATCH DOG ON WD.
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
COCOUT6  BDR,R6   COCOUT1
         B        *R11              RETURN
         SPACE    3
COCOUT8  EQU      %
         LI,R12   X'300E'           STOP TRANSMIT FUNCTION
         LI,R6    LCOC+1            L/# OF COCS
COCOUT3  LI,R2    -1
         AW,R2    R6                COC NUMBER
         LH,R2    COH:DN,R2         COC IO ADDRESS
         CI,R2    -1                COC PARTITIONED
         BE       COCOUT7           YES
         TIO,0    *R2               COC PRESENT
         BCS,X'C' COCOUT7           NO-SKIP THIS COC
         LI,R13   X'F0'
         LS,R12   CO:STAT-1,R6      DIO ADDRESS
         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
COCOUT7  BDR,R6   COCOUT3
         B        *11
*
2741TRNS CI,R7    X'6E'             C/2741 CHAR W/2741 LF
         BNE      %+2               B/NOT 2741 LF
         LI,R7    X'1C'             L/UPPER CASE SHIFT CHAR
         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
         LI,R0    DCT26
         BEZ      RBOUT1A           NO FECP IF NO DCT26
         LB,R0    DCT26,R2
         BNEZ     RBOUT2            IGNORE RBT IF HOOKED TO FECP
RBOUT1A  CI,R6    LIPBIT+ACTBIT     IS 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        RBOUT5            DISCONNECT SIO
RBOUT3   EQU      %
         CW,R6    2780BIT           2780 BIT ON
         BAZ      RBOUT4            NO
         LI,R0    DA(RBCOM4)
         B        RBOUT5            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
RBOUT5   :SIO,0   *R1
RBOUT2   AI,2     1                 INC DCTX
         BIR,5    RBOUT1
         B        *11
         PAGE
         SPACE    2
*F*      NAME: TPCHECK
*F*      PURPOSE: THE TP PORTION OF RCVCTL IS USED TO VERIFY THAT
*F*               TP IS GENNED INTO THE SYSTEM AND IS ACTIVE.
*F*               IF IT IS THE TP QUEUE WILL BE WRITTEN OUT TO ITS
*F*               QUEUE FILE LOCATION.  THE COMMON JOURNAL(S) WILL
*F*               BE CLOSED FOR POSSIBLE USAGE BY THE TP RECOVERY
*F*               PROCESSORS.
         SPACE    2
************************************************************************
*D*      NAME: TPCHECK
*DO*
*D*
*        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
*FIN*
************************************************************************
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      TPCHKRET          RID OF UNECESSAGE RECOV MSG #24144
         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
         LW,R2    ACNCFU+13         USER CFU UPPER LIMIT IS IN ACNCFU+13
         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      TPCHKRET          RMC GET RID OF UNESSAGE MSG #24144
*                 FLAG TP AS ACTIVE
         MTW,1    TPACTIVE
TPCHKRET EQU      %                 RETURN SET UP
         PULL     1,R11
         B        *R11              RETURN TO RECOVERY CONTROL
TPTYOUT  EQU      %
         BAL,R11  TYOUT
         B        TPCHKRET
TPERR1   GET,R2,R4  Q:TID           IS TP ACTIVE?
         BEZ      TPCHKRET          RMC RID OF UNECESSARY SIDR  #24144
         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 '
TPMES6   TEXTC    '
 TP ALREADY IN RECOVERY - NO ACTION TAKEN'
         TITLE    'TP RECOVERY * TPBLOCKS'
************************************************************************
*D*      NAME: TPBLOCKS
*DO*
*D*
*                 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
*FIN*
************************************************************************
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
         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
         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
         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
********
*D*      NAME: TPOUTPUT
*DO*
*D*
*  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
*
*FIN*
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
TPPUBLIC EQU      %
         SLS,R8   1                 BLOCK TO REL SECT
         L,R9     CFU#FDA,R2
         LDCTX,R6 R9
NXTHGP   EQU      %
         LH,R6    R:DCT23,R6
         AI,R6    R:HGP
         AI,R6    1                 A(HGP)+1
         LH,R3    *R6               DCTX
         LB,R3    R:DCT22,R3        TYPE
         LW,R15   DISCLIMS,R3
         LI,R1    X'FF'             GRAN/CYL
         AND,R1   0,R6
         BEZ      TQGRANALL         NOT CYL ALLOCATED
         SLS,R1   1
         DW,R15   R1
         MW,R15   R1
TQGRANALL EQU %
         LSECTA,R7 R9
         LCW,R5   R7
         AW,R5    R15
         SW,R8    R5
         BLZ      TQDEVFND          +BEG SEC
         AI,R9    X'10000'
         AND,R9   =X'007F0000'
         LH,R6    R9
         B        NXTHGP
TQDEVFND EQU %
         AW,R7    R8
         AW,R7    R5
         STSECTA,R7,R15 R9
         LW,R8    R9
TPIOUT EQU %
*                 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'
************************************************************************
*D*      NAME:  TPJRNLCLS
*DO*
*D*
*
*                 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
*FIN*
************************************************************************
*
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
         CW,R3    ACNCFU+13         IS IT THE LAST ONE
         BLE      TPCKFUN-1         RMC 1-9-75
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'00FFFFFF'
         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'
         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
KRD21    BDR,R9   %+2               ALWAYS CHECK NUMBER OF Q ENTRIES
         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     EQU      %                 DATA CHAINED Q ENTRY
         LB,R7    R:DCT24,R2        DEVICE FLAGS
         CI,R7    4                 MPC CONTROLED DEVICE
         BANZ     FROUNT1           YES-MAKE CLIST
         AND,R4   M24               NO-XEROX DEVICE-DA(MPOOL)
         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
KRD22    EQU      %                 COME BACK FROM MPC CLIST
         LH,R7    R:DCT1,R2         DEVICE ADDRESS
         :SIO,0   *R7               START TRANSFERRING BYTES
         LI,R3    2000              LOOP COUNTER
KRD13    LI,R4    41
         BDR,R4   %                 STANDARD DELAY
         :TIO,R11 0,R7              TEST DEVICE
         BCS,12   KRD23             DEVICE STIL BUSY
         LC       R11
         BCR,6    KRD21             XFER COMPLETE
KRD23    BDR,R3   KRD13             LOOP ON COUNTER
         :HIO,0   0,R7              HALT THE DEVICE
         B        KRD21             GIVE UP
         PAGE
:CDW     CNAME
         PROC
         BOUND    8
LF       GEN,8,24,8,8,8,8     AF(1),AF(2),AF(3),0,AF(4),AF(5)
         PEND
*
:IDCW    CNAME
         PROC
         BOUND    8
LF       GEN,6,6,6,3,1,1,1,6,34  CF(2),;  DEVICE COMMAND
                                     0,;  DEVICE ADDRESS
                                      ,;  MBZ
                                     7,;  MUST BE ALL ONES
                                     0,;  MASK FIELD
                                 AF(1),;  CONTINUE BIT
                                     0,;  MARK BIT
                                 AF(2),;  CHANNEL INSTRUCTION
                                     0    MBZ
         PEND
*
CC       EQU      X'28'             COMMAND CHAIN FLAGS
DC       EQU      X'A8'             DATA CHAIN FLAGS
SIL      EQU      X'2A'             SUPPRESS INCORRECT LENGTH FLAGS
NCC      EQU      X'08'             NO COMMAND CHAINING
WRT      EQU      X'19'             MPC WRITE ORDER
SK       EQU      X'1C'             MPC SEEK ORDER
*
IDCWOFF  EQU      8                 DBL-WORD OFFSET FROM BASE OF CLIST
*
ALLSTOP  :CDW     X'B0',0,NCC,0,0
SEEK     :CDW     3,0,CC,0,5
SKPASS2  :CDW     1,0,CC,0,5
CONTRL   :CDW     3,0,CC,0,5        PASS OPERATION IDCW
TXIC     :CDW     8                 TRANSFER IN CHANNEL
SEEKON   :IDCW,SK            1,X'11'
WRTIT    :IDCW,WRT           0,0
SEEKUP   EQU      %
         LD,R10   SKPASS2           GET CONTROL ORDER TO PASS SEEK #
*
         LH,R8    IOQ9,R3           TOTAL BYTE COUNT
         BNEZ     %+2               LESS THAN MAX
         LI,R8    X'10000'          SET AT MAX
         AI,R8    X'3FF'            ROUND UP
         SLS,R8   -10               TO SECTORS
*
         SLS,R8   4                 POSITION SECTOR COUNT LIMIT FIELD
         LW,R9    IOQ12,R3          GET SEEK ADDRESS
         SLS,R9   12                POSITION RELATIVE SECTOR NUMBER
         SLD,R8   16                POSITION SECTOR NUMBER/SEEK ADDRESS
         STD,R8   0,R6              STORE SEEK ADDRESS IN TOP OF CLIST
         SLS,R6   3                 CREATE SEEK ADDRS BYTE ADDRESS
         OR,R10   R6                INSET THAT BA INTO SIGMA CDW
         STD,R10  0,R7              AND STORE THE CDW AWAY
         SLS,R6   -3                BACK TO DA AGAIN
         B        0,R4              AND RETURN
*
*
GETPAIRS EQU      %
         LD,R8    CONTRL            PASS OPERATION IDCW
         LD,R10   WRTIT             AND HONEYWELL IDCW
DEVNUM   EQU      %
         LH,R12   R:DCT1,R1         GET LOW DIGIT OF DEVICE ADD.
         LI,R13   X'F'              MASK
         SLD,R12  20                POSITION DEVICE NUMBER
         STS,R12  R10               INSERT INTO IDCW
         B        0,R4              AND EXIT TO CALLER
*
*
FROUNT1  PUSH     16,R0             SAVE EM ALL
         LW,R1    R2                DCTX
         LW,R3    R5                IOQX
         LW,R5    IOQ8,R3           DA MPOOL ADDRESS
         AND,R5   M24               DROP THOSE FLAGS IN BITS0 - 3
         LW,R7    IOQ8,R3           DA MPOOL
         SLS,R7   3                 MAKE BYTE ADDRESS
         LI,R15   1                 SET WRITE ORDER IF NOT
         MTB,0    0,R7              HAS MPOOL BEEN CHANGED FOR MPC
         BNEZ     FROUNT3           YES-USE MPOOL AS IS
         LH,R12   IOQ9,R3           GET COMMAND PAIR COUNTER
         CI,R12   5                 NUMBER OF POSSIBLE CDWS
         BLE      FROUNT2           HAVE ROOM FOR THIS NO.
         B        KRD21             GIVE UP
FROUNT2  LI,R10   X'AA00'           FLAGS/WRITE KEY FOR 560
         LI,R4    1                 HALF-WORD INDEX TO BYTE COUNT
         LW,R7    R5                DA OF THE MPOOL
         AI,R7    14                DA OF LAST CDW POSITION
         LW,R6    R5                DA OF MPOOL
         AW,R6    R12               ADD NUMBER OF CDWS
         AI,R6    -1                ADDRESS OF LAST CDW
         LI,R0    0                 INIT BYTE COUNTER REGISTER
ORDERLOP LD,R8    0,R6              CDW GREATED BY CHAINCHK
         STB,R15  R8                INSERT ORDER CODE
         STH,R10  R9                INSERT FLAGS
         AH,R0    R9,R4             CONTINUE CALCULATING B. C.
         STD,R8   0,R7              SPEAD OUT THE CDWS
         AI,R7    -1
         AI,R6    -1                MOVE THE POSITION ADDRESSES
         LD,R8    TXIC              TIC ORDER
         OR,R8    R5                MPC RE-TRY POINT
         STD,R8   0,R7              RE-TRY TIC  INTO CLIST
         AI,R7    -1                MOVE POSITION ADDRESS
         LW,R8    TXIC              TIC  ORDER CODE
         OR,R8    R7
         AI,R8    2                 ADDRESS OF NEXT CDW
         STD,R8   0,R7              NEXT CDW TIC
         AI,R7    -1                MOVE POSITION ADDRESS
         BDR,R12  ORDERLOP          FINISH UP THE CDW LIST
*
         STH,R0   IOQ9,R3           SAVE TOTAL BYTE COUNT
         AI,R7    3                 ADDRESS OF FIRST CDW
         LW,R8    TXIC              TIC  ORDER CODE
         OR,R8    R7
         STD,R8   2,R5              TIC  TO      THE FIRST CDW
         LD,R8    28,R5             LAST CDW
         LI,R10   X'2A00'           AT END OF DATA CHAIN LIST
         STH,R10  R9                DROP THE DC BIT FROM LAST CDW
         STD,R8   28,R5             REPLACE LAST CDW
         B        FROUNT4
*
*        FILL IN CORRECT ORDER CODE IF HERE ON RETRY
*
FROUNT3  EQU      %
         LI,R11   5                 FIVE POSIBLE CDWS
         LW,R7    R5                DA(MPOOL)
         SLS,R7   3                 BA(MPOOL)
         AI,R7    16                FIRST CDW
         STB,R15  0,R7              CORRECT ORDER CODE
         AI,R7    24                NEXT CDW
         BDR,R11  %-2               LOOP ON NUMBER OF POSIBLE CDWS
*
*        SIGMA CDW LIST FOR DATA CHAINING NOW READY TO GO
*
FROUNT4  LH,R7    R:DCT7,R1         DA OF THE CLIST
         LW,R6    R7                COPY CLIST DA TO R6
         AI,R6    IDCWOFF           R6 POINTS TO IDCW AREA
*
*        FIRST SIGMA PAIR MUST BE SEEK
*
         LD,R8    SEEK              NORMAL SEEK CDW
         LD,R10   SEEKON            GET IDCW PAIR FOR SEEK
         BAL,R4   DEVNUM            INSERT DEVICE NUMBER INTO IDCW
         STD,R10  0,R6              SHOVE INTO IDCW AREA
         SLS,R6   3                 BA OF IDCW AREA
         OR,R8    R6                INSERT BA OF IDCW AREA
         STD,R8   0,R7              INSERT SIGMA CDW
         SLS,R6   -3                BACK TO DA
*
*        NEXT IS CDW TO PASS THE SEEK ADDRESS
*
         AI,R7    1                 NEXT SIGMA PAIR
         AI,R6    -1                NEXT IDCW PAIR
         BAL,R4   SEEKUP            BUILD SECTOR #/ SECTOR COUNT
*
*        NEXT PAIR IS TIC  OVER TO THE MPOOL AREA
*
         LD,R8    TXIC              GET A SKELETON TIC CDW
         OR,R8    R5                INSERT THE DA OF THE DATA CHAIN LIST
         AI,R7    1                 NEXT CDW LOC IN CLIST
         AI,R6    -1                NEXT IDCW LIST
         STD,R8   0,R7              STORE THE TIC  TO THE DATACHAIN LIST
*
*        NEXT PAIR IS THE CONTROL CDW FOR THE TRANSFER OPERATION
*
         BAL,R4   GETPAIRS          LOAD REGISTERS UP W/CDW'S AND IDCW'S
         LW,R12   R6                CURRENT IDCW DOUBLEWORD ADDRS
         SLS,R12  3                 INTO BA FORMAT
         OR,R8    R12               INSERT INTO SIGMA CDW
         STD,R8   0,R5              STORE IN BOTTOM OF LIST
         STD,R10  0,R6              STORE THE OPERATION IDCW AWAY
         LW,R15   R5                HOLD HEAD OF LIST DA IN R15
         LW,R7    R5                DA OF THE MPOOL
         AI,R7    15                DA OF POSITION FOR STOP ORDER
         LD,R8    ALLSTOP           GET COMPLETE STOP CDW (SIGMA)
         STD,R8   0,R7              REPLACE
*
*        NEXT PAIR IS THE TIC  ORDER
*
         AI,R7    1                 STEP TO THAT LOC
         LD,R8    TXIC              PICK IT UP
         OR,R8    R15               R15 IS HOLDING THE DA OF THE ORDER
         STD,R8   0,R7              WE MUST TIC  TO FOR RECOVERY STEPS
         PULL     16,R0             BRING EM BACK
         LH,R0    R:DCT7,R2         DA(CLIST)
         B        KRD22             BACK TO IOQ FLUSH LOOP
*
*
M24      DATA     X'00FFFFFF'
         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      ' '
ESC      EQU      ' '               ESCAPE CHARACTER
SI       EQU      ' '               SHIFT-IN CHARACTER
*                 DATA - MESSAGES FOR RECOVERY CONTROL
MSFTW    TEXTC    '
SOFTWARE CHECK  XX-YY '
M0       TEXTC    '
OPERATOR RECOVERY
'
MNTH     TEXTC    '
RECOVERY FOR UNKNOWN REASON
'
OPERFAIL TEXTC    '
RECOVERY ERROR -'
FAILMS   TEXTC    CR,LF,TCS,'STAND BY - FOR EXTENDED RECOVERY',CR,LF
         BOUND    8
LPTYDWD  GEN,8,24    5,BA(MSFTW)+1  BUFFER ADDRESS
         DATA     0                 BYTE COUNT
*
TYINC    GEN,8,24    6,BA(MSFTW)    INPUT BUFFER
         DATA     1
40FLAG   DATA     0                 NO TRAP 40 YET
TRAP40   MTW,1    40FLAG
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,R0   REGS1             SAVE REGISTER BLOCK ONE
         LRP      =0                GO TO BLOCK ZERO
         STM,0    REGS                 LATER ANALYSIS
         MTW,0    40FLAG
         BEZ      NORCVR4           NOT TRAP 40
         LI,R0    X'1FFFF'
         AND,R0   DWXPSD
         CI,R0    LMSINST
         BNE      NORCVR4           NOT THE LMS INSTRUCTION IN CYCUSR
         LI,R0    0
         STW,R0   RCVFAIL           CLEAR FAILURE PATH
         MTW,1    DWXPSD            INCR OLD PSD
         LPSD,8   DWXPSD            RETURN
NORCVR4  LI,R3    X'2080'
         WD,R3    X'1100'           TURN OFF CLOCK3
         LI,4     FAILMS            TELL USERS ABOUT PROBLEMS
         BAL,11   COCOUT
         LI,4     OPERFAIL          TELL OPERATOR ABOUT PROBLEMS
         BAL,11   TYOUT
         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
'
         DO1      6
         DATA     0                 PATCH AREA FOR HEADER TO 'STAND-BY' MES.
RELOGM   TEXTC    TC,TC,TC,TC,;
                  TC,TC,XO,CR,LF,TCS,BELL,TCS,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
REGS1    DO1      16
         DATA     0                 SAVE AREA FOR BLOCK ONE REGS.
         BOUND    8                 RCBUF MUST BE EVEN******
RCBUF    RES      511
         DATA     0
         END      RCVCTL

