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),,*