*M* DUMP FORMATS AND PRINTS DUMPS FOR SNAPS AND PMDS.
         DEF      DUMP:             XDELTA LABEL FOR DUMP MODULE.
DUMP:    EQU      %
*P*
*P*      NAME:    DUMP
*P*
*P*      PURPOSE: TO FORMAT AND PRINT DUMPS FOR THE SNAP COMMAND AND
*P*               FOR POST-MORTEM DUMPS.
*P*
*P*  DESCRIPTION: DUMP USES A PREVIOUSLY-OBTAINED BUFFER PAGE WHICH
*P*               HAS BEEN SET UP TO INCLUDE A PUSHDOWN STACK (TO
*P*               CONSERVE TSTACK SPACE), A PRINT BUFFER, AND MAYBE
*P*               A DCB IF NO M:DO EXISTS.
*P*               IT IS PASSED A PAIR OR PAIRS OF CORE ADDRESSES,
*P*               AND PRINTS THE CONTENTS OF THE INCLUDED LOCATIONS
*P*               IN HEXADECIMAL AND EBCDIC.
*P*
MONPROC  SET      1
BITS     SET      1                 GET DEFINITIONS OF XN,YN,MN.
         SYSTEM   UTS
         PCC      0
         PAGE
         DEF      DUMPER      ENTRY FOR PMD (MULT FROM/TO + EXTRAS)
         DEF      DUMPW       ENTRY TO DUMP CONTENTS & ADDRESSES
         DEF      FINDDO      ENTRY TO FIND M:DO DCB ADDRESS.
         DEF      PRINTV      ENTRY TO PRINT N CHARACTERS
         DEF      REGPRNT     ENTRY TO PRINT USER'S REGISTERS
*
         REF      CFUSIZE     = SIZE OF A CFU IN WORDS
         REF      DOUBLEONE   CONSTANT
         REF      E:QE        EVENT TO REG USER
         REF      FPMC        = FLAG FOR NOT-THIS-USER'S PAGE IN MAP
         REF      HEX         EBCDIC OF '0' - 'F'.
         REF      TREECHEK          DUMP - CHECK TREE STATUS
         REF      J:ASSIGN    BIT 1 OUTPUT = NO BUFCHK ON M:WRITE
*,*                           BIT 14 INPUT = PMDS EXIST
         REF      J:DCBLINK   BITS 15-31 INPUT => USER DCB TABLE
         REF      J:DDLL      INPUT = PAGE# FIRST USER DYN PAGE
         REF      J:DDUL      INPUT = PAGE# LAST USER COMMON PAGE
         REF      J:JIT       BASE ADDRESS OF JIT
         REF      J:TREE      BITS 15-31 INPUT => USER TREE.
         REF      JBBCP       INPUT = PAGE# FIRST-1 USER COMMON PAGE
         REF      JBTDP       INPUT = PAGE# LAST+1 USER DYN PAGE
         REF      JX:CMAP     INPUT = USER PAGE MAP
         REF      MAPBUFS     ROUTINE MAPS DCB BLOCKING BUFFERS
         REF      MSRRDWT     ROUTINE READS OR WRITES THRU DCB
         REF      S:CUN       INPUT = USER# OF CURRENT USER
         REF      S:HIR       INPUT = HIGH-PRIO USER IN & WAITING
         REF      T:IACU      ROUTINE RETURNS PROT TYPE OF PAGE
         REF      T:REG       ROUTINE GIVES UP CONTROL TO SCHED
         REF      UH:DL       INPUT BITS 0-3 NONZERO MEAN QUIT
         REF      JB:PCW            SEE IF PLATEN WIDTH IS WIDE ENOUGH
*,*                                 FOR AN 8-COLUMN DUMP
         PAGE
*        REGISTER EQUATES
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
*D*      NAME:    DUMPER
*D*      REGISTERS: ALL BUT R6,R14,R15 DESTROYED.
*D*      CALL:    BAL,R11  DUMPER
*D*      INTERFACE: REGPRNT, DUMPW, T:IACU, MAPBUFS.
*D*      ENVIRONMENT: MASTER MAPPED.
*D*      INPUT:   R6=>DCB FOR PRINTING DUMP.
*D*               R7 = PMDE FLAG. NONZERO IF PMDE PRESENT.
*D*               R10=>USER'S R15 IN STACK.
*D*               R14=>BUFFER TO USE FOR PRINTING.
*D*               R15=>PAGE OF (FROM,TO) PAIRS OF LOCATIONS TO DUMP.
*D*                   WORD0= #PAIRS.  WORD1= UNUSED.
*D*      DESCRIPTION: DUMPER IS CALLED BY PMD TO ACTUALLY PERFORM
*D*               POST-MORTEM DUMPS OF REGISTERS AND MEMORY.
*D*               IF PMDE, IT DUMPS THE JIT.
*D*               IT SHOWS WHICH PROGRAM OVERLAYS WERE IN CORE.
*D*               IT DUMPS ALL USER DCBS.
*D*                  IF PMDE, IT DUMPS CFU & BLOCKING BUFFERS.
*D*               IT DUMPS CORE LOCATIONS SPECIFIED BY USER.
*D*               IT DUMPS ALL DYNAMIC PAGES, COMMON PAGES,
*D*                  AND VIRTUAL PAGES GOTTEN BY USER.
*D*
DUMPER   EQU      %
         LI,R12   X'130'
         AND,R12  0,R6                GET OLD VFC & BTD FROM M:DO.
         PUSH     2,R11               SAVE LINK & VFC/BTD.
         LI,R13   X'100'              SET M:DO TO VFC.
         STS,R13  0,R6
         BAL,R11  REGPRNT             DUMP THE PSD & REGISTERS.
         CW,R7    *R15                ANY PMDE OR FROM-TO TO DO...
         BCS,7    MAIN10            --->YES.
