*M* PMD  PROCESS PMD REQUESTS AT END OF JOB STEPS.
         DEF      PMD:              XDELTA LABEL FOR PMD MODULE.
PMD:     EQU      %
*P*      NAME:    PMD
*P*
*P*      PURPOSE: TO PROCESS POST-MORTEM DUMP REQUESTS AT JOBSTEP END.
*P*               ALSO CAUSES REASON FOR ABORT TO BE PRINTED (BATCH).
*P*               MODULE ALSO CONTAINS BRANCH VECTOR FOR DEBUG CALS.
*P*
*P*  DESCRIPTION: PMD IS CALLED AT THE END OF ANY JOBSTEP WHICH --
*P*                 * TERMINATED ABNORMALLY
*P*                 * HAD !PMD COMMANDS ASSOCIATED WITH IT
*P*               PMD CALLS TELLUSR TO SHOW THE REASON FOR A JOBSTEP
*P*               ABORT.  IF THERE WERE !PMD COMMANDS, IT READS THE
*P*               ID-D FILE TO FIND RELEVANT ONES. IT THEN CALLS
*P*               DUMPER TO SHOW THE USER'S REGISTERS AND DUMP DUMPS.
*
BITS     SET      1                 WE WANT BITS & MASKS TO USE.
         SYSTEM   UTS
         PCC      0
         PAGE
*
         REF      CLSSEG      = # OF 'CLOSE' MONITOR OVERLAY
         REF      CLSXX       ROUTINE CLOSES M:XX DCB
         REF      DEBUGX1     ROUTINE  (BRANCH VECTOR ONLY)
         REF      DUMPER      ROUTINE TO ACTUALLY DO PMD DUMPS
         REF      FINDDO      ROUTINE FINDS M:DO DCB IF ANY.
         REF      IOSDEV      ROUTINE SKIPS TO NEW PAGE THRU DCB
         REF      IOSPIN      ROUTINE WAITS FOR FINISH OF DCB I/O
         REF      J:ASSIGN    BIT 1 OUTPUT = NO BUFCHK ON M:WRITE
*,*                           BIT 14 INPUT = PMD'S EXIST
         REF      J:CFLGS     BITS 0-15 OUTPUT SET TO FFFF AT START
*,*                                            SET TO 0000 AT EXIT
         REF      J:DLL       INPUT DOUBLEWORD PAGE# USER DATA
*,*                                 START & END.
         REF      J:JIT       BASE ADDRESS OF JIT
*,*                           BIT 0 INPUT =1 FOR ONLINE USER
*,*                           BITS 16-31 INPUT = USER ID (ID-D FILE)
         REF      J:PLL       INPUT PAGE# OF USER PROCEDURE START.
         REF      J:RNST      BITS 0-7 INPUT NONZERO IF ABORTED
*,*                                    TEMP SET =0 DURING DUMP
*,*                           BITS 10-14 INPUT WHO WAS RUNNING
*,*                                      OUTPUT SET =0
         REF      J:TREE      BITS 15-31 INPUT => USER TREE.
         REF      M:XX        OUTPUT USED TO READ ID-D FILE FOR PMD'S
         REF      MAPBUFS     ROUTINE MAPS DCB BUFF1/2.
         REF      MDEBUG      ROUTINE PROCESSES DEBUG CALS.
         REF      MSRRDWT     ROUTINE READS OR WRITES THRU DCB
         REF      OPNSEG      = # OF 'OPEN' MONITOR OVERLAY
         REF      S:CUN       INPUT = USER# OF CURRENT USER
         REF      SBUF1VPA    = ADDRESS OF TEMP PAGE BUFFER
         REF      T:GBUF      ROUTINE GETS TEMP BUFFER PAGE
         REF      T:RBUF      ROUTINE GIVES BACK TEMP BUFFER PAGE
         REF      TELLUSR     ROUTINE PRINTS REASON FOR JOBSTEP ABORT
         REF      UH:DL       BITS 0-3 OUTPUT ZEROED FOR DUMPER'S USE
         REF      YFF         MASK
         DEF      TREECHEK          CHECK SEGMENT TABLE
