Writing A PDS With EXCP

For the next exercise I chose to write a PDS dataset using EXCP. There are several restrictions to this program:

  1. Members must be added is ascending name sequence
  2. The first track will be used for directory blocks. It doesnt matter how many directory blocks are specified on the initial allocation, the directory will be overwritten.
  3. The blocksize is hard coded to 3280 and the logical record length is hard coded to 80.
  4. ISPF statistics are not reloaded
  5. The dataset is completely overwritten and any previously existing data is lost.

I chose to use an IEBUPDTE style input.  I created my test data using the LISTPDS program (from the CBT Tape) using PARM=’NOLIST,DECK,UPDTE’ and ran it against my MVSSP source PDS.

The program can be found in the source (available in the downloads) under the name EXCPDS.

Program Overview

Input cards are read from the input file. Control cards have the sequence “./” in columns one and two. The only control card accepted is “./ ADD NAME=” to add a member to the dataset.

The first track of the dataset is used for directory blocks. A full track of directory blocks and an EOF will be written on the first track. It doesn’t matter how many directory blocks were initially allocated to the dataset, the original directory will be overwritten.

Member data will be written beginning on the second track (relative track number one). When all the data for a member has been written an EOF is written to mark then end of the member. A directory entry for the member is then added to the current directory block I/O buffer. Directory blocks are not written until they are completely full. When a directory blcok is full it is written to the directory track (relative track zero) and a new directory block is started.

When the final member is written to the dataset the directory “logical EOF” entry is written. This is a directory entry with the value x’FFFFFFFFFFFFFFFF’ (8 bytes of x’FF’). This is always the last entry in a PDS directory and does not point to a member.

Once the EOF entry is added to the directory block it is written. Empty directory blocks are then written to fill out the track. The last block written to the directory track is an EOF record.

There is a very basic program and there are several things that should be done to make it more useful. One would be to save up the directory entries in memory and then sort them before writing any data blocks. This would allow members to be added in any sequence.

It might also be good to initially read the directory to determine how many directory blocks initially exist in the dataset. The direcory blocks could then be written with an update write (Write Key+Data) instead of formatting the track.

I would also be possible without too much effort to then add members to the existing dataset instead of overwriting all previously existing data.

If really large amounts of data was being added blocks could be buffered up and written out a track at a time to reduce the number of EXCPs (I/O requests) which would speed up operation. We could also use multiple buffers for output so while one track was writing the next tracks buffers could be under construction.

This would result in a high performance PDS loader.

EXCPDS Code

         OPEN  (SYSPRINT,OUTPUT)       OPEN SYSPRINT DCB 
         TM    SYSPRINT+48,X'10'       WAS IT SUCCESSFUL 
         BO    OPEN010                    YES - BRANCH   
*                                                        
         WTO   'SYSPRINT FAILED TO OPEN',ROUTCDE=(1,11)  
         B     EXIT                                      
*                                                        
OPEN010  DS    0H                                        
         OPEN  (EXCPDCB,OUTPUT)        OPEN EXCPWRIT DCB 
         TM    EXCPDCB+48,X'10'        WAS IT SUCCESSFUL 
         BO    OPEN020                    YES - BRANCH   
*                                                        
         LOG   'EXCPWRIT FAILED TO OPEN'                 
         WTO   'EXCPWRIT FAILED TO OPEN',ROUTCDE=(1,11)  
         B     EXIT                                      
*                                                        
OPEN020  DS    0H                                        
         OPEN  (SYSIN,INPUT)           OPEN SYSIN DCB    
         TM    EXCPDCB+48,X'10'        WAS IT SUCCESSFUL 
         BO    OPEN040                    YES - BRANCH   
*                                                      
         LOG   'SYSIN FAILED TO OPEN'                  
         WTO   'SYSIN FAILED TO OPEN',ROUTCDE=(1,11)   
         B     EXIT                                    
*                                                      
*                                                      
OPEN040  DS    0H

We begin by opening the three DCBs. One for SYSPRINT, one for SYSIN which contains the IEBUPDTE stream, and the EXCP DCB used for the output dataset. If any DCB fails to open a message is logged and execution is terminated.

         GETMAIN R,LV=3280        DATA BLOCK BUFFER                
         ST    R1,BLKBUF          SAVE ADDRESS                     
*                                                                  
         GETMAIN R,LV=264         INDEX BLOCK BUFFER               
         ST    R1,IXBLKBUF        SAVE ADDRESS                     
