ibm:vm370-lib:cms:dmslfs.assemble_src
Table of Contents
DMSLFS Source
References
- Fixes Applied : 2
- This Source Date : Tuesday, December 12, 1978
- Last Fix ID : [R14929DS]
Source Listing
- DMSLFS.ASSEMBLE.txt
- LFS TITLE 'DMSLFS (CMS) VM/370 - RELEASE 6' 00001000
- SPACE 2 00002000
- *. 00003000
- * MODULE NAME: 00004000
- * 00005000
- * DMSLFS 00006000
- * 00007000
- * SUBROUTINE NAME: 00008000
- * 00009000
- * DMSLFS (FSTLKP) 00010000
- * 00011000
- * FUNCTION: 00012000
- * 00013000
- * TO FIND A SPECIFIED 40-BYTE FST ENTRY WITHIN THE FST 00014000
- * TABLES FOR READ-ONLY OR READ-WRITE DISK(S). 00015000
- * 00016000
- * ATTRIBUTES: 00017000
- * 00018000
- * NUCLEUS RESIDENT, REENTRANT 00019000
- * 00020000
- * ENTRY POINTS: 00021000
- * 00022000
- * DMSLFS 00023000
- * 00024000
- * ENTRY CONDITIONS: 00025000
- * 00026000
- * L R15,AFSTLKP WHERE AFSTLKP=V(DMSLFS) 00027000
- * BALR R14,R15 00028000
- * 00029000
- * 1. TO SEARCH APPROPRIATE DISK TABLE(S) FROM THE 00030000
- * BEGINNING: 00031000
- * 00032000
- * R0 = IMMATERIAL 00033000
- * R1 = POINTER TO USUAL P-LIST (WITH SIGN-BIT PLUS): 00034000
- * 00035000
- * DS 0F 00036000
- * PLIST DC CL8' ' IMMATERIAL 00037000
- * DC CL8' ' FILENAME OR '*' 00038000
- * DC CL8' ' FILETYPE OR '*' 00039000
- * DC CL2' ' FILEMODE OR '*' 00040000
- * 00041000
- * 2. TO SEARCH APPROPRIATE DISK TABLE(S), PICKING UP 00042000
- * FROM WHERE YOU LEFT OFF PREVIOUSLY, STARTING 00043000
- * WITH NEXT 40-BYTE FST ENTRY: 00044000
- * 00045000
- * R0 = POINTER TO ACTIVE DISK TABLE 00046000
- * R1 = POINTER TO USUAL P-LIST BUT WITH SIGN-BIT NEGATIVE 00047000
- * 00048000
- * EXIT CONDITIONS: 00049000
- * 00050000
- * FILE FOUND: 00051000
- * 00052000
- * R0 = POINTER TO ACTIVE DISK TABLE 00053000
- * R1 = POINTER TO (ADDRESS OF) 40-BYTE FST ENTRY FOUND 00054000
- * R15 = 0 (AND CONDITION-CODE = 0) 00055000
- * 00056000
- * FILE NOT FOUND: 00057000
- * 00058000
- * R0 = 0 00059000
- * R1 = 0 (WITH SIGN-BIT NEGATIVE) 00060000
- * R15 = 1 (AND CONDITION-CODE = 2) 00061000
- * R15= 80,81,82,83 ERROR ACCESSING OSFST FOR OS DISK 00061100
- * 00062000
- * PARAMETER LIST ERROR: 00063000
- * 00064000
- * R0 = 0 00065000
- * R1 = 0 (WITH SIGN-BIT NEGATIVE) 00066000
- * R15 = 2 (AND CONDITION-CODE = 2) 00067000
- * 00068000
- * CALLS TO OTHER ROUTINES: 00069000
- * 00070000
- * DMSLAD, DMSLADN, DMSROS 00071000
- * 00072000
- * EXTERNAL REFERENCES: 00073000
- * 00074000
- * ADTSECT, FVSECT 00075000
- * 00076000
- * TABLES/WORKAREAS 00077000
- * 00078000
- * NONE 00079000
- * 00080000
- * REGISTER USAGE: 00081000
- * 00082000
- * R13 FVSECT 00083000
- * R12 BASE 00084000
- * REST WORK 00085000
- * 00086000
- * OPERATION: 00087000
- * 00088000
- * DMSLFS CHECKS TO ENSURE THAT R1 IS NOT ZERO (A 00089000
- * CALLING ERROR), AND INITIALIZES 00090000
- * TO TEST FOR EITHER A READ-ONLY OR READ-WRITE DISK. 00091000
- * THEN THE PARAMETER LIST IS CHECKED TO ENSURE THAT THE 00092000
- * FILENAME AND FILETYPE ARE PRESENT (CALLING ERROR IF 00093000
- * NOT), AND CHECKS TO SEE IF THE MODE-LETTER IS 00094000
- * ALPHABETIC, AND IF SO WHETHER A MODE-NUMBER IS GIVEN. 00095000
- * 00096000
- * IF THE MODE IS ALPHABETIC, DMSLAD IS CALLED TO CHECK 00097000
- * FOR A DISK WHOSE MODE-LETTER 00098000
- * ADTM MATCHES THE PARAMETER LIST. IF THE MODE IS *-* 00099000
- * OR EQUIVALENT (NOT ALPHABETIC), DMSLADN IS CALLED TO 00100000
- * CHECK FOR ANY AVAILABLE DISK. AN ERROR RETURN FROM 00101000
- * DMSLAD OR DMSLADN TRIGGERS A 'FILE NOT FOUND' RETURN 00102000
- * FROM DMSLFS. ON A SUCCESSFUL RETURN, DMSLFS CHECKS TO 00103000
- * MAKE SURE THE DISK FOUND IS LOGGED IN 00104000
- * (AS EITHER READ-ONLY OR READ-WRITE OR IF DMSLFS WAS 00105000
- * CALLED BY DMSSTT, OS READ ONLY). IF NOT, THE 00105100
- * LOGIC CONTINUES AS DESCRIBED BELOW, WHERE THE GIVEN 00106000
- * FST ENTRY WAS NOT FOUND ON THE DISK. 00107000
- * IF THE DISK IS AN OS DISK, DMSLFS CALLS ROSSTT IN 00107050
- * DMSROS TO VERFIY THAT THE DATA SET EXISTS AND THAT THE 00107100
- * ATTRIBUTES OF THE DATA SET ARE SUPPORTED. UPON RETURN 00107150
- * FROM DMSROS, A RETURN CODE OF 88 INDICATES THAT 00107200
- * THE DATA SET WAS NOT FOUND AND DMSLFS INITIATES THE 00107250
- * SEARCH AGAIN USING THE NEXT DISK IN ORDER. ANY OTHER 00107300
- * ERRORS SUCH AS RETURN CODE 80 CAUSE DMSLFS TO EXIT 00107350
- * IMMEDIATELY. 00107400
- * 00107450
- * A RETURN CODE OF 0 FROM DMSROS INDICATES THAT THE DATA 00107500
- * SET WAS FOUND ON THE SPECIFIED DISK AND DMSLFS CONTINUES 00107550
- * AS IT DOES WHEN A CMS FST IS FOUND. 00107600
- * 00108000
- * IF THE DISK FOUND BY DMSLAD OR DMSLADN IS LOGGED IN, 00109000
- * DMSLFS CHECKS THROUGH THE VARIOUS 00110000
- * FST HYPERBLOCKS IN CORE TO FIND A MATCHING FST ENTRY 00111000
- * FOR THE FILENAME (IF GIVEN IN THE PARAMETER LIST) AND 00112000
- * FILETYPE (IF GIVEN). NOTE - IF R1 WAS NEGATIVE AT 00113000
- * ENTRY TO DMSLFS, SEARCHING FOR THE GIVEN FST RESUMES 00114000
- * FROM THE POINT LAST SEARCHED, AS INDICATED BY 00115000
- * THE ADTCHBA (CURRENT HYPERBLOCK ADDRESS) AND ADTCFST 00116000
- * (CURRENT FST ENTRY DISPLACMENT) POINTERS IN THE 00117000
- * ACTIVE DISK TABLE FOR THE GIVEN DISK. 00118000
- * 00119000
- * IF THE FILENAME AND FILETYPE ARE BOTH GIVEN AND MATCH 00120000
- * EXPLICITLY, THE FILE IS DEEMED 'FOUND' IRRESPECTIVE 00121000
- * OF ANY MODE-NUMBER IN THE PARAMETER LIST. IF EITHER 00122000
- * (OR BOTH) WAS '*' IN THE PARAMETER LIST, HOWEVER, AND 00123000
- * THE MODE-NUMBER WAS GIVEN, THEN THE MODE-NUMBER IN 00124000
- * THE PARAMETER LIST MUST MATCH THE MODE-NUMBER IN THE 00125000
- * FST ENTRY. 00126000
- * 00127000
- * THUS, FOR EXAMPLE, A CALL TO DMSLFS FOR "SOME FILE 00128000
- * A5" WOULD CONSIDER "SOME FILE A1" 00129000
- * (ON THE A-DISK) A MATCH EVEN THOUGH THE MODE-NUMBER 00130000
- * IS WRONG. (THIS LOGIC IS PURPOSELY PROVIDED TO AVOID 00131000
- * MISLEADING THE USER, SINCE YOU CANNOT HAVE TWO FILES 00132000
- * ON THE SAME DISK WITH SAME FILENAME AND FILETYPE, BUT 00133000
- * DIFFERENT MODE NUMBERS.) A SEARCH FOR "* FILE A5", 00134000
- * HOWEVER, WOULD NOT CONSIDER "SOME FILE A1" TO MATCH, 00135000
- * SINCE THE MODE NUMBER DIFFERS. 00136000
- * 00137000
- * (NOTE - THIS LOGIC IS NOW CONSISTENT THROUGHOUT CMS. 00138000
- * THAT IS, IF THE FILENAME AND FILETYPE MATCH 00139000
- * EXPLICITLY, THE MODE NUMBER NEED NOT BE CORRECT FOR A 00140000
- * MATCH; BUT IF THE FILENAME AND/OR FILETYPE IS '*' AND 00141000
- * THE MODE-NUMBER IS GIVEN, THEN IT MUST EQUAL THE FST 00142000
- * MODE-NUMBER TO BE CONSIDERED A MATCH.) 00143000
- * 00144000
- * IF DMSLFS FINDS THE MATCHING FILE ON THE GIVEN DISK, 00145000
- * IT RETURNS THE ADDRESSES OF THE ACTIVE 00146000
- * DISK TABLE (ADT) AND THE FST ENTRY IN R0 AND R1 AS 00147000
- * SHOWN IN EXIT CONDITIONS, AND REMEMBERS WHERE IT 00148000
- * FOUND THE FILE IN THE ADTCHBA AND ADTCFST POINTERS IN 00149000
- * THE ADT BLOCK. 00150000
- * 00151000
- * FST ENTRY NOT FOUND ON THE DISK 00152000
- * 00153000
- * IF THE FST ENTRY WAS NOT FOUND ON THE DISK JUST 00154000
- * CHECKED, DMSLFS CHECKS THE MODE SUPPLIED IN THE 00155000
- * P-LIST. IF IT WAS '*' (OR EQUIVALENT), DMSLADN IS 00156000
- * CALLED AND THE NEXT 00157000
- * DISK (IF ANY) IS CHECKED AS ABOVE FOR THE MATCHING 00158000
- * FILE. 00159000
- * 00160000
- * IF THE MODE, ON THE OTHER HAND, WAS ALPHABETIC, 00161000
- * DMSLADN IS CALLED TO DETERMINE IF ANOTHER 00162000
- * DISK IS AVAILABLE FOR CHECKING. IF SO, THE ADTMX 00163000
- * EXTENSION-MODE-LETTER IS CHECKED TO SEE IF IT MATCHES 00164000
- * THE MODE GIVEN IN THE PARAMETER LIST. IF IT MATCHES, 00165000
- * THIS INDICATES THAT THE NEW DISK IS A READ-ONLY 00166000
- * EXTENSION OF THE ONE PREVIOUSLY CHECKED, AND THE 00167000
- * GIVEN FILE IS LOOKED UP ON THIS DISK. IF FOUND, 00168000
- * SUCCESSFUL RETURN IS GIVEN POINTING TO THIS DISK AND 00169000
- * THE FST ENTRY FOUND. IF NOT, THIS PROCESS IF 00170000
- * REPEATED UNTIL A MATCH IS FOUND, OR UNTIL NO MORE 00171000
- * DISK(S) WITH A MATCHING ADTMX LETTER ARE FOUND. 00172000
- * 00173000
- * DMSLFS (FSTLKP) 00174000
- * 00175000
- * SUBROUTINE: 00176000
- * 00177000
- * DMSLFSW (FSTLKW) 00178000
- * 00179000
- * FUNCTION: 00180000
- * 00181000
- * TO FIND A SPECIFIED 40-BYTE FST ENTRY WITHIN THE FST 00182000
- * TABLES FOR READ-WRITE 00183000
- * DISK(S); ALSO, TO FIND AN EMPTY 40-BYTE ENTRY FOR USE 00184000
- * BY DMSFNS. 00185000
- * 00186000
- * ATTRIBUTES: 00187000
- * 00188000
- * NUCLEUS RESIDENT, REENTRANT 00189000
- * 00190000
- * ENTRY CONDITIONS: 00191000
- * 00192000
- * L R15,AFSTLKW WHERE AFSTLKW=V(DMSLFSW) 00193000
- * BALR R14,R15 00194000
- * 00195000
- * 1. TO SEARCH APPROPRIATE DISK TABLE(S) FROM THE 00196000
- * BEGINNING: 00197000
- * 00198000
- * R0 = IMMATERIAL 00199000
- * R1 = POINTER TO USUAL P-LIST (WITH SIGN-BIT PLUS) 00200000
- * DS 0F 00201000
- * PLIST DC CL8' ' IMMATERIAL 00202000
- * DC CL8' ' FILENAME OR '*' 00203000
- * DC CL8' ' FILETYPE OR '*' 00204000
- * DC CL2' ' FILEMODE OR '*' 00205000
- * 00206000
- * 2. TO SEARCH APPROPRIATE DISK TABLE(S) PICKING UP 00207000
- * FROM WHERE YOU LEFT OFF PREVIOUSLY, STARTING 00208000
- * WITH NEXT 40-BYTE FST ENTRY: 00209000
- * 00210000
- * R0 = POINTER TO ACTIVE DISK TABLE 00211000
- * R1 = POINTER TO USUAL P-LIST BUT WITH SIGN-BIT NEGATIVE 00212000
- * 00213000
- * 3. TO FIND AN EMPTY 40-BYTE ENTRY FOR A COMPLETED NEW 00214000
- * OUTPUT FILE (CALLED ONLY BY 'FINIS') 00215000
- * 00216000
- * R0 = POINTER TO ACTIVE DISK TABLE 00217000
- * R1 = 0 00218000
- * 00219000
- * EXIT CONDITIONS: 00220000
- * 00221000
- * FILE FOUND: 00222000
- * 00223000
- * R0 = POINTER TO ACTIVE DISK TABLE 00224000
- * R1 = POINTER TO (ADDRESS OF) 40-BYTE FST ENTRY 00225000
- * FOUND OR PROVIDED 00226000
- * R15 = 0 (AND CONDITION-CODE = 0) 00227000
- * 00228000
- * FILE NOT FOUND: 00229000
- * 00230000
- * R0 = 0 00231000
- * R1 = 0 (WITH SIGN-BIT NEGATIVE) 00232000
- * R15 = 1 (AND CONDITION-CODE = 2) 00233000
- * 00234000
- * PARAMETER LIST ERROR: 00235000
- * 00236000
- * R0 = 0 00237000
- * R1 = 0 (WITH SIGN-BIT NEGATIVE) 00238000
- * R15 = 2 (AND CONDITION-CODE = 2) 00239000
- * 00240000
- * CALLS TO OTHER ROUTINES: 00241000
- * 00242000
- * DMSLAD, DMSLADN, DMSFREE 00243000
- * 00244000
- * EXTERNAL REFERENCES: 00245000
- * 00246000
- * ADTSECT, FVSECT 00247000
- * 00248000
- * TABLES/WORKAREAS: 00249000
- * 00250000
- * 808 BYTE HYPEBLOCK AREA 00251000
- * 00252000
- * REGISTER USAGE: 00253000
- * 00254000
- * R12 BASE 00255000
- * R13 FVSECT 00256000
- * REST WORK 00257000
- * 00258000
- * OPERATION: 00259000
- * 00260000
- * DMSLFSW CHECKS TO SEE IF R1 = 0, INDICATING A SPECIAL 00261000
- * ENTRY MADE BY DMSFNS TO FIND 00262000
- * AN EMPTY 40-BYTE FST ENTRY, OR THE REGULAR ENTRIES 00263000
- * MADE TO LOCATE A SPECIFIC FILE. 00264000
- * 00265000
- * IF R1 IS NONZERO, DMSLFSW CHECKS THE SPECIFIC 00266000
- * READ-WRITE DISK (IF THE MODE LETTER 00267000
- * WAS ALPHABETIC) OR ALL READ-WRITE DISKS (IF THE MODE 00268000
- * LETTER WAS '*' OR EQUIVALENT) 00269000
- * FOR THE GIVEN FILE. THIS SEARCH IS ALMOST IDENTICAL 00270000
- * TO THAT PERFORMED BY DMSLFS, 00271000
- * EXCEPT THAT ONLY READ-WRITE DISK(S) ARE EXAMINED, AND 00272000
- * READ-ONLY EXTENSION(S) VIA THE ADTMX MODE LETTER ARE 00273000
- * NOT APPLICABLE. (SEE FSTLKP DESCRIPTION FOR 00274000
- * DETAILS.) 00275000
- * 00276000
- * IF R1 = 0, THE LOCATION OF THE LAST FILE IS 00277000
- * DETERMINED FROM THE ADTLHBA AND ADTLFST POINTERS IN 00278000
- * THE GIVEN ACTIVE DISK TABLE. IF THE 40-BYTE ENTRY AT 00279000
- * THIS LOCATION IS EMPTY (=0), ITS ADDRESS IS RETURNED. 00280000
- * IF NOT, A CHECK IS MADE TO SEE IF THE NEXT 40-BYTE 00281000
- * ENTRY IN THE SAME IN-CORE HYPERBLOCK IS AVAILABLE; 00282000
- * IF YES, ITS ADDRESS IS RETURNED AND THE ADTLFST 00283000
- * POINTER UPDATED BY 40. IF NOT, THEN A NEW 808-BYTE 00284000
- * BLOCK IS OBTAINED FROM FREE STORAGE, CLEARED, CHAINED 00285000
- * TO THE END OF THE LAST FST HYPERBLOCK, ALL 00286000
- * APPROPRIATE POINTERS AND COUNTERS UPDATED, AND THE 00287000
- * ADDRESS OF THE FIRST 40-BYTE ENTRY IN THE NEW BLOCK 00288000
- * RETURNED TO THE CALLER. 00289000
- * 00290000
- * IN ANY EVENT, THE EMPTY 40-BYTE ENTRY IS MADE 00291000
- * AVAILABLE TO THE CALLER (DMSFNS), AND 00292000
- * ALL COUNTERS AND POINTERS UPDATED INSOFAR AS 00293000
- * NECESSARY. 00294000
- * 00295000
- * NOTE: DMSLFSW IS INCLUDED WITH THE DMSLFS ROUTINE. 00296000
- * 00297000
- *. 00298000
- EJECT 00299000
- DMSLFS CSECT 00300000
- USING NUCON,R0 00301000
- ENTRY TYPSRCH QUICK FILETYPE SEARCH SUBROUTINE 00302000
- ENTRY FSTLKP,FSTLKW ***** REMOVE ***** 00303000
- ENTRY DMSLFSO,DMSLFSOW,DMSLFSW 00304000
- SPACE 00305000
- USING *,R15 00306000
- B LKP 00307000
- SPACE 00308000
- * THE FOLLOWING IS POINTED TO BY AFSTLKP IN NUCON 00309000
- DMSLFSO EQU * 00310000
- FSTLKP EQU * 00311000
- SVCENT LKP,SVLFS 00312000
- SPACE 00313000
- * THE FOLLOWING IS POINTED TO BY AFSTLKW IN NUCON. 00314000
- DMSLFSOW EQU * 00315000
- FSTLKW EQU * 00316000
- SVCENT LKW,SVLFS 00317000
- * 00318000
- EXTRN FVS 00319000
- * 00320000
- * ENTER 'FSTLKP' HERE ... 00321000
- LKP EQU * 00322000
- FSENTR DISK$SEG USE FREE STORAGE AT BEGINNING OF DISK$SEG 00323000
- LA R10,ADTFRO+ADTFRW SET R10 FOR READ-ONLY OR READ-WRITE 00324000
- LA R12,FSTL00 SET R12 FOR COMMON ADDRESSABILITY 00325000
- USING FSTL00,R12 ... 00326000
- LTR R2,R1 SAVE R1 IN R2 AND SET CONDITION-CODE 00327000
- BNZ FSTL01 OK IF R1 WAS NONZERO, JOIN FORCES. 00328000
- B ERROR2 PARAMETER-LIST ERROR IF R1=0 FOR FSTLKP 00329000
- DROP R12,R13 00330000
- * 00331000
- DMSLFSW EQU * 00332000
- LKW EQU * 00333000
- FSENTR DISK$SEG 00334000
- FSTL00 EQU * (COMMON ADDRESSABILITY) 00335000
- LA R10,ADTFRW SET R10 FOR JUST READ-WRITE DISK(S) 00336000
- * (CMS AND OS/DOS DISKS) @VA14929 00336500
- LTR R2,R1 SAVE R1 IN R2 AND SET CONDITION-CODE 00337000
- BZ FINDZERO IF R1 = 0, GO FIND AN EMPTY ENTRY. 00338000
- * 00339000
- FSTL01 CLI PLTYP(R2),X'FF' FILENAME & TYPE MUST BE THERE 00340000
- BE ERROR2 PARAMETER-LIST ERROR IF FENCE INSTEAD. 00341000
- LR R11,R0 SAVE R0 IN R11 IN CASE NEEDED LATER 00342000
- SR R15,R15 CLEAR R15 00343000
- CLI PLTYP(R2),C'*' ALL FILETYPES WANTED ? 00344000
- BE JS1 TRF IF YES. 00345000
- LM R0,R1,PLTYP(R2) FILETYPE INTO R0-R1, 00346000
- LA R15,TYPSRCH CALL "TYPSRCH" TO SEE IF IT 00347000
- BALR R14,R15 IS A "POPULAR NAME BRAND" 00348000
- LR R1,R2 (RESTORE R1 - NEEDED BY ACTLKP BELOW) 00349000
- JS1 ST R15,REGSAV0 STORE 00 OR "INDEXED FLAG-BYTE". 00350000
- LA R9,FSTL40 SET 'SWITCH' FOR NO SPECIFIC MODE GIVEN 00351000
- CLI PLMOD(R2),C'A' CHECK MODE FOR A LETTER OF ALPHABET 00352000
- BL LESSA CAREFUL IF LESS THAN A 00353000
- CLI PLMOD(R2),C'Z' OR 00354000
- BH MOREZ MORE THAN Z 00355000
- L R15,=V(DMSLAD) SET R15 TO POINT TO ADTLKP 00356000
- CLI PLMOD+1(R2),C'0' IS THERE A MODE NO. (FROM 0 UP) ? 00357000
- BL FSTL02 BL IF NOT (PRESUMABLY BLANK) 00358000
- LA R9,FSTL38 IF YES (0 UP), SET SWITCH TO CHECK MODE-NO 00359000
- * 00360000
- FSTL02 LTR R2,R2 CHECK PARAMETER-LIST POINTER, 00361000
- BP FSTL04 IF PLUS, GO CALL ADTLKP 00362000
- USING ADTSECT,R11 REFERENCE ACTIVE DISK TABLE 00363000
- LM R4,R5,ADTCHBA R4 = A(CURRENT HYPERBLOCK), 00364000
- AR R5,R4 R5 NOW = A(CURRENT FST-ENTRY) 00365000
- B FSTL06 JOIN CODE BELOW. 00366000
- * 00367000
- FSTL03 TM ADTFLG1,*-* CHECK FOR READ-ONLY AND/OR READ-WRITE DISK 00368000
- * 00369000
- FSTL04 BALR R14,R15 CALL 'ADTLKP' (OR 'ADTNXT') 00370000
- BNZ NOTFOUND GIVE UP IF COULDN'T FIND DISK-TABLE 00371000
- LR R11,R1 IF OK, LET R11 POINT TO ACTIVE-DISK-TABLE 00372000
- FSTL04A SR R4,R4 R4=0 MEANS 'START AT BEGINNING' 00373000
- EX R10,FSTL03 CHECK FOR READ-ONLY AND/OR READ-WRITE DISK 00374000
- BNZ FSTL04B BRANCH IF ONE OF THE ABOVE @V201105 00375100
- TM ADTFLG2,ADTFROS IS THIS AN OS DISK? @V201105 00375150
- BNO FSTL23 NO, CONTINUE SEARCH @V201105 00375200
- CLC DISK$SEG+R14*4+1(3),VDMSSTTR+1 CALLED BY STT ? @V201105 00375250
- BNE FSTL23 CONTINUE SEARCH @V201105 00375300
- CH R10,=X'0020' IS R10 SET FOR JUST R/W DISKS ? @VA14929 00375310
- BNE FSTL04B NO - SKIP OS R/W SEARCH @VA14929 00375320
- CLI ADTFLG3,ADTFRWOS IS THIS AN OS R/W DISK ?? @VA14929 00375330
- BNE FSTL23 NO - CONTINUE SEARCH @VA14929 00375340
- FSTL04B EQU * @V201105 00375350
- CLI PLMOD(R2),ALLBUT WERE ALL DISKS BUT THIS ONE WANTED ? 00377000
- BE JS2 TRF IF YES - "ALLBUT" SPECIFIED. 00378000
- CLI ADTM,C'S' IS THIS THE S-DISK ? 00379000
- BE CKOPTN YES, CHECK SPECIAL OPTIONS @VA11527 00379100
- CLI ADTMX,C'S' IS IT EXTENSION OF S DISK @VA11527 00379200
- BNE FSTL06 TRF IF NOT - WE'RE ALL SET. 00380000
- CKOPTN EQU * @VA11527 00380100
- CLI PLMOD(R2),FIRSTUSR IF YES, WAS "FIRSTUSR" WANTED ? 00381000
- BE FSTL23 YES, SKIP 'S' DISK SEARCH @VA11527 00382000
- CLC ALLUSERD,PLMOD(R2) OR "ALL USER DISKS" ? 00383000
- BNE FSTL06 TRF IF NOT - GO SEARCH S-DISK. 00384000
- B FSTL23 YES, SKIP 'S' DISK SEARCH @VA11527 00385000
- * 00386000
- JS2 CLC ADTM,PLMOD+1(R2) FOR "ALLBUT" IS THIS THE 00387000
- BE FSTL23 FORBIDDEN DISK - SKIP IT IF YES. 00388000
- * 00389000
- FSTL06 TM ADTFLG2,ADTFROS OS ADT @V201105 00390010
- BNO FSTL06A NO @V201105 00390020
- L R15,ADMSROS CALLL DMSROS TO SEARCH OS DISK @V201105 00390030
- BAL R14,4(R15) SECOND ENTRY POINT IN DMSROS @V201105 00390040
- CH R15,=H'88' DATA SET NOT FOUND @V201105 00390050
- BE FSTL23 YES, TIME FOR ANOTHER ADT @V201105 00390060
- LTR R15,R15 OTHER ERROR @V201105 00390070
- BNZ FSTL41A YES @V201105 00390080
- LR R1,R5 OS FST ADDR TO R1 @V201105 00390090
- B FSTL41 FOUND @V201105 00390100
- FSTL06A L R15,REGSAV0 CHECK SPECIAL INDEX FLAG BYTE @V201105 00390110
- LTR R15,R15 ... 00391000
- BZ FSTL07 IF = 0, WE'LL HAVE TO CHECK THIS DISK. 00392000
- TM ADTFLG2,ADTPSTM FST CHAIN MODIFIED BY AUX DIR @VA05274 00392065
- BO FSTL07 YES, HAVE TO DO FRUITFUL SEARCH @VA05274 00392130
- N R15,ADTFTYP-3 DOES THIS DISK HAVE A MATCHING FILETYPE? 00393000
- BZ FSTL20 TRF IF NOT (SAVE TIME OF FRUITLESS SEARCH) 00394000
- FSTL07 LA R6,40 40 INTO R6 FOR GENERAL USE 00395000
- LM R0,R1,PLNAM(R2) FILENAME INTO R0-R1, 00396000
- L R3,ADTFDA GET ADDRESS OF FIRST HYPERBLOCK @V305032 00397250
- L R8,FOUR(,R3) AND SIZE OF BLOCK (E.G. 800) @V305032 00397500
- SR R8,R6 LESS 40 = LIMIT FOR BXLE @V305032 00397750
- ST R8,REGSAV0+FOUR SAVE R8 IN LOW-LEVEL SAVE AREA @V305032 00398000
- CLI PLNAM(R2),C'*' IS NAME '*' MEANING ACCEPT ANY ? 00399000
- BE FSTL08 YES - GO CHECK FILETYPE ALSO @V305032 00400200
- LA R15,FSTL16 NO - SET R15 TO CHECK FILENAME @V305032 00400400
- CLI PLTYP(R2),STAR WAS "ANY" FILETYPE ACCEPTABLE ? @V305032 00400600
- BE FSTL09 YES - GO SET R14 ACCORDINGLY. @V305032 00400800
- * FILENAME AND FILETYPE ARE BOTH SPECIFIC: 00401000
- LA R14,FSTL18 SET R14 TO CHECK FILETYPE @V305032 00401200
- TM ADTFLG3,ADTFSORT ARE FST'S ON THE DISK SORTED ? @V305032 00401400
- BZ FSTL10 NO - DO IT "THE OLD WAY" @V305032 00401600
- TM ADTFLG2,ADTPSTM FST CHAIN MODIFIED BY AUX. DIR.@VA04896 00401665
- BO FSTL10 YES, HAVE TO DO IT THE OLD WAY @VA04896 00401730
- LTR R4,R4 STARTING AT BEGINNING ? @V305032 00401800
- BZ FSTLFAST YES - OK TO USE FAST SEARCH. @V305032 00402000
- B FSTL11 NO - PICK UP WHERE WE LEFT OFF. @V305032 00402200
- SPACE 00402400
- * FILENAME = '*' - CHECK FILETYPE: 00402600
- FSTL08 LA R15,FSTL18 SET R15 TO ACCEPT ANY FILENAME @V305032 00402800
- CLI PLTYP(R2),STAR IS FILETYPE ALSO '*' = "ANY" ? @V305032 00403000
- BNE FSTL10 NO - R15 OK; R14 IMMATERIAL. @V305032 00403200
- * FILENAME AND FILETYPE ARE BOTH '*': 00403400
- LA R15,FSTL36 SET R15 FOR ANY FILENAME & TYPE @V305032 00403600
- B FSTL10 (R14 IS IMMATERIAL) GO CHECK R4. @V305032 00403800
- * FILENAME = SPECIFIC, BUT FILETYPE = '*': 00404000
- FSTL09 LA R14,FSTL36 SET R14 TO ACCEPT ANY FILETYPE @V305032 00404200
- FSTL10 EQU * CONTINUE (R14 & R15 ALL SET): @V305032 00404400
- LTR R4,R4 START AT BEGINNING OR WHERE WE LEFT OFF ? 00409000
- BZ FSTL12 BZ IF START AT BEGINNING. 00410000
- FSTL11 LA R7,0(R4,R8) R4 + R8 INTO R7 FOR BXLE-LIMIT, @V305032 00411100
- SR R8,R8 R8=0 (TO CHECK FOR NULL FILE) 00412000
- LA R3,BXLE56 SET R3 FOR BCR'S IN LOOP, AND JUMP INTO 00413000
- BR R3 LOOP AT BXLE56 TO START WITH 'NEXT' ENTRY 00414000
- * 00415000
- DS 0D (FORCE MAIN SEARCH LOOP DBL-WORD ALIGNED) 00416000
- * 00417000
- FSTL12 LA R5,8(,R3) START AT BEGINNING OF INFORMATION 00418000
- FSTL13 LR R4,R5 REMEMBER BEGINNING OF CURRENT BLOCK 00419000
- LA R7,0(R5,R8) R7 POINTS TO LAST ITEM. 00420000
- SR R8,R8 R8=0 (TO CHECK FOR NULL FILE) 00421000
- LA R3,BXLE56 SET R3 FOR BCR'S IN LOOP. 00422000
- * 00423000
- * MAIN SEARCH-LOOP ... 00424000
- FSTL15 C R8,0(,R5) IS NAME = 0 (NULL FILE) ? 00425000
- BCR 8,R3 'BE BXLE56' IF YES (FORGET THIS ONE). 00426000
- BR R15 ACCEPT NAME IF '*' WAS GIVEN, OR ... 00427000
- FSTL16 CL R0,0(,R5) DOES NAME (1ST HALF) MATCH ? 00428000
- BCR 7,R3 TRF TO BXLE56 IF NOT. 00429000
- CL R1,4(,R5) IF YES, DOES 2ND HALF OF NAME MATCH ? 00430000
- BCR 7,R3 'BNE BXLE56' IF NOT. 00431000
- FSTL17 BR R14 GO TO FSTL36 IF '*' WAS GIVEN, OR ... 00432000
- FSTL18 CLC PLTYP(8,R2),8(R5) DOES TYPE MATCH ? 00433000
- BE FSTL34 IF YES, WE'VE FOUND IT. 00434000
- BXLE56 BXLE R5,R6,FSTL15 ITERATE THRU CURRENT HYPERBLOCK 00435000
- LM R3,R4,0(R5) GET POINTER TO NEW HYPERBLOCK & NEXT WORD 00436000
- LTR R5,R3 (ALSO IN R5) AND CHECK ITS EXISTENCE 00437000
- BZ FSTL20 BZ IF NO MORE HYPERBLOCKS FOR THIS DISK. 00438000
- L R8,REGSAV0+4 RESTORE R8 (WE NEED IT AT FSTL13) 00439000
- TM ADTFLG1,ADTFFSTV ARE THEY VARIABLE LENGTH (SSTAT) ? 00440000
- BZ FSTL13 IF NOT, START WITH NEXT BLOCK FORTHWITH. 00441000
- FSTL19 L R8,FOUR(,R5) IF YES (SSTAT), GET NEW SIZE, @V305032 00442100
- SR R8,R6 (SUBTRACTING 40 FOR LAST ITEM FOR BXLE) 00443000
- LTR R4,R4 IS "STATEXT+4" = 0 ? 00444000
- BNP FSTL12 IF YES, SEARCH SSTAT-EXTENSIONS ON THIS DISK. 00445000
- LR R11,R4 BUT IF > 0, RESUME SEARCH WITH GIVEN DISK! 00446000
- B FSTL12 LET CODE AT FSTL12 ADD 8, ETC. 00447000
- * 00448000
- * IF MODE IS LESS THAN CHARACTER 'A' ... 00449000
- LESSA LA R14,FSTL05 (FOR BCR'S TO SAVE SPACE) 00450000
- CLI PLMOD(R2),00 00 IS ACCEPTABLE 00451000
- BCR 8,R14 'BE' IF 00 00452000
- CLI PLMOD(R2),C'*' ASTERISK ALSO OK 00453000
- BCR 8,R14 'BE' IF '*' 00454000
- CLI PLMOD(R2),C' ' BLANK ALSO OK 00455000
- BCR 8,R14 'BE' IF A BLANK 00456000
- CLI PLMOD(R2),ALLBUT ALLOW "ALLBUT" CHARACTER JS 00457000
- BCR 8,R14 ... 00458000
- CLI PLMOD(R2),C'(' LEFT PAREN OK DL 00459000
- BCR 8,R14 BE IF '(' DL 00460000
- ERROR2 EQU * ANYTHING ELSE = PARAMETER-LIST ERROR 00461000
- LA R15,2 MAKE THAT ERROR 2, AND 00462000
- B SR00 GO EXIT ON ERROR-RETURN. 00463000
- * 00464000
- MOREZ CLI PLMOD(R2),X'FF' IF MORE THAN Z, MUST BE X'FF' 00465000
- BE FSTL05 ... 00466000
- CLI PLMOD(R2),FIRSTUSR OR ALLOW "FIRSTUSR" CHARACTER JS 00467000
- BNE ERROR2 ERROR IF OTHERWISE. 00468000
- * 00469000
- FSTL05 SR R1,R1 START WITH FIRST ADT TABLE, 00470000
- L R15,=V(DMSLADN) SET R15 -> ADTNXT INSTEAD OF ADTLKP 00471000
- B FSTL02 NOW GO CHECK PARAMETER-LIST-POINTER. 00472000
- * 00473000
- * FILE-TYPE MATCHES EXPLICITLY ... 00474000
- FSTL34 CLI PLNAM(R2),C'*' WAS 'ANY' FILE-NAME WANTED ? 00475000
- BNE FSTL40 IF NOT, MATCH OF NAME & TYPE IS ENOUGH. 00476000
- FSTL36 EQU * IF NAME AND/OR TYPE WAS '*', CHECK MODE IF GIVEN 00477000
- BR R9 ACCEPT FILE IF MODE WASN'T GIVEN, OR 00478000
- FSTL38 CLC 25(1,R5),PLMOD+1(R2) DOES MODE-NUMBER MATCH P-LIST ? 00479000
- BCR 7,R3 'BNE BXLE56' IF IT DOES NOT. 00480000
- * 00481000
- * SUCCESS - WE FOUND DESIRED 40-BYTE ITEM. 00482000
- FSTL40 LR R1,R5 R1 = POINTER TO DESIRED 40-BYTE ITEM, 00483000
- SR R5,R4 DISPLACEMENT OF CURRENT ITEM, 00484000
- STM R4,R5,ADTCHBA STORE INFORMATION IN CASE RE-ENTERED 00485000
- FSTL41 LR R0,R11 R0 = POINTER TO ACTIVE DISK TABLE 00486000
- SR R15,R15 CLEAR RETURN CODE (& C.C.) 00487000
- FSTL41A LM R2,R14,GPR2 RETORE REGS 2-14 @V201105 00488100
- BR R14 AND RETURN TO CALLER. 00489000
- EJECT 00490000
- * COMES HERE IF FILE NOT FOUND ON A LOGGED-IN DISK: 00491000
- * 00492000
- FSTL20 DS 0H IF DESIRED 40-BYTE ITEM NOT FOUND IN CORE 00493000
- CLI PLMOD(R2),FIRSTUSR WAS "FIRST USER DISK" SPECIFIED ? 00494000
- BE NOTFOUND TRF IF YES - QUIT SEARCHING. 00495000
- LR R1,R11 START WITH PREVIOUS TABLE, 00496000
- FSTL23 L R15,=V(DMSLADN) CALL ADTNXT TO CHECK NEXT TABLE 00497000
- BALR R14,R15 ... 00498000
- BNZ NOTFOUND GIVE UP IF NO MORE TABLES 00499000
- LR R11,R1 IF OK, LET R11 POINT TO ACTIVE-DISK-TABLE 00500000
- CLI PLMOD(R2),C'A' WAS MODE SPECIFIED ? 00501000
- BL FSTL04A IF NOT, TRY THIS TABLE 00502000
- CLI PLMOD(R2),C'Z' (ALSO CHECK FOR > Z) 00503000
- BH FSTL04A ... 00504000
- CLC PLMOD+1(1,R2),PLMOD(R2) IS IT A "DOUBLE-LETTER" MODE ? 00505000
- BE NOTFOUND TRF IF YES - QUIT SEARCHING. 00506000
- CLC ADTMX,PLMOD(R2) IS IT AN EXTENSION ? 00507000
- BE FSTL04A WORTH TRYING IF YES 00508000
- BNE FSTL23 IF NOT, TRY NEXT TABLE (R1 ALREADY SET). 00509000
- SPACE 3 00510000
- * SPECIAL CONSTANTS AND EQUATES FOR DEFINING DISK-SEARCHING: 00511000
- * 00512000
- ALLUSERD DC C'*U' = "ALL USER DISKS" (FSTLKP) 00513000
- * OR "ALL READ-WRITE DISKS" (FSTLKW) 00514000
- * 00515000
- FIRSTUSR EQU C'1' = "FIRST USER DISK" (FSTLKP) 00516000
- * OR "FIRST READ-WRITE DISK" (FSTLKW) 00517000
- * 00518000
- ALLBUT EQU C'-' = "ALL DISKS EXECPT THIS ONE" 00519000
- * E.G. "-S" MEANS ALL DISKS EXCEPT S-DISK 00520000
- EJECT 00521000
- FINDZERO LR R11,R0 ACCESS ACTIVE DISK TABLE 00522000
- LA R5,1 GET A '1', 00523000
- LM R2,R3,ADTLHBA ACCESS LAST BLOCK AND ITEM 00524000
- AR R3,R2 ADDRESS OF LAST ITEM 00525000
- CL R1,0(,R3) IS IT EMPTY (E.G. FROM PREVIOUS ERASE) 00526000
- BE LR13 BE (BZ) IF YES, WE'RE ALL SET TO EXIT. 00527000
- LA R4,800(,R2) POINT R4 TO END OF BLOCK 00528000
- LA R3,40(,R3) ADVANCE 40 BYTES TO NEXT ITEM, 00529000
- CR R3,R4 ARE WE STILL WITHIN BLOCK ? 00530000
- BL LR13 BL IF YES, GOOD SHOW. 00531000
- DMSFREE DWORDS=101,TYPCALL=BALR,TYPE=NUCLEUS GET 800 BYTES 00532000
- LR R3,R1 REFERENCE IT VIA R3, 00533000
- XC 0(208,R3),0(R3) CLEAR 804 BYTES IN SAME 00534000
- MVC 208(200,R3),0(R3) ... 00535000
- MVC 408(200,R3),0(R3) ... 00536000
- MVC 608(196,R3),0(R3) ... 00537000
- ST R3,800(,R2) STORE POINTER TO THIS BLOCK IN OLD BLOCK, 00538000
- ST R2,804(,R3) AND BACKPOINTER TO OLD BLOCK IN THIS ONE. 00539000
- L R2,ADTHBCT ADD 1 TO FST HYPERBLOCK COUNT 00540000
- AR R2,R5 ... 00541000
- ST R2,ADTHBCT AND REPLACE. 00542000
- LH R2,ADTRES ADD 1 TO 00543000
- AR R2,R5 RESERVE-COUNT 00544000
- STH R2,ADTRES AND REPLACE 00545000
- LR R2,R3 R2 AND R3 POINT TO NEW BLOCK 00546000
- LR13 LR R1,R3 POINTER TO EMPTY ITEM INTO R1, 00547000
- SR R3,R2 R3 A DISPLACEMENT 00548000
- STM R2,R3,ADTLHBA STORE NEW LAST-BLOCK & ITEM INFO. 00549000
- * 00550000
- * INCREMENTING OF ADTFSTC (NO. OF FILES) REMOVED FROM HERE AND 00551000
- * PUT INTO WRBUF. NEEDS TO BE THERE IF ERASE IS TO DO THE RIGHT 00552000
- * THING WITH OPEN FILES. OTHERWISE ERASING OPEN FILES DECREMENTS 00553000
- * THE COUNT INDEFINITELY UNTIL EVENTUALLY WRBUF COMPLAINS. 00554000
- * 00555000
- B FSTL41 AND GO EXIT WITH R0 & R1 ALL SET UP. 00556000
- SPACE 3 00557000
- NOTFOUND LA R15,1 ERROR 1 = DISK-TABLE OR FILE NOT FOUND... 00558000
- SR00 SR R0,R0 CLEAR R0 00559000
- L R1,SB ZERO WITH SIGN-BIT ON INTO R1, 00560000
- LM R2,R14,GPR2 RESTORE R2 THRU R14, 00561000
- LTR R15,R15 SET CONDITION-CODE FOR CONVENIENCE OF CALLER 00562000
- BR R14 AND RETURN TO CALLER. 00563000
- EJECT 00566000
- *********************************************************************** 00567000
- * 00568000
- * "TYPSRCH" 00569000
- * 00570000
- * QUICK FILETYPE SEARCH SUBROUTINE 00571000
- * 00572000
- * CHECKS FILETYPE TO DETERMINE IF IT IS 00573000
- * ONE OF UP TO EIGHT HEAVILY USED FILETYPES. 00574000
- * IF SO, EXITS WITH INDEXED FLAG-BYTE. 00575000
- * 00576000
- * (CALLED BY FSTLKP, FINIS, READFST, & ALTER) 00577000
- * 00578000
- * CALLING SEQUENCE: 00579000
- * 00580000
- * R0-R1 (TOGETHER) HOLD FILETYPE 00581000
- * R13 = V(FVS) SAVE AREA 00582000
- * R15 = V(TYPSRCH) 00583000
- * 00584000
- * BALR R14,R15 00585000
- * 00586000
- * EXIT CONDITIONS: 00587000
- * 00588000
- * FILETYPE NOT FOUND IN TABLE: 00589000
- * R15 = 0 (AND CONDITION-CODE = 0) 00590000
- * 00591000
- * FILETYPE WAS FOUND IN TABLE: 00592000
- * R15 (BITS 24-31) HOLDS INDEXER TO WHICH FILETYPE FOUND 00593000
- * (I.E. = X'80', OR X'40', OR X'20', ETC.) 00594000
- * 00595000
- *********************************************************************** 00596000
- * 00597000
- USING *,R15 ADDRESSABILITY 00598000
- USING FVSECT,R13 (MUST BE IN EFFECT) 00599000
- TYPSRCH STM R3,R5,REGSAV0+12 SAVE R3-R5 IN LOW-LEVEL SAVE-AREA 00600000
- SR R3,R3 INITIALIZE R3-R4-R5 FOR BXLE LOOP 00601000
- LA R4,8 ... 00602000
- LA R5,(AFTRLAST-8-TYPTABLE) 00603000
- * 00604000
- CHKTYLP CL R0,TYPTABLE(R3) CHECK FILETYPE AGAINST TABLE 00605000
- BE CHEK2ND TRF IF AN APPARENT MATCH. 00606000
- BXLE R3,R4,CHKTYLP ITERATE LOOP 00607000
- * 00608000
- NTFND SR R5,R5 RETURN-CODE WILL = 0. 00609000
- * 00610000
- LTR155 LTR R15,R5 RETURN-CODE (0 OR FLAG) INTO R15, 00611000
- LM R3,R5,REGSAV0+12 RESTORE R3-R5 00612000
- BR R14 RETURN TO CALLER. 00613000
- * 00614000
- CHEK2ND CL R1,TYPTABLE+4(R3) CHECK 2ND HALF 00615000
- BNE NTFND IF NO MATCH, FORGET IT. 00616000
- SRL R3,3 DIVIDE TABLE-INDEXER BY 8, 00617000
- LA R5,X'80' START WITH X'80' 00618000
- SRL R5,0(R3) SHIFT 0, 1, .. , 7 PLACES 00619000
- B LTR155 GO PLACE R5 IN R15 AND EXIT. 00620000
- * 00621000
- TYPTABLE DS 0F TABLE OF HEAVILY USED FILETYPES (NO MORE THAN 8 !) 00622000
- DC CL8'EXEC' 1ST 00623000
- DC CL8'MODULE' 2ND 00624000
- DC CL8'MACLIB' ETC. 00625000
- DC CL8'TXTLIB' ... 00626000
- DC CL8'TEXT' 00627000
- DC CL8'ASSEMBLE' 00628000
- DC CL8'FORTRAN' 00629000
- DC CL8'PLI' 8TH (AND LAST). 00630000
- * 00631000
- * 00632000
- AFTRLAST EQU * (KEEP AFTER THE LAST ONE !!!) 00633000
- SPACE 00634100
- DROP R15 REVERT TO R12 ADDRESSABILITY @V305032 00635100
- EJECT 00636100
- * FILENAME AND FILETYPE ARE BOTH SPECIFIC; DISK IS ALL "SORTED", 00637100
- * AND WE'RE "STARTING AT THE BEGINNING" (R4 = 0): 00638100
- SPACE 00639100
- * ENTRY CONDITIONS: 00640100
- * R0-R1 HOLD FILENAME 00641100
- * R2 HOLDS POINTER TO ORIGINAL P-LIST 00642100
- * R3 = ADDRESS OF FIRST HYPERBLOCK 00643100
- * R4 = 0 00644100
- * R8 = SIZE OF <FIRST> BLOCK MINUS 40 00645100
- * R6 = 40 00646100
- SPACE 00647100
- * NOTE: SUPPORT CODE FOR THIS SECTION = @V305032 00648100
- SPACE 00649100
- FSTLFAST DS 0H DO A "FAST" SEARCH: @V305032 00650100
- LR R5,R8 BLOCK SIZE -40 INTO R5 WHERE NEEDED, @V305032 00651100
- STM R2,R5,REGSAV0+EIGHT SAVE R2 THRU R5 @V305032 00652100
- LA R4,EIGHT(,R3) LET R4 POINT TO 1ST BLOCK OF FSTS@V305032 00653100
- LM R2,R3,PLTYP(R2) GET FILETYPE INTO R2-R3 @V305032 00654100
- LA R14,FSTL51 SET R14 TO "GET THE NEXT BLOCK" @V305032 00655100
- LA R15,FSTL55 SET R15 TO "IN THE RIGHT BLOCK" @V305032 00656100
- TM ADTFLG1,ADTFFSTV VARIABLE LENGTH (E.G. "SSTAT") @V305032 00657100
- BOR R15 YES - GO TO FSTL55 TO LOOK AT 1 BLK. @V305032 00658100
- L R7,ADTHBCT NO - GET FST HYPERBLOCK COUNT @V305032 00659100
- BCT R7,FSTL50 LESS ONE & BRANCH IF THERE ARE > ONE @V305032 00660100
- B FSTL52 HANDLE ONE HYPERBLOCK AS IF THE LAST. @V305032 00661100
- SPACE 00662100
- DS 0D SEARCH ALL HYPERBLOCKS BUT THE LAST: @V305032 00663100
- * TIGHT LOOP TO NARROW THE FST DOWN TO THE RIGHT HYPERBLOCK: 00664100
- FSTL50 CL R0,FN1(R4,R5) CHECK FILENAME AGAINST LAST FST @V305032 00665100
- BNH FSTL60 IF NOT HIGH, CHECK FURTHER. @V305032 00666100
- FSTL51 L R4,FORTY(R4,R5) IF "HIGH", GET NEXT HYPERBLOCK @V305032 00667100
- BCT R7,FSTL50 AND KEEP LOOKING. @V305032 00668100
- * 00669100
- FSTL52 EQU * HANDLE LAST (OR ONLY) HYPERBLOCK: @V305032 00670100
- L R5,ADTLFST GET DISP. OF LAST FST IN LAST @V305032 00671100
- * HYPERBLOCK. CONTINUE ... 00672100
- SPACE 00673100
- * WE HAVE FOUND THE RIGHT BLOCK (OR THIS IS THE LAST OR ONLY BLOCK): 00674100
- FSTL55 AR R5,R6 TOTAL BLOCK SIZE INTO R5, @V305032 00675100
- BAL R8,BINSERCH TRY TO FIND THE FST ENTRY @V305032 00676100
- * RETURNS IF NOT FOUND ... 00677100
- LM R2,R5,REGSAV0+EIGHT RESTORE R2 THRU R5 @V305032 00678100
- TM ADTFLG1,ADTFFSTV VARIABLE LENGTH (E.G. "SSTAT")?@V305032 00679100
- BZ FSTL20 IF NOT, TRY NEXT DISK (IF ANY). @V305032 00680100
- LA R5,FORTY8(R3,R5) POINT TO END OF <SSTAT> BLOCK, @V305032 00681100
- LM R3,R4,0(R5) PNTRS TO NEW HYPERBLOCK & NEXT WORD @V305032 00682100
- LTR R5,R3 (ALSO IN R5) AND CHECK ITS EXISTENCE @V305032 00683100
- BZ FSTL20 IF 0, NO MORE HYPERBLOCKS FOR THIS DISK @V305032 00684100
- LA R15,FSTL16 SET R15 AND R14 AGAIN @V305032 00685100
- LA R14,FSTL18 (AS NEEDED), @V305032 00686100
- LA R6,FORTY RESTORE R6=40, AND @V305032 00687100
- B FSTL19 GO CHECK EXTENSION TO "SSTAT". @V305032 00688100
- EJECT 00689100
- * FST MAY POSSIBLY BE LOCATED IN THIS BLOCK: 00690100
- FSTL60 BLR R15 IF LESS, IT'S THE RIGHT BLOCK. @V305032 00691100
- CL R1,FN2(R4,R5) IF =, CHECK 2ND HALF OF FILENAME @V305032 00692100
- BLR R15 IF LESS, IT'S THE RIGHT BLOCK. @V305032 00693100
- BHR R14 IF MORE, GET THE NEXT BLOCK. @V305032 00694100
- CL R2,FT1(R4,R5) IF =, CHECK 1ST HALF OF FILETYPE @V305032 00695100
- BLR R15 IF LESS, IT'S THE RIGHT BLOCK. @V305032 00696100
- BHR R14 IF MORE, GET THE NEXT BLOCK. @V305032 00697100
- CL R3,FT2(R4,R5) IF =, CHECK 2ND HALF OF FILETYPE @V305032 00698100
- BLR R15 IF LESS, IT'S THE RIGHT BLOCK. @V305032 00699100
- BHR R14 IF MORE, GET THE NEXT BLOCK. @V305032 00700100
- LA R1,0(R4,R5) IF MATCH, RETURN ADDR OF FST ENTRY @V305032 00701100
- STM R4,R5,ADTCHBA STORE ADDRESS & DISP. IN CASE @V305032 00702100
- B FSTL41 RE-ENTERED AND "GO EXIT". @V305032 00703100
- SPACE 2 00704100
- * NEEDED EQUATES: 00705100
- STAR EQU C'*' ASTERISK MEANS 'ALL' @V305032 00706100
- ONE EQU 1 @V305032 00707100
- FOUR EQU 4 @V305032 00708100
- EIGHT EQU 8 @V305032 00709100
- FORTY EQU 40 LENGTH OF ONE FST ENTRY @V305032 00710100
- FORTY8 EQU 48 ABOVE + 8 @V305032 00711100
- FN1 EQU 0 1ST HALF OF FILENAME @V305032 00712100
- FN2 EQU 4 2ND HALF OF FILENAME @V305032 00713100
- FT1 EQU 8 1ST HALF OF FILETYPE @V305032 00714100
- FT2 EQU 12 2ND HALF OF FILETYPE @V305032 00715100
- EJECT 00716100
- * BINSERCH = BINARY SEARCH INTERNAL SUBROUTINE 00717100
- SPACE 00718100
- * ENTRY CONDITIONS: 00719100
- * R0-R1 HOLD FILENAME 00720100
- * R2-R3 HOLD FILETYPE 00721100
- * R4 = ADDRESS OF BLOCK TO BE SEARCHED 00722100
- * R5 = SIZE OF BLOCK TO BE SEARCHED (IN BYTES) 00723100
- * R8 = RETURN REGISTER 00724100
- SPACE 00725100
- * INTERNAL REGISTER USAGE 00726100
- * R0-R1 HOLD FILENAME 00727100
- * R2-R3 HOLD FILETYPE 00728100
- * R4 = ADDRESS OF BEGINNING OF BLOCK 00729100
- * R5 = "INDEXER" FOR SEARCHING THE BLOCK 00730100
- * R6 = "ADJUSTER" FOR BINARY SEARCH TECHNIQUE 00731100
- * R7 = COUNTER FOR BINARY SEARCH LOOP 00732100
- * R14 & R15 USED FOR WORK REGISTERS 00733100
- SPACE 00734100
- * EXIT CONDITIONS: 00735100
- * IF FILE WAS FOUND: 00736100
- * R1 HOLDS ADDRESS OF FST ENTRY FOUND 00737100
- * ADDRESS & DISPLACEMENT OF FST STORED IN ADTCHBA/ADTCFST 00738100
- * EXITS VIA CODE AT FSTL41. 00739100
- * IF FILE WAS NOT FOUND: 00740100
- * RETURNS VIA R8. 00741100
- * R0-R4 STILL INTACT 00742100
- * R5-R7 AND R14-R15 NOT PRESERVED 00743100
- SPACE 00744100
- * NOTE: SUPPORT CODE FOR THIS SUBROUTINE = @V305032 00745100
- SPACE 00746100
- DS 0D @V305032 00747100
- BINSERCH C R5,=F'800' BLOCK SIZE PERCHANCE = 800 ? @V305032 00748100
- BE BINSUB2 YES (QUITE LIKELY) - SET DEFAULTS@V305032 00749100
- LA R6,FORTY NO - START WITH ADJUSTER = FST SIZE, @V305032 00750100
- SR R7,R7 CLEAR "NUMBER OF TRIES" COUNTER @V305032 00751100
- LA R15,ONE NEED A "1" AVAILABLE @V305032 00752100
- BINSUB1 AR R6,R6 DOUBLE THE ADJUSTER @V305032 00753100
- AR R7,R15 INCREMENT "NUMBER OF TRIES" COUNTER @V305032 00754100
- CR R6,R5 COMPARE WITH BLOCK SIZE @V305032 00755100
- BNH BINSUB1 ITERATE LOOP UNTIL IT IS GREATER.@V305032 00756100
- SRL R6,ONE THEN HALVE THE ADJUSTER, @V305032 00757100
- SR R5,R6 INDEXER = BLOCK SIZE MINUS ADJUSTER @V305032 00758100
- SRL R6,ONE HALVE THE ADJUSTER ONCE MORE @V305032 00759100
- B BINSUB3 FINISH INITIALIZATION & START SEARCH @V305032 00760100
- SPACE 00761100
- * SET R5/R6/R7 FOR (DEFAULT) BLOCK SIZE OF 800 BYTES: 00762100
- CNOP 4,8 (DBL-WORD ALIGN BINARY SEARCH LOOP) @V305032 00763100
- BINSUB2 LA R5,ONESIXTY SET INDEXER = 160,, @V305032 00764100
- LA R6,THREE20 ADJUSTER = 320, AND @V305032 00765100
- LA R7,NUMTRIES "NUMBER OF TRIES" COUNTER = 5; @V305032 00766100
- * CONTINUE TO BINSUB3 ... 00767100
- EJECT 00768100
- BINSUB3 LA R14,BINSUB5 SET R14 TO TRANSFER IF "TOO LOW" @V305032 00769100
- LA R15,BINSUB4 SET R15 TO TRANSFER IF "TOO HIGH"@V305032 00770100
- SPACE 00771100
- * FAST "BINARY SEARCH LOOP" TO FIND DESIRED FST IN BLOCK (IF IT EXISTS) 00772100
- BINSUBLP CL R0,FN1(R4,R5) COMPARE FIRST HALF OF FILENAME @V305032 00773100
- BLR R14 TRANSFER IF "TOO LOW" IN BLOCK @V305032 00774100
- BHR R15 TRANSFER IF "TOO HIGH" IN BLOCK @V305032 00775100
- CL R1,FN2(R4,R5) IF =, COMPARE 2ND HALF OF FNAME @V305032 00776100
- BLR R14 TRANSFER IF "TOO LOW" IN BLOCK @V305032 00777100
- BHR R15 TRANSFER IF "TOO HIGH" IN BLOCK @V305032 00778100
- CL R2,FT1(R4,R5) IF =, COMPARE 1ST HALF OF FTYPE @V305032 00779100
- BLR R14 TRANSFER IF "TOO LOW" IN BLOCK @V305032 00780100
- BHR R15 TRANSFER IF "TOO HIGH" IN BLOCK @V305032 00781100
- CL R3,FT2(R4,R5) IF =, COMPARE 2ND HALF OF FTYPE @V305032 00782100
- BLR R14 TRANSFER IF "TOO LOW" IN BLOCK @V305032 00783100
- BHR R15 TRANSFER IF "TOO HIGH" IN BLOCK @V305032 00784100
- LA R1,0(R4,R5) IF MATCH RETURN ADDR OF FST ENTRY@V305032 00785100
- STM R4,R5,ADTCHBA STORE ADDRESS & DISP. IN CASE @V305032 00786100
- B FSTL41 RE-ENTERED AND "GO EXIT". @V305032 00787100
- SPACE 00788100
- * "TOO HIGH" IN THE BLOCK - INCREMENT THE INDEXER: 00789100
- BINSUB4 AR R5,R6 ADD ADJUSTER TO INDEXER @V305032 00790100
- SRL R6,ONE HALVE ADJUSTER (FOR NEXT TIME) @V305032 00791100
- BCT R7,BINSUBLP AND ITERATE BINARY SEARCH LOOP. @V305032 00792100
- BR R8 IF NOT FOUND, RETURN TO CALLER. @V305032 00793100
- SPACE 00794100
- * "TOO LOW" IN THE BLOCK - DECREMENT THE INDEXER: 00795100
- BINSUB5 SR R5,R6 SUBTRACT ADJUSTER FROM INDEXER @V305032 00796100
- BM BINSUB6 BEWARE MINUS = RUNNING OFF FRONT OF BLK @V305032 00797100
- SRL R6,ONE OK - HALVE ADJUSTER (FOR NEXT TIME) @V305032 00798100
- BCT R7,BINSUBLP AND ITERATE BINARY SEARCH LOOP. @V305032 00799100
- BR R8 IF NOT FOUND, RETURN TO CALLER. @V305032 00800100
- SPACE 00801100
- * IF INDEXER GOES MINUS, DON'T "RUN OFF THE FRONT OF THE BLOCK": 00802100
- BINSUB6 SR R5,R5 SET INDEXER = 0; @V305032 00803100
- SRL R6,ONE HALVE ADJUSTER (FOR NEXT TIME) @V305032 00804100
- BCT R7,BINSUBLP AND ITERATE BINARY SEARCH LOOP. @V305032 00805100
- BR R8 IF NOT FOUND, RETURN TO CALLER. @V305032 00806100
- SPACE 00807100
- * ADDITIONAL NEEDED EQUATES: 00808100
- ONESIXTY EQU 160 INITIAL INDEXER FOR AN 800-BYTE BLOCK @V305032 00809100
- THREE20 EQU 320 INITIAL ADJUSTER FOR AN 800-BYTE BLOCK@V305032 00810100
- NUMTRIES EQU 5 INITIAL NO. OF TRIES FOR 800-BYTE BLK @V305032 00811100
- EJECT 00812100
- LTORG @V305032 00813100
- SPACE 00814100
- * OTHER CONSTANTS AND DEFINITIONS ... 00815100
- DS 0F @V305032 00816100
- SB DC X'80000000' ZERO WITH SIGN-BIT ON @V305032 00817100
- VDMSSTTR DC V(DMSSTTR) VCON TO CHECK FOR STATE CALL @V305032 00818100
- SPACE 00819100
- * PARAMETER-LIST (R2) DISPLACEMENTS 00820100
- PLNAM EQU 8 FILENAME @V305032 00821100
- PLTYP EQU 16 FILETYPE @V305032 00822100
- PLMOD EQU 24 FILEMODE @V305032 00823100
- EJECT 00824100
- FVS , @V305032 00825100
- GPR2 EQU DISK$SEG+EIGHT SAVED REGISTERS FROM R2 UP @V305032 00826100
- EJECT 00827100
- REGEQU , @V305032 00828100
- NUCON , @V305032 00829100
- ADT , @V305032 00830100
- SVCSECT , @V305032 00831100
- END 00832100
ibm/vm370-lib/cms/dmslfs.assemble_src.txt · Last modified: 2023/08/06 13:35 by Site Administrator