*M* CYCUSR RECONSTRUCT USERS IN CORE TO CLOSE OPEN DCBS.
*P* NAME: CYCUSR
*P* DESCRIPTION:
*P* SV1: PUT A WORD INTO THE RECOVERY BUFFER.
*P* MVEBUF:  MOVE USER JITS, RBBAT AJIT, AND RBBAT DATA PAGES
*P*               BELOW WHERE USER# 4 WILL SWAP WHEN MONITOR IS RE-BOOTED.
*P*          PUT RBBAT JIT AND AJIT SWAPPER ADDRESS IN RECOVER BUFFER.
*P*          PUT RECOVER CODE X'11' ITEMS INTO RECOVER BUFFER.
*P*          PUT ZAP CODE IN RECOVER BUFFER IF ZAP.
*P*          MOVE CONTENTS OF RECOVER BUFFER TO HIGH END OF BUFFER.
*P*          PUT USER JIT SWAPPER ADDRESSES IN RECOVER BUFFER.
*P*          WRITE RECOVER BUFFER TO SWAPPER.
*P*          IF ZAP, TYPE 'THAT'S ALL FOLKS' ON OC AND PLAY MUSIC.
*P* SVDNDEV: PUT LIST OF DOWN DEVICES IN RECOVER BUFFER.
*P* SYSLIM: SAVE MONITOR TABLES FROM THE LIST OF TABLES IN RCVTAB.
*P* CYCUSR: AJUST INCORE/OUT-OF-CORE FLAG. USER BEING SWAPPED
*P*               IN IS OUT-OF-CORE, USER BEING SWAPPED OUT IS IN-CORE.
*P*         CLOSE DCBS AND COOPERATIVE FILES FOR IN CORE USERS.
*P*         CLOSE DCBS AND COOPERATIVE FILES FOR OUT-OF-CORE USERS.
*P* MAPSET:  LOAD THE HARDWARE MAP REGISTER WITH MAP IMAGE FOR A USER.
*P* R:MAP: CHANGE CURRENT PSD TO MAPPED MODE.
*P* R:UNMAP: CHANGE CURRENT PSD TO UNMAPPED MODE.
*P* MAPSPARE: MAP A SPARE BUFFER INTO A WINDOW PAGE OF A USER.
*P* READPGE: READ A USER PAGE FROM SWAP DEVICE INTO NON REAL-TIME PAGE.
*P* PGCHK: INSURE REAL-TIME PAGES ARE NOT CLOBBERED ACROSS RECOVER.
*P* TSTUSR: CHECK USER TABLES IN CORE FOR CONSISTENCY.
*P* ACCPGE: MAKE A TABLE OF SWAPPER ADDRESSES FOR PAGES IN A USER'S
*P*               COMMAND LIST.
*P* RCVDMP: DUMP ALL OF PHYSICAL CORE TO SWAPPER.
*P* TAPDMP: DUMP ALL OF PHYSICAL CORE TO A TAPE IN LABELED TAPE FORMAT.
*P* SUABORT: DUMP ALL OF PHYSICAL CORE TO A RADOM FILE(DUMPFILE)
*P*               AND WRITE ALL IN-CORE AND PRIMARY SWAPPER USER JITS
*P*                   TO DUMPFILE.
         DEF      CYCUSR:           PATCHING DEF
         DEF      CYCUSRS
*,*               ENTRY POINT TO RECONSTRUCT USERS IN CORE FOR
*,*               DCB CLOSEING.
         DEF      MAPFLG
*,*               INDICATOR IF RECOVERY IS CURRENTLY RUNNING MAPPED.
         DEF      MAPSPARE
*,*               ENTRY POINT OF ROUTINE TO PUT PHYSICAL PAGE IN
*,*               USER MAP IMAGE.
         DEF      MVEBUF
*,*               ENTRY POINT OF ROUTINE TO CLEAN UP AND WRITE
*,*               RECOVERY BUFFER TO SWAPPER.
         DEF      PPCHK
*,*               ENTRY POINT TO CHECK FOR REAL TIME PAGES.
         DEF      RCVDMP
*,*               ENTRY POINT TO ROUTINE TO DUMP ALL OF MEMORY
*,*               TO PRIMARY SWAPPER.
         DEF      RCVRT
*,*               ENTRY POINT TO ROUTINE TO CHECK REAL TIME PAGES.
         DEF      SUABORT
*,*               ENTRY POINT OF SUA ROUTINE TO DUMP MEMORY
*,*               TO DUMPFILE.
         DEF      SUABORT1
*,*               ENTRY POINT OF ROUTINE TO DEUMP MEMOY TO DUMPFILE
*,*               IN FAST PATH.
         DEF      SV1
*,*               ENTRY POINT OF ROUTINE TO PUT A WORD INTO
*,*               RECOVERY BUFFER.
         DEF      SYMBGERR
*,*               CELL TO INDICATE ERROR RECONSTRUCTING RBBAT DATA.
         DEF      SYMBGUNO
*,*               CELL CONTAINING RBBAT USER NUMBER.
         DEF      SYSLIM
*,*               ENTRY POINT OF ROUTINE THAT SAVES SYSTEM LIMITS.
         DEF      TAPDMP
*,*               ENTRY POINT OF ROUTINE THAT WRITES MEMORY TO
*,*               LABELED TAPED.
         DEF      TSTUSR
*,*               ENTRY POINT OF ROUTINE THAT CHECKS IN CORE
*,*               TABLES.
         DEF      USER#
*,*               CELL THAT CONTAINS NUMBER OF USER BEING RECONSTRUCTED
         DEF      X560CUCL
*,*               ADDRESS OF 560 CLUSTER CONVERSION TABLE.
         DEF      X560CUCLL
*,*               EQU OF LENGTH OF 560 CLUSTER CONVERSION TABLE.
         DEF      BUFLN             CELL CONTAINS ADDRESS OF LAST WORD
*,*                                 IN RECOVER BUFFER.
         DEF      R:JXCMAP          CMAP BUFFER IN RECOVERY.
         DEF      LMSINST           LOC FOR LEGAL TRAP 40
         DEF      TAPDCTX,TAPDEV,WRTAP,WREOF
*
         SYSTEM   SIG9P
CYCUSR:  RES
*
DISCBPROC SET     1
UTSPROC  SET      0
S69PROC  SET      1
         SYSTEM   UTS
         CLOSE    BUFSIZ
         PCC      0
         SPACE    3
TXTC     CNAME
         PROC
         LOCAL    I,VEC
LF       EQU      %
VEC      SET      NUM(S:UT(AF)),S:UT(AF)
I        DO       (NUM(VEC)+3)/4
         GEN,8,8,8,8  VEC(I*4-3),VEC(I*4-2),VEC(I*4-1),VEC(I*4)
         FIN
         PEND
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
:CDW     CNAME
         PROC
         BOUND    8
LF       GEN,8,24,8,24  AF(1),;     ORDER CODE
                        AF(2),;     ADDRESS
                        AF(3),;     FLAGS
                        AF(4)       SIZE
         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
         PAGE
         REF      UB:ASP,P:SA,PB:PVA,PB:DCBSZ
         REF      JAJITVP,LOW
         REF      RCVDEF,IOTBLSIZ
         REF      RCVBIAS
         REF      SB:HQ
         REF      R:TSTACK
         PAGE
R0       EQU      0
R1       EQU      1
R2       EQU      2
R3       EQU      3
R4       EQU      4
R5       EQU      5
R6       EQU      6
R7       EQU      7
R8       EQU      8
SR1      EQU      8
R9       EQU      9
SR2      EQU      9
R10      EQU      10
SR3      EQU      10
R11      EQU      11
SR4      EQU      11
R12      EQU      12
D1       EQU      12
R13      EQU      13
D2       EQU      13
R14      EQU      14
D3       EQU      14
R15      EQU      15
D4       EQU      15
X2A      EQU      X'2A'
         TITLE    'CYCUSR - RECONSTRUCT USERS TO CLOSE OPEN DCBS.'
         REF      JBPCP,JBPCDD,JBPCC
         REF      CKRAD
*
         REF      TABLE,TABLESZ
         REF      JSPBFLG,JSBUF1VP,JBUPVP
         REF      FPMC,HIGH
         REF      TIME,RCVCODE
         REF      JIT
         REF      CLSFILS,COOPFILS
         REF      RCVRAD            NEXT AVAILABLE SWAP GRANULE
         REF      TYIN,MX:PPUT,JX:PPT,JX:PPH,DCTSIZ
         REF      SNSTS,DATE
         REF      UH:AJIT
         REF      SMUIS,UB:US,UH:FLG,UX:JIT,NPMC,UH:JIT
         REF      SMAKFLG,BOOTFLG
         REF      JCMAP,TSTACK,JB:VLH,J:CLE
         REF      JXBUFVP,J:DCBLL,J:DCBUL
         REF      JH:DA,JB:LMAP
         REF      M:ADRINCR
         REF     J:DLL,J:DDUL
         REF      CORED
         REF      JB:PPC,J:JIT,RDRAD1,JJITVP
         REF      J:AJIT
         REF      TYOUT
         REF      RCVRDSZ,WRRAD1
         REF      RCBUF
         REF      RCVRCNT,HEXCVT
         REF      S:SIP,DID%IO,SB:OSUL,S:ISUN
         REF      R:CHKDA,R:DSCCVT,WRDISK1
         REF      NORCVR
         REF      UB:SWAPI
         REF      BOOTSBAND
         REF      TRCVRAD
         REF      NRCVRX,RECOVER0
         REF      S:DP
         REF      WRUSR1
         REF      R:DCT24
         REF      R:DCT1
         REF      RDUSR1
         SREF     UB:C#
         SREF     MPCDUMP
         REF      RDDISK1
         REF      MB:SDI
         REF      M:GASLIM,MB:GAM6
         REF      S:CUN
         REF      :BIG,:BSIG,:B560
         REF      PWPTABLE,PWPEND
         REF      RBUFSIZE
         REF      JB:CUN            USER # IN JIT
         REF      R:DCT1A,R:DCT4,TB:FLGS,R:DCT22
         REF      R:NSPT,R:NTPC
         PAGE
*
*                 ROUTINES TO SAVE AND MOVE BUFFER
*
BUFFER   EQU      RCVDEF+IOTBLSIZ   START OF RECOVER BUFFER
BUFLN    DATA     0                 ADDRESS OF LAST WORD IN RECOVER BUF
*                                   (X'04',0) NO. WORDS IN REC BUFFER
JITCD    DATA     X'8000001'
JITLN    DATA     0
JITDA    RES      256               ADDRESSES OF JITS
MVE1     DATA     0                 TEMP STORAGE
MVE11    DATA     0
*F*      NAME:    SV1
*F*      PURPOSE: PUT A WORD INTO THE RECOVERY BUFFER.
SV1      EQU      %                 SAVE ONE WORD WITHOUT DISTURBING
         STW,15   TEMP
         LW,R15   *BUFLN            NO. OF WORDS IN RECOVER BUFFER
         AI,15    BUFFER            LOC +N
         XW,15    TEMP
         STW,15   *TEMP
         MTW,1    *BUFLN            COUNT THIS WORD
         B        *11
TEMP     DATA     0
         BOUND    8
DLIM     DATA     0,0
BTSBNDTMP DATA    0
         PAGE
*F*      NAME:    MVEBUF
*F*      PURPOSE:
*DO*
*F*
* PACK DATA TO TOP END OF BUFFER AND WRITE TO RCVRAD AREA. MOVE JITS
* IN THE WAY OF GHOST1.
*FIN*
*F*      DESCRIPTION:
*F*          MOVE USER JITS, RBBAT AJIT, AND RBBAT DATA PAGES
*F*               BELOW WHERE USER# 4 WILL SWAP WHEN MONITOR IS RE-BOOTED.
*F*          PUT RBBAT JIT AND AJIT SWAPPER ADDRESS IN RECOVER BUFFER.
*F*          PUT RECOVER CODE X'11' ITEMS INTO RECOVER BUFFER.
*F*          PUT ZAP CODE IN RECOVER BUFFER IF ZAP.
*F*          MOVE CONTENTS OF RECOVER BUFFER TO HIGH END OF BUFFER.
*F*          PUT USER JIT SWAPPER ADDRESSES IN RECOVER BUFFER.
*F*          WRITE RECOVER BUFFER TO SWAPPER.
*F*          IF ZAP, TYPE 'THAT'S ALL FOLKS' ON OC AND PLAY MUSIC.
MVEBUF   EQU      %
         STW,11   MVE11             SAVE LINK
         LW,R8    SUABTFLE          FDA OF DUMPFILE
         STW,R8   TSUAFLE
         LI,R2    RBUFSIZE+RBUFSIZE+2 MAKE ROOM FOR RECOVERY BUF+RBBAT JIT
         BAL,R11  SECTAINC          SET SUABTFLE TO RBBAT DATA GRANULES
         LW,R7    JITLN             NUMBER OF JITS IN SYSTEM
         STW,R7   JITLNSAV          SET UP IF NO RBBAT
         BEZ      MVEJITP           NO-SKIP GHOST1 TESTS
         LW,R7    SYMBGUNO          SYMBIONT GHOST USER NUMBER
         BEZ      KRD4              SYMB GHOST NOT RUNNING
         MTW,0    S:DP
         BEZ      KRD28             RAD SWAPPER
*                                   PACK SWAPPER MOVE USER NO. FOUR
*                                   JIT TO SNULL USER SLOT.
         LI,R7    4                 USER NO. FOUR
         LH,R1    UH:JIT,R7
         STB,R7   R1                USER NO.,..... TO COMPARE WITH
         LW,R2    JITLN             NO. OF JITS
         CW,R1    JITDA-1,R2        USER NO. FOUR JIT ADD
         BE       KRD29             YES
         BDR,R2   %-2
         B        JBFKDRGAP1        NO USER NO. FOUR
KRD29    LI,R8    1                 JIT SECTOR NO.
         LI,R3    4*512             JIT SIZE
         LI,R4    RCVBIAS-X'800'    BUFFER
         BAL,R11  RDUSR1            READ USER 4 JIT
         B        JBFKDRGAP1        ERROR
         LI,R7    SNULL             SNULL STATE
         LB,R7    SB:HQ,R7          HEAD OF SNULL CHAIN
         STB,R7   R1                NEW USER NO.
         STW,R1   JITDA-1,R2        INTO JIT TABLE
         BEZ      JBFKDRGAP1        NO SNULL SLOT
         BAL,R11  WRUSR1            WRITE NO. 4 JIT TO NEW SLOT
         B        JBFKDRGAP1        ERROR
         B        JBFKDRGAP1        CONTIUE WITH PACK SWAPPER
         SPACE    3
* * * * ****************************************************************
*        PUT SWAPPER DISC ADDRESS OF SYMBIONT GHOST (00) AND AJIT      *
*        PAGES INTO JITDA TABLE SO THEY WILL GET MOVED IF IN WAY       *
*        OF GHOST1                                                     *
* * * * ****************************************************************
         SPACE    3
KRD28    EQU      %                 RAD SWAPPER
         LW,8     BOOTSBAND         SET UP BOOTSBAND SEEK ADDR
         BAL,11   R:DSCCVT          FOR LIMIT CHECK LATER.
         STW,8    BTSBNDTMP
         LH,SR1   UH:JIT,R7
         STB,R7   SR1               USER NO,0,SEEK ADDRESS OF JIT
         LW,R1    JITLN
         CW,SR1   JITDA-1,R1
         BE       KRD7
         BDR,R1   %-2
         B        ABN18:5           ERROR-CANT FIND SYMB GHOST JIT
