FISC TITLE 'FISCDK -- DIRECT ACCESS OPEN, BUILD, READ, WRITE, CLOS-00010000 C*********************************************************************** C COPYRIGHT ATLANTIC RICHFIELD COMPANY 1991 * C*********************************************************************** E.' 00020000 *AINDMFISCDK -- DIRECT ACCESS OPEN, BUILD, READ, WRITE, CLOSE 00030000 *TITLE FISCDK -- DIRECT ACCESS OPERATIONS, SUMMARY 00040000 * AUTHOR DEBORAH REED 00050000 * DESIGNER JOHN MENDEKE 00060000 * LANGUAGE S/370 ASSEMBLER 00070000 * SYSTEM IBM (SEE CRAY) 00080000 * WRITTEN 2/18/75 00090000 * REVISED 5/15/75 R. MCMILLAN TO CHANGE NAME FROM FISCDISK TO 00100000 * FISCDK AND TO ADD ANOTHER LOAD INSTRUCTION TO 00110000 * GET DCB ADDRESS. 00120000 * REVISED 7/26/76 F. COLLINS. ADD SYNAD EXIT. 00130000 * 00140000 * REVISED 9/10/79 K. KELLY,IBM SE,UNDER IBM SES AGREEMENT 49870A 00150000 * ESTIMATE D68. 00160000 * ADD CODE TO ALLOW BDAM DATA SET TO EXCEED 00170000 * 65536 TRACKS. 00180000 * MODULES IGG019KF AND IGG019KE WEREADDED AS 00190000 * EXTRNS TO THIS MODULE TO PERFORM THE RELATIVE 00200000 * RECORD TO MBBCCHHR CONVERSION. 00210000 * IT WAS NECESSARY TO RESEQUENCE THIS MODULE. 00220000 * CHANGES ARE FLAGGED D68. 00230000 * REVISED 10/10/79 REM. CHANGE NAMES OF IGG019KF AND IGG019KE TO 00240000 * USRBCT AND USRBCN RESPECTIVELY. 00250000 * 00260000 * REVISED 4/01/80 H. LAVALLET TO ADD SUBROUTINE -COUNT- TO 00270000 * COUNT I/O AND SAVE IN WORD KPWKIO IN KP-AREA. 00280000 * 00290000 * REVISED 4/18/80 H. LAVALLET TO ADD CODE AND PARAMETERS TO 00300000 * PASS TO SYNAD I/O ERROR MSG PRINT ROUTINE 00310000 * FOPERR TO INCLUDE RELATIVE RCD # IN MSG. 00320000 * 00330000 * REVISED 11/30/83 R. MCMILLAN TO EXPAND COMMON P SIZE. ADD ABEND 00340000 * 450 FOR SHADOW BDAM DCB NOT FOUND. 00350000 * 00360000 * REVISED 01/14/85 R. KNIGHT. ADDED DUMMY ENTRY POINT FICDD FOR 00370000 * CRAY COMPATIBILITY. 00380000 * REVISED 7-15-85 RSK. 'CAPPED' TO USE 24 BIT ADDRESSING EVEN 00390000 * WHEN CALLED BY A 31 BIT MAIN. ALSO ADDED CODE 00400000 * TO ALLOW THE I/O BUFFERS TO BE MOVED FROM 00410000 * BLANK COMMON TO/FROM BELOW THE LINE BEFORE I/O 00420000 * WAS DONE. CHANGES ARE MARKED BY 'EXT'. 00430000 * REVISED 9-09-86 REM. CHANGE THE WAY AMODE IS SWITCHED TO HANDLE 00440000 * DISK ADDRESSES ABOVE THE LINE. 00450000 * REVISED 2-18-87 REM. ADD EXTRN FOR GETMN2 TO SATISFY BKBUFADD. 00460000 * REVISED 03-19-87 ESN. CHANGED NAME TO FISCDK. 00470000 * REVISED 08-24-87 RSH. ADDED ABORT 451 FOR DA OUTSIDE RANGE 00480000 * REVISED 12-15-87 WAB. ADDED ASYNCH CAPABLITY 00490000 * REVISED 02-25-88 WAB. ADDED LENGTH TO THE CLOSE FREEMAIN FOR 00500000 * ASYNCH CALLS 00510000 * REVISED 02-29-88 WAB. FIXED FREEMAIN IN SEQUENTIAL CLOSE 00520000 * REVISED 05-06-88 WAB. CHANGE GETMAIN/FREEMAINS TO RU TYPE AND 00530000 * SUBPOOL 1. 00540000 * 00550000 * 00560000 * CALL FIISSD (DCBAD, LEN, CRAYPARM, ECB) 00570000 * INPUT DCBAD = ADDRESS OF A BSAM DCB. A4 00580000 * LEN = LENGTH OF EACH RECORD IN BYTES. I4 00590000 * OPTIONAL -- CRAYPARM = PLACE HOLDER NEEDED FOR ASYNCH OPTION I4 00600000 * OPTIONAL -- ECB = 8 WORD INT ARRAY TO HOLD ECB I4 00610000 * PREPARE TO BUILD FILE WITH SEQUENTIAL WRITES (USING FIWSSD). 00620000 * SET THE RECORD LENGTH IN THE BSAM DCB AND OPEN THE FILE. 00630000 * SPECIFYING AN ECB INDICATES ASYNCH I/O WILL BE DONE 00640000 * 00650000 * CALL FIWSSD (DCBAD, SEQDA, DATA, ECB) 00660000 * INPUT DCBAD = BSAM DCB ADDRESS. I4 00670000 * SEQDA = SEQUENTIAL DISK ADDRESS. I4 00680000 * DATA = RECORD TO BE WRITTEN. ANY 00690000 * LENGTH = 'LEN' USED WITH FIISSD. 00700000 * OPTIONAL -- ECB = 8 WORD INT ARRAY TO HOLD ECB I4 00710000 * BUILD FILE BY WRITING SEQUENTIALLLY WITH BSAM. 00720000 * SPECIFYING AN ECB INDICATES ASYNCH I/O WILL BE DONE 00730000 * ASYNCH ROUTINE REQUIRES A 2ND CALL TO COMPLETE 00740000 * 00750000 * CALL FIIDSD (DCBAD, LEN, ECB) 00760000 * INPUT DCBAD = ADDRESS OF BDAM DCB. I4 00770000 * LEN = LENGTH OF EACH RECORD IN BYTES. I4 00780000 * OPTIONAL -- ECB = 8 WORD INT ARRAY TO HOLD ECB I4 00790000 * OPEN FILE FOR DIRECT ACCESS, AFTER 00800000 * FILE HAS BEEN BUILT WITH FIISSD AND FIWSSD. 00810000 * LEN MUST BE SAME VALUE USED WITH FIISSD. 00820000 * SPECIFYING AN ECB INDICATES ASYNCH I/O WILL BE DONE 00830000 * 00840000 * CALL FIRDSD (DCBAD, DA, DATA, ECB) 00850000 * INPUT DCBAD = BDAM DCB ADDRESS. I4 00860000 * DA = RECORD NUMBER IN FILE (1, 2, 3, ...) I4 00870000 * OUTPUT DATA = RECORD NUMBER DA READ FROM FILE. ANY 00880000 * DA = DA + 1 I4 00890000 * OPTIONAL -- ECB = 8 WORD INT ARRAY TO HOLD ECB I4 00900000 * READ RECORD NUMBER DA AND STORE IN DATA. 00910000 * RECORD LENGTH IS 'LEN' USED IN FIISSD AND FIIDSD. 00920000 * SPECIFYING AN ECB INDICATES ASYNCH I/O WILL BE DONE 00930000 * 00940000 * CALL FIWDSD (DCBAD, DA, DATA, ECB) 00950000 * INPUT DCBAD = BDAM DCB ADDRESS. I4 00960000 * DA = RECORD NUMBER IN FILE (1, 2, 3, ...) I4 00970000 * DATA = RECORD TO BE WRITTEN. ANY 00980000 * OPTIONAL -- ECB = 8 WORD INT ARRAY TO HOLD ECB I4 00990000 * OUTPUT DA = DA + 1 I4 01000000 * WRITE RECORD GIVEN IN DATA AT LOCATION GIVEN BY DA. 01010000 * RECORD LENGTH IS 'LEN' USED IN FIISSD AND FIIDSD. 01020000 * SPECIFYING AN ECB INDICATES ASYNCH I/O WILL BE DONE 01030000 * 01040000 * CALL FICSD (DCBAD, ECB) 01050000 * INPUT DCBAD = ADDRESS OF DCB TO BE CLOSED. I4 01060000 * OPTIONAL -- ECB = 8 WORD INT ARRAY TO HOLD ECB I4 01070000 * CLOSE THE FILE. 01080000 * SPECIFYING AN ECB INDICATES ASYNCH I/O WAS DONE 01090000 * 01100000 * CALL FICDD (DCBAD, ECB) 01110000 * INPUT DCBAD = ADDRESS OF DCB TO BE CLOSED. I4 01120000 * OPTIONAL -- ECB = 8 WORD INT ARRAY TO HOLD ECB I4 01130000 * CLOSE THE FILE. 01140000 * SPECIFYING AN ECB INDICATES ASYNCH I/O WAS DONE 01150000 * 01160000 EJECT 01170000 * THE FILE IS CREATED SEQUENTIALLY WITH FIISSD AND FIWSSD. THEN 01180000 * IT CAN BE ACCESSED DIRECTLY WITH FIIDSD, FIRDSD, AND FIWDSD. 01190000 * 01200000 * DCB PARAMETERS DSORG RECFM DEVD MACRF OPTCD 01210000 * BSAM PS F DA (WL) 01220000 * BDAM DA F DA (RIC,WIC) RF 01230000 * EJECT 01240000 * USER ABEND CODES: 444 - FIISSD CALLED, OPEN FAILED. 01250000 * 445 - FIIDSD CALLED, OPEN FAILED. 01260000 * 446 - FIWSSD CALLED, FILE NOT OPEN. 01270000 * 447 - FIRDSD CALLED, FILE NOT OPEN. 01280000 * 448 - FIWDSD CALLED, FILE NOT OPEN. 01290000 * 449 - INPUT/OUTPUT ERROR. SYNADAF MESSAGE. 01300000 * 450 - SHADOW BDAM DCB NOT FOUND. 01310000 * 451 - DA OUTSIDE FILE RANGE. 01320000 * SYSTEM ABEND CODE: 001 - DIRECT ACCESS USED BEFORE FILE BUILT. 01330000 * END 01340000 EJECT 01350000 *TITLE FIISSD -- OPEN FOR BUILDING DIRECT FILE SEQUENTIALLY 01360000 *A AUTHOR DEBORAH REED 01370000 *A DESIGNER JOHN MENDEKE 01380000 *A LANGUAGE S/370 ASSEMBLER 01390000 *A WRITTEN 2/18/75 01400000 *A 01410000 *A 01420000 *A CALL FIISSD (DCBAD, LEN, CRAYPARM, ECB) 01430000 *A INPUT DCBAD = ADDRESS OF A BSAM DCB A4 01440000 *A LEN = LENGTH OF EACH RECORD IN BYTES I4 01450000 *A CRAYPARM = PLACE HOLDER IF ECB IS SPECIFYED I4 01460000 *A ECB = 8 WORD ARRAY FOR ECB FOR ASYNCH I/O I4 01470000 *A 01480000 *A 01490000 *A PREPARE TO BUILD FILE WITH SEQUENTIAL WRITES (USING FIWSSD). 01500000 *A SET THE RECORD LENGTH IN THE BSAM DCB AND OPEN THE FILE. 01510000 *A 01520000 *A THE FILE IS CREATED SEQUENTIALLY WITH FIISSD AND FIWSSD. THEN 01530000 *A IT CAN BE ACCESSED DIRECTLY WITH FIIDSD, FIRDSD, AND FIWDSD. 01540000 *A 01550000 *A DCB PARAMETERS DSORG RECFM DEVD MACRF OPTCD 01560000 *A BSAM PS F DA (WL) 01570000 *A BDAM DA F DA (RIC,WIC) RF 01580000 *A 01590000 *A USER ABEND CODES: 444 - FIISSD CALLED, OPEN FAILED. 01600000 * 445 - FIIDSD CALLED, OPEN FAILED. 01610000 * 446 - FIWSSD CALLED, FILE NOT OPEN. 01620000 * 447 - FIRDSD CALLED, FILE NOT OPEN. 01630000 * 448 - FIWDSD CALLED, FILE NOT OPEN. 01640000 * 449 - INPUT/OUTPUT ERROR. SYNADAF MESSAGE. 01650000 * 450 - SHADOW BDAM DCB NOT FOUND. 01660000 * 451 - DA OUTSIDE FILE RANGE. 01670000 *A SYSTEM ABEND CODE: 001 - DIRECT ACCESS USED BEFORE FILE BUILT. 01680000 *AEND 01690000 EJECT 01700000 *TITLE FIWSSD -- WRITE SEQUENTIALLY TO BUILD DIRECT ACCESS FILE 01710000 *A AUTHOR DEBORAH REED 01720000 *A DESIGNER JOHN MENDEKE 01730000 *A LANGUAGE S/370 ASSEMBLER 01740000 *A WRITTEN 2/18/75 01750000 *A 01760000 *A 01770000 *A CALL FIWSSD (DCBAD, SEQDA, DATA, ECB) 01780000 *A INPUT DCBAD = BSAM DCB ADDRESS I4 01790000 *A SEQDA = SEQUENTIAL DISK ADDRESS I4 01800000 *A DATA = RECORD TO BE WRITTEN ANY 01810000 *A LENGTH = 'LEN' USED WITH FIISSD 01820000 *A OPTIONAL ECB = 8 WORD ARRAY FOR ECB FOR ASYNCH I/O I4 01830000 *A 01840000 *A 01850000 *A BUILD FILE BY WRITING SEQUENTIALLLY WITH BSAM. 01860000 *A A SECOND CALL IS REQUIRED TO COMPLETE THE WRITE WHEN USING THE 01870000 *A ASYNCH OPTION. 01880000 *A 01890000 *A THE FILE IS CREATED SEQUENTIALLY WITH FIISSD AND FIWSSD. THEN 01900000 *A IT CAN BE ACCESSED DIRECTLY WITH FIIDSD, FIRDSD, AND FIWDSD. 01910000 *A 01920000 *A DCB PARAMETERS DSORG RECFM DEVD MACRF OPTCD 01930000 *A BSAM PS F DA (WL) 01940000 *A BDAM DA F DA (RIC,WIC) RF 01950000 *A 01960000 * USER ABEND CODES: 444 - FIISSD CALLED, OPEN FAILED. 01970000 * 445 - FIIDSD CALLED, OPEN FAILED. 01980000 *A USER ABEND CODES: 446 - FIWSSD CALLED, FILE NOT OPEN. 01990000 * 447 - FIRDSD CALLED, FILE NOT OPEN. 02000000 * 448 - FIWDSD CALLED, FILE NOT OPEN. 02010000 *A 449 - INPUT/OUTPUT ERROR. SYNADAF MESSAGE. 02020000 * 450 - SHADOW BDAM DCB NOT FOUND. 02030000 *A SYSTEM ABEND CODE: 001 - DIRECT ACCESS USED BEFORE FILE BUILT. 02040000 *AEND 02050000 EJECT 02060000 *TITLE FIIDSD -- OPEN FOR DIRECT ACCESS (AFTER FILE IS BUILT) 02070000 *A AUTHOR DEBORAH REED 02080000 *A DESIGNER JOHN MENDEKE 02090000 *A LANGUAGE S/370 ASSEMBLER 02100000 *A WRITTEN 2/18/75 02110000 *A 02120000 *A 02130000 *A CALL FIIDSD (DCBAD, LEN) 02140000 *A INPUT DCBAD = ADDRESS OF BDAM DCB I4 02150000 *A LEN = LENGTH OF EACH RECORD IN BYTES I4 02160000 *A OPTIONAL ECB = 8 WORD ARRAY FOR ECB FOR ASYNCH I/O I4 02170000 *A OPEN FILE FOR DIRECT ACCESS, AFTER 02180000 *A FILE HAS BEEN BUILT WITH FIISSD AND FIWSSD. 02190000 *A LEN MUST BE SAME VALUE USED WITH FIISSD. 02200000 *A 02210000 *A THE FILE IS CREATED SEQUENTIALLY WITH FIISSD AND FIWSSD. THEN 02220000 *A IT CAN BE ACCESSED DIRECTLY WITH FIIDSD, FIRDSD, AND FIWDSD. 02230000 *A 02240000 *A DCB PARAMETERS DSORG RECFM DEVD MACRF OPTCD 02250000 *A BSAM PS F DA (WL) 02260000 *A BDAM DA F DA (RIC,WIC) RF 02270000 *A 02280000 * USER ABEND CODES: 444 - FIISSD CALLED, OPEN FAILED. 02290000 *A USER ABEND CODES: 445 - FIIDSD CALLED, OPEN FAILED. 02300000 * 446 - FIWSSD CALLED, FILE NOT OPEN. 02310000 * 447 - FIRDSD CALLED, FILE NOT OPEN. 02320000 * 448 - FIWDSD CALLED, FILE NOT OPEN. 02330000 * 449 - INPUT/OUTPUT ERROR. SYNADAF MESSAGE. 02340000 * 450 - SHADOW BDAM DCB NOT FOUND. 02350000 *A SYSTEM ABEND CODE: 001 - DIRECT ACCESS USED BEFORE FILE BUILT. 02360000 *AEND 02370000 EJECT 02380000 *TITLE FIRDSD -- READ DIRECT ACCESS FILE 02390000 *A AUTHOR DEBORAH REED 02400000 *A DESIGNER JOHN MENDEKE 02410000 *A LANGUAGE S/370 ASSEMBLER 02420000 *A WRITTEN 2/18/75 02430000 *A 02440000 *A 02450000 *A CALL FIRDSD (DCBAD, DA, DATA, ECB) 02460000 *A INPUT DCBAD = BDAM DCB ADDRESS I4 02470000 *A DA = RECORD NUMBER IN FILE (1, 2, 3, ...) I4 02480000 *A OUTPUT DATA = RECORD NUMBER DA READ FROM FILE ANY 02490000 *A OPTIONAL ECB = 8 WORD ARRAY FOR ECB FOR ASYNCH I/O I4 02500000 *A DA = DA + 1 I4 02510000 *A 02520000 *A 02530000 *A READ RECORD NUMBER DA AND STORE IN DATA. 02540000 *A RECORD LENGTH IS 'LEN' USED IN FIISSD AND FIIDSD. 02550000 *A A SECOND CALL IS REQUIRED TO COMPLETE THE READ WHEN USING THE 02560000 *A ASYNCH OPTIONS. 02570000 *A 02580000 *A THE FILE IS CREATED SEQUENTIALLY WITH FIISSD AND FIWSSD. THEN 02590000 *A IT CAN BE ACCESSED DIRECTLY WITH FIIDSD, FIRDSD, AND FIWDSD. 02600000 *A 02610000 *A DCB PARAMETERS DSORG RECFM DEVD MACRF OPTCD 02620000 *A BSAM PS F DA (WL) 02630000 *A BDAM DA F DA (RIC,WIC) RF 02640000 *A 02650000 * USER ABEND CODES: 444 - FIISSD CALLED, OPEN FAILED. 02660000 * 445 - FIIDSD CALLED, OPEN FAILED. 02670000 * 446 - FIWSSD CALLED, FILE NOT OPEN. 02680000 *A USER ABEND CODES: 447 - FIRDSD CALLED, FILE NOT OPEN. 02690000 * 448 - FIWDSD CALLED, FILE NOT OPEN. 02700000 *A 449 - INPUT/OUTPUT ERROR. SYNADAF MESSAGE. 02710000 *A 450 - SHADOW BDAM DCB NOT FOUND. 02720000 *A SYSTEM ABEND CODE: 001 - DIRECT ACCESS USED BEFORE FILE BUILT. 02730000 *AEND 02740000 EJECT 02750000 *TITLE FIWDSD -- WRITE DIRECT ACCESS RECORD 02760000 *A AUTHOR DEBORAH REED 02770000 *A DESIGNER JOHN MENDEKE 02780000 *A LANGUAGE S/370 ASSEMBLER 02790000 *A WRITTEN 2/18/75 02800000 *A 02810000 *A 02820000 *A CALL FIWDSD (DCBAD, DA, DATA, ECB) 02830000 *A INPUT DCBAD = BDAM DCB ADDRESS I4 02840000 *A DA = RECORD NUMBER IN FILE (1, 2, 3, ...) I4 02850000 *A DATA = RECORD TO BE WRITTEN ANY 02860000 *A OPTIONAL ECB = 8 WORD ARRAY FOR ECB FOR ASYNCH I/O I4 02870000 *A OUTPUT DA = DA + 1 I4 02880000 *A 02890000 *A 02900000 *A WRITE RECORD GIVEN IN DATA AT LOCATION GIVEN BY DA. 02910000 *A RECORD LENGTH IS 'LEN' USED IN FIISSD AND FIIDSD. 02920000 *A A SECOND CALL IS REQUIRED TO COMPLETE THE WRITE WHEN USING THE 02930000 *A ASYNCH OPTION. 02940000 *A 02950000 *A THE FILE IS CREATED SEQUENTIALLY WITH FIISSD AND FIWSSD. THEN 02960000 *A IT CAN BE ACCESSED DIRECTLY WITH FIIDSD, FIRDSD, AND FIWDSD. 02970000 *A 02980000 *A DCB PARAMETERS DSORG RECFM DEVD MACRF OPTCD 02990000 *A BSAM PS F DA (WL) 03000000 *A BDAM DA F DA (RIC,WIC) RF 03010000 *A 03020000 * USER ABEND CODES: 444 - FIISSD CALLED, OPEN FAILED. 03030000 * 445 - FIIDSD CALLED, OPEN FAILED. 03040000 * 446 - FIWSSD CALLED, FILE NOT OPEN. 03050000 * 447 - FIRDSD CALLED, FILE NOT OPEN. 03060000 *A USER ABEND CODES: 448 - FIWDSD CALLED, FILE NOT OPEN. 03070000 *A 449 - INPUT/OUTPUT ERROR. SYNADAF MESSAGE. 03080000 *A 450 - SHADOW BDAM DCB NOT FOUND. 03090000 *A SYSTEM ABEND CODE: 001 - DIRECT ACCESS USED BEFORE FILE BUILT. 03100000 *AEND 03110000 EJECT 03120000 *TITLE FICSD -- CLOSE DIRECT ACCESS FILE 03130000 *A AUTHOR DEBORAH REED 03140000 *A DESIGNER JOHN MENDEKE 03150000 *A LANGUAGE S/370 ASSEMBLER 03160000 *A WRITTEN 2/18/75 03170000 *A 03180000 *A 03190000 *A 03200000 *A CALL FICSD (DCBAD, ECB) 03210000 *A INPUT DCBAD = ADDRESS OF DCB TO BE CLOSED I4 03220000 *A OPTIONAL ECB = 8 WORD ARRAY FOR ECB FOR ASYNCH I/O I4 03230000 *A 03240000 *A CLOSE THE FILE. 03250000 *A YOU MUST SPECIFY THE ECB TO RELEASE SPACE ALLOCATED FOR ASYNCH 03260000 *A I/O. 03270000 *A 03280000 *A THE FILE IS CREATED SEQUENTIALLY WITH FIISSD AND FIWSSD. THEN 03290000 *A IT CAN BE ACCESSED DIRECTLY WITH FIIDSD, FIRDSD, AND FIWDSD. 03300000 *A 03310000 *A DCB PARAMETERS DSORG RECFM DEVD MACRF OPTCD 03320000 *A BSAM PS F DA (WL) 03330000 *A BDAM DA F DA (RIC,WIC) RF 03340000 *A 03350000 * USER ABEND CODES: 444 - FIISSD CALLED, OPEN FAILED. 03360000 * 445 - FIIDSD CALLED, OPEN FAILED. 03370000 * 446 - FIWSSD CALLED, FILE NOT OPEN. 03380000 * 447 - FIRDSD CALLED, FILE NOT OPEN. 03390000 * 448 - FIWDSD CALLED, FILE NOT OPEN. 03400000 * 449 - INPUT/OUTPUT ERROR. SYNADAF MESSAGE. 03410000 * 450 - SHADOW BDAM DCB NOT FOUND. 03420000 *A SYSTEM ABEND CODE: 001 - DIRECT ACCESS USED BEFORE FILE BUILT. 03430000 *AEND 03440000 EJECT 03450000 *TITLE FICDD -- CLOSE DIRECT ACCESS FILE 03460000 *A AUTHOR DEBORAH REED 03470000 *A DESIGNER JOHN MENDEKE 03480000 *A LANGUAGE S/370 ASSEMBLER 03490000 *A WRITTEN ADDED BY RDK 01/14/84 03500000 *A 03510000 *A 03520000 *A 03530000 *A CALL FICDD (DCBAD) 03540000 *A INPUT DCBAD = ADDRESS OF DCB TO BE CLOSED I4 03550000 *A OPTIONAL ECB = 8 WORD ARRAY FOR ECB FOR ASYNCH I/O I4 03560000 *A 03570000 *A CLOSE THE FILE. 03580000 *A YOU MUST SPECIFY THE ECB TO RELEASE SPACE ALLOCATED FOR ASYNCH 03590000 *A I/O. 03600000 *A 03610000 *A THE FILE IS CREATED SEQUENTIALLY WITH FIISSD AND FIWSSD. THEN 03620000 *A IT CAN BE ACCESSED DIRECTLY WITH FIIDSD, FIRDSD, AND FIWDSD. 03630000 *A 03640000 *A DCB PARAMETERS DSORG RECFM DEVD MACRF OPTCD 03650000 *A BSAM PS F DA (WL) 03660000 *A BDAM DA F DA (RIC,WIC) RF 03670000 *A 03680000 * USER ABEND CODES: 444 - FIISSD CALLED, OPEN FAILED. 03690000 * 445 - FIIDSD CALLED, OPEN FAILED. 03700000 * 446 - FIWSSD CALLED, FILE NOT OPEN. 03710000 * 447 - FIRDSD CALLED, FILE NOT OPEN. 03720000 * 448 - FIWDSD CALLED, FILE NOT OPEN. 03730000 * 449 - INPUT/OUTPUT ERROR. SYNADAF MESSAGE. 03740000 * 450 - SHADOW BDAM DCB NOT FOUND. 03750000 *A SYSTEM ABEND CODE: 001 - DIRECT ACCESS USED BEFORE FILE BUILT. 03760000 *AEND 03770000 EJECT 03780000 PRINT GEN D68 03790000 FISCDK MENTRYPT 2,(FIISSD,FIWSSD,FIIDSD,FIRDSD,FIWDSD,FICSD,FICDD) 03800000 * 03810000 EXTRN GETMN2 03820000 * 03830000 LR R12,R13 USE R12 AS BASE REGISTER 03840000 DROP R13 TO REDUCE COMPLICATIONS 03850000 USING SAVEAREA,R12 IN SYNAD EXIT. 03860000 USING IHADCB,R10 R10 = ADDRESS OF DATA CONTROC BLOCK. 03870000 L R6,=V(P) R6 = ADDR OF COMMON P AREA, USED TO 03880000 USING PDSECT,R6 COUNT I/O FOR EACH PROCESS 03890000 LR R11,R1 03900000 ST R11,PARMLIST SAVE R11 FOR LATER USE 03910000 L R10,0(,R11) 03920000 L R10,0(,R10) 03930000 SPACE 03940000 **************** ADDRESSING MODE SWITCH ****************** EXT 03950000 FISCDK AMODE ANY EXT 03960000 FISCDK RMODE 24 EXT 03970000 B *(2) 03980000 B FIISSD$ 03990000 B FIWSSD$ 04000000 B FIIDSD$ 04010000 B FIRDSD$ 04020000 B FIWDSD$ 04030000 B FICSD$ 04040000 B FICDD$ 04050000 SPACE 04060000 *************************************************************** 04070000 * INITIALIZE SEQUENTIAL(BSAM) SCRATCH DISK 04080000 * CALL FIISSD (DCBAD,LENGTH,CRAYPARM,ECB) 04090000 * 04100000 *************************************************************** 04110000 FIISSD$ TM DCBOFLGS,X'10' OPEN? 04120000 BO RETURN 04130000 L R3,4(R11) A(LENGTH) 04140000 L R3,0(R3) LENGTH 04150000 STH R3,DCBBLKSI STORE LENGTH IN DCB 04160000 LA R3,BSAMERR ADDRESS OF BSAM SYNAD. 04170000 ST R3,DCBSYNAD STORE IN DCB. 04180000 LA R11,FOISXX2 04190000 LA R4,FOISXX1 04200000 BSM R11,R4 CHANGE TO 24 BIT ADDR&SAVE OLD 04210000 FOISXX1 DS 0H 04220000 * 04230000 OPEN ((R10),(OUTPUT)) 04240000 * 04250000 BSM 0,R11 CHANGE BACK TO INPUT AMODE 04260000 FOISXX2 DS 0H 04270000 TM DCBOFLGS,X'10' 04280000 BO FOGETBF 04290000 ABEND 444 04300000 SPACE 04310000 FOGETBF L R11,PARMLIST 04320000 L R3,4(R11) CHECK FOR A 3RD ARG 04330000 ST R3,PARMLIST 04340000 CLC PARMLIST,=X'80000000' 04350000 BH RETURN 04360000 L R3,8(R11) CHECK FOR A 4TH ARG 04370000 ST R3,PARMLIST 04380000 CLC PARMLIST,=X'80000000' 04390000 BH RETURN 04400000 * WE'VE GOT AN ECB, SO DO A GETMAIN FOR A BUFFER NEEDED FOR ASYNCH 04410000 LH R3,DCBBLKSI 04420000 GETMAIN RU,LV=(3),SP=1,LOC=BELOW 04430000 L R3,12(R11) 04440000 MVC 0(32,R3),ZEROS 04450000 ST R1,28(R3) 04460000 B RETURN 04470000 SPACE 04480000 ******************************************************************* 04490000 * WRITE SEQUENTIALLY ON SCRATCH DISK 04500000 * CALL FIWSSD (DCBAD, SEQDA, DATA, ECB) 04510000 ******************************************************************* 04520000 FIWSSD$ TM DCBOFLGS,X'10' OPEN? 04530000 BO WRITSEQ YES. 04540000 ABEND 446,DUMP 04550000 WRITSEQ L R3,8(R11) CHECK FOR A 4TH ARG 04560000 ST R3,PARMLIST 04570000 CLC PARMLIST,=X'80000000' 04580000 BL ARITSEQ 04590000 * WE'VE GOT AN ECB, SO GO TO THE ASYNCH VERSION 04600000 L R4,4(R11) A(SEQDA) 04610000 L R2,0(R4) SEQDA 04620000 ST R2,SYNDSKA SAVE RCD # FOR ERROR MSG 04630000 L R3,8(R11) A(DATA) 04640000 SPACE 04650000 LA R11,FOWSXX5 04660000 BSM R11,0 SAVE INPUT AMODE 04670000 ST R3,COMPADD EXT 04680000 NI COMPADD,X'7F' EXT 04690000 CLC COMPADD,THELINE IS DATA ADDRESS > 16M? EXT 04700000 BH FOWSXXSW IF SO, DO SWITCH. EXT 04710000 LR R9,R3 ELSE DO WRITE THE OLD FASHIONED EXT 04720000 B FOWSXX3 WAY. EARN IT! EXT 04730000 ************* SWITCH MODE, MOVE DATA, WRITE DATA ************* EXT 04740000 FOWSXXSW DS 0H EXT 04750000 STM R4,R7,FOWSXXRS SAVE REGS USED FOR MOVE EXT 04760000 L R4,=V(BKBUFADD) GET BUFFER ADDRESS ADDRESS EXT 04770000 L R4,0(R4) GET BUFFER ADDRESS ADDRESS EXT 04780000 LTR R4,R4 EXT 04790000 BNZ FOWSXX0 EXT 04800000 ABEND 999,DUMP EXT 04810000 FOWSXX0 DS 0H EXT 04820000 L R5,FOWSXX1 ADDRESS FOR MODE SWITCH EXT 04830000 BSM 0,R5 SWITCH TO 31 BIT MODE EXT 04840000 DS 0F EXT 04850000 FOWSXX1 DC A(FOWSXX2+X'80000000') EXT 04860000 FOWSXXRS DC 4F'0' EXT 04870000 FOWSXX2 DS 0H EXT 04880000 LH R5,DCBBLKSI LENGTH OF DATA BUFFER EXT 04890000 N R5,=X'0000FFFF' EXT 04900000 LR R7,R5 EXT 04910000 LR R6,R3 ADDRESS TO MOVE DATA FROM EXT 04920000 LR R9,R4 SAVE BUFFER ADDRESS FOR LATER EXT 04930000 MVCL R4,R6 MOVE IN THE DATA EXT 04940000 LM R4,R7,FOWSXXRS RESTORE REGS USED FOR MOVE EXT 04950000 FOWSXX3 LA R8,FOWSXX4 EXT 04960000 BSM 0,R8 SWITCH TO 24 BIT MODE EXT 04970000 FOWSXX4 DS 0H EXT 04980000 ************* WRITE DATA ************************************** EXT 04990000 SPACE 05000000 WRITE BSAMWDEC,SF,(R10),(R9),'S' CHANGED TO R9 FROM R3 EXT 05010000 CHECK BSAMWDEC 05020000 * 05030000 BSM 0,R11 SWITCH BACK TO INPUT MODE 05040000 FOWSXX5 DS 0H 05050000 LA R2,1(R2) SEQDA+1 05060000 ST R2,0(R4) 05070000 ** 05080000 ** GO COUNT THIS I/O 05090000 ** 05100000 BAL R14,COUNT ACCUMULATE I/O COUNT 05110000 ** 05120000 B RETURN 05130000 EJECT 05140000 ******************************************************************* 05150000 * WRITE SEQUENTIALLY ON SCRATCH DISK, ASYNCH VERSION 05160000 * CALL FIWSSD (DCBAD, SEQDA, DATA, ECB) 05170000 ******************************************************************* 05180000 * SAVE THE WAITFLAG 05190000 ARITSEQ L R4,12(R11) 05200000 MVC WAITFLAG(4),8(R4) 05210000 ST R4,ECBADDR 05220000 * 05230000 L R4,4(R11) A(SEQDA) 05240000 L R2,0(R4) SEQDA 05250000 ST R2,SYNDSKA SAVE RCD # FOR ERROR MSG 05260000 L R3,8(R11) A(DATA) 05270000 * 05280000 LA R11,AOWSXX5 05290000 BSM R11,0 SAVE INPUT AMODE 05300000 * 05310000 * SEE IF THIS IS A WAIT CALL 05320000 CLC WAITFLAG,=F'0' 05330000 BNE AOWWAIT 05340000 MVC WAITFLAG(4),=F'1' 05350000 * 05360000 * IN THE ASYNCH VERSION, WE ALWAYS MOVE THE DATA INTO A BUFFER 05370000 ************* SWITCH MODE, MOVE DATA, WRITE DATA ************* EXT 05380000 STM R4,R7,AOWSXXRS SAVE REGS USED FOR MOVE EXT 05390000 L R4,ECBADDR GET ECB ARRAY ADDRESS 05400000 L R4,28(R4) GET BUFFER ADDRESS FROM ECB 05410000 LTR R4,R4 EXT 05420000 BNZ AOWSXX0 EXT 05430000 ABEND 999,DUMP EXT 05440000 AOWSXX0 L R5,AOWSXX1 ADDRESS FOR MODE SWITCH EXT 05450000 BSM 0,R5 SWITCH TO 31 BIT MODE EXT 05460000 DS 0F EXT 05470000 AOWSXX1 DC A(AOWSXX2+X'80000000') EXT 05480000 AOWSXXRS DC 4F'0' EXT 05490000 AOWSXX2 DS 0H EXT 05500000 LH R5,DCBBLKSI LENGTH OF DATA BUFFER EXT 05510000 N R5,=X'0000FFFF' EXT 05520000 LR R7,R5 EXT 05530000 LR R6,R3 ADDRESS TO MOVE DATA FROM EXT 05540000 LR R9,R4 SAVE BUFFER ADDRESS FOR LATER EXT 05550000 MVCL R4,R6 MOVE IN THE DATA EXT 05560000 LM R4,R7,AOWSXXRS RESTORE REGS USED FOR MOVE EXT 05570000 AOWSXX3 LA R8,AOWSXX4 EXT 05580000 BSM 0,R8 SWITCH TO 24 BIT MODE EXT 05590000 AOWSXX4 DS 0H EXT 05600000 ************* WRITE DATA ************************************** EXT 05610000 * 05620000 WRITE ASAMWDEC,SF,(R10),(R9),'S' CHANGED TO R9 FROM R3 EXT 05630000 ORG *-2 CANCEL BALR 05640000 L R1,ECBADDR MOVE THE ECB INTO THE 4TH ARG 05650000 LA R3,ASAMWDEC ARRAY FOR USE ON THE WAIT CALL 05660000 MVC 0(28,R1),0(R3) 05670000 WRITE (1),SF,(R10),(R9),'S',,,MF=E 05680000 BSM 0,R11 SWITCH BACK TO INPUT MODE 05690000 * 05700000 ************* WAIT CALL *************************************** 05710000 AOWWAIT L 1,ECBADDR ISSUE THE CHECK MACRO TO WAIT 05720000 MVC WAITFLAG(4),=F'0' CLEAR THE WAIT FLAG 05730000 LA R8,AOWWAIT1 EXT 05740000 BSM 0,R8 SWITCH TO 24 BIT MODE EXT 05750000 AOWWAIT1 DS 0H EXT 05760000 CHECK (1) FOR THE IO TO COMPLETE 05770000 MVC 8(4,R1),=F'0' CLEAR THE WAIT FLAG 05780000 BSM 0,R11 SWITCH BACK TO INPUT MODE 05790000 * 05800000 AOWSXX5 DS 0H 05810000 CLC WAITFLAG,=F'0' SEE IF THIS WAS A WAIT CALL 05820000 BE RETURN 05830000 LA R2,1(R2) SEQDA+1 05840000 ST R2,0(R4) 05850000 ** 05860000 ** GO COUNT THIS I/O 05870000 ** 05880000 BAL R14,COUNT ACCUMULATE I/O COUNT 05890000 ** 05900000 B RETURN 05910000 EJECT 05920000 ******************************************************************* 05930000 * INITIALIZE DIRECT(BDAM) SCRATCH DISK 05940000 * CALL FIIDSD (DCBAD, LENGTH, ECB) 05950000 **************************************************************** 05960000 FIIDSD$ TM DCBOFLGS,X'10' OPEN? 05970000 BO RETURN 05980000 L R3,4(R11) A(LENGTH) 05990000 L R3,0(R3) LENGTH 06000000 STH R3,DCBBLKSI STORE LENGTH IN DCB. 06010000 LA R3,BDAMERR ADDRESS OF BDAM SYNAD. 06020000 ST R3,DCBSYNAD STORE IN DCB. 06030000 TM DCBDSORG,DCBDSGDA D68 06040000 BZ FIIDSD$2 NOT DSORG=DA D68 06050000 TM DCBOPTCD,DCBOPTRB D68 06060000 BZ FIIDSD$2 REL BLK ADDR NOT SPEC D68 06070000 ** OBTAIN SHADOW ELEMENT TO BUILD SECOND DCB IN. D68 06080000 ** THIS DCB WILL BE OPEN FOR ABS ADDR TYPE BDAM. D68 06090000 GETMAIN RU,LV=MC99,SP=1 SHADOW ELM D68 06100000 LR R9,R1 D68 06110000 USING MCHAIND,R9 D68 06120000 L R1,MCHAINS FIRST PREV ALLOC ELM D68 06130000 ST R1,MCHAINP CHAIN IN D68 06140000 ST R9,MCHAINS THIS TO CURRENT PTR D68 06150000 ST R10,MCHAIN1 ORIG DCB TO SHADOW ELM D68 06160000 MVC MCHAIN2,0(R10) COPY DCB AND MOD IT D68 06170000 LA R9,MCHAIN2 COPYIED DCB ADDR D68 06180000 DROP R9 D68 06190000 NI DCBOPTCD-IHADCB(R9),X'FF'-DCBOPTRB CANCEL REL BLK D68 06200000 OI DCBOPTCD-IHADCB(R9),DCBOPTA TURN ON ABS D68 06210000 LA R11,FOIDXX2 06220000 LA R4,FOIDXX1 06230000 BSM R11,R4 SWITCH TO 24 BIT MODE 06240000 FOIDXX1 DS 0H 06250000 * 06260000 OPEN ((R9),UPDAT) OPEN SHADOW DCB D68 06270000 FIIDSD$2 EQU * D68 06280000 OPEN ((R10),(UPDAT)) 06290000 * 06300000 BSM 0,R11 SWITCH BACK TO INPUT MODE 06310000 FOIDXX2 DS 0H 06320000 TM DCBOFLGS,X'10' 06330000 BO FIGETBUF 06340000 ABEND 445 06350000 * 06360000 FIGETBUF L R11,PARMLIST 06370000 L R3,4(R11) CHECK FOR A 3RD ARG 06380000 ST R3,PARMLIST 06390000 CLC PARMLIST,=X'80000000' 06400000 BH RETURN 06410000 * WE'VE GOT AN ECB, SO DO A GETMAIN FOR A BUFFER NEEDED FOR ASYNCH 06420000 LH R3,DCBBLKSI 06430000 GETMAIN RU,LV=(3),SP=1,LOC=BELOW 06440000 L R3,8(R11) GET THE ECB ARRAY ADDRESS 06450000 MVC 0(32,R3),ZEROS SET IT TO ZEROS AND THEN SAVE 06460000 ST R1,28(R3) THE GETMAIN ADDRESS IN IT 06470000 B RETURN 06480000 EJECT 06490000 **************************************************************** 06500000 * READ DIRECT FROM SCRATCH DISK 06510000 * CALL FIRDSD (DCBAD, DA, DATA, ECB) 06520000 **************************************************************** 06530000 FIRDSD$ TM DCBOFLGS,X'10' OPEN? 06540000 BO READDIR 06550000 ABEND 447,DUMP 06560000 READDIR L R3,8(R11) CHECK FOR A 4TH ARG 06570000 ST R3,PARMLIST 06580000 CLC PARMLIST,=X'80000000' 06590000 BL AEADDIR 06600000 * WE'VE GOT AN ECB, SO GO TO THE ASYNCH VERSION 06610000 L R4,4(R11) A(DA) 06620000 L R2,0(R4) RECORD # 06630000 ST R2,SYNDSKA SAVE RCD # FOR ERROR MSG 06640000 L R3,8(R11) A(DATA) 06650000 LR R5,R2 06660000 BCTR R5,0 -1 06670000 ST R5,BLKREF SAVE DA - 1 06680000 LA R5,BLKREF+1 06690000 ST R3,COMPADD EXT 06700000 NI COMPADD,X'7F' EXT 06710000 CLC COMPADD,THELINE IS DATA ADDRESS > 16M? EXT 06720000 BL READBK11 IF NOT, GO ON. EXT 06730000 L R3,=V(BKBUFADD) GET BUFFER ADDRESS ADDRESS EXT 06740000 L R3,0(R3) GET BUFFER ADDRESS ADDRESS EXT 06750000 LTR R3,R3 EXT 06760000 BNZ READBK11 EXT 06770000 ABEND 999,DUMP EXT 06780000 READBK11 DS 0H EXT 06790000 LA R11,FORDXX2 06800000 LA R8,FORDXX1 06810000 BSM R11,R8 CHANGE TO 24 BIT MODE 06820000 FORDXX1 DS 0H 06830000 * 06840000 READ BDAMRDEC,DI,(R10),(R3),'S',0,(R5) 06850000 ORG *-2 CANCEL BALR D68 06860000 LA R0,BLKREF2 LOC TO PUT MBBCCHHR D68 06870000 LR R5,R0 SAVE FOR LATER D68 06880000 L R15,=V(USRBCT) TRK O'FLOW CONVERT MODULE D68 06890000 TM DCBRECFM,DCBRECTO D68 06900000 BO READDIR2 IT IS TRACKS O'FLOW D68 06910000 L R15,=V(USRBCN) NON TRACK O'FLOW MODULE D68 06920000 READDIR2 BALR R14,R15 CALL CONVERT ROUTINE D68 06930000 LTR R15,R15 06940000 BNZ AB451 06950000 * NOW DO THE REAL READ WITH MBBCCHHR TYPE CALL D68 06960000 BAL R14,FINDS GET SHADOW DCB ADDR D68 06970000 B AB450 DID NOT GET-IF GOT RETS BELOW D68 06980000 READ BDAMRDEC,DI,(R9),,,,(R5),MF=E D68 06990000 CHECK BDAMRDEC 07000000 SPACE 07010000 CLC COMPADD,THELINE IS DATA ADDRESS > 16M? EXT 07020000 BL FORTRX99 IF NOT, DON'T DO MOVE EXT 07030000 ************* SWITCH MODES AND MOVE IN READ DATA ************* EXT 07040000 STM R4,R7,FORTRXRS SAVE REGS USED FOR MOVE EXT 07050000 L R4,FORTRX1 ADDRESS FOR MODE SWITCH EXT 07060000 BSM 0,R4 SWITCH TO 31 BIT MODE EXT 07070000 DS 0F EXT 07080000 FORTRX1 DC A(FORTRX2+X'80000000') EXT 07090000 FORTRXRS DC 4F'0' EXT 07100000 FORTRX2 DS 0H EXT 07110000 L R4,COMPADD LOAD "OLD R3" EXT 07120000 LH R5,DCBBLKSI LENGTH OF DATA BUFFER EXT 07130000 N R5,=X'0000FFFF' EXT 07140000 LR R7,R5 EXT 07150000 LR R6,R3 ADDRESS TO MOVE DATA FROM EXT 07160000 MVCL R4,R6 MOVE IN THE DATA EXT 07170000 LM R4,R7,FORTRXRS RESTORE REGS USED FOR MOVE EXT 07180000 FORTRX99 DS 0H EXT 07190000 BSM 0,R11 SWITCH BACK TO INPUT MODE EXT 07200000 FORDXX2 DS 0H 07210000 SPACE 07220000 LA R2,1(R2) DA + 1 07230000 ST R2,0(R4) 07240000 ** 07250000 ** GO COUNT THIS I/O 07260000 ** 07270000 BAL R14,COUNT ACCUMULATE I/O COUNT 07280000 ** 07290000 B RETURN 07300000 * 07310000 AB450 ABEND 450,DUMP 07320000 AB451 ABEND 451,DUMP 07330000 EJECT 07340000 **************************************************************** 07350000 * READ DIRECT FROM SCRATCH DISK, ASYNCH VERSION 07360000 * CALL FIRDSD (DCBAD, DA, DATA, ECB) 07370000 **************************************************************** 07380000 * GET AND SAVE THE WAIT FLAG 07390000 AEADDIR L R4,12(R11) 07400000 MVC WAITFLAG(4),8(R4) 07410000 ST R4,ECBADDR 07420000 * 07430000 L R4,4(R11) A(DA) 07440000 L R2,0(R4) RECORD # 07450000 ST R2,SYNDSKA SAVE RCD # FOR ERROR MSG 07460000 L R3,8(R11) A(DATA) 07470000 LR R5,R2 07480000 BCTR R5,0 -1 07490000 ST R5,BLKREF SAVE DA - 1 07500000 LA R5,BLKREF+1 07510000 ST R3,COMPADD EXT 07520000 L R3,ECBADDR GET ECB ARRAY ADDRESS 07530000 L R3,28(R3) GET BUFFER ADDRESS FROM ECB 07540000 LTR R3,R3 EXT 07550000 BNZ AEADBK11 EXT 07560000 ABEND 999,DUMP EXT 07570000 AEADBK11 DS 0H EXT 07580000 LA R11,AORDXX2 07590000 LA R8,AORDXX1 07600000 BSM R11,R8 CHANGE TO 24 BIT MODE 07610000 AORDXX1 DS 0H 07620000 * 07630000 * SEE IF THIS IS A WAIT CALL 07640000 CLC WAITFLAG,=F'0' 07650000 BNE AORWAIT 07660000 MVC WAITFLAG(4),=F'1' 07670000 * 07680000 READ ADAMRDEC,DI,(R10),(R3),'S',0,(R5) 07690000 ORG *-2 CANCEL BALR D68 07700000 LA R0,BLKREF2 LOC TO PUT MBBCCHHR D68 07710000 LR R5,R0 SAVE FOR LATER D68 07720000 L R15,=V(USRBCT) TRK O'FLOW CONVERT MODULE D68 07730000 TM DCBRECFM,DCBRECTO D68 07740000 BO AEADDIR2 IT IS TRACKS O'FLOW D68 07750000 L R15,=V(USRBCN) NON TRACK O'FLOW MODULE D68 07760000 AEADDIR2 BALR R14,R15 CALL CONVERT ROUTINE D68 07770000 LTR R15,R15 07780000 BNZ AB451 07790000 * NOW DO THE REAL READ WITH MBBCCHHR TYPE CALL D68 07800000 BAL R14,FINDS GET SHADOW DCB ADDR D68 07810000 B AB450 DID NOT GET-IF GOT RETS BELOW D68 07820000 L R1,ECBADDR SAVE THE ECB IN THE 4TH ARG 07830000 LA R3,ADAMRDEC ARRAY FOR USE IN THE WAIT CALL 07840000 MVC 0(28,R1),0(R3) 07850000 READ (1),DI,(R9),,,,(R5),MF=E D68 07860000 BSM 0,R11 SWITCH BACK TO INPUT MODE EXT 07870000 * 07880000 ********** WAIT CALL **************************************** 07890000 AORWAIT L 1,ECBADDR 07900000 MVC WAITFLAG(4),=F'0' CLEAR THE WAIT FLAG 07910000 CHECK (1) WAIT FOR THE IO TO COMPLETE 07920000 * 07930000 * FOR ASYNCH IO WE ALWAYS USE A BUFFER AREA 07940000 ************* SWITCH MODES AND MOVE IN READ DATA ************* EXT 07950000 STM R4,R7,AORTRXRS SAVE REGS USED FOR MOVE EXT 07960000 L R4,AORTRX1 ADDRESS FOR MODE SWITCH EXT 07970000 BSM 0,R4 SWITCH TO 31 BIT MODE EXT 07980000 DS 0F EXT 07990000 AORTRX1 DC A(AORTRX2+X'80000000') EXT 08000000 AORTRXRS DC 4F'0' EXT 08010000 AORTRX2 DS 0H EXT 08020000 L R4,COMPADD LOAD "OLD R3" EXT 08030000 LH R5,DCBBLKSI LENGTH OF DATA BUFFER EXT 08040000 N R5,=X'0000FFFF' EXT 08050000 LR R7,R5 EXT 08060000 LR R6,R3 ADDRESS TO MOVE DATA FROM EXT 08070000 MVCL R4,R6 MOVE IN THE DATA EXT 08080000 LM R4,R7,AORTRXRS RESTORE REGS USED FOR MOVE EXT 08090000 AORTRX99 DS 0H EXT 08100000 MVC 8(4,R1),=F'0' CLEAR THE WAIT FLAG 08110000 BSM 0,R11 SWITCH BACK TO INPUT MODE EXT 08120000 AORDXX2 DS 0H 08130000 * SEE IF THIS WAS A WAIT CALL 08140000 CLC WAITFLAG,=F'0' 08150000 BE RETURN 08160000 * 08170000 LA R2,1(R2) DA + 1 08180000 ST R2,0(R4) 08190000 ** 08200000 ** GO COUNT THIS I/O 08210000 ** 08220000 BAL R14,COUNT ACCUMULATE I/O COUNT 08230000 ** 08240000 B RETURN 08250000 EJECT 08260000 ************************************************************** 08270000 * WRITE DIRECT TO SCRATCH DISK 08280000 * CALL FIWDSD (DCBAD, DA, DATA, ECB) 08290000 ************************************************************** 08300000 FIWDSD$ TM DCBOFLGS,X'10' OPEN? 08310000 BO WRITDIR YES. 08320000 ABEND 448,DUMP 08330000 WRITDIR L R3,8(R11) CHECK FOR A 4TH ARG 08340000 ST R3,PARMLIST 08350000 CLC PARMLIST,=X'80000000' 08360000 BL ARITDIR 08370000 * WE'VE GOT AN ECB, SO GO TO THE ASYNCH VERSION 08380000 L R4,4(R11) A(DA) 08390000 L R2,0(R4) DA 08400000 ST R2,SYNDSKA SAVE RCD # FOR ERROR MSG 08410000 L R3,8(R11) A(DATA) 08420000 LR R5,R2 08430000 BCTR R5,0 - 1 08440000 ST R5,BLKREF 08450000 LA R5,BLKREF+1 08460000 SPACE 08470000 LA R11,FOWDXX2 EXT 08480000 BSM R11,0 SAVE INPUT AMODE EXT 08490000 ST R3,COMPADD EXT 08500000 NI COMPADD,X'7F' EXT 08510000 CLC COMPADD,THELINE IS DATA ADDRESS > 16M? EXT 08520000 BL WRITBK91 IF NOT, DON'T DO MOVE EXT 08530000 ************* SWITCH MODES AND MOVE IN WRIT DATA ************* EXT 08540000 STM R4,R7,WRITDXRS SAVE REGS USED FOR MOVE EXT 08550000 L R4,=V(BKBUFADD) GET BUFFER ADDRESS ADDRESS EXT 08560000 L R4,0(R4) GET BUFFER ADDRESS ADDRESS EXT 08570000 LTR R4,R4 EXT 08580000 BNZ WRITBK11 EXT 08590000 ABEND 999,DUMP EXT 08600000 WRITBK11 DS 0H EXT 08610000 L R5,WRITDX1 ADDRESS FOR MODE SWITCH EXT 08620000 BSM 0,R5 SWITCH EXT 08630000 DS 0F EXT 08640000 WRITDX1 DC A(WRITDX2+X'80000000') EXT 08650000 WRITDXRS DC 4F'0' EXT 08660000 WRITDX2 DS 0H EXT 08670000 LH R5,DCBBLKSI LENGTH OF DATA BUFFER EXT 08680000 N R5,=X'0000FFFF' EXT 08690000 LR R7,R5 EXT 08700000 LR R6,R3 ADDRESS TO MOVE DATA FROM EXT 08710000 LR R3,R4 EXT 08720000 MVCL R4,R6 MOVE IN THE DATA EXT 08730000 LM R4,R7,WRITDXRS RESTORE REGS USED FOR MOVE EXT 08740000 WRITBK91 DS 0H EXT 08750000 LA R8,FOWDXX1 08760000 BSM 0,R8 SWITCH TO 24 BIT MODE 08770000 FOWDXX1 DS 0H 08780000 SPACE 08790000 WRITE BDAMWDEC,DI,(R10),(R3),'S',0,(R5) 08800000 ORG *-2 CANCEL BALR D68 08810000 LA R0,BLKREF2 LOC TO PUT MBBCCHHR D68 08820000 LR R5,R0 SAVE FOR LATER D68 08830000 L R15,=V(USRBCT) TRK O'FLOW CONVERT MODULE D68 08840000 TM DCBRECFM,DCBRECTO D68 08850000 BO WRITDIR2 IT IS TRACKS O'FLOW D68 08860000 L R15,=V(USRBCN) NON TRACK O'FLOW MODULE D68 08870000 WRITDIR2 BALR R14,R15 CALL CONVERT ROUTINE D68 08880000 LTR R15,R15 08890000 BNZ AB451 08900000 * NOW DO THE REAL WRITE WITH MBBCCHHR TYPE CALL D68 08910000 BAL R14,FINDS GET SHADOW DCB ADDR D68 08920000 B AB450 DID NOT GET-IF GOT RETS BELOW D68 08930000 WRITE BDAMWDEC,DI,(R9),,,,(R5),MF=E D68 08940000 CHECK BDAMWDEC 08950000 BSM 0,R11 SWITCH BACK TO INPUT MODE EXT 08960000 FOWDXX2 DS 0H 08970000 LA R2,1(R2) DA + 1 08980000 ST R2,0(R4) 08990000 ** 09000000 ** GO COUNT THIS I/O 09010000 ** 09020000 BAL R14,COUNT ACCUMULATE I/O COUNT 09030000 ** 09040000 B RETURN 09050000 SPACE 09060000 EJECT 09070000 ************************************************************** 09080000 * WRITE DIRECT TO SCRATCH DISK, ASYNCH VERSION 09090000 * CALL FIWDSD (DCBAD, DA, DATA, ECB) 09100000 ************************************************************** 09110000 * GET AND SAVE THE WAIT FLAG 09120000 ARITDIR L R4,12(R11) 09130000 MVC WAITFLAG(4),8(R4) 09140000 ST R4,ECBADDR 09150000 * 09160000 L R4,4(R11) A(DA) 09170000 L R2,0(R4) DA 09180000 ST R2,SYNDSKA SAVE RCD # FOR ERROR MSG 09190000 L R3,8(R11) A(DATA) 09200000 LR R5,R2 09210000 BCTR R5,0 - 1 09220000 ST R5,BLKREF 09230000 LA R5,BLKREF+1 09240000 * 09250000 LA R11,AOWDXX2 EXT 09260000 BSM R11,0 SAVE INPUT AMODE EXT 09270000 * 09280000 * SEE IF THIS IS A WAIT CALL 09290000 CLC WAITFLAG,=F'0' 09300000 BNE ADWWAIT 09310000 MVC WAITFLAG(4),=F'1' SET THE WAIT FLAG 09320000 * 09330000 * FOR ASYNCH IO WE ALWAYS USE A BUFFER AREA 09340000 ************* SWITCH MODES AND MOVE IN WRIT DATA ************* EXT 09350000 STM R4,R7,ARITDXRS SAVE REGS USED FOR MOVE EXT 09360000 L R4,ECBADDR GET ECB ARRAY ADDRESS 09370000 L R4,28(R4) GET BUFFER ADDRESS FROM ECB 09380000 LTR R4,R4 EXT 09390000 BNZ ARITBK11 EXT 09400000 ABEND 999,DUMP EXT 09410000 ARITBK11 L R5,ARITDX1 ADDRESS FOR MODE SWITCH EXT 09420000 BSM 0,R5 SWITCH EXT 09430000 DS 0F EXT 09440000 ARITDX1 DC A(ARITDX2+X'80000000') EXT 09450000 ARITDXRS DC 4F'0' EXT 09460000 ARITDX2 DS 0H EXT 09470000 LH R5,DCBBLKSI LENGTH OF DATA BUFFER EXT 09480000 N R5,=X'0000FFFF' EXT 09490000 LR R7,R5 EXT 09500000 LR R6,R3 ADDRESS TO MOVE DATA FROM EXT 09510000 LR R3,R4 EXT 09520000 MVCL R4,R6 MOVE IN THE DATA EXT 09530000 LM R4,R7,ARITDXRS RESTORE REGS USED FOR MOVE EXT 09540000 LA R8,AOWDXX1 09550000 BSM 0,R8 SWITCH TO 24 BIT MODE 09560000 AOWDXX1 DS 0H 09570000 SPACE 09580000 * 09590000 WRITE ADAMWDEC,DI,(R10),(R3),'S',0,(R5) 09600000 ORG *-2 CANCEL BALR D68 09610000 LA R0,BLKREF2 LOC TO PUT MBBCCHHR D68 09620000 LR R5,R0 SAVE FOR LATER D68 09630000 L R15,=V(USRBCT) TRK O'FLOW CONVERT MODULE D68 09640000 TM DCBRECFM,DCBRECTO D68 09650000 BO ARITDIR2 IT IS TRACKS O'FLOW D68 09660000 L R15,=V(USRBCN) NON TRACK O'FLOW MODULE D68 09670000 ARITDIR2 BALR R14,R15 CALL CONVERT ROUTINE D68 09680000 LTR R15,R15 09690000 BNZ AB451 09700000 * NOW DO THE REAL WRITE WITH MBBCCHHR TYPE CALL D68 09710000 BAL R14,FINDS GET SHADOW DCB ADDR D68 09720000 B AB450 DID NOT GET-IF GOT RETS BELOW D68 09730000 * 09740000 L R1,ECBADDR SAVE THE ECB IN THE 4TH ARG 09750000 LA R3,ADAMWDEC ARRAY FOR USE IN THE WAIT CALL 09760000 MVC 0(28,R1),0(R3) 09770000 WRITE (1),DI,(R9),,,,(R5),MF=E D68 09780000 BSM 0,R11 SWITCH BACK TO INPUT MODE EXT 09790000 * 09800000 ************** WAIT CALL *************************************** 09810000 ADWWAIT L 1,ECBADDR 09820000 LA R8,ADWWAIT1 09830000 BSM 0,R8 SWITCH TO 24 BIT MODE 09840000 ADWWAIT1 DS 0H 09850000 MVC WAITFLAG(4),=F'0' CLEAR THE WAIT FLAG 09860000 CHECK (1) WAIT FOR THE IO TO COMPLETE 09870000 MVC 8(4,R1),=F'0' CLEAR ANOTHER WAIT FLAG 09880000 BSM 0,R11 SWITCH BACK TO INPUT MODE EXT 09890000 AOWDXX2 DS 0H 09900000 * SEE IF THIS IS A WAIT CALL 09910000 CLC WAITFLAG,=F'0' 09920000 BE RETURN 09930000 LA R2,1(R2) DA + 1 09940000 ST R2,0(R4) 09950000 ** 09960000 ** GO COUNT THIS I/O 09970000 ** 09980000 BAL R14,COUNT ACCUMULATE I/O COUNT 09990000 ** 10000000 B RETURN 10010000 SPACE 10020000 EJECT 10030000 ** SUBR TO LOCATE SHADOW DCB FROM DCB SUPPLIED IN REG 10 D68 10040000 ** RETURN SHADOW DCB IN REG 9,SHADOW ELM PTR IN REG 1 D68 10050000 ** PREV SHADOW PTR IN REG 15. D68 10060000 ** RET AT 0(R14) IF NOT FOUND AND 4(R14) IF FOUND. D68 10070000 * D68 10080000 FINDS LA R15,MCHAINS INIT PREV PTR TO ORG D68 10090000 FINDS2 ICM R1,15,MCHAINP-MCHAIND(R15) NEXT ELM D68 10100000 USING MCHAIND,R1 D68 10110000 BZR R14 QUIT IF END CHAIN D68 10120000 C R10,MCHAIN1 D68 10130000 LA R9,MCHAIN2 DCB ADDR IN ELM D68 10140000 BE 4(R14) RETURN IF CORRECT ELM D68 10150000 LR R15,R1 CURRENT TO PREV D68 10160000 B FINDS2 TRY AGAIN D68 10170000 DROP R1 D68 10180000 EJECT 10190000 *************************************************************** 10200000 * CLOSE SCRATCH DISK 10210000 * CALL FICSD (DCBAD, ECB) 10220000 *************************************************************** 10230000 FICSD$ TM DCBOFLGS,X'10' OPEN? 10240000 BZ RETURN 10250000 FICSD2 LA R11,RETURN 10260000 LA R4,FOCSXX1 SWITCH TO 24 BIT MODE AND 10270000 BSM R11,R4 SAVE INPUT MODE 10280000 FOCSXX1 DS 0H 10290000 * 10300000 LH R3,DCBBLKSI GET LENGTH OF DATA BUFFER 10310000 STH R3,SIZEHOLD SAVE LENGTH OF DATA BUFFER 10320000 CLOSE ((R10)) 10330000 **LOCATE SHADOW DCB ELM AND RELASE IT. D68 10340000 BAL R14,FINDS LOCATE SHADOW ELM D68 10350000 B FOCSXX3 NOT ONE IF RET HERE D68 10360000 L R0,MCHAINP-MCHAIND(R1) NEXT PTR IN FOUND ELM D68 10370000 ST R0,MCHAINP-MCHAIND(R15) DECHAIN D68 10380000 LR R7,R1 D68 10390000 CLOSE ((R9)) CLOSE SHADOW DCB D68 10400000 FREEMAIN RU,LV=MC99,A=(R7),SP=1 REL SHADOW ELM D68 10410000 FOCSXX3 L R5,PARMLIST 10420000 L R3,0(R5) CHECK FOR A 2ND ARG 10430000 ST R3,PARMLIST 10440000 CLC PARMLIST,=X'80000000' 10450000 BH FOCSXX2 10460000 * WE'VE GOT AN ECB, SO DO A FREEMAIN ON THE BUFFER NEEDED FOR ASYNCH 10470000 L R3,4(R5) 10480000 LH R3,6(R3) 10490000 L R4,4(R5) 10500000 L R4,28(R4) 10510000 LH R3,SIZEHOLD GET LENGTH OF DATA BUFFER 10520000 FREEMAIN RU,LV=(3),A=(R4),SP=1 10530000 L R3,4(R5) 10540000 MVC 0(32,R3),ZEROS CLEAR THE ECB ARRAY 10550000 ST 15,0(R3) 10560000 FOCSXX2 BSM 0,R11 SWITCH BACK TO INPUT MODE & RETURN 10570000 SPACE 10580000 EJECT 10590000 *************************************************************** 10600000 * CLOSE SCRATCH DISK 10610000 * CALL FICDD (DCBAD, ECB) 10620000 *************************************************************** 10630000 FICDD$ TM DCBOFLGS,X'10' OPEN? 10640000 BZ RETURN 10650000 B FICSD2 10660000 *************************************************************** 10670000 * 10680000 * SYNAD EXIT FOR INPUT/OUTPUT ERRORS. 10690000 * 10700000 *************************************************************** 10710000 BSAMERR SYNADAF ACSMETH=BSAM 10720000 B BDAMERR1 10730000 BDAMERR SYNADAF ACSMETH=BDAM 10740000 BDAMERR1 ST R14,SYNADR14 SAVE R14 FOR RETURN. 10750000 LA R1,8(,R1) SKIP FIRST 8 BYTES OF SYNADAF MESSAGE. 10760000 ST R1,SYNADMSA ESTABLISH PARAMETER LIST FOR FOPERR. 10770000 LA R1,SYNADMSA 10780000 L R15,=V(FOPERR) CALL FOPERR TO PRINT SYNADAF MESSAGE. 10790000 BALR R14,R15 10800000 SYNADRLS RELEASE SYNAD SAVE AREA. 10810000 L R14,SYNADR14 RESTORE R14 TO LEAVE SYNAD EXIT. 10820000 ABEND 449 10830000 SPACE 1 10840000 EJECT 10850000 ******************************************************************** 10860000 * 10870000 * COUNT SUBROUTINE - THE COUNT SUBR WILL ADD 1 TO LOC KPWKIO 10880000 * IN KP-AREA OF COMMON P FOR EVERY I/O 10890000 * REQUEST FOR EACH PROCESS. 10900000 * 10910000 ******************************************************************** 10920000 SPACE 1 10930000 COUNT DS 0H 10940000 L R8,KPWKIO ADD 1 TO I/O COUNT 10950000 LA R8,1(R8) FOR THIS PROCESS AND 10960000 ST R8,KPWKIO SAVE IT 10970000 BR R14 RETURN 10980000 SPACE 10990000 RETURN DS 0H EXT 11000000 STDRET 11010000 SPACE 11020000 R0 EQU 0 11030000 R1 EQU 1 11040000 R2 EQU 2 11050000 R3 EQU 3 11060000 R4 EQU 4 11070000 R5 EQU 5 11080000 R6 EQU 6 D68 11090000 R7 EQU 7 D68 11100000 R8 EQU 8 D68 11110000 R9 EQU 9 D68 11120000 R10 EQU 10 11130000 R11 EQU 11 11140000 R12 EQU 12 11150000 R13 EQU 13 11160000 R14 EQU 14 11170000 R15 EQU 15 11180000 WAITFLAG DC F'0' 11190000 ECBADDR DS F ADDRESS OF ECB AS PASSED IN 11200000 PARMLIST DS F HOLD AREA FOR R11 11210000 ZEROS DC 8F'0' 11220000 SIZEHOLD DS F 11230000 BLKREF DS F 11240000 SYNADMSA DS F 11250000 SYNADRN DC A(SYNDSKA) ADDRESS OF RCD # FOR ERROR MSG 11260000 SYNDSKA DC F'0' RELATIVE RCD # FOR ERROR MSG 11270000 SYNADR14 DS F 11280000 BLKREF2 DC D'0' LOC TO PUT MBBCCHHR D68 11290000 THELINE DC F'16777215' EXT 11300000 COMPADD DC F'0' EXT 11310000 LTORG , D68 11320000 PRINT NOGEN D68 11330000 MCHAINS DC A(0) ORIGIN OF SHADOW ELMS D68 11340000 DCBD DSORG=DA,DEVD=DA 11350000 ORG , D68 11360000 DCBL99 EQU *-IHADCB D68 11370000 ** DSECT TO MAP SHADOW ELM D68 11380000 MCHAIND DSECT D68 11390000 MCHAINP DS A NEXT ELM D68 11400000 MCHAIN1 DS A ADDR DCB SUPPLIED BY CALLER OF FISCDK D68 11410000 MCHAIN2 DS XL(DCBL99) SHADOW DCB D68 11420000 MC99 EQU *-MCHAIND LENGTH ELM D68 11430000 SPACE 3 11440000 ********************************************************************* 11450000 * 11460000 * THE FOLLOWING DSECT REPRESENTS THE LAYOUT OF COMMON P THRU 11470000 * THE KP-AREA - WHEN COMMON P IS CHANGED, THIS DSECT SHOULD 11480000 * ALSO BE CHANGED. 11490000 * 11500000 * THE FOLLOWING STATEMENT IS PLACE HERE TO AID IN PANVALET SCANS 11510000 * FOR COMMON P 11520000 * COMMON /P/ STARTP 11530000 ********************************************************************* 11540000 PDSECT DSECT 11550000 STARTP DS CL8 11560000 LCNAME DS 22F 11570000 ACNAME DS 40F 11580000 LHJBNO DS 40F 11590000 KPNA DS 33F 11600000 KPTRIO DS F 11610000 KPWKIO DS F 11620000 KPRESV DS 21F 11630000 END 11640000