//jobname  JOB (ACCT#),CLASS=x,MSGCLASS=x,NOTIFY=userid        <- CHECK         
//* -----------------------------------------------------------------           
//* Revive ! Install ...                                       <- CHECK         
//*                                                                             
//* Step1:                                                                      
//*   File Transfer to MVS .                                                    
//* Step2:                                                                      
//*  Enter Flow Line                                                            
//*  => X ALL;F '<- CHECK' ALL (Enter)                                          
//* Step3:                                                     <- CHECK         
//*  Update Non-Exclusive Line .                               <- CHECK         
//*  e.g. => C serial VOL001 ALL NX (Enter)                    <- CHECK         
//* Step4:                                                     <- CHECK         
//*  Submit This JCL.                                          <- CHECK         
//* Step5:(Optional)                                           <- CHECK         
//*  Comcat Created Datasets in Your Logon Procedure .         <- CHECK         
//*   module.library : ISPLLIB or STEPLIB                      <- CHECK         
//*   clist.library  : SYSPROC                                 <- CHECK         
//*   panel.library  : ISPPLIB or ISPPALT                      <- CHECK         
//* Step6:                                                     <- CHECK         
//*  Enter Flow Line on ISPF Command Line .                    <- CHECK         
//*  => TSO @REV ( Enter )                                     <- CHECK         
//*   or                                                       <- CHECK         
//*  => TSO EX 'clist.library(@REV)' (Enter)                   <- CHECK         
//*                                                            <- CHECK         
//* -----------------------------------------------------------------           
//JOBCAT   DD DSN=user.catalog,DISP=SHR                        <- CHECK         
//* - Volume Serial Define -----------------------------------------            
//DUMMY   EXEC PGM=IEFBR14                                                      
//TARGET   DD DISP=SHR,UNIT=SYSALLDA,VOL=SER=serial            <- CHECK         
//WORK     DD DISP=SHR,UNIT=SYSALLDA,VOL=SER=serial            <- CHECK         
//* - Dataset Scratch ----------------------------------------------            
//REMOVE  EXEC PGM=IEFBR14                                                      
//OBJECT   DD DSN=object.library,DISP=(OLD,DELETE),            <- CHECK         
//*               --------------                                                
//         UNIT=SYSALLDA,VOL=REF=*.DUMMY.TARGET                                 
//LOAD     DD DSN=module.library,DISP=(OLD,DELETE),            <- CHECK         
//*               --------------                                                
//         UNIT=SYSALLDA,VOL=REF=*.DUMMY.TARGET                                 
//PLIB     DD DSN=panel.library,DISP=(OLD,DELETE),             <- CHECK         
//*               --------------                                                
//         UNIT=SYSALLDA,VOL=REF=*.DUMMY.TARGET                                 
//CLIST    DD DSN=clist.library,DISP=(OLD,DELETE),             <- CHECK         
//*               --------------                                                
//         UNIT=SYSALLDA,VOL=REF=*.DUMMY.TARGET                                 
//* - Dataset Create -----------------------------------------------            
//CREATE  EXEC PGM=IEFBR14                                                      
//OBJECT   DD DSN=*.REMOVE.OBJECT,DISP=(,CATLG),                                
//         UNIT=SYSALLDA,VOL=REF=*.DUMMY.TARGET,                                
//         SPACE=(TRK,(20,20,10)),                                              
//         DCB=(RECFM=FB,LRECL=80,BLKSIZE=3120)                                 
//LOAD     DD DSN=*.REMOVE.LOAD,DISP=(,CATLG),                                  
//         UNIT=SYSALLDA,VOL=REF=*.DUMMY.TARGET,                                
//         SPACE=(TRK,(20,20,10)),                                              
//         DCB=(RECFM=U,LRECL=0,BLKSIZE=23200)                                  
//PLIB     DD DSN=*.REMOVE.PLIB,DISP=(,CATLG),                                  
//         UNIT=SYSALLDA,VOL=REF=*.DUMMY.TARGET,                                
//         SPACE=(TRK,(20,20,10)),                                              
//         DCB=(RECFM=FB,LRECL=80,BLKSIZE=3120)                                 
//CLIST    DD DSN=*.REMOVE.CLIST,DISP=(,CATLG),                                 
//         UNIT=SYSALLDA,VOL=REF=*.DUMMY.TARGET,                                
//         SPACE=(TRK,(20,20,10)),                                              
//         DCB=(RECFM=FB,LRECL=80,BLKSIZE=3120)                                 
//* - Copy Routine -------------------------------------------------            
//COPY    EXEC PGM=IEBGENER                                                     
//SYSUT1   DD *                                                                 
* --- Start of Oh Shock ! Dummy Section ---------------------------             
@RV#COPY DSECT                                                                  
*--- Version Number ---                                                         
@RV#VER  DS    CL6                         OH-Shock Version Number              
*--- Compiled Date ---                                                          
@RV#COMP DS    CL14                        OH-Shock Compiled Date               
*--- DD Name --------                                                           
@RV#DD   DS    CL8                         DD-Name                              
*--- Dataset Name ---                                                           
@RV#DSN  DS    CL44                        Dataset Name                         
*--- Volume Serial ---                                                          
@RV#VOL  DS    CL6                         Volume Serial Number                 
*--- Disposition ---                                                            
@RV#DISP DS    CL1                         Disposition                          
*--- Search String ---                                                          
@RV#LSTR DS    F                           Search String Length                 
@RV#SSTR DS    CL50                        Search Storing                       
*--- PDS ( Directory ) DCB address ---                                          
APDSFD   DS    A                           Address of PDSFD                     
*--- PDS ( Data ) DCB address ---                                               
APDSF    DS    A                           Address of PDSF                      
* --- Copy Section ( using R07 ) ---                                            
CPY_A    DS    F                           Copy Section Getmain Address         
CPY_L    DS    F                           Copy Section Getmain Length          
* --- Directory Table ---                                                       
DIRT_A   DS    F                           Directory Table GetM Address         
DIRT_P   DS    F                           Directory Table GetM Pointer         
DIRT_L   DS    F                           Directory Table GetM Length          
* --- Data Area Read Buffer ---                                                 
BUFF_A   DS    F                           Data Read Buff GetM Address          
BUFF_L   DS    F                           Data Read Buff GetM Length           
* --- dataset configration area ---                                             
*ETM_A3  DS    F                                 GETMAIN ADDRESS 2              
*ETM_L3  DS    F                                 GETMAIN LENGTH 2               
D_ENDP   DS    F                                 DIRECTORY END POINT            
*--- Dataset Dynamic Allocation Parameter ---                                   
DA#AREA  DS    0F                                                               
DA#PROC  DS    CL8                         Process Name                         
DA#DSN   DS    CL44                        Dataset Name                         
DA#VOL   DS    CL6                         Volume Serial                        
DA#DISP  DS    CL3                         Disposition                          
DA#RETDD DS    CL8                         Return DD-Name                       
DA#RETC  DS    CL4                         Return Code                          
DA#SPC   DS    CL3                         Space ( TRK or CYL )                 
DA#SIZE1 DS    XL3                         Primary Space                        
DA#SIZE2 DS    XL3                         Secondary Space                      
DA#DSORG DS    CL2                         Dataset Organization ( PS )          
DA#RECFM DS    XL1                         Record Format                        
*                                         ( F, V, FB, VB, FBA, VBA, U )         
DA#LRECL DS    XL2                         Logical Record Length                
DA#BLKSZ DS    XL2                         Block Size                           
*--- Length of Copy Section ---                                                 
@RV#CPYL EQU   *-@RV#COPY                                                       
/*                                                                              
//SYSUT2   DD DSN=&&COPY(@RV#080X),DISP=(,PASS),                                
//         UNIT=SYSALLDA,VOL=REF=*.DUMMY.WORK,SPACE=(TRK,(10,10,10)),           
//         DCB=(RECFM=FB,LRECL=80,BLKSIZE=3120)                                 
//SYSPRINT DD SYSOUT=*                                                          
//SYSIN    DD DUMMY                                                             
//* - CLIST --------------------------------------------------------            
//CLIST   EXEC PGM=IEBGENER                                                     
//SYSUT1   DD *,DLM=@@                                                          
/* - REXX -                                                                     
                                                                                
      - REVIVE ! PDS Members ...                                                
                                                                                
*/                                                                              
TRACE N                                                                         
SIGNAL ON ERROR NAME ERR_PROC                                                   
                                                                                
ADDRESS TSO                                                                     
 "ALLOC F(ISPLUSR) DA('isp.sispload'," ,                /* <- CHECK */          
                     "'module.library')" ,              /* <- CHECK */          
                  "SHR REU"                                                     
 "ALLOC F(ISPPUSR) DA('panel.library')" ,               /* <- CHECK */          
                  "SHR REU"                                                     
 "ALLOC F(SNAPDD)  DA(*)" ,                                                     
                  "SHR REU"                                                     
ADDRESS ISPEXEC                                                                 
 "LIBDEF ISPLLIB EXCLLIBR ID(ISPLUSR) COND"                                     
 "LIBDEF ISPPLIB LIBRARY  ID(ISPPUSR) COND"                                     
 "SELECT PGM(@RV#0)"                                                            
 "LIBDEF ISPLLIB EXCLLIBR"                                                      
 "LIBDEF ISPPLIB LIBRARY"                                                       
ADDRESS TSO                                                                     
 "FREE F(ISPLUSR,ISPPUSR,SNAPDD)"                                               
 EXIT                                                                           
                                                                                
ERR_PROC:                                                                       
  SAY                                                                           
  SAY                                                                           
  SAY '>> OS000 Initial Process Abnormal Ended ....      Bye !!'                
  SAY                                                                           
@@                                                                              
//SYSUT2   DD DSN=*.CREATE.CLIST,DISP=OLD                                       
//SYSPRINT DD SYSOUT=*                                                          
//SYSIN    DD *                                                                 
 GENERATE MAXNAME=1                                                             
  MEMBER NAME=(@REV)                                                            