*                                                                  
*                                 INITIALIZE DIRECTORY BLOCK BUFFER
         XC    0(8,R1),0(R1)      CLEAR KEY                        
         XC    8(256,R1),8(R1)    CLEAR DATA                       
         MVC   8(2,R1),=X'0002'   BYTES USED                       
*                                                                  
         RDJFCB (EXCPDCB)         READ JFCB FOR EXCPWRIT OUTPUT DS 
*                                                                  
         OBTAIN CAMSRCH           GET DSCB FOR EXCPWRIT            
*                                                                  
*                                                                  
         SLR   R1,R1                                               
         ICM   R1,B'0111',DSCB+X'36'   GET TTR OF LAST BLOCK USED  
         STCM  R1,B'0111',LASTBLK                                  
*                                                                     
         SLR   R1,R1                                                  
         ICM   R1,B'0011',DSCB+X'39'   GET TRACKBAL OF LAST TRACK USED
         STCM  R1,B'0011',TRKBAL

Next two I/O buffers are allocated using GETMAIN. The first is for the data blocks and is 3280 bytes which is the blocksize we will use for the output. The other is for the directory blocks and it is 264 bytes (256 bytes for the data plus 8 bytes for the key).

Next the directory block is initialized by clearing the buffer and then initializing the bytes used value which is the first two bytes in the data portion. This value is set to x’0002′ because the length uses up two bytes.

Next the JFCB is read to get the dataset name and volser. This information is used to read the format one DSCB to get the TTR of the last used block and the track balance for the last track used. This information is not currently used but would be needed if the output dataset was being extended instead of replacing all the contents.

         GET   SYSIN,INREC        READ AN INPUT RECORD
*                                                     
*                                                     
         CLC   =C'./',INREC       CONTROL RECORD      
         BE    MBR010                YES - BRANCH     
*                                                     
         LOG  'INVALID INPUT RECORD - NO ./ ADD'      
         B     EXIT

Processing begins by reading the first record from SYSIN and verifying it is a control record (./ ADD NAME=). If it is not a control record an error is logged and execution is terminated.

MBR010   DS    0H                                          
         CLI   FIRSTIME,0         FIRST TIME HERE          
         BNE   MBR020               YES - DON'T ISSUE STOW 
*                                                          
         BAL   R14,BLKWRITE       GO WRITE A BLOCK         
         BAL   R14,EOFWRITE       GO WRITE AN EOF          
*                                                          
         LA    R1,DIRNAME                                  
         BAL   R14,STOW           ADD "EOF" MEMBER ENTRY   
*

This begins the main processing loop. Each time a control record is detected (“./” in the first two bytes) control is transfered here. A first time switch is used to skip over the code to flush the member currently being loaded. If it is not the first time the current data block is flushed (written) to the output dataset. It may be a short block (less than 3280 bytes) but it will always be a multiple of 80 bytes. Next an EOF record is written to mark the end of the current member. Finally the directory entry is added by calling the STOW routine (please note this is done without using the STOW macro).

MBR020   DS    0H                                           
         MVI   FIRSTIME,0         CLEAR SWITCH              
         LA    R1,78              MAX BUFFER LENGTH         
         LA    R2,INREC+2         SKIP OVER ./              
MBR030   DS    0H                                           
         CLI   0(R2),C' '         SKIP BLANKS               
         BNE   MBR040                                       
         LA    R2,1(,R2)          NEXT CHAR                 
         BCT   R1,MBR030          LOOP BACK                 
         B     MBR900               - INVALID CONTROL CARD  
*                                                           
*                                                           
MBR040   DS    0H                                           
         CLC   =C'ADD ',0(R2)     ADD CARD                  
         BNE   MBR900                NO - ERROR             
*                                                           
         LA    R2,3(,R2)          SKIP OVER                 
         S     R1,=F'3'           ADJUST LENGTH             
MBR042   DS    0H                                           
         CLI   0(R2),C' '         SKIP BLANKS               
         BNE   MBR044                                       
         LA    R2,1(,R2)          NEXT CHAR               
         BCT   R1,MBR042          LOOP BACK               
         B     MBR900               - INVALID CONTROL CARD
*                                                         
*                                                         
MBR044   DS    0H                                         
         CLC   =C'NAME=',0(R2)    FOUND NAME=             
         BNE   MBR900                NO - ERROR           
*                                                         
         LA    R2,5(,R2)          POINT TO NAME           
         S     R1,=F'5'           ADJUST LENGTH           