*
*        TRANSFER VECTOR FOR THE DEBUG ROUTINES
*        CONTAINED IN THE OVERLAY 'DEBUGSEG'
*
*        IN: R0 = INDEX TO THE PROPER ENTRY POINT
*
DEBUGTV  EQU      %
         PUSH     11
*------------------------*
         BLOCK
*------------------------*
         AI,0     TVEC
         B        *0              GO TO THE PROPER ROUTINE
TVEC     EQU      %             REG 0
         B        MDEBUG            0  (DEBUG CALS)
         B        DEBUGX1           1  (FIN OF LDR-BUILT M:SEGLD)
         B        PMDDP             2  (PMD DUMP @ JOB STEP TIME)
         PAGE
*                 SYMBOLIC REGISTER DEF'S.
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
R9       EQU      9
R10      EQU      10
R11      EQU      11
R12      EQU      12
R13      EQU      13
R14      EQU      14
R15      EQU      15
         PAGE
         BOUND    8
DODCB    GEN,8,24 22,3
         GEN,15,3,14  2,1,5         OUT,LIST,DO DEVICE
DCBPLACE EQU      X'1D0'            PLACE IN BUFFPAGE FOR DCB.
RNSTPLACE EQU     X'1FE'            PLACE IN BUFFPAGE TO SAVE J:RNST.
FLAGPLACE EQU     1                 PLACE IN BUFFPAGE FOR FLAGS.
FTPLACE  EQU      0                 PLACE IN BUFFPAGE FOR # FROM-TOS.
BUFPLACE EQU      X'1A0'            PLACE IN BUFFPAGE FOR PRINTBUFFER
FPTPLACE EQU      BUFPLACE+2        PLACE IN BUFFPAGE FOR FPTS.
TTESIZE  EQU      11
KBUF     EQU      10
         PAGE
*D*      NAME:    PMD
*D*      REGISTERS: ALL VOLATILE.
*D*      CALL:    OVERLAY  DEBUGSEG,2.
*D*      INTERFACE: (OPNSEG,0),(CLSSEG,0),MSRRDWT,IOSDEV,
*D*               T:GBUF,T:RBUF.
*D*      ENVIRONMENT: MASTER MAPPED.
*D*      DATA:    PMD GETS A SPECIAL BUFFER PAGE (SBUF1VPA).
*D*               WORD 0 OF THE PAGE IS A COUNT OF THE NUMBER OF
*D*               DUMP (FROM,TO) LIMIT DOUBLEWORDS WHICH PMD HAS
*D*               GOTTEN FROM THE ID-D FILE AND STORED IN WORDS
*D*               2-X'19F' OF THE PAGE. PMD PASSES THE ADDRESS OF
*D*               THE PAGE TO DUMPER TO DO THE ACTUAL DUMP.
*D*               WORD 1 OF THE PAGE IS SET NONZERO FOR 'PMDE'.
*D*               WORDS X'1A0'-X'1CF' OF THE PAGE ARE USED BY PMD
*D*               TO HOLD ITS FPT'S WHILE WORKING WITH THE ID-D FILE,
*D*               AND BY DUMPER AS A BUFFER FOR PRINTING THE DUMP.
*D*               WORDS X'1D0'-X'1FF' OF THE PAGE ARE USED TO BUILD
*D*               A DCB FOR DUMPING IF THERE IS NO M:DO DCB.
*D*
PMDDP    EQU      %
         LW,R6    L(X'00C1FFFF')      CLEAR RUN-STATUS BYTE AND
         AND,R6   J:RNST              WHO-IS-RUNNING BITS IN J:RNST.
         XW,R6    J:RNST            R6 = RUN STATUS FROM JOBSTEP.
         PUSH     R6                  SAVE OLD RUNSTATUS IN STACK.
         LI,R9    -1
         STH,R9   J:CFLGS             SET 'PMD-IS-RUNNING' FLAG.
         CW,R6    L(X'FF100000')      IF NORMAL EXIT & NOT USER,
         BAZ      MEXIT2A           --->DONT TELL OR PMD.
         LI,R14   SBUF1VPA
         BAL,R2   T:GBUF              GET SBUF1 PAGE FOR TEMP USES.
         AI,R10   0                   DID WE GET THE PAGE...
         BEZ      MEXIT2A           --->NO. CANT TELL OR PMD.
         LW,R0    L('1   ')
         LI,R1    BUFPLACE
         LW,R2    J:ASSIGN          GET FLAG BITS
         CW,R2    L(X'00060000')    ANY !PMD'S (OF ANY SORT)?
         BANZ     PMDVFC            IF SO, PAGE FEED BEFORE PRINTING
         LW,R0    L(C'C   ')        IF NOT, TRIPLE-SPACE
