//MEMBER  JOB (TSO),
//             'Install MEMBER',
//             CLASS=A,
//             MSGCLASS=A,
//             MSGLEVEL=(1,1),
//             USER=IBMUSER,
//             PASSWORD=SYS1
//*
//* ********************************************************
//* *  INSTALL THE 'MEMBER' TSO COMMAND                    *
//* ********************************************************
//ASSEM    EXEC ASMFCL,COND=(0,NE),
//         PARM.ASM='OBJECT,NODECK,LIST,RENT',
//         PARM.LKED='LIST,MAP,RENT,REUS,REFR'
//SYSIN    DD *
         TITLE '   M E M B E R    '
***********************************************************************
*                                                                     *
*        'MEMBER' TSO COMMAND                                         *
*                                                                     *
***********************************************************************
         SPACE
* WRITTEN BY BILL GODFREY, PRC INC.
*  (PRC INC. OF MCLEAN, VIRGINIA, WAS FORMERLY PLANNING RESEARCH CORP.)
* CURRENT INSTALLATION:
*  NOAA (NATIONAL OCEANIC AND ATMOSPHERIC ADMINISTRATION),
*  5200 AUTH ROAD, CAMP SPRINGS, MARYLAND 20746
* DATE WRITTEN: JANUARY 20 1977.
* DATE UPDATED: MAY 21 1991.
* ATTRIBUTES: RE-ENTRANT.
* DISCLAIMER: NO GUARANTEE; NO WARRANTY; INSTALL/USE AT YOUR OWN RISK.
* DESCRIPTION.
*           THIS TSO COMMAND DISPLAYS THE INFORMATION RETURNED BY
*           THE 'BLDL' MACRO. FOR LOAD MODULES, IT FORMATS THE
*           INFORMATION CONTAINED IN THE USER DATA FIELD OF THE
*           DIRECTORY ENTRY RETURNED BY THE 'BLDL' MACRO. FOR
*           MEMBERS CREATED BY THE 'SPF' IBM PRODUCT, IT FORMATS
*           THE SPF STATISTICS FROM THE USER DATA FIELD. FOR LOAD
*           MODULES, IT CAN LIST ESD AND IDR INFORMATION.
*
*           THE SYNTAX IS
*                MEMBER  'DSNAME(MEMBER)'  UNIT(NAME)  VOLUME(NAME)
*                                          ESOTERIC  DATA
*                                          LIST  MAP  IDR  LOAD
*                                          PLUS(MEMBER2 MEMBER3...)
*            OR
*                MEMBER 'MEMBER' SYS  ESOTERIC  WHERE
*            OR
*                MEMBER 'MEMBER' SLPA      LIST
*
*            THE LATTER 2 FORMS (SYS AND SLPA) ARE MORE FOR
*            SYSTEMS SUPPORT USE THAN FOR NORMAL APPLICATIONS.
*
***********************************************************************
*
*            KEYWORDS FOR THE FIRST FORM (DSNAME FORM)
*
*            THE 'DATA' KEYWORD PRODUCES AN UNFORMATTED HEX DISPLAY
*            OF THE DIRECTORY DATA.
*
*            THE 'ESOTERIC' KEYWORD CAUSES DISPLAY OF EXTRA INFORMATION
*            THAT MOST USERS NEVER CARE OR NEED TO KNOW.
*
*            THE 'LIST' KEYWORD CAUSES THE FIRST 48 BYTES OF THE
*            LOAD MODULE TEXT TO BE DISPLAYED.  THIS IS USEFUL FOR
*            MODULES ASSEMBLED WITH IDENTIFICATION INFORMATION
*            NEAR THE TOP OF THE MODULE.
*
*            THE 'MAP' KEYWORD CAUSES 'CESD' (EXTERNAL SYMBOL
*            DICTIONARY) INFORMATION IN THE MODULE TO BE DISPLAYED.
*
*            THE 'IDR' KEYWORD CAUSES 'IDR' (IDENTIFICATION RECORD)
*            INFORMATION IN THE MODULE TO BE DISPLAYED.
*
*            THERE ARE 4 TYPES OF IDR'S -
*               LINKEDIT, TRANSLATOR, ZAP, AND IDENTIFY.
*            IF ONLY 'IDR' IS SPECIFIED, ONLY LINKEDIT IS DISPLAYED.
*            TO DISPLAY A TRANSLATOR, SPECIFY IDR(TRAN).
*            TO DISPLAY A SECOND TRANSLATOR, SPECIFY IDR(PLS).
*            TO DISPLAY ZAP RECORDS, SPECIFY IDR(ZAP).
*            TO DISPLAY ZAP RECORD SPACE, SPECIFY IDR(SPACE).
*            TO DISPLAY IDENTIFY RECORDS, SPECIFY IDR(ID).
*            TO DISPLAY ALL OF THE ABOVE, EXCEPT SPACE,
*               SPECIFY IDR(ALL) OR IDR(T Z I P).
*
*            THE CSECT('NAME') KEYWORD ALLOWS YOU TO RESTRICT THE
*            MAP AND IDR DISPLAYS TO A SPECIFIC CSECT.
*
***********************************************************************
*
*            KEYWORDS FOR THE 'SYSTEM' AND 'SLPA' FORM
*
*            IF THE 'SYS' KEYWORD IS SPECIFIED, THE FIRST OPERAND
*            IS ONLY A MEMBER NAME, AND THE SYSTEM LINK LIBRARIES
*            ARE SEARCHED (AND STEPLIB IF THE SESSION HAS ONE).
*
*            IF THE 'SLPA' KEYWORD IS SPECIFIED, THE FIRST OPERAND
*            IS ONLY A MEMBER NAME, AND THE LINK PACK AREA IS SEARCHED.
*
*            'LIST' IS THE ONLY VALID KEYWORD WITH 'SLPA'.
*
*            'LIST' 'MAP' 'IDR' AND 'CSECT' ARE NOT VALID WITH 'SYS'
*            BECAUSE READING ESD AND IDR RECORDS REQUIRES A DCB
*            AND THIS PROGRAM IS DOES NOT HAVE ACCESS TO THE
*            SYSTEM LINKLIST DCB OR STEPLIB DCB.
*
*            THE 'WHERE' KEYWORD, VALID ONLY WITH 'SYS', CAUSES
*            THE NUMBER OF THE SYSTEM LINK LIBRARY TO BE DISPLAYED.
*
***********************************************************************
*
*           LOG OF CHANGES.
*            14SEP79 - GBLB ADDED FOR SVS/MVT VERSION.
*                      SUBFIELD ADDED TO 'MAP' KEYWORD.
*                      ESTAE REMOVED.
*            18SEP79 - 'WHERE' KEYWORD ADDED.
*            24OCT79 - MSG08 IMPROVED. MAPENTX LENGTHENED BY 1.
*            10APR80 - TEST CVT+116 FOR MVS.
*            09OCT80 - SPF STATISTICS DISPLAY ADDED.
*            10OCT80 - FIRST OPERAND MAY NOW BE A LIST IN PARENS.
*            19DEC80 - SPF SIZE FIELD 16 BITS, NOT 15.
*            06JAN81 - SPF V.M IS BINARY, NOT DECIMAL.
*            06JAN81 - SHOW SPF DATES AS MM/DD/YY INSTEAD OF JULIAN.
*            27FEB81 - IDR DISPLAY ADDED. CSECT SELECTION ADDED.
*            10APR81 - TEST OPT3I AT IDRIDENT. BUG FIXED (MAP(ALL)
*                      BUG FIXED - WAS TESTING OPTION1 FOR OPT2A.
*            27MAY81 - PLUS(MEMBER MEMBER MEMBER...) KEYWORD ADDED.
*            09NOV82 - SHOW APF AUTHORIZATION ON FIRST LINE.
*                      SHOW SCTR ATTRIBUTE. UNIT AND VOL KEYWORDS.
*                      SLPA KEYWORD FOR SEARCH LPA DIRECTORY.
*            10NOV82 - SLPA ALSO SEARCHES JPAQ/LPAQ USING THE
*                      IDENTIFY SVC LIKE IKJEFT02 DOES.
*            18JUL83 - LOAD KEYWORD, TO TEST FOR VALID LOAD MODULE.
*            01MAY85 - FIX LOOP IN SLPA BY RESTORING R3 FROM MYANS
*                      AFTER CALLING IEAVVMSR.
*            22JUL86 - FIX BUG WHEN BOTH I(A) AND LOAD ARE SPECIFIED
*                      R7 MUST BE RESET TO PROPERLY ADDRESS PDSINDIC.
*            15FEB91 - CHECK FOR MSGCRTXT00'S FUNNY DATE IN IDR-TRAN,
*                      FOUND IN TCPIP-FOR-MVS MODULES, CSECT MSG$LIST,
*                      DOES NOT CONFORM TO TRANSLATOR RECORD FORMAT AS
*                      DESCRIBED IN LINKAGE EDITOR LOGIC MANUAL.
*                      SHOW SOME TRANSLATORS BY NAME. THIRD BASE REG.
*                      SHOW PRIVATE (PC) REFERENCED IN IDR TRANS.
*                      FIX DAIR ERROR 4 PROBLEM (XA) BY ADDING VOLSER
*                      WITH TWO BLANKS FOR DA08SER. SHOW ESDID IN MAP.
*                      ADD ANYCESD FLAG, TO READ PAST SYM'S FOR CESD.
*            19FEB91 - IF VOL, SKIP IKJEHDEF AND ADD PREFIX (MVS).
*            25APR91 - NO CODE CHANGES, JUST COMMENTS.
*            06MAY91 - ADD RMODE/AMODE TO ESOTERIC INFO.
*            14MAY91 - RMODE/AMODE IN PARENS IF NO BITS ON.
*            15MAY91 - INSTEAD OF 1 BYTE UNDER VS, 3 UNDER VSMRLD.
*            20MAY91 - CHECK FOR ALIAS THAT HAS NO ALIAS INFO.
*            21MAY91 - ADD OUTFILE KEYWORD. MOVE DELETE OF IKJPUTL
*                      OUTSIDE OF DSNLOOP.
*
***********************************************************************
         SPACE
         GBLB  &MVS
&MVS     SETB  ('&SYSPARM' NE 'OS')     1 = MVS   0 = OS/MVT
         SPACE
MEMBER   START
         USING *,R10,R11,R12
ORIGIN   B     @START-*(,15)
         DC    AL1(8),CL11'MEMBER'
         DC    CL16' &SYSDATE &SYSTIME '
@SIZE    DC    0F'0',AL1(1),AL3(@DATAL) SUBPOOL AND LENGTH
@START   STM   14,12,12(13)
         LR    R10,15
         LA    R14,4095
         LA    R11,1(R14,R10)      SECOND BASE REGISTER
         LA    R12,1(R14,R11)      SECOND BASE REGISTER
         LR    R2,R1
         USING CPPL,R2
         L     R0,@SIZE
         GETMAIN R,LV=(0)
         ST    R13,4(,R1)          PUT OLD ADDRESS IN NEW SAVE AREA
         ST    R1,8(,R13)          PUT NEW ADDRESS IN OLD SAVE AREA
         LR    R13,R1              SWITCH R13 TO NEW SAVE AREA
         LR    R9,R13
         USING @DATA,R9
         SPACE 1
         MVI   CLEANUP,0
         MVI   OPTION1,0
         MVI   OPTION2,0
         SLR   R15,R15
         STH   R15,RC
         ST    R15,LINKAREA+4
         SPACE
************************************************************
*                                                          *
*        SET UP IOPL FOR PUTLINE                           *
*                                                          *
************************************************************
         SPACE
         LA    R15,MYIOPL
         USING IOPL,R15
         MVC   IOPLUPT(4),CPPLUPT
         MVC   IOPLECT(4),CPPLECT
         LA    R0,MYECB
         ST    R0,IOPLECB
         XC    MYECB,MYECB
         LA    R0,MYPTPB
         ST    R0,IOPLIOPB
         DROP  R15                 IOPL
         SPACE
         AIF   (NOT &MVS).SKIP1
         L     R15,16              LOAD CVT POINTER
         TM    116(R15),X'13'      IS THIS MVS ?
         BNO   PUTLOAD             BRANCH IF NOT MVS
         TM    444(R15),X'80'      IS PUTLINE LOADED (VS2)
         BNO   PUTLOAD             NO - BRANCH TO LOAD
         L     R15,444(,R15)       YES - GET ADDRESS
         B     PUTLODED            BRANCH AROUND LOAD
.SKIP1   ANOP
PUTLOAD  LA    R0,=CL8'IKJPUTL '
         LOAD  EPLOC=(0)
         LR    R15,R0
         LA    R15,0(,R15)         CLEAR HI BYTE FOR DELETE ROUTINE
PUTLODED ST    R15,MYPUTLEP        SAVE PUTLINE ADDRESS
         SPACE
************************************************************
*                                                          *
*        SET UP PPL FOR PARSE                              *
*                                                          *
************************************************************
         SPACE
         LA    R15,MYPPL
         USING PPL,R15
         MVC   PPLUPT(4),CPPLUPT
         MVC   PPLECT(4),CPPLECT
         LA    R0,MYECB
         ST    R0,PPLECB
         XC    MYECB,MYECB
*        L     R0,=A(MEMPCL)
         LA    R0,PCLADDR
         ST    R0,PPLPCL
         LA    R0,MYANS
         ST    R0,PPLANS
         MVC   PPLCBUF(4),CPPLCBUF
         LA    R0,MYUWA
         ST    R0,PPLUWA
         DROP  R15                 PPL
         SPACE 1
************************************************************
*                                                          *
*        CALL THE PARSE SERVICE ROUTINE                    *
*                                                          *
************************************************************
         SPACE 1
         LR    R1,R15              POINT TO PPL
         AIF   (NOT &MVS).SKIP2
         L     R15,16              CVTPTR
         TM    116(R15),X'13'      IS THIS MVS ?
         BNO   PARSELNK            BRANCH IF NOT MVS
         TM    520(R15),X'80'      IF HI ORDER BIT NOT ON
         BNO   PARSELNK               THEN DO LINK, NOT CALL
         L     R15,520(,R15)       CVTPARS
         BALR  R14,R15             CALL IKJPARS
         B     PARSEEXT            SKIP AROUND LINK
PARSELNK EQU   *
.SKIP2   ANOP
         LINK  EP=IKJPARS,SF=(E,LINKAREA)
PARSEEXT EQU   *
         SPACE 1
         LTR   R15,R15
         BZ    PARSEOK
         LA    R1,MSG01
         LA    R0,L'MSG01
         BAL   R14,PUTMSG
         LA    R15,12
         B     EXIT
PARSEOK  EQU   *
         SPACE
         L     R3,MYANS
         USING IKJPARMD,R3
         CLI   DATAKW+1,0
         BE    *+8
         OI    OPTION1,OPT1D       DATA
         CLI   TESTKW+1,0
         BE    *+8
         OI    OPTION1,OPT1T       TEST
         CLI   SYSTKW+1,0
         BE    *+8
         OI    OPTION1,OPT1S       SYSTEM OR SLPA
         CLI   SYSTKW+1,3
         BNE   *+8
         OI    OPTION1,OPT1L       SLPA
         CLI   ESOKW+1,0
         BE    *+8
         OI    OPTION1,OPT1E       ESOTERIC
         CLI   MAPKW+1,0           MAP
         BE    *+8
         OI    OPTION2,OPT2M
         CLI   MAPSKW+1,1          MAP(ALL)
         BNE   *+8
         OI    OPTION2,OPT2A       MAP(ALL)
         CLI   LISTKW+1,0
         BE    *+8
         OI    OPTION2,OPT2L       LIST
         CLI   LOADKW+1,0
         BE    *+8
         OI    OPTION2,OPT2O       LOAD
         CLI   WHEREKW+1,0
         BE    *+8
         OI    OPTION1,OPT1W       WHERE
         CLI   IDRKW+1,0
         BE    NOIDRK
         OI    OPTION2,OPT2I       IDR
         CLI   IDRTRNKW+1,0
         BE    *+8
         OI    OPTION3,OPT3T       IDR(TRAN)
         CLI   IDRPLSKW+1,0
         BE    *+8
         OI    OPTION3,OPT3T+OPT3P IDR(PLS)
         CLI   IDRZAPKW+1,0
         BE    *+8
         OI    OPTION3,OPT3Z       IDR(ZAP)
         CLI   IDRSPCKW+1,0
         BE    *+8
         OI    OPTION3,OPT3S       IDR(SPACE)
         CLI   IDRIDEKW+1,0
         BE    *+8
         OI    OPTION3,OPT3I       IDR(IDENTIFY)
         CLI   IDRALLKW+1,0
         BE    *+8
         OI    OPTION3,OPT3Z+OPT3T+OPT3P+OPT3I       (ALL)
NOIDRK   EQU   *
         SPACE
         MVC   CNAME,=CL8' '
         TM    CSECT+6,X'80'
         BZ    NOCSECT
         LA    R15,CSECT
         L     R14,0(,R15)
         LH    R1,4(,R15)
         BCTR  R1,0
         B     *+10
         MVC   CNAME(0),0(R14)
         EX    R1,*-6
NOCSECT  EQU   *
         SPACE
         MVC   ONAME,=CL8' '
         TM    OUTFI+6,X'80'
         BZ    NOOUTFI
         LA    R15,OUTFI
         L     R14,0(,R15)
         LH    R1,4(,R15)
         BCTR  R1,0
         B     *+10
         MVC   ONAME(0),0(R14)
         EX    R1,*-6
         MVC   OUTDCBW(OUTDCBL),OUTDCB
         LA    R4,OUTDCBW
         USING IHADCB,R4
         MVC   DCBDDNAM(8),ONAME
         LA    R1,OUTEXL
         STCM  R1,7,DCBEXLST
         LA    R0,OUTOPEN          POINT R0 TO OPEN EXIT
         ST    R0,0(,R1)           STORE ADDRESS IN OUTEXL
         MVI   0(R1),X'85'         OPEN EXIT
         MVC   OPEND(4),OPEN
         SPACE
         OPEN  ((R4),OUTPUT),MF=(E,OPEND)
         SPACE
         TM    DCBOFLGS,X'10'
         BO    OUTOK
         B     NOOUTFI
OUTOPEN  CLI   DCBRECFM,0          IF NO RECFM
         BNE   *+8                    THEN
         MVI   DCBRECFM,X'90'         RECFM=FB
         CLC   DCBLRECL,=H'0'      IF NO LRECL
         BNE   *+10                   THEN
         MVC   DCBLRECL,=H'80'        LRECL=80
         CLC   DCBBLKSI,=H'0'      IF NO BLKSI
         BNE   *+10                   THEN
         MVC   DCBBLKSI,=H'3120'      BLKSI=3120
         BR    R14
         DROP  R4                  IHADCB
OUTOK    OI    OPTION1,OPT1O       OUTFILE
NOOUTFI  EQU   *
         SPACE
         MVC   UNITN,=CL8' '
         MVC   VOLSER(8),=CL8' '
         TM    VOL+6,X'80'         VOL SPECIFIED
         BZ    NOVOL               NO, LEAVE UNIT AND VOL BLANK
         LA    R15,VOL
         L     R14,0(,R15)
         LH    R1,4(,R15)
         BCTR  R1,0
         B     *+10
         MVC   VOLSER(0),0(R14)
         EX    R1,*-6
         SPACE
         TM    UNIT+6,X'80'
         BZ    NOVOL
         LA    R15,UNIT
         L     R14,0(,R15)
         LH    R1,4(,R15)
         BCTR  R1,0
         B     *+10
         MVC   UNITN(0),0(R14)
         EX    R1,*-6
NOVOL    EQU   *
         SLR   R15,R15
         ST    R15,KOUNT
         SPACE
************************************************************
*                                                          *
*        GET THE MEMBER NAME                               *
*                                                          *
************************************************************
         SPACE
         LA    R8,DSN
         B     DSNGO
DSNLOOP  L     R8,24(,R8)
DSNGO    ST    R8,DSNPTR
         MVC   MEMBER8(8),=CL8' '
         TM    14(R8),X'80'        MEMBER SPECIFIED?
         BZ    NOMEMBER            NO - BRANCH
         LH    R1,12(,R8)          GET LENGTH OF MEMBER
         BCTR  R1,0                MINUS 1 FOR EX
         L     R14,8(,R8)          GET ADDRESS OF MEMBER NAME
         B     *+10
         MVC   MEMBER8(0),0(R14)    MOVE MEMBER NAME
SYSDSN   EX    R1,*-6
         STH   R1,MEMBERL
         B     OKMEMBER
NOMEMBER EQU   *
         TM    OPTION1,OPT1S       'SYSTEM' SPECIFIED?
         BZ    NOMEMMSG            NO, BRANCH          14SEP79
         LH    R1,4(,R8)           YES - LET DSN BE MEM IF NOT GT 8
         CH    R1,=H'8'            IS IT TOO LONG?
         BH    NOMEMMSG            YES - BRANCH
         L     R14,0(,R8)          NO - POINT TO DSN
         BCTR  R1,0
         B     SYSDSN
NOMEMMSG LA    R1,MSG07
         LA    R0,L'MSG07
         BAL   R14,PUTMSG          MEMBER NOT SPECIFIED
         LA    R15,12
         B     NEXTDSN
OKMEMBER EQU   *
         TM    OPTION1,OPT1S       'SYSTEM' SPECIFIED?
         BZ    NOTSYS              NO - ALLOCATE THE DATASET
         SLR   R4,R4               NULLIFY DCB POINTER FOR BLDL
         B     SYSTEM1
NOTSYS   EQU   *
         SPACE
************************************************************
*                                                          *
*        QUALIFY THE DSNAME IF NECESSARY                   *
*                                                          *
************************************************************
         SPACE
         TM    6(R8),X'80'         IS DATASET NAME SPECIFIED?
         BO    OKDSN               YES - BRANCH
         LA    R1,MSG05            NO - JUST MEMBER NAME
         LA    R0,L'MSG05
         BAL   R14,PUTMSG          DATA SET NAME NOT SPECIFIED
         LA    R15,12
         B     NEXTDSN
OKDSN    EQU   *
         MVI   DSNAME,C' '
         MVC   DSNAME+1(45),DSNAME
         LH    R1,4(,R8)           GET LENGTH
         STH   R1,DSNAME
         L     R14,0(,R8)          GET ADDRESS OF NAME
         BCTR  R1,0
         B     *+10
         MVC   DSNAME+2(0),0(R14)
         EX    R1,*-6
         TM    6(R8),X'40'         IS IT QUOTED?
         BO    DEFX                YES - SKIP DEFAULT SERVICE
         CLI   VOLSER,C' '         IS VOL SPECIFIED?
         BNE   DEFP                YES - SKIP DEFAULT SERVICE
         SPACE
         LA    R15,MYIOPL
         USING IOPL,R15
         LA    R14,MYDFPB
         ST    R14,IOPLIOPB
         USING DFPB,R14
         XC    0(20,R14),0(R14)
         LA    R0,DSNAME
         ST    R0,DFPBDSN
         OI    DFPBCODE,X'04'      SEARCH CAT AND PROMPT IF MULTI
         MVC   DFPBPSCB,CPPLPSCB
         MVI   DFPBCNTL,X'20'      PREFIX THE DSNAME
         DROP  R14
         SPACE
         LA    R1,MYIOPL
         SPACE
         LR    R1,R15              POINT TO IOPL
         AIF   (NOT &MVS).SKIP3
         L     R15,16              CVTPTR
         TM    116(R15),X'13'      IS THIS MVS ?
         BNO   EHDEFLNK            BRANCH IF NOT MVS
         TM    736(R15),X'80'      IF HI ORDER BIT NOT ON
         BNO   EHDEFLNK               THEN DO LINK, NOT CALL
         L     R15,736(,R15)       CVTEHDEF
         BALR  R14,R15             CALL IKJEHDEF
         B     EHDEFEXT            SKIP AROUND LINK
EHDEFLNK EQU   *
.SKIP3   ANOP
         LINK  EP=IKJEHDEF,SF=(E,LINKAREA)
EHDEFEXT EQU   *
         SPACE
         B     DEFCODE(R15)
DEFCODE  B     DEF00               SUCCESS
         B     NEXTDSN              MSG ALREADY ISSUED
         B     DEF08               INVALID NAME GT 44
         B     NEXTDSN              MSG ALREADY ISUED
         B     DEF16               NOT IN CATALOG
         B     DEF20               NOT IN CATALOG
         B     DEF24               IMPOSSIBLE
         B     DEF28               COMMAND SYSTEM ERROR
         B     DEF32               IMPOSSIBLE
         B     DEF36               ?
DEF08    EQU   *
DEF16    EQU   *
         B     DEF24
DEF20    EQU   *
LOCERR   EQU   *
         MVC   MSGWK(L'MSG02),MSG02
         LA    R15,MSGWK+L'MSG02
         LA    R14,DSNAME
         LH    R1,0(,R14)
         BCTR  R1,0
         B     *+10
         MVC   MSGWK+L'MSG02(0),2(R14)
         EX    R1,*-6
         LA    R15,1(R1,R15)
         MVC   0(L'MSG02A,R15),MSG02A
         LA    R0,L'MSG02+L'MSG02A+1(,R1)
         LA    R1,MSGWK
         BAL   R14,PUTMSG          NOT IN CATALOG
         B     NEXTDSN
DEF24    EQU   *
DEF28    EQU   *
DEF32    EQU   *
DEF36    EQU   *
         LA    R1,MSG03
         LA    R0,L'MSG03
         BAL   R14,PUTMSG          ERROR IN DEFAULT SERVICE ROUTINE
         B     NEXTDSN
         SPACE
DEFP     MVI   DSNAME,C' '
         MVC   DSNAME+1(45),DSNAME
         L     R15,CPPLUPT
         USING UPT,R15
         SR    R0,R0               INITIAL LENGTH OF PREFIX AND PERIOD
         SR    R1,R1
         IC    R1,UPTPREFL         LENGTH OF PREFIX
         LTR   R1,R1               IF PROFILE NOPREFIX
         BZ    DEFP1                  SKIP PREFIX
         BCTR  R1,0                LENGTH MINUS 1 FOR EX
         B     *+10
         MVC   DSNAME+2(0),UPTPREFX  (EXECUTED)
         EX    R1,*-6              MOVE PREFIX TO DSNAME+2
         LA    R1,1(,R1)           RESTORE LENGTH
         LA    R15,DSNAME+2(R1)    POINT PAST PREFIX
         DROP  R15                 UPT
         MVI   0(R15),C'.'         APPEND PERIOD
         LA    R0,1(,R1)           SET LENGTH OF PREFIX PLUS PERIOD
DEFP1    LA    R15,DSNAME+2        RESET R15 IN CASE HERE VIA BRANCH
         AR    R15,R0              POINT PAST PREFIX
         LH    R1,4(,R8)           GET LENGTH
         AR    R1,R0               PLUS LENGTH OF PREFIX
         STH   R1,DSNAME
         SR    R1,R0               MINUS LENGTH OF PREFIX
         L     R14,0(,R8)          GET ADDRESS OF NAME
         BCTR  R1,0                LENGTH MINUS 1 FOR EX
         B     *+10
         MVC   0(0,R15),0(R14)
         EX    R1,*-6
DEF00    EQU   *
DEFX     EQU   *
         SPACE
************************************************************
*                                                          *
*        ALLOCATE THE DATASET                              *
*                                                          *
************************************************************
         SPACE
         LA    R1,MYDAPL
         USING DAPL,R1
         MVC   DAPLUPT(4),CPPLUPT
         MVC   DAPLECT(4),CPPLECT
         LA    R0,MYECB
         ST    R0,DAPLECB
         MVC   DAPLPSCB(4),CPPLPSCB
         LA    R15,MYDAPB
         ST    R15,DAPLDAPB
         DROP  R1
         USING DAPB08,R15
         XC    0(84,R15),0(R15)
         MVI   DA08CD+1,X'08'
         LA    R0,DSNAME
         ST    R0,DA08PDSN
         MVC   DA08DDN(8),=CL8' '
         MVC   DA08UNIT,UNITN
         MVC   DA08SER,VOLSER
         MVC   DA08MNM,=CL8' '
         MVC   DA08PSWD,=CL8' '
         MVI   DA08DSP1,DA08SHR
         MVI   DA08DPS2,DA08KEEP
         MVI   DA08DPS3,DA08KEP
         TM    22(R8),X'80'        PASSWORD SPECIFIED?
         BZ    PASSX               NO - BRANCH
         LH    R1,20(,R8)          GET LENGTH OF PSWD
         BCTR  R1,0                MINUS 1 FOR EX
         L     R14,16(,R8)         GET ADDRESS OF PSWD
         B     *+10
         MVC   DA08PSWD(0),0(R14)  MOVE PSWD
         EX    R1,*-6
PASSX    EQU   *
         LA    R1,MYDAPL
         SPACE
         BAL   R14,CALLDAIR
         LTR   R15,R15
         BZ    OKDAIR
         BAL   R14,DAIRFAIL
         LA    R15,12
         B     NEXTDSN
OKDAIR   EQU   *
         OI    CLEANUP,X'40'       TELL CLEANUP TO FREE IT
         LA    R15,MYDAPB
         MVC   DDSAVE,DA08DDN
         TM    DA08DSO,X'02'       IS DSORG PARTITIONED?
         BO    OKDSORGP            YES - BRANCH
*
*              DSORG IS NOT PO
*              PS=X'40' ISAM=X'80' DA=X'20' VSAM=X'00' NONE=X'00'
*
         LA    R1,MSG06
         LA    R0,L'MSG06
         BAL   R14,PUTMSG          DATA SET NOT PARTITIONED
         LA    R15,12
         B     NEXTDSN
OKDSORGP EQU   *
         DROP  R15
         SPACE
************************************************************
*                                                          *
*        SET UP THE DCB                                    *
*                                                          *
************************************************************
         SPACE
         MVC   DCB(DCBLEN),DCBMODEL
         LA    R4,DCB
         USING IHADCB,R4
         MVC   DCBDDNAM(8),DDSAVE
         LA    R15,DYNEOD
         IC    R0,DCBEODAD-1
         ST    R15,DCBEODAD-1
         STC   R0,DCBEODAD-1
         LA    R15,DYNSYNAD
         IC    R0,DCBSYNAD-1
         ST    R15,DCBSYNAD-1
         STC   R0,DCBSYNAD-1
         MVC   OPEND(4),OPEN
         SPACE
         OPEN  ((R4),INPUT),MF=(E,OPEND)
         SPACE
         TM    DCBOFLGS,X'10'
         BO    OKOPEN
         LA    R1,MSG04
         LA    R0,L'MSG04
         BAL   R14,PUTMSG          UNABLE TO OPEN
         LA    R15,12
         B     NEXTDSN
OKOPEN   EQU   *
         OI    CLEANUP,X'80'       TELL CLEANUP TO CLOSE IT
         SPACE
SYSTEM1  EQU   *
         MVI   SPFHDRS,0           SET SPF HEADER SWITCH
         SPACE
         CLI   PLUSKW+1,1          WAS PLUS(MEMBER,MEMBER...) SPECIFIED
         BNE   PLUSNO              NO, BRANCH
         LA    R0,PLUS             YES, PUT THE PDE
         ST    R0,PLUSPTR           ADDRESS IN THE POINTER FIELD
PLUSNO   EQU   *
         SPACE
***********************************************************************
*                                                                     *
*         IF SLPA SPECIFIED, SEE IF MEMBER IS IN LPA                  *
*                                                                     *
***********************************************************************
         SPACE
MEMLOOP  EQU   *
         TM    OPTION1,OPT1L       SLPA?
         BZ    LPAX1               NO, BRANCH
*
*
*
         LA    R0,MEMBER8
         SR    R1,R1
         IDENTIFY EPLOC=(0),ENTRY=(1)
         LR    R6,R15
         CH    R15,=H'8'           IN JPAQ/LPAQ
         BE    IDENTIF1
         CH    R15,=H'20'          IN JPAQ/LPAQ
         BNE   IDENTIFX
IDENTIF1 LA    R1,MSGWK
         MVI   MSGWK,C' '
         MVC   MSGWK+1(L'MSGWK-1),MSGWK
         MVC   0(7,R1),MSG08
         LA    R15,7(,R1)
         MVC   0(8,R15),MEMBER8
         AH    R15,MEMBERL
         MVC   1(L'MSG14,R15),MSG14
         LA    R15,L'MSG14+1-3(,R15)
         CH    R6,=H'20'
         BNE   *+10
         MVC   0(3,R15),=C'20)'    SHOW RC 20 FROM IDENTIFY
         LA    R15,3(,R15)
         LR    R0,R15
         LA    R1,MSGWK
         SR    R0,R1
         BAL   R14,PUTMSG          MEMBER FOUND IN LPA
IDENTIFX EQU   *
*
*              CALL IEAVVMSR TO SEARCH LPA DIRECTORY
*
*                  REGS 0 AND 1 - CONTAIN NAME
*                  REG 3        - CVT
*                  REGS 6 7 8 9 - WORK REGS
*                  REG 14       - RETURN - BAD RETURN 4(14)
*                  REG 0        - POINTS TO LPDE AFTER GOOD RETURN
*
         LM    R0,R1,MEMBER8
         STM   R7,R8,LPAREGS
         LR    R5,R9              SAVE R9
         L     R3,16              CVTPTR
         L     R15,352(,R3)       CVTLPDSR
         BALR  R14,R15            CALL IEAVVMSR
         B     LPAFOUND
         B     LPANOTFO
LPAFOUND LR    R9,R5
         LM    R7,R8,LPAREGS
         LR    R6,R0
         B     LPAMSG
LPANOTFO LR    R9,R5
         LM    R7,R8,LPAREGS
         SR    R6,R6
LPAMSG   L     R3,MYANS            RESTORE R3
         LA    R1,MSGWK
         MVI   MSGWK,C' '
         MVC   MSGWK+1(L'MSGWK-1),MSGWK
         MVC   0(7,R1),MSG08
         LA    R15,7(,R1)
         MVC   0(8,R15),MEMBER8
         AH    R15,MEMBERL
         LTR   R6,R6               LPDE FOUND
         BZ    LPAMSG2             NO, BRANCH
         MVC   1(L'MSG12A,R15),MSG12A
         LA    R15,L'MSG12A+1(,R15)
         LA    R15,MSGWK+40
         MVC   0(35,R15),=C'LPDE XXXXXX, EP XXXXXX, ADDR XXXXXX'
*        MVC   0(35,R15),=C'LPDE XXXXXX, EP XXXXXX, IN XXXXXXXX'
         LA    R15,05(,R15)
         ST    R6,DOUBLE
         LA    R1,DOUBLE+1
         LA    R0,3
         BAL   R14,UNPACK
         MVI   0(R15),C','
         SPACE
         LA    R15,05(,R15)
         LA    R1,17(,R6)
         LA    R0,3
         BAL   R14,UNPACK
         MVI   0(R15),C','
         SPACE
         TM    28(R6),X'04'        IS THIS AN ALIAS
         BO    LPALIAS             YES
         SPACE
         LA    R15,07(,R15)
         LA    R1,37(,R6)
         LA    R0,3
         BAL   R14,UNPACK
         MVI   0(R15),C' '
         B     LPAMSG1
         SPACE
LPALIAS  LA    R15,2(,R15)
         MVC   0(03,R15),=C'IN '
         MVC   3(8,R15),32(R6)
         LA    R15,12(,R15)
         SPACE
LPAMSG1  LR    R0,R15
         LA    R1,MSGWK
         SR    R0,R1
         BAL   R14,PUTMSG          MEMBER FOUND IN LPA
         SR    R15,R15
         TM    OPTION2,OPT2L       LIST KEYWORD
         BZ    NEXTMEM
         MVC   MSGWK(6),=C'  +0  '
         L     R1,16(,R6)
         MVC   MSGWK+6(48),0(R1)
         TR    MSGWK+6(48),PERIODS
         LA    R1,MSGWK
         LA    R0,6+48
         BAL   R14,PUTLINE
         SR    R15,R15
         B     NEXTMEM
LPAMSG2  MVC   1(L'MSG12B,R15),MSG12B
         LA    R15,L'MSG12B+1(,R15)
         LR    R0,R15
         LA    R1,MSGWK
         SR    R0,R1
         BAL   R14,PUTMSG          MEMBER NOT FOUND IN LPA
         LA    R15,12
         B     NEXTMEM
LPAX1    EQU   *
         SPACE
***********************************************************************
*                                                                     *
*         ISSUE BLDL FOR MEMBER                                       *
*                                                                     *
***********************************************************************
         SPACE
         MVI   SYNADSW,0           SET SYNAD SWITCH OFF
         SPACE
         LA    R15,BLDLW
         XC    0(62,R15),0(R15)    CLEAR BLDL LIST
         MVI   1(R15),1            NUMBER OF ENTRIES
         MVI   3(R15),58           MAXIMUM LENGTH EXPECTED
         MVC   4(8,R15),MEMBER8
         LR    R0,R15              POINT R0 TO LIST
         SPACE
         BLDL  (R4),(0)
         SPACE
         CLI   SYNADSW,0           WAS SYNAD EXIT TAKEN?
         BE    OKIO                NO - BRANCH
ERRSYNAD LA    R1,SYNADMSG
         LA    R0,78
         BAL   R14,PUTMSG
         LA    R15,12
         B     NEXTDSN
OKIO     EQU   *
         LTR   R15,R15
         BZ    OKBLDL
NOTINSYS LA    R1,MSGWK
         MVC   0(7,R1),MSG08
         LA    R15,7(,R1)
         MVC   0(8,R15),MEMBER8
         AH    R15,MEMBERL
         MVC   1(L'MSG08A,R15),MSG08A
         LA    R15,L'MSG08A+1(,R15)
         LR    R0,R15
         SR    R0,R1
         BAL   R14,PUTMSG          MEMBER NOT FOUND
         LA    R15,12
         B     NEXTMEM
         SPACE
***********************************************************************
*                                                                     *
*         BLDL WAS SUCCESSFUL                                         *
*                                                                     *
***********************************************************************
         SPACE
OKBLDL   EQU   *
         LA    R6,MSGWH
         MVI   0(R6),C' '
         MVC   1(L'MSGWH-1,R6),0(R6)
         MVC   0(L'MSG09,R6),MSG09
         LA    R6,L'MSG09(,R6)
         LA    R5,L'MSG09
         SPACE
         LA    R1,BLDLW+4
         LA    R15,BLDLX
         LA    R0,60
         BAL   R14,UNPACK          CONVERT TO HEX
         SPACE
         MVI   MSGWK,C' '
         MVC   MSGWK+1(L'MSGWK-1),MSGWK
         LA    R7,BLDLW+4
         USING PDS,R7
         LA    R8,BLDLX
         MVC   MSGWK+2(8),PDSMEMBR
         SPACE
         MVC   MSGWK+11(6),(2*(PDSTTR-PDS))(R8)
         SPACE
         MVC   MSGWK+18(2),=C'NO'  SET ALIAS 'NO'
         TM    PDSINDIC,X'80'      ALIAS?
         BZ    *+10                NO - BRANCH
         MVC   MSGWK+18(3),=C'YES' YES - MOVE YES
         SPACE
         MVI   MSGWK+24,C'0'       NO. OF TTR'S
         TM    PDSINDIC,B'01100000'
         BZ    FMT1
         MVI   MSGWK+24,C'3'       NOT ZERO - TRY 3
         BO    FMT1                BRANCH IF 3
         MVI   MSGWK+24,C'1'       NOT 3 - TRY 1
         TM    PDSINDIC,B'00100000'
         BO    FMT1                BRANCH IF 1
         MVI   MSGWK+24,C'2'       MUST BE 2
FMT1     EQU   *
         SPACE
         SLR   R1,R1
         IC    R1,PDSINDIC
         STC   R1,BYTE
         NI    BYTE,B'00011111'    ISOLATE LAST 5 BITS
         IC    R1,BYTE
         STH   R1,USERLEN
         LA    R1,USERLEN+1
         LA    R15,MSGWK+29
         LA    R0,1
         BAL   R14,UNPACK
         SPACE
         LH    R0,USERLEN
         LTR   R0,R0               LENGTH ZERO?
         BZ    NOTLINK             YES - BRANCH
         CH    R0,=H'11'           LESS THAN 11 HALFWORDS?
         BL    NOTLINK             YES - NOT CREATED BY LINK EDITOR
*                                  COULD BE SPF-CREATED MEMBER
*                                  (15 HALFWORDS), SO CHECK TTR BITS
         TM    PDSINDIC,B'01100000' ANY TTR'S IN USER DATA AREA?
         BZ    NOTLINK             NO, NOT CREATED BY LINKAGE EDITOR
         SPACE
         XC    LINKOFF(16),LINKOFF
         LA    R15,33+2            SET OFFSET PAST REQUIRED DATA
*              NOTE: EXTRA 2 BYTES AT OFFSET 11 INSERTED BY BLDL.
         MVI   MODES,0
         TM    PDSATTV,X'80'       VS?
         BZ    MODEX               NO, NO MODES
         MVC   MODES,PDSATTV+1     SAVE RMODE AND AMODES
MODEX    EQU   *
         TM    PDSATTR1,X'04'      SCATTER DATA PRESENT?
         BZ    NOOFF1              NO - BRANCH
*              SCATTER DATA IS PRESENT,
*              SO 8 BYTES OF SCATTER INFO ARE AT OFFSET IN R15
         ST    R15,LINKOFF1        YES - SAVE OFFSET
         OI    LINKOFF1,X'80'      SET SWITCH
         LA    R15,8(,R15)         INCREMENT OFFSET PAST SCATTER DATA
NOOFF1   TM    PDSINDIC,X'80'      ALIAS?
         BZ    NOOFF2              NO - BRANCH
*              IT'S AN ALIAS. SWAP THE AMODE BITS
*              SO THE LAST 2 (WHICH ARE THE ONLY ONES WE SHOW, AND
*              ARE NORMALLY FOR THE MAIN EP) ARE FOR THE ALIAS.
         IC    R0,MODES
         N     R0,=A(X'03')        ISOLATE MAIN AMODE
         IC    R1,MODES
         N     R1,=A(X'0C')        ISOLATE ALIAS AMODE
         IC    R14,MODES
         N     R14,=A(X'F0')       ERASE ALL 4 AMODE BITS FROM R14
         SLL   R0,2                SHIFT MAIN TO ALIAS
         SRL   R1,2                SHIFT ALIAS TO MAIN
         OR    R1,R0               COMBINE SWAPPED AMODES INTO R1
         OR    R14,R1              COMBINE AMODES WITH RMODE
         STC   R14,MODES
*              CHECK FOR PRESENCE OF 11 BYTES OF ALIAS DATA
         TM    PDSATTV,X'80'       VS?
         BO    YSOFF2              YES - ALIAS DATA IS PRESENT
         TM    PDSATTR1,X'C0'      OS - IS IT RENT OR REUS?
         BZ    NOOFF2              NO - BRANCH
*              IT'S AN ALIAS AND VS, OR
*              IT'S AN ALIAS NOT VS BUT RENT-OR-REUS,
*              SO 11 BYTES OF ALIAS INFO ARE AT OFFSET IN R15
YSOFF2   EQU   *
         LH    R14,USERLEN         NUMBER OF HALFWORDS OF USERDATA
         SLL   R14,1               NUMBER OF BYYTES OF USERDATA
         LA    R14,14(,R14)        PLUS 8,3,1,1,1 (NAME, TTR, C, L, I)
         SR    R14,R15             MINUS OFFSET OF ALIAS DATA
         CH    R14,=H'11'          ARE THERE AT LEAST 11 BYTES LEFT
         BL    NOOFF2              NO, ALIAS IS MISSING ITS INFO
         ST    R15,LINKOFF2        SAVE OFFSET OF ALIAS DATA
         OI    LINKOFF2,X'80'      SET SWITCH
         LA    R15,11(,R15)        SET OFFSET PAST ALIAS DATA
NOOFF2   TM    PDSATTV,X'80'       VS BIT ON?
         BNO   OFF3OS              NO - OS - BRANCH
         TM    PDSATTV,X'10'       IS VS SSI BIT ON?
         BO    YSOFF3              YES - BRANCH
         B     NOOFF3              NO - BRANCH AROUND OS LOGIC
OFF3OS   LR    R14,R15             COPY OFFSET INTO WORK REG
         STC   R14,BYTE            SAVE OFFSET FOR EVEN/ODD CHECK
         TM    BYTE,X'01'          IS IT ODD?
         BZ    *+8                 NO - LEAVE IT
         LA    R14,1(,R14)         YES - ADD 1
         SH    R14,=H'14'          SUBTRACT LENGTH OF NON USER-DATA
         SRL   R14,1               DIVIDE BY 2 FOR NO. OF HALFWORDS
         CH    R14,USERLEN         IS COMPUTED LENGTH TOO SHORT?
         BNL   NOOFF3              NO - THERE MUST NOT BE ANY SSI
*              IT'S VS AND THE SSI BIT IS ON, OR
*              IT'S NOT VS AND THE LENGTH OF THE USER DATA IS LONGER
*               THAN THE OFFSET IN R15,
*              SO 4 BYTES OF SSI INFO ARE AT OFFSET IN R15
*               (UNLESS THE OFFSET IS ODD, IN WHICH CASE A PAD BYTE
*                PLUS 4 BYTES OF SSI INFO ARE AT OFFSET IN R15)
YSOFF3   STC   R15,BYTE            START EVEN/ODD CHECK
         TM    BYTE,X'01'          IS IT ODD?
         BZ    *+8                 NO - BRANCH
         LA    R15,1(,R15)         YES - MAKE IT EVEN, (HALFWORD)
         ST    R15,LINKOFF3        SAVE OFFSET OF SSI
         OI    LINKOFF3,X'80'      SET SWITCH
         LA    R15,4(,R15)         INCREMENT OFFSET PAST SSI
*                R15 NOW HAS THE OFFSET TO THE AUTHORIZATION INFO.
NOOFF3   TM    PDSATTV,X'80'       IS VS BIT ON?
         BZ    NOOFF4              NO - BRANCH
         TM    PDSATTV,X'08'       IS VS APF BIT ON?
         BZ    NOOFF4              NO - BRANCH
         ST    R15,LINKOFF4        SAVE OFFSET OF APF CODE
         OI    LINKOFF4,X'80'      SET SWITCH
NOOFF4   EQU   *
         MVC   0(L'MSG09A,R6),MSG09A
         LA    R5,L'MSG09A(,R5)
         MVC   MSGWK+33(4),(2*(PDSATTR-PDS))(R8)
         MVC   MSGWK+38(6),(2*(PDSSIZE-PDS))(R8)
         MVC   FULL+1(3),PDSSIZE
         MVI   FULL,0
         L     R1,FULL
         NC    FULL,=X'FFFFFC00'  SET OFF BITS UNDER 1 K
         CL    R1,FULL            WERE ANY BITS SET OFF?
         SRL   R1,10              SHIFT OUT BITS UNDER 1 K
         BE    SIZER              BRANCH ON CONDITION SET BY 'CL'
         LA    R15,10
         CLR   R1,R15             IF OVER 10K, ROUND TO NEAREST K
         BH    SIZERUP            BRANCH IF OVER
         MVC   FULL+1(3),PDSSIZE
         NC    FULL,=X'000003FF'  SET OFF ALL EXCEPT UNDER 1 K
         L     R15,FULL
         SLR   R14,R14            SET UP REG PAIR FOR DIVIDE
         D     R14,=F'100'        DIVIDE BY 100
         LA    R15,1(,R15)        ROUND THE QUOTIENT UP
         CH    R15,=H'9'          GREATER THAN 9?
         BNH   *+8                NO - LEAVE IT
         LA    R15,9              YES - MAKE IT 9
         MH    R1,=H'10'          MULTIPLY K BY 10
         ALR   R1,R15             ADD TENTH-OF-K UNITS TO K
         CVD   R1,DOUBLE
         LA    R15,MSGWK+45
         MVC   0(8,R15),=X'40202020214B2040'
         ED    0(7,R15),DOUBLE+5
         MVI   0(R15),C'('
         B     SIZLOOP
         SPACE
SIZERUP  AH    R1,=H'1'           SOME BITS WERE SET OFF - ADD 1 K
SIZER    CVD   R1,DOUBLE          CONVERT K TO DECIMAL
         LA    R15,MSGWK+45
         MVC   0(8,R15),=X'4020202020202120'
         ED    0(8,R15),DOUBLE+4
         MVI   0(R15),C'('
SIZLOOP  CLI   1(R15),C' '
         BNE   SIZLX
         MVC   1(6,R15),2(R15)
         MVI   7(R15),C' '
         B     SIZLOOP
SIZLX    CLI   1(R15),C' '
         BE    SIZLX2
         LA    R15,1(,R15)
         B     SIZLX
SIZLX2   MVI   1(R15),C'K'
         MVI   2(R15),C')'
         SPACE
         MVC   MSGWK+54(6),=C'ABSENT'
         TM    LINKOFF3,X'80'      IS SSI PRESENT?
         BZ    NOSSI               NO - BRANCH
         LH    R15,LINKOFF3+2      GET OFFSET TO SSI
         SLL   R15,1               DOUBLE IT (FOR HEX)
         LA    R15,0(R15,R8)       POINT TO HEX COPY
         MVC   MSGWK+54(8),0(R15)  MOVE HEX COPY
NOSSI    EQU   *
         SPACE
         LA    R15,MSGWK+64
         TM    PDSATTR1,X'80'
         BZ    *+14
         MVC   0(3,R15),=C'RE,'
         LA    R15,3(,R15)
         TM    PDSATTR1,X'40'
         BZ    *+14
         MVC   0(3,R15),=C'RU,'
         LA    R15,3(,R15)
         TM    PDSATTR2,X'01'
         BZ    *+14
         MVC   0(3,R15),=C'RF,'
         LA    R15,3(,R15)
         TM    PDSATTR1,X'20'
         BZ    *+14
         MVC   0(5,R15),=C'OVLY,'
         LA    R15,5(,R15)
         TM    PDSATTR1,X'10'
         BZ    *+14
         MVC   0(5,R15),=C'TEST,'
         LA    R15,5(,R15)
         TM    PDSATTR1,X'08'
         BZ    *+14
         MVC   0(3,R15),=C'OL,'
         LA    R15,3(,R15)
         TM    PDSATTR1,X'04'
         BZ    *+14
         MVC   0(5,R15),=C'SCTR,'
         LA    R15,5(,R15)
         TM    PDSATTR1,X'02'
         BO    *+14
         MVC   0(4,R15),=C'NEX,'
         LA    R15,4(,R15)
         TM    PDSATTR2,X'08'
         BZ    *+14
         MVC   0(3,R15),=C'NE,'
         LA    R15,3(,R15)
         TM    PDSATTR2,X'80'
         BO    *+14
         MVC   0(3,R15),=C'DC,'
         LA    R15,3(,R15)
         TM    PDSATTR2,X'04'
         BZ    *+14
         MVC   0(4,R15),=C'SYM,'
         LA    R15,4(,R15)
         TM    PDSATTV,X'A0'
         BNO   *+14
         MVC   0(5,R15),=C'PAGE,'
         LA    R15,5(,R15)
         SPACE
         TM    LINKOFF4,X'80'      IS APF PRESENT?
         BZ    APF1X               NO - BRANCH
         LH    R14,LINKOFF4+2      GET OFFSET TO APF
         LA    R14,0(R14,R7)       POINT TO APF
         CLC   0(2,R14),=X'0101'   IS IT AC(1)?
         BNE   APF1X               NO - BRANCH
         MVC   0(5,R15),=C'AC=1,'
         LA    R15,5(,R15)
APF1X    EQU   *
         BCTR  R15,0               POINT TO LAST COMMA
         MVI   0(R15),C' '         BLANK OUT LAST COMMA
         SPACE
         LA    R1,MSGWH
         LR    R0,R5
         BAL   R14,PUTLINE         WRITE FIRST HEADER
         LA    R1,MSGWK
         LR    R0,R15
         SR    R0,R1
         BAL   R14,PUTLINE         WRITE LOAD MODULE BASIC INFO
         SPACE
************************************************************
*                                                          *
*         ESOTERIC                                         *
*                                                          *
************************************************************
         SPACE
         TM    OPTION1,OPT1E       'ESOTERIC' SPECIFIED?
         BZ    NOESO               NO - BRANCH
         LA    R1,MSG11
         LA    R0,L'MSG11
         TM    LINKOFF2,X'80'      ALIAS DATA PRESENT?
         BO    *+8                 YES - BRANCH
         LA    R0,56               NO - TRUNCATE HEADER         +13.RA.
         BAL   R14,PUTLINE
         MVC   MSGWK+1(L'MSGWK-1),MSGWK
         MVC   MSGWK+2(6),(2*(PDSTTRT-PDS))(R8)
         MVC   MSGWK+10(6),(2*(PDSTTRN-PDS))(R8)
         MVC   MSGWK+18(2),(2*(PDSTTRNO-PDS))(R8)
         MVC   MSGWK+22(4),(2*(PDSFTXTL-PDS))(R8)
         MVC   MSGWK+28(6),(2*(PDSENTRY-PDS))(R8)
*        MVC   MSGWK+36(2),(2*(PDSATTV-PDS))(R8)
         MVC   MSGWK+36(6),(2*(PDSATTV-PDS))(R8)
         SPACE
         MVC   MSGWK+44(7),=C'(24/24)'
         TM    MODES,X'13'         IF ALL BITS OFF
         BZ    MODEY                  24/24 AND KEEP PARENS
         MVI   MSGWK+44,C' '
         MVI   MSGWK+44+6,C' '
         TM    MODES,X'10'
         BNO   *+10
         MVC   MSGWK+44(3),=C'ANY' RMODE ANY
         TM    MODES,X'03'
         BZ    MODEY               AMODE 24 IMPLICIT
         MVC   MSGWK+44+4(3),=C'ANY' AMODE ANY
         BO    MODEY
         MVC   MSGWK+44+4(3),=C'31 ' AMODE 31
         TM    MODES,X'02'
         BO    MODEY
         MVC   MSGWK+44+4(3),=C'24 ' AMODE 24 EXPLICIT
MODEY    LA    R15,MSGWK+53                                     +13.RA.
         MVI   0(R15),C'*'
         TM    LINKOFF4,X'80'      IS APF PRESENT?
         BZ    APFX                NO - BRANCH
         LH    R14,LINKOFF4+2      GET OFFSET TO APF
         LA    R14,0(R14,R7)       POINT TO APF
         MVI   0(R15),C'0'
         CLC   0(2,R14),=X'0100'   IS IT AC(0)?
         BE    APFX                YES - BRANCH
         MVI   0(R15),C'1'
         CLC   0(2,R14),=X'0101'   IS IT AC(1)?
         BE    APFX                YES - BRANCH
         MVI   0(R15),C'?'         SOMETHING UNEXPECTED
APFX     EQU   *
         SPACE
         TM    LINKOFF2,X'80'      ALIAS DATA PRESENT?
         BZ    NOESOA              NO - BRANCH
         LH    R14,LINKOFF2+2
         LA    R1,0(R14,R7)
         MVC   MSGWK+57(8),3(R1)                                +13.RA.
         SLL   R14,1                DOUBLE FOR HEX
         LA    R1,0(R14,R8)
         MVC   MSGWK+67(6),0(R1)                                +13.RA.
NOESOA   EQU   *
         LA    R1,MSGWK
         LA    R0,73                                            +13.RA.
         BAL   R14,PUTLINE
NOESO    EQU   *
         SPACE
************************************************************
*                                                          *
*         DATA (UNFORMATTED)                               *
*                                                          *
************************************************************
         SPACE
         TM    OPTION1,OPT1D       'DATA' SPECIFIED?
         BZ    NODATA              NO - BRANCH
         LA    R1,MSG10
         LA    R0,L'MSG10
         BAL   R14,PUTLINE         WRITE HEADER FOR DATA
         LH    R1,USERLEN
         SLL   R1,2                DOUBLE FOR BYTES, DOUBLE FOR HEX
         BCTR  R1,0
         B     *+10
         MVC   MSGWK+2(0),28(R8)
         EX    R1,*-6
         LA    R0,3(,R1)
         LA    R1,MSGWK
         BAL   R14,PUTLINE
NODATA   EQU   *
         SPACE
************************************************************
*                                                          *
*         WHERE                                            *
*                                                          *
************************************************************
         SPACE
         TM    OPTION1,OPT1S+OPT1W 'SYS' AND 'WHERE' SPECIFIED
         BNO   NOWHERE             BRANCH IF NOT BOTH
         MVI   MSGWK,C' '
         MVC   MSGWK+1(59),MSGWK
         CLI   PDSBLDL2,1          LINKLIST LIBRARY
         BNE   WHRSTEP             NO, BRANCH
         MVC   MSGWK(11),=C'SYSTEM LINK'
         LA    R15,MSGWK+12
         B     WHRCON
WHRSTEP  MVC   MSGWK(13),=C'JOB/TASK/STEP'
         LA    R15,MSGWK+14
WHRCON   SLR   R1,R1
         IC    R1,PDSBLDL1         GET CONCAT NUMBER
         LA    R1,1(,R1)           BASE 0 TO BASE 1
         CVD   R1,DOUBLE
         MVC   0(14,R15),=C'LIBRARY NUMBER'
         LA    R15,15(,R15)
         UNPK  0(3,R15),DOUBLE+6(2)
         OI    2(R15),X'F0'
         LA    R0,2
WHRSUP   CLI   0(R15),C'0'         LEADING ZERO
         BNE   WHRSUPX
         MVC   0(2,R15),1(R15)
         MVI   2(R15),C' '
         BCT   R0,WHRSUP
WHRSUPX  EQU   *
         LA    R1,MSGWK
         LA    R0,60
         BAL   R14,PUTLINE
NOWHERE  EQU   *
         SPACE
************************************************************
*                                                          *
*         LIST / MAP / IDR                                 *
*                                                          *
************************************************************
         SPACE
         TM    OPTION2,OPT2M+OPT2L+OPT2I  MAP,LIST,IDR
         BZ    NOMAP               NO - BRANCH
         TM    OPTION1,OPT1S       'SYSTEM'?
         BO    NOMAP               YES - MAP NOT SUPPORTED
         L     R0,=A(32768)        (COULD BE REDUCED TO BLKSIZE)
         GETMAIN R,LV=(0)
         LR    R5,R1
         SPACE
         TM    OPTION2,OPT2I       'IDR' SPECIFIED?
         BZ    NOIDR1              NO - BRANCH
         L     R0,=A(32768)
         GETMAIN R,LV=(0)
         ST    R1,ESDPTR
NOIDR1   EQU   *
         SPACE
         TM    OPTION2,OPT2L       'LIST' SPECIFIED?
         BZ    NOLIST              NO - BRANCH
         MVC   FULL,PDSTTRT        TTR OF FIRST TEXT BLOCK
         MVI   FULL+3,0
         LA    R0,FULL
         SPACE
         POINT (R4),(0)
         SPACE
LISTREAD MVC   MYDECB(20),LFDECB   MOVE IN MODEL DECB
         SPACE
         READ  MYDECB,SF,(R4),(R5),32760,MF=E
         SPACE
         CHECK MYDECB
         SPACE
         CLI   SYNADSW,0           WAS SYNAD EXIT TAKEN?
         BNE   ERRSYNAD            YES, BRANCH
         MVC   MSGWK(6),=C'  +0  '
         MVC   MSGWK+6(48),0(R5)
         TR    MSGWK+6(48),PERIODS
         LA    R1,MSGWK
         LA    R0,6+48
         BAL   R14,PUTLINE
NOLIST   EQU   *
         SPACE
************************************************************
*                                                          *
*         MAP / IDR                                        *
*                                                          *
************************************************************
         SPACE
         TM    OPTION2,OPT2M+OPT2I 'MAP' OR 'IDR' SPECIFIED
         BZ    MAPX                NO - BRANCH
         SPACE
         LA    R7,BLDLW+4          RESET PDS ADDRESSABILITY
         MVC   FULL,PDSTTR
         MVI   FULL+3,0
         LA    R0,FULL
         SPACE
         POINT (R4),(0)
         SPACE
         MVC   MYDECB(20),LFDECB   MOVE IN MODEL DECB
         MVI   ANYCESD,0
MAPREAD  XC    MYDECB(4),MYDECB    RESET THE ECB
         SPACE
         READ  MYDECB,SF,(R4),(R5),32760,MF=E
         SPACE
         CHECK MYDECB
         SPACE
         CLI   SYNADSW,0           WAS SYNAD EXIT TAKEN?
         BNE   ERRSYNAD            YES, BRANCH
         SPACE
         CLI   0(R5),X'20'         CESD RECORD?
         BE    HAVCESD             YES - BRANCH
         TM    ANYCESD,1           IF NO CESD YET
         BZ    MAPREAD                KEEP LOOKING (PAST SYM'S)
         B     MAPX                CESD'S DONE
HAVCESD  OI    ANYCESD,1           SHOW WE GOT SOME CESD
         LH    R6,6(,R5)           GET NUMBER OF BYTES
         TM    OPTION2,OPT2I       IDR
         BZ    NOIDR2
         LH    R15,4(,R5)          GET ESDID OF FIRST ITEM
         SLL   R15,4               MULTIPLY BY 16 TO GET OFFSET
         A     R15,ESDPTR          ADD DICTIONARY ADDRESS TO OFFSET
         BCTR  R6,0                LENGTH CODE FOR EX
         B     *+10
         MVC   0(0,R15),8(R5)      ADD RECORD TO OUR DICTIONARY
         EX    R6,*-6
         LA    R6,1(,R6)           RESTORE LENGTH
NOIDR2   EQU   *
         SRL   R6,4                DIV BY 16 = NO OF ENTRIES
         LTR   R6,R6               ZERO?
         BZ    MAPX                YES - BRANCH
         MVC   ESDID,4(R5)         SAVE ESDID OF FIRST ITEM
         LA    R7,8(,R5)           POINT TO 1ST ENTRY
MAPENTRY EQU   *
         CLI   CNAME,C' '          LOOKING FOR A SPECIFIC CSECT
         BE    MAPALLC             NO, BRANCH
         TM    8(R7),X'0F'         IS THIS AN SD
         BNZ   MAPNEXT             NO, BRANCH
         CLC   CNAME,0(R7)         IS THIS THE ONE
         BNE   MAPNEXT             NO, BRANCH
         MVC   CNAMEID,ESDID       YES, SAVE ITS ESDID
MAPALLC  EQU   *
         TM    OPTION2,OPT2M       MAP
         BZ    MAPREAD             NO, BRANCH
         MVI   MSGWK,C' '
         MVC   MSGWK+1(50),MSGWK
         CLI   0(R7),0             IS THERE A NAME
         BE    *+10                NO, SKIP NEXT INSTRUCTION
         MVC   MSGWK(8),0(R7)      MOVE EXTERNAL NAME
         LA    R15,MAPENTX         POINT TO AREA FOR HEX
         LA    R1,8(,R7)           POINT TO LAST 8 BYTES OF ENTRY
         LA    R1,8(,R7)           POINT TO LAST 8 BYTES OF ENTRY
         LA    R0,8
         BAL   R14,UNPACK
         SPACE
         MVC   BYTE,8(R7)          MOVE TYPE
         NI    BYTE,X'0F'          ZERO 1ST 4 BITS
         LA    R15,=C'SD'
         CLI   BYTE,X'00'
         BE    MAPTYPEX
         LA    R15,=C'PC'
         CLI   BYTE,X'04'
         BE    MAPTYPPC
         LA    R15,=C'CM'
         CLI   BYTE,X'05'
         BE    MAPTYPEX
         TM    OPTION2,OPT2A     MAP(ALL)            .BUGFIX.08APR81.
         BZ    MAPNEXT           NO, BYPASS IT
         LA    R15,=C'LR'
         CLI   BYTE,X'03'
         BE    MAPTYPEX
         LA    R15,=C'PR'
         CLI   BYTE,X'06'
         BE    MAPTYPEX
         LA    R15,=C'NU'
         CLI   BYTE,X'07'
         BE    MAPTYPEX
         LA    R15,=C'ER'
         CLI   BYTE,X'02'
         BE    MAPTYPEX
         LA    R15,=C'WX'
         CLI   BYTE,X'0A'
         BE    MAPTYPEX
         LA    R15,=C'??'
         B     MAPTYPEX
MAPTYPPC TM    8(R7),X'10'         DELETED PC MEANS SEGTAB/ENTAB
         BZ    MAPTYPEX
         MVC   MSGWK(8),=C'-SEGTAB-'
MAPTYPEX MVC   MSGWK+9(2),0(R15)
         MVC   MSGWK+12(2),MAPENTX
         MVC   MSGWK+15(6),MAPENTX+2
         MVC   MSGWK+22(2),MAPENTX+8
         MVC   MSGWK+25(6),MAPENTX+10
         UNPK  MSGWK+33(5),ESDID(3)
         TR    MSGWK+33(4),UNPACKT-240
         MVI   MSGWK+37,C' '
         SPACE
         LA    R1,MSGWK
         LA    R0,37
         BAL   R14,PUTLINE
MAPNEXT  LA    R7,16(,R7)
         LA    R1,1
         AH    R1,ESDID
         STH   R1,ESDID
         BCT   R6,MAPENTRY
         B     MAPREAD
DYNEOD   EQU   *
         B     IDRX
MAPX     EQU   *
         SPACE
************************************************************
*                                                          *
*         IDR                                              *
*                                                          *
************************************************************
         SPACE
         TM    OPTION2,OPT2I       IDR
         BZ    NOIDR3
         CLI   0(R5),X'80'         IDR RECORD
         BE    IDRIN               YES
         TM    0(R5),X'01'         CCW RECORD
         BO    IDRX                YES, THERE ARE NO IDR'S
         B     IDRFIND             NO, READ UNTIL IDR FOUND
         LA    R0,FULL             NO, START BACK AT BEGINNING
         SPACE
         POINT (R4),(0)
         SPACE
IDRFIND  MVC   MYDECB(20),LFDECB   MOVE IN MODEL DECB
IDRFINDR XC    MYDECB(4),MYDECB    RESET THE ECB
         SPACE
         READ  MYDECB,SF,(R4),(R5),32760,MF=E
         SPACE
         CHECK MYDECB
         SPACE
         CLI   SYNADSW,0           WAS SYNAD EXIT TAKEN?
         BNE   ERRSYNAD            YES, BRANCH
         SPACE
         TM    0(R5),X'01'         CCW RECORD
         BO    IDRX                YES, THERE ARE NO IDR'S
         CLI   0(R5),X'80'         IDR RECORD?
         BNE   IDRFINDR            NO, ASSUME NO MORE
IDRIN    EQU   *
IDRENTRY MVI   MSGWK,C' '
         MVC   MSGWK+1(80),MSGWK
         MVC   MSGWK(5),=C'IDR -'
         TM    2(R5),X'01'         ZAP DATA
         BO    IDRZAP
         TM    2(R5),X'02'         LINKAGE EDITOR DATA
         BO    IDRLINK
         TM    2(R5),X'04'         TRANSLATOR DATA
         BO    IDRTRAN
         TM    2(R5),X'08'         USER IDENTIFY
         BO    IDRIDENT
IDRNEXT  EQU   *
         XC    MYDECB(4),MYDECB    RESET THE ECB
         SPACE
         READ  MYDECB,SF,(R4),(R5),32760,MF=E
         SPACE
         CHECK MYDECB
         SPACE
         CLI   SYNADSW,0           WAS SYNAD EXIT TAKEN?
         BNE   ERRSYNAD            YES, BRANCH
         SPACE
IDRNEXTT CLI   0(R5),X'80'         IDR RECORD?
         BE    IDRIN               YES, BRANCH
IDRX     TM    OPTION2,OPT2I       IDR (MAY BE HERE FROM EOF)
         BZ    NOIDR4              NO, BRANCH
         L     R1,ESDPTR
         L     R0,=A(32768)
         FREEMAIN R,LV=(0),A=(1)
NOIDR3   EQU   *
         LR    R1,R5
         L     R0,=A(32768)
         FREEMAIN R,LV=(0),A=(1)
NOIDR4   EQU   *
         SPACE
NOMAP    EQU   *
         TM    OPTION2,OPT2O       LOAD
         BZ    NOLOAD
         LH    R0,USERLEN
         LTR   R0,R0               LENGTH ZERO?
         BZ    LOADCANT            YES - BRANCH
         CH    R0,=H'11'           LESS THAN 11 HALFWORDS?
         BL    LOADCANT            YES - NOT CREATED BY LINK EDITOR
         LA    R7,BLDLW+4                                  (22JUL86)
         TM    PDSINDIC,B'01100000' ANY TTR'S IN USER DATA AREA?
         BZ    LOADCANT            NO, NOT CREATED BY LINKAGE EDITOR
         LOAD  EPLOC=MEMBER8,DCB=(R4),ERRET=LOADFAIL
         DELETE EPLOC=MEMBER8
         LA    R1,=C'LOAD WAS SUCCESSFUL'
         LA    R0,19
         BAL   R14,PUTLINE
         B     NOLOAD
LOADFAIL LA    R1,=C'LOAD FAILED'
         LA    R0,11
         BAL   R14,PUTLINE
         B     NOLOAD
LOADCANT LA    R1,=C'LOAD IGNORED'
         LA    R0,12
         BAL   R14,PUTLINE
NOLOAD   EQU   *
         B     DONEMEM
         SPACE
************************************************************
*                                                          *
*         IDR FOR ZAP                                      *
*                                                          *
************************************************************
         SPACE
IDRZAP   EQU   *
         TM    OPTION3,OPT3Z
         BZ    IDRZAP4
         SLR   R6,R6
         IC    R6,3(,R5)           GET NUMBER OF ACTIVE ENTRIES
         N     R6,=A(X'0000003F')  ISOLATE LAST 6 BITS
         BZ    IDRZAP4             BRANCH IF NONE ACTIVE
         LA    R7,4(,R5)           POINT TO FIRST ENTRY
IDRZAP1  MVC   DOUBLE(2),0(R7)
         LH    R15,DOUBLE          ESDID
         SLL   R15,4               MULTIPLY BY 16 TO GET OFFSET
         A     R15,ESDPTR          ADD DICTIONARY ADDRESS TO OFFSET
         CLI   CNAME,C' '          ARE WE SELECTING A CSECT
         BE    IDRZAP2             NO, PRINT ALL CSECT ZAPS
         CLC   CNAME,0(R15)        IS THIS THE CSECT
         BNE   IDRZAP3             NO, BRANCH
IDRZAP2  MVI   MSGWK,C' '
         MVC   MSGWK+1(80),MSGWK
         MVC   MSGWK(8),0(R15)    MOVE NAME FROM DICTIONARY
         MVC   MSGWK+9(10),=C'ZAPPED    '
         UNPK  MSGWK+21(5),02(3,R7)
         MVC   MSGWK+20(2),MSGWK+21
         MVI   MSGWK+22,C'.'
         MVC   MSGWK+27(8),5(R7)
         LA    R1,MSGWK
         LA    R0,72
         BAL   R14,PUTLINE
IDRZAP3  LA    R7,13(,R7)
         BCT   R6,IDRZAP1
IDRZAP4  TM    OPTION3,OPT3S      SPACE
         BZ    IDRNEXT
         MVI   MSGWK,C' '
         MVC   MSGWK+1(80),MSGWK
         MVC   MSGWK(40),=C'THERE ARE NO EMPTY SLOTS FOR ZAP IDRDATA'
         SR    R0,R0
         IC    R0,1(,R5)          GET LENGTH OF DATA (ALWAYS 250)
         SH    R0,=H'3'           MINUS BYTES AT +1, +2, +3 = 247
         SRDA  R0,32              SHIFT INTO DOUBLE REGISTER FOR DIVIDE
         D     R0,=F'13'          GET NUMBER OF SLOTS (ALWAYS 19)
         IC    R0,3(,R5)          NUMBER OF SLOTS USED
         N     R0,=A(X'0000003F') ISOLATE LAST 6 BITS
         SR    R1,R0              NUMBER OF SLOTS AVAILABLE
         BNP   IDRZAP5
         CVD   R1,DOUBLE
         OI    DOUBLE+7,X'0F'
         UNPK  MSGWK+10(2),DOUBLE+6(2)
         CH    R1,=H'1'           ONE SLOT
         BNE   IDRZAP5            NO, MESSAGE IS READY
         MVC   MSGWK+6(3),=C'IS ' CHANGE ARE TO IS
         MVI   MSGWK+23,C' '      CHANGE SLOTS TO SLOT
IDRZAP5  LA    R1,MSGWK
         LA    R0,40
         BAL   R14,PUTLINE
         B     IDRNEXT
         SPACE
************************************************************
*                                                          *
*         IDR FOR LINKAGE EDITOR                           *
*                                                          *
************************************************************
         SPACE
IDRLINK  EQU   *
         MVC   MSGWK(8),MEMBER8
         LA    R7,3(,R5)
         MVC   MSGWK+9(23),=C'LINKEDITED YY.DDD USING'
         UNPK  MSGWK+21(5),12(3,R7)
         MVC   MSGWK+20(2),MSGWK+21
         MVI   MSGWK+22,C'.'
         MVC   MSGWK+33(10),0(R7)
         MVC   MSGWK+44(7),=C'VERSION'
         SLR   R0,R0
         IC    R0,10(,R7)
         CVD   R0,DOUBLE
         OI    DOUBLE+7,X'0F'
         UNPK  MSGWK+52(2),DOUBLE+6(2)
         IC    R0,11(,R7)
         CVD   R0,DOUBLE
         OI    DOUBLE+7,X'0F'
         UNPK  MSGWK+55(2),DOUBLE+6(2)
         LA    R1,MSGWK
         LA    R0,72
         BAL   R14,PUTLINE
         B     IDRNEXT
         SPACE
************************************************************
*                                                          *
*         IDR FOR TRANSLATORS                              *
*                                                          *
************************************************************
         SPACE
IDRTRAN  EQU   *
         TM    OPTION3,OPT3T
         BZ    IDRNEXT
         XC    IDRLEN,IDRLEN
         L     R0,=A(10240)        GET AN AREA TO MERGE RECORDS IN
         ST    R0,IDRFREE
         GETMAIN R,LV=(0)
         ST    R1,IDRPTR
IDRTRANA L     R15,IDRPTR
         A     R15,IDRLEN
         SR    R6,R6
         IC    R6,1(,R5)           BYTES COUNT (THIS PLUS REST)
         SH    R6,=H'3'
         B     *+10
         MVC   0(0,R15),3(R5)
         EX    R6,*-6              MOVE RECORD TO IDR AREA
         LA    R6,1(,R6)
         A     R6,IDRLEN
         ST    R6,IDRLEN
         XC    MYDECB(4),MYDECB    RESET THE ECB
         READ  MYDECB,SF,(R4),(R5),32760,MF=E
         CHECK MYDECB
         CLI   SYNADSW,0           WAS SYNAD EXIT TAKEN?
         BNE   ERRSYNAD            YES, BRANCH
         CLI   0(R5),X'80'         IDR RECORD?
         BNE   IDRTRANB
         TM    2(R5),X'04'         FOR TRANSLATOR
         BO    IDRTRANA            YES, ADD TO PREVIOUS RECORD
IDRTRANB L     R1,IDRLEN
         A     R1,IDRPTR
         ST    R1,IDRPTRE          STORE END-OF-DATA ADDRESS
         L     R7,IDRPTR
IDRTRANC EQU   *
         CLI   CNAME,C' '          SELECTING A CSECT
         BE    IDRTRANF            NO, BRANCH
         TM    0(R7),X'80'         ONLY ONE ESDID
         BO    IDRTRANF            YES, SWAP NOT NECESSARY
         LR    R6,R7               NO, SWAP SELECTED ESDID WITH FIRST
IDRTRAND MVC   DOUBLE(2),0(R6)     COPY ESDID TO WORK AREA
         NI    DOUBLE,X'7F'        TURN OFF FLAG BIT
         CLC   CNAMEID,DOUBLE      IS THIS THE ONE WE WANT
         BE    IDRTRANE            YES, BRANCH
         TM    0(R6),X'80'         NO, IS THIS THE LAST ONE
         BO    IDRTRANF            YES, NOT FOUND IN THIS SET
         LA    R6,2(,R6)           POINT TO NEXT ESDID
         B     IDRTRAND
IDRTRANE CR    R6,R7               YES, IS IT THE FIRST
         BE    IDRTRANF            YES, NO NEED TO SWAP
         MVC   DOUBLE+2(2),0(R7)   SAVE FIRST ENTRY
         MVC   0(2,R7),DOUBLE      PUT THIS ONE FIRST
         TM    0(R6),X'80'         WAS THIS ONE LAST
         MVC   0(2,R6),DOUBLE+2    MOVE SAVED FIRST ONE HERE
         BZ    *+8                 BRANCH IF NOT LAST
         OI    0(R6),X'80'         RESTORE END BIT
IDRTRANF EQU   *
         SPACE
         MVC   DOUBLE(2),0(R7)
         NI    DOUBLE,X'7F'
         LH    R15,DOUBLE          ESDID
         SLL   R15,4               MULTIPLY BY 16 TO GET OFFSET
         A     R15,ESDPTR          ADD DICTIONARY ADDRESS TO OFFSET
         MVI   MSGWK,C' '
         MVC   MSGWK+1(80),MSGWK
         MVC   MSGWK(8),0(R15)     MOVE NAME FROM DICTIONARY
         MVC   MSGWK+9(23),=C'TRANSLATED YY.DDD USING'
         LA    R1,MSGWK
         BAL   R14,IDRTPC          CHECK FOR PC
         SPACE
         LR    R6,R7               START LOOKING FOR END OF ESDID LIST
IDRTRAN1 TM    0(R6),X'80'         IS THIS THE LAST ONE
         BO    IDRTRAN2            YES, BRANCH
         LA    R6,2(,R6)           NO, BUMP ADDRESS BY 2
         B     IDRTRAN1            KEEP LOOKING
IDRTRAN2 LA    R6,2(,R6)           POINT PAST LAST ONE TO DATA
         TM    15(R6),X'0F'        IF LAST 4 BITS OF DATE NOT F
         BO    IDRTRANQ               IT'S NORMAL
         CLC   11(2,R6),=X'0101'   IF VERSION IS 01 01
         BE    IDRTRANU               IT'S FORTRAN-H 5734-FO3
         MVC   DOUBLE(3),12(R6)    ELSE IT'S THAT CRAZY MSGCRTXT00
         OI    DOUBLE+2,X'0F'      FORCE SIGN BITS
         UNPK  MSGWK+21(5),DOUBLE(3)
         MVC   MSGWK+20(2),MSGWK+21
         MVI   MSGWK+22,C'.'
         MVC   MSGWK+33(10),1(R6)
         B     IDRTRANW            SKIP VERSION
IDRTRANU MVC   DOUBLE(3),13(R6)    FORTRAN-H 0101 HAS A PROBLEM
         OI    DOUBLE+2,X'0F'      FORCE SIGN BITS
         UNPK  MSGWK+21(5),DOUBLE(3)
         B     IDRTRANV
IDRTRANQ UNPK  MSGWK+21(5),13(3,R6)
IDRTRANV MVC   MSGWK+20(2),MSGWK+21
         MVI   MSGWK+22,C'.'
         MVC   MSGWK+33(10),1(R6)
         MVC   MSGWK+44(7),=C'VERSION'
         SLR   R0,R0
         IC    R0,11(,R6)
         CVD   R0,DOUBLE
         OI    DOUBLE+7,X'0F'
         UNPK  MSGWK+52(2),DOUBLE+6(2)
         IC    R0,12(,R6)
         CVD   R0,DOUBLE
         OI    DOUBLE+7,X'0F'
         UNPK  MSGWK+55(2),DOUBLE+6(2)
IDRTRANW CLC   1(9,R6),=C'566896201'
         BNE   *+10
         MVC   MSGWK+58(7),=C'(ASM-H)'
         CLC   1(7,R6),=C'5734AS1'
         BNE   *+10
         MVC   MSGWK+58(8),=C'(ASM-H1)'
         CLC   1(9,R6),=C'5741SC103'
         BNE   *+10
         MVC   MSGWK+58(8),=C'(ASM-XF)'
         CLC   1(9,R6),=C'5688040  '
         BNE   *+10
         MVC   MSGWK+58(3),=C'(C)'
         CLC   1(9,R6),=C'566876701'
         BNE   *+10
         MVC   MSGWK+58(8),=C'(PASCAL)'
         CLC   1(8,R6),=C'5734-FO3'
         BNE   *+10
         MVC   MSGWK+58(8),=C'(FORT-H)'
         CLC   1(9,R6),=C' 5796-PKR'
         BNE   *+10
         MVC   MSGWK+58(9),=C'(FORT-HX)'
         CLC   1(8,R6),=C'5748-FO3'
         BNE   *+10
         MVC   MSGWK+58(9),=C'(VSFORT1)'
         CLC   1(8,R6),=C'5668-806'
         BNE   *+10
         MVC   MSGWK+58(9),=C'(VSFORT2)'
         CLC   1(8,R6),=C'5734-PL1'
         BNE   *+10
         MVC   MSGWK+58(6),=C'(PL/1)'
         CLC   1(4,R6),=C'ASMG'
         BNE   *+10
         MVC   MSGWK+58(7),=C'(ASM-G)'
         CLI   MSGWK+58,C' '
         BNE   *+8
         MVI   MSGWK+58,C'?'
         CLI   CNAME,C' '          SELECTING A CSECT
         BE    IDRTSEL1            NO, BRANCH
         CLC   CNAME,MSGWK         IS THIS THE ONE WE WANT
         BNE   IDRTSUP1            NO, BYPASS DISPLAY
IDRTSEL1 LA    R1,MSGWK
         LA    R0,67
         BAL   R14,PUTLINE
IDRTSUP1 EQU   *
         SPACE
         LA    R15,16(,R6)         POINT TO NEXT ESDID LIST
         CLI   0(R6),X'01'         PLS PRE-COMPILER ID PRESENT
         BNE   IDRTRAN3            NO, BRANCH
         LA    R6,15(,R6)          YES, POINT R6 TO SECOND ENTRY
         TM    OPTION3,OPT3P       IDR(PLS) SPECIFIED
         BZ    IDRTRANP            NO, BRANCH
         CLI   CNAME,C' '          SELECTING A CSECT
         BE    IDRTSEL2            NO, BRANCH
         CLC   CNAME,MSGWK         IS THIS THE ONE WE WANT
         BNE   IDRTRANP            NO, BYPASS DISPLAY
IDRTSEL2 MVI   MSGWK,C' '
         MVC   MSGWK+1(80),MSGWK
         MVC   MSGWK+27(5),=C'USING'
         UNPK  MSGWK+21(5),13(3,R6)
         MVC   MSGWK+20(2),MSGWK+21
         MVI   MSGWK+22,C'.'
         MVC   MSGWK+33(10),1(R6)
         MVC   MSGWK+44(7),=C'VERSION'
         SLR   R0,R0
         IC    R0,11(,R6)
         CVD   R0,DOUBLE
         OI    DOUBLE+7,X'0F'
         UNPK  MSGWK+52(2),DOUBLE+6(2)
         IC    R0,12(,R6)
         CVD   R0,DOUBLE
         OI    DOUBLE+7,X'0F'
         UNPK  MSGWK+55(2),DOUBLE+6(2)
         LA    R1,MSGWK
         LA    R0,57
         BAL   R14,PUTLINE
IDRTRANP LA    R15,16(,R6)         POINT TO NEXT ESDID LIST
         SPACE
IDRTRAN3 ST    R15,IDRPTRC         UPDATE CURRENT POINTER
         TM    0(R7),X'80'         WAS THERE ONLY ONE ESDID
         BO    IDRTRANY            YES, ALREADY DISPLAYED IT
         CLI   CNAME,C' '          ARE WE SELECTING A CSECT
         BNE   IDRTRANY            YES, DONT SHOW OTHER NAMES
         LA    R6,2(,R7)           POINT TO SECOND ESDID
IDRTRAN4 MVI   MSGWK,C' '
         MVC   MSGWK+1(80),MSGWK
         MVC   MSGWK+2(6),=C'ALSO -'
         LA    R1,MSGWK+9
         LA    R0,7                FIT 7 NAMES ON A LINE
IDRTRAN5 MVC   DOUBLE(2),0(R6)
         NI    DOUBLE,X'7F'
         LH    R15,DOUBLE          ESDID
         SLL   R15,4               MULTIPLY BY 16 TO GET OFFSET
         A     R15,ESDPTR          ADD DICTIONARY ADDRESS TO OFFSET
         MVC   0(8,R1),0(R15)      MOVE NAME FROM DICTIONARY
         BAL   R14,IDRTPC          CHECK FOR PC
         LA    R1,9(,R1)           POINT TO NEXT SLOT ON LINE
         TM    0(R6),X'80'         WAS THAT LAST ID IN THIS RECORD
         BO    IDRTRANX            YES, GO LIST THEM
         LA    R6,2(,R6)           NO, POINT TO NEXT ESD ID
         BCT   R0,IDRTRAN5         BRANCH IF LINE NOT FILLED
         LA    R1,MSGWK
         LA    R0,71
         BAL   R14,PUTLINE
         B     IDRTRAN4
IDRTPC   CLC   0(8,R1),=CL8' '     IF NAME IS NOT BLANK
         BNER  R14                    IT'S NOT A PC
         MVC   DOUBLE+7(1),8(R15)  GET TYPE FROM DICTIONARY
         NI    DOUBLE+7,X'0F'      ISOLATE IDENTIFYING BITS
         CLI   DOUBLE+7,X'04'      PC
         BNER  R14
         MVC   0(3,R1),=C'PC('
         UNPK  3(5,R1),DOUBLE(3)
         TR    3(4,R1),UNPACKT-240
         MVI   7(R1),C')'
         BR    R14
IDRTRANX EQU   *
         LA    R1,MSGWK
         LA    R0,71
         BAL   R14,PUTLINE
IDRTRANY L     R7,IDRPTRC          POINT TO NEXT ESDID LIST
         C     R7,IDRPTRE          IS THAT ALL THERE IS
         BL    IDRTRANC            NO, BRANCH
         LM    R0,R1,IDRFREE
         FREEMAIN R,LV=(0),A=(1)
         B     IDRNEXTT            NEXT IDR IS ALREADY READ
         SPACE
************************************************************
*                                                          *
*         IDR FOR IDENTIFY                                 *
*                                                          *
************************************************************
         SPACE
IDRIDENT EQU   *
         TM    OPTION3,OPT3I
         BZ    IDRNEXT
         XC    IDRLEN,IDRLEN
         L     R0,=A(10240)
         ST    R0,IDRFREE
         GETMAIN R,LV=(0)
         ST    R1,IDRPTR
IDRIDENA L     R15,IDRPTR
         A     R15,IDRLEN
         SR    R6,R6
         IC    R6,1(,R5)           BYTES COUNT (THIS PLUS REST)
         SH    R6,=H'3'
         B     *+10
         MVC   0(0,R15),3(R5)
         EX    R6,*-6              MOVE RECORD TO IDR AREA
         LA    R6,1(,R6)
         A     R6,IDRLEN
         ST    R6,IDRLEN
         XC    MYDECB(4),MYDECB    RESET THE ECB
         READ  MYDECB,SF,(R4),(R5),32760,MF=E
         CHECK MYDECB
         CLI   SYNADSW,0           WAS SYNAD EXIT TAKEN?
         BNE   ERRSYNAD            YES, BRANCH
         CLI   0(R5),X'80'         IDR RECORD?
         BNE   IDRIDENB
         TM    2(R5),X'08'         FOR IDENTIFY
         BO    IDRIDENA            YES, ADD TO PREVIOUS RECORD
IDRIDENB L     R1,IDRLEN
         A     R1,IDRPTR
         ST    R1,IDRPTRE          STORE END-OF-DATA ADDRESS
         L     R7,IDRPTR
IDRIDENC MVC   DOUBLE(2),0(R7)
         LH    R15,DOUBLE          ESDID
         SLL   R15,4               MULTIPLY BY 16 TO GET OFFSET
         A     R15,ESDPTR          ADD DICTIONARY ADDRESS TO OFFSET
         MVI   MSGWK,C' '
         MVC   MSGWK+1(80),MSGWK
         MVC   MSGWK(8),0(R15)    MOVE NAME FROM DICTIONARY
         MVC   MSGWK+9(10),=C'IDENTIFIED'
         UNPK  MSGWK+21(5),02(3,R7)
         MVC   MSGWK+20(2),MSGWK+21
         MVI   MSGWK+22,C'.'
         SLR   R1,R1
         IC    R1,5(,R7)
         BCTR  R1,0
         B     *+10
         MVC   MSGWK+27(0),6(R7)
         EX    R1,*-6
         LA    R15,7(R1,R7)        POINT TO NEXT ENTRY
         ST    R15,IDRPTRC
         CLI   CNAME,C' '          SELECTING A CSECT
         BE    IDRISEL1            NO, BRANCH
         CLC   CNAME,MSGWK         IS THIS THE ONE WE WANT
         BNE   IDRISUP1            NO, BYPASS DISPLAY
IDRISEL1 LA    R1,MSGWK
         LA    R0,68
         BAL   R14,PUTLINE
IDRISUP1 L     R7,IDRPTRC          POINT TO NEXT ESDID
         C     R7,IDRPTRE          IS THAT ALL THERE IS
         BL    IDRIDENC            NO, BRANCH
         LM    R0,R1,IDRFREE
         FREEMAIN R,LV=(0),A=(1)
         B     IDRNEXTT            NEXT IDR IS ALREADY READ
         SPACE
************************************************************
*                                                          *
*         NON LOAD-MODULE MEMBERS                          *
*                                                          *
************************************************************
         SPACE
NOTLINK  TM    OPTION1,OPT1D       'DATA' SPECIFIED
         BO    DATAPUT
         CH    R0,=H'15'           SPF LENGTH
         BNE   DATAPUT
         LA    R0,10
         SR    R6,R0
         MVC   0(SPFHDRL,R6),SPFHDR
         LA    R0,SPFHDRL(,R6)
         LA    R1,MSGWH
         SR    R0,R1
         CLI   SPFHDRS,0           HAS HEADER BEEN WRITTEN ONCE
         BNE   *+8                 YES, SKIP IT
         BAL   R14,PUTLINE         WRITE SPF HEADER
         MVI   SPFHDRS,1           INDICATE IT'S BEEN WRITTEN
         SLR   R0,R0
         IC    R0,SPFV             VERSION OF V.M
         CVD   R0,DOUBLE
         OI    DOUBLE+7,X'0F'
         UNPK  MSGWK+24(2),DOUBLE+6(2)
         MVI   MSGWK+26,C'.'
         IC    R0,SPFM             MODIFICATION OF V.M
         CVD   R0,DOUBLE
         OI    DOUBLE+7,X'0F'
         UNPK  MSGWK+27(2),DOUBLE+6(2)
         MVI   MSGWK+29,C' '
         MVC   MSGWK+30(3),MSGWK+29
*        MVC   MSGWK+33(2),(2*(SPFCREDT+1-PDS))(R8)
*        MVI   MSGWK+35,C'.'
*        MVC   MSGWK+36(3),(2*(SPFCREDT+2-PDS))(R8)
         LA    R1,SPFCREDT
         BAL   R14,JULIAN
         MVC   MSGWK+31(8),JULIANO
*        MVC   MSGWK+43(2),(2*(SPFMODDT+1-PDS))(R8)
*        MVI   MSGWK+45,C'.'
*        MVC   MSGWK+46(3),(2*(SPFMODDT+2-PDS))(R8)
         LA    R1,SPFMODDT
         BAL   R14,JULIAN
         MVC   MSGWK+41(8),JULIANO
         MVC   MSGWK+50(2),(2*(SPFMODTM+0-PDS))(R8)
         MVI   MSGWK+52,C'.'
         MVC   MSGWK+53(2),(2*(SPFMODTM+1-PDS))(R8)
         LH    R0,SPFSIZE
         N     R0,=A(X'0000FFFF') USE ALL 16 BITS, NO SIGN
         CVD   R0,DOUBLE
         MVC   MSGWK+55(6),=X'402020202120'
         ED    MSGWK+55(6),DOUBLE+5
         MVC   MSGWK+63(10),SPFID
         LA    R1,MSGWK
         LA    R0,73
         BAL   R14,PUTLINE
         B     DONEMEM
         SPACE
JULIAN   CLC   0(4,R1),JULIANI
         BER   R14
         MVC   JULIANI(4),0(R1)
         MVC   DOUBLE(4),0(R1)
         LH    R0,DOUBLE           GET 00YY
         SLL   R0,4                SHIFT TO 00000YY0
         STH   R0,DOUBLE+6
         OI    DOUBLE+7,X'0F'      SET SIGN
         XC    DOUBLE(6),DOUBLE
         CVB   R0,DOUBLE
         UNPK  JULIANO+6(2),DOUBLE+6(2)
         ST    R0,DOUBLE
         MVC   JULIANW(26),JULIAND SET DAYS PER MONTH
         TM    DOUBLE+3,X'03'      IS YEAR DIVISIBLE BY 4
         BNZ   JULIAN1             NO
         MVI   JULIANW+3,29        YES, CHANGE FEB TO 29
JULIAN1  MVC   DOUBLE+4(4),0(R1)   GET 00YYDDDF
         XC    DOUBLE(6),DOUBLE    GET DDDF
         CVB   R1,DOUBLE           GET DDD IN BINARY
         LA    R15,2               INDEX FOR TABLE
         LR    R0,R15              INDEX INCREMENT
JULIAN2  CH    R1,JULIANW-2(R15)   DAY .LT. OR .EQ. ENTRY
         BNH   JULIAN3             YES, BRANCH
         SH    R1,JULIANW-2(R15)   NO, SUBTRACT ENTRY FROM DDD
         ALR   R15,R0              ADD 2 TO INDEX
         B     JULIAN2             LOOP
JULIAN3  SRL   R15,1               HALVE INDEX TO GET MM
         CVD   R1,DOUBLE           CONVERT DD TO PACKED
         OI    DOUBLE+7,X'0F'      SET SIGN OF DD
         UNPK  JULIANO+3(2),DOUBLE+6(2) UNPACK DD
         CVD   R15,DOUBLE          CONVERT MM TO PACKED
         OI    DOUBLE+7,X'0F'      SET SIGN OF MM
         UNPK  JULIANO+0(2),DOUBLE+6(2) UNPACK MM
         MVI   JULIANO+2,C'/'
         MVI   JULIANO+5,C'/'
         BR    R14
         SPACE
DATAPUT  MVC   0(5,R6),=C'DATA-'
         LA    R1,MSGWH
         LA    R0,5(,R5)
         BAL   R14,PUTLINE         WRITE BASIC HEADER
         LH    R1,USERLEN
         LTR   R1,R1
         BZ    NOTLZRO
         SLL   R1,2
         BCTR  R1,0
         B     *+10
         MVC   MSGWK+L'MSG09(0),28(R8)
         EX    R1,*-6
NOTLZRO  LA    R0,5(R5,R1)
         LA    R1,MSGWK
         BAL   R14,PUTLINE         WRITE BASIC INFO AND DATA
         SPACE
DONEMEM  TM    OPTION1,OPT1T       'TEST' SPECIFIED?
         BZ    NOTESTD
         LA    R1,BLDLX
         LH    R0,USERLEN
         AH    R0,=H'7'            14 OTHER BYTES (NAME, TTR, K, Z, C)
         SLL   R0,2                DOUBLE TO BYTES, DOUBLE FOR HEX
         BAL   R14,PUTLINE         DISPLAY ALL IN HEX FOR TESTING
NOTESTD  EQU   *
         SR    R15,R15
         SPACE
NEXTMEM  CH    R15,RC              IS R15 HIGHEST YET
         BNH   *+8                 NO
         STH   R15,RC              YES, SAVE HIGHEST VALUE
         SPACE
         CLI   PLUSKW+1,1          WAS PLUS(MEMBER,MEMBER..) SPECIFIED
         BNE   PLUSX               NO, BRANCH
         CLI   PLUSPTR,X'FF'       YES, ANY MORE MEMBERS SPECIFIED
         BE    PLUSX               NO, BRANCH
         L     R15,PLUSPTR         YES, POINT TO CURRENT PDE
         MVC   PLUSPTR,8(R15)      SET UP FOR NEXT MEMBER
         MVC   MEMBER8(8),=CL8' '
         LH    R1,4(,R15)          GET LENGTH OF MEMBER
         BCTR  R1,0                MINUS 1 FOR EX
         L     R14,0(,R15)         GET ADDRESS OF MEMBER NAME
         B     *+10
         MVC   MEMBER8(0),0(R14)    MOVE MEMBER NAME
         EX    R1,*-6
         STH   R1,MEMBERL
         B     MEMLOOP
PLUSX    EQU   *
         SPACE
NEXTDSN  CH    R15,RC              IS R15 HIGHEST YET
         BNH   *+8                 NO
         STH   R15,RC              YES, SAVE HIGHEST VALUE
         SPACE
         TM    CLEANUP,X'80'
         BZ    NOCLOSE
         MVC   CLOSED,CLOSE
         CLOSE ((R4)),MF=(E,CLOSED)
         NI    CLEANUP,B'01111111'
NOCLOSE  TM    CLEANUP,X'40'
         BZ    NOFREE
         LA    R1,MYDAPL
         LA    R15,MYDAPB
         USING DAPB18,R15
         XC    0(40,R15),0(R15)
         MVI   DA18CD+1,X'18'
         MVC   DA18DDN,DDSAVE
         MVC   DA18MNM(8),=CL8' '
         MVC   DA18SCLS(2),=CL8' '
         BAL   R14,CALLDAIR        UNALLOCATE
         NI    CLEANUP,B'10111111'
NOFREE   EQU   *
         SPACE
         L     R8,DSNPTR
         CLI   24(R8),X'FF'
         BNE   DSNLOOP
         SPACE
         TM    MYPUTLEP,X'80'     WAS PUTLINE LOADED BY ME?
         BO    NODELETE           NO - USED CVTPUTL - BRANCH
         LA    R0,=CL8'IKJPUTL '
         DELETE EPLOC=(0)
NODELETE EQU   *
         SPACE
         TM    OPTION1,OPT1O       IF OUTFILE IS OPEN
         BZ    NOCLOUT
         MVC   CLOSED,CLOSE
         LA    R8,OUTDCBW
         CLOSE ((R8)),MF=(E,CLOSED)
NOCLOUT  EQU   *
         LH    R15,RC
         B     EXIT
         SPACE
************************************************************
*                                                          *
*         CALL IKJDAIR SERVICE ROUTINE                     *
*                                                          *
************************************************************
         SPACE
CALLDAIR ST    R14,DAIRREGS
         AIF   (NOT &MVS).SKIP4
         L     R15,16
         TM    116(R15),X'13'      IS THIS MVS ?
         BNO   DAIRLINK            BRANCH IF NOT MVS
         TM    X'2DC'(R15),X'80'  CVTDAIR
         BNO   DAIRLINK
         L     R15,X'2DC'(,R15)
         BALR  R14,R15
         B     DAIRFINI
DAIRLINK EQU   *
.SKIP4   ANOP
         LINK  EP=IKJDAIR,SF=(E,LINKAREA)
DAIRFINI L     R14,DAIRREGS
         BR    R14
         SPACE
************************************************************
*                                                          *
*        DYNAMIC ALLOCATION FAILURE ROUTINE                *
*                                                          *
************************************************************
         SPACE
DAIRFAIL ST    R14,MYDFREGS
         AIF   (NOT &MVS).SKIP5
         LA    R1,MYDFPARM
         USING DFDSECTD,R1
         ST    R15,MYDFRC
         LA    R15,MYDFRC
         ST    R15,DFRCP
         LA    R15,MYDAPL
         ST    R15,DFDAPLP
         SLR   R15,R15
         ST    R15,MYJEFF02
         LA    R15,MYJEFF02
         ST    R15,DFJEFF02
         LA    R15,DFDAIR
         STH   R15,MYDFID
         LA    R15,MYDFID
         ST    R15,DFIDP
         SLR   R15,R15
         ST    R15,DFCPPLP
         LINK  EP=IKJEFF18,SF=(E,LINKAREA)
         L     R15,MYDFRC
         DROP  R1
.SKIP5   ANOP
         AIF   (&MVS).SKIP6
         LA    R1,MSGDAIR
         LA    R0,L'MSGDAIR
         BAL   R14,PUTMSG
.SKIP6   ANOP
         L     R14,MYDFREGS
         BR    R14
         SPACE
************************************************************
*                                                          *
*  UNPACK - CONVERT A FIELD TO HEXADECIMAL.                *
*  REG 1 --> INPUT   REG 15 --> OUTPUT                     *
*  REG 0  =  INPUT LENGTH  (OUTPUT IS TWICE PLUS 1 BLANK)  *
*  REG 14 --> RETURN ADDRESS                               *
*                                                          *
************************************************************
         SPACE
UNPACK   MVC   1(1,R15),0(R1)      MOVE BYTE
         UNPK  0(3,R15),1(2,R15)   UNPACK
         TR    0(2,R15),UNPACKT-240
         LA    R15,2(,R15)         INCREMENT OUTPUT PTR
         LA    R1,1(,R1)           INCREMENT INPUT PTR
         BCT   R0,UNPACK           DECREMENT LENGTH, THEN LOOP
         MVI   0(R15),C' '         BLANK THE TRAILING BYTE
         BR    R14                 RETURN TO CALLER
UNPACKT  DC    C'0123456789ABCDEF' TRANSLATE TABLE
         SPACE
************************************************************
*                                                          *
*        PUTMSG ROUTINE                                    *
*                                                          *
************************************************************
         SPACE
PUTMSG   STM   R14,R1,PUTLINS
         XC    MYOLD(8),MYOLD
         XC    MYSEG1(4),MYSEG1
         MVC   MYPTPB(12),MODLPTPM
         LA    R14,1               NO. OF MESSAGE SEGMENTS
         ST    R14,MYOLD
         LA    R14,MYSEG1          POINT TO 1ST SEGMENT
         ST    R14,MYOLD+4
         LR    R14,R0              LENGTH IN R0
         LA    R14,4(,R14)         ADD 4
         LA    R15,MYSEG1+4
         CLC   0(3,R1),=C'IKJ'     IS DATA PRECEEDED BY MESSAGE ID?
         BE    *+16                YES - BRANCH
         LA    R14,1(,R14)         ADD 1 TO LENGTH
         MVI   0(R15),C' '         INSERT LEADING BLANK
         LA    R15,1(,R15)         BUMP POINTER
         STH   R14,MYSEG1
         LR    R14,R0
         BCTR  R14,0
         B     *+10
         MVC   0(0,R15),0(R1)      MOVE MESSAGE IN
         EX    R14,*-6
         L     R15,MYPUTLEP
         LA    R1,MYIOPL
         SPACE
         PUTLINE PARM=MYPTPB,OUTPUT=(MYOLD),ENTRY=(15),MF=(E,(1))
         SPACE
         LM    R14,R1,PUTLINS
         BR    R14
         SPACE
************************************************************
*                                                          *
*        PUTLINE ROUTINE                                   *
*                                                          *
************************************************************
         SPACE
PUTLINE  STM   R14,R1,PUTLINS
         TM    OPTION1,OPT1O
         BO    PUTFILE
         XC    MYSEG1(4),MYSEG1
         MVC   MYPTPB(12),MODLPTPB
         LR    R14,R0              LENGTH IN R0
         LA    R14,4(,R14)         ADD 4
         STH   R14,MYSEG1
         LR    R14,R0
         BCTR  R14,0
         B     *+10
         MVC   MYSEG1+4(0),0(R1)   MOVE TEXT IN
         EX    R14,*-6
         L     R15,MYPUTLEP
         LA    R1,MYIOPL
         SPACE
         PUTLINE PARM=MYPTPB,OUTPUT=(MYSEG1,DATA),ENTRY=(15),MF=(E,(1))
         SPACE
         LM    R14,R1,PUTLINS
         BR    R14
         SPACE
PUTFILE  LR    R14,R0              LENGTH IN R0
         MVI   LINE,C' '
         MVC   LINE+1(L'LINE-1),LINE
         LTR   R14,R14
         BZ    PUTF2
         LA    R0,80
         CR    R14,R0              IF LONGER THAN 80
         BNH   *+6                    THEN
         LR    R14,R0                 TRUNCATE TO 80
         BCTR  R14,0
         EX    R14,PUTFMOVE
PUTF2    LA    R1,OUTDCBW
         LA    R0,LINE
         PUT   (1),(0)
         LM    R14,R1,PUTLINS
         BR    R14
PUTFMOVE MVC   LINE(0),0(R1)      (EXECUTED VIA EX)
         SPACE
EXIT0    SR    15,15
EXIT     LR    1,13
         L     0,@SIZE
         L     13,4(,13)
         ST    15,16(,13)
         FREEMAIN R,A=(1),LV=(0)
         LM    14,12,12(13)
         BR    14
         SPACE
************************************************************
*                                                          *
*        SYNAD EXIT                                        *
*                                                          *
************************************************************
         SPACE
*        THIS ROUTINE IS ENTERED DURING THE 'CHECK' MACRO
*        IF AN I/O ERROR OCCURS.
         SPACE
DYNSYNAD EQU   *
         SYNADAF ACSMETH=BPAM
         MVC   SYNADMSG(78),50(R1)
         MVI   SYNADSW,X'FF'
         SYNADRLS
         BR    R14
         SPACE
************************************************************
*                                                          *
*        CONSTANTS                                         *
*                                                          *
************************************************************
         SPACE
MODLPTPM PUTLINE OUTPUT=(1,TERM,SINGLE,INFOR),                         X
               TERMPUT=(EDIT,WAIT,NOHOLD,NOBREAK),MF=L
         SPACE
MODLPTPB PUTLINE OUTPUT=(1,TERM,SINGLE,DATA),                          X
               TERMPUT=(EDIT,WAIT,NOHOLD,NOBREAK),MF=L
         SPACE
         PRINT NOGEN
         SPACE
DCBMODEL DCB   DDNAME=DYNAM,DSORG=PO,MACRF=(R),                        +
               EODAD=0,SYNAD=0
DCBLEN   EQU   *-DCBMODEL
         SPACE
OUTDCB   DCB   DDNAME=DYNAM,DSORG=PS,MACRF=(PM)
OUTDCBL  EQU   *-OUTDCB
         SPACE
         PRINT GEN
         SPACE
OPEN     OPEN  0,MF=L
         SPACE
CLOSE    CLOSE 0,MF=L
         SPACE
LFDECB   READ  LFDECB1,SF,2,3,4,MF=L
LFDECBL  EQU   *-LFDECB
         SPACE
JULIAND  DC    H'31,28,31,30,31,30,31,31,30,31,30,31,999'
         SPACE
MSG01    DC    C'ERROR IN PARSE SERVICE ROUTINE'
MSG02    DC    C'IKJ58503I DATA SET '
MSG02A   DC    C' NOT IN CATALOG'
MSG03    DC    C'ERROR IN DEFAULT SERVICE ROUTINE'
MSG04    DC    C'UNABLE TO OPEN DATASET'
MSG05    DC    C'IKJ58509I DATA SET NAME REQUIRED WHEN MEMBER IS SPECIF+
               IED'
MSG06    DC    C'ORGANIZATION OF DATA SET MUST BE PARTITIONED'
MSG07    DC    C'MEMBER NOT SPECIFIED'
MSG08    DC    C'MEMBER '
MSG08A   DC    C' NOT FOUND'
MSG09    DC    C'--MEMBER---TTR----ALIAS-TTRN-CNT-'
MSG09A   DC    C'ATTR-STORAGE---------SSI------'
MSG10    DC    C'--DATA--'
*SG11    DC    C'--TTR1----TTR2----OV--LFTX--EP------VS--AC--ALIAS OF--
*              MAINEP-'
*SG11    DC    C'--TTR1----TTR2----OV--LFTX--EP------VS--R/AMODE--AC--A
*              LIAS OF--MAINEP-'
MSG11    DC    C'--TTR1----TTR2----OV--LFTX--EP------VSMRLD--R/AMODE--A+
               C--ALIAS OF--MAINEP-'
MSG12A   DC    C' FOUND IN LPA'
MSG12B   DC    C' NOT FOUND IN LPA DIRECTORY'
MSG14    DC    C' FOUND IN ACTIVE JPAQ/LPAQ (8) '
SPFHDR   DC    C'  V.M    CREATED   LAST MODIFIED  SIZE    ID'
SPFHDRL  EQU   *-SPFHDR
         AIF   (&MVS).SKIP7
MSGDAIR  DC    C'UNABLE TO ALLOCATE DATA SET'
.SKIP7   ANOP
PERIODS  DC    077C'.'                00-76    0-76
         DC    C'(+'                  4D-4E   77-78
         DC    C'.'                      4F      79
         DC    X'50'                     50      80
         DC    10C'.'                 51-5A   81-90
         DC    C'$*)'                 5B-5D   91-93
         DC    02C'.'                 5E-5F   94-95
         DC    C'-/'                  60-61   96-97
         DC    09C'.'                 62-6A   98-106
         DC    C','                   6B      107
         DC    15C'.'                 6C-7A  108-122
         DC    C'#@',X'7D',C'='       7B-7E  123-126
         DC    2C'.'                  7F-80  127-128
         DC    C'ABCDEFGHI'           81-89  129-137
         DC    7C'.'                  8A-90  138-144
         DC    C'JKLMNOPQR'           91-99
         DC    8C'.'                  9A-A1
         DC    C'STUVWXYZ'            A2-A9
         DC    23C'.'                 AA-C0
         DC    C'ABCDEFGHI'           C1-C9
         DC    7C'.'                  CA-D0
         DC    C'JKLMNOPQR'           D1-D9
         DC    8C'.'                  DA-E1
         DC    C'STUVWXYZ'            E2-E9
         DC    06C'.'                 EA-EF
         DC    C'0123456789'          F0-F9
         DC    6C'.'
         LTORG
PCLADDR  DC    0D'0'               END MAIN CSECT, BEGIN PCL CSECT
         SPACE
************************************************************
*                                                          *
*        PARSE PARAMETERS                                  *
*                                                          *
************************************************************
         SPACE
         PRINT NOGEN
MEMPCL   IKJPARM
DSN      IKJPOSIT DSNAME,PROMPT='DATA SET NAME',LIST
UNITKW   IKJKEYWD
         IKJNAME 'UNIT',SUBFLD=UNITSF
VOLKW    IKJKEYWD
         IKJNAME 'VOLUME',SUBFLD=VOLSF
PLUSKW   IKJKEYWD
         IKJNAME 'PLUS',SUBFLD=PLUSSF
DATAKW   IKJKEYWD
         IKJNAME 'DATA'
TESTKW   IKJKEYWD
         IKJNAME 'TEST'
SYSTKW   IKJKEYWD
         IKJNAME 'S'
         IKJNAME 'SYSTEM'
         IKJNAME 'SLPA'
WHEREKW  IKJKEYWD
         IKJNAME 'WHERE'
ESOKW    IKJKEYWD
         IKJNAME 'ESOTERIC'
MAPKW    IKJKEYWD
         IKJNAME 'MAP',SUBFLD=MAPSF
LISTKW   IKJKEYWD
         IKJNAME 'LIST'
         IKJNAME 'L'
LOADKW   IKJKEYWD
         IKJNAME 'LOAD'
IDRKW    IKJKEYWD
         IKJNAME 'IDR',SUBFLD=IDRSF
CSECTKW  IKJKEYWD
         IKJNAME 'CSECT',SUBFLD=CSECTSF
OUTFIKW  IKJKEYWD
         IKJNAME 'OUTFILE',SUBFLD=OUTFISF
UNITSF   IKJSUBF
UNIT     IKJIDENT 'UNIT NAME',                                         +
               FIRST=ALPHANUM,OTHER=ANY,MAXLNTH=8,                     +
               PROMPT='UNIT NAME'
VOLSF    IKJSUBF
VOL      IKJIDENT 'VOLUME SERIAL',                                     +
               FIRST=ALPHANUM,OTHER=ALPHANUM,MAXLNTH=6,                +
               PROMPT='VOLUME SERIAL'
PLUSSF   IKJSUBF
PLUS     IKJIDENT 'MEMBER NAME',LIST,                                  +
               FIRST=ALPHANUM,OTHER=ALPHANUM,MAXLNTH=8,                +
               PROMPT='MEMBER NAME'
MAPSF    IKJSUBF
MAPSKW   IKJKEYWD
         IKJNAME 'ALL'
         IKJNAME 'SHORT'
IDRSF    IKJSUBF
IDRTRNKW IKJKEYWD
         IKJNAME 'TRANSLATOR'
IDRPLSKW IKJKEYWD
         IKJNAME 'PLS'
IDRZAPKW IKJKEYWD
         IKJNAME 'ZAP'
IDRSPCKW IKJKEYWD
         IKJNAME 'SPACE'
IDRIDEKW IKJKEYWD
         IKJNAME 'IDENTIFY'
IDRALLKW IKJKEYWD
         IKJNAME 'ALL'
CSECTSF  IKJSUBF
CSECT    IKJIDENT 'CSECT NAME',                                        +
               FIRST=ALPHANUM,OTHER=ALPHANUM,MAXLNTH=8,                +
               PROMPT='CSECT NAME'
OUTFISF  IKJSUBF
OUTFI    IKJIDENT 'DDNAME',                                            +
               FIRST=ALPHANUM,OTHER=ALPHANUM,MAXLNTH=8,                +
               PROMPT='DDNAME FOR OUTFILE'
         IKJENDP
         PRINT GEN
         SPACE
************************************************************
*                                                          *
*        DSECTS                                            *
*                                                          *
************************************************************
         SPACE
@DATA    DSECT
         DS    18F                 REGISTER SAVEAREA
LINKAREA DS    2F
MYPPL    DS    7F
MYANS    DS    F
MYUWA    DS    F
DSNPTR   DS    F
MYECB    DS    F                  USED BY PUTLINE ROUTINE
MYIOPL   DS    4F                 USED BY PUTLINE ROUTINE
MYPTPB   DS    3F                 USED BY PUTLINE ROUTINE
MYPUTLEP DS    F                  USED BY PUTLINE ROUTINE
MYOLD    DS    2F                 USED BY PUTLINE ROUTINE
MYSEG1   DS    2H,CL128           USED BY PUTLINE ROUTINE
PUTLINS  DS    4F                 USED BY PUTLINE ROUTINE
MYDAPL   DS    5F
MYDAPB   DS    21F
MYDFPB   DS    5F
PLUSPTR  DS    F
DSNAME   DS    H,CL44
CLEANUP  DS    X
OPTION1  DS    X
OPT1D    EQU   X'80'               DATA
OPT1T    EQU   X'40'               TEST
OPT1S    EQU   X'20'               SYS
OPT1E    EQU   X'10'               ESOTERIC
OPT1W    EQU   X'08'               WHERE
OPT1L    EQU   X'04'               SLPA
OPT1O    EQU   X'02'               OUTFILE
OPTION2  DS    X
OPT2L    EQU   X'80'               LIST
OPT2I    EQU   X'40'               IDR
OPT2M    EQU   X'20'               MAP
OPT2A    EQU   X'10'               MAP(ALL)
OPT2O    EQU   X'08'               LOAD
OPTION3  DS    X
OPT3T    EQU   X'80'               TRAN
OPT3P    EQU   X'40'               PLS
OPT3Z    EQU   X'20'               ZAP
OPT3I    EQU   X'10'               IDENT
OPT3S    EQU   X'08'               SPACE
CNAME    DS    CL8
CNAMEID  DS    H
ESDID    DS    H
RC       DS    H
SPFHDRS  DS    C
ESDPTR   DS    F
IDRLEN   DS    F
IDRFREE  DS    F
IDRPTR   DS    F
IDRPTRC  DS    F
IDRPTRE  DS    F
IDRR5    DS    F
MSGWK    DS    CL128
MSGWH    DS    CL80
MYDFPARM DS    5F  USED BY DAIRFAIL
MYDFREGS DS    F   USED BY DAIRFAIL
MYDFRC   DS    F   USED BY DAIRFAIL
MYJEFF02 DS    F   USED BY DAIRFAIL
MYDFID   DS    H   USED BY DAIRFAIL
DOUBLE   DS    D
FULL     EQU   DOUBLE,4
BYTE     EQU   DOUBLE,1
DDSAVE   DS    CL8
DAIRREGS DS    F
OPEND    DS    0F
CLOSED   DS    F
KOUNT    DS    F
DCB      DS    0D,XL(DCBLEN)
ONAME    DS    CL8
OUTDCBW  DS    0D,XL(OUTDCBL)
OUTEXL   DS    F
LINE     DS    CL80
MYDECB   DS    5F
SYNADSW  DS    F
SYNADMSG DS    CL78
ANYCESD  DS    C
MODES    DS    C
JULIANI  DS    F
JULIANO  DS    CL8
JULIANW  DS    13H
LPAREGS  DS    2F
UNITN    DS    CL8
VOLSER   DS    CL6,CL2
MEMBER8  DS    D
MEMBERL  DS    H
USERLEN  DS    H
LINKOFF  DS    0F
LINKOFF1 DS    F
LINKOFF2 DS    F
LINKOFF3 DS    F
LINKOFF4 DS    F
BLDLW    DS    CL64                4 + 11 + 2 + 47
BLDLX    DS    CL129               2 * L'BLDLW + 1
MAPENTX  DS    4F,C
         DS    0D
@DATAL   EQU   *-@DATA
         SPACE
PDSDSECT DSECT
PDS      EQU   *
PDSMEMBR DS    CL8                 MEMBER NAME
PDSTTR   DS    XL3                 TTR OF 1ST BLOCK
PDSBLDL1 DS    XL1                 CONCATENATION NUMBER
PDSBLDL2 DS    XL1                 1 - LINKLIST  2 - STEPLIB
PDSINDIC DS    XL1                 INDICATORS
*              USER DATA FIELD
PDSUSER  DS    0C
PDSTTRT  DS    XL3                 TTR OF FIRST TEXT BLOCK
         DS    XL1                 ZERO, FOR ALIGNMENT
PDSTTRN  DS    XL3                 TTR OF NOTE LIST OR SCATTER
PDSTTRNO DS    XL1                 NUMBER OF NOTE LIST ENTRIES
PDSATTR  DS    0XL2                ATTRIBUTES
PDSATTR1 DS    XL1                 ATTRIBUTES, BYTE 1
PDSATTR2 DS    XL1                 ATTRIBUTES, BYTE 2
PDSSIZE  DS    XL3                 CONTIGUOUS MAIN STORAGE REQUIRED
PDSFTXTL DS    XL2                 LENGTH OF FIRST TEXT BLOCK
PDSENTRY DS    XL3                 ENTRY POINT ADDRESS
PDSFTXTO DS    0XL3                ORIGIN OF FIRST TEXT BLOCK (OS)
PDSATTV  DS    XL3                 VS ATTRIBUTES, R/AMODE, RLD COUNT
PDSOPTIO EQU   *                   BEGIN OPTIONAL FIELDS
         ORG   PDSUSER
SPFV     DS    XL1                 VERSION
SPFM     DS    XL1                 MODIFICATION LEVEL
         DS    XL2
SPFCREDT DS    PL4                 00YYDDDF
SPFMODDT DS    PL4                 00YYDDDF
SPFMODTM DS    XL2                 HHMM
SPFSIZE  DS    XL2                 CURRENT SIZE
SPFINIT  DS    XL2                 INITIAL SIZE
SPFMOD   DS    XL2                 MODIFICATIONS
SPFID    DS    CL10                USERID
         SPACE
IHADCB   DSECT
         DS    32XL1
         DS    XL1
DCBEODAD DS    AL3
DCBRECFM DS    X
DCBEXLST DS    AL3
DCBDDNAM DS    CL8
DCBOFLGS DS    X
         DS    7XL1
         DS    X
DCBSYNAD DS    AL3
         DS    H
DCBBLKSI DS    H
         DS    XL18
DCBLRECL DS    H
         SPACE
         IKJCPPL
         SPACE 3
         IKJPPL
         SPACE
         IKJDFPB
         SPACE 2
         IKJUPT
         SPACE 2
         IKJIOPL
         SPACE 2
         IKJDAPL
         SPACE 2
         IKJDAP08
         SPACE 2
         IKJDAP18
         SPACE 2
         AIF   (NOT &MVS).SKIP8
         IKJEFFDF DFDSECT=YES
.SKIP8   ANOP
         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.CMDLIB,DISP=SHR         <= TARGET LIBRARY
//LKED.SYSIN DD *
 ALIAS MEM
 NAME MEMBER(R)
//HELP    EXEC PGM=IEBUPDTE,PARM=NEW,COND=(0,NE)
//SYSPRINT DD  SYSOUT=*
//SYSUT2   DD  DISP=SHR,DSN=SYS2.HELP              <= TARGET LIBRARY
//SYSIN    DD  *
./ ADD NAME=MEMBER
./ ALIAS NAME=MEM
)F FUNCTION -
  THE MEMBER COMMAND DISPLAYS INFORMATION ABOUT A MEMBER
  OF A PDS FROM THE PDS DIRECTORY.

  FOR MEMBERS CREATED BY THE 'SPF' EDIT, THE STATISTICS
  IN THE DIRECTORY ARE FORMATTED.

  FOR LOAD MODULES, INFORMATION FROM THE DIRECTORY
  IS INTERPRETED AND FORMATTED, INCLUDING MODULE SIZE,
  ATTRIBUTES, AND SSI INFORMATION.

  FOR LOAD MODULES, INFORMATION FROM THE 'ESD' AND 'IDR'
  RECORDS CAN BE LISTED.

  THE COMMAND CAN ALSO BE USED TO SEARCH THE SYSTEM LINK
  LIBRARIES FOR A SPECIFIED LOAD MODULE.
)X SYNTAX  -
         MEMBER  'DSNAME(MEMBER)'  ESOTERIC  LIST  MAP  IDR  CSECT(ID)
                                   PLUS('MEMBERS')  DATA  OUTFILE('DD')
                                   UNIT('UNITNAME')  VOLUME('VOLSER')
     OR
         MEMBER  'MEMBER'  SYS     ESOTERIC  WHERE
                                   PLUS('MEMBERS')  DATA  OUTFILE('DD')
  REQUIRED - 'DSNAME(MEMBER)'  (OR 'MEMBER' AND 'SYS')
  DEFAULTS - NONE
  ALIAS    - MEM
)O OPERANDS -
  'DSNAME(MEMBER)' THE DATA SET AND MEMBER TO BE DISPLAYED.
             (OR JUST A MEMBER NAME IF 'SYS' IS ALSO SPECIFIED).
             THIS OPERAND MAY OPTIONALLY BE A LIST IN PARENTHESES.
))ESOTERIC - FOR LOAD MODULES, A SECOND LINE OF DIRECTORY
             INFORMATION, WHICH IS RARELY OF INTEREST, IS TO
             BE DISPLAYED.
))LIST     - FOR LOAD MODULES, THE FIRST 48 BYTES OF THE
             TEXT WILL BE DISPLAYED.  USEFUL IF THE PROGRAM
             HAD IDENTIFYING INFORMATION SUCH AS DATE-ASSEMBLED
             IN ITS 'SAVE' MACRO.  NOT VALID WITH 'SYS'.
))MAP      - FOR LOAD MODULES, THE CSECT NAMES FROM THE CESD
             RECORD(S) WILL BE DISPLAYED.  NOT VALID WITH 'SYS'.
))IDR      - FOR LOAD MODULES, THE IDR RECORD CONTAINING THE
             DATE OF LINKEDIT IS DISPLAYED.
             IF IDR(ZAP) IS SPECIFIED, IDR ZAP RECORDS ARE DISPLAYED.
             IF IDR(TRAN) IS SPECIFIED, IDR TRANSLATOR RECORDS, CON-
             TAINING THE DATE OF ASSEMBLY OR COMPILATION, ARE DISPLAYED.
             IDR(PLS) IS THE SAME AS IDR(TRANS), EXCEPT PLS TRANSLATOR
             INFORMATION IS ALSO DISPLAYED.
             IF IDR(IDENT) IS SPECIFIED, IDR IDENTIFY RECORDS, CREATED
             BY THE LINKEDIT 'IDENTIFY' STATEMENT, ARE DISPLAYED.
             IF IDR(SPACE) IS SPECIFIED, THE NUMBER OF AVAILABLE
             SLOTS FOR ZAP ENTRIES IS DISPLAYED.
             IF IDR(ALL) IS SPECIFIED, ALL IDR RECORDS ARE DISPLAYED,
             BUT NOT THE ZAP SPACE AVAILABLE.  USE IDR(ALL SPACE).
))PLUS(MEMBERS) - ADDITIONAL MEMBER NAMES TO BE PROCESSED.
))CSECT(ID) - IF THE NAME OF A CSECT IS SPECIFIED HERE, THE
             'MAP' AND 'IDR' INFORMATION WILL BE RESTRICTED TO
             THE SPECIFIED CSECT.
))SYS      - THE 'SYS' KEYWORD INDICATES THAT THE FIRST
             OPERAND IS A MEMBER NAME AND THE SYSTEM LINK LIBRARIES
             (OR SESSION STEPLIB) ARE TO BE SEARCHED FOR IT.
             THIS OPERAND CANCELS THE 'LIST', 'MAP' AND 'IDR' OPERANDS,
             WHICH REQUIRE A DATA SET NAME IN THE 1ST OPERAND.
))WHERE    - VALID ONLY WITH 'SYS', THIS CAUSES THE CONCATENATION
             NUMBER OF THE LINKLIST (OR STEPLIB) LIBRARY TO BE
             DISPLAYED.  USEFUL FOR DETERMINING WHICH LIBRARY
             A MEMBER IS LOCATED IN.
))LOAD     - FOR LOAD MODULES, THE COMMAND WILL LOAD THE MEMBER INTO
             MEMORY USING THE 'LOAD' MACRO, AND REPORT WHETHER IT WAS
             SUCCESSFUL OR NOT.  USEFUL FOR CHECKING SYSTEM 106 ABENDS.
))DATA     - REQUESTS A RAW HEX DISPLAY OF THE DIRECTORY ENTRY.
))UNIT(UNIT) - FOR UNCATALOGED DATA SETS, THE UNIT TYPE.
))VOLUME(VOLSER) - FOR UNCATALOGED DATA SETS, THE VOLUME.
))OUTFILE(DD) - REDIRECTS THE DISPLAY TO THE FILE PRE-ALLOCATED TO
             THE SPECIFIED DDNAME.
./ ENDUP
//
