ibm:vm370-lib:cms:dmsfns.assemble_src
Table of Contents
DMSFNS Source
References
- Fixes Applied : 2
- This Source Date : Tuesday, December 12, 1978
- Last Fix ID : [HRC015DS]
Source Listing
- DMSFNS.ASSEMBLE.txt
- 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
ibm/vm370-lib/cms/dmsfns.assemble_src.txt · Last modified: 2023/08/06 13:35 by Site Administrator