PMDVFC   STW,R0   *R14,R1           SAVE THE APPROPRIATE VFC CODE
         CW,R6    YFF
         BAZ      PMDDMP0           ---> SAY NOTHING IF NOT ABORTED.
         LC       J:JIT
         BCS,8    PMDDMP0           ---> SAY NOTHING IF ONLINE.
         AI,R14   BUFPLACE
         BAL,R0   TELLUSR             SAY HOW THE JOBSTEP ABORTED.
         AI,R14   -BUFPLACE
         LW,R6    *TSTACK           R6 = SAVED J:RNST.
PMDDMP0  PUSH     R14                 SAVE BUFFPAGE ADDR IN STACK.
         LW,2     S:CUN
         DISABLE
         LH,12    UH:DL,2           GET DO LIST HEAD
         AND,12   M12               SCRUB TO RESET FLAGS
         STH,12   UH:DL,2           STORE
         ENABLE
         LW,R7    R14                 GET PAGE ADDR IN INDEX REG.
         STW,R6   RNSTPLACE,R7        REMEMBER RNST IN PAGE.
         LI,R2    0
         STW,R2   FLAGPLACE,R7        REMEMBER 0 FOR PMDI/PMDE FLAG.
         STW,R2   FTPLACE,R7          REMEMBER 0 FOR # FROM-TOS.
         CW,R6    Y001                IF A USER ABORTED,
         BANZ     PMDDMP1           ---> LOOK FOR ID-D FILE.
         LI,R5    X'40000'
         CW,R5    J:ASSIGN            PROCESSOR ABORT. LOOK FOR PPMD.
         BAZ      PMDDMP27          --->NO. SHOW REGISTERS ONLY.
         LI,R3    1
         STD,R3   *R7               #FROMTO=1; PMDEFLAG=YES.
         LD,R8    J:DLL
         SLD,R8   +9                DO PMDE OF PROCESSOR DATA.
         AI,R9    X'1FF'
         STD,R8   *R7,R3
         B        PMDDMP27          ---> GO DO IT.
PMDDMP1  LI,R5    X'20000'
         CW,R5    J:ASSIGN            IF USER HAD NO PMDS,
         BAZ      PMDDMP27          ---> SHOW REGISTERS ONLY.
         BAL,R0   CLSXX               CLOSE M:XX IF OPEN.
         LW,R7    *TSTACK           R7 =>BUFFER PAGE.
         LCI      9
         LM,R8    ODBFPT              COPY FPT FOR M:OPEN OF ID-D
         STM,R8   FPTPLACE,R7         TO BUFFER PAGE.
         INT,R11  J:JIT
         SLS,R11  +8                  ADD JOB ID TO
         AWM,R11  FPTPLACE+7,R7       ID-D FILE NAME.
         LI,R6    M:XX              R6 =>DCB (M:XX).
         AI,R7    FPTPLACE+1        R7 =>FPT +1.
         LI,R8    X'14'             R8 = FPT CODE (M:OPEN).
         OVERLAY  OPNSEG,0            OPEN M:XX TO ID-D FILE.
         CI,R10   0                   IS IT OPEN...
         BNE      PMDDMP27          ---> NO. DUMP REGISTERS ONLY.
         LW,R2    J:PLL
         SLS,R2   +9                  TREE MUST BE AT J:PLL PAGE.
         CW,R2    J:TREE              IF IT ISN'T, MUST BE LDTRC
         BNE      PMDDMP24          ---> SO REL ID-D & DO REGS ONLY.
