FNS TITLE 'DMSFNS (CMS) VM/370 - RELEASE 6' 00001000 SPACE 2 00002000 *. 00003000 * MODULE NAME: 00009000 * 00010000 * DMSFNS 00011000 * 00012000 * SUBROUTINE NAME: 00013000 * 00014000 * DMSFNSA (FINIS) 00015000 * 00016000 * FUNCTION: 00017000 * 00018000 * TO CLOSE ONE OR MORE INPUT OR OUTPUT DISK FILE(S). 00019000 * 00020000 * ATTRIBUTES: 00021000 * 00022000 * NUCLEUS RESIDENT, REENTRANT 00023000 * 00024000 * ENTRY POINTS: 00025000 * 00026000 * DMSFNSA 00027000 * 00028000 * ENTRY CONDITIONS: 00029000 * 00030000 * LA R1,PLIST R1 MUST POINT TO P-LIST AS USUAL 00031000 * THEN EITHER 00032000 * SVC X'CA' CALL FINIS VIA SVC 00033000 * 00034000 * DC AL4(ERROR) ERROR-RETURN (FOR EXAMPLE, IF FILE 00035000 * NOT OPEN) 00036000 * OR 00037000 * L R15, AFINIS WHERE AFINIS=V(DMSFNSA) 00038000 * BALR R14,R15 CALL FINIS VIA BALR (WITHIN NUCLEUS) 00039000 * BNZ ERROR TRANSFER IF ERROR (FOR EXAMPLE, FILE 00040000 * NOT OPEN) 00041000 * 00042000 * R1 MUST POINT TO FINIS PARAMETER LIST: 00043000 * 00044000 * DS 0F 00045000 * PLIST DC CL8'FINIS' (NOTE-IMMATERIAL IF CALLED BY 00046000 * DC CL8' ' FILENAME 00047000 * DC CL8' ' FILETYPE 00048000 * DC CL2' ' FILEMODE 00049000 * 00050000 * EXIT CONDITIONS: 00051000 * 00052000 * NORMAL RETURN 00053000 * R15=0 (AND CONDITION-CODE=0) 00054000 * FILE NOT OPEN 00055000 * R15=6 (AND CONDITION-CODE=2) 00056000 * 00057000 * CALLS TO OTHER ROUTINES: 00058000 * 00059000 * DMSLAFFT, DMSLAD, DMSERS, DMSFREE, DMSFRET, DMSLFSW, 00060000 * DMSDIOR, DMSAUD, DMSDIOW 00061000 * 00062000 * EXTERNAL REFERENCES: 00063000 * 00064000 * FVSECT, AFTSECT, FSTSECT, DMSNUC, ADTSECT 00065000 * 00066000 * TABLES/WORKAREAS 00067000 * 00068000 * WORK AREA FOR CALL TO DMSERS 00069000 * 00070000 * REGISTER USAGE: 00071000 * 00072000 * 12 BASE 00073000 * 13 FVSECT 00074000 * 9 ADTSECT 00075000 * 10 FSTSECT 00076000 * 11 AFTSECT 00077000 * 15 FVSECT 00078000 * REST WORK 00079000 * 00080000 * OPERATION: 00081000 * 00082000 * DMSFNSA CHECKS THE CALLER'S PARAMETER LIST FOR '*' IN 00083000 * FILENAME OR FILETYPE, OR A NONALPHABETIC CHARACTER 00084000 * FOR THE MODE; IF ANY OF THESE CONDITIONS ARE MET, A 00085000 * FLAG IS SET TO CHECK FOR ADDITIONAL ENTRIES IN THE 00086000 * ACTIVE FILE TABLE. 00087000 * 00088000 * AFTER THIS PRELIMINARY CHECK, DMSFNSA CALLS DMSLAD TO 00089000 * FIND AN AFT BLOCK 00090000 * THAT MATCHES THE CALLER'S PARAMETER LIST. IF NONE IS 00091000 * FOUND, AN ERROR 6 IS GIVEN AS SHOWN IN THE EXIT 00092000 * CONDITIONS. 00093000 * 00094000 * IF A MATCH IS FOUND, A CHECK IS MADE TO DETERMINE 00095000 * WHETHER THE FILE IS AN ACTIVE WRITE, AN ACTIVE READ, 00096000 * OR NEITHER. IF NEITHER, IT WAS PLACED THERE BY 00097000 * POINT, BUT WAS NOT READ OR WRITTEN SUBSEQUENTLY. 00098000 * ACTION IS TAKEN IN THESE THREE CASES AS DESCRIBED IN 00099000 * THE FOLLOWING PARAGRAPHS. 00100000 * 00101000 * ACTIVE READ FILE 00102000 * 00103000 * IF THE FILE FOUND BY DMSLAD IS AN ACTIVE READ FILE, 00104000 * DMSFNSA TAKES THE FOLLOWING 00105000 * STEPS TO CLOSE THE FILE: 00106000 * 00107000 * 1. RELEASE TO FREE STORAGE THE 800-BYTE BUFFER USED 00108000 * FOR THE DATA BLOCK (VIA A CALL TO FRET). 00109000 * 00110000 * 2. ALSO RELEASE EITHER THE 200- OR 800-BYTE BUFFER 00111000 * CURRENTLY IN USE FOR THE CHAIN LINK. 00112000 * 00113000 * 3. IF THE FILE HAS A MODE NUMBER OF 3 (FOR EXAMPLE, 00114000 * A3), IT IS NOW ERASED UNLESS THE SUBSET INITIAL- 00115000 * IZATION FLAG IS ON. 00116000 * THIS IS DONE BY CALLING DMSFREE TO 00117000 * OBTAIN FREE STORAGE FOR A SUITABLE CALL TO 00118000 * DMSERS, THEN CALLING DMSERS TO ELIMINATE THE 00119000 * FILE AND THEN GIVING BACK THE FREE STORAGE VIA 00120000 * DMSFRET. CARE IS TAKEN 00121000 * TO PRESERVE INFORMATION TO AVOID RE-ENTERABILITY 00122000 * PROBLEMS BETWEEN DMSFNSA AND DMSERS. 00123000 * 00124000 * 4. NEXT, DMSLAFFT IS CALLED TO RELEASE THIS SLOT IN 00125000 * THE ACTIVE FILE TABLE. 00126000 * 00127000 * 5. FINALLY, IF EITHER THE FILENAME, FILETYPE, OR 00128000 * FILEMODE INDICATED 00129000 * THAT ADDITIONAL FILES SHOULD BE CHECKED. 00130000 * DMSFNSA RETURNS TO THE PORTION OF CODE WHICH 00131000 * CALLS DMSLAD, TO CHECK FOR ANY MORE AFT BLOCKS 00132000 * THAT MAY 00133000 * MATCH THE CALLER'S P-LIST. 00134000 * 00135000 * 6. FINALLY, WHEN ALL APPROPRIATE FILE(S) 00136000 * HAVE BEEN CLOSED, DMSFNSA GIVES A NORMAL RETURN 00137000 * AS INDICATED UNDER 00138000 * EXIT CONDITIONS. 00139000 * 00140000 * FILE ACTIVE FROM A POINT CALL 00141000 * 00142000 * FOR THIS CASE (ACTIVE BUT NEITHER A READ NOR A 00143000 * WRITE), DMSLAFFT IS CALLED, ETC., 00144000 * AS SHOWN ABOVE IN STEPS 4, 5, AND 6 FOR THE "ACTIVE 00145000 * READ FILE" CASE. 00146000 * 00147000 * ACTIVE WRITE FILE 00148000 * 00149000 * IF THE FILE FOUND BY DMSLAD IS AN ACTIVE WRITE FILE, 00150000 * DMSFNSA TAKES THE FOLLOWING 00151000 * STEPS TO CLOSE THE FILE: 00152000 * 00153000 * 1. CHECKS THE POINTER (AFTPFST) IN THE AFT BLOCK TO 00154000 * THE FST ENTRY (IF ANY) IN THE FST HYPERBLOCKS. 00155000 * IF NONZERO, PROCEED TO STEP 2. IF ZERO (AS IS 00156000 * THE CASE FOR A NEW FILE NEVER BEFORE CLOSED), 00157000 * THE SPECIAL FSTLKW ENTRY TO OBTAIN AN EMPTY 00158000 * 40-BYTE FST ENTRY IS CALLED, AND THE AFTPFST 00159000 * POINTER IS SET TO THE ADDRESS PROVIDED BY 00160000 * DMSLFSW. 00161000 * 00162000 * 2. MOVES THE 40-BYTE ENTRY FROM THE AFTFST SLOT IN 00163000 * THE AFT BLOCK TO ITS LOCATION WITHIN THE FST 00164000 * HYPERBLOCKS, SETS THE MODE-LETTER AND CLEARS THE 00165000 * FLAG-BYTE. 00166000 * 00167000 * 3. UNLESS THE FIRST FIVE LETTERS OF THE 00168000 * FILETYPE=SYSUT OR CMSUT, THE TIME OF DAY AND 00169000 * YEAR ARE COMPUTED IN THE SAME MANNER AS GETCLK, 00170000 * AND THE DATE-TIME STORED IN FSTD IN THE FST 00171000 * ENTRY, AND THE YEAR IN FSTYR. (IF THE FILETYPE 00172000 * INDICATES A UTILITY FILE IS BEING FINIS'ED, THIS 00173000 * STEP IS UNNECESSARY AND IS THEREFORE OMITTED.) 00174000 * 00175000 * 4. NEXT THE CURRENT DATA BLOCK POINTED TO BY AFTDBA 00176000 * IS WRITTEN ON DISK. 00177000 * 00178000 * 5. THEN THE FREE STORAGE BLOCK THAT WAS USED FOR THE 00179000 * DATA BLOCK IS RETURNED TO FREE 00180000 * STORAGE VIA DMSFRET. 00181000 * 00182000 * 6. IF THE FIRST CHAIN LINK IS NOT RESIDENT, THE 00183000 * CURRENT CHAIN LINK (UNLESS NULL) IS WRITTEN ON 00184000 * DISK, AND THE FIRST CHAIN LINK BROUGHT INTO 00185000 * CORE. 00186000 * 00187000 * 7. THE LINKAGE PORTION OF THE FIRST CHAIN LINK 00188000 * (AFTCLB) IS MOVED FROM THE AFT BLOCK TO THE 00189000 * FIRST CHAIN LINK, AND THE FIRST CHAIN LINK 00190000 * WRITTEN ON DISK. 00191000 * 00192000 * 8. THEN THE FREE STORAGE BLOCK USED FOR THE CHAIN 00193000 * LINK (EITHER 200 OR 800 BYTES IN LENGTH) 00194000 * IS RETURNED TO FREE STORAGE VIA DMSFRET. 00195000 * 00196000 * 9. THE WRITE POINTER IS COMPUTED AS THE NUMBER OF 00197000 * ITEMS PLUS ONE AND STORED IN THE FST ENTRY. 00198000 * 00199000 * 10. THE NUMBER OF ACTIVE WRITE FILES FOR THIS ACTIVE 00200000 * DISK TABLE (ADTNACW) IS DECREMENTED BY ONE. 00201000 * 00202000 * 11. IF THE NUMBER OF ACTIVE WRITE FILES (ADTNACW) IS 00203000 * NOW=0, THEN DMSAUDUD IS CALLED TO 00204000 * UPDATE THE FILE DIRECTORY FOR THIS ACTIVE DISK 00205000 * TABLE. 00206000 * 00207000 * 12. DMSLAFFT IS THEN CALLED TO RELEASE THIS SLOT IN 00208000 * THE ACTIVE FILE TABLE. 00209000 * 00210000 * 13. THEN IF EITHER THE FILENAME, FILETYPE, OR 00211000 * FILEMODE INDICATED THAT ADDITIONAL FILES 00212000 * SHOULD BE CHECKED, DMSFNSA RETURNS TO THE 00213000 * PORTION OF CODE THAT CALLS DMSLAD, TO 00214000 * CHECK FOR ANY MORE AFT BLOCKS THAT MAY MATCH THE 00215000 * CALLER'S P-LIST. 00216000 * 00217000 * 14. FINALLY, WHEN ALL APPROPRIATE FILE(S) HAVE BEEN 00218000 * CLOSED, DMSFNSA GIVES A NORMAL RETURN 00219000 * AS INDICATED UNDER EXIT CONDITIONS. 00220000 * 00221000 * SUBROUTINE NAMES: 00222000 * 00223000 * DMSFNST (TFINIS) 00224000 * DMSFNSE (EFINIS) 00225000 * 00226000 * FUNCTION: 00227000 * 00228000 * TO TEMPORARILY CLOSE A GIVEN FILE OR ACTIVE DISK 00229000 * TABLE, FOR THE PURPOSE OF UPDATING THE FILE 00230000 * DIRECTORY. 00231000 * 00232000 * ATTRIBUTES: 00233000 * 00234000 * NUCLEUS RESIDENT, REENTRANT. 00235000 * 00236000 * ENTRY POINTS: 00237000 * 00238000 * DMSFNST 00239000 * DMSFNSE 00240000 * 00241000 * ENTRY CONDITIONS: 00242000 * 00243000 * L R15,ATFINIS WHERE ATFINIS=V(DMSFNST) OR V(DMSFNSE) 00244000 * BALR R14,R15 00245000 * 00246000 * 1. DMSFNSE ENTRY - TO CLOSE A PARTICULAR FILE WITHOUT 00247000 * UPDATING THE DIRECTORY OR REMOVING FROM THE ACTIVE FILE 00248000 * TABLE. 00249000 * 00250000 * R0 = POINTER TO ACTIVE DISK TABLE R1 = POINTER TO 00251000 * ACTIVE FILE TABLE 00252000 * 00253000 * 2. DMSFNST ENTRY - TO TEMPORARILY CLOSE ALL OUTPUT FILES 00254000 * FOR A GIVEN DISK TABLE 00255000 * 00256000 * R0 = POINTER TO ACTIVE DISK TABLE R1 = 0 00257000 * 00258000 * EXIT CONDITIONS: 00259000 * 00260000 * NORMAL RETURN 00261000 * R15=0 (AND CONDITION-CODE=0) 00262000 * 00263000 * FILE NOT OPEN 00264000 * R15=6 (AND CONDITION-CODE=2) 00265000 * 00266000 * CALLS TO OTHER ROUTINES: 00267000 * 00268000 * DMSLAF, DMSFRET, DMSLFSW, DMSDIOR, DMSDIOW 00269000 * 00270000 * EXTERNAL REFERENCES: 00271000 * 00272000 * ADTSECT, AFTSECT, FSTSECT, FVSECT 00273000 * 00274000 * REGISTER USAGE: 00275000 * 00276000 * R12 BASE 00277000 * R13 FVSECT 00278000 * REST WORK 00279000 * 00280000 * OPERATION: 00281000 * 00282000 * THE DMSFNST ROUTINE IS PART OF THE DMSFNS FUNCTION 00283000 * PROGRAM. IT IS CALLED, HOWEVER, ONLY BY BALR, AS 00284000 * FROM DMSRNM OR DMSERS (NOT VIA SVC). 00285000 * 00286000 * THE DMSFNSE ENTRY IS DIFFERENTIATED FROM THE DMSFNST 00287000 * ENTRY FROM R1 BEING ZERO (FOR DMSFNST), OR NONZERO 00288000 * (FOR DMSFNSE). 00289000 * 00290000 * SEE THE DMSFNSA DESCRIPTION FOR INFORMATION ON THE 00291000 * DMSFNSA STEPS, SOME OF WHICH ARE FOLLOWED BY DMSFNSE 00292000 * AND DMSFNST, AS DESCRIBED BELOW. 00293000 * 00294000 * 1. THE DMSFNSE LOGIC IS AS FOLLOWS: 00295000 * 00296000 * ACTIVE READ FILE 00297000 * GIVES BACK FREE STORAGE BUFFERS AS IN STEPS 00298000 * 1 AND 2 OF THE "ACTIVE READ FILE" IN THE DMSFNSA 00299000 * DESCRIPTION. (NOTE THAT DMSLAFFT IS NOT CALLED - 00300000 * THIS IS DONE LATER BY DMSERS.) 00301000 * 00302000 * ACTIVE FILE FROM POINT 00303000 * NO ACTION TAKEN. (DMSERS CALLS DMSLAFFT LATER.) 00304000 * 00305000 * ACTIVE WRITE FILE 00306000 * PERFORMS SELECTED STEPS OF THOSE FOLLOWED BY THE 00307000 * "ACTIVE WRITE FILE" LOGIC AS IN THE DMSFNSA 00308000 * DESCRIPTION, NAMELY STEPS 4 THROUGH 10 (OMITTING 00309000 * STEPS 1-3 AND 11-14). 00310000 * 00311000 * 2. THE DMSFNST LOGIC, FOR TEMPORARILY CLOSING ALL 00312000 * OUTPUT FILES FOR A GIVEN DISK (CALLED BY DMSERS 00313000 * AND DMSRNM) IS AS FOLLOWS: 00314000 * SEARCH THROUGH ACTIVE FILE TABLE FOR ENTRIES (IF 00315000 * ANY) WHOSE ACTIVE DISK TABLE MATCHES THAT PROVIDED 00316000 * TO DMSFNST. FOR EACH ONE FOUND (IF ANY), ACTION 00317000 * IS AS FOLLOWS: 00318000 * 00319000 * ACTIVE READ FILE 00320000 * NO ACTION TAKEN. 00321000 * 00322000 * ACTIVE FILE FROM POINT 00323000 * NO ACTION TAKEN. 00324000 * 00325000 * ACTIVE WRITE FILE 00326000 * PERFORMS SELECTED STEPS OF THOSE FOLLOWED BY THE 00327000 * "ACTIVE WRITE FILE" LOGIC AS GIVEN IN THE DMSFNSA 00328000 * DESCRIPTION, NAMELY STEPS 1,2,3,4,6,7,9,13, AND 14 00329000 * (OMITTING STEPS 5,8, AND 10 THROUGH 12). 00330000 * 00331000 * NOTE: ONE ADDITIONAL STEPS IS PERFORMED IF NEEDED; 00332000 * IF IT WAS NECESSARY TO BRING THE FIRST CHAIN LINK 00333000 * INTO CORE IN STEP 6, THE NTH CHAIN LINK IS BROUGHT 00334000 * BACK INTO CORE AFTER STEP 7. 00335000 * 00336000 *. 00337000 EJECT 00338000 DMSFNS START 0 P3035 00339000 SPACE 00340000 ENTRY FINIS P3035 00341000 FINIS EQU DMSFNS P3035 00342000 ENTRY DMSFNST P3035 00343000 ENTRY TFINIS ('EFINIS' USES 'TFINIS' ENTRY-POINT) 00344000 ENTRY DMSFNSD P3035 00345000 ENTRY DISKDIE (ENTRY TO 'DIE' IF HARDWARE DISK-ERROR) 00346000 EXTRN FVS 00347000 * 00348000 USING NUCON,R0 00349000 USING AFTSECT,R11 R11 = ACTIVE FILE TABLE 00350000 USING FSTSECT,R10 R10 = FST-BLOCK IN FST TABLES 00351000 USING ADTSECT,R9 R9 = ACTIVE DISK TABLE 00352000 * 00353000 FSENTR REGSAV3 ENTER 'FINIS', SAVE REGISTERS 00354000 MVI FINFLG,00 CLEAR FINIS-FLAG. 00355000 OI UFDBUSY,FNBIT SET OUR BIT IN 'UFDBUSY' FLAG 00356000 LA R2,SETALL R2 POINT TO 'SETALL' FOR BCR'S 00357000 LA R1,0(,R1) MAKE SURE THE REGISTER IS PRESENTABLE 00358000 CLI 8(R1),C'*' ALL NAMES ? 00359000 BE CHEKTYPE YES - CHECK FOR ALL TYPES ALSO @VA01100 00360100 CLI 16(R1),C'*' ALL TYPES ? 00361000 BCR 8,R2 'BE' IF YES. 00362000 CLI 24(R1),C'A' MODE LETTER FROM 'A' TO 'Z' ? 00363000 BCR 4,R2 'BL' IF < A, ASSUME ALL MODES. 00364000 CLI 24(R1),C'Z' CHECK AGAINST 'Z', 00365000 BNH FIN00 BNH IF NOT > Z. 00366000 SETALL OI FINFLG,ALL SET BIT FOR ALL NAMES, TYPES, OR MODES 00367000 FIN00 SR R11,R11 (TO SEARCH ACTIVE-FILE-TABLE FROM BEG.) 00368000 LA R12,FIN01 SET R12 FOR COMMON ADDRESSABILITY, 00369000 USING FIN01,R12 ... 00370000 B FIN03 JOIN FORCES WITH 'TFINIS' BELOW. 00371000 * 00371100 CHEKTYPE CLI 16(R1),C'*' ALL TYPES ALSO ? @VA01100 00371200 BNER R2 NOPE - JUST GO TO "SETALL" @VA01100 00371300 OI FINFLG,ALLNT YES - REMEMBER ALL NAMES & TYPES @VA01100 00371400 BR R2 AND CONTINUE AT "SETALL". @VA01100 00371500 * 00371600 DROP R12,R13 (FOR NOW) 00372000 * 00373000 DMSFNST DS 0H ENTER 'TFINIS' OR 'EFINIS' HERE. P3035 00374000 TFINIS EQU DMSFNST P3035 00375000 L R15,AFVS A(FVS) INTO R15 P3035 00377000 USING FVSECT,R15 P3035 00378000 STM R0,R14,REGSAV3 SAVE REGISTERS 0-14 P3035 00379000 DROP R15 P3035 00380000 LR R13,R15 REFERENCE FVS INFO P3035 00381000 USING FVSECT,R13 P3035 00382000 BALR R12,0 ESTABLISH OUR OWN ADDRESSIBILITY P3035 00383000 USING *,R12 P3035 00384000 FIN01 LR R9,R0 SET R9 TO ACTIVE-DISK-TABLE 00385000 OI UFDBUSY,FNBIT SET OUR BIT IN 'UFDBUSY' FLAG 00386000 MVI FINFLG,TFIN TENTATIVELY SET FLAG FOR 'TFINIS' 00387000 LA R1,0(,R1) MAKE SURE THE REGISTER IS PRESENTABLE 00388000 LTR R11,R1 R11 TO ACTIVE-FILE-TABLE FOR EFINIS, 00389000 BZ FIN02 BZ TO 'TFINIS' CODE IF R1 WAS 0. 00390000 MVI FINFLG,EFIN+YES SET FLAG FOR 'EFINIS', 00391000 TM AFTFLG,AFTRD AN ACTIVE-READ ? 00392000 BO RDITEM IF YES, GO FRET BUFFERS ONLY. 00393000 TM AFTFLG,AFTWRT AN ACTIVE-WRITE THEN, HOPEFULLY ? 00394000 BNO FIN07 JUST A 'POINT'. GO EXIT. V0510 00395051 LA R10,AFTFST POINT FST IN AFT. V0510 00395101 B WRITEM3 GO TO EFINIS V0510 00395151 * 00397000 FIN03 L R1,REGSAV3+4 SET UP R1, 00398000 * 00399000 FIN06 LR R0,R11 SET UP R0, 00400000 L R15,AACTLKP CALL 00401000 BALR R14,R15 'ACTLKP' 00402000 BNZ FIN07 BNZ IF 'NOT FOUND'. 00403000 LR R2,R11 'REMEMBER' OLD R11 FOR RESUMING SEARCH 00404000 LR R11,R1 POINT TO ACTIVE-FILE-TABLE FOUND 00405000 L R10,AFTPFST-1 GET POINTER TO FST-ENTRY IN FST-TABLES JS 00406000 TM FINFLG,TFIN IS IT 'TFIN' ? 00407000 BZ FIN04 BZ IF NOT, PRESUMABLY A GOOD MATCH 00408000 C R9,AFTADT IF TFINIS, IS IT 'OUR' ACTIVE-DISK-TABLE? 00409000 BNE FIN02 TRF IF NOT, KEEP LOOKING ... 00410000 OI FINFLG,YES IF OK, INDICATE WE FOUND SOMETHING, 00411000 TM AFTFLG,AFTWRT IS IT AN ACTIVE-WRITE ? 00412000 BO WRITEM BO IF YES, GO 'TCLOSE' IT. 00413000 FIN02 LA R1,FINISLST USE A P-LIST WHICH WILL FIND ALL FILES 00414000 B FIN06 AND GO CALL ACTLKP FOR FIRST OR NEXT ONE. 00415000 * STRATEGY CHANGED FOR POINT, READ POINTER AND WRITE 00416000 * POINTER. 00417000 * POINT NOW AFFECTS ONLY THE WP AND RP IN THE AFT. 00418000 * WHEN THE FILE IS CLOSED (VIA FINIS), THE CURRENT WP IS 00419000 * ALWAYS MOVED TO THE REAL (STATIC) FST. 00420000 * THE CURRENT RP IS NEVER MOVED. 00421000 * THIS ENABLES THE CMS SUBSET TO DEAL NICELY WITH OPEN 00422000 * FILES. 00423000 * 00424000 * 00425000 FIN04 L R9,AFTADT ACCESS ACTIVE-DISK-TABLE, 00426000 OI FINFLG,YES INDICATE WE'RE CLOSING SOMETHING 00427000 TM AFTFLG,AFTWRT IS IT AN ACTIVE WRITE? 00428000 BO WRITEM BO IF YES. 00429000 MVC FSTWP(2),AFTWP MOVE THE WRITE POINTER 00430000 TM AFTFLG,AFTRD IS IT AN ACTIVE READ? 00431000 BO RDITEM BRANCH IF SO 00432000 * 00433000 FIN05 LR R1,R11 SET UP R1, 00434000 L R15,AACTFRET GIVE BACK THE 00435000 BALR R14,R15 SLOT IN THE ACTIVE-TABLE, 00436000 LR R11,R2 BACK UP TO PREVIOUS ONE FOR NEXT SEARCH, 00437000 TM FINFLG,ALL SHOULD WE CONTINUE CHECKING ? 00438000 BNZ FIN03 BNZ IF YES. 00439000 * 00440000 FIN07 SR R15,R15 R15 TENTATIVELY 0, 00441000 TM FINFLG,YES DID WE CLOSE ANYTHING AT ALL ? 00442000 BNO FIN08A NO P3051 00443000 XC STATEFST(STFSTSIZ-8),STATEFST Clear STATEFST HRC015DS 00444100 B FIN08 P3051 00445000 FIN08A LA R15,6 ERROR 6 IF NOTHING CLOSED P3051 00446000 FIN08 KXCHK FNBIT CHECK FOR 'KX' WANTED... 00447000 LM R0,R14,REGSAV3 RESTORE R0-R14 00448000 LTR R15,R15 SET CONDITION-CODE FOR CONVENIENCE OF CALLER 00449000 BR R14 AND EXIT. 00450000 EJECT 00451000 RDITEM DS 0H FINISH AN ACTIVE INPUT FILE... 00452000 CLI UFDBUSY,X'FF' 'UFDBUSY' FLAG ALL ONES FROM 'KX' ? 00453000 BE RDITEM2 IF YES, AVOID POSSIBLE FRET 'ERROR HALT' 00454000 BAL R7,FRETEM GOTO THE COMMON CLEANUP ROUTINE. V0510 00455051 RDITEM2 TM FINFLG,EFIN WAS THIS AN 'EFINIS' CALL ? 00463000 BO FIN07 BO IF YES, THAT'S ALL FOR NOW. 00464000 CLI AFTM+1,C'3' WAS MODE '3' ? 00465000 BNE FIN05 BNE, GO RELEASE FROM ACT-TABLE 00466000 TM SUBFLAG,SUBINIT IN SUBSET INITIALIZATION? V0510 00467100 BO FIN05 BRANCH IF SO (DO NOT ERASE) 00471000 MVI AFTFLG,00 CLEAR FLAG-BYTE SO ERASE DOESN'T FIND IT 00472000 LA R0,JCNT2 GET ENOUGH FREE STORAGE FOR ERASE 00473000 * PARAMETER LIST AND TO PRESERVE FINIS RE-ENTRABILITY 00474000 DMSFREE DWORDS=(0),TYPE=NUCLEUS,TYPCALL=BALR 00475000 LTR R15,R15 FAIL IF STORAGE NOT @VA02374 00475300 BNZ ERROR25 AVAILABLE @VA02374 00475600 MVC 8(16,R1),AFTN MOVE IN FILE-NAME & FILE-TYPE, 00476000 MVC 24(2,R1),AFTM AND THE MODE, 00477000 MVC 26(JCNT1,R1),REGSAV3 SAVE NECESSARY CRUCIAL INFO., 00478000 L R15,AERASE NOW CALL ERASE (VIA BALR) TO GET RID JS 00479000 BALR R14,R15 OF 'P3' FILE (OR EQUIVALENT) JS 00480000 MVC REGSAV3(JCNT1),26(R1) NOW RESTORE OUR CRUCIAL INFO. 00481000 * RETURN THE FREE STORAGE WE USED 00482000 DMSFRET DWORDS=(0),LOC=(1),TYPCALL=BALR 00483000 OI AFTFLG,AFTUSED SET FLAG-BIT FOR BENEFIT OF ACTFRET, 00484000 B FIN05 AND GO RELEASE FROM ACTIVE-TABLE. 00485000 EJECT 00486000 WRITEM DS 0H FINISH AN ACTIVE OUTPUT FILE... 00487000 N R10,ADDONLY DOES FST-ENTRY EXIST YET ? JS 00488000 BNZ WRITEM1 BP IF YES, IT'S THERE. 00489000 LR R0,R9 SET UP R0 FOR FSTLKW, 00490000 SR R1,R1 AND SET UP R1, 00491000 L R15,=V(DMSLFSW) GET A PLACE FOR 40-BYTE ENTRY IN FST TBL 00492000 BALR R14,R15 ... 00493000 STCM R1,B'0111',AFTPFST STORE THE POINTER BACK THERE @VA01100 00494100 LR R10,R1 POINT TO IT VIA R10 FROM NOW ON. 00497000 LA R1,1 MAKE THE RP = 1 00498000 STH R1,FSTRP 00499000 WRITEM1 EQU * 00500000 MVC FSTN(FSTWP+2-FSTN),AFTN MOVE NAME...WP 00501000 MVC FSTM(FSTYR+2-FSTM),AFTM AND MODE...YEAR 00502000 MVI FSTM,C'P' MAKE SURE MODE-LETTER IS 'P', 00503000 MVI FSTFB,00 AND CLEAR THE FLAG-BYTE 00504000 WRITEM2 CLC SYSUT,FSTT IS FILE-TYPE SYSUT___ ? 00505000 BE WRITEM2A SKIP TYPSRCH V0510 00506051 * 00507000 LM R0,R1,FSTT NEW FILETYPE INTO R0-R1, JS 00508000 L R15,ATYPSRCH CHECK NEW FILETYPE JS 00509000 BALR R14,R15 VIA "TYPSRCH" JS 00510000 O R15,ADTFTYP-3 "OR" IN THE POSSIBLE BITS JS 00511000 ST R15,ADTFTYP-3 FOR THE FILETYPE. JS 00512000 * 00513000 * COMPUTE TIME OF DAY A LA 'GETCLK' ... 00514000 * 00514051 WRITEM2A EQU * V0510 00514101 LA R13,BALRSAVE GET SCRATCH AREA V0040 00515100 LA R15,DMSFNSTM POINT TO "GET THE TIME" ROUTINE @V305032 00515125 BALR R14,R15 CALL IT @V305032 00515150 BZ GETMONTH IF OK, BYPASS DIAGNOSE CALL. @V305032 00515175 DC X'83',X'D0',X'000C' CALL CP FOR TIME INFO V0040 00515200 * AND 'SCRATCH' = SAME + 24 BYTES. 00520000 GETMONTH MVC SCRATCH(2),0(R13) GET THE MONTH, @V305032 00521100 MVC SCRATCH+2(2),3(R13) ...AND THE DAY, 00522000 MVC SCRATCH+4(2),8(R13) ...AND THE HOUR, 00523000 MVC SCRATCH+6(2),11(R13) ...AND THE MINUTE, 00524000 MVI SCRATCH+8,X'C0' ...AND THE SIGN, 00525000 PACK SCRATCH+9(5),SCRATCH(9) PACK THE INFO., 00526000 MVC FSTD(4),SCRATCH+9 AND PUT IT IN THE FST 00527000 MVC FSTYR(2),6(R13) YEAR (E.G. F6F9 FOR 69) TO LAST 2 BYTES 00528000 L R13,AFVS RESTORE R13 V0040 00528100 TM AFTFLG2,AFTCLX EXTRA CHAIN LINK(S) AROUND ? @VA01100 00528200 BZ WRITEM3 NO - FORGET IT (NO PROBLEM) @VA01100 00528300 TM FINFLG,TFIN WAS THIS A 'TFINIS' CALL? @VA01100 00528400 BO WRITEM3 YES - FORGET IT @VA01100 00528500 LA R15,1 IS THIS PERCHANCE THE @VA02751 00528800 CH R15,ADTNACW ONE AND ONLY ACTIVE WRITE FILE ? @VA01100 00528900 BNE WRITEM3 NO SUCH LUCK THIS TIME @VA01100 00529000 * CLOSING SINGLE OUTPUT FILE, WITH EXTRA CHAIN LINK(S) IN IT: 00529100 WRITEM2B TM ADTFLG3,ADTFUPD1 MAYBE 1ST HALF ALREADY CALLED? @VA01100 00529200 BO WRITEM3 YES - DON'T NEED TO DO. @VA01100 00529300 LR R0,R9 R0 = A (ACTIVE DISK TABLE) @VA01100 00529400 SR R1,R1 R1 = 0 @VA01100 00529500 L R15,AUPDISK CALL THE "FIRST HALF OF UPDISK" @VA01100 00529600 BALR R14,R15 TO GET FILE DIRECTORY IN ADVANCE @VA01100 00529700 *** OI ADTFLG3,ADTFUPD1 *** DONE BY "UPDISK" *** 00529800 * 00529900 WRITEM3 LA R7,800 SET FOR 800-BYTES, 00530000 L R6,AFTDBA WRITE THE DATA-BLOCK 00531000 SR R15,R15 CLEAN A REG @VA01841 00531100 CH R15,AFTDBD SEE IF WE REALLY HAVE DATA BLOCK @VA01841 00531200 BE WRITEM3A NO, THEN DONT CALL DIO (WRITE) @VA01841 00531300 LA R8,AFTDBD ON DISK 00532000 BAL R5,DISKWR ... 00533000 WRITEM3A NI AFTFLG2,255-AFTNEW SIGNAL NO LONGER ANEW FILE @VA01841 00534052 CLC AFTCLN(2),ONE IS THE FCL THE CURRENT CHAIN LINK? V0510 00534101 BE WRITEM4 NO WRITING REQUIRED YET, IF SO. V0510 00534151 L R6,AFTCLA IF NOT, WRITE CURRENT CHAIN-LINK ON DISK 00541000 LA R8,AFTCLD ... 00542000 BAL R5,CHEKWRT MAKE SPECIAL CHECK; IF OK, WRITE ON DISK 00543000 WRITEM4 L R6,AFTFCLA GET THE STORAGE ADDR OF THE FCL. V0510 00544051 MVC 0(80,R6),AFTCLB MOVE THE CHAIN LINK ADDRS THEREV0510 00544101 SR R7,R7 SIGNAL WRITING OF A FCL. V0510 00544151 LA R8,AFTFCL POINT TO THE DISK ADDR OF THE FCL V0510 00544201 BAL R5,DISKWR WRITE OUT THE FCL. V0510 00544251 TM FINFLG,TFIN IS THIS TFINIS? V0510 00544301 BO WRCLSE4 NOW, BACK TO NORMAL. V0510 00544351 LA R7,WRCLSE4 BUILD AN EFFECTIVE NOP. V0510 00544401 FRETEM TM AFTFLG,AFTFBA IS THERE AN N'TH CHAIN LINK BUFFER? V0510 00544451 BNO FRETFCL JUST FRET THE FCL BUFFER IF NOT. V0510 00544501 LA R0,100 INDICATE SIZE OF THE N'TH CL BUFFER.V0510 00544551 L R1,AFTCLA ..AND POINT TO IT. V0510 00544601 DMSFRET DWORDS=(0),LOC=(1),TYPCALL=BALR V0510 00544651 FRETFCL LA R0,125 SIZE OF FCL BUFF + DATA BLOCK BUFF V0510 00544701 L R1,AFTFCLA POINT TO THE AREA. V0510 00544751 LTR R1,R1 CONCEIVABLY, WE FAILED TRYING @VA03665 00544771 BZR R7 TO ACQUIRE THIS @VA02374 00544791 DMSFRET DWORDS=(0),LOC=(1),TYPCALL=BALR V0510 00544801 BR R7 (IN CASE WE CAME FROM RDITEM) V0510 00544851 WRCLSE4 SR R14,R14 ... V0510 00544901 ICM R14,B'0011',FSTIC NO. ITEMS IN FILE. V0510 00544951 LA R14,1(,R14) INCREMENT BY 1. V0510 00545001 STH R14,FSTWP STORE AS NEW WRITE POINTER 00576000 TM FINFLG,TFIN IS IT A 'TFINIS' CALL ? 00577000 BO FIN02 TRF IF YES. 00578000 LH R8,ADTNACW GET NO. OF ACTIVE WRITE FILES @VA01100 00579100 LR R15,R8 @VA04916 00579150 BCTR R8,0 LESS 1. @VA01100 00579200 STH R8,ADTNACW STORE NEW VALUE @VA01100 00579300 SR R14,R14 ZERO FOR DIVIDE @VA04916 00579500 D R14,=F'20' (20 FST'S PER HYPERBLOCK) @VA04916 00579750 LTR R14,R14 ANY REMAINDER? @VA04916 00580000 BP RESOK YES; SKIP @VA04916 00580250 LH R14,ADTRES NO; DECREMENT RESERVE COUNT @VA04916 00580500 BCTR R14,R0 (BY 2 TO COMPENSATE FOR THE @VA04916 00580750 BCTR R14,R0 2 ADDED IN DMSBWR) @VA04916 00581000 STH R14,ADTRES AND RESTORE IT @VA04916 00581250 RESOK TM FINFLG,EFIN IS THIS "EFINIS"? @VA04916 00581500 BO EFINBR BO IF YES CHECK FOR ODD PARTS @VA04221 00583000 TM AFTFLG2,AFTCLX EXTRA CHAIN LINK(S) AROUND ? @VA01100 00583100 BZ WRCLSE6 NO - FORGET IT @VA01100 00583200 TM ADTFLG3,ADTFUPD1 DID WE CALL UPDISK BEFORE ? @VA01100 00583300 BZ WRCLSE8 NO - MUST REMEMBER TO DO LATER. @VA01100 00583400 EFINBR LR R1,R9 POINT TO ACTIVE DISK TABLE @VA04221 00583500 SR R0,R0 GET THE "EXTRA" @VA01100 00583600 ICM R0,B'0011',AFTCLDX CHAIN LINK @VA01100 00583700 BZ WRCLSE5 IF NONE, FORGET IT @VA01100 00583800 L R15,ATRKLKPX CALL "TRKLKPX" @VA01100 00583900 BALR R14,R15 TO GET RID OF IT @VA01100 00584000 * (NOTE - R1 INTACT AFTER TRKLKPX) 00584100 WRCLSE5 ICM R0,B'0011',AFTFCLX NOW GET EXTRA 1ST CHAIN LINK @VA01100 00584200 BZ WRCLSE6 IF NONE, FORGET IT @VA01100 00584300 L R15,AQQTRKX CALL QQTRKX TO GET RID OF IT @VA01100 00584400 BALR R14,R15 ... @VA01100 00584500 WRCLSE6 TM FINFLG,EFIN IS THIS EFINIS? @VA04221 00584610 BO FIN07 YES, THEN WE'RE FINISHED @VA04221 00584710 LTR R8,R8 NO OF ACTIVE FILES NOW 0? @VA04221 00584810 BP FIN05 BP IF NOT (STILL SOME OPEN). 00585000 LR R0,R9 NOW PREPARE TO CALL "UPDISK" @VA01100 00586100 L R15,AUPDISK ... @VA01100 00586200 TM ADTFLG3,ADTFXCHN EXTRA CHN LINKS TO BE RETURNED @VA01100 00586300 BO WRCLSE12 YES - DO IT (CAREFULLY). @VA01100 00586400 LR R1,R0 NO - SET R1 > 0 FOR NORMAL ENTRY @VA01100 00586500 TM ADTFLG3,ADTFUPD1 DID WE CALL THE 1ST HALF ? @VA01100 00586600 BZ WRCLSE7 NOPE - JUST CALL IT NORMALLY. @VA01100 00586700 WRCLSE7N LNR R1,R0 YES - MAKE R1 NEGATIVE @VA01100 00586800 WRCLSE7 BALR R14,R15 UPDATE DIRECTORY FOR THIS DISK @VA01100 00586900 B FIN05 NOW GO CHECK FOR ANY MORE IN P-LIST. 00589000 SPACE 00589100 * NECESSARY TO "REMEMBER" EXTRA CHAIN LINK(S), AND GIVE BACK 00589200 * LATER, WHEN THE LAST OUTPUT FILE ON THIS DISK HAS BEEN CLOSED: 00589300 WRCLSE8 TM ADTFLG3,ADTFXCHN HAVE WE DONE THIS BEFORE ? @VA01100 00589400 BO WRCLSE10 YES - WE'RE DOING IT AGAIN @VA01100 00589500 LA R0,2(,R8) NO. OF ACTIVE WRITE FILES + 2 @VA01100 00589700 SRL R0,1 DIVIDED BY 2 FOR DBL WORDS @VA01100 00589800 DMSFREE DWORDS=(0),TYPE=NUCLEUS,TYPCALL=BALR @VA01100 00589900 LTR R15,R15 FAIL IF STORAGE NOT AVAILABLE@VA02374 00589930 BNZ ERROR25 @VA02374 00589960 OI ADTFLG3,ADTFXCHN INDICATE CHAIN ALLOCATED @VA02374 00589990 STM R0,R1,ADTXNREC REMEMBER DBL-WORD-COUNT/ADDRESS @VA01100 00590000 SLR R7,R7 CLEAR R7 (R6 IS IMMATERIAL) @VA01100 00590100 LR R14,R1 SET R14 = ADDRESS OF AREA @VA01100 00590200 LR R15,R0 COUNT INTO R15 @VA01100 00590300 SLL R15,3 IN BYTES, PLEASE @VA01100 00590400 MVCL R14,R6 CLEAR THE BLOCK @VA01100 00590500 WRCLSE9 L R14,AFTFCLX PICK UP AFTFCLX AND AFTCLDX @VA01100 00590600 ST R14,0(,R1) STORE IN 1ST AVAILABLE WORD @VA01100 00590700 B WRCLSE6 REJOIN THE MAIN PARTY. @VA01100 00590800 * 00590900 WRCLSE10 LM R0,R1,ADTXNREC GET COUNT & ADDRESS OF BLOCK @VA01100 00591000 AR R0,R0 LET R0 = COUNT OF FULL WORDS @VA01100 00591100 SR R15,R15 R15 = 0 @VA01100 00591200 WRCLSE11 CL R15,0(,R1) EMPTY SLOT ? @VA01100 00591300 BE WRCLSE9 YES - STORE IT AND GET OUT @VA01100 00591400 LA R1,4(,R1) BUMP R1 @VA01100 00591500 BCT R0,WRCLSE11 KEEP LOOKING @VA01100 00591600 B WRCLSE6 OUT OF LUCK IF NO ROOM LEFT. @VA01100 00591700 SPACE 00591800 * WHEN THE LAST FILE HAS BEEN CLOSED, GET RID OF THE EXTRA BLOCKS: 00591900 WRCLSE12 SR R1,R1 R1 = 0 TO CALL FIRST HALF UPDISK @VA01100 00592000 BALR R14,R15 NOW DO IT (R15 WAS SET UP) @VA01100 00592100 LM R6,R7,ADTXNREC GET COUNT & ADDRESS OF BLOCK @VA01100 00592200 AR R6,R6 WE WANT THE COUNT OF FULLWORDS @VA01100 00592300 * NOTE: R8 ALREADY = 0 00592400 SR R0,R0 CLEAR R0 FOR ICM USE @VA01100 00592500 WRCLSE13 CL R8,0(,R7) CLEAR WORD FOUND ? @VA01100 00592600 BE WRCLSE16 YES - WE'RE ALL DONE. @VA01100 00592700 USING AFTFCLX,R7 REFERENCE THE STUFF TO GIVE BACK @VA01100 00592800 LR R1,R9 POINT TO ACTIVE DISK TABLE @VA01100 00592900 ICM R0,B'0011',AFTCLDX GET EXTRA CHAIN LINK @VA01100 00593000 BZ WRCLSE14 IF NOT THERE, GO ON @VA01100 00593100 L R15,ATRKLKPX OK - GIVE IT BACK @VA01100 00593200 BALR R14,R15 ... @VA01100 00593300 * (NOTE - R1 INTACT AFTER TRKLKPX) 00593400 WRCLSE14 ICM R0,B'0011',AFTFCLX NOW GET EXTRA 1ST CHAIN LINK @VA01100 00593500 BZ WRCLSE15 IF NOT THERE, GO ON @VA01100 00593600 L R15,AQQTRKX CALL QQTRKX TO GET RID OF IT @VA01100 00593700 BALR R14,R15 ... @VA01100 00593800 WRCLSE15 LA R7,4(,R7) BUMP R7 @VA01100 00593900 BCT R6,WRCLSE13 ITERATE THRU TABLE @VA01100 00594000 DROP R7 ALL DONE. @VA01100 00594100 WRCLSE16 LM R0,R1,ADTXNREC GET COUNT & ADDRESS @VA01100 00594200 SR R7,R7 CLEAR R7 (R8 ALREADY = 0) @VA01100 00594300 STM R7,R8,ADTXNREC CLEAR THE COUNT & ADDRESS @VA01100 00594400 NI ADTFLG3,255-ADTFXCHN CLEAR THE FLAGBIT @VA01100 00594500 DMSFRET DWORDS=(0),LOC=(1),TYPCALL=BALR GIVE IT BACK @VA01100 00594600 LR R0,R9 R0 = A(ACTIVE DISK TABLE) @VA01100 00594700 L R15,AUPDISK SET R15 TO CALL UPDISK @VA01100 00594800 B WRCLSE7N SET R1 MINUS & CALL UPDISK. @VA01100 00594900 ERROR25 LA R15,25 CODE FOR CORE NOT AVAILABLE @VA02374 00594930 B DMSFNSD HALT THE SYSTEM @VA02374 00594960 EJECT 00595000 * SUBROUTINE TO READ FROM OR WRITE ON DISK FOR FINIS ... 00600000 * 00601000 * REGISTER REQUIREMENTS ... 00602000 * 00603000 * R5 = RETURN-REGISTER 00604000 * R6 = CORE ADDRESS OF BUFFER 00605000 * R7 = 0 (FOR 1ST CHAIN LINK), OR 800 00606000 * R8 = CORE-ADDRESS OF DISK-ADDRESS 00607000 * R9 = POINTER TO ACTIVE-DISK-TABLE (ALREADY THERE) 00608000 * 00609000 DISKRD L R15,ARDTK SET TO BRANCH TO RDTK 00610000 B SETPL AND SET UP PARAMETER LIST 00611000 * 00612000 CHEKWRT TM AFTFLG,AFTFULD SPECIAL WARNING-FLAG FROM WRBUF SET ? 00613000 BCR 1,R5 'BO' IF YES, EXIT WITHOUT TRYING TO WRITE 00614000 * 00615000 DISKWR L R15,AWRTK SET TO BRANCH TO WRTK 00616000 SETPL STM R6,R9,DSKLOC STORE ALL NECESSARY PARAMETERS, 00617000 LA R1,DSKLST POINT TO WRTK-RDTK P-LIST, 00618000 BALR R14,R15 CALL WRTK OR RDTK 00619000 BCR 8,R5 RETURN TO CALLER IF C.C. = 0 (NO ERROR) 00620000 * 00623000 DISKDIE BALR R12,0 NEW ADDRESSABILITY 00624000 DMSFNSD EQU DISKDIE P3035 00625000 USING *,R12 (FOR ENTERING FROM WITHOUT) 00626000 USING NUCON,R0 @VM03203 00627000 L R9,ADIOSECT GET DIOSECT ADDR @VM03203 00627025 USING DIOSECT,R9 @VM03203 00627050 L R13,AFVS GET FVS ADDRESS @VM03203 00627075 L R8,ADTADD GET CORRECT ADT ADDRESS @VM03203 00627100 USING ADTSECT,R8 @VM03203 00627125 L R7,ADTDTA GET DEVICE TABLE ENTRY @VM03203 00627150 LH R5,0(,R7) GET DEVICE VIRTUAL ADDRESS @VM03203 00627175 LA R6,2 GET ARGUMENT @VA00895 00627300 CR R6,R15 PERM I/O ERROR ? @VA00895 00627350 BNE NOTIO NO...BR @VA00895 00627400 LA R8,SENSB6 SET FOR 2314 SENSE HRC004DS 00627480 TM DEVTYP,T2314 2314 ? HRC004DS 00627510 BO SHRTSNS NO ... BR HRC004DS 00627540 LH R8,DIOSNSCT GET SENSE BYTE CNT FROM DIOSECT HRC004DS 00627570 SHRTSNS EQU * 00627650 LA R6,DIOCSW SAVED CSW @VA00895 00627700 LA R7,SENSB SAVED SENSE ADDR @VA00895 00627750 DMSERR NUM=909,LET=T,SUB=(HEX,(5),HEX4A,(6),HEX4A,((7),(8))),T*00627800 YPCALL=BALR,TEXT='PERM I/O ERROR ON ''...''. CSW .......*00627850 .......... SENSE ......................................*00627900 ...............',MF=(E,'SYS') @VA01567 00627970 B DIESKIP @VA00895 00628000 NOTIO LR R6,R15 GET RETURN CODE @VA00895 00628050 CH R15,H25 NO CORE CONDITION @VA02374 00628065 BE NOCORE @VA02374 00628080 DMSERR NUM=908,LET=T,SUB=(HEX,(5),HEX,(6)),TYPCALL=BALR,TEXT='*00628100 FILE SYSTEM ERROR DETECTED. VIRTUAL ADDR ''...''. REASON*00628120 CODE ''..''.',MF=(E,'SYS') @VM03203 00628140 B DIESKIP @VM03203 00628160 SPACE 1 00628180 NOCORE DMSERR NUM=109,LET=T,TYPCALL=BALR,TEXT='VIRTUAL STORAGE CAPACI*00628200 TY EXCEEDED' @VM03203 00628220 DIESKIP MVC X'50'(8),ADDONLY GOOD SIZED NUMBER TO TIMER @VA00895 00628250 LA R1,=CL8'CONWAIT' WAIT FOR ERROR MESSAGE TO @VA01107 00628300 SVC 202 FINISH TYPING; THEN RESTORE @VA01107 00628350 MVC X'50'(8),ADDONLY TIMER TO LARGE VALUE, AND ... @VA01107 00628400 LPSW DIE PURPOSELY 'DIE' ON FATAL DISK ERROR 00632000 * (USER'S LAST UFD IS STILL INTACT) 00633000 EJECT 00633100 *. 00633200 * DMSFNSTM = SUBROUTINE TO COMPUTE THE TIME (HOURS AND MINUTES) 00633300 * 00633400 * ENTRY CONDITIONS: 00633500 * 'DATIPCMS' & 'CLKVALMD' SET (IN NUCON) FROM IPL OF CMS. 00633600 * R13 = A(SAVE AREA) - DBL-WORD ALIGNED, AT LEAST 16 BYTES LONG 00633700 * R14 = RETURN-REGISTER 00633800 * R15 = A(DMSFNSTM) 00633900 * 00634000 * REGISTER USAGE: 00634100 * R0-R1 USED FOR WORK REGISTERS 00634200 * 00634300 * EXIT CONDITIONS: 00634400 * IF SUCCESSFUL: 00634500 * R0 HOLDS MINUTES (0-59) SINCE LAST HOUR-CHANGE 00634600 * R1 HOLDS ELAPSED HOURS (0-23) SINCE MIDNIGHT 00634700 * R15 AND CONDITION-CODE = 0 00634800 * EIGHT BYTES AT 0(R13) HOLDS DATE (= DATIPCMS) 00634900 * TWO BYTES AT 8(R13) HOLD HOURS IN UNPACKED DECIMAL FORM 00635000 * TWO BYTES AT 11(R13) HOLD MINUTES IN UNPACKED DECIMAL FORM 00635100 * IF UNSUCCESSFUL: 00635200 * R0-R1 = WORK VALUES 00635300 * R15 = NONZERO (UNCHANGED FROM INPUT) 00635400 * CONDITION-CODE IS NONZERO. 00635500 *. 00635600 USING NUCON,R0 (MUST BE IN EFFECT) @V305032 00635700 ENTRY DMSFNSTM (CALLABLE FROM WITHOUT) @V305032 00635800 USING DMSFNSTM,R15 R15 FOR ADDRESSABILITY PLEASE @V305032 00635900 DMSFNSTM STCK 0(R13) GET/SAVE THE TIME RIGHT NOW @V305032 00636000 LM R0,R1,0(R13) AND PICK IT UP; @V305032 00636100 SL R1,CLKVALMD+4 SUBTRACT LOW ORDER MIDNIGHT VALUE@V305032 00636200 BC 2+1,*+6 TRF IF CARRY OCCURRED @V305032 00636300 BCTR R0,0 DECREMENT R0 IF NO CARRY @V305032 00636400 SL R0,CLKVALMD SUBTRACT HIGH ORDER MIDNITE VALUE@V305032 00636500 SRDL R0,12 CHANGE INTO MICROSECONDS @V305032 00636600 D R0,=F'60000000' DIVIDE BY 60 MILLION @V305032 00636700 SR R0,R0 CLEAR REMAINDER @V305032 00636800 D R0,=F'60' DIVIDE AGAIN TO GET MIN. & HOURS @V305032 00636900 CL R1,=F'23' IS HOURS A REASONABLE FIGURE ? @V305032 00637000 BHR R14 NOPE - WHOLE DAY ELAPSED OR SUCH.@V305032 00637100 * AND EXIT (R15 & COND. CODE NONZERO) 00637200 CVD R1,0(R13) OK - CONVERT HOURS TO DECIMAL @V305032 00637300 UNPK 8(2,R13),6(2,R13) STORE WHERE NEEDED FOR FINIS @V305032 00637400 OI 9(R13),SIGN (AND FIX UP SIGN BIT) @V305066 00637500 CVD R0,0(R13) AND CONVERT MINUTES TO DECIMAL @V305032 00637600 UNPK 11(2,R13),6(2,R13) STORE WHERE NEEDED FOR FINIS @V305032 00637700 OI 12(R13),SIGN (AND FIX UP SIGN BIT) @V305066 00637800 MVC 0(8,R13),DATIPCMS NOW PUT DATE IN 1ST DBL WORD @V305032 00637900 SR R15,R15 CLEAR R15 & CONDITION CODE, AND @V305032 00638000 BR R14 EXIT; MINUTES IN R0; HOURS IN R1.@V305032 00638100 DROP R15 END OF SUBROUTINE. @V305032 00638200 EJECT 00638300 * MISCELLANEOUS CONSTANTS... 00639000 * 00640000 SYSUT DC CL5'SYSUT' (5 BYTES ARE ENOUGH) 00641000 * 00642000 ONE DC H'1' 00643000 HSIX DC H'6' 00644000 H25 DC H'25' @VA02374 00644500 ADDONLY DC A(X'FFFFFF') (TO ISOLATE ADDRESS-BITS ONLY) 00645000 * 00646000 DS 0D V0040 00648100 DIE DC X'00020000',A(*) DISABLED PSW TO DIE @VM03061 00651000 SPACE 00651100 LTORG OTHER CONSTANTS: @V305032 00651200 EJECT 00652000 NUCON 00653000 DIOSECT @VA00895 00653100 FVS 00654000 SCRATCH EQU DISK$SEG+24 SCRATCH-AREA 00656000 TFINSV EQU RWFSTRG DISK-ADDRESS SAVED HERE (IF NECESSARY) 00657000 FINFLG EQU TFINSV+2 (FOR NOW) 00658000 * 00659000 EFIN EQU X'80' INDICATES 'EFINIS' CALL. 00660000 TFIN EQU X'40' INDICATES 'TFINIS' CALL. 00661000 ALL EQU X'20' ALL NAMES, TYPES, AND/OR MODES 00662000 YES EQU X'10' YES, WE CLOSED SOMETHING. 00663000 SPC EQU X'08' SPECIAL FLAG-BIT FOR 'FINIS' LOGIC 00664000 ALLNT EQU X'04' ALL NAMES & ALL TYPES WANTED @VA01100 00664100 TWELVE EQU 12 @V305066 00664110 SIGN EQU X'F0' @V305066 00664120 T2314 EQU X'08' 2314 DEVICE TYPE HRC004DS 00664220 SENSB6 EQU 6 SENSE BYTE COUNT FOR 2314 HRC004DS 00664320 SENSB24 EQU 24 FOR 3330, 3350 HRC004DS 00664420 SENSB32 EQU 32 FOR 3380 HRC004DS 00664520 * 00665000 END$FIN EQU FINFLG+1 END OF FINIS INFORMATION 00666000 * 00667000 JCNT1 EQU END$FIN-REGSAV3 NO. OF BYTES TO SAVE IF ERASE CALLED 00668000 JCNT2 EQU (JCNT1+26+7)/8 NO. OF DBL-WORDS FREE STORAGE NEEDED 00669000 EJECT 00670000 AFT (R11) 00671000 FSTB (R10) 00673000 ADT (R9) 00675000 REGEQU 00677000 END 00678000