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