*M* RECOVER2 RESTORE DATA REMEMBERED BY RECOVER AND CREATE MONDMP.
*P*      NAME:        RECOVER2
*P*      PURPOSE:     RESTORE THE TABLES SAVED BY RECOVER1 IN
*P*                   THE RECOVER BUFFER.
*P*      DECRIPTION:  EACH CODE WORD FROM THE RECOVER BUFFER IS
*P*                   USED TO DETERMINE WHAT SUBROUTINE TO
*P*                   EXECUTE.
         DEF      MAPFLG
*,*               CELL SET TO ONE TO INDICATE GHOST1 MAPPED.
         DEF      P:JIT
*,*               EQU OF THE ADDRESS OF JIT.
         DEF      R:CYL%SHFT
*,*               EQU TO MONITOR ADDRESS.
         DEF      R:DCT1
*,*               EQU TO MONITOR ADDRESS.
         DEF      R:DCT22
*,*               EQU TO MONITOR ADDRESS.
         DEF      R:DCT4
*,*               EQU TO MONITOR ADDRESS.
         DEF      R:DISCLIMS
*,*               EQU TO MONITOR ADDRESS.
         DEF      R:HGP
*,*               EQU TO MONITOR ADDRESS.
         DEF      R:NCYL
*,*               EQU TO MONITOR ADDRESS.
         DEF      R:NSPC
*,*               EQU TO MONITOR ADDRESS.
         DEF      R:NSPT
*,*               EQU TO MONITOR ADDRESS.
         DEF      R:NTPC
*,*               EQU TO MONITOR ADDRESS.
         DEF      R:SEC%SHFT
*,*               EQU TO MONITOR ADDRESS.
         DEF      R:TRK%SHFT
*,*               EQU TO MONITOR ADDRESS.
         DEF      R:JXCMAP          EQU TO JIT ADDRESS.
         DEF      R:DCT24           EQU TO MONITOR ADDRESS
         REF      DCT24
         REF      JX:CMAP           USER MAP IMAGE IN JIT.
         REF      RBUFSIZE          NUMBER OF PAGES IN RECOVER BUFFER.
         REF,1    JB:CUN
         SYSTEM   SIG7P
         SYSTEM   BPM
         TITLE    ' RECOVER2 -- RESTORE DATA REMEMBERED BY RECOVER'
R0       EQU      0
R1       EQU      1
R2       EQU      2
R3       EQU      3
R4       EQU      4
R5       EQU      5
R6       EQU      6
R7       EQU      7
SR1      EQU      8
R8       EQU      8
SR2      EQU      9
R9       EQU      9
SR3      EQU      10
R10      EQU      10
SR4      EQU      11
R11      EQU      11
D1       EQU      12
R12      EQU      12
D2       EQU      13
R13      EQU      13
D3       EQU      14
R14      EQU      14
D4       EQU      15
R15      EQU      15
         PAGE
         PCC      0
PUSH     CNAME    X'0B'
PULL     CNAME    X'0A'
         PROC
LF       EQU      %
TMP      SET      -2
         DO       NUM(AF)>1
         DO       AF(1)<16
         LCI      AF(1)
         ELSE
         LCI      0
         FIN
TMP      SET      0
         FIN
         GEN,8,4,20 NAME+TMP,AF(NUM(AF)),R:TSTACK
         PEND
*
*
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
         PAGE
         REF      JACCN
         REF      RCVRAD,RCVRCNT
         REF      DCT1,DCT4
         REF      CHKDA,JIT,J:AMR
         REF      R:TSTACK,RDRAD1
         REF      75BUF
         REF      RDDISK1,RBG,HGP
         REF      NCYL,NTPC,NSPT
         REF      DCT22
         REF      CYL%SHFT,TRK%SHFT,SEC%SHFT
         REF      DISCLIMS
         REF      NSPC
         SREF     COC
         SREF     LCOC
         REF      M:XX,M:EI,M:EO
         REF      RECORD,RATEFLAG,ACCNTSUM
         REF      TSTACK
         REF      S:DP
         REF      RDUSR1
         REF      WRDISK1
         SREF     UB:C#
         REF      RCVCODE
         SREF     COD:LPC,COCTERM,COCOTV,MODE2,CO:STAT
         SREF     COH:DN
         SREF     S:COUP            COUPLING CONTROL WORD