*                                                         
         LA    R3,8               MAX NAME LENGTH         
         LA    R4,DIRNAME         TARGET PTR FOR MBR NAME 
         MVC   DIRNAME,=CL8' '    CLEAR MEMBER NAME       
MBR050   DS    0H                                         
         CLI   0(R2),C' '         LOOK FOR END OF NAME    
         BE    MBR060                                     
         MVC   0(1,R4),0(R2)      COPY CHAR               
         LA    R2,1(,R2)            NEXT INPUT BYTE       
         LA    R4,1(,R4)            NEXT OUTPUT BYTE       
         S     R1,=F'1'           ADJUST SOURCE LEN        
         BNP   MBR060             END IF END OF BUFFER     
         BCT   R3,MBR050          LOOP BACK FOR NEXT CHAR  
*                                                          
         CLI   0(R2),C' '         EXPECTING TO FIND A BLANK
         BNE   MBR910               -- NAME TOO LONG       
MBR060   DS    0H

This section of code scans the control statement and obtains the member name. I think it is all pretty straight forward so there is no need for additional comments.

         MVC   DIRTTR,CURTTR      ADDRESS OF NEXT RECORD TO WRITE 
         MVI   DIRC,0             NO USER DATA (FOR NOW)          
*                                                                 
         L     R8,BLKBUF          I/O BUFFER ADDRESS              
         SLR   R9,R9              ZERO LENGTH USED

Here is the initial processing for a new member. The TTR of the next block to be written is moved to the directory entry and the user data length is set to zero. Register 8 is primed with the current offset into the I/O buffer and register 9, which is used to contain the number of bytes used in the buffer, is set to zero.

MBR070   DS    0H                                       
         GET   SYSIN,INREC        GET NEXT RECORD       
         CLC   =C'./',INREC       CONTROL RECORD        
         BE    MBR010                YES - LOOP BACK    
*                                                       
         MVC   0(80,R8),INREC     COPY DATA             
         LA    R8,80(,R8)         NEXT RECORD           
         LA    R9,80(,R9)         ADJUST LENGTH         
         C     R9,=F'3280'        COMPARE TO BLOCK SIZE 
         BL    MBR070             LOOP BACK             
*                                                       
         BAL   R14,BLKWRITE       GO WRITE A BLOCK      
         L     R8,BLKBUF          I/O BUFFER ADDRESS    
         SLR   R9,R9              ZERO LENGTH           
         B     MBR070             LOOP BACK

This is the inner loop for processing all the input records for a single PDS member. First a check is made for a control record. If a control record is indicated we branch back to the main loop to finish up the current member and start processing for the new member.

If the record is not a control record it is copied into the output buffer. The buffer position pointer and the buffer length registers are incremented. If the output block is not full we simply loop back and read another card.

When the buffer is full we call the BLKWRITE routine to write it to the dataset and reset registers 8 and 9 before looping back.

MBR900   DS    0H                            
         LOG  'EPDS010E INVALID CONTROL CARD'
         B     EXIT                          
*                                            
*                                            
MBR910   DS    0H                            
         LOG  'EPDS011E MEMBER NAME TOO LONG'
         B     EXIT

If an error is detected an error message is logged and execution is terminated.

SYSINEOF DS    0H                                                 
         BAL   R14,BLKWRITE       FLUSH DATA BUFFER               
         BAL   R14,EOFWRITE       GO WRITE AN EOF                 
*                                                                 
         LA    R1,DIRNAME         STOW THE                        
         BAL   R14,STOW                   FINAL MEMBER            
*                                                                 
         MVC   DIRNAME,=X'FFFFFFFFFFFFFFFF'  "EOF" DIRECTORY ENTRY
         MVC   DIRTTR,=X'000000'                                  
         MVC   DIRC,=X'00'                                        
         LA    R1,DIRNAME                                         
         BAL   R14,STOW           ADD "EOF" MEMBER ENTRY

When EOF is detected on the input dataset we branch here (using the EODAD=SYSINEOF parameter on the DCB). The current data buffer is flushed and an EOF is written to finish out the current member. The directory entry is added using the STOW routine. We then need to add the “Logical EOF” directory entry. A member name of x’FFFFFFFFFFFFFFFF’ indicates the end of the directory. We add it using the STOW routine.

