//DISPLAY JOB (JOB),
//             'INSTALL DISPLAY',
//             CLASS=A,
//             MSGCLASS=A,
//             MSGLEVEL=(1,1),
//             USER=IBMUSER,
//             PASSWORD=SYS1
//BUILD  EXEC ASMFCL,PARM.ASM='OBJECT,NODECK,XREF',
//             MAC1='SYS1.MACLIB',MAC2='SYS1.AMODGEN'
//*                                          
//ASM.SYSIN DD DATA,DLM=@@ 
         TITLE ' D I S P L A Y   ( M V S )  '
************************************************************
*                                                          *
*        'DISPLAY' TSO COMMAND                             *
*                                                          *
************************************************************
         SPACE
*        DATE UPDATED. SEPTEMBER 21 1981.
*        ATTRIBUTES. RE-ENTRANT.
*        NOTES.
*            THIS TSO COMMAND DISPLAYS INFORMATION FOR
*            SYSTEMS SUPPORT SUCH AS UCB'S, VIRTUAL
*            ADDRESSES, LPA DIRECTORY ENTRIES, SVC'S,
*            AND ENTRIES IN THE BLDL LIST.
*            (THE BLDL ROUTINE DEPENDS ON A CODED OFFSET).
*            UPDATES...
*            28AUG80 - ADDED DEVICE TYPE IN DASD VOLUME DISPLAY.
*                      ADDED FIELD W5STYPE.
*            29OCT80 - CHANGED BLDL OFFSET TO '58' (WAS 4C).
*                      ADDED SVCTABLE LOCATION TO SVC DISPLAY.
*            21SEP81 - ADDED 'SHARED' TO DASD DISPLAY.
         SPACE
         MACRO
&NAME    CONV  &IN,&OUT,&LEN
         LCLC  &L