R:HGP    EQU      HGP
R:DCT1   EQU      DCT1
R:DCT22  EQU      DCT22
R:NCYL   EQU      NCYL
R:NTPC   EQU      NTPC
R:NSPT   EQU      NSPT
R:CYL%SHFT EQU    CYL%SHFT
R:TRK%SHFT EQU    TRK%SHFT
R:SEC%SHFT EQU    SEC%SHFT
R:DISCLIMS EQU    DISCLIMS
R:NSPC   EQU      NSPC
R:DCT4   EQU      DCT4
MONDMP   EQU      M:XX
R:JXCMAP EQU      JX:CMAP
R:DCT24  EQU      DCT24
M:DO     EQU      %                 DUMMY FOR SNAP PROC
X2A      EQU      X'2A'
         PAGE
*F*      NAME:        RECOVER2
*F*      PURPOSE:     BRANCH TO THE PROPER SUBROUTINE DEPENDING
*F*                   ON THE CONTROL WORD FROM THE RECOVER
*F*                   BUFFER.
*F*      DESCRIPTION: READ THE RECOVER BUFFER FROM SWAP
*F*                   DEVICE. DESTROY RECOVER BUFFER ON
*F*                   SWAP DEVICE.
*F*                   VERIFY THAT RECOVER BUFFER WAS READ.
*F*                   BRANCH TO SUBROUTINE, DETERMINE BY
*F*                   CODE WORD FROM RECOVER BUFFER.
RECOVER2 DSECT    0
         STW,11   RCVXT
         CAL1,8   GET:CM
         BCS,8    NORCV
         LW,R4    R9                START ADDRESS OF REC BUF
         LI,R9    RBUFSIZE          NUMBER OF PAGES IN RECOVER BUFFER.
         SLS,R9   9                 WORDS IN RECOVER BUF
         AI,R9    -1
         AW,R9    R4                ADDRESS OF LAST WORD IN REC BUF
         STW,9    BUFLN
         LW,8     RCVRAD            SAVE RCVRAD ADDRESSES
         LI,3     512*4                 TO LOCATE RECOVERY BUFFER
*
         MTB,0    X2A               ZAPPING
         BEZ      KRD2              NO
         LI,R1    RBUFSIZE
         SLS,R1   11                BYTES IN RECOVER BUFFER
         M:OPEN   M:XX,(FILE,'DUMPFILE'),(ABN,KRD2),(ERR,KRD2),INOUT
         M:READ   M:XX,(ERR,KRD4),(BLOCK,0),;
                  (BUF,*R4),(SIZE,*R1)
         M:WRITE  M:XX,(ERR,KRD4),(BLOCK,RBUFSIZE-1),;
                  (BUF,RECOVER2),(SIZE,2048)
KRD4     CAL1,1   CLSMON            CLOSE AND SAVE M:XX
         LB,R1    *BUFLN
         CI,R1    4                 RECOVER BUFFER
         BNE      KRD2              NO-READ FROM SWAPPER
         AI,R8    RBUFSIZE+RBUFSIZE-2  POINT TO LAST PAGE OF RCV BUF
         B        KRD3
KRD2     EQU      %
         LI,R1    RBUFSIZE          NUMBER OF PAGES IN REC BUF
         B        %+3
KRD1     AI,R4    512               ADVANCE TO NEXT PAGE
         AI,R8    2                 ADVANCE TO NEXT GRANULE
         BAL,11   RDDISK1
         B        NORCV             ERR RETURN
         BDR,R1   KRD1              READ ALL RECOVER BUFFER PAGES
KRD3     EQU      %
         LI,R4    RECOVER2
         BAL,SR4  WRDISK1           GO-CLOBBER RECOVER BUF ON SWAPER
         B        NORCV
         MTW,0    75BUF             ANY ERRORS REPORTED FROM FIX
         BGEZ     KRD50             NO
         LI,R4    HGPERRUM          YES-TELL USERS
         BAL,SR4  COCOUT            ON THERE TTYS
         B        %                 OPERATOR MUST REBOOT