*
         BAL,R7   TREECHEK          CHECK OUT THE SEGMENT TABLE
         B        PMDDMP24          IF BAD, SKIP THE !PMD'S
         LW,R7    *TSTACK           R7 =>BUFFER PAGE.
         LCI      5
         LM,R8    RDBFPT              MOVE FPT FOR M:READ OF ID-D
         STM,R8   FPTPLACE,R7         TO BUFFER PAGE.
         AWM,R7   FPTPLACE+3,R7       FIX BUFFER ADDRESS IN FPT.
         AI,R7    FPTPLACE-1        R7 =>FPT.
PMDDMP4  EQU      %
         LI,R8    X'10'             R8 = FPT CODE (M:READ).
         LW,R11   Y4
         STS,R11  J:ASSIGN            SET NO-BUFFER-CHECK FLAG.
         BAL,R11  MSRRDWT             READ A RECORD FROM ID-D FILE.
         AI,R10   0                   DID WE GET ONE...
         BNEZ     PMDDMP24          --->NO. ALL DONE.
         LW,R2    KBUF,R6           R2 =>RECORD KEY.
         LW,R3    J:TREE
         AI,R3    +1                R3 =>TREE TABLE SEGMENT NAME.
         LW,R8    J:TREE
         AW,R8    *R8               R8 = END OF TREE TABLES.
PMDDMP5  LB,R1    *R2
         AI,R1    -1                R1 = KEYLEN-1 (SEGNAME LEN).
         CB,R1    *R3                 IS IT THIS SEGMENT...
         BNE      PMDDMP7           --->NO.
PMDDMP6  LB,R4    *R2,R1              POSSIBLY. CHECK IT
         CB,R4    *R3,R1              BYTE BY BYTE.
         BE       PMDDMP10          --->MIGHT BE THIS SEG.
PMDDMP7  AI,R3    TTESIZE             NOT THIS SEG; TRY NEXT.
         CW,R3    R8                  ANY MORE OVERLAYS...
         BGE      PMDDMP4           --->NO. READ NEXT RECORD.
         MTW,0    3,R3                YES. IS THIS ONE IN CORE...
         BGEZ     PMDDMP7           --->NO. TRY NEXT SEGMENT.
         B        PMDDMP5           --->YES. COMPARE W/ RECORD KEY.
PMDDMP10 BDR,R1   PMDDMP6           --->CHECK WHOLE SEGNAME FOR EQ.
         LW,R1    *TSTACK           R1 =>BUFFER PAGE.
         LW,R5    4,R7              R5 =>RECORD FROM ID-D FILE.
         LB,R3    *R5               R3 = RECORD TYPE.
         CI,R3    5                   IS THIS A PMDI...
         BNE      PMDDMP11          --->NO.
         LW,R9    Y8                  YES.
         STS,R9   FLAGPLACE,R1        SET PMDI FLAG.
         B        PMDDMP13          --->PROCESS PMDIS ALWAYS.
PMDDMP11 LW,R4    RNSTPLACE,R1      R4 = SAVED J:RNST.
         CW,R4    YFF                 WAS IT ABORT...
         BAZ      PMDDMP4           --->NO. SKIP NON-PMDIS.
         CI,R3    4                   IS THIS A PMDE...
         BNE      PMDDMP13          --->NO.
         STS,R3   FLAGPLACE,R1        YES. SET A PMDE-PRESENT FLAG.