MAINEXIT PULL     2,R11             RESTORE LINK & OLD VFC/BTD.
         LI,R13   X'130'
         STS,R12  0,R6                RESTORE VFC & BTD TO M:DO.
         B        *R11              ---> RETURN TO CALLER.
         SPACE    3
*
*        IF EXTENDED, DUMP THE JOB INFORMATION TABLE.
*
MAIN10   PUSH     R7                  SAVE PMDE FLAG FIRST.
         AI,R7    0                   IS IT EXTENDED...
         BEZ      MAIN20            --->NO.
         LI,R1    JITMES              YES.
         BAL,R11  PRINTM              PRINT 'JIT' MESSAGE.
         LI,R8    J:JIT
         LI,R9    J:JIT+511
         BAL,R11  DUMPW
         SPACE    3
*
*        PRINT NAMES OF ALL OVERLAYS IN MEMORY.
*
MAIN20   EQU      %
         BAL,R7   TREECHEK          CHECK THE TREE
         B        %+2               BRANCH IF TREE BAD
         B        MAIN20A           BRANCH IF TREE'S OK
TREEBAD  LI,R1    TREEMUSH          GET 'BAD TREE' MESSAGE
         BAL,R7   PRINTM
         B        MAIN24
MAIN20A  EQU      %
         LW,R2    *J:TREE           GET TREE TABLE SIZE
         CI,R2    TTESIZE+1           IS PROGRAM OVERLAID...
         BLE      MAIN24            --->NO. DONT PRINT.
         LI,R1    SEGMES
         BAL,R11  PRINTM              PRINT 'SEGS IN CORE' MESSAGE.
         AW,R2    J:TREE            R2 =>END+1 OF TREE TABLES.
         LW,R1    J:TREE
         AI,R1    TTESIZE+1         R1 =>FIRST OVERLAY ENTRY IN TREE.
MAIN22   MTW,0    3,R1                IS THIS SEGMENT IN CORE...
         BGEZ     MAIN23            --->NO.
         BAL,R11  PRINTM              YES. PRINT ITS NAME.
MAIN23   AI,R1    TTESIZE             ON TO NEXT SEG.
         CW,R1    R2
         BL       MAIN22            ---> IF ANY.
         SPACE    2
*
*        DUMP ALL DCB'S.
*        IF EXTENDED, GIVE CFU, FPOOL, IPOOL.
*
MAIN24   EQU      %
         LW,R7    J:DCBLINK
         BEZ      MAIN30            --->NO DCBS; NO DCB DUMP.
         LI,R1    DCBMES
         BAL,R11  PRINTM
MAIN26   AI,R7    1                   INCREMENT TO DCB NAME.
         LB,R3    *R7                 GET DCB NAME LENGTH.
         BNEZ     MAIN27            --->GOT A DCB.
         LW,R7    0,R7                NO DCB; TRY FOR ANOTHER BLOCK.
         BNEZ     MAIN26            --->GOT A BLOCK; KEEP GOING.
         B        MAIN30            --->THAT'S ALL FOR DCBS.
MAIN27   LW,R1    R7                R1 =>DCB NAME FOR PRINTM.
         AI,R3    4
         SLS,R3   -2
         AW,R7    R3                R7 =>DCB ADDRESS.
         LW,R8    0,R7              R8 = ADDRESS OF DCB.
         BEZ      MAIN26            --->DCB IS PREF; SKIP IT.
         BAL,R11  PRINTM              PRINT DCB NAME (FROM R1.)
*
*        M:* DCB NEEDS SPECIAL TREATMENT FOR DUMPING
*
         LW,R9    MSTAR
         CW,R9    0,R1              IS THIS THE M:* DCB?
         BNE      MAIN271           NO, CALCULATE SIZE NORMALLY
