//DISKSEEK JOB (JOB),
//             'INSTALL DISKSEEK',
//             CLASS=A,
//             MSGCLASS=A,
//             MSGLEVEL=(1,1),
//             USER=IBMUSER,
//             PASSWORD=SYS1
//BUILD  EXEC ASMFCL,PARM.ASM='OBJECT,NODECK,XREF',
//             MAC1='SYS1.MACLIB',MAC2='SYS1.AMODGEN'
//*                                          
//ASM.SYSIN DD DATA,DLM=@@ 
DISK     TITLE  '... DIRECT ACCESS VOLUME LIST ...'
*
* THIS MUST BE LINKED AS AC=1
*
* SAMPLE PROC
*
* SMAP     PROC SO=A,U='SYSALLDA',COPY=1,V=VOLUME
* SMAP     EXEC PGM=DISKSEEK,PARM=SMAP,REGION=1024K
* STEPLIB  DD DSN=LA.PSUP.AUTHLIB,DISP=SHR                  *HMD 06/82*
* VOLUME01 DD VOL=SER=&V,DISP=SHR,UNIT=&U
* SYSPRINT DD SYSOUT=&SO,COPIES=&COPY
* SYSSEEK  DD DUMMY,DCB=BLKSIZE=121
*
*         STEPNAME SETS NUMBER OF SAMPLES FOR "SMAP"
*
*         STEPNAME FORMAT IS AS FOLLOWS -
*
*         SNNNN -
*                  "NNNN"  IS THE NO. OF 1/5 SEC SAMPLES.
*                  IF "NNNN" IS NOT NUMERIC A DEFAULT OF
*                  3000 SAMPLES WILL BE USED (10 MINUTES)
*
*   NOTE: IF YOU WANT TO CHANGE THE NUMBER OF SAMPLES
*         AND YOU HAVE A PROC IN SYS1.PROCLIB THAT YOU START FROM
*         THE CONSOLE THE WAY TO DO IT IS:
*
*           S SMAP.SNNNN,V=SYSRES
*
DISKSEEK CSECT
         EJECT
*
*FUNCTION -DIRECT ACCESS VOLUME LISTING UTILITY.
*          IT WILL PRODUCE A LISTING OF EVERY DATASET ON A VOLUME
*          PLUS CALCULATE THE FREE SPACE, FREE DSCBS ETC. OPTIONALLY
*          VIA PARM INFORMATION IT WILL PRODUCE THE FOLLOWING:
*         PARM=MAP - PRODUCE TRACK MAP OF VOLUME.
*         PARM=SMAP - PRODUCE TRACK MAP OF VOLUME INCLUDING SEEK INFO
*         PARM=PDS - LIST ALL PDS DIRECTORIES ON VOLUME.
*         PARM=ISAM - LIST ISAM REORG ONFORMATION FOR DATASETS.
*         PARM=EXT- LIST THE EXTENTS OF THE DATASETS.
*         PARM=DUMP - LIST IN HEX ALL DSCBS ON VOLUME.
*         PARM=EMPTY - LIST ONLY DATASETS THAT ARE EMPTY.
*         PARM=MODEL - WILL ONLY LIST MODEL DSCBS.
*         PARM=SDUMP - LIST IN HEX FORMAT 4 AND 5 DSCBS.
*         PARM=VOLS - ONLY USE DDNAMES OF VOLUMEXX    .
*         PARM=JDATE - LIST CREATION/EXPIRATION DATES IN JULIAN.
******     OTHER COMMENT ARE DOCUMENTED IN BEGINING OF SOURCE.
******     NOTE - SYS1.AMODGEN MUST BE CONCATENATED TO MACLIB FOR ASMB
*
*
*
*         STEPNAME SETS NO. OF SAMPLES FOR "SMAP"
*
*         STEPNAME FORMAT IS AS FOLLOWS -
*
*         SNNNN -
*                  "NNNN"  IS THE NO. OF 1/5 SEC SAMPLES.
*                  IF "NNNN" IS NOT NUMERIC A DEFAULT OF
*                  3000 SAMPLES WILL BE USED (10 MINUTES)
*
*
         EJECT
R0       EQU   0                   WORK
R1       EQU   1                   WORK
R2       EQU   2                   WORK
R3       EQU   3                   WORK
R4       EQU   4                   WORK
R5       EQU   5                   WORK
R6       EQU   6                   -> FM1, FM4 DSCB, PDS ENTRY
R7       EQU   7                   -> FM2 DSCB, IF ANY
R8       EQU   8                   -> FM3, FM5 DSCB, IF ANY
R9       EQU   9                   BASE REG 1
R10      EQU   10                  BASE REG 2
R11      EQU   11                  BASE REG 3
R12      EQU   12                  BASE REG 4
R13      EQU   13                  -> SAVE AREA
R14      EQU   14                  LINK, WORK
R15      EQU   15                  WORK
         SPACE 1
SPACE0AP EQU   X'01'
SPACE1AP EQU   X'09'
SPACE2AP EQU   X'11'
SPACE3AP EQU   X'19'
EJECTAP  EQU   X'89'
SPACE0IM EQU   X'03'
SPACE1IM EQU   X'0B'
SPACE2IM EQU   X'13'
SPACE3IM EQU   X'1B'
EJECTIM  EQU   X'8B'
         SPACE 1
DEBUCBAD EQU   32                                           *HMD 06/82*
CAMLSTLN EQU   148
PDSBLKLN EQU   264
NCPDFLT  EQU   10
UTILPRIV EQU   5
OPERPRIV EQU   9
         SPACE 1
EMPTYOPT EQU   X'80'
LSTDTOPT EQU   X'40'
DUMPOPT  EQU   X'20'
SDUMPOPT EQU   X'10'
MAPOPT   EQU   X'08'
PDSOPT   EQU   X'04'
EXTNTOPT EQU   X'02'
DIRFLAG  EQU   X'01'
         SPACE 1
VOLSOPT  EQU   X'80'
LNCNTOPT EQU   X'40'
SMAPOPT  EQU   X'20'
RESETOPT EQU   X'10'
NCPOPT   EQU   X'08'
ISAMOPT  EQU   X'04'
JDATEOPT EQU   X'02'
MODELOPT EQU   X'01'
         EJECT
         SAVE  (14,12),,*
         LR    R9,R15
         USING DISKSEEK,R9
         LM    R10,R12,BASEVALS
         USING DISKSEEK,R9,R10,R11,R12
         SPACE 1
         LR    R2,R13
         LA    R13,SAVEAREA
         ST    R2,SAVEAREA+4
         ST    R13,8(,R2)
         SR    R2,R2
         SPM   R2
         B     INIT
         SPACE 1
BASEVALS DC    A(DISKSEEK+X'1000',DISKSEEK+X'2000',DISKSEEK+X'3000')
         EJECT
MAXCYL   EQU   808
MAXTRK   EQU   32
DEVBUSY  STM   R2,R12,VOLSAVE
         MVC   VOLTRKS(2),TRKSPCYL
         OPEN  (SYSSEEK,(OUTPUT))
         L     R1,VOLTAB
         LTR   R1,R1               FREEMAIN NECESSARY
         BZ    DEVBUSY0            NO
         L     R0,=A(MAXCYL*MAXTRK*4) VOLTAB LENGTH
         FREEMAIN R,LV=(0),A=(1)
         SPACE 1
DEVBUSY0 L     R0,=A(MAXCYL*MAXTRK*4) VOLTAB LENGTH
         GETMAIN R,LV=(0)
         ST    R1,VOLTAB           VOLTAB ADDR
         L     R4,VOLUCB           UCB ADDR
         L     R3,VOLSAMP          NO. OF SAMPLES
         L     R14,PSATOLD-PSA     CURRENT TCB              *HMD 06/82*
         L     R14,TCBTIO-TCBRBP(R14)      GET TIOT ADDR    *HMD 06/82*
         USING TIOT1,R14           ADDRESS THE TIOT         *HMD 06/82*
         MVC   SEEKDBL(4),=4C'0'
         MVZ   SEEKDBL(4),TIOCSTEP+1   SNNNN STEP NAME
         CLC   SEEKDBL(4),=4C'0'   NUMERIC
         BNE   DEVBUSY1            NO, USE DEFAULT
         PACK  SEEKDBL(8),TIOCSTEP+1(4)
         CVB   R3,SEEKDBL          SPECIFIED NO. OF SAMPLES
         ST    R3,VOLSAMP
         DROP  R14                                          *HMD 06/82*
         SPACE 1
DEVBUSY1 STIMER WAIT,DINTVL=INTERVL
         USING UCBOB,R4                                     *HMD 06/82*
         TM    UCBSTAT,UCBONLI+UCBALOC                      *HMD 06/82*
         BNO   DEVBUSY2            NO                       *HMD 06/82*
         TM    UCBFLA,UCBBSY+UCBCUB+UCBACTV                 *HMD 06/82*
         BZ    DEVBUSY2            BUSY OR CHANNEL PGM ACT  *HMD 06/82*
         DROP  R4                                           *HMD 06/82*
         LR    R14,R4             UCB ADDR
         S     R14,=F'4'          DECR ADDR -4
         L     R14,0(0,R14)       IOQ ADDR
         LA    R14,0(0,R14)
         LTR   R14,R14            ANY IOQ
         BZ    DEVBUSY2           NO
         L     R14,8(,R14)        GET IOSB ADDRESS          *HMD 06/82*
         LA    R14,0(0,R14)
         LTR   R14,R14            EXIST
         BZ    DEVBUSY2           NO
         SR    R1,R1
         USING IOSB,R14           ADDRESS THE IOSB          *HMD 06/82*
         ICM   R1,3,IOSSKH1       SEEK TRK
         ST    R1,DOUBTRK
         CH    R1,VOLTRKS         CHECK MAX TRK NO. THIS DEVICE
         BL    *+8                OK
         LA    R1,31              LAST ENTRY
         SLL   R1,2
         SR    R15,R15
         ICM   R15,3,IOSSKCC      SEEK CYL
         ST    R15,DOUBCYL
         SLL   R15,7
         AR    R1,R15             VOLTAB ENTRY OFFSET
         L     R15,VOLTAB
         AR    R15,R1             VOLTAB ENTRY ADDR
         L     R1,0(0,R15)
         A     R1,=F'1'
         ST    R1,0(0,R15)
         L     R1,VOLSEEK
         A     R1,=F'1'
         ST    R1,VOLSEEK
         DROP  R14                                          *HMD 06/82*
         MVC   SEEKPRT+1(120),=CL120'CYL NNNN   TRK NN'
         UNPK  SEEKPRT+5(5),DOUBCYL+2(3)
         MVI   SEEKPRT+9,C' '
         NC    SEEKPRT+5(4),=4X'0F'
         TR    SEEKPRT+5(4),=C'0123456789ABCDEF'
         UNPK  SEEKPRT+16(3),DOUBTRK+3(2)
         MVI   SEEKPRT+18,C' '
         NC    SEEKPRT+16(2),=4X'0F'
         TR    SEEKPRT+16(2),=C'0123456789ABCDEF'
         PUT   SYSSEEK,SEEKPRT
         SPACE 1
DEVBUSY2 BCT   R3,DEVBUSY1
         LM    R2,R12,VOLSAVE
         CLOSE (SYSSEEK)
         BR    R8
         EJECT
         SPACE 3
