ibm:vm370-lib:cms:dmssmn.assemble_src
Table of Contents
DMSSMN Source
References
- Fixes Applied : 4
- This Source Date : Tuesday, December 12, 1978
- Last Fix ID : [R14218DS]
Source Listing
- DMSSMN.ASSEMBLE.txt
- 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
ibm/vm370-lib/cms/dmssmn.assemble_src.txt · Last modified: 2023/08/06 13:35 by Site Administrator