For the next exercise I chose to write a PDS dataset using EXCP. There are several restrictions to this program:<\/p>\n
I chose to use an IEBUPDTE style input.\u00a0 I created my test data using the LISTPDS\u00a0program (from the CBT Tape) using PARM=’NOLIST,DECK,UPDTE’ and ran it against my MVSSP source PDS.<\/p>\n
The program can be found in the source (available in the downloads) under the name EXCPDS.<\/p>\n
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. <\/p>\n
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.<\/p>\n
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.<\/p>\n
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.<\/p>\n
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.<\/p>\n
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.<\/p>\n
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.<\/p>\n
I would also be possible without too much effort to then add members to the existing dataset instead of overwriting all previously existing data.<\/p>\n
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.<\/p>\n
This would result in a high performance PDS loader.<\/p>\n
OPEN (SYSPRINT,OUTPUT) OPEN SYSPRINT DCB \r\n TM SYSPRINT+48,X'10' WAS IT SUCCESSFUL \r\n BO OPEN010 YES - BRANCH \r\n* \r\n WTO 'SYSPRINT FAILED TO OPEN',ROUTCDE=(1,11) \r\n B EXIT \r\n* \r\nOPEN010 DS 0H \r\n OPEN (EXCPDCB,OUTPUT) OPEN EXCPWRIT DCB \r\n TM EXCPDCB+48,X'10' WAS IT SUCCESSFUL \r\n BO OPEN020 YES - BRANCH \r\n* \r\n LOG 'EXCPWRIT FAILED TO OPEN' \r\n WTO 'EXCPWRIT FAILED TO OPEN',ROUTCDE=(1,11) \r\n B EXIT \r\n* \r\nOPEN020 DS 0H \r\n OPEN (SYSIN,INPUT) OPEN SYSIN DCB \r\n TM EXCPDCB+48,X'10' WAS IT SUCCESSFUL \r\n BO OPEN040 YES - BRANCH \r\n* \r\n LOG 'SYSIN FAILED TO OPEN' \r\n WTO 'SYSIN FAILED TO OPEN',ROUTCDE=(1,11) \r\n B EXIT \r\n* \r\n* \r\nOPEN040 DS 0H<\/pre>\nWe 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.<\/p>\n
GETMAIN R,LV=3280 DATA BLOCK BUFFER \r\n ST R1,BLKBUF SAVE ADDRESS \r\n* \r\n GETMAIN R,LV=264 INDEX BLOCK BUFFER \r\n ST R1,IXBLKBUF SAVE ADDRESS \r\n* \r\n* INITIALIZE DIRECTORY BLOCK BUFFER\r\n XC 0(8,R1),0(R1) CLEAR KEY \r\n XC 8(256,R1),8(R1) CLEAR DATA \r\n MVC 8(2,R1),=X'0002' BYTES USED \r\n* \r\n RDJFCB (EXCPDCB) READ JFCB FOR EXCPWRIT OUTPUT DS \r\n* \r\n OBTAIN CAMSRCH GET DSCB FOR EXCPWRIT \r\n* \r\n* \r\n SLR R1,R1 \r\n ICM R1,B'0111',DSCB+X'36' GET TTR OF LAST BLOCK USED \r\n STCM R1,B'0111',LASTBLK \r\n* \r\n SLR R1,R1 \r\n ICM R1,B'0011',DSCB+X'39' GET TRACKBAL OF LAST TRACK USED\r\n STCM R1,B'0011',TRKBAL<\/pre>\nNext 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).<\/p>\n
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.<\/p>\n
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.<\/p>\n
GET SYSIN,INREC READ AN INPUT RECORD\r\n* \r\n* \r\n CLC =C'.\/',INREC CONTROL RECORD \r\n BE MBR010 YES - BRANCH \r\n* \r\n LOG 'INVALID INPUT RECORD - NO .\/ ADD' \r\n B EXIT<\/pre>\nProcessing 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.<\/p>\n
MBR010 DS 0H \r\n CLI FIRSTIME,0 FIRST TIME HERE \r\n BNE MBR020 YES - DON'T ISSUE STOW \r\n* \r\n BAL R14,BLKWRITE GO WRITE A BLOCK \r\n BAL R14,EOFWRITE GO WRITE AN EOF \r\n* \r\n LA R1,DIRNAME \r\n BAL R14,STOW ADD \"EOF\" MEMBER ENTRY \r\n*<\/pre>\nThis 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).<\/p>\n
MBR020 DS 0H \r\n MVI FIRSTIME,0 CLEAR SWITCH \r\n LA R1,78 MAX BUFFER LENGTH \r\n LA R2,INREC+2 SKIP OVER .\/ \r\nMBR030 DS 0H \r\n CLI 0(R2),C' ' SKIP BLANKS \r\n BNE MBR040 \r\n LA R2,1(,R2) NEXT CHAR \r\n BCT R1,MBR030 LOOP BACK \r\n B MBR900 - INVALID CONTROL CARD \r\n* \r\n* \r\nMBR040 DS 0H \r\n CLC =C'ADD ',0(R2) ADD CARD \r\n BNE MBR900 NO - ERROR \r\n* \r\n LA R2,3(,R2) SKIP OVER \r\n S R1,=F'3' ADJUST LENGTH \r\nMBR042 DS 0H \r\n CLI 0(R2),C' ' SKIP BLANKS \r\n BNE MBR044 \r\n LA R2,1(,R2) NEXT CHAR \r\n BCT R1,MBR042 LOOP BACK \r\n B MBR900 - INVALID CONTROL CARD\r\n* \r\n* \r\nMBR044 DS 0H \r\n CLC =C'NAME=',0(R2) FOUND NAME= \r\n BNE MBR900 NO - ERROR \r\n* \r\n LA R2,5(,R2) POINT TO NAME \r\n S R1,=F'5' ADJUST LENGTH \r\n* \r\n LA R3,8 MAX NAME LENGTH \r\n LA R4,DIRNAME TARGET PTR FOR MBR NAME \r\n MVC DIRNAME,=CL8' ' CLEAR MEMBER NAME \r\nMBR050 DS 0H \r\n CLI 0(R2),C' ' LOOK FOR END OF NAME \r\n BE MBR060 \r\n MVC 0(1,R4),0(R2) COPY CHAR \r\n LA R2,1(,R2) NEXT INPUT BYTE \r\n LA R4,1(,R4) NEXT OUTPUT BYTE \r\n S R1,=F'1' ADJUST SOURCE LEN \r\n BNP MBR060 END IF END OF BUFFER \r\n BCT R3,MBR050 LOOP BACK FOR NEXT CHAR \r\n* \r\n CLI 0(R2),C' ' EXPECTING TO FIND A BLANK\r\n BNE MBR910 -- NAME TOO LONG \r\nMBR060 DS 0H<\/pre>\nThis 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.<\/p>\n
MVC DIRTTR,CURTTR ADDRESS OF NEXT RECORD TO WRITE \r\n MVI DIRC,0 NO USER DATA (FOR NOW) \r\n* \r\n L R8,BLKBUF I\/O BUFFER ADDRESS \r\n SLR R9,R9 ZERO LENGTH USED<\/pre>\nHere 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.<\/p>\n
MBR070 DS 0H \r\n GET SYSIN,INREC GET NEXT RECORD \r\n CLC =C'.\/',INREC CONTROL RECORD \r\n BE MBR010 YES - LOOP BACK \r\n* \r\n MVC 0(80,R8),INREC COPY DATA \r\n LA R8,80(,R8) NEXT RECORD \r\n LA R9,80(,R9) ADJUST LENGTH \r\n C R9,=F'3280' COMPARE TO BLOCK SIZE \r\n BL MBR070 LOOP BACK \r\n* \r\n BAL R14,BLKWRITE GO WRITE A BLOCK \r\n L R8,BLKBUF I\/O BUFFER ADDRESS \r\n SLR R9,R9 ZERO LENGTH \r\n B MBR070 LOOP BACK<\/pre>\nThis 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.<\/p>\n
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.<\/p>\n
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.<\/p>\n
MBR900 DS 0H \r\n LOG 'EPDS010E INVALID CONTROL CARD'\r\n B EXIT \r\n* \r\n* \r\nMBR910 DS 0H \r\n LOG 'EPDS011E MEMBER NAME TOO LONG'\r\n B EXIT<\/pre>\nIf an error is detected an error message is logged and execution is terminated.<\/p>\n
SYSINEOF DS 0H \r\n BAL R14,BLKWRITE FLUSH DATA BUFFER \r\n BAL R14,EOFWRITE GO WRITE AN EOF \r\n* \r\n LA R1,DIRNAME STOW THE \r\n BAL R14,STOW FINAL MEMBER \r\n* \r\n MVC DIRNAME,=X'FFFFFFFFFFFFFFFF' \"EOF\" DIRECTORY ENTRY\r\n MVC DIRTTR,=X'000000' \r\n MVC DIRC,=X'00' \r\n LA R1,DIRNAME \r\n BAL R14,STOW ADD \"EOF\" MEMBER ENTRY<\/pre>\nWhen 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.<\/p>\n
DIRCL010 DS 0H \r\n SLR R1,R1 \r\n ICM R1,B'0111',IXTTR GET TTR FOR BLOCK \r\n ST R1,WPARM+0 SAVE INTO PARM LIST\r\n L R1,IXBLKBUF I\/O BUFFER \r\n ST R1,WPARM+4 \r\n LA R1,256 DATA LEN \r\n ST R1,WPARM+8 \r\n LA R1,8 KEY LEN \r\n ST R1,WPARM+12 \r\n LA R1,WPARM \r\n BAL R14,WRITEBLK GO WRITE THE BLOCK<\/pre>\nNow 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.<\/p>\n
* \r\n SLR R1,R1 \r\n IC R1,IXTTR+2 GET RECORD NUMBER\r\n LA R1,1(,R1) ADD ONE \r\n STC R1,IXTTR+2 SAVE IT BACK<\/pre>\nNow the record number in the TTR for the next index block is incremented.<\/p>\n
L R1,IXTKBAL GET INDEX TRACK TRK BALANCE\r\n S R1,KEYOH SUBTRACT OUT KEY OVERHEAD \r\n S R1,=F'264' SUBTRACK BLOCK+KEY LENGTH \r\n ST R1,IXTKBAL SAVE UPDATED TRACK BALANCE<\/pre>\nHere the track balance (bytes remaining) on the index track is updated.<\/p>\n
L R1,IXBLKBUF INITILIZE DIRECTORY BLOCK BUFFER\r\n XC 0(8,R1),0(R1) CLEAR KEY \r\n XC 8(246,R1),8(R1) CLEAR DATA \r\n STCM R7,B'0011',8(R1) BYTES USED IN BLOCK<\/pre>\nNext the I\/O buffer for the index block is reset to an empty block.<\/p>\n
L R1,IXTKBAL GET TRACK BALANCE \r\n LA R2,264 IX BLK KEY+DATA LEN \r\n A R2,KEYOH BLK OVERHEAD \r\n A R2,NKEYOH EOF OVERHEAD \r\n CR R1,R2 ROOM FOR DATA BLOCK + EOF \r\n BH DIRCL010 YES - GO WRITE FILL BLOCK<\/pre>\nNow 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.<\/p>\n
SLR R1,R1 \r\n ICM R1,B'0111',IXTTR GET TTR FOR BLOCK \r\n ST R1,WPARM+0 SAVE INTO PARM LIST \r\n LA R1,IXBLKBUF I\/O BUFFER \r\n ST R1,WPARM+4 \r\n LA R1,0 DATA LEN \r\n ST R1,WPARM+8 \r\n LA R1,0 KEY LEN \r\n ST R1,WPARM+12 \r\n LA R1,WPARM \r\n BAL R14,WRITEBLK GO WRITE EOF FOR DIRECTORY \r\n* \r\n B EXIT<\/pre>\nIf 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.<\/p>\n
BLKWRITE – Write A Data Block<\/h2>\n
This routine is called to write a data block (member data) to the PDS. This routine does not write on the directory track.<\/p>\n
BLKWRITE DS 0H \r\n STM R14,R12,12(R13) SAVE CALLERS REGISTERS \r\n LA R14,SAVEA3 CHAIN \r\n ST R13,4(,R14) ON \r\n ST R14,8(,R13) SAVE \r\n LR R13,R14 AREA \r\n* \r\n* \r\n LR R1,R9 BLOCK SIZE \r\n A R1,NKEYOH ADD IN BLOCK OVERHEAD \r\n C R1,CURTKBAL COMPARE TO CURRENT TRACK BALANCE \r\n BL BLKW010 RECORD WILL FIT ON TRACK<\/pre>\nWe start by saving the caller’s registers.\u00a0 Next we determine if there is sufficient room on the current track to contain the block.<\/p>\n
\r\n SLR R1,R1 \r\n ICM R1,B'0011',CURTTR GET CURRENT TRACK \r\n LA R1,1(,R1) NEXT TRACK \r\n STCM R1,B'0011',CURTTR SAVE BACK \r\n MVI CURTTR+2,1 START BACK WITH RECORD 1 \r\n L R1,ETRKBAL EMPTY TRACK BALANCE VALUE\r\n ST R1,CURTKBAL NEW CURRENT TRACK BALANCE<\/pre>\nIf 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.<\/p>\n
\r\n SLR R1,R1 \r\n ICM R1,B'0111',CURTTR GET TTR FOR BLOCK \r\n ST R1,WPARM+0 SAVE INTO PARM LIST\r\n L R1,BLKBUF I\/O BUFFER \r\n ST R1,WPARM+4 \r\n ST R9,WPARM+8 DATA LEN \r\n LA R1,0 KEY LEN \r\n ST R1,WPARM+12 \r\n LA R1,WPARM \r\n BAL R14,WRITEBLK GO WRITE THE BLOCK <\/pre>\nThe 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. <\/p>\n
\r\n* \r\n SLR R1,R1 \r\n IC R1,CURTTR+2 GET RECORD NUMBER \r\n LA R1,1(,R1) ADD ONE \r\n STC R1,CURTTR+2 SAVE IT BACK \r\n* \r\n L R1,CURTKBAL GET TRACK TRK BALANCE \r\n S R1,NKEYOH SUBTRACT OUT BLOCK OVERHEAD\r\n SR R1,R9 SUBTRACK BLOCK LENGTH \r\n ST R1,CURTKBAL SAVE UPDATED TRACK BALANCE \r\n* \r\n L R13,4(,R13) UNCHAIN SAVE AERA \r\n LM R14,R12,12(R13) RESTORE REGS \r\n BR R14 RETURN <\/pre>\nThe record number in the TTR is incremented, the track balance is updated and then we return to the caller.<\/p>\n
EOFWRITE – Write An EOF In Data Area<\/h2>\n
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.<\/p>\n
\r\nEOFWRITE DS 0H \r\n STM R14,R12,12(R13) SAVE CALLERS REGISTERS \r\n LA R14,SAVEA3 CHAIN \r\n ST R13,4(,R14) ON \r\n ST R14,8(,R13) SAVE \r\n LR R13,R14 AREA \r\n* \r\n L R1,NKEYOH ADD IN BLOCK OVERHEAD FOR EOF \r\n C R1,CURTKBAL COMPARE TO CURRENT TRACK BALANCE\r\n BL EOFW010 RECORD WILL FIT ON TRACK \r\n* \r\n*** NEED TO WRITE EOF ON A NEW TRACK \r\n* \r\n SLR R1,R1 \r\n ICM R1,B'0011',CURTTR GET CURRENT TRACK \r\n LA R1,1(,R1) NEXT TRACK \r\n STCM R1,B'0011',CURTTR SAVE BACK \r\n MVI CURTTR+2,1 START BACK WITH RECORD 1 \r\n L R1,ETRKBAL EMPTY TRACK BALANCE VALUE \r\n ST R1,CURTKBAL NEW CURRENT TRACK BALANCE \r\n* \r\n* \r\nEOFW010 DS 0H \r\n SLR R1,R1 \r\n ICM R1,B'0111',CURTTR GET TTR FOR BLOCK \r\n ST R1,WPARM+0 SAVE INTO PARM LIST \r\n L R1,BLKBUF I\/O BUFFER \r\n ST R1,WPARM+4 \r\n LA R1,0 KL=DL=0 \r\n ST R1,WPARM+8 DATA LEN \r\n ST R1,WPARM+12 KEY LEN \r\n LA R1,WPARM \r\n BAL R14,WRITEBLK GO WRITE THE BLOCK \r\n* \r\n*** SAVE CURRENT BLOCK ADDRESS IN CASE THIS IS THE LAST MEMBER \r\n* \r\n MVC EXCPDCB+5(8),IOBSEEK COPY MBBCCHHR \r\n MVC EXCPDCB+5+7(1),CURTTR+2 MOVE IN RECORD \r\n* \r\n SLR R1,R1 \r\n IC R1,CURTTR+2 GET RECORD NUMBER \r\n LA R1,1(,R1) ADD ONE \r\n STC R1,CURTTR+2 SAVE IT BACK \r\n* \r\n L R1,CURTKBAL GET TRACK TRK BALANCE \r\n S R1,NKEYOH SUBTRACT OUT BLOCK OVERHEAD\r\n ST R1,CURTKBAL SAVE UPDATED TRACK BALANCE \r\n STCM R1,B'0011',EXCPDCB+18 \r\n* \r\n L R13,4(,R13) UNCHAIN SAVE AERA \r\n LM R14,R12,12(R13) RESTORE REGS \r\n BR R14 RETURN <\/pre>\nThis 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.<\/p>\n
STOW – Store Directory Entry<\/h2>\n
\r\nSTOW DS 0H \r\n STM R14,R12,12(R13) SAVE CALLERS REGISTERS \r\n LA R14,SAVEA3 CHAIN \r\n ST R13,4(,R14) ON \r\n ST R14,8(,R13) SAVE \r\n LR R13,R14 AREA \r\n* \r\n LR R10,R1 POINT TO DIR ENTRY \r\n SLR R9,R9 \r\n IC R9,11(R10) GET USER DATA LENGTH \r\n N R9,=A(X'1F') \r\n SLL R9,2 MULTIPLY BY 2 \r\n LA R9,12(,R9) CALC DIR ENTRY LENGTH <\/pre>\nThe 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).<\/p>\n
\r\n SLR R7,R7 CLEAR REG \r\n L R1,IXBLKBUF POINT TO IX BLOCK BUFFER \r\n ICM R7,B'0011',8(R1) BYTES USED IN DIR BLK \r\n LA R8,256 MAX BYTES AVAILABLE \r\n SR R8,R7 TOTAL BYTES AVAILABLE \r\n CR R9,R8 WILL THE ENTRY FIT? \r\n BNH STOW010 YES - BRANCH <\/pre>\nNext 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.<\/p>\n
\r\n SLR R1,R1 \r\n ICM R1,B'0111',IXTTR GET TTR FOR BLOCK \r\n ST R1,WPARM+0 SAVE INTO PARM LIST \r\n L R1,IXBLKBUF I\/O BUFFER \r\n ST R1,WPARM+4 \r\n LA R1,256 DATA LEN \r\n ST R1,WPARM+8 \r\n LA R1,8 KEY LEN \r\n ST R1,WPARM+12 \r\n LA R1,WPARM \r\n BAL R14,WRITEBLK GO WRITE THE BLOCK <\/pre>\nIf the block is full we must write it onto the directory track using the WRITEBLK (low-level write) routine.<\/p>\n
\r\n SLR R1,R1 \r\n IC R1,IXTTR+2 GET RECORD NUMBER \r\n LA R1,1(,R1) ADD ONE \r\n STC R1,IXTTR+2 SAVE IT BACK \r\n* \r\n L R1,IXTKBAL GET INDEX TRACK TRK BALANCE\r\n S R1,KEYOH SUBTRACT OUT KEY OVERHEAD \r\n S R1,=F'264' SUBTRACK BLOCK+KEY LENGTH \r\n ST R1,IXTKBAL SAVE UPDATED TRACK BALANCE <\/pre>\nNext we increment the record number and update the track balance value for the directory track.<\/p>\n
\r\n L R1,IXBLKBUF INITIALIZE DIR BLK I\/O BUFFER \r\n XC 0(8,R1),0(R1) CLEAR KEY \r\n XC 8(256,R1),8(R1) CLEAR DATA \r\n LA R7,2 BYTES USED \r\n STCM R7,B'0011',8(R1) BYTES USED IN BLOCK \r\n LA R8,254 BYTES AVAILABLE <\/pre>\nFinally we initialize the directory block I\/O buffer as an empty directory block.<\/p>\n
\r\nSTOW010 DS 0H \r\n L R2,IXBLKBUF BUFFER \r\n MVC 0(8,R2),0(R10) UPDATE KEY \r\n LA R2,8(,R2) POINT PAST KEY \r\n AR R2,R7 POINT PAST LAST ENTRY\r\n LR R1,R9 SIZE OF DIR ENT \r\n BCTR R1,0 \r\n EX R1,STOWMVC \r\nSTOWMVC MVC 0(1,R2),0(R10) COPY IN DIR ENTRY \r\n AR R7,R9 UPDATE BYTES USED \r\n L R1,IXBLKBUF I\/O BUFFER \r\n STCM R7,B'0011',8(R1) UPDATE BYTES USED <\/pre>\nNow 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.<\/p>\n
\r\n L R13,4(,R13) UNCHAIN \r\n LM R14,R12,12(R13) SAVE AREA \r\n BR R14 RETURN TO CALLER <\/pre>\nJust restore the caller’s registers and return.<\/p>\n
WRITEBLK – Low-Level Write Routine<\/h2>\n
\r\n***********************************************************************\r\n* WRITE A BLOCK \r\n* \r\n* R1 = A(PARM LIST) \r\n* +0 0TTR \r\n* +4 BUFFER ADDR \r\n* +8 BLOCK LENGTH \r\n* +12 KEY LENGTH \r\n* \r\n***********************************************************************<\/pre>\nThis 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.<\/p>\n
\r\nWRITEBLK DS 0H \r\n STM R14,R12,12(R13) STORE CALLER'S REGISTERS\r\n LA R14,SAVEA2 CHAIN \r\n ST R13,4(,R14) ON \r\n ST R14,8(,R13) SAVE \r\n LR R13,R14 AREA \r\n* \r\n LR R10,R1 SAVE PARAMETER POINTER <\/pre>\nAs always we begin by saving the caller’s registers.<\/p>\n
\r\n L R1,0(,R10) TTR OF BLOCK TO WRITE \r\n SRL R1,8 SHIFT OFF RECORD NUMBER \r\n BAL R14,GETCCHH CONVERT TO MBBCCHHR \r\n LTR R15,R15 CHECK RETURN CODE \r\n BZ WRITE010 - BRANCH IF GOOD \r\n* \r\nWRITE000 DS 0H \r\n LOG 'TTR CONVERSION FAILED' \r\n WTO 'TTR CONVERSION FAILED',ROUTCDE=(1,11) \r\n B EXIT \r\n* \r\n* \r\nWRITE010 DS 0H <\/pre>\nThe relative track address is isolated from the TTR and the actual MBBCCHH is calculated.<\/p>\n
\r\nWRITE010 DS 0H \r\n MVC IOBSEEK(8),MBBCCHHR SET IOB SEEK ADDRESS \r\n MVC COUNTBUF(4),MBBCCHHR+3 SET CCHH INTO COUNT AREA \r\n* \r\n L R1,0(,R10) TTR OF BLOCK TO WRITE \r\n STC R1,COUNTR PUT RECORD NUMBER INTO COUNT <\/pre>\nThe 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.<\/p>\n
\r\n L R2,8(,R10) DATA BLOCK LENGTH \r\n L R3,12(,R10) KEY LENGTH \r\n STCM R3,B'0001',COUNTKL SET KEY LEN IN COUNT \r\n STCM R2,B'0011',COUNTDL SET DATA LEN IN COUNT \r\n AR R3,R2 GET TOTAL LENGHT KEY+DATA\r\n STCM R3,B'0011',CCWWRIT2+6 STORE INTO CCW \r\n<\/pre>\nThe 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.<\/p>\n
\r\n DS 0D \r\nCCWSRCH DC X'31',AL3(IOBSRCH),X'40',X'00',AL2(5) SERACH \r\nCCWTIC DC X'08',AL3(CCWSRCH),X'40',X'00',AL2(0) TIC \r\nCCWWRITE DC X'1D',AL3(COUNTBUF),X'80',X'00',AL2(8) WRITE CKD \r\nCCWWRIT2 DC X'00',AL3(*-*),X'00',X'00',AL2(*-*) (DATA CHAIN) <\/pre>\nLooking 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. <\/p>\n
\r\n LTR R3,R3 IS IT AN EOF RECORD \r\n BNZ WRITE020 NO - BRANCH \r\n* \r\n NI CCWWRITE+4,255-X'80' TURN OFF DATA CHAIN \r\nWRITE020 DS 0H <\/pre>\nNow 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.<\/p>\n
\r\n L R1,4(,R10) POINT TO DATA BUFFER\r\n STCM R1,B'0111',CCWWRIT2+1 STORE INTO CCW \r\n* \r\n L R1,0(,R10) GET TTR \r\n N R1,=A(X'FF') KEEP ONLY RECORD \r\n BCTR R1,0 SUBTRACT 1 \r\n STC R1,IOBSEEK+7 SEARCH FOR RN-1 \r\n* <\/pre>\nNow 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.<\/p>\n
\r\n XC ECB,ECB CLEAR ECB \r\n EXCP IOB ISSUE I\/O REQUEST \r\n* \r\n WAIT 1,ECB=ECB WAIT FOR I\/O TO COMPLETE\r\n* \r\n OI CCWWRITE+4,X'80' TURN ON DATA CHAIN \r\n<\/pre>\nNow we issue the I\/O and wait for completion. We also reset the data-chaining bit in case we previously turn it off.<\/p>\n
\r\n CLI IOBECBAD,X'7F' WAS IT SUCCESSFUL \r\n BE WRITE900 \r\n* \r\n BAL R14,PRINTIOB GO FORMAT IOB AND EXIT\r\n L R13,4(R13) UNCHAIN SAVE AREA \r\n B EXIT \r\n* \r\nWRITE900 DS 0H \r\n L R13,4(,R13) UNCHAIN SAVE AREA \r\n LM R14,R12,12(R13) RESTORE REGISTERS \r\n BR R14 RETURN TO CALLER \r\n<\/pre>\nThe 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.<\/p>\n
A Successful PDS Load<\/h2>\n
Here is the member listing from RPF.<\/p>\n
\r\nEDIT PDS : TCS3.EXCPDS.PDS----------------------------------------------\r\nCmd => \r\nC Name Newname TTR Userid Date Time Lines Level Members=00037\r\n #ASM 000101 \r\n #BR14 000104 \r\n #DSUINFO 000106 \r\n #EXCP01 000108 \r\n #EXCP02 00010A \r\n #EXCP03 00010C \r\n #EXCP04 00010E \r\n #EXCP05 000110 \r\n #EXCP06 000112 \r\n #LINK 000203 \r\n #LINKSVC 000205 \r\n #LINKSVX 000207 \r\n #PUNCH 000209 \r\n #PUNCH2 00020B \r\n #RUN 00020D \r\n #RUNSVX 00020F \r\n CIB01 000212 \r\n DSUINFO 000307 \r\n EXCP01 000805 \r\n EXCP02 000A06 \r\n EXCP03 000C07 <\/pre>\nAnd here is the XDUMP member. Everything looks good!!<\/p>\n
\r\nUpdate XDUMP : Trunc Xlate Top Nonum Nulls Asis -----------------------------\r\nCmd => Scope 01,72 Scroll CSR \r\n...... ----+----1----+----2----+----3----+----4----+----5----+----6----+----7--\r\n000100 XDUMP CSECT , \r\n000200 *********************************************************************** \r\n000300 * -- XDUMP -- * \r\n000400 * * \r\n000500 * PRINT DATA IN DUMP FORMAT * \r\n000600 * * \r\n000700 * ON INPUT R1 = A(DUMP PARM LIST) * \r\n000800 * A - ADDRESS OF DATA TO DUMP * \r\n000900 * F - LENGTH OF DATA * \r\n001000 * A - PRINT ROUTINE * \r\n001100 * A - USER WORD * \r\n001200 * * \r\n001300 * ON ENTRY TO PRINT ROUTINE * \r\n001400 * R0 - USER WORD CONTENTS * \r\n001500 * R1 - PRINT LINE (CL133 FIRST BYTE IS BLANK) * \r\n001600 * R14 - RETURN ADDRESS * \r\n001700 * R15 - PRINT ROUTINE ENTRY ADDRESS * \r\n001800 * * \r\n001900 *********************************************************************** \r\n002000 * \r\n002100 SAVE (14,12),,* <\/pre>\n","protected":false},"excerpt":{"rendered":"For the next exercise I chose to write a PDS dataset using EXCP. There are several restrictions to this program: Members must be added is ascending name sequence 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. …<\/p>\n