STG TITLE 'DMSSTG (CMS) VM/370 - RELEASE 6' 00001000 SPACE 2 00003000 *. 00004000 * 00005000 * 00006000 *MODULE NAME - 00007000 * 00008000 * DMSSTG 00009000 * 00010000 *FUNCTION - 00011000 * 00012000 * THE DMSSTG ROUTINE PROCESSES CMS CALLS TO DMSSTGST 00013000 * DMSSTGSB (STRINIT), DMSSTGAT, DMSSTGCL AND DMSSTGSV. 00014000 * 00015000 *ATTRIBUTES - 00016000 * 00017000 * NUCLEUS RESIDENT, RE-ENTRANT 00018000 * 00019000 *ENTRY POINTS - 00020000 * 00021000 * DMSSTGSB, DMSSTGST -- STRINIT 00022000 * 00023000 * DMSSTGCL -- OS EXIT RESET ROUTINE 00024000 * 00025000 * DMSSTGAT -- DOS/VSAM SET PARTITION AND ANCHOR TABLE SIZE 00026000 * 00027000 * DMSSTGSV -- SERVICE ROUTINE TO CHANGE NUCLEUS VARIABLES 00028000 * 00029000 *ENTRY CONDITIONS - 00030000 * 00031000 * DMSSTGSB, DMSSTGST ( STRINIT) -- BALR R14,R15 00032000 * 00033000 * DMSSTGCL -- SVC 203 FOLLOWED BY HALFWORD OF 12 00034000 * 00035000 * DMSSTGAT -- SVC 202 00036000 * 00037000 * DMSSTGSV -- SVC 203 FOLLOWED BY X'010D' - TSOGET 00038000 * DMSSTGSV -- SVC 203 FOLLOWED BY X'020E' - RELPAGES 00039000 * DMSSTGSV -- SVC 203 FOLLOWED BY X'030F' - COMSWT 00040000 * DMSSTGSV -- SVC 203 FOLLOWED BY X'040F' - COMPSWT 00041000 * 00042000 *EXIT CONDITIONS - 00043000 * 00044000 * NORMAL - 00045000 * THE SPECIFIED STORAGE IS ALLOCATED OR RELEASED, AND CONTROL 00046000 * RETURNS TO THE USER. 00047000 * 00048000 * ERROR - 00049000 * IF THE STORAGE CANNOT BE RELEASED, 00050000 * THEN MESSAGE DMSSTG133S IS TYPED OUT AND 00051000 * THE USER IS ABENDED. 00052000 * 00053000 *CALLS TO OTHER ROUTINES - 00054000 * 00055000 * DMSSVT, DMSSAB, DMSFRE, DMSLGTA, DMSSLNAB 00056000 * 00057000 *EXTERNAL REFERENCES - 00058000 * 00059000 * NUCON, SSAVE 00060000 * 00061000 *TABLES / WORKAREAS - 00062000 * 00063000 * MACLIB DIRECTORY TABLES ARE FREED BY DMSSTGCL 00064000 * 00065000 *REGISTER USAGE - 00066000 * 00067000 * R12 = BASE 00068000 * R0 - R11 = SCRATCH AND WORK REGISTERS 00069000 * R13 - SYSTEM SAVE AREA 00070000 * 00071000 *OPERATION - 00072000 * 00073000 * IF A CMS ROUTINE CALLS THE STORAGE INITIALIZATION 00074000 * ROUTINE (STRINIT) IN DMSSTG, STRINIT 00075000 * RESETS THE FREE STORAGE EXTENTS AND EFFECTIVELY FREES 00076000 * ANY STORAGE THAT WAS PREVIOUSLY GETMAINED. 00077000 * 00078000 * IF A CMS ROUTINE CALLS DMSSTGCL IN DMSSTG, DMSSTGCL 00079000 * ISSUES STAE, SPIE, TTIMER, AND STAX CANCEL MACROES 00080000 * TO CANCEL ANY OUTSTANDING OS EXIT ROUTINES. IT ALSO 00081000 * CALLS DMSLGTA, DMSSLNAB, AND DMSFRET TO FREE ANY TXTLIB, 00082000 * MACLIB, OR LINK TABLES LEFT AROUND FROM PREVIOUS OS 00083000 * PROGRAMS. CONTROL IS THEN RETURNED TO THE USER. 00084000 * 00085000 * THE GETBLK ROUTINE IN DMSSTG SEARCHES THE FREE CHAIN 00086000 * FOR A BLOCK OF FREE STORAGE LARGE ENOUGH TO MEET THE 00087000 * CALLER'S NEEDS. WHEN IT FINDS ONE, IT EITHER RESETS 00088000 * THE BLOCK LENGTH OR, IF ALL THE BLOCK IS NEEDED, 00089000 * DELETES IT AND RETURNS CONTROL TO THE CALLER. IF A 00090000 * LARGE ENOUGH BLOCK CANNOT BE FOUND 00091000 * CONTROL IS RETURNED TO THE CALLER WITH AN ERROR CODE IN 00092000 * REGISTER 15. 00093000 * 00094000 * THE FREEBLK ROUTINE IN DMSSTG RETURNS A BLOCK OF 00095000 * STORAGE TO THE FREE CHAIN. IF THE ADDRESS PASSED IT IS 00096000 * BAD, THE FREEBLK ROUTINE ISSUES AN ABEND. IF THE BLOCK 00097000 * IT IS FREEING IS CONTIGUOUS TO ANY OTHER FREE BLOCK IN 00098000 * CORE, THE FREEBLK ROUTINE WILL COMBINE THE TWO BLOCKS. 00099000 * UPON SUCCESSFUL COMPLETION CONTROL IS RETURNED TO THE 00100000 * CALLER. 00101000 * 00102000 * PREVIOUS STORAGE ALLOCATION REQUESTS MAINTAIN A 00103000 * CHAIN OF POINTERS TO DISCONNECTED AREAS OF FREE CORE 00104000 * EACH LINK +00 IS FREPTR - POINTER TO NEXT LINK 00105000 * ZERO IF LAST IN CHAIN 00106000 * +04 IS FRELEN - LENGTH OF FREE AREA 00107000 * FRELST POINTS TO THE FIRST LINK IN THE CHAIN 00108000 * OF DISCONNECTED AREAS 00109000 * FSTFRE HOLDS THE ORIGINAL BEGINNING OF USER FREE STORAGE 00110000 * LENFRE HOLDS THE LENGTH OF THAT AREA 00111000 * 00112000 * NUCON LOCATION MAINHIGH HOLDS THE LOWER BOUND FOR EXTEND. 00113000 * NUCON LOCATION FREELOWE (LOWEXT) HOLDS THE UPPER BOUND FOR 00114000 * GETMAIN. 00115000 * 00116000 * 00117000 * 00118000 *. 00119000 EJECT 00120000 DMSSTG START X'00' IN THE BEGINNING ... 00121000 ENTRY DMSSTGSB,DMSSTGST @VA04199 00122000 ENTRY DMSSTGAT @VA04199 00123000 ENTRY DMSSTGCL @VA04199 00124000 ENTRY DMSSTGSV @VA04199 00125000 USING NUCON,R0 00126000 USING DMSSTG,R12 00127000 USING SSAVE,R13 00128000 EJECT 00129000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00130000 * 00131000 * 'STORAGE HANDLER INITIALIZATION' 00132000 * * * * * * * * * * * * * * * * * 00133000 * BEFORE ISSUING ANY 'GETMAIN /FREEMAIN',AVAILABLE CORE SHOULD BE 00134000 * FREED.( VIA A CALL TO 'STRINIT'. ) 00135000 * 00136000 ***IF THE ROUTINE CALLING 'STRINIT' IS NUCLEUS RESIDENT, 00137000 * L 15,ASTRINIT 00138000 * BALR 14,15 00139000 * 00140000 ***IF THE ROUTINE IS NOT NUCLEUS RESIDENT THE MACRO INSTRUCTION 00141000 * 'CMSYSREF' SHOULD APPEAR, AND THE CALL COULD BE 00142000 * L 15,ASTRINIT 00143000 * BALR 14,15 00144000 * 00145000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00146000 SPACE 1 00147000 DMSSTGSB DS 0H CMS STORAGE INITIALIZATION 00148000 STM R0,R15,BALRSAVE SAVE THE CALLER'S REGISTERS 00149000 LR R12,R15 SET BASE 00150000 SR R0,R0 ZERO GETMAIN STORAGE POINTER 00151000 ST R0,MAINLIST ... 00152000 L R1,LOCCNT GET THE CURRENT LOCATION COUNTER 00153000 LA R1,7(,R1) ROUND UP TO NEXT DOUBLE WORD BOUNDARY 00154000 N R1,MASKB ... 00155000 C R1,AUSRAREA MUST BE >= START OF USER AREA @VM03182 00156000 BNL STRESET OK, IF SO @VM03182 00157000 L R1,AUSRAREA ELSE, FORCE TO USER AREA START @VM03182 00158000 SPACE 1 00159000 STRESET ST R1,MAINSTRT INITIALIZE THE START AND @VM03182 00160000 ST R1,MAINHIGH END OF MAIN STORAGE AREA 00161000 L R1,ABGCOM POINT TO BGCOM AREA @V305032 00162000 USING BGCOM,R1 REFERENCE SAME BRIEFLY @V305032 00163000 TM VSAMFLG1,VIPINIT OS VSAM USER? @V304669 00163100 BO CLREOC YES, FORGET ABOUT PPEND @V304669 00163200 ST R0,PPEND (R0 IS STILL 0) CLEAR 'PPEND' @V305032 00164000 CLREOC EQU * @V304669 00164100 ST R0,EOCADR AND 'EOCADR' IN COMM. REGIOM @V305032 00165000 DROP R1 THEN ... @V305032 00166000 LM R0,R14,BALRSAVE RESTORE THE CALLER'S REGISTERS 00167000 SR R15,R15 ZERO THE RETURN CODE 00168000 BR R14 RETURN TO THE CALLER 00169000 * 00170000 * THE FOLLOWING IS POINTED TO BY THE NUCON LOCATION 'ASTRINIT' 00171000 * 00172000 DMSSTGST DS 0H 00173000 STRINIT TYPCALL=SVC 00174000 BR R14 RETURN TO THE CALLER 00175000 EJECT 00176000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00177000 * 00178000 * DMSSTGAT - GET STORAGE AND SET UP ANCHOR-TABLE (FOR VSAM) 00179000 * 00180000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00181000 SPACE 00182000 USING DMSSTGAT,R15 @V305665 00183000 DMSSTGAT L R12,=A(DMSSTG) COMMON ADDRESABILITY @V305665 00184000 DROP R15 ... @V305032 00185000 CLM R1,8,=X'0C' CALLED AS A COMMAND ? @V305032 00186000 BL SMNAT01 NO - OK. @V305032 00187000 CLM R1,8,=X'0E' CHECK FURTHER ... @V305032 00188000 BNH SMNATINV IF 0C TO 0E, CALL IT "INVALID" @V305032 00189000 * OK - DMSSTGAT CALLED AS A FUNCTION: 00190000 SMNAT01 LH R9,FRERESPG GET # PAGES TO SAVE FOR CMS @VA04199 00191000 SLL R9,12 CONVERT PAGES TO BYTES @VA04199 00192000 LR R4,R9 PUT IT IN R4, @V305032 00193000 LR R5,R4 AND IN R5 (NOTE R4=R5) @V305032 00194000 TM VSAMFLG1,VSAMRUN+VSAMSERV VSAM AND/OR AMSERV ? @V305032 00195000 BNZ SMNAT02 YES - WE'LL NEED AN ANCHOR TABLE @V305032 00196000 TM DOSFLAGS,DOSVSAM "GOING TO BE" RUNNING VSAM ? @V305032 00197000 BZ SMNAT03 NO - NOT THIS TIME. @V305032 00198000 SMNAT02 LA R5,ANCHSIZ(,R4) RESERVE SPACE FOR ANCHOR TABLE @V305032 00199000 SMNAT03 L R3,FREELOWE GET TOTAL AMOUNT OF SPACE @V305032 00200000 S R3,MAINHIGH IN USER STORAGE @V305032 00201000 CR R3,R5 BETTER BE BIG ENOUGH ... @V305032 00202000 BNH SMNATER ERROR IF NOT. @V305032 00203000 SR R3,R9 SUBTRACT THE MAGIC NUMBER @V305032 00204000 SR R9,R9 ZERO WORK REGISTER @VA04299 00204200 ICM R9,3,DOSKPART GET DOS PARTITION SIZE @VA04299 00204400 BZ SMNAT04 IF NONE SPECIFIED, USE DEFAULT @VA04299 00204600 SLL R9,10 CONVERT TO BYTES @VA04299 00204800 CR R3,R9 WILL USER'S SIZE FIT ? @VA04299 00205000 BNH SMNAT04 NO, USE DEFAULT.. @VA04299 00205200 LR R3,R9 PREPARE TO USE USER'S SIZE @VA04299 00205400 SMNAT04 BAL R10,GETBLK GET SPECIFIED BLOCK OF STORAGE @VA04299 00205600 * NOTE: UPON RETURN, R7 = ADDRESS OF THE BLOCK WE "WANTED" ... 00206000 EJECT 00206100 CLR R4,R5 (SEE ABOVE) - WAS IT VSAM ? @V305032 00207000 BE SMNAT06 NOPE - THAT'S SIMPLE, THEN. @V305032 00208000 LR R1,R3 VSAM: SIZE OF AREA INTO R1, @V305032 00209000 LH R2,PCTVSAM PERCENT TO RESERVE FOR VSAM @V305032 00210000 MR R0,R2 CALCULATE HOW MUCH ROOM TO LEAVE @V305032 00211000 D R0,=F'100' FOR GETVIS/FREEVIS USE @V305032 00212000 LA R0,7(,R1) QUOTIENT INTO R0 ROUNDED TO @V305032 00213000 N R0,MASKB MULTIPLE OF 8 BYTES @V305032 00214000 LA R1,0(R3,R7) END OF WHOLE AREA INTO R1 @V305032 00215000 SR R1,R0 MINUS SIZE TO GIVE BACK @V305032 00216000 LR R3,R0 AMOUNT TO GIVE BACK IN R3 @V305032 00217000 LR R0,R1 REMEMBER ITS ADDRESS @V305032 00218000 BAL R10,FREBLK GIVE BACK HIGH PART WE DON'T WANT@V305032 00219000 LA R1,ANCHSIZ SIZE OF ANCHOR TABLE INTO R1, @V305032 00220000 SR R0,R1 COMPUTE BEGIN. OF ANCHOR TABLE @V305032 00221000 LR R3,R0 SAVE ADDRESS FOR LATER USE @V305032 00222000 SR R5,R5 CLEAR R5 (R4 IS IMMATERIAL) @V305032 00223000 MVCL R0,R4 CLEAR ENTIRE ANCHOR TABLE @V305032 00224000 LA R1,ANCHSIZ-4(,R3) POINT TO END OF ANCHOR TABLE @V305032 00225000 USING ANCHSECT,R3 AND @V305032 00226000 ST R1,ANCHENDA STORE ENDING ADDRESS @V305032 00227000 DROP R3 ANCHOR TABLE ALL INITIALIZED; @V305032 00228000 B SMNAT07 NOW GO STORE ITS ADDRESS (-1). @V305032 00229000 EJECT 00230000 * NOT VSAM - NO ANCHOR TABLE, BUT NEED TO SET UP "PPEND": 00231000 SMNAT06 AR R3,R7 COMPUTE END OF AREA OBTAINED @V305032 00232000 SMNAT07 BCTR R3,0 MINUS ONE, @V305032 00233000 L R15,ABGCOM POINT TO BGCOM AREA @V305032 00234000 USING BGCOM,R15 REFERENCE SAME BRIEFLY @V305032 00235000 ST R3,PPEND AND STORE IN 'PPEND' @V305032 00236000 L R3,ALDRTBLS GET BEGIN LOADER TABLES @V305032 00237000 LA R3,0(,R3) CLEAR NUMBER TABLE ENTRIES @V305001 00238000 ST R3,EOCADR AND STORE IN 'EOCADR' AS NEEDED @V305032 00239000 CR R4,R5 (SEE ABOVE) - WAS IT VSAM ? @VM03158 00240000 BE SMNAT08 NOPE - DON'T SET GETVIS FLAG @VM03158 00241000 OI OPTNBYTE,GETVIS SHOW GETVIS INITIALIZED. @VM03158 00242000 DROP R15 THEN ... @V305032 00243000 SMNAT08 L R15,ASYSCOM POINT TO SYSCOM AREA @VM03158 00244000 USING SYSCOM,R15 REFERENCE SAME BRIEFLY @V305001 00245000 L R15,IJBBOX POINT TO BOUNDARY BOX @V305001 00246000 ST R3,12(,R15) INITIALIZE BBOX GENERAL ENTRY @VA09503 00246500 LA R15,16(,R15) AND BUMP TO PARTITION BOX @V305001 00247000 ST R3,12(,R15) NOW SAVE PARTITION END IN BBOX @V305001 00248000 DROP R15 THEN ... @V305001 00249000 SR R15,R15 CLEAR R15, @V305032 00250000 BR R14 AND WE'RE BACK HOME. @V305032 00251000 SPACE 00252000 SMNATER LA R15,1 ERROR 1 IF NOT ENOUGH SPACE @V305032 00253000 BR R14 EXIT (TOO BAD). @V305032 00254000 SPACE 00255000 SMNATINV LH R15,=H'-3' -3 MEANS "NO SUCH COMMAND" @V305032 00256000 BR R14 (NOT VALID AS A "COMMAND"). @V305032 00257000 EJECT 00258000 * 00259000 * THE FUNCTION OF DMSSTGCL IS TO INSURE THAT OS CONTROL 00260000 * BLOCK POINTERS ARE RESET BETWEEN PROGRAMS. 00261000 * 00262000 USING EXTSECT,R3 00263000 USING PGMSECT,R4 00264000 USING PDSSECT,R5 00265000 USING DMSSTGCL,R12 SET BASE REG 00266000 DMSSTGCL EQU * @V305665 00267000 LR R12,R15 GET ADDRESS OF DMSSTGCL @V305665 00268000 L R13,CURRSAVE GET ADDR OF SAVE AREA 00269000 * CLEAR OUTSTANDING STAE REQUESTS 00270000 LA R0,2 GET NO. OF DOUBLE WORDS 00271000 L R4,APGMSECT GET ADDR OF PGMSECT 00272000 LA R3,SCBPTR GET START OF STAE CHAIN 00273000 LR R6,R14 SAVE R14 (USED BY DMSFRET CALLS) @VM03083 00274000 STAELOOP L R1,0(R3) GET NEXT POINTER IN CHAIN 00275000 LTR R1,R1 IS PTR ZERO 00276000 BZ CLRWORK YES, THEN CLEAR STIMER EXIT 00277000 MVC 0(4,R3),0(R1) UPDATE SCBPTR CHAIN 00278000 DMSFRET DWORDS=(0),LOC=(1),TYPCALL=BALR CALL "FRET" @VM03083 00279000 B STAELOOP GET NEXT BLOCK IN CHAIN 00280000 CLRWORK ST R1,SCBWORK CLEAR SCB WORK AREA 00281000 * CLEAR OUTSTANDING STIMER REQUESTS 00282000 L R3,AEXTSECT GET ADDR OF EXTSECT 00283000 ST R1,STIMEXIT CLEAR STIMER EXIT 00284000 * CLEAR OUTSTANDING SPIE REQUESTS 00285000 ST R1,PICADDR CLEAR PICA ADDR 00286000 NI OLDPSW+4,X'F0' CLEAR PROGRAM MASK 00287000 * CLEAR OUTSTANDING STAX REQUESTS 00288000 STXCLR L R2,TAXEADDR GET HIGHEST ELEMENT 00289000 LTR R1,R2 IS THERE ONE 00290000 BZ GETUSAVE NO, GO GET SAVE AREA 00291000 L R3,8(R2) GET PTR TO NEXT 00292000 LA R3,0(0,R3) CLEAR HI BYTE 00293000 ST R3,TAXEADDR MAKE NXT=1ST 00294000 LA R0,28 NUMBER OF DOUBLEWORDS @VA05249 00295000 DMSFRET DWORDS=(0),LOC=(1),TYPCALL=BALR CALL "FRET" @VM03083 00296000 B STXCLR GET NEXT ELEMENT 00297000 GETUSAVE L R13,USAVEPTR GET ADDR OF SAVE AREA 00298000 LR R14,R6 RESTORE R14 (USED BY DMSFRET) @VM03083 00299000 STM R12,R14,EGPR12 SAVE RETURN ADDR 00300000 L R15,=V(DMSLGTA) GET ADDR OF TXTLIB FREE ROUTINE 00301000 BALR R14,R15 FREE TXTLIB DIRECTORIES 00302000 L R12,EGPR12 RESTORE ADDR OF BASE REG 00303000 MVI OSSFLAGS,0 CLEAR COMPILER FLAG SWITCH 00304000 SR R6,R6 SET INDEX REG AT ZERO 00305000 MACLOOP L R5,MACDIRC(R6) GET NEXT DIRECTORY PTR 00306000 LA R1,MACLIBL(R6) SETUP GLOBAL NAME POINTR@V201122 00307000 AR R1,R6 SETUP GLOBAL NAME POINTR@V201122 00308000 CLI 0(R1),X'FF' IS THIS THE LAST ENTRY @V201122 00309000 BE MACFREE YES, CLEAR POINTERS @V201122 00310000 LA R6,4(R6) UP TO NEXT POINTER @V201122 00311000 LTR R1,R5 IS THIS A PDS POINTER @V201122 00312000 BNP MACLOOP NO, GET NEXT POINTER @V201122 00313000 LH R7,CORESIZE GET DIRECTORY SIZE 00314000 LA R0,27(R7) ADD CONTROL WORDS 00315000 SLL R0,16 CLEAR FIRST HALF OF REG 00316000 SRL R0,19 SET SIZE IN DOUBLE WORDS 00317000 DMSFRET DWORDS=(0),LOC=(1),TYPCALL=BALR 00318000 B MACLOOP GET NEXT PDS PTR 00319000 MACFREE XC MACDIRC(32),MACDIRC CLEAR MACLIB PDS PTR'S 00320000 L R1,ASTATEXT GET ADDR OF SSTAT EXTENSION 00321000 XC 0(8,R1),0(R1) CLEAR ADDR OF SSTAT EXTENSIONS 00322000 L R1,LINKSTRT GET FIRST CHAIN POINTER @VA02596 00323000 LA R0,15 GET NUMBER OF DOUBLEWORDS @VA02596 00324000 LINKFREE LTR R1,R1 ARE THERE ANY OTHERS TO FREE? @VA02596 00325000 BZ GOAWAY NO, GET OUT @VA02596 00326000 L R7,0(R1) GET NEXT CHAIN POINTER @VA02596 00327000 DMSFRET DWORDS=(0),LOC=(1),TYPCALL=BALR @VA02596 00328000 LR R1,R7 GET NEXT POINTER @VA02596 00329000 B LINKFREE CONTINUE LOOP @VA02596 00330000 GOAWAY EQU * @V305665 00331000 NI OSSFLAGS,255-DYLD-DYLIBO-DYMBRNM CLEAR FLAGS @V305665 00332000 XC LINKLAST(4),LINKLAST CLEAR LINK CHAIN ANCHOR @V305665 00333000 XC LINKSTRT(4),LINKSTRT CLEAR LOAD CHAIN ANCHOR @V305665 00334000 L R14,EGPR14 RESTORE RETURN ADDR 00335000 SR R15,R15 00336000 BR R14 RETURN TO CALLER 00337000 USING DMSSTG,R12 @V305665 00338000 EJECT 00339000 DMSSTGSV EQU * CHANGING NUCLEUS VARIABLES @V305665 00340000 LR R12,R15 SET UP ADDRESSIBILITY 00341000 USING DMSSTGSV,R12 @V305665 00342000 SR R15,R15 ASSUME THAT NO ERRORS WILL OCCUR 00343000 SR R1,R1 PREPARE FOR CODE 203 CHECK 00344000 IC R1,CODE203 INSERT FIRST BYTE FOR CHECK 00345000 CH R1,=AL2(4) IS IT GREATER THAN 4 00346000 BH ABENDSV YES, THEN ABEND THE USER 00347000 LTR R1,R1 IS IT LESS THAN OR EQUAL TO 0 00348000 BNP ABENDSV YES, THEN ABEND THE USER 00349000 AR R1,R1 INCREMENT CODE FOR SUBSEQUENT BRANCH 00350000 AR R1,R1 TO VALID DISPLACEMENT 00351000 B *+0(R1) BRANCH TO APPROPRIATE ROUTINE 00352000 SPACE 1 00353000 B DMSSTGTS 1 - GET A(TSOCPPL) 00354000 B DMSSTGRP 2 - SET RELPAGES FLAG 00355000 B DMSSTGCN 3 - SET COMPSWT ON 00356000 B DMSSTGCF 4 - SET COMPSWT OFF 00357000 SPACE 2 00358000 ABENDSV EQU * ABEND USER FOR INVALID 203 CODE 00359000 DMSABN 0F1 00360000 SPACE 2 00361000 DMSSTGTS EQU * GET A(TSOCPPL) 00362000 L R1,ATSOCPPL SET REGISTER 1 TO A(TSOCPPL) 00363000 BR R14 RETURN TO CALLER 00364000 SPACE 2 00365000 DMSSTGRP EQU * SET THE RELPAGES FLAG 00366000 OI MISFLAGS,RELPAGES SET THE RELPAGES FLAG 00367000 BR R14 RETURN TO CALLER 00368000 SPACE 2 00369000 DMSSTGCN EQU * SET COMPSWT ON 00370000 OI OSSFLAGS,COMPSWT SET COMPSWT ON 00371000 BR R14 RETURN TO CALLER 00372000 SPACE 2 00373000 DMSSTGCF EQU * SET COMPSWT OFF 00374000 NI OSSFLAGS,X'FF'-COMPSWT 00375000 BR R14 RETURN TO CALLER 00376000 USING DMSSTG,R12 00377000 EJECT 00378000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00379000 * 00380000 * ALLOCATE A BLOCK OF STORAGE 00381000 * 00382000 * ON ENTRY: R3 = SIZE OF BLOCK DESIRED 00383000 * ON EXIT: R7 -> ALLOCATED BLOCK 00384000 * 00385000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00386000 SPACE 1 00387000 GETBLK LA R7,MAINLIST R7 -> V(FIRST FREE BLOCK) @VA04199 00388000 SPACE 1 00389000 NEXTG LR R9,R7 @VA04199 00390000 ICM R7,B'1111',FREPTR(R9) R7 -> NEXT (OR 1ST) FB @VA04199 00391000 BZ CKHIMAIN IF NONE LEFT, TRY HIMAIN @VA04199 00392000 C R3,FRELEN(,R7) TEST SIZE OF FREE AREA @VA04199 00393000 BH NEXTG IF NOT BIG ENOUGH GET NEXT BLOCK @VA04199 00394000 BE DESBLK IF WHOLE AREA USED, DESTROY BLOCK@VA04199 00395000 SPACE 1 00396000 * REQUESTED LENGTH IS SHORTER THAN THIS BLOCK, 00397000 * SO LEAVE LEFTOVER PART IN THE CHAIN: 00398000 LR R6,R7 ADDRESS OF BLOCK, @VA04199 00399000 ALR R6,R3 PLUS REQUESTED LENGTH, @VA04199 00400000 ST R6,FREPTR(,R9) EQUALS ADDRESS OF LEFTOVER @VA04199 00401000 MVC FREPTR(4,R6),FREPTR(R7) SET LEFTOVER'S POINTER @VA04199 00402000 L R8,FRELEN(,R7) OLD LENGTH OF THIS BLOCK, @VA04199 00403000 SLR R8,R3 MINUS REQUESTED LENGTH, @VA04199 00404000 ST R8,FRELEN(,R6) EQUALS NEW LENGTH OF LEFTOVER @VA04199 00405000 BR R10 RETURN @VA04199 00406000 SPACE 1 00407000 * LENGTH OF THIS BLOCK = REQUESTED LENGTH, 00408000 * SO REMOVE THE WHOLE BLOCK FROM THE CHAIN: 00409000 DESBLK MVC FREPTR(4,R9),FREPTR(R7) @VA04199 00410000 BR R10 RETURN @VA04199 00411000 SPACE 1 00412000 CKHIMAIN L R7,MAINHIGH GET ADDRESS OF AVAILABLE STORAGE @VA04199 00413000 LH R2,FRERESPG GET # OF PAGES TO SAVE FOR CMS @VA04199 00414000 SLL R2,12 CONVERT IT TO # OF BYTES @VA04199 00415000 L R6,FREELOWE HI END OF AVAILABLE FREE STORAGE @VA04199 00416000 SR R6,R7 MINUS THE LOW END, @VA04199 00417000 SR R6,R2 MINUS AMOUNT TO SAVE FOR CMS, @VA04199 00418000 CR R6,R3 CAN BE USED; COMPARE IT WITH MIN @VA04199 00419000 BL NOBLOCK IF NOT ENOUGH, SET ERROR RETURN @VA04199 00420000 LR R6,R7 ADDRESS OF ALLOCATED BLOCK, @VA04199 00421000 ALR R6,R3 PLUS ITS LENGTH, @VA04199 00422000 ST R6,MAINHIGH IS MAINHIGH'S NEW VALUE @VA04199 00423000 BR R10 RETURN @VA04199 00424000 SPACE 1 00425000 NOBLOCK MVI EGPR15+3,QUATRE INFORM USER VIA R15 @VA04199 00426000 BR R10 RETURN @VA04199 00427000 EJECT 00428000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00429000 * 00430000 * RETURN A FREED BLOCK ("FB") TO THE CHAIN OF 00431000 * AVAILABLE FREE BLOCKS ("AFB") 00432000 * 00433000 * ON ENTRY: R1 -> FREED BLOCK 00434000 * R3 = LENGTH OF FREED BLOCK 00435000 * 00436000 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00437000 SPACE 1 00438000 FREBLK LA R1,0(,R1) CLEAR R1'S HIGH-ORDER BYTE @VA04199 00439000 C R1,MAINSTRT IS V(FB) < START OF GETMAIN AREA?@VA04199 00440000 BL SMNATER ERROR IF SO @VA06270 00441100 LA R8,MAINLIST R8 -> V(FIRST AFB) @VA04199 00442000 SPACE 1 00443000 NEXTF LR R9,R8 @VA04199 00444000 ICM R8,B'1111',FREPTR(R9) R8 -> NEXT (OR 1ST) AFB@VA04199 00445000 BZ CKMAIN NO MORE AFB'S - GO CHECK HIMAIN @VA04199 00446000 CR R8,R1 IS AFB > FB ? @VA04199 00447000 BH FRABVE YES, FB MUST BE INSERTED IN CHAIN@VA04199 00448000 LR R6,R8 @VA04199 00449000 AL R6,FRELEN(,R8) R6 -> END OF AFB @VA04199 00450000 CR R1,R6 DOES FB OVERLAP THIS AFB? @VA04199 00451000 BL SMNATER ERROR IF SO @VA06270 00452100 BH NEXTF NOWHERE NEAR - TRY AGAIN @VA04199 00453000 SPACE 1 00454000 * THE FB IS CONTIGUOUS WITH THE END OF THE AFB, 00455000 * SO WE JUST MERGE THEM INTO ONE AFB: 00456000 L R7,FRELEN(,R8) GET LENGTH OF AFB, @VA04199 00457000 ALR R7,R3 PLUS LENGTH OF FB @VA04199 00458000 LR R6,R7 @VA04199 00459000 ALR R6,R8 R6 -> END OF MERGED BLOCK @VA04199 00460000 ICM R2,B'1111',FREPTR(R8) IS THERE ANOTHER AFB? @VA04199 00461000 BNZ CKOVRLAP YES - GO SEE IF FB OVERLAPS IT @VA04199 00462000 C R6,MAINHIGH NO; DOES IT OVERLAP MAINHIGH? @VA04199 00463000 BL KPBLK NO - IT'S WITHIN MAINHIGH @VA04199 00464000 BH SMNATER ERROR IF YES @VA06270 00465100 ST R8,MAINHIGH JUST RESET MAINHIGH; THE FB @VA04199*00466000 WAS CONTIGUOUS TO IT @VA04199 00467000 SR 15,15 THE LAST AFB IS NOW AT @VA04199 00468000 ST R15,FREPTR(,R9) THE END OF THE CHAIN @VA04199 00469000 BR 10 RETURN @VA04199 00470000 SPACE 1 00471000 CKOVRLAP CR R6,R2 DOES FB OVERLAP THE NEXT AFB? @VA04199 00472000 BH SMNATER ERROR IF SO @VA06270 00473100 BL KPBLK NO - THERE'S A GAP @VA04199 00474000 SPACE 1 00475000 * THE NEXT AFB IS CONTIGUOUS WITH THE END OF THE FB, 00476000 * SO WE MERGE THAT IN, TOO: 00477000 MVC FREPTR(4,R8),FREPTR(R2) @VA04199 00478000 AL R7,FRELEN(,R2) ADD ITS LENGTH TO OUR TOTAL @VA04199 00479000 SPACE 1 00480000 KPBLK ST R7,FRELEN(,R8) SET THE LENGTH OF THE NEW AFB @VA04199 00481000 BR 10 RETURN @VA04199 00482000 EJECT 00483000 CKMAIN LR R7,R1 @VA04199 00484000 ALR R7,R3 R7 -> END OF FB @VA04199 00485000 C R7,MAINHIGH DOES THE FB OVERLAP MAINHIGH? @VA04199 00486000 BL ADDBLK NO - IT'S WITHIN MAINHIGH @VA04199 00487000 BH SMNATER ERROR IF YES @VA06270 00488100 ST R1,MAINHIGH JUST RESET MAINHIGH; THE FB @VA04199*00489000 WAS CONTIGUOUS TO IT @VA04199 00490000 BR 10 RETURN @VA04199 00491000 SPACE 1 00492000 * THE FB MUST BE INSERTED BETWEEN TWO AFB'S IN THE CHAIN, 00493000 * OR POSSIBLY AT THE BEGINNING OF THE CHAIN: 00494000 FRABVE LR R6,R1 @VA04199 00495000 ALR R6,R3 R6 -> END OF THE FB @VA04199 00496000 CR R6,R8 DOES THE FB OVERLAP THE NEXT AFB?@VA04199 00497000 BL ADDBLK NO - GO INSERT IT AS A NEW AFB @VA04199 00498000 BH SMNATER ERROR IF YES @VA06270 00499100 SPACE 1 00500000 * THE NEXT AFB IS CONTIGUOUS WITH THE END OF THE FB, 00501000 * SO WE MERGE THEM TOGETHER: 00502000 ST R1,FREPTR(,R9) LAST AFB -> THIS (NEW) AFB @VA04199 00503000 AL R3,FRELEN(,R8) TOTAL LENGTH = L'FB + L'AFB @VA04199 00504000 ST R3,FRELEN(,R1) SET THE PROPER LENGTH AND @VA04199 00505000 MVC FREPTR(4,R1),FREPTR(R8) ADDRESS FOR NEW AFB @VA04199 00506000 BR 10 RETURN @VA04199 00507000 SPACE 1 00508000 * THE FB IS NOT CONTIGUOUS TO ANYTHING, 00509000 * SO WE MAKE A NEW AFB OUT OF IT: 00510000 ADDBLK ST R1,FREPTR(,R9) LAST AFB -> THIS NEW AFB @VA04199 00511000 ST R8,FREPTR(,R1) THIS NEW AFB -> NEXT AFB @VA04199 00512000 ST R3,FRELEN(,R1) WE MUSTN'T FORGET OUR SIZE @VA04199 00513000 BR 10 RETURN @VA04199 00514000 EJECT 00515000 * EACH BLOCK OF FREE STORAGE CONTAINS, IN ITS FIRST TWO 00530000 * WORDS, A POINTER TO THE NEXT FREE BLOCK IN THE CHAIN, 00531000 * AND ITS OWN LENGTH IN BYTES: 00532000 FREPTR EQU 0 DISPLACEMENT FOR THE POINTER @VA04199 00533000 FRELEN EQU 4 DISPLACEMENT FOR THE LENGTH @VA04199 00534000 SPACE 1 00535000 QUATRE EQU 4 RET. CODE IF COND. GETMAIN FAILS @VA04199 00536000 GETVIS EQU X'01' GETVIS INITIALIZED FLAG @VM03158 00537000 SPACE 1 00538000 DS 0F 00539000 MASKB DC X'00FFFFF8' MASK FOR ROUNDING TO A DOUBLEWORD@VA04199 00540000 MAXBLK DC X'007FFFF0' MAXIMUM POSSIBLE FREE BLOCK SIZE @VA04199 00541000 LTORG 00637000 EJECT 00638000 SVCSECT 00639000 SVCSAVE 00640000 NUCON 00641000 BGCOM @V305032 00642000 SYSCOM @V305001 00643000 ANCHTAB @V305032 00644000 PGMSECT 00645000 EXTSECT 00646000 PDSSECT 00647000 REGEQU 00648000 END 00649000