*
         LW,R9    R8
         AI,R9    39                M:* IS 40 WORDS LONG
         BAL,R11  DUMPWNA           DUMP IN NORMAL FASHION
         B        MAIN26             AND PROCEED WITH NEXT DCB
*
*        CALCULATE THE SIZE OF THE DCB
*
MAIN271  EQU      %
         LW,R1    R8                PICK UP DCB POINTER IN INDEX REG
         LW,R9    KBUF,R1
         BEZ      MAIN272           NO KBUF
         AI,R9    7                 KBUF SIZE FOR UPPER LIMIT
         B        MAIN279
MAIN272  EQU      %
         LW,R9    FLP,R1            PICK UP VLP LIST POINTER
         BEZ      MAIN276
         LI,R1    1
MAIN274  EQU      %
         LI,R3    X'FF'
         AND,R3   *R9               PICK UP SIZE OF THIS VLP
         AI,R3    1
         CB,R1    *R9,R1            CHECK FOR LEI SET
         BE       MAIN278
         AW,R9    R3                POINT TO NEXT VLP
         B        MAIN274            AND CONTINUE
MAIN276  EQU      %
         LW,R9    R8                THERE IS NO FLP OR KBUF
         AI,R9    21                MINIMUM DCB SIZE IS 22 WORDS
         B        MAIN279
MAIN278  EQU      %
         AW,R9    R3                PICK UP THE WHOLE LAST ENTRY
         AI,R9    -1                (LESS 1 FOR NOT-THERE FORWARD LINK)
MAIN279  EQU      %
         SLS,R9   15                STRIP ANY GARBAGE AT FRONT
         SLS,R9   -15
         BAL,R11  DUMPWNA             DUMP DCB.
         MTW,0    *TSTACK             IS THIS PMDE...
         BEZ      MAIN26            --->NO.
         LW,R1    *R8                 GET DCB WORD0.
         CW,R1    Y002                IS IT OPEN...
         BAZ      MAIN26            --->NO. DONE WITH IT.
         AND,R1   M4                  GET DCB TYPE.
         CI,R1    3                   IS IT FILE OR LABELTAPE...
         BGE      MAIN26            --->NO. DONE WITH IT.
         PUSH     R8                  SAVE DCB ADDRESS.
         CI,1     2
         BE       MAIN28            TAPES DON'T HAVE CFU'S
         LI,1     CFUMES
         BAL,11   PRINTM
         AI,8     1
         LI,9     X'1FFFF'
         AND,9    *8
         LW,8     9
         AI,9     CFUSIZE-1
         BAL,R11  DUMPWNA             DUMP THE CFU.
MAIN28   PULL     R2                R2 = DCB ADDRESS.
         LI,R9    BUF1MSK+BUF2MSK
         AND,R9   BUFX,R2             ANY BUFFERS FOR THIS DCB...
         BEZ      MAIN26            --->NO. DONE WITH DCB.
         XW,R6    R2                R6 = DCBADDR; SAVE OLD R6.
         PUSH     5,R14               SAVE REGS.
         BAL,R0   MAPBUFS             MAP DCB'S BUFFERS.
         PULL     5,R14               RESTORE REGS.
         XW,R6    R2                R2 = DCBADDR; R6 RESTORED.
         LI,R9    BUF2MSK
         AND,R9   BUFX,R2             ANY BUF2 (IPOOL) FOR DCB...
         BEZ      MAIN29            --->NO.
         PUSH     R2                  SAVE DCB ADDRESS.
         LI,R1    IPOLMES
         BAL,R11  PRINTM              PRINT 'IPOOL' MESSAGE.
         LI,R8    BUFF2
         LI,R9    BUFF2+511
         BAL,R11  DUMPW
         PULL     R2
MAIN29   LI,R9    BUF1MSK
         AND,R9   BUFX,R2             ANY BUF1 (FPOOL) FOR DCB...
         BEZ      MAIN26            --->NO. DONE WITH DCB.
         LI,R1    FPOLMES
         BAL,R11  PRINTM              PRINT 'FPOOL' MESSAGE.
         LI,R8    BUFF1
         LI,R9    BUFF1+511
         BAL,R11  DUMPW
         B        MAIN26            --->NOW DONE WITH DCB.
         SPACE    3
*
*        DUMP MEMORY SPECIFIED BY USER.
*
MAIN30   PULL     R8                  CLEAR PMDE FLAG OUT OF STACK.
         MTW,0    *R15                ANY USER FROM-TO LIST...
         BEZ      MAINEXIT          --->NO.
         LI,R1    SPECMES
         BAL,R11  PRINTM              PRINT 'USER-SPECIFIED' MESSAGE.
MAIN31   EQU      %
         LW,R7    *R15                GET POINTER TO NEXT FROM-TO.
         LD,R8    *R15,R7           R8/R9= NEXT FROM-TO PAIR.
         LW,R7    R8
