*AINDMFATRCE -- SUMMARY OF TRACE INPUT/OUTPUT OPERATIONS 00010000 C*********************************************************************** C COPYRIGHT ATLANTIC RICHFIELD COMPANY 1991 * C*********************************************************************** *TITLE FATRCE -- SUMMARY OF TRACE INPUT/OUTPUT OPERATIONS 00020000 * AUTHORS DEBORAH REED, FRANCIS COLLINS 00030000 * DESIGNERS DEBORAH REED, FRANCIS COLLINS 00040000 * LANGUAGE IBM ASSEMBLER 00050000 * SYSTEM IBM (SEE CRAY) 00060000 * WRITTEN 3- 5-75, 4-23-76 00070000 * REVISED 4- 4-75 FAC. NAMES AND ORDER. 00080000 * REVISED 8- 9-76 FAC. DCBBUFL = 32000, BUFNO = 2. 00090000 * REVISED 8-18-76 FAC. REMOVE DCBBUFL = 32000. 00100000 * REVISED 9-14-76 FAC. DCBBUFL = 32000. 00110000 * REVISED 1-26-79 FAC. OBTAIN INPUT VOL. SER. NO. 00120000 * REVISED 9- 9-80 FAC. CORRECT RETURN ADDRESS OF DCBBLKCT (R8). 00130000 * REVISED 12-17-80 FAC. OBTAIN OUTPUT VOL. SER. NO. 00140000 * REVISED 06-25-82 PKC. ADDED SYNAD EXIT TO FAWTR, CORRECT 00150000 * EXIT LIST FOR FAWTR. 00160000 * REVISED 07-01-83 NAM1. ADDED FREEPOOL MACRO TO FACRTR TO AVOID 00170000 * RUNNING OUT OF MEMORY 00180000 * REVISED 01-25-84 REM. CHANGED BUFFER SIZE FROM 32000 TO 32760. 00190000 * REVISED 4-26-84 FAC. BUILD CHAIN OF DATA SET ATTRIBUTE AREAS. 00200000 * EACH AREA CONTAINS POINTER TO NEXT AREA, 00210000 * ADDRESS OF DATA CONTROL BLOCK, VOLUME 00220000 * NUMBER, AND DATA SET NAME. THIS MAKES 00230000 * THE PROGRAM SERIALLY REUSABLE. 00240000 * DSACHAIN = POINTER TO FIRST AREA. 00250000 * REVISED 4-09-85 FAC. COMMENTS ONLY. INCLUDE STATUS = 9 (NO 00260000 * DD-CARD) IN FAIRTR AND FAIWTR. THESE 00270000 * CODES WERE ADDED 4-26-84. 00280000 * REVISED 7-18-85 RSK. 'CAPPED' FOR USE IN EXTENDED MODE AND 00290000 * ALLOWED FOR MOVING OF DATA BUFFERS 00300000 * ABOVE OR BELOW THE 16M LINE. CHANGES 00310000 * ARE MARKED 'EXT'. 00320000 * REVISED 2-10-86 REM. CHANGED FAWTR TO USE INPUT DATA LENGTH 00330000 * INSTEAD OF LRECL FROM DCB FOR EXTENDED 00340000 * MODE. 00350000 * REVISED 2-18-87 REM. ADD EXTRN FOR GETMN2 TO SATISFY BKBUFADD. 00360000 * REVISED 5-13-87 REM. SWITCH FROM BSAM TO QSAM FOR OUTPUT. 00370000 * REVISED 5-26-87 REM. CONVERT GETMAIN/FREEMAINS TO "RU" AND ADD 00380000 * FREEPOOL TO FACWTR. 00390000 * REVISED 5-06-88 REM. DO GETMAIN/FREEMAINS FROM SUBPOOL 1. 00400000 * REVISED 11-30-89 ESN. RENAMED FATRCE FROM FOTRCE. 00401001 * 00410000 * 00420000 * CALL FAIRTR (DCBAD, BLKSIZ, STATUS) 00430000 * INPUT DCBAD = ADDRESS OF A QSAM DCB. I4 00440000 * BLKSIZ = MAXIMUM BLOCK SIZE IN WORDS. I4 00450000 * OUTPUT STATUS = STATUS CODE. 1 = OK. I4 00460000 * 2 = OPEN FAILED. 00470000 * 9 = NO DD-CARD OR 00480000 * BLANK DDNAME. 00490000 * INITIALIZE TO READ TRACES. STORES BLOCK SIZE, BUFFER 00500000 * LENGTH, EODAD ADDRESS, SYNAD ADDRESS, AND EXIT LIST 00510000 * ADDRESS IN THE DCB, THEN OPENS THE DCB FOR INPUT. 00520000 * IMPORTANT: BE SURE TO CALL FACRTR TO CLOSE THE DATA SET. 00530000 EJECT 00540000 * CALL FARTR (DCBAD, DATA, LEN, STATUS, BLKCOUNT) 00550000 * INPUT DCBAD = ADDRESS OF QSAM DCB OPENED BY FAIRTR. I4 00560000 * OUTPUT DATA = ARRAY OF LENGTH LEN. ANY 00570000 * LEN = LENGTH IN WORDS OF RECORD READ. I4 00580000 * STATUS = STATUS CODE. I4 00590000 * 1 = OK. 00600000 * 2 = FILE NOT OPEN. 00610000 * 3 = READ ERROR. 00620000 * 4 = VOLUME SWITCH. 00630000 * 5 = CONCATENATION. 00640000 * 6 = VOLUME SWITCH + READ ERROR. 00650000 * 7 = CONCATENATION + READ ERROR. 00660000 * 8 = END OF FILE. 00670000 * 9 = NO DD-CARD OR BLANK DDNAME. 00680000 * BLKCOUNT = BLOCK COUNT FROM TRAILER LABEL AND 2I4 00690000 * BLOCK COUNT AS READ (FROM DCBBLKCT). 00700000 * READ TRACE DATA. READS THE RECORD INTO DATA, THEN GETS 00710000 * THE RECORD LENGTH FROM THE LOGICAL RECORD LENGTH FIELD 00720000 * (LRECL) OF THE DCB AND RETURNS IT IN LEN. 00730000 * EODAD AND SYNAD ARE IN THIS SECTION. 00740000 * IMPORTANT NOTE: WHEN PROCESSING IS FINISHED, BE SURE TO 00750000 * CALL FACRTR TO CLOSE THE DATA SET. 00760000 * 00770000 * CALL FADRTR (DCBAD, DSNAD, VOLAD) 00780000 * INPUT DCBAD = ADDRESS OF QSAM DATA CONTROL BLOCK. I4 00790000 * OUTPUT DSNAD = CURRENT DATA SET NAME. C44 00800000 * OUTPUT VOLAD = CURRENT VOLUME SERIAL NUMBER. C6 00810000 * 00820000 * CALL FACRTR (DCBAD, STATUS) 00830000 * INPUT DCBAD = ADDRESS OF A QSAM DCB. I4 00840000 * OUTPUT STATUS = STATUS CODE. 1 = OK. I4 00850000 * 2 = CLOSE FAILED. 00860000 * CLOSE INPUT TRACE DCB. CLOSE AND REWIND FILE AND FREE 00870000 * BUFFERS SO THEY CAN BE REALLOCATED. 00880000 * IMPORTANT NOTE: WHEN PROCESSING IS FINISHED, BE SURE TO 00890000 * CALL FACRTR TO CLOSE THE DATA SET. 00900000 EJECT 00910000 * CALL FAIWTR (DCBAD, BLKSIZ, STATUS) 00920000 * INPUT DCBAD = ADDRESS OF A BSAM DCB. I4 00930000 * BLKSIZ = MAXIMUM BLOCK SIZE IN WORDS. I4 00940000 * OUTPUT STATUS = STATUS CODE. 1 = OK. I4 00950000 * 2 = OPEN FAILED. 00960000 * 9 = NO DD-CARD OR 00970000 * BLANK DDNAME. 00980000 * INITIALIZE TO OUTPUT TRACE DATA. STORES THE MAXIMUM BLOCK 00990000 * SIZE AND RECORD LENGTH IN THE DCB, THEN OPENS THE DCB FOR 01000000 * OUTPUT. 01010000 * IMPORTANT NOTE: WHEN PROCESSING IS FINISHED, BE SURE TO 01020000 * CALL FACWTR TO CLOSE THE DATA SET. 01030000 * 01040000 * CALL FAVWTR (DCBAD, VOLAD) 01050000 * INPUT DCBAD = ADDRESS OF QSAM DATA CONTROL BLOCK. I4 01060000 * OUTPUT VOLAD = CURRENT VOLUME SERIAL NUMBER. C6 01070000 * 01080000 * CALL FAWTR (DCBAD, DATA, LEN, STATUS) 01090000 * INPUT DCBAD = ADDRESS OF A BSAM DCB OPENED BY FAIWTR. I4 01100000 * LEN = LENGTH (WORDS) OF RECORD TO BE WRITTEN. I4 01110000 * DATA = ARRAY CONTAINING THE RECORD. ANY 01120000 * OUTPUT STATUS = STATUS CODE. 1 = OK. 01130000 * 2 = FILE NOT OPEN. 01140000 * 3 = WRITE ERROR. 01150000 * 4 = VOLUME SWITCH. 01160000 * 6 = VOLUME SWITCH + ERROR. 01170000 * WRITE TRACE DATA. RECORD LENGTH IS SMALLER OF LEN AND 01180000 * BLOCK SIZE. 01190000 * IMPORTANT NOTE: WHEN PROCESSING IS FINISHED, BE SURE TO 01200000 * CALL FACWTR TO CLOSE THE DATA SET. 01210000 * 01220000 * CALL FACWTR (DCBAD, STATUS) 01230000 * INPUT DCBAD = ADDRESS OF A BSAM DCB. I4 01240000 * OUTPUT STATUS = STATUS CODE. 1 = OK. I4 01250000 * 2 = CLOSE FAILED. 01260000 * CLOSE OUTPUT TRACE DCB. CLOSE AND REWIND FILE. 01270000 * IMPORTANT NOTE: WHEN PROCESSING IS FINISHED, BE SURE TO 01280000 * CALL FACWTR TO CLOSE THE DATA SET. 01290000 * 01300000 * SUMMARY OF STATUS CODES. 01310000 * 01320000 * STATUS FAIRTR FARTR FACRTR FAIWTR FAWTR FACWTR 01330000 * 1 OK OK OK OK OK OK 01340000 * 2 FAILED CLOSED FAILED FAILED CLOSED FAILED 01350000 * 3 ERROR ERROR 01360000 * 4 EOV EOV 01370000 * 5 CONCAT 4 + 3 01380000 * 6 4 + 3 01390000 * 7 5 + 3 01400000 * 8 EOF 01410000 * 9 NO DD NO DD NO DD 01420000 * END 01430000 EJECT 01440000 *TITLE FAIRTR -- OPEN TRACE INPUT DATA SET 01450000 *A AUTHORS DEBORAH REED, FRANCIS COLLINS 01460000 *A DESIGNERS DEBORAH REED, FRANCIS COLLINS 01470000 *A LANGUAGE S/370 ASSEMBLER 01480000 *A WRITTEN 3- 5-75, 4-23-76 01490000 *A 01500000 *A 01510000 *A CALL FAIRTR (DCBAD, BLKSIZ, STATUS) 01520000 *A INPUT DCBAD = ADDRESS OF A QSAM DCB. I4 01530000 *A BLKSIZ = MAXIMUM BLOCK SIZE IN WORDS. I4 01540000 *A OUTPUT STATUS = STATUS CODE. 1 = OK. I4 01550000 *A 2 = OPEN FAILED. 01560000 *A 9 = NO DD-CARD OR 01570000 *A BLANK DDNAME. 01580000 *A 01590000 *A 01600000 *A INITIALIZE TO READ TRACES. STORES BLOCK SIZE, BUFFER 01610000 *A LENGTH, EODAD ADDRESS, SYNAD ADDRESS, AND EXIT LIST 01620000 *A ADDRESS IN THE DCB, THEN OPENS THE DCB FOR INPUT. 01630000 *A IMPORTANT NOTE: WHEN PROCESSING IS FINISHED, BE SURE TO 01640000 *A CALL FACRTR TO CLOSE THE DATA SET. 01650000 *A 01660000 *A REQUIRED PARAMETERS FOR QSAM DATA CONTROL BLOCK: 01670000 *A 01680000 *A DDNAME, DSORG=PS, MACRF=(GM), RECFM=UT 01690000 *AEND 01700000 EJECT 01710000 *TITLE FARTR -- READ TRACE 01720000 *A AUTHORS DEBORAH REED, FRANCIS COLLINS 01730000 *A DESIGNERS DEBORAH REED, FRANCIS COLLINS 01740000 *A LANGUAGE S/370 ASSEMBLER 01750000 *A WRITTEN 3- 5-75, 4-23-76 01760000 *A 01770000 *A 01780000 *A CALL FARTR (DCBAD, DATA, LEN, STATUS, BLKCOUNT) 01790000 *A INPUT DCBAD = ADDRESS OF QSAM DCB OPENED BY FAIRTR. I4 01800000 *A OUTPUT DATA = ARRAY OF LENGTH LEN. ANY 01810000 *A LEN = LENGTH IN WORDS OF RECORD READ. I4 01820000 *A STATUS = STATUS CODE. I4 01830000 *A 1 = OK. 01840000 *A 2 = FILE NOT OPEN. 01850000 *A 3 = READ ERROR. 01860000 *A 4 = VOLUME SWITCH. 01870000 *A 5 = CONCATENATION. 01880000 *A 6 = VOLUME SWITCH + READ ERROR. 01890000 *A 7 = CONCATENATION + READ ERROR. 01900000 *A 8 = END OF FILE. 01910000 *A 9 = NO DD-CARD OR BLANK DDNAME. 01920000 *A BLKCOUNT = BLOCK COUNT FROM TRAILER LABEL AND 2I4 01930000 *A BLOCK COUNT AS READ (FROM DCBBLKCT). 01940000 *A 01950000 *A 01960000 *A READ TRACE DATA. READS THE RECORD INTO DATA, THEN GETS 01970000 *A THE RECORD LENGTH FROM THE LOGICAL RECORD LENGTH FIELD 01980000 *A (LRECL) OF THE DCB AND RETURNS IT IN LEN. 01990000 *A EODAD AND SYNAD ARE IN THIS SECTION. 02000000 *A IMPORTANT NOTE: WHEN PROCESSING IS FINISHED, BE SURE TO 02010000 *A CALL FACRTR TO CLOSE THE DATA SET. 02020000 *AEND 02030000 SPACE 3 02040000 *TITLE FADRTR -- GET CURRENT NAME OF INPUT TRACE DATA SET 02050000 *A AUTHOR/DESIGNER FRANCIS COLLINS 02060000 *A LANGUAGE S/370 ASSEMBLER 02070000 *A WRITTEN 6-14-76 02080000 *A 02090000 *A 02100000 *A CALL FADRTR (DCBAD, DSNAD, VOLAD) 02110000 *A INPUT DCBAD = ADDRESS OF BSAM DATA CONTROL BLOCK. I4 02120000 *A OUTPUT DSNAD = CURRENT DATA SET NAME OF A44 02130000 *A INPUT TRACE DATA SET 02140000 *A OPENED BY FAIRTR. 02150000 *A OUTPUT VOLAD = CURRENT VOLUME SERIAL NUMBER. A6 02160000 *AEND 02170000 EJECT 02180000 *TITLE FACRTR -- CLOSE TRACE INPUT DATA SET 02190000 *A AUTHORS DEBORAH REED, FRANCIS COLLINS 02200000 *A DESIGNERS DEBORAH REED, FRANCIS COLLINS 02210000 *A LANGUAGE S/370 ASSEMBLER 02220000 *A WRITTEN 3- 5-75, 4-23-76 02230000 *A 02240000 *A 02250000 *A CALL FACRTR (DCBAD, STATUS) 02260000 *A INPUT DCBAD = ADDRESS OF A QSAM DCB. I4 02270000 *A OUTPUT STATUS = STATUS CODE. 1 = OK. I4 02280000 *A 2 = CLOSE FAILED. 02290000 *A 02300000 *A 02310000 *A CLOSE INPUT TRACE DCB. 02320000 *A IMPORTANT NOTE: WHEN PROCESSING IS FINISHED, BE SURE TO 02330000 *A CALL FACRTR TO CLOSE THE DATA SET. 02340000 *AEND 02350000 SPACE 3 02360000 *TITLE FAIWTR -- OPEN TRACE OUTPUT DATA SET 02370000 *A AUTHORS DEBORAH REED, FRANCIS COLLINS 02380000 *A DESIGNERS DEBORAH REED, FRANCIS COLLINS 02390000 *A LANGUAGE S/370 ASSEMBLER 02400000 *A WRITTEN 3- 5-75, 4-23-76 02410000 *A 02420000 *A 02430000 *A CALL FAIWTR (DCBAD, BLKSIZ, STATUS) 02440000 *A INPUT DCBAD = ADDRESS OF A QSAM DCB. I4 02450000 *A BLKSIZ = MAXIMUM BLOCK SIZE IN WORDS. I4 02460000 *A OUTPUT STATUS = STATUS CODE. 1 = OK. I4 02470000 *A 2 = OPEN FAILED. 02480000 *A 9 = NO DD-CARD OR 02490000 *A BLANK DDNAME. 02500000 *A 02510000 *A 02520000 *A INITIALIZE TO OUTPUT TRACE DATA. STORES THE MAXIMUM BLOCK 02530000 *A SIZE AND RECORD LENGTH IN THE DCB, THEN OPENS THE DCB FOR 02540000 *A OUTPUT. 02550000 *A IMPORTANT NOTE: WHEN PROCESSING IS FINISHED, BE SURE TO 02560000 *A CALL FACWTR TO CLOSE THE DATA SET. 02570000 *A 02580000 *A REQUIRED PARAMETERS FOR QSAM DATA CONTROL BLOCK: 02590000 *A 02600000 *A DDNAME, DSORG=PS, MACRF=(PM), RECFM=UT 02610000 *AEND 02620000 EJECT 02630000 *TITLE FAVWTR -- GET CURRENT VOLUME NO. OF OUTPUT TRACE DATA SET 02640000 *A AUTHOR/DESIGNER FRANCIS COLLINS 02650000 *A LANGUAGE S/370 ASSEMBLER 02660000 *A WRITTEN 12-17-80 02670000 *A 02680000 *A 02690000 *A CALL FAVWTR (DCBAD, VOLAD) 02700000 *A INPUT DCBAD = ADDRESS OF QSAM DATA CONTROL BLOCK. I4 02710000 *A OUTPUT VOLAD = CURRENT VOLUME SERIAL NUMBER OF A6 02720000 *A OUTPUT TRACE DATA SET 02730000 *A OPENED BY FAIWTR. 02740000 *AEND 02750000 SPACE 3 02760000 *TITLE FAWTR -- WRITE TRACE 02770000 *A AUTHORS DEBORAH REED, FRANCIS COLLINS 02780000 *A DESIGNERS DEBORAH REED, FRANCIS COLLINS 02790000 *A LANGUAGE S/370 ASSEMBLER 02800000 *A WRITTEN 3- 5-75, 4-23-76 02810000 *A 02820000 *A 02830000 *A CALL FAWTR (DCBAD, DATA, LEN, STATUS) 02840000 *A INPUT DCBAD = ADDRESS OF A QSAM DCB OPENED BY FAIWTR. I4 02850000 *A LEN = LENGTH (WORDS) OF RECORD TO BE WRITTEN. I4 02860000 *A DATA = ARRAY CONTAINING THE RECORD. ANY 02870000 *A OUTPUT STATUS = STATUS CODE. I4 02880000 *A 1 = OK. 02890000 *A 2 = FILE NOT OPEN. 02900000 *A 3 = WRITE ERROR. 02910000 *A 4 = VOLUME SWITCH. 02920000 *A 6 = VOLUME SWITCH AND WRITE ERROR. 02930000 *A 02940000 *A 02950000 *A WRITE TRACE DATA. RECORD LENGTH IS SMALLER OF LEN AND 02960000 *A BLOCK SIZE. 02970000 *A IMPORTANT NOTE: WHEN PROCESSING IS FINISHED, BE SURE TO 02980000 *A CALL FACWTR TO CLOSE THE DATA SET. 02990000 *AEND 03000000 EJECT 03010000 *TITLE FACWTR -- CLOSE TRACE OUTPUT DATA SET 03020000 *A AUTHORS DEBORAH REED, FRANCIS COLLINS 03030000 *A DESIGNERS DEBORAH REED, FRANCIS COLLINS 03040000 *A LANGUAGE S/370 ASSEMBLER 03050000 *A WRITTEN 3- 5-75, 4-23-76 03060000 *A 03070000 *A 03080000 *A CALL FACWTR (DCBAD, STATUS) 03090000 *A INPUT DCBAD = ADDRESS OF A QSAM DCB. I4 03100000 *A OUTPUT STATUS = STATUS CODE. 1 = OK. I4 03110000 *A 2 = CLOSE FAILED. 03120000 *A 03130000 *A 03140000 *A CLOSE OUTPUT TRACE DCB. CLOSE AND REWIND FILE. 03150000 *AEND 03160000 SPACE 3 03170000 *********************************************************************** 03180000 * 03190000 * EXAMPLE QSAM INPUT DCB: 03200000 * 03210000 * IN DCB DDNAME=DBG001,DSORG=PS,MACRF=(GM),RECFM=UT 03220000 * 03230000 * 03240000 * EXAMPLE QSAM OUTPUT DCB: 03250000 * 03260000 * OUT DCB DDNAME=DBG002,DSORG=PS,MACRF=(PM),RECFM=UT 03270000 * 03280000 *********************************************************************** 03290000 SPACE 3 03300000 MACRO 03310000 &ENTRY ENTER 03320000 ENTRY &ENTRY 03330000 USING *,R15 03340000 &ENTRY B &ENTRY.1 03350000 DC X'06',CL7'&ENTRY' 03360000 &ENTRY.1 ST R15,ENTRYADD 03370000 L R15,=A(FATRCE) 03380000 USING FATRCE,R15 03390000 B PRELIM 03400000 DROP R15 03410000 MEND 03420000 SPACE 3 03430000 PRINT NOGEN 03440000 EJECT 03450000 FATRCE CSECT 03460000 DC CL8'FATRCE ' 03470000 EXTRN GETMN2 03480000 R0 EQU 0 03490000 R1 EQU 1 03500000 R2 EQU 2 ADDRESS OF DATA CONTROL BLOCK. 03510000 R3 EQU 3 ADDRESS AND VALUE OF BLKSIZ IN FAIRTR AND FAIWTR. 03520000 * ADDRESS OF DATA IN FARTR AND FAWTR. 03530000 R4 EQU 4 ADDRESS OF LEN IN FARTR AND FAWTR. 03540000 R5 EQU 5 ADDRESS OF STATUS. 03550000 R6 EQU 6 VALUE OF STATUS. 03560000 R7 EQU 7 ADDRESS OF JOB FILE CONTROL BLOCK AREA. 03570000 R8 EQU 8 ADDRESS OF BLOCK COUNT FROM TRAILER LABEL. 03580000 * R8+4 = ADDRESS OF BLOCK COUNT FROM DATA CONTROL BLOCK. 03590000 R9 EQU 9 WORK. 03600000 R10 EQU 10 WORK. 03610000 R11 EQU 11 LINKAGE TO INTERNAL SUBROUTINE PREOPN. WORK. 03620000 R12 EQU 12 BASE REGISTER. 03630000 R13 EQU 13 SAVE AREA ADDRESS. 03640000 R14 EQU 14 03650000 R15 EQU 15 03660000 SPACE 03670000 BYTE234 EQU B'0111' 03680000 B1T3 EQU B'00010000' 03690000 CLOSFAIL EQU 2 03700000 CONCAT EQU 5 03710000 EOFST EQU 8 03720000 NODDCARD EQU 9 03730000 OK EQU 1 03740000 OPENFAIL EQU 2 03750000 VOLSWTCH EQU 4 03760000 SPACE 03770000 SAVEAREA DC 18F'0' 03780000 USING FATRCE,R12 03790000 USING IHADCB,R2 DATA CONTROL BLOCK. 03800000 USING IHAJFCB,R7 03810000 USING DSATTRIB,R10 DATA SET ATTRIBUTE AREA (DSECT). 03820000 SPACE 03830000 USING FATRCE,R15 03840000 PRELIM STM R14,R12,12(R13) PRELIM COMMON TO ALL ENTRY POINTS. 03850000 MVC 16(4,R13),ENTRYADD SAVE ENTRY POINT FOR RETURN. 03860000 ST R13,SAVEAREA+4 03870000 LA R12,SAVEAREA 03880000 ST R12,8(,R13) 03890000 LR R13,R12 03900000 LR R12,R15 03910000 DROP R15 03920000 SPACE 03930000 **************** ADDRESSING MODE SWITCH ****************** EXT 03940000 FATRCE AMODE ANY EXT 03950000 FATRCE RMODE 24 EXT 03960000 LA R4,FONEXT EXT 03970000 LA R5,RETURNIT EXT 03980000 BSM R5,R4 EXT 03990000 RETADD DC F'0' EXT 04000000 THELINE DC F'16777215' EXT 04010000 ADDCOMP DC F'0' EXT 04020000 FONEXT DS 0H EXT 04030000 ST R5,RETADD EXT 04040000 LM R2,R5,0(R1) PARAMETER ADDRESSES 1 TO 4. 04050000 L R8,16(,R1) PARAMETER ADDRESS 5 (BLOCK COUNTS). 04060000 L R2,0(,R2) PARAMETER 1 = DCB ADDRESS. 04070000 LA R6,OK NORMAL VALUE OF STATUS CODE. 04080000 LA R7,JFCB 04090000 ST R6,STATUS 04100000 L R15,ENTRYADD 04110000 B FAIRTR2-FAIRTR(,R15) 04120000 EJECT 04130000 ********************************************************************** 04140000 * CALL FAIRTR (DCBAD, BLKWDS, STATUS) * 04150000 * R2 R3 R4---->R5 (IN PREOPN) * 04160000 * IN IN OUT * 04170000 * INITIALIZE TO READ TRACES * 04180000 ********************************************************************** 04190000 FAIRTR ENTER 04200000 FAIRTR2 BAL R11,PREOPN INSERT BLOCK SIZE. 04210000 MVI DCBBUFNO,X'02' NUMBER OF BUFFERS = 2. 04220000 MVI DCBBUFL,X'7F' BUFFER SIZE = 32760 04230000 MVI DCBBUFL+1,X'F8' = 7FF8 HEX. 04240000 MVI DCBMACR1,X'48' GET/LOCATE MODE EXT 04250000 LA R0,EOF 04260000 STCM R0,BYTE234,DCBEODA END OF DATA ADDRESS. 04270000 LA R0,RSYNAD 04280000 STCM R0,BYTE234,DCBSYNA SYNAD ADDRESS. 04290000 LA R0,REXLST 04300000 STCM R0,BYTE234,DCBEXLSA EXIT LIST ADDRESS. 04310000 OPEN ((R2),(INPUT)) OPEN THE DATA SET. 04320000 TM DCBOFLGS,B1T3 VERIFY THE OPEN OPERATION. 04330000 BNO OPNTST10 04340000 * GET A DATA SET ATTRIBUTE AREA. SEE DSATTRIB DSECT. 04350000 GETMAIN RU,LV=64,SP=1 04360000 LR R10,R1 THE NEW ATTRIBUTE AREA WILL BE THE 04370000 XC DSPOINTR(64),DSPOINTR FIRST AREA IN THE CHAIN. 04380000 L R9,DSACHAIN 04390000 ST R9,DSPOINTR DSACHAIN POINTS TO NEW AREA, AND 04400000 ST R10,DSACHAIN NEW AREA POINTS TO FORMER FIRST AREA. 04410000 ST R2,DSDCBAD STORE DCB ADDRESS IN NEW AREA. 04420000 SPACE 04430000 * OBTAIN THE DATA SET NAME FROM THE JOB FILE CONTROL BLOCK, 04440000 XC JFCB,JFCB AND STORE IN NEW AREA. 04450000 RDJFCB ((R2),(INPUT)) 04460000 LTR R15,R15 04470000 BNZ NODDCD 04480000 MVC DSNAME,JFCBDSNM 04490000 SPACE 04500000 * OBTAIN THE VOLUME SERIAL NUMBER FROM THE UNIT CONTROL BLOCK, 04510000 L R15,DCBDEBAD AND STORE IN NEW AREA. 04520000 L R15,32(,R15) 04530000 MVC DSVOLSER,28(R15) 04540000 B OPNTST 04550000 EJECT 04560000 ********************************************************************** 04570000 * CALL FARTR (DCBAD, DATA, LEN, STATUS, BLKCOUNT) * 04580000 * R2 R3 R4 R5 R8 * 04590000 * IN OUT OUT OUT OUT * 04600000 * READ TRACE * 04610000 ********************************************************************** 04620000 FARTR ENTER 04630000 TM DCBOFLGS,B1T3 IS THE DCB OPEN? 04640000 BNO OPNTST10 NO, STATUS = 2. 04650000 * SR R0,R0 YES, PROCEED. EXT 04660000 * STH R0,DCBLRECL CLEAR THE RECORD LENGTH IN THE DCBEXT 04670000 * GET IS DONE IN LOCATE MODE. THE BUFFER IS THEN MOVED REGARDLESS EXT 04680000 * OF THE ADDRESSING MODE OF THE CALLER EXT 04690000 SPACE 04700000 FARTRXSW DS 0H EXT 04710000 STM R4,R7,FARTRXRS SAVE REGS USED FOR MOVE EXT 04720000 GET (R2) READ WITH QSAM. EXT 04730000 L R4,FARTRX1 ADDRESS FOR MODE SWITCH EXT 04740000 BSM 0,R4 SWITCH EXT 04750000 DS 0F EXT 04760000 FARTRX1 DC A(FARTRX2+X'80000000') EXT 04770000 FARTRXRS DC 4F'0' EXT 04780000 FARTRX2 DS 0H EXT 04790000 LR R4,R3 ADDRESS TO MOVE DATA INTO EXT 04800000 LR R6,R1 ADDRESS TO MOVE DATA FROM EXT 04810000 LH R5,DCBLRECL LENGTH OF DATA BUFFER EXT 04820000 N R5,=X'0000FFFF' CLEAR FIRST HALF OF WORD. EXT 04830000 LR R7,R5 EXT 04840000 MVCL R4,R6 MOVE IN THE DATA EXT 04850000 LA R4,FARTRX3 SWITCH OUT OF 31 BIT MODE EXT 04860000 BSM 0,R4 EXT 04870000 FARTRX3 DS 0H EXT 04880000 LM R4,R7,FARTRXRS RESTORE REGS USED FOR MOVE EXT 04890000 FARTRX99 DS 0H EXT 04900000 SPACE 04910000 LH R1,DCBLRECL GET LENGTH READ FROM DCB. 04920000 N R1,=X'0000FFFF' CLEAR FIRST HALF OF WORD. 04930000 SRL R1,2 CONVERT BYTES TO WORDS. 04940000 ST R1,0(R4) STORE LENGTH READ (WORDS) IN LEN. 04950000 L R6,STATUS WAS END-OF-VOLUME EXIT ENTERED? 04960000 C R6,=F'4' STATUS = 4 = EOV, OR 04970000 BE FARTR2 STATUS = 6 = EOV + READ ERROR. 04980000 C R6,=F'6' IF NO, FINISHED. 04990000 BNE RETURN10 IF YES, EOV AND MAYBE CONCATENATION. 05000000 FARTR2 L R10,DSACHAIN FIND THE DATA SET ATTRIBUTE AREA FOR 05010000 LTR R10,R10 THIS DATA CONTROL BLOCK. 05020000 BZ FARTR4 05030000 FARTR3 C R2,DSDCBAD COMPARE INPUT DCB TO AREA DCB. 05040000 BE FARTR5 ATTRIBUTE AREA FOUND. 05050000 L R10,DSPOINTR LOAD POINTER FOR NEXT AREA, IF ANY. 05060000 LTR R10,R10 IS THERE ANOTHER AREA? 05070000 BNZ FARTR3 YES. LOOP TO TEST NEXT AREA. 05080000 FARTR4 ABEND 222,DUMP NO. WANTED AREA NOT FOUND. ERROR. 05090000 FARTR5 L R15,DCBDEBAD OBTAIN THE VOLUME SERIAL NO. 05100000 L R15,32(,R15) FROM THE UNIT CONTROL BLOCK. 05110000 MVC DSVOLSER,28(R15) 05120000 XC JFCB,JFCB CONCATENATION TEST. CLEAR JFCB AREA. 05130000 RDJFCB ((R2),INPUT) READ JOB FILE CONTROL BLOCK. 05140000 LTR R15,R15 TEST RETURN CODE FROM READ JFCB. 05150000 BNZ NODDCD RD JFCB FAILED. PROBABLY NO DDCARD. 05160000 CLC DSNAME,JFCBDSNM IF NEW DATA SET NAME = OLD DSNAME, 05170000 BE RETURN10 CONCATENATION DID NOT OCCUR. 05180000 MVC DSNAME,JFCBDSNM CONCATENATION. SAVE NEW NAME. 05190000 LA R6,1(,R6) STATUS 4 --> 5, EOV --> CONCAT, 05200000 ST R6,STATUS STATUS 6 --> 7, EOV+RERROR --> CONCAT+RERROR. 05210000 B RETURN10 05220000 SPACE 05230000 * END-OF-FILE ROUTINE FOR READ ENTRY FARTR. 05240000 EOF LA R6,EOFST END OF FILE. STATUS = 8. 05250000 B RETURN10 05260000 SPACE 05270000 * SYNAD ERROR EXIT FOR READ ENTRY FARTR. 05280000 RSYNAD LA R6,2 05290000 A R6,STATUS STATUS 1 --> 3, OK --> READ ERROR, 05300000 ST R6,STATUS STATUS 4 --> 6, EOV --> EOV + READ ERROR. 05310000 BR R14 05320000 SPACE 05330000 * EXIT LIST FOR READ ENTRY FARTR. 05340000 DS 0F 05350000 REXLST DC X'06',AL3(REOV) END-OF-VOLUME, OR CONCATENATION. 05360000 DC X'07',AL3(JFCB) JOB FILE CONTROL BLOCK AREA. 05370000 DC X'8B',AL3(RBLKCT) BLOCK COUNT EXIT. 05380000 SPACE 05390000 * END-OF-VOLUME EXIT FOR READ ENTRY FARTR. 05400000 * THIS EXIT ALSO TAKEN WHEN CONCATENATION OCCURS. 05410000 REOV LA R6,VOLSWTCH VOLUME SWITCH, STATUS = 4. WILL BE 05420000 ST R6,STATUS CHANGED TO 6 IF READ ERROR OCCURS. 05430000 BR R14 IF CONCATENATION, 4 --> 5 & 6 --> 7. 05440000 SPACE 05450000 * BLOCK COUNT EXIT FOR READ ENTRY FARTR. 05460000 RBLKCT L R1,DCBBLKCT GET ACTUAL BLOCK COUNT FROM DCB. 05470000 STM R0,R1,0(R8) RETURN TRAILER BLOCK COUNT (R0) AND 05480000 LA R15,4 ACTUAL COUNT FROM DCB. 05490000 BR R14 RETURN CODE 4--CONTINUE PROCESSING. 05500000 SPACE 05510000 IHAJFCB DSECT MAP OF JOB FILE CONTROL BLOCK. 05520000 JFCBDSNM DS CL44 05530000 SPACE 05540000 FATRCE CSECT 05550000 DS 0F 05560000 JFCB DS CL176 AREA FOR JOB FILE CONTROL BLOCK. 05570000 EJECT 05580000 ********************************************************************** 05590000 * CALL FADRTR (DCBAD, DSNAD, VOLAD) * 05600000 * R2 R3 R4 * 05610000 * IN OUT OUT * 05620000 * MOVE CURRENT DATA SET NAME TO CALLING PROGRAM. * 05630000 * MOVE CURRENT VOLSER NUMBER TO CALLING PROGRAM. * 05640000 ********************************************************************** 05650000 FADRTR ENTER 05660000 L R10,DSACHAIN FIND THE DATA SET ATTRIBUTE AREA FOR 05670000 LTR R10,R10 THIS DATA CONTROL BLOCK. 05680000 BZ FADRTR4 05690000 FADRTR3 C R2,DSDCBAD COMPARE INPUT DCB TO AREA DCB. 05700000 BE FADRTR5 ATTRIBUTE AREA FOUND. 05710000 L R10,DSPOINTR LOAD POINTER FOR NEXT AREA, IF ANY. 05720000 LTR R10,R10 IS THERE ANOTHER AREA? 05730000 BNZ FADRTR3 YES. LOOP TO TEST NEXT AREA. 05740000 FADRTR4 ABEND 223,DUMP NO. WANTED AREA NOT FOUND. ERROR. 05750000 FADRTR5 DS 0H 05760000 ************* SWITCH TO 31 BIT ADDRESSING MODE ************* EXT 05770000 L R9,FODR0X1 ADDRESS FOR MODE SWITCH EXT 05780000 BSM 0,R9 SWITCH EXT 05790000 DS 0F EXT 05800000 FODR0X1 DC A(FODR0X2+X'80000000') EXT 05810000 FODR0X2 DS 0H EXT 05820000 MVC 0(44,R3),DSNAME MOVE DATA SET NAME AND VOLUME NUMBER 05830000 MVC 0(6,R4),DSVOLSER FROM DATA SET ATTRIBUTE AREA TO 05840000 ************* SWITCH BACK TO 24 BIT ADDRESSING MODE ************* EXT 05850000 LA R9,FODR0X3 SWITCH OUT OF 31 BIT MODE EXT 05860000 BSM 0,R9 EXT 05870000 FODR0X3 DS 0H EXT 05880000 B RETURN20 05890000 EJECT 05900000 ********************************************************************** 05910000 * CALL FACRTR (DCBAD, STATUS) * 05920000 * R2 R3---->R5 * 05930000 * IN OUT * 05940000 * CLOSE INPUT TRACE DCB * 05950000 ********************************************************************** 05960000 FACRTR ENTER 05970000 LR R5,R3 A(STATUS). 05980000 TM DCBOFLGS,B1T3 NEED TO BE CLOSED? 05990000 BZ RETURN10 NO. 06000000 LA R9,DSACHAIN REMOVE DATA SET ATTRIBUTE AREA FROM CHAIN. 06010000 L R10,DSACHAIN R9 = ADDRESS OF PREVIOUS AREA, 06020000 LTR R10,R10 R10 = ADDRESS OF AREA BEING TESTED, 06030000 BZ FACRTR4 IF R10 = 0 INITIALLY, NO AREAS EXIST. 06040000 B FACRTR3 R11 = ADDRESS OF NEXT AREA. 06050000 FACRTR2 LR R9,R10 06060000 LR R10,R11 06070000 FACRTR3 L R11,DSPOINTR ENTER LOOP HERE WITH R9 & R10 INITIALIZED. 06080000 C R2,DSDCBAD COMPARE DCB ADDRESSES. 06090000 BE FACRTR5 06100000 LTR R11,R11 IS THIS THE LAST AREA? 06110000 BNZ FACRTR2 NO, LOOP TO TEST NEXT AREA. 06120000 FACRTR4 ABEND 224,DUMP NOT FOUND IN LAST AREA--ERROR. 06130000 FACRTR5 ST R11,0(,R9) 06140000 FREEMAIN RU,LV=64,A=(R10),SP=1 06150000 CLOSE ((R2),REWIND) 06160000 FREEPOOL ((R2)) FREE THE ALLOCATED POOL NAM1 06170000 B CLSTST 06180000 EJECT 06190000 ********************************************************************** 06200000 * CALL FAIWTR (DCBAD, BLKWDS, STATUS) * 06210000 * R2 R3 R4---->R5 (IN PREOPN) * 06220000 * IN IN OUT * 06230000 * INITIALIZE TO WRITE TRACES * 06240000 ********************************************************************** 06250000 FAIWTR ENTER 06260000 BAL R11,PREOPN 06270000 STH R3,DCBLRECL STORE RECORD LENGTH IN DCB. 06280000 LA R0,WSYNAD SYNAD ADDRESS 06290000 STCM R0,BYTE234,DCBSYNA 06300000 LA R0,WEXLST 06310000 STCM R0,BYTE234,DCBEXLSA EXIT LIST ADDRESS. 06320000 OPEN ((R2),(OUTPUT)) OPEN THE DATA SET. 06330000 * GET A NEW DATA SET ATTRIBUTE AREA. SEE DSATTRIB DSECT. 06340000 GETMAIN RU,LV=64,SP=1 06350000 LR R10,R1 THE NEW DATA SET ATTRIBUTE AREA 06360000 XC DSPOINTR(64),DSPOINTR BECOMES THE FIRST IN THE CHAIN. 06370000 L R9,DSACHAIN 06380000 ST R9,DSPOINTR DSACHAIN POINTS TO NEW AREA, AND 06390000 ST R10,DSACHAIN NEW AREA POINTS TO FORMER FIRST AREA. 06400000 ST R2,DSDCBAD STORE DCB ADDRESS IN NEW AREA. 06410000 SPACE 06420000 * OBTAIN THE DATA SET NAME FROM THE JOB FILE CONTROL BLOCK, 06430000 XC JFCB,JFCB AND STORE IN NEW AREA. 06440000 RDJFCB ((R2),(OUTPUT)) 06450000 LTR R15,R15 06460000 BNZ NODDCD 06470000 MVC DSNAME,JFCBDSNM 06480000 SPACE 06490000 * OBTAIN THE VOLUME SERIAL NUMBER FROM THE UNIT CONTROL BLOCK, 06500000 L R15,DCBDEBAD AND STORE IN NEW AREA. 06510000 L R15,32(,R15) 06520000 MVC DSVOLSER,28(R15) 06530000 B OPNTST 06540000 EJECT 06550000 ********************************************************************** 06560000 * CALL FAVWTR (DCBAD, VOLAD) * 06570000 * R2 R3 * 06580000 * MOVE CURRENT VOLSER NUMBER TO CALLING PROGRAM * 06590000 ********************************************************************** 06600000 FAVWTR ENTER 06610000 L R10,DSACHAIN FIND THE DATA SET ATTRIBUTE AREA FOR 06620000 LTR R10,R10 THIS DATA CONTROL BLOCK. 06630000 BZ FAVWTR4 06640000 FAVWTR3 C R2,DSDCBAD COMPARE INPUT DCB TO AREA DCB. 06650000 BE FAVWTR5 ATTRIBUTE AREA FOUND. 06660000 L R10,DSPOINTR LOAD POINTER FOR NEXT AREA, IF ANY. 06670000 LTR R10,R10 IS THERE ANOTHER AREA? 06680000 BNZ FAVWTR3 YES. LOOP TO TEST NEXT AREA. 06690000 FAVWTR4 ABEND 225,DUMP NO. WANTED AREA NOT FOUND. ERROR. 06700000 FAVWTR5 DS 0H 06710000 ************* SWITCH TO 31 BIT ADDRESSING MODE ************* EXT 06720000 L R9,FOVW0X1 ADDRESS FOR MODE SWITCH EXT 06730000 BSM 0,R9 SWITCH EXT 06740000 DS 0F EXT 06750000 FOVW0X1 DC A(FOVW0X2+X'80000000') EXT 06760000 FOVW0X2 DS 0H EXT 06770000 MVC 0(6,R3),DSVOLSER MOVE VOLUME SEIAL NUMBER FROM DATA 06780000 ************* SWITCH BACK TO 24 BIT ADDRESSING MODE ************* EXT 06790000 LA R9,FOVW0X3 SWITCH OUT OF 31 BIT MODE EXT 06800000 BSM 0,R9 EXT 06810000 FOVW0X3 DS 0H EXT 06820000 B RETURN20 ATTRIBUTE AREA TO CALLING PROGRAM. 06830000 SPACE 3 06840000 EJECT 06850000 ********************************************************************** 06860000 * CALL FAWTR (DCBAD, DATA, LEN, STATUS) * 06870000 * R2 R3 R4 R5 * 06880000 * WRITE TRACE * 06890000 ********************************************************************** 06900000 FAWTR ENTER 06910000 TM DCBOFLGS,B1T3 IS THE FILE OPEN? 06920000 BNO OPNTST10 NO, STATUS = 2. 06930000 L R4,0(,R4) LENGTH IN WORDS. 06940000 SLL R4,2 LENGTH IN BYTES. 06950000 CH R4,DCBBLKSI IS LENGTH LARGER THAN BLOCK SIZE? 06960000 BNH FAWTR40 NO, PROCEED. 06970000 LH R4,DCBBLKSI YES, MAKE LENGTH = BLOCK SIZE. 06980000 N R4,=X'0000FFFF' 06990000 SPACE 07000000 FAWTR40 EQU * 07010000 STH R4,DCBLRECL DCBLRECL FIXES LENGTH TO BE WRITTEN 07020000 SPACE 07030000 ST R3,ADDCOMP EXT 07040000 NI ADDCOMP,X'7F' IF SO, MAKE SWITCH EXT 07050000 CLC ADDCOMP,THELINE DATA AREA OVER LINE? EXT 07060000 BH FORTWSW IF SO, MAKE SWITCH EXT 07070000 LR R9,R3 EXT 07080000 B FORTWX99 ELSE, GO DO WRITE AS IS EXT 07090000 FORTWSW DS 0H EXT 07100000 ************* SWITCH MODES AND MOVE IN WRITE DATA ************* EXT 07110000 STM R4,R7,FORTWXRS SAVE REGS USED FOR MOVE EXT 07120000 LR R7,R4 SAVE INPUT DATA LENGTH REM-EXT 07130000 L R4,=V(BKBUFADD) EXT 07140000 L R4,0(R4) EXT 07150000 LTR R4,R4 EXT 07160000 BNZ FORTWX0 EXT 07170000 ABEND 999,DUMP EXT 07180000 FORTWX0 DS 0H EXT 07190000 L R5,FORTWX1 ADDRESS FOR MODE SWITCH EXT 07200000 BSM 0,R5 SWITCH EXT 07210000 DS 0F EXT 07220000 FORTWX1 DC A(FORTWX2+X'80000000') EXT 07230000 FORTWXRS DC 4F'0' EXT 07240000 FORTWX2 DS 0H EXT 07250000 LR R5,R7 LENGTH OF DATA BUFFER EXT 07260000 LR R6,R3 ADDRESS TO MOVE DATA FROM EXT 07270000 LR R9,R4 SAVE ADDRESS EXT 07280000 MVCL R4,R6 MOVE IN THE DATA EXT 07290000 LA R4,FORTWX3 SWITCH OUT OF 31 BIT MODE EXT 07300000 BSM 0,R4 EXT 07310000 FORTWX3 DS 0H EXT 07320000 LM R4,R7,FORTWXRS RESTORE REGS USED FOR MOVE EXT 07330000 FORTWX99 DS 0H EXT 07340000 SPACE 07350000 * R2=DCB ADDRESS 07360000 * | R9=DATA ADDRESS (USED TO BE R3) 07370000 * | | R4=LENGTH 07380000 PUT (R2),(R9) 07390000 * 07400000 L R6,STATUS WAS END-OF-VOLUME EXIT ENTERED? 07410000 C R6,=F'4' STATUS = 4 = EOV? 07420000 BE FAWTR2 IF YES, EOV. 07430000 C R6,=F'6' STATUS = 6 = EOV + WRITE ERROR? 07440000 BNE RETURN10 IF NO, FINISHED. 07450000 FAWTR2 L R10,DSACHAIN FIND THE DATA SET ATTRIBUTE AREA FOR 07460000 LTR R10,R10 THIS DATA CONTROL BLOCK. 07470000 BZ FAWTR4 07480000 FAWTR3 C R2,DSDCBAD COMPARE INPUT DCB TO AREA DCB. 07490000 BE FAWTR5 ATTRIBUTE AREA HAS BEEN FOUND. 07500000 L R10,DSPOINTR LOAD POINTER FOR NEXT AREA, IF ANY. 07510000 LTR R10,R10 IS THERE ANOTHER AREA? 07520000 BNZ FAWTR3 YES. LOOP TO TEST NEXT AREA. 07530000 FAWTR4 ABEND 226,DUMP NO. WANTED AREA NOT FOUND. ERROR. 07540000 FAWTR5 L R15,DCBDEBAD OBTAIN THE VOLUME SERIAL NO. 07550000 L R15,32(,R15) FROM THE UNIT CONTROL BLOCK 07560000 MVC DSVOLSER,28(R15) AND SEND IT TO CALLING PROGRAM. 07570000 B RETURN10 07580000 SPACE 3 07590000 * SYNAD ERROR EXIT FOR WRITE ENTRY FAWTR 07600000 WSYNAD LA R6,2 07610000 A R6,STATUS STATUS 1 --> 3, OK --> WRITE ERROR. 07620000 ST R6,STATUS STATUS 4 --> 6, EOV --> EOV + WRITE ERROR 07630000 BR R14 07640000 SPACE 3 07650000 * EXIT LIST FOR WRITE ENTRY FAWTR. 07660000 DS 0F 07670000 WEXLST DC X'06',AL3(WEOV) END-OF-VOLUME. 07680000 DC X'87',AL3(JFCB) JOB FILE CONTROL BLOCK AREA. 07690000 SPACE 3 07700000 * END-OF-VOLUME EXIT FOR WRITE ENTRY FAWTR. 07710000 WEOV LA R6,VOLSWTCH VOLUME SWITCH, STATUS = 4. 07720000 ST R6,STATUS 07730000 BR R14 07740000 EJECT 07750000 ********************************************************************** 07760000 * CALL FACWTR (DCBAD, STATUS) * 07770000 * R2 R3---->R5 * 07780000 * CLOSE OUTPUT TRACE DCB * 07790000 ********************************************************************** 07800000 FACWTR ENTER 07810000 LR R5,R3 A(STATUS). 07820000 TM DCBOFLGS,B1T3 DOES IT NEED TO BE CLOSED? 07830000 BZ RETURN10 NO, FINISHED. 07840000 LA R9,DSACHAIN REMOVE DATA SET ATTRIBUTE AREA FROM CHAIN. 07850000 L R10,DSACHAIN R9 = ADDRESS OF PREVIOUS AREA, 07860000 LTR R10,R10 R10 = ADDRESS OF AREA BEING TESTED, 07870000 BZ FACWTR4 R10 = 0 INITIALLY MEANS NO AREAS EXIST. 07880000 B FACWTR3 R11 = ADDRESS OF NEXT AREA. 07890000 FACWTR2 LR R9,R10 07900000 LR R10,R11 07910000 FACWTR3 L R11,DSPOINTR ENTER LOOP HERE WITH R9 & R10 INITIALIZED. 07920000 C R2,DSDCBAD COMPARE DCB ADDRESSES. 07930000 BE FACWTR5 07940000 LTR R11,R11 IS THIS THE LAST AREA? 07950000 BNZ FACWTR2 NO, LOOP TO TEST NEXT AREA. 07960000 FACWTR4 ABEND 227,DUMP NOT FOUND IN LAST AREA--ERROR. 07970000 FACWTR5 ST R11,0(,R9) CHANGE POINTERS TO REMOVE AREA FROM CHAIN. 07980000 FREEMAIN RU,LV=64,A=(R10),SP=1 FREE THE ATTRIBUTE AREA. 07990000 CLOSE ((R2),REWIND) 08000000 FREEPOOL ((R2)) FREE THE ALLOCATED POOL 08010000 B CLSTST 08020000 EJECT 08030000 PREOPN LR R5,R4 A(STATUS). 08040000 TM DCBOFLGS,B1T3 ALREADY OPEN? 08050000 BO RETURN10 YES, FINISHED. 08060000 L R3,0(,R3) BLKSIZE IN WORDS. 08070000 SLL R3,2 BLKSIZE IN BYTES. 08080000 STH R3,DCBBLKSI STORE BLKSIZE IN DCB. 08090000 BR R11 08100000 SPACE 08110000 NODDCD LA R6,NODDCARD 08120000 B RETURN10 08130000 SPACE 08140000 CLSTST TM DCBOFLGS,B1T3 DID THE CLOSE REALLY CLOSE? 08150000 BZ RETURN10 YES. 08160000 LA R6,CLOSFAIL NO. STATUS = 2. 08170000 B RETURN10 08180000 SPACE 08190000 OPNTST TM DCBOFLGS,B1T3 IS IT OPEN? 08200000 BO RETURN10 YES, STATUS = 1 = OK. 08210000 OPNTST10 LA R6,OPENFAIL NO, STATUS = 2 = NOT OPENED. 08220000 B RETURN10 08230000 SPACE 08240000 RETURN L R6,STATUS 08250000 RETURN10 ST R6,0(,R5) STORE STATUS CODE. 08260000 RETURN20 DS 0H 08270000 SPACE 08280000 **************** ADDRESSING RETURN ****************** EXT 08290000 L R5,RETADD EXT 08300000 BSM 0,R5 EXT 08310000 RETURNIT DS 0H EXT 08320000 L R13,4(,R13) 08330000 LM R14,R12,12(R13) 08340000 SR R15,R15 08350000 BR R14 08360000 SPACE 08370000 DS 0F 08380000 SYNADMSA DS F 08390000 SYNADR14 DS F 08400000 DSACHAIN DC F'0' ADDRESS OF FIRST DATA SET ATTRIBUTE AREA. 08410000 ENTRYADD DC F'0' ADDRESS OF ENTRY POINT. 08420000 SAVE14 DC F'0' 08430000 STATUS DC F'0' 08440000 SPACE 08450000 DSATTRIB DSECT DATA SET ATTRIBUTE AREA. 08460000 DSPOINTR DS F ADDRESS OF NEXT AREA. ZERO FOR LAST AREA. 08470000 DSDCBAD DS F ADDRESS OF DCB ASSOCIATED WITH THIS AREA. 08480000 DSVOLSER DS CL6 CURRENT VOLUME SERIAL NUMBER. 08490000 DS CL2 PRESERVE WORD BOUNDARIES. 08500000 DSNAME DS CL44 DATA SET NAME. 08510000 DS F EXTEND AREA TO A MULTIPLE OF 8 (64). 08520000 SPACE 08530000 PRINT NOGEN 08540000 DCBD DSORG=(PS),DEVD=(DA,TA) 08550000 END 08560000