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