*M* RVGHOST CREATE MONDMP FROM SINGLE USER ABORT.
*P* NAME: RVGHOST
*P* DESCRIPTION:
*P* THE RANDOM FILE DUMPFILE IS READ, USING READ CALS WITH NO-WAIT I/O,
*P* IN 5 GRANULE BLOCKS.  THE MONDMP FILE IS WRITTEN WITH NO-WAIT I/O
*P* WITH KEYED RECORDS, ONE RECORED/PAGE OF MEMORY.  THE KEY IS FORMED
*P* FROM THE PHYSICAL PAGE NUMBER. USER JITS ARE WRITTEN
*P* TO THE MONDMP FILE USING THE USER NUMBER TO FORM THE KEY.
         SYSTEM   SIG7P
         SYSTEM   BPM
         REF      M:EI,M:EO
         REF      DUMPFILE,RCVRCNT
         REF      Y03,J:JIT
         REF      SUACNT,RCVCODE,SUACUN
         REF,1    JB:CUN
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,R8   EQU      8
SR2,R9   EQU      9
SR3,R10  EQU      10
SR4,R11  EQU      11
D1,R12   EQU      12
D2,R13   EQU      13
D3,R14   EQU      14
D4,R15   EQU      15
START    M:SYS                      GO MASTER MODE
         MTW,0    DUMPFILE
         BLEZ     RETURN            DONT RUN IF NO SUA DUMP PRESENT
         LW,R1    SUACNT            COUNT OF SUA'S AFTER LAST CRASH
         BEZ      KRD9              NONE SKIP OC MESSAGE
         AI,R1    -1                FORM INDEX
         LB,R0    SUACUN,R1         USER NUMBER OF LAST SUA
         LI,R13   SUAMESTL+2
         BAL,R12  MESSPUT           PUT USER NUMBER IN MESSAGE
         LI,R0    X'FF'
         AND,R0   RCVCODE           SCREECH SUB CODE
         LI,R13   SUAMESTL+1
         BAL,R12  MESSPUT           PUT SCREECH SUB CODE IN MESS.
         LW,R0    RCVCODE
         SLS,R0   -16               SCREECH CODE
         LI,R13   SUAMESTL
         BAL,R12  MESSPUT           PUT SCREECH CODE IN MES.
         CAL1,2   FPTMESS           PRINT MESS ON OC
KRD9     EQU      %
         M:OPEN   M:EI,(FILE,'DUMPFILE',':SYS    '),;
                       IN,SAVE,(ERR,ERR),(ABN,ABN)
         MTB,0    DUMPFILE          PREVIOUS MONDMP NAMED
         BEZ      RETURN-1          NO
         LI,R2    4
         INT,R3   DUMPFILE          TYPE OF DUMP
         CI,R3    2                 SUA
         BE       %+2               YES-OPEN MONDMP OUT MODE
         STW,R2   MODE              SET MODE IN/OUT
         LB,R1    DUMPFILE          PREVIOUS MONDMP NUMBER
         AND,R1   =7                MOD 8
         STS,R1   DMPNAME+1         FORM CORRECT MONDMPI NAME
         CAL1,1   FPTMONDI          OPEN MONDMPI FILE
         LW,R1    DUMPFILE+1        NUMBER OF MEMORY PAGES
         SLS,R1   -16
         OR,R1    Y03
         LI,D1    0                 START AT FIRST GRANULE
         M:READ   M:EI,(BUF,RCBUF1),(SIZE,10240),(ERR,ERR),(ABN,ABN),;
                       WAIT,(BLOCK,*D1)
         AI,D1    5                 INC THE GRANULE NUMBER
         LI,R6    1                 INDICATE SECOND BUFFER
         LW,D4    RCBUF,R6          GET CORRECT BUFFER ADDRESS
KRD1,RD  M:READ   M:EI,(BUF,*D4),(SIZE,10240),(BLOCK,*D1)
         AI,D1    5                 INC THE GRANULE NUMBER
         EOR,R6   =1                FLIP THE BUFFER
         LW,D4    RCBUF,R6          GET CORRECT BUFFER ADDRSS
         LI,R7    5                 5 GRANULES/READ