DIRCL010 DS    0H                                    
         SLR   R1,R1                                 
         ICM   R1,B'0111',IXTTR   GET TTR FOR BLOCK  
         ST    R1,WPARM+0         SAVE INTO PARM LIST
         L     R1,IXBLKBUF        I/O BUFFER         
         ST    R1,WPARM+4                            
         LA    R1,256             DATA LEN           
         ST    R1,WPARM+8                            
         LA    R1,8               KEY LEN            
         ST    R1,WPARM+12                           
         LA    R1,WPARM                              
         BAL   R14,WRITEBLK       GO WRITE THE BLOCK

Now we start a loop to fill the first track of the dataset with directory blocks. We start by flushing the current directory block. This is done by calling the WRITEBLK (which is our low-level write routine). We build a parameter list containing the TTR of the block to write, the I/O buffer, the data length, and the key length.

*                                                  
         SLR   R1,R1                               
         IC    R1,IXTTR+2         GET RECORD NUMBER
         LA    R1,1(,R1)          ADD ONE          
         STC   R1,IXTTR+2         SAVE IT BACK

Now the record number in the TTR for the next index block is incremented.

         L     R1,IXTKBAL         GET INDEX TRACK TRK BALANCE
         S     R1,KEYOH           SUBTRACT OUT KEY OVERHEAD  
         S     R1,=F'264'         SUBTRACK BLOCK+KEY LENGTH  
         ST    R1,IXTKBAL         SAVE UPDATED TRACK BALANCE

Here the track balance (bytes remaining) on the index track is updated.

         L     R1,IXBLKBUF        INITILIZE DIRECTORY BLOCK BUFFER
         XC    0(8,R1),0(R1)      CLEAR KEY                       
         XC    8(246,R1),8(R1)    CLEAR DATA                      
         STCM  R7,B'0011',8(R1)   BYTES USED IN BLOCK

Next the I/O buffer for the index block is reset to an empty block.

         L     R1,IXTKBAL         GET TRACK BALANCE          
         LA    R2,264             IX BLK KEY+DATA LEN        
         A     R2,KEYOH           BLK OVERHEAD               
         A     R2,NKEYOH          EOF OVERHEAD               
         CR    R1,R2              ROOM FOR DATA BLOCK + EOF  
         BH    DIRCL010             YES - GO WRITE FILL BLOCK

Now we check to see if there is enough room on the track to write another directory block and an EOF record on the index track. If both blocks will fit we can loop back and write the empty directory block.

         SLR   R1,R1                                         
         ICM   R1,B'0111',IXTTR    GET TTR FOR BLOCK         
         ST    R1,WPARM+0         SAVE INTO PARM LIST        
         LA    R1,IXBLKBUF        I/O BUFFER                 
         ST    R1,WPARM+4                                    
         LA    R1,0               DATA LEN                   
         ST    R1,WPARM+8                                    
         LA    R1,0               KEY LEN                    
         ST    R1,WPARM+12                                   
         LA    R1,WPARM                                      
         BAL   R14,WRITEBLK       GO WRITE EOF FOR DIRECTORY 
*                                                            
         B     EXIT

If there is not enough room for a directory block and an EOF record we write the EOF to complete the directory portion of the PDS. We then clean up and exit. An EOF is simply a record with a key length of zero and a data length of zero.

BLKWRITE – Write A Data Block

This routine is called to write a data block (member data) to the PDS. This routine does not write on the directory track.

BLKWRITE DS    0H                                                  
         STM   R14,R12,12(R13)    SAVE CALLERS REGISTERS           
         LA    R14,SAVEA3         CHAIN                            
         ST    R13,4(,R14)             ON                          
         ST    R14,8(,R13)               SAVE                      
         LR    R13,R14                       AREA                  
*                                                                  
*                                                                  
         LR    R1,R9              BLOCK SIZE                       
         A     R1,NKEYOH          ADD IN BLOCK OVERHEAD            
         C     R1,CURTKBAL        COMPARE TO CURRENT TRACK BALANCE 
         BL    BLKW010              RECORD WILL FIT ON TRACK

We start by saving the caller’s registers.  Next we determine if there is sufficient room on the current track to contain the block.

         SLR   R1,R1                                       
         ICM   R1,B'0011',CURTTR  GET CURRENT TRACK        
         LA    R1,1(,R1)          NEXT TRACK               
         STCM  R1,B'0011',CURTTR  SAVE BACK                
         MVI   CURTTR+2,1         START BACK WITH RECORD 1 
         L     R1,ETRKBAL         EMPTY TRACK BALANCE VALUE
         ST    R1,CURTKBAL        NEW CURRENT TRACK BALANCE

