SLN TITLE 'DMSSLN (CMS) VM/370 - RELEASE 6' 00001000
SPACE 2 00002000
*. 00003000
* MODULE NAME 00004000
* 00005000
* DMSSLN 00006000
* 00007000
* FUNCTION 00008000
* 00009000
* HANDLE OS CONTENTS MANAGEMENT REQUESTS ISSUED 00010000
* UNDER CMS. (LINK, LOAD, XCTL, DELETE, ATTACH,EXIT) 00011000
* 00012000
* ATTRIBUTES 00013000
* 00014000
* REENTRANT, SEGMENT RESIDENT 00015000
* 00016000
* ENTRY POINTS 00017000
* 00018000
* DMSSLN7 - XCTL - R15 POINTS TO ADDRESS OF REQUESTED 00019000
* PHASE NAME 00020000
* DMSSLN6 - LINK - SAME AS DMSSLN7 00021000
* DMSSLN42 - ATTACH - R15 POINTS TO ATTACH PARAMETER LIS 00022000
* DMSSLN8 - LOAD - R0 POINTS TO PHASE NAME 00023000
* DMSSLN9 - DELETE - R0 POINTS TO PHASE NAME 00024000
* DMSSLN3 - EXIT - NO ENTRY CONDITIONS 00025000
* DMSSLNAB - ABEND RECOVERY - R14 RETURN ADDRESS 00026000
* ALL ENTRY POINTS - R15 CONTAINS ADDRESSIBILITY 00027000
* 00028000
* ENTRY CONDITIONS 00029000
* 00030000
* SEE ENTRY POINTS 00031000
* 00032000
* EXIT CONDITIONS 00033000
* 00034000
* NORMAL 00035000
* RETURN TO DMSITS TO: 00036000
* 1) CONTINUE PROCESSING WITH CALLED PHASE OR END 00037000
* OF TASK EXIT (LINK, XCTL, ATTACH) 00038000
* 2) RETURN TO CALLER - EXIT FROM CALLED PHASE 00039000
* 3) RETURN TO CALLER WITH LOADED PHASE ADDRESS IN 00040000
* REGISTER ZERO (LOAD) 00041000
* 4) RETURN TO CALLER WITH ZERO IN REGISTER 15 FOR 00042000
* SUCCESSFUL DELETE 00043000
* 00044000
* ERROR 00045000
* 1) RETURN TO CALLER WITH 4 IN REGISTER 15 FOR 00046000
* PHASE NOT FOUND - DELETE 00047000
* 2) ABEND X'155' LOADMOD ERROR (LINK, LOAD, XCTL, 00048000
* ATTACH) 00049000
* 3) ABEND X'15A' - CMS LOADER ERROR (>4) OR ENTRY 00050000
* LOCATION NOT DETERMINEABLE 00051000
* 00052000
* CALLS TO OTHER ROUTINES 00053000
* 00054000
* DMSMOD, DMSLDRB 00055000
* 00056000
* EXTERNAL REFERENCES 00057000
* 00058000
* NUCON, SVCSECT, PGMSECT, DCB, 00059000
* CALLER'S SAVE AREA + 12 (LINK, LOAD, XCTL, 00060000
* ATTACH) IF COMPILER SWITCH IS OFF 00061000
* 00062000
* TABLES/WORKAREAS 00063000
* 00064000
* REQUEST BLOCK 00065000
* 00066000
* REGISTER USAGE 00067000
* 00068000
* R7 REQUEST BLOCK ADDRESS 00069000
* R12 BASE REGISTER 00070000
* R13 CMS SVC SAVE AREA ADDRESS 00071000
* WORK 0-5,8-11,14,15 00072000
* UNUSED 6 00073000
* 00074000
* OPERATION 00075000
* 00076000
* DMSSLN7 - XCTL 00077000
* 1. IF XCTL IS FROM NON-DYNAMICALLY LOADED 00078000
* PHASE GO TO DMSSLN6 STEP 2 (BELOW) 00079000
* 2. RELEASE STORAGE OCCUPIED BY CURRENT PHASE (LATEST 00080000
* RB ON LINK CHAIN DEFINES STORAGE AREA) 00081000
* 3. GO TO DYNAMIC (BELOW) 00082000
* 00083000
* DMSSLN6 - LINK 00084000
* 00085000
* 1. CALL RESIDENT (BELOW) TO CHECK FOR LINK TO CMS 00086000
* RESIDENT FUNCTION. 00087000
* 2. ISSUE GETMAIN FOR A NEW REQUEST BLOCK 00088000
* 3. IF ATTACH REQUEST SAVE ATTACHER'S R13 AND R15 00089000
* IN THE RB. POINT R13 TO RB SAVE AREA FOR ATTACHEE 00090000
* 4. IF THIS IS A LOAD REQUEST GO TO STEP 7 00091000
* 5. CHAIN THIS RB AS LATEST ON LINK CHAIN. SAVE 00092000
* RESUME PSW IN RB. 00093000
* 6. IF COMPILER SWITCH IS ON GO TO LODMOD (BELOW), 00094000
* OTHERWISE, GO TO DYNAMIC (BELOW). 00095000
* 7. CHAIN THIS RB ON LOAD LIST. SET ZERO USE COUNT 00096000
* GO TO DYNAMIC STEP 2 (BELOW). 00097000
* 00098000
* DMSSLN42 - ATTACH 00099000
* 00100000
* 1. ISSUE STAE MACRO IF STAI EXIT IS REQUESTED BY 00101000
* ATTACHER. 00102000
* 2. GO TO DMSSLN6 (ABOVE). 00103000
* 00104000
* DMSSLN8 - LOAD 00105000
* 00106000
* 1. IF REQUESTED PHASE IS ON LOAD RB CHAIN GO TO 00107000
* DYNAMIC STEP 6 (BELOW). 00108000
* STEP 2 (ABOVE). 00109000
* 3. IF COMPILER SWITCH IS ON GO TO LODMOD 00110000
* STEP 2 (BELOW; OTHERWISE GO TO DMSSLN6 STEP 2 00111000
* (ABOVE). 00112000
* 00113000
* DMSSLN9 - DELETE 00114000
* 00115000
* 1. IF COMPILER SWITCH IS ON RETURN TO DMSITS. 00116000
* 2. IF REQUESTED PHASE IS NOT ON LOAD RB CHAIN SET 00117000
* RETURN CODE 4 IN R15. AND RETURN TO DMSITS. 00118000
* 3. DECREMENT USE COUNT BY ONE. IF USE COUNT IS NOT 00119000
* ZERO RETURN TO DMSITS. 00120000
* 4. RELEASE PHASE STORAGE AREA, UNCHAIN AND FREEMAIN 00121000
* LOAD REQUEST BLOCK. ZERO R15 AND RETURN TO DMSITS. 00122000
* 00123000
* DMSSLN3 - EXIT FROM CALLED PHASE 00124000
* 00125000
* 1. IF NOT RETURN FROM SUBTASK (ATTACH) GO TO STEP 3. 00126000
* 2. POST ECB, EXECUTE END OF TASK EXIT ROUTINE IF ONE 00127000
* WAS REQUESTED. 00128000
* 3. RELEASE PHASE STORAGE, UNCHAIN AND FREE LATEST RB O 00129000
* LINK RB CHAIN. RESTORE REGISTERS IF RETURN FROM SUBTAS 00130000
* RETURN TO DMSITS. 00131000
* 00132000
* DYNAMIC - CALL CMS LOADER 00133000
* 00134000
* 1. IF REQUESTED PHASE IS ON LOAD REQUEST BLOCK CHAIN 00135000
* GO TO STEP 6. 00136000
* 2. SET PHASE NAME IN RB. ISSUE CONDITIONAL GETMAIN FOR 00137000
* AN AREA TO LOAD REQUESTED PHASE INTO. SET LOCATION 00138000
* COUNTER TO PHASE AREA. CALL DMSLDRB TO INCLUDE PHASE. 00139000
* 3. IF DMSLDR RETURNS AN ERROR CODE >4 ISSUE ABEND 00140000
* X'15A'. OTHERWISE RESET LOADER TABLE COUNT TO PRE-INCL 00141000
* COUNT. 00142000
* 4. RELEASE EXCESS PHASE STORAGE. 00143000
* 5. DETERMINE PHASE ENTRY POINT: 00144000
* A.USE STRTADDR VALUE IN NUCON IF COMPILER SWITCH IS O 00145000
* B.USE STRTADDR IF PHASE NAME OCCURED AS A MEMBER NAME 00146000
* IN A CMS TXTLIB (OS FORM - REF. TXTLIB COMMAND). 00147000
* C.USE ALIASENT IN NUCON IF PHASE NAME OCCURED IN LOAD 00148000
* CSECTS BUT WAS NOT THE TXTLIB MEMBER NAME (REAL ALI 00149000
* D.USE STRTADDR FOR ALL OTHER CASES (SYMBOLIC ALIAS). 00150000
* 00151000
* 6. RESET DYNAMIC FLAGS. 00152000
* 7. IF THIS IS A LOAD REQUEST GO TO STEP 9. 00153000
* 8. SET PHASE ENTRY ADDRESS IN CMS OLD PSW AND R15, SET 00154000
* THAT CALLED PHASE WILL RETURN TO AN SVC 3 INSTRUCTION. 00155000
* RETURN TO DMSITS WHICH WILL TRANSFER TO CALLED PHASE. 00156000
* 9. IF COMPILER SWITCH IS OFF INCREASE USE COUNT IN RB 00157000
* ONE AND SAVE ENTRY LOCATION IN LOAD RB. 00158000
* 10. SET R0 TO ENTRY LOCATION. RETURN TO DMSITS. 00159000
* THE ENTRY ADDR. IS FROM THE LOAD RB IF PHASE WAS ALREA 00160000
* IN STORAGE. 00161000
* 00162000
* LODMOD - LOADMOD A PHASE 00163000
* 00164000
* 1. SAVE REQUESTED NAME IN RB. IF REQUESTED NAME IS 00165000
* ON LOAD RB CHAIN GO TO DYNAMIC STEP 6 (ABOVE). 00166000
* 2. CALL DMSMOD TO BRING IN REQUESTED PHASE AS A CMS MO 00167000
* IF DMSMOD RETURNS NON ZERO RETURN CODE ISSUE ABEND X'1 00168000
* 3. GO TO DYNAMIC STEP 5 (ABOVE). 00169000
* 00170000
* RESIDENT 00171000
* 00172000
* CHECK REQUESTED PHASE NAME AGAINST CMS RESIDENT LIST 00173000
* (IECQBFG1 IS ONLY ENTRY). IF EQUAL GO TO RESIDENT ROUT 00174000
* OTHERWISE RETURN TO INTERNAL CALLER. 00175000
* 00176000
* DMSSLNAB - ABEND RECOVERY 00177000
* 00178000
* ENTERED WHEN AN ABEND (SVC 13) OCCURS IN CMS. DMSSLNAB 00179000
* RELEASES THE LOAD AND LINK REQUEST BLOCK CHAINS BY 00180000
* ZEROING THEIR RESPECTIVE ANCHORS IN NUCON. RETURN 00181000
* TO DMSABN. 00182000
*. 00183000
EJECT 00184000
DMSSLN7 START , @V305665 00185000
ENTRY DMSSLN @V305665 00186000
ENTRY DMSSLN3,DMSSLN6,DMSSLN7,DMSSLN8 @V1D1705 00187000
ENTRY DMSSLN9,DMSSLN42 @V1D1705 00188000
USING NUCON,XR0 @V1D1705 00189000
USING SVCSECT,XRB @V1D1705 00190000
USING SSAVE,XRD @V1D1705 00191000
* TRANSFER CONTROL - XCTL, SVC 7 00192000
SPACE 1 00193000
DMSSLN EQU * @V305665 00194000
USING DMSSLN7,XRC @V1D1705 00195000
BAL XRA,LODREG SET REGS 7 13 @V1D1705 00196000
LTR XR7,XR7 XCTL FROM DYNAMICALLY LOADED PHAS@V1D1705 00197000
BZ LINK1 NO, TREAT XCTL AS LINK @V1D1705 00198000
LA XRA,LINK1A SET LINKAGE @V1D1705 00199000
B DEL6 FREE OLD PHASE AREA @V1D1705 00200000
EJECT 00201000
SPACE 1 00202000
USING *,12 @V1D1705 00203000
DMSSLN42 EQU * @V1D1705 00204000
TM 8(XRF),X'01' WAS STAI EXIT REQUESTED @V1D1705 00205000
BNO DMSSLN6 NO @V1D1705 00206000
L XR4,40(XRF) GET STAE PARM ADDR @V1D1705 00207000
L XR5,44(XRF) GET STAE EXIT ADDR @V1D1705 00208000
LR XR1,XRD SET PARAM REG @V1D1705 00209000
STAE (XR5),CT,PARAM=(XR4),MF=(E,(1)) @V1D1705 00210000
L XRA,APGMSECT SET STAI FLG IN SCB @V1D1705 00211000
USING PGMSECT,XRA @V1D1705 00212000
L XRA,SCBPTR PTR TO CURRENT SCB @V1D1705 00213000
DROP XRA @V1D1705 00214000
OI 12(XRA),X'20' INDICATE SCB FOR STAI @V1D1705 00215000
EJECT 00216000
* LINK - SVC 6 00217000
SPACE 1 00218000
DMSSLN6 BALR XRC,0 @V1D1705 00219000
USING *,XRC @V1D1705 00220000
L XRC,BASED COMMON CAUSE @V1D1705 00221000
USING DMSSLN7,XRC @V1D1705 00222000
BAL 10,RESIDENT CHECK FOR RESIDENT ROUTINE @V1D1705 00223000
BAL 10,LODREG SET REGS BY CONVENTION @V1D1705 00224000
USING LINKBLK,XR1 LINKBLK DSECT @V1D1705 00225000
LINK1 LA XR0,SAVLEN/8 GET LINK BLOCK @V1D1705 00226000
DMSFREE DWORDS=(0),TYPCALL=BALR @V1D1705 00227000
CLI OLDPSW+3,42 IS THIS ATTACH @V1D1705 00228000
BNE LINK11 BRANCH IF NOT @V1D1705 00229000
MVC SAVR15(4),EGPR15 SAVE PARAMETER REG @V1D1705 00230000
MVC SAVR13(4),EGPR13 SAVE ATTACHER'S R13 @V1D1705 00231000
LA XR0,SVAREA POINT TO NEW SAVE AREA FOR ATTACH@V1D1705 00232000
ST XR0,EGPR13 @V1D1705 00233000
B LINKA JOIN BELOW @V1D1705 00234000
LINK11 CLI OLDPSW+3,SLOAD SVC 08 @V1D1705 00235000
BE LOAD5 BRANCH IF YES @V1D1705 00236000
LINKA ST XR7,LINKPTR CHAIN NEW AREA AHEAD OF OTHERS @V1D1705 00237000
LR XR7,XR1 @V1D1705 00238000
ST XR7,LINKLAST @V1D1705 00239000
XC LINKBYTE(4),LINKBYTE CLEAR SIZE FIELD @V1D1705 00240000
DROP XR1 @V1D1705 00241000
USING LINKBLK,XR7 USE LINKBLK DSECT @V1D1705 00242000
MVC SAVPSW(8),OLDPSW SAVE OLD SVC PSW @V1D1705 00243000
LINK1A L XRF,EGPR15 GET A(PHASE NAME) @V1D1705 00244000
L XRF,0(,XRF) @V1D1705 00245000
TM OSSFLAGS,COMPSWT MODULES @V1D1705 00246000
BO LODMOD CMS LOADMOD @V1D1705 00247000
B DYNAMIC GO DYNAMICALLY LINK @V1D1705 00248000
LINK2 EQU * RETURN FROM DYNAMIC LOAD OF T@V1D1705 00249000
ST XR0,OLDPSW+4 SET PSW TO ENTRY POINT @V1D1705 00250000
ST XR0,EGPR15 SET ENTRY POINT IN R15 @V1D1705 00251000
LINK3 LA XRE,EXIT SET RETURN ADDRESS @V1D1705 00252000
CLI OLDPSW+3,07 WAS THIS A TRANSFER CONTROL? @VA05460 00253000
BE TRANS1 YES, SPECIAL CONSIDERATION @VA05460 00254000
ST XRE,EGPR14 FOR CALLEE @V1D1705 00255000
TRANS1 EQU * @VA05460 00256000
L XRE,OSTEMP RETURN TO SVC HANDLER @V1D1705 00257000
BR XRE @V1D1705 00258000
LOAD5 L XRF,EGPR0 GET REQUESTED PHASE NAME @V1D1705 00259000
LPR XRF,XRF IN CASE DE TYPE @V1D1705 00260000
L XR7,LINKSTRT CHAIN NEW BLOCK TO LOAD LIST @V1D1705 00261000
ST XR1,LINKSTRT AT THE TOP OF THE LIST @V1D1705 00262000
ST XR7,0(XR1) @V1D1705 00263000
LR XR7,XR1 R7 HAS LINK BLOCK ADDR @V1D1705 00264000
MVI LINKCNT,X'00' CLEAR USE COUNT @V1D1705 00265000
XC LINKBYTE,LINKBYTE CLEAR SIZE FIELD @VA04980 00266000
B DYNAMIC1 FETCH PHASE @V1D1705 00267000
EJECT 00268000
* EXIT MACRO EXIT, SVC 3 00269000
EXIT SVC 3 COME HERE ON RETURN MACRO @V1D1705 00270000
SPACE 3 00271000
* RETURN FROM LINKED-TO PHASE - RETURN, SVC 3 00272000
SPACE 1 00273000
USING *,12 @V1D1705 00274000
DMSSLN3 L XRC,BASED COMMON ADDRESSABILITY @V1D1705 00275000
USING DMSSLN7,XRC @V1D1705 00276000
BAL 10,LODREG SET REGS BY CONVENTION @V1D1705 00277000
CLI SAVPSW+3,42 WAS THIS AN ATTACH SVC @V1D1705 00278000
BNE RETURN3 NO, SKIP ATTACH EXIT CODE @V1D1705 00279000
L XR1,SAVR15 GET ADDR OF ATTACH PARM LIST @V1D1705 00280000
LA XR1,0(0,XR1) CLEAR HI BYTE @V1D1705 00281000
LTR XR1,XR1 IS THIS SECOND TIME THROUGH @V1D1705 00282000
BZ RETURN3 YES, RETURN @V1D1705 00283000
XC SAVR15(4),SAVR15 SET SWITCH FOR 2ND TIME THROU@V1D1705 00284000
L XRA,8(XR1) GET ECB ADDR @V1D1705 00285000
LA XRA,0(0,XRA) CLEAR HI BYTE @V1D1705 00286000
LTR XRA,XRA IS IT ZERO @V1D1705 00287000
BZ CKEXIT YES, CONTINUE @V1D1705 00288000
MVC 0(4,XRA),EGPR15 FILL IN RETURN CODE @V1D1705 00289000
MVI 0(XRA),X'40' FILL IN COMPLETION BIT @V1D1705 00290000
CKEXIT L XRA,20(XR1) GET ADDR OF EXIT ROUTINE @V1D1705 00291000
LA XRA,0(0,XRA) CLEAR HI BYTE @V1D1705 00292000
LTR XRA,XRA IS THERE AN EXIT RTN. SPECIFI@V1D1705 00293000
BZ RETURN3 NO, RETURN @V1D1705 00294000
XC EGPR1,EGPR1 ZERO REG 1 @V1D1705 00295000
ST XRA,EGPR15 SET ENTRY POINT IN REG 15 @V1D1705 00296000
MVC OLDPSW+5(3),21(XR1) SET OLDPSW TO EXIT ROUTINE @V1D1705 00297000
B LINK3 RETURN TO SVC ROUTINE @V1D1705 00298000
RETURN3 BAL XRA,DEL6 RELEASE PHASE STORAGE @V1D1705 00299000
MVC OLDPSW,SAVPSW RESTORE PSW FROM LAST LINK @V1D1705 00300000
LR XR1,XR7 PREPARE TO FREE LATEST BLOCK ON C@V1D1705 00301000
L XR7,LINKPTR GET SECOND MEMBER OF CHAIN @V1D1705 00302000
ST 7,LINKLAST @V1D1705 00303000
LA XR0,SAVLEN/8 LINK/XCTL LINK BLOCK SIZE @V1D1705 00304000
CLI OLDPSW+3,42 IS THIS ATTACH @V1D1705 00305000
BNE RETURN4 NO @V1D1705 00306000
LA XRF,SVAREA-LINKBLK(XR1) GET ATTACHEE'S SAVE ARE@V1D1705 00307000
MVC EGPR0(52),20(XRF) RESTORE REGS FOR ATTACHER @V1D1705 00308000
MVC EGPR13(4),SAVR13-LINKBLK(XR1) RESTORE ATTACHER'S@V1D1705 00309000
RETURN4 DMSFRET DWORDS=(0),LOC=(1),TYPCALL=BALR @V1D1705 00310000
B DEL7A @VA03007 00311000
EJECT 00312000
* LOAD IN AN OBJECT DECK - LOAD, SVC 8 00313000
SPACE 1 00314000
DMSSLN8 EQU * LOAD A MODULE, SVC 8 @V1D1705 00315000
USING DMSSLN8,12 @V1D1705 00316000
L XRC,BASED COMMON ADDRESSABILITY @V1D1705 00317000
USING DMSSLN7,12 @V1D1705 00318000
BAL 10,LODREG SET REGS BY CONVENTION @V1D1705 00319000
L 15,EGPR0 GET A(PHASE NAME) @V1D1705 00320000
LPR XRF,XRF IN CASE OF DE TYPE @V1D1705 00321000
LA XR8,LOAD2 IN CASE FOUND @V1D1705 00322000
LA XRA,LODMOD1 IN CASE NOT FOUND @V1D1705 00323000
TM OSSFLAGS,COMPSWT TEST FOR MODULE FORM @V1D1705 00324000
BO SCAN MODULES, LOOK FOR LRB @V1D1705 00325000
LA XRA,LINK1 IN CASE NOT FOUND @V1D1705 00326000
SCAN L XR0,LINKSTRT GET LRB ANCHOR @V1D1705 00327000
LDLOOP LTR XR1,XR0 LAST LRB ? @V1D1705 00328000
DROP XR7 @V1D1705 00329000
USING LINKBLK,XR1 @V1D1705 00330000
BCR 8,XRA BRANCH IF LAST @V1D1705 00331000
CLC LINKNAM(8),0(XRF) IS THIS REQUESTED PHASE @V1D1705 00332000
L XR0,LINKPTR PTR TO NEXT LRB @V1D1705 00333000
BNE LDLOOP NO, CHECK NEXT LRB @V1D1705 00334000
L XR0,LINKENT GET ENTRY LOCATION @V1D1705 00335000
LR XR7,XR1 SET LINKBLK IN 7 @V1D1705 00336000
DROP XR1 @V1D1705 00337000
USING LINKBLK,XR7 @V1D1705 00338000
BR XR8 RETURN @V1D1705 00339000
EJECT 00340000
* 00341000
* SET UP TO GO TO "LOADER" TO LOAD APPROPRIATE TEXT DECKS 00342000
* 00343000
DYNAMIC LA XR8,INCORE2 IN CASE FOUND IN CORE @V1D1705 00344000
BAL XRA,SCAN LOOK FOR PHASE IN CORE @V1D1705 00345000
USING DYNALIST,XR9 @V1D1705 00346000
DYNAMIC1 MVC LINKNAM(8),0(XRF) MOVE PHASE NAME TO LINK BLOC@V1D1705 00347000
LH XR0,TBENT GET NUMBER OF TABLE ENTRIES @VA04980 00348000
LTR XR0,XR0 HAS ANYTHING BEEN LOADED? @VA04980 00349000
BZ DYNAMIC9 BRANCH IF NOT @VA04980 00350000
L XR4,ALDRTBLS GET LOADER TABLE ADDRESS @VA04980 00351000
LA XR4,0(,XR4) CLEAR HIGH BYTE @VA04980 00352000
LA XR3,LDRENT GET LENGTH OF TABLE ENTRY @VA04980 00353000
USING LDRSECT,XR4 @VA04980 00354000
DYNAMIC3 EQU * @VA04980 00355000
SR XR4,XR3 POINT TO NEXT LOADER ENTRY @VA04980 00356000
CLC LINKNAM(8),LDRNAME IS THIS THE NAME? @VA04980 00357000
BE DYNAMIC4 BRANCH IF YES @VA04980 00358000
BCT XR0,DYNAMIC3 GO CHECK NEXT ENTRY @VA04980 00359000
B DYNAMIC9 NAME IS NOT IN TABLE @VA04980 00360000
DYNAMIC4 EQU * @VA04980 00361000
L XR0,LDRADD GET START ADDRESS @VA04980 00362000
MVC LINKAREA,LDRRELO MOVE IN RELOCATION FACTOR @VA04980 00363000
B INCORE2 @VA04980 00364000
DROP XR4 @VA04980 00365000
DYNAMIC9 EQU * @VA04980 00366000
L XR9,EGPR13 CALLER'S REG13 @V1D1705 00367000
MVC LDNAME(8),0(XRF) SET NAME @V1D1705 00368000
LA XR4,LOADLST+16 GETMAIN PARAM AREA @V305665 00369000
LA XR3,LINKAREA SET ANSWER AREA @V1D1705 00370000
GETMAIN VU,LA=GETCONST,A=(XR3),MF=(E,(XR4)) @V1D1705 00371000
* FOR NEW PHASE 00372000
L XR1,LINKAREA ADDR OF GOTTEN AREA @V1D1705 00373000
ST XR1,LOCCNT SET LOCATION COUNTER @V1D1705 00374000
A XR1,LINKBYTE POINT TO END OF GOTTEN AREA @V1D1705 00375000
ST XR1,DYNAEND CHECKED BY DMSLDR @V1D1705 00376000
XC ALIASENT(4),ALIASENT CLEAR ENTRY LOCATION FO@V1D1705 00377000
MVC LOADLST+16(32),WLIST COMPLETE INCLUDE PLIST @V305665 00378000
LH XRB,TBENT REMEMBER LOADER TABLE COUNT @V1D1705 00379000
LA XR1,LOADLST SET PLIST @V305665 00380000
LR XRA,XR7 SAVE XR7 @V1D1705 00381000
L XRF,=V(DMSOLD) CALL LOADER @V305665 00382000
BALR XRE,XRF @V1D1705 00383000
USING *,XRE @V1D1705 00384000
L XRC,BASED @V1D1705 00385000
DROP XRE @V1D1705 00386000
L XRD,CURRSAVE RESTORE R13 @V1D1705 00387000
LR XR7,XRA RESTORE XR7 @V1D1705 00388000
CH XRF,=H'4' CHECK LOADER RETURN CODE @V1D1705 00389000
BH DYNAERR BRANCH IF YES @V1D1705 00390000
STH XRB,TBENT RESTORE LOADER TBL COUNT @V1D1705 00391000
L XR1,LOCCNT ENDING LOAD LOCATION @V1D1705 00392000
LA XR1,7(0,XR1) ROUND TO DBL WD BDRY. @V1D1705 00393000
N XR1,GETMASK @V1D1705 00394000
L XR0,DYNAEND END OF PHASE AREA @V1D1705 00395000
SR XR0,XR1 REMAING UNUSED STOR. @V1D1705 00396000
BZ LOAD3A BRANCH IF ZERO @V1D1705 00397000
FREEMAIN R,LV=(XR0),A=(XR1) RELEASE IT @V1D1705 00398000
LOAD3A L XRF,LINKBYTE LENGTH OF GOTTEN AREA @V1D1705 00399000
SR XRF,XR0 MINUS AM'T JUST FREED @V1D1705 00400000
ST XRF,LINKBYTE AM'T STILL LEFT @V1D1705 00401000
TM OSSFLAGS,DYMBRNM WAS A MEMBER CALLED BY ITS N@V1D1705 00402000
BO DEFENT YES, USE DEFAULT ENTRY ADDRESS @V1D1705 00403000
TM OSSFLAGS,DYLIBO WAS ENTRY POINT FOUND IN PHA@V1D1705 00404000
BNO DEFENT NO, USE DEFAULT @V1D1705 00405000
L XR0,ALIASENT GET ENTRY NAME LOCATION @V1D1705 00406000
B INCORE2 CONTINUE @V1D1705 00407000
DEFENT L XR0,STRTADDR DEFAULT ENTRY LOCATION @V1D1705 00408000
LTR XR0,XR0 WAS ENTRY POINT SET @V1D1705 00409000
BZ DYNAERR NO, ERROR @V1D1705 00410000
INCORE2 NI OSSFLAGS,255-DYLD-DYLIBO-DYMBRNM @V1D1705 00411000
* RESET DYNAMIC FLAGS 00412000
CLI OLDPSW+3,SLOAD SVC 8 ? @V1D1705 00413000
BE LOAD2 YES. @V1D1705 00414000
B LINK2 ALL OTHER SVC'S @V1D1705 00415000
DYNAERR ABEND 346 ERROR FROM DMSLDR @V1D1705 00416000
LOAD2 TM OSSFLAGS,COMPSWT MODULES @V1D1705 00417000
BO LOAD3 YES, SKIP USE COUNT CODE @V1D1705 00418000
IC XRE,LINKCNT GET USE COUNT @V1D1705 00419000
LA XRE,1(0,XRE) INCREASE IT @V1D1705 00420000
STC XRE,LINKCNT SAVE IT @V1D1705 00421000
ST XR0,LINKENT SET ENTRY ADDRESS IN LOAD BLOCK @V1D1705 00422000
LOAD3 ST XR0,EGPR0 SET ANSWER REG @V1D1705 00423000
L XRE,OSTEMP @V1D1705 00424000
BR 14 RETURN TO SVCINT @V1D1705 00425000
SPACE 1 00426000
EJECT 00427000
* RELEASE A LOAD MODULE - DELETE, SVC 9 00428000
DMSSLN9 EQU * DELETE A PHASE, SVC 9 @V1D1705 00429000
USING DMSSLN9,12 SET TEMPORARY ADDRESSABLIITY@V1D1705 00430000
L XRC,BASED @V1D1705 00431000
USING DMSSLN7,12 @V1D1705 00432000
BAL XRA,LODREG @V1D1705 00433000
TM OSSFLAGS,COMPSWT CMS MODULES @V1D1705 00434000
BO DEL1 YES, DELETE TREATED AS NOP @V1D1705 00435000
L XRF,EGPR0 SET R15 FOR SCAN @V1D1705 00436000
LA XRA,DELABEND IN CASE NOT FOUND IN CORE @V1D1705 00437000
BAL XR8,SCAN LOOK FOR PHASE ON LOAD LIST @V1D1705 00438000
SR XR8,XR8 CLEAR FOR IC @V1D1705 00439000
IC XR8,LINKCNT GET USE COUNT @V1D1705 00440000
BCT XR8,DEL5 DECREMENT, BRANCH IF NOT ZERO @V1D1705 00441000
LA XRA,DEL2 @V1D1705 00442000
DEL6 L XR0,LINKBYTE LENGTH OF PHASE AREA @V1D1705 00443000
LTR XR0,XR0 DOES PHASE OCCUPY STOR. @V1D1705 00444000
BCR 8,XRA RETURN IF NOT @V1D1705 00445000
L XR1,LINKAREA ADDR OF PHASE AREA @V1D1705 00446000
FREEMAIN R,LV=(0),A=(1) RETURN STORAGE @V1D1705 00447000
BR XRA RETURN TO CALLING SECTION @V1D1705 00448000
DEL2 LA XR3,LINKSTRT FIND PREVIOUS LRB @V1D1705 00449000
DEL4 C XR7,0(XR3) THIS LRB POINT TO CURRENT LRB @V1D1705 00450000
BE DEL3 YES, FOUND IT @V1D1705 00451000
L XR3,0(XR3) NEXT LRB ON CHAIN @V1D1705 00452000
B DEL4 @V1D1705 00453000
DEL3 LR XR1,XR7 @V1D1705 00454000
L XR7,LINKPTR NEXT LRB @V1D1705 00455000
LA XR0,SAVLEN/8 FREE LOAD BLOCK @V1D1705 00456000
DMSFRET DWORDS=(0),LOC=(1),TYPCALL=BALR @V1D1705 00457000
ST XR7,0(XR3) RECONNECT CHAIN @V1D1705 00458000
DEL1 EQU * @V1D1705 00459000
SR XRF,XRF CLEAR ERROR CODE @V1D1705 00460000
DEL7 ST XRF,EGPR15 SET RETURN CODE FOR USER @VA02371 00461000
DEL7A DS 0H @VA03007 00462000
NI OSSFLAGS,255-DYLD-DYLIBO-DYMBRNM CLEAR DYMAMIC @VA02371 00463000
L XRE,OSTEMP @V1D1705 00464000
BR 14 RETURN TO SVC @V1D1705 00465000
DEL5 STC XR8,LINKCNT SET USE COUNT @V1D1705 00466000
B DEL1 RETURN @V1D1705 00467000
DELABEND LA XRF,4 SET DELETE RETURN CODE @V1D1705 00468000
B DEL7 EXIT @V1D1705 00469000
EJECT 00470000
* 00471000
* INITIALIZE PROGRAM REGISTERS 00472000
* 00473000
LODREG OI OSSFLAGS,DYLD+OSRESET SET FLAGS @V1D1705 00474000
L XR7,LINKLAST V(LAST LINKAGE CHAIN BLOCK) @V1D1705 00475000
L XRD,CURRSAVE POINT TO SYSTEM SAVE ARE@V1D1705 00476000
ST XRE,OSTEMP SAVE RETURN REG @V1D1705 00477000
BR 10 @V1D1705 00478000
SPACE 3 00479000
SPACE 3 00480000
EJECT 00481000
* 00482000
* EXECUTE CMS LOADMOD OF A MODULE PHASE 00483000
* 00484000
LODMOD MVC LINKNAM(8),0(XRF) PHASE NAME TO LINK BLOCK @V1D1705 00485000
LA XR8,INCORE2 IN CASE FOUND @V1D1705 00486000
BAL XRA,SCAN LOOK FOR PHASE ON LOAD RB CHAIN @V1D1705 00487000
LODMOD1 L XRB,ASVCSECT @V1D1705 00488000
MVC DUMCOM(8),0(XRF) MOVE PHASE NAME TO LOAD PLIST@V1D1705 00489000
LA XR1,MODLIST @V1D1705 00490000
L XRD,USAVEPTR SAVE AREA FOR DMSMOD @V1D1705 00491000
USING FREEST,XRD @V305665 00492000
L XRA,AFVS ADDR. OF FVSECT @V305665 00493000
USING FVSECT,XRA @V305665 00494000
MVC DSKLIN(44),DSKLIS MOVE PARAMETER LIST @V305665 00495000
MVC DSKLIN+8(8),8(XR1) MOVE MODULE NAME TO PLIST @V305665 00496000
LA XR1,DSKLIN SET PLIST REGISTER @V305665 00497000
SR XR9,XR9 AVOID POSSIBLE FRET ERROR @VA06348 00498000
L XRF,ASTATE CHECK FOR FILE @V305665 00499000
BALR XRE,XRF @V305665 00500000
BNZ LMODSTER STATE ERROR @V305665 00501000
L XR1,28(,XR1) GET A(FST COPY) @V305665 00502000
MVC DSKLIN+24(2),24(XR1) SET MODE IN PLIST @V305665 00503000
LA XR0,TEN GET AN INPUT BUFFER @V305066 00504000
DMSFREE DWORDS=(0),TYPCALL=BALR @V305665 00505000
LR XR9,XR1 USE R9 AS BUFFER ADDR @V305665 00506000
ST XR9,DSKLIN+28 SET IN PLIST @V305665 00507000
LA XR1,DSKLIN ADDR OF READ PLIST @V305665 00508000
L XRF,ARDBUF READ FIRST RECORD @V305665 00509000
BALR XRE,XRF @V305665 00510000
BNZ ERR104S ERROR @V305665 00511000
L XR6,0(XR9) GET STARTING ADDR OF MOD @V305665 00512000
LM XR3,XR4,4(XR9) GET 1ST AND LAST LOCATIONS @V305665 00513000
TM SUBFLAG,SUBACT IS IT ACTIVE? @V305665 00514000
BZ SUBOK BRANCH IF NOT @V305665 00515000
C XR3,AUSRAREA COMPARE LOAD LOC WITH USER @V305665 00516000
BL SUBOK OK IF LOADING BELOW USER @V305665 00517000
LA XRF,THIRTY2 WOULD OVERLAY VALID TEXT @V305066 00518000
B EXITA @V305665 00519000
LMODSTER EQU * @V305665 00520000
CH XRF,=H'28' FILE NOT FOUND? @V305665 00521000
BE ERR002E BRANCH IF YES @V305665 00522000
B EXITA @V305665 00523000
SUBOK EQU * @V305665 00524000
CLM XR3,LOW3,ADTRANS PUT MODULE IN TRANS? @V305665 00525000
BNE STR6 BRANCH IF NOT @V305665 00526000
MVC LASTTMOD,DSKLIN+8 REMEMBER MODULE @V305665 00527000
ST XR6,STRTADDR SET STARTING ADDRESS @VA14326 00527500
B LM34 @V305665 00528000
STR6 EQU * @V305665 00529000
C XR4,FREELOWE WILL FREE STOR BE OVERLAID @V305665 00530000
BH ERR109S BRANCH IF YES @V305665 00531000
MVC LASTLMOD,DSKLIN+8 REMEMBER MODULE @V305665 00532000
ST XR6,STRTADDR SET STARTING ADRESS @V305665 00533000
MVC LOCCNT(4),LOCCNT-STRTADDR(XR9) SET LOCATIONS @V305665 00534000
LH XR8,TBENT-STRTADDR(XR9) LDR TABLE COUNT @V305665 00535000
LTR XR8,XR8 IS IT ZERO (NO MAP)? @V305665 00536000
BZ NOCOUNT BRANCH IF YES @V305665 00537000
STH XR8,TBENT SET NEW COUNT @V305665 00538000
SR XR0,XR0 GET NUM OF LDRTBL PAGES @V305665 00539000
IC XR0,ALDRTBLS FROM LEFT-MOST BYTE @V305665 00540000
MH XR0,=H'204' X 204 (204 ENTRIES/PAGE) @V305665 00541000
CR XR8,XR0 @V305665 00542000
BH ERR116S REFERENCE TABLE OVERFLOW @V305665 00543000
NOCOUNT EQU * @V305665 00544000
OI LDRFLAGS,HEX04 SET NOERASE FOR LOAD MAP @V305066 00545000
LM34 EQU * @V305665 00546000
MVC FRSTLOC(8),FRSTLOC-STRTADDR(XR9) SET LOCATIONS @V305665 00547000
L XR5,F65535 MAX SIZE FOR RDBUF @V305665 00548000
SR XR4,XR3 GET LENGTH OF TEXT @V305665 00549000
RLOOP EQU * @V305665 00550000
STM XR3,XR4,DSKLIN+28 ADDR AND LNTH IN PLIST @V305665 00551000
CR XR4,XR5 TOO BIG FOR RDBUF? @V305665 00552000
BNH OKR BRANCH IF NOT @V305665 00553000
ST XR5,DSKLIN+32 IF TOO BIG SUBSTITUTE MAX @V305665 00554000
OKR EQU * @V305665 00555000
L XRF,ARDBUF READ IN SOME TEXT @V305665 00556000
BALR XRE,XRF @V305665 00557000
BNZ ERR104S BRANCH IF ERROR @V305665 00558000
AR XR3,XR5 INCREMENT STARTING ADDRESS @V305665 00559000
SR XR4,XR5 REMAINING COUNT @V305665 00560000
BP RLOOP LOOP IF MORE @V305665 00561000
LH XR4,TBENT-STRTADDR(XR9) NUM OF LOADER TBL ENT @V305665 00562000
MH XR4,=H'20' MULTIPLY BY 20 @V305665 00563000
LTR XR4,XR4 ANY LOADER TABLES? @V305665 00564000
BZ CHKSTR BRANCH IF NOT @V305665 00565000
L XR3,ALDRTBLS TOP OF LOADER TABLES @V305665 00566000
LA XR3,0(,XR3) CLEAR HIGH BYTE @V305665 00567000
SR XR3,XR4 GET STORAGE LOADER LOC @V305665 00568000
STM XR3,XR4,DSKLIN+28 SET PLIST @V305665 00569000
L XRF,ARDBUF @V305665 00570000
BALR XRE,XRF READ IN LDR TABLES @V305665 00571000
N XRF,=A(X'FFFFF7') ALLOW ONLY 0 OR 8 @V305665 00572000
BNZ ERR104S READ ERROR @V305665 00573000
CHKSTR EQU * @V305665 00574000
TM LDRFLAGS+1-STRTADDR(XR9),X'80' STRINIT? @V305665 00575000
BNO CHKSYS BRANCH IF NOT @V305665 00576000
L XRF,=V(DMSSMNSB) STORAGE INIT. ROUTINE @V305665 00577000
BALR XRE,XRF @V305665 00578000
CHKSYS EQU * @V305665 00579000
L XR3,4(XR9) GET FIST LOCATION @V305665 00580000
CLM XR3,LOW3,ADTRANS TRANSIENT AREA? @V305665 00581000
LA XR1,PRFUSYS XR1 <- USER SYSTEM BIT @V305665 00582000
BNE CHKSYSA SKIP IF USER ROUTINE @V305665 00583000
LA XR1,PRFTSYS XR1 <- TRANSIENT SYSTEM BIT @V305665 00584000
CHKSYSA EQU * @V305665 00585000
EX XR1,CHKSYSO TURN ON SYSTEM FLAG @V305665 00586000
TM LDRFLAGS-STRTADDR(XR9),SYSTEM IS IT SYSTEM MOD? @V305665 00587000
BO FINMOD SKIP IF SO @VA09429 00588000
EX XR1,CHKSYSX IF NOT, RESET FLAG @VA09429 00589000
B FINMOD @V305665 00590000
CHKSYSO OI PROTFLAG,BINZERO BIT FILLED IN BY EX @V305066 00591000
CHKSYSX XI PROTFLAG,BINZERO BIT FILLED IN BY EX @V305066 00592000
FINMOD EQU * @V305665 00593000
LA XR1,DSKLIN PLIST FOR FINIS @V305665 00594000
L XRF,AFINIS @V305665 00595000
BALR XRE,XRF FINIS FILE @V305665 00596000
BNZ ERR105S BRANCH IF ERROR @V305665 00597000
EXITA EQU * @V305665 00598000
LTR XR1,XR9 WAS A BUFFER ACQUIRED? @V305665 00599000
BZ EXIT1 BRANCH IF NOT @V305665 00600000
LR XR5,XRF PROTECT RETURN CODE @V305665 00601000
LA XR0,TEN SIZE OF BUFFER @V305066 00602000
DMSFRET DWORDS=(0),LOC=(1),TYPCALL=BALR @V305665 00603000
LR XRF,XR5 RESTORE RETURN CODE @V305665 00604000
EXIT1 EQU * @V305665 00605000
LR XRE,XRB @V305665 00606000
LM XR3,XR4,FRSTLOC FIRST AND LAST LOCATIONS @V305665 00607000
L XR7,LINKLAST RESTORE SOME REGS @V1D1705 00608000
L XRD,CURRSAVE @V1D1705 00609000
LTR XRF,XRF ANY ERRORS @V1D1705 00610000
BZ DEFENT SET ENTRY POINT AND EXIT @V1D1705 00611000
ABEND 341 TERMINATE @V1D1705 00612000
EJECT 1 00613000
ERR002E EQU * @V305665 00614000
LA XR2,DSKLIN+8 ADDR OF FILE NAME @V305665 00615000
DMSERR TEXT='FILE ........ MODULE NOT FOUND', @V305665X00616000
LET=E,NUM=2,SUB=(CHARA,(XR2)) @V305665 00617000
LA XRF,TWENTY8 SET ERROR CODE @V305066 00618000
B EXITA AND RETURN @V305665 00619000
SPACE 1 00620000
ERR104S EQU * @V305665 00621000
LR XR3,XRF SAVE RETURN CODE @V305665 00622000
LA XR2,DSKLIN+8 ADDR OF FILE NAME @V305665 00623000
DMSERR TEXT=('ERROR ''..'' READING FILE ', @V305665X00624000
'''....................'' FROM DISK'), @V305665X00625000
NUM=104,LET=S,MF=(E,MSG), @V305665X00626000
SUB=(DEC,(XR3),CHAR8A,(XR2)) @V305665 00627000
LA XRF,HUNDRED SET RETURN CODE @V305066 00628000
B EXITA AND EXIT @V305665 00629000
SPACE 1 00630000
ERR105S EQU * @V305665 00631000
LR XR3,XRF SAVE RETURN CODE @V305665 00632000
LA XR2,DSKLIN+8 ADDR OF FILE NAME @V305665 00633000
DMSERR TEXT=('ERROR ''..'' WRITING FILE ', @V305665X00634000
'''....................'' ON DISK'), @V305665X00635000
NUM=105,LET=S,MF=(E,MSG), @V305665X00636000
SUB=(DEC,(XR3),CHAR8A,(XR2)) @V305665 00637000
LA XRF,HUNDRED SET RETURN CODE @V305066 00638000
B EXITA AND RETURN @V305665 00639000
SPACE 1 00640000
ERR109S EQU * @V305665 00641000
DMSERR TEXT='STORAGE EXCEEDED',LET=S,NUM=109 @V305665 00642000
LA XRF,HUNDRED4 SET ERROR CODE @V305066 00643000
B EXITA AND RETURN @V305665 00644000
SPACE 1 00645000
ERR116S EQU * @V305665 00646000
DMSERR TEXT='LOADER TABLE OVERFLOW',LET=S,NUM=116 @V305665 00647000
LA XRF,HUNDRED4 SET ERROR CODE @V305066 00648000
B EXITA AND RETURN @V305665 00649000
EJECT 00650000
XR0 EQU 0 @V1D1705 00651000
XR1 EQU 1 @V1D1705 00652000
XR2 EQU 2 @V1D1705 00653000
XR3 EQU 3 @V1D1705 00654000
XR4 EQU 4 @V1D1705 00655000
XR5 EQU 5 @V1D1705 00656000
XR6 EQU 6 @V1D1705 00657000
XR7 EQU 7 @V1D1705 00658000
XR8 EQU 8 @V1D1705 00659000
XR9 EQU 9 @V1D1705 00660000
XRA EQU 10 @V1D1705 00661000
XRB EQU 11 @V1D1705 00662000
XRC EQU 12 @V1D1705 00663000
XRD EQU 13 @V1D1705 00664000
XRE EQU 14 @V1D1705 00665000
XRF EQU 15 @V1D1705 00666000
DROP XRA @V305665 00667000
EJECT 00668000
*************************************************************** 00669000
* 00670000
* 'RESIDENT' 00671000
* TESTS IF THE CALLED ROUTINE IS ELEMENT OF A 'CORE RESIDENT RO 00672000
* LIST', IF SO BRANCHES TO IT. 00673000
* 00674000
*************************************************************** 00675000
RESIDENT EQU * @V1D1705 00676000
USING SSAVE,XRD @V1D1705 00677000
L XRD,CURRSAVE POINT TO SYSTEM SAVE ARE@V1D1705 00678000
L XRD,USAVEPTR POINT TO USER SAVE AREA @V1D1705 00679000
STM XR8,XRB,0(XRD) SAVE SOME REGS @V1D1705 00680000
L XRD,CURRSAVE POINT TO SYSTEM SAVE ARE@V1D1705 00681000
LA 9,ROUTABLE ORIGIN OF CORE RESIDENT ROUTINES@V1D1705 00682000
LA XRA,12 GET TABLE INCREMENT @V1D1705 00683000
LA 11,ROUTEND END OF THE CORE RESIDENT ROUTINE@V1D1705 00684000
SR 11,10 @V1D1705 00685000
L 8,EGPR15 R8 POINTS TO THE NAME @V1D1705 00686000
L 8,0(,8) OF THE CALLED ROUTINE @V1D1705 00687000
SUIT01 CLC 0(8,9),0(8) @V1D1705 00688000
BE SUIT02 THE CALLED ROUTINE IS ON THE LIS@V1D1705 00689000
BXLE 9,10,SUIT01 @V1D1705 00690000
L XR8,USAVEPTR POINT TO USER SAVE AREA @V1D1705 00691000
LM XR8,XRB,0(XR8) RESTORE REGS @V1D1705 00692000
LA XRD,EGPRS REPOINT TO XRD TO EGPRS @V1D1705 00693000
BR 10 PROBABLY ON DISK. @V1D1705 00694000
* 00695000
SUIT02 LA 9,8(,9) @V1D1705 00696000
L 12,0(,9) LOAD ROUTINE ADDRESS IN REGISTER @V1D1705 00697000
LM XR0,XR8,EGPRS @V1D1705 00698000
LA XRD,EGPRS @V1D1705 00699000
BR 12 @V1D1705 00700000
* 00701000
* TRANSFERT WITH RETURN (TO SVCINT) IN R14,SAVE AREA(USED BY SV 00702000
* IN R13,BASE IN R12.R15 TO R11, THE CONTENTS THAT EXISTED BEFO 00703000
* THE OS SVC WAS EXECUTED. 00704000
* THE ROUTINE IS ENTERED WITH REGISTERS SET AS IF IT HAS BEEN C 00705000
* DIRECTLY VIA AN OS SVC INSTEAD OF BEING 'LINK-ED'. 00706000
* 00707000
EJECT 00708000
*************************************************************** 00709000
* 00710000
* GETPOOL OS MACRO INSTRUCTION 00711000
* **************************** 00712000
*GETPOOL ROUTINE IS ENTERED VIA AN LINK SVC WHEN USER ISSUES 00713000
* A GETPOOL MACRO.THE ROUTINE GETS CORE AND BUILD THE POOL 00714000
* OF BUFFERS. 00715000
*ENTRY POINT BY LINK TO IECQBFG1 00716000
*INPUT REGISTER 13 USER SAVE AREA ADDRESS 00717000
* REGISTER 14 RETURN ADDRESS 00718000
* REGISTER 12 IECQBFG1 FIRST LOCATION ADDRESS 00719000
* REGISTER 1 DCB ADDRESS FOR POOL ASSIGNMENT 00720000
* +22 NUMBER OF BUFFERS REQUESTED 00721000
* +24 LENGTH OF BUFFERS REQUESTED 00722000
*OUTPUT NUMBER AND ADDRESS OF BUILT BUFFERS IN DCB BUFNO AND BU 00723000
* EXITS NORMAL RETURN ON REGISTER 14 TO CALLER. NUMBER AND ADDR 00724000
* BUILT BUFFERS IN DCB BUFNO AND BUFCB 00725000
*EXITS ERRORS RETURN ON REGISTER 14 TO CALLER.NO BUFFERS BUILT. 00726000
* FORCE OPEN TO BUILD BUFFERS SINCE USER SPECIFIED 0 BUFFER 00727000
* NUMBER OR LENGTH 00728000
* 00729000
*************************************************************** 00730000
USING IECQBFG1,12 @V1D1705 00731000
IECQBFG1 EQU * @V1D1705 00732000
LPR DCBR,BUFPTR (R1 MIGHT BE COMPLEMENTED) @V1D1705 00733000
LH BUFNOR,22(,DCBR) PLACE NUMBER OF BUFFERS IN R@V1D1705 00734000
LH LBUFLR,24(,DCBR) PLACE LENGTH OF BUFFERS IN R@V1D1705 00735000
LTR BUFNOR,BUFNOR Q. ZERO NUMBER REQUESTED. @V1D1705 00736000
BZ RETURNA YES,RETURN @V1D1705 00737000
LTR LBUFLR,LBUFLR Q. ZERO LENGTH REQUESTED. @V1D1705 00738000
BZ RETURNA YES, RETURN @V1D1705 00739000
LA LBUFLR,7(,LBUFLR) ROUND LENGTH. @V1D1705 00740000
SRL LBUFLR,3 TO MULTIPLE @V1D1705 00741000
SLL LBUFLR,3 OF EIGHT. @V1D1705 00742000
LR BUFPTR,LBUFLR ROUNDED LENGTH TIMES @V1D1705 00743000
MR BUFPAR,BUFNOR NUMBER FOR TOTAL LENGTH @V1D1705 00744000
TM 32(DCBR),1 Q.FULL WORD ALIGNMENT SPECIFIED @V1D1705 00745000
BO POOL1 YES @V1D1705 00746000
LA BUFPAR,8(,BUFPTR) NO, ADD 8 TO LGN FOR BCB @V1D1705 00747000
B POOL2 @V1D1705 00748000
POOL1 LA BUFPAR,16(,BUFPTR) YES, ADD 16 FOR BCB AND ALIG@V1D1705 00749000
POOL2 GETMAIN R,LV=(0) OBTAIN CORE @V1D1705 00750000
ST BUFPTR,20(,DCBR) PLACE BUFCB IN DCB @V1D1705 00751000
STC BUFNOR,20(,DCBR) PLACE BUFNO IN DCB @V1D1705 00752000
TM 32(DCBR),1 Q. FULL WORD ALIGNMENT SPECIFIED @V1D1705 00753000
BO POOL3 YES @V1D1705 00754000
LA BUFPAR,8(,BUFPTR) NO,DETERMINE BCB LINK ADDR @V1D1705 00755000
B POOL4 @V1D1705 00756000
POOL3 LA BUFPAR,12(,BUFPTR) YES,LINK ADDR AROUND ALIGN P@V1D1705 00757000
POOL4 ST BUFPAR,0(,BUFPTR) PLACE LINK ADDR IN BCB @V1D1705 00758000
STH LBUFLR,6(,BUFPTR) PLACE LENGTH IN BCB @V1D1705 00759000
STH BUFNOR,4(,BUFPTR) PLACE NUMBER IN BCB @V1D1705 00760000
POOLLOOP LR BUFPTR,BUFPAR UPDATE BUFFER ADDRESS POINTER @V1D1705 00761000
BCT BUFNOR,LOOP Q.ALL BUFFERS BUILT @V1D1705 00762000
XC 0(4,BUFPTR),0(BUFPTR) CLEAR BUFFER LINK ADDRES@V1D1705 00763000
RETURNA BR 14 RETURN TO CALLER @V1D1705 00764000
LOOP LA BUFPAR,0(3,BUFPTR) NO,CALCULATE NEXT BUFFER ADD@V1D1705 00765000
ST BUFPAR,0(,BUFPTR) STORE BUFFER LINK ADDRESS @V1D1705 00766000
BC 15,POOLLOOP BUILD NEXT BUFFER @V1D1705 00767000
SPACE 1 00768000
BUFPAR EQU 0 @V1D1705 00769000
BUFPTR EQU 1 @V1D1705 00770000
BUFNOR EQU 2 @V1D1705 00771000
LBUFLR EQU 3 @V1D1705 00772000
DCBR EQU 4 @V1D1705 00773000
* SOME NICE CONSTANTS AND EQUATES 00774000
* 00775000
SPACE 1 00776000
DS 0D @V1D1705 00777000
BASED DC A(DMSSLN7) @V1D1705 00778000
* 00779000
* TABLE OF CORE-RESIDENT ROUNTINES 00780000
* CL8'*NAME*', A(CORE LOCATION) 00781000
* 00782000
ROUTABLE DS 0F BEGGINING OF TABLE @V1D1705 00783000
DC CL8'IECQBFG1',A(IECQBFG1) @V1D1705 00784000
ROUTEND DS 0F END OF TABLE @V1D1705 00785000
* 00786000
GETMASK DC X'00FFFFF8' @V1D1705 00787000
* 00788000
* 00789000
WLIST DS 0X STOCK VOCABULARY @V1D1705 00790000
DC CL8'(' @V1D1705 00791000
DC CL8'RESET' @V1D1705 00792000
DC CL8'*' @V1D1705 00793000
DC 8X'FF' @V1D1705 00794000
GETCONST DC F'16' MINIMUM GETMAIN STOR. @V1D1705 00795000
DC X'00F00000' MAXIMUM @V1D1705 00796000
LOW3 EQU 7 MASK FOR 2-4 BYTES @V305665 00797000
SYSTEM EQU X'01' @V305665 00798000
TEN EQU 10 @V305066 00799000
THIRTY2 EQU 32 @V305066 00800000
HEX04 EQU X'04' @V305066 00801000
BINZERO EQU X'00' @V305066 00802000
TWENTY8 EQU 28 @V305066 00803000
HUNDRED EQU 100 @V305066 00804000
HUNDRED4 EQU 104 @V305066 00805000
SPACE 2 00806000
DSKLIS EQU *-8 @V305665 00807000
DC X'FF',7X'40' SET FOR DEFAULT FNAME @V305665 00808000
DC CL8'MODULE' FTYPE @V305665 00809000
DC CL2'* ' FMODE @V305665 00810000
DC H'0' ITEM NUMBER @V305665 00811000
DC F'0' BUFFER ADDRESS @V305665 00812000
DC A(80) LENGTH OF FIRST RECORD @V305665 00813000
DC CL2'V ' VARIABLE LENGTH FILE @V305665 00814000
DC H'1' NO. OF ITEMS @V305665 00815000
DC F'0' NO. OF BYTES READ @V305665 00816000
SPACE 2 00817000
LTORG @V1D1705 00818000
* 00819000
* SOME DUMMIES FOLLOW .... 00820000
* 00821000
SPACE 1 00822000
* BASE=XR9=A(12+XRD OF CALLER OS SAVEAREA) 00823000
DYNALIST DSECT @V1D1705 00824000
DS 3F @V1D1705 00825000
LOADLST DS CL8 INCLUDE @V305665 00826000
LDNAME DS CL8 "*NAME*" @V1D1705 00827000
DS 8F @V1D1705 00828000
FREEST DSECT @V305665 00829000
BUFF DS 2F @V305665 00830000
DSKLIN DS 11F @V305665 00831000
MSG DMSERR MF=L,MAXSUBS=2 @V305665 00832000
EJECT 00833000
SPACE 3 00834000
SLOAD EQU 8 @V1D1705 00835000
LINKBLK DSECT @V1D1705 00836000
LINKPTR DS 1F POINTER TO NEXT LINK BLOCK @V1D1705 00837000
LINKAREA DS 1F PHASE STORAGE AREA LOCATION @V1D1705 00838000
LINKBYTE DS 1F LENGTH (BYTES) OF PHASE AREA @V1D1705 00839000
LINKNAM DS 2F PHASE NAME @V1D1705 00840000
SAVPSW DS 2F OLD SVC PSW FOR LINK @V1D1705 00841000
LINKENT DS 1F ENTRY LOCATION OF PHASE @V1D1705 00842000
LINKCNT DS 2X USE COUNT - LOAD RB @V1D1705 00843000
SVAREA DS 19F SAVE AREA FOR ATTACHEE @V1D1705 00844000
SAVR13 DS 1F @V1D1705 00845000
SAVR15 DS 1F @V1D1705 00846000
DS 0D @V1D1705 00847000
SAVLEN EQU (*-LINKBLK) BLOCK LENGTH @V1D1705 00848000
SPACE 3 @VA04980 00849000
LDRSECT DSECT LOADER TABLE ENTRY @VA04980 00850000
LDRNAME DS 2F LOADED TEXT NAME @VA04980 00851000
LDRRELO DS F RELOCATION FACTOR @VA04980 00852000
LDRADD DS F ASSIGNED ADDRESS @VA04980 00853000
LDRFLG2 DS F @VA04980 00854000
LDRENT EQU *-LDRNAME @VA04980 00855000
EJECT 00856000
PGMSECT @V1D1705 00857000
SPACE 3 00858000
NUCON @V1D1705 00859000
SPACE 3 00860000
SVCSECT @V1D1705 00861000
SPACE 3 00862000
FVS @V305665 00863000
CMSAVE @V1D1705 00864000
EJECT 00865000
END 00866000