KRD7     STW,R1   SYMBGJIX          SAVE SYMB GHOST JITDA-1 INDEX
         LI,R3    512*4
         LI,4     J:JIT             BUFF FOR JIT INPUT.
         BAL,11   RDUSR1
         B        ABN17:5
         LI,R8    :BIG
         BEZ      GRIM
         LH,8     UH:AJIT,7         IF BIG9 READ AJIT TO GET
         STB,7    8                 AT DISC ADDRESS TABLE.
         LI,4     J:AJIT
         BAL,11   RDUSR1
         B        ABN17:5
GRIM     LI,3     JBPCP+1           #DATA PAGES
         LI,R4    J:JIT             ADDRESSS OF JIT
         LB,2     *4,3
         LI,3     JBPCDD            #DYN DATA PAGES
         LB,1     *4,3
         AW,2     1
         LI,3     JBPCC             #CONTEXT PAGES
         LB,1     *4,3
         MTH,0    UH:AJIT,R7        RABIT HAVE AJIT
         BEZ      %+2               NO
         AI,R1    -1                YES-TAKE OUT AJIT PAGE
         AI,R1    -1                TAKE OUT JIT PAGE
         AW,R2    R1                TOTAL (00) PAGES IN RABBIT
         AI,R2    3                 ROUND UP TO FULL GRANULE GROUP
         SAS,2    -2                (N+2)/4
         SAS,1    -2                INDEX TO FIRST DA
         SW,2     1                 NUMBER OF DAS
         LW,R3    JITLN
         AW,R3    R2
         STW,R3   JITLN             # OF PAGES TO CHECK-GHOST1 CONFLICT
         STW,R1   DISCDAIX          SYMB GHOST (00) JH:DA INDEX
KRD5     LH,R5    JH:DA,R1          SEEK ADDRESS OF (00) PAGE SYMB GHOST
         AI,R1    1                 INC TO NEXT JH:DA ENTRY
KRD6     STB,R7   R5                USER#,0,SEEK ADDRESS
         STW,R5   JITDA-1,R3
         AI,R3    -1
         BDR,R2   KRD5              COPY ALL (00) PAGES TO JIT LIST
KRD4     EQU      %
         LW,R1    JITLN             NO. OF JITS
MVEJITS  LW,8     JITDA-1,1         GET NEXT JIT POINTER
         LB,7     8                 USER NUMBER
         STW,1    MVE1              YES - SAVE INDEX
         LW,R15   X2A               RECOVER FLAG
         CI,R15   X'40404'          ZAPPING
         BNE      %+3               NO-NO NEED TO CHECK FOR RBBAT
         CI,R7    3                 RBBAT
         BE       KRD30             YES-MOVE AND WRITE TO DUMPFILE
         LB,15    UB:SWAPI,7        IS THIS THE SWAPPING RAD WITH SYSTEM
         BNEZ     MVEJIT2           NO - NO CONFLICTS
         AND,SR1  =X'FFFF'          MASK OUT SEEK ADDRESS
         CH,8     BTSBNDTMP         IS JIT IN GHOST1 SWAP AREA.
         BL       MVEJIT2           NO
KRD30    EQU      %
         LI,3     512*4             JIT SIZE
         CW,1     JITLNSAV
         BLE      %+2               JIT PAGE
         SAS,3    2                 SYM DATA, READ 4 GRANULES
         LI,R4    RCVBIAS-X'800'    4 PAGE BUFFER
         BAL,11   RDRAD1            BRING IN JIT
         B        MVEJIT2           BAD ADDRESS
         MTB,0    UB:SWAPI,R7       SECOND SWAPPER
         BNEZ     KRD31             YES-NO NEED TO MOVE
MVEJIT0  LW,R8    RCVRAD            CURRENT DA OF DUMP AREA
         STW,R8   TEMP              SAVE TO WRITE TO
         BAL,R11  INCRDA            BUMP RCVRAD
         CW,1     JITLNSAV
         BLE      %+3               JIT PAGE
         MTW,-3   RCVRDSZ           INCR DA X4
         MTW,6    RCVRAD
         LW,11    RCVRDSZ           IS THERE MORE ROOM IN DUMP AREA
         BLEZ     NOROOM            NO - MAY HAVE TO LOOK ELSEWHERE
MVEJIT1  LI,R4    RCVBIAS-X'800'    4 PAGE BUFFER
         LI,3     512*4
         CW,1     JITLNSAV
         BLE      %+2               JIT PAGE
         SAS,3    2                 SYM DATA,WRITE 4 GRANULES
         LW,R8    TEMP              RCVRAD DA
         BAL,11   WRDISK1           WRITE JIT TO NEW AREA
         B        MVEJIT2           OH-OH! WE GAVE IT A BAD ADDRESS
         BAL,11   R:DSCCVT          GET SEEK ADDRESS
         LH,8     8
         LI,9     X'FFFF'           MODIFY RAD ADDRESS IN JIT POINTER
         STS,8    JITDA-1,1
KRD31    MTW,0    DUMPFILE          DUMPFILE BUSY
         BNEZ     MVEJIT2           YES-DO NOT COPY TO DUMPFILE
         LW,R15   X2A               RECOVER FLAG
         CI,R15   X'40404'          ZAPPING
         BNE      MVEJIT2           NO-DO NOT COPY TO DUMPFILE
         CW,R1    JITLNSAV          RBBAT DATA GRANULE GROUP
         BLE      MVEJIT2           NO
         LI,R5    4                 WRITE 4 PAGES
         LI,R3    512*4             ONE PAGE AT A TIME
KRD34    LW,R8    SUABTFLE          DUMPFILE DA
         BAL,R11  WRDISK1           WRITE RBBAT DATA GRANULE GROUP
         B        MVEJIT2           ERROR
         AI,R4    512               A PAGE
         LI,R2    2                 ONE PAGE
         BAL,R11  SECTAINC          INC DA IN SUABTFLE
         BDR,R5   KRD34             WRITE GRANULE GROUP ONE AT A TIME
MVEJIT2  LW,1     MVE1
         BDR,1    MVEJITS           LOOP UNTIL ALL JITS PROCESSED
         PAGE
* * * * ****************************************************************
*        IF SYMBIONT GHOST (00)        GRANUALS HAD TO BE MOVE FOR     *
*        GHOST1, PUT NEW ADDRESS IN SYMBIONT GHOST JIT JH:DA AND WRITE *
*        UPDATED  JIT TO UPDATED DISC ADDRESS. RESTORE TRUE NO. OF JITS*
*                                                                      *
*        SAVE                                                          *
*             FOR RAD SWAPPER
*                 0,SWAPX,SEEK      AJIT     ZERO=NO AJIT              *
*                 0,SWAPX,SEEK      JIT                                *
*                 0F000002          CODE WORD
*
*             FOR PACK SWAPPER
*                 USER#,0,C#,0      AJIT
*                 USER#,0,C#,0      JIT
*                 0F000002          CODE WORD
* * * * ****************************************************************
         SPACE    3
JBFKDRGAP1  EQU    %
         LW,R7    SYMBGUNO          SYMBIONT GHOST USER NUMBER
         BEZ      MVEJITP           NO SYMB GHOST PRESENT
         LW,R1    SYMBGERR          SYMBIONT GHOST ERROR WORD
         CI,R1    2                 BAD DATA PAGES
         BANZ     MVEJITP           YES-SKIP SYMBIONT GHOST
         MTW,0    S:DP
         BEZ      KRD7:9
         LB,15    UB:C#,7           CYLINDER NUMBER
         SLS,15   8
         STB,7    15                USER NUMBER
         BAL,SR4  SV1
         BAL,SR4  SV1
         LW,D4    =X'0F000002'
         BAL,SR4  SV1               F CODE WORD FOR RECOVER2
         B        MVEJITP1
KRD7:9   EQU      %
         LW,R1    DISCDAIX          SYMB GHOST (00) JH:DA INDEX
         LW,R2    JITLN
         SW,R2    JITLNSAV          PAGE COUNT ALL SYMB GHOST DATA
         LW,R3    JITLN             # OF PAGES TO CHECK GHOST1 CONFLICT
         LH,D4    UH:AJIT,R7        AJIT PRESENT
         BEZ      KRD8              NO
         LB,R5    UB:SWAPI,R7
         LI,D4    :BIG              BIG MAP MODE
         BEZ      KRD8              NO-DONT SAVE AJIT ADDRESS
         LW,R4    SYMBGJIX          INDEX TO RBBAT JIT ADDRESS
         LW,D4    JITDA,R4          UPDATED SYMB GHST AJIT SEEK ADDRESS
         STH,5    D4                0,SWAPX,AJIT SEEK ADDR
KRD8     BAL,SR4  SV1               GO-SAVE DISC ADDRESS OF AJIT
KRD9     LW,R5    JITDA-1,R3        UPDATED DISC SEEK ADDRESS
         STH,R5   JH:DA,R1          BACK TO JH:DA IN JIT
         AI,R1    1                 INC JH:DA INDEX
         AI,R3    -1                INC JITDA INDEX
         BDR,R2   KRD9              UPDATE ALL (00) PAGES
         LI,R3    512*4
         LI,4     J:JIT             BUFF FOR JIT OUTPUT.
         LW,R5    SYMBGJIX          SYMB GHOST JITDA-1 JIT INDEX
         LW,SR1   JITDA-1,R5        UPDATED SYMB GHOST JIT SEEK ADDRESS
         BAL,SR4  WRRAD1            GO-WRITE UPDATED JIT TO UPDATED ADDR
         B        ABN19:5           ERROR-BAD I/O-WE LOST THE SYMB GHOST
         MTW,0    DUMPFILE          DUMPFILE BUSY
         BNEZ     KRD32             YES-DO NOT COPY RBBAT JIT
         LW,R15   X2A               RECOVER FLAG
         CI,R15   X'40404'          ZAPPING
         BNE      KRD32             NO-DO NOT COPY RBBAT JIT
         LW,R8    TSUAFLE           FDA OF DUMPFILE
         LI,R2    RBUFSIZE+RBUFSIZE  INC OVER RECOVER BUF
         BAL,R11  SECTAINC
         BAL,R11  WRDISK1           COPY RBBAT JIT TO DUMPFILE
         B        ABN19:5           ERROR
KRD32    EQU      %
         LI,R4    :BIG              BIG MAP MODE
         BEZ      ABN19
         LI,4     J:AJIT
         LW,8     JITDA,5
         BAL,11   WRRAD1            WRITE OUT THE AJIT..
         B        ABN19:5
ABN19    EQU      %
         LW,D4    JITDA-1,R5
         LB,R5    UB:SWAPI,R7
         STH,R5   D4                0,SWAPX,SEEK ADDRESS
         BAL,SR4  SV1               GO-SAVE DISC ADDRESS OF JIT
         LW,D4    =X'0F000002'      F CODE WORD FOR RECOVER2
         BAL,SR4  SV1               F CODE WORD FOR RECOVER2
MVEJITP1 EQU      %
         LW,R5    JITLNSAV
         STW,R5   JITLN             RESTORE NUMBER OF TRUE JITS
MVEJITP  EQU      %
         LW,D4    SYMBGERR          ERROR WORD
         LH,D3    RCVCODE
         CI,D3    -1                OPERATOR RECOVERY
         BNE      %+2               NO
         OR,D4    =1                INDICATE OPERATOR RECOVERY
         LW,D3    S:CUN             CURRENT USER NUMBER
         STB,D3   D4                SAVE FOR RABBIT
         BAL,SR4  SV1               GO-SAVE ERROR WORD
         LW,D4    RCVRCNT           NUMBER OF RECOVERYS
         BAL,SR4  SV1               SAVE NUMBER OF RECOVERYS
         INT,D4   DUMPFILE+1        NUMBER OF JITS
         BAL,SR4  SV1               SAVE SUA DUMP FILE BUSY FLAG
         LW,15    DATE
         BAL,11   SV1
         LW,15    DATE+1
         BAL,11   SV1
         LW,15    TIME
         BAL,11   SV1
         LW,D4    RCVCODE
         LOCAL    RCVCODE
         BAL,SR4  SV1               SAVE THE RECOVERY REASON
         LW,D4    =X'11000007'      CODE WORD FOR ERROR AND RCVRCNT
         BAL,SR4  SV1               CODE WORD IN RECOVER BUFFER
         LW,15    X'2A'             IF SHUTDOWN, SAVE CODE FOR REVOCER2
         CI,15    X'40404'
         BNE      %+2
         BAL,11   SV1
         LW,R14   BUFLN
         AI,R14   -1                ADDRESS OF LAST WORD OF REC BUF-1
         INT,R1   *BUFLN            NO. WORDS TO MOVE IN REC BUF
         SW,14    1
         LW,15    BUFFER-1,1
         STW,15   *14,1
         BDR,1    %-2               MOVE DATA TO TOP OF BUFFER
         MTW,1    *BUFLN            COUNT 04 CODE WORD
         MTW,0    JITLN
         BEZ      NOJITS            THERE ARE NO JITS IN SYSTEM
         LI,1     1
         LH,R5    *BUFLN,R1         ADJUST BUFLN FOR NUMBER OF JIT
         AW,5     JITLN                POINTERS TO BE SAVED
         AI,5     1                 AND ADJUST FOR CODE WORD OF BUFLN
         STH,R5   *BUFLN,R1
         LW,R1    BUFLN
         SW,1     5
         LW,5     JITLN             NO. OF JITS
         LI,2     3
         LW,3     JITCD
         STB,5    3,2               PUT JIT COUNT IN CODE WORD
         AI,5     1
         STW,3    *1,5              PUT CODE WORD IN BUFFER
         AI,5     -1
MVEJIT3  LW,7     JITDA-1,5         MOVE JIT POINTERS TO BUFFER
         LB,3     7
         LB,8     UB:SWAPI,3        SAVE UB:SWAPI FOR RECOVER2
         LI,3     1
         STB,8    7,3
         LW,3     S:DP
         BEZ      MVJ4
         LB,3     7                 SAVE UB:C# FOR RCVR2
         LB,8     UB:C#,3
         LI,3     2
         STB,8    7,3
MVJ4     EQU      %
         STW,7    *1,5
         BDR,5    MVEJIT3
NOJITS   EQU      %
         LW,R8    TSUAFLE           FDA OF DUMPFILE
         STW,R8   SUABTFLE          INTO SUABTFLE
         LI,R1    RBUFSIZE          NO. PAGES IN REC BUF
         LW,8     TRCVRAD              DUMP AREA
         LI,R3    512*4             ONE PAGE
         LI,4     BUFFER
KRD16    EQU      %
         BAL,11   WRDISK1           WRITE IT OUT
         B        NORCVR            ERROR RETURN
         MTW,0    DUMPFILE          DUMPFILE BUSY
         BNEZ     KRD33             YES-DO NOT COPY REC BUF TO DUMPFILE
         LW,R15   X2A               RECOVER FLAG
         CI,R15   X'40404'          ZAPPING
         BNE      KRD33             NO-DO NOT COPY REC BUF
         PUSH     R8
         LW,R8    SUABTFLE          DA ON DUMPFILE
         BAL,R11  WRDISK1           COPY REC BUF TO DUMPFILE
         B        NORCVR
         LI,R2    2                 INC ONE PAGE
         BAL,R11  SECTAINC
         PULL     R8