KRD50    EQU      %
         LB,1     *BUFLN
         CI,1     4                 CHECK SV CODE
         BNE      NORCV             NO RECOVERY POSSIBLE
         LI,R5    7
         AND,R5   RCVRCNT           RECOVER COUNT MOD 8
         STS,R5   DMPNAME+1         PUT INTO FILE NAME
         LI,2     -1                POINTER TO CURRENT WORD
         MTB,0    X'2A'             RECOVERY FROM CRASH
         BEZ      PROCBUF           YES
         LW,3     *BUFLN,2          'ZAP' CODE WORD
         LI,2     -2                POINT TO NEXT CODE WORD
         CI,3     X'40404'          BOOT AFTER 'ZAP'
         BNE      EXIT              NO-TAKE ERROR RETURN
         LW,R5    =X'00010000'
         STW,R5   DMPNAME-1         PREVENT MONDMP OPEN FOR ZAP CASE
PROCBUF  LW,3    *BUFLN,2           PROCESS BUFFER
         LI,1     1
         LB,4     3                 FETCH SV CODE
         BEZ      NORCV
         CI,4     MAX               MAX ASSIGNED COMPUTER
         BGE      NORCV
         MTB,0    X'2A'             IF NO CRASH, DO LIMOTED RECOVERY
         BEZ      %+2
         LB,4     CODECODE,4
MAXST    EQU      %
         B        %+1,R4
         B        SKIP
         B        SKIP               1 = ERROR LOG (FIX)
         B        MAPREG             2 = MAP, ACCESS, LOCK REGS
         B        RCVDMP             3 = RECOVERY DUMP
         B        RETURN-1           4 = SIZE OF BUFFER
         B        SKIP               5 = TAPE DUMP
         B        SKIP               6 = **UNUSED**
         B        SKIP               7 = SYMFILES (FIX)
         B        ACT                8 = JITS FOR ACCOUNTING
         B        SKIP               9 = SYSTEM LIMITS (FIX)
         B        SKIP               A = **UNUSED**
         B        SKIP               B = HGP RECON (FIX)
         B        SKIP               C = **UNUSED**
         B        SKIP               D = RELEASE GRANULES (FIX)
         B        SKIP               E = **UNUSED**
         B        SKIP               F = RBBAT DATA (FIX)
         B        SKIP              10 = RBBAT COMM BUFFERS (FIX)
         B        SKIP              11 = RBBAT ERROR WORD (FIX)
MAX      EQU      %-MAXST
*
CODECODE DATA,1   0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
         BOUND    4
SKIP     SH,2     3,1               IGNORE THIS ENTRY
         AI,2     -1
RETURN   LI,3     X'FFFF'           RETURN FROM PROCESSORS
         LS,3    *BUFLN
         AW,3     2
         BGZ      PROCBUF
         MTB,0    X'2A'             IF NO CRASH WE ARE DONE
         BNEZ     EXIT
         MTW,1    RCVXT             NO - EXIT SKIPPING
EXIT     EQU      %
         B        *RCVXT
         PAGE
