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