If we need to start on a new track we increment the track number in the TTR and reset the record number to one. We also must reset the current track balance to the empty track size.

         SLR   R1,R1                                 
         ICM   R1,B'0111',CURTTR  GET TTR FOR BLOCK  
         ST    R1,WPARM+0         SAVE INTO PARM LIST
         L     R1,BLKBUF          I/O BUFFER         
         ST    R1,WPARM+4                            
         ST    R9,WPARM+8         DATA LEN           
         LA    R1,0               KEY LEN            
         ST    R1,WPARM+12                           
         LA    R1,WPARM                              
         BAL   R14,WRITEBLK       GO WRITE THE BLOCK 

The low-level WRITEBLK routine is called to write the block to the dataset. I could have probably chosen better names since WRITEBLK and BLKWRITE are easy to confuse. The Assembler doesn’t care but it really isn’t great coding style.

*                                                            
         SLR   R1,R1                                         
         IC    R1,CURTTR+2        GET RECORD NUMBER          
         LA    R1,1(,R1)          ADD ONE                    
         STC   R1,CURTTR+2        SAVE IT BACK               
*                                                            
         L     R1,CURTKBAL        GET TRACK TRK BALANCE      
         S     R1,NKEYOH          SUBTRACT OUT BLOCK OVERHEAD
         SR    R1,R9              SUBTRACK BLOCK LENGTH      
         ST    R1,CURTKBAL        SAVE UPDATED TRACK BALANCE 
*                                                            
         L     R13,4(,R13)        UNCHAIN SAVE AERA          
         LM    R14,R12,12(R13)    RESTORE REGS               
         BR    R14                RETURN                     

The record number in the TTR is incremented, the track balance is updated and then we return to the caller.

EOFWRITE – Write An EOF In Data Area

The EOFWRITE routine is just like the BLKWRITE routine. It writes an EOF record in the member data area. It does not write on the directory track.

EOFWRITE DS    0H                                                 
         STM   R14,R12,12(R13)    SAVE CALLERS REGISTERS          
         LA    R14,SAVEA3         CHAIN                           
         ST    R13,4(,R14)             ON                         
         ST    R14,8(,R13)               SAVE                     
         LR    R13,R14                       AREA                 
*                                                                 
         L     R1,NKEYOH          ADD IN BLOCK OVERHEAD FOR EOF   
         C     R1,CURTKBAL        COMPARE TO CURRENT TRACK BALANCE
         BL    EOFW010              RECORD WILL FIT ON TRACK      
*                                                                 
*** NEED TO WRITE EOF ON A NEW TRACK                              
*                                                                 
         SLR   R1,R1                                              
         ICM   R1,B'0011',CURTTR  GET CURRENT TRACK               
         LA    R1,1(,R1)          NEXT TRACK                      
         STCM  R1,B'0011',CURTTR  SAVE BACK                       
         MVI   CURTTR+2,1         START BACK WITH RECORD 1        
         L     R1,ETRKBAL         EMPTY TRACK BALANCE VALUE       
         ST    R1,CURTKBAL        NEW CURRENT TRACK BALANCE       
*                                                              
*                                                              
EOFW010  DS    0H                                              
         SLR   R1,R1                                           
         ICM   R1,B'0111',CURTTR  GET TTR FOR BLOCK            
         ST    R1,WPARM+0         SAVE INTO PARM LIST          
         L     R1,BLKBUF          I/O BUFFER                   
         ST    R1,WPARM+4                                      
         LA    R1,0               KL=DL=0                      
         ST    R1,WPARM+8         DATA LEN                     
         ST    R1,WPARM+12        KEY LEN                      
         LA    R1,WPARM                                        
         BAL   R14,WRITEBLK       GO WRITE THE BLOCK           
*                                                              
*** SAVE CURRENT BLOCK ADDRESS IN CASE THIS IS THE LAST MEMBER 
*                                                              
         MVC   EXCPDCB+5(8),IOBSEEK     COPY MBBCCHHR          
         MVC   EXCPDCB+5+7(1),CURTTR+2  MOVE IN RECORD         
*                                                              
         SLR   R1,R1                                           
         IC    R1,CURTTR+2        GET RECORD NUMBER          
         LA    R1,1(,R1)          ADD ONE                    
         STC   R1,CURTTR+2        SAVE IT BACK               
*                                                            
         L     R1,CURTKBAL        GET TRACK TRK BALANCE      
         S     R1,NKEYOH          SUBTRACT OUT BLOCK OVERHEAD
         ST    R1,CURTKBAL        SAVE UPDATED TRACK BALANCE 
         STCM  R1,B'0011',EXCPDCB+18                         