MAIN34   SLS,R7   -9                R7 = PAGE#(FROM).
         BAL,R11  T:IACU              CHECK ACCESS OF FROMPAGE.
         BCR,2    MAIN35            --->00/01 OKAY.
         BCS,1    MAIN36            --->11    BAD.
MAIN35   AI,R7    1                   FROM IN R8 OKAY; CHECK 'TO'.
         SLS,R7   +9
         CW,R7    R9                  ARE WE ALREADY TO 'TO'...
         BG       MAIN38            --->YES. GO DUMP IT.
         SLS,R7   -9
         BAL,R11  T:IACU              NO. CHECK ACCESS OF PAGE.
         BCR,2    MAIN35            --->00/01 OKAY; KEEP CHECKING.
         BCR,1    MAIN35            ---> 10   OKAY; KEEP CHECKING.
         SLS,R7   +9                  11 BAD, SO STOP HERE.
         AI,R7    -1                  THIS IS LAST GOOD ADDRESS.
         XW,R9    R7                R9 = NEW 'TO'; SAVE INPUT 'TO'.
         BAL,R11  DUMPW               DUMP WHAT WE GOT.
         XW,R7    R9                  NO. RESTORE R9=INPUT 'TO'.
         SLS,R7   -9                  CONVERT 'TO' TO PAGE ADDRESS.
MAIN36   AI,R7    1                   ADVANCE TO NEXT PAGE.
         SLS,R7   +9                R7 = NEW 'FROM' PAGE.
         LW,R8    R7                R8 = NEW 'FROM' PAGE.
         CW,R7    R9                  (IS THERE ANOTHER PAGE...)
         BLE      MAIN34            --->YES. TRY AGAIN.
         B        MAIN39            --->NO. QUIT.
MAIN38   BAL,R11  DUMPW               DUMP LAST PIECE OF FROM-TO.
MAIN39   MTW,-1   *R15                COUNT DOWN # OF FROM-TO PAIRS.
         BGZ      MAIN31            --->GO IF MORE TO DO.
         SPACE    3
*
*        DUMP DYNAMIC PAGES GOTTEN BY M:GP.
*
         LI,2     JBTDP                                                 UTS-F00

         LW,8     J:DDLL            GET PAGE NOS. OF LIMITS OF          UTS-F00

         LB,9     J:JIT,2           DYNAMIC DATA                        UTS-F00

         CW,9     8
         BLE      MAIN40            NO DYN PAGES
         SLD,8    9                 WORD
         AI,9     -1
         LI,1     DYNMES
         BAL,11   PRINTM
         BAL,11   DUMPW
         SPACE    3
*
*        DUMP COMMON PAGES GOTTEN BY M:GCP.
*
MAIN40   LI,R2    JBBCP
         LB,8     J:JIT,2           GET LIMITS OF COMMON DATA           UTS-F00

         LW,9     J:DDUL                                                UTS-F00

         CW,8     9
         BGE      MAIN50
         AD,8     DOUBLEONE
         SLD,8    9                 WORD
         AI,9     -1
         LI,1     CMNMES
         BAL,11   PRINTM
         BAL,11   DUMPW
         SPACE    3
*
*        DUMP VIRTUAL PAGES GOTTEN BY M:GVP.
*
MAIN50   LI,R2    JBTDP
         LB,R7    J:JIT,R2          R7 = LAST DYNAMIC PAGE +1.
         LI,R2    JBBCP
         LB,R10   J:JIT,R2          R10= FIRST COMMON PAGE -1.
         LI,R11   0                 R11= 0 MEANS TITLE NOT PRINTED.
MAIN60   CW,7     10
         BG       MAINEXIT          DONE
         LOAD,2   JX:CMAP,7               PHYSICAL PAGE NR.
         CI,2     FPMC              IS IT ALLOCATED
         BE       MAIN70            NO, SKIP IT
         CI,R11   0                 YES, IS MESSAGE PRINTED
         BNE      MAIN65            YES, SKIP IT
         LI,1     VPMES             NO, PRINT MESSAGE
         BAL,11   PRINTM
MAIN65   LW,8     7                 SET UP
         LW,9     7                 ARGS TO DUMP
         SLD,8    9
         AI,9     511               DUMP THE PAGE
         BAL,11   DUMPW
MAIN70   AI,7     1                 INCR INDEX
         B        MAIN60            & LOOK AT NEXT PAGE
         PAGE
*D*      NAME:    FINNDO
*D*      REGISTERS: R4,R5,R6,R12,R13 USED.
*D*      CALL:    BAL,R4  FINDDO
*D*      ENVIRONMENT: MASTER MAPPED.
*D*      INPUT:   R4= LINK REGISTER.
*D*               J:DCBLINK => USER DCB NAME TABLES.
*D*      OUTPUT:  R6=>M:DO DCB OR =0.
*D*               CC SET TO REFLECT R6.
*
FINDDO   EQU      %
         LI,R6    J:DCBLINK