KRD33    EQU      %
         AI,R4    512               NEXT PAGE
         AI,R8    2                 NEXT GRANULE
         BDR,R1   KRD16             WRITE THE RECOVER BUFFER
         LI,R11   MPCDUMP           MPC DUMP ROUTINE PRESENT
         BEZ      %+2               NO
         BAL,R11  MPCDUMP           YES-GO TO IT
         LW,11    X'2A'
         CI,11    X'40404'
MVEBI11  BNE      *MVE11
         LI,R3    512*4             SIZE
         LI,R4    X'40'             CLOBBER LOW CORE SO CANT OP REC AFTER ZAP
         LW,8     S:DP
         BEZ      MVBIR
         LB,11    MB:SDI
         LI,8     0
         STH,11   8
         BAL,11   RDDISK1
         B        %+3
         B        %+3
MVBIR    EQU      %
         BAL,11   RDRAD1
         LI,4     MVEBI11-22
         LI,0     DA(BYECMND)
         :SIO,0   1
         LW,5     4
         AI,5     22
         LB,4     *5
         CI,4     X'68'
         BNE      %                 HANG AT END OF ZAP IF MUSIC BAD.
         :TIO,0   1
         BCS,12   :A                DELAY FOR OC TO QUIET DOWN
         B        0,R5
         BOUND    8
BYECMND  GEN,8,24 5,BA(MYEMSG)
         DATA     MYEMSGSIZ
PORKEYPIG EQU     '


  THAT''S ALL, FOLKS!!


'
MYEMSG   TEXT     PORKEYPIG
MYEMSGSIZ EQU     S:NUMC(PORKEYPIG)
**
**
NOROOM   EQU      %                 NO ROOM FOR JIT IN DUMP AREA
         LI,9     X'FFFF'           LET'S SEE IF WE CAN USE CURRENT DA
         CS,8     BOOTSBAND         IS IT IN GHOST1 AREA
         BGE      OUTOFRUM          YES - WE'RE IN TROUBLE
         BAL,SR4  R:DSCCVT          GO-CONVERT RCVRAD TO SEEK ADDRESS
         LH,SR1   SR1
         LW,7     JITLN             NO - SEARCH JIT POINTERS TO SEE IF
         CS,8     JITDA-1,7            THERE'S A JIT ALREADY HERE
         BE       NOROOM2           TRACK/SECTORS MATCH
NOROOM1  BDR,7    %-2
         B        MVEJIT1           OK TO USE THIS ADDRESS
NOROOM2  EQU      %                 T/S MATCH - ARE THEY ON THE SAME
         LW,6     JITDA-1,7            RAD (WITH SYSTEM)
         LB,6     6
         LB,6     UB:SWAPI,6
         BNEZ     NOROOM1           NO - STILL OK
         B        MVEJIT0           LET'S TRY ANOTHER ADDRESS
**
**
OUTOFRUM EQU      %                 OUT OF ROOM ON SYSTEM'S SWAPPING RAD
         LW,1     JITLN             THROW AWAY JIT AND MODIFY LIST
         SW,1     MVE1
         BEZ      OUT1              NO JITS PROCESSED YET
         LW,2     MVE1              CURRENT INDEX
         LW,3     JITDA,2           MOVE JIT POINTERS
         STW,3    JITDA-1,2
         AI,2     1
         BDR,1    %-3
OUT1     MTW,-1   JITLN             DECREMENT # OF JITS
         B        MVEJIT2           GO PROCESS NEXT JIT
         PAGE
SECTAINC PUSH     3,R3
         LSECTA,R3 R8
         AW,R3    R2                INC DA BY (R2)
         STSECTA,R3,R5  R8
         STW,R8   SUABTFLE          INTO SUABTFLE
         PULL     3,R3
         B        *R11
*
*
TSUAFLE  DATA     0                 SAVE FDA OF DUMPFILE
         PAGE
*F*      NAME:    SYSLIM
*F*      PURPOSE: SAVE MONITOR TABLES FROM THE LIST OF TABLES IN RCVTAB.
SYSLIM   EQU      %
         STW,11   SVX11
         LI,R7    -TABLESZ          TABLE SIZE
         LW,R3    *BUFLN            NUMBER OF WORDS IN REC BUF
         AI,R3    BUFFER            ADDRESSS OF NEXT WORD IN RECOVER BUF
         SLS,R3   2                 BYTE DESTINATION ADDRESS
KRD21    LW,R5    =X'7FFFFFFF'
         CW,R5    SMAKFLG           GOING TO DO A SYSMAK
         BANZ     %+2               NO-SAVE  EVERYTHING
         LI,R5    -1                YES-CHECK FOR CONDITIONAL SAVE
         AND,R5   TABLE+TABLESZ,R7  RCVTAB ENTRY
         BLZ      KRD17             SKIP IF CONDITIONAL BIT SET
         LI,R4    0
         SLD,R4   15                NUMBER OF BYTES IN R4
         SLS,R5   -15               BYTE FROM ADDRESS
         LW,R2    R5
         BEZ      KRD17             TABLE NOT IN THIS SYSTEM
KRD23    CI,R4    255
         BG       KRD22             MORE THAN ONE MBS NEEDED
         STB,R4   R3                COUNT FOR MBS
         BAL,R11  BYTESIM           * MBS,2 REPLACEMENT
         AI,R3    3
         AND,R3   =X'FFFFFFFC'      BOUND UP TO WORD
KRD17    BIR,R7   KRD21             MOVE EVERY TABLE IN RCVTAB
         SLS,R3   -2                SHIFT TO WORDS
         AI,R3    -BUFFER           TOTAL USE COUNT IN RECOVER BUFFER
         LW,R2    R3
         LI,R1    1
         SH,R2    *BUFLN,R1         WORD COUNT FOR TABLE SAVE ENTRIES
         STH,R2   LIMCODE,R1        INTO TABLE SAVE CODE WORD
         STH,R3   *BUFLN,R1         TOTAL USE COUNT INTO BUF CONTROL WD.
         LW,D4    LIMCODE
         BAL,11   SV1
         B        *SVX11
LIMCODE  GEN,8,24 X'09',0
KRD22    LI,R5    255
         STB,R5   R3                SET UP FULL MBS
         AI,R4    -255
         BAL,R11  BYTESIM           * MBS,2 REPLACMENT
         B        KRD23
*
*        06-22-77 REPLACED BYTE STRING INSTRUCTIONS
*        WITH FOLLOWING SUBROUTINE
*
BYTESIM  EQU      %
         LB,R1    R3                * COUNT INTO R3
         LI,R5    0                 * CLEAR OLD COUNT
         STB,R5   R3                * FROM INDEX REG
         LB,R5    0,R2              * GET A BYTE
         STB,R5   0,R3              * STORE A BYTE
         AI,R2    1                 * UP AN INDEX
         AI,R3    1                 * ANOTHER INDEX
         BDR,R1   %-4               * DOWN COUNT
         B        *R11
         PAGE
*F*      NAME:    CYCUSRS
*F*      PURPOSE:
*DO*
*F*
** CYCLE THRU ALL USER JITS AND CLOSE ALL
*FIN*
*F*      DESCRIPTION:
*F*         AJUST INCORE/OUT-OF-CORE FLAG. USER BEING SWAPPED
*F*               IN IS OUT-OF-CORE, USER BEING SWAPPED OUT IS IN-CORE.
*F*         CLOSE DCBS AND COOPERATIVE FILES FOR IN CORE USERS.
*F*         CLOSE DCBS AND COOPERATIVE FILES FOR OUT-OF-CORE USERS.
**                CLOBBERS ALL REGS: 7  CARRIES USR NO.
CYCUSRS  EQU      %
         STW,11   SVX11
*                                   PUT MAP,ACCESS,LOCK REGS IN MONDMP
         BIF,S7   KRD10             FORGET IT IF SIGMA 7
         LW,R13   *BUFLN            ACTIVE RECOVER BUF WORD COUNT
         AI,R13   BUFFER+X'100'     FORM BUFFER ADDRESS
         LI,R1    -X'100'           LOOP COUNTER
         LI,R3    1
         LI,R2    X'100'            ADDRESS IN PAGE
         AWM,R2   *BUFLN            ADD NUMBER OF WORDS ADDED TO REV BUF
KRD24    LCI      8                 INDICATE WORD RESOLUTION
         LRA,R5   R2                REAL WORD ADDRESS OF PAGE IN R2
         STCF     R4                SAVE ACCESS
         SCS,R4   4                 ALIGN ACCESS
         LB,R15   R5                SAVE LOCKS ON SIG9
         SLS,R5   -7
         SLD,R4   -2                PUT ACCESS AND PAGE NO. TOGETHER
         BIF,X560 KRD26             GET LOCKS ON 560
KRD25    STB,R15  R5,R3             PUT LOCKS AT BYTE ONE
         STW,R5   *R13,R1           PUT WORD INTO REC BUF
         AI,R2    X'200'            ADDRESS IN NEXT PAGE
         BIR,R1   KRD24             GO THROUGH VIRTUAL MEMORY
         LW,R15   MAPREGCD
         BAL,R11  SV1               PUT MAP REGISTER CODE WORD IN
KRD10    EQU      %
*                                   INITIALIZE MAP AT ONE TO ONE
         LI,R3    64                NUMBER OF WORDS FOR COMPLETE MAP
         SLS,R3   :BIG              DOUBLE FOR BIG MAP MODE
         LW,R2    MAPINIT           INITIAL MAP IMAGE WORD
         LI,R1    1                 ONE IMAGE WORD AT A TIME
KRD11    LI,R0    R2                POINT TO R2 FOR IMAGE WORD
         STB,R1   R1                 ALWAYS A WORD COUNT OF ONE
         LDMAP,0  0                 PUT IN ONE WORD OF MAP IMAGE
         AW,R2    MAPINC            SET UP NEXT WORD OF MAP IMAGE
         BDR,R3   KRD11             MAP ALL OF MEMORY ONE TO ONE
*
         LI,R7    SMUIS             MAX USERS IN SYSTEM
KRD27    LH,R1    UH:FLG,R7
         AND,R1   =X'FBFF'          CLEAR .400 BIT
         STH,R1   UH:FLG,R7          TO INDICATE NOT OUTSWAP USER.
         BDR,R7   KRD27
*
         LW,7     S:SIP             CHECK SWAPPER FLAGS FOR IN/OUT
         BEZ      LOCTUSR           NO SWAP IN PROGRESS
         LW,7     DID%IO
         BEZ      LOCTUSR           NO I/O IN PROGRESS
         BLZ      OUTSWAP           OUT SWAP IN PROGRESS
         LW,R7    S:ISUN            IN SWAP USER NUMBER
         LH,15    UH:FLG,7          SET USER OUT
         AND,15   =X'FDFF'
         STH,15   UH:FLG,7
         B        LOCTUSR
OUTSWAP  LB,R6    SB:OSUL           NO. OF USERS IN OUT SWAP LIST
         LB,7     SB:OSUL,6
         LH,15    UH:FLG,7
         OR,R15   =X'600'           SET INCORE,OUTSWAP USER.
         STH,15   UH:FLG,7
         BDR,R6   OUTSWAP+1         CHANGE ALL OUT SWAP USERS
LOCTUSR  EQU      %
         LI,7     SMUIS
NXTUSR   LB,15    UB:US,7           GET USER'S STATE
         REF      UB:PCT
         REF      SNULL
         CI,15    SNULL             CHECK FOR ACTIVE
         BNE      TST1              MAY BE ACTIVE
ABN1     EQU      %
NXT1     BDR,7    NXTUSR
         B        OUT:USR           END OF IN-CORE USRS
         SPACE    3
KRD26    LI,R15   -1                IN CASE NO PHYSICAL PAGE
         LCI      6                 INDICATE GET LOCK REGISTER
LMSINST  LMS,R15  *R2               RETURN TO LMSINST+1 IF TRAP 40
         CI,R2    X'200'            ODD NUMBERED PAGE
         BANZ     KRD25             YES
         SLS,R15  -4                NO-ALIGN LOCK IMAGE
         B        KRD25
MAPREGCD GEN,8,24 2,256             MAP REGISTER CODE WORD
         PAGE
TST1     LH,15    UH:FLG,7
         CW,15    =X'200'           BIT 6 IS IN/OUT
         BAZ      NXT1              IGNORE OUT USER
         STW,R7   USER#             SAVE USER NUMBER
         BAL,10   R:UNMAP           GO UN-MAPPED
         BAL,R11  TRANSMAP          MOVE CMAP IMAGE TO R:JXCMAP
         LOAD,R2  UX:JIT,R7         PHYSICAL ADDRESS OF JIT
         SLS,R2   9                 WORD ADDRESS OF JIT
         LW,R1    =X'00800000'
         CW,R1    JSPBFLG,R2        INDEX IN WINDOW PAGES
         BAZ      %+2               NO
         BAL,SR4  MWINDOW           YES-PUT PHYSICAL PAGE NUMBERS IN MAP
         BAL,11   MAPSET            LOAD THE MAP
         B        ABN13             ERROR
         LW,R14   LOW               FIRST PAGE AVIAL TO USERS
         LW,R13   HIGH              LAST PAGE AVAIL TO USERS
         LI,1     1                 CHECK VALIDITY OF JIT
         LW,6     TSTACK
         SH,6     TSTACK+1,1
         AND,6    =X'1FFFF'
         LI,11    ABN1              MSG AND RETURN FROM ABNXT
         CI,6     TSTACK+1
         BNE      ABNXT             BAD- ERROR RETURN
         LB,6     JB:VLH            VIRTUAL PAGE NO
         BEZ      NXT1              NO LMAP CHAIN
         LW,3     J:CLE
         SLS,3    -1
         LW,5     J:CLE
         AI,5     8
         DW,5     =10
         SW,3     5                 NR. GRANULE WRITES IN CLIST
NXT2     LOAD,R12 R:JXCMAP,R6       PHYSICAL PAGE NUMBER
         CI,12    NPMC              NULL PHYSICAL
         BE       OK:PG
         LI,11    ABN2
         CW,12    13                MAX
         BG       ABNXT             ERR
         CW,12    14                MIN
         BL       ABNXT             ERR
OK:PG    EQU      %
         LB,6     JB:LMAP,6
         BDR,3    NXT2
         BNEZ     ABNXT             LAST ENTRY IN LMAP CHAIN NOT ZERO
         LI,4     0
NXT21    EQU      %
         LH,8     JH:DA,4
         STB,7    8                 INSERT USER #
         LI,11    ABN9
         BAL,0    CKRAD             IS RAD ADDRESS OK
         LI,11    ABN2
         AI,4     1
         BDR,5    NXT21
         LB,5     JB:PPC            NUMBER OF PHYSICAL PAGES
         LOAD,6   JX:PPH            HEAD OF CHAIN
NXT3     BEZ      ABNXTCK           CANT BE END OF CHAIN
         CW,6     13                MAX
         BG       ABNXTCK           ERR
         CW,6     14                MIN
         BL       ABNXTCK           ERR
         LW,4     6
         LOAD,6   MX:PPUT,6
         BDR,5    NXT3
         BNEZ     ABNXTCK           MUST ALSO BE END OF CHAIN
         COMPARE,4 JX:PPT
         BNE      ABNXTCK           END MUST BE TAIL
ABN2     EQU      %
** END OF IN-CORE USER VERIFICATIONS
         STW,7    TEMP
         BAL,11   CLSFILS           CLOSE FILES
         BAL,11   ABNXT             DCB TABLE FLINKS CLOBBERED
