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