*                                                            
         L     R13,4(,R13)        UNCHAIN SAVE AERA          
         LM    R14,R12,12(R13)    RESTORE REGS               
         BR    R14                RETURN                     

This is almost exactly the same as the BLKWRITE routine except there is no need to pass a pointer to a data buffer or a block length. We also update the DCB with the MBBCCHHR of the EOF record in case this is the member entry. This will cause CLOSE processing to set the last used TTR value in the DSCB. We only need to update the value in the EOFWRITE because an EOF will always be the last block we write.

STOW – Store Directory Entry

STOW     DS    0H                                        
         STM   R14,R12,12(R13)    SAVE CALLERS REGISTERS 
         LA    R14,SAVEA3         CHAIN                  
         ST    R13,4(,R14)             ON                
         ST    R14,8(,R13)               SAVE            
         LR    R13,R14                       AREA        
*                                                        
         LR    R10,R1             POINT TO DIR ENTRY     
         SLR   R9,R9                                     
         IC    R9,11(R10)         GET USER DATA LENGTH   
         N     R9,=A(X'1F')                              
         SLL   R9,2               MULTIPLY BY 2          
         LA    R9,12(,R9)         CALC DIR ENTRY LENGTH  

The STOW routine places a directory entry into a directory block. We begin by saving the caller’s registers. Next we calculate the total length of the directory entry (12 + user data length).

         SLR   R7,R7              CLEAR REG                
         L     R1,IXBLKBUF        POINT TO IX BLOCK BUFFER 
         ICM   R7,B'0011',8(R1)   BYTES USED IN DIR BLK    
         LA    R8,256             MAX BYTES AVAILABLE      
         SR    R8,R7              TOTAL BYTES AVAILABLE    
         CR    R9,R8              WILL THE ENTRY FIT?      
         BNH   STOW010               YES - BRANCH          

Next we determine how many unused bytes are in the current directory block. This is accomplised by subtracting the bytes used from the total length. We can then determine if the entry will fit into the current block.

         SLR   R1,R1                                   
         ICM   R1,B'0111',IXTTR   GET TTR FOR BLOCK    
         ST    R1,WPARM+0         SAVE INTO PARM LIST  
         L     R1,IXBLKBUF        I/O BUFFER           
         ST    R1,WPARM+4                              
         LA    R1,256             DATA LEN             
         ST    R1,WPARM+8                              
         LA    R1,8               KEY LEN              
         ST    R1,WPARM+12                             
         LA    R1,WPARM                                
         BAL   R14,WRITEBLK       GO WRITE THE BLOCK   

If the block is full we must write it onto the directory track using the WRITEBLK (low-level write) routine.

         SLR   R1,R1                                         
         IC    R1,IXTTR+2         GET RECORD NUMBER          
         LA    R1,1(,R1)          ADD ONE                    
         STC   R1,IXTTR+2         SAVE IT BACK               
*                                                            
         L     R1,IXTKBAL         GET INDEX TRACK TRK BALANCE
         S     R1,KEYOH           SUBTRACT OUT KEY OVERHEAD  
         S     R1,=F'264'         SUBTRACK BLOCK+KEY LENGTH  
         ST    R1,IXTKBAL         SAVE UPDATED TRACK BALANCE 

Next we increment the record number and update the track balance value for the directory track.

         L     R1,IXBLKBUF        INITIALIZE DIR BLK I/O BUFFER 
         XC    0(8,R1),0(R1)      CLEAR KEY                     
         XC    8(256,R1),8(R1)    CLEAR DATA                    
         LA    R7,2               BYTES USED                    
         STCM  R7,B'0011',8(R1)   BYTES USED IN BLOCK           
         LA    R8,254             BYTES AVAILABLE               

Finally we initialize the directory block I/O buffer as an empty directory block.

STOW010  DS    0H                                      
         L     R2,IXBLKBUF        BUFFER               
         MVC   0(8,R2),0(R10)     UPDATE KEY           
         LA    R2,8(,R2)          POINT PAST KEY       
         AR    R2,R7              POINT PAST LAST ENTRY
         LR    R1,R9              SIZE OF DIR ENT      
         BCTR  R1,0                                    
         EX    R1,STOWMVC                              
STOWMVC  MVC   0(1,R2),0(R10)     COPY IN DIR ENTRY    
         AR    R7,R9              UPDATE BYTES USED    
         L     R1,IXBLKBUF        I/O BUFFER           
         STCM  R7,B'0011',8(R1)   UPDATE BYTES USED    

