SOP TITLE 'DMSSOP (CMS) VM/370 - RELEASE 6' 00001000
SPACE 2 00002000
*. 00003000
* 00004000
* 00005000
* 00006000
* 00007000
* MODULE NAME: 00008000
* 00009000
* DMSSOP (SOOPCL) 00010000
* 00011000
* FUNCTION: 00012000
* 00013000
* TO PROCESS OS OPEN AND CLOSE MACROS. 00014000
* 00015000
* ATTRIBUTES: 00016000
* 00017000
* REENTRANT, NUCLEUS RESIDENT. 00018000
* 00019000
* ENTRY POINTS: 00020000
* 00021000
* DMSSOP19 - OPEN MACRO 00022000
* DMSSOP22 - OPEN MACRO TYPE= J 00023000
* DMSSOP20 - CLOSE MACRO 00024000
* DMSSOP23 - CLOSE MACRO TYPE= T 00025000
* 00026000
* ENTRY CONDITIONS: 00027000
* 00028000
* DMSSOP19 - OPEN MACRO 00029000
* DMSSOP22 - OPEN MACRO TYPE = J 00030000
* DMSSOP20 - OS CLOSE MACRO 00031000
* DMSSOP23 - OS CLOSE MACRO TYPE = T 00032000
* 00033000
* EXIT CONDITIONS: 00034000
* 00035000
* IF AN OPEN IS SUCCESSFUL, CONTROL IS RETURNED TO THE 00036000
* USER WITH THE DCBOFLGS OPEN BIT ON. IF AN OPEN FAILS 00037000
* FOR ONE OF THE REASONS LISTED BELOW, THE DCBOFLGS BIT 00038000
* IS TURNED OFF. THE FOLLOWING MESSAGE IS TYPED ON THE 00039000
* CONSOLE AND CONTROL IS RETURNED TO THE PROGRAM WHICH 00040000
* ISSUED THE OPEN CALL. 00041000
* 00042000
* DMSSOP036E OPEN ERROR 'CODE' ON 'DCBDDNAME' 00043000
* 00044000
* CODES ON WHY AN OPEN MIGHT FAIL. 00045000
* 00046000
* 1. EITHER THE RDBACK OPTION OF OPEN IS SPECIFIED OR 00047000
* THE DATA SET ORGANIZATION IS NOT BSAM, QSAM, 00048000
* BPAM OR BDAM. 00049000
* 00050000
* 2. DEFAULT FILEDEF ISSUED BY OPEN FAILED. 00051000
* 00052000
* 3. RECFM DOES NOT AGREE WITH THE FORMAT OF THE EXISTING 00053000
* FILE. ONE RECFM IS F AND THE OTHER IS V. 00054000
* 00055000
* 4. MISSING OR INVALID BLKSIZE. 00056000
* 00057000
* 5. BLKSIZE NOT CORRECT MULTIPLE OF LRECL. 00058000
* 00059000
* 6. RECFM IS FIXED AND LRECL DOES NOT AGREE WITH THE 00060000
* RECORD LENGTH OF THE EXISITING FILE OR IF FILEMODE 00061000
* IS 4 THE BLKSIZE DOES NOT AGREE WITH THE RECORD 00062000
* LENGTH OF THE EXISTING FILE. 00063000
* 00064000
* 7. RECFM IS VARIABLE SPANNED AND EITHER FILEMODE IS NOT 00064800
* 4 OR ACCESS METHOD IS NOT BSAM OR IS NOT QSAM WITH 00065500
* GET LOCATE MODE. 00066200
* 00067000
* 8. ERROR SAVING BPAM DIRECTORY FOR UPDATE. 00068000
* OR ERROR DOING FIND FOR MEMBER NAME SPECIFIED 00069000
* IN FILEDEF COMMAND OR CMSCB. 00070000
* 00071000
* 9. THE DCB SPECIFIES OUTPUT, BDAM OR A KEY LENGTH 00072000
* FOR AN OS DATA SET. 00073000
* 00074100
* 11. I/O OPTION 'UPDATE' IS INVALID FOR FILE FOUND ON 00074200
* READ-ONLY DISK. 00074300
* 00074400
* 11. I/O OPTION 'UPDATE' IS INVALID FOR A FILE @VA12049 00074410
* FOUND ON A READ-ONLY EXTENSION. OUTPUT FILE @VA12049 00074420
* WITH DISP=MOD OR DSORG=PO MEANS UPDATE, SO @VA12049 00074430
* IT MAY NOT EXIST ON READ-ONLY EXTENSION. @VA12049 00074440
* @VA12049 00074450
* 80. UNSUPPORTED OS DATA SET OR I/O ERROR ACCESSING 00074500
* OS DISK. 00074600
* 00077000
* IF CLOSE ENCOUNTERS ANY ERRORS SAVING KEY OR PDS TABLES, 00078000
* CONTROL IS PASSED TO DMSSCTCE TO PRINT A MESSAGE AND ABEND 00079000
* THE USER. 00080000
* 00081000
* CALLS TO OTHER ROUTINES: 00082000
* 00083000
* DMSFLD, DMSSTT, DMSERS, DMSERR, DMSCPF, DMSTIO, DMSFNS, 00084000
* GETMAIN, OPEN EXIT ROUTINE, PDSSAVE AND KEYSAVE IN DMSSVT, 00085000
* GETPOOL, FIND, DMSSCTCE, DMSVIB, DMSVIP. 00086000
* 00087000
* EXTERNAL REFERENCES: 00088000
* 00089000
* NUCON, OPSECT, FCBSECT, IHADDCB, OSFST 00090000
* 00091000
* TABLES/WORKAREAS: 00092000
* 00093000
* NONE 00094000
* 00095000
* REGISTER USAGE: 00096000
* 00097000
* R10 SECOND BASE @VA08024 00098000
* R0,R1,R4,R6-R9,R11,R14,R15 WORK @VA08024 00098500
* R2 DCB 00099000
* R3 OPSECT DSECT 00100000
* R5 FCB 00101000
* R12 BASE 00102000
* R13 SAVE AREA 00103000
* 00104000
* OPERATION: OPEN (SVC22) AND OPENJ (SVC 19) 00105000
* 00106000
* INITIALIZATION 00107000
* IOTYPE IS SET TO INDICATE OPEN OR OPENJ, UPON ENTRY TO 00108000
* SOOPCL, AND THE ADDRESS OF THE CURRENT DCB IS OBTAINED 00109000
* FROM THE LIST POINTED TO BY REGISTER 1. 00110000
* 00111000
* VSAM 00112000
* IF ANY OR ALL OF THE CONTROL BLOCKS POINTED TO BY 00113000
* THE ADDRESSES IN THE PLIST ARE ACB'S, A BALR IS 00114000
* MADE TO THE OS VSAM INTERFACE AFTER COMPLETION OF 00115000
* DCB PROCESSING. THE ADDRESS OF THE INTERFACE IS 00116000
* OBTAINED FROM CVT+256( PRIOR TO THE FIRST CALL, 00117000
* THIS CELL CONTAINS THE ADDRESS OF THE INTERFACE 00118000
* BOOTSTRAP). 00119000
* 00120000
* A PARAMETER LIST IS CONSTRUCTED IN THE USER SAVE 00121000
* AREA AS FOLLOWS: 00122000
* 00123000
* DC CL1'O' OPTION BYTE (C'O'-OPEN, 00124000
* C'C'-CLOSE, C'T'-TCLOSE) 00125000
* DC CL3'SOP' SOP IDENTIFIER 00126000
* 00127000
* UPON RETURN FROM DMSVIP, REGISTER 15 CONTAINS THE 00128000
* RETURN CODE FROM THE DOS VSAM OPEN ROUTINE. 00129000
* 00130000
* 00131000
* DETERMINATION OF ACCESS METHOD 00132000
* THE DATA SET ORGANIZATION (DCBDSORG) SWITCH IS 00133000
* CHECKED TO BE SURE IT IS EITHER PHYSICAL 00134000
* SEQUENTIAL, PARTITIONED, OR DIRECT ACCESS 00135000
* (EFFECTIVELY ELIMINATING ONLY ISAM). IF NONE OF 00136000
* THE ABOVE, THE DCB WILL NOT BE OPENED. 00137000
* 00138000
* NEXT THE MACRO FORMAT FIELD (DCBMACRF) IS CHECKED 00139000
* TO SEE WHICH ACCESS METHOD IS REQUESTED, AND THE 00140000
* ACCESS METHOD INDICATOR (DCBCIND2) IS SET TO 00141000
* SIGNAL QSAM OR BSAM. 00142000
* 00143000
* 00144000
* QSAM 00145000
* IF THE ACCESS METHOD IS QSAM, DCBMACRF IS TESTED 00146000
* FOR A GET, UPDATE OR PUT REQUEST, AND THE RELEVANT ROUTINE 00147000
* ADDRESS IS PLACED IN THE CORRESPONDING DCB ACCESS 00148000
* FIELD (NOTE THAT GET, UPDATE AND PUT ARE IN THE CMS 00149000
* ROUTINE DMSSQS) 00150000
* 00151000
* 00152000
* BSAM 00153000
* IF THE ACCESS METHOD IS BSAM, THE ADDRESS OF 00154000
* DMSSBS IS PLACED IN DCB ACCESS FIELD; THE CHECK 00155000
* ADDRESS IS PLACED IN THE DCB CHECK FIELD; AND IF 00156000
* POINT IS REQUESTED, THE DMSSCT ADDRESS IS PLACED 00157000
* IN THE DCBNOTE FIELD. 00158000
* 00159000
* 00160000
* SETTING UP DCB FIELDS 00161000
* AFTER THE RELEVANT QSAM OR BSAM PROCESSING, 00162000
* THE CMSCB(FCB) CHAIN IS TESTED TO 00163000
* SEE IF THERE IS A CMSCB FOR THIS DCB. THAT IS, IF 00164000
* A FILEDEF COMMAND FOR THE RESPECTIVE DATA SET HAS 00165000
* BEEN ISSUED. IF ONE DOES NOT EXIST, THE ASSUMPTION 00166000
* IS MADE THAT THE USER HAS SET UP THE REQUIRED DCB 00167000
* FIELDS, AND FILEDEF IS CALLED TO CREATE A CMSCB 00168000
* WITH A FILENAME OBTAINABLE FROM LOCATION CMSNAME 00169000
* (INITIALIZED AS 'FILE'), 00170000
* A FILEMODE OF A1, AND A FILETYPE EQUAL TO THE DCB 00171000
* DDNAME. AFTER A MATCHING CMSCB IS FOUND OR CREATED, 00172000
* IT IS USED TO FILL IN VACANT ENTRIES IN THE 00173000
* DCB. IF THE MACLIB CONCAT OPTION IS ON IN THE CMSCB, 00174000
* OPEN CHECKS THE MACLIB NAMES IN THE GLOBAL LIST AND 00175000
* FILLS IN THE ADDRESSES OF OS FSTS FOR ANY MACLIBS THAT 00176000
* ARE ON OS DISKS. THE CMSCB OF THE 1ST MACLIB IN THE 00177000
* GLOBAL LIST IS USED FOR CMSCB MERGING AND INITIAL- 00178000
* IZATION. 00179000
* 00180000
* THE FOLLOWING TABLE SHOWS THE CMSCB FIELDS THAT 00181000
* ARE USED TO COMPLETE DCB FILEDS NOT INITIALIZED BY 00182000
* THE USER PRIOR TO ISSUING THE OPEN CALL. IT ALSO 00183000
* SHOWS THE JFCBMASK BIT SETTING WHICH IS ON IF THE 00184000
* ASSOCIATED CMSCB FIELD MUST BE USED. IF THE CMSCB 00185000
* FIELDS ARE NOT SPECIFIED BY A FILEDEF 00186000
* COMMAND, NO DEFAULTS WILL BE USED TO FILL IN THE 00187000
* RESPECTIVE FIELDS OF THE CMSCB. 00188000
* 00189000
* _______________________________________ 00190000
* | DCB || FCB | JFCBMASK | 00191000
* |___________||____________|___________| 00192000
* |-----------||------------|-----------| 00193000
* | || | | 00194000
* | DCBBLKSI || JFCBLKSI |+2 X'10' | 00195000
* | DCBDSORG || JFCDSORG |+3 X'01' | 00196000
* | DCBLRECL || JFCLRECL |+3 X'02' | 00197000
* | DCBRECFM || JFCRECFM |+2 X'04' | 00198000
* | DCBKEYLE || JFCKEYLE |+3 X'20' | 00199000
* | DCBOPTCD || JFCOPTCD |+2 X'80' | 00200000
* | DCBLIMCT || JFCLIMCT |+2 X'40' | 00201000
* |___________||____________|___________| 00202000
* 00203000
* 00204000
* SETTING UP A NEW CMSCB 00205000
* 00206000
* THIS ROUTINE IS ENTERED IF IT IS NECESSARY TO SET 00207000
* UP AND INITIALIZE A NEW CMSCB FOR THE DCB 00208000
* CURRENTLY BEING OPENED. IT ISSUES A FILEDEF 00209000
* WITH THE FOLLOWING FIELDS FILLED IN: 00210000
* 00211000
* 00212000
* ________________________________________________________ 00213000
* | FIELD || CONTENT | DESCRIPTION | 00214000
* |____________||_____________|__________________________| 00215000
* |------------||-------------|--------------------------| 00216000
* | FCBSECT || X'08' | INDICATES OPEN ACQUIRED | 00217000
* | || | THIS CMSCB. | 00218000
* | FCBDEV || X'14' | DISK DEFAULT | 00219000
* | FCBDSNAM || FILENAME | CMS FILENAME ('FILE') | 00220000
* | FCBDD || DCBDDNAM | CMS FILETYPE | 00221000
* | FCBDSTYP || DCBDDNAM | CMS FILETYPE | 00222000
* | FCBDSMD || FILEMODE | CMS FILEMODE ('A1') | 00223000
* |____________||_____________|__________________________| 00224000
* 00225000
* 00226000
* 00227000
* 00228000
* SETTING UP CONTROL BLOCK POINTERS 00229000
* 00230000
* AFTER THE CMSCB IS INITIALIZED, THE ADDRESS 00231000
* POINTERS ARE SET TO LINK THE VARIOUS SIMULATED 00232000
* CONTROL BLOCKS. 00233000
* 00234000
* 00235000
* ___________________________________________________________ 00236000
* | CONTROL | || | 00237000
* | BLOCK | FIELD || CONTENTS AFTER COMPLETION | 00238000
* |___________|___________||________________________________| 00239000
* | | || | 00240000
* | DCB | DCBDEBAD || DEB ADDRESS | 00241000
* | DCB | DCBIOBAD || IOB ADDRESS | 00242000
* | DCB | DCBIOBA || IOB ADDRESS | 00243000
* | DCB | DCBIOBL || LENGTH IN DOUBLE WORDS OF IOB | 00244000
* |___________|___________||________________________________| 00245000
* | IOB | IOBDCBPT || DCB POINTER | 00246000
* |___________|___________||________________________________| 00247000
* | DEB | DEBDCBAD || DCB POINTER | 00248000
* | DEB | DEBDEBID || X'0F' FLAG TO SHOW BLOCK IS DEB| 00249000
* | DEB | DEBOPATB || OPEN OPTION BYTE | 00250000
* |___________|___________||________________________________| 00251000
* 00252000
* 00253000
* FILE VERIFICATION 00254000
* 00255000
* THE CMSCB DEVICE TYPE IS CHECKED AND IF THE TYPE IS 00256000
* NOT DISK, OR IF THE FILE DOES NOT EXIST, CONTROL 00257000
* PASSES TO EXITLIST. 00258000
* 00259000
* . IF THE CMSCB MOD OPTION IS NOT SPECIFIED AND THE 00260000
* DCBDSORG OPTION = PS, AND THE FILE IS OPENED FOR 00261000
* OUTPUT OR OUTIN, THE FILE IS ERASED AND CONTROL IS 00262000
* PASSED TO EXITLIST. 00263000
* 00264000
* . IF THE CMSCB MOD OPTION IS SPECIFIED, THE ITEM NO. 00265000
* IS SET TO POINT TO THE END OF THE FILE RATHER THAN 00266000
* THE START OF THE FILE AND CONTROL IS PASSED TO EXITLIST. 00267000
* 00268000
* . IF THE CMSCB REFERS TO A DATA SET ON AN OS DISK 00269000
* A CHECK IS MADE TO INSURE THAT THE DATA SET IS 00270000
* ACCESSABLE AND THAT THE DCB DOES NOT SPECIFY OUTPUT, 00271000
* BDAM OR A KEY LENGTH. IF ANY ERRORS ARE FOUND, ERROR 00272000
* MESSAGE DMSSOP036E IS PRINTED AND THE DCB IS NOT 00273000
* OPENED. IF DCBRECFM, DCBLRECL OR DCBBLKSI ARE NOT 00274000
* FILLED IN, THEY ARE FILLED IN FROM THE OSFST FOR 00275000
* THE DATA SET. 00276000
* 00277000
* . IF THE I/O PROCESSING OPTION SPECIFIES UPDATE FOR 00278100
* A FILE FOUND ON A READ-ONLY DISK, ERROR MESSAGE 00278200
* DMSSOP036E WILL BE PRINTED, AND THE DCB WILL NOT 00278300
* BE OPENED. 00278400
* 00283000
* EXITLIST USER EXIT PROCESSING ROUTINE 00284000
* 00285000
* IF THE EXIT LIST FIELD (DCBEXLST) IS EMPTY, 00286000
* CONTROL PASSES IMMEDIATELY TO VEROPEN - THE 00287000
* VERIFICATION ROUTINE FOR RECORD FORMAT DEPENDENT 00288000
* QUANTIFIERS. 00289000
* 00290000
* IF DCBEXLST CONTAINS A CODE OTHER THAN X'05', 00291000
* CHECKING CONTINUES UNTIL AN END-OF-LIST TAG IS 00292000
* FOUND, AT WHICH TIME CONTROL RETURNS TO VEROPEN, 00293000
* OR UNTIL A X'05' IS FOUND, IN WHICH CASE THE 00294000
* DCBOFLGS ARE LOCKED ON AND A BRANCH IS TAKEN TO 00295000
* THE USER DCB EXIT PROCESSING ROUTINE. ON RETURN 00296000
* EXIT CONDITIONS ARE RESTORED AND THE POSSIBLE 00297000
* EXISTENCE OF FURTHER REQUESTS IS CHECKED. 00298000
* 00299000
* 00300000
* VEROPEN VALIDATE CONTENTS OF RECORD 00301000
* FORMAT DEPENDENT FIELDS 00302000
* 00303000
* VEROPEN CHECKS TO INSURE THAT DCBBLKSI IS NOT MISSING, 00304000
* AND THAT IT IS A CORRECT MULTIPLE OF LRECL. IT ALSO 00305000
* INSURES THAT DCBRECFM, DCBBLKSI AND DCBLRECL AGREE 00306000
* WITH THE RECORD FORMAT AND RECORD LENGTH OF THE 00307000
* CORRESPONDING DISK FILE IF IT EXISTS. IF ANY ERRORS 00308000
* ARE ENCOUNTERED AS A RESULT OF THE ABOVE TESTS, THE 00309000
* DCB IS NOT OPENED AND MESSAGE NO. DMSSOP036E IS 00310000
* TYPED OUT AS LISTED ABOVE IN THE EXIT CONDITIONS. 00311000
* IF DCBLRECL IS NOT FILLED IN, IT IS SET EQUAL TO 00312000
* DCBBLKSI AND THE APPROPRIATE JFCBMASK BIT 00313000
* IS TURNED ON. IF A BPAM WRITE IS SPECIFIED, PDSSAVE 00314000
* IN DMSSVT IS CALLED TO SAVE THE PDS IN CASE OF 00315000
* AN ABEND. IF A MEMBER NAME IS SPECIFIED IN THE 00316000
* CMSCB FCBMEMBR FIELD (FILLED IN BY FILEDEF WITH 00317000
* THE MEMBER OPTION), AN OS FIND MACRO IS ISSUED TO 00318000
* POSITION THE FILE POINTER TO THE CORRECT MEMBER. IF 00319000
* AN ERROR IS ENCOUNTERED ON THE CALL TO PDSSAVE OR 00320000
* FIND MACRO, ERROR MSG DMSSOP036E IS PRINTED AND THE 00321000
* DCB IS NOT OPENED. 00322000
* 00323000
* 00324000
* BUFFPOOL 00325000
* 00326000
* IF THE USER SUPPLIES A BUFFER POOL, CONTROL IS PASSED TO 00327000
* BUCN3. 00328000
* IF USER DOES NOT SUPPLY A BUFFER POOL, PARAMETERS FOR 00329000
* THE GETPOOL MACRO ARE SET UP BY EXAMINING DCBBUFNO 00330000
* AND DCBBUFL AND A GETPOOL MACRO IS ISSUED IF DCBBUFNO IS 00331000
* NOT ZERO. IF BUFNO IS NOT SPECIFIED AND THE ACCESS 00332000
* METHOD IS NOT QSAM OR BDAM, CONTROL IS PASSED TO BUCN4. 00333000
* IF THE ACCESS METHOD IS QSAM OR BDAM AND DCBBUFNO 00334000
* OR DCBBUFL IS NOT FILLED IN, DCBBUFNO IS DEFAULTED TO TWO 00335000
* AND DCBBUFL IS DEFAULTED TO DCBBLKSI. IF 00336000
* DCBBLKSI IS LARGER THAN DCBBUFL, DCBBUFL IS SET EQUAL TO 00337000
* DCBBLKSI. 00338000
* 00339000
* 00340000
* BUCN3 00341000
* 00342000
* AFTER A BUFFER POOL HAS BEEN EITHER VERIFIED OR 00343000
* OBTAINED, DCBRECAD, DCBEOBAD, IOBSTART AND IOBNXTAD 00344000
* ARE INITIALIZED FOR LATER USE BY THE CMS QSAM (DMSSQS) 00345000
* ROUTINE AND OR THE PROBLEM PROGRAMMER. 00346000
* THE ADDRESS OF THE FIRST BUFFER 00347000
* IN THE CHAIN IS STORED IN IOBSTART AND THE ADDRESS OF 00348000
* FIRST BUFFER TO BE USED (SAME ADDRESS) IS STORED IN 00349000
* DCBRECAD. IF THE METHOD IS QSAM AND THE FORMAT IS 00350000
* VARIABLE, THE ADDRESS IS ADJUSTED TO ELIMINATE THE 00351000
* BDW. 00352000
* 00353000
* THE SAME ADDRESS AS FOR IOBSTART IS PLACED IN 00354000
* IOBNXTAD AS INITIAL CONDITION OF NEXT BUFFER AND IN 00355000
* DCBEOBAD AS INITIAL END OF BLOCK CONDITION. 1 IS 00356000
* INSERTED IN THE HIGH ORDER BYTE OF DCBEOBAD AS THE ID 00357000
* OF THE NEXT BUFFER TO BE USED. 00358000
* 00359000
* IF THE ACCESS METHOD IS QSAM PUT-LOCATE MODE AND THERE 00360000
* ARE TWO OR MORE BUFFERS, THE ADDRESS 00361000
* OF THE NEXT BUFFER IS PLACED IN DCBEOBAD AND A TWO IS SET 00362000
* IN IOBSTART AS THE ID OF THE NEXT BUFFER TO BE USED. 00363000
* 00364000
* BUCN4 00365000
* 00366000
* IF THE ACCESS METHOD IS QSAM OR IF DCBNCP IS ONE, CONTROL 00367000
* IS PASSED TO OPENED. OTHERWISE, A NUMBER OF IOB'S EQUAL 00368000
* TO DCBNCP ARE BUILT AND CHAINED TO THE FIRST IOB IN THE 00369000
* CMSCB. 00370000
* 00371000
* 00372000
* OPENED 00373000
* 00374000
* DCBOFLGS IS SET TO INDICATE THAT THE DCB HAS BEEN 00375000
* OPENED SUCCESSFULLY AND RETURN IS TO INTSVC IF THERE 00376000
* ARE NO MORE DCBS TO BE PROCESSED. OTHERWISE, CONTROL GOES 00377000
* BACK TO COMOPEN. 00378000
* 00379000
* OPERATION: CLOSE (SVC 20) AND TCLOSE (SVC 23) 00380000
* 00381000
* INITIALIZATION 00382000
* 00383000
* IOTYPE IS SET TO INDICATE CLOSE OR TCLOSE. 00384000
* 00385000
* 00386000
* VSAM 00387000
* SEE DESCRIPTION UNDER OPEN (ABOVE). 00388000
* 00389000
* 00390000
* COMCLOSE 00391000
* 00392000
* AFTER CHECKING TO MAKE SURE THAT THE PARTICULAR 00393000
* DCB HAS ACTUALLY BEEN OPENED, THE ADDRESS OF THE 00394000
* CMS CONTROL BLOCK IS OBTAINED FROM DCBDEBAD, 00395000
* FCBIOSW IS SET TO INDICATE CLOSING IN PROCESS, AND 00396000
* DCBOFLGS IS SET TO "BUSY". IF TCLOSE IS NOT 00397000
* SPECIFIED AND IF THE KEY TABLE AND OR PDS FIELD OF THE 00398000
* CMSCB IS NON ZERO, CONTROL IS PASSED TO KEYSAVE AND OR 00399000
* PDSSAVE IN DMSSVT, DEPENDING ON WHICH FIELD IS FILLED IN. 00400000
* KEYSAVE AND PDSSAVE FREE ASSOCIATED CORE TABLES AND SAVE 00401000
* THE TABLES AT THE END OF THE DATA FILE. IF THERE ARE 00402000
* ANY ERRORS SAVING THE TABLES, CONTROL IS PASSED TO 00403000
* DMSSCTCE TO PRINT A MESSAGE AND ABEND THE USER. 00404000
* IF THE ACCESS METHOD 00405000
* USED IS QSAM, PUT-LOCATE, THE LAST RECORD MUST BE 00406000
* OUTPUTTED AND CONTROL IS PASSED TO DMSSQS-PUT. IF 00407000
* THE REQUESTED FILE DISPOSITION WAS LEAVE, FCBIOSW 00408000
* IS SET TO INDICATE THIS. THEN THE FCBDEV IS 00409000
* CHECKED FOR DEVICE TYPE CODE AND THE APPROPRIATE 00410000
* ROUTINE IS BRANCHED TO: 00411000
* 00412000
* 00413000
* TAPE 00414000
* 00415000
* IF THE DCBOFLGS WRITE BIT IS ON, A TAPE MARK IS WRITTEN, 00416000
* OTHERWISE NOT. 00417000
* IF THE FILE DISPOSITION WAS LEAVE, THE ROUTINE 00418000
* GOES OFF TO CLOSE2--THE COMMON CLOSE ROUTINE. IF 00419000
* NOT, THE TAPE IS REWOUND BEFORE GOING OFF TO THE 00420000
* COMMON CLOSE ROUTINE. 00421000
* 00422000
* 00423000
* DISK 00424000
* 00425000
* IF THE FCBPROC CLOSE BIT IS ON AND IF AN FCBPROC ROUTINE 00426000
* EXISTS, CONTROL IS PASSED TO THE FCBPROC ROUTINE. IF THE 00427000
* FILE MODE IS NOT 4 OR THE DCBOFLGS WRITE BIT IS NOT ON 00428000
* OR UPDATE MODE IS SPECIFIED OR DSORG IS NOT PS OR THE 00429000
* FILE IS NOT IN THE ACTIVE DISK TABLE, FINIS CLOSES THE 00430000
* FILE AND CONTROL PASSES TO THE COMMON CLOSE ROUTINE. 00431000
* OTHERWISE, THE NO. OF ITEMS IN THE FILE IS SET EQUAL 00432000
* TO THE LAST ITEM WRITTEN, FINIS CLOSES THE FILE AND 00433000
* CONTROL PASSES TO THE COMMON CLOSE ROUTINE. 00434000
* 00435000
* 00436000
* 00437000
* UNIT RECORD 00438000
* 00439000
* A CP CLOSE COMMAND IS ISSUED FOR THE DEVICE--PRINTER, 00440000
* PUNCH OR READER--AND A BRANCH TAKEN TO COMMON CLOSE. 00441000
* 00442000
* 00443000
* CONSOLE 00444000
* 00445000
* GO TO COMMON CLOSE 00446000
* 00447000
* 00448000
* CLOSE2 00449000
* 00450000
* IF IOTYPE IS T, CONTROL IS PASSED TO CLOSED. 00451000
* OTHERWISE, DCBMACR, DCBIFLG, DCBDDNAM, DCBLRECL, 00452000
* DCBRECFM, DCBDSORG, DCBCIND2, DCBKEYLE, DCBDPTCD, 00453000
* DCBIOBA, DCBIOBAD 00454000
* AND DCBLIMCT ARE RESTORED TO THEIR STATUS BEFORE 00455000
* OPEN. IF THE CMSCB FOR THE SPECIFIED DCB WAS 00456000
* ACQUIRED BY OPEN AND IF THERE ARE NO OTHER OPEN 00457000
* DCB'S USING THE CMSCB, THE CMSCB IS CLEARED. NEXT 00458000
* CONTROL IS PASSED TO CLOSED. 00459000
* 00460000
* 00461000
* CLOSED 00462000
* 00463000
* THE DCB LIST POINTER IS RESTORED AND, IF THIS WAS 00464000
* THE LAST DCB, THE ROUTINE RETURNS TO THE USER. IF 00465000
* NOT, THE ROUTINE RETURNS TO COMCLOSE AND PROCEEDS 00466000
* TO CLOSE NEXT DCB. 00467000
* 00468000
*. 00469000
EJECT 00470000
SPACE 00471000
DMSSOP START 0 IN THE BEGINNING ... 00472000
USING DMSSOP,R12 00473000
USING IHADCB,R2 00474000
USING OPSECT,R3 00475000
USING FCBSECT,R5 00476000
USING NUCON,R0 00477000
USING SSAVE,R13 00478000
ENTRY DMSSOP19,DMSSOP22,DMSSOP20,DMSSOP23 00479000
UPDT EQU X'80' UPDATE MODE 00480000
SPAN EQU X'08' SPANNED RECFM 00481000
QSAMDCB EQU X'01' QSAM DCB 00482000
ACBID EQU X'A0' VSAM ACB IDENTIFIER @V305174 00483000
EJECT 00484000
*********************************************************************** 00485000
* * 00486000
* OOOOHHPPEEEEEEEEEEEENNNNN * 00487000
* * 00488000
*********************************************************************** 00489000
SPACE 00490000
* 00491000
* OPEN A DCB - SVC 22. 00492000
* 00493000
DMSSOP22 DS 0H SVC 22 00494000
USING *,R12 00495000
LA R9,C'J' OSIOTYPE = "J" 00496000
LA R11,COMOPEN 00497000
B IOSETUP 00498000
DROP R12 00499000
SPACE 00500000
* 00501000
* OPEN A DCB - SVC 19. 00502000
* 00503000
DMSSOP19 EQU * SVC 19. 00504000
USING *,R12 00505000
LA R9,C'O' OSIOTYPE = "O" 00506000
LA R11,COMOPEN CONTINUE OPEN @VA12049 00507000
B IOSETUP AFTER SETUP @VA12049 00507100
* 00507200
* TEMPARARILY CLOSE A DCB - SVC 23. 00507300
* 00507400
DMSSOP23 DS 0H 00507500
USING *,R12 00507600
LA R9,C'T' OSIOTYPE = "T" 00507700
LA R11,COMCLOSE 00507800
B IOSETUP 00507900
SPACE 3 00508000
* 00508100
* CLOSE A DCB - SVC 20. 00508200
* 00508300
DMSSOP20 DS 0H SVC 20. 00508400
USING *,R12 00508500
LA R9,C'C' OSIOTYPE = "C" 00508600
LA R11,COMCLOSE CONTINUE CLOSE @VA12049 00508700
* @VA12049 00508800
* COMMON ENTRANCE INITIALIZATION ROUTINE @VA12049 00508900
* @VA12049 00509000
IOSETUP DS 0H @VA12049 00509100
L R13,CURRSAVE POINT TO SYSTEM SAVE ARE@VA12049 00509200
BALR R12,0 @VA12049 00509300
USING *,R12 @VA12049 00509400
L R3,AOPSECT V(I/O SECTION) @VA12049 00509500
STC R9,OSIOTYPE SET TYPE INDICATOR @VA12049 00509600
L R12,AIOMAN GET COMMON ADDRESSABILITY @VA12049 00509700
LA R10,4095(R12) SECOND BASE REG SET UP @VA12049 00509800
LA R10,1(R10) AT FIRST BASE REG PLUS 1K @VA12049 00509900
ST R1,EGPR0 SAVE SVC PLIST POINTER @VA12049 00510000
BR R11 RETURN TO CORRECT ROUTINE @VA12049 00510100
AIOMAN DC A(DMSSOP) ADCON TO DMSSOP ENTRY @VA12049 00510200
* @VA12049 00510300
* ALL JOIN HANDS, AND COMMENCE OPENING .... 00511000
* 00512000
SPACE 00513000
COMOPEN EQU * COMMON OPEN ROUTE 00514000
USING DMSSOP,R12,R10 @VA12049 00515000
L R2,0(,R1) GET V(CURRENT DCB) 00516000
CLI 0(R2),ACBID ACB? @V305174 00517000
BNE COMOP2 NO, PROCESS DCB @V305174 00518000
OI TYPFLAG,TPFACB SET FLAG BIT @V305174 00519000
TM 0(R1),EOL END OF LIST? @V305174 00520000
BO RETURN YES @V305174 00521000
LA R1,4(,R1) NO, POINT TO NEXT ADDRESS @V305174 00522000
B COMOPEN AND CONTINUE @V305174 00523000
COMOP2 ST R2,EGPR1 ST: AL1(OPT BYTE), AL3(DCB) @V305174 00524000
ST R1,SAVER1 SAVE REG 1 00525000
DMSFREE DWORDS=12,ERR=NROOM,TYPE=NUCLEUS,TYPCALL=BALR @VA04752 00526000
MVC 0(96,R1),0(R2) @VA02963 00527000
ST R1,DCBSAV SAVE ADDRESS TO FRET @VA02963 00528000
L R1,SAVER1 RESTORE REG 1 @VA02963 00529000
TM DCBOFLGS,GOODOPEN INVALID DUPLICATE OPEN? 00530000
BO NOTOPEN YES, IGNORE THIS OPEN REQUEST V0213 00531000
* IGNORE THE POSSIBLITY OF OPENING A NULL DATA SET 00532000
MVI DCBOFLGS,X'00' SET DCBOFLGS BYTE TO ZERO 00533000
OI DCBOFLGS,OPENBUSY SET BUSY=ON 00534000
MVC SAVER15(8),DCBDDNAM 00535000
LD F6,SAVER15 00536000
MVC DCBIFLGS(1),DCBIFLG 00537000
MVC DCBMACRF(2),DCBMACR 00538000
XC DCBTIOT(2),DCBTIOT SET TIOT DISPLACEMENT AT ZERO 00539000
* DETERMINE ACCESS METHOD DESIRED 00540000
TM DCBDSORG,PS+PO+DA PHYSICAL SEQUENTIAL- PARTIONED 00541000
LA R15,1 00542000
BZ BADDCB NO. ERROR IN FILE ORGANZATION 00543000
NI DCBCIND2,255-UPDT-QSAMDCB RESET INDICATORS 00544000
TM 0(R1),X'0E' SETUP TO CHECK FOR RDBACK V0206 00545000
BNZ CKOPENCD RDBACK NOT SPECIFIED V0206 00546000
TM 0(R1),1 RDBACK SPECIFIED V0206 00547000
BO BADDCB YES, THEN RETURN ERROR CODE V0206 00548000
CKOPENCD TM 0(R1),X'04' SETUP TO CHECK FOR UPDATE V0206 00549000
BNO CKMACRF NO,CONTINUE 00550000
TM 0(R1),X'03' ARE ANY OTHER SWITCHES ON 00551000
BNZ CKMACRF YES, CONTINUE 00552000
OI DCBCIND2,UPDT SET UPDATE INDICATORS 00553000
CKMACRF EQU * @VA08866 00554100
TM DCBMACRF,DCBMRECP EXCP DCB @VA08866 00554200
BO OP1 YES @VA08866 00554300
TM DCBMACRF,QS IS THIS QSAM ? @VA08866 00554400
BO QSAM YES, GO TO QSAM SETUP 00555000
TM DCBMACRF+1,QS IS THIS QSAM? 00556000
BO QSAM YES, GO TO QSAM SETUP 00557000
BSAM EQU * BSAM: BASIC SEQUENTIAL ACCESS METHOD 00558000
TM 0(R1),X'07' OUTPUT OR OUTIN SPECIFIED P3056 00559000
BNO FILLDCB NO, FILL IN DCB P3056 00560000
OI DCBOFLGS,PREVIOUS SET WRITE FLAG P3056 00561000
FILLDCB EQU * FILL DCB I/O ADDRESSES P3056 00562000
MVC DCBREAD+1(3),VBSAM 00563000
MVC DCBCHECK+1(3),VCHECK 00564000
OP2 MVC DCBNOTE+1(3),VNTPT 00565000
B OP1 GET FCB 00566000
QSAM EQU * QSAM: QUEUED SEQUENTIAL ACCESS METH 00567000
OI DCBCIND2,QSAMDCB INDICATE THIS IS QSAM 00568000
MVC DCBGET+1(3),VGET SETUP FOR GET 00569000
TM 0(R1),X'0F' OPENNING FOR OUTPUT? 00570000
BO QSAMPUT YES. 00571000
TM 0(R1),X'04' OPENNING FOR UPDATE 00572000
BNO OP1 NO, MUST BE GET 00573000
MVC DCBPUT+1(3),VUPDATE QSAM UPDATE ENTRY (GL PL) 00574000
B OP1 GO GET FCB 00575000
QSAMPUT EQU * INDICATE QSAM-PUT. 00576000
MVC DCBPUT+1(3),VPUT 00577000
EJECT 00578000
* SCAN FCBTABLE FOR CORRESPONDING FCB-DCB ENTRY 00579000
SPACE 1 00580000
OP1 DS 0H @VA02242 00581000
LA R5,FCBFIRST ADDR OF FCB ANCHOR @VA02242 00582000
OP1A DS 0H @VA02242 00583000
ICM R5,B'0111',1(R5) ADDR OF NEXT FCB @VA02242 00584000
BZ NOFCB BIF NONE LEFT @VA02242 00585000
CD F6,FCBDD IS THIS DCB/FCM MATCH? @VA02242 00586000
BNE OP1A BIF IF NOT @VA02242 00587000
TM FCBINIT,FCBCATML IS CONCAT SPECIFIED? @VA02242 00588000
BNO CKJFCB NO, CONTINUE OPEN @VA02242 00589000
SPACE 1 00590000
L R1,SAVER1 ADDR OF CURR DCB ADDR @VA02242 00591000
LA R11,MACLIBL-8 GET ADDR MAC NAME LIST-8 @VM03203 00592000
LA R4,MACDIRC-4 GET ADDR MAC FCB LIST-4 @VM03203 00593000
TM FCBINIT,FCBDOSL CONCAT DOSLIB FCB ? @VM03203 00594000
BNO OP1B NO, ASSUME MACLIB @VM03203 00595000
LA R11,DOSLIBL-8 GET ADDR DOS NAME LIST-8 @VM03203 00596000
LA R4,DOSDIRC-4 GET ADDR DOS FCB LIST-4 @VM03203 00597000
OP1B CLI 8(R11),FF ANY LIBRARIES GLOBAL'D ? @VM03203 00598000
BE NOTOPEN BRANCH DONT OPEN DCB @VA02242 00599000
LNR R8,R5 ADDR OF LAST RESORT @VA02242 00600000
XC 4(32,R4),4(R4) CLEAR FST POINTERS (IF ANY) @V305001 00601000
SPACE 1 00602000
CHKFCB DS 0H @VA02242 00603000
CD F6,FCBDD DCB*FCB MATCH? @VA02242 00604000
BNE NXTFCB BIF IF NOT @VA02242 00605000
TM FCBINIT,FCBCATML IS CONCAT SPECIFIED? @VA02242 00606000
BNO NXTFCB BIF NOT @VA02242 00607000
CLC FCBDSNAM(8),0(R11) DOES FN EQ MAC NAME ENTRY? @VA02242 00608000
BNE NXTFCB BRANCH IF NOT @VA02242 00609000
TM FCBINIT,FCBDOSL IS IT CONCAT DOSLIB FCB ? @VM03203 00610000
BO CHKDOSL YES, BRANCH... @VM03203 00611000
CLC FCBDSTYP(8),=CL8'MACLIB' IS FT MACLIB? @VA02242 00612000
BNE NXTFCB BRANCH IF NOT @VA02242 00613000
B SETMODE BRANCH AROUND DOSLIB CODE.. @VM03203 00614000
CHKDOSL CLC FCBDSTYP(8),=CL8'DOSLIB' IS FT DOSLIB ? @VM03203 00615000
BNE NXTFCB BRANCH IF NOT @VM03203 00616000
SPACE 1 00617000
SETMODE MVI FCBDSMD,ASTERISK FORCE MODE TO '*' @V305066 00618000
MVI FCBDSMD+1,C' ' FORCE MODE NUM TO ' ' @VA02242 00619000
NI FCBINIT,255-FCBOS TURN OFF FCB OS SWITCH @VA02242 00620000
SR R15,R15 CLEAN A REG @VA02242 00621000
ST R15,FCBOSFST CLEAR OS FST POINTER @VA02242 00622000
ST R15,FCBPDS CLEAR DIR POINTER @VA02242 00623000
LA R1,FCBOP GET ADDR OF STATE PLIST @VA02242 00624000
L R15,ASTATE GET ADDR OF STATE @VA02242 00625000
BALR R14,R15 DO STATE @VA02242 00626000
L R15,FCBOSFST LOAD OS FST POINTER @VA02242 00627000
LTR R15,R15 IS THIS AN OS FCB? @VA02242 00628000
BZ CHKSAVRG BIUF IF NOT @VA02242 00629000
OI FCBINIT,FCBOS INDICATE OS FCB @VA02242 00630000
ST R15,0(,R4) SAVE OS FST ADDRESS @VA02242 00631000
MVI 0(R4),X'80' INDICATE OS MAC FCB @VA02242 00632000
SPACE 1 00633000
CHKSAVRG DS 0H @VA02242 00634000
LTR R8,R8 IS THIS FIRST? @VA02242 00635000
* MAC NAME/FCB MATCH? 00636000
BH NXTFCB BIF IF NOT @VA02242 00637000
LR R8,R5 SAVE ADDR OF THIS FCB @VA02242 00638000
SPACE 1 00639000
NXTFCB DS 0H @VA02242 00640000
ICM R5,B'0111',1(R5) ADDR OF NEXT FCB @VA02242 00641000
BNZ CHKFCB BIF SOME MORE LEFT @VA02242 00642000
SPACE 1 00643000
L R5,FCBFIRST ADDR OF FIRST FCB IN LIST @VA02242 00644000
LA R4,4(,R4) ADDR OF NEXT MAC DIR ENTRY @VA02242 00645000
LA R11,8(,R11) ADDR NEXT MAC NAME ENTRY @VA02242 00646000
CLI 0(R11),X'FF' IS END OF MAC NAMES @VA02242 00647000
BNE CHKFCB BIF NOT RESCAN FCB CHAIN @VA02242 00648000
LPR R5,R8 ADDR OF MASTER FCB @VA02242 00649000
B CKJFCB CONTINUE WITH OPEN @VA02242 00650000
EJECT 00651000
NOFCB DS 0H @VA02242 00652000
MVC CMSOP(8),FILEDEF PREP FOR FILEDEF COMMAND @VA02242 00653000
STD F6,FILENAME FILL IN DDNAME 00654000
MVC FILETYPE(8),=CL8'DISK' FILL IN DEV TYPE AND MODE 00655000
STD F6,FILEBYTE FILE IN FILE TYPE 00656000
MVC FILEMODE(8),CMSNAME FILL IN DEFAULT NAME OF FILE 00657000
LM R6,R7,SAVER1 SAVE THIS DOUBLE WORD 00658000
MVC FILEREAD(24),NOCHNG FILL IN NOCHNG OPTION 00659000
LA R1,PLIST GET ADDR OF PLIST 00660000
SVC X'CA' ISSUE FILEDEF SVC 00661000
DC AL4(*+4) 00662000
STM R6,R7,SAVER1 RESTORE DOUBLE WORD 00663000
LTR R15,R15 WAS FILEDEF SUCCESSFUL? 00664000
LA R15,2 SET ERROR CODE 00665000
BNZ BADDCB NO, THEN DO NOT OPEN DCB 00666000
LPR R5,R0 SET UP CORRECT ADDR 00667000
XI FCBSECT,X'08' INDICATE OPEN FCB 00668000
CKJFCB EQU * 00669000
NI FCBINIT,255-FCBOS TURN OFF FCB OS SWITCH @V201122 00670000
LA R5,0(R5) CLEAR HIGH ORDER BYTE 00672000
TM DCBMACRF,DCBMRECP EXCP DCB @VA08866 00672100
BO TSECT YES @VA08866 00672200
IC R15,FCBDCBCT GET NO. DCB'S USING THIS FCB 00673000
LA R15,1(R15) UP THIS NO. BY ONE 00674000
STC R15,FCBDCBCT SAVE NEW DCB COUNT 00675000
* USE FCB ENTRIES TO FILL UNSPECIFIED DCB PARAMETERS 00676000
TM FCBDEV,X'0C' IS THE DEVICE A CONSOLE? 00677000
BNO TBLKSIZ NO, CONTINUE 00678000
MVI DCBBUFNO,X'01' YES, SET UP SINGLE BUFFERING 00679000
TBLKSIZ SR R11,R11 ZERO REG 11 00680000
CH R11,DCBBLKSI IS BLKSI ZERO V0307 00681000
BL TDSORG YES, CONTINUE 00682000
CH R11,FCBBLKSZ IS BLKSI ZERO 00683000
BE TDSORG YES, CONTINUE 00684000
OI JFCBMASK+2,X'10' SET JFCBMASK 00685000
MVC DCBBLKSI(2),FCBBLKSZ USE FCB ENTRY 00686000
TDSORG CH R11,DCBDSORG WAS DSORG SPECIFIED 00687000
BNZ TLRECL YES. 00688000
CH R11,JFCDSORG IS DSORG ZERO 00689000
BE TLRECL YES, CONTINUE 00690000
MVC DCBDSORG(2),JFCDSORG USE USER SPECIFICATION 00691000
OI JFCBMASK+3,X'01' 00692000
TLRECL TM DCBDSORG,DA ACCESS METHOD= BDAM V0277 00693000
BNO NOTBDAM NO, THEN CONTINUE @VA04226 00694000
MVC DCBREL+1(2),FCBXTENT STORE NUM RECORDS IN DCB @VA04226 00695000
* FIELD 00696000
B TRECFM AND CONTINUE @VA04226 00697000
NOTBDAM SR R4,R4 CLEAR REG 4 @VA04226 00698000
IC R4,FCBDEV GET DEVICE CODE V0277 00699000
SRL R4,2 GET DISPLACEMENT OF OS CODE V0277 00700000
IC R4,DEVTYP(R4) GET OS DEVICE CODE V0277 00701000
STC R4,DCBDEVT SET OS DCB DEVICE CODE V0277 00702000
CLI FCBDEV,FCBDSK DASD DEVICE @VA06212 00703000
BNE NOTDASD NO- BYPASS @VA06212 00704000
SLR R4,R4 CLEAR R4 @VA06212 00705000
ST R4,DCBDVTBL CLEAR @VA06212 00706000
MVI DCBFDAD,X'00' INDICATE NO POINT V0277 00707000
NOTDASD EQU * @VA06212 00708000
CH R11,DCBLRECL IS LRECL ZERO V0307 00709000
BL TRECFM YES, CHECK FOR RECFM V0277 00710000
CH R11,FCBLRECL IS LRECL ZERO 00711000
BE TRECFM YES, CONTINUE 00712000
MVC DCBLRECL(2),FCBLRECL USE FCB ENTRY 00713000
OI JFCBMASK+3,X'02' 00714000
TRECFM TM DCBRECFM,X'FE' WAS RECFM SPECIFIED? @VA10680 00715000
BNZ TKEYLE 00716000
CLI FCBRECFM,X'00' IS RECFM ZERO 00717000
BE TKEYLE YES, CONTINUE 00718000
OI JFCBMASK+2,X'04' 00719000
OC DCBRECFM(1),FCBRECFM USE FCB ENTRY @VA10680 00720000
TKEYLE CLI DCBKEYLE,X'00' WAS KEYLE SPECIFIED 00721000
BNE TOPTCD YES, CONTINUE 00722000
CLI JFCKEYLE,X'00' IS KEYLE ZERO 00723000
BE TOPTCD YES, CONTINUE 00724000
MVC DCBDVTBL+4(1),JFCKEYLE NO, GET IT FROM JFCB 00725000
OI JFCBMASK+3,X'20' SET JFCB MASK 00726000
TOPTCD CLI DCBOPTCD,X'00' IS OPTCD SPECIFIED 00727000
BNE TSECT YES, CONTINUE 00728000
CLI JFCOPTCD,X'00' IS OPTCD ZERO 00729000
BE TSECT YES, CONTINUE 00730000
MVC DCBOPTCD(1),JFCOPTCD NO, GET IT FROM JFCB 00731000
OI JFCBMASK+2,X'80' SET JFCB MASK 00732000
TSECT EQU * SET PARAMETERS FOR CONTROL BLOCK SECT 00733000
LA R4,IHADEB GET V(DEB) 00734000
LA R7,IOBNXTAD GET IOB ADDR 00735000
TM FCBDEV,X'E3' VERIFY VALID DEV CODE & MODULO 4 00736000
BZ OP3 OK. 00737000
MVI FCBDEV,FCBDSK DEFAULT TO DISK DATA SET 00738000
OP3 NI FCBIOSW,FCBPROCO+FCBPROCC+FCBCASE CLEAR SWITCHES 00739000
MVI IOBIOFLG,0 CLEAR I/O FLAGS V0307 00740000
ST R4,DCBDEBAD 00741000
ST R7,DCBIOBAD SAVE V(IOB) FOR CHAINED SCHEDULING 00742000
TM DCBMACRF,DCBMRECP EXCP DCB @VA08866 00742100
BO OPENED YES @VA08866 00742200
ST R7,DCBIOBA STORE ADDR OF IOB IN DCB 00743000
LA R7,(IOBEND-IOBIOFLG)/8 GET L'IOB IN DOUBLE WORDS 00744000
STC R7,DCBIOBL 00745000
ST R2,IOBDCBPT SET DCB POINTER INTO IOB AND DEB 00746000
ST R2,DEBDCBAD 00747000
MVI DEBDEBID,X'0F' SIGNAL: THIS HERE BLOCK IS A DEB 00748000
MVC DEBOPATB(1),EGPR1 SAVE OPEN OPTION BYTE 00749000
* VERIFY: OPEN FOR OUTPUT AT THE BEGIN OF A DATA SET 00750000
XC FCBOP(8),FCBOP CLEAR FCBOP 00751000
XC FCBITEM(18),FCBITEM CLEAR PART OF PLIST 00752000
MVI FCBITEM+1,X'01' POINT TO ITEM ONE 00753000
CKDEV XC FCBKEYS(8),FCBKEYS CLEAR TABLE ADDRESSES 00754000
CLI FCBDEV,FCBDUM IS DEV DUMMY? @VA04566 00755000
BE GETREG1 CHECK FOR EXIT LIST,DON'T STATE @VA04566 00756000
CLI FCBDEV,FCBDSK IS DEVICE DISK 00757000
BE DOSTATE YES, SEE IF FILE EXISTS 00758000
XC FCBDSTYP(4),FCBDSTYP CLEAR PRINT BUFFER ADDR 00759000
B GETREG1 CHECK FOR EXIT LIST 00760000
DOSTATE LA R1,FCBOP GET ADDR OF STATE PLIST 00761000
L R15,ASTATE BY CALLING STATE 00762000
BALR R14,R15 00763000
L R14,FCBOSFST GET OS FST ADDRESS @V201122 00764000
LTR R14,R14 IS IT ZERO @V201122 00765000
BNZ OSCHKS NO, THEN MUST BE OS FCB @V201122 00766000
CH R15,OSRDERR ERROR ACCESSING OS DISK? @V201122 00767000
BNL OSCHKS YES, THEN DON'T OPEN @V201122 00768000
LTR R15,R15 WAS FILE FOUND @V201122 00769000
BNZ CHKASTRK VALIDATE FILEMODE @VA07040 00770500
L R8,SAVER1 GET PARAMETER LIST POINTER @VA07040 00771000
L R14,FCBBUFF GET FST ADDRESS @VA07040 00771500
TM BINZERO(R8),OPNWRITE WRITE OPERATION MANDATED? @VA07040 00772000
BZ MUSBIN NO, CHECK FORMAT @VA07040 00772500
USING FSTD,R14 FST ADDRESSABILITY 00772800
TM FCBINIT,FCBDOSL+FCBCATML CONCATENATED LIBS ?? @VA13863 00772860
BNZ YESLIB YES DON'T MESS WITH FILE MODE @VA13863 00772920
MVC FCBDSMD(2),FSTFMODE WE FOUND IT SO SAVE IT @VA13863 00772980
YESLIB EQU * @VA13863 00773040
TM FSTFLAGS,FSTXWDSK AN EXTENSION OF R/W DISK @VA14488 00773100
BO UPDATE YES, CHECK FOR UPDATE @VA12049 00773500
TM FSTFLAGS,FSTRWDSK A R/W DISK? @VA07824 00774000
BO MUSBIN YES, CHECK FORMAT @VA07040 00774500
EXTDISK EQU * @VA07040 00775000
TM BINZERO(R8),OPNOUT OUTPUT OR OUTIN? @VA07040 00775500
BO CHKASTRK YES, CHECK FILEMODE @VA07040 00776000
TM FSTFLAGS,FSTXRDSK AN EXTENSION ? @VA07824 00777000
BNO GETREG1 NO - CONTINUE @VA07824 00777500
L R15,AFVS FVS ADDRESS @VA07824 00778000
L R15,STATER0-FVSECT(R15) POINT TO ACTUAL ADT @VA07824 00778500
MVC FCBDSMD(1),ADTM-ADTSECT(R15) FILE'S ACTUAL MODE @VA07824 00779000
B GETREG1 CONTINUE @VA07824 00779500
DROP R14 DROP FST ADDRESSABILITY @VA07824 00780000
MUSBIN TM DCBDSORG,PO BPAM DATA SET? @VA05159 00782000
BO CKFORM YES, GO CHECK FORM 00783000
TM JFCBIND2,X'80' IS MOD OPTION ON 00784000
BO SETPTR YES, SET PTR 00785000
TM 0(R8),X'07' IS FILE OPEN FOR OUT/IN? 00786000
BNO CKFORM NO, GO CHECK FORMAT 00787000
CKORG TM DCBDSORG,DA IS DIRECT ACCESS OPTION ON? 00788000
BO CKFORM YES, GO CHECK FORM 00789000
CLI FCBMEMBR,0 MEMBER NAME? @VA07442 00789300
BNE GETREG1 YES, DO NOT ERASE FILE-- @VA07442 00789600
L R15,AERASE GET ADDR OF ERASE RTN 00790000
BALR R14,R15 ERASE FILE 00791000
B GETREG1 GO TO EXITLIST @VA04335 00792000
SETPTR L R1,SAVER1 GET PLIST @VA04335 00793000
TM 0(R1),X'07' OUTPUT OR IN/OUT ? @VA04759 00794000
BNO CKFORM NO, THEN DO NOT SET ITEM NUMBER @VA04335 00795000
LH R15,26(R14) GET NO. ITEMS IN FILE @VA04335 00796000
N R15,HALFWORD ALLIGN ITEM NO. V0206 00797000
LA R15,1(R15) POINT TO NEXT ITEM V0206 00798000
STH R15,FCBITEM SET ITEM NO. FOR EOF V0206 00799000
CKFORM MVC FCBOP+2(6),30(R14) GET FORM AND LENGTH 00800000
CLI FCBDSMD,C'*' IF MODE IS *, NO MODE NUMBER. @VA00893 00801000
BE CKFSTM MODE IS * @VA09484 00802000
MVC FCBDSMD+1(1),25(R14) MODE NO.= EXISTING MODE NO. P3056 00803000
B GETREG1 RESTORE REG 1 AND GO @VA02169 00804000
CKFSTM EQU * CHECK MODE IN FST @VA09484 00804100
NI JFCBIND2,255-M4FLAG RESET MODE 4 FLAG FIRST @VA09484 00804200
CLI 25(14),C'4' MODE IN FST = 4? @VA09484 00804300
BNE GETREG1 NO, CONTINUE @VA09484 00804400
OI JFCBIND2,M4FLAG YES,SET M4FLAG IN FCB @VA09484 00804500
B GETREG1 GO TO EXITLIST @VA09484 00804600
CHKASTRK CLI FCBDSMD,C'*' DON'T WANT * FOR UNDEFINED @VA02169 00805000
BNE GETREG1 FILES @VA02169 00806000
TM FCBINIT,FCBCATML UNLESS THIS DESCRIBES THE @VA02169 00807000
BO GETREG1 CONCATENATED MACRO LIBES @VA02169 00808000
MVC FCBDSMD(2),CA1 SET IT FOR AN A1 FILE @VA02169 00809000
GETREG1 L R1,SAVER1 RESTORE REG 1 00810000
B EXITLIST 00811000
USING OSFST,R14 @V201122 00812000
OSCHKS LTR R15,R15 ANY ERRORS FROM STATE @V201122 00813000
LA R15,80 SET OPEN ERROR 80 @V201122 00814000
BNZ BADDCB YES, DON'T OPEN DCB @V201122 00815000
OI FCBINIT,FCBOS INDICATE FCB FOR OS DISK @V201122 00816000
XC OSFSTCHR(5),OSFSTCHR CLEAR DISK ADDRESS POINTER @V201122 00817000
LA R15,9 SET ERROR CODE 9 @V201122 00818000
L R1,SAVER1 GET ADDRESS OF OPTION BITS @V201122 00819000
TM 0(R1),X'0C' ANY OUTPUT SPECIFIED @V201122 00820000
BNZ BADDCB YES, DON'T OPEN DCB @V201122 00821000
TM DCBDSORG,DA BDAM SPECIFIED @V201122 00822000
BNZ BADDCB YES, THEN DON'T OPEN DCB @V201122 00823000
CLI DCBKEYLE,0 KEYLE= 0 @V201122 00824000
BNE BADDCB NO, THEN INDICATE ERROR @V201122 00825000
TM FCBINIT,FCBCATML CONCATIONATION SPECIFIED @V201122 00826000
BO CKDSNRFM YES, DON'T FORCE FILE MODE @V201122 00827000
MVI FCBDSMD+1,C'4' SET MODE NO. TO 4 @V201122 00828000
CKDSNRFM TM DCBRECFM,UND RECFM SPECIFIED @V201122 00829000
BNZ CKDSNLRL YES, CONTINUE @V201122 00830000
MVC DCBRECFM(1),OSFSTRFM SET RECFM FROM DSCB @V201122 00831000
OI JFCBMASK+2,X'04' INDICATE RECFM CHANGE @V201122 00832000
CKDSNLRL SR R8,R8 CLEAR REG 8 FOR COMPARES @V201122 00833000
CH R8,DCBLRECL DCBLRECL SPECIFIED @V201122 00834000
BNZ CKDSNBLK NO, CHECK FOR BLKSI @V201122 00835000
MVC DCBLRECL(2),OSFSTLRL+2 SET LRECL FROM DSCB @V201122 00836000
OI JFCBMASK+3,X'02' INDICATE CHANGE @V201122 00837000
CKDSNBLK CH R8,DCBBLKSI IS BLKSIXE SPECIFIED @V201122 00838000
BNZ EXITLIST YES, CONTINUE @V201122 00839000
MVC DCBBLKSI(2),OSFSTBLK SET BLKSI FROM DSCB @V201122 00840000
OI JFCBMASK+2,X'10' INDICATE CHANGE @V201122 00841000
B EXITLIST CHECK FOR EXIT ROUTINE @V201122 00842000
DROP R14 @V201122 00843000
UPDATE EQU * CHECK FOR UPDATE @VA12049 00843070
USING FSTD,R14 FST ADDRESSABILITY @VA12049 00843140
TM JFCBIND2,X'80' DISP=MOD ? @VA12049 00843210
BO UPDTERR YES , UPDATE ERROR @VA12049 00843280
TM DCBDSORG,PO PARTITIONED DATASET ? @VA12049 00843350
BO UPDTERR YES, UPDATE ERROR @VA12049 00843420
TM BINZERO(R8),OPNOUT OUTPUT OR OUTIN ? @VA12049 00843490
BO CHKASTRK YES, NO ERROR @VA12049 00843560
DROP R14 DROP FST ADDRESSABILITY @VA12049 00843630
UPDTERR EQU * UPDATE ERROR @VA12049 00843700
LA R15,11 OPEN ERROR CODE 11 @VA12049 00843770
B BADDCB OPEN FAILS @VA12049 00843840
EJECT 00844000
* VERIFY LEGITAMATE RECFM-DEPENDENT QUANTITIRS 00845000
VEROPEN EQU * PLAY BALL... 00846000
TM DCBRECFM,UND IS DCBRECFM SPECIFIED? 00847000
BNZ SETFORM YES, CONTINUE 00848000
MVI DCBRECFM,UND NO, DEFAULT TO UNDEFINED 00849000
OI JFCBMASK+2,X'04' SET JFCBMASK BIT 00850000
CLI FCBOP+2,0 DOES FILE EXISTS P3056 00851000
BE SETFORM NO, SET TO UND FORMAT P3056 00852000
MVI DCBRECFM,VAR SET FORMAT TO VAR P3056 00853000
CLI FCBOP+2,C'F' IS FILE MODE FIXED P3056 00854000
BNE SETFORM NO, THEN USE VAR FORMAT P3056 00855000
MVI DCBRECFM,FXD SET MODE TO FIXED P3056 00856000
SETFORM MVI FCBFORM,C'F' SET FIXED FORM 00857000
TM DCBRECFM,VAR IS RECFM VARIABLE 00858000
BNO CKFST NO, GO CHECK FST 00859000
MVI FCBFORM,C'V' SET VARIABLE FORM 00860000
CKFST CLI FCBOP+2,X'00' DOES FILE EXIST 00861000
BE CKDSORG NO, CONTINUE 00862000
TM DCBDSORG,PO DSORG=PO? @V201122 00863000
BNO CKRECFM NO, DON'T CHECK BLKSIZE @V201122 00864000
TM DCBMACRF+1,X'20' WRITE SPECIFIED @V201122 00865000
BNO CKRECFM NO, CONTINUE @V201122 00866000
MVC DCBBLKSI(2),FCBOP+6 BLKSI MUST = FILE BLKSI @V201122 00867000
CKRECFM EQU * @V201122 00868000
CLC FCBFORM(1),FCBOP+2 DO RECFM'S MATCH 00869000
BE CKDSORG YES, CONTINUE 00870000
TM DCBRECFM,UND IS RECFM UNDEFINED 00871000
LA R15,3 SET ERROR CODE 00872000
BNO BADDCB NO, THEN SIGNAL ERROR 00873000
MVC FCBFORM(1),FCBOP+2 SET FORMS EQUAL 00874000
CKDSORG EQU * 00875000
TM DCBDSORG,DA IS DA OPTION SPECIFIED 00876000
BNO CKLNGTHS NO, CONTINUE V0277 00877000
MVC FCBOP(3),DCBLRECL-1 SAVE LIMCT 00878000
XC DCBLRECL(2),DCBLRECL CLEAR DCBLRECL 00879000
CLC FCBOP(3),ZERO IS LIMCT OPTION SPECIFIED 00880000
BNE CKLNGTHS NO, CONTINUE V0277 00881000
CLC JFCLIMCT(3),ZERO IS LIMCT ZERO 00882000
BE CKLNGTHS YES, CONTINUE V0277 00883000
MVC FCBOP(3),JFCLIMCT GET IT FROM JFCB 00884000
OI JFCBMASK+2,X'40' SET JFCB MASK 00885000
CKLNGTHS EQU * 00886000
MVC FCBCOUT(2),HALF1+2 SET BLOCKING TO ONE V0307 00887000
LH R9,DCBBLKSI GET BLKSIZE 00888000
HALF4 LA R15,4 SET ERROR CODE 00889000
LH R11,MAXOS GET MAXIMUM OS BLOCKSIZE @VA04751 00890000
CH R11,DCBBLKSI IS BLOCKSIZE TOO LARGE? @VA04751 00891000
BL BADDCB BRANCH IF SO @VA04751 00892000
TM DCBRECFM,FXD IS RECFORM VARIABLE? @VA04751 00893000
BO NOTVAR BRANCH IF NOT @VA04751 00894000
SR R11,R15 MAXIMUM LRECL 4 BYTES LESS @VA04751 00895000
NOTVAR EQU * @VA04751 00896000
CH R11,DCBLRECL IS LRECL TOO LARGE? @VA04751 00897000
BL BADDCB BRANCH IF SO @VA04751 00898000
SR R11,R11 SET REGISTER 11 TO ZERO @VA04751 00899000
CR R11,R9 IS BLKSIZE SPECIFIED 00900000
BL CKFXD YES, GO CHECK RECFM P3056 00901000
LH R9,DCBLRECL GET LRECL P3056 00902000
CR R11,R9 IS LRECL SPECIFIED P3056 00903000
BL SETCLR YES, USE LRECL FOR BLKSI P3056 00904000
LH R9,FCBOP+6 GET BLKSI OF FILE P3056 00905000
CR R11,R9 DOES FILE EXISTS P3056 00906000
BNL BADDCB NO, GO TYPE ERR MSG. P3056 00907000
TM DCBRECFM,VAR RECFM VARIABLE ? @VA05077 00908000
BNO SETCLR NO, BRANCH @VA05077 00909000
CLI FCBDSMD,C'*' MODE SPECIFIED AS '*' ? @VA05077 00910000
BNE CKMD4 NO, CHECK FOR MODE OF '4' @VA05077 00911000
L R15,FCBBUFF GET FST @VA05077 00912000
CLI 25(R15),C'4' IS MODE '4' ? @VA05077 00913000
BNE UPDR9 NO, INCREMENT FILE BLKSIZE @VA05077 00914000
B SETCLR YES, SKIP INCREMENT @VA05077 00915000
CKMD4 CLI FCBDSMD+1,C'4' FCB MODE '4' ? @VA05077 00916000
BE SETCLR YES, SKIP INCREMENT @VA05077 00917000
UPDR9 LA R9,4(R9) V FILES MODE NE 4 BLOCK NOT SPECIFIED @VA05077 00918000
* DEFAULT TO FILE BLKSIZE + 8 (RDW AND BDW) 4 HERE AND 4 LATER @VA05077 00919000
SETCLR OI JFCBMASK+2,X'10' CLEAR BLKSI AT CLOSE P3056 00920000
TM DCBRECFM,FXD IS RECFM FXD OR UND P3056 00921000
BO SETBLKSI YES, LRECL= BLKSI P3056 00922000
LA R9,4(R9) NO,BLKSIZE = LRECL + 4 @VA02732 00923000
SETBLKSI STH R9,DCBBLKSI SET BLKSI P3056 00924000
CKFXD TM DCBRECFM,FXD IS FORMAT VAR P3056 00925000
BO CKLRECL NO, GO CHECK LRECL 00926000
SH R9,HALF4+2 SUBTRACT BDW WORD 00927000
CKLRECL CH R11,DCBLRECL IS LRECL SPECIFIED 00928000
BL GETLRECL YES, GO GET LRECL 00929000
STH R9,DCBLRECL NO, LRECL = BLKSI OR BLKSI- 4 00930000
OI JFCBMASK+3,X'02' SET JFCBMASK BIT 00931000
GETLRECL LH R11,DCBLRECL GET LRECL 00932000
TM DCBRECFM,UND IS RECFM UNDEFINED 00933000
BO SETSIZE YES, THEN BYPASS LRECL CHECKS 00934000
TM DCBRECFM,VAR+SPAN IS VARIABLE SPANNED SPECIFIED 00935000
BNO CKBLKING NO, GO CHECK BLOCKING 00936000
LA R15,7 SET ERROR CODE 00937000
TM DCBDSORG,PS IS DSORG PS 00940000
BNO BADDCB NO, THEN BAD DCB 00941000
TM DCBCIND2,QSAMDCB IS QSAM SPECIFIED 00942000
BNO CKFILMOD NO, CHECK FILEMODE @VA10560 00943200
CLI DCBMACRF,X'48' GET/LOCATE VBS? @VA10560 00943400
BNE BADDCB NO, MACRF NOT SUPPORTED @VA10560 00943600
CKFILMOD EQU * @VA10560 00943800
CLI FCBDEV,FCBTAP IS IT TAPE DEVICE @VA11433 00943850
BE SETSIZE YES, BYPASS SETTING FILEMOD @VA11433 00943900
CLI FCBDSMD+1,C'4' IS FILE MODE 4 00944000
BE SETSIZE YES, THEN CONTINUE P3056 00945000
CLC FCBOP+4(4),ZERO IS THIS A NEW FILE P3056 00946000
BNE BADDCB NO, THEN TYPE ERROR MSG. P3056 00947000
MVI FCBDSMD+1,C'4' YES, THEN SET MODE= 4 P3056 00948000
B SETSIZE BYPASS BLK CHECKING 00949000
CKBLKING LA R15,5 SET ERROR CODE 00950000
CLC DCBLRECL,DCBBLKSI IS LRECL LARGER THAN BLOCK @VA05960 00951000
BH BADDCB YES, THEN BAD DCB 00952000
BE RECFMT EQUAL - CHK FORMAT @VA05960 00953000
TM DCBRECFM,BLK IS BLOCKING SPECIFIED 00954000
BNO RECLOW NO, HOW LOW IS IT? @VA05960 00955000
SR R8,R8 ZERO R8 FOR DIVIDE 00956000
DR R8,R11 DIVIDE BLKSI BY LRECL 00957000
TM DCBRECFM,VAR IS RECFM VARIABLE V0020 00958000
BO CKDEVBLK YES, CHECK FOR BLOCKED RDR V0020 00959000
LTR R8,R8 REMAINDER? 00960000
BNZ BADDCB YES, THEN BAD DCB 00961000
CKDEVBLK CH R9,HALF1+2 IS BLOCKING SPECIFIED V0020 00962000
BE SETSIZE YES, THEN NO CHECKS NECESSARY 00963000
CLI FCBDEV,FCBCON IS CONSOLE BLOCKED 00964000
BE BADDCB YES, THEN ERROR 00965000
CLI FCBDEV,FCBRDR IS RDR BLOCKED 00966000
BE BADDCB YES, THEN PRINT ERROR MSG 00967000
TM DCBRECFM,VAR IS RECFM VARIABLE 00968000
BO SETSIZE YES, THEN DON'T SET BLOCKING COUNT 00969000
STH R9,FCBCOUT SET BLOCKING COUNT 00970000
B SETSIZE GO SET IT @VA05960 00971000
RECFMT TM DCBRECFM,VAR IS IT VARIABLE? @VA05960 00972000
BNO SETSIZE NO, MUST BE FIXED @VA05960 00973000
LA R11,8(R11) ADD 8 TO LRECL @VA05960 00974000
STH R11,DCBBLKSI AND SET BLOCK SIZE @VA05960 00975000
B SETSIZE AND GO SET IT @VA05960 00976000
RECLOW EQU * @VA09654 00976400
TM DCBRECFM,VAR LENGTH VARIABLE? @VA09654 00976800
BNO SETSIZE NO, FIXED-LENGTH RECORDS @VA09654 00977200
LA R11,4(R11) ADD 4 TO LRECL @VA09654 00977600
CH R11,DCBBLKSI DIFFERENCE LESS THAN 4? @VA05960 00978000
BH BADDCB YES, THAT IS AN ERROR @VA05960 00979000
SETSIZE MVC FCBBYTE+2(2),DCBBLKSI SET BUFFER AT BLKSI 00980000
LH R9,DCBLRECL GET LRECL 00981000
STH R9,FCBRECL SAVE DCBLRECL AT OPEN 00982000
CLI FCBDSMD,C'*' IS MODE AN ASTERISK? @VA04535 00983000
BNE CKAGAIN NO, THEN CHECK AGAIN @VA04535 00984000
L R8,FCBOP+4 SEE IF FILE EXISTS @VA04535 00985000
LTR R8,R8 DOES IT? @VA04535 00986000
BZ CKAGAIN NO, THEN CHECK AGAIN @VA04535 00987000
L R15,FCBBUFF GET FST @VA04535 00988000
CLI 25(R15),C'4' IS MODE 4? @VA04535 00989000
BNE CKAGAIN NO,CHECK AGAIN @VA04535 00990000
B USBLKSI YES, THEN USE BLOCKSIZE @VA04535 00991000
CKAGAIN CLI FCBDSMD+1,C'4' IS MODE 4? @VA04535 00992000
BNE CKOLDSIZ NO, THEN BRANCH @VA04535 00993000
USBLKSI MVC FCBCOUT(2),HALF1+2 SET FCBCOUT TO ONE @VA04535 00994000
LH R9,DCBBLKSI GET BLKSI 00995000
CKOLDSIZ N R9,HALFWORD CLEAR FIRST HALF OF REG 00996000
HALF6 LA R15,6 SET ERROR CODE 00997000
L R8,FCBOP+4 GET BLKSIZE OF FILE 00998000
LTR R8,R8 DOES FILE EXIST 00999000
BZ CKDA NO, GO CHECK DSORG 01000000
CR R8,R9 CHECK BLKSIZE OF FILE 01001000
BE CKDA OKAY, THEN GO CHECK DSORG 01002000
BL CKVAR FILE RECORD LENGTH LOW, GO CHECK VAR. @VA04986 01003000
TM DCBRECFM,UND IS THIS UNDEFINED RECFM ? @VA04986 01004000
BO CKDA YES, NOT AN ERROR CONDITION @VA04986 01005000
TM DCBDSORG,DA IF HIGH IS IT BDAM ? @VA04986 01006000
BNO BADDCB NO, ERROR @VA04986 01007000
TM DCBMACRF,X'10' YES, THEN MUST BE KEYED @VA04986 01008000
BNO BADDCB IF NOT, ERROR @VA04986 01009000
CKVAR EQU * 01010000
TM DCBRECFM,VAR IS RECFM VARIABLE 01011000
BNO BADDCB NO, THEN DCB BAD 01012000
CKDA TM DCBDSORG,DA IS DSORG DIRECT ACCESS 01013000
BNO CKMAC NO, CONTINUE V0277 01014000
MVC DCBLRECL-1(3),FCBOP RESTORE LIMCT 01015000
B BUFFPOOL GET BUFFER POOL @V201122 01016000
CKMAC EQU * V0277 01017000
TM DCBDSORG,PO ACCESS METHOD = BPAM V0277 01018000
BNO CKMEMBR NO, CHECK FOR MEMBER @V201122 01019000
TM FCBINIT,FCBCATML IS CONCATONATION SPECIFIED V0277 01020000
BO BUFFPOOL GO CHECK DCBBUFL @V201122 01021000
CKWRPDS TM DCBMACRF+1,X'20' WRITE SPECIFIED V0277 01022000
BNO CKMEMBR NO, CHECK FOR MEMBER @V201122 01023000
LCR R0,R3 INDICATE PDSSAVE CALL V0277 01024000
SVC 203 CALL PDSSAVE V0277 01025000
DC H'-3' V0277 01026000
LTR R15,R15 ANY ERRORS V0277 01027000
LA R15,8 SET OPEN ERROR CODE V0277 01028000
BNZ BADDCB YES, DON'T OPEN V0277 01029000
CKMEMBR CLI FCBMEMBR,0 MEMBER NAME SPECIFIED @V201122 01030000
BE BUFFPOOL NO, GET BUFFERS @V201122 01031000
TM FCBIOSW2,FCBMVPDS MOVE PDS SPECIFIED? @V201122 01032000
BO BUFFPOOL YES, BYPASS FIND @V201122 01033000
LA R2,0(R2) CLEAR HIGH ORDER BYTE @V201122 01034000
FIND (R2),FCBMEMBR,D POSITION TO MEMBER @V201122 01035000
LTR R15,R15 SUCCESSFUL ? @V201122 01036000
BZ BUFFPOOL YES, GET BUFFERS @VA09291 01037000
L R0,FCBPDS GET PDS ADDRESS @VA09291 01037200
LTR R0,R0 IS IT ZERO @VA09291 01037400
BZ BADFIND YES, DO NOT FRET @VA09291 01037600
SR R0,R0 CLEAR REG @VA09291 01037800
BCTR R0,R0 FRET PDS DIRECTORY CORE @VA09291 01038000
SVC 203 IN DMSSVT @VA09291 01038200
DC H'-3' SVC 203 ENTRY @VA09291 01038400
BADFIND EQU * @VA09291 01038600
LA R15,8 SET OPEN ERROR @VA09291 01038800
B BADDCB ISSUE ERROR MESSAGE @VA09291 01039000
EJECT 01040000
* PERFORM INDICATED "EXIT LIST" PROCESSING 01041000
EXITLIST L R15,DCBEXLST V(LIST OF ROUTINE ADDRESS) 01042000
LA R15,0(,R15) 01043000
LTR R15,R15 VALID LIST POINTER? 01044000
BZ VEROPEN NO. IGNOR& 01045000
EX1 TM 0(R15),X'0A' 01046000
BNZ EX2 IF ANY BAD BITS, TRY NEXT @VA02035 01047000
TM 0(R15),X'05' IS THERE A DCB EXIT LIST POINTER 01048000
BO EX3 YES, GO HANDLE IT 01049000
EX2 TM 0(R15),EOL "END-OF-LIST"? 01050000
BO VEROPEN YES. 01051000
LA R15,4(,R15) POINT T NEXT LIST ENTRY 01052000
B EX1 01053000
* 01054000
EX3 EQU * GO OFF TO USER'S EXIT DCB ROUTINE 01055000
NI DCBOFLGS,255-OPENLOCK SET LOCK = ON 01056000
L R13,USAVEPTR POINT TO USER SAVE AREA 01057000
L R9,DCBSAV SAVE CURRENT DCB SAVE AREA @VA10775 01057100
STM R0,R15,0(R13) SAVE PRESENT REGS 01058000
DMSKEY LASTUSER SET PSW KEY TO LAST USER KEY 01059000
L R15,4*R15(,R13) RESTORE R15 01060000
L R13,CURRSAVE RESET REG 13 01061000
L R15,0(,R15) GET A(EXIT ROUTINE) FROM EXIT LIST 01062000
LR R1,R2 SET REG1 = V(DCB) 01063000
LM R2,R13,EGPR2 RESTORE REGS TO PRE-SVC VALUE 01064000
BALR R14,R15 GO TO USER EXIT ROUTINE 01065000
DMSKEY RESET RESTORE NUCLEUS KEY 01066000
L R13,CURRSAVE POINT TO SYSTEM SAVE AREA 01067000
L R13,USAVEPTR POINT TO USER SAVE AREA 01068000
LM R0,R15,0(R13) RESTORE PRESENT REGS 01069000
ST R9,DCBSAV RESTORE CURR DCB SAVE AREA @VA10775 01069100
L R13,CURRSAVE RESET TO SYSTEM SAVE AREA 01070000
OI DCBOFLGS,OPENLOCK SET LOCK=OFF 01071000
ST R1,SAVER1 SAVE REG 1 01072000
B EX2 01073000
EJECT 01074000
* BUFFER POOL CONSTRUCTION 01075000
BUFFPOOL EQU * SIMULATE A WET BUFFER POOL 01076000
SR R4,R4 ZERO REG 4 01077000
IC R4,DCBNCP GET NO. OF CHAN. PROGS. 01078000
TM DCBBUFCB+3,1 DID USER SUPPLY OWN BUFFER POOL 01079000
BZ BUCN3 YES. DO NOT GET POOL 01080000
SR R0,R0 CLEAN REG 01081000
IC R0,DCBBUFNO NUMBER OF BUFFERS REQUESTED 01082000
LTR R0,R0 ZERO? 01083000
BNZ BUCN1 NO. 01084000
LA R0,2 SET DEFAULT BUFNO TO 2 01085000
TM DCBCIND2,QSAMDCB ACCESS METHOD QSAM 01086000
BZ BUCN4 NO, DON'T GET BUFFER 01087000
BUCN1 SLL R0,16 01088000
LH R1,DCBBUFL GET BUFFER LENGTH 01089000
N R1,HALFWORD 01090000
BNZ BUCN2 BUFL IS NOT ZERO. 01091000
SETBUFL LH R1,DCBBLKSI GET BLKSIZE 01092000
N R1,HALFWORD CLEAR FIRST HALF 01093000
BUCN2 CH R1,DCBBLKSI BUFL > BLKSI 01094000
BL SETBUFL NO, BUFL LESS SO USE BLKSI 01095000
AR R0,R1 SET GETPOOL PARAMETER 01096000
LA R1,0(,R2) GET V(DCB) 01097000
OI DCBCIND2,X'08' SIGNAL: OPEN ACQUIRED BUFFER POOL. 01098000
GETPOOL (R1),(0) 01099000
* SET INTIAL BUFFER CONDITIONS ACCORDING TO RECFM AND MACRF 01100000
BUCN3 EQU * 01101000
L R1,DCBBUFCB GET V(BUFFER CONTROL BLOCK) 01102000
L R1,0(,R1) GET A(FIRST BUFFER) 01103000
ST R1,IOBSTART SET V(FIRST AVAILABLE BUFFER IN CHAIN 01104000
ST R1,DCBRECAD SET V(FIRST BUFFER TO BE USED) 01105000
TM DCBCIND2,1 QSAM? 01106000
BZ BUCN3A NOPE. 01107000
TM DCBRECFM,FXD RECFM=VARIABLE? 01108000
BO BUCN3A NO. FXD OR UND. 01109000
LA R0,4(,R1) ACCOUNT FOR BDW 01110000
ST R0,DCBRECAD SET ADJUSTED RECAD 01111000
BUCN3A ST R1,DCBEOBAD SET END OF BLOCK CONDITION 01112000
LA R0,1 ID OF NEXT BUFFER TO BE USED 01113000
STC R0,IOBSTART 01114000
TM DCBCIND2,X'01' QSAM? 01115000
BZ BUCN4 NOPE. GOOD. LEAVE EOB CONDITION 01116000
L R7,SAVER1 GET ADDR OF REG 1 01117000
TM 0(R7),X'0F' WAS OUTPUT SPECIFIED? 01118000
BNO BUCN4 NO. 01119000
TM DCBCIND2,UPDT QSAM UPDATE MODE V0307 01120000
BO BUCN4 YES 01121000
LH R14,DCBBUFL GET BUFFER LENGTH IF ANY @VA04227 01122000
N R14,HALFWORD CLEAN TOP @VA04227 01123000
BZ USBLKSZ THERE IS NONE, USE BLOCKSIZE @VA04227 01124000
CH R14,DCBBLKSI IS THE BUFL GREATER THAN @VA07550 01124200
BH USBLKSZ YES,USE BLOCKSIZE @VA07550 01124400
STH R14,DCBBUFL SAVE BUFFER LENGTH @VA07550 01124600
B KONT CONTINUE ALONG @VA04227 01125000
USBLKSZ MVC DCBBUFL(2),DCBBLKSI SET BUFFER LENGTH = @VA04227 01126000
* BLOCKSIZE 01127000
KONT AH R1,DCBBUFL GET V(NEXT BUFFER) @VA04227 01128000
ST R1,DCBEOBAD REMOVE EOB CONDITION. SET NEW ONE@VA04227 01129000
TM DCBMACRF+1,LOC QSAM PUT-LOCATE? @VA04227 01130000
BNO BUCN4 BR IF NOT 01131000
LA R0,2 SET ID OF NEXT-BUFFER-TO-BE-USED 01132000
SR R14,R14 01133000
IC R14,DCBBUFNO GET N'BUFFERS 01134000
CLR R0,R14 HAS N'BUFFERS BEEN EXCEEDED? 01135000
BNH BUCN3B NO. NEXT BUFFER IS VALID 01136000
BCTR R0,0 RESET TO FIRST BUFFER 01137000
L R1,IOBSTART GET V(FIRST BUFFER IN CHAIN) 01138000
LA R1,0(R1) REMOVE ID BYTE 01139000
BUCN3B STC R0,IOBSTART 01140000
BUCN4 STC R4,DCBNCP RESTORE DCBNCP 01141000
SPACE 2 01142000
* SETUP EXTRA IOBS IF NECCESSARY 01143000
* 01144000
TM DCBCIND2,1 QSAM DCB? 01145000
BO OPENED YES, CONTINUE 01146000
LA R7,32 GET IOB LENGTH 01147000
LA R8,IOBNXTAD GET ADDR OF IOB 01148000
LR R9,R8 SAVE FCB IOB ADDR 01149000
LR R1,R8 SETUP REG 1 FOR 1ST IOB 01150000
CKNCP ST R1,0(R8) CHAIN THIS IOB TO PREV. IOB 01151000
TM DCBDSORG,DA ORGANIZATION= BDAM? 01152000
BO OPENED YES, THEN IGNORE DCBNCP 01153000
LR R8,R1 SAVE ADDR OF THIS IOB 01154000
BCTR R4,R0 DECREMENT NO. OF CHAN. PROGS. 01155000
LTR R4,R4 IS IT PLUS 01156000
BNP OPENED NO, GO FINISH OPEN 01157000
BLDLIOBS GETMAIN R,LV=(R7) GET CORE FOR IOB 01158000
MVC 0(32,R1),0(R8) FILL IN IOB 01159000
ST R9,0(R1) SET IOB POINTER TO 1ST IOB 01160000
B CKNCP CHAIN IOB TO PREV. IOB 01161000
EJECT 01162000
* SIGNAL "OPEN" COMPLETED FOR THIS DCB 01163000
OPENED OI DCBOFLGS,GOODOPEN SIGNAL SUCCESSFUL OPEN 01164000
L R1,SAVER1 RESTORE REG 1 01165000
TM FCBIOSW,FCBPROCO DOES FCBPROC WANT CONTROL 01166000
BNO NOTOPEN DON'T GO TO FCBPROC RTN. 01167000
L R15,FCBPROC GET ADDR OF PROC RTN. 01168000
LTR R15,R15 IS IT ZERO 01169000
BZ NOTOPEN YES, THEN DON'T GO 01170000
LR R11,R5 FCB ADDR. IN REG, 11 FOR PROC. P3003 01171000
BALR R14,R15 BRANCH TO PROC RTN. 01172000
NOTOPEN EQU * DCB WAS NOT OPENED 01173000
L R1,DCBSAV GET ADDR TO FRET 01174000
DMSFRET DWORDS=12,LOC=(1),TYPCALL=BALR 01175000
L R1,SAVER1 RESTORE REG 1 @VA02963 01176000
NI DCBOFLGS,255-OPENBUSY 01177000
TM 0(R1),EOL END-OF-LIST FOR OPENING DCB 01178000
BO RETURN YES. 01179000
LA R1,4(,R1) GET NEXT DCB IN OPEN LIST 01180000
B COMOPEN 01181000
* RETURN TO SVCINT, WHO WILL RETURN TO CALLER 01182000
RETURN TM TYPFLAG,TPFACB ACB'S IN PLIST? @V305174 01183000
BZ RETURN2 NO, HEAD FOR THE EXITS @V305174 01184000
NI TYPFLAG,255-TPFACB CLEAR FLAG BIT @V305174 01185000
L R1,EGPR0 RESTORE R1 TO SVC PLIST ADDR @V305174 01186000
L R13,USAVEPTR POINT TO USER SAVE AREA @V305174 01187000
SR R7,R7 CLEAR WORK REG @V305174 01188000
ICM R7,BIN0001,OSIOTYPE GET REQUEST TYPE @V305066 01189000
EX R7,SETSVC SET SVC TYPE IN VIP LIST @V305174 01190000
VSAMCALL MVC 89(3,R13),=CL3'SOP' MOVE IN ID @V305174 01191000
MVC 92(4,R13),BRBACK AND FINALLY RETURN INSTR @V305174 01192000
LA R14,88(,R13) INIT RETURN REG FOR VIP @V305174 01193000
L R15,ACMSCVT POINT TO CVT @V305174 01194000
USING CMSCVT,R15 @V305174 01195000
L R15,CVTAVIB GET ADDR OF VSAM INTFC @V305174 01196000
BR R15 BR FOR VSAM REQUEST @V305174 01197000
DROP R15 @V305174 01198000
SETSVC MVI 88(R13),BINZERO EXECUTED INSTR @V305066 01199000
BRBACK B RETURN3 RETURN INSTR FOR VSAM @V305174 01200000
RETURN2 SR R15,R15 CLEAR ERROR REG @V305174 01201000
RETURN3 L R13,CURRSAVE RESTORE ADDR OF SAVE AREA @V305174 01202000
ST R15,EGPR15 SAVE VSAM RETURN CODE @V305174 01203000
L R14,AOSRET GET OS RET VECTOR INTO INTSVC@V305174 01204000
BR R14 01205000
* TYPE DCB NOT OPENED MSG 01206000
BADDCB L R4,USAVEPTR GET ADDR OF SCRATCH AREA 01207000
CVD R15,0(R4) CONVERT NO. TO DECIMAL @V201122 01208000
UNPK 0(2,R4),6(2,R4) UNPACK NO. @V201122 01209000
MVC 2(15,R4),ERRMSG1 SETUP ERROR MESSAGE @V201122 01210000
OI 1(R4),X'F0' CONVERT TO EBCDIC 01211000
STD F6,8(R4) INDICATE DDNAME 01212000
DMSERR MF=I,SUB=(CHARA,(R4)),NUM=036,LET=E, X01213000
TEXT='OPEN ERROR CODE ''.................' 01214000
SR R0,R0 SEARCH FOR BEGINING OF AFT @VA07070 01215000
L R13,USAVEPTR GET ADDR OF SAVE AREA @VA07070 01216000
LA R1,FCBOP GET ADDR OF PLIST @VA07070 01217000
L R15,AACTLKP GET ADDR OF AFT ROUTINE @VA07070 01218000
BALR R14,R15 GET ADDR OF AFT @VA07070 01219000
L R13,CURRSAVE RESTORE REG 13 SAVE AREA @VA07783 01219100
LTR R15,R15 WAS AFT FOUND? @VA07070 01220000
BNZ NOTOPEN NO, LEAVE @VA07070 01221000
L R13,CURRSAVE RESTORE ADDRESS OF SAVEAREA @VA10705 01221500
MVC FCBOP(8),=CL8'FINIS' SET TO FINIS FILE @VA10705 01222000
LA R1,FCBOP @VA10705 01222500
SVC 202 @VA10705 01223000
DC AL4(*+4) @VA10705 01223500
L R1,DCBSAV GET ADDRESS TO FRET @VA02963 01225000
MVC 0(96,R2),0(R1) RESTORE ORIGINAL DCB @VA02963 01226000
MVI DCBOFLGS,X'00' SET NOTOPEN BIT @VA02963 01227000
LR R15,R11 RESTORE REG 15 01228000
B NOTOPEN SET FLAG BYTE 01229000
NROOM EQU * @VA04752 01230000
MVI DCBOFLGS,X'00' SET NOTOPEN BIT ON @VA02963 01231000
B RETURN @VA02963 01232000
EJECT 01233000
*********************************************************************** 01234000
* * 01235000
* CLLOOOOOOOOOOOOSSSSSSSIINNNGGGGGGGGGGGGGGGG * 01236000
* * 01237000
*********************************************************************** 01238000
SPACE 01239000
* 01259000
* COMMENCE CLOSING A DATA CONTROL BLOCK 01260000
* 01261000
COMCLOSE EQU * ALL CLOSE JOIN IN HERE... 01262000
USING DMSSOP,R12 01263000
L R2,0(R1) GET V(DCB) FROM CLOSE LIST 01264000
CLI 0(R2),ACBID ACB? @V305174 01265000
BNE COMCL2 NO, PROCESS DCB @V305174 01266000
OI TYPFLAG,TPFACB SET FLAG BIT @V305174 01267000
TM 0(R1),EOL END OF LIST? @V305174 01268000
BO RETURN YES @V305174 01269000
LA R1,4(,R1) NO, POINT TO NEXT ENTRY @V305174 01270000
ST R1,EGPR1 SAVE UP-TO-DATE DCB LIST PTR @V305174 01271000
B COMCLOSE AND CONTINUE @V305174 01272000
COMCL2 TM DCBOFLGS,GOODOPEN HAD THIS DCB BEEN OPENED? @V305174 01273000
BZ CLOSED NO. IGNORE THIS FIOLISHNESS 01274000
L R5,DCBDEBAD GET ADDR OF DEB IN FCB 01275000
SH R5,=AL2(IHADEB-FCBINIT) GET ADDR OF FCB 01276000
CLI OSIOTYPE,C'T' IS THIS A TEMPORARY CLOSE 01277000
BE SETFLGS YES 01278000
L R0,FCBKEYS GET KEY TABL ADDR 01279000
LTR R0,R0 IS IT ZERO 01280000
BZ CKFORPDS YES CHECK FOR PDS 01281000
SR R0,R0 NO GO TO SAVE KEYS 01282000
SVC 203 01283000
DC H'-3' SVC 203 ENTRY IN DMSSVT 01284000
LTR R15,R15 ANY ERRORS? 01285000
BZ CKFORPDS NO, CONTINUE 01286000
ERREXIT LR R11,R5 YES, SETUP TO ABEND 01287000
LA R6,=XL4'420000FF' SET ERROR CODE FOR CHECK 01288000
L R15,=V(DMSSCTCE) GET CHECK ADDR 01289000
L R12,=V(DMSSCTCK) GET CHECK BASE REG 01290000
BR R15 PRINT MSG AND ABEND 01291000
CKFORPDS EQU * CHECK FOR PDS @VA14182 01292000
LA R15,BINZERO SET REG 15 TO ZERO @VA14182 01292040
TM MACDIRC,X'80' IS HIGH ORDER BIT ON @VA14182 01292080
BZ FOUNDIT NO, CLEAR OSFST POINTER @VA14182 01292120
ICM R15,7,MACDIRC+1 YES, PUT IT IN REG 15 @VA14182 01292160
TM FCBNEXT,FCBCATML IS IT CONCATENATED ??? @VA14182 01292200
BZ FREEPDS NO, GO AHEAD AND FREE @VA14182 01292240
TM FCBNEXT,FCBDOSL DOSLIB ?? @VA14182 01292280
BNZ FREEPDS IF SO, GO AHEAD AND FREE @VA14182 01292320
L R1,FCBFIRST GET FIRST FCB @VA14182 01292360
FCBLOOP EQU * @VA14182 01292400
LA R1,0(,R1) CLEAR HIGH BYTE @VA14182 01292440
LTR R1,R1 IS IT ZERO ?? @VA14182 01292480
BZ FREEPDS YES, NOTHING LEFT TO CHECK @VA14182 01292520
CLC FCBDD-FCBSECT(8,R1),FCBDD COMPARE DD NAME OF FCB@VA14182 01292560
* WE'RE CLOSING WITH THE @VA14182 01292600
* ONE WE'RE POINTING TO @VA14182 01292640
BE FOUNDIT THEY'RE EQUAL..GOT IT @VA14182 01292680
L R1,FCBNEXT-FCBSECT(R1) GET NEXT FCB IN CHAIN @VA14182 01292720
B FCBLOOP CHECK NEXT FCB @VA14182 01292760
FOUNDIT EQU * @VA14182 01292800
STCM R15,7,FCBOSFST+1 RESET OSFST POINTER @VA14182 01292840
SPACE 1 @VA14182 01292880
FREEPDS EQU * @VA14182 01292920
L R0,FCBPDS GET PDS ADDR 01292960
LTR R0,R0 IS IT ZERO 01293000
BZ SETFLGS YES, THEN CONT 01294000
SR R0,R0 CALL PDSSAVE TO 01295000
BCTR R0,R0 FREE PDS CORE 01296000
SVC 203 AND OR SAVE DIRECTORY 01297000
DC H'-3' SVC 203 ENTRY IN DMSSVT 01298000
LTR R15,R15 ANY ERRORS? 01299000
BNZ ERREXIT YES, SETUP TO ABEND 01300000
SETFLGS EQU * 01301000
OI FCBIOSW,FCBCLOSE SIGNAL: DURING CLOSE 01302000
OI DCBOFLGS,OPENBUSY 01303000
* IF I/O=OUTPUT, MUST CLOSE OUT AND PUT LAST BUFFER 01304000
TM DCBRECFM,VAR RECFM= VAR OR UND V0206 01305000
BNO CKPUT NO, BYPASS PREVIOUS CHECK V0206 01306000
TM DCBOFLGS,PREVIOUS IS WRITE BIT ON 01307000
BNO CLOSE0 NO, CONTINUE CLOSE 01308000
CKPUT TM DCBDSORG,PS ACCESS METHOD= SEQUENTIAL V0206 01309000
BNO SETWRBIT NO, TURN OFF WRITE BIT 01310000
CLC DCBGET+1(3),VGET IS GET SPECIFIED 01311000
BE SETWRBIT YES, TURN WRITE BIT OFF 01312000
TM DCBCIND2,QSAMDCB QSAM SPECIFIED 01313000
BZ CKUPDT NO, CHECK FOR UPDATE MODE 01314000
TM DCBMACRF+1,PUT IS THIS UPDATE OR OUTPUT FILE @VA07538 01314200
BNO SETWRBIT NO-TURN OFF WRITE BIT @VA07538 01314400
CLI FCBDEV,FCBDUM HAS FILE BEEN DUMMIED? @VA03854 01315000
BE CKUPDT YES - BYPASS PUT OF LAST BUFFER @VA03854 01316000
L R13,USAVEPTR GET NEEDED SAVE AREA 01317000
LR R1,R2 SET R1=DCB FOR PUT ROUTINE 01318000
L R15,DCBPUT GET V(PUT) 01319000
BALR R14,R15 PUT LAST BLOCK 01320000
OI DCBOFLGS,PREVIOUS LAST I/O WAS WRITE @VA09421 01320500
L R13,CURRSAVE RESET REG 13 01321000
L R1,EGPR1 RESTORE R1 TO DCB LIST POINTER 01322000
STC R9,OSIOTYPE RESTORE TYPE INDICATOR 01323000
CKUPDT TM DCBCIND2,UPDT IS THIS UPDATE MODE? 01324000
BNO CLOSE0 NO, CONTINUE CLOSE 01325000
SETWRBIT NI DCBOFLGS,255-PREVIOUS TURN OFF WRITE BIT 01326000
CLOSE0 EQU * INTERROGATE CLOSE MACRO INSTRUC 01327000
NI FCBIOSW,255-FCBCLEAV 01328000
TM 0(R1),X'40' REWIND OPTION ON CLOSE? @VA07569 01328100
BO CLOSE4B YES-DON'T SET LEAVE BIT @VA07569 01328200
TM 0(R1),OPLEAVE TEST OPTION BYTE- DISP=LEAVE? 01329000
BM CLOSE4B NO.REREAD 01331000
CLOSE4A OI FCBIOSW,FCBCLEAV SIGNAL: DISP=LEAVE 01334000
* DOES FCBPROC ROUTINE WANT CONTROL ? 01335000
CLOSE4B TM FCBIOSW,FCBPROCC FCBPROC WANT CONTROL ? P3003 01336000
BNO CLOSE4C NO, CONTINUE CLOSING P3003 01337000
L R15,FCBPROC GET PROC ROUTINE ADDR. P3003 01338000
LTR R15,R15 IS IT ACTIVE ? P3003 01339000
BZ CLOSE4C P3003 01340000
LR R11,R5 FCB ADDR. IN REG. 11 FOR PROC P3003 01341000
BALR R14,R15 GO TO PROC P3003 01342000
SPACE 1 01343000
CLOSE4C SR R11,R11 P3003 01344000
IC R11,FCBDEV GET DEVICE TYPE CODE 01345000
B *+4(R11) GO TO DEVICE DEPENDENT CODE 01346000
B CDUMMY DUMMY DEVICE 01347000
B CPRINT PRINTER 01348000
B CREADER READER 01349000
B CCONSOLE CONSOLE 01350000
B CTAPE TAPE 01351000
B CDISK DISK 01352000
B CPUNCH CARD PUNCH 01353000
B CCRT CATHODE RAY TUBE 01354000
EJECT 01355000
* DEVICE TYPE = MAG TAPE 01356000
CTAPE EQU * CLOSE OUT TAPE DATA SET 01357000
MVC TAPEDEV(4),FCBDSNAM GET SYMBOLIC TAPE NAME 01358000
MVC TAPEMASK(1),FCBMODE SET TAPE MODE 01359000
LA R1,TAPELIST 01360000
MVC TAPEOPER(8),=CL8'WTM' WRITE TAPE MARK 01361000
TM IOBIOFLG,IOBIN INPUT? @VA03973 01362000
BO TAPEREW YES THEN DON'T WRITE TAPE MARK @VA03973 01363000
TM DEBOPATB,OPNOUT DATASET OPENED AS OUTPUT? @VA08930 01364000
BNO TAPEREW TREAT IT AS AN INPUT DATA SET @VA05424 01365000
* THEN. 01366000
TM DCBOFLGS,PREVIOUS WAS LAST I/O A WRITE @VA06253 01367000
BO TAPEWTM YES,WRITE THE TAPE MARK @VA08024 01367150
* MAY BE VAR OR UND OUTPUT DATA SET AND NO WRITE DONE 01367175
TM DEBOPATB,DEBOUTPT D.S. OPENED FOR OUTPUT @VA11273 01367200
BO TAPEWTM YES, WRITE TAPE MARK @VA11273 01367225
TM FCBIOSW2,FCBTCLOS HAVE WE ISSUED A CLOSE T? @VA08024 01367300
BZ TAPEREW NO,OK TO CONTINUE @VA08024 01367450
MVC TAPEOPER(3),=CL3'FSF' FSF PAST THE TAPE MARK @VA08024 01367600
SVC 202 ISSUE FSF @VA08024 01367750
DC AL4(*+4) IGNORE ERROR @VA08024 01367900
MVC TAPEOPER(8),=CL8'WTM' RESET TO WRITE TAPE MARK @VA08024 01368050
NI FCBIOSW2,255-FCBTCLOS TURN OFF TCLOSE @VA08024 01368200
B TAPEREW CONTINUE @VA08024 01368350
TAPEWTM DS 0H @VA08024 01368500
SVC 202 01369000
DC AL4(*+4) 01370000
CLI OSIOTYPE,TYPET IS THIS CLOSE TYPE T ? @VA06253 01371000
BNE TAPEREW NO. FORGET IT @VA06253 01372000
MVC TAPEOPER(8),BACKSPCE SET UP TO BACK SPACE @VA06253 01373000
SVC 202 OVER PREVIOUSLY WRITTEN @VA06253 01374000
DC AL4(*+4) TAPE MARK @VA06253 01375000
OI FCBIOSW2,FCBTCLOS JUST DID A TCLOSE @VA08024 01375500
TAPEREW TM FCBIOSW,FCBCLEAV TEST OPTION BYTE FOR LEAVE 01376000
BO CLOSE2 LEAVE TAPE POSITIONED 01377000
MVC TAPEOPER(8),=CL8'REW' REWIND TAPE 01378000
SVC 202 01379000
DC AL4(*+4) 01380000
B CLOSE1A 01381000
EJECT 01382000
* CLOSE OUT UNIT RECORD EQUIPMENT 01383000
CPUNCH SR R11,R11 GET PUNCH CODE 01384000
B CREADER CLOSE DEVICE 01385000
CPRINT L R1,FCBDSTYP GET ADDR OF PRINT BUFFER 01386000
LTR R1,R1 IS IT ZERO? 01387000
BZ CREADER YES, CONTINUE 01388000
FREEMAIN R,LV=160,A=(R1) NO, FREE CORE FOR PRINT BUFFER 01389000
CREADER MVC FCBDSNAM(12),=CL12'CP C' SETUP PLIST 01390000
L R6,UNITREC(R11) GET DEVICE CODE @VA08024 01391000
ST R6,FCBDSTYP+4 SET DEVICE NAME IN PLIST @VA08024 01392000
MVC FCBDSMD(4),FENCE SET PLIST DELIMITER 01393000
LA R1,FCBDSNAM GET PLIST ADDR 01394000
SVC 202 CLOSE OUT UNIT RECORD EQUIP. 01395000
DC AL4(*+4) 01396000
SR R1,R1 ZERO OUT PRINT BUFFER ADDR 01397000
ST R1,FCBDSTYP PRINT BUFFER ADDR = ZERO 01398000
SPACE 5 01399000
* DEVICE TYPE = CONSOLE 01400000
CCONSOLE EQU * 01401000
* DEVICE TYPE = DUMMY OR CRT 01402000
CDUMMY EQU * 01403000
CCRT B CLOSE2 01404000
EJECT 01405000
* DEVICE TYPE = DISK, DIRECT ACCESS 01406000
CDISK EQU * CLOSE OUT DISK DATA SET 01407000
TM DCBOFLGS,PREVIOUS WAS LAST I/O A WRITE 01408000
BNO DOFINIS NO, GO DO FINIS 01409000
TM DCBDSORG,X'40' CHECK FILE ORGANIZATION @VA10276 01409100
BZ GETAFT NOT SEQUENTIAL @VA10276 01409200
TM DCBCIND2,X'80' UPDATE PROCESSING? @VA10276 01409300
BO GETAFT YES, BYPASS READ TEST @VA10276 01409400
TM DEBOPATB,X'04' USING OUTPUT OR OUTIN METHOD? @VA10276 01409500
BO GETAFT YES, BYPASS READ TEST @VA10276 01409600
TM IOBFLG,IOBIN WAS READ IN PROCESS? @VA10276 01409700
BO DOFINIS YES, FILE STATUS UNCHANGED @VA10276 01409800
GETAFT EQU * @VA10276 01409900
SR R0,R0 SEARCH BEGINNING OF AFT 01410000
L R13,USAVEPTR GET ADDR OF SAVE AREA 01411000
LA R1,FCBOP GET ADDR OF PLIST 01412000
L R15,AACTLKP GET ADDR OF AFT ROUTINE 01413000
BALR R14,R15 GET ADDR OF AFT 01414000
LTR R15,R15 WAS AFT FOUND 01415000
BNZ DOFINIS NO, GO FINIS FILE 01416000
USING AFTSECT,R1 USE AFT DSECT 01417000
LH R15,AFTIN GET LAST I/O PTR @VA01052 01418000
N R15,HALFWORD ZERO FIRST HALF 01419000
LTR R15,R15 IF AFT WAS JUST CREATED @VA09567 01419350
BZ SKIPITEM SKIP UPDATING THE ITEM COUNT @VA09567 01419700
BCTR R15,R0 GET NO. ITEMS IN FILE 01420000
STH R15,AFTIC UPDATE EOF INDICATOR 01421000
L R14,AFTPFST-1 GET FST ADDR @VA01052 01422000
STH R15,AFTIC-AFTFST(R14) SET FSTIC FIELD @VA01052 01423000
SKIPITEM EQU * @VA09567 01423500
L R1,AFTADT GET ADT ADDR @VA01052 01424000
USING ADTSECT,R1 USE ADT BASE @VA01052 01425000
TM ADTFLG1,ADTFRO IS DISK READ ONLY @VA01052 01426000
BO DOFINIS YES, DON'T CALL UPDISK @VA01052 01427000
SR R15,R15 CLEAR REG 15 @VA01052 01428000
CH R15,ADTNACW ANY DISKS ACTIVE FOR WRITTING@VA01052 01429000
BE DOFINIS YES, DON'T CALL UPDISK @VA01052 01430000
LR R0,R1 SAVE ADT ADDR IN R0 @VA01052 01431000
LA R1,FCBOP GET ADDR OF PLIST @VA01052 01432000
L R15,AFINIS GET FINIS ADDR @VA01052 01433000
BALR R14,R15 DO FINIS @VA01052 01434000
L R15,AUPDISK GET ADDR OF UPDISK @VA01052 01435000
BALR R14,R15 CALL UPDISK TO WRITE FST @VA01052 01436000
L R13,CURRSAVE RESTORE ADDR. OF SAVE AREA @VA04107 01437000
B CLOSE1 CONTINUE CLOSE @VA04107 01438000
DROP R1 @VA04107 01439000
DOFINIS EQU * @VA13031 01439080
L R13,CURRSAVE RESTORE ADDR OF SAVE AREA @VA13031 01440840
MVC FCBOP(8),=CL8'FINIS' SET TO FINIS FILE 01441000
LA R1,FCBOP 01442000
SVC 202 01443000
DC AL4(*+4) 01444000
EJECT 01445000
CLOSE1 TM FCBIOSW,FCBCLEAV DISP=LEAVE? 01446000
BO CLOSE2 YES. 01447000
CLOSE1A MVC FCBITEM(2),HALF1+2 SET ITEM NO. TO ONE 01448000
* FOR FULL CLOSE, NOT TCLOSE, RESET DCB ENTRIES MODIFIED BY OPEN. 01449000
TM DCBDSORG,DA DSORG=DA V0313 01450000
BO CLOSE2 YES, NO POINT INDICATOR V0313 01451000
MVI DCBFDAD,0 SET POINT INDICATOR OFF V0313 01452000
CLOSE2 NI DCBOFLGS,255-PREVIOUS-OPENBUSY SET SW OFF V0313 01453000
NI FCBIOSW,255-FCBCLOSE SET CLOSE SW OFF V0313 01454000
CLI OSIOTYPE,C'T' IS THIS A TCLOSE 01455000
BE CLOSED 01456000
MVC DCBMACR(2),DCBMACRF RESTORE DCB FIELDS 01457000
MVC DCBIFLG(1),DCBIFLGS 01458000
MVC DCBDDNAM(8),FCBDD 01459000
* IF FILEMODE WAS CHANGED TO '*4' CHANGE IT BACK TO '* ' 01459100
CLI FCBDSMD,C'*' FILEMODE = '*'? @VA10414 01459200
BNE CL2A NO,NEVER MIND @VA10414 01459300
CLI FCBDSMD+1,C' ' FILEMODE = '* '? @VA10414 01459400
BE CL2A YES,ALL OK @VA10414 01459500
MVI FCBDSMD+1,C' ' BLANK OUT MODE NUMBER @VA10414 01459600
CL2A EQU * @VA10414 01459700
NI JFCBIND2,255-M4FLAG TURN OFF MODE 4 FLAG @VA09484 01459800
NI FCBINIT,255-FCBOS TURN OFF FCB OS SWITCH @V201122 01460000
TM FCBINIT,FCBCATML CONCATONATED BIT ON? @V201122 01462000
BNO CKFORDA NO, CONTINUE @V201122 01463000
CLI MACLIBL,X'FF' MACLIB GLOBALED @V201122 01464000
BE CKFORDA NO, CONTINUE @V201122 01465000
MVC FCBDSNAM(8),MACLIBL RESET DSNAME @V201122 01466000
CKFORDA EQU * @V201122 01467000
TM DCBMACR,DCBMRECP EXCP DCB @VA08866 01467100
BO CLOSEXCP YES @VA13742 01467200
TM DCBDSORG,DA BDAM SPECIFIED? 01468000
BO RESETDCB YES, THEN DON'T RESET LRECL 01469000
MVC DCBLRECL(2),FCBRECL DCBLRECL SET SAME AS BEFORE OPEN 01470000
RESETDCB EQU * @VA08024 01471000
SR R6,R6 ZERO WORK REG @VA08024 01471500
TM JFCBMASK+2,X'10' WAS BLKSI MERGED 01472000
BNO *+8 NO,CONTINUE 01473000
STH R6,DCBBLKSI ZERO BLKSIZE @VA08024 01474000
TM JFCBMASK+3,X'02' WAS LRECL MERGED? 01475000
BNO *+8 NO. 01476000
STH R6,DCBLRECL ZERO LRECL @VA08024 01477000
TM JFCBMASK+2,X'04' WAS RECFM MERGED? 01478000
BNO *+8 NO. 01479000
NI DCBRECFM,X'01' RESET RECFM FLAGS @VA10680 01480000
TM JFCBMASK+3,X'01' WAS DSORG MERGED? 01481000
BNO *+8 NO. 01482000
STH R6,DCBDSORG ZERO DATA SET ORGANIZATION @VA08024 01483000
TM JFCBMASK+2,X'80' WAS DCBOPTCD FILLED IN 01484000
BNO *+8 NO, CONTINUE 01485000
STC R6,DCBOPTCD ZERO OPTCD @VA08024 01486000
TM JFCBMASK+3,X'20' WAS KEYLE FILLED IN 01487000
BNO *+8 NO, CONTINUE 01488000
STC R6,DCBKEYLE ZERO DCB KEYLE @VA08024 01489000
TM JFCBMASK+2,X'40' WAS LIMCT FILLED IN 01490000
BNO *+10 NO, CONTINUE 01491000
XC DCBLRECL-1(3),DCBLRECL-1 ZERO LIMCT 01492000
TM DCBCIND2,1 IS THIS A QSAM DATA SET 01493000
BNO FREEIOBS NO, THEN FREE IOB'S 01494000
L R1,DCBBUFCB GET ADDR OF BUFFER CONTROL BLK 01495000
MVC 1(3,R1),IOBSTART+1 RESET BUFFER CHAIN TO START 01496000
B CLOSE3 TURN OFF OPEN FLAG 01497000
FREEIOBS CLI DCBNCP,1 NO. IOB'S = ONE 01498000
BNH RESETIOB YES, RESET IOB PTRS IN DCB 01499000
LA R9,IOBNXTAD GET START OF IOB CHAIN P3040 01500000
L R8,0(R9) GET ADDR OF NEXT IOB P3040 01501000
ST R9,0(R9) RESET IOB CHAIN P3056 01502000
CKIOBS LA R1,0(R8) CLEAR HIGH ORDER BYTE P3040 01503000
CR R1,R9 DOES IOB POINT TO FIRST IOB P3040 01504000
BE RESETIOB YES, THEN IOB CHAIN EMPTY P3040 01505000
L R8,0(R1) GET ADDR OF NEXT IOB P3040 01506000
FREEMAIN R,LV=32,A=(1) FREE IOB AREA 01507000
B CKIOBS GET NEXT IOB IN CHAIN 01508000
RESETIOB SR R8,R8 ZERO REG 8 01509000
ST R8,DCBIOBA CLEAR IOB ADDR 01510000
ST R8,DCBIOBAD CLEAR IOB ADDR 01511000
CLOSE3 NI DCBOFLGS,255-GOODOPEN SIGNAL: DCB CLOSED 01512000
IC R6,FCBDCBCT GET NUM DCBS USING THIS FCB @VA08024 01513000
BCT R6,SETCNT IF MORE THAN ONE, SAVE FCB @VA08024 01514000
TM FCBSECT,X'08' DID OPEN GET THIS FCB V0311 01515000
BZ SETCNT NO, RESET DCB COUNT V0311 01516000
MVC CMSOP(8),FILEDEF SET FILEDEF INDICATOR 01517000
MVC FILENAME(8),FCBDD SET UP PLIST 01518000
MVC FILETYPE(8),=CL8'CLEAR' ISSUE A FILEDEF 01519000
MVC FILEMODE(8),FENCE CLEAR SVC 01520000
LA R1,CMSOP GET ADDR OF PLIST 01521000
SVC X'CA' 01522000
DC AL4(*+4) 01523000
CLOSEXCP NI DCBOFLGS,255-GOODOPEN SIGNAL: DCB CLOSED @VA13742 01523500
CLOSED L R1,EGPR1 RESTORE DCB LIST POINTER 01524000
TM 0(R1),EOL END-OF-LIST OF DCB 01525000
BO RETURN YES. 01526000
LA R1,4(,R1) POIYT TO NEXT DCB 01527000
ST R1,EGPR1 SAVE UP-TO-DATE DCB LIST POINTER 01528000
B COMCLOSE 01529000
SETCNT EQU * @VA08024 01530000
STC R6,FCBDCBCT SAVE NEW DCB COUNT @VA08024 01530500
B CLOSED FINIS CLOSE 01531000
EJECT 01532000
* 01546000
* ROUTINE VECTORS AND GOODIES 01547000
* 01548000
TYPET EQU 227 @VA06253 01549000
PUT EQU X'40' PUT FLAG FOR DCBMACRF FLAG @VA07538 01549100
OUTIN EQU 7 @VA06253 01550000
BACKSPCE DC CL8'BSR' @VA06253 01551000
FILEDEF DC CL8'FILEDEF' 01552000
NOCHNG DC CL8'(' 01553000
DC CL8'NOCHANGE' 01554000
FENCE DC 8X'FF' 01555000
VBSAM DC VL3(DMSSBS) 01557000
VCHECK DC VL3(DMSSCTCK) 01558000
VGET DC VL3(DMSSQSGT) 01559000
VNTPT DC VL3(DMSSCTNP) 01560000
VPUT DC VL3(DMSSQSPT) 01561000
VUPDATE DC VL3(DMSSQSUP) 01562000
DEBOUTPT EQU X'0F' TEST FOR OUTPUT ONLY OPTION @VA11273 01562100
OPNWRITE EQU X'04' TEST FOR WRITE OPERATION @VA07040 01562300
OPNOUT EQU X'03' TEST FOR OUTPUT OPTIONS @VA07040 01562400
DISP31 EQU 31 31-BYTE DISPLACEMENT @VA07040 01562500
ERCOD11 EQU 11 ERROR CODE 11 @VA07040 01562600
ZERO DC F'0' 01563000
HALF1 DC F'1' V0307 01564000
HALFWORD DC F'65535' 01565000
MAXOS DC H'32760' MAXIMUM OS BLOCKSIZE ALLOWED @VA04751 01566000
UNITREC DC CL12'PUN PRT RDR ' UNIT RECORD NAMES 01567000
DEVTYP DC XL8'2848414F81284200' OS DEVICE CODES V0020 01568000
CA1 DC CL2'A1' DEFAULT FILE MODE @VA02169 01569000
DCBMRECP EQU X'80' EXCP DCB @VA08866 01569100
DCBCNT EQU X'71' NO. OF DCBS USING FCB 01570000
EOL EQU X'80' END-OF-LIST 01571000
GOODOPEN EQU X'10' SUCCESSFUL OPEN PERFORMED 01572000
GT EQU X'40' MACRF=GET 01573000
OPENBUSY EQU X'01' OPEN BUSY BIT 01574000
OPENLOCK EQU X'02' OPEN LOCK BIT 01575000
OPLEAVE EQU X'30' OPEN OPTION = LEAVE 01576000
PT EQU X'40' NACRF+1=PUT 01577000
FF EQU X'FF' ANY LIBRARIES GLOBABLED @V305066 01578000
ASTERISK EQU C'*' ASTERISK @V305066 01579000
BIN0001 EQU B'0001' MASK @V305066 01580000
BINZERO EQU X'00' ZERO @V305066 01581000
OSRDERR DC H'80' OS STATE ERROR,CODES 80-89 @V201122 01582000
ERRMSG1 DC C''' ON '' ''' OPEN ERROR MESSAGE @V201122 01583000
M4FLAG EQU X'01' FM IN FCB=*, MODE IS 4 @VA09484 01583100
PRINT GEN 01584000
LTORG 01585000
EJECT 01586000
DCBD DSORG=(PS) 01587000
EJECT 01588000
* 01589000
CMSCB 01590000
EJECT 01591000
NUCON 01592000
EJECT 01593000
IO 01594000
OSFST @V201122 01595000
CMSCVT 01596000
AFT 01597000
ADT @VA01052 01598000
EJECT 01599000
FVS @VA07824 01599200
FSTD @VA07824 01599400
CMSAVE 01600000
EJECT 01601000
REGEQU 01602000
EJECT 01603000
END 01604000