ABN3     EQU      %
         BAL,11   COOPFILS          CLOSE COOP FILES
         LW,7     TEMP
         LH,15    UH:JIT,7          JIT DISC ADDRESS
         STB,7    15                USER NUMBER FOR CORE DUMP FILE
         MTW,1    JITLN
         LW,4     JITLN
         STW,15   JITDA-1,4
         LI,4     JIT
         LH,8     UH:JIT,7          DA
         LI,3     512*4             BYTES
         STB,7    8                 INSERT USER #
         LW,11    S:DP
         BEZ      %+2
         LI,8     1
         BAL,11   WRUSR1            WRITE JIT BACK TO ITS SPACE
         BAL,11   ABNXT             BAD JIT DA
ABN4     EQU      %
         CW,7     SYMBGUNO
         BNE      NXT1
         AI,4     X'200'            AJIT MEMORY ADDRESS
         LH,8     UH:AJIT,7
         BEZ      ABN4:1
         LI,R2    :BIG
         BEZ      ABN4:1            NOT BIG MAP MODE
         STB,R7   R8                USER NUMBER OF SYMB GHST
         MTW,1    JITLN             SYMBIONT GHOST AJIT TO
         LW,2     JITLN             THE DISC ADDRESS TABLE.
         STW,R8   JITDA-1,R2
         MTW,0    S:DP              PACK SWAPPING SYSTEM
         BEZ      %+2               NO
         LI,R8    0                 YES-SET GRANULE NUMBER OF AJIT
         BAL,11   WRUSR1            WRITE AJIT OF SYMB GHOST
         BAL,11   ABNXT
ABN4:1   EQU      %
         LW,2     J:DLL
         LW,3     J:DDUL
         STD,2    DLIM
         LI,0     DLIM
         BAL,11   ACCPGE            GATHER ALL DATA PAGES
         LW,6     3
         BEZ      NXT1              NONE
         LI,5     0
         LI,3     2048
SYMGUANO LW,8     DISC,5
         LB,4     PAGE,5
         SLS,4    9
         STB,7    8                 USER NR.
         BAL,11   WRUSR1            WRITE DATA PAGES BACK TO
         BAL,11   ABNXT             SWAPPER
ABN4:2   EQU      %
         AI,5     1
         CW,5     6
         BL       SYMGUANO          WRITE BACK ALL DATA PAGES
         B        NXT1
ABN9     LI,11    ABN4:5
         B        ABNXT
ABN4:5   B        ABN2
MAPINIT  GEN,15,1,6,1,7,1,1   0,1-:BIG,0,1-:BIG,0,1-:BIG,1
MAPINC   GEN,5,1,7,1,1,6,1,7,1,1,1   0,1-:BIG,0,1-:BIG,:BIG,0,1-:BIG,;
                                     0,1-:BIG,:BIG,0
         SPACE    3
ABNXTCK  LH,R1    UH:FLG,R7
         CI,R1    X'400'            OUTSWAP USER
         BAZ      ABNXT             NO-REPORT ERROR
         B        ABN2              YES-USER NOT IN MX:PPUT
         PAGE
         SPACE    2
*
*  PROCESS OUT-OF-CORE USERS
*
OUT:USR  EQU      %
         LI,7     SMUIS
OUTUSR2  LI,R15   RBUFSIZE
         SLS,R15  9                 WORDS IN REC BUF
         AI,R15   RCVDEF+IOTBLSIZ+X'1FF'
         SLS,R15  -9                BOUND UP TO PAGE AFTER RECOVERY
         STW,15   NEWPAGE
         LB,15    UB:US,7           USER STATE
         CI,15    SNULL
         BNE      TST2              MAYBE ACTIVE
ABN6     EQU      %
NXT4     BDR,7    OUTUSR2
         LW,10    SVX11             RETURN ADDRESS
         AI,R10   1                 INCREMENT FOR NORMAL RETURN
         B        R:UNMAP           UN-MAP THEN RETURN
         SPACE    2
TST2     STW,7    USER#             SAVE USER NUMBER
         BAL,10   R:UNMAP           GO UN-MAPPED
         LH,15    UH:FLG,7
         CW,15    =X'200'           IS IN OR OUT
         BANZ     NXT4               IN SO IGNORE
         LI,R5    JJITVP            PAGE NUMBER OF JIT
         BAL,11   PGCHK             GET PP WORD ADDR IN R4
         LH,8     UH:JIT,7
         BEZ      NXT4              IGNORE IF JUST STARTING UP
         STB,7    8                 INSERT USER #
         LW,11    S:DP
         BEZ      %+2
         LI,8     1
         LI,3     2048
         BAL,11   RDUSR1            READ JIT
         B        ABN11             THROW IT IN IF JIT DA BAD
         SLS,R4   -9                PHYSICAL PAGE NUMBER OF JIT
         STORE,R4 UX:JIT,R7           INTO UX:JIT
         BAL,R11  TRANSMAP          MOVE CMAP IMAGE TO R:JXCMAP
         LI,R5    JJITVP
         STORE,R4 R:JXCMAP,R5       JIT PP# IN CMAP IMAGE
         LH,8     UH:AJIT,7
         BEZ      TST3
         LI,5     JAJITVP           VP TO GET PP FOR
         BAL,11   PGCHK             GET PP WORD ADDR IN R4
         LI,3     2048
         STB,7    8                 INSERT USER #
         LW,11    S:DP
         BEZ      %+2
         LI,8     0
         BAL,11   RDUSR1            READ AJIT
         B        ABN5:5
TST3     EQU      %
         BAL,11   MAPSET            LOAD THE MAP
         B        ABN7:5            ERROR
         LI,1     1                 CHECK VALIDITY OF JIT
         LH,6     TSTACK,1
         SH,6     TSTACK+1,1
         AND,6    =X'FFFF'
         LI,11    ABN6
         CI,6     TSTACK+1
         BNE      ABNXT
*
*  FIND DCB PAGES
*
         LW,3     J:DCBUL
         SW,3     J:DCBLL
         BGEZ     TST4              THERE ARE DCB PAGES
*
*  IF THIS USER HAS A SPECIAL SHARED PROCESSOR ASSOCIATED, THE
*    DCB PAGES WILL NOT BE REFLECTED IN J:DCBLL/J:DCBUL.  MUST
*    LOOK ELSEWHERE TO FIND THEM.
*
         LB,4     UB:ASP,7          SHARED PROCESSOR #
         BEZ      TST5:2            NONE - NO DCBS
         INT,3    P:SA,4            CHECK FLAGS
         BCS,3    TST5:2            DEBUGGER OR CORE LIB - NO DCBS
         LB,0     PB:PVA,4          PROCEDURE START
         LB,1     PB:DCBSZ,4        # DCB PAGES
         BEZ      TST5:2            NO DCBS
         SW,0     1                 FIRST DCB PAGE
         AW,1     0
         AI,1     -1                LAST DCB PAGE
         STD,0    J:DCBLL           PUT IN JIT
*
TST4     EQU      %
         LI,0     J:DCBLL           DCB LOWER LIMIT
         BAL,11   ACCPGE
         LW,6     3
         BEZ      TST5:2            NO DCBS
*
*  READ ALL DCB PAGES
*
         BAL,1    READPGS
         BAL,10   R:MAP             GO MAPPED
*
*  SET UP SPARE BUFFER AREA IN PAGE AND DISC TABLES
*
TST5:2   EQU      %
         LI,0     R:SPLIMS          LIMITS OF SPARE BUFFER AREA
         BAL,11   ACCPGE
         STW,3    TBLSIZ            SAVE SIZE OF TABLE
*
*  VALIDATE DISC ADDRESSES IN JH:DA
*
         LW,R5    J:CLE             NUMBER OF WORDS IN COMMAND LIST
         AI,5     8
         DW,5     =10               LENGTH OF DA LIST
         LI,4     0
VALDA    LI,11    ABN10
         LH,8     JH:DA,4
         STB,7    8                 INSERT USER #
         BAL,0    CKRAD             IS RAD ADDRESS OK
         AI,4     1
         BDR,5    VALDA
*
*  READ ALL SPARE BUFFER PAGES
*
         LW,6     TBLSIZ            # ENTRIES IN PAGE/DISC TABLE
         BAL,1    READPGS
*
*  LOAD THE USER'S MAP IMAGE
*
         BAL,SR4  MWINDOW           PUT PHYSICAL PAGE NUMBERS IN MAP
         BAL,11   MAPSET
         B        ABN7:5            ERROR
ABN8     EQU      %
         STW,7    TEMP
         BAL,11   CLSFILS
RETCLS   B        ABN12:5           DCB TABLE FLINKS CLOBBERED
*
*  CLOSE COOPERATIVE FILES
*
         BAL,11   COOPFILS
         LW,7     TEMP
         LH,15    UH:JIT,7
         STB,7    15
         LW,4     JITLN
         AI,4     1
         STW,4    JITLN
         STW,15   JITDA-1,4
         LW,SR1   D4                JIT DA
         LI,R3    :BIG
         BEZ      KRD3              NOT BIG MAP MODE
         CW,R7    SYMBGUNO          SYMB GHST
         BNE      KRD3              NO
         AI,R4    1
         STW,R4   JITLN
         LH,D4    UH:AJIT,R7
         STB,R7   D4
         STW,D4   JITDA-1,R4        SAVE SEEK OF SYMB GHST AJIT
KRD3     EQU      %
         LI,R3    512*4
         LI,R4    J:JIT
         MTW,0    S:DP              PACK SWAPPER
         BEZ      %+2               NO
         LI,SR1   1                 YES-RELATIVE GRANULE NUMBER OF JIT
         BAL,SR4  WRUSR1            GO-WRITE JIT WITH INFO FROM CLSFILS
         BAL,SR4  ABNXT             ERROR-BAD JIT DA
         LW,R7    TEMP              USER NUMBER
         B        NXT4
ABN11    EQU      %                 JIT DA
         BAL,11   ABNXT
ABN11:5  B        NXT4
ABN14    B        NXT4
ABN5:5   EQU      %                 AJIT DA
         BAL,11   ABNXT
ABN5     B        NXT4
ABN7:5   BAL,11   ABNXT             CONTEXT
ABN7     B        NXT4
ABN10    LI,11    ABN8
         B        ABNXT
ABN12:5  BAL,11   ABNXT
ABN12    EQU      %
         B        RETCLS+1
ABN18:5  BAL,11   ABNXT
         B        ABN17
ABN19:5  BAL,SR4  ABNXT
         LI,R3    2
         STS,R3   SYMBGERR          BAD (00) PAGES
         B        ABN19
ABN17:5  BAL,11   ABNXT
ABN17    LI,R3    2
         STS,R3   SYMBGERR          BAD (00) PAGES
         B        KRD4              SKEIP SYMB GHOST-WE LOST HIM
ABNXT    EQU      %
         LI,1     1                 TYPE INDICATION OF PROBLEM
         STW,11   TRPCL             IN ORDER TO AVOID
         STB,7    TRPCL             RECOVERY IMPOSSIBLE
         LW,0     TRPCL                UNUSED TRAP CELL
         AI,R0    -RCVBIAS          TAKE OUT RECOVER BIAS
         BAL,11   HEXCVT
         STW,3    MSGBUF+1
         SLS,2    -8
         LI,11    MSGLN*4
         STB,11   2                 BYTE COUNT FOR TEXTC
         LI,3     3
         LI,11    X'40'             BLANK
         STB,11   2,3
         STW,2    MSGBUF
         LI,2     NMSG
         LI,3     X'1FFFF'          MASK FOR ADDRESS
         LS,3     TRPCL             WHERE IS ENTRY TO ABNXT
         LW,11    MSGFLG-1,2
         CW,11    3                 FIND MSG
         BLE      %+2
         BDR,2    %-3
         LW,11    MSGWHR-1,2
         AI,11    -1
         LI,3     3
         LW,2     *11,3
         STW,2    MSGBUF+1,3
         BDR,3    %-2
         LI,4     MSGBUF
         BAL,11   TYOUT
         LW,11    TRPCL
         B        *TRPCL
TRPCL    EQU      X'47'             UNUSED TRAP CELL -EASY FOR ANALZ
**
**                                  DATA FOR ABNXT
MSGLN    EQU      5                 5 WORD MSG TO O.C.
MSGBUF   RES      MSGLN
MSGFLG   DATA     ABN1,ABN2,ABN3,ABN4,ABN4:1,ABN4:2
         DATA     ABN4:5,ABN6,ABN8,ABN11:5
         DATA     ABN14
         DATA     ABN5,ABN7,ABN12,ABN17,ABN13
         DATA     LPEND+1,TSTT5+1
MSGWHR   DATA     MSG1,MSG2,MSG3,MSG4,MSG5,MSG4:5,MSG4:5
         DATA     MSG1,MSG4:5,MSG4
         DATA     MSG9
         DATA     MSG5,MSG6,MSG3,MSG10,MSG8
         DATA     MSG7,MSG4
NMSG     EQU      %-MSGWHR
MSG1     TEXT     ' BAD JIT   
'
MSG2     TEXT     ' PHY PG MAP
'
MSG3     TEXT     ' DCB TABLES
'
MSG4     TEXT     ' JIT DA    
'
MSG4:5   TEXT     ' SWAP DA   
'
MSG5     TEXT     ' AJIT DA   
'
MSG6     TEXT     ' CONTXT DA 
'
MSG7     TEXT     ' USR CNTL T
'
MSG8     TEXT     ' BAD MAP   
'
MSG9     TEXT     ' READ CHECK
'
MSG10    TEXT     ' SYMBT LOST
'
SVX11    DATA     0
         PAGE
         SPACE    2
*                                   14=# OF PAGES      N
*                                   15= START VP#      P
*                 ESTABLISH IN REGS 14 AND 15
*                 14= IMAGE ADR = A+(P/X) IN BITS 15-31
*                 15= ((B-1+P)/X)-(P/X)+1 IN BITS 0-7 -- COUNT
*                 15= (P/X)*X  IN BITS 15-22 -- START CONTROL
*                                   X IS SHIFT COUNT = 4
         REF      JOVVP             USER FIRST VIRTUAL PAGE
MAPSET   EQU      %
         STW,11   MAPRET            SAVE RETURN ADDRESS
         LI,15    JOVVP             CONTROL START
         SLS,15   9
         LI,14    256-JOVVP
         SLS,R14  :BIG-2
         STB,14   15                COUNT
         LI,14    JOVVP
         SLS,R14  :BIG-2
         AI,R14   R:JXCMAP          MAP IMAGE ADDRESS
         LDMAP,14 0                 LOAD THE MAP
**  GO MAPPED
         LW,10    MAPRET
         AI,10    1                 NORMAL RETURN
         B        R:MAP             RETURN MAPPED
         SPACE    2
ABN13    BAL,11   ABNXT
         B        NXT1
MAPRET   DATA     0
         PAGE
         SPACE    2
*
*        BAL,10   R:MAP             GO MAPPED
*        BAL,10   R:UNMAP           GO UN-MAPPED
*
R:MAP    EQU      %
         AND,10   =X'1FFFF'         REMOVE EXTRANEOUS BITS
         OR,10    =X'00400000'      SET MAP BIT
         STW,10   MAPFLG            INDICATE MAPPED
         LW,R11   =X'03000000'      SET INHIBIT BITS
         LPSD,0   10                RETURN MAPPED