Now we can add the directory entry into the directory block. First we update the block key. We then point past the last used entry in the block. Now the directory entry can be copied into the I/O buffer. After updating the bytes used (the first two bytes of the block) we are done.

         L     R13,4(,R13)        UNCHAIN          
         LM    R14,R12,12(R13)           SAVE AREA 
         BR    R14                RETURN TO CALLER 

Just restore the caller’s registers and return.

WRITEBLK – Low-Level Write Routine

***********************************************************************
* WRITE A BLOCK                                                        
*                                                                      
*  R1 = A(PARM LIST)                                                   
*       +0    0TTR                                                     
*       +4    BUFFER ADDR                                              
*       +8    BLOCK LENGTH                                             
*      +12    KEY LENGTH                                               
*                                                                      
***********************************************************************

This routine expects the address of a 4-word parameter list to be passed in register 1. The parameter list contains the TTR of the block to be written, a pointer to the I/O buffer to write, the length of the block to write, and the length of the key for the block. The I/O buffer contains the key (if any) followed by the block data.

WRITEBLK DS    0H                                          
         STM   R14,R12,12(R13)     STORE CALLER'S REGISTERS
         LA    R14,SAVEA2          CHAIN                   
         ST    R13,4(,R14)              ON                 
         ST    R14,8(,R13)                SAVE             
         LR    R13,R14                        AREA         
*                                                          
         LR    R10,R1        SAVE PARAMETER POINTER        

As always we begin by saving the caller’s registers.

         L     R1,0(,R10)         TTR OF BLOCK TO WRITE   
         SRL   R1,8               SHIFT OFF RECORD NUMBER 
         BAL   R14,GETCCHH        CONVERT TO MBBCCHHR     
         LTR   R15,R15            CHECK RETURN CODE       
         BZ    WRITE010           - BRANCH IF GOOD        
*                                                         
WRITE000 DS    0H                                         
         LOG   'TTR CONVERSION FAILED'                    
         WTO   'TTR CONVERSION FAILED',ROUTCDE=(1,11)     
         B     EXIT                                       
*                                                         
*                                                         
WRITE010 DS    0H                                         

The relative track address is isolated from the TTR and the actual MBBCCHH is calculated.

WRITE010 DS    0H                                                
         MVC   IOBSEEK(8),MBBCCHHR      SET IOB SEEK ADDRESS     
         MVC   COUNTBUF(4),MBBCCHHR+3   SET CCHH INTO COUNT AREA 
*                                                                
         L     R1,0(,R10)         TTR OF BLOCK TO WRITE          
         STC   R1,COUNTR          PUT RECORD NUMBER INTO COUNT   

The MBBCCHH is moved to the IOB to provide the SEEK address. The CCHH is also copied into the Count buffer area and the record number is added.

         L     R2,8(,R10)         DATA BLOCK LENGTH        
         L     R3,12(,R10)        KEY LENGTH               
         STCM  R3,B'0001',COUNTKL SET KEY LEN IN COUNT     
         STCM  R2,B'0011',COUNTDL SET DATA LEN IN COUNT    
         AR    R3,R2              GET TOTAL LENGHT KEY+DATA
         STCM  R3,B'0011',CCWWRIT2+6  STORE INTO CCW            

The Key length and the Data length are then copied into the Count buffer area and then added together and placed into the CCW. Here I am using Data-Chaining so I can have separate buffer areas for the count and the key+data. Here is the Channel Program used.

         DS    0D                                                    
CCWSRCH  DC    X'31',AL3(IOBSRCH),X'40',X'00',AL2(5)    SERACH       
CCWTIC   DC    X'08',AL3(CCWSRCH),X'40',X'00',AL2(0)    TIC          
CCWWRITE DC    X'1D',AL3(COUNTBUF),X'80',X'00',AL2(8)   WRITE CKD    
CCWWRIT2 DC    X'00',AL3(*-*),X'00',X'00',AL2(*-*)      (DATA CHAIN) 

Looking at eh CCWWRITE we see a command code of X’1D’ for Write CKD. The data address points to the count buffer. In the flags Data-Chaining is set and the length is 8 (the length of the count area). Data chaining will cause the current operation to continue using the address and length fields of the next CCW. This keeps us from having to move data around to get everything into a single I/O buffer.

         LTR   R3,R3              IS IT AN EOF RECORD      
         BNZ   WRITE020              NO - BRANCH           