PMDDMP13 LI,R2    4                   THERE ARE 4 PAIRS IN RECORD.
PMDDMP16 LW,R8    1,R5              R8 = LOLIMIT.
         LW,R9    2,R5              R9 = HILIMIT.
         AND,R8   M17                 DISCARD
         AND,R9   M17                 GARBAGE.
         CW,R8    R9
         BCR,7    PMDDMP19          --->LIMITS=0 MEANS NO DUMP.
         LW,R3    0,R1              R3 = # FROM-TOS SO FAR.
         AI,R3    1                   + 1 FOR THIS ONE.
         CI,R3    BUFPLACE/2          DO WE HAVE ALL WE CAN...
         BGE      PMDDMP19          --->YES; SKIP THIS ONE.
         STW,R3   0,R1                SAVE UPDATED COUNT.
         STD,R8   *R1,R3              SAVE LIMITS.
PMDDMP17 AI,R3    -1
         BEZ      PMDDMP19          --->ALL LIMITS COMPARED.
         CD,R8    *R1,R3              ARE LIMITS IN ORDER...
         BLE      PMDDMP19          --->YES.
         LD,R10   *R1,R3              NO.
         STD,R8   *R1,R3
         AI,R3    1
         STD,R10  *R1,R3
         AI,R3    -1
         B        PMDDMP17
PMDDMP19 AI,R5    2                   BUMP LIMITS POINTER.
         BDR,R2   PMDDMP16            DO 4 LIMITS.
         B        PMDDMP4           ---> ON TO NEXT RECORD.
PMDDMP24 EQU      %
         LI,R2    1                 **RELEASE
         BAL,R0   CLSXX+1           M:CLOSE M:XX (REL)
PMDDMP27 EQU      %
         BAL,R4   FINDDO              FIND M:DO. RETURN =0 IF NONE.
         BNEZ     PMDDMP28          --->R6 = M:DO DCB ADDRESS.
         LW,R6    *TSTACK             NO M:DO OR M:DO PREF.
         AI,R6    DCBPLACE          R6 => OUR DCB TO BE BUILT.
         LI,R5    21
         LI,R9    0
         STW,R9   *R6,R5              ZERO OUT OUR DCB.
         BDR,R5   %-1
         LD,R8    DODCB               THEN SET TO
         STD,R8   *R6                 (DEVICE,DO)
PMDDMP28 EQU      %
         LW,R1    *TSTACK
         LW,R2    RNSTPLACE,R1        GET SAVED J:RNST.
         CW,R2    YFF                 WAS IT AN M:EXIT...
         BANZ     PMDDMP29          --->NO. GO DO DUMPS.
         LW,R3    FLAGPLACE,R1
         BGEZ     PMDDMP30          --->M:EXIT W/ NO PMDI; NO DUMP.
         LI,R8    4                 R8 = M:DEVICE (PAGE) CODE.
         BAL,R0   MAPBUFS
         LI,R11   %+3
         REMEMBER
         B        IOSDEV
PMDDMP29 EQU      %
         LW,R1    *TSTACK
         LW,R7    FLAGPLACE,R1      R7 = PMDI/PMDE FLAG WORD.
         AND,R7   M31                 REMOVE PMDI FLAG.
         LW,R15   *TSTACK           R15=>PAGE OF FROM-TO LIMITS.
         LW,R14   *TSTACK
         AI,R14   BUFPLACE          R14=>BUFFER AREA FOR DUMP.
         LI,R10   TSTACK+20         R10=>USER R15 IN TSTACK.
         BAL,R11  DUMPER             GO DO PMD DUMPS.
         BAL,R11  IOSPIN             WAIT FOR I/O TO STOP ON M:DO.
         LW,R2    0,R6
         CW,R2    Y002              IF M:DO ISN'T OPEN,
         BAZ      PMDDMP30            DON'T CLOSE IT.
         AND,R2   M4
         CI,R2    3                 IF M:DO IS ASSIGNED TO (DEVICE),
         BE       PMDDMP30            DON'T BOTHER TO CLOSE IT.
         LW,R2    Y8
         LI,R3    2                 BUILD M:CLOSE (SAVE) FPT.
         LW,R7    *TSTACK           R7 =>BUFFER PAGE.
         LCI      2
         STM,R2   FPTPLACE,R7         PLACE FPT IN PAGE.
         AI,R7    FPTPLACE          R7 =>FPT IN PAGE.
         LI,R8    X'15'             R8 = M:CLOSE FPT CODE.
         OVERLAY  CLSSEG,0            CLOSE M:DO WITH SAVE.