FINDDO1  LW,R6    0,R6                NEW OR FIRST NAME TABLE.
         BEZ      0,R4              --->NO M:DO; QUIT.
         AI,R6    1                   BUMP TO NEXT DCBNAME.
FINDDO2  LB,R5    *R6
         BEZ      FINDDO1           --->NOT DCBNAME; MAY BE TABLE.
         CI,R5    4
         BNE      FINDDO3           --->NOT 4 CHAR; CANT BE M:DO.
         LCI      2
         LM,R12   0,R6                GET DCB NAME.
         SLD,R12  +8                  GET NAME IN ONE REG.
         CW,R12   L('M:DO')
         BNE      FINDDO3           --->NOT M:DO.
         LW,R6    2,R6              R6 = M:DO DCB ADDRESS.
         B        0,R4              --->RETURN TO CALLER.
FINDDO3  SLS,R5   -2
         AW,R6    R5                  INCR OVER DCBNAME (-1).
         AI,R6    2                   INCR OVER DCBNAME & ADDR.
         B        FINDDO2           --->KEEP LOOKING.
         PAGE
*D*      NAME:    DUMPW
*D*      ENTRY:   DUMPWO, DUMPWNA
*D*      REGISTERS: R6-R10,R14,R15 PRESERVED.
*D*      CALL:    BAL,R11  DUMP(W)(WO)(WNA)
*D*      INTERFACE: PRINT, T:REG.
*D*      ENVIRONMENT: MASTER MAPPED.
*D*      INPUT:   R6 =>DCB FOR PRINTING.
*D*               R8/R9= LIMITS OF CORE TO DUMP.
*D*               R14= WA(PRINT BUFFER)
*D*  DESCRIPTION: DUMP PRINTS A RANGE OF CORE MEMORY IN HEXADECIMAL
*D*               AND AS CHARACTERS.  DUMPWO PRINTS WITHOUT THE
*D*               ASSOCIATED ADDRESSES, DUMPW PRINTS THE ADDRESSES
*D*               AND STARTS EACH LINE AT A (ZERO MOD 8) WORD ADD-
*D*               RESS, AND DUMPWNA PRINTS ADDRESSES WITH NO
*D*               SPECIFIC ALIGNMENT.
*D*               WORDS ARE  DUMPED 8 PER LINE.
DUMPWO   LI,R1    0                 NO-ADDRESS FLAG.
         B        1D05
DUMPW    LI,R1    X'1FFF8'          ADDR 8-WORD-ALIGNED FLAG.
         B        1D05
DUMPWNA  LI,R1    X'1FFFF'          ADDR NOT ALIGNED FLAG.
1D05     AND,R8   M17               R8 = LOW LIMIT OF DUMP.
         AND,R9   M17               R9 = HIGH LIMIT OF DUMP.
         CW,R8    R9                  IS THERE ANYTHING TO DUMP...
         BG       *R11              --->NO. GET OUT.
         PUSH     6,R6                SAVE CALLER'S REGISTERS.
         PAGE
*
*        SET UP AN INTERNAL TABLE IN USER'S TSTACK THAT WILL
*        GOVERN THE FORMAT OF THE DUMP TO FOLLOW.  GENERALLY,
*        ONLINE DUMPS WILL BE 4 COLUMNS WIDE IF DIRECTED TO A
*        TERMINAL WITH A PLATEN WIDTH LESS THAN 132; OTHERWISE,
*        THE DUMP WILL BE THE STANDARD 8-COLUMN BATCH DUMP.
*
*        TABLE SET UP IN USER'S TSTACK:
*
*                 ************************************
*        WORD 1   * COLUMN INDEX (3 OR 7)            *
*                 ************************************
*        WORD 2   * DUPLICATE LINE COUNT  (12 OR 24) *
*                 ************************************
*        WORD 3   * NEGATIVE COLUMN COUNT (-4 OR -8) *
*                 ************************************
*        WORD 4   * BYTE TABLE WITH COLUMN LOCATIONS *
*         AND 5   * FOR EBCDIC PART OF SNAP DUMP     *
*                 ************************************
*
         LW,R5    TSTACK            SAVE CURRENT TOP OF STACK
         LC       J:JIT             IS THIS AN ONLINE GUY?
         BCR,8    DUMP10             NO, DO THE 8 COLUMN DUMP
         LI,R7    3                 COLUMN INDEX
         LI,R8    12                DUPLICATE WORD COUNT FOR SKIPPED LINES
         LI,R9    -4                NEGATIVE COLUMN COUNT
         LCI      2
         LM,R10   TEXTOX            4-COLUMN EBCDIC TABLE