*                                                          
         NI    CCWWRITE+4,255-X'80'  TURN OFF DATA CHAIN   
WRITE020 DS    0H 

Now we check to see if there is any key and data to write. These values are zero to write an EOF record. If they are zero we need to turn off the data-chaining bit so the channel will not attempt to use the second CCW as part of the write.

         L     R1,4(,R10)         POINT TO DATA BUFFER
         STCM  R1,B'0111',CCWWRIT2+1  STORE INTO CCW  
*                                                     
         L     R1,0(,R10)         GET TTR             
         N     R1,=A(X'FF')       KEEP ONLY RECORD    
         BCTR  R1,0               SUBTRACT 1          
         STC   R1,IOBSEEK+7       SEARCH FOR RN-1     
*                                                     

Now the Key+Data buffer address is palced in the second write CCW. The Search address is set for one less than the record number we are writing.

         XC    ECB,ECB            CLEAR ECB               
         EXCP  IOB                ISSUE I/O REQUEST       
*                                                         
         WAIT  1,ECB=ECB          WAIT FOR I/O TO COMPLETE
*                                                         
         OI    CCWWRITE+4,X'80'   TURN ON DATA CHAIN      

Now we issue the I/O and wait for completion. We also reset the data-chaining bit in case we previously turn it off.

         CLI   IOBECBAD,X'7F'     WAS IT SUCCESSFUL     
         BE    WRITE900                                 
*                                                       
         BAL   R14,PRINTIOB       GO FORMAT IOB AND EXIT
         L     R13,4(R13)         UNCHAIN SAVE AREA     
         B     EXIT                                     
*                                                       
WRITE900 DS    0H                                       
         L     R13,4(,R13)        UNCHAIN SAVE AREA     
         LM    R14,R12,12(R13)    RESTORE REGISTERS     
         BR    R14                RETURN TO CALLER      

The completion code is checked. If the I/O was not completed successfully the information from the IOB is logged and exeuction is terminated. If all is well we restore the caller’s registers and return.

A Successful PDS Load

Here is the member listing from RPF.

EDIT       PDS : TCS3.EXCPDS.PDS----------------------------------------------
Cmd =>                                                                        
C Name     Newname  TTR    Userid  Date       Time  Lines Level  Members=00037
  #ASM              000101                                                    
  #BR14             000104                                                    
  #DSUINFO          000106                                                    
  #EXCP01           000108                                                    
  #EXCP02           00010A                                                    
  #EXCP03           00010C                                                    
  #EXCP04           00010E                                                    
  #EXCP05           000110                                                    
  #EXCP06           000112                                                    
  #LINK             000203                                                    
  #LINKSVC          000205                                                    
  #LINKSVX          000207                                                    
  #PUNCH            000209                                                    
  #PUNCH2           00020B                                                    
  #RUN              00020D                                                    
  #RUNSVX           00020F                                                    
  CIB01             000212                                                    
  DSUINFO           000307                                                    
  EXCP01            000805                                                    
  EXCP02            000A06                                                    
  EXCP03            000C07                                                    

And here is the XDUMP member. Everything looks good!!

Update XDUMP   : Trunc Xlate Top Nonum Nulls Asis -----------------------------
Cmd =>                                                  Scope 01,72 Scroll CSR 
...... ----+----1----+----2----+----3----+----4----+----5----+----6----+----7--
000100 XDUMP    CSECT ,                                                        
000200 *********************************************************************** 
000300 *  -- XDUMP --                                                        * 
000400 *                                                                     * 
000500 *     PRINT DATA IN DUMP FORMAT                                       * 
000600 *                                                                     * 
000700 *     ON INPUT R1 = A(DUMP PARM LIST)                                *  
000800 *           A  - ADDRESS OF DATA TO DUMP                              * 
000900 *           F  - LENGTH OF DATA                                       * 
001000 *           A  - PRINT ROUTINE                                        * 
001100 *           A  - USER WORD                                            * 
001200 *                                                                     * 
001300 *     ON ENTRY TO PRINT ROUTINE                                       * 
001400 *          R0  - USER WORD CONTENTS                                   * 
001500 *          R1  - PRINT LINE (CL133 FIRST BYTE IS BLANK)               * 
001600 *          R14 - RETURN ADDRESS                                       * 
001700 *          R15 - PRINT ROUTINE ENTRY ADDRESS                          * 
001800 *                                                                     * 
001900 *********************************************************************** 
002000 *                                                                       
002100          SAVE  (14,12),,*