ibm:vm370-lib:cms:dmsalu.assemble_src
Table of Contents
DMSALU Source
References
- Fixes Applied : 3
- This Source Date : Tuesday, December 12, 1978
- Last Fix ID : [HRC015DS]
Source Listing
- DMSALU.ASSEMBLE.txt
- ALU TITLE 'DMSALU (CMS) VM/370 - RELEASE 6' 00001000
- SPACE 2 00002000
- *. 00003000
- * MODULE NAME: 00008000
- * 00009000
- * DMSALU (RELUFD) 00010000
- * 00011000
- * FUNCTION: 00012000
- * 00013000
- * FOR A GIVEN DISK, TO RELEASE ALL TABLES KEPT IN FREE 00014000
- * STORAGE AND TO CLEAR APPROPRIATE INFORMATION IN THE 00015000
- * ACTIVE DISK TABLE. 00016000
- * 00017000
- * ATTRIBUTES: 00018000
- * 00019000
- * DISK RESIDENT 00020000
- * 00021000
- * ENTRY POINTS: 00022000
- * 00023000
- * RELUFD - RELEASE FILE DIRECTORY TABLES FOR A DISK 00024100
- * | SORTFST - SORT FST ENTRIES FOR ALL FST HYPERBLOCKS FOR A DISK 00024200
- * 00025000
- * ENTRY CONDITIONS: 00026000
- * 00027000
- * L R15,ARELUFD WHERE ARELUFD=V(DMSALU) 00028000
- * BALR R14,R15 00029000
- * 00030000
- * R0 MUST POINT TO ACTIVE DISK TABLE 00031000
- * 00032000
- * EXIT CONDITIONS: 00033000
- * 00034000
- * R15=0 (AND CONDITION-CODE=0) 00035000
- * 00036000
- * CALLS TO OTHER ROUTINES: 00037000
- * 00038000
- * DMSFRET 00039000
- * 00040000
- * EXTERNAL REFERENCES: 00041000
- * 00042000
- * ADTSECT, FVSECT 00043000
- * 00044000
- * TABLES/WORKAREAS: 00045000
- * 00046000
- * NONE. 00047000
- * 00048000
- * REGISTER USAGE: 00049000
- * 00050000
- * R12 BASE 00051000
- * R13 VVSECT 00052000
- * R11 ADTSECT 00053000
- * REST WORK 00054000
- * 00055000
- * OPERATION: 00056000
- * 00057000
- * FOR THE GIVEN ACTIVE DISK TABLE, THE FOLLOWING 00058000
- * TABLES ARE RETURNED TO FREE STORAGE VIA DMSFRET, IF 00059000
- * THEY ARE CURRENTLY RESIDENT FOR A CMS DISK: 00060100
- * 00062000
- * 1. ALL FST HYPERBLOCK EXTENSIONS (IF ANY) 00063000
- * 2. THE FIRST FST HYPERBLOCK IF IT WAS IN FREE STORAGE 00064000
- * 3. MASTER FILE DIRECTORY 00065000
- * 4. QMSK BIT-MASK 00066000
- * 5. QQMSK TABLE IF IT WAS IN FREE STORAGE 00067000
- * 00068000
- * IN CLEARING ANY OF THE ABOVE, THE APPROPRIATE 00069000
- * FLAG-BITS ARE ALSO CLEARED, AND ANY POINTERS POINTING 00070000
- * TO THE OLD TABLES. 00071000
- * 00072000
- * FOR CERTAIN TABLES, DMSALU CLEARS 00073000
- * THEM IF THEY EXIST BUT ARE NOT IN FREE STORAGE, 00074000
- * NAMELY: 00075000
- * 00076000
- * 1. FIRST FST HYPERBLOCK IS NOT IN FREE STORAGE 00077000
- * 2. QQMSK IF NOT IN FREE STORAGE 00078000
- * 00079000
- * FOR AN O/S DISK, THE O/S FST BLOCKS (IF ANY) ARE RE- 00079100
- * TURNED TO FREE STORAGE VIA DMSFRET. THE OSFST POINTER 00079200
- * IN ALL ACTIVE O/S FCB'S IS CLEARED, THEN THE DMSROS 00079300
- * USAGE COUNT IS DECREMENTED AND IF THE USAGE COUNT IS 00079400
- * ZERO, THEN THE ADDRESS OF DMSROS IN THE NUCLEUS AREA 00079500
- * IS CLEARED, AND THE AREA OCCUPIED BY DMSROS IS RE- 00079600
- * TURNED TO FREE STORAGE VIA DMSFRET. 00079700
- * DMSALU ALSO CLEARS ALL INFORMATION IN THE ACTIVE DISK 00080000
- * TABLE FROM ADTMFDN THROUGH ADTCYL, AND SETS THE ADTMX 00081000
- * EXTENSION-MODE-LETER TO A BLANK. 00082000
- * ALSO, DMSALU 00083000
- * CLEARS ALL INFORMATION IN THE ACTIVE DISK TABLE FROM 00084000
- * ADTPQM1 TO ADTRES, AND ALSO CLEARS THE ADTFLG2 00085000
- * FLAG-BYTE. 00086000
- * 00087000
- * DMSALU IS CALLED BY DMSARE FOR RELEASING AN ACTIVE 00088000
- * DISK, AND BY DMSACC AND DMSFOR TO CLEAR ALL 00089000
- * INFORMATION 00090000
- * BEFORE READING IN OR CREATING A NEW USER FILE 00091000
- * DIRECTORY FOR THE GIVEN DISK. 00092000
- * 00093000
- * | IF THE CMS/DOS ENVIRONMENT IS ACTIVE, DMSALU WILL 00093100
- * | SEARCH THE DOS SIMULATED LUB TABLE TO VERIFY IF 00093200
- * | ANY LOGICAL UNIT IS ASSIGNED TO THE DISK BEING RE- 00093300
- * | LEASED. IF SO, THE LOGICAL UNIT ASSIGNED TO THE 00093400
- * | DISK BEING RELEASED IS UNASSIGNED. 00093500
- * 00093600
- * | NOTE: THE "SORTFST" ENTRY POINT IS DESCRIBED 00093700
- * | IN A SEPARATE SECTION. 00093800
- *. 00094000
- EJECT 00095000
- DMSALU START 0 P3035 00096000
- SPACE 00097000
- ENTRY RELUFD P3035 00098000
- RELUFD EQU DMSALU P3035 00099000
- ENTRY SORTFST ENTRY TO SORT FST ENTRIES @V305032 00099100
- ENTRY END$RELU P3035 00100000
- SPACE 00101000
- USING NUCON,R0 00103000
- L R15,AFVS A(FVS) INTO R15 00104000
- USING FVSECT,R15 00105000
- STM R0,R14,REGSAV0 SAVE R0 THRU 14 00106000
- DROP R15 00107000
- LR R13,R15 REFERENCE 'FVS' INFO 00108000
- USING FVSECT,R13 00109000
- BALR R12,0 OUR OWN ADDRESSABILITY 00110000
- USING *,R12 00111000
- XC STATEFST(STFSTSIZ),STATEFST Clear STATEFST info HRC015DS 00112100
- LR R11,R0 REFERENCE ACTIVE DISK TABLE 00113000
- SR R9,R9 CLEAR R9 AND 00114000
- SR R10,R10 R10 FOR GENERAL USE 00115000
- LA R6,8 8 INTO R6 FOR GENERAL USE 00116000
- USING ADTSECT,R11 ... 00117000
- L R3,ADTFDA START WITH FIRST FST HYPERBLOCK 00118000
- LTR R3,R3 (IF ANY) 00119000
- BZ RELU06 SKIP IT IF NOT THERE 00120000
- L R4,4(,R3) GET SIZE=DISPLACEMENT OF NEXT POINTER 00121000
- AR R3,R6 ADD 8 TO SPACE OVER 2 COUNTERS, 00122000
- LR R8,R3 REMEMBER IN R8 WHERE FST HYPERBLOCK STARTS 00123000
- LA R7,0(R4,R3) ADDRESS OF POINTER-TO-EXTENSION INTO R7, 00124000
- L R5,0(,R7) OBTAIN POINTER TO NEXT FST-EXT. 00125000
- STM R9,R10,0(R7) CLEAR POINTER & WORD AFTER THAT 00126000
- LTR R1,R5 ARE THERE ANY EXTENSION(S) AT ALL ? 00127000
- BZ RELU04 BZ IF NOT (DON'T TRY TO 'FRET' ANY). 00128000
- LA R0,8(,R4) SIZE+8 (E.G. 808) INTO R0, 00129000
- SRL R0,3 CHANGE INTO DOUBLE-WORDS (E.G. 101) 00130000
- RELU02 DS 0H MAIN LOOP TO 'FRET' FST HYPERBLOCK EXTENSIONS 00131000
- L R5,0(R4,R5) SET UP FOR NEXT EXTENSION (IF ANY) 00132000
- DMSFRET DWORDS=(0),LOC=(1),TYPCALL=BALR RELEASE SPACE @VM03083 00133100
- LTR R1,R5 POINTER TO ANOTHER ? 00134000
- BP RELU02 BP (BNZ) IF YES, GO RELEASE IT. 00135000
- RELU04 TM ADTFLG1,ADTFFSTF IS FIRST FST HYPERBLOCK IN FREE STORAGE 00136000
- BZ RELU05 BZ IF NOT (GO CLEAR IT). 00137000
- LA R0,16(,R4) SIZE+16 (E.G. 816) INTO R0, 00138000
- SRL R0,3 MAKE THAT DOUBLE-WORDS (E.G. 102) 00139000
- L R1,ADTFDA LET R1 POINT TO THE FIRST HYPERBLOCK, 00140000
- DMSFRET DWORDS=(0),LOC=(1),TYPCALL=BALR GIVE IT BACK @VM03083 00141100
- NI ADTFLG1,255-ADTFFSTF TURN OFF FREE STORAGE BIT 00142000
- ST R10,ADTFDA CLEAR OLD ADDRESS 00143000
- B RELU06 00144000
- * 00145000
- RELU05 STM R9,R10,0(R8) CLEAR A DBL-WORD IN FIRST FST-HYPERBLOCK, 00146000
- BXLE R8,R6,RELU05 AND ITERATE UP TO POINTER AT THE END. 00147000
- * 00148000
- RELU06 LM R0,R1,ADTMFDN GET OLD MFD IN CORE (IF ANY) 00149000
- LTR R1,R1 ANYTHING THERE ? 00150000
- BZ RELU07 BZ IF NOT (FORGET IT) 00151000
- DMSFRET DWORDS=(0),LOC=(1),TYPCALL=BALR RELEASE IT @VM03083 00152100
- RELU07 TM ADTFLG2,ADTFROS IS IT AN O/S DISK ? @V201101 00153100
- BZ RELU07A NO..KEEP IT UP @V201101 00153200
- BAL R3,RELOSFST RELEASE ALL OSFST'S @VM03083 00153300
- RELU07A TM DOSFLAGS,DOSMODE ARE WE IN CMS/DOS MODE ? @V305001 00153500
- BZ RELU07B NO, BRANCH @V305001 00153600
- BAL R14,CLRLUBS GO CLEAR ASSIGNED UNITS @V305001 00153700
- RELU07B XC ADTMFDN(ADTM-ADTMFDN),ADTMFDN CLEAR SOME ADT @V305001 00153800
- CLI ADTMX,C' ' WAS THIS AN EXTENSION OF ANY OTHER DISK? 00154000
- BE RELU11 TRF IT NOT (NO PROBLEM). 00155000
- MVC FLGSAVE,ADTMX SAVE THE EXTENSION-MODE-LETTER, 00156000
- MVI ADTMX,C' ' CLEAR IT 00157000
- LA R1,FLGSAVE-24 POINT TO IT, 00158000
- L R15,VCADTLKP FIND THE 'PARENT' @VM03093 00159100
- BALR R14,R15 DISK 00160000
- BNZ RELU11 TRF IF NOT FOUND 00161000
- DROP R11 00162000
- LR R2,R1 REFERENCE THE "PARENT" DISK 00163000
- USING ADTSECT,R2 VIA R2, PLEASE ... 00164000
- SR R3,R3 OBTAIN MODE-LETTER OF THIS-DISK 00165000
- IC R3,ADTM IN R3 FOR LATER COMPARING. 00166000
- NI ADTFLG1,255-ADTROX RESET R/O-EXTENSION FLAG-BIT 00167000
- DROP R2 00168000
- RELU10 L R15,VCADTNXT SCAN ALL REMAINING DISKS FOR ANY @VM03093 00169100
- BALR R14,R15 WHICH ARE A R/O EXTENSION OF THIS ONE 00170000
- LTR R1,R1 ANYTHING THERE ? 00171000
- BZ RELU11 IF NOT, WE'RE DONE. 00172000
- USING ADTSECT,R1 REFERENCE THIS LATEST DISK 00173000
- EX R3,CLINST IS IT AN EXTENSION OF THE PARENT DISK ? 00174000
- BNE RELU10 IF NOT, GO CHECK REMAINING DISK(S) 00175000
- DROP R1 00176000
- USING ADTSECT,R2 IF YES, BACK TO PARENT-DISK PLEASE, 00177000
- OI ADTFLG1,ADTROX SET THE BIT ON-AGAIN FOR R/O EXTENSIONS 00178000
- DROP R2 00179000
- USING ADTSECT,R11 NOW BACK TO REFERENCING 'OUR' DISK 00180000
- RELU11 MVC ADTID(6),BLNK6 BLANK OUT DISK-LABEL 00181000
- MVI ADTFTYP,00 CLEAR FILETYPE FLAG-BYTE (FOR SURE), 00182000
- MVI ADTFLG3,ZERO AND "ADTFLG3" FLAG-BYTE @V305032 00183000
- TM ADTFLG1,ADTFMIN IS THIS A MINIMUM SIZE ADT BLOCK ? 00184000
- BO LMR14 BO IF YES, NO READ/WRITE INFO THERE 00185000
- LM R1,R2,ADTMSK GET BIT-MASK AND QQ-MASK ADDRESSES 00186000
- LTR R1,R1 MAKE SURE BIT-MASK THERE TO GIVE BACK, 00187000
- BZ RELU08 BZ IF NOT THERE 00188000
- L R0,ADTPQM3 NOW WE'VE GOT NO. OF DOUBLE WORDS, 00189000
- DMSFRET DWORDS=(0),LOC=(1),TYPCALL=BALR FRET IT @VM03083 00190100
- ST R10,ADTMSK CLEAR BIT-MASK ADDRESS 00191000
- RELU08 LTR R1,R2 CHECK QQMSK ADDRESS 00192000
- BZ REL10 BZ IF NOT THERE 00193000
- TM ADTFLG1,ADTFQQF IS IT IN FREE STORAGE ? 00194000
- BO RELU09 BO IF YES, RELEASE IT, ETC. 00195000
- XC 0(200,R1),0(R1) IF NOT, MERELY CLEAR IT. 00196000
- B REL10 00197000
- RELU09 EQU * 00198000
- DMSFRET DWORDS=25,LOC=(1),TYPCALL=BALR FRET QQMSK @VM03083 00199100
- ST R10,ADTQQM CLEAR THE ADDRESS, 00200000
- NI ADTFLG1,255-ADTFQQF AND CLEAR THE FLAG 00201000
- REL10 XC ADTPQM1(ADTRES-ADTPQM1+2),ADTPQM1 CLR ADTPQM1 TO ADTRES 00202000
- LMR14 NI ADTFLG1,255-(ADTFRO+ADTFRW) SIGNAL DISK NOT LOGGED IN, 00203000
- MVI ADTFLG2,00 CLEAR 2ND FLAG-BYTE 00204000
- LM R0,R14,REGSAV0 RESTORE REGISTERS 0-14, 00205000
- SR R15,R15 CLEAR R15, AND 00206000
- BR R14 AND RETURN TO CALLER. 00207000
- * 00208000
- EJECT 00208050
- * RELEASE ALL OSFST BLOCKS (R3 = RETURN-REGISTER) AND ZERO OUT @VA14031 00208100
- * THE CORRESPONDING POINTERS IN THE FCB: @VA14031 00208107
- * @VA14031 00208114
- * @VA14031 00208121
- RELOSFST EQU * @VA14031 00208128
- L R9,OSADTFST GET 1ST. OSFST ADDRESS @VA14031 00208135
- OSFSTLUP EQU * @VA14031 00208142
- LA R9,0(,R9) CLEAR HIGH ORDER BYTE @VA14031 00208149
- LTR R9,R9 ANYTHING THERE ? @VA14031 00208156
- BZ TESTCNT NO..COMPUTE NEW DMSROS COUNT @VA14031 00208163
- LR R1,R9 GET OSFST LOC @VA14031 00208170
- USING OSFST,R1 OSFST ADDRESSABILITY @VA14031 00208177
- SPACE 1 @VA14031 00208184
- RELFCBPT EQU * @VA14031 00208191
- L R9,FCBFIRST GET 1ST. OSFCB ADDRESS @VA14031 00208198
- OSFCBLUP EQU * @VA14031 00208205
- LA R9,0(,R9) CLEAR HIGH ORDER BYTE @VA14031 00208212
- LTR R9,R9 ANYTHING THERE ? @VA14031 00208219
- BZ FREEFST NONE FOUND, FREE OSFST BLOCK @VA14031 00208226
- LR R6,R9 ... @VA14031 00208233
- USING FCBSECT,R6 OSFCB ADDRESSABILITY @VA14031 00208240
- L R9,FCBNEXT GET NEXT OSFCB ADDRESS @VA14031 00208247
- CLM R1,B0111,FCBOSFST+1 DO THE OSFST'S MATCH ??? @VA14031 00208254
- BNE OSFCBLUP NO..SEARCH NEXT OSFCB @VA14031 00208261
- XC FCBOSFST(4),FCBOSFST CLEAR OSFST POINTER @VA14031 00208268
- SPACE 1 @VA14031 00208275
- FREEFST EQU * @VA14031 00208282
- LA R0,OSFSTLTH GET OSFST DWORDS @VA14031 00208289
- L R9,OSFSTNXT GET NEXT OSFST ADDRESS @VA14031 00208296
- DMSFRET DWORDS=(0),LOC=(1),TYPCALL=BALR @VA14031 00208303
- B OSFSTLUP KEEP SEARCHING @VA14031 00208310
- DROP R6,R1 DROP ADDRESSABILITY @VA14031 00208317
- * @VA14031 00208324
- TESTCNT LH R9,CDMSROS GET DMSROS COUNT @V201101 00208350
- BCTR R9,0 LESS ONE @V201101 00208360
- LTR R9,R9 ... @V201101 00208370
- BNP RELROS IF NOT POSITIVE,REL DMSROS @V201101 00208380
- STH R9,CDMSROS RESTORE COUNT @V201101 00208390
- BR R3 RETURN (WAS CALLED VIA R3) @VM03083 00208400
- * 00208410
- RELROS LR R9,R1 SAVE REG. 1 @V201101 00208420
- LH R0,LDMSROS GET DMSROS LENGTH @V201101 00208430
- L R1,ADMSROS GET DMSROS ADDRESS @V201101 00208440
- XC ADMSROS(8),ADMSROS CLEAR ADDR , SIZE & COUNT @V201101 00208450
- DMSFRET DWORDS=(0),LOC=(1),TYPCALL=BALR FRET DMSROS @VM03203 00208460
- LR R1,R9 RESTORE REG. 1 @V201101 00208470
- BR R3 RETURN (WAS CALLED VIA R3) @VM03083 00208480
- EJECT 00208500
- CLRLUBS LA R9,MODETAB POINT TO MODES TABLE @V305001 00208520
- LA R6,EMODTAB NUMBER ENTRIES IN TABLE @V305001 00208540
- CLRLUP1 CLC ADTM(ONE),0(R9) MODES MATCH ? @V305001 00208560
- BE CLRFND YES, BRANCH @V305001 00208580
- LA R9,TWO(,R9) BUMP TO NEXT ENTRY @V305001 00208600
- BCT R6,CLRLUP1 KEEP LOOKING... @V305001 00208620
- BR R14 SHOULD NOT HAPPEN... @V305001 00208640
- CLRFND L R1,ABGCOM GET COMM. REGION ADDRESS @V305001 00208660
- LH R1,LUBADDR(,R1) GET LUB ADDRESS @V305001 00208680
- LA R6,TWO55 NUMBER LUB ENTRIES IN CMS @V305001 00208700
- CLRLUP2 CLC 0(ONE,R1),ONE(R9) DO PUB INDEXES MATCH ? @V305001 00208720
- BNE CLRCONT NO, CONTINUE BELOW @VM03111 00208740
- MVI 0(R1),FF UNASSIGN THIS LUB @V305001 00208760
- CLRCONT LA R1,TWO(,R1) POINT TO NEXT LUB @V305001 00208780
- BCT R6,CLRLUP2 KEEP CHECKING... @V305001 00208800
- BR R14 RETURN... @V305001 00208820
- SPACE 2 00208840
- MODETAB DC C'A',X'08' A-DISK MODE AND PUB INDEX @V305001 00208860
- DC C'B',X'09' B-DISK MODE AND PUB INDEX @V305001 00208880
- DC C'C',X'0A' C-DISK MODE AND PUB INDEX @V305001 00208900
- DC C'D',X'0B' D-DISK MODE AND PUB INDEX @V305001 00208920
- DC C'E',X'0C' E-DISK MODE AND PUB INDEX @V305001 00208940
- DC C'F',X'0D' F-DISK MODE AND PUB INDEX @V305001 00208960
- DC C'G',X'0E' G-DISK MODE AND PUB INDEX @V305001 00208980
- DC C'H',X'0F' H-DISK MODE AND PUB INDEX HRC002DS 00209003
- DC C'I',X'10' I-DISK MODE AND PUB INDEX HRC002DS 00209006
- DC C'J',X'11' J-DISK MODE AND PUB INDEX HRC002DS 00209009
- DC C'K',X'12' K-DISK MODE AND PUB INDEX HRC002DS 00209012
- DC C'L',X'13' L-DISK MODE AND PUB INDEX HRC002DS 00209015
- DC C'M',X'14' M-DISK MODE AND PUB INDEX HRC002DS 00209018
- DC C'N',X'15' N-DISK MODE AND PUB INDEX HRC002DS 00209021
- DC C'O',X'16' O-DISK MODE AND PUB INDEX HRC002DS 00209024
- DC C'P',X'17' P-DISK MODE AND PUB INDEX HRC002DS 00209027
- DC C'Q',X'18' Q-DISK MODE AND PUB INDEX HRC002DS 00209030
- DC C'R',X'19' R-DISK MODE AND PUB INDEX HRC002DS 00209033
- DC C'S',X'1A' S-DISK MODE AND PUB INDEX HRC002DS 00209036
- DC C'T',X'1B' R-DISK MODE AND PUB INDEX HRC002DS 00209039
- DC C'U',X'1C' R-DISK MODE AND PUB INDEX HRC002DS 00209042
- DC C'V',X'1D' R-DISK MODE AND PUB INDEX HRC002DS 00209045
- DC C'W',X'1E' R-DISK MODE AND PUB INDEX HRC002DS 00209048
- DC C'X',X'1F' R-DISK MODE AND PUB INDEX HRC002DS 00209051
- DC C'Y',X'20' Y-DISK MODE AND PUB INDEX HRC002DS 00209054
- DC C'Z',X'21' Z-DISK MODE AND PUB INDEX HRC002DS 00209057
- EMODTAB EQU (*-MODETAB)/2 NUMBER ITEMS IN TABLE @V305001 00209060
- SPACE 2 00209080
- DROP R11 @V305001 00209100
- USING ADTSECT,R1 00210000
- CLINST CLI ADTMX,*-* CHECKS (VIA R3) EXTENSION-MODE-LETTER(S) 00211000
- * 00212000
- BLNK6 DC CL6' ' (TO BLANK OUT DISK-LABEL) 00213000
- SPACE 00214100
- * NEEDED EQUATES: 00215100
- ZERO EQU 00 TO CLEAR A BYTE @V305032 00216100
- TWO EQU 2 @V305001 00217100
- LUBADDR EQU 76 DISPLACEMENT OF LUB ADDRESS @V305001 00218100
- TWO55 EQU 255 NUMBER OF LUB ENTRIES IN CMS @V305001 00219100
- FF EQU X'FF' TO UNASSIGN A LUB @V305001 00220100
- B0111 EQU B'0111' MASK FOR AN ADDRESS @VA14031 00220600
- SPACE 00221100
- LTORG END OF "RELUFD" LITERALS @V305032 00222100
- DROP R12,R13 @V305032 00223100
- EJECT 00224100
- *. 00225100
- * ROUTINE NAME: 00226100
- * 00227100
- * SORTFST 00228100
- * 00229100
- * FUNCTION: 00230100
- * 00231100
- * TO SORT ALL FST ENTRIES FOR A CMS DISK. 00232100
- * 00233100
- * ATTRIBUTES: 00234100
- * 00235100
- * DISK RESIDENT (INCLUDED WITH CALLING PROGRAM); 00236100
- * SERIALLY REUSABLE; CALLED VIA BALR. 00237100
- * 00238100
- * ENTRY POINT: 00239100
- * 00240100
- * SORTFST 00241100
- * 00242100
- * ENTRY CONDITIONS: 00243100
- * 00244100
- * R0 = ADDRESS OF ACTIVE DISK TABLE 00245100
- * R14 = RETURN REGISTER 00246100
- * R15 = V(SORTFST) 00247100
- * 00248100
- * EXIT CONDITIONS: 00249100
- * 00250100
- * NORMAL RETURN (WHEN CALLED WITH CORRECT PARAMETERS: 00251100
- * R15 = 0 00252100
- * R0-R14 PRESERVED. 00253100
- * 00254100
- * ERROR RETURN (R0 DID NOT POINT TO AN ACCESSED CMS DISK): 00255100
- * R15 = 36 00256100
- * R0-R14 PRESERVED. 00257100
- * 00258100
- * CALLS TO OTHER ROUTINES: 00259100
- * 00260100
- * NONE 00261100
- * 00262100
- * CALLED BY: 00263100
- * 00264100
- * DMSACF (READFST) - EXCEPT FOR THE S-DISK. 00265100
- * DMSINS - FOR THE S-DISK ONLY. 00266100
- * DMSARE (RELEASE) - FOR READ/WRITE DISKS ONLY. 00267100
- * 00268100
- * EXTERNAL REFERENCES: 00269100
- * 00270100
- * STATEFST 00271100
- * 00272100
- * TABLES/WORKAREAS: 00273100
- * 00274100
- * BUFF1600 = 1600-BYTE BUFFER AREA 00276100
- * 00277100
- EJECT 00278100
- * REGISTER USAGE: 00279100
- * 00280100
- * R11 ADTSECT 00281100
- * R12 ADDRESSABILITY 00282100
- * 00283100
- * OTHERS = WORK REGISTERS 00284100
- * 00285100
- * RESPONSES/ERROR MESSAGES: 00286100
- * 00287100
- * NONE. 00288100
- * 00289100
- * OPERATION: 00290100
- * 00291100
- * 1. IF THE DISK IS NOT ACCESSED AS A CMS READ-WRITE OR 00292100
- * READ-ONLY DISK, EXITS WITH RETURN-CODE = 36. 00293100
- * 00294100
- * 2. FOR THE S-DISK, OR IF THE DISK CONTAINS NO MORE THAN 20 00295100
- * FILES, THE FST ENTRIES ARE SORTED VIA AN INTERNAL SUBROUTINE, 00296100
- * THE CONTENTS OF 'STATEFST' ARE CLEARED, AND RETURN IS MADE 00297200
- * TO THE CALLER. 00298100
- * 00299100
- * 3. FOR DISKS CONTAINING MORE THAN 20 ENTRIES, EACH FST 00300100
- * HYPERBLOCK OF 20 FILES (OR LESS FOR THE LAST ONE) IS SORTED 00301100
- * INDIVIDUALLY VIA THE INTERNAL SUBROUTINE. 00302100
- * 00303100
- * 4. THEN ANY CONTIGUOUS BLOCKS WHICH ARE OUT OF ORDER ARE 00304100
- * MERGED (USING THE 1600-BYTE WORK BUFFER), AND THIS STEP 00305100
- * IS REPEATED UNTIL ALL FST ENTRIES ARE IN ORDER. 00306100
- * THEN STATEFST IS CLEARED (AS ABOVE) AND RETURN MADE. 00307100
- * 00308100
- * 5. THE INTERNAL SUBROUTINE USES A SORT BY INSERTION AND 00309100
- * MOVE, WORKING DOWNWARD FROM THE END OF THE BLOCK TO TAKE 00310100
- * ADVANTAGE OF THE 370 MVCL INSTRUCTION FOR THE MOVING. 00311100
- *. 00312100
- SPACE 00313100
- * NOTE: SUPPORT CODE FOR THIS SECTION (SORTFST) = @V305032 00314100
- SPACE 00315100
- USING NUCON,R0 (AS USUAL) @VM03111 00316100
- SORTFST L R15,AFVS REFERENCE "FVS" AREA @VM03111 00316600
- USING FVSECT,R15 (BRIEFLY) @VM03111 00317100
- STM R0,R14,REGSAV0 SAVE REGISTERS 0-14 @VM03111 00317600
- XC STATEFST(STFSTSIZ),STATEFST Ensure STATEFST 0 HRC015DS 00318200
- DROP R15 THEN ... @VM03111 00318600
- BALR R12,0 ESTABLISH ADDRESSABILITY @VM03111 00319100
- USING *,R12 ... @VM03111 00319600
- LR R11,R0 A(ADT) INTO R11 PLEASE @V305032 00321100
- USING ADTSECT,R11 AND REFERENCE THE ADT BLOCK @V305032 00322100
- TM ADTFLG1,ADTFRO+ADTFRW CMS DISK ACCESS'D ? @V305032 00323100
- BZ ERROR36 IF NOT, NO GOOD. @V305032 00324100
- CLI ADTM,SDISK IS IT THE S-DISK ? @V305032 00325100
- BE SORTSDSK YES - THAT'S EASY. @V305032 00326100
- L R3,ADTFSTC GET TOTAL NUMBER OF FILES @V305032 00327100
- LTR R15,R3 PERCHANCE NONE AT ALL ? @V305032 00328100
- BZ EXIT IF NONE (NOT LIKELY) JUST EXIT. @V305032 00329100
- CH R3,=AL2(TWENTY) MORE THAN 20 ? @V305032 00330100
- BNH SORTSMAL NOPE (1-20) - THAT MAKES IT EASY.@V305032 00331100
- LR R10,R3 MORE THAN 20 - REMEMBER IN R10. @V305032 00332100
- * MORE THAN 20 FILES - SORT EACH INDIVIDUAL HYPERBLOCK FIRST: 00333100
- L R8,ADTFDA POINT TO FIRST HYPERBLOCK @V305032 00334100
- LA R8,EIGHT(,R8) SKIP OVER 1ST DOUBLE-WORD @V305032 00335100
- HYPBLOOP LA R3,B800 SIZE = 800 @V305032 00336100
- HYPBLAST LR R1,R8 ADDRESS INTO R1 @V305032 00337100
- BAL R13,SORTSUB SORT ONE HYPERBLOCK @V305032 00338100
- ICM R8,M7,B801(R8) POINTER TO NEXT HYPERBLOCK @V305032 00339100
- BZ HYPBDONE IF NONE LEFT, WE'RE DONE. @V305032 00340100
- LA R15,TWENTY (NEEDED) @V305032 00341100
- SR R10,R15 SUBTRACT 20 FROM NO. OF FILES @V305032 00342100
- BNP HYPBDONE IF NONE LEFT, WE'RE DONE. @V305032 00343100
- CR R10,R15 LESS THAN 20 LEFT ? @V305032 00344100
- BNL HYPBLOOP NOPE - NO PROBLEM. @V305032 00345100
- LR R3,R10 IF LESS THAN 20, PUT IN R3, @V305032 00346100
- MH R3,=H'40' NO. OF FILES (1-19) TIMES 40 @V305032 00347100
- B HYPBLAST AND GO DO THE LAST ONE. @V305032 00348100
- SPACE 00349100
- HYPBDONE EQU * ALL HYPERBLOCKS SORTED INDIVIDUALLY; @V305032 00350100
- SORTHYP1 L R9,ADTFDA POINT TO FIRST HYPERBLOCK @V305032 00351100
- LA R9,EIGHT(,R9) SKIP OVER 1ST DOUBLE-WORD @V305032 00352100
- L R10,ADTFSTC GET TOTAL NUMBER OF FILES @V305032 00353100
- LA R15,TWENTY 20 INTO R15 FOR HANDY USE @V305032 00354100
- SORTHYP2 LR R8,R9 POINT TO 1ST (2ND, ...) HYPERBLOC@V305032 00355100
- ICM R9,M7,B801(R8) POINT TO 2ND (3RD, ...) HYPERBLOC@V305032 00356100
- BZ EXITOK IF NONE LEFT, WE'RE ALL FINISHED.@V305032 00357100
- SR R10,R15 SUBTRACT 20 FROM NUMBER OF FILES @V305032 00358100
- BNP EXITOK IF NONE LEFT, WE'RE FINISHED. @V305032 00359100
- L R6,B760(,R8) POINT TO LAST ITEM IN "THIS" BLOC@V305032 00360100
- CL R6,0(,R9) COMPARE WITH FIRST ITEM IN "NEXT"@V305032 00361100
- BL SORTHYP2 LESS THAN = HAPPINESS @V305032 00362100
- BH SORTHYP3 IF GREATER, MUST MERGE THE BLOCKS@V305032 00363100
- CLC B764(TWELVE,R8),FOUR(R9) IF =, CHK NEXT 12 BYTES@V305032 00364100
- BNH SORTHYP2 "LESS THAN" IS WHAT WE LIKE. @VM03111 00365100
- SORTHYP3 EQU * MERGE THE TWO SORTED BLOCKS: @V305032 00366100
- LR R1,R8 STARTING ADDRESS OF 1ST BLOCK @V305032 00367100
- LA R2,FORTY LENGTH OF ONE FST ENTRY @V305032 00368100
- LA R3,B760(,R1) ADDRESS OF LAST FST IN 1ST BLOCK @V305032 00369100
- LA R4,BUFF1600 ADDRESS OF 1600-BYTE BUFFER @V305032 00370100
- LR R5,R9 STARTING ADDRESS OF 2ND BLOCK @V305032 00371100
- LA R7,B800 LET R7 TENTATIVELY = 800 @V305032 00372100
- CR R10,R15 LESS THAN 20 FILES LEFT ? @V305032 00373100
- BNL SORTHYP4 NOPE (20 OR MORE) - NO PROBLEM. @V305032 00374100
- LR R7,R10 IF < 20, COUNT INTO R7, @V305032 00375100
- MR R6,R2 TIMES 40 = NUMBER OF BYTES IN "NEXT" BLK @V305032 00376100
- SORTHYP4 LR R10,R7 REMEMBER NO. OF BYTES IN 2ND BLOC@V305032 00377100
- LR R6,R2 R6 ALSO = 40 @V305032 00378100
- AR R7,R5 R7 = ADDRESS OF LAST FST IN 2ND BLOCK @V305032 00379100
- SR R7,R6 ... @V305032 00380100
- SORTHYP5 L R0,0(,R1) GET 1ST HALF OF FNAME FROM 1ST BLOCK @V305032 00381100
- CL R0,0(,R5) COMPARE WITH SAME IN 2ND BLOCK @V305032 00382100
- BL SORTHYP6 TRANSFER IF LESS @V305032 00383100
- BH SORTHYP7 TRANSFER IF GREATER @V305032 00384100
- CLC FN2(TWELVE,R1),FN2(R5) CHECK REMIANING 12 BYTES @V305032 00385100
- BH SORTHYP7 TRANSFER IF GREATER @V305032 00386100
- SORTHYP6 MVC 0(FORTY,R4),0(R1) FST FROM 1ST BLK TO 1600 BLK @V305032 00387100
- AR R4,R2 BUMP R4 FOR THE NEXT TIME @V305032 00388100
- BXLE R1,R2,SORTHYP5 ITERATE BUMPING 1ST BLK ADDRESSES@V305032 00389100
- SR R7,R5 NUMBER OF BYTES LEFT IN 2ND BLOCK@V305032 00390100
- AR R7,R6 ... @V305032 00391100
- LR R6,R5 ADDRESS OF REMAINING BYTES @V305032 00392100
- LR R5,R7 BYTE COUNT ALSO INTO R5, @V305032 00393100
- MVCL R4,R6 MOVE REMAINDER OF THE OTHER BLOCK@V305032 00394100
- B SORTHYP8 GO MOVE BOTH BLKS BACK INTO PLACE@V305032 00395100
- SORTHYP7 MVC 0(FORTY,R4),0(R5) FST FROM 1ST BLK TO 1600 BLK @V305032 00396100
- AR R4,R6 BUMP R4 FOR THE NEXT TIME @V305032 00397100
- BXLE R5,R6,SORTHYP5 ITERATE BUMPING 1ST BLOCK ADDRESS@V305032 00398100
- SR R3,R1 NUMBER OF BYTES LEFT IN 1ST BLOCK@V305032 00399100
- AR R3,R2 ... @V305032 00400100
- LR R2,R1 ADDRESS OF REMAINING BYTES @V305032 00401100
- LR R5,R3 BYTE COUNT ALSO INTO R5, @V305032 00402100
- MVCL R4,R2 MOVE REMAINDER OF THE OTHER BLOCK@V305032 00403100
- SORTHYP8 LA R0,BUFF1600 POINT TO 1600-BYTE BUFFER @V305032 00404100
- LA R1,B800 SET BYTE-COUNT @V305032 00405100
- LR R14,R8 POINT TO FIRST HYPERBLOCK @V305032 00406100
- LR R15,R1 R15 ALSO = 800 @V305032 00407100
- MVCL R14,R0 MOVE FIRST HYPERBLOCK BACK AGAIN @V305032 00408100
- LA R0,BUFF1600+B800 POINT TO 2ND HALF OF 1600 BUFFR@V305032 00409100
- LR R1,R10 SET BYTE-COUNT @V305032 00410100
- LR R14,R9 POINT TO "NEXT" HYPERBLOCK @V305032 00411100
- LR R15,R1 SET R15 ALSO, @V305032 00412100
- MVCL R14,R0 MOVE "NEXT" HYPERBLOCK BACK AGAIN@V305032 00413100
- B SORTHYP1 AND THEN START ALL OVER AGAIN. @V305032 00414100
- SPACE 00415100
- * SORT SMALL DISK - ONLY ONE HYPERBLOCK: 00416100
- SORTSMAL L R1,ADTFDA POINT TO ONE AND ONLY HYPERBLOCK @V305032 00417100
- MH R3,=H'40' NO. OF FILES (1-20) TIMES 40 @V305032 00418100
- B SKIPOVER GO TREAT AS IF AN S-DISK. @V305032 00419100
- SPACE 00420100
- * SORT S-DISK (A SPECIAL CASE): 00421100
- SORTSDSK L R1,ADTFDA POINT TO FST HYPERBLOCK (SSTAT) @V305032 00422100
- L R3,FOUR(,R1) SIZE (IN BYTES) INTO R3 @V305032 00423100
- * 00424100
- SKIPOVER LA R1,EIGHT(,R1) SKIP OVER THE FIRST DOUBLE WORD @V305032 00425100
- BAL R13,SORTSUB SORT ONE AND ONLY FST HYPERBLOCK @V305032 00426100
- * 00427100
- EXITOK EQU * ALL SORTING COMPLETE: @V305032 00428100
- SR R15,R15 CLEAR RETURN CODE @V305032 00433100
- EXIT L R13,AFVS REFERENCE "FVS" AREA @VM03111 00434100
- USING FVSECT,R13 (BRIEFLY) @VM03111 00434600
- LM R0,R14,REGSAV0 RESTORE REGISTERS 0-14 @VM03111 00435100
- DROP R13 AND @VM03111 00435600
- BR R14 EXIT. @VM03111 00436100
- SPACE 00436600
- ERROR36 LA R15,RC36 DISK IS NOT ACCESSED AS CMS-DISK @V305032 00437100
- B EXIT GO EXIT. @V305032 00438100
- EJECT 00441100
- SPACE 2 00442100
- * SUBROUTINE TO SORT ONE CONTIGUOUS BLOCK OF FST'S: 00443100
- * ENTRY CONDITIONS: 00444100
- * R1 = ADDRESS OF FST HYPERBLOCK TO BE SORTED 00445100
- * R3 = SIZE OF SAME 00446100
- * R13 = RETURN REGISTER 00447100
- * REGISTER USAGE: 00448100
- * R0 = -40 00449100
- * R1 = A(FIRST FST IN BLOCK) 00450100
- * R2 = +40 00451100
- * R3 = A(LAST FST IN BLOCK) 00452100
- * R4 = A("THIS" FST) 00453100
- * R5 = A("NEXT" FST IN BLOCK = "PREVIOUS" ONE HANDLED) 00454100
- * R6/R7 = SCRATCH AND MVCL USE 00455100
- * R11 = A(ADT) 00456100
- * R12 = ADDRESSABILITY 00457100
- * R14/R15 = SCRATCH AND MVCL USE 00458100
- * 00459100
- SORTSUB DS 0H CODE TO SORT THE FST ENTRIES ... @V305032 00460100
- LA R2,FORTY R2 = LENGTH OF ONE FST BLOCK (40)@V305032 00461100
- CR R3,R2 BEWARE JUST ONE FST IN THE BLOCK @V305032 00462100
- BER R13 IF YES, EXIT, (NOTHING TO SORT). @V305032 00463100
- AR R3,R1 > ONE, ADD ADDRESS TO COUNT IN R3@V305032 00464100
- SR R3,R2 BACK OFF ONE FST ON R3 PLEASE @V305032 00465100
- LNR R0,R2 R0 = -40 (AS NEEDED) @V305032 00466100
- LR R5,R3 INITIALIZE R5 AS NEEDED @V305032 00467100
- SORT2 LR R4,R5 "THIS" = "PREVIOUS" @V305032 00468100
- AR R4,R0 MINUS 40 @V305032 00469100
- SORT3 L R6,0(,R4) GET 1ST HALF OF "THIS" FILENAME @V305032 00470100
- CL R6,0(,R5) COMPARE WITH "NEXT" @V305032 00471100
- BL SORT4 LESS THAN = HAPPINESS @V305032 00472100
- BH SORT7 GREATER THAN, MUST REARRANGE THEM@V305032 00473100
- CLC FN2(TWELVE,R4),FN2(R5) IF =, CHECK NEXT 12 BYTES@V305032 00474100
- BH SORT7 GREATER THAN - MUST REARRANGE @V305032 00475100
- SORT4 BXH R5,R0,SORT2 ITERATE LOOP @V305032 00476100
- BR R13 AND EXIT. @V305032 00477100
- SPACE 00478100
- DS 0H LOOP TO FIND WHERE STUFF SHOULD GO @V305032 00479100
- SORT6 CL R6,0(,R5) COMPARE 1ST HALF OF FILENAME @V305032 00480100
- BH SORT7 IF HIGH KEEP CHECKING @V305032 00481100
- BL SORT8 IF LOW WE KNOW WHERE TO PUT STUFF@V305032 00482100
- CLC FN2(TWELVE,R4),FN2(R5) IF =, CHECK NEXT 12 BYTES@V305032 00483100
- BL SORT8 IF LESS WE KNOW WHAT TO DO @V305032 00484100
- SORT7 BXLE R5,R2,SORT6 ITERATE LOOP @V305032 00485100
- SORT8 SR R5,R2 BACK OFF 40 BYTES ON THE LAST FST@V305032 00486100
- MVC WORK40(FORTY),0(R4) SAVE THE ONE OUT OF ORDER @V305032 00487100
- LR R6,R4 SET R6 FOR MVCL @V305032 00488100
- LR R7,R5 AND R7 @V305032 00489100
- SR R7,R6 (THE COUNT) @V305032 00490100
- LA R14,FORTY(,R6) WHERE TO MOVE FROM @V305032 00491100
- LR R15,R7 COUNT = THE SAME @V305032 00492100
- MVCL R6,R14 MOVE IT ALL UP, AND @V305032 00493100
- MVC 0(FORTY,R5),WORK40 PUT "NONCONFORMIST" AT END @V305032 00494100
- LR R5,R4 NOW SET R5 AGAIN @V305032 00495100
- AR R5,R2 PLUS 40 TO COMPENSATE FOR BXH @V305032 00496100
- B SORT4 GO CHECK FOR COMPLETION ETC. @V305032 00497100
- SPACE 00498100
- DS 0D ALIGN "BUFF1600" AND LTORG. @VM03111 00499100
- BUFF1600 DC 1600X'00' TWO 800-BYTE BUFFERS @VM03111 00500100
- WORK40 EQU BUFF1600 40-BYTE WORK AREA @VM03111 00501100
- SPACE 00502100
- LTORG @V305032 00503100
- SPACE 00504100
- * NEEDED EQUATES: 00505100
- SDISK EQU C'S' 'S' FOR SYSTEM DISK (S-DISK) @V305032 00506100
- M7 EQU B'0111' LOW 3 BYTES (FOR ICM USE) @V305032 00507100
- RC36 EQU 36 FOR RETURN-CODE = 36 @V305032 00508100
- ONE EQU 1 @V305032 00509100
- FOUR EQU 4 @V305032 00510100
- EIGHT EQU 8 @V305032 00511100
- TWELVE EQU 12 @V305032 00512100
- TWENTY EQU 20 TWENTY FST ENTRIES PER FST HYPERBLOCK @V305032 00513100
- FORTY EQU 40 LENGTH OF ONE FST ENTRY @V305032 00514100
- FN2 EQU 4 2ND HALF OF FILENAME @V305032 00516100
- B800 EQU 800 BLOCK SIZE FOR CMS = 800 @V305032 00517100
- B801 EQU 801 POINTER TO NEXT FST HYPERBLOCK @V305032 00518100
- B760 EQU 760 LAST FST IN A FST HYPERBLOCK @V305032 00519100
- B764 EQU 764 ABOVE + 4 = 2ND HALF OF FILENAME @V305032 00520100
- SPACE 00521100
- END$RELU DS 0D WHEN LOADING WITH ACCESS MUST ¬ EXCEED 10000 @V305032 00522100
- EJECT 00523100
- NUCON , @V305032 00524100
- ADT , @V305032 00525100
- OSFST , @V305032 00526100
- CMSCB , @V305032 00527100
- FVS , @V305032 00528100
- SPACE 00529100
- REGEQU , @V305032 00530100
- SPACE 00531100
- END 00532100
ibm/vm370-lib/cms/dmsalu.assemble_src.txt · Last modified: 2023/08/06 13:35 by Site Administrator