*
         LI,R12   X'F'
         AND,R12  ASN,R6            PICK UP ASN OF DCB
         CI,R12   3                 IF NOT A DEVICE TYPE DCB,
         BNE      DUMP10             DO AN 8 COLUMN DUMP
         LI,R12   X'BF00'
         AND,R12  1,R6              PICK UP DEVICE TYPE
         CI,R12   X'9000'           COC DEVICE TYPE
         BNE      DUMP10             DO AN 8 COLUMN DUMP
         LI,R3    BA(JB:PCW)        CHECK FOR A WIDE PLATEN TERMINAL
         LB,R3    0,R3
         CI,R3    132
         BGE      DUMP10            132 OR GREATER => 8 COLUMN DUMP
         CI,R1    0
         BE       DUMP15            DON'T TINKER WITH ADDRESS MASK
         CI,R1    X'1FFFF'           IF SPECIFIED ON INPUT
         BE       DUMP15
         LI,R1    X'1FFFC'          4 COLUMN ADDRESS MASK FOR 'DUMPW' ENTRY
         B        DUMP15            PROCEED WITH 4 COLUMN DUMP
*
DUMP10   EQU      %
         LI,R7    7
         LI,R8    24
         LI,R9    -8
         LCI      2
         LM,R10   TEXTX             8-COLUMN EBCDIC TABLE
DUMP15   EQU      %
         PUSH     5,R7              PUT TABLE INTO USER'S STACK
         LCI      4
         LM,R8    -3,R5             PICK UP THE CLOBBERED REGISTERS
*                                    OUT OF TSTACK FROM PREVIOUS PUSH
         LW,R7    TSTACK
         AI,R7    -1                R7 <= EBCDIC LOCATION TABLE
         XW,R8    R9                  SWAP DUMP LIMITS .
         LW,R10   R1                R10= HOW-TO-DUMP FLAG.
         LI,R11   ' '               R11= CURRENT CARR.CONTROL CHAR.
*
BA@R14   EQU      %                   ((ANLZ THIS GIVES BA(R14).))
DUMP20   STB,R11  *R14                PUT CARR.CONTROL IN BUFFER.
         ANLZ,R1  BA@R14
         AW,R1    L(135**24+1)        CLEAR PRINT BUFFER
         MBS,R0   BA(Y4)              TO BLANKS.
         LW,R5    R10               R5 = HOW-TO-DUMP FLAG.
         BEZ      DUMP39            --->GO IF DUMP W/O ADDRESSES.
         LW,R3    S:CUN
         LH,R3    UH:DL,R3
         CI,R3    X'F000'
         BANZ     DUMP90            --->GO IF WE GOT ABORTED.
         MTW,0    S:HIR               SEE IF SHOULD PASS TO
         BLEZ     1D21              --->HIPRI WAITER; GO IF NO.
         PUSH     R6
         PUSH     R11
         LI,R6    E:QE              EVENT = QUANTUM END
         BAL,R11  T:REG             ALLOW SCHED TO SERVICE HI-PRI GUY.
         PULL     R11
         PULL     R6
1D21     AND,R5   R9
         SLS,R5   +12               R5 = ADDRESS OF DUMP.
         LI,R1    5                   SHOW 5 DIGITS OF ADDRESS,
         LI,R2    1                   STARTING AT BUFFER BYTE 1.
1D22     LI,R4    0
         SLD,R4   4
         LB,R4    HEX,R4              CONVERT ADDRESS TO EBCDIC
         STB,R4   *R14,R2             AND PUT IN BUFFER.
         AI,R2    1
         BDR,R1   1D22
         CS,R9    R10                 DO WE START AT L.H. END OF LINE
         BE       1D30              --->YES.
         LW,R1    -3,R7             NO, GET COLUMN INDEX
         AND,R1   R9                R1 = # WORD SLOTS TO SKIP.
         B        DUMP40            --->GO PRINT PARTIAL LINE.
1D30     LW,R3    R9                R3 =>CURRENT DUMP WORD.
         LW,R5    0,R3                LOOK FOR WORDS ALIKE.
1D32     AI,R3    1
         CW,R5    0,R3
         BNE      1D34              --->FOUND FIRST MISMATCH.
         CW,R3    R8
         BLE      1D32              --->HAVENT HIT DUMP HIGH LIMIT.
1D34     SW,R3    R9                R3 = # WORDS ALIKE -1.
         CW,R3    -2,R7             DO WE HAVE 3 LINES ALIKE?
         BL       DUMP38            --->NO. DUMP NORMALLY.
         AND,R3   -1,R7             YES, GET #ALIKE MOD 1 LINE
         AW,R9    R3                  BUMP CURRENT-WORD POINTER.
         AW,R9    -1,R7
         LI,R1    2
         LCI      2
         LM,R2    THRU                PLACE 'THRU'
         STM,R2   *R14,R1             INTO PRINT BUFFER.
         LW,R5    R9
         AW,R5    -3,R7             COLUMN INDEX
         SLS,R5   +12               R5 = ADDR OF LAST ALIKE WORD.
         LI,R1    5                   SHOW 5 DIGITS OF ADDRESS,
         LI,R2    14                  STARTING AT BUFFER BYTE 14.
