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