//* - PANELS ( @RV#2ENT ) ------------------------------------------            
//PNL#ENT EXEC PGM=IEBGENER                                                     
//SYSUT1   DD *,DLM=@@                                                          
)Attr                                                                           
   % type(text  ) intens(high) caps(off)                                        
   + type(text  ) intens(low )                                                  
   _ type(input ) intens(high) caps(off) just(left )                            
   $ type(input ) intens(high) caps(on ) just(left ) hilite(uscore)             
   \ type(input ) intens(high) caps(on ) just(right) hilite(uscore)             
   ? type(input ) intens(high) caps(off) just(left ) hilite(uscore)             
   @ type(text)   intens(high) caps(off)             color(yellow)              
   ~ type(text)   intens(high) caps(off)             color(turq)                
)Body  Expand(//)                                                               
%-/-/- Revive ! < &rev > Entry -/-/-                                            
%Command ===>_zcmd                                                / / +         
+                                                                               
@ Keyin Recovery Dataset ..                                                     
+   Dataset Name  :$I#DSN                                       +               
+   Volume Serial :$I#VOL +                         --------------------------  
+                                                  | Version :~&REV          +| 
+   Select Option                                  | Fix     :~&REVD         +| 
+     o Recovery Members After Compressed ..       | Compile :~&REVC         +| 
+         Extended Recovery :$z+ ( Y.N )            --------------------------  
+                                                                               
+     o Add Current Member ...                                                  
+                           :\z+ ( Y.N )                                        
+                                                                               
+     o Recovery Dataset Disposition ..                                         
+                           :$z+ ( S:shr O:old )                                
+                                                                               
+     o GetMain Directory Table Space ...                                       
+                           :\z      + ( nnnnn:Byte )                           
+                                                                               
+     o Search String .. ( BLANK or Search String )                             
+                   :?i#srhstr                                          +       
+                                                                               
)Init                                                                           
  .help = @rv#2hlp                /* insert name of tutorial panel  */          
  .cursor = i#dsn                                                               
  .zvars = '(i#extopt i#extop2 i#disp i#dspace)'                                
)proc                                                                           
  ver (&i#dsn,nb,dsname)                                                        
  if ( &i#vol ^= ' ' )                                                          
    ver (&i#vol,len,EQ,6)                                                       
  ver (&i#extopt,nb,list,Y,N)                                                   
  ver (&i#extop2,nb,list,Y,N)                                                   
  ver (&i#disp,nb,list,S,O)                                                     
  ver (&i#dspace,nb,num)                                                        
  ver (&i#dspace,range,3,9999999)                                               
  vput i#srhstr                                                                 
)END                                                                            
@@                                                                              
//SYSUT2   DD DSN=*.CREATE.PLIB,DISP=OLD                                        
//SYSPRINT DD SYSOUT=*                                                          
//SYSIN    DD *                                                                 
 GENERATE MAXNAME=1                                                             
  MEMBER NAME=(@RV#2ENT)                                                        
//* - PANELS ( @RV#2LST ) ------------------------------------------            
//PNL#LST EXEC PGM=IEBGENER                                                     
//SYSUT1   DD *,DLM=@@                                                          
)Attr                                                                           
   % type(text  ) intens(high) caps(off)                                        
   + type(text  ) intens(low )                                                  
   _ type(input ) intens(high) caps(on ) just(left )                            
   $ type(input ) intens(high) caps(on ) just(left ) hilite(uscore)             
   @ type(text)   intens(high) caps(off)             color(yellow)              
   ^ type(output) intens(low ) caps(off) just(asis ) color(blue)                
   ~ type(output) intens(low ) caps(off) just(right) color(blue)                
   \ type(input ) intens(low ) caps(on ) just(asis ) color(turq)                
)Body  Expand(//)                                                               
%-/-/- P D S F - Oh Shock ! < &rev > -/-/-                                      
%Command ===>_zcmd                                 / /%Scroll ===>_amt +        
+                                                                               
+ DataSet Name :^I#DSN                                       + Vol :^I#VOL      
+                                                                               
@                 Select: 'B' - Browse    'R' - Restore                         
%  Member   -- Data ( First 60 Byte ) --                                  Rec#  
)MODEL                                                                          
$Z\O#M     ^O#D                                                         ~O#LEN+ 
)Init                                                                           
  &amt = csr                                                                    
  .help = @rv#2hlp                /* insert name of tutorial panel  */          
  .zvars = '( @select )'                                                        
)PROC                                                                           
)END                                                                            
@@                                                                              
//SYSUT2   DD DSN=*.CREATE.PLIB,DISP=OLD                                        
//SYSPRINT DD SYSOUT=*                                                          
//SYSIN    DD *                                                                 
 GENERATE MAXNAME=1                                                             
  MEMBER NAME=(@RV#2LST)                                                        
//* - PANELS ( @RV#CRE ) -------------------------------------------            
//PNL#CRE EXEC PGM=IEBGENER                                                     
//SYSUT1   DD *,DLM=@@                                                          
)Attr                                                                           
   % type(text  ) intens(high) caps(off)                                        
   + type(text  ) intens(low )                                                  
   _ type(input ) intens(high) caps(off) just(left )                            
   $ type(input ) intens(high) caps(on ) just(left ) hilite(uscore)             
   @ type(text)   intens(high) caps(off)             color(yellow)              
)Body  Expand(//)                                                               
%-/-/- Revive ! < &rev > Restore -/-/-                                          
%Command ===>_zcmd                                                / / +         
+                                                                               
@ Keyin Restore Dataset ..                                                      
+                                                                               
+   Dataset Name  :$R#DSN                                       +               
+   Volume Serial :$R#VOL +                                                     
+                                                                               
)Init                                                                           
  .help = tutorpan                /* insert name of tutorial panel  */          
  .cursor = r#dsn                                                               
)proc                                                                           
  ver (&r#dsn,nb,dsname)                                                        
  if ( &r#vol ^= ' ' )                                                          
    ver (&r#vol,len,EQ,6)                                                       
)END                                                                            
@@                                                                              
//SYSUT2   DD DSN=*.CREATE.PLIB,DISP=OLD                                        
//SYSPRINT DD SYSOUT=*                                                          
//SYSIN    DD *                                                                 
 GENERATE MAXNAME=1                                                             
  MEMBER NAME=(@RV#CRE)                                                         
//* - PANELS ( @RV#INF ) -------------------------------------------            
//PNL#INF EXEC PGM=IEBGENER                                                     
//SYSUT1   DD *,DLM=@@                                                          
)Attr                                                                           
   % type(text  ) intens(high) caps(off)                                        
   + type(text  ) intens(low )                                                  
   _ type(input ) intens(high) caps(off) just(left )                            
   $ type(input ) intens(high) caps(on ) just(left ) hilite(uscore)             
   @ type(text)   intens(high) caps(off)             color(yellow)              
   ^ type(output) intens(low ) caps(off) just(asis ) color(blue)                
   \ type(input ) intens(low ) caps(on ) just(asis ) color(turq)                
)Body  Expand(//)                                                               
%-/-/- Revive ! < &rev > Information -/-/-                                      
%Command ===>_zcmd                                                 / / +        
+                                                                               
+ DataSet Name :^i#dsn                                                          
+                       m b b c  c h h r     t t r                              
+  ------------  Addr :^o#asp                        +recfm       :^o#recfm     
+ | Directory  | blks :^o#dblk      +mem# :^o#mem    +lrecl       :^o#lrecl     
+  ------------  Addr :^o#adp             +(^z     +)+blksize     :^o#blksz     
+ | Data       |                                     +devtype     :^o#devt      
+ |  ( Used )  |                                     +serial      :^i#vol       
+  ------------  Addr :^o#aup             +(^z     +)+extent      :^o#ext       
+ | Data       |                                     +allocated   :^o#alc+trk   
+ | ( UnUsed ) |                                     +use         :^o#use+per   
+  ------------  Addr :^o#aep             +(^z     +)+creation    :^o#cre       
+                                                    +expiration  :^o#exp       
+                                                    +system code :^o#syscd     
+       1st      2nd      3rd      4th      5th      6th      7th      8th      
+ Low :^o#l1    ^o#l2    ^o#l3    ^o#l4    ^o#l5    ^o#l6    ^o#l7    ^o#l8     
+ High:^o#h1    ^o#h2    ^o#h3    ^o#h4    ^o#h5    ^o#h6    ^o#h7    ^o#h8     
+       9th      10th     11th     12th     13th     14th     15th     16th     
+ Low :^o#l9    ^o#l10   ^o#l11   ^o#l12   ^o#l13   ^o#l14   ^o#l15   ^o#l16    
+ High:^o#h9    ^o#h10   ^o#h11   ^o#h12   ^o#h13   ^o#h14   ^o#h15   ^o#h16    
+                                                                               
+                                                                               
)init                                                                           
  .zvars = '(o#adp2 o#aup2 o#aep2)'                                             
)proc                                                                           
)end                                                                            
@@                                                                              
//SYSUT2   DD DSN=*.CREATE.PLIB,DISP=OLD                                        
//SYSPRINT DD SYSOUT=*                                                          
//SYSIN    DD *                                                                 
 GENERATE MAXNAME=1                                                             
  MEMBER NAME=(@RV#INF)                                                         
//A       EXEC PGM=IEV90,PARM=OBJECT,REGION=2000K                               
//SYSIN    DD  *                                                                
         START                                                                  
* -----------------------------------------------------------------             
         DC   C'<< Revive ! >> Version 0.80 ( '                                 
REV      DC   CL6'v0r8m0'                                                       
         DC   C' ) _ Kimu  // '                                                 
         DC   C' Fixed Date : '                                                 
REVD     DC   C'05/02/96 00.00'                                                 
*EVD     DC   C'*Test Version*'                                                 
         DC   C' Compiled Date : '                                              
REVC     DC   C'&SYSDATE &SYSTIME'                                              
         PRINT NOGEN                                                            
* --- Start of Process --------------------------------------------             
@RV#080  CSECT                                                                  
         SAVE  (14,12),T,*                                                      
         BALR  R03,0                                                            
         USING *,R03,R04,R05,R06           Base Reg. R03,R04,R05                
         LA    R04,2048(R03)               2'ND Base Reg                        
         LA    R04,2048(R04)                                                    
         LA    R05,2048(R04)               3'ND Base Reg                        
         LA    R05,2048(R05)                                                    
         LA    R06,2048(R05)               4'ND Base Reg                        
         LA    R06,2048(R06)                                                    
         ST    R13,SAVEAREA+4              Save A(OLD SaveArea)                 
         LR    R12,R13                                                          
         LA    R13,SAVEAREA                                                     
         ST    R13,8(R12)                  Save A(NEW SaveArea)                 
*-------- Initialization -------------------------------------------            
         L     R01,0(R01)                                                       
         LH    R02,0(R01)                                                       
         LTR   R02,R02                                                          
         BZ    @INISKP                                                          
         CL    R02,=F'44'                                                       
         BH    @INISKP                                                          
         MVI   I#DSN,C' '                  Search String                        
         MVC   I#DSN+1(43),I#DSN                                                
         BCTR  R02,0                                                            
         STC   R02,*+5                                                          
         MVC   I#DSN(0),2(R01)                                                  
@INISKP  EQU   *                                                                
*-------- Copy Section Storae  -------------------------------------            
         LA    R08,@RV#CPYL                Get Copy Section Length              
         GETMAIN RC,LV=(R08)               Member TTR Save Area                 
         LTR   R15,R15                                                          
         BNZ   GETM_ER0                                                         
         LR    R07,R01                                                          
         USING @RV#COPY,R07                using r07 <- Copy Section            
         ST    R07,CPY_L                   Store GetMain Length                 
         ST    R09,CPY_A                   Getmain Copy Section Addr.           
*-------- Morning Message ------------------------------------------            
*        L     R01,=A(REV)                                                      
*        MVC   @RV#VER(L'@RV#VER),0(R01)                                        
*        L     R01,=A(REVC)                                                     
*        MVC   @RV#COMP(L'@RV#COMP),0(R01)                                      
*        MVC   MSG004+17(L'@RV#VER),@RV#VER                                     
*        MVC   MSG004+26(L'@RV#COMP),@RV#COMP                                   
*        TPUT  MSG004,L'MSG004                                                  
*-------- Set Copy Section -----------------------------------------            
         LA    R01,PDSFD                   save PDSFD DCB address               
         ST    R01,APDSFD                    ( PDS Directory )                  
         LA    R01,PDSF                    save PDSF DCB address                
         ST    R01,APDSF                     ( PDS Data )                       
*-------- Define ISPF Variable -------------------------------------            
         BAL   R14,ISPFVDEF                                                     
*-------- Initialize Entry Panel Variable ... ----------------------            
         MVI   I#VOL,C' '                  Search String                        
         MVC   I#VOL+1(6),I#VOL                                                 
         MVI   I#EXTOPT,C'N'               Extended Option 1                    
         MVI   I#EXTOP2,C'N'               Extended Option 2                    
         MVI   I#DISP,C'S'                 Disposition                          
         MVC   I#DSPACE,=F'110000'         Directory Space                      
         MVI   I#SRHSTR,C' '               Search String                        
         MVC   I#SRHSTR+1(49),I#SRHSTR                                          
*-------- Entry Panel Show -----------------------------------------            
SHOW_ENT EQU   *                                                                
         CALL  ISPLINK,(DISPLAY,PANELENT),VL   Entry Panel Display              
         LTR   R15,R15                         if PF03 then                     
         BNZ   @QUIT                             goto @EXIST                    
*-------- Panel Field Copy -----------------------------------------            
         MVC   @RV#DSN(44),I#DSN           Copy Dataset name                    
         MVC   @RV#VOL(06),I#VOL           Copy Volume Serial                   
         MVC   @RV#DISP(1),I#DISP          Copy Disposition                     
         MVC   DIRT_L,I#DSPACE             Copy Genmain Size                    
         MVI   @RV#SSTR,C' '               Search String                        
         MVC   @RV#SSTR(L'@RV#SSTR-1),@RV#SSTR+1                                
         XC    @RV#LSTR,@RV#LSTR                                                
         LA    R01,L'I#SRHSTR                                                   
         BCTR  R01,0                                                            
         LA    R02,I#SRHSTR(R01)                                                
S#SSTRL  EQU   *                                                                
         CLI   0(R02),C' '                                                      
         BNE   S#SSTRLX                                                         
         BCTR  R02,0                                                            
         BCT   R01,S#SSTRL                                                      
         B     S#SSTRLQ                                                         
S#SSTRLX EQU   *                                                                
         LA    R01,1(R01)                                                       
         ST    R01,@RV#LSTR                                                     
         STC   R01,*+5                                                          
         MVC   @RV#SSTR(0),I#SRHSTR                                             
S#SSTRLQ EQU   *                                                                
*-------- Recover Dataset ENQ ( Exclusive ) -----------------------             
         MVC   RNAME(44),@RV#DSN               ENQ rname                        
         ENQ   MF=(E,@ENQ)                                                      
         LTR   R15,R15                                                          
         BNZ   ENQ_ER0                                                          
*-------- Dynamic Allocaation of Recovery dataset -----------------             
         MVC   DA#PROC(8),=CL8'ALLOCATE'       Dynamic Allocation Rout          
         MVC   DA#DSN(44),@RV#DSN              Copy Allocation DataSet          
         MVC   DA#VOL(06),@RV#VOL              Copy Allocation Volume           
         CLI   @RV#DISP,C'O'                   if DISP = OLD then               
         BE    @ENT_OLD                                                         
         MVC   DA#DISP(3),=CL3'SHR'            Set Disposition                  
         B     @ENT_ALC                                                         
@ENT_OLD EQU   *                                                                
         MVC   DA#DISP(3),=CL3'OLD'            Set Disposition                  
@ENT_ALC EQU   *                                                                
         LA    R01,DA#AREA                     Set r01 = Parm Area              
         L     R15,@RV#6DA                                                      
         BALR  R14,R15                         Call Dynam Alloc Routine         
         LTR   R15,R15                         if rc = 0 then                   
         BZ    @ENT_OK                           goto @DY_OK                    
*-------- Dynamic Allocation Error ---------------------------------            
         CL    R15,=F'8'                       if rc = 8 then                   
         BNE   @ENT_DNF                          dataset not found              
         MVC   ZEDLMSG,ERRMSG06                                                 
         MVC   ZEDSMSG,=CL20'DSN Not Found !'                                   
         B     @ENT_ERX                                                         
@ENT_DNF EQU   *                                                                
         LA    R01,DA#RETC                                                      
         CALL  @RV#6HC,((R01),ERRMSG02+30,4)                                    
         MVC   ZEDLMSG,ERRMSG02                                                 
         CLC   DA#RETC(2),=XL2'0210'          Dataset In Use ( EXCL )           
*                                               Already Other JOB               
         BE    @ENT_USE                                                         
         CLC   DA#RETC(2),=XL2'020C'          Dataset In Use ( SHR )            
*                                               Already Other JOB               
         BE    @ENT_USE                                                         
         MVC   ZEDSMSG,=CL20'Dynam alloc err !'                                 
         B     @ENT_ERX                                                         
@ENT_USE EQU   *                                                                
         MVC   ZEDSMSG,=CL20'In Use .. Other User !'                            
@ENT_ERX EQU   *                                                                
         DEQ   MF=(E,@DEQ)                     DEQ                              
         CALL  ISPLINK,(SETMSG,ISRZ001),VL                                      
         B     SHOW_ENT                        Retry Entry Panel                
*-------- Allocate & Initialization --------------------------------            
@ENT_OK  EQU   *                                                                
         MVC   @RV#DD(8),DA#RETDD              Save Input DD                    
         MVC   PDSF+X'28'(8),@RV#DD            Directory Read DD                
         MVC   PDSFD+X'28'(8),@RV#DD           Data Read DD                     
         MVC   PDSFS+X'28'(8),@RV#DD           Stow DD                          
         MVC   PDSFR+X'28'(8),@RV#DD           ExRecovery Write DD              
         MVC   ZEDLMSG,MSG002                                                   
         MVC   ZEDSMSG,=CL20' '                                                 
         CALL  ISPLINK,(SETMSG,ISRZ001),VL     Show Wait Message                
         CALL  ISPLINK,(CONTROL,DISPLAY,LOCK),VL                                
         CALL  ISPLINK,(DISPLAY,PANELENT),VL                                    
*                                                                               
         OPEN  (PDSFD,,PDSF)                                                    
         RDJFCB PDSF                           Get JFCB                         
         CALL  @RV#6DC                         Get Dataset Information          
*-------- Check Input Dataset Organization ( PO File Only ) --------            
         CLI   CK#DSORG,JFCORGPO               If Dsorg is Not PO Then          
         BE    @ENT_QUT                          goto @dy_quit                  
         CALL  @RV#6HC,(CK#DSORG,ERRMSG05+40,1)                                 
         MVC   ZEDLMSG,ERRMSG05                                                 
         MVC   ZEDSMSG,=CL20'OSORG Error !'                                     
         CALL  ISPLINK,(SETMSG,ISRZ001),VL                                      
         CLOSE (PDSFD,,PDSF)                                                    
         MVC   DA#PROC(8),=CL8'FREE    '       Free                             
         MVC   DA#RETDD(8),@RV#DD                                               
         LA    R01,DA#AREA                                                      
         L     R15,@RV#6DA                                                      
         BALR  R14,R15                         Call Free Routine                
         DEQ   MF=(E,@DEQ)                     DEQ                              
         B     SHOW_ENT                                                         
@ENT_QUT EQU   *                                                                
*-------- Directory Table Area GetMain -----------------------------            
         L     R02,DIRT_L                                                       
         GETMAIN RC,LV=(R02)                   Member TTR Save Area             
         LTR   R15,R15                                                          
         BNZ   GETM_ER1                                                         
         ST    R01,DIRT_A                      getmain 1 address                
         ST    R01,DIRT_P                      getmain 1 pointer                
*-------- Data Area Read Buffer Getmain ----------------------------            
         LH    R02,PDSF+X'3E'                                                   
         ST    R02,BUFF_L                      getmain 2 length                 
         GETMAIN RC,LV=(R02)                   Read Buffer Work Area            
         LTR   R15,R15                                                          
         BNZ   GETM_ER2                                                         
         ST    R01,BUFF_A                      getmain 2 address                
*-------- ISPF Table Create ----------------------------------------            
         CALL  ISPLINK,(TBCREATE,@RV#00,KEYN,NAMEL,NOWRITE),VL                  
*-------- Directory Read -------------------------------------------            
         XR    R10,R10                         Clear Member Counter             
         XC    O#DBLK(L'O#DBLK),O#DBLK         Clear Directory Block            
@D_READ  EQU   *                                                                
         READ  DECB01,SF,PDSFD,DIR,'S'         READ DIRECTORY                   
         CHECK DECB01                                                           
*                                                                               
         L     R01,O#DBLK                      Directory Block Count            
         LA    R01,1(R01)                                                       
         ST    R01,O#DBLK                                                       
*                                                                               
         LH    R12,DIR                         Load Read Length                 
         LA    R12,DIR(R12)                                                     
         ST    R12,D_ENDP                      Save Directory END-ADDR          
         LA    R12,DIR+2                       Set Member Start Point           
@D_LOP01 EQU   *                                                                
         CL    R12,D_ENDP                      If Directory END-ADDR            
         BNL   @D_READ                           Goto Read Next Record          
         CLI   0(R12),X'FF'                    If End of Member Name            
         BE    @D_READ                           Goto Read Next Record          
         L     R11,DIRT_P                      R11 <- Table Pointer             
         MVC   0(11,R11),0(R12)                Copy Member Name and TTR         
         LA    R11,11(R11)                                                      
         ST    R11,DIRT_P                      Store Table Pointer              
         LA    R10,1(R10)                      Member Counter + 1               
         L     R01,DIRT_A                                                       
         L     R02,DIRT_L                                                       
         LA    R01,0(R01,R02)                  Check End of Table Space         
         CLR   R01,R11                         If No More Table                 
         BL    @TB_OVER                          Goto @TB_OVER                  
*                                                                               
         IC    R11,11(R12)                     Load 'C'                         
         N     R11,=X'0000001F'                User Data Length                 
         SLL   R11,1                           * 2                              
         LA    R12,12(R12,R11)                 Point Next Member                
         B     @D_LOP01                                                         
*-------- End of Directory ( Directory at end Routie ) -------------            
@D_EXIT  EQU   *                                                                
         NOTE  PDSFD                           Get Last Directory Addr          
         ST    R01,W_TTR                                                        
         MVI   W_TTR+3,X'00'                                                    
         POINT PDSF,W_TTR                      Point Data Area Addr             
*-------- Store Member Number --------------------------------------            
         CVD   R10,PK_AREA                                                      
         UNPK  UPK_AREA(8),PK_AREA(8)                                           
         OI    UPK_AREA+7,X'F0'                                                 
         MVC   O#MEM(5),UPK_AREA+3                                              
*-------- Store Member Number --------------------------------------            
         CALL  @RV#6HC,(W_TTR,O#ADP2,3)                                         
         L     R00,W_TTR                      MBBCCHHR Convert                  
         N     R00,=X'FFFFFF00'                                                 
         L     R01,PDSF+44                    Load DEB Address                  
         N     R01,=X'00FFFFFF'                                                 
         LA    R02,W_CHR                                                        
         BAL   R14,@CNVCHR                    Convert TTR -> MBBCCHHR           
         CALL  @RV#6HC,(W_CHR,O#ADP,8)                                          
*-------- Read First Data Area -------------------------------------            
@M_FIRST EQU   *                                                                
         MVI   MEMAREA,X'40'                   Clear OutArea                    
         MVC   MEMAREA+1(77),MEMAREA                                            
         XC    O#LEN,O#LEN                     Clear Record Counter             
*        OI    FLAG,X'02'                      Set Str Srch Flag                
         NI    FLAG,X'FD'                      Clear Str-Srch Flag              
* Convert 'Real Address' to 'Relative Address'                                  
* DEBUG *                                                                       
*        CALL  @RV#6HC,(PDSF+5,ERRMSG10+2,8)                                    
*        CALL  @RV#6HC,(T#CHR,ERRMSG10+22,8)                                    
*        TPUT  ERRMSG10,L'ERRMSG10                                              
* DEBUG *                                                                       
         L     R01,PDSF+44                     Load DEB Address                 
         N     R01,=X'00FFFFFF'                                                 
         LA    R02,PDSF+5                      MBCCHHR ADDRESS                  
         BAL   R14,@CNVTTR                     CONVERT MBCCHHR -> TTR           
         ST    R00,W_TTR                       GET TTR                          
         CLI   I#EXTOPT,C'Y'                                                    
         BE    EXTOPT1                                                          
         CLC   W_TTR(3),E#TTR                  IF END BLOCK                     
         BNL   @M_EXIT2                                                         
         B     EXTOPT1X                                                         
EXTOPT1  EQU   *                                                                
         CLC   T#CHR+3(4),PDSF+8               IF END BLOCK                     
         BNH   @M_EXIT2                                                         
*                                                                               
EXTOPT1X EQU   *                                                                
         L     R12,BUFF_A                                                       
         READ  DECB11,SF,PDSF,(R12),'S'        READ MEMBER                      
         CHECK DECB11                            ( FIRST BLOCK )                
         LA    R01,1                                                            
         ST    R01,O#LEN                       Clear Record Counter             
         L     R01,DECB11+16                                                    
         LH    R01,14(R01)                                                      
         L     R02,BUFF_L                                                       
         SR    R02,R01                                                          
         ST    R02,R_LEN                       Save Read Length                 
*                                                                               
*        TPUT  =CL20'** 1ST 1 **',20                                            
         BAL   R10,@SRCHSTR                                                     
*        TPUT  =CL20'** 1ST 2 **',20                                            
*        LA    R12,FLAG                                                         
*        CALL  @RV#6HC,((R12),ERRMSG10+9,1)                                     
*        CALL  @RV#6HC,(R_LEN,ERRMSG10+11,4)                                    
*        TPUT  ERRMSG10,L'ERRMSG10                                              
* --- DEBUG ---                                                                 
*        CALL  @RV#6HC,(PDSF+5,ERRMSG07+11,8)                                   
*        TPUT  ERRMSG07,L'ERRMSG07                                              
* --- DEBUG ---                                                                 
         L     R01,PDSF+44                     DEB ADDRESS                      
         N     R01,=X'00FFFFFF'                                                 
         LA    R02,PDSF+5                      MBCCHHR ADDRESS                  
         BAL   R14,@CNVTTR                     CONVERT MBCCHHR -> TTR           
         ST    R00,W_TTR                       GET TTR                          
         CLI   I#EXTOPT,C'Y'                                                    
         BE    EXTOPT2                                                          
         CLC   W_TTR(3),E#TTR                  IF END BLOCK                     
         BNL   @M_EXIT2                                                         
         B     EXTOPT2X                                                         
EXTOPT2  EQU   *                                                                
         CLC   T#CHR+3(4),PDSF+8               IF END BLOCK                     
         BNH   @M_EXIT2                                                         
*                                                                               
EXTOPT2X EQU   *                                                                
*                                                                               
         L     R12,DIRT_A                                                       
@M_LOP01 EQU   *                               SEARCH TTR                       
*        B     @M_NOF                                                           
         CL    R12,DIRT_P                      IF END ADDRESS                   
         BNL   @M_NOF                                                           
         CLC   8(3,R12),W_TTR                  IF EQUAL                         
         BE    @M_FND                                                           
         LA    R12,11(R12)                                                      
         B     @M_LOP01                                                         
*-------- TTR Found on Directory Table -----------------------------            
@M_FND   EQU   *                                                                
         CLI   I#EXTOP2,C'Y'                                                    
         BE    @M_FND2                                                          
         NI    FLAG,X'FE'                      Set Add Table Flag               
         B     @M_DUM_L                                                         
@M_FND2  EQU   *                                                                
         MVC   O#M(8),0(R12)                   Copy Member Name                 
         MVC   O#TTRB(4),W_TTR                                                  
         CALL  @RV#6HC,(W_TTR,O#TTR,3)                                          
         L     R01,PDSF+44                    Load DEB Address                  
         N     R01,=X'00FFFFFF'                                                 
         LA    R02,O#MBCHR                                                      
         BAL   R14,@CNVCHR                    convert ttr -> mbbcchhr           
         L     R12,BUFF_A                                                       
*        L     R10,BUFF_L                                                       
*        S     R10,R_LEN                                                        
         L     R10,R_LEN                                                        
         LA    R11,60                                                           
         CLR   R10,R11                                                          
         BNL   @M_FNDS                         IF READ LENGTH >= 55             
         BCTR  R10,0                                                            
         STC   R10,*+5                                                          
         MVC   O#D(0),0(R12)                   COPY DATA AREA                   
         B     @M_SKIPX                                                         
@M_FNDS  EQU   *                                                                
         MVC   O#D(60),0(R12)                  COPY DATA AREA                   
         B     @M_SKIPX                                                         
@M_NOF   EQU   *                                                                
         MVI   O#M,C'+'                        MEMBER NAME ( +TTR )             
         CALL  @RV#6HC,(W_TTR,O#M+1,3)                                          
         MVC   O#TTRB(4),W_TTR                                                  
         CALL  @RV#6HC,(W_TTR,O#TTR,3)                                          
         L     R01,PDSF+44                    Load DEB Address                  
         N     R01,=X'00FFFFFF'                                                 
         LA    R02,O#MBCHR                                                      
         BAL   R14,@CNVCHR                    convert ttr -> mbbcchhr           
*                                                                               
         L     R12,BUFF_A                                                       
*        L     R10,BUFF_L                                                       
*        S     R10,R_LEN                                                        
         L     R10,R_LEN                                                        
         LA    R11,60                                                           
         CLR   R10,R11                                                          
         BNL   @M_SKIP                         IF READ LENGTH >= 55             
         BCTR  R10,0                                                            
         STC   R10,*+5                                                          
         MVC   O#D(0),0(R12)                   COPY DATA AREA                   
         B     @M_SKIPX                                                         
@M_SKIP  EQU   *                                                                
         MVC   O#D(60),0(R12)                  COPY DATA AREA                   
@M_SKIPX EQU   *                                                                
         OI    FLAG,X'01'                                                       
*-------- Read Data Area ( Dummy Read ) ----------------------------            
@M_DUM_L EQU   *                                                                
         L     R12,BUFF_A                      2'ND BLOCK                       
         READ  DECB12,SF,PDSF,(R12),'S'        READ MEMBER                      
         CHECK DECB12                                                           
         L     R01,O#LEN                       Add block length + 1             
         LA    R01,1(R01)                                                       
         ST    R01,O#LEN                                                        
         L     R01,DECB12+16                                                    
         LH    R01,14(R01)                                                      
         L     R02,BUFF_L                                                       
         SR    R02,R01                                                          
         ST    R02,R_LEN                       Save Read Length                 
*        TPUT  =CL20'** 2ND 1 **',20                                            
         BAL   R10,@SRCHSTR                                                     
*        TPUT  =CL20'** 2ND 2 **',20                                            
*        LA    R12,FLAG                                                         
*        CALL  @RV#6HC,((R12),ERRMSG10+9,1)                                     
*        TPUT  ERRMSG10,L'ERRMSG10                                              
* --- DEBUG ---                                                                 
*        CALL  @RV#6HC,(PDSF+5,ERRMSG07+11,8)                                   
*        TPUT  ERRMSG07,L'ERRMSG07                                              
* --- DEBUG ---                                                                 
         L     R01,PDSF+44                     DEB ADDRESS                      
         N     R01,=X'00FFFFFF'                                                 
         LA    R02,PDSF+5                      MBCCHHR ADDRESS                  
         BAL   R14,@CNVTTR                     CONVERT MBCCHHR -> TTR           
         ST    R00,W_TTR                       GET TTR                          
         CLI   I#EXTOPT,C'Y'                                                    
         BE    EXTOPT3                                                          
         CLC   W_TTR(3),E#TTR                  IF END BLOCK                     
         BNL   @M_EXIT1                                                         
         B     EXTOPT3X                                                         
EXTOPT3  EQU   *                                                                
         CLC   T#CHR+3(4),PDSF+8               IF END BLOCK                     
         BNH   @M_EXIT1                                                         
*                                                                               
EXTOPT3X EQU   *                                                                
*                                                                               
         B     @M_DUM_L                                                         
*-------- Next Member Process --------------------------------------            
@M_NEXT  EQU   *                               next member read !               
         TM    FLAG,X'01'                                                       
         BNO   @M_NEXTX                                                         
         TM    FLAG,X'02'                                                       
         BNO   @M_NEXTX                                                         
         L     R01,O#LEN                       If Member is No-Records          
         LTR   R01,R01                           Goto @M_NEXTX                  
         BZ    @M_NEXTX                                                         
         CALL  ISPLINK,(TBADD,@RV#00,NAMELIST),VL                               
@M_NEXTX EQU   *                                                                
         B     @M_FIRST                                                         
@M_EXIT1 EQU   *                               member read terminate.           
         TM    FLAG,X'01'                                                       
         BNO   @M_EXIT2                                                         
         CALL  ISPLINK,(TBADD,@RV#00,NAMELIST),VL                               
@M_EXIT2 EQU   *                               member read terminate.           
         B     @R_EXIT                                                          
@R_EXIT  EQU   *                               read terminate .                 
         CLOSE (PDSFD,,PDSF)                                                    
         CALL  ISPLINK,(TBTOP,@RV#00),VL                                        
         MVC   ZEDLMSG,MSG001                                                   
*        CALL  ISPLINK,(VPUT,VPUT#N),VL                                         
         CALL  ISPLINK,(SETMSG,ISRZ001),VL                                      
*                                                                               
*-------- List Panel Display ---------------------------------------            
@DISPLAY EQU   *                                                                
         MVI   @SELECT,C' '                   clear table select area           
*        CALL  ISPLINK,(TBQUERY,@RV#00),VL CURR),VL                             
*        CALL  ISPLINK,(TBSKIP,@RV#00,,,,,TBCURR),VL                            
*        CALL  ISPLINK,(VPUT,V@SELECT),VL                                       
         CALL  ISPLINK,(TBDISPL,@RV#00,PANELLST),VL                             
         CL    R15,=F'8'                                                        
         BNL   @RLSE                                                            
****                                                                            
         MVC   ZEDSMSG(20),=CL20' '                                             
         MVC   ZEDLMSG(60),=CL60' '                                             
****                                                                            
         PACK  PK_AREA(8),ZTDSELS             multi select code                 
         CVB   R11,PK_AREA                    R11 <- selection number           
@D_LOP02 EQU   *                                                                
         CL    R11,=F'1'                      if multi sel last one             
         BNH   @D_LOP_X                                                         
         CALL  ISPLINK,(CONTROL,DISPLAY,SAVE),VL   panel save                   
         BAL   R10,@D_CMD_P                   command process                   
         BCTR  R11,0                          multi sel - 1                     
*        CALL  ISPLINK,(VPUT,VPUT#N),VL                                         
*        CALL  ISPLINK,(SETMSG,ISRZ001),VL                                      
         CALL  ISPLINK,(CONTROL,DISPLAY,RESTORE),VL  panel restore              
         CALL  ISPLINK,(TBDISPL,@RV#00),VL    display                           
         B     @D_LOP02                       loop to multi select              
@D_LOP_X EQU   *                                                                
         BAL   R10,@D_CMD_P                   command process last one          
****                                                                            
*        CALL  ISPLINK,(VPUT,VPUT#N),VL                                         
         CALL  ISPLINK,(SETMSG,ISRZ001),VL                                      
         B     @DISPLAY                                                         
*-------------------------------------------------------------------            
*-------- command process ------------------------------------------            
*-------------------------------------------------------------------            
@D_CMD_P EQU   *                                                                
         STM   R00,R15,CMD#REG                                                  
         CLC   ZCMD(3),=CL3'INF'                                                
         BE    @INFORM                                                          
         CLI   @SELECT,C'B'                                                     
         BE    @BROWSE                                                          
         CLI   @SELECT,C'R'                                                     
         BE    @RESTORE                                                         
         CLI   @SELECT,C'A'                                                     
         BE    @ADDRESS                                                         
@D_CMD_X EQU   *                                                                
         LM    R00,R15,CMD#REG                                                  
         BR    R10                                                              
*-------- Information Panel Display --------------------------------            
@INFORM  EQU   *                                                                
*                                                                               
         CALL  ISPLINK,(DISPLAY,PANELINF),VL   information panel                
         B     @D_CMD_X                                                         
*-------- TTR and MBBCCHHR Message Display -------------------------            
@ADDRESS EQU   *                                                                
         MVC   ERRMSG14+6(6),O#TTR                                              
         CALL  @RV#6HC,(O#MBCHR,ERRMSG14+24,8)                                  
         MVC   ZEDSMSG(20),=CL20' '                                             
         MVC   ZEDLMSG(60),ERRMSG14                                             
         B     @D_CMD_X                                                         
*                                                                               
         CALL  ISPLINK,(DISPLAY,PANELINF),VL   information panel                
         B     @D_CMD_X                                                         
*-------- Member Browse --------------------------------------------            
@BROWSE  EQU   *                                                                
         MVC   ZEDSMSG(20),=CL20'browse ..'                                     
         CLI   O#M,C'+'                                                         
         BNE   @BR_SKP1                                                         
         BAL   R14,@STOW_A                                                      
@BR_SKP1 EQU   *                                                                
         MVI   BR#DSN,C''''                                                     
         MVC   BR#DSN+1(44),I#DSN                                               
         LA    R12,BR#DSN+1                                                     
@BR_LOP1 EQU   *                                                                
         CLI   0(R12),X'40'                                                     
         BE    @BR_LOPX                                                         
         LA    R12,1(R12)                                                       
         B     @BR_LOP1                                                         
@BR_LOPX EQU   *                                                                
         MVI   0(R12),C'('                                                      
         LA    R12,1(R12)                                                       
         MVC   0(8,R12),O#M                                                     
@BR_LOP2 EQU   *                                                                
         CLI   0(R12),C' '                                                      
         BE    @BR_LOPY                                                         
         LA    R12,1(R12)                                                       
         B     @BR_LOP2                                                         
@BR_LOPY EQU   *                                                                
         MVI   0(R12),C')'                                                      
         MVI   1(R12),C''''                                                     
         MVC   BR#VOL(6),@RV#VOL                                                
*        TPUT  BR#DSN,L'BR#DSN                                                  
         CALL  ISPLINK,(BROWSE,BR#DSN,BR#VOL),VL                                
         CLI   O#M,C'+'                                                         
         BNE   @BR_SKP2                                                         
         BAL   R14,@STOW_D                                                      
@BR_SKP2 EQU   *                                                                
*        CALL  ISPLINK,(VPUT,VPUT#N),VL                                         
*        CALL  ISPLINK,(SETMSG,ISRZ001),VL                                      
         B     @D_CMD_X                                                         
*-------- Member Restore -------------------------------------------            
@RESTORE EQU   *                                                                
         CLI   I#EXTOPT,C'Y'                                                    
         BE    @RST_OPT                                                         
         BAL   R14,@STOW_A                                                      
         MVC   MSG003+12(8),O#M                                                 
         CALL  @RV#6HC,(STOW_RC,MSG003+35,4)                                    
         MVC   ZEDSMSG(20),=CL20' '                                             
         MVC   ZEDLMSG(60),MSG003                                               
         CLC   STOW_RC,=F'0'                                                    
         BNE   @REST_X                                                          
         CALL  ISPLINK,(TBSCAN,@RV#00,NTBSCAN),VL                               
         CALL  ISPLINK,(TBDELETE,@RV#00),VL                                     
         B     @REST_X                                                          
@RST_OPT EQU   *                                                                
         CALL  ISPLINK,(DISPLAY,PANELCRE),VL   information panel                
         LTR   R15,R15                     if PF03 then                         
         BNZ   @REST_X                       goto @EXIST                        
         MVC   DA#PROC(8),=CL8'CREATE  '   dynamic allocation rout              
         MVC   DA#DSN(44),R#DSN            copy input dataset name              
         MVC   DA#VOL(6),R#VOL             copy input volume                    
         MVC   DA#DISP(3),=CL3'NEW'        set disposition                      
         MVC   DA#DSORG(2),=CL2'PS'        copy dataset organization            
         MVC   DA#SPC(3),=CL3'TRK'         copy dataset space                   
*        MVC   DA#SIZE1(3),=XL3'000010'    copy dataset space                   
         CLC   R#VOL,=CL6'      '                                               
         BE    @RST_OP1                                                         
         CALL  @RV#6TC,(R#VOL,CK#BLKSZ,SPC1)                                    
         LTR   R15,R15                                                          
         BZ    @RST_OP2                                                         
         ST    R15,RC#                                                          
         CALL  @RV#6HC,(RC#,ERRMSG12+37,4)                                      
         MVC   ZEDLMSG,ERRMSG12                                                 
         MVC   ZEDSMSG,=CL20'TRKCALC Error !'                                   
         CALL  ISPLINK,(SETMSG,ISRZ001),VL                                      
         B     @RST_OPT                                                         
@RST_OP1 EQU   *                                                                
         MVC   BR#VOL(6),@RV#VOL                                                
         CALL  @RV#6TC,(BR#VOL,CK#BLKSZ,SPC1)                                   
         LTR   R15,R15                                                          
         BZ    @RST_OP2                                                         
         ST    R15,RC#                                                          
         CALL  @RV#6HC,(RC#,ERRMSG12+37,4)                                      
         MVC   ZEDLMSG,ERRMSG12                                                 
         MVC   ZEDSMSG,=CL20'TRKCALC Error !'                                   
         CALL  ISPLINK,(SETMSG,ISRZ001),VL                                      
         B     @RST_OPT                                                         
@RST_OP2 EQU   *                                                                
*        CALL  @RV#6HC,(SPC1,ERRMSG02+30,4)                                     
*        TPUT  ERRMSG02,L'ERRMSG02                                              
*        CALL  @RV#6HC,(O#LEN,ERRMSG02+30,4)                                    
*        TPUT  ERRMSG02,L'ERRMSG02                                              
         L     R08,O#LEN                                                        
         SRDA  R08,32                                                           
         D     R08,SPC1                                                         
         LTR   R08,R08                                                          
         BZ    @RST_OP3                                                         
         LA    R09,1(R09)                                                       
@RST_OP3 EQU   *                                                                
         ST    R09,SPC2                                                         
*        CALL  @RV#6HC,(SPC2,ERRMSG02+30,4)                                     
*        TPUT  ERRMSG02,L'ERRMSG02                                              
*        B     @RST_OPT                                                         
         MVC   DA#SIZE1(3),SPC2+1                                               
*        MVC   DA#SIZE1(3),=XL3'000010'    copy dataset space                   
         MVC   DA#SIZE2(3),=XL3'000001'    copy dataset space                   
         MVC   DA#RECFM(1),CK#RFM          copy record format                   
         MVC   DA#LRECL(2),CK#LRECL        copy logical record length           
         MVC   DA#BLKSZ(2),CK#BLKSZ        copy block size                      
         LA    R01,DA#AREA                 set r01 = parm area                  
         L     R15,@RV#6DA                                                      
         BALR  R14,R15                     call dynam alloc routine             
*                                                                               
         LTR   R15,R15                         if rc = 0 then                   
         BZ    @RS_OK                           goto @DY_OK                     
         LA    R01,DA#RETC                                                      
         CALL  @RV#6HC,((R01),ERRMSG02+30,4)                                    
         MVC   ZEDLMSG,ERRMSG02                                                 
         MVC   ZEDSMSG,=CL20'Dynam alloc err !'                                 
         CALL  ISPLINK,(SETMSG,ISRZ001),VL                                      
         B     @REST_X                                                          
*                                                                               
@RS_OK   EQU   *                                                                
         MVC   RESTDCB+X'28'(8),DA#RETDD                                        
         MVC   RESTDCB+X'24'(1),CK#RFM                                          
         MVC   RESTDCB+X'3E'(2),CK#BLKSZ    copy block size                     
         MVC   RESTDCB+X'52'(2),CK#LRECL    copy logical record length          
         OPEN  (PDSFR,,RESTDCB,(OUTPUT))                                        
         POINT PDSFR,O#TTRB                     FIRST DATA ADDRESS              
@RS_LOP  EQU   *                                                                
*        TPUT  =CL80'** WRITE **',80                                            
         L     R12,BUFF_A                                                       
         READ  DECB30,SF,PDSFR,(R12),'S'                                        
         CHECK DECB30                            ( FIRST BLOCK )                
         L     R01,BUFF_L                                                       
         L     R11,DECB30+16                                                    
         SH    R01,14(R11)                                                      
         STH   R01,RESTDCB+X'3E'                copy block size                 
         WRITE DECB31,SF,RESTDCB,(R12),'S'                                      
         CHECK DECB31                            ( FIRST BLOCK )                
         B     @RS_LOP                                                          
@RS_LOPX EQU   *                                                                
         CLOSE (PDSFR,,RESTDCB)                                                 
         MVC   DA#PROC(8),=CL8'FREE    '       free                             
         MVC   DA#RETDD(8),RESTDCB+X'28'                                        
         LA    R01,DA#AREA                                                      
         L     R15,@RV#6DA                                                      
         BALR  R14,R15                                                          
*                                                                               
@REST_X  EQU   *                                                                
*        CALL  ISPLINK,(VPUT,VPUT#N),VL                                         
*        CALL  ISPLINK,(SETMSG,ISRZ001),VL                                      
         B     @D_CMD_X                                                         
*--------- Return to Entry Panel -----------------------------------            
@RLSE    EQU   *                                                                
         CALL  ISPLINK,(TBCLOSE,@RV#00),VL                                      
         L     R02,DIRT_L                                                       
         L     R12,DIRT_A                                                       
         FREEMAIN RC,LV=(R02),A=(R12)                                           
         L     R02,BUFF_L                                                       
         L     R12,BUFF_A                                                       
         FREEMAIN RC,LV=(R02),A=(R12)                                           
         MVC   DA#PROC(8),=CL8'FREE    '                                        
         MVC   DA#RETDD(8),@RV#DD                                               
         LA    R01,DA#AREA                                                      
         L     R15,@RV#6DA                                                      
         BALR  R14,R15                                                          
         DEQ   MF=(E,@DEQ)                                                      
         B     SHOW_ENT                                                         
*--------- Directory Table Over Flow -------------------------------            
@TB_OVER EQU   *                                                                
         CLOSE (PDSFD,,PDSF)                    Close Recover File              
         L     R02,DIRT_L                                                       
         L     R12,DIRT_A                                                       
         FREEMAIN RC,LV=(R02),A=(R12)           FreeMain Direct Table           
         L     R02,BUFF_L                                                       
         L     R12,BUFF_A                                                       
         FREEMAIN RC,LV=(R02),A=(R12)           FreeMain Read Buffer            
         MVC   DA#PROC(8),=CL8'FREE    '                                        
         MVC   DA#RETDD(8),@RV#DD                                               
         LA    R01,DA#AREA                                                      
         L     R15,@RV#6DA                                                      
         BALR  R14,R15                          Recover File De-Alloc           
         DEQ   MF=(E,@DEQ)                      DEQ                             
         LA    R02,DIRT_A                                                       
         CALL  @RV#6HC,((R02),ERRMSG03+29,4)                                    
         LA    R02,DIRT_L                                                       
         CALL  @RV#6HC,((R02),ERRMSG03+40,4)                                    
         LA    R02,DIRT_P                                                       
         CALL  @RV#6HC,((R02),ERRMSG03+51,4)                                    
         MVC   ZEDLMSG,ERRMSG03                                                 
         MVC   ZEDSMSG,=CL20'Table OverFlow'                                    
         CALL  ISPLINK,(SETMSG,ISRZ001),VL                                      
         B     SHOW_ENT                         Return Entry Panel              
*--------- Recovery Dataset ENQ Check ------------------------------            
ENQ_ER0  EQU   *                                                                
*        ST    R15,WK#F                         Set  ENQ Code                   
         CALL  @RV#6HC,((15),ERRMSG16+47,4)                                     
         MVC   ZEDLMSG,ERRMSG16                                                 
         MVC   ZEDSMSG,=CL20'Recover Faile'                                     
         CALL  ISPLINK,(SETMSG,ISRZ001),VL                                      
         B     SHOW_ENT                         Return Entry Panel              
*-------- Read Buffer Getmain False --------------------------------            
GETM_ER2 EQU   *                                 GETMAIN ERROR                  
         ST    R15,WK#F                         Set  GETMAIN Code               
         CALL  @RV#6HC,(WK#F,ERRMSG16+36,4)                                     
         LA    R02,DIRT_L                       Set GETMAIN Length              
         CALL  @RV#6HC,((R02),ERRMSG16+52,4)                                    
         L     R02,DIRT_L                                                       
         L     R12,DIRT_A                                                       
         FREEMAIN RC,LV=(R02),A=(R12)                                           
         CLOSE (PDSFD,,PDSF)                    Close Input File                
         MVC   DA#PROC(8),=CL8'FREE    '                                        
         MVC   DA#RETDD(8),@RV#DD                                               
         LA    R01,DA#AREA                                                      
         L     R15,@RV#6DA                                                      
         BALR  R14,R15                                                          
         DEQ   MF=(E,@DEQ)                      DEQ                             
         MVC   ZEDLMSG,ERRMSG16                                                 
         MVC   ZEDSMSG,=CL20'Getmain Faile.'                                    
         CALL  ISPLINK,(SETMSG,ISRZ001),VL                                      
         B     SHOW_ENT                         Return Entry Panel              
*--------- Directory Table Space GETMAIN faile ---------------------            
GETM_ER1 EQU   *                                                                
         ST    R15,WK#F                         Set  GETMAIN Code               
         CALL  @RV#6HC,(WK#F,ERRMSG15+36,4)                                     
         LA    R02,DIRT_L                       Set GETMAIN Length              
         CALL  @RV#6HC,((R02),ERRMSG15+52,4)                                    
         CLOSE (PDSFD,,PDSF)                    Close Input File                
         MVC   DA#PROC(8),=CL8'FREE    '                                        
         MVC   DA#RETDD(8),@RV#DD                                               
         LA    R01,DA#AREA                                                      
         L     R15,@RV#6DA                                                      
         BALR  R14,R15                                                          
         DEQ   MF=(E,@DEQ)                      DEQ                             
         MVC   ZEDLMSG,ERRMSG15                                                 
         MVC   ZEDSMSG,=CL20'Table to Large'                                    
         CALL  ISPLINK,(SETMSG,ISRZ001),VL                                      
         B     SHOW_ENT                         Return Entry Panel              
*--------- Control Table Space  Getmain Faile ----------------------            
GETM_ER0 EQU   *                                                                
         ST    R15,WK#F                                                         
         CALL  @RV#6HC,(WK#F,ERRMSG13+35,4)                                     
         TPUT  ERRMSG13,L'ERRMSG13                                              
         B     @TERM8                                                           
*-------------------------------------------------------------------            
@TERM8   EQU   *                                                                
         L     R13,SAVEAREA+4                                                   
         RETURN (14,12),RC=8                                                    
*--------- Terminate Nommary Process -------------------------------            
@QUIT    EQU   *                                                                
         L     R02,CPY_L                                                        
         L     R12,CPY_A                                                        
         FREEMAIN RC,LV=(R02),A=(R12)     Copy Section Free Main                
         L     R13,SAVEAREA+4                                                   
         RETURN (14,12),RC=0                                                    
*--------- Member Stow ( Add New Member ) --------------------------            
@STOW_A  EQU   *                                                                
         MVC   S_TTR(3),O#TTRB                                                  
         MVC   S_MEMBER(8),O#M                                                  
         OPEN  (PDSFS,(OUTPUT))                                                 
         STOW  PDSFS,ST#LIST,A                                                  
         ST    R15,STOW_RC                                                      
         CLOSE (PDSFS)                                                          
         BR    R14                                                              
*--------- Member Stow ( Remove Work Member ) ----------------------            
@STOW_D  EQU   *                                                                
*        MVC   S_TTR(3),O#TTRB                                                  
*        MVC   S_MEMBER(8),O#M                                                  
         OPEN  (PDSFS,(OUTPUT))                                                 
         STOW  PDSFS,ST#LIST,D                                                  
         CLOSE (PDSFS)                                                          
         BR    R14                                                              
*-------------------------------------------------------------------            
*-------- Define ISPF Variable -------------------------------------            
*-------------------------------------------------------------------            
ISPFVDEF EQU   *                                                                
         STM   R00,R15,REGS                                                     
* --- Panel I/O ---                                                             
         CALL  ISPLINK,(VDEFINE,@I#DSN,I#DSN,CHAR,LI#DSN),VL                    
         CALL  ISPLINK,(VDEFINE,@I#VOL,I#VOL,CHAR,LI#VOL),VL                    
         CALL  ISPLINK,(VDEFINE,@R#DSN,R#DSN,CHAR,LR#DSN),VL                    
         CALL  ISPLINK,(VDEFINE,@R#VOL,R#VOL,CHAR,LR#VOL),VL                    
         CALL  ISPLINK,(VDEFINE,@I#EXTOP,I#EXTOPT,CHAR,LI#EXTOP),VL             
         CALL  ISPLINK,(VDEFINE,@I#EXTO2,I#EXTOP2,CHAR,LI#EXTO2),VL             
         CALL  ISPLINK,(VDEFINE,@I#DISP,I#DISP,CHAR,LI#DISP),VL                 
         CALL  ISPLINK,(VDEFINE,@I#DSPAC,I#DSPACE,FIXED,LI#DSPAC),VL            
         CALL  ISPLINK,(VDEFINE,@I#SRHST,I#SRHSTR,CHAR,LI#SRHST),VL             
* --- Panel I/O ( Table Row Selection Area ) ---                                
         CALL  ISPLINK,(VDEFINE,@@SELECT,@SELECT,CHAR,L@SELECT),VL              
* --- Command Line ---                                                          
         CALL  ISPLINK,(VDEFINE,@ZCMD,ZCMD,CHAR,LZCMD),VL                       
* --- Version number ---                                                        
         CALL  ISPLINK,(VDEFINE,@REV,REV,CHAR,LREV),VL                          
* --- Panel I/O ( Information Panels ) ---                                      
         CALL  ISPLINK,(VDEFINE,@O#DEVT,O#DEVT,CHAR,LO#DEVT),VL                 
         CALL  ISPLINK,(VDEFINE,@O#BLKSZ,O#BLKSZ,CHAR,LO#BLKSZ),VL              
         CALL  ISPLINK,(VDEFINE,@O#LRECL,O#LRECL,CHAR,LO#LRECL),VL              
         CALL  ISPLINK,(VDEFINE,@O#RECFM,O#RECFM,CHAR,LO#RECFM),VL              
         CALL  ISPLINK,(VDEFINE,@O#EXT,O#EXT,CHAR,LO#EXT),VL                    
         CALL  ISPLINK,(VDEFINE,@O#ALC,O#ALC,CHAR,LO#ALC),VL                    
         CALL  ISPLINK,(VDEFINE,@O#USE,O#USE,CHAR,LO#USE),VL                    
         CALL  ISPLINK,(VDEFINE,@O#CRE,O#CRE,CHAR,LO#CRE),VL                    
         CALL  ISPLINK,(VDEFINE,@O#EXP,O#EXP,CHAR,LO#EXP),VL                    
         CALL  ISPLINK,(VDEFINE,@O#SYSCD,O#SYSCD,CHAR,LO#SYSCD),VL              
         CALL  ISPLINK,(VDEFINE,@O#ASP,O#ASP,CHAR,LO#ASP),VL                    
         CALL  ISPLINK,(VDEFINE,@O#ADP,O#ADP,CHAR,LO#ADP),VL                    
         CALL  ISPLINK,(VDEFINE,@O#AUP,O#AUP,CHAR,LO#AUP),VL                    
         CALL  ISPLINK,(VDEFINE,@O#AEP,O#AEP,CHAR,LO#AEP),VL                    
         CALL  ISPLINK,(VDEFINE,@O#ASP2,O#ASP2,CHAR,LO#ASP2),VL                 
         CALL  ISPLINK,(VDEFINE,@O#ADP2,O#ADP2,CHAR,LO#ADP2),VL                 
         CALL  ISPLINK,(VDEFINE,@O#AUP2,O#AUP2,CHAR,LO#AUP2),VL                 
         CALL  ISPLINK,(VDEFINE,@O#AEP2,O#AEP2,CHAR,LO#AEP2),VL                 
         CALL  ISPLINK,(VDEFINE,@O#DBLK,O#DBLK,FIXED,LO#DBLK),VL                
         CALL  ISPLINK,(VDEFINE,@O#H1,O#H1,CHAR,LO#H1),VL                       
         CALL  ISPLINK,(VDEFINE,@O#H2,O#H2,CHAR,LO#H2),VL                       
         CALL  ISPLINK,(VDEFINE,@O#H3,O#H3,CHAR,LO#H3),VL                       
         CALL  ISPLINK,(VDEFINE,@O#H4,O#H4,CHAR,LO#H4),VL                       
         CALL  ISPLINK,(VDEFINE,@O#H5,O#H5,CHAR,LO#H5),VL                       
         CALL  ISPLINK,(VDEFINE,@O#H6,O#H6,CHAR,LO#H6),VL                       
         CALL  ISPLINK,(VDEFINE,@O#H7,O#H7,CHAR,LO#H7),VL                       
         CALL  ISPLINK,(VDEFINE,@O#H8,O#H8,CHAR,LO#H8),VL                       
         CALL  ISPLINK,(VDEFINE,@O#H9,O#H9,CHAR,LO#H9),VL                       
         CALL  ISPLINK,(VDEFINE,@O#H10,O#H10,CHAR,LO#H10),VL                    
         CALL  ISPLINK,(VDEFINE,@O#H11,O#H11,CHAR,LO#H11),VL                    
         CALL  ISPLINK,(VDEFINE,@O#H12,O#H12,CHAR,LO#H12),VL                    
         CALL  ISPLINK,(VDEFINE,@O#H13,O#H13,CHAR,LO#H13),VL                    
         CALL  ISPLINK,(VDEFINE,@O#H14,O#H14,CHAR,LO#H14),VL                    
         CALL  ISPLINK,(VDEFINE,@O#H15,O#H15,CHAR,LO#H15),VL                    
         CALL  ISPLINK,(VDEFINE,@O#H16,O#H16,CHAR,LO#H16),VL                    
         CALL  ISPLINK,(VDEFINE,@O#L1,O#L1,CHAR,LO#L1),VL                       
         CALL  ISPLINK,(VDEFINE,@O#L2,O#L2,CHAR,LO#L2),VL                       
         CALL  ISPLINK,(VDEFINE,@O#L3,O#L3,CHAR,LO#L3),VL                       
         CALL  ISPLINK,(VDEFINE,@O#L4,O#L4,CHAR,LO#L4),VL                       
         CALL  ISPLINK,(VDEFINE,@O#L5,O#L5,CHAR,LO#L5),VL                       
         CALL  ISPLINK,(VDEFINE,@O#L6,O#L6,CHAR,LO#L6),VL                       
         CALL  ISPLINK,(VDEFINE,@O#L7,O#L7,CHAR,LO#L7),VL                       
         CALL  ISPLINK,(VDEFINE,@O#L8,O#L8,CHAR,LO#L8),VL                       
         CALL  ISPLINK,(VDEFINE,@O#L9,O#L9,CHAR,LO#L9),VL                       
         CALL  ISPLINK,(VDEFINE,@O#L10,O#L10,CHAR,LO#L10),VL                    
         CALL  ISPLINK,(VDEFINE,@O#L11,O#L11,CHAR,LO#L11),VL                    
         CALL  ISPLINK,(VDEFINE,@O#L12,O#L12,CHAR,LO#L12),VL                    
         CALL  ISPLINK,(VDEFINE,@O#L13,O#L13,CHAR,LO#L13),VL                    
         CALL  ISPLINK,(VDEFINE,@O#L14,O#L14,CHAR,LO#L14),VL                    
         CALL  ISPLINK,(VDEFINE,@O#L15,O#L15,CHAR,LO#L15),VL                    
         CALL  ISPLINK,(VDEFINE,@O#L16,O#L16,CHAR,LO#L16),VL                    
         CALL  ISPLINK,(VDEFINE,@O#MEM,O#MEM,CHAR,LO#MEM),VL                    
* --- Message Area ---                                                          
         CALL  ISPLINK,(VDEFINE,@ZEDLMS,ZEDLMSG,CHAR,LZEDLMSG),VL               
         CALL  ISPLINK,(VDEFINE,@ZEDSMS,ZEDSMSG,CHAR,LZEDSMSG),VL               
* --- ISPF Table Item ---                                                       
         CALL  ISPLINK,(VDEFINE,@O#M,O#M,CHAR,LO#M),VL                          
         CALL  ISPLINK,(VDEFINE,@O#D,O#D,CHAR,LO#D),VL                          
         CALL  ISPLINK,(VDEFINE,@O#TTR,O#TTR,CHAR,LO#TTR),VL                    
         CALL  ISPLINK,(VDEFINE,@O#TTRB,O#TTRB,CHAR,LO#TTRB),VL                 
         CALL  ISPLINK,(VDEFINE,@O#LEN,O#LEN,FIXED,LO#LEN),VL                   
         CALL  ISPLINK,(VDEFINE,@O#MBCHR,O#MBCHR,CHAR,LO#MBCHR),VL              
         CALL  ISPLINK,(VDEFINE,@ZTDSEL,ZTDSELS,CHAR,LZTDSELS),VL               
         CALL  ISPLINK,(VDEFINE,@TBCURR,TBCURR,CHAR,LTBCURR),VL                 
         CALL  ISPLINK,(VDEFINE,@REVC,REVC,CHAR,LREVC),VL                       
         CALL  ISPLINK,(VDEFINE,@REVD,REVD,CHAR,LREVD),VL                       
         LM    R00,R15,REGS                                                     
         BR    R14                                                              
*-------------------------------------------------------------------            
*-------- Search String --------------------------------------------            
*-------------------------------------------------------------------            
@SRCHSTR EQU   *                                                                
*                                                                               
         L     R15,@RV#LSTR                      If No-string Search            
         LTR   R15,R15                             Goto @SRCH_NG                
         BZ    @SRCH_BP                                                         
*                                                                               
         L     R11,BUFF_A                        R01 <- Read Buffer             
         L     R12,R_LEN                         R02 <- Read Length             
* DEBUG *                                                                       
*        ST    R11,WK#F                                                         
*        CALL  @RV#6HC,(WK#F,ERRMSG10+9,4)                                      
*        ST    R12,WK#F                                                         
*        CALL  @RV#6HC,(WK#F,ERRMSG10+19,4)                                     
*        TPUT  ERRMSG10,L'ERRMSG10                                              
* DEBUG *                                                                       
         LTR   R12,R12                                                          
         BZ    @SRCH_BP                                                         
*        CLR   R12,R15                                                          
*        BNH   @SRCH_BP                                                         
         S     R12,@RV#LSTR                      L'Read - L'Srch Str            
*        LA    R12,1(R12)                        + 1                            
         LA    R11,0(R11,R12)                    Chk Pos <- Buf + L'Chk         
* DEBUG *                                                                       
*        ST    R11,WK#F                                                         
*        CALL  @RV#6HC,(WK#F,ERRMSG10+9,4)                                      
*        ST    R12,WK#F                                                         
*        CALL  @RV#6HC,(WK#F,ERRMSG10+19,4)                                     
*        TPUT  ERRMSG10,L'ERRMSG10                                              
* DEBUG *                                                                       
@SRCH_LP EQU   *                                                                
* DEBUG *                                                                       
*        L     R15,@RV#LSTR                                                     
*        STC   R15,*+5                                                          
*        MVC   ERRMSG10+30(0),0(R11)                                            
*        ST    R11,WK#F                                                         
*        CALL  @RV#6HC,(WK#F,ERRMSG10+9,4)                                      
*        ST    R12,WK#F                                                         
*        CALL  @RV#6HC,(WK#F,ERRMSG10+19,4)                                     
*        L     R15,@RV#LSTR                                                     
*        STC   R15,*+5                                                          
*        MVC   ERRMSG10+40(0),@RV#SSTR                                          
*        TPUT  ERRMSG10,L'ERRMSG10                                              
* DEBUG *                                                                       
         L     R15,@RV#LSTR                                                     
         BCTR  R15,0                                                            
***      EX    R15,EX#CLC                                                       
         STC   R15,*+5                                                          
         CLC   0(0,R11),@RV#SSTR                                                
         BE    @SRCH_OK                                                         
         BCTR  R11,0                                                            
         BCT   R12,@SRCH_LP                                                     
         B     @SRCH_NG                                                         
@SRCH_BP EQU   *                                                                
         OI    FLAG,X'02'                                                       
         BR    R10                                                              
@SRCH_OK EQU   *                                                                
         OI    FLAG,X'02'                                                       
         BR    R10                                                              
@SRCH_NG EQU   *                                                                
         BR    R10                                                              
*                                                                               
***CLC   CLC   0(0,R11),@RV#SSTR                                                
*-------------------------------------------------------------------            
*-------- convert mbcchhr to ttr -----------------------------------            
*-------------------------------------------------------------------            
@CNVTTR  EQU   *                                                                
         STM   R03,R15,REGS                                                     
         L     R12,CVTPTR                                                       
         USING CVTMAP,R12                                                       
         L     R15,CVTPRLTV                                                     
         DROP  R12                                                              
         BALR  R14,R15                                                          
         LM    R03,R15,REGS                                                     
         BR    R14                                                              
@CNVCHR  EQU   *                                                                
         STM   R03,R15,REGS                                                     
         L     R12,CVTPTR                                                       
         USING CVTMAP,R12                                                       
         L     R15,CVTPCNVT                                                     
         DROP  R12                                                              
         BALR  R14,R15                                                          
         LM    R03,R15,REGS                                                     
         BR    R14                                                              
*-------------------------------------------------------------------            
*-------- i/o error routine ( ps ) ---------------------------------            
*-------------------------------------------------------------------            
IOERR_S  EQU   *                                                                
         SYNADAF ACSMETH=BSAM                  I/O ERROR                        
         STM   R01,R15,REGS                                                     
         LA    R01,91(R01)                                                      
*        B     @IOERR                                                           
         MVC   ERRMSG04+23(15),0(R01)                                           
         CALL  @RV#6HC,(W_TTR,ERRMSG04+16,3)                                    
         TPUT  ERRMSG04,L'ERRMSG04                                              
         B     @IOERR                                                           
*        LR    R12,R01                                                          
*        B     @IOERR                                                           
*-------------------------------------------------------------------            
*-------- i/o error routine ( po ) ---------------------------------            
*-------------------------------------------------------------------            
IOERR_P  EQU   *                                                                
         SYNADAF ACSMETH=BPAM                                                   
         STM   R01,R15,REGS                                                     
         LA    R01,91(R01)                                                      
*        B     @IOERR                                                           
         MVC   ERRMSG04+23(15),0(R01)                                           
         CALL  @RV#6HC,(W_TTR,ERRMSG04+16,3)                                    
         TPUT  ERRMSG04,L'ERRMSG04                                              
         B     @IOERR                                                           
IOERR_W  EQU   *                                                                
         SYNADAF ACSMETH=BPAM                                                   
         STM   R01,R15,REGS                                                     
         LA    R01,91(R01)                                                      
*        B     @IOERR                                                           
         MVC   ERRMSG04+23(15),0(R01)                                           
         CALL  @RV#6HC,(W_TTR,ERRMSG04+16,3)                                    
         TPUT  ERRMSG04,L'ERRMSG04                                              
         B     @IOERR                                                           
IOERR_WS EQU   *                                                                
         SYNADAF ACSMETH=BSAM                                                   
         STM   R01,R15,REGS                                                     
         LA    R01,91(R01)                                                      
         MVC   ERRMSG04+23(15),0(R01)                                           
         CALL  @RV#6HC,(W_TTR,ERRMSG04+16,3)                                    
         TPUT  ERRMSG04,L'ERRMSG04                                              
         B     @IOERR                                                           
@IOERR   EQU   *                                                                
         LM    R01,R15,REGS                                                     
         SYNADRLS                                                               
*        LTR   R00,R00                                                          
*        BZ    @IOERRX                                                          
*        TPUT  =CL20'SYNADRLS ERR',20                                           
         B     @R_EXIT                                                          
@IOERRX  EQU   *                                                                
         TPUT  =CL20'RETURN      ',20                                           
         LM    R01,R15,REGS                                                     
         PRINT GEN                                                              
         RETURN                                                                 
         PRINT NOGEN                                                            
*        B     @M_NEXT                                                          
*-------------------------------------------------------------------            
*-------- Dataset Configratin Block --------------------------------            
*-------------------------------------------------------------------            
RESTDCB  DCB   DSORG=PS,MACRF=W,DDNAME=@@@@,                           *        
               SYNAD=IOERR_WS,EODAD=@RS_LOPX                                    
PDSFR    DCB   DSORG=PO,MACRF=(R),DDNAME=@@@@,                         *        
               SYNAD=IOERR_WS,EODAD=@RS_LOPX                                    
PDSFD    DCB   DSORG=PS,MACRF=(RP),DDNAME=@@@@,BLKSIZE=256,            *        
               SYNAD=IOERR_S,EODAD=@D_EXIT,RECFM=F                              
         ENTRY PDSF                                                             
PDSF     DCB   DSORG=PO,MACRF=(R),DDNAME=@@@@,                         *        
               SYNAD=IOERR_P,EODAD=@M_NEXT,EXLST=EXLST                          
EXLST    DC    X'87',AL3(POSJFCB)                                               
PDSFS    DCB   DSORG=PO,MACRF=W,DDNAME=@@@@,                           *        
               SYNAD=IOERR_W                                                    
*                                                                               
         DS    0F                                                               
* --- SAVE AREA ---                                                             
SAVEAREA DS    18F                               SAVEAREA                       
* --- Work Area ---                                                             
WK#F     DS    F                                                                
* --- Register Save ( work ) area ---                                           
REGS     DS    18F                               WORK SAVEAREA                  
CMD#REG  DS    18F                               WORK SAVEAREA                  
FLAG     DS    XL1                                                              
*                                                                               
*              '........'                                                       
*                      + : Add List .                                           
*                     +  : String Search .                                      
* --- V con ---                                                                 
@RV#6DA  DC    V(@RV#6DA)                                                       
*RV#6DC  DC    V(@RV#6DC)                                                       
         DS    0D                                                               
* --- Panel RC Packed Area ---                                                  
PK_AREA  DC    PL8'0'                                                           
UPK_AREA DC    CL16' '                                                          
         DS    0F                                                               
* --- Condition Code ---                                                        
RC#      DS    F                                                                
SPC1     DS    F                                                                
SPC2     DS    F                                                                
* --- ENQ And DEQ List Function ---                                             
QNAME    DC    CL8'@REVIVE'                                                     
RNAME    DS    CL44                                                             
@ENQ     ENQ   (QNAME,RNAME,E,44,SYSTEMS),RET=USE,MF=L                          
@DEQ     DEQ   (QNAME,RNAME,44,SYSTEMS),MF=L                                    
* --- ISPF Control Name ---                                                     
CONTROL  DC    CL8'CONTROL '                                                    
DISPLAY  DC    CL8'DISPLAY '                                                    
SAVE     DC    CL8'SAVE    '                                                    
RESTORE  DC    CL8'RESTORE '                                                    
TBDELETE DC    CL8'TBDELETE'                                                    
TBSCAN   DC    CL8'TBSCAN  '                                                    
LOCK     DC    CL8'LOCK    '                                                    
SETMSG   DC    CL8'SETMSG  '                                                    
ISRZ001  DC    CL8'ISRZ001 '                                                    
VDEFINE  DC    CL8'VDEFINE '                     VDEFINE COMMAND                
TBCREATE DC    CL8'TBCREATE'                     TBCREATE COMMAND               
TBTOP    DC    CL8'TBTOP   '                     TBTOP COMMAND                  
TBSKIP   DC    CL8'TBSKIP  '                     TBTOP COMMAND                  
TBQUERY  DC    CL8'TBQUERY '                     TBTOP COMMAND                  
TBDISPL  DC    CL8'TBDISPL '                     TBDISPL COMMAND                
TBCLOSE  DC    CL8'TBCLOSE '                     TBCLOSE COMMAND                
TBADD    DC    CL8'TBADD   '                     TBADD COMMAND                  
VPUT     DC    CL8'VPUT    '                     TBADD COMMAND                  
VGET     DC    CL8'VGET    '                     TBADD COMMAND                  
BROWSE   DC    CL8'BROWSE  '                     TBCREATE COMMAND               
PANELLST DC    CL8'@RV#2LST'                     ISPF PANEL ( LIST )            
PANELENT DC    CL8'@RV#2ENT'                     ISPF PANEL ( ENTRY )           
PANELINF DC    CL8'@RV#INF '                     ISPF PANEL ( INFO )            
PANELCRE DC    CL8'@RV#CRE '                     ISPF PANEL ( INFO )            
@RV#00   DC    CL8'@RV#00  '                     ISPF TABLE NAME                
KEYN     DC    CL8'O#M     '                     TABLE KEY NAME                 
NTBSCAN  DC    CL8'( O#M ) '                     TABLE KEY NAME                 
* ispf table                                                                    
* O#M    : Restore Member name                                                  
* O#D    : Data Area                                                            
* O#TTR  : TTR Area                                                             
* O#TTRB : TTR Area ( binary )                                                  
* O#LEN  : Member Block#                                                        
NAMEL    DC    CL40'(O#D O#TTR O#TTRB O#LEN O#MBCHR)' LIST ( TBCREATE )         
NAMELIST DC    CL40'(O#M O#D O#TTR O#TTRB O#LEN O#MBCHR)'  ( TBADD )            
VPUT#N   DC    CL25'( ZEDLMSG ZEDSMSG )'                                        
V@SELECT DC    CL25'( @SELECT I#DSN )'                                          
NOWRITE  DC    CL8'NOWRITE '                     TBCREATE NOWRITE               
CHAR     DC    CL8'CHAR    '                     VDEFINE CHAR                   
FIXED    DC    CL8'FIXED   '                     VDEFINE CHAR                   
* --- ispf Variable Name ---                                                    
@ZEDLMS  DC    CL8'ZEDLMSG '                                                    
@ZEDSMS  DC    CL8'ZEDSMSG '                                                    
@ZTDSEL  DC    CL8'ZTDSELS '                                                    
@TBCURR  DC    CL8'TBCURR  '                                                    
@ZCMD    DC    CL8'ZCMD    '                                                    
@REV     DC    CL8'REV     '                                                    
@O#M     DC    CL8'O#M     '                     Table ( Member Name )          
@O#D     DC    CL8'O#D     '                     Table ( Data )                 
@O#TTR   DC    CL8'O#TTR   '                     Table ( TTR )                  
@O#TTRB  DC    CL8'O#TTRB  '                     Table ( TTR <Bin> )            
@O#LEN   DC    CL8'O#LEN   '                     Table ( TTR <Bin> )            
@O#MBCHR DC    CL8'O#MBCHR '                     Table ( TTR <Bin> )            
@I#DSN   DC    CL8'I#DSN   '                     Input Dataset Name             
@I#VOL   DC    CL8'I#VOL   '                     Input Volume Serial            
@R#DSN   DC    CL8'R#DSN   '                     Input Dataset Name             
@R#VOL   DC    CL8'R#VOL   '                     Input Volume Serial            
@I#EXTOP DC    CL8'I#EXTOPT'                     Input Volume Serial            
@I#EXTO2 DC    CL8'I#EXTOP2'                     Input Volume Serial            
@I#DISP  DC    CL8'I#DISP  '                     Input Volume Serial            
@I#DSPAC DC    CL8'I#DSPACE'                     Input Volume Serial            
@I#SRHST DC    CL8'I#SRHSTR'                     Input Volume Serial            
@O#DEVT  DC    CL8'O#DEVT  '                     Device Type                    
@O#BLKSZ DC    CL8'O#BLKSZ '                     Block Size                     
@O#LRECL DC    CL8'O#LRECL '                     Record Length                  
@O#RECFM DC    CL8'O#RECFM '                     Record Format                  
@O#EXT   DC    CL8'O#EXT   '                     Extencson                      
@O#ALC   DC    CL8'O#ALC   '                     Allocation Size                
@O#USE   DC    CL8'O#USE   '                     InUse Size                     
@O#CRE   DC    CL8'O#CRE   '                     Creation Date                  
@O#EXP   DC    CL8'O#EXP   '                     Expiration Date                
@O#SYSCD DC    CL8'O#SYSCD '                     System Code                    
@O#ASP   DC    CL8'O#ASP   '                     Start Address                  
@O#ADP   DC    CL8'O#ADP   '                     Data Address                   
@O#AUP   DC    CL8'O#AUP   '                     Use Address                    
@O#AEP   DC    CL8'O#AEP   '                     End Address                    
@O#ASP2  DC    CL8'O#ASP2  '                     Start Address ( TTR )          
@O#ADP2  DC    CL8'O#ADP2  '                     Data Address ( TTR )           
@O#AUP2  DC    CL8'O#AUP2  '                     Use Address ( TTR )            
@O#AEP2  DC    CL8'O#AEP2  '                     End Address ( TTR )            
@O#DBLK  DC    CL8'O#DBLK  '                     Directory Blocks               
@O#H1    DC    CL8'O#H1    '                     extent high c-h                
@O#H2    DC    CL8'O#H2    '                     extent high c-h                
@O#H3    DC    CL8'O#H3    '                     extent high c-h                
@O#H4    DC    CL8'O#H4    '                     extent high c-h                
@O#H5    DC    CL8'O#H5    '                     extent high c-h                
@O#H6    DC    CL8'O#H6    '                     extent high c-h                
@O#H7    DC    CL8'O#H7    '                     extent high c-h                
@O#H8    DC    CL8'O#H8    '                     extent high c-h                
@O#H9    DC    CL8'O#H9    '                     extent high c-h                
@O#H10   DC    CL8'O#H10   '                     extent high c-h                
@O#H11   DC    CL8'O#H11   '                     extent high c-h                
@O#H12   DC    CL8'O#H12   '                     extent high c-h                
@O#H13   DC    CL8'O#H13   '                     extent high c-h                
@O#H14   DC    CL8'O#H14   '                     extent high c-h                
@O#H15   DC    CL8'O#H15   '                     extent high c-h                
@O#H16   DC    CL8'O#H16   '                     extent high c-h                
@O#L1    DC    CL8'O#L1    '                     extent high c-h                
@O#L2    DC    CL8'O#L2    '                     extent high c-h                
@O#L3    DC    CL8'O#L3    '                     extent high c-h                
@O#L4    DC    CL8'O#L4    '                     extent high c-h                
@O#L5    DC    CL8'O#L5    '                     extent high c-h                
@O#L6    DC    CL8'O#L6    '                     extent high c-h                
@O#L7    DC    CL8'O#L7    '                     extent high c-h                
@O#L8    DC    CL8'O#L8    '                     extent high c-h                
@O#L9    DC    CL8'O#L9    '                     extent high c-h                
@O#L10   DC    CL8'O#L10   '                     extent high c-h                
@O#L11   DC    CL8'O#L11   '                     extent high c-h                
@O#L12   DC    CL8'O#L12   '                     extent high c-h                
@O#L13   DC    CL8'O#L13   '                     extent high c-h                
@O#L14   DC    CL8'O#L14   '                     extent high c-h                
@O#L15   DC    CL8'O#L15   '                     extent high c-h                
@O#L16   DC    CL8'O#L16   '                     extent high c-h                
@O#MEM   DC    CL8'O#MEM   '                     extent high c-h                
@@SELECT DC    CL8'@SELECT '                     Selection Area                 
@REVC    DC    CL8'REVC    '                     Selection Area                 
@REVD    DC    CL8'REVD    '                     Selection Area                 
* --- ispf Variable Length ---                                                  
LI#DSN   DC    F'44'                             ITEM LENGTH                    
LI#VOL   DC    F'6'                              ITEM LENGTH                    
LR#DSN   DC    F'44'                             ITEM LENGTH                    
LR#VOL   DC    F'6'                              ITEM LENGTH                    
LI#EXTOP DC    F'1'                              ITEM LENGTH                    
LI#EXTO2 DC    F'1'                              ITEM LENGTH                    
LI#DISP  DC    F'1'                              ITEM LENGTH                    
LI#DSPAC DC    F'4'                              ITEM LENGTH                    
LI#SRHST DC    F'50'                             ITEM LENGTH                    
LO#M     DC    F'8'                              ITEM LENGTH                    
LO#D     DC    F'60'                             ITEM LENGTH                    
LO#TTR   DC    F'6'                              ITEM LENGTH                    
LO#TTRB  DC    F'4'                              ITEM LENGTH                    
LO#LEN   DC    F'4'                                                             
LO#MBCHR DC    F'8'                                                             
LZEDLMSG DC    F'60'                                                            
LZEDSMSG DC    F'20'                                                            
LZTDSELS DC    F'4'                                                             
LTBCURR  DC    F'8'                                                             
LZCMD    DC    F'80'                                                            
LREV     DC    F'6'                                                             
L@SELECT DC    F'1'                                                             
LO#DEVT  DC    F'4'                              Device Type                    
LO#BLKSZ DC    F'5'                              Block Size                     
LO#LRECL DC    F'5'                              Record Length                  
LO#RECFM DC    F'3'                              Record Format                  
LO#EXT   DC    F'2'                              Extencson                      
LO#ALC   DC    F'5'                              Allocation Size                
LO#USE   DC    F'5'                              InUse Size                     
LO#CRE   DC    F'6'                              Creation Date                  
LO#EXP   DC    F'6'                              Expiration Date                
LO#SYSCD DC    F'13'                             System Code                    
LO#ASP   DC    F'17'                             Start Address                  
LO#ADP   DC    F'17'                             Data Address                   
LO#AUP   DC    F'17'                             Use Address                    
LO#AEP   DC    F'17'                             End Address                    
LO#ASP2  DC    F'6'                              Start Address ( TTR )          
LO#ADP2  DC    F'6'                              Data Address ( TTR )           
LO#AUP2  DC    F'6'                              Use Address ( TTR )            
LO#AEP2  DC    F'6'                              End Address ( TTR )            
LO#DBLK  DC    F'4'                              Directory Blocks               
LO#H1    DC    F'8'                              extent high c-h                
LO#H2    DC    F'8'                              extent high c-h                
LO#H3    DC    F'8'                              extent high c-h                
LO#H4    DC    F'8'                              extent high c-h                
LO#H5    DC    F'8'                              extent high c-h                
LO#H6    DC    F'8'                              extent high c-h                
LO#H7    DC    F'8'                              extent high c-h                
LO#H8    DC    F'8'                              extent high c-h                
LO#H9    DC    F'8'                              extent high c-h                
LO#H10   DC    F'8'                              extent high c-h                
LO#H11   DC    F'8'                              extent high c-h                
LO#H12   DC    F'8'                              extent high c-h                
LO#H13   DC    F'8'                              extent high c-h                
LO#H14   DC    F'8'                              extent high c-h                
LO#H15   DC    F'8'                              extent high c-h                
LO#H16   DC    F'8'                              extent high c-h                
LO#L1    DC    F'8'                              extent high c-h                
LO#L2    DC    F'8'                              extent high c-h                
LO#L3    DC    F'8'                              extent high c-h                
LO#L4    DC    F'8'                              extent high c-h                
LO#L5    DC    F'8'                              extent high c-h                
LO#L6    DC    F'8'                              extent high c-h                
LO#L7    DC    F'8'                              extent high c-h                
LO#L8    DC    F'8'                              extent high c-h                
LO#L9    DC    F'8'                              extent high c-h                
LO#L10   DC    F'8'                              extent high c-h                
LO#L11   DC    F'8'                              extent high c-h                
LO#L12   DC    F'8'                              extent high c-h                
LO#L13   DC    F'8'                              extent high c-h                
LO#L14   DC    F'8'                              extent high c-h                
LO#L15   DC    F'8'                              extent high c-h                
LO#L16   DC    F'8'                              extent high c-h                
LO#MEM   DC    F'5'                              extent high c-h                
LREVC    DC    F'14'                             extent high c-h                
LREVD    DC    F'14'                             extent high c-h                
* --- ispf Variable ---                                                         
ZEDSMSG  DC    CL20' '                           short error message            
ZEDLMSG  DS    CL60                              long error message             
ZTDSELS  DS    CL4                               multi select number            
TBCURR   DS    XL8                               multi select number            
ZCMD     DS    CL80                              command line                   
*REV     DC    CL6                               command line                   
MEMAREA  DS    0CL78                                                            
O#M      DS    CL8                               member name                    
O#D      DS    CL60                              data ( first 60 byte )         
O#TTR    DS    CL6                               ttr ( character )              
O#TTRB   DS    XL4                               ttr ( binary )                 
O#LEN    DS    F                                 member block length            
O#MBCHR  DS    XL8                               member block length            
* -----------------------------------                                           
*                                                                               
         ENTRY POSJFCB                                                          
POSJFCB  DS    0CL176                            job file control block         
         ENTRY POSJDSN                                                          
POSJDSN  DS    CL44                              dataset name                   
         ENTRY POSJDSCB                                                         
POSJDSCB DS    CL140                                                            
         ENTRY O#DEVT                                                           
O#DEVT   DS    CL4                               Device Type                    
         ENTRY O#BLKSZ                                                          
O#BLKSZ  DS    CL5                               Block Size                     
         ENTRY O#LRECL                                                          
O#LRECL  DS    CL5                               Record Length                  
         ENTRY O#RECFM                                                          
O#RECFM  DS    CL3                               Record Format                  
         ENTRY O#EXT                                                            
O#EXT    DS    CL2                               Extencson                      
         ENTRY O#ALC                                                            
O#ALC    DS    CL5                               Allocation Size                
         ENTRY O#USE                                                            
O#USE    DS    CL5                               InUse Size                     
         ENTRY O#CRE                                                            
O#CRE    DS    CL6                               Creation Date                  
         ENTRY  O#EXP                                                           
O#EXP    DS    CL6                               Expiration Date                
         ENTRY O#SYSCD                                                          
O#SYSCD  DS    CL13                              System Code                    
         ENTRY O#ASP                                                            
O#ASP    DS    CL17                              Start Address                  
         ENTRY O#ADP                                                            
O#ADP    DS    CL17                              Data Address                   
         ENTRY O#AUP                                                            
O#AUP    DS    CL17                              Use Address                    
         ENTRY O#AEP                                                            
O#AEP    DS    CL17                              End Address                    
         ENTRY O#ASP2                                                           
O#ASP2   DS    CL6                               Start Address ( TTR )          
         ENTRY O#ADP2                                                           
O#ADP2   DS    CL6                               Data Address ( TTR )           
         ENTRY O#AUP2                                                           
O#AUP2   DS    CL6                               Use Address ( TTR )            
         ENTRY O#AEP2                                                           
O#AEP2   DS    CL6                               End Address ( TTR )            
         ENTRY O#DBLK                                                           
O#DBLK   DS    F                                 Directory Blocks               
         ENTRY O#XXX                                                            
O#XXX    DS    0CL256                            extent high c-h                
         ENTRY O#H1                                                             
O#H1     DS    CL8                               extent high c-h                
         ENTRY O#H2                                                             
O#H2     DS    CL8                               extent high c-h                
         ENTRY O#H3                                                             
O#H3     DS    CL8                               extent high c-h                
         ENTRY O#H4                                                             
O#H4     DS    CL8                               extent high c-h                
         ENTRY O#H5                                                             
O#H5     DS    CL8                               extent high c-h                
         ENTRY O#H6                                                             
O#H6     DS    CL8                               extent high c-h                
         ENTRY O#H7                                                             
O#H7     DS    CL8                               extent high c-h                
         ENTRY O#H8                                                             
O#H8     DS    CL8                               extent high c-h                
         ENTRY O#H9                                                             
O#H9     DS    CL8                               extent high c-h                
         ENTRY O#H10                                                            
O#H10    DS    CL8                               extent high c-h                
         ENTRY O#H11                                                            
O#H11    DS    CL8                               extent high c-h                
         ENTRY O#H12                                                            
O#H12    DS    CL8                               extent high c-h                
         ENTRY O#H13                                                            
O#H13    DS    CL8                               extent high c-h                
         ENTRY O#H14                                                            
O#H14    DS    CL8                               extent high c-h                
         ENTRY O#H15                                                            
O#H15    DS    CL8                               extent high c-h                
         ENTRY O#H16                                                            
O#H16    DS    CL8                               extent high c-h                
         ENTRY O#L1                                                             
O#L1     DS    CL8                               extent high c-h                
         ENTRY O#L2                                                             
O#L2     DS    CL8                               extent high c-h                
         ENTRY O#L3                                                             
O#L3     DS    CL8                               extent high c-h                
         ENTRY O#L4                                                             
O#L4     DS    CL8                               extent high c-h                
         ENTRY O#L5                                                             
O#L5     DS    CL8                               extent high c-h                
         ENTRY O#L6                                                             
O#L6     DS    CL8                               extent high c-h                
         ENTRY O#L7                                                             
O#L7     DS    CL8                               extent high c-h                
         ENTRY O#L8                                                             
O#L8     DS    CL8                               extent high c-h                
         ENTRY O#L9                                                             
O#L9     DS    CL8                               extent high c-h                
         ENTRY O#L10                                                            
O#L10    DS    CL8                               extent high c-h                
         ENTRY O#L11                                                            
O#L11    DS    CL8                               extent high c-h                
         ENTRY O#L12                                                            
O#L12    DS    CL8                               extent high c-h                
         ENTRY O#L13                                                            
O#L13    DS    CL8                               extent high c-h                
         ENTRY O#L14                                                            
O#L14    DS    CL8                               extent high c-h                
         ENTRY O#L15                                                            
O#L15    DS    CL8                               extent high c-h                
         ENTRY O#L16                                                            
O#L16    DS    CL8                               extent high c-h                
         ENTRY O#MEM                                                            
O#MEM    DS    CL5                               member number                  
* --- extent high and low address ( cchh ) ---                                  
         ENTRY EXT#XXX                                                          
EXT#XXX  DS    0XL128        ( 16 * 2 * 4 byte )                                
         ENTRY EXT#0HI                                                          
EXT#0HI  DS    XL4                                                              
         ENTRY EXT#0LO                                                          
EXT#0LO  DS    XL4                                                              
         ENTRY EXT#1HI                                                          
EXT#1HI  DS    XL4                                                              
         ENTRY EXT#1LO                                                          
EXT#1LO  DS    XL4                                                              
         ENTRY EXT#2HI                                                          
EXT#2HI  DS    XL4                                                              
         ENTRY EXT#2LO                                                          
EXT#2LO  DS    XL4                                                              
         ENTRY EXT#3HI                                                          
EXT#3HI  DS    XL4                                                              
         ENTRY EXT#3LO                                                          
EXT#3LO  DS    XL4                                                              
         ENTRY EXT#4HI                                                          
EXT#4HI  DS    XL4                                                              
         ENTRY EXT#4LO                                                          
EXT#4LO  DS    XL4                                                              
         ENTRY EXT#5HI                                                          
EXT#5HI  DS    XL4                                                              
         ENTRY EXT#5LO                                                          
EXT#5LO  DS    XL4                                                              
         ENTRY EXT#6HI                                                          
EXT#6HI  DS    XL4                                                              
         ENTRY EXT#6LO                                                          
EXT#6LO  DS    XL4                                                              
         ENTRY EXT#7HI                                                          
EXT#7HI  DS    XL4                                                              
         ENTRY EXT#7LO                                                          
EXT#7LO  DS    XL4                                                              
         ENTRY EXT#8HI                                                          
EXT#8HI  DS    XL4                                                              
         ENTRY EXT#8LO                                                          
EXT#8LO  DS    XL4                                                              
         ENTRY EXT#9HI                                                          
EXT#9HI  DS    XL4                                                              
         ENTRY EXT#9LO                                                          
EXT#9LO  DS    XL4                                                              
         ENTRY EXT#AHI                                                          
EXT#AHI  DS    XL4                                                              
         ENTRY EXT#ALO                                                          
EXT#ALO  DS    XL4                                                              
         ENTRY EXT#BHI                                                          
EXT#BHI  DS    XL4                                                              
         ENTRY EXT#BLO                                                          
EXT#BLO  DS    XL4                                                              
         ENTRY EXT#CHI                                                          
EXT#CHI  DS    XL4                                                              
         ENTRY EXT#CLO                                                          
EXT#CLO  DS    XL4                                                              
         ENTRY EXT#DHI                                                          
EXT#DHI  DS    XL4                                                              
         ENTRY EXT#DLO                                                          
EXT#DLO  DS    XL4                                                              
         ENTRY EXT#EHI                                                          
EXT#EHI  DS    XL4                                                              
         ENTRY EXT#ELO                                                          
EXT#ELO  DS    XL4                                                              
         ENTRY EXT#FHI                                                          
EXT#FHI  DS    XL4                                                              
         ENTRY EXT#FLO                                                          
EXT#FLO  DS    XL4                                                              
* -----------------------------------                                           
*                                                                               
@SELECT  DS    CL1             1                 Table Selection Area           
*                                                                               
         DS    0F                                                               
ST#LIST  DS    0CL24                                                            
S_MEMBER DC    CL8'        '                                                    
S_TTR    DC    XL3'000000'                                                      
C        DC    BL1'10000110'                                                    
*                  1.......    ARIAS                                            
*                  ...11111    USER DATA LENGTH ( HALF WORD )                   
USERDATA DC    CL12'- BY KIMU - '                                               
*                                                                               
         DS    0F                                                               
* --- Browse DataSet Name ---                                                   
BR#DSN   DS    CL46                                                             
         DS    XL10                                                             
BR#VOL   DS    CL6                                                              
* --- Input DataSet Name ---                                                    
         ENTRY I#DSN                                                            
I#DSN    DS    CL44                                                             
* --- Input Volume Serial ---                                                   
         ENTRY I#VOL                                                            
I#VOL    DS    CL6                                                              
* --- Restore DataSet Name ---                                                  
         ENTRY R#DSN                                                            
R#DSN    DS    CL44                                                             
* --- Restore Volume Serial ---                                                 
         ENTRY R#VOL                                                            
R#VOL    DS    CL6                                                              
* --- Input Volume Serial ---                                                   
I#EXTOPT DS    CL1                                                              
I#EXTOP2 DS    CL1                                                              
I#DISP   DS    CL1                                                              
I#DSPACE DS    F                                                                
I#SRHSTR DS    CL50                                                             
*#DD     DS    CL8                                                              
R_LEN    DS    F                           data area read length                
* --- check of dataset organization  for input dataset ---                      
         DS    0F                                                               
         ENTRY CK#DSORG                                                         
CK#DSORG DS    BL1                                                              
* --- check of record format for input dataset ---                              
         DS    0F                                                               
         ENTRY CK#RFM                                                           
CK#RFM   DS    BL1                                                              
* --- check of block size ---                                                   
         DS    0F                                                               
         ENTRY CK#BLKSZ                                                         
CK#BLKSZ DS    BL2                                                              
* --- check of logical record length ---                                        
         DS    0F                                                               
         ENTRY CK#LRECL                                                         
CK#LRECL DS    BL2                                                              
* --- end of ttr ---                                                            
         ENTRY E#TTR                                                            
E#TTR    DS    0F,XL4                            end of ttr                     
* --- terminate of mbbcchhr ---                                                 
         ENTRY T#CHR                                                            
T#CHR    DS    0F,XL8                            end of mbbcchhr                
* --- end of mbbcchhr ---                                                       
         ENTRY E#CHR                                                            
E#CHR    DS    0F,XL8                            end of mbbcchhr                
* --- work of ttr ---                                                           
W_TTR    DS    0F,XL4                            work ttr                       
* --- work of mbbcchhr ---                                                      
W_CHR    DS    0F,XL8                            end of mbbcchhr                
* --- number of logical cylindar ---                                            
         ENTRY NUMCYL#                                                          
NUMCYL#  DS    XL2                                                              
* --- number of track in a logical cylindar ---                                 
         ENTRY NUMTRK#                                                          
NUMTRK#  DS    XL2                                                              
* --- number of allocation track number ---                                     
         ENTRY NUMALC#                                                          
NUMALC#  DS    F                                                                
* --- number of extent ---                                                      
         ENTRY EXT#                                                             
EXT#     DS    B                                                                
         DS    0F                                                               
STOW_RC  DS    F                                                                
         DS    0F                                                               
*--- messages ---                                                               
*RRMSG01 DC    CL30' << Getmain Error >>'        GETMAIN ERROR MESSAGE          
ERRMSG02 DC    CL60'< Dynamic Allocation Error rc_@@@@@@@@ >'                   
*                   |....+....1....+....2....+....3....+....4....+....5         
*              ....+....6....+....7....+....8                                   
ERRMSG03 DS    0CL75                                                            
         DC    CL27'Directory Table OverFlow . '                                
         DC    CL48'A:@@@@@@@@ L:@@@@@@@@ P:@@@@@@@@'                           
ERRMSG04 DC    CL60'< I/O Error TTR:@@@@@@ @@@@@@@@@@@@@@@ >'                   
ERRMSG05 DC    CL60'< DSORG Error !   Not Partitioned File :@@ >'               
ERRMSG06 DC    CL60'< This Dataset is Not Found ... >'                          
*RRMSG07 DC    CL60'< MBBCCHHR:M B B C C H H R  >'                              
ERRMSG10 DC    CL60'< SRCH :'                                                   
*RRMSG11 DC    CL60'< BLOCK : @@@@ / @@@@ = @@@@@@@@@@@@@@@@@@ >'               
ERRMSG12 DC    CL60'< Allocation Space Compute Error  RC:@@@@@@@@ >'            
ERRMSG13 DC    CL60'< Control Table Getmain Faile .. : @@@@@@@@ >'              
ERRMSG14 DC    CL60'< TTR:@@@@@@ = MBBCCHHR:@@@@@@@@ @@@@@@@@ >'                
*                   |....+....1....+....2....+....3....+....4....+....5         
*              ....+....6....+....7....+....8                                   
ERRMSG15 DC    CL75'Directory Table Space to Large . RC:@@@@@@@@ Length*        
               :@@@@@@@@'                                                       
ERRMSG16 DC    CL75'Dataset Now Recovering of Other User .  ENQ RC:@@@@*        
               @@@@'                                                            
ERRMSG17 DC    CL75'Read Buffer Space Getmain False. RC:@@@@@@@@ Length*        
               :@@@@@@@@'                                                       
*RRMSG99 DC    CL60'< TTR:@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ >'           
*RRMSG99 DC    CL60'< GETMAIN SPACE IS:@@@@@@@@ >'                              
MSG001   DC    CL60'< Select ---- members . >'                                  
MSG002   DC    CL60'<< Dataset Reading ...  Wait a Few Minuts .. >>'            
MSG003   DC    CL60'<< Member ( @@@@@@@@ ) restored rc_@@@@@@@@ >>'             
*                   |....+....1....+....2....+....3....+....4....+....5         
MSG004   DC    CL70'>> RV001 : @RV ; @@@@@@ < @@/@@/@@ @@:@@ > ; Good M*        
               orning !! '                                                      
*SG005   DC    CL60'>> RV002 :     Parameter Area GetMain OK .'                 
*SG006   DC    CL60'>> RV001 : @RV Initialize Start ...'                        
*SG007   DC    CL60'>> RV001 : @RV Initialize Start ...'                        
* --- directory read buffer ---                                                 
         LTORG                                                                  
DIR      DS    CL256                             DIRECTORY WORK AREA            
*        PRINT GEN                                                              
JFCBSECT DSECT                                                                  
         IEFJFCBN LIST=YES                                                      
         IEFUCBOB LIST=YES                                                      
         DCBD  DSORG=PO,DEVD=DA                                                 
         CVT   DSECT=YES,LIST=YES                                               
* --- Dataset Configration Dsect ---                                            
         PRINT GEN                                                              
*        COPY  @RV#06DC                                                         
* --- @RV Copy Section ---                                                      
         COPY  @RV#080X                                                         
R00      EQU   00                                                               
R01      EQU   01                                                               
R02      EQU   02                                                               
R03      EQU   03                                                               
R04      EQU   04                                                               
R05      EQU   05                                                               
R06      EQU   06                                                               
R07      EQU   07                                                               
R08      EQU   08                                                               
R09      EQU   09                                                               
R10      EQU   10                                                               
R11      EQU   11                                                               
R12      EQU   12                                                               
R13      EQU   13                                                               
R14      EQU   14                                                               
R15      EQU   15                                                               
         END   @RV#080                                                          
/*                                                                              
//SYSLIB   DD DSN=SYS1.MACLIB,DISP=SHR                                          
//         DD DSN=SYS1.AMODGEN,DISP=SHR                                         
//         DD DSN=&&COPY,DISP=(OLD,PASS)                                        
//SYSUT1   DD UNIT=(SYSALLDA,SEP=SYSLIB),SPACE=(CYL,(10,5)),DSN=&SYSUT1         
//SYSPUNCH DD DUMMY                                                             
//SYSPRINT DD SYSOUT=*,DCB=(BLKSIZE=3509),                                      
//         UNIT=(,SEP=(SYSUT1,SYSPUNCH))                                        
//*YSLIN   DD DISP=(,PASS),UNIT=SYSALLDA,SPACE=(CYL,(5,5,0)),                   
//*        DCB=(BLKSIZE=400),DSN=&&LOADSET                                      
//SYSLIN   DD DSN=object.library(@RV#080),DISP=OLD             <- CHECK         
//B       EXEC PGM=IEV90,PARM=OBJECT,REGION=2000K                               
//SYSIN    DD  *                                                                
         START                                                                  
         DC   C'<< Oh Shock ! _ Dynamic Allocation >> Version 6 ( '             
REV      DC   CL6'v6r0m1'                                                       
         DC   C' ) _ Kimu  // Compiled Date : &SYSDATE _ &SYSTIME '             
* RC                                                                            
*    0 : OK                                                                     
*    1 : dynamic allocation error                                               
*    8 : dsn not found !                                                        
*   16 : PAn not found !                                                        
*                                                                               
         PRINT NOGEN                                                            
@RV#6DA  CSECT                                                                  
         SAVE  (14,12),T,*                                                      
         BALR  R03,0                                                            
         USING *,R03,R04,R05               Base Reg. R03,R04,R05                
         LA    R04,2048(R03)               2'ND Base Reg                        
         LA    R04,2048(R04)                                                    
         LA    R05,2048(R04)               3'ND Base Reg                        
         LA    R05,2048(R05)                                                    
         ST    R13,SAVEAREA+4              Save A(OLD SaveArea)                 
         LR    R12,R13                                                          
         LA    R13,SAVEAREA                                                     
         ST    R13,8(R12)                  Save A(NEW SaveArea)                 
*-------- Parameter Process ----------------------------------------            
         LR    R12,R01                                                          
         USING @RVDA#PM,R12                                                     
         CLC   0(8,R12),=CL8'ALLOCATE' if allocation process                    
         BE    @DY_ALC                                                          
         CLC   0(8,R12),=CL8'CREATE  ' if allocation process                    
         BE    @DY_CRE                                                          
         CLC   0(8,R12),=CL8'FREE    ' if free process                          
         BE    @DY_FRE                                                          
         LA    R15,16                  initial condition code                   
         B     @BYE                                                             
*-------- Dynamic Allocation ( Allocate ) --------------------------            
@DY_ALC  EQU   *                                                                
* --- Dynamic Allocation Parameter List ---                                     
         LA    R06,ALLOCTP             parameter list address                   
* --- dataset name ---                                                          
         MVC   ALCDSN(44),P#DSN        copy to dataset name                     
         LA    R07,@D_DSN              dsn parm address                         
         ST    R07,0(R06)                                                       
         LA    R06,4(R06)                                                       
* --- volume serial ---                                                         
         CLC   P#VOL(6),=CL6'      '   if volume serial is not space            
         BE    @DY_VOL                   goto @DY_VOL                           
         MVC   W#DSN(44),P#DSN         copy to dataset name                     
         MVC   W#VOL(6),P#VOL          copy to volume serial                    
         XC    DSCB,DSCB               search dataset in volume                 
         OBTAIN DSCBFMT1                                                        
         LTR   R15,R15                                                          
         BZ    @DY_VOL1                                                         
         LA    R15,8                   dataset not found                        
         B     @BYE                                                             
@DY_VOL1 EQU   *                               else                             
         MVC   ALCVOL(06),P#VOL        copy Input Volume Serial                 
         LA    R07,@D_VOL              volser parm address                      
         ST    R07,0(R06)                                                       
         LA    R06,4(R06)                                                       
@DY_VOL  EQU   *                       volume serial get                        
* --- disp ---                                                                  
* old                                                                           
         CLC   P#DISP,=CL3'OLD'                                                 
         BNE   @DY_DOLD                                                         
         LA    R07,@D_DOLD             disp parm address                        
         ST    R07,0(R06)                                                       
         LA    R06,4(R06)                                                       
         B     @DY_DEXT                                                         
@DY_DOLD EQU   *                                                                
* shr                                                                           
         LA    R07,@D_DSHR             disp parm address                        
         ST    R07,0(R06)                                                       
         LA    R06,4(R06)                                                       
@DY_DEXT EQU   *                                                                
* --- unit ---                                                                  
         LA    R07,@D_UNIT             unit parm address                        
         ST    R07,0(R06)                                                       
         LA    R06,4(R06)                                                       
* --- dd name ---                                                               
         LA    R07,@D_RETDD            return dd name list                      
         ST    R07,0(R06)                                                       
         LA    R06,4(R06)                                                       
* --- dataset organization ---                                                  
         LA    R07,@D_RETOR            return organization                      
         O     R07,=X'80000000'        end of parameter list                    
         ST    R07,0(R06)                                                       
* --- end of parameter list ---                                                 
         LA    R01,ALLOC                                                        
         SVC   99                      Dynamic Allocate                         
         LTR   R15,R15                 if Alloc OK then                         
         BZ    @DY_OK                    goto @DY_OK                            
         MVC   P#RETC(4),ALLOCER                                                
         LA    R15,1                                                            
         B     @BYE                                                             
@DY_OK   EQU   *                                                                
         MVC   P#RETDD(8),ALCDD                                                 
         MVC   P#RETC(4),ALLOCER                                                
         LA    R15,0                                                            
         B     @BYE                                                             
*-------------------------------------------------------------------            
*-------- Dynamic Allocation ( Allocate ) --------------------------            
@DY_CRE  EQU   *                                                                
*        B     @BYE                                                             
*        TPUT  =CL20'** CREATE **',20                                           
* --- Dynamic Allocation Parameter List ---                                     
         XC    ALLOCTP(LALLOCTP),ALLOCTP                                        
         LA    R06,ALLOCTP             parameter list address                   
* --- dataset name ---                                                          
*        TPUT  =CL20'** DSNAME **',20                                           
         MVC   ALCDSN(44),P#DSN        copy to dataset name                     
         LA    R07,@D_DSN              dsn parm address                         
         ST    R07,0(R06)                                                       
         LA    R06,4(R06)                                                       
* --- volume serial ---                                                         
         CLC   P#VOL(6),=CL6'      '   if volume serial is not space            
         BE    @CR_VOL                   goto @DY_VOL                           
*        TPUT  =CL20'** VOLUME **',20                                           
         MVC   ALCVOL(06),P#VOL        copy Input Volume Serial                 
         LA    R07,@D_VOL              volser parm address                      
         ST    R07,0(R06)                                                       
         LA    R06,4(R06)                                                       
@CR_VOL  EQU   *                       volume serial get                        
* --- disp ---                                                                  
* new                                                                           
*        TPUT  =CL20'** DISP **',20                                             
         LA    R07,@D_DNEW             disp parm address                        
         ST    R07,0(R06)                                                       
         LA    R06,4(R06)                                                       
* --- disp ---                                                                  
         LA    R07,@D_CTLG             disp parm address                        
         ST    R07,0(R06)                                                       
         LA    R06,4(R06)                                                       
* --- space ---                                                                 
*        TPUT  =CL20'** SPACE **',20                                            
         CLC   P#SPC(3),=CL3'CYL'                                               
         BE    @CR_DNE1                                                         
         LA    R07,@D_STRK                                                      
         B     @CR_DNE2                                                         
@CR_DNE1 EQU   *                                                                
         LA    R07,@D_SCYL                                                      
@CR_DNE2 EQU   *                                                                
         ST    R07,0(R06)                                                       
         LA    R06,4(R06)                                                       
* --- size 1 ---                                                                
*        TPUT  =CL20'** SIZE 1 **',20                                           
         MVC   ALCSPC1(3),P#SIZE1                                               
         LA    R07,@D_SPC1                                                      
         ST    R07,0(R06)                                                       
         LA    R06,4(R06)                                                       
* --- size 2 ---                                                                
*        TPUT  =CL20'** SIZE 2 **',20                                           
         MVC   ALCSPC2(3),P#SIZE2                                               
         LA    R07,@D_SPC2                                                      
         ST    R07,0(R06)                                                       
         LA    R06,4(R06)                                                       
* --- dsorg ---                                                                 
*        TPUT  =CL20'** DSORG **',20                                            
         MVC   ALCDSORG(2),@D_PS                                                
         LA    R07,@D_DSORG                                                     
         ST    R07,0(R06)                                                       
         LA    R06,4(R06)                                                       
* --- recfm ---                                                                 
*        TPUT  =CL20'** RECFM **',20                                            
         MVC   ALCRECFM(1),P#RECFM                                              
         LA    R07,@D_RECFM                                                     
         ST    R07,0(R06)                                                       
         LA    R06,4(R06)                                                       
* --- blksize ---                                                               
*        TPUT  =CL20'** BLKSIZE **',20                                          
         MVC   ALCBLKSZ(2),P#BLKSZ                                              
         LA    R07,@D_BLKSZ                                                     
         ST    R07,0(R06)                                                       
         LA    R06,4(R06)                                                       
* --- lrecl ---                                                                 
*        TPUT  =CL20'** LRECL **',20                                            
         MVC   ALCLRECL(2),P#LRECL                                              
         LA    R07,@D_LRECL                                                     
         ST    R07,0(R06)                                                       
         LA    R06,4(R06)                                                       
* --- unit ---                                                                  
*        TPUT  =CL20'** UNIT **',20                                             
         LA    R07,@D_UNIT             unit parm address                        
         ST    R07,0(R06)                                                       
         LA    R06,4(R06)                                                       
* --- dd name ---                                                               
*        TPUT  =CL20'** DDNAME **',20                                           
         LA    R07,@D_RETDD            return dd name list                      
         O     R07,=X'80000000'        end of parameter list                    
         ST    R07,0(R06)                                                       
         LA    R06,4(R06)                                                       
* --- dataset organization ---                                                  
*        TPUT  =CL20'** DSORG **',20                                            
*        LA    R07,@D_RETOR            return organization                      
*        ST    R07,0(R06)                                                       
* --- end of parameter list ---                                                 
*        TPUT  =CL20'** START **',20                                            
         LA    R01,ALLOC                                                        
         SVC   99                      Dynamic Allocate                         
         LTR   R15,R15                 if Alloc OK then                         
         BZ    @CR_OK                    goto @DY_OK                            
*        B     @CR_OK                    goto @DY_OK                            
*        TPUT  =CL20'** ERROR **',20                                            
         MVC   P#RETC(4),ALLOCER                                                
         LA    R15,1                                                            
         B     @BYE                                                             
@CR_OK   EQU   *                                                                
*        TPUT  =CL20'** OK OK **',20                                            
         MVC   P#RETDD(8),ALCDD                                                 
         MVC   P#RETC(4),ALLOCER                                                
         LA    R15,0                                                            
         B     @BYE                                                             
*-------------------------------------------------------------------            
@DY_FRE  EQU   *                                                                
         MVC   FREEDD(8),P#RETDD                                                
         LA    R01,FREE                                                         
         SVC   99                                                               
         B     @BYE                                                             
*-------------------------------------------------------------------            
@BYE     EQU   *                                                                
         L     R13,SAVEAREA+4          return                                   
         RETURN (14,12),RC=(15)                                                 
         DS    0F                                                               
* --- SAVE AREA ---                                                             
SAVEAREA DS    18F                               SAVEAREA                       
* --- Convert Hexa to Char Routine Work Area ---                                
         DS    0D                                                               
*--- job file control block ---                                                 
JFCB     DS    0CL176                            JOB FILE CONTROL BLOCK         
W#DSN    DS    CL44                              DATASET NAME                   
DSCB     DC    CL140' '                          DATASET CONTROL BLOCK          
W#VOL    DS    CL6                               DATASET NAME                   
         DS    0F                                                               
* --- dinamic allocations ---                                                   
ALLOC    DC    0F'0',X'80',AL3(ALLOCRB)                                         
ALLOCRB  DS    0F                                                               
         DC    AL1(20),AL1(01),AL2(0)                                           
ALLOCER  DC    AL2(0)                                                           
ALLOCIN  DC    AL2(0)                                                           
         DC    A(ALLOCTP)                                                       
         DC    A(0)                                                             
         DC    A(0)                                                             
ALLOCTP  DC    A(0)                  A(@D_DSN)                                  
         DC    A(0)                  A(@D_DISP)                                 
         DC    A(0)                  A(@D_UNIT)                                 
         DC    A(0)                  A(@D_VOL)                                  
         DC    A(0)                  X'80',AL3(@D_RETDD)                        
         DC    A(0)                                                             
         DC    A(0)                                                             
         DC    A(0)                                                             
         DC    A(0)                                                             
         DC    A(0)                                                             
         DC    A(0)                                                             
         DC    A(0)                                                             
         DC    A(0)                                                             
         DC    A(0)                                                             
         DC    A(0)                                                             
         DC    A(0)                                                             
         DC    A(0)                                                             
         DC    A(0)                                                             
         DC    A(0)                                                             
         DC    A(0)                                                             
         DC    A(0)                                                             
         DC    A(0)                                                             
         DC    A(0)                                                             
LALLOCTP EQU   *-ALLOCTP                                                        
* DDNAME <- DSN=@@@@,DISP=SHR,UNIT=SYSDA,VOL=SER=@@@@@@                         
@D_DSN   DC    XL2'0002',XL2'0001',HL2'44'                                      
ALCDSN   DS    CL44                                                             
@D_DOLD  DC    XL2'0004',XL2'0001',HL2'01',XL1'01'   disp=old                   
@D_DNEW  DC    XL2'0004',XL2'0001',HL2'01',XL1'04'   disp=new                   
@D_DSHR  DC    XL2'0004',XL2'0001',HL2'01',XL1'08'   disp=shr                   
@D_CTLG  DC    XL2'0005',XL2'0001',HL2'01',XL1'02'   disp=(,catlg)              
@D_UNIT  DC    XL2'0015',XL2'0001',HL2'08',CL8'SYSALLDA'                        
@D_STRK  DC    XL2'0007',XL2'0000'                                              
@D_SCYL  DC    XL2'0008',XL2'0000'                                              
@D_SPC1  DC    XL2'000A',XL2'0001',HL2'03'                                      
ALCSPC1  DS    CL3                                                              
@D_SPC2  DC    XL2'000B',XL2'0001',HL2'03'                                      
ALCSPC2  DS    CL3                                                              
@D_BLKSZ DC    XL2'0030',XL2'0001',HL2'02'                                      
ALCBLKSZ DS    CL2                                                              
@D_LRECL DC    XL2'0042',XL2'0001',HL2'02'                                      
ALCLRECL DS    CL2                                                              
@D_RECFM DC    XL2'0049',XL2'0001',HL2'01'                                      
ALCRECFM DS    CL1                                                              
@D_F     DC    XL1'80'          recfm=f                                         
@D_FB    DC    XL1'90'          recfm=fb                                        
@D_DSORG DC    XL2'003C',XL2'0001',HL2'02'                                      
ALCDSORG DS    CL2                                                              
@D_PS    DC    XL2'4000'     dataset organization ( PS )                        
@D_VOL   DC    XL2'0010',XL2'0001',HL2'06'                                      
ALCVOL   DS    CL6                                                              
@D_RETDD DC    XL2'0055',XL2'0001',HL2'08'                                      
ALCDD    DS    CL8                                                              
@D_RETOR DC    XL2'0057',XL2'0001',HL2'02'                                      
ALCORG   DS    H                                                                
*                                                                               
@D_DDN   DC    XL2'0001',XL2'0001',HL2'08',CL8'INDD    '                        
**************************************************************                  
FREE     DC    0F'0',X'80',AL3(FREERB)                                          
FREERB   DS    0F                                                               
         DC    AL1(20),AL1(02),AL2(0)                                           
FREEER   DC    AL2(0)                                                           
FREEIN   DC    AL2(0)                                                           
         DC    A(FREETP)                                                        
         DC    A(0)                                                             
         DC    A(0)                                                             
FREETP   DC    X'80',AL3(@FREEDD)                                               
@FREEDD  DC    XL2'0001',XL2'0001',HL2'08'                                      
FREEDD   DS    CL8                                                              
DSCBFMT1 CAMLST SEARCH,W#DSN,W#VOL,DSCB                                         
         LTORG                                                                  
* --- Dynamic Allocation Parameter Area ( Dummy Section ) ---                   
@RVDA#PM DSECT                                                                  
P#PROC   DS    CL8                                                              
P#DSN    DS    CL44                                                             
P#VOL    DS    CL6                                                              
P#DISP   DS    CL3                                                              
P#RETDD  DS    CL8                                                              
P#RETC   DS    CL4                                                              
P#SPC    DS    CL3           'trk' or 'cyl'                                     
P#SIZE1  DS    XL3                                                              
P#SIZE2  DS    XL3                                                              
P#DSORG  DS    CL2           'ps'                                               
P#RECFM  DS    XL1           f, v, fb, vb, fba, vba, u                          
P#LRECL  DS    XL2                                                              
P#BLKSZ  DS    XL2                                                              
* ---                                                                           
R00      EQU   00                                                               
R01      EQU   01                                                               
R02      EQU   02                                                               
R03      EQU   03                                                               
R04      EQU   04                                                               
R05      EQU   05                                                               
R06      EQU   06                                                               
R07      EQU   07                                                               
R08      EQU   08                                                               
R09      EQU   09                                                               
R10      EQU   10                                                               
R11      EQU   11                                                               
R12      EQU   12                                                               
R13      EQU   13                                                               
R14      EQU   14                                                               
R15      EQU   15                                                               
         END   @RV#6DA                                                          
/*                                                                              
//SYSLIB   DD  DSN=SYS1.MACLIB,DISP=SHR                                         
//         DD  DSN=SYS1.AMODGEN,DISP=SHR                                        
//SYSUT1   DD UNIT=(SYSALLDA,SEP=SYSLIB),SPACE=(CYL,(10,5)),DSN=&SYSUT1         
//SYSPUNCH DD  DUMMY                                                            
//*YSPUNCH DD  SYSOUT=*,DCB=(BLKSIZE=800),SPACE=(CYL,(5,5,0))                   
//SYSPRINT DD  SYSOUT=*,DCB=(BLKSIZE=3509),                                     
//         UNIT=(,SEP=(SYSUT1,SYSPUNCH))                                        
//*YSLIN   DD  DISP=(,PASS),UNIT=SYSALLDA,SPACE=(CYL,(5,5,0)),                  
//*        DCB=(BLKSIZE=400),DSN=&&LOADSET                                      
//SYSLIN   DD DSN=object.library(@RV#6DA),DISP=OLD             <- CHECK         
//C       EXEC PGM=IEV90,PARM=OBJECT,REGION=2000K                               
//SYSIN    DD  *                                                                
         START                                                                  
         DC   C'<< Oh Shock ! Dataset Configration >> Version 6 ( '             
REV      DC   CL6'v6r0m1'                                                       
         DC   C' ) _ Kimu  // Compiled Date : &SYSDATE _ &SYSTIME '             
         PRINT NOGEN                                                            
@RV#6DC  CSECT                                                                  
         SAVE  (14,12),T,*                                                      
         BALR  R03,0                                                            
         USING *,R03,R04,R05               Base Reg. R03,R04,R05                
         LA    R04,2048(R03)               2'ND Base Reg                        
         LA    R04,2048(R04)                                                    
         LA    R05,2048(R04)               3'ND Base Reg                        
         LA    R05,2048(R05)                                                    
         ST    R13,SAVEAREA+4              Save A(OLD SaveArea)                 
         LR    R12,R13                                                          
         LA    R13,SAVEAREA                                                     
         ST    R13,8(R12)                  Save A(NEW SaveArea)                 
* --- dataset configration ---                                                  
@DS_CONF EQU   *                              dataset configration              
*        L     R07,APDSF                                                        
*        RDJFCB (R07)                         get JFCB                          
*        LTR   R15,R15                                                          
*        BZ    @DS_SKP1                                                         
*        TPUT  ERRMSG01,L'ERRMSG01                                              
*DS_SKP1 EQU   *                                                                
         USING JFCBSECT,R12                   base reg. R12                     
         L     R12,AOSJFCB                                                      
* --- volume serial ---                                                         
         L     R01,AI#VOL                                                       
         MVC   0(6,R01),JFCBVOLS                                                
         MVC   VOLUME,JFCBVOLS                camlst volume serial              
* --- dataset organization ---                                                  
         XR    R01,R01                                                          
         IC    R01,JFCDSRG1                                                     
         L     R02,ACK#DSOR                                                     
         STC   R01,0(R02)                                                       
* --- record format ---                                                         
         XR    R01,R01                                                          
         IC    R01,JFCRECFM                                                     
         L     R02,ACK#RFM                                                      
         STC   R01,0(R02)                                                       
* --- block size ---                                                            
         XR    R01,R01                                                          
         LH    R01,JFCBLKSI                                                     
         L     R02,ACK#BLKS                                                     
         STH   R01,0(R02)                                                       
         CVD   R01,PK_AREA                                                      
         UNPK  UPK_AREA(8),PK_AREA(8)                                           
         OI    UPK_AREA+7,X'F0'                                                 
         L     R02,A#BLKSZ                                                      
         MVC   0(5,R02),UPK_AREA+3                                              
* --- records# of 1 track ---                                                   
         L     R02,ACK#BLKS                                                     
         CALL  @RV#6TC,(VOLUME,(R02),R)                                         
* --- logical record length ---                                                 
         XR    R01,R01                                                          
         LH    R01,JFCLRECL                                                     
         L     R02,ACK#LRL                                                      
         STH   R01,0(R02)                                                       
         CVD   R01,PK_AREA                                                      
         UNPK  UPK_AREA(8),PK_AREA(8)                                           
         OI    UPK_AREA+7,X'F0'                                                 
         L     R02,A#LRECL                                                      
         MVC   0(5,R02),UPK_AREA+3                                              
* --- directory block ---                                                       
         L     R01,JFCBDQTY                                                     
         CVD   R01,PK_AREA                                                      
         UNPK  UPK_AREA(8),PK_AREA(8)                                           
         OI    UPK_AREA+7,X'F0'                                                 
         L     R02,A#DBLK                                                       
         MVC   0(5,R02),UPK_AREA+3                                              
* --- drop rdjfcb dsect ---                                                     
         DROP  R12                                                              
* --- DSCB type 4 ( volume information ) ---                                    
         XC    DSCB4,DSCB4                    clear dscb area                   
         MVI   DSCB4DSN,X'04'                 move dscb 4 name                  
         MVC   DSCB4DSN+1(43),DSCB4DSN                                          
         OBTAIN DSCBFMT4                      get JFCB                          
         LTR   R15,R15                                                          
         BZ    @DSCB4CK                                                         
         TPUT  ERRMSG02,L'ERRMSG02                                              
@DSCB4CK EQU   *                                                                
         USING DSCBSEC4,R12                   base reg. R12                     
         LA    R12,DSCB4                                                        
         L     R02,ANUMCYL#                                                     
         MVC   0(2,R02),DS4DSCYL                                                
         L     R02,ANUMTRK#                                                     
         MVC   0(2,R02),DS4DSTRK                                                
* --- DEBUG ---                                                                 
*        CALL  @RV#6HC,((R02),ERRMSG99+4,4)                                     
*        TPUT  ERRMSG99,L'ERRMSG99                                              
* --- drop dscb4 ---                                                            
         DROP  R12                                                              
* --- DSCB type 1 ( dstaset formation ) ---                                     
         XC    DSCB1,DSCB1                                                      
         L     R01,AI#DSN                                                       
         MVC   DSCB1DSN(44),0(R01)                                              
         OBTAIN DSCBFMT1                      get JFCB                          
         LTR   R15,R15                                                          
         BZ    @DSCB1CK                                                         
         TPUT  ERRMSG03,L'ERRMSG03                                              
@DSCB1CK EQU   *                                                                
         USING DSCBSEC1,R12                   base reg. R12                     
         LA    R12,JFCB1                                                        
* --- last used track ---                                                       
         L     R06,AE#TTR                                                       
         MVC   0(4,R06),DS1LSTAR              ttr                               
         L     R07,A#AUP2                                                       
         CALL  @RV#6HC,((R06),(R07),3)                                          
         L     R00,DS1LSTAR                   mbbcchhr                          
         N     R00,=X'FFFFFF00'                                                 
*        L     R01,PDSFD+44                                                     
         L     R01,APDSF                                                        
         L     R01,44(R01)                                                      
         N     R01,=X'00FFFFFF'                                                 
         L     R02,AE#CHR                                                       
         BAL   R14,@CNVCHR                    convert ttr -> mbbcchhr           
         L     R06,AE#CHR                                                       
         L     R07,A#AUP                                                        
         CALL  @RV#6HC,((R06),(R07),8)                                          
* --- start address ---                                                         
         L     R00,=X'00000100'               ttr ( first address )             
         L     R01,APDSF                                                        
         L     R01,44(R01)                                                      
         N     R01,=X'00FFFFFF'                                                 
         LA    R02,W_CHR                                                        
         BAL   R14,@CNVCHR                    convert ttr -> mbbcchhr           
         L     R07,A#ASP                                                        
         CALL  @RV#6HC,(W_CHR,(R07),8)                                          
* --- extent ---                                                                
         XR    R01,R01                                                          
         IC    R01,DS1NOEPV                                                     
         L     R02,AEXT#                                                        
         STC   R01,0(R02)                                                       
         CVD   R01,PK_AREA                                                      
         UNPK  UPK_AREA(8),PK_AREA(8)                                           
         OI    UPK_AREA+7,X'F0'                                                 
         L     R02,A#EXT                                                        
         MVC   0(2,R02),UPK_AREA+6                                              
* --- system code ---                                                           
         L     R02,A#SYSCD                                                      
         MVC   0(13,R02),DS1SYSCD                                               
* --- creation date ---                                                         
         IC    R01,DS1CREDT                                                     
         CVD   R01,PK_AREA                                                      
         UNPK  UPK_AREA(8),PK_AREA(8)                                           
         OI    UPK_AREA+7,X'F0'                                                 
         L     R02,A#CRE                                                        
         MVC   0(2,R02),UPK_AREA+6                                              
         MVI   2(R02),C'/'                                                      
         L     R01,DS1CREDT                                                     
         SRL   R01,8                                                            
         N     R01,=X'0000FFFF'                                                 
         CVD   R01,PK_AREA                                                      
         UNPK  UPK_AREA(8),PK_AREA(8)                                           
         OI    UPK_AREA+7,X'F0'                                                 
         MVC   3(3,R02),UPK_AREA+5                                              
* --- expiration date ---                                                       
         IC    R01,DS1EXPDT                                                     
         CVD   R01,PK_AREA                                                      
         UNPK  UPK_AREA(8),PK_AREA(8)                                           
         OI    UPK_AREA+7,X'F0'                                                 
         L     R02,A#EXP                                                        
         MVC   0(2,R02),UPK_AREA+6                                              
         MVI   2(R02),C'/'                                                      
         L     R01,DS1EXPDT                                                     
         SRL   R01,8                                                            
         CL    R01,=F'0'                                                        
         BE    @EXPJP1                                                          
         N     R01,=X'0000FFFF'                                                 
         CVD   R01,PK_AREA                                                      
         UNPK  UPK_AREA(8),PK_AREA(8)                                           
         OI    UPK_AREA+7,X'F0'                                                 
         MVC   3(3,R02),UPK_AREA+5                                              
         B     @EXPJP2                                                          
@EXPJP1  EQU   *                                                                
         L     R02,A#EXP                                                        
         MVC   0(6,R02),=CL6'*NONE*'                                            
@EXPJP2  EQU   *                                                                
* --- extent address ---                                                        
         XR    R06,R06                       extent number                      
         XR    R08,R08                       allocation space compute           
         L     R02,AEXT#XXX                  clear extent area                  
         MVI   0(R02),X'00'                                                     
         MVC   1(127,R02),0(R02)                                                
         L     R02,A#XXX                     clear extent area                  
         MVI   0(R02),C' '                    ( display area )                  
         MVC   1(255,R02),0(R02)                                                
         L     R07,AT#CHR                    terminate cchhr                    
         IC    R06,DS1NOEPV                                                     
* --- extent 1 address ---                                                      
         L     R09,AEXT#0LO                                                     
         MVC   0(4,R09),DS1EXT1+2          ext 0 high                           
         L     R08,A#L1                                                         
         CALL  @RV#6HC,((R09),(R08),4)                                          
         L     R10,AEXT#0HI                                                     
         MVC   0(4,R10),DS1EXT1+6          ext 0 low                            
         L     R08,A#H1                                                         
         CALL  @RV#6HC,((R10),(R08),4)                                          
         MVC   0(3,R07),=X'000000'                    ( mbb )                   
         MVC   3(4,R07),DS1EXT1+6          ext 0 high ( cchh )                  
         MVC   7(1,R07),R+3                ext 0 high ( cchh )                  
         BAL   R14,@E_A_TRK                allocation space compute             
         L     R02,ANUMALC#                  allocation track number            
         ST    R01,0(R02)                                                       
         BCTR  R06,0                                                            
         LTR   R06,R06                                                          
         BZ    @E_A_X                                                           
* --- extent 2 address ---                                                      
         L     R09,AEXT#1LO                                                     
         MVC   0(4,R09),DS1EXT2+2          ext 1 high                           
         L     R08,A#L2                                                         
         CALL  @RV#6HC,((R09),(R08),4)                                          
         L     R10,AEXT#1HI                                                     
         MVC   0(4,R10),DS1EXT2+6          ext 1 low                            
         L     R08,A#H2                                                         
         CALL  @RV#6HC,((R10),(R08),4)                                          
         MVC   0(3,R07),=X'010000'                      ( mbb )                 
         MVC   3(4,R07),DS1EXT2+6          ext 1 high ( cchh )                  
         MVC   7(1,R07),R+3                ext 0 high ( cchh )                  
         BAL   R14,@E_A_TRK                allocation space compute             
         L     R09,ANUMALC#                  allocation track number            
         L     R10,0(R09)                                                       
         LA    R10,0(R10,R01)                                                   
         ST    R10,0(R09)                                                       
         BCTR  R06,0                                                            
         LTR   R06,R06                                                          
         BZ    @E_A_X                                                           
* --- extent 3 address ---                                                      
         L     R09,AEXT#2LO                                                     
         MVC   0(4,R09),DS1EXT3+2          ext 2 high                           
         L     R08,A#L3                                                         
         CALL  @RV#6HC,((R09),(R08),4)                                          
         L     R10,AEXT#2HI                                                     
         MVC   0(4,R10),DS1EXT3+6          ext 2 low                            
         L     R08,A#H3                                                         
         CALL  @RV#6HC,((R10),(R08),4)                                          
         MVC   0(3,R07),=X'020000'                      ( mbb )                 
         MVC   3(4,R07),DS1EXT3+6          ext 2 high ( cchh )                  
         MVC   7(1,R07),R+3                ext 0 high ( cchh )                  
         BAL   R14,@E_A_TRK                allocation space compute             
         L     R09,ANUMALC#                  allocation track number            
         L     R10,0(R09)                                                       
         LA    R10,0(R10,R01)                                                   
         ST    R10,0(R09)                                                       
         BCTR  R06,0                                                            
         LTR   R06,R06                                                          
         BZ    @E_A_X                                                           
* --- dscb type 3 ( extent dataset information ) ---                            
         MVC   DSCB3CHR(5),DS1PTRDS                                             
         XC    DSCB3,DSCB3                                                      
         OBTAIN DSCBFMT3                                                        
         LTR   R15,R15                                                          
         BNZ   @E_A_X                                                           
         USING DSCBSEC3,R11                                                     
         LA    R11,DSCB3                                                        
* --- extent 4 address ---                                                      
         L     R09,AEXT#3LO                                                     
         MVC   0(4,R09),DS3EXTNT+2         ext 3 high                           
         L     R08,A#L4                                                         
         CALL  @RV#6HC,((R09),(R08),4)                                          
         L     R10,AEXT#3HI                                                     
         MVC   0(4,R10),DS3EXTNT+6         ext 3 low                            
         L     R08,A#H4                                                         
         CALL  @RV#6HC,((R10),(R08),4)                                          
         MVC   0(3,R07),=X'030000'                      ( mbb )                 
         MVC   3(4,R07),DS3EXTNT+6         ext 3 high ( cchh )                  
         MVC   7(1,R07),R+3                ext 0 high ( cchh )                  
         BAL   R14,@E_A_TRK                allocation space compute             
         L     R09,ANUMALC#                  allocation track number            
         L     R10,0(R09)                                                       
         LA    R10,0(R10,R01)                                                   
         ST    R10,0(R09)                                                       
         BCTR  R06,0                                                            
         LTR   R06,R06                                                          
         BZ    @E_A_X                                                           
* --- extent 5 address ---                                                      
         L     R09,AEXT#4LO                                                     
         MVC   0(4,R09),DS3EXTNT+12        ext 4 high                           
         L     R08,A#L5                                                         
         CALL  @RV#6HC,((R09),(R08),4)                                          
         L     R10,AEXT#4HI                                                     
         MVC   0(4,R10),DS3EXTNT+16        ext 4 low                            
         L     R08,A#H5                                                         
         CALL  @RV#6HC,((R10),(R08),4)                                          
         MVC   0(3,R07),=X'040000'                      ( mbb )                 
         MVC   3(4,R07),DS3EXTNT+16        ext 4 high ( cchh )                  
         MVC   7(1,R07),R+3                ext 0 high ( cchh )                  
         BAL   R14,@E_A_TRK                allocation space compute             
         L     R09,ANUMALC#                  allocation track number            
         L     R10,0(R09)                                                       
         LA    R10,0(R10,R01)                                                   
         ST    R10,0(R09)                                                       
         BCTR  R06,0                                                            
         LTR   R06,R06                                                          
         BZ    @E_A_X                                                           
* --- extent 6 address ---                                                      
         L     R09,AEXT#5LO                                                     
         MVC   0(4,R09),DS3EXTNT+22        ext 5 high                           
         L     R08,A#L6                                                         
         CALL  @RV#6HC,((R09),(R08),4)                                          
         L     R10,AEXT#5HI                                                     
         MVC   0(4,R10),DS3EXTNT+26        ext 5 low                            
         L     R08,A#H6                                                         
         CALL  @RV#6HC,((R10),(R08),4)                                          
         MVC   0(3,R07),=X'050000'                      ( mbb )                 
         MVC   3(4,R07),DS3EXTNT+26        ext 5 high ( cchh )                  
         MVC   7(1,R07),R+3                ext 0 high ( cchh )                  
         BAL   R14,@E_A_TRK                allocation space compute             
         L     R09,ANUMALC#                  allocation track number            
         L     R10,0(R09)                                                       
         LA    R10,0(R10,R01)                                                   
         ST    R10,0(R09)                                                       
         BCTR  R06,0                                                            
         LTR   R06,R06                                                          
         BZ    @E_A_X                                                           
* --- extent 7 address ---                                                      
         L     R09,AEXT#6LO                                                     
         MVC   0(4,R09),DS3EXTNT+32        ext 6 high                           
         L     R08,A#L7                                                         
         CALL  @RV#6HC,((R09),(R08),4)                                          
         L     R10,AEXT#6HI                                                     
         MVC   0(4,R10),DS3EXTNT+36        ext 6 low                            
         L     R08,A#H7                                                         
         CALL  @RV#6HC,((R10),(R08),4)                                          
         MVC   0(3,R07),=X'060000'                      ( mbb )                 
         MVC   3(4,R07),DS3EXTNT+36        ext 6 high ( cchh )                  
         MVC   7(1,R07),R+3                ext 0 high ( cchh )                  
         BAL   R14,@E_A_TRK                allocation space compute             
         L     R09,ANUMALC#                  allocation track number            
         L     R10,0(R09)                                                       
         LA    R10,0(R10,R01)                                                   
         ST    R10,0(R09)                                                       
         BCTR  R06,0                                                            
         LTR   R06,R06                                                          
         BZ    @E_A_X                                                           
* --- extent 8 address ---                                                      
         L     R09,AEXT#7LO                                                     
         MVC   0(4,R09),DS3ADEXT+2         ext 7 high                           
         L     R08,A#L8                                                         
         CALL  @RV#6HC,((R09),(R08),4)                                          
         L     R10,AEXT#7HI                                                     
         MVC   0(4,R10),DS3ADEXT+6         ext 7 low                            
         L     R08,A#H8                                                         
         CALL  @RV#6HC,((R10),(R08),4)                                          
         MVC   0(3,R07),=X'070000'                      ( mbb )                 
         MVC   3(4,R07),DS3ADEXT+6         ext 7 high ( cchh )                  
         MVC   7(1,R07),R+3                ext 0 high ( cchh )                  
         BAL   R14,@E_A_TRK                allocation space compute             
         L     R09,ANUMALC#                  allocation track number            
         L     R10,0(R09)                                                       
         LA    R10,0(R10,R01)                                                   
         ST    R10,0(R09)                                                       
         BCTR  R06,0                                                            
         LTR   R06,R06                                                          
         BZ    @E_A_X                                                           
* --- extent 9 address ---                                                      
         L     R09,AEXT#8LO                                                     
         MVC   0(4,R09),DS3ADEXT+12        ext 8 high                           
         L     R08,A#L9                                                         
         CALL  @RV#6HC,((R09),(R08),4)                                          
         L     R10,AEXT#8HI                                                     
         MVC   0(4,R10),DS3ADEXT+16        ext 8 low                            
         L     R08,A#H9                                                         
         CALL  @RV#6HC,((R10),(R08),4)                                          
         MVC   0(3,R07),=X'080000'                      ( mbb )                 
         MVC   3(4,R07),DS3ADEXT+16        ext 8 high ( cchh )                  
         MVC   7(1,R07),R+3                ext 0 high ( cchh )                  
         BAL   R14,@E_A_TRK                allocation space compute             
         L     R09,ANUMALC#                  allocation track number            
         L     R10,0(R09)                                                       
         LA    R10,0(R10,R01)                                                   
         ST    R10,0(R09)                                                       
         BCTR  R06,0                                                            
         LTR   R06,R06                                                          
         BZ    @E_A_X                                                           
* --- extent 10 address ---                                                     
         L     R09,AEXT#9LO                                                     
         MVC   0(4,R09),DS3ADEXT+22        ext 9 high                           
         L     R08,A#L10                                                        
         CALL  @RV#6HC,((R09),(R08),4)                                          
         L     R10,AEXT#9HI                                                     
         MVC   0(4,R10),DS3ADEXT+26        ext 9 low                            
         L     R08,A#H10                                                        
         CALL  @RV#6HC,((R10),(R08),4)                                          
         MVC   0(3,R07),=X'090000'                      ( mbb )                 
         MVC   3(4,R07),DS3ADEXT+26        ext 9 high ( cchh )                  
         MVC   7(1,R07),R+3                ext 0 high ( cchh )                  
         BAL   R14,@E_A_TRK                allocation space compute             
         L     R09,ANUMALC#                  allocation track number            
         L     R10,0(R09)                                                       
         LA    R10,0(R10,R01)                                                   
         ST    R10,0(R09)                                                       
         BCTR  R06,0                                                            
         LTR   R06,R06                                                          
         BZ    @E_A_X                                                           
* --- extent 11 address ---                                                     
         L     R09,AEXT#ALO                                                     
         MVC   0(4,R09),DS3ADEXT+32        ext 10 high                          
         L     R08,A#L11                                                        
         CALL  @RV#6HC,((R09),(R08),4)                                          
         L     R10,AEXT#AHI                                                     
         MVC   0(4,R10),DS3ADEXT+36        ext 10 low                           
         L     R08,A#H11                                                        
         CALL  @RV#6HC,((R10),(R08),4)                                          
         MVC   0(3,R07),=X'0A0000'                       ( mbb )                
         MVC   3(4,R07),DS3ADEXT+36        ext 10 high ( cchh )                 
         MVC   7(1,R07),R+3                ext 0 high ( cchh )                  
         BAL   R14,@E_A_TRK                allocation space compute             
         L     R09,ANUMALC#                  allocation track number            
         L     R10,0(R09)                                                       
         LA    R10,0(R10,R01)                                                   
         ST    R10,0(R09)                                                       
         BCTR  R06,0                                                            
         LTR   R06,R06                                                          
         BZ    @E_A_X                                                           
* --- extent 12 address ---                                                     
         L     R09,AEXT#BLO                                                     
         MVC   0(4,R09),DS3ADEXT+42        ext 11 high                          
         L     R08,A#L12                                                        
         CALL  @RV#6HC,((R09),(R08),4)                                          
         L     R10,AEXT#BHI                                                     
         MVC   0(4,R10),DS3ADEXT+46        ext 11 low                           
         L     R08,A#H12                                                        
         CALL  @RV#6HC,((R10),(R08),4)                                          
         MVC   0(3,R07),=X'0B0000'                       ( mbb )                
         MVC   3(4,R07),DS3ADEXT+46        ext 11 high ( cchh )                 
         MVC   7(1,R07),R+3                ext 0 high ( cchh )                  
         BAL   R14,@E_A_TRK                allocation space compute             
         L     R09,ANUMALC#                  allocation track number            
         L     R10,0(R09)                                                       
         LA    R10,0(R10,R01)                                                   
         ST    R10,0(R09)                                                       
         BCTR  R06,0                                                            
         LTR   R06,R06                                                          
         BZ    @E_A_X                                                           
* --- extent 13 address ---                                                     
         L     R09,AEXT#CLO                                                     
         MVC   0(4,R09),DS3ADEXT+52        ext 12 high                          
         L     R08,A#L13                                                        
         CALL  @RV#6HC,((R09),(R08),4)                                          
         L     R10,AEXT#CHI                                                     
         MVC   0(4,R10),DS3ADEXT+56        ext 12 low                           
         L     R08,A#H13                                                        
         CALL  @RV#6HC,((R10),(R08),4)                                          
         MVC   0(3,R07),=X'0C0000'                       ( mbb )                
         MVC   3(4,R07),DS3ADEXT+56        ext 12 high ( cchh )                 
         MVC   7(1,R07),R+3                ext 0 high ( cchh )                  
         BAL   R14,@E_A_TRK                allocation space compute             
         L     R09,ANUMALC#                  allocation track number            
         L     R10,0(R09)                                                       
         LA    R10,0(R10,R01)                                                   
         ST    R10,0(R09)                                                       
         BCTR  R06,0                                                            
         LTR   R06,R06                                                          
         BZ    @E_A_X                                                           
* --- extent 14 address ---                                                     
         L     R09,AEXT#DLO                                                     
         MVC   0(4,R09),DS3ADEXT+62        ext 13 high                          
         L     R08,A#L14                                                        
         CALL  @RV#6HC,((R09),(R08),4)                                          
         L     R10,AEXT#DHI                                                     
         MVC   0(4,R10),DS3ADEXT+66        ext 13 low                           
         L     R08,A#H14                                                        
         CALL  @RV#6HC,((R10),(R08),4)                                          
         MVC   0(3,R07),=X'0D0000'                       ( mbb )                
         MVC   3(4,R07),DS3ADEXT+66        ext 13 high ( cchh )                 
         MVC   7(1,R07),R+3                ext 0 high ( cchh )                  
         BAL   R14,@E_A_TRK                allocation space compute             
         L     R09,ANUMALC#                  allocation track number            
         L     R10,0(R09)                                                       
         LA    R10,0(R10,R01)                                                   
         ST    R10,0(R09)                                                       
         BCTR  R06,0                                                            
         LTR   R06,R06                                                          
         BZ    @E_A_X                                                           
* --- extent 15 address ---                                                     
         L     R09,AEXT#ELO                                                     
         MVC   0(4,R09),DS3ADEXT+72        ext 14 high                          
         L     R08,A#L15                                                        
         CALL  @RV#6HC,((R09),(R08),4)                                          
         L     R10,AEXT#EHI                                                     
         MVC   0(4,R10),DS3ADEXT+76        ext 14 low                           
         L     R08,A#H15                                                        
         CALL  @RV#6HC,((R10),(R08),4)                                          
         MVC   0(3,R07),=X'0E0000'                       ( mbb )                
         MVC   3(4,R07),DS3ADEXT+76        ext 14 high ( cchh )                 
         MVC   7(1,R07),R+3                ext 0 high ( cchh )                  
         BAL   R14,@E_A_TRK                allocation space compute             
         L     R09,ANUMALC#                  allocation track number            
         L     R10,0(R09)                                                       
         LA    R10,0(R10,R01)                                                   
         ST    R10,0(R09)                                                       
         BCTR  R06,0                                                            
         LTR   R06,R06                                                          
         BZ    @E_A_X                                                           
* --- extent 16 address ---                                                     
         L     R09,AEXT#FLO                                                     
         MVC   0(4,R09),DS3ADEXT+82        ext 15 high                          
         L     R08,A#L16                                                        
         CALL  @RV#6HC,((R09),(R08),4)                                          
         L     R10,AEXT#FHI                                                     
         MVC   0(4,R10),DS3ADEXT+86        ext 15 low                           
         L     R08,A#H16                                                        
         CALL  @RV#6HC,((R10),(R08),4)                                          
         MVC   0(3,R07),=X'0F0000'                       ( mbb )                
         MVC   3(4,R07),DS3ADEXT+86        ext 15 high ( cchh )                 
         MVC   7(1,R07),R+3                ext 0 high ( cchh )                  
         BAL   R14,@E_A_TRK                allocation space compute             
         L     R09,ANUMALC#                  allocation track number            
         L     R10,0(R09)                                                       
         LA    R10,0(R10,R01)                                                   
         ST    R10,0(R09)                                                       
         BCTR  R06,0                                                            
         LTR   R06,R06                                                          
         BZ    @E_A_X                                                           
**                                                                              
@E_A_X   EQU   *                                                                
         L     R01,AT#CHR                                                       
         L     R02,A#AEP                                                        
         CALL  @RV#6HC,((R01),(R02),8)                                          
         L     R01,APDSF                                                        
         L     R01,44(R01)                                                      
         N     R01,=X'00FFFFFF'                                                 
         L     R02,AT#CHR                                                       
         BAL   R14,@CNVTTR                    convert ttr -> mbbcchhr           
         L     R02,A#AEP2                                                       
         ST    R00,W_TTR                                                        
         CALL  @RV#6HC,(W_TTR,(R02),3)                                          
*        L     R01,ANUMALC#                  allocation track number            
*        L     R02,A#ALC                                                        
*        CALL  @RV#6HC,((R01),(R02),4)                                          
         L     R08,ANUMALC#                  allocation track number            
         L     R08,0(R08)                    allocation track number            
         CVD   R08,PK_AREA                                                      
         UNPK  UPK_AREA(8),PK_AREA(8)                                           
         OI    UPK_AREA+7,X'F0'                                                 
         L     R01,A#ALC                                                        
         MVC   0(5,R01),UPK_AREA+3                                              
         DROP  R11                                                              
         DROP  R12                                                              
* --- end of sub routine ---                                                    
         L     R13,SAVEAREA+4                                                   
         RETURN (14,12),RC=0                                                    
@E_A_TRK EQU   *                                                                
         STM   R03,R00,REGS                                                     
         XR    R06,R06                                                          
         LH    R06,0(R10)                                                       
         SH    R06,0(R09)                                                       
         L     R07,ANUMTRK#                                                     
         MH    R06,0(R07)                                                       
         AH    R06,2(R10)                                                       
         SH    R06,2(R09)                                                       
         LA    R01,1(R06)                                                       
         LM    R03,R00,REGS                                                     
         BR    R14                                                              
*-------------------------------------------------------------------            
*-------- convert mbcchhr to ttr -----------------------------------            
*-------------------------------------------------------------------            
@CNVTTR  EQU   *                                                                
         STM   R03,R15,REGS                                                     
         L     R12,CVTPTR                                                       
         USING CVTMAP,R12                                                       
         L     R15,CVTPRLTV                                                     
         DROP  R12                                                              
         BALR  R14,R15                                                          
         LM    R03,R15,REGS                                                     
         BR    R14                                                              
@CNVCHR  EQU   *                                                                
         STM   R03,R15,REGS                                                     
         L     R12,CVTPTR                                                       
         USING CVTMAP,R12                                                       
         L     R15,CVTPCNVT                                                     
         DROP  R12                                                              
         BALR  R14,R15                                                          
         LM    R03,R15,REGS                                                     
         BR    R14                                                              
*                                                                               
         DS    0F                                                               
* --- SAVE AREA ---                                                             
SAVEAREA DS    18F                     savearea                                 
APDSF    DC    V(PDSF)                 dcb address                              
AOSJFCB  DC    V(POSJFCB)              jfcb ( rdjfcb )                          
AI#VOL   DC    V(I#VOL)                volume serial                            
AI#DSN   DC    V(I#DSN)                volume serial                            
ACK#DSOR DC    V(CK#DSORG)             dataset organization                     
ACK#RFM  DC    V(CK#RFM)               record format                            
ACK#BLKS DC    V(CK#BLKSZ)             record format                            
ACK#LRL  DC    V(CK#LRECL)             record format                            
A#BLKSZ  DC    V(O#BLKSZ)              block size                               
A#LRECL  DC    V(O#LRECL)              logical record length                    
A#DBLK   DC    V(O#DBLK)               directory block number                   
ANUMCYL# DC    V(NUMCYL#)              number of cylinder                       
ANUMTRK# DC    V(NUMTRK#)              track number of 1 cylinder               
ANUMALC# DC    V(NUMALC#)              track number of 1 cylinder               
AE#TTR   DC    V(E#TTR)                end of ttr                               
A#AUP2   DC    V(O#AUP2)               end of ttr ( display area )              
AE#CHR   DC    V(E#CHR)                end of cchhr                             
A#AUP    DC    V(O#AUP)                end of cchhr ( display area )            
A#ASP    DC    V(O#ASP)                start of cchhr                           
A#AEP    DC    V(O#AEP)                end of address                           
A#AEP2   DC    V(O#AEP2)               end of address                           
AEXT#    DC    V(EXT#)                 extent                                   
A#EXT    DC    V(O#EXT)                extent                                   
A#SYSCD  DC    V(O#SYSCD)              system code                              
A#CRE    DC    V(O#CRE)                create code                              
A#USE    DC    V(O#USE)                create code                              
A#ALC    DC    V(O#ALC)                create code                              
W_CHR    DS    0F,XL8                                                           
W_TTR    DS    0F,XL4                                                           
A#EXP    DC    V(O#EXP)                                                         
AT#CHR   DC    V(T#CHR)                                                         
AEXT#XXX DC    V(EXT#XXX)                                                       
AEXT#0LO DC    V(EXT#0LO)                                                       
AEXT#1LO DC    V(EXT#1LO)                                                       
AEXT#2LO DC    V(EXT#2LO)                                                       
AEXT#3LO DC    V(EXT#3LO)                                                       
AEXT#4LO DC    V(EXT#4LO)                                                       
AEXT#5LO DC    V(EXT#5LO)                                                       
AEXT#6LO DC    V(EXT#6LO)                                                       
AEXT#7LO DC    V(EXT#7LO)                                                       
AEXT#8LO DC    V(EXT#8LO)                                                       
AEXT#9LO DC    V(EXT#9LO)                                                       
AEXT#ALO DC    V(EXT#ALO)                                                       
AEXT#BLO DC    V(EXT#BLO)                                                       
AEXT#CLO DC    V(EXT#CLO)                                                       
AEXT#DLO DC    V(EXT#DLO)                                                       
AEXT#ELO DC    V(EXT#ELO)                                                       
AEXT#FLO DC    V(EXT#FLO)                                                       
AEXT#0HI DC    V(EXT#0HI)                                                       
AEXT#1HI DC    V(EXT#1HI)                                                       
AEXT#2HI DC    V(EXT#2HI)                                                       
AEXT#3HI DC    V(EXT#3HI)                                                       
AEXT#4HI DC    V(EXT#4HI)                                                       
AEXT#5HI DC    V(EXT#5HI)                                                       
AEXT#6HI DC    V(EXT#6HI)                                                       
AEXT#7HI DC    V(EXT#7HI)                                                       
AEXT#8HI DC    V(EXT#8HI)                                                       
AEXT#9HI DC    V(EXT#9HI)                                                       
AEXT#AHI DC    V(EXT#AHI)                                                       
AEXT#BHI DC    V(EXT#BHI)                                                       
AEXT#CHI DC    V(EXT#CHI)                                                       
AEXT#DHI DC    V(EXT#DHI)                                                       
AEXT#EHI DC    V(EXT#EHI)                                                       
AEXT#FHI DC    V(EXT#FHI)                                                       
A#XXX    DC    V(O#XXX)                                                         
A#H1     DC    V(O#H1)                                                          
A#H2     DC    V(O#H2)                                                          
A#H3     DC    V(O#H3)                                                          
A#H4     DC    V(O#H4)                                                          
A#H5     DC    V(O#H5)                                                          
A#H6     DC    V(O#H6)                                                          
A#H7     DC    V(O#H7)                                                          
A#H8     DC    V(O#H8)                                                          
A#H9     DC    V(O#H9)                                                          
A#H10    DC    V(O#H10)                                                         
A#H11    DC    V(O#H11)                                                         
A#H12    DC    V(O#H12)                                                         
A#H13    DC    V(O#H13)                                                         
A#H14    DC    V(O#H14)                                                         
A#H15    DC    V(O#H15)                                                         
A#H16    DC    V(O#H16)                                                         
A#L1     DC    V(O#L1)                                                          
A#L2     DC    V(O#L2)                                                          
A#L3     DC    V(O#L3)                                                          
A#L4     DC    V(O#L4)                                                          
A#L5     DC    V(O#L5)                                                          
A#L6     DC    V(O#L6)                                                          
A#L7     DC    V(O#L7)                                                          
A#L8     DC    V(O#L8)                                                          
A#L9     DC    V(O#L9)                                                          
A#L10    DC    V(O#L10)                                                         
A#L11    DC    V(O#L11)                                                         
A#L12    DC    V(O#L12)                                                         
A#L13    DC    V(O#L13)                                                         
A#L14    DC    V(O#L14)                                                         
A#L15    DC    V(O#L15)                                                         
A#L16    DC    V(O#L16)                                                         
* --- Error Message ---                                                         
ERRMSG01 DC    CL79'*** RDJFCB Error ***'                                       
ERRMSG02 DC    CL79'*** OBTAIN Error ( DSCB - Type 4 ) ***'                     
ERRMSG03 DC    CL79'*** OBTAIN Error ( DSCB - Type 1 ) ***'                     
ERRMSG99 DC    CL79'*** @@@@@@@@ @@@@@@@ ***'                                   
* --- Convert Hexa to Char Routine Work Area ---                                
REGS     DS    18F                               WORK SAVEAREA                  
         DS    0D                                                               
* --- Panel RC Packed Area ---                                                  
PK_AREA  DC    PL8'0'                                                           
UPK_AREA DC    CL16' '                                                          
         DS    0F                                                               
* --- hexa to character convert ( translate character ) ---                     
*R       DC    C'0123456789ABCDEF'               CHAR TRUNC TABLE               
*_TR     DC    A(TR)                                                            
* --- dscb search ---                                                           
DSCBFMT1 CAMLST SEARCH,DSCB1DSN,VOLUME,DSCB1                                    
DSCBFMT3 CAMLST SEEK,DSCB3CHR,VOLUME,DSCB3                                      
DSCBFMT4 CAMLST SEARCH,DSCB4DSN,VOLUME,DSCB4                                    
VOLUME   DS    CL6                                                              
R        DS    F                                                                
DSCB3CHR DS    CL6                                                              
JFCB1    DS    0CL176                      job file control block               
DSCB1DSN DS    CL44                                                             
DSCB1    DS    CL140                                                            
DSCB3    DS    CL140                                                            
*                                                                               
JFCB4    DS    0CL176                      job file control block               
DSCB4DSN DS    CL44                        dataset name                         
DSCB4    DS    CL140                       dataset control block                
         DS    0F                                                               
         LTORG                                                                  
JFCBSECT DSECT                                                                  
         IEFJFCBN LIST=YES                                                      
DSCBSEC1 DSECT                                                                  
         IECSDSL1 (1)                                                           
DSCBSEC3 DSECT                                                                  
         IECSDSL1 (3)                                                           
DSCBSEC4 DSECT                                                                  
         IECSDSL1 (4)                                                           
         IEFUCBOB LIST=YES                                                      
         DCBD  DSORG=PO,DEVD=DA                                                 
         CVT   DSECT=YES,LIST=YES                                               
R00      EQU   00                                                               
R01      EQU   01                                                               
R02      EQU   02                                                               
R03      EQU   03                                                               
R04      EQU   04                                                               
R05      EQU   05                                                               
R06      EQU   06                                                               
R07      EQU   07                                                               
R08      EQU   08                                                               
R09      EQU   09                                                               
R10      EQU   10                                                               
R11      EQU   11                                                               
R12      EQU   12                                                               
R13      EQU   13                                                               
R14      EQU   14                                                               
R15      EQU   15                                                               
         END   @RV#6DC                                                          
/*                                                                              
//SYSLIB   DD  DSN=SYS1.MACLIB,DISP=SHR                                         
//         DD  DSN=SYS1.AMODGEN,DISP=SHR                                        
//SYSUT1   DD UNIT=(SYSALLDA,SEP=SYSLIB),SPACE=(CYL,(10,5)),DSN=&SYSUT1         
//SYSPUNCH DD  DUMMY                                                            
//SYSPRINT DD  SYSOUT=*,DCB=(BLKSIZE=3509),                                     
//         UNIT=(,SEP=(SYSUT1,SYSPUNCH))                                        
//*YSLIN   DD  DISP=(,PASS),UNIT=SYSALLDA,SPACE=(CYL,(5,5,0)),                  
//*        DCB=(BLKSIZE=400),DSN=&&LOADSET                                      
//SYSLIN   DD DSN=object.library(@RV#6DC),DISP=OLD             <- CHECK         
//D       EXEC PGM=IEV90,PARM=OBJECT,REGION=2000K                               
//SYSIN    DD  *                                                                
         START                                                                  
         DC   C'<< Oh Shock ! >> Version 6 ( '                                  
REV      DC   CL6'v6r1m1'                                                       
         DC   C' ) _ Kimu  // Compiled Date : &SYSDATE _ &SYSTIME '             
         PRINT NOGEN                                                            
@RV#6HC  CSECT                                                                  
         SAVE  (14,12),T,*                                                      
         BALR  R03,0                                                            
         USING *,R03                       Base Reg. R03                        
         ST    R13,SAVEAREA+4              Save A(OLD SaveArea)                 
         LR    R12,R13                                                          
         LA    R13,SAVEAREA                                                     
         ST    R13,8(R12)                  Save A(NEW SaveArea)                 
* --- from characher ---                                                        
         L     R07,0(R01)                                                       
* --- to character ---                                                          
         L     R08,4(R01)                                                       
* --- convert length ---                                                        
         L     R09,8(R01)                                                       
*        LA    R07,ALLOCER                                                      
*        LA    R08,ERRMSG02+30                                                  
*        LA    R09,4                                                            
*        BAL   R14,@CO_HEX                     CALL CONVERT HEX-CHAR            
@CO_HEX  EQU   *                               CONVERT HEX-CHARACTER            
         LA    R15,5                                                            
@CO_HC   EQU   *                                                                
         LTR   R09,R09                                                          
         BZ    @CO_EXIT                                                         
         BCT   R15,@CO_SKIP                                                     
*                                                                               
         MVI   0(R08),X'40'                                                     
         LA    R08,1(R08)                                                       
         LA    R15,4                                                            
@CO_SKIP EQU   *                                                                
         SR    R01,R01                                                          
         IC    R01,0(R07)                                                       
         SRL   R01,4                                                            
         A     R01,A_TR                                                         
         ICM   R02,B'0010',0(R01)                                               
         IC    R01,0(R07)                                                       
         N     R01,=F'15'                                                       
         A     R01,A_TR                                                         
         ICM   R02,B'0001',0(R01)                                               
         STCM  R02,B'0011',0(R08)                                               
         LA    R07,1(R07)                                                       
         LA    R08,2(R08)                                                       
         BCTR  R09,0                                                            
         B     @CO_HC                                                           
@CO_EXIT EQU   *                                                                
         L     R13,SAVEAREA+4                                                   
         RETURN (14,12),RC=0                                                    
*                                                                               
SAVEAREA DS    18F                               WORK SAVEAREA                  
TR       DC    C'0123456789ABCDEF'               CHAR TRUNC TABLE               
A_TR     DC    A(TR)                                                            
         LTORG                                                                  
R00      EQU   00                                                               
R01      EQU   01                                                               
R02      EQU   02                                                               
R03      EQU   03                                                               
R04      EQU   04                                                               
R05      EQU   05                                                               
R06      EQU   06                                                               
R07      EQU   07                                                               
R08      EQU   08                                                               
R09      EQU   09                                                               
R10      EQU   10                                                               
R11      EQU   11                                                               
R12      EQU   12                                                               
R13      EQU   13                                                               
R14      EQU   14                                                               
R15      EQU   15                                                               
         END   @RV#6HC                                                          
/*                                                                              
//SYSLIB   DD  DSN=SYS1.MACLIB,DISP=SHR                                         
//         DD  DSN=SYS1.AMODGEN,DISP=SHR                                        
//SYSUT1   DD UNIT=(SYSALLDA,SEP=SYSLIB),SPACE=(CYL,(10,5)),DSN=&SYSUT1         
//SYSPUNCH DD  DUMMY                                                            
//*YSPUNCH DD  SYSOUT=*,DCB=(BLKSIZE=800),SPACE=(CYL,(5,5,0))                   
//SYSPRINT DD  SYSOUT=*,DCB=(BLKSIZE=3509),                                     
//         UNIT=(,SEP=(SYSUT1,SYSPUNCH))                                        
//*YSLIN   DD  DISP=(,PASS),UNIT=SYSALLDA,SPACE=(CYL,(5,5,0)),                  
//*        DCB=(BLKSIZE=400),DSN=&&LOADSET                                      
//SYSLIN   DD DSN=object.library(@RV#6HC),DISP=OLD             <- CHECK         
//E       EXEC PGM=IEV90,PARM=OBJECT,REGION=2000K                               
//SYSIN    DD  *                                                                
         START                                                                  
         PRINT NOGEN                                                            
         DC   C'<< Oh Shock ! _ Track Calculator >> Version 6 ( '               
REV      DC   CL6'V6R1M2'                                                       
         DC   C' ) _ Kimu  // Compiled Date : &SYSDATE _ &SYSTIME '             
* RC                                                                            
*    0 : OK ( RETURN BLOCK# -> R00 )                                            
*    4 : Block Size Over .                                                      
*    8 : Block Size Over .                                                      
*   12 : UCB Error                                                              
*   16 : Volume Serial Not Found .                                              
*                                                                               
@RV#6TC  CSECT                                                                  
         SAVE  (14,12),T,*                                                      
         BALR  R03,0                                                            
         USING *,R03,R04,R05,R06           BASE REG. R03                        
         LA    R04,2048(R03)                                                    
         LA    R04,2048(R04)               2ND BASE REG. R04                    
         LA    R05,2048(R04)                                                    
         LA    R05,2048(R05)               3RD BASE REG. R05                    
         LA    R06,2048(R05)                                                    
         LA    R06,2048(R06)               4RD BASE REG. R06                    
         ST    R13,SAVEAREA+4              SAVE A(OLD SAVEAREA)                 
         LR    R12,R13                                                          
         LA    R13,SAVEAREA                                                     
         ST    R13,8(R12)                  SAVE A(NEW SAVEAREA)                 
*                                                                               
         L     R02,0(R01)                                                       
         MVC   VOLSER(6),0(R02)            VOLSER                               
         L     R02,4(R01)                                                       
         MVC   @DD(2),0(R02)                                                    
         L     R02,8(R01)                                                       
         ST    R02,NUM#A                                                        
*                                                                               
         L     R12,CVTPTR              CVT ADDR. ( PSA + X'10' )                
         USING CVTMAP,R12                                                       
*                                                                               
         XC    UCBWORK,UCBWORK                                                  
         MVI   DEVCLASS,UCB3DACC                                                
         OI    PARMUCB,X'80'                                                    
*                                                                               
UCB_SCAN EQU   *                                                                
         LA    R01,PARMLIST                                                     
         L     R15,CVTUCBSC                                                     
         BALR  R14,R15                                                          
         LTR   R15,R15                                                          
         BNZ   END_SCAN                                                         
         USING UCBOB,R11                                                        
         L     R11,UCBPTR                                                       
*                                                                               
         TM    UCBSTAT,X'80'                                                    
         BNO   UCB_SCAN                                                         
*                                                                               
         CLC   UCBVOLI,VOLSER                                                   
         BE    UCB_OK                                                           
         B     UCB_SCAN                                                         
         DROP  R11                                                              
         DROP  R12                                                              
*********                                                                       
UCB_OK   EQU   *                                                                
         TRKCALC FUNCTN=TRKCAP,UCB=UCBPTR,RKDD=RKDD,                   *        
                REGSAVE=YES                                                     
         LTR   R15,R15                                                          
         BZ    UCB_SAVE                                                         
         ST    R15,RC#                                                          
         CALL  @RV#6DA,(RC#,ERRMSG01+28,4)                                      
         TPUT  ERRMSG01,L'ERRMSG01                                              
         L     R15,RC#                                                          
         B     @BYE                                                             
UCB_SAVE EQU   *                                                                
         L     R01,NUM#A                                                        
         ST    R00,0(R01)                                                       
*** END OF PROCESS ***********************************************              
@BYE     EQU   *                                                                
         L     R13,SAVEAREA+4                                                   
         RETURN (14,12),RC=(15)                                                 
******************************************************************              
END_SCAN EQU   *                                                                
         LA    R15,16                                                           
         B     @BYE                                                             
******************************************************************              
MSG      DC    CL80'********* @@@@@@@@ ********'                                
*                                                                               
         DS    0F                                                               
SAVEAREA DS    18F                               SAVEAREA                       
VOLSER   DS    CL6                                                              
RKDD     DS    0F                                                               
@R       DC    X'01'                                                            
@K       DC    X'00'                                                            
@DD      DS    H                                                                
*                                                                               
NUM#A    DS    F                                                                
BLK#     DS    F                                                                
RC#      DS    F                                                                
*                                                                               
PARMLIST DS    3F                                                               
         ORG   PARMLIST                                                         
PARMWA   DC    A(UCBWORK)                                                       
PARMDEVT DC    A(DEVCLASS)                                                      
PARMUCB  DC    A(UCBPTR)                                                        
*                                                                               
         DS    0D                                                               
UCBWORK  DS    CL100                                                            
DEVCLASS DS    CL1                                                              
UCBPTR   DS    F                                                                
*                                                                               
ERRMSG01 DC    CL80'*** TRKCALC ERROR HAPPEND !! RC:@@@@@@@@ ***'               
*                                                                               
         LTORG                                                                  
         DSECT                                                                  
         IEFUCBOB LIST=YES                                                      
         CVT   DSECT=YES,LIST=YES                                               
R00      EQU   00                                                               
R01      EQU   01                                                               
R02      EQU   02                                                               
R03      EQU   03                                                               
R04      EQU   04                                                               
R05      EQU   05                                                               
R06      EQU   06                                                               
R07      EQU   07                                                               
R08      EQU   08                                                               
R09      EQU   09                                                               
R10      EQU   10                                                               
R11      EQU   11                                                               
R12      EQU   12                                                               
R13      EQU   13                                                               
R14      EQU   14                                                               
R15      EQU   15                                                               
         END   @RV#6TC                                                          
/*                                                                              
//SYSLIB   DD  DSN=SYS1.MACLIB,DISP=SHR                                         
//         DD  DSN=SYS1.AMODGEN,DISP=SHR                                        
//SYSUT1   DD UNIT=(SYSALLDA,SEP=SYSLIB),SPACE=(CYL,(10,5)),DSN=&SYSUT1         
//SYSPUNCH DD  DUMMY                                                            
//*YSPUNCH DD  SYSOUT=*,DCB=(BLKSIZE=800),SPACE=(CYL,(5,5,0))                   
//SYSPRINT DD  SYSOUT=*,DCB=(BLKSIZE=3509),                                     
//         UNIT=(,SEP=(SYSUT1,SYSPUNCH))                                        
//*YSLIN   DD  DISP=(,PASS),UNIT=SYSALLDA,SPACE=(CYL,(5,5,0)),                  
//*        DCB=(BLKSIZE=400),DSN=&&LOADSET                                      
//SYSLIN   DD DSN=object.library(@RV#6TC),DISP=OLD             <- CHECK         
//L       EXEC PGM=IEWL,PARM='MAP,LET,LIST',                                    
//         REGION=1M,COND=(8,LT)                                                
//SYSLIN   DD  DDNAME=SYSIN                                                     
//SYSUT1   DD  UNIT=SYSALLDA,SPACE=(CYL,(3,2)),DSN=&SYSUT1                      
//SYSPRINT DD  SYSOUT=*,DCB=(RECFM=FB,BLKSIZE=3509)                             
//LINK     DD  DSN=isp.sispload,DISP=SHR                       <- CHECK         
//OBJ      DD  DISP=SHR,UNIT=SYSALLDA,                                          
//         DSN=*.CREATE.OBJECT                                                  
//SYSLMOD  DD  DISP=SHR,UNIT=SYSALLDA,                                          
//         DSN=*.CREATE.LOAD                                                    
//SYSIN    DD  *                                                                
 INCLUDE OBJ(@RV#080)                                                           
 INCLUDE OBJ(@RV#6DA)                                                           
 INCLUDE OBJ(@RV#6DC)                                                           
 INCLUDE OBJ(@RV#6HC)                                                           
 INCLUDE OBJ(@RV#6TC)                                                           
 INCLUDE LINK(ISPLINK)                                                          
 ENTRY   @RV#080                                                                
 NAME    @RV#0(R)                                                               
//                                                                              