*F*      NAME:    R:UNMAP
*F*      PURPOSE: CHANGE CURRENT PSD TO UNMAPPED MODE.
R:UNMAP  EQU      %
         AND,10   =X'1FFFF'         REMOVE EXTRANEOUS BITS
         LI,11    0
         STW,11   MAPFLG            INDICATE UN-MAPPED
         LW,11    UNMAPWD           INHIBITS, BIG9 BITS
         LPSD,0   10
*
UNMAPWD  GEN,8,1,6,1,13,1,2 3,:BSIG,,:BSIG,,:B560,0
MAPFLG   DATA     0
         PAGE
         SPACE    2
MWINDOW  EQU      %
         LI,R2    JSBUF1VP          PAGE NUMBER OF FIRST WINDOW PAGE
KRD19    LOAD,R1  R:JXCMAP,R2       BUFFER PAGE INDEX
         CI,R1    FPMC              FREE PAGE MAP CONSTANT
         BE       KRD20             YES-SKIP THE PAGE
         CLM,R1   BUFLIMS           LEGAL RANGE FOR INDEX
         BOL      KRD20             NO-SKIP PAGE
         LOAD,R1  R:JXCMAP,R1       PHYSICAL PAGE NUMBER
         STORE,R1 R:JXCMAP,R2         INTO WINDOW PAGE
KRD20    AI,R2    1                 INC TO NEXT WINDOW PAGE
         CI,R2    JBUPVP            IN RANGE OF WINDOW PAGES
         BL       KRD19             YES
         B        *SR4              NO-RETURN
         BOUND    8
BUFLIMS  DATA     JXBUFVP,JOVVP-1   BUFFER PAGES LIMIT
         PAGE
*F*      NAME:    MAPSPARE
*DO*
*F*
*  PURPOSE:  MAP A SPARE BUFFER INTO A WINDOW PAGE
*FIN*
*  INPUT:  R4 = VIRTUAL WINDOW ADDRESS
*          R5 = SPARE BUFFER #
*
*  CALL:  BAL,R2   MAPSPARE
*         RETURN NORMAL IF ERROR
*         RETURN SKIPPING IF NO ERROR
*
*  REGISTERS USED:  1,3,8,11,14,15
*
         SPACE    1
MAPSPARE EQU      %
         AI,R5    JXBUFVP-1         CONVERT TO PAGE #
         CI,R5    JXBUFVP
         BL       0,R2              TOO SMALL
         CI,R5    JOVVP
         BGE      0,R2              CAN'T BE IN OVERLAY AREA
         LW,R7    USER#             USER NUMBER
         SLS,R4   -9                PAGE #
         LOAD,R3  R:JXCMAP,R5       PHYSICAL PAGE NUMBER
         STORE,R3 R:JXCMAP,R4         INTO WINDOW PAGE
         SLS,R4   9
         LW,R1    J:DLL             HOW FAR TO GO IN MAP
         BAL,SR4  MAPSET            LOAD THE MAP
         B        0,R2              ERROR
         B        1,R2              NORMAL RETURN
         PAGE
         SPACE    2
*
*  PURPOSE:  READ ALL VIRTUAL PAGES IN THE PAGE/DISC TABLES
*            INTO THE CORE PAGES INDICATED IN JX:CMAP.
*
*  INPUT:  R6 = # ENTRIES IN PAGE/DISC TABLES
*          R7 = USER #
*
*  CALL:   BAL,1   READPGS
*
         SPACE    1
READPGS  EQU      %
         STW,1    SVRTN
         BAL,10   R:UNMAP
         AI,R6    0
         BLEZ     *SVRTN            NO PAGES TO READ
         LI,1     0                 INDEX TO PAGE/DISC
RDPGS2   LB,5     PAGE,1            VP TO GET
         BAL,11   PGCHK             GET PP WORD ADDR IN R4
         LI,3     2048              # OF BYTES TO READ
         LW,8     DISC,1            DISC ADDRESS
         STB,7    8                 STORE USER #
         BAL,11   RDUSR1            READ IT
         B        ABN7:5            ERROR
         AI,1     1                 NEXT VP TO GET
         CW,1     6                 ARE WE DONE
         BL       RDPGS2            NO
         B        *SVRTN
         PAGE
*
*  PURPOSE:       ASSIGN PHYSICAL PAGES TO USER INSURING THAT
*                 THEY ARE NOT REAL-TIME PAGES THAT MUST BE
*                 PRESERVED ACROSS A RECOVERY
*
*  INPUT:
*                 R5 = VIRTUAL PAGE TO GET PHYSICAL PAGE FOR
*
*  OUTPUT:        R4 = WORD ADDRESS OF PHYSICAL PAGE
*
*  CALL:          BAL,11 PGCHK
*
*
PGCHK    LW,4     NEWPAGE           GET POTENTIAL PP #
         CI,R4    JJITVP            MONITOR JIT PAGE
         BE       PGCHK3            YES-DONT CLOBBER IT
         CW,4     HIGH              ARE WE OUT OF PAGES
         BG       ABN7:5            YES
         LI,0     PP:UPPH           MAY NOT BE DEFED
PGCHK1   LW,3     PP:UPPH           GET HEAD OF REAL-TIME PAGE CHAIN
         BEZ      PGCHK4            NONE-PP IN R4 IS OK
PGCHK2   CW,3     4                 ARE WE LOOKING AT A REAL-TIME PAGE
         BE       PGCHK3            YES-SELECT ANOTHER PAGE
         LOAD,3   MX:PPUT,3         NO-GET NEXT REAL-TIME PAGE
         BNEZ     PGCHK2             AND SEE IF IT IS THE PAGE WE HAVE
PGCHK4   STORE,R4 R:JXCMAP,R5       STORE PP# IN CMAP IMAGE
         MTW,1    NEWPAGE           BUMP TO NEXT AVAILABLE PAGE
         SLS,4    9                 CONVERT TO WORD ADDRESS
         B        *11               RETURN
*
PGCHK3   MTW,1    NEWPAGE           GET NEW PP #
         B        PGCHK             AND SEE IF IT IS OK TO USE
         PAGE
TRANSMAP LI,R1    JXBUFVP           FIRST BUFFER PAGE
         LOAD,R2  UX:JIT,R7         PHYSICAL PAGE NUMBER OF JIT
         SLS,R2   9                 PHYSICAL ADDRESS OF JIT
         AI,R2    JCMAP             ADDRESS OF CMAP IMAGE
TRANS1   LOAD,R3  *R2,R1
         STORE,R3 R:JXCMAP,R1       COPY CMAP TO RECOVER BUFFER
         AI,R1    1
         CI,R1    X'100'
         BL       TRANS1            COPY ALL OF CMAP
         B        *R11              RETURN
         PAGE
         GEN,8,24 7,0
DISCDAIX DATA     0                 SYMBIONT GHOST (00) JH:DA INDEX
JITLNSAV DATA     0                 SAVE NUMBER OF TRUE JITS
SYMBGERR DATA     0                 Z-NO SYMBIONT GHOST ERROR,NZ-ERROR
SYMBGJIX DATA     0                 SAVE SYMBIONT GHOST JITDA-1 INDEX
SYMBGUNO DATA     0                 SYMBION GHOST USER NUMBER
         PAGE
*F*      NAME:    TSTUSR
*F*      PURPOSE: CHECK USER TABLES IN CORE FOR CONSISTENCY.
TSTUSR   EQU      %
         STW,11   SVX11
         LI,11    LPEND+1           USR TABL ERROR
         LI,7     SMUIS
LPT1     LB,15    UB:US,7
         CI,15    SNULL             CHECK FOR EMPTY SLOT
         BE       LPEND             YES
         LB,15    UB:PCT,7          GET PAGE COUNT
         CI,15    1                 CHECK FOR JUST A JIT
         BNE      TSTUS             NO
         LH,15    UH:FLG,7
         BEZ      ABNXT
LPEND    BDR,7    LPT1
         LW,11    SVX11             SUCCESSFUL FINISH
         B        *11
TSTUS    EQU      %
         LOAD,15  UX:JIT,7
         BEZ      ABNXT
         LH,15    UH:JIT,7
         BEZ      ABNXT
         LH,15    UH:FLG,7          TEST VARIOUS FLAGS
TSTT1    CI,15    1                 BIT 15
         BAZ      TSTT2
         CI,15    X'200'            BIT 6
         BAZ      ABNXT
TSTT2    RES      0
         CI,15    X'40'             BIT 9
         BAZ      TSTT3
         CI,15    X'400'            BIT 5
         BAZ      ABNXT
TSTT3    CI,15    X'200'            BIT 6
         BAZ      TSTT4
         LOAD,15  UX:JIT,7          JIT ADDRESS TO BE HIGHER THAN
         CW,R15   LOW
         BL       ABNXT             ERR
         CW,R15   HIGH
         BG       ABNXT             ERR
TSTT4    LI,11    TSTT5
         LH,8     UH:JIT,7          CHECK DISC ADDRESSES OF JITS
         STB,7    8                 INSERT USER #
         BEZ      %+2
         BAL,0    CKRAD             CHECK RAD ADDRESS
         LH,8     UH:AJIT,7
         STB,7    8                 INSERT USER #
         BEZ      %+3
         LI,11    TSTT5
         BAL,0    CKRAD             CHECK RAD ADDRESS
         LI,11    TSTT5
         LB,15    UB:US,7           CHECK USER STATE
         CI,15    SNSTS
         BG       ABNXT
         B        LPEND
TSTT5    BAL,11   ABNXT
         B        LPEND+1
         PAGE
ACCPGE   EQU      %
         LI,3     0
         LB,2     UB:SWAPI,7
         LB,6     JB:VLH
         LI,4     0
         LW,5     J:CLE
         AI,5     -4
         DW,4     TEN
         LW,1     5
         SLS,1    3                 4Q
         AW,1     4
         SLS,1    -1
         AI,1     2
         B        %+2
NEXTDA   EQU      %
         LI,4     6
         LW,13    4
         SLS,4    -1
         LH,14    JH:DA,5
         LB,15    MB:GAM6,2
         CI,4     0
         BE       NEXTPGE
NXTDA0   AI,14    2                 INC SECTOR ADDRESS
         CS,14    M:GASLIM,2
         BLE      NXTDA1
         AW,14    M:ADRINCR,2
NXTDA1   BDR,4    NXTDA0
NEXTPGE  EQU      %
         CLM,6    *0
         BCS,9    NXTPG1
         STW,14   DISC,3
         MTW,0    S:DP
         BEZ      NXTPG0
         STW,1    DISC,3
NXTPG0   EQU      %
         STB,6    PAGE,3
         AI,3     1
NXTPG1   EQU      %
         AI,14    -2
         CS,14    M:GASLIM,2
         BL       NXTPG1A
         SW,14    M:ADRINCR,2
NXTPG1A  EQU      %
         AI,1     -1
         LB,6     JB:LMAP,6
         BEZ      NXTPG2
         AI,13    -2
         BGEZ     NEXTPGE
         AI,5     -1
         BGEZ     NEXTDA
NXTPG2   B        *11               RETURN
*
         BOUND    8
R:SPLIMS DATA     JXBUFVP,JOVVP-1
TBLSIZ   DATA     0
USER#    DATA     0
DISC     RES      40                DISC ADDRESS FOR USER
PAGE     RES,1    40                PAGE ADDRESS FOR USER
         BOUND    4
NEWPAGE  DATA     0
SVRTN    DATA     0                 RETURN FROM READPGS
TEN      DATA     10
         PAGE
*F*      NAME:    RCVDMP
*F*      PURPOSE: DUMP ALL OF PHYSICAL CORE TO SWAPPER.
RCVDMP   STW,11   RCVDX
         LI,R13   RBUFSIZE          NUMBER OF RECOVERY BUF PAGES
         BAL,R11  INCRDA
         BDR,R13  %-1               ADVANCE RCVRAD PAST RECOVER BUF.
         MTW,0    BOOTFLG           SYSTEM UP
         BNEZ     BTAPDMP           NO-PUT DUMP ON TAPE
         LW,13    CORED
         SLS,13   -9                NUMBER OF PAGES TO DUMP
         LW,14    RCVRDSZ           NUMBER OF GRANULES
         CW,14    13
         BL       BTAPDMP           NOT ENUFF ROOM ON SWAPPER
         LW,8     RCVRAD
         BAL,11   R:CHKDA
         BCR,15   BTAPDMP
         LW,15    RCVRAD
         STW,R15  DUMPDA            DA OF DUMP ON SWAPPER
         BAL,R11  CDUMP             GO-TAKE CORE DUMP
         LW,R15   DUMPDA            DA OF DUMP ON SWAPPER
         BAL,11   SV1
         LW,15    RCVRAD            NEXT GRANULE
         BAL,11   SV1
         LW,15    RCVCODE
         BAL,11   SV1
         LW,11    RCVDX
         B        *11
BTAPDMP  LW,11    RCVDX             RCVRAD IS GARBAGE
         B        TAPDMP
RCVDX    DATA     0
CDUMPRTN DATA     0                 RETURN ADDRESS FOR CDUMP
DUMPDA   DATA     0                 DA OF CORE DUMP ON SWAPPER
RCVCODE  GEN,8,24 X'03',2           CODE WORD FOR RAD CORE DUMP
         PAGE
* INCREMENT RIGHT HALFWORD OF RCVRAD (DUMP ADDRESS OF ALTERNATE
* MONITOR) BY ONE GRANULE AND DECREMENT RCVRDSZ BY ONE GRANULE.
*
INCRDA   EQU      %
         MTW,-1   RCVRDSZ           DECREMENT RECOVER RAD SIZE
         LW,R8    RCVRAD
         LSECTA,R3  R8
         AI,R3    2                 INC ONE GRANULE
         STSECTA,R3,R5  R8
         STW,R8   RCVRAD
         B        *11               RETURN
**
RCVADR   DATA     0                 SWAP FWA
         PAGE
CDUMP    STW,R11  CDUMPRTN          SAVE RETURN
         MTW,0    BOOTFLG           SYSTEM UP
         BNEZ     TAPDMP            NO-PUT DUMP ON TAPE
         LI,R5    0
         LW,R4    CORED             HIGHEST ADDRESS+1 IN MEMORY
         SLD,R4   -17               NUMBER OF 256 PAGE BLOCKS
         STD,R4   DMPCNT            NUMBER OF WORDS IN PARTIAL BLOCK
         LW,R8    RCVRAD            DA FOR DUMP
         LDCTX,R7 R8                DCTX
         LB,R6    R:DCT24,R7
         CI,R6    4                 MPC CONTROLED DEVICE
         BAZ      MPC3              NO-KEEP ADDRESS AT ZERO
         LSECTA,R3  R8
         AI,R3    X'80'             SKIP OVER PRE DUMP
         STSECTA,R3,R5  R8
MPC3     EQU      %
         CI,R4    0                 JUST A PARTIAL BLOCK
         BE       KRD18             YES