PMDDMP30 EQU      %
         PULL     R14               RELEASE
         LI,R5    0                   (VIRTUAL AND PHYSICAL)
         BAL,R2   T:RBUF            THE BUFFER PAGE.
MEXIT2A  EQU      %
         LI,R8    0
         STH,R8   J:CFLGS           SHOW PMD NO LONGER RUNNING.
         PULL     R8
         STW,R8   J:RNST            RESTORE RUN STATUS.
         PULL     R11               RESTORE RETURN ADDRESS.
         DESTRUCT                   ---> EXIT PMD.
         PAGE
*D*      NAME:    TREECHEK
*D*      DESCRIPTION:  TREECHEK VALIDATES THE USER'S IN-CORE
*D*               SEGMENT TABLE - THE SIZE MUST BE A MULTIPLE
*D*               OF 11, PLUS 1;  THE TABLE MUST CONTAIN NO
*D*               MORE THAN 256 ENTRIES;  AND THE LENGTH OF EACH
*D*               SEGMENT NAME MUST BE 1-10 CHARACTERS.
*D*      REGISTERS: R7 LINK; R2, R3 DESTROYED.
*D*      CALL:    BAL,R7  TREECHEK
*D*      RETURNS: B 0,R7   IF THE TABLE IS MALFORMED.
*D*               B 1,R7   IF THE TABLE IS OK.
*D*
         SPACE    2
TREECHEK LW,R3    *J:TREE           GET TREE SIZE
         MI,R2    1                 MAKE IT A DOUBLEWORD
         DW,R2    L(TTESIZE)        DIVIDE BY SIZE OF EACH ENTRY
         CI,R2    1                 1 WORD LEFT OVER?
         BNE      0,R7              IF NOT CRY A LITTLE
         CI,R3    1
         BL       0,R7              IF NO TABLE AT ALL, FAIL
         CI,R3    256               TOO MANY SEGMENTS?
         BG       0,R7              IF SO, FAIL
         LW,R3    *J:TREE           GET LENGTH AGAIN
TREELOOP AI,R3    -TTESIZE          PULL POINTER BACK 1 ENTRY
         BLZ      1,R7              IF DONE, RETURN SUCCESSFULLY
         LW,R2    *J:TREE,R3        GET 1ST WORD OF SEG. NAME
         LB,R2    R2                GET LENGTH OF SEGNAME
         BE       0,R7              IF ZERO, FAIL
         CI,R2    10                IF LENGTH IS > 10 CHARS,
         BG       0,R7                  FAIL
         B        TREELOOP
         PAGE
ODBFPT   EQU      %                 M:OPEN  M:XX,(FILE,ID-D)
         DATA     0
         DATA     X'C1020001'        FILE
         PZE      %                 *ERR (NONZERO)
         PZE      %                 *ABN (NONZERO)
         DATA     1                 *IN
         DATA     0                 *BTD = 0
         DATA     X'01000101'       *FILENAME:
         DATA     X'030000C4'           (ID)-D
         DATA     X'02010000'       *ACCOUNT:  (CURRENT)
*
RDBFPT   EQU      %                 M:READ  M:XX
         DATA     X'F0000010'       *WAIT
         PZE      %                 *ERR (NONZERO)
         PZE      %                 *ABN (NONZERO)
         PZE      FPTPLACE+5        *BUF = (FOLLOWING FPT)
         DATA     36                *SIZE = 36 BYTES
         END      DEBUGTV