KRD4,WR  M:WRITE  M:EO,(BUF,*D4),(SIZE,2048),;
                       (KEY,KEYLOC),ONEWKEY
         AI,D4    512               POINT TO NEXT PAGE
         MTW,1    KEYLOC            INC PAGE KEY  030000PAGE NUMBER
         CW,R1    KEYLOC            PUT ALL OF THE PAGES IN MONDMP
         BL       KRD5              DONE WITH CORE
         BDR,R7   KRD4              CONTINUE WRITING  FROM THIS INPUT BLOCK
         LW,D4    RCBUF,R6          GET CORRECT BUFFER ADDRESS
,CHKEI   M:CHECK  M:EI,(ERR,ERR),(ABN,ABN)
,CHKEO   M:CHECK  M:EO,(ERR,ERR),(ABN,ABN)
         B        KRD1              CONTINUE WRITING  FROM BLOCK
         PAGE
KRD5     EQU      %
         LW,R1    Y03
         STW,R1   KEYLOC            CLEAR KEY BUFFER
         LI,R2    0
         INT,R1   DUMPFILE+1        NUMBER OF JITS TO PUT IN MONDUMP
         LI,R3    JB:CUN-BA(J:JIT)  DISPLACEMENT TO USER NUMBER.
         LI,R4    1                 BYTE POSITION FOR USER NO. IN JIT KEY
         B        KRD7
KRD2     CAL1,1   RD                READ JIT
         AI,D1    5                 INC THE GRANULE NUMBER
         EOR,R6   =1                FLIP THE BUFFER
         LW,D4    RCBUF,R6          GET CORRECT BUFFER ADDRESS
         LI,R7    5                 5 GRANULES/BLOCK
KRD6     LB,R5    *D4,R3            USER NUMBER, FROM JIT
         STB,R5   KEYLOC,R4         INTO KEY  0300USER NO.00
         CAL1,1   WR                WRITE JIT
         AI,D4    512               POINT TO CORRECT PAGE
         AI,R2    1                 COUNT THIS JIT
         CW,R2    R1                PUT OUT ALL JITS TO MONDMP
         BGE      KRD8              DONE WITH JITS
KRD7     BDR,R7   KRD6              CONTINUE IN THIS BLOCK
         LW,D4    RCBUF,R6          CORRECT BUFFER ADDRESS
         CAL1,1   CHKEI             WAIT ON INPUT
         CAL1,1   CHKEO             WAIT ON OUTPUT
         B        KRD2              READ AN OTHER BLOCK
KRD8     CAL1,1   CHKEO             WAIT ON OUTPUT
         M:CLOSE  M:EO,(SAVE)       CLOSE MONDMP
         M:CLOSE  M:EI,(SAVE)       CLOSE DUMP FILE
GJOB     CAL1,6   FPTANLZ           START UP ANLZ
         BCR,8    %+3               ANLZ STARTED
         M:WAIT   50                WAIT A MIN
         B        GJOB              TRY TO ANLZ AGAIN
         LI,R0    0
         LI,R1    X'FFFF'
         LI,R2    X'FF'
         AND,R2   DMPNAME+1         MONDMP NUMBER
         LI,R3    S:NUMC(NLS)
         STB,R2   MESSOC,R3         INSERT MONDMP NO. INTO OC MESS.
         WD,0     X'37'             DISABLE
         LB,R2    DUMPFILE          MONDMP NUMBER
         STB,R2   RCVRCNT           MONDMP NO. FOR ANLZ
KRD3     STW,R0   DUMPFILE          SET DUMP FILE FREE
         STS,R0   DUMPFILE+1        ZERO NUMBER OF JITS
         WD,0     X'27'             ENABLE
         CAL1,2   FPTOC             PRINT MESSAGE ON OC