KRD110   STW,R4   DMPCNT            NUMBER OF 256 PAGES BLOCKS REMAINING
         BAL,R11  COREDUMP          GO-WRITE 256 PAGES
         B        BTAPDMP           ERROR - TAKE TAPE DUMP
         MTW,0    DMPCNT            DUMPED PARTIAL BLOCK
         BEZ      KRD120            YES-ACCOUNT FOR IT
         LW,R4    =X'80000'
         AWM,R4   CORESTRT          INC. STARTING ADDRESS BY 256 PAGES
         BAL,R2   SETCOMM           GO-INITIALIZE COMMAND LIST
         LI,R8    -256
         AWM,R8   RCVRDSZ           DECREMENT RECOVER RAD SIZE
         LW,R8    RCVRAD
         LSECTA,R3  R8
         AI,R3    512               INC BY 256 PAGES
         STSECTA,R3,R5  R8
         STW,R8   RCVRAD            INCREMENT DA BY 256 PAGES
         LW,R4    DMPCNT            NUMBER OF 256 PAGE BLOCKS
         BDR,R4   KRD110            WRITE ALL OF CORE
KRD18    EQU      %
         LW,R3    DMPCNT+1          ANY PARTIAL BLOCK
         BEZ      *CDUMPRTN         NO-RETURN
         LI,R2    0
         SLD,R2   3                 (R2)=# 16K BLOCKS,(R3)=# REMIANING BYTES
         SLS,R3   -16
         LDCTX,R7 R8                DCTX
         LB,R6    R:DCT24,R7
         CI,R6    4                 MPC CONTROLED DEVICE
         BANZ     MPC1              YES-SET ITS CLIST
         CI,R3    0                 FULL 16K BLOCK
         BNE      %+2               NO
         AI,R2    -1                YES-STAY IN THIS COMMAND
         LD,R6    COMMRAD+2,R2
         OR,R3    =X'08000000'      HALT ON ERROR FLAG
         STW,R3   R7
         STD,R6   COMMRAD+2,R2      SET CORRECT BYTE COUNT
         B        KRD110            YES-DUMP IT
*
MPC1     XW,R2    R3
         MI,R3    6                 GET INDEX INTO CLIST
         CI,R2    0                 IS THERE A PARTIAL BLOCK
         BNE      %+2               YES
         AI,R3    -6                NO-BACK UP ONE BLOCK
         OR,R2    =CC**24           YES-SET CAMMAND CHAINING
         STW,R2   MPCCDW+5,R3       SET FLAGS AND BYTE COUNT
         LI,R6    X'B0'             STOP ORDER
         STB,R6   MPCCDW+6,R3       INTO CLIST
         B        KRD110
KRD120   LW,R4    DMPCNT+1
         SLS,R4   -23               NUMBER OF SECTORS IN PARTIAL BLOCK
         LW,R8    RCVRAD
         LSECTA,R3  R8
         AW,R3    R4                INC TO NEXT SECTOR AFTER DUMP
         STSECTA,R3,R5  R8
         STW,R8   RCVRAD
         SLS,R4   -1
         LCW,R4   R4
         AWM,R4   RCVRDSZ           SIZE OF RECOVERY AREA AFTER DUMP
         B        *CDUMPRTN         RETURN
COREDUMP EQU      %                 DUMP 256 PAGES OF CORE
         LI,R3    10
         STW,R3   ERRCNT            SET ERROR RE-TRY COUNT AT 10
         STW,R11  CORDMPRT          SAVE RETURN ADDRESS
         LDCTX,R7 R8                DCTX
         LH,R1    R:DCT1,R7         DEVICE ADDRESS
         BAL,R11  R:DSCCVT          GO-CONVERT TO SEEK ADDRESS
         BCR,X'F' *CORDMPRT         ERROR-DA NO GOOD
         LB,R3    R:DCT24,R7
         CI,R3    4                 MPC CONTROLED DEVICE
         BAZ      COREDMP1          NO
*
         LI,R9    0
         SLD,R8   -4                SLIDE THE SEEK DOWN TO POSITION
         OR,R8    =X'20000000'      SECTOR COUNT LIMIT
         STD,R8   MPCSEEK1
         LH,R2    R:DCT1,R7         DEVICE ADDRESS
         LI,R3    X'F'              DEVICE NUMBER POSITION
         SLD,R2   20                SLIDE DEVICE NUMBER TO POSITION
         STS,R2   MPCSEEK
         STS,R2   MPCWRITE
         LI,R0    DA(MPCCLIST)
         B        KRD1              DO THE MPC IO
COREDMP1 EQU      %
         STW,R8   SEEK              SAVE STARTING SEEK ADDRESS
         LI,R9    X'F0000'
         STS,R8   SEEK1             CURRENT CYLINDER NUMBER
         LB,R7    R:DCT22,R7        RAD/PACK TYPE INDEX
         LI,R0    DA(COMMRAD)
KRD1     :SIO,0   *R1               TRANSFER BYTES TO RAD / PACK
         BCS,12   ERRCHK1           ERROR-SIO REJECTED
         LI,R3    100000            LOOP COUNTER
KRD1A    LI,R2    41
         BDR,R2   %                 DELAY
         :TIO,R4  *R1               GET TIO STATUS
         STD,R4   TIO%STATUS
         BCS,12   %+3               BUSY
         LC       R5
         BCR,6    KRD1C             DEVICE READY
         BDR,R3   KRD1A             DEC LOOP COUNTER
         B        ERRCHK1           CHECK RETRY COUNT
KRD1C    AI,R5    1023
         AND,R5   =X'FFFFFC00'      BOUND UP TO FULL SECTOR
         LI,R4    X'FFFF'
         XW,R4    R5
         STS,R4   TIO%STATUS+1      CORRECT COUNT OF BYTES TRANSMITTED
         LH,R5    TIO%STATUS+1      STATUS BITS
         LDCTX,R3 RCVRAD            DCTX OF DUMP DEVICE
         LB,R3    R:DCT24,R3
         CI,R3    4                 MPC CONTROLED DEVICE
         BAZ      %+3               NO
         CI,R5    X'800'            MPC GIVE UN END
         BANZ     MPC5              YES-ERROR
         :TDV,R3  *R1
         LC       R3
         BCS,4    FLAW              FLAW HEADER DETECTED
         BCR,2    ERRORCHK          ERROR CHECK-NO SECTOR UNAVAIL INDIC.
         CI,R5    X'800'            UNUSUAL END
         BAZ      ERRORCHK          NO-ERROR CHECK
*
*                                   CROSS CYLINDER ON PACK
*
         MTH,1    SEEK1             INC CURRENT CYLINDER NUMBER
         LI,R3    X'FFFF'
         LI,R2    X'FFFF'
         AND,R2   TIO%STATUS
         STS,R2   COMMPACK+2        DA(COMMRAD) ADDRESS
         SLS,R2   1                 ADDRESS OF COMMRAD ENTRY
         LI,R5    X'FFFF'
         LI,R4    X'FFFF'
         AND,R4   TIO%STATUS+1      REMAINGING BYTE COUNT
         BNEZ     %+2
         LI,R4    X'10000'          REMAING BYTE COUNT
         CI,R4    X'400'            ODD NUMBER OF SECTORS/CYLINDER
         BAZ      %+2               NO
         AI,R4    X'400'            YES-RE-WRITE THE LAST SECTOR
         INT,R3   1,R2              STARTING BYTE COUNT FROM COMMRAD
         CI,R3    0
         BNE      %+2
         LI,R3    X'10000'          STARTING BYTE COUNT
         STS,R4   1,R2              NEW BYTE COUNT
         SW,R3    R4
         AWM,R3   0,R2              INC MEMORY ADDRESS BY AMOUNT WRITTEN
         LI,R0    DA(COMMPACK)
         B        KRD1
*
*                                   CHECK FOR ERROR
*
ERRORCHK CI,R5    X'7E'             ERROR BITS SET
         BAZ      RETURN            NO-RETURN
ERRCHK1  :HIO,0   0,R1              HALT THE DEVICE
MPC5     LI,R2    2000
         BDR,R2   %                 HANG
         MTW,-1   ERRCNT
         BEZ      *CORDMPRT         ERROR-RE-TRY COUNT EXCEEDED
         BAL,R2   SETCOMM           GO-INITIALIZE COMMAND LIST
         LDCTX,R5 RCVRAD            DCTX OF DUMP DEVICE
         LB,R2    R:DCT24,R5        DEVICE FLAGS
         CI,R2    4                 MPC DEVICE
         BANZ     KRD1              YES-CLIST ADDRESS AT MPC
         B        KRD1-1            RE ISSUE SIO
FLAW     EQU      %                 FLAWED TRACK HAS BEEN INCOUNTERED
         LI,R0    DA(COMMHEAD)
         :SIO,0   *R1               READ THE HEADER
FLAW1A   LI,R2    41
         BDR,R2   %                 DELAY
         :TIO,R3  *R1               GET STATUS
         BCS,12   FLAW1A
         SLS,R3   -16
         CI,R3    X'7E'             ERROR INDICATED
         BANZ     *CORDMPRT         YES-TAKE ERROR RETURN
         LB,R2    HEADER
         CI,R2    X'FF'             HEADER RECORD
         BNE      *CORDMPRT         ERROR-NOT HEADER FLAW RECORD
         LI,R2    X'1FF00'
         AND,R2   HEADER
         SLS,R2   -8                CURRENT CYLINDER
         CH,R2    SEEK1
         BNE      *CORDMPRT         ERROR-CURRENT CYLINDER NOT MATCH
         LB,R2    HEADER+1          CURRENT SECTOR
         LW,R3    =X'FFFF00'
         AND,R3   HEADER+1          ALTERNATE CYLINDER/TRACK ADDRESS
         CI,R3    X'8000'           MOVE CYLINDER BIT TO HIGH ORDER
         BAZ      %+3               NO
         EOR,R3   =X'8000'
         OR,R3    =X'1000000'       MOVE THE BIT
         LI,R4    3
         STB,R2   R3,R4             ALTERNATE CYLINDER/TRACK/SECTOR
         STW,R3   SEEKFLAW          SEEK FOR ALTERNATE POSITION
*
         LW,R4    R:NSPT,R7         NUMBER OF SECTORS/TRACK
         SW,R4    R2                REMAINING SECTORS IN TRACK
         SLS,R4   10                NUMBER BYTES REMAING IN TRACK
         LI,R5    X'FFFF'
         STS,R4   COMMFLAW+3        NUMBER OF BYTES TO WRITE TO FLAW
*
         INT,R3   TIO%STATUS        DA(COMM)
         SLS,R3   1                 COMMAND ADDRESS
         INT,R5   1,R3              STARTING BYTES COUNT
         CI,R5    0
         BNE      %+2
         LI,R5    X'10000'          0=X'10000'
         INT,R9   TIO%STATUS+1      REMAING BYTE COUNT
         CI,R9    0
         BNE      %+2
         LI,R9    X'10000'          0=X'1000'
         SW,R5    R9                NUMBER OF BYTES TRANSMITTED
         INT,R9   0,R3              STARTING BYTE ADDRESS
         AW,R9    R5                CURRENT BYTE ADDRESS
         LI,R8    X'FFFF'
         XW,R8    R9
         STS,R8   COMMFLAW+2        CURRENT BYTE ADDRESS
*
         INT,R5   TIO%STATUS+1      REMAING BYTE COUNT
         CI,R5    0
         BNE      %+2
         LI,R5    X'10000'
         CW,R5    R4                NUMBER OF BYTES REMAING IN TRACK
         BGE      RBC%GE%TRACK
*
RBC%LT%TRACK  EQU   %
         LI,R4    X'FFFF'
         XW,R4    R5
         STS,R4   COMMFLAW+3        SET BYTE COUNT (LESS THAN TRACK)
         SLS,R4   -10               SECTORS REMAING
         AW,R4    R2                NEW SECTOR ADDRESS
         LW,R5    HEADER            CURRENT CYLINDER/TRACK
         SLS,R5   8
         LI,R6    3
         STB,R4   R5                INSERT NEW SECTOR
         STW,R5   SEEK2             NEW SEEK ADDRESS
*
RBC%EQ%TRACK  EQU   %
         CI,R3    COMMEND           LAST COMMAND
         BL       KRD12             NO
         LI,R3    8
         STB,R3   COMMFLAW+3        COMMAND END
         LI,R0    DA(COMMFLAW)
         B        KRD1              WRITE LAST TRACK TO FLAW AREA
KRD12    AI,R3    2                 NEXT COMMAND ADDRESS
STORE%COMM%ADD EQU  %
         SLS,R3   -1                DA(COMMAND)
KRD13    LI,R2    X'FFFF'
         XW,R2    R3
         STS,R2   COMMFLAW+6        DA(RETURN COMMAND) AFTER FLAW
         LI,R0    DA(COMMFLAW)
         B        KRD1              GO-RE ISSUE SIO
*
RBC%GE%TRACK  EQU   %
         LI,R8    X'FF'
         AND,R8   HEADER            CURRENT TRACK
         AI,R8    1                 INC TO NEXT TRACK
         CW,R8    R:NTPC,R7         SPILL OVER TO NEXT CYLINDER
         BL       KRD15             NO
         MTH,1    SEEK1             YES-INC IT
         LW,R8    SEEK1
KRD14    STW,R8   SEEK2             CYL#,0,0 AFTER FLAW WRITE
         CW,R5    R4
         BE       RBC%EQ%TRACK
         BG       RBC%GT%TRACK
KRD15    LI,R9    X'1FF00'
         LS,R8    HEADER
         SLS,R8   8                 CYL,TRACK,0   AFTER FLAW WRITE
         B        KRD14
*
RBC%GT%TRACK  EQU   %
         INT,R9   1,R3              STARTING BYTE COUNT
         CI,R9    0
         BNE      %+2
         LI,R9    X'10000'          0=X'1000'
         SW,R9    R5                BYTES TRANSMITTED
         AW,R9    R4                + BYTES GOING TO FLAW TRACK
         AWM,R9   0,R3              NEW BA(CORE)
         LW,R8    R5                REMAING BYTE COUNT
         SW,R8    R4                -BYTES GOING TO FLAW TRACK
         LI,R9    X'FFFF'
         STS,R8   1,R3              NEW BYTE COUNT
         B        STORE%COMM%ADD
RETURN   LW,R11   CORDMPRT          RETURN
         AI,R11   1
         B        *R11                  BAL+2
SETCOMM  EQU      %                 INITIALIZE COMMAND CHAIN
         LI,R3    -8                COMMAND PAIRS
         LW,R9    =X'FFFFFF'
         LI,R10   0
         LI,R11   X'FFFF'
         LW,R8    CORESTRT          INITIAL CORE ADDRESS IN BYTES
         BEZ      KRD2
         LI,R4    1
         STB,R4   COMMRAD+2
         STB,R4   COMMRAD+4         SET BACK TO WRITE ORDER
         LI,R4    X'28'
         STB,R4   COMMRAD+3
         STB,R4   COMMRAD+5         SET BACK FLAGS
         LW,R4    =X'08000000'+DA(COMMRAD2)
         STW,R4   COMMRAD1          CHANGE TIC TO USE ALL OF CLIST
KRD2     LD,R4    COMMRAD+2+16,R3
         STS,R8   R4
         AI,R8    X'10000'
         STS,R10  R5                SIZE 0=X'10000'
         STD,R4   COMMRAD+2+16,R3
         BIR,R3   KRD2
         LH,R3    SEEK
         STH,R3   SEEK1             PUT CYLINDER BACK
         LI,R3    X'28'
         STB,R3   COMMFLAW+3        RESTORE FLAGS IN FLAW COMM.
*
         LW,R8    CORESTRT          INITIAL CORE ADDRESS IN BYTES
         LI,R3    0                 START AT TOP OF CLIST