1D36     LI,R4    0
         SLD,R4   4
         LB,R4    HEX,R4              CONVERT ADDRESS TO EBCDIC
         STB,R4   *R14,R2             AND PUT IN BUFFER.
         AI,R2    1
         BDR,R1   1D36
         LI,R11   'A'               R11= CARR. CONTROL (DOUBLE SP.)
         STB,R11  *R14
         XW,R15   R2                R15= LENGTH OF PRINTLINE.
         BAL,R12  PRINTV              **MBP: 2,6,8,9,10,11,14
         LW,R15   R2                  RESTORE R15.
         ANLZ,R1  BA@R14
         AW,R1    L(136**24)          CLEAR PRINT BUFFER & CARR.CTL
         MBS,R0   BA(Y4)              TO BLANKS.
         B        DUMP39            --->NOW NORMALPRINT; FOUND NE.
*
DUMP38   LI,R11   ' '               R11= SINGLESPACE CARR.CONTROL.
DUMP39   LI,R1    0                 R1 = # WORD SLOTS TO SKIP.
DUMP40   EQU      %
         LB,R2    *R7,R1            R2 <= WHERE TO PUT EBCDIC DUMP
         AI,R2    -1
         LI,R0    '*'                 PUT ASTERISK JUST BEFORE EBCDIC
         STB,R0   *R14,R2             OF FIRST WORD IN LINE.
1D50     LB,R2    HEXX,R1           R2 = WHERE TO PUT HEX DUMP.
         LW,R5    *R9               R5 = WORD TO DUMP.
         LI,R3    8                   DO 8 DIGITS OF WORD.
1D53     LI,R4    0
         SLD,R4   4
         LB,R4    HEX,R4              CONVERT WORD TO 8 EBCDIC-OF-HEX
         STB,R4   *R14,R2             AND PUT INTO PRINT BUFFER.
         AI,R2    1
         BDR,R3   1D53
         AI,R9    1                 R9 INCREMENTS TO NEXT WORD.
         LB,R2    *R7,R1            R2 <= WHERE TO PUT EBCDIC DUMP
         LI,R3    -4                  DO WORD AS 4 TEXT CHAR.
1D56     LB,R5    *R9,R3
         LB,R5    CNVT,R5             CONVERT UNPRINTABLES TO '.'
         STB,R5   *R14,R2
         AI,R2    1
         BIR,R3   1D56
         CW,R9    R8                  HAVE WE HIT DUMP UPPER LIMIT...
         BG       1D60              --->YES; ALL DONE WITH LINE.
         AI,R1    1                   NO.
         CW,R1    -3,R7             ARE WE AT R.H. END OF LINE?
         BLE      1D50              --->NO. DO MORE WORDS.
1D60     STB,R0   *R14,R2             PUT ASTERISK @ R.H. END TEXT.
         AI,R2    1                 R2 = TOTAL LENGTH TO PRINT.
         XW,R15   R2                R15= LENGTH OF PRINTLINE.
         BAL,R12  PRINTV              **MBP: 2,6,8,9,10,11,14
         LW,R15   R2                  RESTORE R15.
         CW,R9    R8                  HAVE WE HIT DUMP UPPER LIMIT...
         BLE      DUMP20            --->NO. DO MORE DUMPING.
DUMP90   EQU      %
         BUMP     -5,R7             CLEAR FORMAT TABLES FROM STACK
         PULL     6,R6              RESTORE CALLING REGISTERS
         B        *R11              --->AND RETURN TO CALLER.
*
HEXX     GEN,8,8,8,8,8,8,8,8 010,020,030,040,052,062,072,082
TEXTX    GEN,8,8,8,8,8,8,8,8 095,099,103,107,111,115,119,123
TEXTOX   GEN,8,8,8,8,8,8,8,8        53,57,61,65,111,115,119,123
THRU     TEXT     'THRU    '
CNVT     TEXT     '................................',;
                  '................................',;
                  ' ...........<(+|&..........%*);.',;
                  '-/.........,%.>...........:#@''=.'
         TEXT     '................................',;
                  '................................',;
                  '.ABCDEFGHI.......JKLMNOPQR......',;
                  '..STUVWXYZ......0123456789......'
MSTAR    TEXTC    'M:*'
         PAGE
