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.
- The blocksize is hard coded to 3280 and the logical record length is hard coded to 80.
- ISPF statistics are not reloaded
- 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),,*