MPC2     LD,R4    MPCCDW+4,R3       DATA XFER CDW
         STS,R8   R4                ADDRESS INTO CDW
         AI,R8    X'10000'          BYTES/CDW
         STS,R10  R5
         STD,R4   MPCCDW+4,R3
         AI,R3    3                 THREE DOUBLE WORDS
         CI,R3    24                END OF CLIST
         BL       MPC2              NO
         B        0,R2              RETURN
         BOUND    8
COMMRAD  GEN,8,24   X'03',BA(SEEK)  SEEK
         GEN,8,24   X'2A',4
         GEN,8,24   X'02',4*0
         GEN,8,24   X'29',0         SKIP WRITTING 0-X'3FFF'
         GEN,8,24   X'02',4*X'4000' X'4000'
         GEN,8,24   X'29',0         SKIP WRITTING X'4000'-X'7FFF'
         GEN,8,24   X'01',4*X'8000' X'8000'
         GEN,8,24   X'28',0
         GEN,8,24   X'01',4*X'C000' X'C000'
         GEN,8,24   X'28',0
         GEN,8,24   X'01',4*X'10000' X'10000'
         GEN,8,24   X'28',0
         GEN,8,24   X'01',4*X'14000' X'14000'
         GEN,8,24   X'28',0
         GEN,8,24   X'01',4*X'18000' X'18000'
         GEN,8,24   X'28',0
COMMEND  GEN,8,24   X'01',4*X'1C000' X'1C000'
         GEN,8,24   X'08',0
MPCCLIST :CDW     3,BA(MPCSEEK),CC,5
         :CDW     1,BA(MPCSEEK1),CC,5
MPCCDW   :CDW     3,BA(MPCWRITE),CC,5 WRITE ORDER TO MPC
COMMRAD1 :CDW     8,DA(COMMRAD3)    SKIP THE PRE DUMP AREA
COMMRAD2 :CDW     1,4*0,DC,0
         :CDW     8,DA(%+4)
         :CDW     8,DA(MPCCDW)
         :CDW     1,4*X'4000',DC,0
         :CDW     8,DA(%+4)
         :CDW     8,DA(MPCCDW)
COMMRAD3 :CDW     1,4*X'8000',DC,0
         :CDW     8,DA(%+4)
         :CDW     8,DA(MPCCDW)
         :CDW     1,4*X'C000',DC,0
         :CDW     8,DA(%+4)
         :CDW     8,DA(MPCCDW)
         :CDW     1,4*X'10000',DC,0
         :CDW     8,DA(%+4)
         :CDW     8,DA(MPCCDW)
         :CDW     1,4*X'14000',DC,0
         :CDW     8,DA(%+4)
         :CDW     8,DA(MPCCDW)
         :CDW     1,4*X'18000',DC,0
         :CDW     8,DA(%+4)
         :CDW     8,DA(MPCCDW)
         :CDW     1,4*X'1C000',CC,0
         :CDW     X'B0',0,NCC
         :CDW     8,DA(MPCCDW)
*
MPCSEEK  :IDCW,SK 1,X'11'           MPC SEEK ORDER
MPCSEEK1 DATA     0,0
MPCWRITE :IDCW,WRT                  MPC WRITE ORDER
COMMPACK GEN,8,24   X'03',BA(SEEK1) SEEK TO NEXT CYLINDER
         GEN,8,24   X'2A',4
         GEN,8,24   X'08',0         TIC BACK INTO COMMRAD
         GEN,8,24   0,0
COMMFLAW GEN,8,24   X'03',BA(SEEKFLAW)  SEEK TO ALTERNATE TRACK
         GEN,8,24   X'2A',4
         GEN,8,24 X'01',0           BA(CORE) TO WRITE
         GEN,8,24   X'28',0         BYTE COUNT TO WRITE
         GEN,8,24   X'03',BA(SEEK2) SEEK BACK TO PRIMARY AREA
         GEN,8,24   X'2A',4
         GEN,8,24   X'08',0         TIC BACK TO COMMRAD
         GEN,8,24   0,0
COMMHEAD GEN,8,24   X'0A',BA(HEADER)  READ HEADER RECORD
         GEN,8,24   X'08',8
         BOUND    8
TIO%STATUS DATA   0,0               TIO STATUS AFTER SIO FINISHES
DMPCNT   DATA     0,0               COUNT OF BLOCKS TO DUMP
SEEK     DATA     0                 STARTING SEEK ADDRESS
SEEK1    DATA     0                 CYL#,0,0  CURRENT CYLINDER NUMBER
SEEK2    DATA     0                 CYL#,TRACK#,0  SEEK TO PRIMARY
SEEKFLAW DATA     0                 FLAWED TRACK SEEK ADDRESS
HEADER   DATA     0,0               HEADER RECORD
ERRCNT   DATA     0                 RE-TRY COUNT
CORESTRT DATA     0                 BYTE ADDRESS TO START DUMPING
CORDMPRT DATA     0                 RETURN ADDRESS FOR 256 PAGE DUMP
         PAGE
*F*      NAME:    TAPDMP
*F*      PURPOSE: DUMP ALL OF PHYSICAL CORE TO A TAPE IN LABELED TAPE
*F*               FORMAT.
TAPDMP   MTW,1    TAPDMPX           ONLY ONE TAPE DUMP PER CRASH
         BEZ      %+2
         B        *11
         STW,11   TAPDMPX
TAPRST   LI,4     TAPREQM           OUTPUT REQUEST FOR TAPE DRIVE
         BAL,11   TYOUT
         BAL,11   GETDEV            INPUT OPERATOR RESPONSE
         LW,15    TAPDEV            SAVE TAPE UNIT/DEVICE NO. (0=NONE)
         BAL,11   SV1
         LW,15    TPCODE
         BAL,11   SV1
         LW,15    TAPDEV            HAS A TAPE DRIVE BEEN SPECIFIED
         BEZ      TAPEND              -NO, FORGET RECOVERY DUMP-
         LI,R4    1000              TIME OUT COUNTER
         BAL,11   REWTAP            REWIND TAPE
         LI,0     0
         STW,0    RCVADR
** WRITE TAPE LABEL
         LI,0     LBL               :LBL SENTINEL
         LI,1     12                3 WORD RECORD
         BAL,11   WRTAP
         LW,0     DATE
         STW,0    ACN+5
         LW,0     DATE+1
         STW,0    ACN+6
         LI,0     ACN               :ACN SENTINEL
         LI,1     7*4               7 WORD RECORD
         BAL,11   WRTAP
         BAL,11   WREOF             TAPE MARK
         LI,0     BOF               :B0F BEGINNING OF FILE SENTINEL
         LI,1     7*4
         BAL,11   WRTAP
         BAL,11   WREOF
TAPD10   LI,0     CNTL              CONTROL RECORD
         LI,1     3*4
         BAL,11   WRTAP             WRITE CONTROL
         LI,R11   X'800'            PREVIOUS BLOCK SIZE
         STH,11   CNTL
         LW,0     RCVADR
         LI,1     512*4
         BAL,11   WRTAP             WRITE 1 PAGE
         LI,1     1
         AWM,1    CNTL+1
         LI,0     512
         AWM,0    RCVADR
         LW,0     RCVADR
         CW,0     CORED
         BL       TAPD10             LOOP TILL DONE
         BAL,11   WREOF             DOUBLE EOF
         LI,0     EOF               END OF FILE SENT.
         LI,1     12
         BAL,11   WRTAP
         BAL,11   WREOF
         LI,0     EOR               END OF REEL SENT.
         LI,1     12
         BAL,11   WRTAP
         BAL,11   WREOF
         BAL,11   WREOF
         LI,R4    X'7FFFF'          TIME OUT COUNTER
         BAL,11   REWTAP            REWIND
         LI,4     TPOPMSG           TELL OPERATOR WHERE DUMP TAPE IS
         BAL,11   TYOUT
TAPEND   EQU      %
         B        *TAPDMPX
TAPDMPX  DATA     -1
*
*                                   REWIND SCRATCH TAPE
REWTAP   EQU      %
         AIO,0    0                 CLEAR DEVICE INTERRUPT
         BCR,8    %-1               CLEAN THEM ALL
         :TIO,R3  *TAPDEV
         BCS,12   TAPBAD            TAPE MUST BE READY
         LC       R3                TAPE READY
         BCS,6    TAPBAD            NO
         LI,R0    DA(TAPRW)         USE    XEROX CLIST
         LW,R1    TAPDCTX           DCTX OF THE TAPE DRIVE
         LB,R2    R:DCT24,R1        DEVICE FLAGS
         CI,R2    4                 MPC CONTROLED DEVICE
         BAZ      MPC6              NO
         LD,R12   REWINDON          REWIND IDCW
         BAL,R11  DEVNUM            PUT AWAY IDCW
         LI,R0    DA(MPCREW)        MPC REWIND CLIST
MPC6     EQU      %
         :SIO,0   *TAPDEV           SEND OUT REWIND ORDER
REWT10A  LI,0     1000
         BDR,0    %                 DELAY
         CI,R2    4                 MPC TAPE
         BANZ     MPC4              YES
         :TIO,0   *TAPDEV
         BCS,12   REWT10A
         BIF,X560 SETD              SET DENSITY ON 560
         B        *11
MPC4     :TIO,R3  *TAPDEV           TIO MPC TAPE
         LC       R3
         BCS,8    %+3               DEV INT HAS ARRIVED
         BDR,R4   REWT10A           HANG UNTILL DEV INT
         B        TAPBAD
         AIO,0    0                 CLEAR DEVICE INT FROM MPC
         LD,R12   800BPI            800 BPI DENSITY IDCW
         BAL,R11  DEVNUM            PUT AWAY IDCW
         LI,R0    DA(MPCDEN)        MPC SET DENSITY CLIST
         B        WRTSIO            ISSUE SIO
*
SETD     LI,R0    DA(SETDCOMM)      SET DENSITY COMM
         B        WRTSIO            ISSUE SIO
*
TAPBAD   LW,R4    TAPDMPX
         CI,R4    -1                IN HERE FROM TSTHGP
         BE       *R11              YES-RETURN
         LI,R11   TAPRST            FORCE REPEAT OF TAPE UNIT REQUEST
         LI,4     TAPBADM
         B        TYOUT             OUTPUT ALARM, THEN GET NEW IO ADDR
**  WRITE TAPE RECORD FROM LOC IN R0 AND SIZE OF R1
WRTAP    EQU      %                 R0 = WHERE, R1=SIZE
         STW,1    TAPIO+1
**
         SLS,0    2
         STW,0    TAPIO             STORE BYTE ADDRESS OF BUFFER
         LI,0     1
         STB,0    TAPIO             STORE WRITE ORDER
         LI,0     DA(TAPIO)
         LW,R1    TAPDCTX           DCTX OF TAPE DRIVE
         LB,R2    R:DCT24,R1        DEVICE FLAGS
         CI,R2    4                 MPC CONTROLED DEVICE
         BAZ      WRTSIO            NO
         LD,R12   WRITE             WRITE IDCW
         BAL,R11  DEVNUM            PUT IDCW AWAY
         LI,R0    DA(MPCWRT)        MPC WRITE TAPE CLIST
WRTSIO   :SIO,0   *TAPDEV           START IO ON TAPE DRIVE
         BCS,12   TAPBAD            ERROR
WRTAP1A  LI,0     1000
         BDR,0    %                 DELAY
         :TIO,R3  *TAPDEV           GET TIO STATUS
         BCS,12   WRTAP1A
         CI,R2    4                 MPC CONTROLED DEVICE
         BANZ     CHKMPC            YES-ERROR CHECK MPC OPERATION
         :TDV,13  *TAPDEV           GET STATUS
         AND,13   TDVMASK
         BNE      TAPBAD
         B        *11
*
CHKMPC   LH,R3    R3                TIO STATUS
         CI,R3    X'800'            MPC UN END
         BANZ     TAPBAD            YES-REPORT ERROR
         B        *R11              NO-GO BACK OK.
TDVMASK  DATA     X'A77F0000'       MASK FOR XEROX DRIVE TDV STATUS
*                                   WRITE END OF FILE ON TAPE
WREOF    EQU      %                 WRITE TAPE MARK
         LI,R0    DA(TAPEOF)        XEROX WEOF CLIST
         LW,R1    TAPDCTX           DCTX OF TAPE DRIVE
         LB,R2    R:DCT24,R1        DEVICE FLAGS
         CI,R2    4                 MPC CONTROLED DEVICE
         BAZ      WRTSIO            NO
         LD,R12   TAPEMARK          TAPEMARK IDCW
         BAL,R11  DEVNUM            PUT AWAY IDCW
         LI,R0    DA(MPCWEOF)       MPC WEOF CLIST
         B        WRTSIO            ISSUE THE SIO
*
LF       EQU      '
'               LINE FEED CHARACTER
TAPREQM  TEXTC    LF,'ENTER I/O ADDRESS FOR TAPE DUMP',LF
TAPNGM   TEXTC    '
EH?
'
TAPBADM  TEXTC    '
I/O ERROR, TAPE DUMP DEVICE
'
TPOPMSG  TEXTC    LF,' DUMP TAPE -RCVT- IS ON UNIT   XXX',LF
TPHXUN   EQU      TPOPMSG+9
*
TAPDEV   DATA     0                 TAPE UNIT I/O ADDRESS
TAPDCTX  DATA     0                 DCTX OF TAPE DRIVE
*
*                 GET TAPE DEVICE NUMBER
*
GETDEV   STW,11   GETDEVX           SAVE RETURN
         LI,0     0
         STW,0    TAPDEV
         LI,0     -3
         STW,0    CHRCNT            SET FOR 3 CHAR. I/O ADDRESS
GETD10   BAL,11   GETACHR           GET ONE DEV CHARACTER VIA REG.1(0-H)
         LW,0     TAPDEV
         SLS,0    4
         AW,0     1
         STW,0    TAPDEV
         MTW,1    CHRCNT
         BNEZ     GETD10            LOOP TILL 3 CHARACTERS INPUT
         CI,0     X'80'             MUST BE A MULTI-UNIT CONTROLLER
         BAZ      TAPDEVNG            -NOT A MULTI-UNIT CONTROLLER
         BIF,X560 GETD11            B/ 560
         AI,0     -X'A'*256         CHANGE IOP,IF GIVEN AS A-H (8,9=0,1)
         BLZ      %+2               ADDRESS GIVEN PHYSICAL
         STW,0    TAPDEV
GETD11   LI,R1    DCTSIZ            NO. DEVICES IN SYSTEM
GETD12   CH,R0    R:DCT1,R1
         BE       GETD13            FOUND THE DEVICE
         CH,R0    R:DCT1A,R1
         BE       GETD13            FOUND THE DEVICE ON ALTERNATE
         BDR,R1   GETD12            LOOP ON NO OF DEVICES IN SYSTEM
         B        TAPDEVNG          ERROR-CANT FIND ADDRESS
GETD13   LB,R2    R:DCT4,R1         TYPE INDEX
         LC       TB:FLGS,R2        DEVICE TYPE FLAGS
         BCS,4    TAPDEVNG          NOT TAPE
         BCR,8    TAPDEVNG          NOT TAPE
         STW,R1   TAPDCTX           YES-SAVE THE DCTX
         B        *GETDEVX
GETDEVX  DATA     -1
CHRCNT   DATA     -1
*
*
GETACHR  STW,11   GETCHRX           GET A CHARACTER
         BAL,11   TYIN
         CI,R0    X'15'             CARRIAGE RETURN
         BE       *GETDEVX          YES-RETURN
         LW,R2    CHRCNT            CHAR POSITION
         STB,R0   TPHXUN,R2         PUT CHAR IN OUTPUT MESSAGE
         LI,1     0
         BIF,X560 GETCH560          USE 560 TRANSLATE TABLE