*D*      NAME:    REGPRNT
*D*      REGISTERS:  R6,R7,R10,R14,R15 PRESERVED.
*D*      CALL:    BAL,R11  REGPRNT.
*D*      INTERFACE: MSRRDWT.
*D*      ENVIRONMENT: MASTER MAPPED.
*D*      INPUT:   R6=> DCB FOR PRINTING.
*D*               R10=>USER'S R15 IN TSTACK.
*D*               R11= LINK.
*D*               R14= ADDRESS OF PRINT BUFFER.
*D*DESCRIPTION: REGPRNT PRINTS THE UER'S PSD AND REGISTERS IN
*D*               HEX AND AS CHARACTERS, WITH TITLES. THIS IS THE
*D*               START OF A SNAP OR POST-MORTEM DUMP.
*
REGPRNT  EQU      %
         PUSH     R11                 SAVE RETURN.
         LI,R1    PSDMES
         BAL,R11  PRINTM              PRINT 'PSD' MESSAGE.
         LW,R9    R10
         AI,R9    -17
         OR,R9    X1                R9 =>USER PSW1.
         LW,R8    R9
         AI,R8    -1                R8 =>USER PSW0.
         BAL,R11  DUMPWO              PRINT PSD.
         LI,R1    REGMES
         BAL,R11  PRINTM              PRINT 'REGISTERS' MESSAGE.
         LW,R8    R10
         AI,R8    -15               R8 =>USER R0.
         LW,R9    R10               R9 =>USER R15.
         BAL,R11  DUMPWO              PRINT REGISTERS.
         PULL     R11                 RESTORE RETURN.
         B        *R11              --->RETURN TO CALLER.
         PAGE
*
*        PRINTM - PRINT MESSAGE.
*        IN: R1->TEXTC MESSAGE;  R11=LINK;  R6->DCB,R14->BUF.
*        NONE ZAPPED.  MESSAGE DOUBLE SPACED.
*
PRINTM   EQU      %
         PUSH     5,R12
BA@R1    LB,R15   *R1               R15= MESSAGE SIZE.
         AI,R15   1                     + 1 FOR VFC CHARACTER.
         CI,R15   34*4                WILL MESSAGE FIT IN AN MPOOL...
         BLE      %+2               --->YES.
         LI,R15   34*4                NO. TRUNCATE IT.
         ANLZ,R12 BA@R1               SOURCE = MESSAGE.
         ANLZ,R13 BA@R14              DEST = BUFFER.
         STB,R15  R13
         MBS,R12  0                   MOVE MESSAGE TO BUFFER.
         LI,R0    'A'                 DOUBLE SPACE
         STB,R0   *R14                THE MESSAGE.
         BAL,R12  PRINTV              PRINT THE MESSAGE.
         PULL     5,R12
         B        *R11
         PAGE
*D*      NAME:    PRINTV
*D*      REGISTERS: R0,R13 DESTROYED.
*D*      CALL:    BAL,R12           PRINTV
*D*      INTERFACE: MSRRDWT.
*D*      ENVIRONMENT: MASTER MAPPED.
*D*      INPUT:   R6 =>DCB FOR PRINTING.
*D*               R12= LINK.
*D*               R14=>BUFFER TO PRINT.
*D*               R15= MESSAGE LENGTH.
*D*      DESCRIPTION: PRINTV PRINTS THE MESSAGE USING THE DCB.
*D*
PRINTV   LW,13    =X'34000000'
         LI,0     0                 BTD
         PUSH     16,1
         LW,7     TSTACK
         AI,7     -4                POINTS TO FPT -1
         LI,R8    X'11'             R8 = FPT CODE (M:WRITE).
         LW,R11   Y4
         STS,R11  J:ASSIGN            SET NO-BUFFER-CHECK FLAG.
         BAL,R11  MSRRDWT             GO PRINT THE MESSAGE.
         PULL     16,1
         B        *12
         PAGE
TTESIZE  EQU      11
PSDMES   TEXTC    'USER''S PROGRAM STATUS DOUBLE WORD.'
REGMES   TEXTC    'USER''S GENERAL REGISTERS.'
JITMES   TEXTC    'CURRENT JOB INFORMATION TABLE (JIT).'
SEGMES   TEXTC    'THE FOLLOWING SEGMENTS ARE PRESENTLY IN CORE.'
TREEMUSH TEXTC    '**** SEGMENT TABLE INVALID OR MISSING - ',;
                  '!PMD, !PMDI, !PMDE REQUESTS BYPASSED ****'
DCBMES   TEXTC    'ALL USER DCB''S FOLLOW.'
CFUMES   TEXTC    'SYSTEM CFU FOR ABOVE DCB.'
IPOLMES  TEXTC    'SYSTEM INDEX BUFFER FOR ABOVE DCB.'
FPOLMES  TEXTC    'SYSTEM BLOCKING BUFFER FOR ABOVE DCB.'
SPECMES  TEXTC    'USER SPECIFIED DUMP LIMITS FOLLOW.'
DYNMES   TEXTC    'USER''S DYNAMIC PAGES FOLLOW.'
CMNMES   TEXTC    'USER''S COMMON DYNAMIC PAGES FOLLOW.'
VPMES    TEXTC    'USER''S VIRTUAL PAGES FOLLOW.'
         END