NORCV    EQU      %
         MTB,0    X'2A'             IF NO CRASH, DONT WORRY
         BNEZ     EXIT              EXIT
         PUSH     16,R0             SAVE ALL REGS
         LI,4     HGPERRUM          TELL USERS RECOVERY IMPOSSIBLE
         BAL,11   COCOUT
         M:MESSAGE (MESS,MSG)       RECOVERY TABLE CLOBBERED
         LI,R4    RBUFSIZE          PAGES OF RECOVER BUFFER
         SLS,R4   9                 WORDS IN RECOVER BUFFER
         AI,R4    -1
         LCW,R4   R4
         AW,R4    BUFLN             ADDRESS OF RECOVER BUFFER
         STW,4    TMP1
         PULL     16,R0             RESY`TORE ALL REGS FOR SNAP
         M:SNAP   'RCVBUFF',(*TMP1,*BUFLN) SNAP BUFFER
         M:MESSAGE (MESS,MSG1)      REBOOT RAD
         B        %
MSG      TEXTC    'RECOVERY TABLES CLOBBERED -- UNABLE TO CONTINUE'
MSG1     TEXTC    'REBOOT FROM SWAPPER'
         PAGE
MAPREG   EQU      %                 MAP,ACCESS,LOCK REGISTERS
         SH,R2    R3,R1             POINT TO FIRST WORD
         AW,R2    BUFLN             FORM BUFFER ADDRESS
         CAL1,1   OPN:MON           OPEN MONDMP FILE
         M:WRITE  MONDMP,(BUF,*R2),(SIZE,256*4),(ERR,ERR),(ABN,ABN),;
                  (KEY,MAPKEY),ONEWKEY
,CLSMON  M:CLOSE  MONDMP,SAVE
         SW,R2    BUFLN
         AI,R2    -1                POINT TO NEXT CONTROL WORD
         B        RETURN
MAPKEY   TEXTC    'ACLKPG'          MAP RECORD KEY
         PAGE
RCVDMP   EQU      %                 MOVE RECOVERY DUMP TO FILE
         SH,2     3,1
         LW,5    *BUFLN,2
         STW,R5   TMP1              DA OF DUMP ON SWAPPER
         AI,2     1
         LW,5    *BUFLN,2
         STW,5    RCVEND            END DA + 1 GRAN
**   GET A VIRTUAL PAGE FOR BUFFER
         M:GVP    P:JIT
         BCS,8    NORCV
         CAL1,1   OPN:MON           OPEN RAD FILE
MOVEDMP  LI,3     512*4
         LW,R8    TMP1              DA OF CURRENT PAGE
         LW,4     BUF
         BAL,11   RDDISK1
         B        NORCV
,LL      M:WRITE  MONDMP,(BUF,*BUF),(SIZE,512*4),(ERR,ERR),;
                  (ABN,ABN),(KEY,KEYLOC),(ONEWKEY)
         MTW,1    KEYLOC            KEY WITH PAGE NO.
         BAL,11   INCRDA
         LW,R5    TMP1              NEXT DA
         CW,5     RCVEND
         BNE      MOVEDMP
         CAL1,1   CLSMON            CLOSE AND SAVE MONDMP
         AI,R2    -2                POINT TO NEXT CONTROL WORD
         B        RETURN
         PAGE
**
**
ACT      EQU      %                 READ JITS, ACCOUNT, MONDMP
         LH,R7    R3,R1             NUMBER OF JITS TO PROCEES
         MTW,0    RCVEND            MONDMP TO BE PRODUCED
         BEZ      NO:OPN
         CAL1,1   OPN:MON           OPEN MONDMP IN INOUT
NO:OPN   EQU      %
         M:OPEN   M:EI,(FILE,':RATE'),(ERR,RATER),(ABN,RATER)
         M:READ    M:EI,(BUF,RECORD),(SIZE,72*4),;
                  (ERR,RATER),(ABN,RATER)
,CLSMEI  M:CLOSE  M:EI
         LI,0     0
         B        RATER+1
RATER    LI,0     X'FF'
         STW,0    RATEFLAG
         M:GVP    P:JIT             GET JIT PAGE BUFFER
JITLP    LI,5     1                 BYTE POSITION FOR USER NO. IN JIT KEY
         AI,2      -1
         PUSH     R2                SAVE REC BUF INDEX
         STW,R7   TMP2              SAVE JIT COUNT
         LW,8      *BUFLN,2
         LB,3      8                USER NO.
         BEZ      NOAMR             NULL ENTRY IN JIT TABLE
         LI,0     0
         STB,0    8                 CLEAR USER NO.
         LW,4      BUF
         LI,3      512*4
         BAL,11   NICOLE
         B        NOAMR             BAD JIT ADDRESS-SKIP THIS USER
         LW,11    RCVEND
         BEZ      NO:DMP            NO RAD DUMP
         LI,R4    JB:CUN-BA(J:JIT)  DISPLACEMENT TO USER NO.
         LB,R4    P:JIT,R4          USER NO.
         STB,R4   JITKEY,R5         SET UP JIT KEY FOR MONDMP
         M:WRITE  MONDMP,(BUF,*BUF),(SIZE,512*4),;
                  (KEY,JITKEY),(NEWKEY),;
                  (ERR,ERR),(ABN,ABN)
NO:DMP   EQU      %
         LI,1     1
         LW,R5    P:JIT+TSTACK-JIT  TOP OF STACK
         SH,R5    P:JIT+TSTACK+1-JIT,R1  WORD COUNT
         AND,5    =X'1FFFF'
         CI,5     TSTACK+1
         BNE      NOAMR             BAD JIT - SKIP THIS USER
         LC       P:JIT             GHOST JOB
         BCS,6    NOAMR             SKIP GHOST AND REMOTE ASSIST(AMR NOT RELEASE
         BCS,8    NO:IDMS           NO ACCOUNTING SUMMARY FOR ONLINE
         LW,R0    P:JIT             GET SYSID FROM JIT
         BAL,11   HEXCVT
         STW,3    JOBMS+2
         LI,4     JOBMS
         BAL,11   TYOUT             PRINT MESSAGE
         M:DEVICE M:LL,PAGE         TOP THE PAGE
         LCI      5
         LM,R4    P:JIT+JACCN       GET ACCOUNT,NAME
         LCI      2
         STM,R4   LPMSG+5           PUT ACCOUNT INTO MESSAGE
         LCI      3
         STM,R6   LPMSG+1           PUT NAME INTO MESSAGE
         M:PRINT  (MESS,LPMSG)      PRINT NAME, ACCT.(SYMBIONT)
NO:IDMS  EQU      %
         LH,SR1   RCVCODE
         CI,SR1   X'89'             CRASH CODE .89
         BE       NOAMR             YES-DONT RELEASE GRANULES AFTER HGP RECON
         LW,SR1   P:JIT+J:AMR-JIT   DA OF ASSIGN MERGE RECORD
         BEZ      NOAMR             NO ASSIGN MERGE RECORD
         BAL,SR4  CHKDA             GO-CHECK DA
         BCR,15   NOAMR             BAD DA DONT GO TO ACCNTSUM
         BAL,11   ACCNTSUM          DO ACCOUNTING
         LW,8     P:JIT+J:AMR-JIT
         BEZ      NOAMR             NO ASSIGN MERGE RECORD
         BAL,11   CHKDA             CHECK IT
         BCR,15   NOAMR             BAD, DON'T RELEASE
         PUSH     2,1
         BAL,11   RBG               GOOD, RELEASE IT
         PULL     2,1
         LC       P:JIT             IS USER ONLINE?
         BCR,8    %+2               NOPE. NOT INTERESTED
         BAL,11   WRLOGD            IF ONLINE, GO WRITE :LOGD RECORD.
NOAMR    EQU      %
         LW,R7    TMP2              RESTORE NUMBER OF JITS
         PULL     R2                RESTORE REC BUF INDEX
         BDR,7    JITLP
         AI,2     -1
         M:FVP    P:JIT
         LW,11    RCVEND
         BEZ      RETURN
         CAL1,1   CLSMON            CLOSE AND SAVE MONDMP
         B        RETURN
JOBMS    TXTC     '   JOB XXXX PARTIALLY COMPLETED',X'15'
         PAGE
ERR      EQU      %
ABN      EQU      %
         SLS,SR3  -17
         CI,SR3   X'300'**-1        FILE NOT THERE
         BNE      *SR1              NO-ERROR
         LW,R3    SR1               SAVE RETURN
         LI,SR1   2
         STW,SR1  MODE              SET OUT MODE
         CAL1,1   OPN:MON           OPEN MONDUMP
         LI,SR1   4
         STW,SR1  MODE              SET UPDATE MODE
         B        *R3               RETURN TO CAL+1
**
**
INCRDA   EQU      %
         MTW,2    TMP1              INC RECOVER RAD ADDRESS
         B        *11               RETURN
         PAGE
TYOUT    EQU      %                 TYPE MESSAGE ON OPERATOR CONSOLE
         M:TYPE   (MESS,*4)
         B        *11               RETURN
**
**
*                 CONVERT HEX TO EBCDIC FOR OUTPUT
*                 INPUT IN 0, OUTPUT IN 2,3
HEXCVT   LI,4     -8
         LI,1     0
         SCD,0    4
         LB,1     HEXCHRS,1
         STB,1    4,4
         BIR,4    HEXCVT+1
         B        *11
HEXCHRS  TEXT     '0123456789ABCDEF'
         PAGE
COCOUT  EQU     %       SEND MESSAGE TO ALL TERMINALS
         LI,12    COC               SEE IF NON-COC SYSTEM
         BEZ      *11               B/NO COC
         PUSH     3,1
         LI,1     0
COCOUT0  EQU      %
         AI,1     1
         LI,R6    LCOC+1            NUMBER OF COCS
COCOUT1  LI,R2    -1
         AW,R2    R6                COC NUMBER
         LH,R2    COH:DN,R2         COC IO ADDRESS
         CI,R2    -1                PARTITIONED OUT
         BE       COCOUT6           YES-SKIP THIS COC
         TIO,0    *R2               COC PRESENT
         BCS,X'C' COCOUT6           NO-SKIP THIS COC
         LI,D1    X'F0'
         AND,D1   CO:STAT-1,R6      DIO ADDRESS
         AI,D1    X'3005'           TRANSMIT DATA FUNCTION
         LD,R2    COD:LPC-2,R6      LOGICAL LINE RANGE THIS COC
COCOUT2  LW,SR2   R3                HIGHEST LOGICAL LINE THIS COC
         SW,SR2   R2                PHYSICAL LINE THIS COC
         LB,R5    COCTERM,R3        TRANSLATE TABLE INDEX
         LH,SR1   COCOTV,R5         TRANSLATE TABLE ADDRESS
         BLEZ     COCOUT4           B/TRANS TBL ADR BAD
         LB,R7    *R4,R1            EBCDIC CHAR
         LB,R7    *R8,R7            L/ASCII OR 2741 CHAR
         LC       MODE2,R3          2741 TYPE TERMINAL
         BCS,1    2741TRNS          YES-TRANSLATE FOR 2741
         SCS,R7   32                CHECK # OF BITS SET IN CHAR
         BEV      %+2               B/EVEN # OF BITS OK
         AI,R7    X'80'             +.80; SET PARITY BIT
COCOUT5  SLS,R7   8
         AW,R7    SR2               PUT IN PHYSICAL LINE NUMBER
         WD,R7    *D1               TRANSMIT CHAR
COCOUT4  AI,R3    -1                DEC LOGICAL LINE NUMBER
         CW,R3    R2                MORE LOGICAL LINES THIS COC
         BGE      COCOUT2           YES-TRANSMIT TO ALL LINES THIS COC
COCOUT6  BDR,R6   COCOUT1
         LI,2     72000             DELAY
         BDR,2    %
         CB,1     *4
         BL       COCOUT0           ARE WE DONE
         LI,R6    LCOC+1            L/# OF COCS
COCOUT3  LI,R2    -1
         AW,R2    R6                COC NUMBER
         LH,R2    COH:DN,R2         COC IO ADDRESS
         CI,R2    -1                COC PARTITIONED
         BE       COCOUT7           YES
         TIO,0    *R2               COC PRESENT
         BCS,X'C' COCOUT7           NO-SKIP THIS COC
         LI,D1    X'F0'
         AND,D1   CO:STAT-1,R6      G/DIO ADR
         AI,D1    X'300E'           STOP TRANSMIT FUNCTION
         LI,R3    63                L/MAX LINE# ON A COC
         WD,R3    *D1               STOP TRANSMIT
         BDR,R3   %-1               BDR/PROCESS NEXT LINE
         WD,R3    *D1               STOP TRANSMIT ON LINE 0
COCOUT7  BDR,R6   COCOUT3
         PULL     3,1
         B        *11               RETURN
**
2741TRNS CI,R7    X'6E'             C/2741 CHAR W/2741 LF
         BNE      %+2               B/NOT 2741 LF
         LI,R7    X'1C'             L/UPPER CASE SHIFT CHAR
         AND,R7   =X'3F'            TAKE OFF ANY CONTROL BITS
         SCS,R7   32
         BOD      %+2
         AI,R7    X'40'             MAKE ODD PARITY
         B        COCOUT5
**
CR       EQU      ' '               CARRIAGE RETURN CHARACTER
LF       EQU      ' '               LINE FEED CHARACTER
TC       EQU      ' '               TIMING CHARACTER; RUBOUT
TCS      EQU      TC,TC,TC,TC,TC,TC,TC,TC    TIMING CHARACTERS
HGPERRUM TEXTC    CR,LF,TCS,'STAND BY - FOR EXTENDED RECOVERY',CR,LF
         PAGE
NICOLE   EQU      %
         MTW,0    S:DP
         BEZ      RDRAD1
         LB,7     8
         SLS,8    -8
         STB,8    UB:C#,7
         LI,8     1
         B        RDUSR1            READ DP
         PAGE
*
*        WRLOGD WRITES A RECORD FOR EACH ONLINE USER INTO THE FILE
*        :LOGD.:SYS IF THE SYSTEM CELL S:COUP EXISTS AND THE TWO BIT
*        IS SET. AN 11 WORD RECORD IS WRITTED CONTAINING THE
*        USER NAME AND ACCOUNT, LOGGED OFF INDICATOR, AND INSTEAD OF
*        THE TIME, THE STRING '*RECOVERY*'. THE RECORD IS WRITTEN
*        USING THE SYSID AS A KEY.
*
         REF      BIN2HEX,KEYBUFF,M:UC,COCLN,J:JIT
WRLOGD   LCI      0
         STM,0    RECORD+20         SAVE THE REGISTERS.
         LI,1     S:COUP            DOES THE CELL EXIST?
         BE       WRX               GUESS NOT.
         LI,2     2
         CW,2     S:COUP            FEATURE ENABLED??
         BAZ      WRX               NOPE. BYE....
         LI,4     X'FF'
         AND,4    P:JIT             PICK UP THE SYSID
         OR,4     =X'03000000'      MAKE IT LOOK LIKE A KEY.
         STW,4    KEYBUFF
         LI,2     X'FF'             PICK UP LINE # FROM M:UC
         AND,2    P:JIT+M:UC+COCLN-J:JIT
         BAL,SR4  BIN2HEX
         SLS,4    16                MAKE IT LOOK PRETTY.
         AI,4     X'4040'           TWO BLANKS.
         LCI      5
         LM,5     P:JIT+JACCN       NAME AND ACCOUNT
         LW,10    ='    '
         LCI      7
         STM,4    RECORD
WRLOGG   LCI      4
         LM,0     WRTXT             SHOVE IN RECOVERY TEXT
         STM,0    RECORD+7          INSTEAD OF THE TIME.
WRLOGO   CAL1,1   WROPEN            OPEN ME THIS FILE
WRLOGW   CAL1,1   WRWRITE           WRITE THE RECORD
WRLOGC   CAL1,1   WRCLS             SLAM......
WRLOGR   EQU      %
WRX      LCI      0
         LM,0     RECORD+20         RESTORE REGS
         B        *11               AND SPLIT.
*
*        ERROR/ABNORMAL CONDITIONS
*
WOPNE    LB,2     10
         CI,2     3                 FILE DOSENT EXIST.
         BE       WROPNO            GO CREATE IT.
WROOPS   STW,10   RECORD+18         SAVE ERROR CODE
         BAL,SR4  BIN2HEX
         STH,4    WRMSG+3
         LW,SR3   RECORD+18
         SLS,SR3  -17               LOOK AT SUBCODE
         LI,2     X'7F'
         AND,2    SR3
         BAL,SR4  BIN2HEX
         STH,4    WRMSG+4
         CAL1,2   WMSGF             HOLLER TO OPERATOR
         LI,1     X'FFFDF'
         AND,1    S:COUP
         STW,1    S:COUP            TURN OFF THE BIT IN S;COUP
         LH,R1    M:EO
         CI,R1    X'20'             DCB OPEN
         BAZ      WRLOGR            NO-DONT CLOSE IT
         B        WRLOGC            AND SPLIT.
*
*        TRY TO OPEN IT OUT.
*
WROPNO   LW,1     WOPNMODE          GET THE MODE WORD
         CI,1     2                 IF ITS 2, WE'VE BEEN HERE BEFORE.
         BE       WROOPS            AND SHOULD GET OUT FAST.
         LI,1     2
         STW,1    WOPNMODE          SET MODE TO OUT
         B        WRLOGO            AND GO TRY AGAIN.
*
*        FPT'S
*
WMSGF    DATA     0,X'80000000',WRMSG SEND IT TO OPERATOR.
WRCLS    GEN,8,24 X'15',M:EO
         GEN,1,31,32 1,0,2          CLOSE WITH SAVE.
WRWRITE  GEN,8,24 X'11',M:EO
         DATA     X'FC000040'
         DATA     WOPNE,WOPNE
         DATA     RECORD,44,KEYBUFF,0
         PAGE
**
**
DATA     DSECT    0
P:JIT    EQU      X'1B000'
BUF      PZE      P:JIT
OPN:MON  GEN,8,24 X'14',MONDMP      OPEN OUTPUT FILE
         DATA     X'FF480001'
         PZE      ERR
         PZE      ABN
         PZE      *BUF
         PZE      512*4             1 PAGE RECORD SIZE
         PZE      10                MAX TRIES
         PZE      2                 KEYED
         PZE      2                 DIRECT
MODE     DATA     4                 INOUT MODE
         PZE      2                 SAVE
         DATA     7                 MAX KEY LENGTH
         DATA     X'01000202'
DMPNAME  TEXTC    'MONDMP0'
         DATA     X'03000000'       NULL PASSWORD ENTRY
         DATA     X'04010202'
         TEXT     ' 00100  '        EXPIRE 1 DAY HENCE
**
**
RCVXT    PZE
BUFLN    PZE      0
RCVEND   DATA     0
GET:CM   GEN,8,24 X'0C',RBUFSIZE    GET COMMON PAGES FOR REC BUF
MAPFLG   DATA     X'FF'             GHOST1 ALWAYS MAPED
LPMSG    TEXTC    '   NAMENAMENAME,   ACCOUNT'
TMP2     PZE
TMP1     DATA      0
KEYLOC   GEN,8,24 X'3',0
JITKEY   GEN,8,24  X'03',0          BYTE 2 IS USER NO.
*
*        DATA AREA FOR :LOGD PROCESSING.
*
WROPEN   GEN,8,24 X'14',M:EO
         DATA     X'CF480009'       LOTS OF PARAMETERS....
         DATA     WOPNE             P1- ERR ADDR
         DATA     WOPNE             P2- ABN ADDR
         DATA     10                P5- TRIES=10
         DATA     2                 P6- KEYED
         DATA     2                 P7- DIRECT
WOPNMODE DATA     4                 P8- INOUT, MAY BE OUT
         DATA     2                 P10- SAVE
         DATA     4                 P13- KEYM=4
WFPAR    GEN,8,8,8,8 1,0,2,2
         TEXTC    ':LOGD'           NAME=:LOGD
         GEN,8,8,8,8 2,0,2,2
         TEXT     ':SYS '           ACCT=:SYS
         GEN,8,8,8,8 3,0,2,2
         RES      2                 PASSWORD=HASH FROM LOADER.
         GEN,8,8,8,8 5,0,2,2
         TEXT     'NONE','    '     READ=NONE
         GEN,8,8,8,8 6,1,2,2
         TEXT     'NONE    '        WRITE=NONE
*
WRMSG    TEXTC    'ERROR CODE XX--XX ON :LOGD FILE.'
WRTXT    TEXT     '****RECOVERY****'
         END