GETCLOOP CB,0     LEGCHR,1
         BE       GETCHR10
         AI,1     1
         CI,1     18
         BL       GETCLOOP
TAPDEVNG LI,11    TAPRST            DEVICE NUMBER ILLEGAL
         LI,4     TAPNGM
         B        TYOUT
*
GETCHR10 EQU      %                 THE CHARACTER MAY BE 0-F, HOWEVER
         CI,1     15                 FIRST CHARACTER MAY BE 0-H FOR IOP
         BLE      *GETCHRX
         LW,0     CHRCNT
         CI,0     -3
         BE       *GETCHRX
         B        TAPDEVNG          ONLY 0-F ARE LEGAL FOR CONT./DEV.
*
GETCH560 LW,R4    CHRCNT
         CI,R4    -3                FIRST CHAR
         BG       GETCLOOP          NO-
X560LOOP CB,R0    X560CUCL,R1
         BE       *GETCHRX          CUCL CODE IN R1
         AI,R1    1                 ENTRY IN TABLE IS CUCL CODE
         CI,R1    X560CUCLL
         BLE      X560LOOP          LOOK AT ALL OF TABLE
         B        TAPDEVNG          ERROR
*
DEVNUM   STD,R12  IDCW              PUT AWAY THE IDCW
         LW,R12   TAPDEV            DEVICE ADDRESS
         LI,R13   X'F'
         SLD,R12  20
         STS,R12  IDCW              DEVICE NUMBER INTO IDCW
         B        *R11              RETURN
X560CUCL DATA,1   'A','%','#','@',':',0,0,0,;
                  'B','C','D','E','F','G',0,0,;
                  'H','I','J','K','L','M',0,0,;
                  'N','O','P','Q','R','S',0,0,;
                  'T','U','V','W','X','Y',0,0,;
                  'Z','0','1','2','3','4',0,0,;
                  '5','6','7','8','9','ž'
X560CUCLL  EQU  BA(%)-BA(X560CUCL)-1
*
LEGCHR   TEXT     '0123456789ABCDEFGH'
GETCHRX  DATA     -1
         BOUND    8
TAPRW    GEN,8,24 X'33',0
         DATA     0
SETDCOMM GEN,8,24 X'0B',BA(%+2)
         GEN,8,24 0,1
         DATA     X'48000000'       800 BBI,NO TRANSLATE
         BOUND    8
*
MPCWRT   :CDW     X'03',BA(IDCW),CC,5
TAPIO    GEN,8,24 1,0               IO COMMAND DBL WD. TO WRITE TAPE
         DATA     0                 SIZE OF OUTPUT TAPE RECORD
TAPEOF   GEN,8,24 X'73',0           IO COMMAND DBL WD. TO WEOF
         DATA     0
*
MPCREW   :CDW     X'03',BA(IDCW),NCC,5
MPCDEN   :CDW     X'03',BA(IDCW),NCC,5
MPCWEOF     :CDW  X'03',BA(IDCW),NCC,5
*
WRITE    :IDCW,X'0B'                WRITE 9 TRACK
TAPEMARK :IDCW,X'2D'  0,2
REWINDON :IDCW,X'38'  0,2
800BPI   :IDCW,X'30'  0,2
IDCW     DATA     0,0               CURRENT IDCW
LBL      TEXT     ':LBLRCVT'
ACN      TEXT     ':ACN:SYS            '
         RES      2
BOF      TEXT     ':BOF'
         DATA     X'01000202'
         TEXTC    'TAPDUMP'
         DATA     X'09010202',X'01000100'
         DATA     0
EOF      TEXT     ':EOF'
         DATA     3*4               3 WORDS IN PREVIOUS CONTROL
EOR      TEXT     ':EOR'
         DATA     0                 NOT USED
CNTL     DATA     1
         GEN,8,24 X'03',0
         DATA     X'05000800'
TPCODE   GEN,8,24 X'05',1
*
         PAGE
         REF      XPSDNO,XPSD46
         REF      SUABTFLE,DUMPFILE
         REF      SUARTN
         REF      TRAPSAVE
*F*      NAME:    SUABORT
*F*      PURPOSE: SUA CORE DUMP.
*F*      DESCRIPTION:
*F*          DUMP ALL OF PHYSICAL CORE TO A RADOM FILE(DUMPFILE)
*F*               AND WRITE ALL IN-CORE AND PRIMARY SWAPPER USER JITS
*F*                   TO DUMPFILE.
SUABORT  EQU      %                 SINGLE USER ABORT ENTRY
         LW,R11   =X'01000000'+SUARTN  SUA RETURN ADDRESS
         LW,R0    NRCVRX
         XW,R0    RECOVER0          DONT RECOVER ON TOP OF SUA
         STW,R0   STOREM            SAVE CONTENT OF RECOVER0
         LW,R0    XPSDNO            POINT TRAP 40 INTO RECOVER
         XW,R0    X'40'
         LW,R1    XPSD46
         XW,R1    X'46'             POINT TRAP 46 INTO RECOVER
         STD,R0   TRAPSAVE          SAVE 40-46 FOR  ANLZ
SUABORT1 EQU      %
         STW,R11  RCVDX             SAVE RETURN
         LW,R1    SUABTFLE+1        NUMBER OF GRANULES IN DUMP FILE
         XW,R1    RCVRDSZ
         STW,R1   SUTEMP1
         LW,R1    SUABTFLE          DA OF DUMP FILE
         XW,R1    RCVRAD
         STW,R1   SUTEMP            SAVE RCVRAD-ADDRESS OF RECOVER BUFF
         BAL,R11  CDUMP             GO-DUMP CORE TO DUMPFILE
         LW,R1    =X'80000000'
         STS,R1   SMAKFLG           SET FAST PATH DUMP DONE
         MTW,1    DUMPFILE          SET DUMP FILE BUSY
         LI,R7    SMUIS             MAX USERS IN SYSTEM
KR1      LB,D4    UB:US,R7          ACTIVE USER
         CI,D4    SNULL             CHECK FOR ACTIVE
         BEZ      SUKRD3            NO
         LOAD,R4  UX:JIT,R7
         SLS,R4   9                 ADDRESS OF JIT IF IN CORE
         LH,D4    UH:FLG,R7
         CI,D4    X'200'            JIT IN CORE
         BANZ     SUKRD2            YES-WRITE JIT FROM CORE
         MTW,0    S:SIP             SWAP IN PROGRESS
         BEZ      SUKRD4            NO-COPY JIT FROM DISC TO DISC
         MTW,0    DID%IO            IN-SWAP IN PROGRESS
         BGEZ     SUKRD4            YES-COPY JIT FROM DISC TO DISC
         LB,R6    SB:OSUL           NO. USERS IN OUT SWAP LIST
         CB,R7    SB:OSUL,R6        USER IN OUT SWAP LIST
         BE       SUKRD2            YES-WRITE JIT FROM CORE
         BDR,R6   %-2
SUKRD4   LW,R11   RCVDX             RETURN ADDRESS
         CI,R11   X'40000'          CRASH CALL FOR FAST PATH
         BL       %+3               YES-READ JITS FROM ALL SWAPPERS
         MTB,0    UB:SWAPI,R7       JIT    ON SYSTEM SWAPPER
         BNEZ     SUKRD3            NO-DONT SAVE
         LI,R4    RCBUF             YES SAVE
         LI,R3    2048              SIZE OF JIT
         LH,SR1   UH:JIT,R7
         BEZ      SUKRD3            IGNORE IF JUST STARTING UP
         STB,R7   SR1               USER NO.,SEEK OF JIT
         MTW,0    S:DP              PACK SWAPPER
         BEZ      %+2               NO
         LI,SR1   1                 YES-RELATIVE GRANULE NUMBER OF JIT
         BAL,SR4  RDUSR1            GO-READ JIT
         B        SUKRD3            ERROR-BAD JIT ADDRESS
SUKRD2   LI,R3    BA(JB:CUN)-BA(J:JIT)
         STB,R7   *R4,R3            INSURE JB:CUN CORRECT FOR RVGHOST
         LI,R3    2048              SIZE OF JIT
         LW,SR1   RCVRAD            DA IN DUMP FILE FOR JIT
         BAL,SR4  WRDISK1           GO-WRITE JIT IN DUMP FILE
         B        SUKRD3            ERROR-BAD JIT ADDRESS
         MTW,1    DUMPFILE+1        COUNT JITS WRITTEN
         BAL,SR4  INCRDA            GO-BUMP RCVRAD
SUKRD3   BDR,R7   KR1
         LW,R1    SUTEMP
         STW,R1   RCVRAD            RESTORE RCVRAD
         LW,R1    SUTEMP1
         STW,R1   RCVRDSZ           RESTORE SIZE OF RECOVER DUMP AREA
         LW,R11   RCVDX             RETURN ADDRESS
         CI,R11   X'40000'          CRASH CALL FOR FAST PATH
         BL       *R11              YES-RETURN
         LW,R0    STOREM
         STW,R0   RECOVER0          RESTORE TO RECOVER
         LD,R0    TRAPSAVE
         STW,R0   X'40'             RESTORE TRAP 40
         STW,R1   X'46'             RESTORE TRAP 46
         B        SUARTN            RETURN TO INITRCVR
STOREM   DATA     0                 CONTENTS OF RECOVER0
SUTEMP   DATA     0                 SAVE RCVRAD
SUTEMP1   DATA    0                 SAVE RCVRDSZ
         TITLE    'CYCUSR  ***  PPCHK'
******************************************************************
*                 P P C H K
*
*        TRANSACTION PROCESSING ROUTINE TO DETERMINE THE
*        VALIDITY OF A PHYSICAL WORK PAGE
*
**********************************************************************
*
*        NOTE:
*                 PPCHK IS LOCATED IN CYCUSR INSTEAD OF RCVCTL
*                 (WHERE IT IS CALLED) BECAUSE IT IS DEPENDENT
*                 ON THE CALL OF SYSTEM UTS USED IN THIS MODULE AND
*                 NOT IN RCVCTL.
*
PPCHK    EQU      %
         LW,R3    R2                FETCH INPUT WORD ADDRESS
         SLS,R3   -9                CONVERT TO PAGE NUMBER
         LI,R5    PWPTABLE          START AT TABLE ORIGIN
PPCHK05  EQU      %
         COMPARE,R3  *R5            SEARCH FOR MATCH
         BE       PPCHK10           YES, TELL CALLER ABOUT USAGE
         CI,R5    PWPEND            NO, ANY MORE ENTRIES IN TABLE
         BL       PPCHK20           YES, STEP TO NEXT ENTRY
         LCI      0                 NO, TELL CALLER PAGE IS NOT
         B        *11               A PHYSICAL WORK PAGE
PPCHK10  EQU      %
         LI,R3    3                 FETCH BYTE CONTAINING
         LB,R3    *R5,R3            USAGE BITS
         SLS,R3   29                ALIGN USAGE BITS
         SLS,R3   -2                FOR CONDITION CODE LOADING
         LC       R3                SET CC
         B        *11               RETURN
PPCHK20  EQU      %
         AI,R5    1                 MOVE TO NEXT ENTRY
         B        PPCHK05           CONTINUE SEARCH
         TITLE    'RECOVER REAL-TIME PAGES'
         SREF     PPTABLE,PPTABLSZ,PPTABDSK2
         SREF     PP:UPPH,PP:UPPT,PP:UPPC
         SREF     DYNRESDF,MDYNRESDF,RESDF
         SREF     RESDFD,RESDFPD,RESDFP,MDRESDFD
         REF      RTICBHDR
*F*      NAME:    RCVRT
*F*      PURPOSE: PRESERVE REAL-TIME MEMORY SEGMENTS AS DEFINED IN
*F*               PPTABLE, ACROSS RECOVERY.
RCVRT    EQU      %
         LW,0     RTICBHDR          IS THIS A RELA-TIME SYSTEM
         BLZ      *11               NO-EXIT
         STW,11   SVX11             SAVE RETURN
* VERIFY CONTENTS OF PPTABLE
         LI,4     0                 INITIALIZE COUNT
         LI,5     PPTABLSZ          INDEX
RCVRT2   LW,2     PPTABLE-1,5       GET ENTRY
         AND,2    =X'FFFF'          MASK OUT # OF PAGES
         AW,4     2                 COUNT THEM UP
         BDR,5    RCVRT2            LOOK AT ALL OF TABLE
         CW,4     PP:UPPC           IS COUNT RIGHT
         BNE      RCVRTX            NO-DONT SAVE
* VERIFY SYSTEM PARAMETERS
         CW,2     RESDF             IS RESDF IN PPTABLE OK
         BNE      RCVRTX            NO
         SW,4     2                 TAKE OUT RESDF COUNT
         CW,4     DYNRESDF          IS COUNT OF DYNRESDF RIGHT
         BNE      RCVRTX            NO
         CW,4     MDYNRESDF         IS IT GREATER THAN SYSTEM MAX
         BG       RCVRTX            YES
* VERIFY CHAIN IN MX:PPUT
         AW,4     2                 R4=PAGE COUNT FROM TABLE
         LI,3     0                 INITIALIZE COUNT
         LW,2     PP:UPPH           GET HEAD
         BNEZ     RCVRT6
         CI,4     0                 IS NONE IN CHAIN OK
         BE       RCVRT9            YES
         B        RCVRTX            NO-DONT SAVE
RCVRT6   AI,3     1                 INCREMENT CHAIN COUNT
         CW,2     PP:UPPT           HAVE WE REACHED THE END
         BNE      RCVRT7            NO-KEEP LOOKING
         CW,3     PP:UPPC           IS CHAIN OK
         BNE      RCVRTX            NO-DONT SAVE RT PAGES
         B        RCVRT9            YES-WRITE OUT PPTABLE AS IS
RCVRT7   LOAD,2   MX:PPUT,2         NO-GET NEXT IN CHAIN
         BEZ      RCVRTX            BROKEN CHAIN
         BDR,4    RCVRT6            DONT LOOP FOREVER
RCVRTX   LI,4     RCVRTM            TELL OPERATOR WE CANT SAVE THEM
         BAL,11   TYOUT
         LI,1     0                 ERROR-DONT SAVE RT PAGES
         STW,1    PP:UPPH           ZAP HEAD FOR RCVR PGCHK ROUTINE
         LI,5     PPTABLSZ+5
         STW,1    RESDF-1,5         ZAP ALL ENTRIES
         BDR,5    %-1
         LI,R3    RESDFD            SYSGENED VALUE
         STW,R3   RESDF
         LI,R3    RESDFPD
         STW,R3   RESDFP
         LI,R3    MDRESDFD          SYSGENED VALUE FOR MDYNRESDF
         STW,R3   MDYNRESDF
*
RCVRT9   EQU      %                 WRITE OUT PPTABLE
         LI,3     PPTABLSZ+5
         SLS,3    2                 BYTE SIZE
         LI,4     RESDF
         LW,8     PPTABDSK2
         BAL,11   WRDISK1           WRITE IT OUT
         NOP
RCVRTEND B        *SVX11            EXIT
RCVRTM   TXTC     '  REAL TIME PAGES LOST',X'15'
         PAGE
R:JXCMAP DO1      X'100'/2
         DATA     0
         END

