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