NEXTVOL  BAL   R14,FREECORE
         XC    START0(LENGTH0),START0 WHOLESALE ZEROING OF CORE
         SR    R0,R0
         ST    R0,BUFPTR
         MVC   CURLINES,=H'999'
         MVI   HEADER,C' '
         MVC   HEADER+1(L'HEADER-1),HEADER
         LA    R1,LASTDS1
         ST    R1,FIRSTDS1
         LA    R1,HOOKSTRT
         ST    R1,HOOKSTRT
         MVC   HWMDS1,EFFS
         NI    PARMOPT1,255-DIRFLAG
         SPACE 1
NEXTDD   TM    PARMOPT2,VOLSOPT
         BO    NEXTDDCV
         L     R1,DDLSTPTR
         LTR   R1,R1
         BZ    TIOTADV
         LH    R0,DDNAMLEN
         SH    R0,=H'8'
         BM    RETURN
         STH   R0,DDNAMLEN
         MVC   VOLDDNAM,0(R1)
         LA    R1,8(R1)
         ST    R1,DDLSTPTR
         B     NMAPSTRT
         SPACE 1
TIOTADV  L     R1,TIOTADDD
         USING TIOENTRY,R1
         SR    R0,R0
         IC    R0,TIOELNGH
         LTR   R0,R0
         BZ    RETURN
         MVC   VOLDDNAM,TIOEDDNM
         AR    R1,R0
         ST    R1,TIOTADDD
         DROP  R1
         SPACE 1
NMAPSTRT LA    R0,8
         LA    R1,NOMAPDDS
         CLC   VOLDDNAM(5),=C'SYS00'   CHECK FOR DAIR DDNAME  P.A.S.
*        **** THIS IS CAUSED BY DAIR FOR THE CVOL CATALOG ***P.A.S.
         BE    NEXTDD      IF FOUND, DO NOT MAP THIS VOL
NMAPSRCH CLC   VOLDDNAM,0(R1)
         BE    NOMAPFND
         BXH   R1,R0,NMAPSRCH
         SPACE 1
NOMAPFND LA    R0,VOLDDNAM
         CR    R0,R1
         BNE   NEXTDD
         B     TYPEDEV
         SPACE 1
NEXTDDCV LH    R0,CURVOL
         CH    R0,NUMVOLS
         BNL   RETURN
         AH    R0,=H'1'
         STH   R0,CURVOL
         BAL   R14,CONVERT
         MVC   CURVOLNM,CONVUNPK+10
         SPACE 1
TYPEDEV  DEVTYPE VOLDDNAM,DEVTYPE,DEVTAB,RPS
         BXH   R15,R15,ERRNODD
         CLI   DEVTYPE+2,UCB3DACC
         BNE   ERRNOTDA
         SPACE 1
         MVC   DEVTABND,DEVTYPE+3
         LA    R0,DEVENTLN
         LA    R1,DEVTABLE
DEVLOOP  CLC   DEVTABND(1),0(R1)
         BE    DEVNTFND
         BXH   R1,R0,DEVLOOP
         SPACE 1
DEVNTFND CLC   1(7,R1),DEVTABND+1
         BE    ERRUNKDV
         ST    R1,DEVTABPT
         EJECT
***** THIS SECTION WILL TELL THE DIFFERENCE BETWEEN THE 2 3340 MODELS.
***** THE 3340 HAS 1 UCBTYPE FOR BOTH 35M/70M.
***** THIS SECTION WILL LOOK FOR THE X'015D' NUMBER OF CYLS....35M
*****   ELSE THE NUMBER OF CYLS (70M) WILL BE X'02BA'...
         SPACE 1
         CLI   DEVTYPE+3,X'0A'   TEST FOR A 3340-?
         BNE   RVDISK    IF NOT 3340...BYPASS
         CLC   DEVTYPE+8(2),=X'015D'    TEST FOR A 35M 3340 TYPE
         BE    RVDISK   IF IT IS A 35MEG...NO NEED TO CHANGE DESC
         MVC   6(2,R1),=C'70'   MOVE A "70M" ON DESC OF UNIT
         SPACE 1
*** THIS SECTION WILL DETERMINE IF THE DISK IS REAL, OR MASS STORAGE
         SPACE 1
RVDISK   TM    DEVTYPE+2,X'08'   TEST IF REAL/VIRT DASD
         BZ    DEVCON   BIT=0, REAL     BIT=1, VIRTUAL
         MVC   6(9,R1),=C'VIRT VOL.' MOVE "VIRT" DESC OF UNIT
         SPACE 1
******** THIS SECTION WILL LOAD THE CONSTANTS FROM THE "DEVTYPE" TO
********   BE USED BY THE HOMEMADE CCHHR CONVERT ROUTINES.....
*
DEVCON   MVC   DEVCONV2(2),DEVTYPE+10    LOW ORDER  CC
         MVC   DEVCONV1(1),DEVTYPE+11     HIGH ORDER CC
         MVI   DEVCONV1+1,X'00'      FINISH HIGH ORDER CC
         MVC   DEVCONV3(2),=X'0000'   ZERO HIGH ORDER HH
         MVC   DEVCONV4(2),=X'0001'   LOW ORDER  HH
         MVC   TRKSPCYL(2),DEVTYPE+10    TRKS/CYL
         SR    R1,R1
         LH    R1,DEVTYPE+8    LOAD  CYL PER VOLUME
         MH    R1,DEVTYPE+10   MULT "CYL/VOL" BY "TRKS/CYL"
         STH   R1,TRKSPVOL    RESULT IS  "TRACKS/VOLUME"
*
         MVC   DCBDDNAM+(PDSDCB-IHADCB),VOLDDNAM
         MVC   DCBDDNAM+(VTOCDCB-IHADCB),VOLDDNAM
         SPACE 1
         RDJFCB MF=(E,OPENLIST)
         TM    JFCBTSDM,X'20'
         BO    ERRNOTDA
         MVI   JFCBDSNM,X'04'
         MVC   JFCBDSNM+1(43),JFCBDSNM
         OI    JFCBTSDM,X'08'
         SPACE 1
         LH    R1,NCPPARM
         SR    R0,R0
         IC    R0,JFCNCP
         MVI   JFCNCP,0
         LTR   R0,R0
         BZ    SAVENCP
         LR    R1,R0
SAVENCP  ST    R1,RENCP
         OI    DCBOPTCD+(VTOCDCB-IHADCB),DCBOPTC
         CH    R1,=H'1'
         BNE   SETNCP
         SR    R1,R1
         NI    DCBOPTCD+(VTOCDCB-IHADCB),255-DCBOPTC
SETNCP   STC   R1,DCBNCP+(VTOCDCB-IHADCB)
         SPACE 1
         OPEN  TYPE=J,MF=(E,OPENLIST)
         TM    DCBOFLGS+(VTOCDCB-IHADCB),DCBOFOPN
         BZ    ERRNOPEN
         L     R2,DCBDEBAD+(VTOCDCB-IHADCB)
         L     R2,DEBUCBAD(,R2)                             *HMD 06/82*
         SPACE 1
********  THIS SECTION DELETED    4/1/75    P.A.S.
********  IT WAS USED FOR DATA CELLS...NO LONGER SUPPORTED
         SPACE 1
         USING UCBOB,R2
MAINUCB  MVC   VTOCTTR,UCBVTOC
         MVC   VOLSERNO,UCBVOLI
         MVC   VOLSTAT,UCBSTAT
         MVC   HEAD1UCB,UCBNAME     MOVE EBCIDIC UCB ADDR FOR HEADN
         TM    UCBSTAB,UCBBPUB    TEST FOR PUBLIC MOUNT
         BNO   *+10
         MVC   HEAD1MT,=C'PUBLIC  '
         TM    UCBSTAB,UCBBPRV    TEST FOR PRIVATE
         BNO   *+10
         MVC   HEAD1MT,=C'PRIVATE '
         TM    UCBSTAB,UCBBSTR   TEST FOR STORAGE
         BNO   *+10
         MVC   HEAD1MT,=C'STORAGE '
         TM    UCBSTAB,UCBPGFL    TEST IF PAGING DEVIC
         BNO   *+10
         MVC   HEAD1MT,=C'*PAGING*'
         TM    UCBSTAT,UCBSYSR    TEST FOR SYS-RES
         BNO   *+10
         MVC   HEAD1MT,=C'*SYSRES*'
         SPACE 1
         MVC   HEAD1MTR,=C'REMOV'
         TM    UCBSTAT,UCBRESV
         BNO   *+10
         MVC   HEAD1MTR,=C'RSERV'
         TM    UCBSTAT,UCBPRES
         BNO   *+10
         MVC   HEAD1MTR,=C'RSDNT'
         SPACE 1
COMONUCB ST    R2,UCBADDR
         ST    R2,VOLUCB
         DROP  R2
         MVC   HEAD1VOL,VOLSERNO
         MVC   HEADMID(81),HEAD1
         TM    PARMOPT2,SMAPOPT
         BZ    *+8
         BAL   R8,DEVBUSY            BUILD VOL TAB
         SPACE 1
         ENQ   MF=(E,ENQVTOC)
         NI    DEQGATE,X'0F'
         SPACE 1
         LH    R1,VTOCTT
         BAL   R14,TTCONVRT
         MVC   VTOCCCHH,CCHH
         MVI   VTDSCBTR+1,255
         SPACE 1
         SR    R4,R4
         IC    R4,DCBKEYLE+(VTOCDCB-IHADCB)
         AH    R4,DCBBLKSI+(VTOCDCB-IHADCB)
         AH    R4,=H'20'
         ST    R4,REBLKSIZ
         L     R5,RENCP
         ST    R5,RECOUNT
         LR    R1,R4
         MR    R0,R5
         LR    R0,R1
         ST    R0,REGETSIZ
         GETMAIN EC,LV=(0),A=REBLOCK@
         BXH   R15,R15,ERRNOCOR
         L     R2,REBLOCK@
         ST    R2,RENEXT@
         LA    R3,VTOCDCB
         SPACE 1
READINIT XC    0(20,R2),0(R2)
         LA    R4,20(R2)
         READ  (2),SF,(3),(4),MF=E
         A     R2,REBLKSIZ
         BCT   R5,READINIT
         SPACE 1
         LA    R4,DS4LEN
         BAL   R14,GETCORE
         ST    R3,FMT4AD
         LR    R6,R3
         USING DS4,R6
         BAL   R14,VTOCREAD
         BAL   R14,ABDUMP
         CLI   DS4IDFMT,C'4'
         MVI   BADDSTYP,C'4'
         LR    R8,R6
         BNE   ERRNOTFX
         MVI   FM4COUNT+1,1
         TM    DS4VTOCI,X'04'
         BZ    *+8
         OI    PARMOPT1,DIRFLAG
         MVC   HOOKLCCH(20),HOOKINIT
         LA    R2,HOOKPTR
         BAL   R14,HOOKUP
         SR    R0,R0
         IC    R0,DS4DEVDT
         STH   R0,VTDSCBTR
         TM    PARMOPT2,RESETOPT
         BNZ   *+10
         MVC   HWMDS1,DS4HPCHR
         MVC   HOOKLCCH(8),DS4VTOCE+2
         LA    R2,DS4VTOCE
         BAL   R14,F1EXTCNV
         STH   R0,HOOKNTRK
         STH   R0,VTOCSIZE
         MVC   HOOKLOTT(4),LOWTT
         MVI   HOOKTYPE,C'4'
         MVC   HOOKSEQN,DS4VTOCE+1
         MVC   HOOKIDPT,=A(VTOCMSG)
         LA    R2,HOOKPTR
         BAL   R14,HOOKUP
         SPACE 1
         LA    R4,DS5LEN
         BAL   R14,GETCORE
         ST    R3,FMT5AD
         LR    R8,R3
         USING DS5,R8
         BAL   R14,VTOCREAD
         BAL   R14,ABDUMP
         CLI   DS5FMTID,C'5'
         MVI   BADDSTYP,C'5'
         BNE   ERRNOTFX
         MVI   FM5COUNT+1,1
         BAL   R14,F56HOOK
         SR    R0,R0
         ST    R0,DS5F5PTR
         DROP  R6,R8
         EJECT
         SPACE 3
NEXTFM1  LA    R4,DS1LEN
         BAL   R14,GETCORE
         LR    R6,R3
         USING DS1,R6
READFM1  BAL   R14,VTOCREAD
         B     READFM5
         SR    R1,R1
         IC    R1,DS1FMTID
         N     R1,=F'15'
         CH    R1,=H'6'
         BNH   *+8
         BAL   R14,ABDUMP
         SLL   R1,1                *2
         LH    R2,FMXCOUNT(R1)
         LA    R2,1(R2)
         STH   R2,FMXCOUNT(R1)
         LTR   R1,R1
         BNZ   CHECKDS1
         CLI   HWMINDIC,1
         BE    READFM1
         MVC   HWMNEW,DS1FDAD+3
         MVI   HWMINDIC,1
         B     READFM1
         SPACE 1
CHECKDS1 CLI   DS1FMTID,C'1'
         BNE   READFM1
         MVC   HWMNEW,DS1FDAD+3
         MVI   HWMINDIC,1
         L     R2,FIRSTDS1
         L     R3,=A(FIRSTDS1-(DS1F1PTR-DS1))
COMPFM1  CLC   DS1DSNAM,DS1DSNAM-DS1(R2)
         BL    INSRTFM1
         LR    R3,R2
         L     R2,DS1F1PTR-DS1(R2)
         B     COMPFM1
INSRTFM1 ST    R2,DS1F1PTR
         ST    R6,DS1F1PTR-DS1(R3)
         SR    R0,R0
         ST    R0,DS1F3PTR
         B     NEXTFM1
         SPACE 1
         DROP  R6
         EJECT
         SPACE 3
READFM5  BAL   R14,CLOSVTOC
         L     R6,FMT4AD
         USING DS4,R6
         L     R8,FMT5AD
         USING DS5,R8
         B     CHECKFM5
         SPACE 1
NEXTFM5  LA    R4,DS5LEN
         BAL   R14,GETCORE
         ST    R3,DS5F5PTR
         LA    R2,DS5PTRDS
         LR    R8,R3
         BAL   R14,OBTAIN
         CLI   DS5FMTID,C'5'
         MVI   BADDSTYP,C'5'
         BNE   ERRNOTFX
         BAL   R14,F56HOOK
         SR    R0,R0
         ST    R0,DS5F5PTR
CHECKFM5 CLC   DS5PTRDS,ZEROES
         BNE   NEXTFM5
         SPACE 1
         CLC   DS4F6PTR,ZEROES
         BE    READFM23
         LA    R4,DS6LEN
         BAL   R14,GETCORE
         ST    R3,FMT6AD
         LA    R2,DS4F6PTR
         SPACE 1
READFM6  LR    R8,R3
         USING DS6,R8
         BAL   R14,OBTAIN
         CLI   DS6FMTID,C'6'
         MVI   BADDSTYP,C'6'
         BNE   ERRNOTFX
         BAL   R14,F56HOOK
         SR    R3,R3
         ST    R3,DS6F6PTR
         CLC   DS6PTRDS,ZEROES
         BE    READFM23
         LA    R4,DS6LEN
         BAL   R14,GETCORE
         ST    R3,DS6F6PTR
         LA    R2,DS6PTRDS
         B     READFM6
         SPACE 1
         DROP  R6,R8
         EJECT ,
         SPACE 3
READFM23 L     R6,=A(FIRSTDS1-(DS1F1PTR-DS1))
         USING DS1,R6
NEXTFM23 L     R6,DS1F1PTR
         CLC   DS1DSNAM,LASTDS1
         BE    VTOCUPDT
         CLC   DS1PTRDS,ZEROES
         BE    NEXTFM23
         SPACE 2
         LA    R4,DS3LEN
         BAL   R14,GETCORE
         LR    R8,R3
         USING DS3,R8
         LA    R2,DS1PTRDS
         BAL   R14,OBTAIN
         ST    R8,DS1F3PTR
         SR    R0,R0
         ST    R0,DS3F2PTR
         TM    DS1DSORG,DCBDSGIS
         BNO   CHECKFM3
         USING DS2,R8
         CLI   DS2FMTID,C'2'
         BNE   CHECKFM3
         CLC   DS2PTRDS,ZEROES
         BE    NEXTFM23
         LA    R4,DS3LEN
         BAL   R14,GETCORE
         ST    R3,DS2F3PTR
         LA    R2,DS2PTRDS
         BAL   R14,OBTAIN
         ST    R8,DS3F2PTR-DS3(,R3)
         LR    R8,R3
         USING DS3,R8
         SPACE 1
CHECKFM3 CLI   DS3FMTID,C'3'
         BE    NEXTFM23
         MVI   BADDSTYP,C'3'
         B     ERRNOTFX
         SPACE 1
         DROP  R6,R8
         EJECT ,
         SPACE 1
VTOCUPDT TM    PARMOPT2,RESETOPT
         BZ    VTOCPRT
         TM    PARMOPT1,DIRFLAG
         BO    VTOCPRT
         OI    OPENFLAG,OPENUPDT
         OPEN  TYPE=J,MF=(E,OPENLIST)
         TM    DCBOFLGS+(VTOCDCB-IHADCB),DCBOFOPN
         BO    *+8
         BAL   R14,ABEND
         NI    OPENFLAG,255-OPENUPDT
         SPACE 1
VTOCUPRD READ  VTOCDECB,SF,MF=E
         CHECK VTOCDECB
         LA    R1,=CL11'VTOC READ.'
         BAL   R14,SYNADCHK
         MVC   DS4FDAD+(CAMLIST-DS4),DCBFDAD+(VTOCDCB-IHADCB)
         SPACE 1
         CLI   DS4IDFMT+(CAMLIST-DS4),C'4'
         MVI   BADDSTYP,C'4'
         LA    R8,CAMLIST
         BNE   ERRNOTFX
         MVC   HWMOLD,DS4HPCHR+(CAMLIST-DS4)
         MVC   DS4HPCHR+(CAMLIST-DS4),HWMNEW
         SPACE 1
         WRITE VTOCDECB,SF,MF=E
         CHECK VTOCDECB
         LA    R1,=CL11'VTOC WRITE.'
         BAL   R14,SYNADCHK
         L     R1,FMT4AD
         MVC   0(DS4LEN,R1),CAMLIST
         SPACE 1
VTOCUPCL CLOSE (VTOCDCB)
         BAL   R14,DEQVTOC
         SPACE 1
         MVC   BUF+1(31),=C'VTOC RESET INFO:  OLD FMT1 HWM='
         MVI   BUF+36,C'.'
         MVI   BUF+41,C'.'
         UNPK  TRAREA,HWMOLD(8)
         TR    TRAREA,TRTABLE
         MVC   BUF+32(4),TRAREA
         MVC   BUF+37(4),TRAREA+4
         MVC   BUF+42(2),TRAREA+8
         SPACE 1
         MVC   BUF+47(13),=C'NEW FMT1 HWM='
         MVI   BUF+64,C'.'
         MVI   BUF+69,C'.'
         UNPK  TRAREA,HWMNEW(8)
         TR    TRAREA,TRTABLE
         MVC   BUF+60(4),TRAREA
         MVC   BUF+65(4),TRAREA+4
         MVC   BUF+70(2),TRAREA+8
         MVI   BUF,SPACE3AP
         BAL   R14,PRINT
         EJECT
         SPACE 1
VTOCPRT  BAL   R14,DEQVTOC
         L     R6,FMT4AD
         USING DS4,R6
         SPACE 1
         MVC   BUF+1(21),=C'DEVICE DESCRIPTION:  '
         MVC   BUF+22(5),=C'TYPE='
         L     R2,DEVTABPT
         MVC   BUF+27(15),1(R2)
         MVC   BUF+42(2),=C'  '                             *HMD 06/82*
         SPACE 1
         MVC   BUF+44(7),=C'NOCYLS='
         LA    R2,DS4DEVSZ
         BAL   R14,CONVERT2
         MVC   BUF+51(5),CONVERTD
         SPACE 1
         MVC   BUF+58(9),=C'TRKS/CYL='
         LA    R2,DS4DEVSZ+2
         BAL   R14,CONVERT2
         MVC   BUF+67(5),CONVERTD
         SPACE 1
         MVC   BUF+74(8),=C'TRKSIZE='
         LA    R2,DS4DEVTK
         BAL   R14,CONVERT2
         MVC   BUF+82(5),CONVERTD
         SPACE 1
         MVC   BUF+89(12),=C'MAX BLKSIZE='
         LA    R2,DEVTYPE+6
         BAL   R14,CONVERT2
         MVC   BUF+101(5),CONVERTD
         SPACE 1
         MVC   BUF+108(9),=C'DSCB/TRK='
         LA    R2,DS4DEVDT
         BAL   R14,CONVERT1
         MVC   BUF+117(3),CONVERTD
         SPACE 1
         MVC   BUF+122(8),=C'PDS/TRK='
         LA    R2,DS4DEVDB
         BAL   R14,CONVERT1
         MVC   BUF+130(3),CONVERTD
         MVI   BUF,SPACE2AP
         BAL   R14,PRINT
         SPACE 1
         MVC   BUF+1(11),=C'VTOC DESCR:'
         MVC   BUF+13(7),=C'R/W=0/0'
         CLI   DS4SECLV,0
         BE    VTPRDSCB
         UNPK  TRAREA,DS4SECLV(8)
         TR    TRAREA,TRTABLE
         MVC   BUF+17(1),TRAREA
         MVC   BUF+19(1),TRAREA+1
         SPACE 1
VTPRDSCB MVC   BUF+23(6),=C'DSCBS='
         SR    R0,R0
         IC    R0,DS4DEVDT
         MH    R0,VTOCSIZE
         BAL   R14,CONVERT
         MVC   BUF+29(5),CONVERTD
         SPACE 1
         MVC   BUF+35(6),=C'AVAIL='
         LA    R2,DS4DSREC
         BAL   R14,CONVERT2
         MVC   BUF+41(5),CONVERTD
         SPACE 1
         MVC   BUF+47(9),=C'VTOC EXT='
         MVI   BUF+60,C'.'
         MVI   BUF+65,C'-'
         MVI   BUF+70,C'.'
         UNPK  TRAREA,DS4VTOCE+2(8)
         TR    TRAREA,TRTABLE
         MVC   BUF+56(4),TRAREA
         MVC   BUF+61(4),TRAREA+4
         UNPK  TRAREA,DS4VTOCE+6(8)
         TR    TRAREA,TRTABLE
         MVC   BUF+66(4),TRAREA
         MVC   BUF+71(4),TRAREA+4
         SPACE 1
         MVC   BUF+78(9),=C'FMT1 HWM='
         MVI   BUF+91,C'.'
         MVI   BUF+96,C'.'
         UNPK  TRAREA,DS4HPCHR(8)
         TR    TRAREA,TRTABLE
         MVC   BUF+87(4),TRAREA
         MVC   BUF+92(4),TRAREA+4
         MVC   BUF+97(2),TRAREA+8
         SPACE 1
         MVC   BUF+101(7),=C'NUMALT='
         LA    R2,DS4NOATK
         BAL   R14,CONVERT2
         MVC   BUF+108(5),CONVERTD
         SPACE 1
       LH   R2,TRKSPVOL    LOAD TRKS PER VOL TOTAL
       SH   R2,DS4NOATK     SUBTRACT OFF ALTERNATES LEFT
       STH    R2,TRKSPVOL     TOTAL PER VOL = OLD TOT - ALTS
             SPACE   1
         MVC   BUF+114(8),=C'NEXTALT='
         UNPK  TRAREA,DS4HCCHH(8)
         TR    TRAREA,TRTABLE
         MVC   BUF+122(4),TRAREA
         MVI   BUF+126,C'.'
         MVC   BUF+127(4),TRAREA+4
         MVI   BUF,SPACE2AP
         BAL   R14,PRINT
         SPACE 1
         MVC   BUF+1(16),=C'AVAILABLE SPACE:'
         LH    R0,AVAILSPC
         BAL   R14,CONVERT
         MVC   BUF+18(5),CONVEDIT+7
         SPACE 1
         MVC   BUF+24(9),=C'TRACKS IN'
         LH    R0,AVAILEXT
         BAL   R14,CONVERT
         MVC   BUF+34(4),CONVEDIT+8
         SPACE 1
         MVC   BUF+39(18),=C'EXTENTS, INCLUDING'
         LH    R0,AVAILCYL
         BAL   R14,CONVERT
         MVC   BUF+58(4),CONVEDIT+8
         SPACE 1
         MVC   BUF+63(34),=C'FULL CYLINDERS.  LARGEST EXTENT IS'
         LA    R2,F5LARGST
         BAL   R14,CONVERT2
         MVC   BUF+98(5),CONVEDIT+7
         SPACE 1
         MVC   BUF+104(14),=C'CYLINDERS PLUS'
         LA    R2,F5LARGST+2
         BAL   R14,CONVERT1
         MVC   BUF+119(3),CONVEDIT+9
         SPACE 1
         MVC   BUF+123(7),=C'TRACKS.'
         MVI   BUF,SPACE2AP
         BAL   R14,PRINT
         SPACE 1
         TM    DS4VSAM,X'80'     TEST FOR VSAM OWNERSHIP BIT TURNED ON
         BZ    NOVSAM            IF NOT ON....NOT OWNED BY VSAM
         MVC   BUF+2(41),=C'*** THIS PACK IS OWNED BY A VSAM CATALOG '
         MVI   BUF,SPACE2AP
         BAL   R14,PRINT
         CLC   DS4VTOCE+24(2),ZEROES      CHECK FOR A "CRA" POINTER
         BE    NOVSAM      IF ZERO, NO POINTER....NO "CRA"
         MVC   CRATRACK(2),DS4VTOCE+24  MOVE CRA ADDRESS FOR ALIGNMENT
         MVC   BUF+2(41),=C'*** THIS PACK CONTAINS A C.R.A. AT TRACK:'
         LH    R0,CRATRACK     LOAD UP 2 BYTE CRA ADDRESS
         BAL   R14,CONVERT    GO CONVERT TO EBCIDIC
         MVC   BUF+43(5),CONVEDIT+7     MOVE TO PRINT LINE
         MVI   BUF,SPACE2AP
         BAL   R14,PRINT
         SPACE 1
NOVSAM   EQU   *
         TM    PARMOPT1,DIRFLAG
         BZ    NODIRFLG
         MVC   BUF+1(59),=C'*** WARNING - POSSIBLE VTOC ERRORS EXIST ONX
                THIS VOLUME ***'
         MVI   BUF,SPACE2AP
         BAL   R14,PRINT
         SPACE 3
NODIRFLG TM    PARMOPT1,DUMPOPT+SDUMPOPT+DIRFLAG
         BZ    FM1PRINT
         SPACE 1
         LR    R2,R6
         LA    R3,DS4FDAD
         BAL   R14,DUMPDSCB
         SPACE 1
         L     R8,FMT5AD
         USING DS5,R8
DMPF5TST LTR   R8,R8
         BZ    ENDUMPF5
         LR    R2,R8
         LA    R3,DS5FDAD
         BAL   R14,DUMPDSCB
         L     R8,DS5F5PTR
         B     DMPF5TST
         SPACE 1
ENDUMPF5 L     R8,FMT6AD
         USING DS6,R8
DMPF6TST LTR   R8,R8
         BZ    ENDUMPF6
         LR    R2,R8
         LA    R3,DS6FDAD
         BAL   R14,DUMPDSCB
         L     R8,DS6F6PTR
         B     DMPF6TST
         SPACE 1
ENDUMPF6 MVI   BUF,SPACE2IM
         BAL   R14,PRINT
         SPACE 1
         DROP  R6,R8
         EJECT
FM1PRINT L     R6,=A(FIRSTDS1-(DS1F1PTR-DS1))
         USING DS1,R6
         LA    R1,HEAD1A
         ST    R1,BUFPTR
         PUT   PRINTDCB,HEADER1
         PUT   PRINTDCB,HEADER2
         LH    R0,CURLINES
         AH    R0,=H'2'
         STH   R0,CURLINES
         SPACE 2
FM1PRLOP L     R6,DS1F1PTR
         CLC   DS1DSNAM,LASTDS1
         BE    FM1PREND
         SR    R7,R7
         L     R8,DS1F3PTR
         USING DS3,R8
         LTR   R8,R8
         BZ    FM1GOHK
         CLI   DS3FMTID,C'3'
         BE    FM1GOHK
         LR    R7,R8
         USING DS2,R7
         L     R8,DS2F3PTR
FM1GOHK  BAL   R14,F13HOOK
         LA    R2,1
         TM    PARMOPT1,EXTNTOPT
         BZ    FM1TSTIS
         LH    R1,NUMEXT
         LA    R2,2(R1,R2)
FM1TSTIS LTR   R7,R7
         BZ    FM1TSTDP
         TM    PARMOPT2,ISAMOPT
         BZ    *+8
         AH    R2,=H'4'
FM1TSTDP TM    PARMOPT1,DUMPOPT
         BZ    FM1LKAHD
         AH    R2,=H'4'
         LTR   R7,R7
         BZ    *+8
         AH    R2,=H'4'
         LTR   R8,R8
         BZ    FM1LKAHD
         AH    R2,=H'4'
FM1LKAHD BAL   R14,PRLKAHED
         SPACE 1
         MVC   L1DSNAME,DS1DSNAM
         SPACE 1
FM1VOLSR MVC   L1SERIAL,VOLSERNO                            *HMD 06/82*
         SPACE 1
FM1SECUR MVC   L1SECUR,=C'-/-'
         TM    DS1DSIND,X'10'  TEST FOR PASSWORD FOR R & W
         BZ    FM1CREDT     IF NO BITS....NO PASSWORD
         MVI   L1SECUR+2,C'W'      AT LEAST "WRITE" IF ANY
         TM    DS1DSIND,X'04'      TEST FOR ONLY "WRITE"..READ OK
         BO    FM1CREDT       IF ON,  "READ" NOT PROTECTED
         MVI   L1SECUR,C'R'      INDICATE "READ" PROTECT
         SPACE 1
FM1CREDT LA    R2,DS1CREDT
         LA    R3,L1CREDT
         BAL   R14,DATEDIT
         SPACE 1
         LA    R2,DS1EXPDT
         LA    R3,L1EXPDT
         BAL   R14,DATEDIT
         SPACE 1
         LA    R2,DS1REFD   IF YOU GET AN ERROR ASSEMBLING THIS AXC
         LA    R3,L1REFDT   IT IS BECAUSE YOU DO NOT HAVE SU60  AXC
         BAL   R14,DATEDIT  JUST NO-OP THESE THREE INSTRUCTIONS AXC
         SPACE 1
FM1DSORG LA    R2,L1DSORG
         TM    DS1DSORG,DCBDSGIS
         BZ    FM1DSO1
         MVC   0(2,R2),=C'IS'
         LA    R2,2(R2)
FM1DSO1  TM    DS1DSORG,DCBDSGPS
         BZ    FM1DSO2
         MVC   0(2,R2),=C'PS'
         LA    R2,2(R2)
FM1DSO2  TM    DS1DSORG,DCBDSGDA
         BZ    FM1DSO3
         MVC   0(2,R2),=C'DA'
         LA    R2,2(R2)
FM1DSO3  TM    DS1DSORG,DCBDSGCX
         BZ    FM1DSO6              AXC
         MVC   0(2,R2),=C'CX'
         LA    R2,2(R2)
*FM1DSO4 TM    DS1DSORG,=X'08'      AXC
*        BZ    FM1DSO5              AXC
*        MVC   0(2,R2),=C'CQ'       AXC
*        LA    R2,2(R2)             AXC
*FM1DSO5 TM    DS1DSORG,=X'04'      AXC
*        BZ    FM1DSO6              AXC
*        MVC   0(2,R2),=C'MQ'       AXC
*        LA    R2,2(R2)             AXC
FM1DSO6  TM    DS1DSORG,DCBDSGPO
         BZ    FM1DSO7
         MVC   0(2,R2),=C'PO'
         LA    R2,2(R2)
FM1DSO7  TM    DS1DSORG+1,DCBDSGGS
         BZ    FM1DSO8
         MVC   0(2,R2),=C'GS'
         LA    R2,2(R2)
FM1DSO8  TM    DS1DSORG+1,DCBDSGTX
         BZ    FM1DSO9
         MVC   0(2,R2),=C'TX'
         LA    R2,2(R2)
FM1DSO9  TM    DS1DSORG+1,DCBDSGTQ
         BZ    FM1DSO10
         MVC   0(2,R2),=C'TQ'
         LA    R2,2(R2)
FM1DSO10 TM    DS1DSORG+1,DCBACBM
         BZ    FM1DSO11
         MVC   0(2,R2),=C'AM'
         LA    R2,2(R2)
FM1DSO11 TM    DS1DSORG+1,DCBDSGTR
         BZ    FM1DSO12
         MVC   0(2,R2),=C'TR'
         LA    R2,2(R2)
FM1DSO12 TM    DS1DSORG,DCBDSGU
         BZ    *+8
         MVI   0(R2),C'U'
         SPACE 1
         LA    R2,L1RECFM
         TM    DS1RECFM,DCBRECU
         BZ    FM1RECF1
         MVI   0(R2),C'U'
         BO    FM1RECF1
         TM    DS1RECFM,DCBRECF
         MVI   0(R2),C'F'
         BO    FM1RECF1
         MVI   0(R2),C'V'
FM1RECF1 LA    R2,1(R2)
         TM    DS1RECFM,DCBRECTO
         BZ    FM1RECF2
         MVI   0(R2),C'T'
         LA    R2,1(R2)
FM1RECF2 TM    DS1RECFM,DCBRECBR
         BZ    FM1RECF3
         MVI   0(R2),C'B'
         LA    R2,1(R2)
FM1RECF3 TM    DS1RECFM,DCBRECSB
         BZ    FM1RECF4
         MVI   0(R2),C'S'
         LA    R2,1(R2)
FM1RECF4 TM    DS1RECFM,DCBRECCC
         BNM   FM1BLKSZ
         TM    DS1RECFM,DCBRECCA
         MVI   0(R2),C'A'
         BO    FM1BLKSZ
         MVI   0(R2),C'M'
         SPACE 1
FM1BLKSZ LA    R2,DS1BLKL
         BAL   R14,CONVERT2
         MVC   L1BLKSIZ,CONVEDIT+7
         SPACE 1
         LA    R2,DS1LRECL
         BAL   R14,CONVERT2
         MVC   L1LRECL,CONVEDIT+7
         SPACE 1
         LA    R2,DS1KEYL
         BAL   R14,CONVERT1
         MVC   L1KEYLEN,CONVEDIT+9
         SPACE 1
         UNPK  TRAREA,DS1OPTCD(8)
         TR    TRAREA,TRTABLE
         MVC   L1OPTCD,TRAREA
         SPACE 1
         L     R0,F1TRKAL
         BAL   R14,CONVERT
         MVC   L1TRKAL,CONVEDIT+7
         SPACE 1
         CLC   DS1LSTAR(5),ZEROES
         BE    FM1NOEPV
         LH    R0,DS1LSTAR
         CLI   DS1LSTAR+2,0
         BE    *+8
         AH    R0,=H'1'
         BAL   R14,CONVERT
         MVC   L1TRKUS,CONVEDIT+7
         SPACE 1
FM1NOEPV LA    R2,DS1NOEPV
         BAL   R14,CONVERT1
         MVC   L1NOEPV,CONVEDIT+10
         SPACE 1
         LA    R2,DS1SCALO+1
         BAL   R14,CONVERT3
         MVC   L1SECQU,CONVEDIT+7
         C     R0,=F'99999'
         BNH   FM1SCALO
         MVC   L1SECQU,STARS
         SPACE 1
FM1SCALO TM    DS1SCALO,X'C0'
         BNO   FM1SCAL1
         MVI   L1TYP,C'C'
         B     FM1SCAL4
FM1SCAL1 BNZ   FM1SCAL2
         MVI   L1TYP,C'A'
         B     FM1SCAL4
FM1SCAL2 TM    DS1SCALO,X'80'
         BO    FM1SCAL3
         MVI   L1TYP,C'B'
         B     FM1SCAL4
FM1SCAL3 MVI   L1TYP,C'T'
FM1SCAL4 LA    R2,L1TYP+1
         TM    DS1SCALO,X'08'
         BZ    FM1SCAL5
         MVI   0(R2),C'C'
         LA    R2,1(,R2)
FM1SCAL5 TM    DS1SCALO,X'04'
         BZ    FM1SCAL6
         MVI   0(R2),C'M'
         LA    R2,1(,R2)
FM1SCAL6 TM    DS1SCALO,X'02'
         BZ    FM1SCAL7
         MVI   0(R2),C'A'
         LA    R2,1(,R2)
FM1SCAL7 TM    DS1SCALO,X'01'
         BZ    FM1OPTS
         MVI   0(R2),C'R'
         SPACE 1
FM1OPTS  MVI   BUF,SPACE1AP
         TM    PARMOPT1,EMPTYOPT     TEST FOR "EMPTY" OPTION
         BO    FM1EM1         IF REQUEST GO TO PROCESS IT
         TM    PARMOPT2,MODELOPT   TEST FOR "MODEL" OPTION
         BZ    FM1SKTS0   IF NOT MODEL BYPASS..
*
FM1EM1   CLC   DS1LSTAR(5),ZEROES   TEST FOR TTR ZEROED...NOT VALID
         BE    FM1DONXT              IF ALL ZERO...BYPASS
         CLI   DS1LSTAR+2,0         TEST FOR A TTR OF RECORD ZERO
         BNE   FM1DONXT             IF NOT ZERO, NON-EMPTY DSN
         CLC   NUMEXT,ZEROES        TEST FOR ANY VALID EXTENTS
         BNE   FM1EM2              IF NOT ZERO...EMPTY DATASET.
         TM    PARMOPT2,MODELOPT    CHECK FOR "MODEL" OPTION SELECTED
         BO    FM1SKTS0      IF SELECTED...PRINT THIS ENTRY
         B     FM1DONXT    IF NOT MODEL...DON'T INCLUDE IT AS "EMPTY"
FM1EM2   TM    PARMOPT1,EMPTYOPT     CHECK FOR OPTION OF "EMPTY"
         BZ    FM1DONXT  IF NOT SELECTED...DON'T PRINT
*
FM1SKTS0 EQU  *
         TM    PARMOPT1,DUMPOPT
         BO    FM1XTRAL
         TM    PARMOPT1,EXTNTOPT
         BZ    FM1SKTS1
         CLC   NUMEXT,ZEROES
         BNE   FM1XTRAL
FM1SKTS1 TM    PARMOPT2,ISAMOPT
         BZ    FM1SKTS2
         LTR   R7,R7
         BNZ   FM1XTRAL
FM1SKTS2 TM    PARMOPT1,PDSOPT
         BZ    FM1GOPRT
         TM    DS1DSORG,DCBDSGPO
         BZ    FM1GOPRT
FM1XTRAL MVI   BUF,SPACE2AP
FM1GOPRT BAL   R14,PRINT
         SPACE 1
FM1SKTS3 EQU   *
         TM    PARMOPT1,DUMPOPT
         BZ    FM1EXDMP
         LA    R2,DS1
         LA    R3,DS1FDAD
         BAL   R14,DUMPDSCB
         LTR   R7,R7
         BZ    FM1DMP3
         LA    R2,DS2
         LA    R3,DS2FDAD
         BAL   R14,DUMPDSCB
FM1DMP3  LTR   R8,R8
         BZ    FM1EXDMP
         LA    R2,DS3
         LA    R3,DS3FDAD
         BAL   R14,DUMPDSCB
         SPACE 1
FM1EXDMP TM    PARMOPT1,EXTNTOPT
         BZ    FM1PDSDP
         CLC   NUMEXT,ZEROES
         BE    FM1PDSDP
         MVC   BUF+10(L'HEAD2DAT),HEAD2DAT
         MVI   BUF,SPACE0AP
         BAL   R14,PRINT
         MVC   BUF+10(L'HEAD2UND),HEAD2UND
         MVI   BUF,SPACE1AP
         BAL   R14,PRINT
         L     R2,LISTEXT
         LA    R3,BUF+9
         SR    R4,R4
         MVI   EXPFLAG,X'FF'
         SPACE 1
FM1EXLP  BAL   R14,EXFORMAT
         LA    R4,4(,R4)
         L     R2,LISTEXT(R4)
         LTR   R2,R2
         BZ    FM1EXLST
         BAL   R14,PRINT
         B     FM1EXLP
FM1EXLST MVI   BUF,SPACE2AP
         BAL   R14,PRINT
         SPACE 1
FM1PDSDP TM    PARMOPT1,PDSOPT
         BZ    FM1ISDMP
         TM    DS1DSORG,DCBDSGPO
         BZ    FM1ISDMP
         LA    R2,DS1
         BAL   R14,PDSLIST
         SPACE 1
FM1ISDMP TM    PARMOPT2,ISAMOPT
         BZ    FM1DONXT
         BAL   R14,ISAMLIST
FM1DONXT B     FM1PRLOP
         EJECT
*
* G.D.F. ROUTINE TO CONVERT INPUT & OUTPUT DATES TO
* SAME FORMAT AS CREDAT & EXPDAT FOR DATEDIT ROUTINE
*
BINARY   UNPK  DASAVE(3),0(2,R2)  G.D.F.
         PACK  DATEWORD,DASAVE(2)  G.D.F.
         CVB   R1,DATEWORD    G.D.F.
         STC   R1,0(R2)       G.D.F.
         ZAP   DATEWORD,1(2,R2)  G.D.F.
         CVB   R1,DATEWORD    G.D.F.
         STH   R1,DATEWORD    G.D.F.
         MVC   1(2,R2),DATEWORD  G.D.F.
         BR    R14            G.D.F.
*
* END OF BINARY CONVERT ROUTINE
*
         EJECT
FM1PREND MVI   BUF,SPACE1IM
         BAL   R14,PRINT
         MVI   BUF+1,C' '          MOVE TO BLANK OUT LINE
         MVC   BUF+2(131),BUF+1    BLANK OUT PRINT LINE
         MVC   BUF+49(14),=C'<<<<< END VTOC'
         LH    R0,FM1COUNT
         BAL   R14,CONVERT
         MVC   BUF+64(4),CONVEDIT+8
         MVC   BUF+69(15),=C'DATA SETS >>>>>'
         MVI   BUF,SPACE3AP
         BAL   R14,PRINT
         SPACE 1
         TM    PARMOPT2,SMAPOPT
         BO    MAPPRINT
         TM    PARMOPT1,MAPOPT+DIRFLAG
         BZ    MAPEND
         SPACE 1
         DROP  R6,R7,R8
         EJECT
MAPPRINT MVC   CURLINES,=H'999'
         LA    R0,HEAD2A
         ST    R0,BUFPTR
         MVI   HEADMID,C' '
         MVC   HEADMID+1(81),HEADMID
         MVC   HEAD2VOL,VOLSERNO
         MVC   HEADMID(40),HEAD2
         L     R6,HOOKSTRT
         USING EXTENT,R6
         L     R4,=F'-1'
         SR    R5,R5
         MVI   EXPFLAG,0
         SPACE 1
MAPPRLOP CLC   EXTLCCHH,HOOKEND
         BE    MAPPREND
         CLC   EXTHITT,TRKSPVOL
         BNL   MAPINVAL
         CLC   EXTLOTT,EXTHITT
         BH    MAPINVAL
         CLI   EXTTYPE,X'80'
         BE    MAPGETEX
         LH    R0,EXTLOTT
         SR    R0,R4
         S     R0,=F'1'
         BZ    MAPTRGET
         BP    MAPTRMIS
         BAL   R14,CONVERT
         MVC   BUF+1(5),CONVEDIT+7
         MVC   BUF+7(14),=C'TRACKS OVERLAP'
         CH    R4,EXTHITT
         BNL   *+8
MAPTRGET LH    R4,EXTHITT
         AH    R5,EXTNOTRK
         B     MAPGETEX
         SPACE 1
MAPINVAL MVC   BUF+7(14),=C'INVALID EXTENT'
         B     MAPGETEX
         SPACE 1
MAPTRMIS BAL   R14,CONVERT
         MVC   BUF+1(5),CONVEDIT+7
         MVC   BUF+7(14),=C'TRACKS MISSING'
         MVI   BUF,SPACE1AP
         BAL   R14,PRINT
         B     MAPTRGET
         SPACE 1
MAPGETEX LA    R2,EXTENT
         LA    R3,BUF+22
         BAL   R14,EXFORMAT
         MVC   SEEKBUF(133),BUF
         BAL   R14,PRINT
         TM    PARMOPT2,SMAPOPT
         BZ    *+8
         BAL   R14,MAPSEEK
         L     R6,EXTPTR
         B     MAPPRLOP
         SPACE 3
MAPPREND LH    R0,TRKSPVOL
         SR    R0,R4
         S     R0,=F'1'
         BNP   MAPNOMIS
         BAL   R14,CONVERT
         MVC   BUF+1(5),CONVEDIT+7
         MVC   BUF+7(40),=C'TRACKS MISSING OR ASSIGNED AS ALTERNATES'
         MVI   BUF,SPACE1AP
         BAL   R14,PRINT
MAPNOMIS MVI   BUF,SPACE1IM
         BAL   R14,PRINT
         LR    R0,R5
         BAL   R14,CONVERT
         MVC   BUF+59(5),CONVEDIT+7
         MVC   BUF+66(20),=C'TRACKS ACCOUNTED FOR'
         MVI   BUF,SPACE2AP
         BAL   R14,PRINT
         TM    PARMOPT2,SMAPOPT    SMAP SPECIFIED?          *HMD 06/82*
         BZ    *+8                                          *HMD 06/82*
         BAL   R14,MAPSEEKA        ERROR TRACKS
         MVC   BUF+59(28),=C'<<<<< END OF TRACK MAP >>>>>'
         MVI   BUF,SPACE0AP
         BAL   R14,PRINT
MAPEND   B     NEXTVOL
         SPACE 1
         DROP  R6
         EJECT
MAPSEEK  STM   R14,R12,VOLSAVE
         TR    SEEKBUF+23(20),SEEKTABL
         SR    R14,R14
         ICM   R15,15,SEEKBUF+34
         SLL   R15,4
         SLDL  R14,4
         SLL   R15,4
         SLDL  R14,4
         SLL   R15,4
         SLDL  R14,4
         SLL   R15,4
         SLDL  R14,4
         ST    R14,SEEKCYL
         SR    R14,R14
         ICM   R15,15,SEEKBUF+39
         SLL   R15,4
         SLDL  R14,4
         SLL   R15,4
         SLDL  R14,4
         SLL   R15,4
         SLDL  R14,4
         SLL   R15,4
         SLDL  R14,4
         ST    R14,SEEKTRK
         SR    R14,R14
         ICM   R15,15,SEEKBUF+23
         SLL   R15,4
         SLDL  R14,4
         SLL   R15,4
         SLDL  R14,4
         SLL   R15,4
         SLDL  R14,4
         SLL   R15,4
         SLDL  R14,4
         LR    R5,R14
         SR    R14,R14
         ICM   R15,15,SEEKBUF+28
         SLL   R15,4
         SLDL  R14,4
         SLL   R15,4
         SLDL  R14,4
         SLL   R15,4
         SLDL  R14,4
         SLL   R15,4
         SLDL  R14,4
         LR    R7,R14
         LA    R6,MAXCYL
         LR    R4,R5               CYL
         SLL   R4,7                X 128
         LR    R1,R7               TRK
         SLL   R1,2                X 4
         AR    R1,R4
         L     R4,VOLTAB           VOL TAB ADDR
         LA    R4,0(R1,R4)         SLOT ADDR
         EJECT
MAPSEEK0 SR    R8,R8               TOTAL
         ST    R5,SEEKCURR
         SPACE 1
MAPSEEK1 C     R5,SEEKCYL          END OF EXTENT (CYL)
         BL    MAPSEEK2            NO
         BH    MAPSEEK3            YES
         C     R7,SEEKTRK          END OF EXTENT (TRK)
         BH    MAPSEEK3            YES
         SPACE 1
MAPSEEK2 A     R8,0(0,R4)          TOTAL TRACK ACCESS COUNT
         LA    R4,4(0,R4)          NEXT TRK
         LA    R7,1(0,R7)
         C     R7,=A(MAXTRK)       MAX TRKS PER CYL
         BL    MAPSEEK1
         SPACE 1
MAPSEEK3 LTR   R15,R8              TOTAL FOR CYL
         BZ    MAPSEEK4            ZERO, NO PRINT
         M     R14,=F'100'
         D     R14,VOLSEEK
         SLL   R14,1
         C     R14,VOLSEEK         ROUND UP
         BL    *+8                 NO
         LA    R15,1(0,R15)
         CVD   R15,SEEKDBL
         MVI   SEEKBUF+1,C' '
         MVC   SEEKBUF+2(131),SEEKBUF+1
         MVC   SEEKBUF+1(3),=CL3'CYL'
         UNPK  SEEKBUF+5(4),SEEKCURR+2(3)
         MVI   SEEKBUF+8,C' '
         NC    SEEKBUF+5(3),=3X'0F'
         TR    SEEKBUF+5(3),=C'0123456789ABCDEF'
         MVC   SEEKBUF+8(5),=X'402021206C'
         ED    SEEKBUF+8(4),SEEKDBL+6
         SRL   R15,1
         CH    R15,=H'50'          MAX
         BNH   *+8                 NO
         LH    R15,=H'50'          SET MAX
         EX    R15,PCTMVE          GRAPHIC PERCENT
         LA    R15,SEEKBUF+15(R15)
         MVI   0(R15),C'>'
         MVC   BUF(133),SEEKBUF
         BAL   R14,PRINT
         SPACE 1
MAPSEEK4 C     R5,SEEKCYL          END OF EXTENT (CYL)
         BL    MAPSEEK5            NO
         BH    MAPSEEK6            YES
         C     R7,SEEKTRK          END OF EXTENT (TRK)
         BNL   MAPSEEK6            YES
         SPACE 1
MAPSEEK5 LA    R5,1(0,R5)          NEXT CYL
         SR    R7,R7               TRK 0
         BCT   R6,MAPSEEK0
         SPACE 1
MAPSEEK6 LM    R14,R12,VOLSAVE
         BR    R14
         SPACE 1
PCTMVE   MVC   SEEKBUF+15(0),PCTLINE
         EJECT
MAPSEEKA STM   R14,R12,VOLSAVE
         L     R4,VOLTAB           VOL TAB ADDR
         LA    R4,124(0,R4)
         SR    R5,R5
         LA    R6,MAXCYL
         SPACE 1
MAPSEEKB ST    R5,SEEKCURR
         L     R8,0(0,R4)          ERROR TRACK ACCESS COUNT
         LA    R4,128(0,R4)        NEXT TRK
         SPACE 1
MAPSEEKC LTR   R15,R8              TOTAL FOR CYL
         BZ    MAPSEEKD            ZERO, NO PRINT
         M     R14,=F'100'
         D     R14,VOLSEEK
         SLL   R14,1
         C     R14,VOLSEEK         ROUND UP
         BL    *+8                 NO
         LA    R15,1(0,R15)
         CVD   R15,SEEKDBL
         MVI   SEEKBUF+1,C' '
         MVC   SEEKBUF+2(131),SEEKBUF+1
         MVC   SEEKBUF+1(3),=CL3'CYL'
         UNPK  SEEKBUF+5(4),SEEKCURR+2(3)
         MVI   SEEKBUF+8,C' '
         NC    SEEKBUF+5(3),=3X'0F'
         TR    SEEKBUF+5(3),=C'0123456789ABCDEF'
         MVC   SEEKBUF+8(5),=X'402021206C'
         ED    SEEKBUF+8(4),SEEKDBL+6
         SRL   R15,1
         CH    R15,=H'50'          MAX
         BNH   *+8                 NO
         LH    R15,=H'50'          SET MAX
         EX    R15,PCTMVE          GRAPHIC PERCENT
         LA    R15,SEEKBUF+15(R15)
         MVI   0(R15),C'>'
         MVC   BUF(133),SEEKBUF
         BAL   R14,PRINT
         SPACE 1
MAPSEEKD LA    R5,1(0,R5)          NEXT CYL
         BCT   R6,MAPSEEKB
         MVC   BUF(133),SEEKEMSG
         SR    R14,R14
         L     R15,VOLSAMP
         CVD   R15,SEEKDBL
         MVC   BUF+22(6),=X'402020202120'
         ED    BUF+22(6),SEEKDBL+5
         L     R15,VOLSEEK
         M     R14,=F'100'
         D     R14,VOLSAMP
         CVD   R15,SEEKDBL
         MVC   BUF+7(4),=X'40202120'
         ED    BUF+7(4),SEEKDBL+6
         BAL   R14,PRINT
         LM    R14,R12,VOLSAVE
         BR    R14
         EJECT
ERRNODD  TM    PARMOPT2,VOLSOPT
         BNO   NEXTDD
         MVC   BUF+41(19),=C'CANNOT FIND DD CARD'
         B     ERRCON1
         SPACE 1
ERRNOTDA TM    PARMOPT2,VOLSOPT
         BNO   NEXTDD
         MVC   BUF+41(27),=C'DEVICE IS NOT DIRECT ACCESS'
         B     ERRCON1
         SPACE 1
ERRUNKDV MVC   BUF+41(19),=C'UNKNOWN DEVICE TYPE'
         B     ERRCON1
         SPACE 1
ERRNOPEN MVC   BUF+41(27),=C'ATTEMPT TO OPEN VTOC FAILED'
         B     ERRCON1
         SPACE 1
ERRCON1  MVC   BUF+10(28),=C'ERROR CONCERNING "VOLUME01":'
         MVC   BUF+28(8),VOLDDNAM
         MVI   BUF,SPACE3AP
         BAL   R14,PRINT
         LA    R0,4
         B     ERRCODST
         SPACE 1
ERRNOTFX MVC   BUF+41(33),=C'BAD DSCB - SHOULD HAVE BEEN TYPE'
         MVC   BUF+75(1),BADDSTYP
         LR    R2,R8
         B     ERRCON2
         SPACE 1
ERRNOCOR MVC   BUF+41(41),=C'INSUFFICIENT MEMORY TO COMPLETE VTOC LIST'
         SR    R2,R2
         B     ERRCON2
         SPACE 1
ERRCON2  BAL   R14,CLOSVTOC
         BAL   R14,DEQVTOC
         MVC   BUF+10(28),=C'ERROR CONCERNING "VOLUME01":'
         MVC   BUF+28(8),VOLDDNAM
         MVI   BUF,SPACE3AP
         BAL   R14,PRINT
         LTR   R2,R2
         BZ    ERRNODMP
         LA    R3,DS4FDAD-DS4(R2)
         BAL   R14,DUMPDSCB
ERRNODMP LA    R0,8
ERRCODST C     R0,RETCODE
         BL    *+8
         ST    R0,RETCODE
         B     NEXTVOL
         EJECT
*
*        SUBROUTINES START HERE
*
PDSLIST  ST    R14,PDSAVE
         STM   R2,R6,PDSAVE+4
         USING DS1,R2
         MVC   JFCBDSNM,DS1DSNAM
         SR    R0,R0
         IC    R0,DS1NOBDB
         BAL   R14,CONVERT
         DROP  R2
         MVC   PDSVAL4,CONVEDIT+9
         SPACE 1
         OPEN  (PDSDCB),TYPE=J
         L     R3,PDSBLKAD+4
         READ  PDSDECB,SF,,(3),MF=E
         SPACE 1
         SR    R0,R0
         STH   R0,PDSBYTCT
         STH   R0,PDSBLKAL
         STH   R0,PDSBLKUS
         STH   R0,PDSMEMCT
PDSNEXT  LH    R0,PDSBYTCT
         LTR   R0,R0
         BP    PDSPRINT
         CHECK PDSDECB
         SPACE 1
         CLI   SYNADFLG,0
         BE    PDSREDOK
         MVC   BUF+28(11),=CL11'DIRECTORY.'
         MVI   BUF,SPACE3AP
         BAL   R14,PRINT
         CLI   SYNADFLG,X'FF'
         BE    PDSEOD
         BAL   R14,ABDUMP
         SPACE 1
PDSREDOK LM    R2,R3,PDSBLKAD
         XR    R2,R3
         XR    R3,R2
         XR    R2,R3
         STM   R2,R3,PDSBLKAD
         READ  PDSDECB,SF,,(3),MF=E
         SPACE 1
         USING PDS,R2
         LH    R1,PDSBLKAL
         LA    R1,1(R1)
         STH   R1,PDSBLKAL
         LH    R0,PDSCOUNT
         SH    R0,=H'2'
         STH   R0,PDSBYTCT
         LA    R1,PDSENTRY
         ST    R1,PDSENTAD
         B     PDSNEXT
         SPACE 1
         DROP  R2
         SPACE 3
PDSPRINT L     R6,PDSENTAD
         USING PDSENTRY,R6
         IC    R2,PDSINDIC
         N     R2,=A(PDSUSERH)
         SLL   R2,1
         LR    R1,R6
         AR    R1,R2
         LA    R1,12(R1)
         ST    R1,PDSENTAD
         LH    R1,PDSBYTCT
         SR    R1,R2
         SH    R1,=Y(PDSUSERD-PDSENTRY)
         STH   R1,PDSBYTCT
         CLC   PDSNAME,EFFS
         BNE   PDSMEMOK
         MVC   PDSBLKUS,PDSBLKAL
         B     PDSNEXT
PDSMEMOK LH    R1,PDSMEMCT
         LA    R1,1(R1)
         STH   R1,PDSMEMCT
         MVC   BUF+12(8),PDSNAME
         TM    PDSINDIC,PDSALIAS
         BZ    *+8
         MVI   BUF+21,C'A'
         UNPK  TRAREA,PDSTTRP(8)
         TR    TRAREA,TRTABLE
         MVC   BUF+23(4),TRAREA
         MVI   BUF+27,C'.'
         MVC   BUF+28(2),TRAREA+4
         IC    R0,PDSINDIC
         N     R0,=A(PDS#TTRS)
         SRL   R0,5
         STC   R0,BUF+32
         OI    BUF+32,X'F0'
         LR    R5,R2
         CH    R2,=H'44'
         BNH   PDSPRLIN
         LA    R2,2
         BAL   R14,PRLKAHED
         LR    R2,R5
         LA    R5,44
PDSPRLIN LA    R3,PDSUSERD
         LA    R4,BUF+35
         BAL   R14,DUMPLINE
         MVI   BUF,SPACE1AP
         BAL   R14,PRINT
         CH    R2,=H'44'
         BNH   PDSNEXT
         LR    R5,R2
         SH    R5,=H'44'
         LA    R3,PDSUSERD+44
         LA    R4,BUF+35
         BAL   R14,DUMPLINE
         MVI   BUF,SPACE1AP
         BAL   R14,PRINT
         B     PDSNEXT
         SPACE 1
         DROP  R6
         SPACE 2
PDSEOD   CLOSE (PDSDCB)
         CLI   SYNADFLG,0
         MVI   SYNADFLG,0
         BNE   PDSRETRN
         LH    R0,PDSMEMCT
         BAL   R14,CONVERT
         MVC   PDSVAL1,CONVEDIT+8
         LH    R0,PDSBLKUS
         BAL   R14,CONVERT
         MVC   PDSVAL2,CONVEDIT+8
         LH    R0,PDSBLKAL
         BAL   R14,CONVERT
         MVC   PDSVAL3,CONVEDIT+8
         MVC   BUF+10(PDSMSGLN),PDSMSG
         MVI   BUF,SPACE3AP
         BAL   R14,PRINT
PDSRETRN LM    R2,R6,PDSAVE+4
         L     R14,PDSAVE
         BR    R14
         EJECT ,
         SPACE 1
         USING DS2,R7
ISAMLIST LTR   R7,R7
         BZR   R14
         ST    R14,ISAVE
         STM   R2,R5,ISAVE+4
         SPACE 1
         MVC   BUF+12(19),=C'NO OF INDEX LEVELS='
         LA    R2,DS2NOLEV
         BAL   R14,CONVERT1
         MVC   BUF+31(3),CONVERTD
         SPACE 1
         MVC   BUF+42(19),=C'FLAGGED FOR DELETE='
         LA    R2,DS2TAGDT
         BAL   R14,CONVERT2
         MVC   BUF+61(5),CONVERTD
         SPACE 1
         MVC   BUF+72(19),=C'TRKS FOR HIGH INDX='
         LA    R2,DS2NOTRK
         BAL   R14,CONVERT1
         MVC   BUF+91(3),CONVERTD
         SPACE 1
         MVC   BUF+102(19),=C'IND OVFL TRKS LEFT='
         LA    R2,DS2RORG2
         BAL   R14,CONVERT2
         MVC   BUF+121(5),CONVERTD
         MVI   BUF,SPACE1AP
         BAL   R14,PRINT
         SPACE 1
         MVC   BUF+12(19),=C'TRKS FOR MAST INDX='
         LA    R2,DS2DVIND
         BAL   R14,CONVERT1
         MVC   BUF+31(3),CONVERTD
         SPACE 1
         MVC   BUF+42(19),=C'OVERFLOW  ACCESSES='
         LA    R2,DS2RORG3
         BAL   R14,CONVERT3
         MVC   BUF+61(8),CONVERTD
         SPACE 1
         MVC   BUF+72(19),=C'PRIME DATA RECORDS='
         LA    R2,DS2PRCTR
         BAL   R14,CONVERT4
         MVC   BUF+91(10),CONVERTD
         SPACE 1
         MVC   BUF+102(19),=C'NO OF OVFL RECORDS='
         LA    R2,DS2OVRCT
         BAL   R14,CONVERT2
         MVC   BUF+121(5),CONVERTD
         MVI   BUF,SPACE1AP
         BAL   R14,PRINT
         SPACE 1
         MVC   BUF+12(19),=C'CYL OVFL  TRKS/CYL='
         LA    R2,DS2CYLOV
         BAL   R14,CONVERT1
         MVC   BUF+31(3),CONVERTD
         SPACE 1
         MVC   BUF+42(19),=C'CORE FOR HIGH INDX='
         LA    R2,DS2NOBYT
         BAL   R14,CONVERT2
         MVC   BUF+61(5),CONVERTD
         SPACE 1
         MVC   BUF+72(19),=C'IND OFL BYTES LEFT='
         LA    R2,DS2BYOVL
         BAL   R14,CONVERT2
         MVC   BUF+91(5),CONVERTD
         SPACE 1
         MVC   BUF+102(19),=C'FULL CYLOVFL AREAS='
         LA    R2,DS2RORG1
         BAL   R14,CONVERT2
         MVC   BUF+121(5),CONVERTD
         MVI   BUF,SPACE2AP
         BAL   R14,PRINT
         SPACE 1
         LM    R2,R5,ISAVE+4
         L     R14,ISAVE
         BR    R14
         DROP  R7
         EJECT
         SPACE 1
         USING EXTENT,R2
         USING EXLINE,R3
         SPACE 1
EXFORMAT LTR   R2,R2               ANY EXTENT.Q
         BZR   R14                 RETURN IMM IF NOT
         ST    R14,EXSAVE
         STM   R2,R3,EXSAVE+4
         SPACE 1
         UNPK  TRAREA,EXTLCCHH(8)
         TR    TRAREA,TRTABLE
         MVC   EXLFCC,TRAREA
         MVI   EXLFPRD,C'.'
         MVC   EXLFHH,TRAREA+4
         SPACE 1
         UNPK  TRAREA,EXTHCCHH(8)
         TR    TRAREA,TRTABLE
         MVC   EXLLCC,TRAREA
         MVI   EXLLPRD,C'.'
         MVC   EXLLHH,TRAREA+4
         SPACE 1
         LH    R0,EXTLOTT
         BAL   R14,CONVERT
         MVC   EXLFTT,CONVEDIT+7
         SPACE 1
         LH    R0,EXTHITT
         BAL   R14,CONVERT
         MVC   EXLLTT,CONVEDIT+7
         SPACE 1
         LH    R0,EXTNOTRK
         BAL   R14,CONVERT
         MVC   EXLNOTRK,CONVEDIT+7
         SPACE 1
         CLI   EXPFLAG,0
         BNE   EXPTYPE
         L     R1,EXTIDPTR
         MVC   EXLDSNAM,0(R1)
         SPACE 1
EXPTYPE  CLI   EXTTYPE,X'01'       IS THIS A DATA EXTENT.Q
         BNE   EXPNDATA            NO, GO CHECK OTHERS
         CLI   EXPFLAG,0           ARE WE MAPPING.Q
         BE    EXPEXTPR            YES, DON'T CLUTTER UP
         MVC   EXLTYPE,=C'PRIM'    ELSE MOVE IN EXTENT TYPE
         B     EXPEXTPR
         SPACE 1
EXPNDATA TM    EXTTYPE,X'F0'       VOL LABEL, OR TYPE 4, 5, OR 6
         BO    EXPCKFMX            BR IF YES
         CLI   EXTTYPE,X'02'       ISAM OVERFLOW.Q
         MVC   EXLTYPE,=C'OVFL'
         BE    EXPEXTPR
         SPACE 1
         CLI   EXTTYPE,X'04'       ISAM INDEX.Q
         MVC   EXLTYPE,=C'INDX'
         BE    EXPEXTPR
         SPACE 1
         CLI   EXTTYPE,X'40'       USER LABEL TRACK.Q
         MVC   EXLTYPE,=C'ULBL'
         BE    EXPEXTPR
         SPACE 1
         CLI   EXTTYPE,X'81'       CYLS OF DATA ON CYL BDRY.Q
         MVC   EXLTYPE,=C'CYLB'
         BE    EXPEXTPR
         SPACE 1
         CLI   EXTTYPE,X'80'       SHARING AN EXTENT.Q
         MVC   EXLTYPE,=C'SHRD'
         BNE   EXPCKFMX
         CLI   EXPFLAG,0           ARE WE MAPPING.Q
         BNE   EXPEXTPR            NO, DON'T ENCLOSE IN PARENS
         MVI   EXLLPARN,C'('
         MVI   EXLRPARN,C')'
         B     EXPEXTPR
         SPACE 1
EXPCKFMX CLI   EXTTYPE,C'5'        FREE EXTENT.Q
         BE    EXPPRLIN
         SPACE 1
         CLI   EXTTYPE,C'4'        VTOC EXTENT.Q
         MVC   EXLTYPE,=C'VTOC'
         BE    EXPEXTPR
         SPACE 1
         CLI   EXTTYPE,X'FF'       VOLUME LABEL.Q
         MVC   EXLTYPE,=C'VLBL'
         BE    EXPPRLIN
         SPACE 1
         CLI   EXTTYPE,C'6'        SHARED EXTENT.Q
         MVC   EXLTYPE,=C'*UN*'
         BNE   EXPEXTPR
         SPACE 1
         MVC   EXLTYPE,=C'SPLT'
         SR    R0,R0
         IC    R0,EXTSEQNO
         BAL   R14,CONVERT
         MVC   EXLSPLIT(3),CONVEDIT+9
         B     EXPPRLIN
         SPACE 1
EXPEXTPR SR    R0,R0
         IC    R0,EXTSEQNO
         AH    R0,=H'1'
         BAL   R14,CONVERT
         MVC   EXLSEQNO,CONVEDIT+10
         SPACE 1
EXPPRLIN MVI   BUF,SPACE1AP
         LM    R2,R3,EXSAVE+4
         L     R14,EXSAVE
         BR    R14
         DROP  R2,R3
         EJECT
         SPACE 3
VTOCREAD ST    R14,VTSAVE
         STM   R2,R4,VTSAVE+4
         L     R2,RENEXT@
         CHECK (2)
         LA    R1,=CL11'VTOC READ.'
         BAL   R14,SYNADCHK
         SPACE 1
         USING DS1,R3
VTOCREOK XC    0(20,R2),0(R2)
         LA    R4,20(R2)
         MVC   DS1(DS1END-DS1),0(R4)
         MVC   DS1FDAD(3),VTOCMBB
         MVC   DS1FDAD+3(4),VTOCCCHH
         MVC   DS1FDAD+7(1),VTOCR
         CLC   HWMDS1,DS1FDAD+3
         BL    VTOCEOD
         SPACE 1
         READ  (2),SF,VTOCDCB,(4),MF=E
         A     R2,REBLKSIZ
         ST    R2,RENEXT@
         L     R1,RECOUNT
         BCT   R1,VTSAVECT
         L     R2,REBLOCK@
         ST    R2,RENEXT@
         L     R1,RENCP
VTSAVECT ST    R1,RECOUNT
         SPACE 1
         LA    R0,1
         SR    R1,R1
         IC    R1,VTOCR
         AR    R1,R0
         STC   R1,VTOCR
         CH    R1,VTDSCBTR
         BNH   VTOCREND
         MVI   VTOCR,1
         AH    R0,VTOCTT
         STH   R0,VTOCTT
         LR    R1,R0
         BAL   R14,TTCONVRT
         MVC   VTOCCCHH,CCHH
         SPACE 1
VTOCREND L     R14,VTSAVE
         LM    R2,R4,VTSAVE+4
         LA    R14,4(R14)
         BR    R14
         SPACE 1
VTOCEOD  L     R14,VTSAVE
         LM    R2,R4,VTSAVE+4
         BR    R14
         SPACE 1
         DROP  R3
         EJECT
         SPACE 3
OBTAIN   MVC   OBCCHHR,0(R2)
         OBTAIN OBCAMLST
         BXLE  R15,R15,*+8
         BAL   R14,ABDUMP
         USING DS1,R3
         MVC   DS1(DS1END-DS1),CAMLIST
         MVC   DS1FDAD(3),VTOCMBB
         MVC   DS1FDAD+3(5),0(R2)
         BR    R14
         SPACE 2
OBCAMLST CAMLST SEEK,OBCCHHR,VOLSERNO,CAMLIST
         SPACE 1
         DROP  R3
         EJECT
         SPACE 3
SYNADXIT SYNADAF ACSMETH=BSAM
         MVC   BUF+7(47),=C'I/O ERROR PROCESSING XXXXXXXXXX. SYNADAF INX
               FO="'
         MVC   BUF+54(78),50(R1)
         MVI   BUF+132,C'"'
         SYNADRLS
         MVI   SYNADFLG,X'FF'
         LTR   R0,R0
         BZR   R14
         MVI   SYNADFLG,1
         BR    R14
         SPACE 3
SYNADCHK CLI   SYNADFLG,0
         BER   R14
         MVC   BUF+28(11),0(R1)
         BAL   R14,CLOSVTOC
         BAL   R14,DEQVTOC
         MVI   BUF,SPACE3IM
         BAL   R14,PRINT
         MVI   BUF,SPACE3AP
         BAL   R14,PRINT
         CLI   SYNADFLG,X'FF'
         BE    ERRNODMP
         BAL   R14,ABDUMP
         EJECT
         SPACE 3
DEQGATE  EQU   *+1
DEQVTOC  BCR   *-*+15,R14
         OI    DEQGATE,X'F0'
         SPACE 1
         DEQ   MF=(E,ENQVTOC)
         SPACE 1
         BR    R14
         SPACE 4
         SPACE 1
CLOSVTOC CLOSE MF=(E,CLOSLIST)
         SPACE 1
         L     R1,REBLOCK@
         LTR   R1,R1
         BZR   R14
         L     R0,REGETSIZ
         FREEMAIN R,LV=(0),A=(1)
         SR    R0,R0
         ST    R0,REBLOCK@
         BR    R14
         EJECT
         SPACE 3
         USING DS1,R6
         USING DS3,R8
         SPACE 1
F13HOOK  ST    R14,F1SAVE
         SR    R5,R5
         ST    R5,F1TRKAL
         STH   R5,NUMEXT
         XC    LISTEXT(17*4),LISTEXT
         IC    R5,DS1NOEPV
         CLI   DS1EXT1,X'40'
         BNE   *+8
         AH    R5,=H'1'
         LTR   R5,R5
         BZR   R14
         STH   R5,NUMEXT
         SPACE 1
         SR    R3,R3
         SR    R4,R4
F1NXTEXT EX    0,F1EXTPIK(R3)
         BAL   R14,F1EXTCNV
         AR    R4,R0
         MVC   HOOKLCCH(8),2(R2)
         STH   R0,HOOKNTRK
         MVC   HOOKTYPE(2),0(R2)
         MVC   HOOKLOTT(4),LOWTT
         LA    R0,DS1DSNAM
         ST    R0,HOOKIDPT
         LA    R2,HOOKPTR
         BAL   R14,HOOKUP
         ST    R15,LISTEXT(R3)
         LA    R3,4(R3)
         BCT   R5,F1NXTEXT
         ST    R4,F1TRKAL
         L     R14,F1SAVE
         BR    R14
         EJECT ,
         SPACE 3
F1EXTCNV CLI   0(R2),0
         BER   R14
         LA    R2,2(R2)
         BAL   R15,CCHHCONV
         STH   R0,LOWTT
         LA    R2,4(R2)
         BAL   R15,CCHHCONV
         STH   R0,HIGHTT
         LH    R1,LOWTT
         SR    R0,R1
         AH    R0,=H'1'
         S     R2,=F'6'
         BR    R14
         SPACE 2
F1EXTPIK LA    R2,DS1EXT1
         LA    R2,DS1EXT2
         LA    R2,DS1EXT3
         LA    R2,DS3EXTNT
         LA    R2,DS3EXTNT+10
         LA    R2,DS3EXTNT+20
         LA    R2,DS3EXTNT+30
         LA    R2,DS3ADEXT
         LA    R2,DS3ADEXT+10
         LA    R2,DS3ADEXT+20
         LA    R2,DS3ADEXT+30
         LA    R2,DS3ADEXT+40
         LA    R2,DS3ADEXT+50
         LA    R2,DS3ADEXT+60
         LA    R2,DS3ADEXT+70
         LA    R2,DS3ADEXT+80
         SPACE 2
         DROP  R6,R8
         EJECT
         SPACE 3
         USING DS5,R8
*        USING DS6,R8
F56HOOK  ST    R14,F5SAVE
         LA    R2,DS5AVEXT
         LA    R3,8
         BAL   R14,F5EXTCNV
         LA    R2,5(R2)
         BCT   R3,*-8
         LA    R2,DS5MAVET
         LA    R3,18
         BAL   R14,F5EXTCNV
         LA    R2,5(R2)
         BCT   R3,*-8
         L     R14,F5SAVE
         BR    R14
         SPACE 1
F5EXTCNV ST    R14,F5SAVE+4
         STM   R2,R5,F5SAVE+8
         CLC   0(5,R2),ZEROES
         BER   R14
         MVC   FMT5TT(4),0(R2)
         LH    R3,FMT5TT
         STH   R3,LOWTT
         LH    R4,FMT5CYLS
         SR    R5,R5
         IC    R5,4(R2)
         CLI   DS5FMTID,C'6'
         BE    F6HOOK
         LH    R1,AVAILEXT
         LA    R1,1(R1)
         STH   R1,AVAILEXT
         LH    R0,AVAILCYL
         AR    R0,R4
         STH   R0,AVAILCYL
         LA    R0,=CL44'  **** AVAILABLE ****'
         ST    R0,HOOKIDPT
         MVI   HOOKSEQN,0
         LR    R0,R4
         MH    R0,TRKSPCYL
         AR    R0,R5
         STH   R0,HOOKNTRK
         CH    R0,F5LARGTT
         BNH   F5AVAIL
         STH   R0,F5LARGTT
         MVC   F5LARGST,2(R2)
F5AVAIL  LR    R1,R0
         AH    R1,AVAILSPC
         STH   R1,AVAILSPC
         EJECT ,
         SPACE 3
F6RETURN AR    R0,R3
         BCTR  R0,0
         STH   R0,HIGHTT
         LH    R1,LOWTT
         BAL   R14,TTCONVRT
         MVC   HOOKLCCH,CCHH
         LH    R1,HIGHTT
         BAL   R14,TTCONVRT
         MVC   HOOKHCCH,CCHH
         MVC   HOOKLOTT(4),LOWTT
         MVC   HOOKTYPE,DS5FMTID
         LA    R2,HOOKPTR
         BAL   R14,HOOKUP
         LM    R2,R5,F5SAVE+8
         L     R14,F5SAVE+4
         BR    R14
         SPACE 1
F6HOOK   STC   R5,HOOKSEQN
         MVC   HOOKIDPT,=A(FMT6MSG)
         LR    R0,R4
         MH    R0,TRKSPCYL
         STH   R0,HOOKNTRK
         B     F6RETURN
         SPACE 1
         DROP  R8
         EJECT
         SPACE 3
HOOKUP   TM    PARMOPT1,MAPOPT+EXTNTOPT+DIRFLAG
         BZR   R14
         ST    R14,HOSAVE
         STM   R3,R5,HOSAVE+4
         LA    R4,EXTNTLEN
         BAL   R14,GETCORE
         USING EXTENT,R3
         MVC   EXTENT(EXTNTLEN),0(R2)
         L     R2,HOOKSTRT
         LA    R4,HOOKSTRT
HOOKLOOK CLC   EXTLCCHH,EXTLCCHH-EXTENT(R2)
         BL    HOOKDONE
         LR    R4,R2
         L     R2,0(R2)
         B     HOOKLOOK
         SPACE 1
HOOKDONE ST    R2,EXTPTR
         ST    R3,EXTPTR-EXTENT(R4)
         LR    R15,R3
         LM    R3,R5,HOSAVE+4
         L     R14,HOSAVE
         BR    R14
         SPACE 1
         DROP  R3
         EJECT ,
         SPACE 3
CCHHCONV SR    R0,R0
         IC    R0,0(R2)
         MH    R0,DEVCONV1
         SR    R1,R1
         IC    R1,1(R2)
         MH    R1,DEVCONV2
         AR    R0,R1
         SR    R1,R1
         IC    R1,2(R2)
         MH    R1,DEVCONV3
         AR    R0,R1
         SR    R1,R1
         IC    R1,3(R2)
         MH    R1,DEVCONV4
         AR    R0,R1
         BR    R15
         SPACE 4
TTCONVRT SR    R0,R0
         ST    R0,CCHH
         LH    R15,DEVCONV1
         LTR   R15,R15
         BZ    TTCONVR2
         DR    R0,R15
         STC   R1,CCHH
         LR    R1,R0
         SR    R0,R0
TTCONVR2 LH    R15,DEVCONV2
         LTR   R15,R15
         BZ    TTCONVR3
         DR    R0,R15
         STC   R1,CCHH+1
         LR    R1,R0
         SR    R0,R0
TTCONVR3 LH    R15,DEVCONV3
         LTR   R15,R15
         BZ    TTCONVR4
         DR    R0,R15
         STC   R1,CCHH+2
         STC   R0,CCHH+3
         BR    R14
         SPACE 1
TTCONVR4 STC   R1,CCHH+3
         BR    R14
         EJECT
         SPACE 3
CONVERT1 LA    R3,1
         B     CONVCOM
         SPACE 1
CONVERT2 LA    R3,2
         B     CONVCOM
         SPACE 1
CONVERT3 LA    R3,3
         B     CONVCOM
         SPACE 1
CONVERT4 LA    R3,4
         SPACE 1
CONVCOM  SR    R0,R0
CONV1MOR SLL   R0,8
         IC    R0,0(R2)
         LA    R2,1(R2)
         BCT   R3,CONV1MOR
         SPACE 1
CONVERT  LPR   R0,R0
         CVD   R0,CONVDEC
         UNPK  CONVUNPK,CONVDEC
         OI    CONVUNPK+11,X'F0'
         MVC   CONVEDIT,=X'402020202020202020202120'
         ED    CONVEDIT,CONVDEC+2
         MVC   CONVERTD,CONVEDIT+1
CONVCLI  CLI   CONVERTD,C' '
         BNER  R14
         MVC   CONVERTD,CONVERTD+1
         B     CONVCLI
         SPACE 1
         EJECT
         SPACE 3
DATEDIT  ST    R14,DASAVE
         STM   R2,R5,DASAVE+4
         XC    DATEWORD,DATEWORD
         LTR   R2,R2
         BZ    DATGET
         SR    R1,R1
         IC    R1,0(R2)
         MH    R1,=H'1000'
         MVC   DATEWORD,1(R2)
         AH    R1,DATEWORD
         CVD   R1,DATEWORD
DATGETRT OI    DATEWORD+7,X'0F'
         L     R2,DATEWORD+4
         SR    R0,R0
         D     R0,=F'1000'
         LA    R15,DATNORMY
         LTR   R14,R1
         BZ    DATCOMP
         N     R14,=F'3'
         BM    DATCOMP
         LA    R15,DATLEAPY
         SPACE 1
DATCOMP  LTR   R0,R0
         BZ    DAJULIAN
         CH    R0,0(R15)
         BH    DAJULIAN
         TM    PARMOPT2,JDATEOPT
         BO    DAJULIAN
         LA    R3,1
         SR    R14,R14
         SPACE 1
DATICMON IC    R14,1(R3,R15)
         CR    R0,R14
         BNH   DATMONOK
         SR    R0,R14
         LA    R3,1(R3)
         B     DATICMON
         SPACE 1
DATMONOK MH    R3,=H'1000'
         AR    R3,R0
         MH    R3,=H'1000'
         AR    R3,R1
         CVD   R3,DATEWORD
         MVC   DATEWORD(5),DATEWORD+3
         UNPK  DATEWORD(8),DATEWORD(5)
         OI    DATEWORD+7,X'F0'
         MVI   DATEWORD+2,C'/'
         MVI   DATEWORD+5,C'/'
         SPACE 3
DATRETRN LM    R2,R5,DASAVE+4
         MVC   0(8,R3),DATEWORD
         L     R14,DASAVE
         BR    R14
         SPACE 2
DAJULIAN ST    R2,DATEWORD
         UNPK  DATEWORD+2(5),DATEWORD+1(3)
         MVC   DATEWORD+1(2),DATEWORD+2
         MVI   DATEWORD,C' '
         MVI   DATEWORD+3,C'.'
         MVI   DATEWORD+7,C' '
         B     DATRETRN
         SPACE 2
DATGET   ST    R1,DATEWORD+4
         LTR   R1,R1
         BNZ   DATGOT
         TIME  DEC
         ST    R1,DATEWORD+4
DATGOT   CVB   R1,DATEWORD
         B     DATGETRT
         SPACE 2
         EJECT
         SPACE 3
DUMPDSCB ST    R14,DUSAVE
         LR    R4,R2
         LA    R2,3
         BAL   R14,PRLKAHED
         LR    R2,R4
         MVC   BUF+8(17),=C'BLK 1234.5678.90:'
         UNPK  TRAREA,3(8,R3)
         TR    TRAREA,TRTABLE
         MVC   BUF+12(4),TRAREA
         MVC   BUF+17(4),TRAREA+4
         MVC   BUF+22(2),TRAREA+8
         LA    R3,0(R2)
         LA    R4,BUF+35
         LA    R5,44
         BAL   R14,DUMPLINE
         MVI   BUF,SPACE1AP
         BAL   R14,PRINT
         MVC   BUF+8(13),=C'FORMAT N DSCB'
         MVC   BUF+15(1),44(R2)
         OI    BUF+15,X'F0'
         LA    R3,44(R2)
         LA    R4,BUF+26
         LA    R5,48
         BAL   R14,DUMPLINE
         MVI   BUF,SPACE1AP
         BAL   R14,PRINT
         LA    R3,92(R2)
         LA    R4,BUF+26
         LA    R5,48
         BAL   R14,DUMPLINE
         MVI   BUF,SPACE2AP
         BAL   R14,PRINT
         L     R14,DUSAVE
         BR    R14
         EJECT ,
         SPACE 3
DUMPLINE LTR   R5,R5
         BNPR  R14
         B     DUMPNEXT
DUMPWORD BCT   R1,DUMPBYTE
         MVI   0(R4),C' '
         LA    R4,1(R4)
DUMPNEXT LA    R1,4
DUMPBYTE UNPK  TRAREA(3),0(2,R3)
         TR    TRAREA(2),TRTABLE
         MVC   0(2,R4),TRAREA
         LA    R3,1(R3)
         LA    R4,2(R4)
         BCT   R5,DUMPWORD
         BR    R14
         EJECT
         SPACE 3
GETCORE  A     R4,=F'3'
         N     R4,=F'-4'
GETAGAIN L     R0,CORLEFT
         SR    R0,R4
         BM    GETMAIN
         ST    R0,CORLEFT
         L     R3,CORNEXT@
         LR    R0,R3
         AR    R0,R4
         ST    R0,CORNEXT@
         BR    R14
         SPACE 3
GETMAIN  L     R3,CURBLK@
         GETMAIN EC,LV=2048,A=CURBLK@
         BXH   R15,R15,ERRNOCOR
         SPACE 1
         L     R1,CURBLK@
         ST    R1,0(R3)
         SR    R0,R0
         ST    R0,0(R1)
         LA    R1,4(R1)
         ST    R1,CORNEXT@
         MVC   CORLEFT,=A(2044)
         B     GETAGAIN
         EJECT ,
         SPACE 3
FREECORE L     R2,CORFRST@
FREELOOP LTR   R1,R2
         BZ    FREEDONE
         L     R2,0(R2)
         LA    R0,2048
         FREEMAIN R,LV=(0),A=(1)
         B     FREELOOP
         SPACE 1
FREEDONE SR    R0,R0
         ST    R0,CORLEFT
         ST    R0,CORFRST@
         LA    R0,CORFRST@
         ST    R0,CURBLK@
         BR    R14
         EJECT
         SPACE 3
PRINT    ST    R14,PRSAVE
         STM   R2,R5,PRSAVE+4
         LH    R0,CURLINES
         CH    R0,MAXLINES
         BL    PRNOPAGE
         PUT   PRINTDCB,NEWPAGE
         SR    R0,R0
         STH   R0,CURLINES
PRNOPAGE LTR   R0,R0
         BNZ   PRINTBUF
         LH    R0,CURPAGES
         AH    R0,=H'1'
         STH   R0,CURPAGES
         CH    R0,MAXPAGES
         BNH   PRTPGCNV
         SR    R0,R0
         STH   R0,CURPAGES
PRTPGCNV BAL   R14,CONVERT
         MVC   PAGENO,CONVERTD
         PUT   PRINTDCB,HEADERCC
         MVC   CURLINES,=H'3'
         L     R2,BUFPTR
PRNXTBUF LH    R0,CURLINES
         LTR   R2,R2
         BZ    PRINTBUF
         AH    R0,4(R2)
         STH   R0,CURLINES
         LA    R3,6(R2)
         PUT   PRINTDCB,(3)
         L     R2,0(R2)
         B     PRNXTBUF
         EJECT
         SPACE 3
PRINTBUF TM    BUF,X'80'
         BZ    PRUPLINE
         SR    R0,R0
         B     PRDOPUT
PRUPLINE SR    R14,R14
         IC    R14,BUF
         SRL   R14,3
         AR    R0,R14
PRDOPUT  STH   R0,CURLINES
         PUT   PRINTDCB,BUF
         TM    BUF,X'02'
         BO    PRETURN
         MVI   BUF+1,C' '
         MVC   BUF+2(131),BUF+1
         SPACE 1
PRETURN  LM    R2,R5,PRSAVE+4
         L     R14,PRSAVE
         BR    R14
         SPACE 4
PRLKAHED AH    R2,CURLINES
         CH    R2,MAXLINES
         BNHR  R14
         MVC   CURLINES,=H'999'
         BR    R14
         EJECT
         SPACE 1
RETURN   CLOSE (PRINTDCB)
         SPACE 1
         TM    DCBBUFCB+3+(PRINTDCB-IHADCB),X'01'
         BO    RETQUIT
         FREEPOOL PRINTDCB
         SPACE 1
RETQUIT  CLI   HDNGLIST,X'FF'
         BNE   RETSAVER
         L     R1,HDNGLIST
         LH    R2,0(R1)
         LH    R0,CURPAGES
         AH    R0,=H'1'
         BAL   R14,CONVERT
         LA    R3,CONVEDIT+12
         SR    R3,R2
         BCTR  R2,0
         STC   R2,*+5
         MVC   2(*-*,R1),0(R3)
         SPACE 1
RETSAVER L     R13,SAVEAREA+4
         L     R15,RETCODE
         L     R14,12(R13)
         LM    R0,R12,20(R13)
         MVI   12(R13),X'FF'
         SPM   R14
         BR    R14
         SPACE 3
ABDUMP   OI    ABCODE,X'80'        SET DUMP FLAG
         SPACE 1
ABEND    L     R1,ABCODE           PICK UP ABEND CODE
         ABEND (1)
         EJECT ,
NEWPAGE  DC    AL1(EJECTIM)
HEADERCC DC    AL1(SPACE3AP)
VOLSERNO DS    CL6                 CURRENT VOLUME SERIAL
         ORG   VOLSERNO
         EJECT
HEADER DS 0CL95
       DC C'DIRECT-ACCESS VOLUME SEEK ANALYSIS .....            '
       DC C'*GTEDS* VERSION--'
       DC C'&SYSDATE'   8 CHARS
       DC CL31' '
HEADMID  EQU   HEADER+19
PRDATE   DC    CL8'03/15/84'
         DC    CL6'  DAY='
PRDAY    DC    CL3'999'
PRTIME   DC    CL7'  23:59',CL4' '
         DC    CL5'PAGE '
PAGENO   DC    CL4'9999'
         SPACE 3
HEAD1    DC    C'TABLE OF CONTENTS FOR VOLUME "'
HEAD1VOL DC    CL6'XXXXXX',C'" ON DEVICE "'
HEAD1UCB DC    CL3'XXX',C'" MOUNTED AS "'
HEAD1MT  DC    CL8'XXXXXXXX',C'/'
HEAD1MTR DC    CL5'XXXXX',C'"'
HEAD1A   DC    A(HEAD1B)
         DC    H'0'
HEADER1  DC    AL1(SPACE0AP),CL19' ',CL26'DSNAME'
HEADAT1A DC    C'SERIAL R/W  REFDT    CREDT    EXPDT   DSO RFM BLKSZ LRX
               ECL KEY OP TRKAL TRKUS EX SECQU T'
HEAD1B   DC    A(0)
         DC    H'2'
HEADER2  DC    AL1(SPACE2AP),44C'_',C' '
HEADAT1B DC    C'______ ___ ________ ________ ________ ___ ___ _____ __X
               ___ ___ __ _____ _____ __ _____ _'
         SPACE 2
HEAD2    DC    C'TRACK ALLOCATION MAP FOR VOLUME "'
HEAD2VOL DC    C'XXXXXX',C'"'
HEAD2A   DC    A(HEAD2B)
         DC    H'0'
         DC    AL1(SPACE0AP),CL22' '
HEAD2DAT DC    C'FIRST TRK   LAST TRK  FIRST   LAST  #TRKS  EX  EX-#  '
         DC    CL44'DSNAME OR USAGE'
         DC    CL13' '
HEAD2B   DC    A(0)
         DC    H'2'
         DC    AL1(SPACE2AP),CL22' '
HEAD2UND DC    C'_________  _________  _____  _____  _____  __  ____  '
         DC    44C'_'
         DC    CL13' '
PDSMSG   DC    CL19'DIRECTORY CONTAINS'
PDSVAL1  DC    CL4'0000'
         DC    CL18' MEMBERS AND USES '
PDSVAL2  DC    CL4'0000'
         DC    CL8' OF THE '
PDSVAL3  DC    CL4'0000'
         DC    CL39' DIRECTORY BLOCKS ALLOCATED, INCLUDING '
PDSVAL4  DC    CL3'000'
         DC    CL24' BYTES OF THE LAST BLOCK'
PDSMSGLN EQU   *-PDSMSG
         EJECT
VTOCDCB  DCB   DDNAME=VOLUME01,                                        X
               DSORG=PS,                                               X
               MACRF=(R),                                              X
               RECFM=FS,                                               X
               KEYLEN=44,                                              X
               BLKSIZE=96,                                             X
               OPTCD=C,                                                X
               NCP=NCPDFLT,                                            X
               EXLST=JFCBAD,                                           X
               EODAD=VTOCEOD,                                          X
               SYNAD=SYNADXIT
         EJECT
PDSDCB   DCB   DDNAME=VOLUME01,                                        X
               DSORG=PS,                                               X
               MACRF=(R),                                              X
               RECFM=F,                                                X
               KEYLEN=8,                                               X
               BLKSIZE=256,                                            X
               EXLST=JFCBAD,                                           X
               EODAD=PDSEOD,                                           X
               SYNAD=SYNADXIT
         EJECT
PRINTDCB DCB   DDNAME=SYSPRINT,                                        X
               DSORG=PS,                                               X
               EROPT=ACC,                                              X
               MACRF=(PM),                                             X
               RECFM=FBM,                                              X
               LRECL=133,                                              X
               BLKSIZE=133
         EJECT
OPENLIST OPEN  (VTOCDCB,(INPUT)),MF=L
OPENFLAG EQU   OPENLIST
OPENUPDT EQU   X'04'
         SPACE 2
CLOSLIST CLOSE (VTOCDCB),MF=L
CLOSFLAG EQU   CLOSLIST
CLOSRERD EQU   X'10'
         SPACE 2
         READ  VTOCDECB,SF,VTOCDCB,CAMLIST,MF=L
         SPACE 2
         READ  PDSDECB,SF,PDSDCB,MF=L
         SPACE 2
ENQVTOC  RESERVE (SYSVTOC,VOLSERNO,S,6,SYSTEMS),UCB=UCBADDR,MF=L
ENQFLAGS EQU   ENQVTOC+2
ENQSHAR  EQU   X'80'
         SPACE 1
SYSVTOC  DC    CL8'SYSVTOC'
         EJECT
DATEWORD DC    D'0'
CONVDEC  DC    D'0'
CONVEDIT DC    CL12' '
CONVERTD DC    CL11' ',C' '
CONVUNPK DC    CL12' '
NOMAPDDS DC    C'JOBLIB  '
         DC    C'STEPCAT '                P.A.S.
         DC    C'JOBCAT  '                P.A.S.
         DC    C'STEPLIB '
         DC    C'SYSCHK  '
         DC    C'PGM=*.DD'
         DC    C'SYSIN   '
         DC    C'SYSPRINT'
         DC    C'SYSABEND'
         DC    C'SYSUDUMP'
         DC    C'        '
VOLDDNAM DC    C'VOLUME00'
         ORG   *-2
CURVOLNM DC    C'00'
TIME     DC    F'0'
PARMLIST DC    A(0)
DDNMLIST DC    A(0)
HDNGLIST DC    A(0)
DDLSTPTR DC    A(0)
         SPACE 1
EXTRACT  EQU   *
TIOTAD   DC    A(0)
COMPTR   DC    A(0)
         SPACE 1
TIOTADDD DC    A(0)
PDSBLKAD DC    A(PDSBLOCK,PDSBLOCK+PDSBLKLN)
CCHH     DC    F'0'
BUFPTR   DC    A(0)
HOOKSTRT DC    A(*)
HOOKEND  DC    F'-1'
DATNORMY DC    H'365',AL1(31,28,31,30,31,30,31,31,30,31,30,31)
DATLEAPY DC    H'366',AL1(31,29,31,30,31,30,31,31,30,31,30,31)
CORLEFT  DC    F'0'
CORNEXT@ DC    A(0)
CURBLK@  DC    A(*+4)
CORFRST@ DC    A(0)
CURLINES DC    H'999'
MAXPAGES DC    H'9999'
MAXLINES DC    H'58'
CURPAGES DC    H'0'
JFCBAD   DC    X'87',AL3(JFCB)
VOLTAB   DC    F'0'
VOLSEEK  DC    F'0'
VOLSAMP  DC    F'3000'              NO. OF SAMPLES   (TEN MINUTES)
VOLUCB   DC    F'0'
VOLTRKS  DC    F'0'
VOLSAVE  DC    15F'0'
SEEKCURR DC    F'0'
SEEKCYL  DC    F'0'
SEEKTRK  DC    F'0'
         DS    0D
INTERVL  DC    CL8'00000020'
SEEKDBL  DC    2F'0'
SEEKTABL DC    193X'00',X'0A0B0C0D0E0F',41X'00'
         DC    X'00010203040506070809',6X'00'
DOUBCYL  DS    2F
DOUBTRK  DS    2F
SEEKPRT  DC    X'09',CL120' '
         EJECT
SYSSEEK  DCB   DDNAME=SYSSEEK,DSORG=PS,RECFM=FB,LRECL=121,MACRF=(PM)
         EJECT
SEEKEMSG DC    X'09',CL132'DEVICE NNN% BUSY, FOR NNNNN SAMPLES'
SEEKBUF  DS    CL133
RETCODE  DC    F'0'
ABCODE   DC    F'100'              ABEND CODE 100
SAVEAREA DC    18F'0'
CURVOL   DC    H'0'
DDNAMLEN DC    H'0'
NUMVOLS  DC    H'-1'
NCPPARM  DC    AL2(NCPDFLT)
TRAREA   DC    CL15' ',C' '
EFFS     DC    44X'FF'
LASTDS1  EQU   EFFS
ZEROES   DC    44X'00'
PARMOPT1 DC    AL1(08)    SET DEFAULT TO NO OPTIONS
PARMOPT2 DC    AL1(0)
TRTABLE  EQU   *-240
         DC    C'0123456789ABCDEF'
STARS    DC    C'*********'
VOLSTAT  DC    X'00'
         DC    0F'0'
HOOKINIT DC    2XL4'00'
         DC    H'1'
         DC    X'FF00'
         DC    A(VOLABMSG)
         DC    F'0'
         EJECT
         SPACE 3
DEVTABLE DC    X'06',CL15'2305-1 DISK'
*
         DC    X'07',CL15'2305-2 DISK'
*
         DC    X'08',CL15'2314 DISK PACK'
*
         DC    X'09',CL15'3330 DISK PACK'
*
         DC    X'0A',CL15'3340-35M DISK'   ADDED 5/4/75  P.A.S.
*
         DC    X'0B',CL15'3350 DISK PACK'  ADDED 01/10/77 G.D.F.
*
         DC    X'0D',CL15'3330-II DISK'     ADDED 4/1/75  P.A.S.
*
DEVTABND DC    X'00',CL7'UNKNOWN'
         SPACE 1
DEVENTLN EQU   16
         EJECT
         LTORG
         SPACE 1
PCTLINE  DC    CL51'0====1====2====3====4====5====6====7====8====9===='
VOLABMSG DC    CL44'  **** VOLUME LABEL ****'
VTOCMSG  DC    CL44'  **** VOLUME TABLE OF CONTENTS ****'
FMT6MSG  DC    CL44'SPLIT CYLINDER(S) SHARED BY NEXT XXX EXTENTS'
         SPACE 3
STORAGES DS    0D
         EJECT
BUF      DS    CL133
         SPACE 2
         ORG   BUF+1
L1       DS    0CL132
L1DSNAME DS    CL44
         DS    C
L1SERIAL DS    CL6
         DS    C
L1SECUR  DS    CL3
         DS    C
L1REFDT  DS    CL8
         DS    C
L1CREDT  DS    CL8
         DS    C
L1EXPDT  DS    CL8
         DS    C
L1DSORG  DS    CL3
         DS    C
L1RECFM  DS    CL3
         DS    C
L1BLKSIZ DS    CL5
         DS    C
L1LRECL  DS    CL5
         DS    C
L1KEYLEN DS    CL3
         DS    C
L1OPTCD  DS    CL2
         DS    C
L1TRKAL  DS    CL5
         DS    C
L1TRKUS  DS    CL5
         DS    C
L1NOEPV  DS    CL2
         DS    C
L1SECQU  DS    CL5
         DS    C
L1TYP    DS    CL1
         SPACE 1
         ORG   L1SERIAL
L1LSTDT  DS    CL8
         DS    C
L1USCNT  DS    CL5
         ORG   ,
         EJECT
PRSAVE   DS    5A
DASAVE   DS    5A
         DS    0D
PDSBLOCK DS    2XL(PDSBLKLN)
CAMLIST  DS    XL(CAMLSTLN)
         SPACE 1
START0   DS    0H                  START OF CORE ZEROED FOR EACH VOL
         SPACE 1
DEVTYPE  DS    6F
UCBADDR  DS    A
FIRSTDS1 DS    A
FMT4AD   DS    A
FMT5AD   DS    A
FMT6AD   DS    A
FMT5TT   DS    H
FMT5CYLS DS    H
         SPACE 1
REBLOCK@ DS    F
RENEXT@  DS    F
REBLKSIZ DS    F
RECOUNT  DS    F
RENCP    DS    F
REGETSIZ DS    F
         SPACE 1
FMXCOUNT DS    0H                  COUNT FIELDS MUST BE TOGETHER
FM0COUNT DS    H
FM1COUNT DS    H
FM2COUNT DS    H
FM3COUNT DS    H
FM4COUNT DS    H
FM5COUNT DS    H
FM6COUNT DS    H
         SPACE 1
AVAILCYL DS    H
AVAILSPC DS    H
AVAILEXT DS    H
VTOCSIZE DS    H
LOWTT    DS    H
HIGHTT   DS    H
         SPACE 1
HOOKPTR  DS    F
HOOKLCCH DS    XL4
HOOKHCCH DS    XL4
HOOKNTRK DS    H
HOOKTYPE DS    X
HOOKSEQN DS    X
HOOKIDPT DS    A
HOOKLOTT DS    XL2
HOOKHITT DS    XL2
         SPACE 1
F1TRKAL  DS    F
DEVTABPT DS    A                   POINTER TO CURRENT DEVTABLE ENTRY
DEVCONV1 DS    H                   CURRENT DEVTABLE INFO
DEVCONV2 DS    H
DEVCONV3 DS    H
DEVCONV4 DS    H
TRKSPCYL DS    H
TRKSPVOL DS    H
CRATRACK DS    H              REL TRACK ADDRESS OF VSAM CRA
HWMOLD   DS    XL5
HWMDS1   DS    XL5
HWMNEW   DS    XL5
HWMINDIC DS    X
F5LARGST DS    XL3
SYNADFLG DS    X
OBCCHHR  DS    XL5
BADDSTYP DS    C
F5LARGTT DS    H
         SPACE 1
         DS    0H
VTOCTTR  DS    0XL3
VTOCTT   DS    H
VTOCR    DS    X
VTOCMBB  DS    0XL3
VTOCM    DS    X
VTOCBIN  DS    H
VTOCCCHH DS    XL4
VTDSCBTR DS    H
         SPACE 1
END0     DS    0H                  END OF CORE ZEROED FOR EACH VOL
LENGTH0  EQU   END0-START0         AMOUNT TO BE ZEROED
         SPACE 1
NUMEXT   DS    H
LISTEXT  DS    17A
PDSAVE   DS    6A
PDSENTAD DS    A
PDSBYTCT DS    H
PDSBLKAL DS    H
PDSBLKUS DS    H
PDSMEMCT DS    H
ISAVE    DS    5A
EXPFLAG  DS    X
EXSAVE   DS    3A
VTSAVE   DS    4A
F1SAVE   DS    A
F5SAVE   DS    6A
HOSAVE   DS    4A
DUSAVE   DS    A
         EJECT ,
         IEFJFCBN  LIST=YES
         SPACE 1
JFCB     EQU   INFMJFCB
         SPACE 3
         ORG   STORAGES
         EJECT
         SPACE 1
INIT     L     R2,0(R1)
         ST    R2,PARMLIST
         LTR   R2,R2
         BM    GETTIME
         L     R2,4(R1)
         ST    R2,DDNMLIST
         LTR   R2,R2
         BM    CHEKDDNM
         L     R2,8(R1)
         ST    R2,HDNGLIST
         SPACE 1
         LA    R2,0(R2)
         LTR   R2,R2
         BZ    CHEKDDNM
         LH    R3,0(R2)
         LA    R2,2(R2)
         BAL   R14,PARMPARS
         LTR   R0,R0
         BNP   CHEKDDNM
         CH    R0,=H'9999'
         BH    CHEKDDNM
         BCTR  R0,0
         STH   R0,CURPAGES
         MVI   HDNGLIST,X'FF'
         SPACE 1
CHEKDDNM TM    PARMLIST,X'80'
         BO    GETTIME
         L     R1,DDNMLIST
         LH    R0,0(R1)
         SH    R0,=H'8'
         BM    GETTIME
         OI    DDNMLIST,X'F0'
         STH   R0,DDNAMLEN
         MVC   DCBDDNAM+(PRINTDCB-IHADCB),2(R1)
         SH    R0,=H'8'
         BM    GETTIME
         LA    R1,10(R1)
         ST    R1,DDLSTPTR
         OI    DDNMLIST,X'0F'
         SPACE 1
GETTIME  TIME  DEC
         SRL   R0,4
         ST    R0,TIME
         MVC   PRTIME,=X'402120207A2020'
         ED    PRTIME,TIME
         ST    R1,DATEWORD+4
         UNPK  TRAREA,DATEWORD+6(8)
         TR    TRAREA,TRTABLE
         MVC   PRDAY,TRAREA
         SR    R2,R2
         LA    R3,PRDATE
         BAL   R14,DATEDIT
         SPACE 1
         OPEN  (PRINTDCB,(OUTPUT))
         TM    DCBOFLGS+(PRINTDCB-IHADCB),DCBOFOPN
         BNZ   *+8
         BAL   R14,ABEND
         MVI   BUF,C' '
         MVC   BUF+1(L'BUF-1),BUF
         SPACE 1
         EXTRACT EXTRACT,FIELDS=(TIOT,COMM)
         L     R1,TIOTAD
         LA    R1,TIOENTRY-TIOT(,R1)
         ST    R1,TIOTADDD
         SPACE 1
         MVC   BUF+10(21),=C'EXEC PARAMETER FIELD:'
         L     R1,COMPTR
         L     R1,COMCIBPT-COM(,R1)
TESTCIB  LA    R1,0(,R1)
         LTR   R1,R1
         B     PARMEX                AXC   NEVER CHECK CIB
*        BZ    PARMEX                AXC   NEVER CHECK CIB
         USING CIB,R1
         CLI   CIBVERB,CIBSTART
         BE    PARMCIB
         L     R1,CIBNEXT
         B     TESTCIB
         SPACE 1
PARMCIB  LA    R1,CIBDATLN
         ST    R1,PARMLIST
         DROP  R1
         MVC   BUF+9(5),=C'START'
         SPACE 1
PARMEX   L     R2,PARMLIST
         LH    R3,0(R2)
         LA    R2,2(R2)
         CH    R3,=H'99'
         BL    PARMLNOK
         MVC   BUF+30(28),=C' IS TOO LONG AND WAS IGNORED'
         SR    R3,R3
         B     PARMPRNT
         SPACE 1
PARMLNOK LTR   R1,R3
         BZ    PARMPRNT
         BCTR  R1,0
         STC   R1,*+5
         MVC   BUF+33(*-*),0(R2)
PARMPRNT MVI   BUF,SPACE3AP
         BAL   R14,PRINT
         SPACE 1
PARMLOOP BAL   R14,PARMPARS
         TM    PARMOPT2,VOLSOPT
         BO    PARMVOL2
         TM    PARMOPT2,LNCNTOPT
         BO    PARMLCT2
         TM    PARMOPT2,NCPOPT
         BO    PARMNCP2
         CLI   PARMBUF,C' '
         BE    PARMDONE
         SPACE 1
         LA    R0,12
         LA    R1,PARMS
PARMCOMP CLC   PARMBUF,0(R1)
         BE    GOTPARM
         BXH   R1,R0,PARMCOMP
         SPACE 1
GOTPARM  MVC   PARMVALS,8(R1)
         MVC   *+8(2),10(R1)
         B     *-*
         SPACE 1
PARMSET  SR    R15,R15
         IC    R15,PARMVALS+1
         LA    R15,PARMOPT1(R15)
         SR    R0,R0
         IC    R0,PARMVALS
         CLI   PARMVALS,128
         BH    PARMOFF
         STC   R0,*+5
         OI    0(R15),*-*
         B     PARMLOOP
         SPACE 1
PARMOFF  STC   R0,*+5
         NI    0(R15),*-*
         B     PARMLOOP
         SPACE 1
PDSON    L     R15,TIOTAD
         B     PARMSET
         SPACE 1
RESETON  NI    ENQFLAGS,255-ENQSHAR
         OI    CLOSLIST,CLOSRERD
         B     PARMSET
         SPACE 1
RESETOFF OI    ENQFLAGS,ENQSHAR
         NI    CLOSLIST,255-CLOSRERD
         B     PARMSET
         SPACE 1
PARMVOL2 NI    PARMOPT2,255-VOLSOPT
         LTR   R0,R0
         BNP   PARMERR
         CH    R0,=H'99'
         BH    PARMERR
         STH   R0,NUMVOLS
         B     PARMLOOP
         SPACE 1
PARMLCT2 NI    PARMOPT2,255-LNCNTOPT
         LTR   R0,R0
         BNP   PARMERR
         CH    R0,=H'999'
         BNL   PARMERR
         STH   R0,MAXLINES
         B     PARMLOOP
         SPACE 1
PARMNCP2 NI    PARMOPT2,255-NCPOPT
         LTR   R0,R0
         BNP   PARMERR
         CH    R0,=H'99'
         BH    PARMERR
         STH   R0,NCPPARM
         B     PARMLOOP
         SPACE 1
PARMERR  MVI   BUF+10,C'"'
         MVC   BUF+11(8),PARMBUF
         MVC   BUF+19(41),=C'" IS AN ILLEGAL PARAMETER AND WAS IGNORED'
         MVI   BUF,SPACE3AP
         BAL   R14,PRINT
         B     PARMLOOP
         SPACE 1
PARMDONE OI    PARMOPT2,VOLSOPT
         LH    R0,NUMVOLS
         CH    R0,=H'-1'
         BNE   PARMVOL#
         NI    PARMOPT2,255-VOLSOPT
         MVC   NUMVOLS,=H'99'
         MVC   BUF+10(3),=C'ALL'
         B     PARMVLPR
         SPACE 1
PARMVOL# BAL   R14,CONVERT
         MVC   BUF+10(3),CONVEDIT+9
PARMVLPR MVC   BUF+14(24),=C'VOLUME(S) WILL BE LISTED'
         MVI   BUF,SPACE3AP
         BAL   R14,PRINT
         SPACE 1
         CLC   NCPPARM,=H'1'
         BNE   *+8
         OI    PARMOPT2,NCPOPT
         TM    PARMOPT1,LSTDTOPT
         BZ    PARMDDCK
         MVC   HEADAT1A(14),=C' LSTDT   USCNT'
         MVC   HEADAT1B(14),=C'________ _____'
         SPACE 1
PARMDDCK TM    DDNMLIST,X'F0'
         BNO   PARMHDCK
         MVC   BUF+10(36),=C'AN INTERNAL DDNAME LIST WILL BE USED'
         TM    DDNMLIST,X'0F'
         BO    *+10
         MVC   BUF+47(14),=C'FOR PRINT ONLY'
         MVI   BUF,SPACE3AP
         BAL   R14,PRINT
         SPACE 1
PARMHDCK CLI   HDNGLIST,X'FF'
         BNE   PRTINFO      ADDED 4/1/75  P.A.S.  FOR 'HELP'
         MVC   BUF+10(35),=C'AN INTERNAL PAGE COUNT WILL BE USED'
         MVI   BUF,SPACE3AP
         BAL   R14,PRINT
         SPACE 3
PRTINFO  EQU   *
         LA    R3,PRTINFOL  POINT TO INFO LISTING
         LA    R2,29    NUMBER OF LINES TO PRINT
PRTINFOA MVC   BUF+9(47),0(R3)  MOVE LINE TO BUFFER
         MVI   BUF,SPACE1AP   INSERT CARRIAGE CONTROL
         LA    R3,47(R3)  INCREMENT TO NEXT LINE
         BAL   R14,PRINT
         BCT   R2,PRTINFOA GO AGAIN
         MVI   BUF,SPACE3IM
         BAL   R14,PRINT
         MVC   BUF+9(33),=C'*** OPERATING SYSTEM RUN ON .... '
         MVI   BUF,SPACE3AP
         L     R3,16  POINT TO CVT
         LA    R3,116(R3)   POINT TO OPERATING SYS
         TM    0(R3),X'40'  PCP
         BNO   *+10
         MVC   BUF+42(4),=C'PCP '
         TM    0(R3),X'20'  MFT
         BNO   *+10
         MVC   BUF+42(4),=C'MFT '
         TM    0(R3),X'10'  MVT
         BNO   *+10
         MVC   BUF+42(4),=C'MP65'
         TM    0(R3),X'22'  VS1
         BNO   *+10
         MVC   BUF+42(4),=C'VS1 '
         TM    0(R3),X'12'  VS2 REL 1 (SVS)
         BNO   *+10
         MVC   BUF+42(4),=C'SVS '
         TM    0(R3),X'11'  VS2 REL 2+  (MVS)
         BNO   *+10
         MVC   BUF+42(4),=C'MVS '
         BAL   R14,PRINT
         B     NEXTVOL
         EJECT
PRTINFOL DC    CL47'**********  EXECUTION  PARM  VALUES  **********'
         DC    CL47'*                                             *'
         DC    CL47'*  MAP.....PRODUCE A TRACK MAP OF VOLUME      *'
         DC    CL47'*  SMAP....PRODUCE A TRACK MAP WITH SEEK INFO *'
         DC    CL47'*  PDS.....LIST ALL PDS DIRECTORIES ON VOLUME *'
         DC    CL47'*  ISAM....LIST ISAM REORG INFO FOR DATASETS  *'
         DC    CL47'*  EXT.....LIST THE EXTENTS OF THE DATASETS   *'
         DC    CL47'*  DUMP....LIST (HEX) ALL DSCBS ON VOLUME     *'
         DC    CL47'*  EMPTY...LIST ONLY DATASETS THAT ARE EMPTY  *'
         DC    CL47'*  MODEL...WILL ONLY LIST "MODEL DSCBS"       *'
         DC    CL47'*  SDUMP...LIST (HEX) FORMAT 4 AND 5 DSCBS    *'
         DC    CL47'*  VOLS....ONLY USE DDNAMES OF "VOLUME--",    *'
         DC    CL47'*      FORMAT--"VOLS=X", WHERE "X" IS MAX #   *'
         DC    CL47'*  JDATE...LIST CREATE/EXPIRE DATE IN JULIAN  *'
         DC    CL47'*                                             *'
         DC    CL47'*  ALL DASD ALLOCATED TO STEP WILL BE LISTED  *'
         DC    CL47'*  EXCEPT SYSTEM DDS.....SYS--, STEP--, ETC.  *'
         DC    CL47'*  ***  DO NOT USE A DDNAME OF "SY000"  ***   *'
         DC    CL47'*                                             *'
         DC    CL47'*                                             *'
         DC    CL47'*  STEPNAME SETS NO. OF SAMPLES FOR "SMAP"    *'
         DC    CL47'*  STEPNAME FORMAT IS AS FOLLOWS -            *'
         DC    CL47'*                                             *'
         DC    CL47'*  SNNNN -                                    *'
         DC    CL47'*      "NNNN"  IS THE NO. OF 1/5 SEC SAMPLES. *'
         DC    CL47'*      IF "NNNN" IS NOT NUMERIC A DEFAULT OF  *'
         DC    CL47'*      3000 SAMPLES WILL BE USED (10 MINUTES) *'
         DC    CL47'*                                             *'
         DC    CL47'***********************************************'
         EJECT
         SPACE 3
PARMPARS SR    R0,R0
         MVC   PARMBUF,=CL8' '
         LA    R4,PARMBUF
         SPACE 1
PRMLOOK  CH    R3,=H'0'
         BNHR  R14
         CLI   0(R2),C' '
         BE    PRMIGNOR
         CLI   0(R2),C','
         BE    PRMRETRN
         CLI   0(R2),C'='
         BE    PRMRETRN
         LTR   R0,R0
         BM    PRMNOT#
         TM    0(R2),X'F0'
         BNO   PRMNOT#
         IC    R15,0(R2)
         N     R15,=F'15'
         CH    R15,=H'10'
         BNL   PRMNOT#
         MH    R0,=H'10'
         AR    R0,R15
         B     PRMSHIFT
         SPACE 1
PRMNOT#  LH    R0,=H'-1'
PRMSHIFT C     R4,=A(PARMBUF+L'PARMBUF)
         BNL   PRMIGNOR
         MVC   0(1,R4),0(R2)
         LA    R4,1(R4)
PRMIGNOR LA    R2,1(R2)
         BCTR  R3,0
         B     PRMLOOK
         SPACE 1
PRMRETRN LA    R2,1(R2)
         BCTR  R3,0
         BR    R14
         EJECT ,
         SPACE 3
PARMS    DS    0H
         DC    C'LINECNT ',AL1(LNCNTOPT),AL1(1),S(PARMSET)
         DC    C'NCP     ',AL1(NCPOPT),AL1(1),S(PARMSET)
         DC    C'MODEL   ',AL1(MODELOPT),AL1(1),S(PARMSET)
         DC    C'VOLS    ',AL1(VOLSOPT),AL1(1),S(PARMSET)
         DC    C'EMPTY   ',AL1(EMPTYOPT),AL1(0),S(PARMSET)
         DC    C'NOEMPTY ',AL1(255-EMPTYOPT),AL1(0),S(PARMSET)
         DC    C'DUMP    ',AL1(DUMPOPT),AL1(0),S(PARMSET)
         DC    C'NODUMP  ',AL1(255-DUMPOPT),AL1(0),S(PARMSET)
         DC    C'EXT     ',AL1(EXTNTOPT),AL1(0),S(PARMSET)
         DC    C'NOEXT   ',AL1(255-EXTNTOPT),AL1(0),S(PARMSET)
         DC    C'ISAM    ',AL1(ISAMOPT),AL1(1),S(PARMSET)
         DC    C'NOISAM  ',AL1(255-ISAMOPT),AL1(1),S(PARMSET)
         DC    C'JDATE   ',AL1(JDATEOPT),AL1(1),S(PARMSET)
         DC    C'NOJDATE ',AL1(255-JDATEOPT),AL1(1),S(PARMSET)
         DC    C'LSTDT   ',AL1(LSTDTOPT),AL1(0),S(PARMSET)
         DC    C'NOLSTDT ',AL1(255-LSTDTOPT),AL1(0),S(PARMSET)
         DC    C'MAP     ',AL1(MAPOPT),AL1(0),S(PARMSET)
         DC    C'NOMAP   ',AL1(255-MAPOPT),AL1(0),S(PARMSET)
         DC    C'SMAP    ',AL1(SMAPOPT),AL1(1),S(PARMSET)
         DC    C'NOSMAP  ',AL1(255-SMAPOPT),AL1(1),S(PARMSET)
         DC    C'PDS     ',AL1(PDSOPT),AL1(0),S(PDSON)
         DC    C'NOPDS   ',AL1(255-PDSOPT),AL1(0),S(PARMSET)
         DC    C'RESET   ',AL1(RESETOPT),AL1(1),S(RESETON)
         DC    C'NORESET ',AL1(255-RESETOPT),AL1(1),S(RESETOFF)
         DC    C'SDUMP   ',AL1(SDUMPOPT),AL1(0),S(PARMSET)
         DC    C'NOSDUMP ',AL1(255-SDUMPOPT),AL1(0),S(PARMSET)
PARMBUF  DC    C'        ',AL1(0),AL1(0),S(PARMERR)
         SPACE 1
PARMVALS DS    XL2
         EJECT ,
         LTORG
         SPACE 1
         ORG   ,
         EJECT
UCB      DSECT
         IEFUCBOB  LIST=YES
         EJECT
TIOT     DSECT
         IEFTIOT1
         EJECT
         DCBD  DSORG=BS,DEVD=DA
         EJECT
DS1      DSECT
         IECSDSL1 (1)
DS1FDAD  DS    XL8                 FULL DA ADDRESS OF F1 DSCB
DS1F3PTR DS    A                   @ OF F3 DSCB, IF ANY
DS1F1PTR DS    A                   @ OF NEXT F1 DSCB
DS1LEN   EQU   *-DS1
         SPACE 1
         ORG   DS1SYSCD-1
DS1SECLV DS    XL1
         ORG   DS1SYSCD+13
DS1LSTDT DS    XL3
DS1USCNT DS    XL2
         EJECT ,
DS2      DSECT
         IECSDSL1 (2)
DS2FDAD  DS    XL8                 FULL DA ADDRESS OF F2 DSCB
DS2F3PTR DS    A                   POINTER TO FMT3 DSCB, IF ANY
DS2LEN   EQU   *-DS2
         EJECT
DS3      DSECT
         IECSDSL1 (3)
DS3FDAD  DS    XL8                 FULL DA ADDRESS OF F3 DSCB
DS3F2PTR DS    A                   POINTER TO FMT2 DSCB, IF ANY
DS3LEN   EQU   *-DS3
         EJECT
DS4      DSECT
DS4KEYID DS    XL44
         IECSDSL1 (4)
DS4FDAD  DS    XL8
DS4LEN   EQU   *-DS4
*
         ORG   DS4NOEXT+2
DS4SECLV DS    XL1                 PRIV LEVEL REQ. FOR VTOC ACCESS
         ORG   DS4DEVDB+9          VSAM OWNERSHIP BIT  X'80'
DS4VSAM  DS    XL1                 USED TO PREVENT MULTIPLE OWNERS
         EJECT
DS5      DSECT
         IECSDSL1 (5)
DS5FDAD  DS    XL8
DS5F5PTR DS    A                   @ OF NEXT F5 DSCB, IF ANY
DS5LEN   EQU   *-DS5
         EJECT
DS6      DSECT
         IECSDSL1 (6)
DS6FDAD  DS    XL8
DS6F6PTR DS    A
DS6LEN   EQU   *-DS6
         EJECT
         CVT   LIST=YES,DSECT=YES                           *HMD 06/82*
         EJECT                                              *HMD 06/82*
         IHAPSA  ,                                          *HMD 06/82*
         EJECT                                              *HMD 06/82*
         IKJTCB  LIST=YES                                   *HMD 06/82*
         EJECT                                              *HMD 06/82*
         IECDIOSB ,                                         *HMD 06/82*
         EJECT                                              *HMD 06/82*
COM      DSECT
         IEZCOM
         EJECT ,
CIB      DSECT
         IEZCIB
         EJECT
EXTENT   DSECT
EXTPTR   DS    A
EXTLCCHH DS    XL4
EXTHCCHH DS    XL4
EXTNOTRK DS    H
EXTTYPE  DS    X
EXTSEQNO DS    X
EXTIDPTR DS    A
EXTLOTT  DS    XL2
EXTHITT  DS    XL2
EXTNTLEN EQU   *-EXTENT
         EJECT
EXLINE   DSECT
EXLLPARN DS    C
EXLFCC   DS    CL4
EXLFPRD  DS    C
EXLFHH   DS    CL4
         DS    2C
EXLLCC   DS    CL4
EXLLPRD  DS    C
EXLLHH   DS    CL4
         DS    2C
EXLFTT   DS    CL5
         DS    2C
EXLLTT   DS    CL5
         DS    2C
EXLNOTRK DS    CL5
EXLRPARN DS    C
         DS    C
EXLSEQNO DS    CL2
         DS    2C
EXLTYPE  DS    CL4
         DS    2C
EXLDSNAM DS    CL44
EXLSPLIT EQU   EXLDSNAM+33
         EJECT
PDS      DSECT
PDSHKEY  DS    CL8
PDSCOUNT DS    H
         SPACE 1
PDSENTRY EQU   *
PDSNAME  DS    CL8
PDSTTRP  DS    XL3
PDSINDIC DS    B
PDSALIAS EQU   X'80'
PDS#TTRS EQU   X'60'
PDSUSERH EQU   X'1F'
PDSUSERD DS    0X
         SPACE 3
         END   DISKSEEK
@@
//LKED.SYSLMOD DD DSN=SYS2.LINKLIB,DISP=SHR  <== TARGET
//LKED.SYSIN DD *
  SETCODE AC(1)
  NAME DISKMAP(R)
//*
//SAMPLIB  EXEC PGM=PDSLOAD
//STEPLIB  DD  DSN=SYSC.LINKLIB,DISP=SHR
//SYSPRINT DD  SYSOUT=*
//SYSUT2   DD  DISP=SHR,DSN=SYS2.PROCLIB
//SYSUT1   DD DATA,DLM=@@
./ ADD NAME=DISKSEEK
//DISKSEEK  JOB  (SETUP),
//             'Run DISKSEEK',
//             CLASS=A,
//             MSGCLASS=H,
//             MSGLEVEL=(1,1),
//             NOTIFY=&SYSUID
//********************************************************************
//*
//* Name: DISKSEEK
//*
//* Desc: Run the DISKSEEK program from SYS2.PROCLIB
//*
//********************************************************************
//SMAP     PROC SO=A,U='SYSALLDA',COPY=1,V=VOLUME
//SMAP     EXEC PGM=DISKSEEK,PARM=SMAP,REGION=1024K
//STEPLIB  DD DSN=SYS2.LINKLIB,DISP=SHR                  *HMD 06/82*
//VOLUME01 DD VOL=SER=&V,DISP=SHR,UNIT=&U
//SYSPRINT DD SYSOUT=&SO,COPIES=&COPY
//SYSSEEK  DD DUMMY,DCB=BLKSIZE=121
@@