         SYSTEM   SIG7P
         SYSTEM   BPM
         REF      M:EI,M:EO
         REF      DUMPFILE,RCVRCNT
         REF      Y03,J:PUF,J:JIT
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
SR2      EQU      9
SR3      EQU      10
SR4      EQU      11
D1       EQU      12
D2       EQU      13
D3       EQU      14
D4       EQU      15
START    M:SYS                      GO MASTER MODE
         MTW,0    DUMPFILE
         BLEZ     RETURN            DONT RUN IF NO SUA DUMP PRESENT
         M:OPEN   M:EI,(FILE,'DUMPFILE',':SYS    '),;
                       IN,SAVE,(ERR,ERR),(ABN,ABN)
         LW,R1    RCVRCNT           CURRENT RECOVERY COUNT
         AI,R1    1                 COUNT THIS S U A
         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    BA(J:PUF)-BA(J:JIT)+2     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'
         WD,0     X'37'             DISABLE
         MTW,1    RCVRCNT           SET CORRECT RECOVER COUNT
KRD3     STW,R0   DUMPFILE          SET DUMP FILE FREE
         STS,R0   DUMPFILE+1        ZERO NUMBER OF JITS
         WD,0     X'27'             ENABLE
         LI,R1    7
         AND,R1   RCVRCNT           GET RECOVER COUNT
         AI,R1    X'F0'             CONVERT TO EBCDIC
         LI,R2    S:NUMC(NLS)
         STB,R1   MESSOC,R2         INSERT DUMP NO. IN OC MESSAGE
         CAL1,2   FPTOC             PRINT MESSAGE ON OC
RETURN   M:EXIT
ABN      EQU      %
ERR      EQU      %
         SLS,SR3  -17
         CI,SR3   X'600'**-1        EOF
         BE       *SR1              YES-RETURN TO CAL+1
         LI,R0    0
         LI,R1    X'FFFF'
         WD,0     X'37'             DISABLE
         B        KRD3
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
         DATA     2                 OUT
         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,;
                  'SINGLE USER ABORT DUMPING    MONDMPX'
TAB EQU ' '
NL       EQU      '
'
FPTOC    DATA     0
         DATA     X'80000000'
         DATA     %+1
MESSOC   TEXTC    NLS,NL,NL,NL,NL,NL,NL,NL
RCBUF    EQU      %
         DATA     RCBUF1,RCBUF2
RCBUF1   RES      512*5
RCBUF2   RES      512*5
         END      START

