FCH TITLE 'DMSFCH (CMS) VM/370 - RELEASE 6' 00001000
SPACE 2 00002000
*. 00003000
* MODULE NAME 00004000
* 00005000
* DMSFCH ( FETCH ROUTINE ) 00006000
* 00007000
* FUNCTION 00008000
* 00009000
* PROVIDE THE FACILITY TO BRING INTO STORAGE A 00010000
* SPECIFIED PHASE FROM THE SYSTEM/PRIVATE CORE 00011000
* IMAGE LIBRARY OR FROM A CMS 'DOSLIB' LIBRARY. 00012000
* THIS ROUTINE IS ENTERED AS A RESULT OF AN SVC 00013000
* 1, 2, OR 4 (DOS/VS SVC) FROM A DOS/VS PROGRAM, 00014000
* OR FROM THE CMS/DOS 'FETCH' COMMAND. 00015000
* 00016000
* ATTRIBUTES 00017000
* 00018000
* CMSDOS SEGMENT RESIDENT MODULE 00019000
* REENTRANT 00020000
* 00021000
* ENTRY POINTS 00022000
* 00023000
* DMSFCH 00024000
* 00025000
* ENTRY CONDITIONS 00026000
* 00027000
* THIS ROUTINE IS CALLED BY DMSDOS VIA BALR R14,R15 00028000
* 00029000
* R14 = RETURN ADDRESS 00030000
* R15 = ENTRY POINT 00031000
* R0 = OVERRIDE LOAD ADDRESS 00032000
* R1 = PHASE DIRECTORY LIST 00033000
* 00034000
* DC CL8'PHASENM' NAME OF PHASE TO LOAD 00035000
* DC F'11' NUMBER HALF WORDS IN LIST 00036000
* DC XL4'0' NOT REFERENCED BY DMSFCH 00037000
* DC XL1'0' OR XL1'1' IF 1, DO NOT LOAD PHASE 00038000
* DC XL17'0' REST OF DIRECTORY LIST 00039000
* 00040000
* EXIT CONDITIONS 00041000
* 00042000
* RETURN TO CALLER WITH RETURN CODE IN R15 00043000
* 00044000
* RETURN CODES AND MESSAGES: 00045000
* 00046000
* 100 - SPECIFIED DISK NOT ATTACHED 00047000
* 100 - INPUT ERROR ON SYSRES OR SYSCLB 00048000
* 100 - ERROR READING DOSLIB FILE FROM DISK 00049000
* 104 - VIRTUAL STORAGE CAPACITY EXCEEDED 00050000
* 104 - DOS PARTITION TOO SMALL TO ACCOMMODATE FETCH REQUEST 00051000
* 00052000
* CALLS TO OTHER ROUTINES 00053000
* 00054000
* DMSFRE, DMSSTT, DMSSOP, DMSSVT 00055000
* DMSSBS, DMSSCT, DMKGIO, DMSERR 00056000
* 00057000
* EXTERNAL REFERENCES 00058000
* 00059000
* NUCON, DCBD, CMSCB, OSFST, BGCOM 00060000
* 00061000
* TABLES/WORK AREAS 00062000
* 00063000
* FCHSECT 00064000
* 00065000
* NOTES 00066000
* 00067000
* DMSFCH WILL DESTROY THE CALLER'S REG. 7 THROUGH 11 00068000
* 00069000
* REGISTER USAGE 00070000
* 00071000
* R0 WORK & PHASE DIRECTORY POINTER UPON EXIT 00072000
* R1 WORK & PHASE ENTRY POINT ADDRESS UPON EXIT 00073000
* R2 WORK 00074000
* R3 WORK 00075000
* R4 WORK 00076000
* R5 WORK 00077000
* R6 FCHSECT ADDRESSABILITY 00078000
* R7 DOSLIB DCB POINTER & WORK 00079000
* R8 WORK 00080000
* R9 WORK 00081000
* R10 INTERNAL LINKAGE & WORK 00082000
* R11 WORK 00083000
* R12 DMSFCH ADDRESSABILITY 00084000
* R13 SAVE AREA POINTER 00085000
* R14 EXTERNAL LINKAGE & RETURN REGISTER 00086000
* R15 ADDRESS OF EXTERNAL LINKAGE & RETURN CODE 00087000
* 00088000
* OPERATION 00089000
* 00090000
* 1. SET UP NECESSARY ADDRESSABILITIES AND SAVE 00091000
* SOME REGISTERS. ACQUIRE WORK AREA FROM FREE 00092000
* STORAGE. INITIALIZE WORK AREA AND CHECK IF 00093000
* USER DOES NOT WANT THE PHASE LOADED ( USED 00094000
* TO VERIFY IF THE PHASE EXISTS ). 00095000
* 00096000
* 2. VERIFY IF THE PRIVATE CORE IMAGE LIBRARY IS 00097000
* ASSIGNED, AND IF SO, LOCATE THE LIBRARY DOSCB. 00098000
* CALL STATE TO VERIFY IF THE LIBRARY EXISTS AND 00099000
* USING THE LIBRARY OSFST, GET THE STARTING DISK 00100000
* ADDRESS OF THE LIBRARY AND THE VIRTUAL DEVICE 00101000
* ADDRESS OF WHERE THE LIBRARY RESIDES. 00102000
* 00103000
* 3. IF THE PRIVATE CORE IMAGE LIBRARY IS NOT ACTIVE 00104000
* OR DOES NOT CONTAINS THE PHASE TO BE LOADED, 00105000
* THE DOSLIB DCB IS OPENED TO SEARCH THROUGH THE 00106000
* CHAIN OF DOSLIB'S GLOBALED. IF THE DCB DID OPEN 00107000
* OK, A 'FIND' ( O/S SVC ) IS ISSUED TO SEE IF THE 00108000
* PHASE RESIDES ON ANY OF THE GLOBALED DOSLIB'S. 00109000
* 00110000
* 4. IF NEITHER PRIVATE CORE IMAGE LIBRARY OR DOSLIB 00111000
* LIBRARIES CONTAIN THE PHASE TO BE LOADED, DMSFCH 00112000
* VERIFIES IF THE SYSRES VOLUME IS ACTIVE. IF THE 00113000
* VOLUME IS ACTIVE, A SEARCH IS MADE TO LOCATE THE 00114000
* SPECIFIED PHASE ON THE SYSTEM CORE IMAGE LIBRARY. 00115000
* 00116000
* 5. ONCE THE PHASE HAS BEEN LOCATED, THE PHASE HEADER 00117000
* (DIRECTORY) RECORD IS READ. THE NUMBER OF TEXT 00118000
* BLOCKS IN THE PHASE IS COMPUTED AND THE LENGTH OF 00119000
* THE PHASE IS DETERMINED. IF THE PHASE RESIDES ON 00120000
* A DOS/VS FORMATTED DISK, THE DISK ADDRESS OF THE 00121000
* PHASE IS COMPUTED. 00122000
* 00123000
* 6. THE PHASE LOAD POINT AND ENTRY POINT IS COMPUTED 00124000
* USING THE INFORMATION ON THE PHASE HEADER RECORD 00125000
* AND THE USER SPECIFIED LOAD ADDRESS, IF ANY. THE 00126000
* RELOCATION FACTOR (IF THE PHASE IS RELOCATABLE) 00127000
* IS THEN COMPUTED AND THE ENDING ADDRESS OF THE 00128000
* PHASE IS SAVED IN THE COMMUNICATIONS REGION. 00129000
* NEXT, THE SIZE OF THE USER'S VIRTUAL PARTITION IS 00130000
* COMPUTED (USING THE SPECIFIED DOSKPART - IF ANY). 00131000
* IF THE PHASE TO BE LOADED WILL EXCEED 'PPEND'- THE 00132000
* FETCH IS NOT ALLOWED AND MESSAGE 777S IS PRODUCED. 00133000
* 00134000
* 00135000
* 7. ALL OF THE PHASE'S TEXT BLOCKS (DATA BLOCKS) ARE 00136000
* READ AND MOVED TO THEIR SPECIFIC LOCATION IN THE 00137000
* VIRTUAL PARTITION. IF THE PHASE IS RELOCATABLE, 00138000
* THE NUMBER OF 'RLD' ITEMS TO RELOCATE IS ACQUIRED 00139000
* FROM THE HEADER RECORD, AND THE PHASE IS RELOCATED 00140000
* BY READING THE RLD ITEMS AND USING THE RELOCATION 00141000
* FACTOR COMPUTED EARLY TO RELOCATE ALL OF THE PHASE'S 00142000
* RELOCATABLE ITEMS. 00143000
* 00144000
* 8. WHEN THE PHASE HAS BEEN LOADED (AND RELOCATED IF 00145000
* NEEDED) THE DOSLIB DCB IS CLOSED, THE DMSFCH WORK 00146000
* AREA IS RETURN TO FREE STORAGE, AND A RETURN TO 00147000
* CALLER IS MADE PASSING BACK THE FOLLOWING INFO. 00148000
* R0. POINTS TO THE UPDATED PHASE DIRECTORY 00149000
* R1. CONTAINS THE PHASE ENTRY POINT 00150000
* R15. CONTAINS THE RETURN CODE OF THIS ROUTINE. 00151000
*. 00152000
EJECT 00153000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00154000
* * 00155000
* SET UP ADDRESSABILITIES , ACQUIRE WORK AREA FROM * 00156000
* FREE STORAGE, AND INITIALIZE SOME FIELDS. * 00157000
* * 00158000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00159000
SPACE 2 00160000
DMSFCH CSECT @V305001 00161000
USING DMSFCH,R9 TEMP ADDRESSABILITY @V305001 00162000
USING NUCON,R0 ... @V305001 00163000
LR R8,R14 SAVE RETURN POINT @V305001 00164000
LR R9,R15 SAVE ENTRY POINT @V305001 00165000
LR R10,R0 SAVE LOAD ORIGIN @V305001 00166000
LR R11,R1 SAVE DIRECTORY @V305001 00167000
LA R0,FCHLEN GET WORK AREA LENGTH @V305001 00168000
DMSFREE DWORDS=(0),TYPCALL=BALR @V305001 00169000
USING FCHSECT,R1 ... @V305001 00170000
XC FCHSECT(256),FCHSECT ZERO ENOUGH AT TOP @V305001 00171000
XC FCHDCB,FCHDCB CLEAR DCB AREA, TOO @VA04915 00172000
LR R14,R8 RESTORE RETURN ADDRESS @V305001 00173000
STM R10,R11,USERLD SAVE ORIGIN AND DIRECTORY @V305001 00174000
STM R12,R14,FCHREG1 SAVE REGS 12 - 14 @V305001 00175000
STM R2,R7,FCHREG2 SAVE REGS 02 - 07 @V305001 00176000
DROP R1,R9 @V305001 00177000
LR R6,R1 WORK AREA ADDRESS TO R6 @V305001 00178000
LR R12,R9 SET UP OUR BASE REGISTER @V305001 00179000
USING FCHSECT,R6 @V305001 00180000
USING DMSFCH,R12 @V305001 00181000
MVC DIRNAME(DIRLEN),0(R11) MOVE DIRECTORY TO WORK @V305066 00182000
LA R1,FCHBUF GET BEGIN WORK BUFFER @V305001 00183000
LA R1,1024(,R1) COMPUTE END OF BUFFER @V305001 00184000
ST R1,FCHBUFE SAVE FOR LATER @V305001 00185000
LA R13,FCHSAVE POINT TO O/S SAVE AREA @V305001 00186000
OC FCHSW,DIRC REMEMBER DIRC BITS FOR LATER @V305001 00187000
NI FCHSW,FIFTEEN MUST RESET CMS BIT @VA05887 00188000
EJECT 00189000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00190000
* * 00191000
* VERIFY IF PRIVATE C.I.L. IS ASSIGNED, AND IF SO, ISSUE * 00192000
* DUMMY DLBL FOR IJSYSCL TO ACQUIRE USER ISSUED DLBL. 00193000
* VERIFY THAT AN OSFST EXIST TO GET THE STARTING CCHHR OF * 00194000
* THE DATA SET AND THE VIRTUAL DEVICE ADDRESS. * 00195000
* * 00196000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00197000
SPACE 2 00198000
CKPCIL EQU * @V305001 00199000
LA R3,SYSCLB GET SYSCLB LUB INDEX NO. @V305001 00200000
BAL R10,TSTUNIT SEE IF UNIT ASSIGNED @V305001 00201000
BZ CKDOSL BRANCH IN NOT ASSIGNED @V305001 00202000
MVC FCHTYP,4(R3) SAVE DASD DEVICE TYPE @V305066 00203000
SR R9,R9 ... @V305001 00204000
ICM R9,M7,DOSFIRST+1 GET DOSCB CHAIN ADDRESS @V305066 00205000
USING FCBSECT,R9 @V305001 00206000
CKPCIL1 BZ CKDOSL IF ZERO, NO MORE DOSCB @V305001 00207000
CLC IJSYSCL,FCBDD MATCHING DDNAME ? @V305001 00208000
BE CKPCIL2 YES, BRANCH @V305001 00209000
ICM R9,M7,1(R9) GET NEXT DOSCB ADDRESS @V305066 00210000
B CKPCIL1 KEEP LOOKING @V305001 00211000
CKPCIL2 CLI FCBDEV,FCBDSK IS DEVICE DISK ? @V305001 00212000
BNE CKDOSL NO, BRANCH @V305001 00213000
LA R1,FCBOP USE FCB FOR STATE PLIST @V305001 00214000
L R15,ASTATE GET STATE ADDRESS @V305001 00215000
BALR R14,R15 GO STATE PRIVATE LIBRARY @V305001 00216000
LA R14,RC28 SET R14 TO RETURN CODE 28 @VA04898 00217000
CLR R15,R14 IS RETURN CODE 28 ? @VA04898 00218000
BZ ERRMSG YES, GO ISSUE ERRMSG @VA04898 00219000
LTR R15,R15 RESET CONDITION CODE @VA04898 00220000
BNZ CKDOSL IF ERRORS, GO TO SEARCH DOSLIB @V305001 00221000
L R9,FCBOSFST GET OSFST FOR P.C.I.L. @V305001 00222000
DROP R9 @V305001 00223000
LTR R9,R9 ANY AVAILABLE ? @V305001 00224000
BZ CKDOSL NO, BRANCH @V305001 00225000
USING OSFST,R9 @V305001 00226000
MVC FCHCHR(4),OSFSTXTN+2 SAVE P.C.I.L. CCHH @V305001 00227000
MVI FCHR,ONE RECORD NUMBER TO 1 @V305066 00228000
MVC FCHCUU(2),OSFSTDSK SAVE P.C.I.L. CUU @V305001 00229000
DROP R9 @V305001 00230000
OI FCHSW,PCILA SET PCIL FLAG IN FCHSW @V305001 00231000
B CILCOMM GO TO COMMON C.I.L. CODE @V305001 00232000
ERRMSG DMSERR TEXT='NO PRIVATE CORE IMAGE LIBRARY X00233000
FOUND',NUM=16,LET=E 00234000
B DONE GET OUT @VA04898 00235000
EJECT 00236000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00237000
* * 00238000
* SEE IF ANY DOSLIB LIBRARIES HAVE BEEN GLOBALED, AND * 00239000
* IF SO, OPEN THE DOSLIB DCB. THEN ISSUE THE O/S FIND * 00240000
* SVC TO SEE IF THE PHASE EXISTS ON ANY OF THE GLOBALED * 00241000
* DOSLIB'S. IF THE PHASE IS FOUND, SET THE 'CMS READ' * 00242000
* FLAG ON, AND GO TO THE PHASE FOUND ROUTINE. * 00243000
* * 00244000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00245000
SPACE 2 00246000
CKDOSL CLC DOSLIBL,FENCE ANY DOSLIB LIBRARY GLOBALED ? @V305066 00247000
BE CKSCIL NO, CHECK FOR SYSTEM C.I.L. @V305001 00248000
LA R9,DOSLIBL POINT TO DOSLIB NAMES @VA04915 00249000
MVC STDOSFT,DOSLIB SET UP PLIST @VA04915 00250000
MVC STDOSEND,FENCE MOVE FENCE TO PLIST @VA04915 00251000
STDOSL EQU * @VA04915 00252000
MVC STDOSNM,0(R9) MOVE IN THE NAME @VA04915 00253000
LA R1,STDOSLST POINT TO LIST @VA04915 00254000
L R15,ASTATE GET STATE ADDRESS @VA04915 00255000
BALR R14,R15 GO STATE DOSLIB @VA04915 00256000
BZ OPENDOSL BRANCH IF FOUND @VA04915 00257000
LA R9,8(,R9) POINT TO NEXT NAME @VA04915 00258000
CLC FENCE,0(R9) IS THERE ONE? @VA04915 00259000
BE CKSCIL BRANCH IF NOT @VA04915 00260000
B STDOSL CHECK THIS ONE @VA04915 00261000
OPENDOSL EQU * @VA04915 00262000
NI DOSFLAGS,255-DOSSVC CLEAR DOSSVC FLAG FOR NOW @V305001 00263000
MVC FCHDCB,SYSLIB MOVE DCB TO WORK AREA @V305066 00264000
LA R7,FCHDCB GET DCB BASE @V305001 00265000
USING IHADCB,R7 ... @V305001 00266000
MVI DCBBUFCB+3,ZERO TELL OPEN DON'T GET BUFFER @V305066 00267000
LA R9,ERR104 GET ERROR ADDRESS @V305001 00268000
ST R9,DCBEODAD SAVE IN DCB EODAD @V305001 00269000
ST R9,DCBSYNAD SAVE IN DCB SYNAD @V305001 00270000
MVI FCHBUF,RENT SET OPEN PLIST AS RE-ENTRANT @V305066 00271000
LA R1,FCHBUF GET OPEN PLIST @V305001 00272000
OPEN ((7)),MF=(E,(1)) OPEN DOSLIB @V305001 00273000
TM DCBOFLGS,OPNOK DCB OPEN SUCCESSFUL ? @V305066 00274000
BZ CKSCIL NO, CHECK FOR SYSTEM C.I.L. @V305001 00275000
LA R15,EIGHT SET RETURN CODE TO 8. @V305066 00276000
FIND (7),DIRNAME,D DO A FIND ON THE MEMBER @V305001 00277000
LTR R15,R15 WAS THE MEMBER FOUND ? @V305001 00278000
BNZ CKSCIL NO, CHECK FOR SYSTEM C.I.L. @V305001 00279000
LA R8,DIRNAME GET BUFFER AREA FOR DIRECTORY @V305001 00280000
L R9,DIRBLOCK GET MAX LENGTH DIRECTORY @V305001 00281000
NI FCHSW,255-DOSREAD RESET DOS READ FLAG @V305001 00282000
BAL R10,READ READ DIRECTORY (1ST RECORD) @V305001 00283000
B PHSEFND GO PROCESS PHASE @V305001 00284000
DROP R7 ... @V305001 00285000
EJECT 00286000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00287000
* * 00288000
* ACQUIRE THE CUU OF SYSRES FORM THE SYSRES LUB/PUB. * 00289000
* SET UP THE SYSTEM C.I.L. CCHHR AND FALL THROUGH C.I.L. * 00290000
* COMMON CODE. BOTH THE PRIVATE C.I.L. AND THE SYSTEM * 00291000
* C.I.L. WILL USE THIS CODE. A READ DIRECTORY CHANNEL * 00292000
* PROGRAM IS USED TO LOCATE THE DIRECTORY ENTRY FOR THE * 00293000
* PHASE. ONCE THE DIRECTORY FOR THE PHASE IS FOUND, * 00294000
* THE DIRECTORY IS MOVED TO THE FETCH WORK AREA. * 00295000
* * 00296000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00297000
SPACE 2 00298000
CKSCIL EQU * @V305001 00299000
LA R3,SYSRES GET SYSRES LUB INDEX NO. @V305001 00300000
BAL R10,TSTUNIT SEE IF UNIT ASSIGNED @V305001 00301000
BZ PHNFND BRANCH IF NOT ASSIGNED @V305001 00302000
MVC FCHTYP,4(R3) SAVE DASD DEVICE TYPE @V305066 00303000
MVC FCHCUU,0(R3) SAVE SYSRES CUU @V305066 00304000
MVC FCHCHR(5),SCILCHR INIT SYSRES DIRECTORY PTR. @V305001 00305000
CILCOMM MVC FCHORG(4),FCHCHR SAVE LIBRARY ORIGIN CCHH @V305001 00306000
LA R9,FCHHDR GET PROPER CHANNEL PGM @V305001 00307000
ST R9,FCHCCWA SAVE IN WORK AREA @V305001 00308000
OI FCHSW,DOSREAD+DACTIVE SET APPROP FLAGS @VA04754 00309000
BAL R10,READ GO GET DIRECTORY @V305001 00310000
NI FCHSW,255-DACTIVE DIRECTORY SEARCH IS OVER @VA04754 00311000
LA R9,FCHTXT GET TEXT CHANNEL PGM @V305001 00312000
ST R9,FCHCCWA SAVE IN WORK AREA @V305001 00313000
LA R2,FCHBUF POINT TO BUFFER READ @V305001 00314000
USING DIRNAME,R2 ... @V305001 00315000
LA R2,2(,R2) ... @V305001 00316000
SR R3,R3 ... @V305001 00317000
BUMP AR R2,R3 BUMP TO NEXT ENTRY @V305001 00318000
SR R3,R3 ZERO REG 3 @V305001 00319000
IC R3,DIRN GET NUMBER HALF WORDS @V305001 00320000
LA R3,DIRTT-DIRNAME(R3,R3) @V305001 00321000
CLC DIRNAME,PHNAME(R6) DO NAMES MATCH ? @V305001 00322000
BE PHFOUND YES, BRANCH @V305001 00323000
BL BUMP NO, KEEP LOOKING @V305001 00324000
DROP R2 ... @V305001 00325000
TM FCHSW,PCILA LOOKINK IN P.C.I.L. ? @V305001 00326000
BZ PHNFND NO, PHASE NOT FOUND @V305001 00327000
NI FCHSW,255-PCILA RESET P.C.I.L. FLAG @V305001 00328000
B CKDOSL TRY DOSLIB LIBRARY NOW.. @V305001 00329000
EJECT 00330000
USING DIRNAME,R2 ... @V305001 00331000
PHFOUND SR R3,R3 ... @V305001 00332000
IC R3,DIRN GET NO. HALF WORDS INFO. @V305001 00333000
SLL R3,ONE MULTIPLY BY 2, @V305066 00334000
LA R3,11(,R3) AND ADD CONSTANT. @V305066 00335000
EX R3,MOVEDIR MOVE DIRECTORY TO WORK @V305001 00336000
DROP R2 ... @V305001 00337000
SPACE 2 00338000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00339000
* * 00340000
* THE NUMBER OF TEXT BLOCKS FOR THE PHASE IS COMPUTED, * 00341000
* AND THE LENGTH OF THE PHASE IS DETERMINED. IF THE PHASE * 00342000
* RESIDES ON A DOS DISK, THE SEEK/SEARCH ADDRESS FOR THE * 00343000
* PHASE IS COMPUTED. * 00344000
* * 00345000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00346000
SPACE 2 00347000
PHSEFND TM FCHSW,NOTEXT TEXT = NO SPECIFIED ? @V305001 00348000
BO RLDEXIT YES, ALL DONE.... @V305001 00349000
LH R9,DIRTT GET NUMBER 1024 BLOCKS @V305001 00350000
BCTR R9,0 LESS LAST ONE @V305001 00351000
SLA R9,TEN MULTIPLY BY 1024 @V305066 00352000
AH R9,DIRLL ADD LENGTH LAST BLOCK @V305001 00353000
ST R9,PHASELN SAVE AS PHASE LENGTH @V305001 00354000
TM FCHSW,DOSREAD DOING I/O VIA DIAGNOSE ? @V305001 00355000
BZ CMSREAD NO, BRANCH @V305001 00356000
MVC FCHR(1),DIRTTR+2 MOVE RECORD NUMBER FROM TTR @V305001 00357000
LH R3,DIRTTR GET RELATIVE HEAD @V305001 00358000
AH R3,FCHORG+2 ADD TO ORIGIN HEAD @V305001 00359000
SR R2,R2 ... @V305001 00360000
LH R5,TC3340 GET 3340 DEVICE CONSTANT @V305001 00361000
CLI FCHTYP,T3350 IS DEVICE 3350 @VA08343 00361100
BNE TST3330 NO CHECK 3330 @VA08343 00361200
LH R5,TC3350 GET 3350 DEV TYPE @VA08343 00361300
B CMSEEK GO COMPUTE SEEK ADDR @VA08343 00361400
TST3330 EQU * @VA08343 00361500
CLI FCHTYP,T3330 IS DEVICE 3330 ? @V305001 00362000
BNE TSTMOD11 IF NOT THEN CHECK 3330-11 @VA08343 00363000
LH R5,TC3330 GET 3330 DEVICE CONSTANT @V305001 00364000
B CMSEEK GO COMPUTE SEEK ADDRESS @V305001 00365000
TSTMOD11 EQU * @VA08343 00365100
CLI FCHTYP,MOD11 IS DEVICE 3330-11 @VA08343 00365200
BNE TST2314 NO CHECK FOR 2314 @VA08343 00365300
LH R5,TC3330 GET 3330 DEVICE CONSTANT @VA08343 00365400
B CMSEEK GO COMPUTE SEEK ADDR @VA08343 00365500
TST2314 CLI FCHTYP,T2314 IS DEVICE 2314 ? @V305001 00366000
BNE CMSEEK NO, BRANCH @V305001 00367000
LH R5,TC2314 GET 2314 DEVICE CONSTANT @V305001 00368000
CMSEEK DR R2,R5 COMPUTE ABSOLUTE HEAD NUMBER @V305001 00369000
STH R2,FCHCHR+2 SAVE FOR SEEK @V305001 00370000
LH R2,FCHORG GET ORIGIN CYLINDER NUMBER @V305001 00371000
AR R3,R2 COMPUTE ABSOLUTE CYL NUMBER @V305001 00372000
STH R3,FCHCHR SAVE FOR SEEK @V305001 00373000
EJECT 00374000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00375000
* * 00376000
* THE PHASE LOAD POINT AND ENTRY POINT IS COMPUTED AND * 00377000
* THE RELOCATION FACTOR (IF PHASE IS RELOCATABLE) IS * 00378000
* COMPUTED TOO. THE ENDING ADDRESS OF THE PHASE IS SAVED * 00379000
* IN THE COMMUNICATIONS REGION . * 00380000
* * 00381000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00382000
SPACE 2 00383000
CMSREAD SR R8,R8 ... @V305001 00384000
SR R9,R9 ... @V305001 00385000
ICM R8,M7,DIRPPP GET PHASE LOAD POINT @V305066 00386000
ICM R9,M7,DIRAAA GET DOS PARTITION BEGIN @V305066 00387000
SR R8,R9 COMPUTE RELATIVE DOS PPBEG @V305001 00388000
BNM GETLDAD IF NOT MINUS, BRANCH @V305001 00389000
SR R8,R8 ZERO RELATIVE DISPLACEMENT @V305001 00390000
GETLDAD ICM R2,M7,USERLD+1 GET USER SUPPLIED R0. @V305066 00391000
BZ GETLDP IF NOT SUPPLIED, USE DEFAULT @VA09200 00392000
CLC DIRNAME(3),=CL3'$$B' LOADING $$B-TRANS ? @V305101 00393000
BE SAVELD YES, DO NOT CHECK FOR 20000, @V305101 00394000
B SAVELDP ELSE SEE IF LOADPOINT >= 20000. @V305101 00395000
GETLDP L R2,AUSRAREA GET BEGINNING OF USERAREA @V305066 00396000
LA R2,0(R8,R2) COMPUTE RELATIVE CMS PPBEG @V305066 00397000
TM DIRC,RELPHSE RELOCATABLE PHASE? @V305066 00398000
BO SAVELD YES, FETCH PHASE AT 20000+ @V305066 00399000
ICM R2,M7,DIRPPP DOS LOAD POINT TO R2 @V305066 00400000
SAVELDP C R2,AUSRAREA IS THE LOAD POINT < 20000 ? @V305066 00401000
BL ERR115E YES, GIVE ERROR... @V305066 00402000
SAVELD ST R2,PHASELD SAVE CMS PHASE LOAD POINT @V305066 00403000
ICM R8,M7,DIRPPP GET PHASE LKED LOAD POINT @V305066 00404000
ICM R9,M7,DIREEE GET PHASE LKED ENTRY POINT @V305066 00405000
SR R2,R8 GET RELOCATION FACTOR @V305001 00406000
AR R9,R2 RELOCATE ENTRY POINT @V305001 00407000
ST R9,PHASEEP SAVE PHASE CMS ENTRY POINT @V305001 00408000
ST R2,RELFACT SAVE RELO FACTOR @V305001 00409000
L R3,PHASELD GET PHASE LOAD POINT @V305001 00410000
L R2,PHASELN GET PHASE LENGTH @V305001 00411000
AR R2,R3 COMPUTE END ADDRESS @V305001 00412000
BCTR R2,0 LESS ONE @V305001 00413000
TM DOSFLAGS,VSMINSTL ARE WE INSTALLING VSAM ? @V305101 00414000
BO CKPHASE YES, DO NOT CHECK FOR $$B. @V305101 00415000
C R3,DOSTRANS LOAD INTO TRANSIENT AREA? @VA09193 00415300
BNE CKPHASE NO, CHECK USERAREA @VA09193 00415600
CLC DIRNAME(3),=CL3'$$B' LOADING $$B-TRANS ? @V305101 00416000
BE CK$$BHI YES, CHECK IF > THAN TRANS AREA @V305101 00417000
CKPHASE C R2,FREELOWE EXCEEDS AVAILABLE STORAGE ? @V305101 00418000
BNL NOCORE YES, GIVE ERROR MESSAGE @V305001 00419000
L R9,ASYSREF GET ADDRESS OF BGCOM @VA04646 00420000
USING BGCOM,R9 @VA04646 00421000
ICM R3,15,PPEND WILL THE REAL PPEND STAND UP? @VA04646 00422000
BNZ AVAILPT GOTCHA @VA04646 00423000
DROP R9 @VA04646 00424000
* 00425000
* ALSO COMPUTE WHETHER PHASE WOULD EXCEED VIRTUAL PARTITION 00426000
* SIZE AT EXECUTION TIME... 00427000
* 00428000
LH R9,FRERESPG GET NO. PP'S TO SAVE FOR CMS @VA04299 00429000
SLL R9,12 CONVERT PAGES TO BYTES @VA04299 00430000
LR R4,R9 AND PUT IT IN R4. @VA04299 00431000
LR R5,R4 ALSO IN R5 @VA04299 00432000
TM VSAMFLG1,VSAMRUN+VSAMSERV VSAM AND/OR AMSERV? @VA04299 00433000
BNZ ADDANCH YES- CONSIDER ANCHOR TAB @VA04299 00434000
TM DOSFLAGS,DOSVSAM WILL BE RUNNING VSAM?? @VA04299 00435000
BZ CVPART NO- SKIP AROUND @VA04299 00436000
ADDANCH LA R5,ANCHSIZ(,R4) RES SPACE FOR ANCHOR TABLE @VA04299 00437000
CVPART L R3,FREELOWE GET TOT AMT OF SPACE @VA04299 00438000
S R3,MAINSTRT IN PARTITION @VA04826 00439000
SR R3,R9 BACK OUT RESERVED AMT. @VA04299 00440000
CLR R4,R5 NOW, WAS VSAM A FACTOR? @VA04299 00441000
BE NOVSM NO- SKIP ADD'L CALCS @VA04646 00442000
LR R1,R3 SIZE INTO R1 FOR WORK @VA04299 00443000
LH R4,PCTVSAM PERCENT TO RES FOR VSAM @VA04299 00444000
MR R0,R4 CALC HOW MUCH ROOM TO LEAVE @VA04299 00445000
D R0,=F'100' FOR GETVIS/FREEVIS USE @VA04299 00446000
LR R3,R1 RELOAD R3- FORGET REMAINDER @VA04299 00447000
LA R5,ANCHSIZ SIZE OF ANCHOR TABLE INTO WORK 00448000
SR R3,R5 BACK IT OUT @VA04646 00449000
* 00450000
* IF PARTITION SIZE IS TOO BIG- USER WILL GET DEFAULT , I.E., A 00451000
* SIZE SMALLER THAN WHAT WAS SPECIFIED IN DOSPART. EITHER AN 00452000
* ACCEPTED DOSPART SIZE OR THIS 'SMALLER' AMOUNT IS THEN CHECKE 00453000
* AGAINST THE SIZE OF THE PHASE TO BE LOADED. IF THE PHASE WILL 00454000
* EXCEED THE END OF THE USER'S VIRTUAL DOS PARTITION, THEN THE 00455000
* FETCH IS NOT ALLOWED AND AN ERROR MESSAGE IS PRODUCED. 00456000
* 00457000
NOVSM A R3,MAINSTRT CALC NEW MAINHIGH @VA04646 00458000
BCTR R3,R0 MINUS ONE = PPEND @VA04646 00459000
SR R9,R9 CLEAR WORK REG @VA04299 00460000
ICM R9,3,DOSKPART GET USER REQ'D PART. SIZE @VA04299 00461000
BZ AVAILPT IF 'NONE' USE DEFAULT SCHEME @VA04299 00462000
SLL R9,10 CONVERT TO BYTES @VA04299 00463000
A R9,MAINSTRT GET USER'S NOTION OF PPEND @VA04646 00464000
CR R3,R9 WILL USER'S SIZE FIT? @VA04299 00465000
BNH AVAILPT NO- USE WHAT'S AVAILABLE @VA04299 00466000
LR R3,R9 GO ALONG WITH USER'S WISHES @VA04299 00467000
AVAILPT EQU * @VA04299 00468000
CR R2,R3 WILL PHASE BEING LOADED @VA04646 00469000
* EXCEED THIS? 00470000
BNH CKPH01 NO - GO GET IT @VA07269 00471000
CL R2,MAINHIGH IS IT WITHIN GETVIS? @VA07269 00472000
BH ERPART ITS OUT OF OUR AREA @VA07269 00473000
L R3,MAINLIST GET FREE LIST POINTER @VA07269 00474000
LA R3,0(R3) CLEAR HIGH ORDER BYTE @VA07269 00475000
LTR R3,R3 IS PIONTER ZERO? @VA07269 00476000
BZ CKPH01 YES - ITS ALL OURS @VA07269 00477000
CKFRE EQU * @VA07269 00478000
LR R4,R3 BRING IN THE FIRST POINTER @VA07269 00479000
CL R4,PHASELD IS IT HIGHER THAN LOAD POINT? @VA07269 00480000
BH CKMORE YES - SEE IF THE PHASE WILL FIT @VA07269 00481000
A R4,4(R4) ADD FREE AREA LENGTH @VA07269 00482000
BCTR R4,R0 SUBTRACT ONE TO GET TRUE LENGTH @VA07269 00483000
CL R4,PHASELD ARE WE LOADING IN THIS FREE AREA?@VA07269 00484000
BNL ERPART YES - THAT IS AN ERROR @VA07269 00485000
L R3,0(R3) GET THE NEXT POINTER @VA07269 00486000
LTR R3,R3 IS THIS THE END OF FREE LIST? @VA07269 00487000
BZ CKPH01 YES - GO LOAD IT @VA07269 00488000
B CKFRE AND GO LOOK AT THIS ONE @VA07269 00489000
CKMORE EQU * @VA07269 00490000
CR R4,R2 HIGHER THAN LOAD PT +LENGTH? @VA07269 00491000
BNL CKPH01 YES - IT FITS GO GET IT @VA07269 00492000
B ERPART NO - ITS OUT OF OUR PARTITION @VA07269 00493000
CKPH01 EQU * @VA07269 00494000
ST R2,LASTLOAD SAVE END OF LAST PHASE LOADED @VA07269 00495000
B TXTREAD GO READ TEXT BLOCKS @V305001 00496000
CK$$BHI LA R3,TRANSLN $$B-TRANS AREA LENGTH @V305066 00497000
A R3,DOSTRANS COMPUTE WHERE DOSTRANS ENDS @V305101 00498000
CR R2,R3 WILL $$B-TRANS EXCEED AREA ? @V305101 00499000
BH NOCORE YES, GIVE ERROR MESSAGE @V305101 00500000
USING BGCOM,R1 @VA06035 00501000
L R1,ASYSREF @VA06035 00502000
MVC LASTLOAD(4),HIPHAS @VA06035 00503000
EJECT 00504000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00505000
* * 00506000
* THIS ROUTINE JUST LOOPS UNTIL ALL TEXT BLOCKS HAVE * 00507000
* BEEN READ. ALL BLOCKS ARE READ INTO A WORK BUFFER AND * 00508000
* MOVED TO THEIR SPECIFIC LOCATION IN CORE. * 00509000
* * 00510000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00511000
SPACE 2 00512000
TXTREAD LH R11,DIRTT GET NUMBER BLOCKS TO READ @V305001 00513000
BCTR R11,0 LESS LAST ONE @V305001 00514000
L R2,PHASELD GET BEGIN ADDRESS OF PHASE @V305001 00515000
NEXTREC LA R8,FCHBUF GET FETCH BUFFER @V305001 00516000
L R9,TXTBLOCK GET LENGTH FETCH BUFFER @V305001 00517000
LTR R11,R11 ONLY ONE BLOCK ? @V305001 00518000
BZ RDLAST YES, READ AS LAST BLOCK @V305001 00519000
LR R4,R8 TEMP SAVE IN R4 @V305001 00520000
LR R3,R9 TEMP SAVE IN R3 @V305001 00521000
LR R5,R3 ... @V305001 00522000
BAL R10,READ GO READ TEXT BLOCK @V305001 00523000
MVCL R2,R4 MOVE TEXT TO PHASE AREA @V305001 00524000
BCT R11,NEXTREC GO GET NEXT RECORD @V305001 00525000
RDLAST BAL R10,READ READ LAST BLOCK (SHORT) @V305001 00526000
LA R4,FCHBUF GET BUFFER ADDRESS @V305001 00527000
LH R3,DIRLL GET LENGTH LAST BLOCK @V305001 00528000
LR R5,R3 ... @V305001 00529000
MVCL R2,R4 MOVE TEXT TO PHASE AREA @V305001 00530000
EJECT 00531000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00532000
* * 00533000
* DETERMINE IF PHASE IS RELOCATABLE, AND IF SO SET UP * 00534000
* THE RLD BUFFER AND NUMBER OF ITEMS TO RELOCATE. * 00535000
* * 00536000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00537000
SPACE 2 00538000
L R1,PHASELD GET PHASE CMS LOAD POINT @V305001 00539000
ICM R5,M15,RELFACT GET RELOCATION FACTOR @V305066 00540000
TM DIRC,RELPHSE PHASE RELOCATABLE ? @V305001 00541000
BZ RLDEXIT NO, DON'T RELOCATE @V305001 00542000
LTR R5,R5 RELOCATION FACTOR ZERO ? @V305001 00543000
BZ RLDEXIT YES, BRANCH @V305001 00544000
LH R2,DIRLL GET LENGTH LAST BLOCK @V305001 00545000
LA R2,3(,R2) PLUS 3 FOR ALIGNMENT @V305001 00546000
N R2,=A(X'FFFFFC') ALIGN TO FULL WORD @V305001 00547000
LA R4,FCHBUF GET BUFFER ADDRESS @V305001 00548000
AR R2,R4 POINT TO RLD ITEMS @V305001 00549000
ST R2,RLDPTR SAVE ADDRESS @V305001 00550000
L R11,LASTLOAD GET END ADDRESS OF PHASE @V305001 00551000
LH R3,DIRRR GET NUMBER RLD ITEMS @V305001 00552000
LTR R3,R3 IF NONE, BRANCH @V305001 00553000
BZ RLDEXIT ... @V305001 00554000
EJECT 00555000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00556000
* * 00557000
* THE RDL BLOCKS ARE READ ONE AT A TIME, AND ALL RLD * 00558000
* ITEMS ARE RELOCATED USING THE COMPUTED RELO FACTOR. * 00559000
* * 00560000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00561000
SPACE 2 00562000
L R4,RLDPTR GET BEGIN RLD ITEMS @V305001 00563000
NXTRLD C R4,FCHBUFE ARE WE AT BUFF END ? @V305001 00564000
BL NXTRLD1 NO, BRANCH @V305001 00565000
READRLD LA R8,FCHBUF GET BUFFER ADDR @V305001 00566000
L R9,TXTBLOCK GET RECORD LEN @V305001 00567000
BAL R10,READ GET NEXT RLD BLOCK @V305001 00568000
LA R4,FCHBUF GET BUFFER BEGIN @V305001 00569000
ST R4,RLDPTR SAVE AS NEW RLD POINTER @V305001 00570000
NXTRLD1 ICM R7,M15,0(R4) GET RLD ITEM. @V305066 00571000
BZ RLDEXIT IF ZERO, ALL DONE @V305001 00572000
NXTRLD2 AR R7,R5 ADD RELOCATION FACTOR @V305001 00573000
LA R2,0(,R7) POINT TO CORE LOCATION @V305001 00574000
SRL R7,27 CREATE MASK @V305001 00575000
IC R14,MASKCON(R7) GET MASK FOR ICM/STCM @V305001 00576000
AR R7,R2 LAST BYTE OF ADCON @V305001 00577000
CR R7,R11 BEYOND END PHASE ? @V305001 00578000
BH RLDEXIT YES, BRANCH @V305001 00579000
EX R14,IADCON LOAD USER ADCON INTO R7 @V305001 00580000
TM 0(R4),ONE ADD OR SUBTRACT ? @V305066 00581000
LR R4,R5 SET TO ADD RELO @V305001 00582000
BZ NXTRLD3 BRANCH IF ADD @V305001 00583000
LCR R4,R5 SET TO SUBTRACT RELO @V305001 00584000
NXTRLD3 AR R7,R4 ADD/SUB RELO FACTOR @V305001 00585000
NXTRLD4 EX R14,SADCON STORE USER ADCON @V305001 00586000
L R4,RLDPTR RLD POINTER @V305001 00587000
LA R4,4(,R4) BUMP TO NEXT RLD ITEM @V305001 00588000
ST R4,RLDPTR SAVE POINTER @V305001 00589000
BCT R3,NXTRLD GO PROCESS NEXT RLD @V305001 00590000
RLDEXIT EQU * DONE @V305001 00591000
SR R9,R9 ZERO RETURN CODE @V305001 00592000
EJECT 00593000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00594000
* * 00595000
* THE DOSLIB DCB IS CLOSED (IF PREVIOUSLY OPEN), * 00596000
* AND THE FETCH WORK AREA IS RETURNED TO FREE STORAGE. * 00597000
* CONTROL THEN RETURNS TO THE CALLER. * 00598000
* * 00599000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00600000
SPACE 2 00601000
DONE NI FCHSW,FIFTEEN CLEAR UPPER 4 BITS OF FCHSW. @V305066 00602000
OC DIRC,FCHSW SET UP DIRC AS UPON ENTRY @V305001 00603000
LA R7,FCHDCB GET DOSLIB DCB ADDR @V305001 00604000
USING IHADCB,R7 @V305001 00605000
TM DCBOFLGS,OPNOK DOSLIB DCB OPEN ? @V305066 00606000
BZ DONE2 NO, BRANCH @V305001 00607000
DROP R7 @V305001 00608000
MVI FCHBUF,RENT SET OPEN PLIST AS RE-ENTRANT @V305066 00609000
LA R1,FCHBUF GET OPEN LIST @V305001 00610000
CLOSE ((7)),MF=(E,(1)) CLOSE DOSLIB DCB @V305001 00611000
DONE2 OI DOSFLAGS,DOSSVC SET DOSSVC FLAG ON @V305001 00612000
L R10,USERDE GET USER'S DIRECTORY @V305001 00613000
MVC 0(DIRLEN,R10),DIRNAME MOVE WORK DIRECTORY @V305066 00614000
TM DIRC,PNOTFND PHASE FOUND ? @V305001 00615000
BNO DONE3 YES, BRANCH @V305001 00616000
SR R11,R11 ENTRY POINT ZERO @V305001 00617000
B DONE4 BRANCH AROUND @V305001 00618000
EJECT 00619000
DONE3 L R11,PHASEEP GET PHASE ENTRY POINT @V305001 00620000
LTR R9,R9 ANY ERRORS ? @V305001 00621000
BNZ DONE4 YES, BRANCH @V305001 00622000
L R1,ASYSREF GET BGCOM ADDRESS @V305001 00623000
USING BGCOM,R1 ... @V305001 00624000
MVC HIPHAS,LASTLOAD SET END PHASE JUST LOADED @V305001 00625000
CLC DIRNAME(3),COMNAME SHOULD HIPROG BE UPDATED ? @V305001 00626000
BNE DONE4 NO, LEAVE ALONE @V305001 00627000
CLC HIPROG,HIPHAS IS THIS LONGEST PHASE ? @V305001 00628000
BH DONE4 NO, LEAVE ALONE @V305001 00629000
MVC HIPROG,HIPHAS SET LONGEST SO FAR... @V305001 00630000
DROP R1 ... @V305001 00631000
DONE4 LA R0,FCHLEN WORK AREA LEN TO R0 @V305001 00632000
LR R1,R6 WORK AREA TO R1 @V305001 00633000
LR R15,R12 TEMP. ADDRESSABILITY @V305001 00634000
DROP R12 @V305001 00635000
USING DMSFCH,R15 @V305001 00636000
LM R12,R14,FCHREG1 RESTORE DMSDOS REGISTERS @V305001 00637000
LM R2,R7,FCHREG2 ... @V305001 00638000
LR R8,R14 RETURN ADDRESS TO R8 @V305001 00639000
DMSFRET DWORDS=(0),LOC=(1),TYPCALL=BALR @V305001 00640000
LR R0,R10 GET DIRECTORY ADDR IN R0 @V305001 00641000
LR R1,R11 GET ENTRY POINT IN R1 @V305001 00642000
LR R15,R9 GET RETURN CODE @V305001 00643000
LR R14,R8 GET RETURN ADDRESS @V305001 00644000
BR R14 RETURN TO DMSDOS @V305001 00645000
DROP R15 @V305001 00646000
USING DMSFCH,R12 @V305001 00647000
PHNFND OI DIRC,PNOTFND SET PHASE NOT FOUND @V305001 00648000
SR R9,R9 ZERO RETURN CODE @V305001 00649000
B DONE BRANCH @V305001 00650000
EJECT 00651000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00652000
* * 00653000
* READING IS DONE FROM CMS DISKS USING O/S MACROS, * 00654000
* OR FROM DOS DISKS VIA DIAGNOSE TO CP. * 00655000
* * 00656000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00657000
SPACE 2 00658000
READ EQU * @V305001 00659000
TM FCHSW,DOSREAD READING FROM DOS DISK ? @V305001 00660000
BO READ2 YES, BRANCH @V305001 00661000
READ FCHDECB,SF,FCHDCB,(8),(9),MF=E @V305001 00662000
CHECK FCHDECB @V305001 00663000
BR R10 RETURN TO CALLER @V305001 00664000
EJECT 00665000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00666000
* * 00667000
* FOR FIRST PASS ONLY, THE CHAN PROGRAMS ARE MOVED TO * 00668000
* THE ACQUIRED WORK AREA, AND ALL CCW'S ARE RELOCATED. * 00669000
* * 00670000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00671000
SPACE 2 00672000
READ2 TM FCHSW,CCWREL CCW'S RELOCATED ? @V305001 00673000
BO READ3 YES, BRANCH @V305001 00674000
MVC FCHTXT(TXTLEN),TXTCCW MOVE CCW'S TO WORK AREA@V305066 00675000
LA R14,FCHTXT GET FIRST CHAIN CCW'S @V305066 00676000
LA R15,FCHBB GET BBCCHHR ADDRESS @V305066 00677000
STCM R15,M7,1(R14) STORE ADDR PORTION CCW @V305066 00678000
LA R14,8(,R14) BUMP TO NEXT CCW @V305066 00679000
LA R15,FCHCHR GET CCHHR ADDRESS @V305066 00680000
STCM R15,M7,1(R14) STORE ADDR PORTION CCW @V305066 00681000
STCM R14,M7,9(R14) STORE ADDR PORTION CCW @V305066 00682000
LA R14,16(,R14) BUMP TO NEXT CCW @V305066 00683000
LA R15,FCHBUF GET BUFFER ADDRESS @V305066 00684000
STCM R15,M7,1(R14) STORE ADDR PORTION CCW @V305066 00685000
LA R14,8(,R14) BUMP TO NEXT CCW @V305066 00686000
LA R15,FCHCHR GET CCHHR ADDRESS @V305066 00687000
STCM R15,M7,1(R14) STORE ADDR PORTION CCW @V305066 00688000
LA R14,FCHHDR GET SECOND CHAIN CCW'S @V305066 00689000
LA R15,FCHBB GET BBCCHHR ADDRESS @V305066 00690000
STCM R15,M7,1(R14) STORE ADDR PORTION CCW @V305066 00691000
LA R14,8(,R14) BUMP TO NEXT CCW @V305066 00692000
LA R15,FCHCHR GET CCHHR ADDRESS @V305066 00693000
STCM R15,M7,1(R14) STORE ADDR PORTION CCW @V305066 00694000
STCM R14,M7,9(R14) STORE ADDR PORTION CCW @V305066 00695000
LA R14,16(,R14) BUMP TO NEXT CCW @V305066 00696000
LA R15,DIRNAME GET KEY ADDRESS @V305066 00697000
STCM R15,M7,1(R14) STORE ADDR PORTION CCW @V305066 00698000
STCM R14,M7,9(R14) STORE ADDR PORTION CCW @V305066 00699000
LA R14,16(,R14) BUMP TO NEXT CCW @V305066 00700000
LA R15,FCHBUF GET BUFFER ADDRESS @V305066 00701000
STCM R15,M7,1(R14) STORE ADDR PORTION CCW @V305066 00702000
OI FCHSW,CCWREL INDICATE CCW'S RELOCATED @V305001 00703000
EJECT 00704000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00705000
* * 00706000
* THE LABEL FCHCCWA CONTAINS THE ADDRESS OF THE CORRECT * 00707000
* CHANNEL PROGRAM TO EXECUTE. LABEL FCHCUU CONTAINS THE * 00708000
* VIRTUAL DEVICE ADDRESS OF THE DISK. * 00709000
* * 00710000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00711000
SPACE 2 00712000
READ3 LH R9,FCHCUU GET VIRTUAL DEVICE ADDRESS @V305001 00713000
L R0,FCHCCWA GET PROPER CHANNEL PGM @V305001 00714000
XC CSW,CSW ZERO OUT CSW @V305066 00715000
DC X'83900020' DIAGNOSE I/O TO CP @V305001 00716000
BZR R10 RETURN CODE = 0 @V305001 00717000
BM NODISK DISK NOT ATTACHED @V305001 00718000
BP DSKERR I/O ERROR @V305001 00719000
STH R0,SENSDATA SAVE SENSE INFO. @V305001 00720000
TM SENSDATA,NOT1 ANY SENSE BITS NOT ALLOWED ? @V305066 00721000
BNZ DSKERR I/O ERROR @V305001 00722000
TM SENSDATA+1,NOT2 ANY MORE BITS NOT ALLOWED ? @V305066 00723000
BNZ DSKERR I/O ERROR @V305001 00724000
MVC SENSBYTE(1),SENSDATA SET UP SENSE BYTE @V305001 00725000
OC SENSBYTE(1),SENSDATA+1 ... @V305001 00726000
TM SENSBYTE,NOREC+OVFLW NO RECORD OR OVERFLOW ?@V305066 00727000
BNZR R10 YES, RETURN @V305001 00728000
TM SENSBYTE,EOC END OF CYLINDER ? @V305066 00729000
BZR R10 NO, RETURN @V305001 00730000
LH R9,FCHCHR GET CYLINDER NUMBER @V305001 00731000
LA R9,1(,R9) UP IT BY ONE @V305001 00732000
STH R9,FCHCHR SAVE NEW CYLINDER NUMBER @V305001 00733000
SR R9,R9 ... @V305001 00734000
STH R9,FCHCHR+2 RESET HEAD TO ZERO @V305001 00735000
MVI FCHCHR+4,ONE AND RECORD NUMBER TO 1 @V305066 00736000
TM FCHSW,DACTIVE IS THIS DIRECTORY SEARCH? @VA04754 00737000
BZR R10 NO, THEN RETURN TO CALLER @VA04754 00738000
B READ3 GO READ NEXT CYLINDER @VA04639 00739000
EJECT 00740000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00741000
* * 00742000
* CHECK IF SYSCLB OR SYSRES HAS BEEN ASSIGNED. * 00743000
* REG 3 = 0 MEANS UNIT NOT ASSIGNED, OTHERWISE REG 3 * 00744000
* CONTAINS THE POINTER TO THE CORRECT PUB ENTRY. * 00745000
* * 00746000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00747000
SPACE 2 00748000
TSTUNIT EQU * @V305001 00749000
USING BGCOM,R1 @V305001 00750000
L R1,ASYSREF GET BGCOM ADDRESS @V305001 00751000
AH R3,LUBPT POINT TO CORRECT LUB ENTRY @V305001 00752000
TM 0(R3),NOASSGN UNIT ASSIGNED ? @V305066 00753000
BO NOTASSGN NO, BRANCH @V305001 00754000
LH R3,0(,R3) LUB ENTRY TO REG 3 @V305001 00755000
SRL R3,8 ISOLATE PUB POINTER @V305001 00756000
SLL R3,3 MULTIPLY BY 8 @V305001 00757000
AH R3,PUBPT POINT TO CORRECT PUB ENTRY @V305001 00758000
LTR R3,R3 SET CONDITION CODE @V305001 00759000
BR R10 RETURN TO CALLER @V305001 00760000
NOTASSGN SR R3,R3 ZERO REG 3 @V305001 00761000
LTR R3,R3 SET CONDITION CODE @V305001 00762000
BR R10 RETURN TO CALLER @V305001 00763000
DROP R1 @V305001 00764000
EJECT 00765000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00766000
* * 00767000
* ERROR MESSAGES * 00768000
* * 00769000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00770000
SPACE 2 00771000
NOCORE DMSERR TEXT='VIRTUAL STORAGE CAPACITY EXCEEDED',LET=S,NUM=109 00772000
LA R9,RC104 RETURN CODE @V305066 00773000
B DONE GET OUT @V305001 00774000
SPACE 1 00775000
NODISK LH R9,FCHCUU GET DISK ADDRESS @V305001 00776000
DMSERR TEXT='DISK (....) NOT ATTACHED',LET=S,NUM=113, @V305001*00777000
SUB=(HEX,(R9)) @V305001 00778000
LA R9,RC100 RETURN CODE @V305066 00779000
B DONE GET OUT @V305001 00780000
ERPART DMSERR TEXT='DOS PARTITION TOO SMALL TO ACCOMMODATE FETCH REQUX00781000
EST',LET=S,NUM=777 @VA04299 00782000
LA R9,RC104 RETURN CODE @VA04299 00783000
B DONE GET OUT @VA04299 00784000
EJECT 00785000
DSKERR LA R10,CSYSRES SUBSTITUTION FOR SYSRES @V305001 00786000
TM FCHSW,PCILA PRIVATE CORE IMAGE LIB ? @V305001 00787000
BZ DSKERR2 NO, BRANCH @V305001 00788000
LA R10,CSYSCLB SUBSTITUTION FOR SYSCLB @V305001 00789000
DSKERR2 LR R9,R15 ERROR CODE TO R9 @V305001 00790000
DMSERR TEXT='INPUT ERROR CODE ''..'' ON ''......''',LET=S, *00791000
NUM=411,SUB=(DEC,(R9),CHARA,(R10)),MF=(E,'SYS') @V305066 00792000
LA R9,RC100 RETURN CODE @V305066 00793000
B DONE GET OUT @V305001 00794000
EJECT 00795000
ERR104 LA R2,FCHDCB GET DCB ADDRESS @V305001 00796000
USING IHADCB,R2 @V305001 00797000
L R2,DCBDEBAD GET DEB ADDRESS @V305001 00798000
DROP R2 @V305001 00799000
SH R2,=AL2(IHADEB-FCBINIT) GET FCB ADDRESS @V305001 00800000
USING FCBSECT,R2 @V305001 00801000
LA R2,FCBDSNAM POINT TO FILEID @V305001 00802000
DROP R2 @V305001 00803000
LH R3,FCHDECB+2 GET RETURN CODE FROM ECB @V305001 00804000
DMSERR TEXT='ERROR ''..'' READING FILE ''.................... *00805000
'' FROM DISK',NUM=104,LET=S,SUB=(DEC,(R3),CHAR8A,(R2)), *00806000
MF=(E,'SYS') @V305001 00807000
LA R9,RC100 RETURN CODE @V305066 00808000
B DONE GET OUT @V305001 00809000
ERR115E EQU * @V305101 00810000
DMSERR TEXT='PHASE LOAD POINT LESS THAN .....', @V305101*00811000
SUB=(HEXA,AUSRAREA),NUM=115,LET=E @V305101 00812000
LA R9,RC40 RETURN CODE @V305066 00813000
B DONE GET OUT @V305101 00814000
EJECT 00815000
SYSLIB DCB DDNAME=DOSLIB,DSORG=PO,RECFM=U,BLKSIZE=1024,MACRF=R 00816000
EJECT 00817000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00818000
* * 00819000
* CONSTANTS, EXECUTED INSTRUCTIONS AND CHANNEL PROGRAMS * 00820000
* * 00821000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00822000
SPACE 2 00823000
DIRBLOCK DC F'34' LENGTH DIRECTORY BLOCK @V305001 00824000
TXTBLOCK DC F'1024' LENGTH FULL TEXT BLOCK @V305001 00825000
MASKCON DC X'0103070F' RELOCATION MASK @V305001 00826000
TC2314 DC H'20' TRACKS/CYL 2314 @V305001 00827000
TC3330 DC H'19' TRACKS/CYL 3330 @V305001 00828000
TC3340 DC H'12' TRACKS/CYL 3340 @V305001 00829000
TC3350 DC H'30' TRACKS / CYL ON 3350 @VA08343 00829500
SCILCHR DC X'0000000201' SYSTEM C.I.L. POINTER @V305001 00830000
FENCE DC 4X'FF' FENCE CODE @V305066 00831000
IJSYSCL DC CL8'IJSYSCL' SYSCLB DDNAME @V305001 00832000
CSYSRES DC CL6'SYSRES' LITERAL @V305001 00833000
CSYSCLB DC CL6'SYSCLB' LITERAL @V305001 00834000
DOSLIB DC CL8'DOSLIB' DOSLIB LITERAL @VA04915 00835000
SPACE 1 00836000
IADCON ICM R7,0,0(R2) GET ADCON VALUE @V305001 00837000
SADCON STCM R7,0,0(R2) SAVE RELOCATED ADCON VALUE @V305001 00838000
MOVEDIR MVC DIRNAME(*-*),0(R2) MOVE DIRECTORY TO DSECT @V305001 00839000
SPACE 1 00840000
TXTCCW CCW SEEK,0,CC,6 @V305001 00841000
CCW SEARCH,0,CC,5 @V305001 00842000
CCW TIC,0,0,1 @V305001 00843000
CCW READDATA,0,CC,1024 @V305001 00844000
CCW READCNT,0,0,8 @V305001 00845000
SPACE 1 00846000
HDRCCW CCW SEEK,0,CC,6 @V305001 00847000
CCW SEARCH,0,CC,5 @V305001 00848000
CCW TIC,0,0,1 @V305001 00849000
CCW SRCHKE,0,CC+SLI,8 @V305001 00850000
CCW TIC,0,0,1 @V305001 00851000
CCW READDATA,0,0,256 @V305001 00852000
SPACE 1 00853000
TXTLEN EQU *-TXTCCW LENGTH OF ABOVE CCWS @V305066 00854000
EJECT 00855000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00856000
* * 00857000
* WORK AREA DSECT (ACQUIRED FROM FREE STORAGE) * 00858000
* * 00859000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00860000
SPACE 2 00861000
FCHSECT DSECT FETCH WORK AREA @V305001 00862000
FCHREG1 DS 3F DMSDOS REGISTER SAVE @V305001 00863000
FCHREG2 DS 6F DITTO @V305001 00864000
DIRNAME DS CL8 PHASE NAME @V305001 00865000
DIRTTR DS XL3 PHASE TTR @V305001 00866000
DIRN DS XL1 NO. HALF WORDS IN DIRECTRY @V305001 00867000
DIRTT DS XL2 NO. TEXT BLOCKS IN PHASE @V305001 00868000
DIRLL DS XL2 LENGTH LAST TEXT BLOCK @V305001 00869000
DIRC DS XL1 FLAG BYTE @V305001 00870000
DIRT DS XL1 RESERVED @V305001 00871000
DIRPPP DS XL3 PHASE LOAD POINT @V305001 00872000
DIREEE DS XL3 PHASE ENTRY POINT @V305001 00873000
DIRRR DS XL2 NUMBER RLD ITEMS IN PHASE @V305001 00874000
DIRR DS XL1 NO. ADDITIONAL RLD BLOCKS @V305001 00875000
DIRAAA DS XL3 PARTITION START ADDRESS @V305001 00876000
DIRK DS XL1 UNUSED @V305001 00877000
DIRVEE DS XL3 PHASE ENTRY POINT IN SVA @V305001 00878000
DIRLEN EQU *-DIRNAME LENGTH OF DIRECTORY @V305066 00879000
PHASELN DS F PHASE LENGTH @V305001 00880000
PHASELD DS F PHASE LOAD POINT IN CMS @V305001 00881000
PHASEEP DS F PHASE ENTRY POINT IN CMS @V305001 00882000
SENSDATA DS H SENSE DATA FROM DIAGNOSE @V305001 00883000
SENSBYTE DS H COMPOUNDED SENSE INFORMATION @V305001 00884000
USERLD DS F USER SPECIFIED LOAD ADDR @V305001 00885000
USERDE DS F DIRECTORY ADDRESS FOR DMSDOS @V305001 00886000
LASTLOAD DS F END ADDRESS OF PHASE @V305001 00887000
RELFACT DS F RELOCATION FACTOR SAVE @V305001 00888000
RLDPTR DS F RLD POINTER SAVE @V305001 00889000
FCHSW DS X FETCH FLAG BYTE @V305001 00890000
FCHTYP DS X DASD DEVICE TYPE @V305001 00891000
FCHCUU DS H VIRTUAL DEVICE ADDR FOR DIAGNOSE @V305001 00892000
FCHBB DS H BB OF BBCCHHR @V305001 00893000
FCHCHR DS 2H CCHH TO SEEK/SEARCH @V305001 00894000
FCHR DS 2H RECORD NUMBER @V305001 00895000
FCHORG DS F ORIGIN CCHH OF LIBRARY @V305001 00896000
FCHCCWA DS F ADDRESS CURRENT CHANNEL PGM @V305001 00897000
FCHTXT DS 5D CCW'S TO READ TEXT BLOCKS @V305001 00898000
FCHHDR DS 6D CCW'S TO READ DIRECTORY @V305001 00899000
FCHDCB DS XL100 DOSLIB DCB @V305066 00900000
FCHDECB DS 20X DOSLIB DECB @V305001 00901000
FCHSAVE DS 18F O/S SAVE AREA @V305001 00902000
FCHBUFE DS F END OF WORK BUFFER @V305001 00903000
FCHBUF DS 1024X FETCH WORK BUFFER @V305001 00904000
FCHEND DS 0D @V305001 00905000
FCHLEN EQU (FCHEND-FCHSECT)/8 @V305001 00906000
PHNAME EQU (DIRNAME-FCHSECT) @V305001 00907000
ORG FCHBUF STATE DOSLIB PLIST @VA04915 00908000
STDOSLST DS D @VA04915 00909000
STDOSNM DS D @VA04915 00910000
STDOSFT DS D @VA04915 00911000
STDOSEND DS D @VA04915 00912000
EJECT 00913000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00914000
* * 00915000
* IMPORTANT EQUATES * 00916000
* * 00917000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00918000
SPACE 2 00919000
* EQUATES FOR DIRC FLAG 00920000
SELFREL EQU X'80' PHASE SELF RELOCATABLE @V305001 00921000
RELPHSE EQU X'40' PHASE TO BE RELOCATED @V305001 00922000
SVAELIG EQU X'20' PHASE SVA ELIGIBLE @V305001 00923000
SVAPHSE EQU X'10' PHASE IN SVA @V305001 00924000
PCLPHSE EQU X'08' PHASE IN PRIV C.I.L. @V305001 00925000
PNOTFND EQU X'04' PHASE NOT FOUND @V305001 00926000
DACTIVE EQU X'02' PHASE DIRECTORY ACTIVE @V305001 00927000
NOTEXT EQU X'01' TEXT = NO SPECIFIED @V305001 00928000
SPACE 1 00929000
* EQUATES FOR FCHSW FLAG 00930000
DOSREAD EQU X'80' READING FROM LIVE DOS DISK @V305001 00931000
PCILA EQU X'40' SEARCHING IN PRIV. C.I.L. @V305001 00932000
CCWREL EQU X'20' CCW 'S ARE RELOCATED @V305001 00933000
* EQU X'01' RESERVED FOR TEXT = NO 00934000
* EQU X'02' RESERVED FOR DIRECTORY ACTIVE 00935000
* EQU X'04' RESERVED FOR PHASE NOT FOUND 00936000
* EQU X'08' DO NOT USE 00937000
SPACE 1 00938000
* EQUATES FOR CHANNEL PROGRAMS 00939000
SEEK EQU X'07' SEEK COMMAND CODE @V305001 00940000
SEARCH EQU X'31' SEARCH ID COMMAND CODE @V305001 00941000
TIC EQU X'08' TIC COMMAND CODE @V305001 00942000
READDATA EQU X'06' READ DATA COMMAND CODE @V305001 00943000
READCNT EQU X'92' READ COUNT COMMAND CODE @V305001 00944000
SRCHKE EQU X'E9' SEARCH KEY EQUAL COMMAND CODE @V305001 00945000
CC EQU X'40' COMMAND CHAIN FLAG @V305001 00946000
SLI EQU X'20' SILI CCW FLAG @V305001 00947000
SPACE 1 00948000
* EQUATES FOR LOGICAL UNITS AND DEVICES 00949000
SYSRES EQU X'0C' SYSRES LUB INDEX * 2 @V305001 00950000
SYSCLB EQU X'16' SYSCLB LUB INDEX * 2 @V305001 00951000
T2314 EQU X'62' 2314 DEVICE TYPE @V305001 00952000
T3330 EQU X'63' 3330 DEVICE TYPE @V305001 00953000
MOD11 EQU X'65' 3330-11 DEVICE TYPE @VA08343 00953100
T3350 EQU X'67' 3350 DEVICE TYPE @VA08343 00953200
T3340 EQU X'68' 3340 DEVICE TYPE @V305001 00954000
EJECT 00955000
* EQUATES FOR SENSE INFORMATION 00956000
CMDREJ EQU X'80' COMMAND REJECT @V305066 00957000
INTREQ EQU X'40' INTERVENTION REQ. @V305066 00958000
BUSOUT EQU X'20' BUS. OUT @V305066 00959000
EQCHK EQU X'10' EQUIPMENT CHECK @V305066 00960000
DATACHK EQU X'08' DATA CHECK @V305066 00961000
OVERUN EQU X'04' OVER RUN @V305066 00962000
TRKCHK EQU X'20' TRACK CONDITION CHECK @V305066 00963000
SEEKCHK EQU X'01' SEEK CHECK @V305066 00964000
NOT1 EQU CMDREJ+INTREQ+BUSOUT+EQCHK+DATACHK+OVERUN+SEEKCHK 00965000
* 00966000
CNTCHK EQU X'80' DATA CHECK IN COUNT @V305066 00967000
TRKOVFLW EQU X'40' TRACK OVERFLOE @V305066 00968000
EOC EQU X'20' END OF CYLINDER @V305066 00969000
INVSEQ EQU X'10' INVALID SEQUENCE @V305066 00970000
NOREC EQU X'08' NO RECORD FOUND @V305066 00971000
FILEPROT EQU X'04' FILE PROTECTED @V305066 00972000
SOVERUN EQU X'02' SERVICE OVER RUN @V305066 00973000
OVFLW EQU X'01' OVERFLOW @V305066 00974000
NOT2 EQU CNTCHK+TRKOVFLW+INVSEQ+SOVERUN @V305066 00975000
SPACE 1 00976000
* OTHER EQUATES 00977000
ZERO EQU X'00' CONSTANT @V305066 00978000
ONE EQU X'01' CONSTANT @V305066 00979000
EIGHT EQU X'08' CONSTANT @V305066 00980000
TEN EQU X'0A' CONSTANT @V305066 00981000
TWELVE EQU X'0C' CONSTANT @V305066 00982000
FIFTEEN EQU X'0F' CONSTANT @V305066 00983000
M7 EQU B'0111' ICM/STCM MASK @V305066 00984000
M15 EQU B'1111' ICM/STCM MASK @V305066 00985000
RENT EQU X'80' RENT OPTION BIT @V305066 00986000
OPNOK EQU X'10' DCBOFLGS OPEN BIT @V305066 00987000
TRANSLN EQU 1400 SIZE OF THE DOS LTA @VA08226 00988100
NOASSGN EQU X'FE' LUB VALUE FOR NOT ASSIGNED @V305066 00989000
SPACE 1 00990000
* EQUATES FOR RETURN CODES 00991000
RC28 EQU 28 RETURN CODE @VA04898 00992000
RC40 EQU 40 RETURN CODE @V305066 00993000
RC100 EQU 100 RETURN CODE @V305066 00994000
RC104 EQU 104 RETURN CODE @V305066 00995000
EJECT 00996000
NUCON @V305001 00997000
DCBD DSORG=PS @V305001 00998000
EJECT 00999000
CMSCB @V305001 01000000
OSFST @V305001 01001000
BGCOM @V305001 01002000
ANCHTAB @VA04299 01003000
REGEQU @V305001 01004000
DMSFCH CSECT @V305001 01005000
LTORG @V305001 01006000
END 01007000