RETURN   M:EXIT
ABN      EQU      %
ERR      EQU      %
         SLS,R10  -17               ERROR CODE,SUBCODE
         CI,R10   X'4200'**-1       42-00
         BE       *R8               YES-RETURN
         CI,R10   X'5700'**-1+X'44' 57-44
         BE       *R8               YES-RETURN
         LCI      0
         STM,R0   REGS              SAVE REGISTERS
         LI,R0    X'7F'
         AND,R0   R10               SUB CODE
         LI,R13   ERRMESTL+1
         BAL,R12  MESSPUT           PUT SUB CODE INTO MESSAGE
         LW,R0    R10
         SLS,R0   -7                ERROR CODE
         LI,R13   ERRMESTL
         BAL,R12  MESSPUT           PUT ERROR CODE INTO MESSAGE
         LW,R0    KEYLOC
         LI,R13   ERRMESTL+2
         BAL,R12  MESSPUT           PUT KEY INTO MESSAGE
         STB,R3   *R4,R5            HIGH ORDER DIGIT OF KEY INTO MES.
         CAL1,2   FPTMESS           OUTPUT MESSAGE ON OC
         LCI      0
         LM,R0    REGS              RESTORE REGISTERS
         B        *R8               RETURN TO CAL+1
FPTANLZ  GEN,8,24   6,0             GJOB ANLZ
         TEXTC    'ANLZ'
KEYLOC   DATA     X'03000000'
FPTMONDI GEN,8,7,17 X'14',0,M:EO
         DATA     X'C7480001'
         DATA     ERR               ERROE
         DATA     ABN               ABNORMAL
         DATA     2                 KEYED
         DATA     2                 DIRECT
MODE     DATA     2                 MODE-OUT FOR SUA;INOUT FOR CRASH
         DATA     2                 SAVE
         DATA     3                 KEYM
         DATA     X'01000202'
DMPNAME  TEXTC    'MONDMP0'
         DATA     X'04010202'
         TEXT     ' 00100  '        EXPIRE ONE DAY HENCE
NLS      EQU      NL,NL,NL,NL,NL,NL,NL,TAB,;
                  'RECOVER GHOST CREATING    MONDMPX'
TAB EQU ' '
NL       EQU      '
'
FPTOC    DATA     0
         DATA     X'80000000'
         DATA     %+1
MESSOC   TEXTC    NLS,NL,NL,NL,NL,NL,NL,NL
M1       EQU      TAB,'RVGHOST I/O ERR XX'
M2       EQU      M1,'-YY'
M3       EQU      M2,', ON KEY ZZZ'
ERRMESS  TEXTC    M3,NL
ERRMESTL GEN,8,7,17  S:NUMC(M1),,ERRMESS
         GEN,8,7,17  S:NUMC(M2),,ERRMESS
         GEN,8,7,17  S:NUMC(M3),,ERRMESS
M4       EQU      TAB,'SINGLE USER ABORT XX'
M5       EQU      M4,'-YY'
M6       EQU      M5,', USER NO. ZZ'
SUAMESS  TEXTC    M6,NL
SUAMESTL GEN,8,7,17  S:NUMC(M4),,SUAMESS
         GEN,8,7,17  S:NUMC(M5),,SUAMESS
         GEN,8,7,17  S:NUMC(M6),,SUAMESS
MESSPUT  BAL,R11  HEXCVT            R0-EBCDIC IN R2,R3
         LI,R1    2                 TWO CHARS.
         LW,R4    *R13              TABLE WORD
         LB,R5    R4                INDEX INTO MESSAGE
MESSPUT1 STB,R3   *R4,R5            INSERT CHAR.
         SLS,R3   -8
         AI,R5    -1
         BDR,R1   MESSPUT1          INSERT TWO CHARS.
         B        *R12              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'
FPTMESS  DATA     0
         DATA     X'80000000'
         PZE      *R4
REGS     DO1      16
         DATA     0
RCBUF    EQU      %
         DATA     RCBUF1,RCBUF2
RCBUF1   RES      512*5
RCBUF2   RES      512*5
         END      START

