SMN TITLE 'DMSSMN (CMS) VM/370 - RELEASE 6' 00001000 SPACE 2 00002000 *. 00003000 * 00004000 * 00005000 *MODULE NAME - 00006000 * 00007000 * DMSSMN 00008000 * 00009000 *FUNCTION - 00010000 * 00011000 * THE DMSSMN ROUTINE PROCESSES OS FREEMAIN AND GETMAIN 00012000 * MACROS, AND CMS CALLS TO DMSSMNSB (STRINIT). 00013000 * 00014000 *ATTRIBUTES - 00015000 * 00016000 * NUCLEUS RESIDENT, RE-ENTRANT 00017000 * 00018000 *ENTRY POINTS - 00019000 * 00020000 * DMSSMN10 (SVC 10) -- GETMAIN AND FREEMAIN, R TYPE, FREEPOOL 00021000 * 00022000 * DMSSMN5 (SVC 5) -- FREEMAIN V,A=ADDRESS 00023000 * 00024000 * DMSSMN4 (SVC 4) -- GETMAIN (VC, RU, EC TYPES) 00025000 * 00026000 * DMSSMNSB, -- STRINIT 00027000 * 00028000 *ENTRY CONDITIONS - 00029000 * 00030000 * DMSSMN10,DMSSMN5,DMSSMN4 -- THE REGISTERS ARE SET UP BY THE OS 00031000 * MACROES GETMAIN, FREEMAIN, AND FREEPOOL. 00032000 * 00033000 * DMSSMNSB -- BALR R14,R15 00034000 * 00035000 *EXIT CONDITIONS - 00036000 * 00037000 * NORMAL - 00038000 * THE SPECIFIED STORAGE IS ALLOCATED OR RELEASED, AND CONTROL 00039000 * RETURNS TO THE USER. 00040000 * 00041000 * ERROR - 00042000 * IF THE REQUEST CANNOT BE SATISFIED, AND IT IS UNCONDITIONAL, 00043000 * THEN MESSAGE DMSSMN109S OR DMSSMN133S IS TYPED OUT AND 00044000 * THE USER IS ABENDED. 00045000 * 00046000 *CALLS TO OTHER ROUTINES - 00047000 * 00048000 * DMSSVT, DMSSAB,DMSFRE,DMSLGTA,DMSSLNAB 00049000 * 00050000 *EXTERNAL REFERENCES - 00051000 * 00052000 * NUCON, SSAVE 00053000 * 00054000 *TABLES / WORKAREAS - 00055000 * 00056000 * MACLIB DIRECTORY TABLES ARE FREED BY DMSSMNCL 00057000 * 00058000 *REGISTER USAGE - 00059000 * 00060000 * R12 = BASE 00061000 * R0 - R11 = SCRATCH AND WORK REGISTERS 00062000 * R13 - SYSTEM SAVE AREA 00063000 * 00064000 *OPERATION - 00065000 * 00066000 * IF AN OS GETMAIN OR FREEMAIN IS ISSUED WITH AN R 00067000 * OPERAND, CONTROL IS PASSED VIA AN SVC10 TO THE SVC10 00068000 * ENTRY POINT IN DMSSMN. DMSSMN ROUNDS THE AMOUNT OF 00069000 * STORAGE SPECIFIED UP TO A DOUBLEWORD AND DETERMINES IF 00070000 * A GETMAIN OR FREEMAIN WAS ISSUED. IF A GETMAIN WAS 00071000 * ISSUED, THE GETBLK ROUTINE IN DMSSMN IS CALLED TO GET A 00072000 * FREE STORAGE BLOCK. CONTROL IS THEN RETURNED TO THE 00073000 * USER WITH THE ADDRESS OF THE FREE STORAGE IN REGISTER 00074000 * ONE. IF A FREEMAIN WAS ISSUED, THE FREEBLK ROUTINE IN 00075000 * DMSSMN IS CALLED TO RELEASE A BLOCK OF STORAGE AND 00076000 * CONTROL IS RETURNED TO THE USER. 00077000 * 00078000 * IF AN OS GETMAIN IS ISSUED WITHOUT AN R OPERAND, 00079000 * CONTROL IS PASSED VIA AN SVC4 TO THE SVC4 ENTRY 00080000 * POINT IN DMSSMN. IF THE GETMAIN WAS NOT VARIABLE, 00081000 * DMSSMN ROUNDS UP THE AMOUNT OF STORAGE SPECIFIED AND 00082000 * CALLS THE GETBLK ROUTINE IN DMSSMN TO GET A FREE 00083000 * STORAGE BLOCK. CONTROL IS THEN RETURNED TO THE USER 00084000 * WITH THE ADDRESS OF THE FREE BLOCK. IF THE GETMAIN WAS 00085000 * CONDITIONAL AND THERE WAS AN ERROR, AN ERROR CODE IS 00086000 * PASSED BACK TO THE USER. IF THE GETMAIN WAS VARIABLE, 00087000 * DMSSMN PROCEEDS AS ABOVE EXCEPT THAT IT SEARCHES THE 00088000 * FREE CHAIN TO DETERMINE HOW MUCH STORAGE IS AVAILABLE 00089000 * BEFORE CALLING THE GETBLK ROUTINE. 00090000 * 00091000 * IF AN OS FREEMAIN IS ISSUED WITHOUT AN R OPERAND, 00092000 * CONTROL IS PASSED VIA AN SVC5 TO THE SVC5 ENTRY POINT 00093000 * IN DMSSMN. DMSSMN ROUNDS THE AMOUNT TO BE FREED UP TO 00094000 * A DOUBLEWORD AND CALLS THE FREEBLK ROUTINE TO FREE THE 00095000 * SPECIFIED STORAGE. CONTROL IS THEN RETURNED TO USER. 00096000 * 00097000 * IF A CMS ROUTINE CALLS THE STORAGE INITIALIZATION 00098000 * ROUTINE (STRINIT) IN DMSSMN, STRINIT 00099000 * RESETS THE FREE STORAGE EXTENTS AND EFFECTIVELY FREES 00100000 * ANY STORAGE THAT WAS PREVIOUSLY GETMAINED. IF ANY 00101000 * ERRORS ARE ENCOUNTERED IN RESETTING THE EXTENTS AN 00102000 * ABEND IS ISSUED, OTHERWISE CONTROL IS RETURNED TO THE 00103000 * USER. 00104000 * 00105000 * THE GETBLK ROUTINE IN DMSSMN SEARCHES THE FREE CHAIN 00106000 * FOR A BLOCK OF FREE STORAGE LARGE ENOUGH TO MEET THE 00107000 * CALLER'S NEEDS. WHEN IT FINDS ONE, IT EITHER RESETS 00108000 * THE BLOCK LENGTH OR, IF ALL THE BLOCK IS NEEDED, 00109000 * DELETES IT AND RETURNS CONTROL TO THE CALLER. IF A 00110000 * LARGE ENOUGH BLOCK CANNOT BE FOUND AND THE GETMAIN IS 00111000 * UNCONDITIONAL, AN ABEND IS ISSUED. IF A LARGE ENOUGH 00112000 * BLOCK CANNOT BE FOUND AND THE GETMAIN WAS CONDITIONAL, 00113000 * CONTROL IS RETURNED TO THE CALLER WITH AN ERROR CODE IN 00114000 * REGISTER 15. 00115000 * 00116000 * THE FREEBLK ROUTINE IN DMSSMN RETURNS A BLOCK OF 00117000 * STORAGE TO THE FREE CHAIN. IF THE ADDRESS PASSED IT IS 00118000 * BAD, THE FREEBLK ROUTINE ISSUES AN ABEND. IF THE BLOCK 00119000 * IT IS FREEING IS CONTIGUOUS TO ANY OTHER FREE BLOCK IN 00120000 * CORE, THE FREEBLK ROUTINE WILL COMBINE THE TWO BLOCKS. 00121000 * UPON SUCCESSFUL COMPLETION CONTROL IS RETURNED TO THE 00122000 * CALLER. 00123000 * 00124000 * PREVIOUS STORAGE ALLOCATION REQUESTS MAINTAIN A 00125000 * CHAIN OF POINTERS TO DISCONNECTED AREAS OF FREE CORE 00126000 * EACH LINK +00 IS FREPTR - POINTER TO NEXT LINK 00127000 * ZERO IF LAST IN CHAIN 00128000 * +04 IS FRELEN - LENGTH OF FREE AREA 00129000 * FRELST POINTS TO THE FIRST LINK IN THE CHAIN 00130000 * OF DISCONNECTED AREAS 00131000 * FSTFRE HOLDS THE ORIGINAL BEGINNING OF USER FREE STORAGE 00132000 * LENFRE HOLDS THE LENGTH OF THAT AREA 00133000 * 00134000 * NUCON LOCATION MAINHIGH HOLDS THE LOWER BOUND FOR EXTEND. 00135000 * NUCON LOCATION FREELOWE (LOWEXT) HOLDS THE UPPER BOUND FOR 00136000 * GETMAIN. 00137000 * 00138000 * 00139000 * 00140000 *. 00141000 EJECT 00142000 DMSSMN START X'00' IN THE BEGINNING ... 00143000 ENTRY DMSSMN4,DMSSMN5,DMSSMN10 00144000 ENTRY DMSSMNSB @VA04199 00145000 USING NUCON,R0 00146000 USING SSAVE,R13 00147000 SPACE 3 00148000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00149000 * 00150000 * SVC 10 - GETMAIN AND FREEMAIN (MODE R) 00151000 * (FREEPOOL IS ALSO SIMULATED AS SVC 10) 00152000 * 00153000 * ON ENTRY: R0 = LENGTH OF BLOCK TO BE FREED 00154000 * OR ALLOCATED 00155000 * R1 -> BLOCK TO BE FREED (FREEMAIN ONLY) 00156000 * 00157000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00158000 SPACE 1 00159000 USING DMSSMN,R12 ESTABLISH COMMON ADDRESSABILITY @VA04199 00160000 DMSSMN10 LA R5,10 SAVE SVC NUMBER IN R5 @VA04199 00161000 L R13,CURRSAVE SET BASE REGISTER FOR SSAVE DSECT@VA04199 00162000 SPACE 1 00163000 LR R3,R0 GET SPECIFIED LENGTH @VA04199 00164000 CLI EGPR1,X'00' LOOK AT R1'S HIGH-ORDER BYTE @VA04199 00165000 BNE GET IF NOT ZERO THEN THIS IS GETMAIN @VA04199 00166000 SPACE 1 00167000 * FREEMAIN 00168000 BAL R2,ROUNDUP ROUND LENGTH TO A DOUBLEWORD @VA04199 00171000 BZR R14 IF IT'S ZERO, RETURN TO CALLER @VA04199 00172000 TM EGPR1+3,X'07' IS BLOCK ALIGNED ON A DBL WORD? @VA12358 00172300 BNZ ABEND9XX NO - ABEND X'90A' @VA12358 00172600 BAL R10,FREBLK OTHERWISE FREE THE BLOCK @VA04199 00173000 BR R14 RETURN @VA04199 00174000 SPACE 1 00175000 * GETMAIN 00176000 GET BAL R2,ROUNDUP ROUND LENGTH TO A DOUBLEWORD @VA04199 00177000 BZ ABEND8ZZ IF IT'S ZERO, THEN ABEND X'80A' @VA04199 00178000 OI OSSFLAGS,OSSMNU SET "UNCONDITIONAL" FLAG @VA04199 00179000 BAL R10,GETBLK NO - ALLOCATE THE BLOCK, IF POSS.@VA04199 00180000 ST R7,EGPR1 RETURN ITS ADDRESS VIA REGISTER 1@VA04199 00181000 BR 14 RETURN @VA04199 00182000 EJECT 00183000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00184000 * 00185000 * SVC 5 - FREEMAIN (MODES E AND V) 00186000 * 00187000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00188000 SPACE 1 00189000 USING *,R12 @VA04199 00190000 DMSSMN5 L R12,=A(DMSSMN) LOAD BASE ADDRESS @VA04199 00191000 USING DMSSMN,R12 ESTABLISH COMMON ADDRESSABILITY @VA04199 00192000 LA R5,5 SAVE SVC NUMBER IN R5 @VA04199 00193000 L R13,CURRSAVE SET BASE REGISTER FOR SSAVE DSECT@VA04199 00194000 SPACE 1 00195000 L R3,0(,R1) GET LENGTH OR V(LENGTH) @VA04199 00196000 LR R2,R1 (TEMPORARILY SAVE R1) @VA04199 00197000 L R1,4(,R1) GET V(ADDRESS AND LENGTH) @VA04199 00198000 TM 8(R2),MODE DETERMINE FREEMAIN MODE @VA04199 00199000 BZ FEMODE "E" MODE @VA04199 00200000 BM ABEND7XX UNRECOGNIZED - ABEND X'705' @VA04199 00201000 SPACE 1 00202000 * V MODE 00203000 L R3,4(,R1) GET LENGTH OF BLOCK TO BE FREED @VA04199 00204000 SPACE 1 00205000 * E MODE (OR V, FROM ABOVE) 00206000 FEMODE EQU * @VA12358 00207500 BAL R2,ROUNDUP ROUND LENGTH TO A DOUBLEWORD @VA04199 00209000 BZR R14 RETURN IF LENGTH IS ZERO @VA04199 00210000 TM 3(R1),X'07' IS BLOCK ALIGNED ON A DBL WORD? @VA12358 00210300 BNZ ABEND9XX IF NOT - ABEND X'905' @VA12358 00210600 L R1,0(,R1) GET ADDRESS OF BLOCK TO BE FREED @VA04199 00211000 BAL R10,FREBLK AND GO FREE IT @VA04199 00212000 BR R14 RETURN @VA04199 00213000 EJECT 00214000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00215000 * 00216000 * SVC 4 - GETMAIN (MODES EC, EU, VC, VU) 00217000 * 00218000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00219000 SPACE 1 00220000 USING *,R12 @VA04199 00221000 DMSSMN4 L R12,=A(DMSSMN) LOAD BASE ADDRESS @VA04199 00222000 USING DMSSMN,R12 ESTABLISH COMMON ADDRESSABILITY @VA04199 00223000 LA R5,4 SAVE SVC NUMBER IN R5 @VA04199 00224000 L R13,CURRSAVE SET BASE REGISTER FOR SSAVE DSECT@VA04199 00225000 SPACE 1 00226000 XC EGPR15,EGPR15 CLEAR ERROR RETURN CODE @VA04199 00227000 OI OSSFLAGS,OSSMNU SET "UNCONDITIONAL" FLAG @VA04199 00228000 TM 8(R1),CONDX CONDITIONAL GETMAIN (EC, VC)? @VA04199 00229000 BZ UNCO NO - SKIP @VA04199 00230000 NI OSSFLAGS,X'FF'-OSSMNU YES - RESET THE FLAG @VA04199 00231000 UNCO TM 8(R1),MODE DETERMINE GETMAIN MODE @VA04199 00232000 BO GVMODE "VU"/"VC" MODES @VA04199 00233000 BM ABEND7XX UNRECOGNIZED - ABEND X'704' @VA04199 00234000 SPACE 1 00235000 * EU OR EC MODE 00236000 L R3,0(,R1) GET REQUESTED LENGTH @VA04199 00237000 BAL R2,ROUNDUP AND ROUND IT TO A DOUBLEWORD @VA04199 00238000 BNZ ALLOC CONTINUE IF NOT ZERO @VA14218 00239000 TM 8(R1),CONDX CONDITIONAL GETMAIN ? @VA14218 00239100 BZ ABEND8ZZ NO, ABEND X'804' @VA14218 00239200 MVI EGPR15+3,QUATRE SET RETURN CODE 4 @VA14218 00239300 BR R14 AND RETURN TO CALLER @VA14218 00239400 ALLOC EQU * CONTINUE @VA14218 00239500 BAL R10,GETBLK ALLOCATE THE BLOCK IF POSSIBLE @VA04199 00240000 CLI EGPR15+3,QUATRE WAS A BLOCK FOUND? @VA04199 00241000 BER R14 NO; TELL USER VIA R15 ("EC" ONLY)@VA04199 00242000 L R2,4(,R1) SET ADDRESS OF ALLOCATED BLOCK @VA04199 00243000 ST R7,0(,R2) INTO CALLER'S PARAMETER LIST @VA04199 00244000 BR R14 RETURN @VA04199 00245000 EJECT 00246000 * "VU" OR "VC" MODE GETMAIN 00247000 * NOTE: THIS ROUTINE ALLOCATES THE BLOCK ITSELF - 00248000 * IT DOES NOT CALL "GETBLK" 00249000 GVMODE L R4,0(,R1) GET V(LENGTH LIST) @VA04199 00250000 L R3,0(,R4) GET THE MINIMUM LENGTH REQUESTED @VA04199 00251000 BAL R2,ROUNDUP ROUND IT TO A DOUBLEWORD @VA04199 00252000 LR R0,R3 AND SAVE IT IN R0 @VA04199 00253000 L R3,4(,R4) GET THE MAXIMUM LENGTH REQUESTED @VA04199 00254000 BAL R2,ROUNDUP ROUND IT TO A DOUBLEWORD @VA04199 00255000 BNZ NOTZERO IF MAX LENGTH NOT 0 GO ON @VA14218 00256000 CR R3,R0 ARE MIN AND MAX EQUAL TO 0 ? @VA14218 00256100 BNE ABEND8ZZ NO, ABEND X'804' @VA14218 00256200 L R7,=X'00020000' ADDRESS IS PARTITION START @VA14218 00256300 B SETUSER ...AND PREPARE TO RETURN @VA14218 00256400 NOTZERO EQU * @VA14218 00256500 SPACE 1 00257000 SR R8,R8 ZERO R8 FOR LATER @VA04199 00258000 LA R7,MAINLIST R7 -> V(FIRST FREE BLOCK) @VA04199 00259000 SPACE 1 00260000 NEXTS LR R9,R7 @VA04199 00261000 ICM R7,B'1111',FREPTR(R9) R7 -> NEXT (OR 1ST) FB @VA04199 00262000 BZ MN IF NONE LEFT, TRY HIMAIN @VA04199 00263000 C R0,FRELEN(,R7) COMPARE MIN WITH FREE AREA SIZE @VA04199 00264000 BH NEXTS FREE AREA TOO SMALL, GET NEXT ONE@VA04199 00265000 LR R8,R9 R8 -> LAST BLOCK, FOR LATER @VA04199 00266000 L R0,FRELEN(,R7) SET MIN TO ACTUAL SIZE OF BLOCK @VA04199 00267000 CR R3,R0 COMPARE MAX WITH ACTUAL (NEW MIN)@VA04199 00268000 BH NEXTS MAX STILL > NEW MIN; KEEP LOOKING@VA04199 00269000 SPACE 1 00270000 BAL R10,ALLOCATE MAX <= ACTUAL; GO ALLOCATE IT @VA04199 00271000 B SETUSER RETURN @VA04199 00272000 SPACE 1 00273000 MN L R7,MAINHIGH GET ADDRESS OF AVAILABLE STORAGE @VA04199 00274000 LH R2,FRERESPG GET # OF PAGES TO SAVE FOR CMS @VA04199 00275000 SLL R2,12 CONVERT IT TO # OF BYTES @VA04199 00276000 LA R2,X'800'(,R2) ADD A HALF PAGE (FOR FORTHX !?) @VA04199 00277000 TM OSSFLAGS,COMPSWT CALLED FROM A COMPILER? @VA04911 00278000 BZ GLOBLIBC RESERVE LESS DIRECTORY SPACE @VA10305 00279000 A R2,TOTLIBS ALSO BYTES FROM GLOBALED LIBES @VA04102 00280000 N R2,MASKB ROUND UP @VA04102 00281000 B MNM ALL LIBRARIES ACCOUNTED FOR @VA10305 00281120 GLOBLIBC EQU * @VA10305 00281240 CLC TOTLIBS,TWOPAGES DIRECTORIES EXCEED TWO PAGES? @VA10305 00281360 BL MNM NO, ASSUME SUFFICIENT SPACE @VA10305 00281480 A R2,TOTLIBS YES, ALLOT MORE DIRECTORY SPACE @VA10305 00281600 S R2,TWOPAGES BUT NOT TOO MUCH @VA10305 00281720 N R2,MASKB ROUND UP @VA10305 00281840 MNM L R6,FREELOWE HI END OF AVAILABLE FREE STORAGE @VA04911 00282000 SR R6,R7 MINUS THE LOW END, @VA04199 00283000 SR R6,R2 MINUS AMOUNT TO SAVE FOR CMS, @VA04199 00284000 CR R6,R0 CAN BE USED; COMPARE IT WITH MIN @VA04199 00285000 BNL MNOK >= MIN; GO CHECK AGAINST MAX @VA04199 00286000 LTR R8,R8 < MIN; WAS A PREVIOUS BLOK FOUND?@VA04199 00287000 BZ NOBLOCKV NO - ABEND OR RETURN WITH ERROR @VA04199 00288000 SPACE 1 00289000 * NEW MIN WON'T FIT WITHIN MAINHIGH, BUT SINCE A PREVIOUS 00290000 * FREE BLOCK OF THAT SIZE EXISTS, WE USE IT: 00291000 L R7,FREPTR(,R8) R7 -> BLOCK THAT WAS FOUND BEFORE@VA04199 00292000 MVC FREPTR(4,R8),FREPTR(R7) REMOVE IT FROM CHAIN @VA04199 00293000 LR R3,R0 RESTORE LENGTH FOR USE AT SETUSER@VA04199 00294000 B SETUSER @VA04199 00295000 EJECT 00296000 MNOK CR R6,R3 AVAIL >= MIN; HOW ABOUT MAX? @VA04199 00297000 BNL GETIT AVAIL >= MAX, SO JUST USE MAX @VA04199 00298000 LR R3,R6 < MAX, SO TAKE ALL WE CAN GET @VA04199 00299000 GETIT LR R6,R7 ADDRESS OF ALLOCATED BLOCK, @VA04199 00300000 ALR R6,R3 PLUS ITS LENGTH, @VA04199 00301000 ST R6,MAINHIGH IS MAINHIGH'S NEW VALUE @VA04199 00302000 SPACE 1 00303000 SETUSER L R2,4(,R1) R2 -> WHERE TO PUT ADDRESS,LENGTH@VA04199 00304000 ST R7,0(,R2) SET ADDRESS OF BLOCK, @VA04199 00305000 ST R3,4(,R2) AND ITS LENGTH, IN USER'S AREA @VA04199 00306000 BR R14 RETURN @VA04199 00307000 SPACE 2 00308000 NOBLOCKV EQU * @VA14218 00309000 LTR R0,R0 @VA14218 00309100 BNZ MINNOT0 IF NO BLOCK AND MIN LENGTH @VA14218 00309200 L R7,=X'00020000' ADDRESS PARTITION START @VA14218 00309300 LA R3,0 ...AND 0 LENGTH @VA14218 00309400 B SETUSER ...AND PREPARE TO RETURN @VA14218 00309500 MINNOT0 EQU * @VA14218 00309600 TM OSSFLAGS,OSSMNU UNCONDITIONAL REQUEST ? @VA14218 00309700 BO ABEND8XX YES - THEN ABEND X'804' @VA04199 00310000 MVI EGPR15+3,QUATRE NO - TELL USER VIA R15 @VA04199 00311000 BR R14 RETURN WITH ERROR CODE IN EGPR15 @VA04199 00312000 EJECT 00313000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00314000 * 00315000 * ALLOCATE A BLOCK OF STORAGE 00316000 * (NOTE: THIS ROUTINE BRANCHES DIRECTLY TO "ABEND8XX" 00317000 * IF AN UNCONDITIONAL REQUEST CANNOT BE SATISFIED) 00318000 * 00319000 * ON ENTRY: R3 = SIZE OF BLOCK DESIRED 00320000 * ON EXIT: R7 -> ALLOCATED BLOCK 00321000 * 00322000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00323000 SPACE 1 00324000 GETBLK LA R7,MAINLIST R7 -> V(FIRST FREE BLOCK) @VA04199 00325000 SPACE 1 00326000 NEXTG LR R9,R7 @VA04199 00327000 ICM R7,B'1111',FREPTR(R9) R7 -> NEXT (OR 1ST) FB @VA04199 00328000 BZ CKHIMAIN IF NONE LEFT, TRY HIMAIN @VA04199 00329000 C R3,FRELEN(,R7) TEST SIZE OF FREE AREA @VA04199 00330000 BH NEXTG IF NOT BIG ENOUGH GET NEXT BLOCK @VA04199 00331000 SPACE 1 00332000 * NOTE: "VU"/"VC" GETMAIN MAY ENTER HERE (R7, R9 OK): 00333000 ALLOCATE BE DESBLK IF WHOLE AREA USED, DESTROY BLOCK@VA04199 00334000 SPACE 1 00335000 * REQUESTED LENGTH IS SHORTER THAN THIS BLOCK, 00336000 * SO LEAVE LEFTOVER PART IN THE CHAIN: 00337000 LR R6,R7 ADDRESS OF BLOCK, @VA04199 00338000 ALR R6,R3 PLUS REQUESTED LENGTH, @VA04199 00339000 ST R6,FREPTR(,R9) EQUALS ADDRESS OF LEFTOVER @VA04199 00340000 MVC FREPTR(4,R6),FREPTR(R7) SET LEFTOVER'S POINTER @VA04199 00341000 L R8,FRELEN(,R7) OLD LENGTH OF THIS BLOCK, @VA04199 00342000 SLR R8,R3 MINUS REQUESTED LENGTH, @VA04199 00343000 ST R8,FRELEN(,R6) EQUALS NEW LENGTH OF LEFTOVER @VA04199 00344000 XC EGPR15,EGPR15 SET RETURN CODE @VA11172 00344100 BR R10 RETURN @VA04199 00345000 SPACE 1 00346000 * LENGTH OF THIS BLOCK = REQUESTED LENGTH, 00347000 * SO REMOVE THE WHOLE BLOCK FROM THE CHAIN: 00348000 DESBLK MVC FREPTR(4,R9),FREPTR(R7) @VA04199 00349000 BR R10 RETURN @VA04199 00350000 SPACE 1 00351000 CKHIMAIN L R7,MAINHIGH GET ADDRESS OF AVAILABLE STORAGE @VA04199 00352000 LH R2,FRERESPG GET # OF PAGES TO SAVE FOR CMS @VA04199 00353000 SLL R2,12 CONVERT IT TO # OF BYTES @VA04199 00354000 TM OSSFLAGS,COMPSWT CALLED FROM A COMPILER? @VA04911 00355000 BZ GLOBLIBU RESERVE LESS DIRECTORY SPACE @VA10305 00356000 A R2,TOTLIBS ALSO BYTE COUNT FROM GLOBALED @VA04102 00357000 N R2,MASKB ROUND UP @VA04102 00358000 B CKM ALL LIBRARIES ACCOUNTED FOR @VA10305 00358120 GLOBLIBU EQU * @VA10305 00358240 CLC TOTLIBS,TWOPAGES DIRECTORIES EXCEED TWO PAGES? @VA10305 00358360 BL CKM NO, ASSUME SUFFICIENT SPACE @VA10305 00358480 A R2,TOTLIBS YES, ALLOT MORE DIRECTORY SPACE @VA10305 00358600 S R2,TWOPAGES BUT NOT TOO MUCH @VA10305 00358720 N R2,MASKB ROUND UP @VA10305 00358840 CKM L R6,FREELOWE HI END OF AVAILABLE FREE STORAGE @VA04911 00359000 SR R6,R7 MINUS THE LOW END, @VA04199 00360000 SR R6,R2 MINUS AMOUNT TO SAVE FOR CMS, @VA04199 00361000 CR R6,R3 CAN BE USED; COMPARE IT WITH MIN @VA04199 00362000 BL NOBLOCK IF NOT ENOUGH, SET ERROR RETURN @VA04199 00363000 LR R6,R7 ADDRESS OF ALLOCATED BLOCK, @VA04199 00364000 ALR R6,R3 PLUS ITS LENGTH, @VA04199 00365000 ST R6,MAINHIGH IS MAINHIGH'S NEW VALUE @VA04199 00366000 XC EGPR15,EGPR15 SET RETURN CODE @VA11172 00366100 BR R10 RETURN @VA04199 00367000 SPACE 1 00368000 NOBLOCK TM OSSFLAGS,OSSMNU UNCONDITIONAL GETMAIN? @VA04199 00369000 BO ABEND8XX ABEND IF SO (X'804' OR X'80A') @VA04199 00370000 MVI EGPR15+3,QUATRE IF NOT, INFORM USER VIA R15 @VA04199 00371000 BR R10 RETURN @VA04199 00372000 EJECT 00373000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00374000 * 00375000 * RETURN A FREED BLOCK ("FB") TO THE CHAIN OF 00376000 * AVAILABLE FREE BLOCKS ("AFB") 00377000 * 00378000 * ON ENTRY: R1 -> FREED BLOCK 00379000 * R3 = LENGTH OF FREED BLOCK 00380000 * 00381000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00382000 SPACE 1 00383000 FREBLK LA R1,0(,R1) CLEAR R1'S HIGH-ORDER BYTE @VA04199 00384000 C R1,MAINSTRT IS V(FB) < START OF GETMAIN AREA?@VA04199 00385000 BL ABENDAXX ABEND IF SO (X'A05' OR X'A0A') @VA04199 00386000 LA R8,MAINLIST R8 -> V(FIRST AFB) @VA04199 00387000 SPACE 1 00388000 NEXTF LR R9,R8 @VA04199 00389000 ICM R8,B'1111',FREPTR(R9) R8 -> NEXT (OR 1ST) AFB@VA04199 00390000 BZ CKMAIN NO MORE AFB'S - GO CHECK HIMAIN @VA04199 00391000 CR R8,R1 IS AFB > FB ? @VA04199 00392000 BH FRABVE YES, FB MUST BE INSERTED IN CHAIN@VA04199 00393000 LR R6,R8 @VA04199 00394000 AL R6,FRELEN(,R8) R6 -> END OF AFB @VA04199 00395000 CR R1,R6 DOES FB OVERLAP THIS AFB? @VA04199 00396000 BL ABENDAXX YES - ABEND X'A05' OR X'A0A' @VA04199 00397000 BH NEXTF NOWHERE NEAR - TRY AGAIN @VA04199 00398000 SPACE 1 00399000 * THE FB IS CONTIGUOUS WITH THE END OF THE AFB, 00400000 * SO WE JUST MERGE THEM INTO ONE AFB: 00401000 L R7,FRELEN(,R8) GET LENGTH OF AFB, @VA04199 00402000 ALR R7,R3 PLUS LENGTH OF FB @VA04199 00403000 LR R6,R7 @VA04199 00404000 ALR R6,R8 R6 -> END OF MERGED BLOCK @VA04199 00405000 ICM R2,B'1111',FREPTR(R8) IS THERE ANOTHER AFB? @VA04199 00406000 BNZ CKOVRLAP YES - GO SEE IF FB OVERLAPS IT @VA04199 00407000 C R6,MAINHIGH NO; DOES IT OVERLAP MAINHIGH? @VA04199 00408000 BL KPBLK NO - IT'S WITHIN MAINHIGH @VA04199 00409000 BH ABENDAXX YES - ABEND X'A05' OR X'A0A' @VA04199 00410000 ST R8,MAINHIGH JUST RESET MAINHIGH; THE FB @VA04199*00411000 WAS CONTIGUOUS TO IT @VA04199 00412000 SR 15,15 THE LAST AFB IS NOW AT @VA04199 00413000 ST R15,FREPTR(,R9) THE END OF THE CHAIN @VA04199 00414000 BR 10 RETURN @VA04199 00415000 SPACE 1 00416000 CKOVRLAP CR R6,R2 DOES FB OVERLAP THE NEXT AFB? @VA04199 00417000 BH ABENDAXX ABEND IF SO (X'A05' OR X'A0A') @VA04199 00418000 BL KPBLK NO - THERE'S A GAP @VA04199 00419000 SPACE 1 00420000 * THE NEXT AFB IS CONTIGUOUS WITH THE END OF THE FB, 00421000 * SO WE MERGE THAT IN, TOO: 00422000 MVC FREPTR(4,R8),FREPTR(R2) @VA04199 00423000 AL R7,FRELEN(,R2) ADD ITS LENGTH TO OUR TOTAL @VA04199 00424000 SPACE 1 00425000 KPBLK ST R7,FRELEN(,R8) SET THE LENGTH OF THE NEW AFB @VA04199 00426000 BR 10 RETURN @VA04199 00427000 EJECT 00428000 CKMAIN LR R7,R1 @VA04199 00429000 ALR R7,R3 R7 -> END OF FB @VA04199 00430000 C R7,MAINHIGH DOES THE FB OVERLAP MAINHIGH? @VA04199 00431000 BL ADDBLK NO - IT'S WITHIN MAINHIGH @VA04199 00432000 BH ABENDAXX YES - ABEND X'A05' OR X'A0A' @VA04199 00433000 ST R1,MAINHIGH JUST RESET MAINHIGH; THE FB @VA04199*00434000 WAS CONTIGUOUS TO IT @VA04199 00435000 BR 10 RETURN @VA04199 00436000 SPACE 1 00437000 * THE FB MUST BE INSERTED BETWEEN TWO AFB'S IN THE CHAIN, 00438000 * OR POSSIBLY AT THE BEGINNING OF THE CHAIN: 00439000 FRABVE LR R6,R1 @VA04199 00440000 ALR R6,R3 R6 -> END OF THE FB @VA04199 00441000 CR R6,R8 DOES THE FB OVERLAP THE NEXT AFB?@VA04199 00442000 BL ADDBLK NO - GO INSERT IT AS A NEW AFB @VA04199 00443000 BH ABENDAXX YES - ABEND X'A05' OR X'A0A' @VA04199 00444000 SPACE 1 00445000 * THE NEXT AFB IS CONTIGUOUS WITH THE END OF THE FB, 00446000 * SO WE MERGE THEM TOGETHER: 00447000 ST R1,FREPTR(,R9) LAST AFB -> THIS (NEW) AFB @VA04199 00448000 AL R3,FRELEN(,R8) TOTAL LENGTH = L'FB + L'AFB @VA04199 00449000 ST R3,FRELEN(,R1) SET THE PROPER LENGTH AND @VA04199 00450000 MVC FREPTR(4,R1),FREPTR(R8) ADDRESS FOR NEW AFB @VA04199 00451000 BR 10 RETURN @VA04199 00452000 SPACE 1 00453000 * THE FB IS NOT CONTIGUOUS TO ANYTHING, 00454000 * SO WE MAKE A NEW AFB OUT OF IT: 00455000 ADDBLK ST R1,FREPTR(,R9) LAST AFB -> THIS NEW AFB @VA04199 00456000 ST R8,FREPTR(,R1) THIS NEW AFB -> NEXT AFB @VA04199 00457000 ST R3,FRELEN(,R1) WE MUSTN'T FORGET OUR SIZE @VA04199 00458000 BR 10 RETURN @VA04199 00459000 EJECT 00460000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00461000 * 00462000 * SUBROUTINE TO ROUND THE VALUE IN REGISTER 3 00463000 * TO A DOUBLEWORD 00464000 * 00465000 * MAXIMUM FREE-BLOCK SIZE (MAXBLK) FOR A 16-MEGABYTE 00465100 * SYSTEM IS EQUAL TO VMSIZE LESS: 00465200 * 00465300 * 276K RESERVED FOR CMS SYSTEM FREE STORAGE USE, 00465400 * 128K FOR THE CMS NUCLEUS, AND 00465500 * 12K FOR LOADER TABLES. 00465600 * 00465700 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00466000 SPACE 1 00467000 ROUNDUP LA R3,0(,R3) CLEAR ANY HIGH-ORDER BYTE @VA04199 00468000 C R3,MAXBLK GREATER THAN MAXIMUM POSSIBLE? @VA04199 00469000 BL ADD7 NO; SKIP @VA04199 00470000 L R3,MAXBLK YES; THEN RESET IT TO MAXIMUM @VA04199 00471000 ADD7 LA R3,7(,R3) @VA04199 00472000 N R3,MASKB ROUND IT OFF (SETTING COND CODE) @VA04199 00473000 BR R2 RETURN @VA04199 00474000 EJECT 00475000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00476000 * 00477000 * ABENDS FOR GETMAIN AND FREEMAIN 00478000 * 00479000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00480000 SPACE 1 00481000 ABEND7XX LA R5,X'700'(,R5) UNSUPPORTED GETMAIN/FREEMAIN @VA04199 00482000 B MSG1 OPTION @VA04199 00483000 SPACE 1 00484000 ABEND8ZZ LA R5,X'800'(,R5) REQUESTED GETMAIN LENGTH = 0 @VA04199 00485000 B MSG1 @VA04199 00486000 SPACE 1 00487000 ABEND9XX LA R5,X'900'(,R5) BLOCK TO BE FREED IS NOT @VA04199 00488000 B MSG1 ON A DOUBLEWORD BOUNDARY @VA04199 00489000 SPACE 1 00490000 ABENDAXX LA R5,X'A00'(,R5) BLOCK TO BE FREED OVERLAPS @VA04199*00491000 AN EXISTING FREE AREA @VA04199 00492000 SPACE 1 00493000 MSG1 DMSERR TEXT='INVALID GETMAIN OR FREEMAIN SPECIFICATION', @VA04199*00494000 NUM=133,LET=S @VA04199 00495000 B ABEND @VA04199 00496000 SPACE 1 00497000 ABEND8XX LA R5,X'800'(,R5) REQUESTED GETMAIN LENGTH @VA04199*00498000 IS GREATER THAN AVAILABLE @VA04199 00499000 SPACE 1 00500000 DMSERR TEXT='VIRTUAL STORAGE CAPACITY EXCEEDED', @VA04199*00501000 NUM=109,LET=S @VA04199 00502000 SPACE 1 00503000 ABEND ABEND (R5) @VA04199 00504000 EJECT 00505000 * EACH BLOCK OF FREE STORAGE CONTAINS, IN ITS FIRST TWO 00506000 * WORDS, A POINTER TO THE NEXT FREE BLOCK IN THE CHAIN, 00507000 * AND ITS OWN LENGTH IN BYTES: 00508000 FREPTR EQU 0 DISPLACEMENT FOR THE POINTER @VA04199 00509000 FRELEN EQU 4 DISPLACEMENT FOR THE LENGTH @VA04199 00510000 SPACE 1 00511000 * GETMAIN/FREEMAIN MODE BITS: 00512000 MODE EQU X'C0' ("E" = X'00', "V" = X'C0') @VA04199 00513000 CONDX EQU X'20' CONDITIONAL GETMAIN ("EC", "VC") @VA04199 00514000 SPACE 1 00515000 QUATRE EQU 4 RET. CODE IF COND. GETMAIN FAILS @VA04199 00516000 SPACE 1 00517000 DS 0F @VA04199 00518000 MASKB DC X'00FFFFF8' MASK FOR ROUNDING TO A DOUBLEWORD@VA04199 00519000 MAXBLK DC X'00F98000' MAXIMUM POSSIBLE FREE BLOCK SIZE @VA07758 00520000 TWOPAGES DC F'8192' X'1000' PER PAGE @VA10305 00520500 EJECT 00521000 ********************************************************************* 00522000 * 00523000 * 'STORAGE HANDLER INITIALIZATION' 00524000 * ******************************* 00525000 * BEFORE ISSUING ANY 'GETMAIN /FREEMAIN',AVAILABLE CORE SHOULD BE 00526000 * FREED.( VIA A CALL TO 'STRINIT'. 00527000 * 00528000 ***IF THE ROUTINE CALLING 'STRINIT' IS NUCLEUS RESIDENT, 00529000 * L 15,ASTRINIT 00530000 * BALR 14,15 00531000 * 00532000 ***IF THE ROUTINE IS NOT NUCLEUS RESIDENT THE MACRO INSTRUCTION 00533000 * 'CMSYSREF' SHOULD APPEAR, AND THE CALL COULD BE 00534000 * L 15,ASTRINIT 00535000 * BALR 14,15 00536000 * 00537000 ********************************************************************* 00538000 * 00539000 DMSSMNSB DS 0H CMS STORAGE INITIALIZATION 00540000 USING NUCON,R0 00541000 USING *,R15 00542000 STM R0,R15,BALRSAVE SAVE THE CALLER'S REGISTERS 00543000 L R12,=A(DMSSMN) LOAD BASE ADDRESS @VA04199 00544000 DROP R15 00545000 USING DMSSMN,R12 00546000 SR R0,R0 ZERO GETMAIN STORAGE POINTER 00547000 ST R0,MAINLIST ... 00548000 L R1,LOCCNT GET THE CURRENT LOCATION COUNTER 00549000 LA R1,7(,R1) ROUND UP TO NEXT DOUBLE WORD BOUNDARY 00550000 N R1,MASKB ... 00551000 C R1,AUSRAREA MUST BE >= START OF USER AREA @VM03182 00552000 BNL STRESET OK, IF SO @VM03182 00553000 L R1,AUSRAREA ELSE, FORCE TO USER AREA START @VM03182 00554000 SPACE 1 00555000 STRESET ST R1,MAINSTRT INITIALIZE THE START AND @VM03182 00556000 ST R1,MAINHIGH END OF MAIN STORAGE AREA 00557000 L R1,ABGCOM POINT TO BGCOM AREA @V305032 00558000 USING BGCOM,R1 REFERENCE SAME BRIEFLY @V305032 00559000 ST R0,PPEND (R0 IS STILL 0) CLEAR 'PPEND' @V305032 00560000 ST R0,EOCADR AND 'EOCADR' IN COMM. REGIOM @V305032 00561000 DROP R1 THEN ... @V305032 00562000 LM R0,R14,BALRSAVE RESTORE THE CALLER'S REGISTERS 00563000 SR R15,R15 ZERO THE RETURN CODE 00564000 BR R14 RETURN TO THE CALLER 00565000 LTORG 00566000 EJECT 00567000 SVCSECT 00568000 SVCSAVE 00569000 NUCON 00570000 BGCOM @V305032 00571000 SYSCOM @V305101 00572000 ANCHTAB @V305032 00573000 PGMSECT 00574000 EXTSECT P3036 00575000 PDSSECT 00576000 REGEQU 00577000 END 00578000