&L       SETC  'L'''
&NAME    LA    R1,&IN
         AIF   (T'&LEN EQ 'O').DEFLEN
         LA    R14,&LEN
         AGO   .OUTLOC
.DEFLEN  LA    R14,&L&OUT
.OUTLOC  LA    R15,&OUT
         BAL   R2,CONVERTB
         MEND
         SPACE 2
         MACRO
&NAME    ACON  &IN,&OUT,&OFFSET=2
         AIF   ('&IN'(1,1) EQ '(').XREG
&NAME    UNPK  WCONDATA,&IN
         AGO   .XGEN
.XREG    ANOP
&NAME    ST    &IN(1),WDOUBLE
         UNPK  WCONDATA,WDOUBLE(5)
.XGEN    TR    WCONDATA(8),TRANS1
         AIF   (T'&OFFSET EQ 'O').XMOVE
         MVC   &OUT,WCONDATA+&OFFSET
         MEXIT
.XMOVE   MVC   &OUT,WCONDATA
         MEND
         SPACE 2
         MACRO
&NAME    FCON  &IN,&OUT
&NAME    ACON  &IN,&OUT,OFFSET=
         MEND
         SPACE 2
         MACRO
&NAME    LINE2
&NAME    MVC   WLINE2,XBLANKS           BLANK HEADER LINE #2
         MVC   WLINE2(4),=Y(L'WLINE2,0) MSG HEADER
         MVI   WLINE2+5,C'*'            SET-UP HEADER LINE
         MVI   WLINE2+14,C'*'
         MEND
         SPACE 2
         MACRO
         TRANS &O,&M
         ORG   TRANS3+&O
         DC    &M.AL1(*-TRANS3)
         MEND
         EJECT
         MACRO
&NAME    ZCHK  &R,&L,&B,&BC=Z
&NAME    L     &R,&L
         LA    &R,0(&R)
         LTR   &R,&R
         B&BC  &B
         MEND
         SPACE 2
         MACRO
&NAME    PCHK  &R,&L,&B
&NAME    ZCHK  &R,&L,&B,BC=P
         MEND
         SPACE 2
         MACRO
&NAME    EDST  &V,&F
&NAME    L     R0,&V
         CVD   R0,WDOUBLE
         MVC   &F,XPAT1
         ED    &F,WDOUBLE+5
         MEND
         SPACE 2
         MACRO
&NAME    EDR   &R,&F
&NAME    CVD   &R,WDOUBLE
         MVC   &F,XPAT1
         ED    &F,WDOUBLE+5
         MEND
         EJECT
DISPLAY  CSECT
         USING *,R11,R12
         B     32(,R15)
         DC    AL1(7),CL7'DISPLAY'
         DC    CL4' 3.0'
         DC    CL16' &SYSDATE &SYSTIME '
         STM   14,12,12(R13)
         LR    R11,R15
         LA    R14,1
         LA    R12,4095(R14,R11)
         LR    R10,R1
         USING CPPL,R10
         GETMAIN R,LV=WORKLEN
         XC    0(256,R1),0(R1)
         MVC   256(WORKLEN-256,R1),0(R1)
         ST    R13,4(,R1)
         ST    R1,8(,R13)
         LR    R13,R1
         USING WORKAREA,R13
         SPACE
************************************************************
*                                                          *
*        SET UP IOPL FOR PUTLINE                           *
*                                                          *
************************************************************
         SPACE
         LA    R15,WIOPL
         USING IOPL,R15
         MVC   IOPLUPT(4),CPPLUPT
         MVC   IOPLECT(4),CPPLECT
         LA    R0,WECB
         ST    R0,IOPLECB
         XC    WECB,WECB
         LA    R0,WPTPB
         ST    R0,IOPLIOPB
         XC    WPTPB(12),WPTPB
         DROP  R15                 IOPL
         EJECT
************************************************************
*                                                          *
*        SET UP PPL FOR PARSE                              *
*                                                          *
************************************************************
         SPACE
         LA    R15,WPPL
         USING PPL,R15
         MVC   PPLUPT(4),CPPLUPT
         MVC   PPLECT(4),CPPLECT
         LA    R0,WECB
         ST    R0,PPLECB
         XC    WECB,WECB
         L     R0,=A(DISPPCL)
         ST    R0,PPLPCL
         LA    R0,WANS
         ST    R0,PPLANS
         MVC   PPLCBUF(4),CPPLCBUF
         XC    PPLUWA(4),PPLUWA
         DROP  R15                 PPL
         SPACE 1
         DROP  R10                 CPPL
         SPACE
         MVI   WSW,0                    CLEAR SWITCH
         MVI   WLINEB,C' '              CLEAR PRINT LINE
         MVC   WLINED,WLINEB
         MVC   WFILLER,XBLANKS          SET DEFAULT FILLER
*
         LA    R0,WDBLKLEN              PUTLINE DATA BLOCK LENGTH
         GETMAIN R,LV=(0)               GET THE BLOCK
         ST    R1,WDBLK                 SAVE START
         LR    R3,R1                    ALSO PLACE IN WORK REGISTER
         LA    R4,WDBLKENT              LINE LENGTH
         LR    R5,R3                    DATA START
         AL    R5,=A(WDBLKLEN-1)        + LENGTH - 1 = END
         STM   R3,R5,WDBLKA             SAVE CONTROL REGISTERS
         LR    R2,R3                    DATA START
         LA    R3,0(R3,R4)              LINE # 2
INDBLK   ST    R3,0(R2)                 CONNECT DATA LINES
         LR    R2,R3                    CURRENT LINE
         BXLE  R3,R4,INDBLK             GET NEXT LINE
         XC    0(4,R2),0(R2)            LAST LINE
*
*        GET ADDRESS OF PUTLINE INTO WPUTL
*
         L     R15,CVTPTR               CVTPTR
         TM    444(R15),X'80'           IS PUTLINE LOADED?
         BNO   LOADPUTL                 NO - BRANCH
         L     R0,444(,R15)             YES - GET CVTPUTL
         B     SAVEPUTL                 BRANCH AROUND LOAD
LOADPUTL EQU   *
         LOAD  EPLOC=LPUTL              LOAD PUTLINE
SAVEPUTL ST    R0,WPUTL                 SAVE ENTRY POINT
         SPACE 1
************************************************************
*                                                          *
*        CALL THE PARSE SERVICE ROUTINE                    *
*                                                          *
************************************************************
         SPACE 1
         XC    WECB,WECB                CLEAR ECB
         LA    R1,WPPL             POINT TO PPL
         L     R15,CVTPTR          CVTPTR
         TM    524(R15),X'80'      IF HI ORDER BIT NOT ON
         BNO   PARSELNK               THEN DO LINK, NOT CALL
         L     R15,524(,R15)       CVTPARS
         BALR  R14,R15             CALL IKJPARS
         B     PARSEEXT            SKIP AROUND LINK
PARSELNK EQU   *
         LINK  SF=(E,LPARSE),MF=(E,(1))
PARSEEXT EQU   *
         SPACE 1
         LTR   R15,R15                  SUCCESS?
         BNZ   ERRPARSE                 NO, ERROR
         L     R10,WANS                 YES, GET RESULT
         USING IKJPARMD,R10
         EJECT
************************************************************
*                                                          *
*        'TCBADDR(TASKNAME)' SPECIFIED                     *
*                                                          *
************************************************************
         SPACE
TCBCHK   CLI   PTYPE+1,1                TCB ADDRESS?
         BNE   QCBCHK                   NO, CHECK FOR QCB REQUEST
         B     RETURN
*          LA    R9,PDTCBA                YES, SET FOR FIRST PDE
*          MVC   WLINEH,=Y(W1LEN+4,0)     SET MSG HEADER
* TCBPDE   BAL   R2,PDESCAN               GET NEXT PDE
*          B     RETURN                   THAT'S ALL
*          MVC   W1NAME,WNAME             SAVE TASK NAME
*          BAL   R2,TCBSCAN               GET TCB ADDRESS
*          B     TCBMISS                  INVALID NAME
*          LR    R8,R15                   SAVE TCB ADDRESS
*          B     TCBAFND                  PROCESS IT
* TCBMISS  MVC   W1ADDR,XBLANKS           BLANK OUT ADDRESS
*          MVI   W1ADDR+2,C'?'
*          B     TCBALIST                 GO LIST IT
*          USING TCB,R8
* TCBAFND  ZCHK  R15,TCBLTC,TCBAFNDA      GET SUBTASK
*          LR    R8,R15                   RESET TCB ADDRESS
*          B     TCBAFND                  CONTINUE
* TCBAFNDA L     R8,TCBJSTCB              NO, GET JOB STEP TCB
*          ACON  (R8),W1ADDR              CONVERT TCB ADDRESS
* TCBALIST BAL   R2,MSGSTD                WRITE IT OUT
* TCBANEXT B     TCBPDE                   GET NEXT TASK
*          SPACE 2
*          DROP  R8
         EJECT
************************************************************
*                                                          *
*        'QCBS(TASKNAME)' SPECIFIED                        *
*                                                          *
************************************************************
         SPACE
QCBCHK   CLI   PTYPE+1,2                QCB REQUEST?
         BNE   LPACHECK                 NO, TRY LINKPACK SEARCH
         MVC   WLINEH,=Y(W2LEN+4,0)     YES, SET MSG HEADER
         MVC   WLINED,WLINEB            CLEAR PRINT LINE
         LINE2
         L     R15,CVTPTR               CVT
         USING CVT,R15
         L     R0,CVTFQCB               GET QCB ORIGIN
         ST    R0,WQCBORG               SAVE IT
         DROP  R15
         LA    R9,PDTCBA                SET FIRST PDE
QCBNMCHK BAL   R2,PDESCAN               GET NEXT PDE
         B     RETURN                   THAT'S ALL
         MVC   WLINE2+6(8),WNAME        SET NAME IN HEADER
         LA    R0,WLINE2
         BAL   R2,MSGDATA               WRITE OUT HEADER
         L     R8,WQCBORG               FIRST QCB
QCBMAJOR LTR   R8,R8                    ANYMORE MAJORS?
         BNP   QCBNEXT                  NO, GET NEXT SEARCH NAME
         MVC   W2QNAME,16(R8)  (MVS)    YES, SET MAJOR NAME
         CLC   16(8,R8),=CL8'SYSDSN'    IS IT DSNAME QUEUE?
         BE    QCBMAJOK                 YES - BRANCH
         CLC   16(8,R8),=CL8'SYSZOPEN'  IS IT OPEN QUEUE?
         BE    QCBMAJOK                 YES - BRANCH
         CLC   16(8,R8),=CL8'SYSIKJUA'  IS IT TSO USERID QUEUE?
         BE    QCBMAJOK                 YES - BRANCH
         B     QCBMAJLP                 NO - GET NEXT MAJOR
QCBMAJOK EQU   *
         L     R7,8(R8)                 FIRST MINOR QCB
QCBMINOR LTR   R7,R7                    ANYTHING?
         BNP   QCBMAJLP                 NO, GET ANOTHER MAJOR QCB
         L     R6,8(R7)        (MVS)    YES, GET FIRST QEL
QCBQEL   LTR   R6,R6                    ANYMORE QEL'S?
         BNP   QCBMINLP                 NO, GET NEXT MINOR QCB
         TM    12(R6),X'80'    (MVS)    YES, SHR?
         BO    QCBTJCHK                 YES, ....
         OI    WSW,WSWAIT               NO, INDICATE ALL OTHERS WAITING
QCBTJCHK EQU   *
*
*        POINT R5 TO JOBNAME, USING ASID AT 14(R6)
*
         L     R1,CVTPTR
         L     R1,X'22C'(,R1)           ASVT
         LA    R1,X'210'(,R1)           FIRST ASVTENTY
         LH    R15,14(,R6)              QELASID
         BCTR  R15,0
         SLL   R15,2                    TIMES FOUR
         L     R1,0(R15,R1)             R1 POINTS TO ASCB
         L     R5,176(,R1)              ASCBJBNS
         LTR   R5,R5
         BNZ   *+8
         LA    R5,=CL8'STARTING'
         CLC   0(5,R5),=C'INIT '        INITIATED JOB?
         BNE   *+8                      NO - BRANCH
         L     R5,172(,R1)              ASCBJBNI
         LTR   R5,R5
         BNZ   *+8
         LA    R5,=CL8'STARTING'
         SPACE
QCBQELCK CLC   WNAME,0(R5)              DESIRED QEL?
         BE    QCBQELFD                 YES, LIST IT
         L     R6,0(R6)                 NO, GET NEXT QEL
         LA    R6,0(R6)                 CLEAR HI-ORDER BYTE
         B     QCBQEL                   KEEP LOOKING
QCBQELFD MVC   W2TYPE,=CL4'SHR'         ASSUME SHR
         TM    12(R6),X'80'    (MVS)    SHR?
         BO    QCBQELST                 YES, ...
         MVC   W2TYPE,=CL4'EXCL'        NO, SET EXCLUSIVE
         CL    R6,0(R7)                 IS THIS THE 1ST QEL?
         BE    QCBQELMC                 YES, CONTINUE
         B     QCBQELWT                 NO, ....
QCBQELST MVC   W2STAT,XBLANKS           BLANK WAITING FIELD
         TM    WSW,WSWAIT               WAITING?
         BZ    QCBQELMC                 NO, ....
QCBQELWT MVC   W2STAT,=C'WAIT'          INDICATE WAITING
         MVC   W2STAT,XBLANKS           NEGATE PREVIOUS INSTR
QCBQELMC MVC   W2SMC,XBLANKS            CLEAR STATUS FIELD
*        TM    0(R6),X'30'              MUST COMPLETE?
*        BZ    QCBQELRN                 NO, WRITE OUT LINE
*        MVC   W2SMC,=CL4'STEP'         YES, ASSUME STEP
*        TM    0(R6),X'10'              STEP?
*        BO    QCBQELRN                 YES, ...
*        MVC   W2SMC,=CL4'SYS'          NO, SYSTEM(SHOULD NEVER SEE IT)
QCBQELRN MVC   W2RNAME,XBLANKS          CLEAR OUT RNAME
         SLR   R15,R15                  CLEAR WORK REGISTER
         IC    R15,16(R7)               RNAME LENGTH
         LA    R0,L'W2RNAME             MAX ALLOWED
         CR    R15,R0                   ACCEPTABLE?
         BNH   *+6                      YES,
         LR    R15,R0                   NO, SET TO MAX
         BCTR  R15,0                    LENGTH - 1
         EX    R15,IMRNAME              MOVE RNAME TO PRINT LINE
         BAL   R2,MSGSTD                WRITE IT ALL OUT
         MVC   W2QNAME,XBLANKS          CLEAR MAJOR NAME
QCBMINLP NI    WSW,X'FF'-WSWAIT         TURN OFF WAIT BIT
         L     R7,0(R7)       (MVS)     NEXT MINOR QCB
         LA    R7,0(R7)
         B     QCBMINOR
QCBMAJLP L     R8,0(R8)                 NEXT MAJOR QCB
         LA    R8,0(R8)
         B     QCBMAJOR
QCBNEXT  B     QCBNMCHK                 GO GET NEXT PDE
         EJECT
************************************************************
*                                                          *
*        'LPA(MODULE)' SPECIFIED                           *
*                                                          *
************************************************************
         SPACE
LPACHECK CLI   PTYPE+1,3                LINKPACK SEARCH?
         BNE   UNITCHK                  NO, ....
         MVC   WLINEH,=Y(W3LEN+4,0)     YES, SET MSG HEADER
         MVC   WLINED,WLINEB            CLEAR MESSAGE LINE
         LA    R9,PDLPA                 FIRST PDE
LPALOOP  BAL   R2,PDESCAN               GO GET PDE
         B     RETURN                   THAT'S ALL
         MVC   W3NAME,WNAME             MOVE NAME TO PRINT LINE
         USING CDE,R15
*
*              CALL IEAVVMSR TO SEARCH LPA DIRECTORY
*
*                  REGS 0 AND 1 - CONTAIN NAME
*                  REG 3        - CVT
*                  REGS 7 8 9   - WORK REGS
*                  REG 14       - RETURN - BAD RETURN 4(14)
*                  REG 0        - POINTS TO LPDE AFTER GOOD RETURN
*
         LM    R0,R1,WNAME
         STM   R7,R9,WLPA
         L     R3,CVTPTR
         USING CVT,R3
         L     R15,CVTLPDSR
         DROP  R3
         BALR  R14,R15
         B     LPAFOUND
         B     LPANOTFO
LPAFOUND LM    R7,R9,WLPA
         LR    R15,R0
         B     LPALIST
LPANOTFO LM    R7,R9,WLPA
         MVI   W3CDE+3,C'?'             INDICATE NOT FOUND
         B     LPALISTA                 GO LIST IT
LPALIST  MVC   W3CDEL,=C'LPDE'
         ACON  (R15),W3CDE              CONVERT CDE ADDRESS
         MVC   W3EPL,=C'EP'
         ACON  CDENTPT(5),W3EP          CONVERT ENTRY POINT
         DROP  R15
LPALISTA BAL   R2,MSGSTD                LIST IT OUT
         MVC   WLINED,WLINEB            CLEAR OUTPUT LINE
         B     LPALOOP                  GO GET NEXT PDE
         EJECT
************************************************************
*                                                          *
*        'UNITS(CUU)' SPECIFIED                            *
*                                                          *
************************************************************
         SPACE
UNITCHK  CLI   PTYPE+1,4                UNITS SPECIFIED?
         BNE   VOLCHECK                 NO, CONTINUE
         MVC   WLINEH,=Y(W5LEN+4,0)     YES, SET MSG HEADER
         TM    PDUNIT+6,X'80'           SPECIFIC UNITS REQUESTED?
         BNO   VOLSETA                  NO, LIST ALL DASD UNITS
         L     R15,CVTPTR               YES, GET THE CVT
         USING CVT,R15
         L     R8,CVTILK2               UCB LOOK-UP TABLE
         DROP  R15                      CVT
         ST    R8,WUCBTBL               SAVE LOOK-UP TABLE ADDRESS
         OI    WSW,WSWRTJ               RIGHT JUSTIFY
         MVC   WFILLER,XC0              SET FILLER
         LA    R9,PDUNIT                SET FIRST PDE
UNITSCAN BAL   R2,PDESCAN               PROCESS PDE
         B     RETURN                   THAT'S ALL
         MVC   WLINED,WLINEB            CLEAR THE PRINT LINE
         MVC   W5UNIT,WNAME+5           SAVE UNIT NAME
         L     R8,WUCBTBL               UCB TABLE START
UNITSCNA LH    R7,0(R8)                 UCB ADDRESS
         LTR   R7,R7                    ANYTHING?
         BZ    UNITSCNB                 NO, EMPTY SLOT
         BM    UNITERR                  NO, THE END....
         USING UCB,R7
         CLC   W5UNIT,UCBNAME           CORRECT UNIT?
         BE    UNITFND                  YES, SET IT UP
UNITSCNB LA    R8,2(R8)                 NO, BUMP TABLE PTR
         B     UNITSCNA                 KEEP LOOKING
UNITFND  CLI   UCBTBYT3,UCB3TAPE        TAPE?
         BE    UNITVOL                  YES, SET SERIAL
         CLI   UCBTBYT3,UCB3DACC        NO, DIRECT ACCESS?
         BNE   UNITDATA                 NO, LIST IT OUT
UNITVOL  MVC   W5VOLSER,UCBVOLI         YES, SET VOLUME SERIAL
         OC    W5VOLSER,W5VOLSER        BINARY ZEROES?
         BNZ   *+10                     NO
         MVC   W5VOLSER,=CL6' '         YES - MAKE IT BLANKS
UNITDATA BAL   R2,UCBDATA               WRITE OUT NECESSARY DATA
         B     UNITLOOP                 KEEP ON....
UNITERR  MVI   W5UCB+2,C'?'             ERROR
         BAL   R2,MSGSTD                WRITE IT OUT
UNITLOOP B     UNITSCAN                 GET NEXT PDE
         DROP  R7                       UCB
         EJECT
************************************************************
*                                                          *
*        'VOLUMES(VOLSER)' SPECIFIED                       *
*                                                          *
************************************************************
         SPACE
VOLCHECK CLI   PTYPE+1,5                VOLUMES REQUESTED?
         BNE   BLDLCHK                  NO, ....
VOLSETA  MVC   WLINEH,=Y(W5LEN+4,0)     YES, SET MESSAGE HEADER
         L     R15,CVTPTR               CVT
         USING CVT,R15
         L     R8,CVTILK2               UCB ADDRESSES
         DROP  R15                      CVT
         BAL   R2,GETUCB                GET INITIAL UCB ADDRESS
         B     ERRUCB                   NOTHING??????
         S     R8,=F'2'                 BACKUP OFF TO FIRST DASD UCB
         ST    R8,WDASTART              SAVE IT
         TM    PDVOL+6,X'80'            VOLUMES SPECIFIED?
         BNO   UNITSET                  NO, LIST THEM ALL
         LA    R9,PDVOL                 YES, SET FIRST PDE
VOLCHKB  BAL   R2,PDESCAN               GO GET PDE
         B     RETURN                   THAT'S ALL
         MVC   W5VOLSER,WNAME           SET VOLUME SERIAL
         L     R8,WDASTART              START OF DASD UCBS
         BAL   R2,GETVOL                LOCATE PROPER UCB
         B     VOLERR                   NOTHING, INVALID SERIAL
         LR    R7,R15                   GET UCB ADDRESS
         USING UCB,R7
         MVC   W5UNIT,UCBNAME           SET UNIT ADDRESS
         BAL   R2,UCBDATA               CHECK FOR DATA REQUEST
         B     VOLCHKB                  GET NEXT PDE
         DROP  R7                       UCB
VOLERR   MVC   W5UNIT(9),XBLANKS        BLANK OUT MESSAGE
         MVI   W5UNIT+1,C'?'
         BAL   R2,MSGSTD                WRITE IT OUT
         B     VOLCHKB                  KEEP LOOKING
UNITSET  L     R8,WDASTART              INITIAL DASD UCB
UNITSETA BAL   R2,GETUCB                GET NEXT UCB
         B     RETURN                   THAT'S ALL
         MVC   WLINED,WLINEB            CLEAR OUTPUT LINE
         LR    R7,R15                   GET UCB ADDRESS
         USING UCB,R7
         MVC   W5VOLSER,UCBVOLI         VOLUME SERIAL
         MVC   W5UNIT,UCBNAME           UNIT NAME
         BAL   R2,UCBDATA               CHECK FOR DATA REQUEST
         B     UNITSETA                 KEEP LOOKING
         DROP  R7                       UCB
         EJECT
************************************************************
*                                                          *
*        'BLDL(MODULE)' SPECIFIED                          *
*                                                          *
************************************************************
         SPACE
BLDLCHK  CLI   PTYPE+1,6                SCAN RESIDENT BLDL LISTS?
         BNE   STORAGE                  NO, ....
         L     R15,CVTPTR               CVT
         USING CVT,R15
         L     R15,CVTPRLTV             TTR0 CONVERSION ROUTINE
         DROP  R15                      CVT
*
*        FOLLOWING ASSUMPTION IS HIGHLY DEPENDENT ON THE ASSEMBLY
*        OF BLDL(SVC 18).
*
         S     R15,=A(X'58')            BACK OFF TO ADDRESSES
*              R15   POINTS TO IEARESBL
*                    WHICH IS ALSO IEARESBS-4
         L     R0,0(R15)                RESIDENT LINKLIB LIST
         ST    R0,WBLDLINK
         L     R0,4(R15)                RESIDENT SVCLIB LIST
         ST    R0,WBLDSVC
         MVC   WLINEH,=Y(W6LEN+4,0)     SET MESSAGE HEADER
         LA    R9,PDLPA                 SET FIRST PDE
BLDLOOP  BAL   R2,PDESCAN               GO GET PDE
         B     RETURN                   THAT'S ALL
         MVC   W6NAME,WNAME             MOVE NAME TO PRINT LINE
         L     R15,WBLDLINK             SEARCH LINKLIB FIRST
         LTR   R15,R15                  ANY?
         BZ    BLDLS                    NO - BRANCH
         BAL   R2,BLDLSCAN              LOOK FOR IT
         B     BLDLIST                  GOT IT
BLDLS    L     R15,WBLDSVC              NOTHING, NOW TRY SVCLIB
         LTR   R15,R15                  ANY?
         BZ    BLDLQ                    NO - BRANCH
         BAL   R2,BLDLSCAN              GO LOOK FOR IT
         B     BLDLIST                  GOT IT THIS TIME
BLDLQ    MVI   W6ADDR+3,C'?'            SORRY, NOTHING....
         B     BLDLISTA
BLDLIST  ACON  (R3),W6ADDR              SET ENTRY POINT IN PRINT LINE
BLDLISTA BAL   R2,MSGSTD                LIST IT OUT
         MVC   WLINED,WLINEB            CLEAR OUTPUT LINE
BLDLNEXT B     BLDLOOP                  GO GET NEXT PDE
         EJECT
************************************************************
*                                                          *
*        'STORAGE(NAME)' SPECIFIED                         *
*                                                          *
************************************************************
         SPACE
STORAGE  CLI   PTYPE+1,7                STORAGE REQUEST SPECIFIED?
         BNE   SUBPOOLS                 NO, ....
         B     RETURN
*          MVC   WLINEH,=Y(W7LEN+4,0)     YES, SETUP PRINT LINE
*          TM    PDNAME+6,X'80'           WERE NAMES SPECIFIED?
*          BO    STORTASK                 YES, GO PROCESS THEM
*          L     R15,CVTPTR               NO, GET THE CVT ADDRESS
*          USING CVT,R15
*          L     R15,CVTABEND             SECONDARY CVT
* *        USING SCVT,R15
* *        L     R15,SCVTMSSQ             GOVRFLB
*          DROP  R15
*          L     R7,8(R15)                DUMMY PQE
*          LA    R2,RETURN                SET EXIT ADDRESS FOR RETURN
*          B     STORAGE2                 GO TO IT
*          SPACE 2
* STORTASK LINE2
*          LA    R9,PDNAME                INITIAL PDE
* STORNEXT BAL   R2,PDESCAN               CHECK IT OUT
*          B     RETURN                   THAT'S ALL
*          MVC   WLINE2+6(8),WNAME        TASK NAME IN HEADER
*          LA    R0,WLINE2                MSG LINE
*          BAL   R2,MSGDATA               LIST IT OUT
*          BAL   R2,TCBSCAN               LOCATE DESIRED TCB
*          B     STORNEXT                 NOTHING....
*          USING TCB,R15                  GOT IT
*          L     R7,TCBPQE                DUMMY PQE
*          DROP  R15
*          BAL   R2,STORAGE2              DO IT TO IT
*          B     STORNEXT                 GO GET THE NEXT NAME
*          SPACE 2
* STORAGE2 DS    0H
*          ST    R2,WSAVE1                SAVE LINKAGE REGISTER
*          SLR   R0,R0                    ZERO WORK REG & CLEAR STORAGE
*          ST    R0,WSTORCNT              ....
*          ST    R0,WSTORSUM              ....
*          ST    R0,WSTORMAX              ....
*          L     R7,8(R7)                 PQE
*          LA    R7,0(R7)                 CLEAR HI-ORDER BYTE
*          C     R7,0(R7)                 ANY FBQE'S?
*          BE    STORNONE                 NO, NOTHING....
*          L     R8,0(R7)                 YES, GET FIRST FBQE
* STORFBQE ACON  (R8),W7ADDR              LOCATION
*          L     R1,8(R8)                 SIZE
*          LA    R1,0(R1)
*          SRL   R1,10                    DIVIDE BY 1024
*          CVD   R1,WDOUBLE               TO DECIMAL
*          MVC   W7KB,XPAT1               PATTERN
*          ED    W7KB,WDOUBLE+5           MAKE IT PRINTABLE
*          MVI   W7K,C'K'                 PLACE "K" IN MESSAGE
*          C     R1,WSTORMAX              LARGEST SO FAR?
*          BNH   STORSUM                  NO, ...
*          ST    R1,WSTORMAX              YES, SET NEW MAXIMUM
* STORSUM  AL    R1,WSTORSUM              UPDATE TOTAL
*          ST    R1,WSTORSUM
*          L     R1,WSTORCNT              UPDATE FBQE COUNT
*          LA    R1,1(R1)
*          ST    R1,WSTORCNT
*          BAL   R2,MSGSTD                LIST IT
*          L     R8,0(R8)                 GET NEXT POSSIBLE FBQE
*          LA    R8,0(R8)
*          CLR   R8,R7                    IS IT THE PQE?
*          BNE   STORFBQE                 NO, PROCESS IT
* *                                       YES, CONSTRUCT TOTAL LINE
*          MVC   WLINED,WLINEB            CLEAR OUT PRINT LINE
*          MVC   W7SX,=C'SUM='            SUMMATION OF ALL AREAS
*          EDST  WSTORSUM,W7S
*          MVI   W7SK,C'K'
*          MVC   W7MX,=C'MAX='            LARGEST AREA
*          EDST  WSTORMAX,W7M
*          MVI   W7MK,C'K'
*          MVC   W7FX,=C'#FBQES='         NUMBER OF FBQE'S
*          EDST  WSTORCNT,W7F
*          BAL   R2,MSGSTD                WRITE IT OUT
*          MVC   WLINED,WLINEB            CLEAR OUT PRINT LINE
* *
*          B     STOR2END                 TERMINATE
* STORNONE LA    R0,MNOFREE               INDICATE NO FREE AREA
*          BAL   R2,MSGDATA
* STOR2END L     R2,WSAVE1                RESTORE LINKAGE REGISTER
*          BR    R2                       RETURN
         EJECT
************************************************************
*                                                          *
*        'SUBPOOLS(TASKNAME)' SPECIFIED                    *
*                                                          *
************************************************************
         SPACE
SUBPOOLS CLI   PTYPE+1,8                SUBPOOLS REQUESTED?
         BNE   SVCTABLE                 NO, ....
         B     RETURN
*          MVC   WLINEH,=Y(W8LEN+4,0)     YES, SET MSG HEADER
*          CLI   PDATA+1,1                DATA?
*          BE    SUBLIST                  YES, GIVE PARTICULARS
*          LA    R0,XSPTOT                NO, GIVE TOTALS HEADER
*          BAL   R2,MSGDATA               TITLE LINE
*          LA    R9,PDTCBA                INITIAL PDE
* SUBTPDE  BAL   R2,PDESCAN               CHECK IT OUT
*          B     RETURN                   THAT'S ALL
*          MVC   W8XTASK,WNAME            NAME TO LINE
*          BAL   R2,TCBSCAN               LOCATE DESIRED TCB
*          B     SUBTPDE                  NOTHING, TRY ANOTHER
*          USING TCB,R15
*          ZCHK  R1,TCBMSS,SUBTPDE        SPQE CHAIN PTR
*          ST    R1,WSPQE
*          DROP  R15
* SUBTSPQE XC    WDQECNT(24),WDQECNT      CLEAR COUNTERS
*          BAL   R2,SPQECHK               GET NEXT SPQE
*          B     SUBTPDE                  THAT'S ALL
*          SLR   R0,R0                    CLEAR WORK REGISTER
*          IC    R0,4(R8)                 SUBPOOL ID
*          CVD   R0,WDOUBLE               TO DECIMAL
*          OI    WDOUBLE+7,X'0F'          MAKE IT PRINTABLE
*          UNPK  W8XSPID,WDOUBLE          ....
*          LR    R7,R8                    DQE PTR - 4
* SUBTDQE  ZCHK  R7,4(R7),SUBTLIST        DQE
*          L     R1,12(R7)                SIZE
*          LA    R1,0(R1)
*          CL    R1,WDQEMAX               IS THIS ONE LARGER?
*          BNH   *+8                      NO, ...
*          ST    R1,WDQEMAX               YES, SET NEW MAX
*          AL    R1,WDQESUM               UPDATE TOTAL SIZE
*          ST    R1,WDQESUM
*          L     R1,WDQECNT               COUNT DQE'S
*          LA    R1,1(R1)
*          ST    R1,WDQECNT
*          LR    R6,R7                    SET FOR FQE'S
* SUBTFQE  ZCHK  R6,0(R6),SUBTDQE         FQE
*          L     R1,4(R6)                 SIZE
*          LA    R1,0(R1)
*          CL    R1,WFQEMAX               IS THIS ONE LARGER?
*          BNH   *+8                      NO, ...
*          ST    R1,WFQEMAX               YES, SET NEW MAX
*          AL    R1,WFQESUM               UPDATE TOTAL SIZE
*          ST    R1,WFQESUM
*          L     R1,WFQECNT               COUNT FQE'S
*          LA    R1,1(R1)
*          ST    R1,WFQECNT
*          B     SUBTFQE                  KEEP LOOKING
* SUBTLIST EDST  WDQECNT,W8XDQES          DQE COUNT
*          L     R0,WDQEMAX               DQE MAX BLOCK
*          SRL   R0,10                    /1024 = # 1K BLOCKS
*          EDR   R0,W8XDQMAX
*          MVI   W8XDQMAX+L'W8XDQMAX,C'K'
*          L     R0,WDQESUM               DQE TOTAL SIZE
*          SRL   R0,10                    /1024 = # 1K BLOCKS
*          EDR   R0,W8XDQSUM
*          MVI   W8XDQSUM+L'W8XDQSUM,C'K'
*          EDST  WFQECNT,W8XFQES          FQE COUNT
*          EDST  WFQEMAX,W8XFQMAX         FQE LARGEST BLOCK
*          EDST  WFQESUM,W8XFQSUM         FQE TOTAL SIZE
*          BAL   R2,MSGSTD                WRITE OUT LINE
*          MVC   W8XTASK,XBLANKS          CLEAR TASK NAME
*          B     SUBTSPQE                 GET NEXT SUBPOOL
*          SPACE 2
* SUBLIST  LINE2
*          LA    R0,MSPHDR
*          BAL   R2,MSGDATA               TITLE LINE
*          LA    R9,PDTCBA                INITIAL PDE
* SUBPDE   BAL   R2,PDESCAN               CHECK IT OUT
*          B     RETURN                   THAT'S ALL
*          MVC   WLINE2+6(8),WNAME        NAME TO HEADER
*          LA    R0,WLINE2
*          BAL   R2,MSGDATA               LIST TASK NAME
*          BAL   R2,TCBSCAN               LOCATE DESIRED TCB
*          B     SUBPDE                   NOTHING, TRY ANOTHER
*          USING TCB,R15
*          ZCHK  R1,TCBMSS,SUBPDE         SPQE CHAIN PTR
*          ST    R1,WSPQE
*          DROP  R15
* SUBSPQE  BAL   R2,SPQECHK               GET NEXT SPQE
*          B     SUBPDE                   THAT'S ALL
*          ACON  (R8),W8SPQE              SPQE ADDRESS
*          UNPK  WCONDATA(3),0(2,R8)      SPQE FLAGS
*          TR    WCONDATA(2),TRANS1
*          MVC   W8FLAGS,WCONDATA         MOVE TO PRINT LINE
*          SLR   R0,R0                    CLEAR WORK REGISTER
*          IC    R0,4(R8)                 SUBPOOL ID
*          CVD   R0,WDOUBLE               TO DECIMAL
*          OI    WDOUBLE+7,X'0F'          MAKE IT PRINTABLE
*          UNPK  W8SPID,WDOUBLE           ....
*          LR    R7,R8                    DQE PTR - 4
* SUBDQE   ZCHK  R7,4(R7),SUBSPQE         DQE
*          ACON  (R7),W8DQE               DQE ADDRESS
*          ACON  9(4,R7),W8BLK            BLOCK ADDRESS
*          ACON  13(4,R7),W8BLKLEN        BLOCK LENGTH
*          ZCHK  R1,12(R7),SUBLISTA       LIST NOW IF NO FQE
*          LR    R6,R7                    SET FOR FQE'S
* SUBFQE   ZCHK  R6,0(R6),SUBDQE          FQE
*          ACON  (R6),W8FQE               FQE ADDRESS
*          ACON  5(4,R6),W8FQELEN         FQE LENGTH
* SUBLISTA BAL   R2,MSGSTD                PRINT IT OUT
*          MVC   WLINED,WLINEB            BLANK OUT PRINT LINE
*          B     SUBFQE                   ON TO THE NEXT FQE
         EJECT
*
*        THIS FUNCTION DEPENDS ON AN ASSEMBLED OFFSET IN
*        THE SVCTABLE - USERORG.  IN THIS ROUTINE IT IS
*        EQUIVALENCED TO ZUSERORG.
*
SVCTABLE CLI   PTYPE+1,9                SVCTABLE REQUESTED?
         BNE   ADDRCHK                     NO, ....
         MVC   WLINEH,=Y(W9LEN+4,0)     YES, SET MSG HEADER
         OI    WSW,WSWRTJ               RIGHT JUSTIFY
         MVC   WFILLER,XC0              FILLER
         L     R15,CVTPTR               CVT
         USING CVT,R15
         L     R15,CVTABEND             SECONDARY CVT
         USING SCVT,R15
         L     R0,SCVTSVCT              SVCTABLE
         ST    R0,WSVCTBL               SAVE STARTING LOCATION
         DROP  R15                      CVT, SCVT
         LA    R9,PDSVC                 INITIAL PDE
SVCPDE   BAL   R2,PDESCAN               CHECK OUT PDE
         B     RETURN                   THAT'S ALL
         MVI   W9LINE,C' '
         MVC   W9LINE+1(W9LEN-1),W9LINE
         PACK  WDOUBLE,WNAME            CONVERT SVC NUMBER
         MVC   W9SVC,XPAT2              PATTERN
         ED    W9SVC,WDOUBLE+6          EDIT SVC NUMBER
         CVB   R15,WDOUBLE              TO BINARY
         L     R8,WSVCTBL               SET IBM BASE
         SLL   R15,3                    SVC# * 8
         LA    R15,0(R15,R8)            SVCTABLE ENTRY
         USING SVCENTRY,R15
         ACON  (R15),W9ADDT             ADDRESS OF SVCTABLE ENTRY
         MVI   W9TRANS,C' '
         TM    SVCATTR1,X'C0'           TRANSIENT?
         BNO   SVCRES                   NO, RESIDENT
         MVI   W9TRANS,C'T'             YES, INDICATE
         B     SVCADDRE
SVCRES   BZ    SVCRES1                  TYPE 1
         TM    SVCATTR1,X'80'           TYPE 2
         BNO   SVCADDRE                 NO - LEAVE BLANK
         MVI   W9TRANS,C'2'             YES - TYPE 2
         B     SVCADDRE
SVCRES1  MVI   W9TRANS,C'1'             TYPE 1
SVCADDRE EQU   *
         ACON  SVCADDR(4),W9ADDR        SVC ADDRESS
         TM    SVCATTR1,X'08'           APF AUTH REQUIRED?
         BZ    *+8                      NO - BRANCH
         MVI   W9AUTH,C'A'
         LA    R1,W9LOCKS
         LA    R14,SVCLOCKS
         TM    0(R14),X'80'
         BZ    *+14
         MVC   0(5,R1),=C'LOCAL'
         LA    R1,6(,R1)
         TM    0(R14),X'40'
         BZ    *+14
         MVC   0(3,R1),=C'CMS'
         LA    R1,4(,R1)
         TM    0(R14),X'20'
         BZ    *+14
         MVC   0(3,R1),=C'SRM'
         LA    R1,4(,R1)
         TM    0(R14),X'10'
         BZ    *+14
         MVC   0(6,R1),=C'SALLOC'
         LA    R1,7(,R1)
         TM    0(R14),X'08'
         BZ    *+14
         MVC   0(4,R1),=C'DISP'
         LA    R1,5(,R1)
         DROP  R15                      SVCENTRY
SVCLIST  BAL   R2,MSGSTD                LIST IT
         B     SVCPDE                   PROCESS ALL REQUESTS
         EJECT
************************************************************
*                                                          *
*        'ADDRESS'                                         *
*                                                          *
************************************************************
         SPACE
ADDRCHK  CLI   PTYPE+1,10               LIST REQUEST?
         BNE   RETURN                   NO, ...
         TM    PADDRESS+6,X'80'         LOAD NAME SPECIFIED?
         BO    ERRADDR                  YES, ERROR
         TM    PADDRESS+14,X'80'        NO, ENTRY NAME?
         BO    ERRADDR                  YES, ERROR
         TM    PADDRESS+22,X'80'        NO, ADDRESS STRING?
         BNO   TCBCHK                   NO, CONTINUE CHECKING ELSEWHERE
         CLI   PADDRESS+24,0            YES, ABSOLUTE ADDRESS?
         BNE   ERRADDR                  NO, ERROR
         MVC   WLINEH,=Y(W13LEN+4,0)    YES, SET MSG HEADER
         MVI   W13AST1,C'*'             INSERT DELIMITORS
         MVI   W13AST2,C'*'
         OI    WSW,WSWRTJ               RIGHT JUSTIFY
         MVC   WFILLER,XC0              FILLER
         LA    R9,PADDRESS+16           PDE POINTER
         BAL   R2,PDESET                GET ADDRESS
         B     ERRADDR                  NOTHING????
         TR    WNAME,TRANS2             TRANSLATE
         PACK  WDOUBLE(5),WNAME(9)      PACK INTO HEX
         L     R3,WDOUBLE               GET STARTING ADDRESS
         LA    R9,PDLENGTH              GET LENGTH PDE
         BAL   R2,PDESET                GET VALUE
         B     ERRADDR                  NOTHING????
         PACK  WDOUBLE,WNAME            PACK DECIMAL VALUE
         CVB   R5,WDOUBLE               CONVERT TO BINARY
ADDRLAST LA    R5,0(R3,R5)              GET ENDING ADDRESS + 1
         BCTR  R5,0                     MINUS 1....
         LA    R4,16                    INCREMENTAL LENGTH
ADDRLOOP LR    R1,R3                    DATA START
         ACON  (R1),W13ADDR             CONVERT ADDRESS
         LR    R14,R4                   DATA LENGTH
         LA    R15,W13DATAX             OUTPUT LOCATION
         BAL   R2,CONVERT               CONVERT TO HEX
         MVC   W13DATAC,0(R3)           MOVE TO CHAR STRING LOCATION
         TR    W13DATAC,TRANS3          TRANSLATE TO PRINTABLE ONLY
         BAL   R2,MSGSTD                PRINT IT OUT
         BXLE  R3,R4,ADDRLOOP           GET THEM ALL
         B     RETURN                   THAT'S ALL....
         EJECT
ERRADDR  LA    R0,MINVADDR              INVALID ADDRESS
         B     ERROR
ERRPARSE LA    R0,MPARSERR              PARSE ERROR
         B     ERROR
ERRUCB   LA    R0,MUCBERR               UCB ERROR
ERROR    BAL   R2,MSGINFOR              ISSUE ERROR MESSAGE
         SPACE 2
RETURN   TM    WSW,WSWDATA              DATA STILL TO BE WRITTEN?
         BNO   RETURNA                  NO, EXIT
         LM    R3,R4,WDBLKA             YES, GET DATA START & LENGTH
         SLR   R3,R4                    BACK OFF TO LAST LINE
         XC    0(4,R3),0(R3)            CLEAR FORWARD LINE POINTER
         BAL   R2,MSGLIST               WRITE THEM OUT
RETURNA  L     R15,CVTPTR
         TM    444(R15),X'80'           PUTLINE IN CVT?
         BO    SKIPDEL                  YES - SKIP DELETE
         DELETE EPLOC=LPUTL             DELETE PUTLINE
SKIPDEL  EQU   *
         IKJRLSA WANS                   RELEASE PARSE AREA
         LR    R1,R13
         L     R13,4(,R13)
         FREEMAIN R,LV=WORKLEN,A=(1)
         LA    R15,0
         L     R14,12(,R13)
         LM    0,12,20(R13)
         BR    R14
         EJECT
UCBDATA  DS    0H
         ST    R7,WDOUBLE               UCB ADDRESS
         UNPK  W5UCB(5),WDOUBLE+2(3)    MAKE IT PRINTABLE
         TR    W5UCB,TRANS1             ...
         MVI   W5UCB+4,C' '             CLEAR RANDOM BYTE
         CLI   PDATA+1,1                NO, DATA REQUESTED?
         BNE   UKBSTATS                 NO, PRINT STATUS
         ST    R2,WSAVE1                YES, SAVE RETURN REGISTER
         LR    R3,R7                    SET UCB START
         LA    R4,16                    SECTION LENGTH
         LA    R5,63(R3)                UCB DATA END
UCBDATAB LR    R1,R3                    DATA START
         LR    R14,R4                   SECTION LENGTH
         LA    R15,W5DATA               OUTPUT LOCATION
         BAL   R2,CONVERT               CONVERT HEX DATA
         BAL   R2,MSGSTD                PRINT IT
         MVC   WLINED,WLINEB            CLEAR PRINT LINE
         BXLE  R3,R4,UCBDATAB           GET IT ALL
UCBDATAX L     R2,WSAVE1                RESTORE RETURN REGISTER
         BR    R2                       RETURN
         SPACE 2
CONVERT  DS    0H
         STM   R3,R5,WCSAVE             SAVE WORK REGISTERS
         LR    R3,R1                    START OF DATA
         LA    R4,4                     ITEM LENGTH
         LA    R5,0(R3,R14)             END OF DATA + 1
         BCTR  R5,0
CONVERTA UNPK  WCONDATA,0(5,R3)         UNPACK
         TR    WCONDATA(8),TRANS1       MAKE IT PRINTABLE
         MVC   2(8,R15),WCONDATA        MOVE TO OUTPUT AREA
         LA    R15,10(R15)              BUMP OUTPUT POINTER
         BXLE  R3,R4,CONVERTA           DO IT ALL
         LM    R3,R5,WCSAVE             RESTORE WORK REGISTERS
         BR    R2                       RETURN
         EJECT
         USING UCB,R7
UKBSTATS DS    0H
         ST    R2,WSAVE1                SAVE RETURN REGISTER
         ST    R7,WDOUBLE               UCB ADDRESS
         UNPK  W5UCB(5),WDOUBLE+2(3)    MAKE IT PRINTABLE
         TR    W5UCB,TRANS1             ...
         MVI   W5UCB+4,C' '             CLEAR RANDOM BYTE
         MVI   W5STAT,C' '
         MVC   W5STAT+1(W5SLENT-1),W5STAT
         TM    UCBSTAT,UCBONLI          ONLINE?
         BO    UKBSONLI                 YES - BRANCH
         MVC   W5SPRIV(9),=C'*OFFLINE*'
         B     UKBPRT                   FINISHED
UKBSONLI CLI   UCBTYP+2,UCB3DACC        DIRECT ACCESS?
         BE    UKBDISK                  YES - BRANCH
         CLI   UCBTYP+2,UCB3TAPE        TAPE
         BE    UKBTAPE                  YES - BRANCH
         B     UKBPRT
UKBDISK  LA    R2,=CL6'3330'
         CLI   UCBTYP+3,9               3330
         BE    UKBDISKT
         LA    R2,=CL6'3330-1'
         CLI   UCBTYP+3,13              3330-1
         BE    UKBDISKT
         LA    R2,=CL6'3350'
         CLI   UCBTYP+3,11              3350
         BE    UKBDISKT
         LA    R2,=CL6' '               NONE OF THE ABOVE
UKBDISKT MVC   W5STYPE,0(R2)            DEVICE TYPE NAME
         TM    UCBTYP+1,8               MSS VIRTUAL 3330, UCBRVDEV
         BZ    *+8                      NO, SKIP NEXT INSTR
         MVI   W5STYPE+4,C'V'           CHANGE 3330 TO 3330V
         TM    UCBTYP+1,X'20'           SHARED
         BZ    *+10                     NO
         MVC   W5SSHR,=C'SHARED'        YES
         TM    UCBSTAB,UCBBPRV          PRIVATE?
         BZ    UKBSTVS1                 NO - BRANCH
         MVC   W5SPRIV,=C'PRIVATE'      YES
UKBSTVS1 TM    UCBSTAB,UCBBSTR          STORAGE?
         BZ    UKBSTVS2                 NO - BRANCH
         MVC   W5SPRIV,=C'STORAGE'      YES
UKBSTVS2 TM    UCBSTAB,UCBBPUB          PUBLIC?
         BZ    UKBSTVS3                 NO - BRANCH
         MVC   W5SPRIV,=C'PUBLIC '      YES
UKBSTVS3 EQU  *
         TM    UCBSTAT,UCBPRES          RESIDENT?
         BZ    UKBSTDV1                 NO - BRANCH
         MVC   W5SPRES,=C'RESIDENT'     YES
UKBSTDV1 TM    UCBSTAT,UCBRESV          RESERVED?
         BZ    UKBSTDV2                 NO - BRANCH
         MVC   W5SPRES,=C'RESERVED'     YES
UKBSTDV2 EQU   *
         TM    UCBSTAT,UCBALOC          ALLOCATED?
         BO    *+10                     NO - BRANCH
         MVC   W5SALLO,=C'NOT-ALLOCATED' NO
         TM    UCBFLA,UCBNRY            READY?
         BZ    *+10                     YES - BRANCH
         MVC   W5SALLO,=C'NOT-READY    ' NO
         B     UKBPRT
UKBTAPE  EQU   *
         OC    W5VOLSER,W5VOLSER        VOLSER PRESENT
         BZ    UKBPRT
         TM    UCBFLA,UCBNRY            READY?
         BZ    *+10                     YES - BRANCH
         MVC   W5SPRIV(9),=C'NOT-READY    ' NO
UKBNDA   EQU   *
UKBPRT   EQU   *
         BAL   R2,MSGSTD                PRINT OUTPUT LINE
         L     R2,WSAVE1                RESTORE RETURN REGISTER
         BR    R2                       RETURN
         DROP  R7
         SPACE 2
CONVERTB DS    0H
         UNPK  WCONDATA,0(5,R1)         UNPACK INPUT
         TR    WCONDATA(8),TRANS1       MAKE IT PRINTABLE
         BCTR  R14,0                    OUTPUT LENGTH - 1
         EX    R14,IMCON                MOVE DATA TO OUTPUT LINE
         BR    R2                       RETURN
         EJECT
MSGINFOR DS    0H
         XC    WECB,WECB                CLEAR ECB
         L     R15,WPUTL                PUTLINE ROUTINE
         PUTLINE OUTPUT=((R0),,,DATA),ENTRY=(15),MF=(E,WIOPL)
         BR    R2                       RETURN
         SPACE 2
MSGSTD   DS    0H                       MESSAGE ROUTINE
         LA    R0,WLINEH                STANDARD MESSAGE AREA
MSGDATA  STM   R2,R5,WDSAVE             SAVE WORK REGISTERS
         LM    R3,R5,WDBLKA             LOAD CONTROL REGISTERS
         OI    WSW,WSWDATA              INDICATE DATA TO WRITE
         LR    R1,R0                    STARTING DATA ADDRESS
         MVC   4(WDBLKENT-4,R3),0(R1)   MOVE PRINT LINE IN
         BXLE  R3,R4,MSGRET             CONTINUE IF MORE LINES REMAIN
         BAL   R2,MSGLIST               ELSE, WRITE THE BLOCK OUT
         L     R3,WDBLK                 GET BLOCK START
MSGRET   ST    R3,WDBLKA                RESET LINE POINTER
         LR    R15,R3                   ALSO RETURN IT IN REG 15
         LM    R2,R5,WDSAVE             RESTORE WORK REGISTERS
         BR    R2                       RETURN
         SPACE 2
MSGLIST  DS    0H                       BLOCK LIST ROUTINE
         XC    WECB,WECB                CLEAR ECB
         L     R0,WDBLK                 BLOCK START
         L     R15,WPUTL                PUTLINE ROUTINE
         PUTLINE OUTPUT=((R0),,MULTLIN,DATA),ENTRY=(15),MF=(E,WIOPL)
         NI    WSW,X'FF'-WSWDATA        INDICATE BLOCK WRITTEN
         BR    R2                       RETURN
         EJECT
TCBSCAN  DS    0H                       TCB LOOK-UP ROUTINE
         L     R15,WTCBA                STARTING TCB
         USING TCB,R15
TCBSCANA ZCHK  R1,TCBTIO,TCBSCANX       TIOT
         CLC   WNAME,0(R1)              DESIRED TASK?
         BE    TCBSCANY                 YES, PROCESS IT
TCBSCANX L     R15,TCBTCB               GET NEXT TCB
         LA    R15,0(R15)
         LTR   R15,R15                  ANY MORE?
         BP    TCBSCANA                 YES, ....
         BR    R2                       NO, RETURN
TCBSCANY LR    R14,R15                  SAVE TCB ADDRESS
         ZCHK  R15,TCBLTC,TCBSCANY,BC=NZ     GET SUBTASK TCB
         DROP  R15
         USING TCB,R14
         L     R15,TCBJSTCB             GET JOB STEP TCB
         B     4(R2)                    RETURN
         DROP  R14
         SPACE 2
SPQECHK  DS    0H                       SPQE DETERMINATION ROUTINE
         ZCHK  R8,WSPQE,R2,BC=ZR        IS THERE ANOTHER SPQE?
         MVC   WSPQE,0(R8)              YES, SAVE NEXT PTR ON CHAIN
         TM    0(R8),X'80'              SHARED SUBPOOL?
         BNO   4(R2)                    NO, RETURN
         L     R8,4(R8)                 YES, GET ACTUAL SPQE ADDRESS
         LA    R8,0(R8)                 CLEAR HI-ORDER BYTE
         B     4(R2)                    RETURN
         EJECT
GETVOL   DS    0H
         OI    WSW,WSWVOL               INDICATE VOLSER CHECK
GETUCB   LH    R15,0(R8)                UCB ADDRESS
         LTR   R15,R15                  VALID?
         BZ    GETBUMP                  YES, BUT EMPTY
         BCR   4,R2                     NO, ALL DONE
         USING UCB,R15
         CLI   UCBTBYT3,UCB3DACC        YES, DASD?
         BNE   GETBUMP                  NO, -
         TM    UCBSTAT,UCBONLI          YES, ONLINE?
         BZ    GETBUMP                  NO, -
         TM    WSW,WSWVOL               YES, DO WE CHECK VOLSER?
         BZ    GETRET                   NO, RETURN
         CLC   UCBVOLI,W5VOLSER         YES, DO THEY MATCH?
         BE    GETRET                   YES, RETURN
GETBUMP  LA    R8,2(R8)                 BUMP UCB POINTER
         B     GETUCB                   CONTINUE...........
GETRET   NI    WSW,X'FF'-WSWVOL         TURN OFF VOLSER SWITCH
         LA    R8,2(R8)                 BUMP UCB POINTER
         B     4(R2)                    RETURN
         DROP  R15
         EJECT
BLDLSCAN DS    0H                       SCAN RESIDENT BLDL LST
         LA    R3,4(R15)                START OF LIST
         LH    R4,2(R15)                ENTRY LENGTH
         LH    R5,0(R15)                # OF ENTRIES
BLDLSCNA CLC   WNAME,0(R3)              CORRECT NAME?
         BER   R2                       YES, GOT IT
         LA    R3,0(R3,R4)              NO, BUMP TO NEXT ENTRY
         BCT   R5,BLDLSCNA              KEEP LOOKING
         B     4(R2)                    NOTHING, RETURN
         SPACE 2
PDESCAN  DS    0H                       PDE SCANNING ROUTINE
         LA    R9,0(R9)                 CLEAR HI-ORDER BYTE
         LTR   R9,R9                    ANYTHING?
         BZR   R2                       NO, THAT'S ALL
         TM    6(R9),X'80'              YES, FIELD PRESENT?
         BO    PDESET                   YES, SET IT UP
         L     R9,8(R9)                 NO, GET NEXT PDE
         B     PDESCAN                  ... AND TRY AGAIN
PDESET   L     R15,0(R9)                FIELD START
         LH    R1,4(R9)                 FIELD LENGTH
         SLR   R14,R14                  DEFAULT OFFSET
         TM    WSW,WSWRTJ               RIGHT JUSTIFY?
         BNO   PDESCLOC                 NO, ....
         LA    R14,L'WNAME              YES, GET MAX LENGTH
         SR    R14,R1                   SUBTRACT LENGTH FOR OFFSET
PDESCLOC LA    R14,WNAME(R14)           START OF DATA
         BCTR  R1,0                     LENGTH - 1
         MVC   WNAME,WFILLER            FILL IN NAME FIELD
         EX    R1,IMNAME                MOVE NAME
         L     R9,8(R9)                 SET FOR NEXT PDE
         B     4(R2)                    RETURN
         EJECT
         PRINT NOGEN
MPARSERR WTO   ' PARSE ERROR',MF=L
MUCBERR  WTO   ' UCB LOOK-UP ERROR',MF=L
MNOFREE  WTO   ' THERE IS NO FREE MAIN STORAGE',MF=L
MNOMSTCB WTO   ' UNABLE TO LOCATE MASTER SCHEDULER TCB(??)',MF=L
MSPHDR   DS    0F
         DC    Y(MSPHDRL,0)
         DC    CL8'  SPQE',CL7' FLGS',CL6'SPID'
         DC    CL8'  DQE',CL8'  BLK',CL8'LENGTH'
         DC    CL8'  FQE',CL8'LENGTH'
MSPHDRL  EQU   *-MSPHDR
MINVADDR WTO   ' INVALID ADDRESS SPECIFIED',MF=L
         PRINT GEN
         EJECT
         DS    0D
LPUTL    DC    CL8'IKJPUTL'
LPARSE   LINK  EP=IKJPARS,SF=L
IMCON    MVC   0(*-*,R15),WCONDATA
IMNAME   MVC   0(*-*,R14),0(R15)
IMRNAME  MVC   W2RNAME(*-*),20(R7)
         SPACE 2
XBLANKS  DC    CL64' '
XC0      DC    8C'0'
XMSNAME  DC    CL16'MASTER  SCHEDULR'
XPAT1    DC    X'402020202120'
XPAT2    DC    X'40202120'
XPAT3    DC    X'40206B2020206B202120'
XSTAT    DC    C'SA=XX,F1=XX,SB=XX,RSV=XXYY,RQE=AAAA,SEEK=CCHH'
XSPTOT   DS    0F
         DC    Y(XSPTOTL,0)
         DC    CL11' ',CL7'SPID'
         DC    CL12'#DQES',CL8'MAX',CL6'SUM'
         DC    CL10'#FQES',CL8'MAX',CL6'SUM'
XSPTOTL  EQU   *-XSPTOT
         EJECT
         DS    0F
TRANS1   EQU   *-C'0'
         DC    C'0123456789ABCDEF'
         DS    0F
TRANS2   EQU   *-C'A'
         DC    X'0A0B0C0D0E0F',XL41'0'
         DC    C'0123456789'
         DS    0F
TRANS3   DC    256C'.'
         TRANS C' '
         TRANS X'4A',7
         TRANS X'5A',8
         TRANS C',',5
         TRANS C':',6
         TRANS X'81',9
         TRANS X'91',9
         TRANS X'A2',8
         TRANS C'A',9
         TRANS C'J',9
         TRANS C'S',8
         TRANS C'0',10
         ORG
         EJECT
         LTORG
         EJECT
         PRINT NOGEN
DISPPCL  IKJPARM
*
PTYPE    IKJKEYWD
#1       IKJNAME  'TCBADDR',SUBFLD=PSTCBA
#2       IKJNAME  'QCBS',SUBFLD=PSTCBA
#3       IKJNAME  'LPA',SUBFLD=PSLPA
#4       IKJNAME  'UNITS',SUBFLD=PSUNIT
#5       IKJNAME  'VOLUMES',SUBFLD=PSVOL
#6       IKJNAME  'BLDL',SUBFLD=PSLPA
#7       IKJNAME  '$TORAGE',SUBFLD=PSNAME
#8       IKJNAME  'SUBPOOLS',SUBFLD=PSTCBA
#9       IKJNAME  'SVCTABLE',SUBFLD=PSSVC
#10      IKJNAME  'ADDRESS',SUBFLD=PSADDR
*
PDATA    IKJKEYWD
         IKJNAME  'DATA',SUBFLD=PSLPA
         IKJNAME  'STATUS'
*
PSTCBA   IKJSUBF
PDTCBA   IKJIDENT 'TASK NAME',LIST,MAXLNTH=8,OTHER=ALPHANUM,           W
               PROMPT='TASK NAME(S)'
*
PSNAME   IKJSUBF
PDNAME   IKJIDENT 'NAME(S)',LIST,MAXLNTH=8,OTHER=ALPHANUM
*
PSUNIT   IKJSUBF
PDUNIT   IKJIDENT 'UNIT NAMES',LIST,MAXLNTH=3,                         W
               FIRST=ALPHANUM,OTHER=ALPHANUM
*
PSVOL    IKJSUBF
PDVOL    IKJIDENT 'VOL-IDS',LIST,MAXLNTH=6,OTHER=ALPHANUM
*
PSLPA    IKJSUBF
PDLPA    IKJIDENT 'MODULES',LIST,MAXLNTH=8,OTHER=ALPHANUM
*
PSSVC    IKJSUBF
PDSVC    IKJIDENT 'SVCS',LIST,MAXLNTH=3,FIRST=NUMERIC,OTHER=NUMERIC,   W
               PROMPT='SVC NUMBERS'
*
PSADDR   IKJSUBF
PADDRESS IKJPOSIT ADDRESS,RANGE,PROMPT='DATA ADDRESS'
PDLENGTH IKJIDENT 'LENGTH',MAXLNTH=8,FIRST=NUMERIC,OTHER=NUMERIC,      W
               DEFAULT='32'
*
         IKJENDP
         PRINT GEN
         EJECT
WORKAREA DSECT
WSAVE    DS    9D
WDOUBLE  DS    D
WSAVE1   DS    F
WCSAVE   DS    3F
WTJB     DS    A
WMSTCB   DS    A
WTCBA    DS    A
WSPQE    DS    A
WLPALINK DS    A
WLPASVC  DS    A
WLPATSO  DS    A
WUCBTBL  DS    0A
WDASTART DS    A
WPUTL    DS    A
WANS     DS    A
WECB     DS    F
WQCBORG  DS    A
WSVCTBL  DS    A
WDBLK    DS    A
WDBLKENT EQU   88
WDBLKLEN EQU   23*WDBLKENT
WDBLKA   DS    3A
WDSAVE   DS    4F
WPPL     DS    XL28
WIOPL    DS    XL16
WPTPB    DS    XL12
WLPA     DS    3F
WNAME    DS    CL8
WFILLER  DS    CL8
         SPACE 2
WCMDWORK DS    0D
WBLDLINK DS    A
WBLDSVC  DS    A
         ORG   WCMDWORK
WSTORSUM DS    F
WSTORMAX DS    F
WSTORCNT DS    F
         ORG   WCMDWORK
WDQECNT  DS    F
WDQEMAX  DS    F
WDQESUM  DS    F
WFQECNT  DS    F
WFQEMAX  DS    F
WFQESUM  DS    F
         ORG
         EJECT
WLINEH   DS    0F,2Y
WLINE    DS    0F
WLINEB   DS    C
WLINED   DS    CL78
         ORG   WLINED
W1LINE   DS    0C
W1NAME   DS    CL8,CL2
W1ADDR   DS    CL6
W1LEN    EQU   *-WLINE
         ORG   WLINED
W2LINE   DS    0C
W2QNAME  DS    CL8,CL2
W2TYPE   DS    CL4,CL2
W2RNAME  DS    CL44,CL2
W2STAT   DS    CL4,CL2
W2SMC    DS    CL4
W2LEN    EQU   *-WLINE
         ORG   WLINED
W3LINE   DS    0C
W3NAME   DS    CL8,CL2
W3CDEL   DS    CL4,CL1
W3CDE    DS    CL6,CL2
W3EPL    DS    CL2,CL1
W3EP     DS    CL6
W3LEN    EQU   *-WLINE
         ORG   WLINED
W5LINE   DS    0C
W5VOLSER DS    CL6,CL2
W5UNIT   DS    CL3,CL2
W5UCB    DS    CL4,CL2
W5DATA   DS    CL48
         ORG   W5DATA
W5STAT   DS    CL3
W5STYPE  DS    CL6,CL2
W5SPRIV  DS    CL7,CL2
W5SPRES  DS    CL8,CL2
W5SALLO  DS    CL13,CL2
W5SSHR   DS    CL6,CL2
W5SLENT  EQU   *-W5STAT
         ORG
W5LEN    EQU   *-WLINE
         ORG   WLINED
W6LINE   DS    0C
W6NAME   DS    CL8,CL2
W6ADDR   DS    CL6
W6LEN    EQU   *-WLINE
         ORG   WLINED
W7LINE   DS    0C
W7ADDR   DS    CL6,CL2
W7KB     DS    CL6
W7K      DS    C
         ORG   W7LINE
         DS    CL4
W7SX     DS    C'SUM='
W7S      DS    CL6
W7SK     DS    C'K',CL5
W7MX     DS    C'MAX='
W7M      DS    CL6
W7MK     DS    C'K',CL5
W7FX     DS    C'#FBQES='
W7F      DS    CL6
W7LEN    EQU   *-WLINE
         ORG   WLINED
W8LINE   DS    0C
W8SPQE   DS    CL6,CL2
W8FLAGS  DS    CL2,CL4
W8SPID   DS    CL3,CL3
W8DQE    DS    CL6,CL2
W8BLK    DS    CL6,CL2
W8BLKLEN DS    CL6,CL2
W8FQE    DS    CL6,CL2
W8FQELEN DS    CL6
         ORG   W8LINE
W8XLINE  DS    0C
W8XTASK  DS    CL8,CL2
W8XSPID  DS    CL3,CL3
W8XDQES  DS    CL6,CL3
W8XDQMAX DS    CL6,CL2
W8XDQSUM DS    CL6,CL3
W8XFQES  DS    CL6,CL2
W8XFQMAX DS    CL6,CL2
W8XFQSUM DS    CL6
W8LEN    EQU   *-WLINE
         ORG   WLINED
W9LINE   DS    0C
W9SVC    DS    CL4,CL3
W9ADDR   DS    CL6
         DS    C
W9TRANS  DS    C
         DS    C
W9AUTH   DS    C
         DS    C
W9ADDT   DS    CL6,C
W9LOCKS  DS    CL25
W9LEN    EQU   *-WLINE
         ORG   WLINED
W10LINE  DS    0C
W10NAME  DS    CL44
         ORG   W10LINE
W10DEVT  DS    CL8,CL2
W10VOL   DS    CL6,CL2
W10CVOL  DS    CL6,CL2
W10TMCNT DS    CL10,CL2
W10CCHHR DS    CL10,CL2
W10TTR   DS    CL6
W10LEN   EQU   *-WLINE
         ORG   WLINED
W13LINE  DS    0C
W13ADDR  DS    CL6,CL2
W13DATAX DS    4CL10,CL5
W13AST1  DS    C
W13DATAC DS    CL16
W13AST2  DS    C
W13LEN   EQU   *-WLINE
         ORG
         SPACE 2
         DS    0F
WLINE2   DS    CL16
WSW      DS    X
WSWVOL   EQU   X'80'
WSWAIT   EQU   X'40'
WSWRTJ   EQU   X'20'
WSWDATA  EQU   X'10'
WCONDATA DS    XL9
         DS    0D
WORKLEN  EQU   *-WORKAREA
         EJECT
         IKJCPPL
         SPACE 2
         IKJPPL
         SPACE 2
         IKJIOPL
         EJECT
CDE      DSECT
CDATTR   DS    0X        ATTRIBUTE FIELD
CD1LPA   EQU   X'80'     MODULE IS RESIDENT IN THE LPA
CD1FTCH  EQU   X'40'     MODULE IS BEING FETCHED
CD1RENT  EQU   X'20'     MODULE IS REENTERABLE
CD1REUS  EQU   X'10'     MODULE IS SERIALLY REUSABLE
CD1NREU  EQU   X'08'     MODULE MAY NOT BE REUSED
CD1MINR  EQU   X'04'     THIS IS A MINOR CDE
CD1JPA   EQU   X'02'     MODULE IS IN THE JOB PACK AREA
CD1NOL   EQU   X'01'     MODULE IS NOT ONLY LOADABLE
CDCHAIN  DS    A         NEXT CDE IN THIS QUEUE
CDROLL   DS    0X        RESERVED
CDRBP    DS    A         RB ADDRESS
CDNAME   DS    CL8       MODULE, AIAS, OR ENTRY NAME
CDUSE    DS    0FL1      USE/RESPONSIBILITY COUNT
CDENTPT  DS    A         MODULE ENTRY POINT
CDATTR2  DS    0X        ATTRIBUTE FIELD 2
CD2NACT  EQU   X'40'     INACTIVE MODULE, OK TO RELEASE
CD2EXTL  EQU   X'20'     EXTENT LIST EXISTS FOR MODULE
CD2REAL  EQU   X'10'     CDE CONTAINS RELOCATED ALIAS EP
CD2REFR  EQU   X'08'     MODULE IS REFRESHABLE
CD2OVLY  EQU   X'04'     OVERLAY
CDXLMJP  DS    A         EXTENT LIST/MAJOR CDE ADDRESS
CDLEN    EQU   *-CDE
         SPACE 2
LLE      DSECT
LLECHAIN DS    A                        A(NEXT ELEMENT ON LOAD LIST)
LLEUSE   DS    0FL1                     RESPONSIBILITY COUNT
LLECDE   DS    A                        CDE FOR MODULE
         SPACE 2
SVCENTRY DSECT                          SVCTABLE ENTRY
SVCEP    DS    0A
         DS    C
SVCADDR  DS    AL3
SVCATTR1 DS    H
SVCLOCKS DS    H
         EJECT
         PRINT GEN
*        IKJTCB
**             TASK CONTROL BLOCK
**
**
TCB      DSECT
         ORG   TCB+X'0C'
TCBTIO   DS    A
         ORG   TCB+X'18'
TCBMSS   DS    0A
         ORG   TCB+X'24'
TCBLLS   DS    A       ADDR OF LAST LLE IN LOAD LIST
         ORG   TCB+X'74'
TCBTCB   DS    A       ADDR OF NEXT LOWER PRIO TCB ON RDY Q
         ORG   TCB+X'7C'
TCBJSTCB DS    0A      ADDR OF 1ST JOBSTEP TCB
         ORG   TCB+X'84'
TCBOTC   DS    A       ADDR OF MOTHER TCB
TCBLTC   DS    A       ADDR OF LAST DAUGHTER TCB
         ORG   TCB+X'98'
TCBPQE   DS    A       POINTER TO DPQE MINUS 8 FOR JOBSTEP
         SPACE 2
CVT      DSECT
*        CVT
CVTPTR   EQU   16
CVTMAP   EQU   *
CVTTCBP  DS    A
         ORG   CVTMAP+X'01C'
CVTPCNVT DS    A            TTR TO MBBCCHHR
CVTPRLTV DS    A            MBBCCHHR TO TTR
CVTILK1  DS    A
CVTILK2  DS    A
         DS    2A
CVTBTERM DS    A
         ORG   CVTMAP+X'0C8'
CVTABEND DS    A
         ORG   CVTMAP+X'160'
CVTLPDSR DS    A
         ORG   CVTMAP+X'280'
CVTFQCB  DS    A
         SPACE 2
SCVT     DSECT
         ORG   *+X'84'
SCVTSVCT DC    V(IBMORG)   ORIGIN OF SVC TABLE
         SPACE 2
UCB      DSECT
         IEFUCBOB LIST=YES
UCBLTS   EQU   0
UCBSKA   EQU   0
         SPACE 2
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
         END
@@
//LKED.SYSLMOD DD DSN=SYS2.LINKLIB,DISP=SHR  <== TARGET
//LKED.SYSIN DD *
  ALIAS DS
  NAME DISPLAY(R)
//*
//SAMPLIB  EXEC PGM=PDSLOAD
//STEPLIB  DD  DSN=SYSC.LINKLIB,DISP=SHR
//SYSPRINT DD  SYSOUT=*
//SYSUT2   DD  DISP=SHR,DSN=SYS2.HELP
//SYSUT1   DD DATA,DLM=@@
./ ADD NAME=DISPLAY
)F FUNCTION -
  THE DISPLAY (DS) COMMAND DISPLAYS SYSTEM INFORMATION FROM
  SYSTEM CONTROL AREAS ON THE TERMINAL.
  THE AREAS THAT CAN BE DISPLAYED ARE:
     - THE LOCATION OF A MODULE IN THE LINK PACK AREA (LPA),
     - THE LOCATION OF AN SVC IN THE NUCLEUS OR LPA,
     - ANY SPECIFIED VIRTUAL ADDRESS IN YOUR ADDRESS SPACE,
     - A UNIT CONTROL BLOCK, BY CUA ADDRESS OR VOLUME,
)X SYNTAX  -
         DS   LPA('MODULE')  SVC('NUMBER')   ADDRESS('LOC' 'LENGTH')
              UNIT('CUA')   VOLUME('VOLUME')   DATA
  REQUIRED - NONE
  DEFAULTS - NOTHING HAPPENS IF NO OPERANDS ARE ENTERED.
             UNIT AND VOLUME DEFAULT TO ALL DASD UCB'S.
  ALIAS    - DS
)O OPERANDS -
))LPA('MODULES') - THE ADDRESS OF THE LPA DIRECTORY ENTRY (LPDE)
             AND ENTRY POINT FOR THE SPECIFIED MODULES IS DISPLAYED.
             DOES NOT SHOW MLPA ENTRY POINT.  SEE ALSO HELP FOR
             THE 'LISTLPA' COMMAND, WHICH DOES REFLECT MLPA.
))SVC('NUMBERS') - THE ADDRESSES OF THE SPECIFIED SVCS ARE DISPLAYED.
))ADDRESS('LOC' 'LENGTH') - THE SPECIFIED LOCATION IS DISPLAYED,
             FOR THE SPECIFIED LENGTH. THE LOCATION IS SPECIFIED
             WITH HEX DIGITS FOLLOWED BY A PERIOD, THE SAME FORMAT
             USED BY THE 'TEST' SUBCOMMANDS.  IF ANY OF THE DATA
             IS IN READ-PROTECTED STORAGE OR THE ADDRESS IS
             OTHERWISE INACCESSIBLE, A S0C4 ABEND OCCURS.  THE
             LENGTH IS A DECIMAL NUMBER, DEFAULTING TO 32.
))UNIT('CUA') - THE UCB ADDRESS OF THE SPECIFIED CHANNEL-UNIT-ADDRESS
             IS DISPLAYED.  IF THE 'DATA' KEYWORD IS ALSO SPECIFIED,
             THEN THE DATA IN THE UCB IS DISPLAYED.  A LIST OF
             CUA'S MAY BE SPECIFIED.
))VOLUME('VOLUMES') - SAME AS THE 'UNIT' KEYWORD, EXCEPT THE UCB'S
             TO BE DISPLAYED ARE SEARCHED FOR USING THE VOLUME.
))DATA  -    WITH 'UNIT' OR 'VOL', THE UCB IS TO BE DISPLAYED,
             NOT JUST ITS ADDRESS.