DLK TITLE 'DMSDLK (CMS) VM/370 - RELEASE 6' 00001000
* "FSSTATE/FSREAD/FSWRITE/FSCLOSE/FSERASE" MACROS WITH BALR CALLS: 00002000
SPACE 00003000
MACRO 00004000
&LABEL FSSTATE &FILEID,&FSCB=,&ERROR= 00005000
GBLC &DMSNAME,&DMSTYPE,&DMSMODE 00006000
AIF (T'&FILEID EQ 'O' AND T'&FSCB EQ 'O').ERR1 00007000
AIF (T'&FILEID EQ 'O').NOID 00008000
AIF ('&FILEID'(1,1) NE '''' AND '&FILEID'(1,1) NE '(').ERR2 00009000
AIF ('&FILEID'(1,1) EQ '(' AND '&FILEID(1)' EQ '1').ERR3 00010000
AIF ('&FILEID'(1,1) EQ '(' AND '&FILEID(1)' EQ '0').ERR4 00011000
&DMSNAME SETC ' ' 00012000
&DMSTYPE SETC ' ' 00013000
&DMSMODE SETC ' ' 00014000
AIF ('&FILEID'(1,1) EQ '(').SKIP1 00015000
&DMSMODE SETC 'A1' 00016000
DMSPID &FILEID 00017000
AIF ('&DMSNAME' EQ ' ' OR '&DMSTYPE' EQ ' ').ERR2 00018000
.SKIP1 AIF (T'&FSCB EQ 'O').NOCB 00019000
.NOID AIF (T'&LABEL EQ 'O').NLBL 00020000
&LABEL DS 0H 00021000
.NLBL ANOP 00022000
AIF ('&FSCB'(1,1) EQ '(').REG1 00023000
LA 1,&FSCB 00024000
AGO .CONT1 00025000
.REG1 AIF ('&FSCB(1)' EQ '1').CONT1 00026000
LR 1,&FSCB(1) 00027000
.CONT1 ANOP 00028000
AIF (T'&FILEID EQ 'O').CONT2 00029000
AIF ('&FILEID'(1,1) EQ '(').REG2 00030000
MVC 8(8,1),=CL8'&DMSNAME' 00031000
MVC 16(8,1),=CL8'&DMSTYPE' 00032000
MVC 24(2,1),=CL2'&DMSMODE' 00033000
AGO .CONT2 00034000
.REG2 ANOP 00035000
MVC 8(18,1),0(&FILEID(1)) 00036000
.CONT2 ANOP 00037000
MVC 40(4,1),28(1) 00038000
ST 14,0(,1) PRESERVE R14 (IN P-LIST) 00039000
L 15,ASTATE CALL 'STATE' VIA BALR 00040000
BALR 14,15 ... 00041000
L 14,0(,1) RECOVER R14 00042000
AIF (T'&ERROR EQ 'O').NOER 00043000
BNZ &ERROR 00044000
AGO .CONT3 00045000
.NOER ANOP 00046000
BNZ DMS&SYSNDX.B 00047000
.CONT3 ANOP 00048000
L 15,28(,1) 00049000
MVC 28(4,1),40(1) 00050000
LR 1,15 00051000
SR 15,15 00052000
AIF (T'&ERROR NE 'O').EXIT 00053000
DMS&SYSNDX.B EQU * 00054000
.EXIT MEXIT 00055000
.NOCB ANOP 00056000
CNOP 0,4 00057000
&LABEL BAL 1,DMS&SYSNDX.A 00058000
DC CL8'STATE' 00059000
DC CL8'&DMSNAME' 00060000
DC CL8'&DMSTYPE' 00061000
DC CL2'&DMSMODE' 00062000
DC CL2' ' 00063000
DC AL4(0) 00064000
DMS&SYSNDX.A EQU * 00065000
AIF ('&FILEID'(1,1) NE '(').SKIP2 00066000
MVC 8(18,1),0(&FILEID(1)) 00067000
.SKIP2 ANOP 00068000
ST 14,0(,1) PRESERVE R14 (IN P-LIST) 00069000
L 15,ASTATE CALL 'STATE' VIA BALR 00070000
BALR 14,15 ... 00071000
L 14,0(,1) RECOVER R14 00072000
AIF (T'&ERROR EQ 'O').NERR 00073000
BNZ &ERROR 00074000
AGO .SKIP3 00075000
.NERR ANOP 00076000
BNZ *+8 00077000
.SKIP3 ANOP 00078000
L 1,28(,1) 00079000
MEXIT 00080000
.ERR1 MNOTE 8,'NEITHER FILEID OF FSCB SPECIFIED' 00081000
MEXIT 00082000
.ERR2 MNOTE 8,'INVALID FILEID SPECIFICATION' 00083000
MEXIT 00084000
.ERR3 MNOTE 8,'REGISTER 1 INVALID FOR FILEID' 00085000
MEXIT 00086000
.ERR4 MNOTE 8,'INVALID USE OF REGISTER 0' 00087000
MEND 00088000
SPACE 00089000
MACRO 00090000
&LABEL FSREAD &FILEID,&FSCB=,&RECFM=,&BUFFER=,&BSIZE=,&RECNO=,&NOREC=X00091000
,&ERROR= 00092000
GBLC &DMSNAME,&DMSTYPE,&DMSMODE 00093000
AIF (T'&FILEID EQ 'O' AND T'&FSCB EQ 'O').ERR1 00094000
AIF (T'&FILEID EQ 'O').NOID 00095000
AIF ('&FILEID'(1,1) NE '''' AND '&FILEID'(1,1) NE '(').ERR2 00096000
AIF ('&FILEID'(1,1) EQ '(' AND '&FILEID(1)' EQ '0').ERR3 00097000
AIF ('&FILEID'(1,1) EQ '(' AND '&FILEID(1)' EQ '1').ERR3 00098000
&DMSNAME SETC ' ' 00099000
&DMSTYPE SETC ' ' 00100000
&DMSMODE SETC ' ' 00101000
AIF ('&FILEID'(1,1) EQ '(').CONT1 00102000
&DMSMODE SETC 'A1' 00103000
DMSPID &FILEID 00104000
AIF ('&DMSNAME' EQ ' ' OR '&DMSTYPE' EQ ' ').ERR2 00105000
.CONT1 AIF (T'&FSCB EQ 'O').NOCB 00106000
.NOID AIF (T'&LABEL EQ 'O').NLBL 00107000
&LABEL DS 0H 00108000
.NLBL ANOP 00109000
AIF ('&FSCB'(1,1) EQ '(').REG1 00110000
LA 1,&FSCB 00111000
AGO .CONT2 00112000
.REG1 AIF ('&FSCB(1)' EQ '1').CONT2 00113000
LR 1,&FSCB(1) 00114000
.CONT2 AIF (T'&FILEID EQ 'O').CONT3 00115000
AIF ('&FILEID'(1,1) EQ '(').REG2 00116000
MVC 8(8,1),=CL8'&DMSNAME' 00117000
MVC 16(8,1),=CL8'&DMSTYPE' 00118000
MVC 24(2,1),=CL2'&DMSMODE' 00119000
AGO .CONT3 00120000
.REG2 ANOP 00121000
MVC 8(18,1),0(&FILEID(1)) 00122000
.CONT3 AIF (T'&RECNO EQ 'O').SKIP1 00123000
AIF ('&RECNO'(1,1) EQ '(').STOR1 00124000
MVC 26(2,1),=H'&RECNO' 00125000
AGO .SKIP1 00126000
.STOR1 ANOP 00127000
AIF ('&RECNO(1)' EQ '1').ERR4 00128000
STH &RECNO(1),26(,1) 00129000
.SKIP1 AIF (T'&BUFFER EQ 'O').SKIP2 00130000
AIF ('&BUFFER'(1,1) EQ '(').STOR2 00131000
MVC 28(4,1),=A(&BUFFER) 00132000
AGO .SKIP2 00133000
.STOR2 ANOP 00134000
AIF ('&BUFFER(1)' EQ '1').ERR5 00135000
ST &BUFFER(1),28(,1) 00136000
.SKIP2 AIF (T'&BSIZE EQ 'O').SKIP3 00137000
AIF ('&BSIZE'(1,1) EQ '(').STOR3 00138000
MVC 32(4,1),=F'&BSIZE' 00139000
AGO .SKIP3 00140000
.STOR3 ANOP 00141000
AIF ('&BSIZE(1)' EQ '1').ERR6 00142000
ST &BSIZE(1),32(,1) 00143000
.SKIP3 AIF (T'&RECFM EQ 'O').SKIP4 00144000
AIF ('&RECFM'(1,1) EQ '(').STOR4 00145000
AIF ('&RECFM' NE 'F' AND '&RECFM' NE 'V').ERR11 00146000
MVC 36(2,1),=CL2'&RECFM' 00147000
AGO .SKIP4 00148000
.STOR4 ANOP 00149000
AIF ('&RECFM(1)' EQ '1').ERR7 00150000
STC &RECFM(1),36(,1) 00151000
.SKIP4 AIF (T'&NOREC EQ 'O').SKIP5 00152000
AIF ('&NOREC'(1,1) EQ '(').STOR5 00153000
MVC 38(2,1),=H'&NOREC' 00154000
AGO .SKIP5 00155000
.STOR5 ANOP 00156000
AIF ('&NOREC(1)' EQ '1').ERR8 00157000
STH &NOREC(1),38(,1) 00158000
.SKIP5 ANOP 00159000
ST 14,0(,1) PRESERVE R14 (IN P-LIST) 00160000
L 15,ARDBUF CALL 'RDBUF' VIA BALR 00161000
BALR 14,15 ... 00162000
L 14,0(,1) RECOVER R14 00163000
AIF (T'&ERROR EQ 'O').NOER 00164000
BNZ &ERROR BRANCH IF ERROR OCCURRED 00165000
.NOER ANOP 00166000
L 0,40(,1) 00167000
MEXIT 00168000
.NOCB ANOP 00169000
AIF (T'&BUFFER EQ 'O').ERR9 00170000
AIF (T'&BSIZE EQ 'O').ERR10 00171000
CNOP 0,4 00172000
&LABEL BAL 1,DMS&SYSNDX.A 00173000
FSCB &FILEID 00174000
DMS&SYSNDX.A EQU * 00175000
AIF ('&FILEID'(1,1) EQ '(').REG2 00176000
AGO .CONT3 00177000
.ERR1 MNOTE 8,'NEITHER FILEID OR FSCB SPECIFIED' 00178000
MEXIT 00179000
.ERR2 MNOTE 8,'INVALID FILEID SPECIFICATION' 00180000
MEXIT 00181000
.ERR3 MNOTE 8,'REGISTERS 0 AND 1 INVALID FOR FILEID' 00182000
MEXIT 00183000
.ERR4 MNOTE 8,'REGISTER 1 INVALID FOR RECNO' 00184000
MEXIT 00185000
.ERR5 MNOTE 8,'REGISTER 1 INVALID FOR BUFFER' 00186000
MEXIT 00187000
.ERR6 MNOTE 8,'REGISTER 1 INVALID FOR BSIZE' 00188000
MEXIT 00189000
.ERR7 MNOTE 8,'REGISTER 1 INVALID FOR RECFM' 00190000
MEXIT 00191000
.ERR8 MNOTE 8,'REGISTER 1 INVALID FOR NOREC' 00192000
MEXIT 00193000
.ERR9 MNOTE 8,'BUFFER ADDRESS NOT SPECIFIED' 00194000
MEXIT 00195000
.ERR10 MNOTE 8,'BUFFER SIZE NOT SPECIFIED' 00196000
MEXIT 00197000
.ERR11 MNOTE 8,'INVALID RECFM SPECIFICATION' 00198000
MEND 00199000
SPACE 00200000
MACRO 00201000
&LABEL FSWRITE &FILEID,&FSCB=,&RECFM=,&BUFFER=,&BSIZE=,&RECNO=,&NORECX00202000
=,&ERROR= 00203000
GBLC &DMSNAME,&DMSTYPE,&DMSMODE 00204000
AIF (T'&FILEID EQ 'O' AND T'&FSCB EQ 'O').ERR1 00205000
AIF (T'&FILEID EQ 'O').NOID 00206000
AIF ('&FILEID'(1,1) NE '''' AND '&FILEID'(1,1) NE '(').ERR2 00207000
AIF ('&FILEID'(1,1) EQ '(' AND '&FILEID(1)' EQ '0').ERR3 00208000
AIF ('&FILEID'(1,1) EQ '(' AND '&FILEID(1)' EQ '1').ERR3 00209000
&DMSNAME SETC ' ' 00210000
&DMSTYPE SETC ' ' 00211000
&DMSMODE SETC ' ' 00212000
AIF ('&FILEID'(1,1) EQ '(').CONT1 00213000
&DMSMODE SETC 'A1' 00214000
DMSPID &FILEID 00215000
AIF ('&DMSNAME' EQ ' ' OR '&DMSTYPE' EQ ' ').ERR2 00216000
.CONT1 AIF (T'&FSCB EQ 'O').NOCB 00217000
.NOID AIF (T'&LABEL EQ 'O').NLBL 00218000
&LABEL DS 0H 00219000
.NLBL ANOP 00220000
AIF ('&FSCB'(1,1) EQ '(').REG1 00221000
LA 1,&FSCB 00222000
AGO .CONT2 00223000
.REG1 AIF ('&FSCB(1)' EQ '1').CONT2 00224000
LR 1,&FSCB(1) 00225000
.CONT2 AIF (T'&FILEID EQ 'O').CONT3 00226000
AIF ('&FILEID'(1,1) EQ '(').REG2 00227000
MVC 8(8,1),=CL8'&DMSNAME' 00228000
MVC 16(8,1),=CL8'&DMSTYPE' 00229000
MVC 24(2,1),=CL2'&DMSMODE' 00230000
AGO .CONT3 00231000
.REG2 ANOP 00232000
MVC 8(18,1),0(&FILEID(1)) 00233000
.CONT3 AIF (T'&RECNO EQ 'O').SKIP1 00234000
AIF ('&RECNO'(1,1) EQ '(').STOR1 00235000
MVC 26(2,1),=H'&RECNO' 00236000
AGO .SKIP1 00237000
.STOR1 ANOP 00238000
AIF ('&RECNO(1)' EQ '1').ERR4 00239000
STH &RECNO(1),26(,1) 00240000
.SKIP1 AIF (T'&BUFFER EQ 'O').SKIP2 00241000
AIF ('&BUFFER'(1,1) EQ '(').STOR2 00242000
MVC 28(4,1),=A(&BUFFER) 00243000
AGO .SKIP2 00244000
.STOR2 ANOP 00245000
AIF ('&BUFFER(1)' EQ '1').ERR5 00246000
ST &BUFFER(1),28(,1) 00247000
.SKIP2 AIF (T'&BSIZE EQ 'O').SKIP3 00248000
AIF ('&BSIZE'(1,1) EQ '(').STOR3 00249000
MVC 32(4,1),=F'&BSIZE' 00250000
AGO .SKIP3 00251000
.STOR3 ANOP 00252000
AIF ('&BSIZE(1)' EQ '1').ERR6 00253000
ST &BSIZE(1),32(,1) 00254000
.SKIP3 AIF (T'&RECFM EQ 'O').SKIP4 00255000
AIF ('&RECFM'(1,1) EQ '(').STOR4 00256000
AIF ('&RECFM' NE 'F' AND '&RECFM' NE 'V').ERR11 00257000
MVC 36(2,1),=CL2'&RECFM' 00258000
AGO .SKIP4 00259000
.STOR4 ANOP 00260000
AIF ('&RECFM(1)' EQ '1').ERR7 00261000
STC &RECFM(1),36(,1) 00262000
.SKIP4 AIF (T'&NOREC EQ 'O').SKIP5 00263000
AIF ('&NOREC'(1,1) EQ '(').STOR5 00264000
MVC 38(2,1),=H'&NOREC' 00265000
AGO .SKIP5 00266000
.STOR5 ANOP 00267000
AIF ('&NOREC(1)' EQ '1').ERR8 00268000
STH &NOREC(1),38(,1) 00269000
.SKIP5 ANOP 00270000
ST 14,0(,1) PRESERVE R14 (IN P-LIST) 00271000
L 15,AWRBUF CALL 'WRBUF' VIA BALR 00272000
BALR 14,15 ... 00273000
L 14,0(,1) RECOVER R14 00274000
AIF (T'&ERROR EQ 'O').NOER 00275000
BNZ &ERROR BRANCH IF ERROR OCCURRED 00276000
.NOER ANOP 00277000
MEXIT 00278000
.NOCB ANOP 00279000
AIF (T'&BUFFER EQ 'O').ERR9 00280000
AIF (T'&BSIZE EQ 'O').ERR10 00281000
CNOP 0,4 00282000
&LABEL BAL 1,DMS&SYSNDX.A 00283000
SPACE 00284000
FSCB &FILEID 00285000
DMS&SYSNDX.A EQU * 00286000
AIF ('&FILEID'(1,1) EQ '(').REG2 00287000
AGO .CONT3 00288000
.ERR1 MNOTE 8,'NEITHER FILEID OR FSCB SPECIFIED' 00289000
MEXIT 00290000
.ERR2 MNOTE 8,'INVALID FILEID SPECIFICATION' 00291000
MEXIT 00292000
.ERR3 MNOTE 8,'REGISTERS 0 AND 1 INVALID FOR FILEID' 00293000
MEXIT 00294000
.ERR4 MNOTE 8,'REGISTER 1 INVALID FOR RECNO' 00295000
MEXIT 00296000
.ERR5 MNOTE 8,'REGISTER 1 INVALID FOR BUFFER' 00297000
MEXIT 00298000
.ERR6 MNOTE 8,'REGISTER 1 INVALID FOR BSIZE' 00299000
MEXIT 00300000
.ERR7 MNOTE 8,'REGISTER 1 INVALID FOR RECFM' 00301000
MEXIT 00302000
.ERR8 MNOTE 8,'REGISTER 1 INVALID FOR NOREC' 00303000
MEXIT 00304000
.ERR9 MNOTE 8,'BUFFER ADDRESS NOT SPECIFIED' 00305000
MEXIT 00306000
.ERR10 MNOTE 8,'BUFFER SIZE NOT SPECIFIED' 00307000
MEXIT 00308000
.ERR11 MNOTE 8,'INVALID RECFM SPECIFICATION' 00309000
MEND 00310000
SPACE 00311000
MACRO 00312000
&LABEL FSCLOSE &FILEID,&FSCB=,&ERROR= 00313000
GBLC &DMSNAME,&DMSTYPE,&DMSMODE 00314000
AIF (T'&FILEID EQ 'O' AND T'&FSCB EQ 'O').ERR1 00315000
AIF (T'&FILEID EQ 'O').NOID 00316000
AIF ('&FILEID'(1,1) NE '''' AND '&FILEID'(1,1) NE '(').ERR2 00317000
AIF ('&FILEID'(1,1) EQ '(' AND '&FILEID(1)' EQ '0').ERR3 00318000
AIF ('&FILEID'(1,1) EQ '(' AND '&FILEID(1)' EQ '1').ERR3 00319000
&DMSNAME SETC ' ' 00320000
&DMSTYPE SETC ' ' 00321000
&DMSMODE SETC ' ' 00322000
AIF ('&FILEID'(1,1) EQ '(').SKIP1 00323000
&DMSMODE SETC 'A1' 00324000
DMSPID &FILEID 00325000
AIF ('&DMSNAME' EQ ' ' OR '&DMSTYPE' EQ ' ').ERR2 00326000
.SKIP1 AIF (T'&FSCB EQ 'O').NOCB 00327000
.NOID AIF (T'&LABEL EQ 'O').NLBL 00328000
&LABEL DS 0H 00329000
.NLBL ANOP 00330000
AIF ('&FSCB'(1,1) EQ '(').REG1 00331000
LA 1,&FSCB 00332000
AGO .CONT1 00333000
.REG1 AIF ('&FSCB(1)' EQ '1').CONT1 00334000
LR 1,&FSCB(1) 00335000
.CONT1 ANOP 00336000
AIF (T'&FILEID EQ 'O').CONT2 00337000
AIF ('&FILEID'(1,1) EQ '(').REG2 00338000
MVC 8(8,1),=CL8'&DMSNAME' 00339000
MVC 16(8,1),=CL8'&DMSTYPE' 00340000
MVC 24(2,1),=CL2'&DMSMODE' 00341000
AGO .CONT2 00342000
.REG2 ANOP 00343000
MVC 8(18,1),0(&FILEID(1)) 00344000
.CONT2 ANOP 00345000
ST 14,0(,1) PRESERVE R14 (IN P-LIST) 00346000
L 15,AFINIS CALL 'FINIS' VIA BALR 00347000
BALR 14,15 ... 00348000
L 14,0(,1) RECOVER R14 00349000
AIF (T'&ERROR EQ 'O').NOER1 00350000
BNZ &ERROR BRANCH IF ERROR OCCURRED 00351000
.NOER1 ANOP 00352000
MEXIT 00353000
.NOCB ANOP 00354000
CNOP 0,4 00355000
&LABEL BAL 1,DMS&SYSNDX.A 00356000
DC CL8'FINIS' 00357000
DC CL8'&DMSNAME' 00358000
DC CL8'&DMSTYPE' 00359000
DC CL2'&DMSMODE' 00360000
DMS&SYSNDX.A EQU * 00361000
AIF ('&FILEID'(1,1) NE '(').SKIP2 00362000
MVC 8(18,1),0(&FILEID(1)) 00363000
.SKIP2 ANOP 00364000
ST 14,0(,1) PRESERVE R14 (IN P-LIST) 00365000
L 15,AFINIS CALL 'FINIS' VIA BALR 00366000
BALR 14,15 ... 00367000
L 14,0(,1) RECOVER R14 00368000
AIF (T'&ERROR EQ 'O').NOER2 00369000
BNZ &ERROR BRANCH IF ERROR OCCURRED 00370000
.NOER2 ANOP 00371000
MEXIT 00372000
.ERR1 MNOTE 8,'NEITHER FILEID OR FSCB SPECIFIED' 00373000
MEXIT 00374000
.ERR2 MNOTE 8,'INVALID FILEID SPECIFICATION' 00375000
MEXIT 00376000
.ERR3 MNOTE 8,'REGISTERS 0 AND 1 INVALID FOR FILEID' 00377000
MEND 00378000
SPACE 00379000
MACRO 00380000
&LABEL FSERASE &FILEID,&FSCB=,&ERROR= 00381000
GBLC &DMSNAME,&DMSTYPE,&DMSMODE 00382000
AIF (T'&FILEID EQ 'O' AND T'&FSCB EQ 'O').ERR1 00383000
AIF (T'&FILEID EQ 'O').NOID 00384000
AIF ('&FILEID'(1,1) NE '''' AND '&FILEID'(1,1) NE '(').ERR2 00385000
AIF ('&FILEID'(1,1) EQ '(' AND '&FILEID(1)' EQ '0').ERR3 00386000
AIF ('&FILEID'(1,1) EQ '(' AND '&FILEID(1)' EQ '1').ERR3 00387000
&DMSNAME SETC ' ' 00388000
&DMSTYPE SETC ' ' 00389000
&DMSMODE SETC ' ' 00390000
AIF ('&FILEID'(1,1) EQ '(').SKIP1 00391000
&DMSMODE SETC 'A1' 00392000
DMSPID &FILEID 00393000
AIF ('&DMSNAME' EQ ' ' OR '&DMSTYPE' EQ ' ').ERR2 00394000
.SKIP1 AIF (T'&FSCB EQ 'O').NOCB 00395000
.NOID AIF (T'&LABEL EQ 'O').NLBL 00396000
&LABEL DS 0H 00397000
.NLBL ANOP 00398000
AIF ('&FSCB'(1,1) EQ '(').REG1 00399000
LA 1,&FSCB 00400000
AGO .CONT1 00401000
.REG1 AIF ('&FSCB(1)' EQ '1').CONT1 00402000
LR 1,&FSCB(1) 00403000
.CONT1 ANOP 00404000
AIF (T'&FILEID EQ 'O').CONT2 00405000
AIF ('&FILEID'(1,1) EQ '(').REG2 00406000
MVC 8(8,1),=CL8'&DMSNAME' 00407000
MVC 16(8,1),=CL8'&DMSTYPE' 00408000
MVC 24(2,1),=CL2'&DMSMODE' 00409000
AGO .CONT2 00410000
.REG2 ANOP 00411000
MVC 8(18,1),0(&FILEID(1)) 00412000
.CONT2 ANOP 00413000
ST 14,0(,1) PRESERVE R14 (IN P-LIST) 00414000
L 15,AERASE CALL 'ERASE' VIA BALR 00415000
BALR 14,15 ... 00416000
L 14,0(,1) RECOVER R14 00417000
AIF (T'&ERROR EQ 'O').NOER1 00418000
BNZ &ERROR BRANCH IF ERROR OCCURRED 00419000
.NOER1 ANOP 00420000
MEXIT 00421000
.NOCB ANOP 00422000
CNOP 0,4 00423000
&LABEL BAL 1,DMS&SYSNDX.A 00424000
DC CL8'ERASE' 00425000
DC CL8'&DMSNAME' 00426000
DC CL8'&DMSTYPE' 00427000
DC CL2'&DMSMODE' 00428000
DC 8X'FF' 00429000
DMS&SYSNDX.A EQU * 00430000
AIF ('&FILEID'(1,1) NE '(').SKIP2 00431000
MVC 8(18,1),0(&FILEID(1)) 00432000
.SKIP2 ANOP 00433000
ST 14,0(,1) PRESERVE R14 (IN P-LIST) 00434000
L 15,AERASE CALL 'ERASE' VIA BALR 00435000
BALR 14,15 ... 00436000
L 14,0(,1) RECOVER R14 00437000
AIF (T'&ERROR EQ 'O').NOER2 00438000
BNZ &ERROR BRANCH IF ERROR OCCURRED 00439000
.NOER2 ANOP 00440000
MEXIT 00441000
.ERR1 MNOTE 8,'NEITHER FILEID OF FSCB SPECIFIED' 00442000
MEXIT 00443000
.ERR2 MNOTE 8,'INVALID FILEID SPECIFICATION' 00444000
MEXIT 00445000
.ERR3 MNOTE 8,'REGISTERS 0 AND 1 INVALID FOR FILEID' 00446000
MEND 00447000
EJECT 00448000
*. * 00449000
* 00450000
* 00451000
*MODULE NAME: 00452000
* 00453000
* DMSDLK (DOSLKED) 00454000
* 00455000
*FUNCTION - EDITS THE RELOCATABLE OUTPUT OF THE LANGUAGE 00456000
* TRANSLATORS INTO EXECUTABLE PROGRAMS. THE CORE IMAGE PHASES 00457000
* ARE ADDED TO THE END OF THE SPECIFIED DOSLIB. 00458000
* 00459000
*ATTRIBUTES: 00460000
* 00461000
* NON-REUSABLE NON-RESIDENT 00462000
* 00463000
*ENTRY POINT: 00464000
* 00465000
* DLKINL - VIA THE COMMANDS DOSLKED OR DOSL 00466000
* 00467000
*ENTRY CONDITIONS: 00468000
* 00469000
* R1 - PLIST 00470000
* 00471000
* PLIST: 00472000
* CL8'DOSLKED' OR 'DOSL' 00473000
* CL8'FILENAME' 00474000
* CL8'LIBNAME' OPTIONAL 00475000
* CL8'(' IF OPTIONS DESIRED 00476000
* CL8'TERM', 'DISK', OR 'PRINT' 00477000
* XL8'FF' 00478000
* 00479000
* FILENAME - FILENAME OF A CMS FILE WITH A 00480000
* FILETYPE OF DOSLNK CONTAINING LINKAGE EDITOR 00481000
* CONTROL STATEMENTS OR, IF NO FILE FOUND, THE 00482000
* FILENAME OF A CMS TEXT DECK OR A DOS OBJECT 00483000
* MODULE ON A PRIVATE OR SYSTEM RELOCATABLE 00484000
* LIBRARY. 00485000
* 00486000
* LIBNAME - THE FILENAME OF THE DOSLIB WHERE 00487000
* THE PHASE WILL BE PLACED AFTER LINKEDITING. 00488000
* FILETYPE WILL BE DOSLIB. THE DEFAULT FOR 00489000
* LIBNAME WILL BE FILENAME. IF THE DOSLIB 00490000
* ALREADY CONTAINS A SPECIFIED PHASE, THE 00491000
* PHASE WILL BE REPLACED. 00492000
* 00493000
* DISK - THE MAP WILL BE WRITTEN ON A CMS 00494000
* DISK WITH THE NAME OF FILENAME MAP A5 00495000
* (THIS IS THE DEFAULT). 00496000
* 00497000
* TERM - THE MAP WILL BE DISPLAYED ON THE USERS 00498000
* TERMINAL. 00499000
* 00500000
* PRINT - THE MAP WILL BE PRINTED ON THE SYSTEM 00501000
* OUTPUT DEVICE. 00502000
* 00503000
*EXIT CONDITIONS: 00504000
* 00505000
* NORMAL - RETURN TO CMS VIA R14, R15 = ZERO 00506000
* ERROR - RETURN TO CMS VIA R14, R15 = NON-ZERO 00507000
* 00508000
*CALLS TO OTHER ROUTINES: 00509000
* 00510000
* DMSERS, DMSFNS, DMSPRT, DMSBRD, DMSSTT, DMSERR, 00511000
* DMSBWR 00512000
* 00513000
*EXTERNAL REFERENCES: 00514000
* 00515000
* NONE 00516000
* 00517000
*TABLES/WORKAREAS: 00518000
* 00519000
* CONTROL DICTIONARY (C/D) 00520000
* CONTAINS ALL THE NECESSARY INFORMATION FOR 00521000
* RELOCATION. FORMAT OF ENTRY - SEE DSECT CDENTRY. 00522000
* STARTS IMMEDIATELY AFTER LINKAGE TABLE. ADDRESS 00523000
* IN CDENT1. 00524000
* 00525000
* LINKAGE TABLE (L/T) 00526000
* CONNECTS THE ESID NUMBERS IN THE OBJECT DECK TO 00527000
* ENTRIES IN THE CONTROL DICTIONARY. FORMAT OF 00528000
* ENTRY - 2 BYTES C/D NUMBER, 1 BYTE ESD TYPE. 00529000
* THE ESID NUMBER DETERMINES THE POSITION IN THE 00530000
* TABLE. BEGINS ON FIRST PAGE BOUNDARY AFTER THE 00531000
* TEXT BUFFER. ADDRESS MINUS LENGTH OF ONE ENTRY 00532000
* IN LTMINE. 00533000
* 00534000
* TEXT BUFFER 00535000
* OUTPUT AREA FOR DOSLIB BLOCKS. OVERLAYS PART 00536000
* OF CSECT DLKINL. STARTS ON FIRST 1K BOUNDARY AFTER 00537000
* BEGIN OF CSECT DLKINL. ADDRESS IN AWKARE. 00538000
* 00539000
* INPBLK 00540000
* INPUT AREA FOR RECORDS FROM DOSLNK, CMS TEXT, OR 00541000
* THE DOS RELOCATABLE LIBRARIES. 00542000
* 00543000
*REGISTER USAGE: 00544000
* 00545000
* R1 - R8 -WORK 00546000
* R9 - BASE OF DLKINL 00547000
* RA - RB -PARAMETER PASSING 00548000
* RC - RD - BASE REGISTERS 00549000
* RE - RF - SUB-ROUTINE LINKAGES 00550000
* 00551000
*OPERATION: 00552000
* 00553000
* CONTROL ENTERS DMSDLK AT THE DLKINL 00554000
* CSECT. THE COMMAND LINE IS SCANNED FOR ERRORS AND 00555000
* ADCONS ARE RELOCATED. THEN SYSRES IS LOCATED AND, IF 00556000
* THE DISK OPTION IS DESIRED, THE OLD MAP FILE IS 00557000
* ERASED IF IT EXISTS AND A NEW ONE CREATED. 00558000
* A CHECK IS MADE TO SEE IF OLD TEMPORARY FILES WITH 00559000
* A FILENAME OF 'FN' ARE PRESENT AND, IF SO, TO ERASE 00560000
* THEM. THE PRIVATE RELOCATABLE LIBRARY, IF 00561000
* SPECIFIED, IS LOCATED AND ADDRESSES ARE CALCULATED. 00562000
* DOSLIB IS THEN FILEDEFED AND OPENED. A CHECK IS 00563000
* MADE FOR DOSLNK AND, IF NOT AVAILABLE, A DUMMY 00564000
* INCLUDE CARD IS SET UP AND CONTROL PASSES TO 00565000
* NORMAL PROCESSING. IF DOSLNK IS AVAILABLE, THE 00566000
* FILE IS READ AND ACTION CARDS ARE PROCESSED. 00567000
* WHEN THE FIRST NON-ACTION CARD IS LOCATED, THE 00568000
* OPTIONS SPECIFIED ON THE ACTION CARDS (IF ANY) 00569000
* ARE PROCESSED AND CONTROL PASSES TO NORMAL 00570000
* PROCESSING. WHEN THE CSECT HAS COMPLETED ITS 00571000
* PROCESSING, IT WILL BE OVERLAID WITH WORK TABLES 00572000
* AND BUFFER AREAS BY SUBSEQUENT PROCESSING. 00573000
* 00574000
* PHASES FORMED FROM LANGUAGE TRANSLATOR RELOCATABLE MODULES 00575000
* ARE ASSIGNED AREAS OF MAIN STORAGE. 00576000
* WHEN ACTION REL IS SPECIFIED OR DEFAULT AND ACCEPTED FOR 00577000
* A PHASE, A RELOCATABLE PHASE WILL RESULT. 00578000
* WHEN ACTION NOREL IS SPECIFIED OR DEFAULT OR ACTION REL 00579000
* NOT ACCEPTED FOR A PHASE THE RESULTING PHASE WILL BE 00580000
* NOT RELOCATABLE. 00581000
* 00582000
* THE FOLLOWING CONTROL CARDS ARE PROCESSED DURING 00583000
* NORMAL PROCESSING: 00584000
* 00585000
* PHASE - AS EACH PHASE IS BUILT, THE INFORMATION FOR 00586000
* THE PHASE IS SET UP IN CPHENT. THE NAME IS 00587000
* CHECKED FOR DUPLICATES AND THE ORIGIN IS 00588000
* DETERMINED. IF THIS IS NOT THE FIRST PHASE 00589000
* THE PREVIOUS PHASE IS INSERTED IN THE CONTROL 00590000
* DICTIONARY TABLE AND THE NUMBER OF BLOCKS ON 00591000
* SYSUT2 CONTAINING BOTH TEXT AND RLD INFORMATION ARE 00592000
* DETERMINED. IF THE PHASE IS RELOCATABLE, A SWITCH 00593000
* IS SET AND PASS 3 OF RLD RECORDS IS INDICATED. 00594000
* 00595000
* INCLUDE - IF AN UNNAMED SUB-MODULE, CARD IS IGNORED. 00596000
* OTHERWISE, THE NAME IS COMPARED AGAINST THE 00597000
* PRIVATE RELOCATABLE DIRECTORY, CMS TEXT FILES 00598000
* AND SYSTEM RELOCATABLE DIRECTORY. IF NOT FOUND 00599000
* AN ERROR MESSAGE IS ISSUED AND PROCESSING 00600000
* CONTINUES. IF FOUND, THE PREVIOUS FILE'S 00601000
* ADDRESSES ARE STORED AND THE NEW FILE IS READ AND 00602000
* PROCESSED. WHEN AN END CARD IS READ THE 00603000
* PREVIOUS FILE'S ADDRESSES ARE RESTORED AND ITS 00604000
* PROCESSING CONTINUES. 00605000
* 00606000
* ENTRY - IF NOAUTO HAS NOT BEEN SET EXTERNAL REFERENCES, 00607000
* IF ANY, ARE RESOLVED, IF POSSIBLE, BY AUTOLINKING 00608000
* THE REQUIRED MODULES INTO THE PHASE. CONTROL 00609000
* IS THEN PASSED TO END PROCESSING. THE TRANSFER 00610000
* ADDRESS, IF SPECIFIED, IS OBTAINED AND THE 00611000
* NUMBER OF TEXT BLOCKS AND RLD BLOCKS IS CALCULATED. 00612000
* IF NOMAP WAS NO SPECIFIED, THE MAP IS PRINTED, 00613000
* TYPED, OR WRITTEN ONTO DISK AS SPECIFIED BY THE 00614000
* OPTION LIST OF THE COMMAND LINE. THE RLD 00615000
* RECORDS ARE THEN PROCESSED AND WRITTEN ONTO 00616000
* SYSUT2. THE STOW TABLE ENTRY IS THEN COMPUTED 00617000
* AND WRITTEN ONTO DOSLIB AS THE FIRST RECORD. 00618000
* THEN SYSUT2 IS READ AND WRITTEN ONTO DOSLIB IN 00619000
* 1024 BYTE BLOCKS WITH THE EXCEPTION OF THE LAST 00620000
* RECORD, WHICH CAN BE ANY LENGTH. A STOW IS 00621000
* THEN ISSUED TO INSERT THE NAME OF THE PHASE IN 00622000
* THE DIRECTORY. THE SYSUT1 AND SYSUT2 FILES ARE 00623000
* THEN ERASED, DOSLNK AND DOSLIB FILES ARE 00624000
* CLOSED, AND CONTROL RETURNS TO CMS. 00625000
* 00626000
* 00627000
*. 00628000
TITLE 'DMSDLK LINKAGE EDITOR CONSTANTS AND SUBROUTINES - $LNKEDT' 00629000
*************************************************************** 00630000
* * 00631000
* CSECT DMSDLK - CONSTANTS AND SUBROUTINES 00632000
* * 00633000
* CONTAINS THESE SUBROUTINES 00634000
* RDS000 - READ INPUT FROM RELOCATABLE LIBRARY 00635000
* CMSREAD- READS INPUT FROM CMS TEXT DECKS 00636000
* LTESID - FIND CTL DICTIONARY INFO AND RELOC FACTOR * 00637000
* WRTUTX - WRITES OUTPUT ONTO EITHER SYSUT1 OR SYSUT2 00638000
* SRCHCD - SEARCH CTL DICTIONARY FOR MATCHING LABEL * 00639000
* CHVHEX - CONVERT HEX CHARACTERS TO BINARY * 00640000
* PRINT - PRINT ONTO SYSLST 00641000
* LOGMSG - PRINT ERROR MESSAGE ONTO TERMINAL 00642000
* SPACE1 - SPACE ONE LINE ON SYSLST 00643000
* PRTLST - PRINT DIAGNOSTICS OF INPUT ONTO SYSLST 00644000
* DISK - WRITES MAP OUTPUT ONTO MAP DISK FILE 00645000
* AD1DSK - UPDATE DISK ADDR * 00646000
* XTPHNO - EXTRACT PHS NO. FROM CTL DICTIONARY ENTRY * 00647000
* READCI - READS CORE IMAGE LIB BLOCKS 00648000
* WRITE - WRITES CORE IMAGE LIB BLOCKS * 00649000
* ABTERR - BRANCHES TO DLKRLD FOR ABORT ERROR 00650000
* DISKIO - EXECUTE I/O * 00651000
* CDSIZE - CHK FOR CTL DICTIONARY OVERFLOW 00652000
* RDNEXT - READS INPUT STREAM * 00653000
* ALNKPR - SETS UP SCAN OF RELOC DIR IF AUTOLNK -SORTS UNRESOLVD ER * 00654000
* ERROR - SETS UP TO PRINT NON-ABORT ERROR MESSAGES * 00655000
* DERDAD - SETS UP CORE IMAGE BLOCKS OF TEXT IN A WORK AREA * 00656000
* * 00657000
*INPUT - DOSLNK, SYSRES, CMS TEXT, PRIVATE RELOC. LIB. 00658000
* * 00659000
*OUTPUT - DOSLIB,MAP 00660000
* * 00661000
* 00662000
* -ERRORS - ABTERR - ABORT ERRORS IN THIS PHASE ARE 2194 00663000
* * 00664000
******************************************************************** 00665000
EJECT 00666000
DMSDLK START 0 CONSTANTS AND SUBROUT @V305096 00667000
DLKNAME DC CL8'DMSDLK' @V305065 00668000
DC X'2900' VERSION/MOD LEVEL ID @V305096 00669000
* 00670000
USING DMSDLK,RC BASE FOR RES CONSTANTS & S/R-S @V305096 00671000
USING E1,RA DSECT TO DEFINE INPUT AREA @V305096 00672000
USING CDENTRY,R9 DSECT FOR C/D ENTRIES @V305096 00673000
USING D17,R6 DSECT TO DEF VAR ESD/RLD FIELDS @V305096 00674000
USING NUCON,R0 @V305065 00675000
* 00676000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * ** 00677000
* 00678000
* REGISTERS TO USE IN DOS 00679000
* 00680000
* R0 R1 R2 R3 R4 R5 R6 R7 R8 R9 R10 R11 R12 R13 R14 00681000
* 00682000
RF EQU 15 SUB-ROUTINE LINKAGES @V305096 00683000
RE EQU 14 @V305096 00684000
* 00685000
RD EQU 13 BASE REGISTERS @V305096 00686000
RC EQU 12 @V305096 00687000
* 00688000
RB EQU 11 PARAMETER PASSING @V305096 00689000
RA EQU 10 @V305096 00690000
* 00691000
R9 EQU 9 PASSING INFORMATION @V305096 00692000
R8 EQU 8 @V305096 00693000
R7 EQU 7 @V305096 00694000
* 00695000
R6 EQU 6 ARITHMETIC USE @V305096 00696000
R5 EQU 5 @V305096 00697000
R4 EQU 4 @V305096 00698000
R3 EQU 3 @V305096 00699000
R2 EQU 2 @V305096 00700000
* 00701000
R1 EQU 1 USE W/CAUTION--DESTROYED BY SVC-S @V305096 00702000
R0 EQU 0 @V305096 00703000
EJECT 00704000
*************************************************************** 00705000
* DSECT FOR CONTROL DICTIONARY ( C/D ) 00706000
*************************************************************** 00707000
CDENTRY DSECT @V305096 00708000
* 00709000
* LAYOUT OF ENTRY OF TYPE OTHER THAN PHASE 00710000
* 00711000
NAMED DS CL8 NAME OF ESD ITEM @V305096 00712000
ESDTYPD DS XL1 ESD TYPE @V305096 00713000
ASSORGD DS 0XL3 ASSEMBLED ORIGIN @V305096 00714000
LNGTHD DS XL3 OR LENGTH OF CM @V305096 00715000
RELFACD DS 0F RELOCATION FACTOR @V305096 00716000
DS H @V305096 00717000
CSNUMD DS 0H OR C/D # OR ESID # OF @V305096 00718000
* CSECT FOR LD/LR 00719000
PHNUMED DS H OR PHASE # FOR ER/WX @V305096 00720000
PHNUMD DS H PHASE NUMBER FOR SD/PC @V305096 00721000
SWITCHD DS XL1 DIVERSE SWITCHES @V305096 00722000
DS XL1 FOR FUTURE USE @V305096 00723000
CDEND EQU * @V305096 00724000
* 00725000
* LAYOUT OF PHASE ENTRY 00726000
* 00727000
ORG CDENTRY @V305096 00728000
PHNAMED DS CL8 PHASE NAME @V305096 00729000
ESDTYPED DS XL1 ESD TYPE @V305096 00730000
ORPHDAD DS XL5 DISK ADDR OF FIRST BLK @V305096 00731000
NOBLOKD DS H NUM OF TEXT BLKS @V305096 00732000
NOBYTED DS H NUM OF BYTES IN LAST BLK@V305096 00733000
RLDITEMD DS H NUM OF RLD ITEMS @V305096 00734000
ORPHRGD DS F PHASE ORIGIN @V305096 00735000
NXPHRGD DS F NEXT PHASE ORIGIN @V305096 00736000
TRFRADD DS F TRANSFER ADDR @V305096 00737000
LINKSTRD DS F START OF PARTITION @V305096 00738000
RLDBLCKD DS H NUM OF EXTRA RLD BLKS @V305096 00739000
PHTYPED DS C PHASE TYPE @V305096 00740000
DS C FOR FUTURE USE @V305096 00741000
* 00742000
************************************************************** 00743000
* 00744000
* THE FIRST BYTE OF ORPHRGD AND THE FIRST BYTE OF 00745000
* TRFRADD MUST BE X'00'. MOST ROUTINES SCANNING THE C/D 00746000
* HANDLE IT AS IF IT CONSISTED OF FIXED LENGTH ( 20 BYTE ) 00747000
* ENTRIES. THE TWO BYTES X'00' PREVENT THE SECOND HALF 00748000
* OF A PHASE ENTRY TO BE SELECTED AS A C/D ENTRY. 00749000
* 00750000
************************************************************** 00751000
EJECT 00752000
************************************************************** 00753000
* MASKS FOR ESDTYPD / ESDTYPED 00754000
************************************************************** 00755000
SD EQU X'00' SECTION DEFINITION @V305096 00756000
LD EQU X'01' LABEL DEFINITION @V305096 00757000
ER EQU X'02' EXTERNAL REFERENCE @V305096 00758000
LR EQU X'03' LABEL REFERENCE @V305096 00759000
PC EQU X'04' PRIVATE CODE @V305096 00760000
CM EQU X'05' COMMMON @V305096 00761000
PH EQU X'07' PHASE ENTRY @V305096 00762000
WX EQU X'0A' WEAK EXTERNAL @V305096 00763000
* 00764000
* IN THE C/D A WEAK EXTERNAL IS STORED AS ER WITH THE 00765000
* WXTRN BIT IN SWITCHD ON 00766000
* 00767000
* 00768000
**************************************************************** 00769000
* MASKS FOR SWITCHD 00770000
*************************************************************** 00771000
UNASSG EQU X'01' @V305096 00772000
WXTRN EQU X'02' INDICATION THAT AN ER @V305096 00773000
* IS A WEAK EXTERNAL 00774000
NOAUTOL EQU X'04' NO AUTOLINK NECESSARY @V305096 00775000
* THIS BIT IS SET FOR A WEAK EXTERNAL , IF NOAUTO IS 00776000
* SPECIFIED, OR IF AN AUTOLINK WAS UNSUCCESSFUL 00777000
ASSG EQU X'FE' MASK TO ASSIGN LD/LR @V305096 00778000
* 00779000
* 00780000
*************************************************************** 00781000
* MASKS FOR PHTYPED 00782000
*************************************************************** 00783000
SELFRELO EQU X'80' SELF RELOCATING PHASE @V305096 00784000
RELPHASE EQU X'40' RELOCATABLE PHASE @V305096 00785000
* X'00' NOT RELOCATABLE 00786000
*************************************************************** 00787000
EJECT 00788000
* 00789000
DUMMY2 DSECT @V305096 00790000
D17 DS C VAR FLDS ON ESD & RLD CRDS @V305096 00791000
D18 DS C @V305096 00792000
D19 DS C DEF'D BY BYTE IN THIS CSECT @V305096 00793000
D20 DS C @V305096 00794000
D21 DS C @V305096 00795000
D22 DS C NUMERIC REFLCTS CORRESP CARD@V305096 00796000
D23 DS C @V305096 00797000
D24 DS C COLS OF 1ST VARIABLE FIELD @V305096 00798000
D25 DS C @V305096 00799000
D26 DS C @V305096 00800000
D27 DS C @V305096 00801000
D28 DS C @V305096 00802000
D29 DS C @V305096 00803000
D30 DS C @V305096 00804000
D31 DS C @V305096 00805000
D32 DS C @V305096 00806000
* 00807000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00808000
* 00809000
DUMMY3 DSECT @V305096 00810000
H1 DS C PHASE NAME @V305096 00811000
H2 DS C @V305096 00812000
H3 DS C FIELDS DEFINE OUTPUT RECORDS@V305096 00813000
H4 DS C @V305096 00814000
H5 DS C USED TO BLOCK PHASE HEADERS @V305096 00815000
H6 DS C @V305096 00816000
H7 DS C INTO LIBRARIAN AREA @V305096 00817000
H8 DS C @V305096 00818000
H9 DS C LOAD ADDRESS THIS PHASE @V305096 00819000
H10 DS C @V305096 00820000
H11 DS C @V305096 00821000
H12 DS C # C.I. BLOCKS IN PHASE @V305096 00822000
H13 DS C TRANSFER ADDRESS THIS PHASE @V305096 00823000
H14 DS C @V305096 00824000
H15 DS C @V305096 00825000
H16 DS C START DSK ADDR OF PHASE IN @V305096 00826000
H17 DS C H CORE IMAGE LIBRARY @V305096 00827000
H18 DS C R @V305096 00828000
H19 DS C LOGICAL LENGTH OF LAST BLOCK@V305096 00829000
H20 DS C @V305096 00830000
* 00831000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00832000
* 00833000
DUMMY4 DSECT @V305096 00834000
E1 DS C IDENTIFICATION @V305096 00835000
E2 DS C @V305096 00836000
E3 DS C @V305096 00837000
E4 DS C @V305096 00838000
E5 DS C @V305096 00839000
E6 DS C ASSEMBLED ORIGIN @V305096 00840000
E7 DS C REP HEX LOAD ORIGIN @V305096 00841000
E8 DS C @V305096 00842000
E9 DS C @V305096 00843000
E10 DS C @V305096 00844000
E11 DS C NO OF VAR BYTES TO PROCESS @V305096 00845000
E12 DS C @V305096 00846000
E13 DS C @V305096 00847000
E14 DS C REP HEX ESID # @V305096 00848000
E15 DS C ESID # @V305096 00849000
E16 DS C @V305096 00850000
E17 DS C FIELDS OF VARIABLE INFO @V305096 00851000
* 00852000
DMSDLK CSECT RESUME CSECT @V305096 00853000
EJECT 00854000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00855000
* 00856000
* CONSTANTS 00857000
* 00858000
*** SIZES EQUATED TO SYMBOLS 00859000
* 00860000
WKAREA EQU 0 DEF TO SUPPLY PSEUDO ADDR'BLTY @V305096 00861000
* 00862000
DEV2314 EQU X'62' DEVICE-TYPE FOR 2314 @V305096 00863000
DEV3330 EQU X'63' DEVICE-TYPE FOR 3330 @V505098 00864000
DEV333B EQU X'65' DEVICE-TYPE FOR 3330-11 @V505098 00865000
DEV3350 EQU X'67' DEVICE-TYPE FOR 3350 @V505098 00866000
DEV3343 EQU X'69' DEVICE-TYPE FOR 3340,36MB @V305096 00867000
DEV3347 EQU X'6A' DEVICE-TYPE FOR 3340,70MB @V305096 00868000
* 00869000
HDFCT1ST EQU 15 NUM OF ENTRIES IN BLOCK @V305096 00870000
* OF REL 00871000
* 00872000
NESTNG EQU 5 NO OF LEVELS OF NESTING ON @V305096 00873000
* INCLUDE STATEMENTS 00874000
RELSW EQU 4 USED AS MASK FOR REL OPTION@V305096 00875000
* THE CONTROL DICTIONARY 00876000
MAPOP EQU X'01' MASK USED FOR MAPSW @V305096 00877000
* 00878000
SYSRS EQU 6 SYSTEM SYMBOL LUB VALUES @V305096 00879000
CDLNGTH EQU CDEND-CDENTRY LENGTH OF C/D ENTRY @V305096 00880000
******************************************************************** 00881000
* EQUATES USED PRIMARILY DURING INITIALIZATION AND MEANINGFUL 00882000
* EQUATES FOR NUMERICS. 00883000
******************************************************************** 00884000
SPACE 00885000
DEC0 EQU 0 @V305096 00886000
DEC1 EQU 1 @V305096 00887000
DEC2 EQU 2 @V305096 00888000
DEC3 EQU 3 @V305096 00889000
DEC4 EQU 4 @V305096 00890000
DEC5 EQU 5 @V305096 00891000
DEC6 EQU 6 @V305096 00892000
DEC7 EQU 7 @V305096 00893000
DEC8 EQU 8 @V305096 00894000
DEC10 EQU 10 @V305096 00895000
DEC13 EQU 13 @V305065 00896000
DEC16 EQU 16 @V305096 00897000
DEC18 EQU 18 @V305096 00898000
DEC20 EQU 20 @V305096 00899000
DEC32 EQU 32 @V305096 00900000
DEC39 EQU 39 @V305096 00901000
DEC88 EQU 88 @V305096 00902000
DEC320 EQU 320 @V305065 00903000
DEC2047 EQU 2047 @V305065 00904000
ER024 EQU 24 ERROR ID'S @V305096 00905000
ER028 EQU 28 @V305065 00906000
ER032 EQU 32 @V305065 00907000
ER036 EQU 36 @V305065 00908000
ER040 EQU 40 @V305065 00909000
ER100 EQU 100 @V305065 00910000
HEX0 EQU X'00' @V305096 00911000
HEX1 EQU X'01' @V305096 00912000
HEX2 EQU X'02' @V305096 00913000
HEX3 EQU X'03' @V305096 00914000
HEX4 EQU X'04' @V305096 00915000
HEX5 EQU X'05' @V305096 00916000
HEX6 EQU X'06' @V305096 00917000
HEX7 EQU X'07' @V305096 00918000
HEX8 EQU X'08' @V305096 00919000
HEXC EQU X'0C' @V305096 00920000
HEXF EQU X'0F' @V305096 00921000
HEX10 EQU X'10' @V305096 00922000
HEX20 EQU X'20' @V305096 00923000
HEX40 EQU X'40' @V305096 00924000
HEX60 EQU X'60' @V305096 00925000
HEX80 EQU X'80' @V305096 00926000
HEX31 EQU X'31' @V305096 00927000
HEXF0 EQU X'F0' @V305096 00928000
HEXFF EQU X'FF' @V305096 00929000
* 00930000
ONEK EQU 1024 1K @V305096 00931000
UNASSGN EQU X'FF' EQUAL TO UNASSIGNED LUB@V305096 00932000
BLANK EQU C' ' END OF ACTION OPERANDS @V305096 00933000
COMMA EQU C',' SEPARATOR OF ACTION OPERANDS@V305096 00934000
E EQU C'E' TO SEE IF 'ENTRY' VERB @V305096 00935000
* 00936000
*** DOUBLE WORD-S & COUPLINGS 00937000
* 00938000
AWKARE DC A(WKAREA) ADDRESS OF WORK AREA @V305065 00939000
DBLWRD DC D'0' DOUBLE WORD FOR SCRATCH USE @V305096 00940000
* 00941000
CTLDNO DC F'-1' C/D # OF LAST C/D ENTRY @V305096 00942000
CTLDAD DC F'0' C/D ADDR OF LAST C/D ENTRY @V305096 00943000
* 00944000
* 00945000
*************************************************************** 00946000
* CURRENT PHASE ENTRY (C/D) 00947000
*************************************************************** 00948000
CPHENT EQU * @V305096 00949000
PHNAMEC DC CL8' ' PHASE NAME @V305096 00950000
ESDTYPC DC X'00' ESDTYPE @V305096 00951000
ORPHDA DC X'0001000000' DISK ADDR OF FIRST BLK @V305096 00952000
NOBLOK DC H'0' NO OF TXT BLKS @V305096 00953000
NOBYTE DC H'0' NO OF BYTES IN LAST BLK @V305096 00954000
RLDITEMS DC H'0' NO OF RLD ITEMS @V305096 00955000
ORPHRG DC F'0' PHASE ORIGIN @V305096 00956000
NXPHRG DC F'0' NEXT PHASE ORIGIN @V305096 00957000
TRFRAD DC F'0' TRANSFER ADDR @V305096 00958000
LNKSTRT DC F'0' START OF PARTITION @V305096 00959000
RLDBLCKS DC H'0' NO OF EXTRA RLD BLKS @V305096 00960000
PHTYPE DC X'00' PHASE TYPE @V305096 00961000
DC X'00' FOR FUTURE USE @V305096 00962000
* 00963000
*************************************************************** 00964000
* CURRENT C/D ENTRY OF TYPE OTHER THAN PHASE 00965000
*************************************************************** 00966000
CESDENT EQU * @V305096 00967000
NAME DC CL8' ' NAME OF ESD ITEM @V305096 00968000
ESDTYP DC X'00' ESD TYPE @V305096 00969000
ASSORG DS 0XL3 ASSEMBLED ORIGIN @V305096 00970000
LNGTH DC XL3'00' LENGTH OF COMMON @V305096 00971000
RELFAC DS 0F RELOCATION FACTOR @V305096 00972000
DC H'0' OR @V305096 00973000
CSNUM DS 0H C/D # OR ESD # OF CSECT@V305096 00974000
* FOR LD/LR 00975000
PHNUME DC H'0' PHASE # FOR ER/WX @V305096 00976000
PHNUM DC H'0' PHASE NUMBER FOR SD/PC @V305096 00977000
CSWITCH DC X'00' DIVERSE SWITCHES @V305096 00978000
DC X'00' FOR FUTURE USE @V305096 00979000
*************************************************************** 00980000
* FOR COMMENTS AND USE OF SWITCHES SEE DSECT CDENTRY 00981000
************************************************************** 00982000
* 00983000
* 00984000
RLDCNT DC H'0' COUNTFIELD NO. OF RLD ITEMS @V305096 00985000
RESADDR DC H'0' SYSRES ADDRESS @V305065 00986000
PRVADDR DC H'0' PRIV RELO ADDRESS @V305065 00987000
* 00988000
LOCORE DC F'0' LOAD ADDR OF CURRENT BLOCK @V305096 00989000
HICORE DC F'0' LOAD ADDRESS OF NEXT BLOCK @V305096 00990000
THPHDA DC H'0' DISK ADDR OF CURRENT C.I. BLOCK @V305096 00991000
* 00992000
PERIDA DC XL5'0' DISK ADDR NEXT RCD THIS BOOK@V305096 00993000
DC CL7' ' FOR CMS TEXT NAMES @V305065 00994000
LNTPRDA EQU *-PERIDA LENGTH OF PERIDA @V305065 00995000
PERISW DC X'01' SWITCH INFO FOR THIS BOOK @V305096 00996000
CMSTXT EQU X'08' INPUT FROM TEXT FILE @V305065 00997000
FSTFILE EQU X'10' FIRST INPUT FILE @V305065 00998000
DC (NESTNG)XL13'00' RESERV AREA FOR NEXTED INCLUDES@V305096 00999000
ENDPER EQU *-1 END OF NESTING AREA @V305096 01000000
DC X'0' THIS ASSURES PROPER @V305096 01001000
* CLEARING OF PUSH DOWN INCLUDE LIST 01002000
TRFRSW DC X'0' '01' WHEN XFER OF END ACCEPTD@V305096 01003000
ZEROH DC H'0' CONSTANT 0 @V305096 01004000
K1 DC H'1' CONSTANT 1 @V305096 01005000
KMIN DC H'-1' @V305065 01006000
ITMCNT DC H'0' CMS TEXT FILE ITEM COUNT @V305065 01007000
* 01008000
BLANKS DC CL8' ' @V305096 01009000
NMELST DC CL40' ' LIST - SUB-MODULAR C/S NAMES@V305096 01010000
* 01011000
DS 0F @V305096 01012000
PHVERB DC CL8' ' FIELDS TAKEN FROM PHASE CARD@V305096 01013000
PHNAME DC CL8' ' @V305096 01014000
SYMBOL DC CL8' ' @V305096 01015000
QUALIF DC CL8' ' @V305096 01016000
DISPLC DC F'0' @V305096 01017000
* 01018000
* 01019000
*** FULL WORDS 01020000
* 01021000
BUCK4 DC F'0' GENL PURPOSE BUCKET, USED TO@V305096 01022000
ORG BUCK4+1 FORCE ALGNMT OF NON-ALIGNED DATA @V305096 01023000
BUCK3 DC XL3'0' @V305096 01024000
ORG BUCK3+1 @V305096 01025000
BUCK2 DC H'0' @V305096 01026000
ORG BUCK2+1 @V305096 01027000
BUCK1 DC X'0' @V305096 01028000
* 01029000
CDENT1 DC F'0' ADDRESS OF FIRST C/D ENTRY @V305096 01030000
LTMINE DC F'0' ADDR OF START OF L/T @V305096 01031000
* MIN LENGTH OF L/T ENTRY 01032000
LNKTAD DC F'0' ADDR OF NEXT AVAIL L/T @V305096 01033000
* ENTRY 01034000
LTENTLN EQU 3 L/T ENTRY LENGTH @V305096 01035000
LTABLTH DC Y(255*LTENTLN/4*4+4) L/T LENGTH @V305096 01036000
HLTLNGTH DC Y(LTENTLN) L/T ENTRY LENGTH HALFW @V305096 01037000
ESDTYPL EQU LTENTLN-1 DISPLACEMENT OF ESD TYPE@V305096 01038000
* IN L/T 01039000
CSLNTH DC F'0' LEN OF SD/PC TO BE NEXT ASSIGNED @V305096 01040000
AD1CYL DC X'0000FFF6' UPD DSK ADDR TO NEXT CYL @V305096 01041000
EOSPVR DC F'0' END OF SUPERVISOR ADDRESS @V305096 01042000
COMSAV DC F'-1' BASE FOR COMMON AREA @V305096 01043000
* TEMPORARY FIX 01044000
* 01045000
PARTSTRT DS F WILL CONTAIN BEGINNING ADDR @V305096 01046000
* RESIDENT PARTITION FOR 01047000
* ACTUAL LINKAGE 01048000
* 01049000
TENK DC F'0' PARTITION END ADDR MIN @V305096 01050000
* LENGTH OF C/D ENTRY 01051000
DUMYPH DC C'PHASE ' @V305096 01052000
EJECT 1 01053000
**************************************************************** CMS 01054000
* 01055000
* CMS CONSTANTS 01056000
* 01057000
**************************************************************** CMS 01058000
* 01059000
DOSLNK FSCB '* DOSLNK *',RECFM=F,BUFFER=INPBLK,BSIZE=80 @V305065 01060000
DOSTXT FSCB '* TEXT *',RECFM=F,BUFFER=INPBLK,BSIZE=80 @V305065 01061000
DOSMAP FSCB '* MAP A5',RECFM=F,BSIZE=121,BUFFER=W1 @V305065 01062000
SYSUT1 FSCB '* SYSUT1 ??',RECFM=F,BSIZE=248 @V305065 01063000
SYSUT2 FSCB '* SYSUT2 A1',RECFM=F,BSIZE=1024 @V305065 01064000
* 01065000
FDEFCLR DC CL8'FILEDEF' COMMAND NAME @VM03220 01066000
DC CL8'DSLIB' DDNAME @VM03220 01067000
DC CL8'CLEAR' ACTION @VM03220 01068000
DC 8X'FF' FENCE @VM03220 01069000
DOSFILDF DC CL8'FILEDEF' @V305065 01070000
DC CL8'DSLIB' @V305065 01071000
DOSFIAC DC CL8'STATE' @V305065 01072000
DOSFINM DC CL8' ' @V305065 01073000
DC CL8'DOSLIB' @V305065 01074000
DOSFIMD DC CL2'* ' ANY DISK @V305065 01075000
DC H'0' @V305065 01076000
DOSFST DC A(0) FST ADDRSS @V305065 01077000
DC 8X'FF' @V305065 01078000
REGSAVE DS 1F'0' @V305065 01079000
CLSPLST DC CL8'CP' CLOSE PRINTER PLIST @V305065 01080000
DC CL8'CLOSE' @V305065 01081000
DC CL8'PRINTER' @V305065 01082000
DC 8X'FF' @V305065 01083000
CMSSWT1 DC X'00' @V305065 01084000
NODOSLNK EQU X'80' NO DOSLNK FILE AVAILABLE @V305065 01085000
WRITERR EQU X'40' WRITE ERROR @V305065 01086000
MAPPRT EQU X'20' PRINT MAP OPTION @V305065 01087000
MAPTYP EQU X'10' TYPE MAP OPTION @V305065 01088000
DOSTXTSW EQU X'08' INPUT FROM TEXT FILE @V305065 01089000
NODOSLIB EQU X'04' NO DOSLIB AT ENTRY @V305065 01090000
FSTSW EQU X'02' FIRST FILE(NO DOSLNK) @V305065 01091000
PRT3211 EQU X'01' VIRTUAL 3211 PRINTER @V305065 01092000
ERCODE DC X'00' ERROR CODE @V305065 01093000
ERRLIST DMSERR MF=L,SUB=(HEX,0,CHAR,0) @V305065 01094000
* 01095000
DOSLIB DCB DDNAME=DSLIB,DSORG=PO,RECFM=U,BLKSIZE=1024, @V305065*01096000
MACRF=(W),SYNAD=WRTERR @V305065 01097000
EJECT 01098000
******************************************************************** 01099000
* 01100000
* DEVICE CONSTANTS AND OVERFLOW FACTORS. 01101000
* THESE CONSTANTS ARE DEVICE DEPENDEND AND ARE CHANGED BY 01102000
* THE INITIALIZATION ROUTINE. 01103000
* AN OVERFLOW FACTOR IS COMPOSED AS FOLLOWS 01104000
* BYTE 0 NUMBER OF RECORDS PER TRACK 01105000
* BYTE 1 LOWER HEAD LIMIT 01106000
* BYTE 2 UPPER HEAD LIMIT 01107000
* BYTE 3 255 - UPPER HEAD LIMIT + LOWER HEAD LIMIT 01108000
* 01109000
******************************************************************** 01110000
* 01111000
CYLFCT DC F'0' USED BY AD1DSK TO @V305096 01112000
* REPRESENT ABOVE 01113000
* 01114000
FCTREL DC F'0' RELOCATABLE DIRECTORY @V305096 01115000
FCTRLL DC F'0' RELOCATABLE LIBRARY @V305096 01116000
CILRSIZE DC Y(CIBLOK) BLOCKSIZE OF CIL @V305096 01117000
CIBLOK EQU 1024 @V305096 01118000
******************************************************************** 01119000
* 01120000
DATE DS CL8 SAVE AREA FOR DATE @V305096 01121000
* 01122000
KS DC C'S ' @V305065 01123000
* 01124000
OVRXFR DC F'0' RETAINS OVERRIDING XFR ADDR @V305096 01125000
ENDWKARE DC F'0' ADDR OF WKAREA END @V305096 01126000
EJECT 01127000
******************************************************************** 01128000
* 01129000
*** DISK ADDRESSES 01130000
* 01131000
DS 0F ALIGNMENT @V305096 01132000
* 01133000
COMNRF DC XL5'0' ADJUSTM FACT = LEN OF COMMON@V305096 01134000
* ALSO USED AS DISK ADDR SAVE AREA 01135000
CTLSVE DC XL5'0' SAVE ADDR OF CONTROL CARD @V305096 01136000
* FOR RETURN FROM AUTOLINK 01137000
RELDST DC FL5'-1' START ADDR OF REL DIRECTORY @V305096 01138000
* 01139000
RELPVT DC FL5'-1' START ADDR OF PRIV REL DIR @V305096 01140000
* 01141000
DS 0F ALIGNMENT @V305096 01142000
NEWDAD DC XL5'0' WORKAREA FOR UPD DISK ADDR @V305096 01143000
ONS000 DC FL5'1' NXT ADDR TO READ FROM DOSLNK@V305096 01144000
NDS000 DC H'0' NXT AVAIL CHAR AFTER DOSLNK @V305096 01145000
* 01146000
ESD000 DC XL5'0' LAST ADDRESS ON DOSLNK @V305096 01147000
ESDN00 DC XL5'0' LAST ADDRESS NOT ON DOSLNK @V305096 01148000
* 01149000
ERRLNT DC X'78' @V305065 01150000
SAVIT DC F'0' REG SAVE AREA @V305096 01151000
SAVEREG DC F'0' REG SAVE AREA @V305096 01152000
H20000 DC XL4'20000' @V305065 01153000
K1024 DC H'1024' @V305065 01154000
* 01155000
PHSNO DC H'-1' C/D NO AND @V305096 01156000
PHSADD DC F'0' ADDR OF CDENTRY OF @V305096 01157000
* CURRENT/LAST PHASE 01158000
PREPHS DC H'-1' C/D # OF @V305096 01159000
* LAST PHASE PROCESSED IN CI LIBRARY 01160000
K9 DC H'9' @V305096 01161000
* 01162000
K12 DC H'12' @V305065 01163000
* 01164000
K15 DC H'15' @V305096 01165000
* 01166000
K16 DC H'16' @V305096 01167000
* 01168000
K255 DC H'255' @V305065 01169000
* 01170000
ROOTNO DC H'0' 1 IF 1ST PHASE IS ROOT @V305096 01171000
* 01172000
HCDLNGTH DC Y(CDLNGTH) LENGTH OF C/D ENTRY @V305096 01173000
* 01174000
RECBLK DC H'1' NO RECDS IN INPUT BLOCK @V305065 01175000
RECLNG DC H'0' LENGTH OF LOGICAL RECORDS @V305065 01176000
* 01177000
LINES DC H'0' SYSLST LINE COUNT @V305096 01178000
LINECNT DC H'0' COUNT OF LINES @V305096 01179000
* REMAINING ON PAGE 01180000
ALNKSW DC H'256' '01' WHEN PHASE ¬ TO BE AUTOLINKD@V305096 01181000
* 'FF' WHEN NOAUTO SPECIFIED 01182000
NUMPART DC H'0' NO. OF PART'TNS(SUPVR OPTN) @V305096 01183000
* 01184000
*** BYTES 01185000
* 01186000
NMSBSW DC X'0' '02' WHEN NAMD SUB-MODLR INCLUDE @V305096 01187000
* '04' WHEN AUTOLINK INCLUDE 01188000
* 01189000
SBMDST DC X'0' '01' - IN SUB-MODULAR STATUS @V305096 01190000
* 01191000
MODSTS DC X'0' '01' WHEN OBJECT MODULE IN PROC @V305096 01192000
* '02' FOR UNNAMED SUB MODULAR 01193000
* 01194000
CILTYPE DC AL1(SYSRS) LOG UNIT FOR CIL RESIDENCE @V305096 01195000
* 01196000
DPNTSW DC X'0' '01' WHEN POSS. DUP LD EXOR @V305096 01197000
* '02' WHEN ZERO LENGTH CONTROL 01198000
* SECTIONS PROCESSED 01199000
* '08' WHEN RELOC. FACTOR IS NEG. 01200000
* '40' WHEN PHASE WITH $ PREFIX PROC 01201000
* '80' WHEN ENTRY LABEL INVALID 01202000
* 01203000
ESDTYPE DC C' ' ESD TYPE RETAINED @V305096 01204000
* 01205000
MAPSW DC X'04' '01' WHEN MAP REQUESTED @V305096 01206000
* '02' WHEN OPTION CANCEL IS ON 01207000
* '04' WHEN ACTION REL SPECIFIED 01208000
* '08' PHASE CARD ALLOWS RELOCATE 01209000
* '10' RELOCATABLE PHASE CREATED 01210000
* '04' NOMAP PREVIOUSLY SPECIFIED 01211000
* '20' 1ST PASS OVER INPUT IS OVER 01212000
CLEARSW EQU X'40' CLEAR REQUESTED @V305065 01213000
* '80' WHEN AN ERROR OCCURS 01214000
* 01215000
POPTSW DC X'00' SWITCH FOR PHASE CARD OPTNS @V305096 01216000
OPTNOAUT EQU X'10' TEMP INDICATES NOAUTO @V305096 01217000
OPTPBDY EQU X'40' IF PBDY OPTION PRESENT @V305096 01218000
KESD DC C'ESD' @V305096 01219000
KSYM DC C'SYM' @V305096 01220000
* 01221000
KLIST DC C'LIST' @V305096 01222000
* 01223000
READRD DS 0F CCW TO READ RELOCATABLE @V305065 01224000
DC X'06' DIRECTORY @V305065 01225000
DC AL3(INPBLK) INTO INPUT AREA @V305065 01226000
DC X'00' @V305065 01227000
DC AL3(320) @V305065 01228000
EJECT 01229000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01230000
* 01231000
* RETENETION AREA FOR TRANSFER INFORMATION 01232000
* 01233000
DS 0F @V305065 01234000
X5 DC 1X'0' ASSEMBLED ORIGIN @V305096 01235000
X6 DC 3X'0' @V305096 01236000
DC 6C' ' @V305096 01237000
X15 DC 2X'0' ESID # @V305096 01238000
X17 DC 8C' ' TRANSFER LABEL @V305096 01239000
EJECT 01240000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01241000
* 01242000
* INPUT MATRIX OF TRANSFER ADDRESSES ON MAJOR INPUT TYPE 01243000
* 01244000
IPTMTX DC A(DLKSCN) CONTROL CARD SCANNER @V305096 01245000
* 01246000
ESDMTX DC A(DLKESD) ESD CARD @V305096 01247000
* 01248000
OTHMTX DC A(DLKOTH) NON-CTL/ESD TYPE OF CARD @V305096 01249000
* 01250000
CTLMTX DC A(DLKCTL) CONTROL CARD PROCESSOR @V305096 01251000
* 01252000
CATMTX DC A(DLKCAT) BUILD STOWLISTS @V305096 01253000
* 01254000
RLDMTX DC A(DLKRLD) 2ND. 3D. PASS RLD PROC @V305096 01255000
* 01256000
MAPMTX DC A(DLKMAP) MAP PROCESSOR @V305096 01257000
EJECT 01258000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01259000
* 01260000
* R15 S/R TO READ INPUT FROM DOSLNK OR THE RELOC LIBRARY 01261000
* 01262000
* INPUT RA - POINTER TO RECORD IN DOSLNK OR LIB BLOCK 01263000
* FUNCTION UPDATES POINTER TO NEXT RECORD IN BLOCK AND 01264000
* READS A NEW BLOCK FROM CMS TEXT OR THE RELOC LIB 01265000
* IF NECESSARY 01266000
* OUTPUT RA - UPDATED POINTER 01267000
* BLOCK FROM CMS TEXT OR THE RELOC LIB IN INPBLK 01268000
* R2 - DESTROYED 01269000
* 01270000
RDS000 NOPR RF SW SET IN CASE OF DUMMY PHASE CRD@V305096 01271000
RDS00A NOP CMSREAD BRANCH IF CMS TEXT FILE @V305065 01272000
AH RA,RECLNG INCREMENT TO NEXT RCD @V305065 01273000
LH R2,RECBLK DECREASE COUNT BY ONE @V305065 01274000
BCTR R2,0 JUST PROCESSED @V305065 01275000
STH R2,RECBLK RETAIN REMAINING COUNT @V305065 01276000
LTR R2,R2 ANY LEFT? @V305065 01277000
BCR 2,RF BRANCH IF SO @V305065 01278000
MVC DSKWHT(8),RDCW00 @V305096 01279000
MVC NEWDAD,ONS000 INITIALIZE DISK ADDRESS TO @V305096 01280000
ST RF,REGRF SAVE RETURN REGISTER @V305065 01281000
LA RF,1 INDICATE ONE READ @V305065 01282000
MVC CYLFCT(4),FCTRLL SET CYL FACTORS FOR REL LIBR@V305096 01283000
MVC ADRESS,NEWDAD SET UP SEARCH FIELD @V305096 01284000
* 01285000
BAL RE,DISKRDWR MULTI RETURN IF NRF CONDITION @V305096 01286000
LA R2,NEWDAD GET CURRENT ADDRESS @V305065 01287000
* 01288000
BAL RE,AD1DSK SET UP ADDR OF NEXT RECORD @V305096 01289000
MVC ONS000,NEWDAD TO READ @V305096 01290000
* 01291000
MVC RECBLK+1(1),PREFIX GET NO. OF RECORDS @V305065 01292000
MVC RECLNG+1(1),PREFIX+1 LENGTH OF EACH RECORD @V305065 01293000
LA RA,INPBLK INIT E1 TO 1ST REC ADDR @V305096 01294000
L RF,REGRF GET RETURN REGISTER @V305065 01295000
BR RF @V305096 01296000
* 01297000
DS 0F FORCE FORWARD ALIGNMENT @V305096 01298000
RDCB00 DC H'-1' CCB TO READ DOSLNK @V305096 01299000
* 01300000
RDCW00 DC X'06' CCW TO READ DOSLNK - DOES @V305096 01301000
DC AL3(PREFIX) NOT HAVE TO BE ALIGNED @V305096 01302000
DC X'00' AS IT IS MOVED INTO ALIGNED @V305096 01303000
DC AL3(322) CCW BEFORE BEING USED @V305096 01304000
REGRF DC F'0' @V305065 01305000
EJECT 1 01306000
************************************************************ 01307000
* 01308000
* CMS S/R TO READ INPUT FROM CMS TEXT FILE 01309000
* 01310000
************************************************************ 01311000
* 01312000
CMSREAD EQU * @V305065 01313000
MVC RDCB00,KMIN REMOVE UNIT ADDRESS @V305065 01314000
LR RB,RF SAVE RETURN REGISTER @V305065 01315000
ICM RF,DEC3,ONS000 GET RECORD NUMBER @V305065 01316000
FSREAD ,FSCB=DOSTXT,RECNO=(15),ERROR=CMSRDERR @V305065 01317000
LA RA,INPBLK POINT TO INPUT AREA @V305065 01318000
USING FSCBD,R1 @V305065 01319000
LH RF,FSCBITNO GET RECORD NUMBER @V305065 01320000
DROP R1 @V305065 01321000
STH RF,ADRESS AND SAVE IT @V305065 01322000
XC ADRESS+2(3),ADRESS+2 CLEAR LOW ORDER BYTES @VA05886 01323000
LA RF,1(,RF) POINT TO NEXT RECORD @V305065 01324000
STCM RF,DEC3,ONS000 @V305065 01325000
MVC NEWDAD,ONS000 COMPATIBILITY WITH DOS DISK @VA05886 01326000
BR RB RETURN @V305065 01327000
CMSRDERR EQU * @V305065 01328000
CH RF,K12 END OF FILE? @V305065 01329000
BNE RDDSKERR BRANCH IF NOT @V305065 01330000
TM CMSSWT1,NODOSLNK WAS DOSLNK SPECIFIED? @V305065 01331000
BZ CMSRDEND BRANCH IF YES @V305065 01332000
TM PERISW,FSTFILE THIS THE FIRST FILE? @V305065 01333000
BO CMSTXTND BRANCH IF YES @V305065 01334000
CMSRDEND EQU * @V305065 01335000
MVI RDS00A+1,X'00' REMOVE CMSREAD INDICATOR @V305065 01336000
BR RB AND RETURN @V305065 01337000
CMSTXTND EQU * @V305065 01338000
MVC INPBLK(7),KNTRY SET UP DUMMY ENTRY @V305065 01339000
MVC INPBLK+7(73),INPBLK+6 CLEAR REST OF BUFFER @V305065 01340000
LA RA,INPBLK POINT TO BUFFER @V305065 01341000
BR RB RETURN @V305065 01342000
EJECT 01343000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01344000
* 01345000
* R15 S/R TO SET UP REQUIRED C.I. BLOCK IN WKAREA 01346000
* 01347000
* INPUT R7 - LOAD ADDRESS 01348000
* R8 - NO OF BYTES 01349000
* THPHDA - DISK ADDRESS OF CURRENT BLOCK 01350000
* 01351000
* FUNCTION PROVIDES C.I. BLOCK CORRESPONDING TO SPECIFIED 01352000
* LOAD ADDRESS AND WRITES LAST BLOCK BACK IF 01353000
* NECESSARY. 01354000
* 01355000
* OUTPUT C.I. BLOCK IN WKAREA 01356000
* R2, R3, RB, RE - DESTROYED 01357000
* ALSO R1 01358000
* 01359000
* 01360000
DERDAD STM R2,R3,SAVER2R3 SAVE WORK REGISTERS @V305096 01361000
LH R2,THPHDA GET RECORD NUMBER @V305065 01362000
L R3,AWKARE GET BUFFER ADDRESS @V305065 01363000
LA R1,SYSUT2 POINT TO SYSUT2 DSCB @V305065 01364000
CLC PREPHS,PHSNO IF PHASE NO. HAS NOT CHGED @V305096 01365000
* CONTINUE 01366000
BE DERDOK ADDR CALC W/CURRENT VALUES @V305096 01367000
* 01368000
OI DERSW1+1,X'F0' SET SW TO FORCE NEW PHASE VALUES @V305096 01369000
* 01370000
DERDOK CL R7,ORPHRG IF ADDR < PHASE ORIGIN IT IS@V305096 01371000
ERR050 L RB,AMSG50 LOAD ADDRESS @V305096 01372000
BL ERROR OUTSIDE PHASE @V305096 01373000
* 01374000
AR R7,R8 IF ADDR+LEN > NEXT PHASE @V305096 01375000
CL R7,NXPHRG ORIGIN IT IS AN ERROR @V305096 01376000
* 01377000
DERDSW BH ERROR SW--NOP WHEN LEN IN ESD-SD @V305096 01378000
* 01379000
SR R7,R8 RESTORE LOAD ADDRESS @V305096 01380000
* 01381000
DERSW1 NOP DERITE SW--FORCE INIT OF NEW PHASE @V305096 01382000
* 01383000
LA RE,DERCAL IF LOAD ADDR >= NEXT C.I. @V305096 01384000
CL R7,HICORE BLOCK GO TO WRITE THE @V305096 01385000
BL DERCUR CURRENT & BRANCH IF NOT @V305065 01386000
NI READCI+DEC1,HEXF SET READ ROUTINE ACTIVE @V305065 01387000
BNL WRTUTX RETURN TO FIND REQ'D BLOCK @V305096 01388000
* 01389000
DERCUR EQU * @V305065 01390000
CL R7,LOCORE IF LOAD ADDRESS IS GT/EQ ADDRESS @V305096 01391000
BNL RTURN VALUE OF CURRENT BLOCK, EXIT @V305096 01392000
B DERITE1 WRITE CURRENT BLOCK @V305096 01393000
* 01394000
DERITE TM MAPSW,HEX20 IST PASS OVER @V305096 01395000
BO DERITE1 INPUT, NO @V305096 01396000
CLC PHSNO,K1 YES, IF THIS IS @V305096 01397000
BH DERITE1 TO READ THE 1ST BLOCK OF THE@V305096 01398000
CLC PREPHS,PHSNO 1ST. PHASE, NO CURRENT @V305096 01399000
BNE DERITE2 BLOCK TO WRITE OUT @V305096 01400000
* NOTE 1ST. BLOCK MEANS 1ST. 01401000
* IN TIME, NOT NECESSARILY 01402000
* IN SPACE 01403000
DERITE1 BAL RE,WRTUTX OTHERWISE WRITE CURRENT BLOCK @V305096 01404000
NI READCI+DEC1,HEXF SET READ ROUTINE ACTIVE @V305065 01405000
DERITE2 NI DERSW1+DEC1,HEXF . @V305096 01406000
* RESET SWITCH FOR IN-PHASE VALUES 01407000
MVC LOCORE(DEC4),ORPHRG RE-INITIATE ADDR TO @V305096 01408000
MVC THPHDA(DEC2),ORPHDA START OF PHASE @V305096 01409000
DERCAL EQU * @V305096 01410000
LH RB,THPHDA GET RECORD NUMBER @V305065 01411000
L R3,LOCORE @V305096 01412000
* 01413000
DERLOP EQU * UPDATE CURRENT ADDRESS @V305096 01414000
LR R2,R3 ACCEPT HICORE AS NEW LOCORE @V305096 01415000
AH R3,CILRSIZE ADD C.I. BLOCKSIZE TO GET NEW @V305096 01416000
* HICORE 01417000
* SET UP TO CONTINUE LOOP, ADDING 01418000
CLR R7,R3 TO DISK ADDRESS UNTIL @V305096 01419000
LA RB,1(,RB) @V305065 01420000
BNL DERLOP LOAD ADDRESS LESS THAN HICORE @V305096 01421000
* 01422000
BCTR RB,0 BACK OFF ONE @V305065 01423000
STH RB,THPHDA SAVE RECORD NUMBER @V305065 01424000
STM R2,R3,LOCORE SET UP NEW LOCORE & HICORE @V305096 01425000
MVC PREPHS,PHSNO SAVE PHASE # THIS @V305096 01426000
* BLOCK BELONGS TO 01427000
LH R2,THPHDA GET RECORD NUMBER @V305065 01428000
L R3,AWKARE GET BUFFER ADDRESS @V305065 01429000
BAL RE,READCI READ CI BLOCK AND @V305096 01430000
RTURN LM R2,R3,SAVER2R3 RESTORE CALLERS REGS @V305096 01431000
* 01432000
BR RF BEFORE RETURNING @V305096 01433000
SAVER2R3 DC 2F'0' . @V305096 01434000
EJECT 01435000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01436000
* 01437000
* R15 S/R TO FIND C/D #/ADDRESS/R/F FROM ESID # BY USE OF L/T 01438000
* 01439000
* INPUT R8 - ESID NO 01440000
* 01441000
* FUNCTION USES ESID NO TO FIND ENTRY IN C/D. INSPECTS C/D 01442000
* POINTER OF L/T AND CALCULATES ADDRESS OF C/D 01443000
* ENTRY IF POSSIBLE. 01444000
* 01445000
* EXIT 1 RF 01446000
* ESID NO NOT YET PROCESSED ( C/D NO IS ZERO ) 01447000
* OUTPUT R7 - ADDR OF L/T ENTRY FOR ESID NO SUPPLIED 01448000
* R8,R9 - C/D NO 01449000
* 01450000
* EXIT 2 RF + 4 01451000
* ESID NO TO BE BYPASSED ( C/D NO NEGATIV ) 01452000
* OUTPUT R7 - ADDR OF L/T ENTRY FOR ESID NO SUPPLIED 01453000
* R8, R9 - C/D NO 01454000
* 01455000
* EXIT 3 RF + 8 01456000
* C/D ENTRY FOUND FOR ESID NO SUPPLIED 01457000
* OUTPUT R7 - RELOCATION FACTOR 01458000
* R8 - C/D NO 01459000
* R9 - ADDR OF C/D ENTRY 01460000
* 01461000
LTESID LTR R7,R8 IS ESID POSITIVE @V305096 01462000
BNP ERR044 NO, ERROR @V305096 01463000
MH R7,HLTLNGTH YES, MULT ESID BY LENGTH@V305096 01464000
* OF L/T ENTRY 01465000
A R7,LTMINE CALC ADDR OF L/T ENTRY @V305096 01466000
LA R8,LTENTLN(R7) FOR THIS ESID @V305096 01467000
* IF L/T ADDRESS OF NEXT ESID NO IS GT 01468000
CL R8,LNKTAD CURRENTLY NEXT AVAIL ADDR @V305096 01469000
BNH LSETB STORE IT TO BE USED FOR C/D-L/T @V305096 01470000
C R8,CDENT1 IF ESID ADDR IS GT 1ST @V305096 01471000
BNL ERR044 C/D ENTRY-S ADDR IT IS AN ERROR @V305096 01472000
ST R8,LNKTAD @V305096 01473000
* 01474000
LSETB L R8,DEC0(R7) SET UP C/D NO @V305096 01475000
SRA R8,DEC8 @V305096 01476000
STC R8,ESDTYPE RETAIN ESD TYPE @V305096 01477000
SRA R8,DEC8 R8 - C/D NO @V305096 01478000
* 01479000
L RB,AMSG70 ESID NOT DEFINED @V305096 01480000
* 01481000
LTCDNO LTR R9,R8 SET UP C/D # FOR USE BELOW @V305096 01482000
** EXIT 1 ***** 01483000
BCR DEC8,RF IF C/D NO ZERO @V305096 01484000
** EXIT 2 ***** 01485000
BM DEC4(RF) IF C/D NO NEGATIVE @V305096 01486000
* 01487000
LTCDAD SH R9,ROOTNO ESTABLISH C/D # AS DISPLACEMENT @V305096 01488000
MH R9,HCDLNGTH MULT C/D # TO GET @V305096 01489000
* DISPLACEMENT IN C/D 01490000
A R9,CDENT1 ADD ADDRESS OF 1ST C/D ENTRY@V305096 01491000
** EXIT 3 ***** 01492000
L R7,RELFACD @V305096 01493000
B DEC8(RF) RETURN @V305096 01494000
EJECT 01495000
************************************************************ 01496000
* 01497000
* CMS ROUTINE TO WRITE SYSUTX FILE 01498000
* 01499000
************************************************************ 01500000
WRTUTX EQU * @V305065 01501000
ST RF,SAVERF SAVE RETURN REGISTER @V305065 01502000
FSWRITE ,FSCB=(1),RECNO=(2),BUFFER=(3),ERROR=WRITER @V305065 01503000
USING FSCBD,R1 @V305065 01504000
CLI FSCBFV,C'V' IS THIS SYSUT2 FILE? @V305065 01505000
BNE NOTUT2 BRANCH IF NOT @V305065 01506000
DROP R1 @V305065 01507000
TM MAPSW,CLEARSW WAS CLEAR SPECIFIED? @V305065 01508000
BZ NOTUT2 BRANCH IF NOT @V305065 01509000
BAL RF,CLEARBUF GO CLEAR BUFFER @V305065 01510000
NOTUT2 EQU * @V305065 01511000
L RF,SAVERF RESTORE RETURN REGISTER @V305065 01512000
BR RE @V305065 01513000
SAVERF DC F'0' @V305065 01514000
EJECT 1 01515000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01516000
* 01517000
* R15 S/R TO FIND LAST DUPLICATE LABEL OCCURRENCE IN C/D 01518000
* 01519000
* R6 - SUPPLIES ADDRESS OF LABEL 01520000
* R8 - RETURNS C/D # 01521000
* R9 - RETURNS C/D ADDRESS 01522000
* 01523000
* EXITS RF - NO DUPLICATE LABEL IN C/D 01524000
* RF+4 - DUPLICATE LABEL FOUND 01525000
* 01526000
SRCHCD LM R8,R9,CTLDNO LAST C/D #/ADDRESS @V305096 01527000
* 01528000
SRLABL CLC NAMED(DEC8),DEC0(R6) IF LABEL DUPLICATE @V305096 01529000
BE 4(RF) @V305096 01530000
* 01531000
SRPCOD CL R9,CDENT1 IF END OF C/D @V305096 01532000
BCR 8,RF @V305096 01533000
* 01534000
SH R9,HCDLNGTH GO TO NEXT C/D ENTRY @V305096 01535000
BCTR R8,R0 SUBTR 1 FROM C/D NO @V305096 01536000
B SRLABL @V305096 01537000
EJECT 01538000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01539000
* 01540000
* R15 S/R TO CONVERT HEX CHARACTERS TO BINARY 01541000
* 01542000
* R2 - COUNT OF HEX CHARACTERS TO CONVERT 01543000
* R3 - ADDRESS OF 1ST BYTE TO BE CONVERTED 01544000
* R4 - WORK REGISTER 01545000
* R5 - RETURNS RESULT 01546000
* 01547000
CNVHEX SR R5,R5 RESET RECIPIENT REGISTER @V305096 01548000
L RB,AMSG02 @V305096 01549000
* 01550000
SR R4,R4 RESET WORK REGISTER @V305096 01551000
CLI 0(R3),C'9' IF GT 9 NON-HEX CHARACTE R @V305096 01552000
BH ERROR @V305096 01553000
* 01554000
IC R4,0(R3) SET UP HEX CHARACTER @V305096 01555000
SH R4,K240 ASSUME 0-9, IF NEG TRY A-F @V305096 01556000
BNL CNVSHF @V305096 01557000
* 01558000
LA R4,57(R4) SHOULD GET A-F @V305096 01559000
CH R4,K9 IF RESULT ¬ A-F ITS NON-HEX @V305096 01560000
BNH ERROR CHARACT @V305096 01561000
CH R4,K15 @V305096 01562000
BH ERROR @V305096 01563000
* 01564000
CNVSHF SLL R5,4 INCLUDE 1/2 BYTE VALUE IN RESULT @V305096 01565000
AR R5,R4 @V305096 01566000
* 01567000
CNVAHX LA R3,1(R3) IF LAST CHAR CONVERTED EXIT,@V305096 01568000
BCT R2,CNVHEX+2 ELSE PROCESS NEXT @V305096 01569000
BR RF @V305096 01570000
* 01571000
K240 DC H'240' @V305096 01572000
EJECT 01573000
************************************************************** 01574000
* 01575000
* ROUTINE TO PRINT ONE LINE ON SYSLST 01576000
* 01577000
* THE ROUTINE PRINTS A HEADER FIRST IF THAT IS NECESSARY 01578000
* ( LINECNT = 0 ). THEN THE OUTPUT AREA W0 IS PRINTED ON 01579000
* SYSLST. 01580000
* 01581000
PRINT EQU * @V305065 01582000
TM CMSSWT1,MAPPRT WAS PRINT SPECIFIED? @V305065 01583000
BO PRTOK BRANCH IF YES @V305065 01584000
ST R6,SAVERERF SAVE RETURN REGISTER @V305065 01585000
BAL R6,TYPE GO CHECK TYPE @V305065 01586000
L R6,SAVERERF RESTORE RETURN REGISTER @V305065 01587000
B PRTCLEAR GO CLEAR LINE @V305065 01588000
PRTOK EQU * @V305065 01589000
SR R1,R1 CLEAR REGISTER @V305065 01590000
CH R1,LINECNT END OF PAGE REACHED @V305096 01591000
BL PRTLINE NO, PRINT LINE @V305096 01592000
* 01593000
PRINTL HEADER,ERROR=PRTERR PRINT HEADER @V305065 01594000
LH R1,LINES INITIALIZE LINECNT @V305096 01595000
BCTR R1,0 TO MAXIMUM - 2 AND @V305096 01596000
BCTR R1,0 INSURE SPACING OF @V305096 01597000
STH R1,LINECNT 2 LINES BEFORE NEXT @V305096 01598000
MVI W0,C0 PRINT @V305096 01599000
* 01600000
PRTLINE EQU * @V305065 01601000
PRINTL W0,ERROR=PRTERR PRINT LINE @V305065 01602000
PRTCLEAR EQU * @V305065 01603000
MVI W0,BLANK BLANK OUTPUT AREA @V305096 01604000
MVC W1(CHARS-DEC1),W0 @V305096 01605000
TM CMSSWT1,PRT3211 IS THIS PRINTER 3211? @V305065 01606000
BO PRTDONE BRANCH IF YES @V305065 01607000
LH R1,LINECNT DIMINISH LINECNT BY @V305096 01608000
BCTR R1,0 ONE @V305096 01609000
STH R1,LINECNT @V305096 01610000
PRTDONE EQU * @V305065 01611000
BR R6 RETURN @V305096 01612000
* 01613000
HEADER DC C'1CMS DOSLKED **/**/** ' @V305096 01614000
DC C' DOS LINKAGE EDITOR DIAGNOSTIC OF INPUT' @V305096 01615000
DC CL67' ' @V305096 01616000
* 01617000
C0 EQU C'0' CNTRL CHARACTER @V305096 01618000
EJECT 1 01619000
************************************************************** 01620000
* 01621000
* ROUTINE TO SPACE ONE LINE ON SYSLST 01622000
* 01623000
SPACE1 MVI W0,C0 INSURE SPACING OF TWO @V305096 01624000
LH R1,LINECNT LINES BEFORE NEXT @V305096 01625000
BCTR R1,0 PRINT AND UPDATE @V305096 01626000
STH R1,LINECNT LINECNT ACCORDINGLY @V305096 01627000
BR R6 RETURN @V305096 01628000
EJECT 1 01629000
************************************************************** 01630000
* 01631000
* ROUTINE TO PRINT DIAGNOSTICS OF INPUT ON SYSLST 01632000
* 01633000
* IF MAP IS REQUESTED THE ROUTINE FILLS THE OUTPUT AREA 01634000
* W0 AND BRANCH-AND-LINKS TO ROUTINE PRINT. 01635000
* 01636000
* 01637000
PRTLST TM MAPSW,MAPOP MAP REQUESTED @V305096 01638000
BZ EXITLST NO, EXIT @V305096 01639000
* 01640000
ST R6,SAVEREG YES, SAVE LINK REG @V305096 01641000
MVC W1(DEC4),KLIST FILL OUTPUT AREA @V305096 01642000
MVC W8(CARDLNG),E1 WITH 'LIST' AND CARD @VM03016 01643000
BAL R6,PRINT PRINT LINE @V305096 01644000
L R6,SAVEREG RESTORE LINK REG @V305096 01645000
EXITLST BR R6 RETURN @V305096 01646000
* 01647000
CARDLNG EQU 80 @V305096 01648000
EJECT 1 01649000
************************************************************ 01650000
* CMS ROUTINE TO PRINT PRINTER ERROR MESSAGE 01651000
************************************************************ 01652000
PRTERR EQU * @V305065 01653000
MVI W0,C'+' SUPPRESS SPACE @V305065 01654000
CH RF,=H'3' CHANNEL 9? @V305065 01655000
BE PRTLINE REPRINT LINE IF SO @V305065 01656000
MVC LINECNT(2),ZEROH INDICATE EJECT @V305065 01657000
CH RF,=H'2' CHANNEL 12 SENSED? @V305065 01658000
BE PRTLINE REPRINT LINE IF SO @V305065 01659000
DMSERR NUM=245,LET=S,SUB=(DEC,(RF)), @V305065*01660000
TEXT='ERROR ''...'' ON PRINTER' @V305065 01661000
MVI ERCODE,ER100 MOVE IN ERROR CODE @V305065 01662000
B CANCL @V305065 01663000
EJECT 1 01664000
************************************************************ 01665000
* CMS TYPE ONE LINE ON TERMINAL 01666000
************************************************************ 01667000
TYPE EQU * @V305065 01668000
TM CMSSWT1,MAPTYP WAS TYPE SPECIFIED? @V305065 01669000
BZ DISK BRANCH IF NOT @V305065 01670000
LOGMSG EQU * @V305065 01671000
WRTERM W1,120 TYPE THE LINE @V305065 01672000
BR R6 RETURN @V305065 01673000
EJECT 1 01674000
************************************************************ 01675000
* CMS WRITE RECORD TO MAP FILE 01676000
************************************************************ 01677000
DISK EQU * @V305065 01678000
FSWRITE ,FSCB=DOSMAP,ERROR=WRITER @V305065 01679000
BR R6 @V305065 01680000
EJECT 1 01681000
************************************************************ 01682000
* 01683000
* CMS WRITE ERROR ROUTINE 01684000
* 01685000
************************************************************ 01686000
WRITER EQU * @V305065 01687000
L RE,WRETEXT POINT TO ERROR MESSAGE @V305065 01688000
LA R4,105 SET ERROR NUMBER @V305065 01689000
WRERR EQU * @V305065 01690000
LR R3,RF GET ERROR CODE @V305065 01691000
LA R6,8(,R1) POINT TO FILENAME @V305065 01692000
DMSERR MF=(E,ERRLIST),NUM=(R4),TEXTA=(RE),LET=S, @V305096X01693000
SUB=(DEC,(3),CHAR8A,(6)) @V305065 01694000
MVI ERCODE,ER028 SET ERROR CODE @V305065 01695000
B CANCL @V305065 01696000
EJECT 1 01697000
W0 DC C' ' ASA CONTROL CHARACTER @V305096 01698000
DC CL132' ' LINE TO BE PRINTED @V305096 01699000
CHARS EQU *-W0 NO OF CHARACTERS IN @V305096 01700000
* PRINT LINE 01701000
* 01702000
*** PRINT LOCATIONS REQUIRED BY MAP 01703000
* 01704000
W1 EQU W0+1 ROOT @V305096 01705000
W9 EQU W0+9 PHASENAME @V305096 01706000
W19 EQU W0+19 TRANSFER ADDRESS @V305096 01707000
W27 EQU W0+27 LOAD ADDRESS @V305096 01708000
W35 EQU W0+35 LAST BYTE ADDRESS @V305096 01709000
W43 EQU W0+43 DISK ADDRESS - CC @V305096 01710000
W46 EQU W0+47 H @V305096 01711000
W48 EQU W0+49 R @V305096 01712000
W52 EQU W0+53 CSECT/EXTRN/COM IDENTIFIER @V305096 01713000
W55 EQU W0+56 ENTRY IDENTIFIER @V305096 01714000
W62 EQU W0+63 LABEL @V305096 01715000
W72 EQU W0+73 LOAD ADDRESS @V305096 01716000
W80 EQU W0+81 RELOCATION FACTOR @V305096 01717000
W88 EQU W0+89 REL IDENTIFIER @V305096 01718000
* 01719000
*** PRINT LOCATIONS REQUIRED BY ERROR LIST 01720000
* 01721000
W8 EQU W0+8 73-80 IDENTIFICATION @V305096 01722000
W17 EQU W0+17 2- 4 TYPE OF CARD @V305096 01723000
W21 EQU W0+21 6- 8 ASSEMBLED ORIGIN @V305096 01724000
W28 EQU W0+28 11-12 NO BYTES PER CARD @V305096 01725000
W32 EQU W0+32 @V305096 01726000
W33 EQU W0+33 15-16 ESID NO @V305096 01727000
W37 EQU W0+37 @V305096 01728000
W38 EQU W0+38 17- VARIABLE INFORMATION @V305096 01729000
EJECT 01730000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01731000
* 01732000
* R14 S/R TO UPDATE DISK ADDRESS BY 1 01733000
* 01734000
* R2 - POINTS TO THE DISK ADDRESS TO BE UPDATED 01735000
* THE UPDATED DISK ADDRESS IS RETURNED IN 01736000
* LOCATION NEWDAD 01737000
* 01738000
* CYLFCT - 'RR' NO OF RECORDS/TRACK 01739000
* REQUIRED FOR - 'LL' LOW TRACK IN CYLINDER 01740000
* SPLIT CYLINDER - 'HH' HIGH TRACK IN CYLINDER 01741000
* - '**' TRACK/CYLINDER OVERFLOW FACTOR 01742000
* 01743000
* AD1CYL - '0000FF**' LOGICAL OVERFLOW FACTOR 01744000
* 01745000
* '**' CALCULATED AS 255 + LOW TRACK - HIGH TRACK 01746000
* 01747000
AD1DSK MVC NEWDAD,DEC0(R2) MOVE DISK ADDR TO WORK AREA @V305096 01748000
CLC NEWDAD+DEC4(DEC1),CYLFCT IF PREV RCD WAS NOT @V305096 01749000
IC R2,NEWDAD+DEC4 INSERT RECORD NUMBER @V305096 01750000
LA R2,DEC1(R2) ADD 1 @V305096 01751000
STC R2,NEWDAD+DEC4 AND STORE BACK @V305096 01752000
BCR DEC7,RE LIMIT, EXIT @V305096 01753000
MVI NEWDAD+DEC4,HEX1 INIT FOR REC 1 ON NXT TRCK @V305096 01754000
L R2,NEWDAD LOAD CCHH IN REGISTER @V305096 01755000
AH R2,K1 ADD 1 TO TRACK ADDRESS @V305096 01756000
CLC NEWDAD+DEC3(DEC1),CYLFCT+DEC2 IF PREV TRCK WAS @V305096 01757000
BNE STDAD NOT LIMIT, EXIT @V305096 01758000
MVC AD1CYL+DEC3(DEC1),CYLFCT+DEC3 SETUP OVFL FACTOR@V305096 01759000
AL R2,AD1CYL TO NEXT CYLINDER @V305096 01760000
STDAD ST R2,NEWDAD STORE UPDATED CCHH @V305096 01761000
BR RE EXIT @V305096 01762000
* 01763000
* * * * * * * * * * * * * * * * * * * 01764000
* 01765000
* TO PROCESS SPLIT CYLINDER, INITIALISATION MUST 01766000
* 01767000
* RECALCULATE GIVEN FACTORS OF 0/LOW 9/HIGH TO 01768000
* 01769000
* DERIVE THE NEW TRACK/CYLINDER OVERFLOW FACTOR 01770000
* 01771000
* * * * * * * * * * * * * * * * * * * * 01772000
EJECT 01773000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01774000
* 01775000
* CMS S/R TO INITIATE READ OF SYSUT2 01776000
* 01777000
* WKAREA - RESERVED INPUT AREA 01778000
* 01779000
* WKAREA - RESERVED O UTPUT AREA 01780000
* 01781000
READCI EQU * ENTRY FROM DERDAD @V305096 01782000
B READEND NOP WHEN FILE EXISTS @V305065 01783000
STM RE,RF,SAVERERF SAVE RETURN REGISTERS @V305065 01784000
FSCLOSE ,FSCB=SYSUT2 CLOSE OUTPUT FILE @V305065 01785000
FSREAD ,FSCB=(1),RECNO=(2),BUFFER=(3),ERROR=READERR @V305065 01786000
READOK EQU * @V305065 01787000
FSCLOSE ,FSCB=SYSUT2 CLOSE INPUT FILE @V305065 01788000
LM RE,RF,SAVERERF RESTORE RETURN REGISTERS @V305065 01789000
READEND EQU * @V305065 01790000
BR RE AND RETURN @V305065 01791000
* 01792000
READERR EQU * @V305065 01793000
CH RF,K12 END OF FILE? @V305065 01794000
BNE RDDSKERR BRANCH IF NOT, ERROR @V305065 01795000
LA RF,READOK SET RETURN ADDRESS @V305065 01796000
CLEARBUF EQU * @V305065 01797000
SR R1,R1 CLEAR REGISTER @V305065 01798000
LR R2,R3 SET REGISTERS FOR @V305063 01799000
LA R3,ONEK CLEARING STORAGE @V305065 01800000
MVCL R2,R0 CLEAR STORAGE @V305065 01801000
BR RF @V305065 01802000
SAVERERF DC 2F'0' @V305065 01803000
EJECT 01804000
************************************************************ 01805000
* 01806000
* CMS S/R TO WRITE DOSLIB 01807000
* 01808000
************************************************************ 01809000
* 01810000
WRITE EQU * @V305065 01811000
ST RE,RESAVE SAVE RETURN REGISTER @V305065 01812000
NI DOSFLAGS,255-DOSSVC TURN OF DOS SVC INDIC. @V305065 01813000
WRITE WRITECB,SF,DOSLIB,(R2),(R3) @V305065 01814000
CHECK WRITECB WAIT FOR COMPLETION @V305065 01815000
OI DOSFLAGS,DOSSVC INDICATE DOS SVC @V305065 01816000
NI CMSSWT1,255-NODOSLIB INDICATE DOSLIB @V305065 01817000
L RE,RESAVE RESTORE RETURN REGISTER @V305065 01818000
BR RE RETURN @V305065 01819000
* 01820000
WRTERR EQU * @V305065 01821000
SYNADAF ACSMETH=BPAM @V305065 01822000
SYNADRLS @V305065 01823000
LA RB,50(,R1) POINT TO MESSAGE @V305065 01824000
ICM RB,DEC8,ERRLNT INSERT LENGTH @V305065 01825000
OI MAPSW,HEX2 INDICATE CANCEL @V305065 01826000
OI ERRSW,NOCARD NO CARD TO PRINT @V305065 01827000
OI DOSFLAGS,DOSSVC INDICATE DOS SVC @V305065 01828000
MVI ERCODE,ER028 SET ERROR CODE @V305065 01829000
B ERROR @V305065 01830000
RESAVE DS F @V305065 01831000
EJECT 1 01832000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01833000
* 01834000
* R14 S/R TO EXECUTE I/O 01835000
* 01836000
* R1 SET BEFORE ENTRY TO ADDRESS WANTED CCB 01837000
* 01838000
* DISK I/O OPERATIONS LAID OUT BELOW 01839000
* 01840000
DISKRDWR EQU * @V305065 01841000
LA RB,DKSEEK LOAD CCW ADDRESS @V305065 01842000
DISKIO LR 2,RB SAVE FOR DIAGNOSE @V305096 01843000
DC X'83120018' DIAGNOSE CODE @V305065 01844000
BCR 8,RE RETURN IF NO ERRORS @V305065 01845000
BC 6,ERR094 @V305065 01846000
TM CSW+4,X'01' END OF FILE? @V305065 01847000
BO ERR097 BRANCH IF YES @V305065 01848000
ERR094 L RB,AMSG94 INVALID NRF @V305096 01849000
B ABTERR @V305096 01850000
ERR097 L RB,AMSG97 EOF RECORD FOUND @V305096 01851000
B ABTERR @V305096 01852000
DSKCCB DC H'0' @V305096 01853000
* 01854000
*** CCW-S NECESSARY TO ACCOMPLISH REQUEST 01855000
* 01856000
DKSEEK CCW X'07',SEEKIT,X'60',6 SEEK @V305096 01857000
DKSRCH CCW HEX31,ADRESS,HEX60,DEC5 SEARCH @V305096 01858000
DKSTIC CCW HEX8,DKSRCH,HEX20,DEC1 TIC @V305096 01859000
DSKWHT CCW 0,0,0,0 MODIFY AS REQUIRED @V305096 01860000
* 01861000
SEEKIT DC XL2'0' BB @V305096 01862000
ADRESS DC XL5'0' CCHHR--SUPPLIED BY REQUESTOR@V305096 01863000
EJECT 1 01864000
************************************************************ 01865000
* 01866000
* CMS ROUTINE TO PRINT DISK READ ERROR 01867000
* 01868000
************************************************************ 01869000
DS 0H @V305065 01870000
RDDSKERR EQU * @V305065 01871000
L RE,REETEXT POINT TO ERROR MESSAGE @V305065 01872000
LA R4,104 SET ERROR MESSAGE @V305065 01873000
B WRERR GO PRINT ERROR @V305065 01874000
EJECT 01875000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01876000
* 01877000
* R14 S/R TO EXTRACT PHASE # FROM SD/PC/LD/LR ENTRIES 01878000
* 01879000
* R1 - USED TO RETAIN C/D ADDRESS & RESTORE ON EXIT 01880000
* R2 - RETURNS PHASE # 01881000
* R9 - ASSUMED TO CONTAIN C/D ADDRESS OF ENTRY 01882000
* RF - IMBEDDED S/R CALL GIVEN IF C/D ENTRY LD/LR 01883000
* 01884000
XTPHNO LR R1,R9 SAVE R9 @V305096 01885000
CLI ESDTYPD,SD IF SD/PC PHASE # CAN BE@V305096 01886000
BE XTPHGT EXTRACTED IMMEDIATELY @V305096 01887000
CLI ESDTYPD,PC @V305096 01888000
BE XTPHGT ... @V305096 01889000
* 01890000
LH R9,CSNUMD FIND SD FOR THIS LD/LR @V305096 01891000
LA RF,* BYPASS MULTI-RETURN @V305096 01892000
B LTCDAD @V305096 01893000
* 01894000
XTPHGT EQU * EXTRACT PHASE NO @V305096 01895000
LH R2,PHNUMD THIS SD BELONGS TO @V305096 01896000
LR R9,R1 RESTORE R9 @V305096 01897000
BR RE RETURN TO REQUESTEE @V305096 01898000
EJECT 01899000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01900000
* 01901000
*** ROUTINE TO HANDLE ABORT ERROR CONDITIONS 01902000
* 01903000
* RB - BYTE 0 - LENGTH OF ERROR MESSAGE 01904000
* BYTES 1, 2, 3 - ADDRESS OF MESSAGE 01905000
* 01906000
ABTERR L RD,RLDMTX GO TO RLD PROC @V305096 01907000
BR RD TO PROC ABORT ERROR @V305096 01908000
EJECT 01909000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01910000
* 01911000
* R14 S/R TO CHECK THAT C/D HAS NOT OVERFLOWED 01912000
* 01913000
CDSIZE TM CTLDNO+DEC2,HEX80 C/D NO MAY NOT @V305096 01914000
BO ERR044 EXCEED 32K @V305096 01915000
C R9,TENK CHECK IF C/D OVERFL @V305096 01916000
BNHR RE NO, RETURN @V305096 01917000
* YES, ERROR 01918000
* 01919000
ERR044 L RB,AMSG44 C/D OVERFLOW @V305096 01920000
B ERROR @V305096 01921000
EJECT 01922000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01923000
* 01924000
* ROUTINE TO READ INPUT STREAM 01925000
* 01926000
ALNKOF OI ALNKSW,X'01' SET SWITCH FOR NOAUTO @V305096 01927000
MVC ONS000,CTLSVE RESTORE ADDR OF CONTROL CARD@V305096 01928000
TM PERISW,HEX4 SYSRLB INPUT @V305096 01929000
BZ RESINP NO @V305096 01930000
NI PVLBSW+1,X'00' SET SW FOR PRIV RELO. INPUT @V305096 01931000
B RDALSW @V305096 01932000
RESINP OI PVLBSW+1,X'F0' SET SW FOR SYSRES RELO INPUT@V305096 01933000
TM PERISW,HEX1 READING DOSLNK? @V305065 01934000
BZ RDALSW BRANCH IF NOT @V305065 01935000
ICM RF,DEC3,ONS000 GET RECORD NUMBER @V305065 01936000
BCTR RF,0 DECREMENT ONE @V305065 01937000
STH RF,DOSLNK+26 AND SAVE IT @V305065 01938000
* 01939000
RDALSW NOP ALNKPR SW SET WHEN AUTOLINK IN PROGRESS @V305096 01940000
RDNEXT LH R1,RESADDR SET UP CCB FOR SYSRES INPUT@V305096 01941000
* 01942000
PVLBSW B RELBSW BR IF NO PRIVATE LIBRARY@V305096 01943000
LH R1,PRVADDR @V305096 01944000
RELBSW NOP RDUNIT SW SET WHEN RELOC LIBRARY INPUT @V305096 01945000
* 01946000
CLI RDS00A+1,X'F0' READTXT SWITCH SET? @V305065 01947000
BE RDUNIT BRANCH IF YES @V305065 01948000
TM RDS000+1,X'F0' DUMMY PHASE SWITCH? @V305065 01949000
BNZ RDUNIT1 BRANCH IF YES @V305065 01950000
TM CMSSWT1,NODOSLNK WAS DOSLNK FOUND? @V305065 01951000
BO RDEND BRANCH IF NOT @V305065 01952000
USING FSCBD,R1 @V305065 01953000
LA R1,DOSLNK POINT TO PLIST @V305065 01954000
LH RF,FSCBITNO GET CURRENT RECORD NUMBER @V305065 01955000
LA RF,1(,RF) ADD ONE @V305065 01956000
FSREAD ,FSCB=(1),RECNO=(15),ERROR=RDLNKERR @V305065 01957000
LA RA,INPBLK POINT TO INPUT BUFFER @V305065 01958000
RDDONE EQU * @V305065 01959000
MVC ADRESS(2),FSCBITNO MOVE IN RECORD NUMBER @V305065 01960000
DROP R1 @V305065 01961000
MVC RDCB00,KMIN REMOVE UNIT ADDRESS @V305065 01962000
B RDEXEC @V305065 01963000
* 01964000
RDUNIT STH R1,RDCB00 STORE CCB LOGICAL UNIT ADDR @V305096 01965000
BAL RF,RDS000 GO TO READ INPUT @V305096 01966000
RDUNIT1 EQU * @V305065 01967000
NI RDS000+1,X'0F' CANCEL DUMMY PHASE SWITCH @V305096 01968000
* 01969000
*** DIAGNOSE TYPE OF CARD READ 01970000
* 01971000
RDEXEC LA R1,IPTMTX TABLE OF TRANSFER ADDRESS @V305096 01972000
* 01973000
DMPHSW MVC COMNRF,ADRESS SWITCH - ADDRESS OF ESD FOR @V305096 01974000
* INPUT CONTROL 01975000
CLI E1,X'02' CHECK FOR CONTROL CARD @V305096 01976000
BNE CTLSKP SEE IF CONTROL CARDS SKIPPED@V305096 01977000
* 01978000
* 01979000
LA R1,4(R1) TRY FOR ESD CARD @V305096 01980000
CLC E1(4),KESD @V305096 01981000
BE EXLOAD @V305096 01982000
CHKSYM CLC E1(4),KSYM PROC SYM CARD IN ESD PROC'SR@V305096 01983000
BE EXLOAD @V305096 01984000
* 01985000
LA R1,4(R1) MUST BE OTHER INPUT TYPES @V305096 01986000
* 01987000
EXLOAD EQU * @V305096 01988000
C RD,OTHMTX CHECK TO SEE IF @V305096 01989000
* RLD-S WERE PROCESSED 01990000
BNE LOADBASE @V305096 01991000
LH R0,RLDOPT-DLKOTH+10(RD) IF NO RLD-S IN PREV MOD@V305096 01992000
LTR R0,R0 DO NOT WRITE OUT THE BUFFER @V305096 01993000
BZ LOADBASE @V305096 01994000
ST R1,OVRXFR SAVE REGISTER ONE @V305096 01995000
BAL RF,WRS001-DLKOTH(RD) WRITE OUT RLD BUFFER @V305096 01996000
L R1,OVRXFR RESTORE REGISTER ONE @V305096 01997000
* 01998000
LOADBASE L RD,0(R1) @V305096 01999000
ALNKSW2 NOP INCGET-DLKSCN(RD) SW TURNED ON BY AUTOLINK@V305096 02000000
* PROCESSOR, TO ENTER INCLUDE 02001000
* ROUTINE DIRECTLY 02002000
BR RD @V305096 02003000
* 02004000
CTLSKP TM MODSTS,X'02' IF IN SUBMOD, SHOULD SKIP CONTROL@V305096 02005000
BZ EXLOAD CARDS @V305096 02006000
* 02007000
LR R1,RA SAVESAVE CONTENTS OF REG 10 @V305096 02008000
* 02009000
FNDENT LA RA,1(RA) UPDATE TO NEXT CHARACTER @V305096 02010000
CLI 0(RA),C' ' IF CHARACTER IS NON-BLANK, @V305096 02011000
BE FNDENT TEST FOR AN ENTRY CARD @V305096 02012000
* 02013000
CLC 0(6,RA),KNTRY+1 IS IT ENTRY @V305096 02014000
BNE INOBJDK NO, THEN SEE IF ALLRITE TO BYPASS@V305096 02015000
* 02016000
LR RA,R1 RESTORE SAVED REGISTER @V305096 02017000
NI MODSTS,255-X'02' END SUB-MOD WHEN ENTRY REACHED@V305096 02018000
B RDEXEC FETCH CONTROL CARD PROCESSER@V305096 02019000
SPACE 2 02020000
INOBJDK TM MODSTS,X'01' IF MODULE STATUS SW IS SET, @V305096 02021000
L RB,AMSG16 CTL CARD WITHIN @V305096 02022000
BO ERROR A MODULE. GO DIAGNOSE IT. @V305096 02023000
B RDNEXT IF NOT, CTL CD--SO SKIP IT @V305096 02024000
* 02025000
RDEND EQU * @V305065 02026000
LA RF,12 INDICATE END @V305065 02027000
RDLNKERR EQU * @V305065 02028000
CH RF,K12 END OF FILE? @V305065 02029000
BNE RDDSKERR BRANCH IF NOT @V305065 02030000
BAL RB,CMSTXTND SET UP RECORD @V305065 02031000
B RDDONE @V305065 02032000
EJECT 02033000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 02034000
* 02035000
*** AUTOLINK PROCESSOR 02036000
* 02037000
ALNKPR L R9,CDENT1 INITIALISE SCAN OF C/D @V305096 02038000
NI ENDERR+1,X'0' @V305096 02039000
MVI PHVERB,C'*' NAME OF CALLING VERB SET UP @V305096 02040000
NI RDALSW+1,X'0F' RESET SW IN PERM RDNEXT @V305096 02041000
SR R6,R6 RESET REG ADDR'NG EXTRN @V305096 02042000
* 02043000
ALNKSC CL R9,CTLDAD IF END OF C/D GO CHECK IF IS @V305096 02044000
BNL ALNKCD NECESSARY TO AUTOLINK @V305096 02045000
LA R9,CDLNGTH(R9) @V305096 02046000
CLI ESDTYPD,ER IF NOT ER CONT SCAN @V305096 02047000
BNE ALNKSC NO. @V305096 02048000
* 02049000
TM SWITCHD,NOAUTOL IF ER KNOWN NOT TO BE @V305096 02050000
BO ALNKSC IN LIBRARY,BYPASS IT @V305096 02051000
* 02052000
LTR R6,R6 ON 1ST ER, FORCE ITS ADDR INTO@V305096 02053000
BNE *+6 SEARCH REGISTER @V305096 02054000
ALNKVL LR R6,R9 @V305096 02055000
* 02056000
CLC NAMED,0(R6) IF THIS ER LOWER @V305096 02057000
* THAN THAT ACCEPTED 02058000
BL ALNKVL PREV'LY USE IT INSTEAD, ELSE @V305096 02059000
B ALNKSC CONTINUE SCAN FOR LOWER @V305096 02060000
* 02061000
ALNKCD LTR R9,R6 IF NO ER-S TO BE SEARCHED ON, @V305096 02062000
BZ ALNKOF AUTOLINK IS OVER @V305096 02063000
* 02064000
OI SWITCHD,NOAUTOL SET ER TO @V305096 02065000
* PROCESSED CONDITION 02066000
OI RDALSW+1,X'F0' SET REQD SWTCHS IN RDNEXT & @V305096 02067000
FRSTSW NOP ALNKGT1 @V305096 02068000
MVI FRSTSW+1,X'F0' SET SW TO BYPASS IF 2ND TIME THRU@V305096 02069000
CLC RDCB00,PRVADDR WAS READ FROM SYSRLB @V305096 02070000
BNE ALNKGT1 @V305096 02071000
OI PERISW,HEX4 FROM SYSRLB @V305096 02072000
ALNKGT1 OI NMSBSW,HEX40 SET FOR AUTOLINKED MODULE @V305096 02073000
LA R1,IPTMTX GET INTO DLKSCN @V305096 02074000
OI ALNKSW2+DEC1,HEXF0 AT ENTRYPOINT INCGET @V305096 02075000
B EXLOAD VIA EXLOAD SUBROUTINE @V305096 02076000
* 02077000
ALNKGT LA R1,CTLMTX GET INTO CTL CD PROCESSOR @V305096 02078000
B EXLOAD @V305096 02079000
EJECT 02080000
************************************************************** 02081000
* CLEAR LINKAGE TABLE TO BINARY ZERO'S 02082000
************************************************************** 02083000
MAINFLOW EQU * @V305096 02084000
L R2,LNKTAD GET PTR TO STRT OF L/T @V305096 02085000
LH R3,LTABLTH GET LNGTH OF L/T @V305096 02086000
LA R3,40(,R3) ALSO C/D START @V305065 02087000
XR R5,R5 CLEAR REG @V305096 02088000
MVCL R2,R4 SET L/T TO BINARY ZERO @V305096 02089000
TM MAPSW,CLEARSW WAS CLEAR REQUESTED? @V305065 02090000
BZ ACTERR BRANCH IF NOT @V305065 02091000
L R2,AWKARE POINT TO BUFFER @V305065 02092000
LH R3,K1024 LENGTH OF BUFFER @V305065 02093000
MVCL R2,R4 CLEAR TO ZERO @V305065 02094000
******************************************************************** 02095000
* GO PROCESS FIRST NON-ACTION STATEMENT 02096000
* IF AN ERROR WAS FOUND ON AN ACTION CARD, THE BRANCH IN- 02097000
* STRUCTION IS CHANGED TO A NOP. THAT RESULTS IN THE ERR BEING 02098000
* PROCESSED BY FALLING THROUGH TO THE ERROR ROUTINE. 02099000
******************************************************************** 02100000
ACTERR B RDEXEC ENTER NORMAL FLOW @V305096 02101000
B ERROR GO TO ERROR ROUTINE @V305096 02102000
SPACE 5 02103000
************************************************************** 02104000
* 02105000
* CANCEL ROUTINE 02106000
* 02107000
CANCL EQU * @V305065 02108000
LA R1,FDEFCLR POINT TO FILEDEF PLIST @VM03220 02109000
SVC 202 AND CLEAR DSLIB CMSCB. @VM03220 02110000
DC AL4(*+4) ... @VM03220 02111000
TM CMSSWT1,NODOSLIB WAS DOSLIB SPECIFIED? @V305065 02112000
BO CANCLA BRANCH IF NOT @V305065 02113000
NI DOSFLAGS,255-DOSSVC TURN OFF DOS SVC INDIC. @V305065 02114000
CLOSE (DOSLIB) CLOSE LIBRARY @V305065 02115000
OI DOSFLAGS,DOSSVC INDICATE DOS SVC @V305065 02116000
CANCLA EQU * @V305065 02117000
FSCLOSE ,FSCB=DOSMAP CLOSE MAP FILE @V305065 02118000
FSERASE ,FSCB=SYSUT1 @V305065 02119000
FSERASE ,FSCB=SYSUT2 @V305065 02120000
CANCLB EQU * @V305065 02121000
COMRG @V305065 02122000
USING BGCOM,R1 @V305065 02123000
MVC COMNAME,=CL8'CMS/DOS' RESET NAME @V305065 02124000
DROP R1 @V305065 02125000
DMSKEY RESET RESET KEYS @V305065 02126000
TM CMSSWT1,MAPPRT WAS PRINT SPECIFIED? @V305065 02127000
BZ CANCLC BRANCH IF NOT @V305065 02128000
LA R1,CLSPLST POINT TO PLIST @V305065 02129000
SVC 202 ISSUE CP CLOSE COMMAND @V305065 02130000
DC AL4(CANCLC) @V305065 02131000
CANCLC EQU * @V305065 02132000
TM CMSSWT1,NODOSLIB WAS DOSLIB PRESENT? @V305065 02133000
BZ CANCL1 BRANCH IF NOT @V305065 02134000
MVC DOSFIAC,=CL8'ERASE' INDICATE ERASE @V305065 02135000
LA R1,DOSFIAC POINT TO PLIST @V305065 02136000
SVC 202 @V305065 02137000
CANCL1 EQU * @V305065 02138000
SR RF,RF CLEAR REGISTER @V305065 02139000
IC RF,ERCODE GET ERROR CODE @V305065 02140000
L RE,REGSAVE GET RETURN REGISTER @V305065 02141000
BR RE AND RETURN TO CMS @V305065 02142000
EJECT 02143000
************************************************************** 02144000
* 02145000
* ERROR ROUTINE 02146000
* 02147000
* ROUTINE INDICATES IN MAPSW THAT AN ERROR HAS OCCURRED. 02148000
* IF MAP IS REQUESTED IT PRINTS MESSAGE AND (IF REQUIRED) 02149000
* STATEMENT IN ERROR ON SYSLST. 02150000
* FOR ACTION NOMAP IT PRINTS ERROR MESSAGE AND ( IF 02151000
* REQUIRED) STATEMENT IN ERROR ON SYSLOG. 02152000
* SUBROUTINES USED - PRINT, LOGMSG 02153000
* 02154000
* INPUT - RB - BYTE 0 - LENGTH OF MESSAGE MIN 1 02155000
* BYTES 1, 2, 3 - ADDR OF ERROR MESSAGE 02156000
* 02157000
* PRINT ERROR MESSAGE 02158000
* 02159000
ERROR OI MAPSW,ERR INDICATE ERROR @V305096 02160000
CLI ERCODE,X'00' IS THERE AN ERROR CODE? @V305065 02161000
BNE ERRSET BRANCH IF YES @V305065 02162000
MVI ERCODE,DEC4 SET ERROR CODE @V305065 02163000
ERRSET EQU * @V305065 02164000
LR R6,RB @V305096 02165000
LA R6,0(R6) R6 - ADDRESS OF MESSAGE @V305096 02166000
SRL RB,24 RB - LENGTH OF MESSAGE @V305096 02167000
* MIN ONE 02168000
EX RB,MOVE MOVE MESSAGE TO @V305096 02169000
* OUTPUT AREA W0 02170000
LA RB,1(,RB) RESTORE LENGTH @V305065 02171000
BAL R6,LOGMSG GO TYPE MESSAGE @V305065 02172000
TM MAPSW,MAPOP MAP REQUESTED @V305096 02173000
BZ ERROR10 NO, CHECK FOR STMT @V305096 02174000
TM CMSSWT1,MAPTYP WAS TERM SPECIFIED? @V305065 02175000
BO ERROR10 BRANCH IF YES, DONE @V305065 02176000
BAL R6,SPACE1 YES, SPACE1 AND @V305096 02177000
BAL R6,PRINT PRINT MESSAGE ON @V305096 02178000
B ERROR20 @V305065 02179000
* 02180000
ERROR10 EQU * @V305065 02181000
BAL R6,PRTCLEAR CLEAR INPUT LINE @V305065 02182000
ERROR20 TM ERRSW,NOCARD STATEMENT IN ERROR @V305096 02183000
* TO BE PRINTED 02184000
BO ERROR40 NO, BRANCH @V305096 02185000
* 02186000
* PRINT STATEMENT IN ERROR 02187000
* 02188000
CLI E1,HEX2 12-2-9 IN COLUMN 1 @V305096 02189000
BE NOTCTL YES, GO TO FORMAT @V305096 02190000
* CARD 02191000
MVC W8(CARDLNG),E1 NO, MOVE CARD TO OUTPUT @V305096 02192000
* AREA 02193000
* 02194000
PRERR EQU * @V305065 02195000
LA RB,CARDLNG+DEC7 SET LENGTH @V305065 02196000
BAL R6,LOGMSG TYPE STATEMENT @V305065 02197000
TM MAPSW,MAPOP PRINT ON SYSLST IF @V305096 02198000
BZ ERROR30 MAP IS REQUESTED @V305096 02199000
TM CMSSWT1,MAPTYP WAS TERM SPECIFIED? @V305065 02200000
BO ERROR30 BRANCH IF YES, DONE @V305065 02201000
BAL R6,PRINT REQUESTED @V305096 02202000
BAL R6,SPACE1 SPACE1 @V305096 02203000
B ERROR40 @V305065 02204000
* 02205000
ERROR30 EQU * @V305065 02206000
BAL R6,PRTCLEAR CLEAR INPUT LINE @V305065 02207000
ERROR40 EQU * @V305065 02208000
MVI ERRSW,HEX0 NO, RESET SWITCH @V305096 02209000
TM MAPSW,HEX2 IS THIS CANCEL? @V305065 02210000
BO CANCL BRANCH IF YES @V305065 02211000
ENDERR NOP ALNKPR @V305096 02212000
B RDNEXT AND GO TO ALNKPR @V305096 02213000
* OR RDNEXT 02214000
ERRSW DC X'00' CONTROL SWITCH @V305096 02215000
* X'00' BRANCH TO RDNEXT OR ALNKPR 02216000
* AND PRINT STATEMENT IN ERROR 02217000
NOCARD EQU X'02' NO STATEMENT IN ERROR TO BE PRINTED @V305096 02218000
* 02219000
MOVE MVC W1(0),0(R6) MOVE INSTR USED FOR @V305096 02220000
* EXECUTE INSTR 02221000
ERR EQU X'80' @V305096 02222000
EJECT 02223000
************************************************************** 02224000
* 02225000
*** CONVERT 12-2-9 CARD TO READABLE FORMAT 02226000
* 02227000
NOTCTL MVC W8(8),E1+72 IDENTIFICATION @V305096 02228000
MVC W17(3),E2 @V305096 02229000
* 02230000
UNPK W21(7),E6(4) ASSEMBLED ORIGIN @V305096 02231000
TR W21(6),TRTABL-240 @V305096 02232000
MVI W27,C' ' @V305096 02233000
* 02234000
UNPK W28(5),E11(3) NO OF BYTES/CARD @V305096 02235000
TR W28(4),TRTABL-240 @V305096 02236000
MVI W32,C' ' @V305096 02237000
* 02238000
UNPK W33(5),E15(3) ESID # @V305096 02239000
TR W33(4),TRTABL-240 @V305096 02240000
MVI W37,C' ' @V305096 02241000
* 02242000
LA R2,E17 ADDR OF VARIABLE INFO @V305096 02243000
LA R1,W38 REST OF CARD STARTS PRINTING HERE@V305096 02244000
LA R0,3 COUNT OF ESD/LINE @V305096 02245000
* 02246000
CLC E1(4),KESD IF ESD CARD, PRINT IN DIFFERENT @V305096 02247000
BE TISESD FORMAT @V305096 02248000
* 02249000
*** CONVERT EACH WORD TO HEX 02250000
* 02251000
LA R0,9 CAN PRINT 36 BYTES @V305096 02252000
* 02253000
NTESLP UNPK 0(9,R1),0(5,R2) CONVERT FULL WORD @V305096 02254000
TR 0(8,R1),TRTABL-240 @V305096 02255000
MVI 8(R1),C' ' @V305096 02256000
LA R1,9(R1) ADDRESS TO PRINT NEXT WORD @V305096 02257000
LA R2,4(R2) MODIFY ADDRESS OF FULL WORD @V305096 02258000
BCT R0,NTESLP @V305096 02259000
LA RB,118 SET LENGTH FOR LOGMSG @V305096 02260000
* 02261000
NDESLP MVI 0(R1),C' ' BLANK LAST POSITION CONVERTED@V305096 02262000
B PRERR @V305096 02263000
* 02264000
*** FORMAT ESD 02265000
* 02266000
TISESD MVC 0(8,R1),0(R2) LABEL @V305096 02267000
MVC 9(1,R1),8(R2) TYPE @V305096 02268000
OI 9(R1),X'F0' @V305096 02269000
* 02270000
UNPK 11(7,R1),9(4,R2) CONVERT ASSEMBLED ORIGIN @V305096 02271000
TR 11(6,R1),TRTABL-240 @V305096 02272000
MVI 17(R1),C' ' @V305096 02273000
* 02274000
UNPK 18(7,R1),13(4,R2) CONVERT C/S LENGTH @V305096 02275000
TR 18(6,R1),TRTABL-240 @V305096 02276000
MVI 24(R1),C' ' @V305096 02277000
* 02278000
LA R1,25(R1) ADDRESS TO PRINT NEXT ITME @V305096 02279000
LA R2,16(R2) MODIFY ADDRESS OF NEXT ITEM @V305096 02280000
BCT R0,TISESD @V305096 02281000
LA RB,112 SET LENGTH FOR LOGMSG @V305096 02282000
B NDESLP ALL PRINTED @V305096 02283000
* 02284000
*** CONSTANTS REQUIRED 02285000
* 02286000
*** TRANSLATE TABLE FOR BINARY-HEX CONVERSION 02287000
* 02288000
TRTABL DC C'0123456789ABCDEF' @V305096 02289000
* 02290000
KNTRY DC C' ENTRY ' @V305096 02291000
DS 0H ALIGNMENT @V305096 02292000
LTORG , @V305096 02293000
EJECT 02294000
* 02295000
** TABLE TO PROVIDE ADDRESSABILITY FOR MESSAGES 02296000
* 02297000
DS 0F @V305096 02298000
AMSGTAB EQU * @V305096 02299000
AMSG02 DC YL1(L'MSG02-DEC1) LENGTH OF MESSAGE MIN 1 @V305096 02300000
DC AL3(MSG02) ADDRESS OF ERROR MESSAGE@V305096 02301000
AMSG16 DC YL1(L'MSG16-DEC1) LENGTH OF MESSAGE MIN 1 @V305096 02302000
DC AL3(MSG16) ADDRESS OF ERROR MESSAGE@V305096 02303000
AMSG44 DC YL1(L'MSG44-DEC1) LENGTH OF MESSAGE MIN 1 @V305096 02304000
DC AL3(MSG44) ADDRESS OF ERROR MESSAGE@V305096 02305000
AMSG50 DC YL1(L'MSG50-DEC1) LENGTH OF MESSAGE MIN 1 @V305096 02306000
DC AL3(MSG50) ADDRESS OF ERROR MESSAGE@V305096 02307000
AMSG70 DC YL1(L'MSG70-DEC1) LENGTH OF MESSAGE MIN 1 @V305096 02308000
DC AL3(MSG70) ADDRESS OF ERROR MESSAGE@V305096 02309000
AMSG94 DC YL1(L'MSG94-DEC1) LENGTH OF MESSAGE MIN 1 @V305096 02310000
DC AL3(MSG94) ADDRESS OF ERROR MESSAGE@V305096 02311000
AMSG97 DC YL1(L'MSG97-DEC1) LENGTH OF MESSAGE MIN 1 @V305096 02312000
DC AL3(MSG97) ADDRESS OF ERROR MESSAGE@V305096 02313000
REETEXT DC AL4(MSGRDER) ADDRESS OF ERROR MESSAGE @V305065 02314000
WRETEXT DC AL4(MSGWRER) ADDRESS OF ERROR MESSAGE @V305065 02315000
AMSGCNT EQU (*-AMSGTAB)/4 NUMBER OF ENTRIES @V305096 02316000
EJECT 1 02317000
************************************************************ 02318000
* 02319000
* INPUT I/O AREA 02320000
* 02321000
************************************************************ 02322000
* 02323000
* WARNING WARNING WARNING WARNING WARNING WARNING WARNING 02324000
* 02325000
* IF THE LABEL 'PREFIX' COMPILES BEYOND X'FE6', ADDRESSABILITY 02326000
* ERRORS ARE PROBABLE 02327000
* 02328000
CNOP 2,4 @V305065 02329000
PREFIX DS 2C @V305065 02330000
INPBLK DS 80C ONE RECORD(80) FROM DOSLNK OR@V305065 02331000
DS 80C ONE RELOC DICT BLK(320) CMS @V305096 02332000
DS 80C @V305065 02333000
DS 80C @V305065 02334000
EJECT 1 02335000
************************************************************** 02336000
* 02337000
* ERROR MESSAGES 02338000
* 02339000
MSG00 DC C'2100I INVALID INPUT CARD TYPE' @V305096 02340000
MSG01 DC C'2101I INVALID OPERATION IN CONTROL STATEMENT' @V305096 02341000
MSG02 DC C'2102I INVALID DECIMAL OR HEXADECIMAL FIELD' @V305096 02342000
MSG10 DC C'2110I INVALID OR MISSING DELIMITER' @V305096 02343000
MSG11 DC C'2111I LENGTH OF A OPERAND GREATER THAN EIGHT' @V305096 02344000
MSG12 DC C'2112I OPERAND FIELD MISSING' @V305096 02345000
MSG13 DC C'2113I STATEMENT EXTENDS BEYOND LIMIT' @V305096 02346000
MSG14 DC C'2114I SUBMODULAR NAMELIST TOO LONG' @V305096 02347000
MSG16 DC C'2116I CONTROL STATEMENT IN OBJECT MODULE' @V305096 02348000
MSG20 DC C'2120I DUPLICATE PHASE NAME' @V305096 02349000
MSG21 DC C'2121I PHASE NAME INVALID' @V305096 02350000
MSG22 DC C'2122I ORIGIN IN PHASE CARD NOT PREVIOUSLY DEFINED' *02351000
02352000
MSG23 DC C'2123I PREVIOUS PHASE WITHOUT VALID STORAGE ASSIGNMENT'*02353000
02354000
MSG24 DC C'2124I PHASE ORIGIN NEGATIVE' @V305096 02355000
MSG25 DC C'2125I PHASE STATEMENT IN AUTOLINKED MODULE' @V305096 02356000
MSG31 DC C'2131I MODULE NOT FOUND' @V305096 02357000
MSG32 DC C'2132I MORE THAN 5 LEVELS OF NESTED INCLUDES' @V305096 02358000
MSG33 DC C'2133I NESTED SUBMODULAR INCLUDE' @V305096 02359000
MSG35 DC C'2135I INVALID OPERAND IN ACTION STATEMENT' @V305096 02360000
MSG40 DC C'2140I INVALID ESD TYPE' @V305096 02361000
MSG41 DC C'2141I DUPLICATE ESID NUMBER' @V305096 02362000
MSG42 DC C'2142I ENTRY POINT NOT IN CSECT OR COMMON' @V305096 02363000
MSG43 DC C'2143I DUPLICATE ENTRY POINT LABEL' @V305096 02364000
MSG44 DC C'2144I INVALID ESID NUMBER OR CONTROL DICTIONARY OR LIN*02365000
KAGE TABLE OVERFLOW' @V305096 02366000
MSG45 DC C'2145I CSECT ORIGIN NOT ON DOUBLEWORD BOUNDARY' *02367000
02368000
MSG46 DC C'2146I COMMON HAS SAME LABEL AS ENTRY POINT' @V305096 02369000
MSG47 DC C'2147I ENTRY POINT LABEL NOT IN DEFINED CSECT' @V305096 02370000
MSG50 DC C'2150I ASSEMBLED ORIGIN LOWER THAN START OF CSECT' *02371000
02372000
MSG51 DC C'2151I INVALID DELIMITER' @V305096 02373000
MSG55 DC C'2155I ESID NUMBER DOES NOT POINT TO CSECT' @V305096 02374000
MSG56 DC C'2156I INVALID FORMAT OF RLD CARD' @V305096 02375000
MSG58 DC C'2158I NO CSECT LENGTH SUPPLIED' @V305096 02376000
MSG61 DC C'2161I INVALID OPTION OPERAND IN PHASE STATEMENT' *02377000
02378000
MSG70 DC C'2170I ESID NUMBER NOT PREVIOUSLY PROCESSED' @V305096 02379000
MSG81 DC C'2181I NO VALID STORAGE ASSIGNMENT IN FINAL PHASE' *02380000
02381000
MSG82 DC C'2182I NO END CARD BEFORE ENTRY STATEMENT' @V305096 02382000
MSG94 DC C'2194I INVALID NO RECORD FOUND CONDITION' @V305096 02383000
MSG97 DC C'2197I END OF FILE RECORD FOUND' @V305096 02384000
MSG99 DC C'2199I ERROR HAS OCCURRED DURING LINKAGE EDITING' *02385000
02386000
* 02387000
MSGRDER DC AL1(L'MSGRD) @VA15210 02388000
MSGRD DC C'ERROR ''..'' READING FILE ''....................'' ON X02388500
DISK' @V305065 02389000
MSGWRER DC AL1(L'MSGWR) @VA15210 02390000
MSGWR DC C'ERROR ''..'' WRITING FILE ''....................'' ON X02390500
DISK' @V305065 02391000
TITLE 'DLKESD LINKAGE EDITOR PROCESS ESD''S - $LNKEDT - DOS' 02392000
*************************************************************** 02393000
* 02394000
* CSECT DLKESD - ESD PROCESSOR * 02395000
* * 02396000
*ENTRY POINTS - DLKESD - PROCESSES SD, LD, ER, PC, AND CM ITEMS * 02397000
* UPDATES CONTROL DICTIONARY * 02398000
* * 02399000
*INPUT - FROM RDNEXT IN DMSDLK 02400000
* * 02401000
*OUTPUT - N/A * 02402000
* * 02403000
*EXTERNAL ROUTINES - SEE LIST OF SUBROUTINES IN DMSDLK 02404000
* * 02405000
*EXITS-NORMAL -- TO RDNEXT IN DMSDLK TO READ NEXT CARD * 02406000
* -ERROR - ERROR MSG NOS. RESULTING FROM THIS CSECT ARE 2140 - * 02407000
* 2141-2142-2143-2145-2146 * 02408000
* * 02409000
*TABLES/WORK AREAS - EXPLAINED IN COMMENTS OF CSECT DMSDLK 02410000
* * 02411000
*ATTRIBUTES - N/A * 02412000
* * 02413000
*********************************************************************** 02414000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 02415000
* 02416000
* ESD PROCESSOR 02417000
* 02418000
DLKESD CSECT ESD PROCESSOR @V305096 02419000
USING *,RD @V305096 02420000
* 02421000
CLI PHSNO,X'FF' CREATE A DUMMY PHASE CARD, IF NO @V305096 02422000
BNE ESD1ST PHASE CARD PROCESSED UP TO NOW @V305096 02423000
* 02424000
MVC DMPHSW+2(2),DMPHSW+4 FORCE TRUE ESD ADDR RETAINE@V305096 02425000
* WHEN DUMMY PHASE CARD PROCESSED NO 02426000
* ACTUAL READING IS DONE OF THE ESD 02427000
* RECORD WHICH IS CURRENTLY IN CORE, 02428000
* SO IT IS NECESSARY TO CANCEL THE 02429000
* INSTRUCTION THAT SETS UP ESD ADRESS 02430000
* IN RDNEXT SO THAT CURRENT ESD ADRESS 02431000
* CAN BE RETAINED FOR CONTROL 02432000
OI RDS000+1,X'F0' SET TO IGNORE NEXT READ @V305096 02433000
MVC PHVERB(18),DUMYPH MOVE IN VERB,PHASE NAME,ORIGIN@V305096 02434000
MVC PHVERB+8(8),DOSLNK+8 MOVE IN DEFAULT NAME @V305065 02435000
MVC SYMBOL+2(13),SYMBOL+1 CLR SYMBL & QUALIF FIELDS @V305096 02436000
MVC SYMBOL(2),KS INDICATE S OPTION @V305065 02437000
XC DISPLC(4),DISPLC RESET DISPLACEMENT TO ZERO @V305096 02438000
NI POPTSW,X'0F' RESET OPTION SW @V305096 02439000
LA R1,IPTMTX NOW PROCESS AS ANY NORMAL @V305096 02440000
B EXLOAD PH ASE CARD @V305096 02441000
* 02442000
ESD1ST EQU * @V305096 02443000
TM MODSTS,HEX1 CHECK IF ALREADY @V305096 02444000
BO ESDNXT STARTED THE MODULE @V305096 02445000
* 02446000
OI MODSTS,X'01' SET MODULE STATUS SWITCH ON @V305096 02447000
MVC DMPHSW+2(2),*+10 RESET ESD INPUT ADDR SWITCH @V305096 02448000
MVC ESDN00,COMNRF SAVE ADDR OF 1ST ESD RECORD @V305096 02449000
TM PERISW,HEX1 IF ON DOSLNK SAVE ADDR OF 1ST@V305096 02450000
BZ ESDNXT @V305096 02451000
MVC ESD000,COMNRF ESD RECORD IN RESERVED BUCKET@V305096 02452000
* 02453000
CLC COMNRF(2),NDS000 IF ESD FOLLOWS AFTER END @V305096 02454000
BNE ESDNXT THEN THE NE_ ESD ADDR MUST BE@V305096 02455000
MVC PERIDA,COMNRF @V305096 02456000
* 02457000
ESDNXT EX 0,CHKSYM BYPASS ALL SYM CARDS @V305096 02458000
BE RDNEXT @V305096 02459000
* 02460000
LA R6,E1 INIT SCAN OF NEW CARD AT E17-16 @V305096 02461000
LH R5,E15 RETAIN ESID NO @V305096 02462000
* 02463000
ESDRET LH R2,E11 IF END OF CARD, GO READ ANOTHER @V305096 02464000
SH R2,K16 @V305096 02465000
BM RDNEXT @V305096 02466000
STH R2,E11 @V305096 02467000
LA R6,16(R6) SCAN TO NEXT ITEM @V305096 02468000
* 02469000
NI D25,X'0F' FORCE BINARY @V305096 02470000
* 02471000
**************************************************************** 02472000
** BUILD CURRENT C/D ENTRY FROM INPUT ESD ITEM 02473000
***************************************************************** 02474000
* 02475000
SR R8,R8 CLEAR PHNUM ,RELFAC @V305096 02476000
ST R8,RELFAC @V305096 02477000
ST R8,PHNUM AND CSWITCH @V305096 02478000
MVC NAME,D17 MOVE ESD INFORM @V305096 02479000
MVC ESDTYP,D25 @V305096 02480000
MVC ASSORG,D26 @V305096 02481000
CLI ESDTYP,CM IF COMMON MOVE LENGTH @V305096 02482000
BE COMMON TO C/D @V305096 02483000
CLI ESDTYP,WX IS THIS A WXTRN @V305096 02484000
BNE COMPVAL NO , BRANCH @V305096 02485000
MVI ESDTYP,ER SET ESD TYPE ER @V305096 02486000
OI CSWITCH,NOAUTOL+WXTRN @V305096 02487000
B CNWEXT CANCEL AUTOLINK @V305096 02488000
COMMON MVC LNGTH,D30 @V305096 02489000
B ESLBCD GO TO PROCESS ESD @V305096 02490000
COMPVAL CLI ESDTYP,HEX5 TEST FOR VALID @V305096 02491000
BH ERR040 INPUT TYPES @V305096 02492000
CLI ESDTYP,HEX3 @V305096 02493000
BE ERR040 @V305096 02494000
* 02495000
*** CONVERT ESID # ON LD-S, CONVERT ESD TYPE TO C/D FORMAT 02496000
* 02497000
CLI ESDTYP,LD @V305096 02498000
* IF NOT A LD CONTINUE PROCESSING 02499000
BNE ENLD OTHER TYPES @V305096 02500000
* 02501000
MVC CSNUM(DEC2),D31 SET CONTROL SECTION NUM @V305096 02502000
OI CSWITCH,UNASSG UNASSIGN THE LD @V305096 02503000
LH R8,CSNUM CONVERT ESID NO @V305096 02504000
BAL RF,LTESID TO C/D NO @V305096 02505000
* 02506000
B ESLBCD DONT ASSGN LD IF SD ¬ YET PROC-D @V305096 02507000
* 02508000
B ESDRET IGNORE LD IF ESID # TO BE BYPASSE@V305096 02509000
* 02510000
NI CSWITCH,ASSG ASSIGN THE LD @V305096 02511000
STH R8,CSNUM STORE C/D NO @V305096 02512000
* 02513000
CLI ESDTYPD,SD IF THE ESD ITEM @V305096 02514000
BE ESLBCD POINTED TO BY THE @V305096 02515000
CLI ESDTYPD,CM INPUT LD IS NOT @V305096 02516000
L RB,AMSG42 A CSECT OR A COMMON @V305096 02517000
BNE ERROR IT IS AN @V305096 02518000
B ESLBCD ERROR @V305096 02519000
* 02520000
*** PRE-PROCESS ER FOR AUTOLINK 02521000
* 02522000
ENLD CLI ESDTYP,ER IF NOT ER GO TRY @V305096 02523000
BNE PRSDPC SD/PC @V305096 02524000
TM ALNKSW,X'01' IF NOAUTO REQUESTED ON THIS PHASE@V305096 02525000
BZ *+8 CANCEL ER-S BEFORE REQUEST @V305096 02526000
CNCALK OI CSWITCH,NOAUTOL @V305096 02527000
CNWEXT MVC PHNUME,PHSNO MOVE PHASE NO TO C/D @V305096 02528000
B ESLBCD GO TO PROCESS ESD @V305096 02529000
* 02530000
*** PRE-PROCESS SD/PC 02531000
* 02532000
PRSDPC CLI ESDTYP,SD IF NOT SD/PC CONT @V305096 02533000
BE SDPC OTHER TYPES @V305096 02534000
CLI ESDTYP,PC @V305096 02535000
BNE ESLBCD ... @V305096 02536000
* 02537000
SDPC EQU * @V305096 02538000
TM ASSORG+2,HEX7 IF ASSEMBLED ORIGIN @V305096 02539000
L RB,AMSG45 NOT ALIGNED ON @V305096 02540000
BNE ERROR DBLWD BOUNDARY, IT IS AN ERROR @V305096 02541000
* 02542000
MVC PHNUM,PHSNO @V305096 02543000
* 02544000
CLI NMELST,C' ' IF NOT IN SUB-MOD STATUS BYPASS @V305096 02545000
BE EISDPC SUB-MODULAR TEST @V305096 02546000
* 02547000
LA R2,05 SET UP TO SCAN SUB-MODULAR TABLE @V305096 02548000
LA R3,NMELST @V305096 02549000
* 02550000
ESDSBM CLC NAME,DEC0(R3) IF SD LABEL IS IN @V305096 02551000
* NAME LIST TABLE 02552000
BE EISDPC CARRY ON TO PROCESS IT @V305096 02553000
LA R3,8(R3) @V305096 02554000
BCT R2,ESDSBM ELSE,BYPASS THIS SD BUT FLAG ITIN@V305096 02555000
NI EUPDSW+1,X'0F' SET SW TO FLAG AS BYPASS SD @V305096 02556000
MVI ESDTYP,ER MAKE ER & CANCEL @V305096 02557000
B CNCALK AUTOLINK ON THIS SD,NOW AN ER @V305096 02558000
* 02559000
EISDPC MVC CSLNTH+1(3),D30 SAVE C/S LGTH TO UPDT PHASE HIGH@V305096 02560000
MVC BUCK3(DEC3),ASSORG SET UP ASSEMBLED @V305096 02561000
* ORIGIN FOR CALC R/F 02562000
L R3,NXPHRG ALIGN NEXT POSS PHASE ORIGIN@V305096 02563000
* ALIGN 02564000
LA R3,DEC7(R3) ALIGN TO @V305096 02565000
SRL R3,DEC3 DOUBLEWORD @V305096 02566000
SLL R3,DEC3 BOUNDARY @V305096 02567000
* 02568000
ST R3,NXPHRG @V305096 02569000
* 02570000
S R3,BUCK4 R/F = NEXT POSS PHASE ORIGIN@V305096 02571000
* MINUS ASSEMBLED ORIGIN 02572000
ST R3,RELFAC @V305096 02573000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 02574000
* 02575000
* PROCESS ESD ITEMS AGAINST C/D 02576000
* 02577000
ESLBCD BAL RF,SRCHCD MULT RETN ON C/D DUP NAME SEARCH @V305096 02578000
* 02579000
B ELBNCD RETURN IF LABEL NOT YET IN C/D @V305096 02580000
* 02581000
TM ESDTYPD,PH IF MATCH WITH PHASE, IGN@V305096 02582000
BO SRPCOD AND CONTINUE SEARCH @V305096 02583000
* 02584000
*** PROCESS PC - PRIVATE CODE 02585000
* 02586000
CLI ESDTYP,PC IF PC TREAT AS @V305096 02587000
BNE ELBCM IF LABEL HAS NOT @V305096 02588000
* OCCURED IN C/D 02589000
CLI D17,C' ' ENSURE PC IS UNNAMED @V305096 02590000
BE ELBNCD @V305096 02591000
ERR040 L RB,AMSG40 INVALID ESD TYPE @V305096 02592000
B ERROR @V305096 02593000
* 02594000
*** PROCESS CM - COMMON 02595000
* 02596000
ELBCM CLI ESDTYP,CM IF ESD NOT CM, TRY ER @V305096 02597000
BNE ELBER @V305096 02598000
* 02599000
CLI ESDTYPD,PC IS IT PRIVATE CODE @V305096 02600000
BE SRPCOD YES, BYPASS ENTRY @V305096 02601000
* 02602000
CLI ESDTYPD,CM IS IT A COMMON @V305096 02603000
BNE ELBCER NO, TRY ER @V305096 02604000
* 02605000
CLC LNGTHD(DEC3),LNGTH CARRY LONGEST LENGTH @V305096 02606000
BH EUPDLT IN C/D, UPDATE L/T @V305096 02607000
MVC LNGTHD(DEC3),LNGTH @V305096 02608000
B EUPDLT @V305096 02609000
* 02610000
ELBCER CLI ESDTYPD,ER IF DUPLCTE ER, OVERRIDE @V305096 02611000
BE ELBINT IT WITH INPUT CM @V305096 02612000
CLI ESDTYPD,SD IF SD, UPDATE L/T @V305096 02613000
BE EUPTRY OTHERWISE LABEL IS SAME @V305096 02614000
ERR046 L RB,AMSG46 AS LD @V305096 02615000
B ERROR WHICH IS ILLEGAL @V305096 02616000
* 02617000
*** PROCESS ER - EXTERNAL REFERENCE 02618000
* 02619000
ELBER CLI ESDTYP,ER IF ESD NOT ER, TRY SD @V305096 02620000
BNE ELBSD @V305096 02621000
* 02622000
TM SWITCHD,UNASSG DO NOT ACCEPT @V305096 02623000
BO SRPCOD UNASSIGNED SYMBOLS @V305096 02624000
* 02625000
CLI ESDTYPD,ER IF ER, @V305096 02626000
BE ELBISITW CHECK FOR A WXTRN @V305096 02627000
CLI ESDTYPD,CM IF CM UPDATE L/T @V305096 02628000
BE EUPDLT @V305096 02629000
* 02630000
CLC KIJ,NAME IF NOT 'IJ' @V305096 02631000
BE PRIVILEG @V305096 02632000
CLC KIBM,NAME NOR 'IBM' PREFIX @V305096 02633000
BNE ELBELR FORCE LR ON LD @V305096 02634000
* 02635000
PRIVILEG EQU * @V305096 02636000
TM ALNKSW,X'01' IF NOAUTO REQUESTED ON THIS @V305096 02637000
BO ELBELR YES, ACCEPT CROSS REF @V305096 02638000
* 02639000
BAL RE,XTPHNO EXTRACT PHASE # OF CURRENT C/D @V305096 02640000
* 02641000
CH R2,PHSNO IF SAME PHASE # @V305096 02642000
BE ELBELR AS CURRENT ACCEPT @V305096 02643000
* CROSS-REFERENCE 02644000
CLC KIBM,NAME IF 'SUPER-PRIVILEGED' @V305096 02645000
BE ELBNCD ADD TO C/D EVEN IF @V305096 02646000
* ROOTPHASE COULD RESOLVE IT 02647000
CH R2,K1 IF NOT PRES IN ROOT PHASE ADD IT @V305096 02648000
BNE ELBNCD TO BE AUTOLINKED @V305096 02649000
* 02650000
* 02651000
ELBELR CLI ESDTYPD,LD IS DUPLICATE LD @V305096 02652000
BNE EUPDLT NO, UPDATE L/T @V305096 02653000
* 02654000
OI ESDTYPD,LR FORCE LR & UPD L/T @V305096 02655000
B EUPDLT @V305096 02656000
* 02657000
ELBISITW CLC PHNUMED,PHNUME @V305096 02658000
* IF NOT EQUAL, THIS PHASES 02659000
BNE ELBINT ER REPLACES PREVIOUS ONE IN @V305096 02660000
* CONTROL DICTIONARY (AUTOLINK) 02661000
TM CSWITCH,NOAUTOL IF NOT A WXTRN OR @V305096 02662000
BO EUPDLT NO AUTO, REPLACE ER IN C/D @V305096 02663000
B ELBINT @V305096 02664000
* 02665000
*** PROCESS SD - SECTION DEFINITION 02666000
* 02667000
ELBSD EQU * @V305096 02668000
* 02669000
CLI ESDTYP,SD IF ESD NOT SD, TRY LD @V305096 02670000
BNE ELBLD @V305096 02671000
* 02672000
CLI ESDTYPD,CM IF CM INSERT @V305096 02673000
BE ELBINT ... SD IMMEDIATELY @V305096 02674000
* 02675000
CLI ESDTYPD,ER IF DUPLICATE ER @V305096 02676000
BE ECHKIBM TEST FOR PRIVILEGED @V305096 02677000
* 02678000
CLI ESDTYPD,SD IF SD GO TO TEST @V305096 02679000
BE ELBDSD DUPLICATION @V305096 02680000
* 02681000
TM SWITCHD,UNASSG @V305096 02682000
* IF LD/LR HAS BEEN ASSIGNED IT MUST 02683000
BZ ERR043 BELONG TO A PREV'LY PROC'D SD @V305096 02684000
* 02685000
CH R5,CSNUMD @V305096 02686000
* IF ESID NO MATCHES THE SD-S ESID AND THE ASSEMBLED 02687000
BNE ERR043 ORIGIN IS THE SAME @V305096 02688000
* THEN THIS MUST BE A CSECT PREVIOUSLY 02689000
CLC ASSORG,ASSORGD @V305096 02690000
BNE ERR043 DEFINED AS ENTRY IN ASSEMBLY @V305096 02691000
B ELBINT @V305096 02692000
* 02693000
ELBDSD BAL RE,XTPHNO EXTRACT PHASE # OF THIS SD @V305096 02694000
* 02695000
CH R2,PHSNO IF PREVIOUSLY PROCESSED @V305096 02696000
BE ELBGSD IN THIS PH IGNORE IT @V305096 02697000
* 02698000
CLC KIBM,NAME IF 'SUPER-PRIVILEGED' @V305096 02699000
BE ELBNCD ADD IT TO CURRENT PHASE, @V305096 02700000
* EVEN IF ALREADY IN ROOTPHSE 02701000
CH R2,K1 IF NOT PRESENT IN ROOT PHASE ADD @V305096 02702000
BNE ELBNCD THIS SD TO CURRENT PHASE @V305096 02703000
* 02704000
* SET NEG C/D # AS A SWITCH IN L/T 02705000
ELBGSD LNR R8,R8 TO BYPASS ALL FUTURE ESID # @V305096 02706000
B EUPDLT @V305096 02707000
* 02708000
*** PROCESS LD - LABEL DEFINITION 02709000
* 02710000
ELBLD MVI ESDTYP,LR FORCE LD TO LR @V305096 02711000
* 02712000
CLI ESDTYPD,CM CM HAS SAME LABEL @V305096 02713000
BE ERR046 AS LD @V305096 02714000
CLI ESDTYPD,ER IF DUPLICATE ER @V305096 02715000
BE ECHKIBM TEST FOR PRIVILEGED @V305096 02716000
* 02717000
TM SWITCHD,UNASSG IF C/D ENTRY ASS @V305096 02718000
BNO ELBNLR PROCESS FURTHER @V305096 02719000
* 02720000
OI DPNTSW,X'01' SET POSS DUP ENTRY SWITCH @V305096 02721000
NC ESDTYP(DEC1),ESDTYPD RETAIN TYPE AND @V305096 02722000
B ELBINT INSERT ESD IN C/D @V305096 02723000
* 02724000
ELBNLR MVI ESDTYP,LD RESET LR TO LD @V305096 02725000
* 02726000
CLC ASSORG,ASSORGD IF NOT EQUAL IT @V305096 02727000
BNE ERR043 MUST BE AN ERROR @V305096 02728000
* 02729000
TM CSWITCH,UNASSG @V305096 02730000
* IF ESD LD NOT ASSIGNED YET, CANNOT 02731000
BO ELBNAS VALIDITY TEST ON ESID C/D # PTRS @V305096 02732000
* 02733000
CLI ESDTYPD,LD IF LD/LR CHECK IF @V305096 02734000
BE ELBLDR C/D NO'S AGREE AND @V305096 02735000
CLI ESDTYPD,LR IF THE NAMES OF THE @V305096 02736000
BE ELBLDR LABELS AGREE @V305096 02737000
* 02738000
CH R8,CSNUM IF C/D NO POINTER @V305096 02739000
* IN LD NOT SAME AS 02740000
BE ESDRET C/D # OF SD IT MUST BE AN ERROR @V305096 02741000
ERR043 EQU * @V305096 02742000
CLC KIBM,NAMED IF SUPER PRIVILEGED @V305096 02743000
BNE ERR043F THIS MIGHT BE NO ERROR @V305096 02744000
BAL RE,XTPHNO EXTRACT PHASE # OF C/D @V305096 02745000
CH R2,PHSNO IF MATCH NOT @V305096 02746000
* IN THIS PHASE 02747000
BNE ELBNCD ACCEPT FOR THIS PHASE @V305096 02748000
ERR043F L RB,AMSG43 LD DUPLICATED @V305096 02749000
B ERROR @V305096 02750000
* 02751000
ELBLDR LR R1,R9 SAVE ADDRESS OF C/D ENTRY @V305096 02752000
* 02753000
LH R9,CSNUMD GET SD FOR THE LD @V305096 02754000
* 02755000
CH R9,CSNUM BUT IF ESD-S C/D NO @V305096 02756000
* MATCHES C/D NO OF C/D 02757000
BE ESDRET # IT IS EXACT DUP SO IGNORE IT @V305096 02758000
* 02759000
LA RF,* @V305096 02760000
B LTCDAD @V305096 02761000
LR R2,R9 RETAIN IN WORK REGISTER @V305096 02762000
* 02763000
LH R9,CSNUM GET C/D SD THE ESD @V305096 02764000
LA RF,* LD BELONGS TO @V305096 02765000
B LTCDAD @V305096 02766000
* 02767000
CLC NAMED(DEC8),DEC0(R2) @V305096 02768000
* C/D LD ARE DIFFERENT IT IS AN ERROR 02769000
LR R9,R1 RESTORE ADDRESS OF C/D ENTRY@V305096 02770000
BNE ERR043 @V305096 02771000
* 02772000
ELBNAS BAL RE,XTPHNO EXTRACT PHASE # OF CURRENT C/D @V305096 02773000
* 02774000
CH R2,PHSNO IF MATCHING C/D ENTRY @V305096 02775000
* NOT IN CURRENT 02776000
BNE ELBNCD PHASE ACCEPT FOR THIS PHASE @V305096 02777000
* 02778000
OI DPNTSW,X'01' SET POSS DUP ENTRY SWITCH @V305096 02779000
B ESDRET IGNORE THIS LD @V305096 02780000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 02781000
* 02782000
* ESD-S HAVE BEEN PROCESSED AGAINST C/D 02783000
* 02784000
ELBNCD LM R8,R9,CTLDNO ADD AN ENTRY TO C/D BY UPDATING @V305096 02785000
TM ESDTYPD,PH LAST ENTRY PHASE @V305096 02786000
LA R8,1(R8) POSSIBLE ENTRY @V305096 02787000
LA R9,CDLNGTH(R9) ADD LNGTH OF ONE ENTRY @V305096 02788000
BNO CONT NO, CONTINUE @V305096 02789000
LA R8,DEC1(R8) @V305096 02790000
LA R9,CDLNGTH(R9) @V305096 02791000
CONT EQU * @V305096 02792000
* A PHASE ENTRY OCCUPIES TWO NORMAL ENTRIES 02793000
STM R8,R9,CTLDNO @V305096 02794000
BAL RE,CDSIZE TEST FOR C/D OVERFLOW @V305096 02795000
* 02796000
** MOVE CURRENT ESD ENTRY TO C/D 02797000
* 02798000
ELBINT MVC CDENTRY(CDLNGTH),CESDENT @V305096 02799000
* 02800000
EUPDLT CLI ESDTYP,LD IF INPUT ESD ITEM @V305096 02801000
BE EUPDXT IS OF TYPE LD OR @V305096 02802000
CLI ESDTYP,LR LR DO NOT UPDATE @V305096 02803000
BE EUPDXT THE L/T @V305096 02804000
* 02805000
EUPTRY LR R2,R8 SAVE C/D # TO USE TO UPDATE L/T @V305096 02806000
LR R8,R5 SET UP ESID # TO MAKE ENTRY AT @V305096 02807000
BAL RF,LTESID MULTIPLE RETURN POINTS @V305096 02808000
* 02809000
B EUPDOK ESID NOT YET PROC'D SO MAKE ENTRY@V305096 02810000
* 02811000
NOP 0 IF ESID #-S SLOT IN L/T HAS BEEN @V305096 02812000
* PREVIOUSLY UPDATED, THIS SUGGEST 02813000
L RB,AMSG41 DUPLICATED ESID # @V305096 02814000
B ERROR LAST MODULE HAD NO END CARD @V305096 02815000
* 02816000
EUPDOK MVC ESDTYPL(DEC1,R7),ESDTYP PUT ESD TYPE IN L/T @V305096 02817000
* 02818000
EUPDSW B EUPDCN SWITCH SET WHEN SD TO BE BYPASSED@V305096 02819000
MVI ESDTYPL(R7),SD SET ER BACK TO SD @V305096 02820000
LNR R2,R2 FLAG C/D # AS NEGATIVE @V305096 02821000
OI EUPDSW+1,X'F0' RESET SW TO NORMAL STATUS @V305096 02822000
* 02823000
EUPDCN STH R2,DEC0(R7) STORE C/D # IN L/T @V305096 02824000
LA R5,1(R5) UPDATE ESID # COUNT ON THIS CARD @V305096 02825000
* 02826000
EUPDXT EQU * @V305096 02827000
LTR R2,R2 IF THIS SD TO BE IGNORED GO GET @V305096 02828000
BM ESCNCD SCAN ON C/D @V305096 02829000
* 02830000
CLI ESDTYP,SD IS INPUT SD @V305096 02831000
BE ADDLEN YES, CALC NXPHRG @V305096 02832000
CLI ESDTYP,PC IS INPUT PC @V305096 02833000
BNE ESDRET NO, GET NEXT ESD @V305096 02834000
* 02835000
*** ADD LENGTH OF THIS SD/PC IN PROCESS TO CURRENT PHASE 02836000
* 02837000
ADDLEN EQU * @V305096 02838000
TM DERDSW+1,X'20' C/S LGTH NOT YET REC'D FROM @V305096 02839000
BNE *+8 @V305096 02840000
OI DPNTSW,X'02' @V305096 02841000
* 02842000
NI DERDSW+1,255-X'20' SET SW ASSUMING ZERO LGTH @V305096 02843000
* 02844000
L R3,CSLNTH IF C/S LGTH = 0, LEAVE SW @V305096 02845000
LTR R3,R3 IN DERDAD TO IGNORE TEST OF ADDR @V305096 02846000
BZ ESCNCD GT CURRENT PHASE LENGTH, ELSE @V305096 02847000
* 02848000
OI DERDSW+1,X'20' RESET SW TO TEST UPPER PHASE@V305096 02849000
* LIMIT 02850000
A R3,NXPHRG STORE NEXT @V305096 02851000
ST R3,NXPHRG POSSIBLE PHASE ORIGIN @V305096 02852000
* 02853000
*** SCAN C/D ON EACH SD, LOOKING FOR UNASSIGNED LD/LR-S 02854000
* 02855000
DROP R9 @V305096 02856000
USING CDENTRY,R3 @V305096 02857000
ESCNCD LM R2,R3,CTLDNO INITIALIZE SCAN OF C/D @V305096 02858000
* 02859000
EPHLOP CLI ESDTYPD,LD SCAN C/D FOR @V305096 02860000
BE TSTASSG UNASSIGNED @V305096 02861000
CLI ESDTYPD,LR LD/LR S @V305096 02862000
BNE EPHSCN CONTINUE SCAN @V305096 02863000
TSTASSG TM SWITCHD,UNASSG @V305096 02864000
BO EPHULD @V305096 02865000
EPHSCN SH R3,HCDLNGTH CONTINUE SCANNING @V305096 02866000
CL R3,CDENT1 SCAN FINISHED @V305096 02867000
BH EPHLOP @V305096 02868000
B ESDRET RETURN TO GET NEXT ESD ITEM @V305096 02869000
* 02870000
EPHULD LH R8,CSNUMD SET UP ESID # @V305096 02871000
LTR R8,R8 IF ESID IS MINUS, THIS INDICATES @V305096 02872000
BM EPHSCN CURRENT L/T NOT APPLICABLE @V305096 02873000
BAL RF,LTESID MULT RETN DEPENDING ON L/T ENTRY @V305096 02874000
* 02875000
B EPHSCN UNASSIGNABLE STILL @V305096 02876000
* 02877000
B EPHSCD STORE NEGATIVE C/D @V305096 02878000
* 02879000
NI SWITCHD,ASSG ASSIGN LD/ LR @V305096 02880000
EPHSCD STH R8,CSNUMD STORE C/D # VALUE @V305096 02881000
B EPHSCN RETURN TO CONTINUE SCAN @V305096 02882000
DROP R3 @V305096 02883000
USING CDENTRY,R9 @V305096 02884000
SPACE 2 02885000
ECHKIBM CLC KIBM,NAMED LD OR SD @V305096 02886000
* WITH 'IBM' PREFIX 02887000
BNE ELBINT NO.. RESOLVE ER IN C/D @V305096 02888000
CLC PHSNO,PHNUMED IF MATCH IN CURR. PH @V305096 02889000
BE ELBINT ACCEPT SOLVING @V305096 02890000
B ELBNCD ELSE MAKE NEW ENTRY IN C/D @V305096 02891000
EJECT 02892000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 02893000
* 02894000
* CONSTANTS & S/R-S USED ONLY BY ESD PROCESSOR 02895000
* 02896000
KIJ DC C'IJ' PRIVILIGED PREFIX @V305096 02897000
KIBM DC C'IBM' SUPER PRIVILEGED PREFIX @V305096 02898000
* 02899000
* 02900000
** TABLE TO PROVIDE ADDRESSABILITY TO ERROR MESSAGES 02901000
* 02902000
DS 0F @VA05886 02903000
AMSG40 DC YL1(L'MSG40-DEC1) LENGTH OF MESSAGE MIN 1 @VA05886 02904000
DC AL3(MSG40) ADDRESS OF ERROR MESSAGE @VA05886 02905000
AMSG41 DC YL1(L'MSG41-DEC1) LENGTH OF MESSAGE MIN 1 @VA05886 02906000
DC AL3(MSG41) ADDRESS OF ERROR MESSAGE @VA05886 02907000
AMSG42 DC YL1(L'MSG42-DEC1) LENGTH OF MESSAGE MIN 1 @VA05886 02908000
DC AL3(MSG42) ADDRESS OF ERROR MESSAGE @VA05886 02909000
AMSG43 DC YL1(L'MSG43-DEC1) LENGTH OF MESSAGE MIN 1 @VA05886 02910000
DC AL3(MSG43) ADDRESS OF ERROR MESSAGE @VA05886 02911000
AMSG45 DC YL1(L'MSG45-DEC1) LENGTH OF MESSAGE MIN 1 @VA05886 02912000
DC AL3(MSG45) ADDRESS OF ERROR MESSAGE @VA05886 02913000
AMSG46 DC YL1(L'MSG46-DEC1) LENGTH OF MESSAGE MIN 1 @VA05886 02914000
DC AL3(MSG46) ADDRESS OF ERROR MESSAGE @VA05886 02915000
LTORG , @V305096 02916000
TITLE 'DLKOTH LINK EDIT PROCESS TXT,REP,RLD,END - $LNKEDT - DOS' 02917000
*********************************************************************** 02918000
*********************************************************************** 02919000
* * 02920000
* CSECT DLK0TH - TXT, REP, RLD, AND END PROCESSING * 02921000
* * 02922000
*ENTRY POINTS - DLKOTH - DETERMINES TYPE OF PROCESSING REQUIRED. FOR * 02923000
* TXT AND REP BUILDS TXT BLOCKS. FOR RLD DOES PASS 1 PROCESSING. * 02924000
* CLEAR LINK TABLE AFTER END CARD PROCESS. * 02925000
* * 02926000
*INPUT - FROM RDNEXT IN CSECT DMSDLK 02927000
* * 02928000
*OUTPUT - PASS 1 RLD INFO TO SYS001 * 02929000
* * 02930000
*EXITS-NORMAL - TO RDNEXT EXCEPT AFTER END CARD PROCESSING WHEN EXIT * 02931000
* MAY BE TO ALNKPR FOR AUTOLINK * 02932000
* -ERROR - ERROR MSG NOS. RESULTING FROM THIS CSECT ARE 2100-2113-* 02933000
* 2147-2151-2155-2156-2158-2191 * 02934000
* * 02935000
*TABLES/WORK AREAS - EXPLAINED IN COMMENTS OF CSECT DMSDLK 02936000
* * 02937000
*ATTRIBUTES - N/A * 02938000
* * 02939000
*********************************************************************** 02940000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 02941000
* 02942000
* PROCESS TXT/REP/RLD/END CARDS 02943000
* 02944000
DLKOTH CSECT TXT,REP,RLD,END PROC @V305096 02945000
USING *,RD @V305096 02946000
* 02947000
TM MODSTS,X'01' IF FIRST NON-CONTROL CARD, @V305096 02948000
BO SETUPSCN SET BEG'NG OF MODULE STATUS @V305096 02949000
* 02950000
OI MODSTS,X'01' TURN ON STATUS INDICATOR @V305096 02951000
MVC ESDN00,COMNRF SAVE 1ST ADDRESS @V305096 02952000
TM PERISW,HEX1 IF ON DOSLNK SAVE IN ESD000 @V305096 02953000
BZ SETUPSCN @V305096 02954000
MVC ESD000,COMNRF @V305096 02955000
CLC E1(4),MODEND IS IT AN END CARD @V305096 02956000
BNE UPNDS IF YES, IGNORE IT @V305096 02957000
OI SBMDST,X'10' SET END CARD SWITCH @V305096 02958000
NI MODSTS,X'FE' RESET 1ST NON-CTL CARD SCH @V305096 02959000
B RDNEXT @V305096 02960000
* 02961000
UPNDS EQU * @V305065 02962000
USING FSCBD,R1 @V305065 02963000
LA R1,DOSLNK POINT TO PLIST @V305065 02964000
LH RF,FSCBITNO GET CURRENT RECORD NUMBER @V305065 02965000
DROP R1 @V305065 02966000
STH RF,NDS000 AND STORE IT, WHICH IS @V305065 02967000
* USED FOR COMPARE IN ESD 02968000
* PROCESSER 02969000
NI MODSTS,255-X'01' RESET MODULAR STATUS BYTE @V305096 02970000
* 02971000
SETUPSCN EQU * @V305096 02972000
LA R0,4 SET UP TO SCAN MATRIX @V305096 02973000
LA R1,MTXOTH @V305096 02974000
* 02975000
OTHTYP MVC OTHTFR+2(2),0(R1) BRANCH ADDRESS FOR THIS TYPE@V305096 02976000
CLC E1(4),2(R1) IF CARD TYPES NO MATCH, GOTO@V305096 02977000
BNE OTHINC CONT SCAN FOR OTHER TYPES @V305096 02978000
* 02979000
CLI PHSNO,X'FF' IF PHASE CARD PREV PROC'D @V305096 02980000
OTHTFR BNE 0 GO TO TYPE PROCESSER @V305096 02981000
* 02982000
LA R1,ESDMTX GO TO ESDPROCESSOR TO CREATE@V305096 02983000
B EXLOAD DUMMY PHASE @V305096 02984000
* 02985000
OTHINC LA R1,6(R1) CONTINUE SCAN FOR VALID TYPE@V305096 02986000
BCT R0,OTHTYP @V305096 02987000
* 02988000
L RB,AMSG00 INVALID INPUT @V305096 02989000
B ERROR CARD TYPE @V305096 02990000
EJECT 02991000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 02992000
* 02993000
* PROCESS TXT CARDS 02994000
* 02995000
TXTPRC LH R8,E15 ESID NO @V305096 02996000
BAL RF,LTESID R7-R/F,R8-C/D #, R9-C/D ADDR@V305096 02997000
* 02998000
B ERROR ERR070 IF ESID # NOT YES PROC'D @V305096 02999000
* 03000000
B RDNEXT RETURN PT IF ESID TO BE BYPASSED @V305096 03001000
* 03002000
CLI ESDTYPD,SD CHECK FOR @V305096 03003000
BE CALCLOAD SD @V305096 03004000
CLI ESDTYPD,PC OR PC @V305096 03005000
BNE ERR055 ESID # DOES NOT PT TO CTL SECT @V305096 03006000
CALCLOAD EQU * @V305096 03007000
MVI E5,X'00' ADD ASSMB'D ORIGIN TO R/F TO GET @V305096 03008000
A R7,E5 LOAD ADDRESS @V305096 03009000
* 03010000
L RB,AMSG50 IF ASSEMBLED @V305096 03011000
* ADDRESS + LOAD 03012000
BL ERROR ADDRESS IS LESS THAN ZERO, ERROR @V305096 03013000
LH R8,E11 NO OF BYTES ON THIS CARD @V305096 03014000
LTR R8,R8 IF ZERO TXT, IGNORE @V305096 03015000
BZ RDNEXT @V305096 03016000
* 03017000
* INSERT TXT BYTES INTO CORRECT BLOCK(S) OF CORE IMAGE 03018000
* 03019000
* R5 - ADDRESS IN WKAREA R7 - AO + R/F 03020000
* R6 - ADDRESS IN CARD R8 - NO OF BYTES ON CARD 03021000
* R9 - AO + R/F + # 03022000
* 03023000
LA R6,E17 ADDRESS OF TXT IN CARD @V305096 03024000
* 03025000
TXTGET BAL RF,DERDAD GET RIGHT BLOCK OFF DISK @V305096 03026000
* 03027000
LA R9,0(R7,R8) MAXIMUM BYTE OF TXT @V305096 03028000
L R5,AWKARE CALC LOAD ADDRESS WITHIN WKAREA @V305096 03029000
AR R5,R7 @V305096 03030000
S R5,LOCORE @V305096 03031000
BCTR R8,0 USE LENGTH-1 IN EXEC MVC COMMAND @V305096 03032000
* 03033000
S R9,HICORE IF DIFFERENCE IS ZERO OR NEGATIVE@V305096 03034000
BNH TXTALL ALL TXT WILL FIT IN BLOCK @V305096 03035000
* 03036000
SR R8,R9 EXECUTE MOVE OF POSS NO. OF BYTES@V305096 03037000
EX R8,TXTMOV INTO WKAREA @V305096 03038000
* 03039000
LA R6,1(R8,R6) INCREMENT TO REQ'D BYPE IN CARD @V305096 03040000
LA R7,1(R8,R7) INCREMENT TO ADDR OF THAT BYTE @V305096 03041000
LR R8,R9 REMAINING NO OF BYTES ON CARD @V305096 03042000
B TXTGET LOAD THE REST @V305096 03043000
* 03044000
TXTALL EX R8,TXTMOV EXECUTE MOVE OF BYTES INTO WKAREA@V305096 03045000
B RDNEXT @V305096 03046000
* 03047000
* 03048000
TXTMOV MVC 0(0,R5),0(R6) SUBJECT INSTRUC OF EX COMMAND @V305096 03049000
EJECT 03050000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 03051000
* 03052000
* REP PROCESSOR 03053000
* 03054000
REPROC EQU * @V305096 03055000
* 03056000
BAL R6,PRTLST LIST REP CARD IN I/O AREA @V305096 03057000
* 03058000
LA R2,6 CONVERT ASSEMBLED ORIGIN & STORE @V305096 03059000
LA R3,E7 @V305096 03060000
BAL RF,CNVHEX @V305096 03061000
ST R5,E5 @V305096 03062000
* 03063000
LA R2,3 CONVERT ESID NO & STORE @V305096 03064000
LA R3,E14 @V305096 03065000
BAL RF,CNVHEX @V305096 03066000
STH R5,E15 @V305096 03067000
* 03068000
LA R3,E16 1ST BYTE OF TXT-1 @V305096 03069000
SR R6,R6 COUNT OF NO OF BYTES THIS CARD @V305096 03070000
* 03071000
REPTXT LA R2,5 4 HEX FOLLOWED BY , @V305096 03072000
BAL RF,CNVAHX THIS ENTRY POINT BYPASSES , @V305096 03073000
STH R5,E17(R6) @V305096 03074000
* 03075000
LA R6,2(R6) COUNT OF BYTES CONVERTED @V305096 03076000
CLI 0(R3),C',' IF MORE BYTES ON CARD, CONTINUE @V305096 03077000
BE REPTXT CONVERSION @V305096 03078000
* 03079000
CLI 0(R3),C' ' @V305096 03080000
L RB,AMSG51 INVALID DELIMITER @V305096 03081000
BNE ERROR @V305096 03082000
* 03083000
STH R6,E11 STORE BYTE COUNT & GOTO PROC AS @V305096 03084000
LA R0,22 A TXT CARD IF LEGIT NO OF BYTES @V305096 03085000
SR R6,R0 ON CARD @V305096 03086000
BNH TXTPRC @V305096 03087000
* 03088000
L RB,AMSG13 INFORM BEYOND COL 71 @V305096 03089000
B ERROR @V305096 03090000
EJECT 03091000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 03092000
* 03093000
* RLD - PASS 1 PROCESSING 03094000
* 03095000
RLDPRC EQU * @V305096 03096000
* 03097000
SR R2,R2 INITIALISE SCAN OF NEW CARD @V305096 03098000
NI RLSW1+1,X'0F' FORCE PROC'NG R & P ON 1ST ITEM @V305096 03099000
* 03100000
RLRET CH R2,E11 IF END OF CARD REACHED GOTO WRITE@V305096 03101000
BE RLWRIT IT OUT @V305096 03102000
LA R6,E17(R2) ADDRESS OF ITEM TO BE PROCESSED @V305096 03103000
LA R2,4(R2) COUNT OF BYTES PROCESSED @V305096 03104000
* 03105000
CNTSW B RLSW1 NOP IF VALID RLD ITEMS @V305096 03106000
LH R8,RLDCNT ADD ONE TO THE @V305096 03107000
LA R8,DEC1(R8) NUMBER OF VALID @V305096 03108000
STH R8,RLDCNT RLD ITEMS @V305096 03109000
* 03110000
RLSW1 NOP RLCONS SW IS B WHEN R&P SAME AS PREV @V305096 03111000
OI RLSW1+1,X'F0' MUST PROCESS CONSTANT AFTER R&P @V305096 03112000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 03113000
* 03114000
* PROCESS R & P POINTERS 03115000
* 03116000
*** - P POINTER 03117000
* 03118000
LH R8,D19 GET C/D # FROM L/T @V305096 03119000
BAL RF,LTESID MULTIPLE RETURN POINTS @V305096 03120000
* 03121000
B ERROR ERROR IF P PTR ESID NOT YET PROC @V305096 03122000
* 03123000
B RLSTP ACCEPT BYPASS OF THIS RLD ITEM @V305096 03124000
* 03125000
NI RLWRIT+1,X'0F' SET SW TO RETAIN THIS FOR PASS 2 @V305096 03126000
* 03127000
NI CNTSW+DEC1,HEXF INDICATE VALID RLD @V305096 03128000
CLI ESDTYPD,SD CHECK P @V305096 03129000
BE RLSTP POINTER @V305096 03130000
CLI ESDTYPD,PC @V305096 03131000
ERR055 L RB,AMSG55 INVALID P POINTER @V305096 03132000
BNE ERROR THERE IS SOMETHING WRONG @V305096 03133000
* 03134000
RLSTP STH R8,D19 SAVE P C/D # @V305096 03135000
* 03136000
*** - R POINTER 03137000
* 03138000
LH R8,D17 GET C/D # FROM L/T @V305096 03139000
BAL RF,LTESID MULTIPLE RETURN POINTS @V305096 03140000
* 03141000
B ERROR ERROR IF R PTR ESID NOT YET PROC @V305096 03142000
* 03143000
LPR R8,R8 SUPPLY ADDR'BLTY OF C/D ENTRY @V305096 03144000
NOPR 0 PADDING @V305096 03145000
* 03146000
STH R8,D17 SAVE R C/D # @V305096 03147000
CLI ESDTYPE,SD IF R DOES NOT @V305096 03148000
BE RLRET POINT TO ER OR CM @V305096 03149000
CLI ESDTYPE,PC RETURN TO SCAN @V305096 03150000
BE RLRET CONSTANTS @V305096 03151000
OI D17,X'80' R POINTS TO ER/CM - FLAG@V305096 03152000
* ... FOR PASS 2 TO 03153000
B RLRET USE R/F + AO AS RELOC ATTRIBUTE @V305096 03154000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 03155000
* 03156000
*** PROCESS CONSTANT PORTION 03157000
* 03158000
RLCONS TM D17,X'01' IF ¬ YET END OF ITEMS TO THIS R&P@V305096 03159000
BO RLRET RETURN TO SCAN @V305096 03160000
* 03161000
NI RLSW1+DEC1,HEXF RESET SWITCH TO PROCESS R&P @V305096 03162000
OI CNTSW+DEC1,HEXF0 AND COUNT SWITCH, RETURN @V305096 03163000
B RLRET TO SCAN @V305096 03164000
* 03165000
*** WRITE RLD RECORD ON SYS001 (IF NECESSARY) 03166000
* 03167000
RLWRIT B RDNEXT SW IS NOP IF ANY RLD ITEMS REQ'D @V305096 03168000
* 03169000
OI RLWRIT+1,X'F0' RESET SWITCH @V305096 03170000
* 03171000
TM RLSW1+1,X'F0' IF NOT YET INDICATED AS BEING@V305096 03172000
L RB,AMSG56 INVALID RLD CARD @V305096 03173000
BO ERROR FINISHED ON CARD,IT IS ERROR@V305096 03174000
* 03175000
LR R3,R2 SAVE COUNT OF BYTES THIS CARD@V305096 03176000
LH R4,RLDOPT+10 NO OF BYTES ALREADY IN AREA @V305096 03177000
AR R2,R4 IF THIS CARD + NO ALREADY @V305096 03178000
CH R2,BYTPCD ¬> LIMITS OF I/O AREA, SHIFT IT @V305096 03179000
BNH RLBYWR IN BESIDE PREVIOUS @V305096 03180000
* 03181000
BAL RF,WRS001 WRITE THIS RECORD OUT @V305096 03182000
SR R4,R4 RESET COUNT OF BYTES IN AREA@V305096 03183000
* 03184000
RLBYWR LA R5,RLDOPT+16(R4) ADDR TO PUT THIS CARDS CONTENTS@V305096 03185000
AR R4,R3 UPDT COUNT OF BYTES IN AREA @V305096 03186000
STH R4,RLDOPT+10 @V305096 03187000
* 03188000
BCTR R3,0 MOVE BYTES INVOLVED INTO I/O AREA@V305096 03189000
STC R3,*+5 @V305096 03190000
MVC 0(0,R5),E17 @V305096 03191000
* 03192000
B RDNEXT RETURN TO READ NEXT CARD @V305096 03193000
EJECT 03194000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 03195000
* 03196000
* PROCESS END CARD 03197000
* 03198000
ENDPRC EQU * @V305096 03199000
* 03200000
NI MODSTS,255-X'03' SET ENDED MODULE STATUS @V305096 03201000
NI ATRLSW,X'0F' ASSUME NORMAL EXIT TO RDNEXT@V305096 03202000
* 03203000
TM PERISW,HEX1 IF NOT DOSLNK, GO TO PROCESS@V305096 03204000
BZ ENOT00 RELOCATABLE LIBRARY INPUT @V305096 03205000
* 03206000
USING FSCBD,R1 @V305065 03207000
LA R1,DOSLNK POINT TO DOSLNK PLIST @V305065 03208000
LH RF,FSCBITNO GET CURRENT RECORD NUMBER @V305065 03209000
STH RF,NDS000 AND STORE IT, WHICH IS @V305065 03210000
* USED FOR COMPARE IN ESD 03211000
* PROCESSER 03212000
TM SBMDST,X'10' TEST FOR END CARD @V305096 03213000
BZ TSTESD BRANCH NO @V305096 03214000
NI SBMDST,X'EF' OTHERWISE, TURN OFF SWITCH @V305096 03215000
B ENDRTN @V305096 03216000
* 03217000
TSTESD CLC PERIDA,ESD000 IF THIS MODULE FINISHED @V305096 03218000
BNL ENDRTN CONTIMUE ON DOSLNK @V305096 03219000
* 03220000
MOVPERA EQU * @V305065 03221000
TM PERISW,CMSTXT IS THIS CMSTEXT? @V305065 03222000
BZ MOVPER BRANCH IF NOT @V305065 03223000
MVI RDS00A+1,X'F0' INDICATE CMSREAD @V305065 03224000
LA R1,DOSTXT POINT TO PLIST @V305065 03225000
MVC FSCBFN,PERIDA+2 MOVE IN FILENAME @V305065 03226000
MVC ITMCNT,PERIDA+10 MOVE IN ITEM COUNT @V305065 03227000
B MOVPER1 @V305065 03228000
MOVPER OI PVLBSW+1,X'F0' SET SWITCH FOR RELO LIB @V305096 03229000
TM PERISW,HEX4 FROM PRIV REL @V305096 03230000
BZ MOVPER1 @V305096 03231000
NI PVLBSW+1,X'00' SET NO. FOR FOR PRIV. RELO @V305096 03232000
MOVPER1 MVC ONS000,PERIDA SET RETURN FOR NEXT CTL CARD@V305096 03233000
B ENDRTN AND INPUT FROM SAME MODULE @V305096 03234000
* 03235000
ENOT00 TM PERISW,HEX2 IF NOT NAMED SUB-MODLR PROC @V305096 03236000
BZ *+8 NORMALLY @V305096 03237000
NI SBMDST,255-X'01' TURM OFF SUB-MODULAR STATUS @V305096 03238000
* 03239000
TM PERISW,CMSTXT IS THIS DOS TEXT? @V305065 03240000
BZ ENOT01 BRANCH IF YES @V305065 03241000
LA R1,DOSTXT POINT TO PLIST @V305065 03242000
CLC FSCBITNO,ITMCNT ANY MORE ITEMS ON CMSTXT @VA07692 03243000
BL ENDRTN BRANCH IF YES @VA07692 03244000
B ENOT02 @V305065 03245000
ENOT01 EQU * @V305065 03246000
CLC PERIDA,ESDN00 IF THIS MODULE NOT FINISHED @V305096 03247000
BL MOVPER CONT SUB-MOD ON REL LIBRARY @V305096 03248000
ENOT02 EQU * @V305065 03249000
TM PERISW,HEX40 SEE IF THIS REQUESTED VIA AUTOLNK@V305096 03250000
BZ *+8 NO @V305096 03251000
* 03252000
OI ATRLSW,X'F0' SET FOR REURN TO AUTOLINK @V305096 03253000
* 03254000
MVI ESDN00,X'0' RESET FOR NEXT TIME THROUGH @V305096 03255000
MVI ESDN00+DEC1,HEX0 @V305096 03256000
MVC PERIDA(DEC13*NESTNG+DEC1),PERIDA+DEC13 @V305096 03257000
MVI ENDPER,X'00' MAKE SURE NEST LEVEL IS RESET@V305096 03258000
TM PERISW,HEX1 IF STILL IN LIBRARY @V305096 03259000
BZ MOVPERA DO NOT SET REL LIBRARY INPUT SW @V305096 03260000
MVI RDS00A+1,X'00' RESET TEXT SW @V305065 03261000
OI PVLBSW+1,X'F0' RESET PRIV LIB SWITCH @V305096 03262000
NI RELBSW+1,X'0F' TURN OFF LIBRARY INPUT SW @V305096 03263000
CLI NDS000,HEXFF IF 1ST BYTE OF NDS000 IS FF @V305096 03264000
BE MOVPERA RETURN TO NXT CARD ON DOSLNK@V305096 03265000
EX 0,TSTESD CHECK IF MODULE FINISHED @V305096 03266000
BL MOVPERA NO, CONTIMUE PROCESSING @V305096 03267000
CLC PERIDA(2),NDS000 IF PERIDA GT NDS000, THEN @V305096 03268000
BH MOVPERA WE HAVE CTL CARD AFTER END @V305096 03269000
MVC ONS000,NDS000 SET TO BYPASS MODULE @V305096 03270000
MVI NDS000,HEXFF INDICATE IN NDS000 @V305096 03271000
* 03272000
ENDRTN MVC ENDERR+1(1),ATRLSW @V305096 03273000
TM SBMDST,X'01' IF IN NESTED SUB-MODULAR @V305096 03274000
BO ENDXFR DO NOT CLEAR NAMELIST @V305096 03275000
* 03276000
MVI NMELST,C' ' OTHERWISE, MAKE SURE @V305096 03277000
MVC NMELST+1(39),NMELST NAMELIST IS CLEAR @V305096 03278000
* 03279000
ENDXFR TM TRFRSW,X'01' IF XFER ALREADY ACCEPTED, BYPASS @V305096 03280000
BO ENOXFR THIS END TRANSFER @V305096 03281000
* 03282000
CLI E17,C' ' IF LABEL PRESENT ACCEPT AS XFER @V305096 03283000
BNE EISXFR POINT @V305096 03284000
* 03285000
CLI E15,C' ' IF ESID # NOT PRESENT, NO XFER @V305096 03286000
BE ENOXFR @V305096 03287000
* 03288000
LH R8,E15 @V305096 03289000
BAL RF,LTESID @V305096 03290000
* 03291000
B ERROR ERR070 IS ESID # NOT YET PROC'D @V305096 03292000
* 03293000
B ENOXFR BYPASS - DO NOT ACCEPT XFER ADDR @V305096 03294000
* 03295000
STH R8,E15 REPLACE ESID BY C/D # @V305096 03296000
EISXFR MVC X6(19),E6 RETAIN XFER INFO & SET @V305096 03297000
OI TRFRSW,X'01' XFER SW TO PROC AT PHASE END @V305096 03298000
* 03299000
CLI E17,C' ' TRANSFER LABEL PRESENT @V305096 03300000
BE ENOXFR NO @V305096 03301000
* 03302000
MVC E6(11),E6-1 CLEAR ALL COLMS EXCEPT LABEL@V305096 03303000
BAL R6,PRTLST AND PRINT CARD @V305096 03304000
* 03305000
ENOXFR L R9,CTLDAD SCAN TABLE FOR UNASSIGNED LD/LR-S@V305096 03306000
ENDSCD CLI ESDTYPD,LD SCAN C/D FOR @V305096 03307000
BE TSTUNAS UNASSIGNED @V305096 03308000
CLI ESDTYPD,LR LD OR LR -S @V305096 03309000
BNE ENUNAS CONTINUE SCAN @V305096 03310000
TSTUNAS EQU * @V305096 03311000
TM SWITCHD,UNASSG IF NOT AN UNASS @V305096 03312000
BNO ENUNAS LD/LR CONT SCAN @V305096 03313000
* 03314000
LH R2,CSNUMD @V305096 03315000
LTR R2,R2 TEST C/D NUMBER @V305096 03316000
BM ENUNAS C/D NUM NEGATIV @V305096 03317000
OI ERRSW,NOCARD NO CARD TO BE PRINTED @V305096 03318000
L RB,AMSG47 IF C/D NUM NOT NEGATIVE @V305096 03319000
B ERROR ON AN UNASSIGNED LD/LR @V305096 03320000
* IT IS AN ERROR 03321000
ENUNAS SH R9,HCDLNGTH SCAN TO NEXT ENTRY @V305096 03322000
C R9,CDENT1 @V305096 03323000
BH ENDSCD TEST @V305096 03324000
* 03325000
L R3,LNKTAD SET UP TO CLEAR @V305096 03326000
SR R9,R9 LINKAGE TABLE @V305096 03327000
LR R8,R9 @V305096 03328000
L R2,LTMINE @V305096 03329000
LA R2,LTENTLN(R2) @V305096 03330000
ST R2,LNKTAD FIRST ENTRY =NEXT @V305096 03331000
SR R3,R2 AVAILABLE ENTRY @V305096 03332000
MVCL R2,R8 CLEAR L/T @V305096 03333000
* 03334000
*** ACCEPT C/S LENGTH IF REQUIRED 03335000
* 03336000
TM DERDSW+1,X'20' IF SW SETTING DOES NOT REQUIRE @V305096 03337000
BO ENDSBM C/S LGTH GO TO CHECK SUB-MODULAR @V305096 03338000
* 03339000
CLI E17+12,X'00' IF 1ST BYTE IS NONZERO IT CANNOT @V305096 03340000
L RB,AMSG58 NO CS LENGTH @V305096 03341000
BNE ERROR BE A VALID C/S LENGTH @V305096 03342000
* 03343000
L R3,NXPHRG USE NEXT POSS PHASE ORIGIN @V305096 03344000
A R3,E17+12 ADD C/S LENGTH FROM END CARD@V305096 03345000
ST R3,NXPHRG RESTOR NXT POSS PHASE ORIGIN@V305096 03346000
* 03347000
OI DERDSW+1,X'20' SET SW FOR C/S LGTH PROC'D @V305096 03348000
* 03349000
ENDSBM NOP ALNKPR SOMETIMES NEC'SRY TO RETURN @V305096 03350000
* TO THE AUTOLINK PROCESSER AND AT 03351000
B RDNEXT OTHERS TO RETURN TO RDNEXT @V305096 03352000
* 03353000
ATRLSW EQU ENDSBM+1 AUTOLINK RETURN SWITCH @V305096 03354000
* 03355000
EJECT 03356000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 03357000
* 03358000
* CONSTANTS AND S/R-S USED ONLY BY ASSEMBLER PROCESSOR 03359000
* 03360000
* 03361000
*** RLD OUTPUT AREA 03362000
* 03363000
RLDOUT DC F'0' CCHH TO WRTE COUNT/KEY/DATA@V305096 03364000
DC H'0' RK OF OUTPUT RECORDS @V305096 03365000
DC Y(RLDCAP) DD LGTH OF RLD RECS @V305096 03366000
* 03367000
RLDOPT DC C'RLD' 1 - 4 STD 16 BYTES OF @V305096 03368000
DC 6C' ' RLD CARD @V305096 03369000
DC H'0' 11-12 @V305096 03370000
DC 4C' ' @V305096 03371000
DS 56C 1 PACKED CARD @V305096 03372000
DS 56C 2 PACKED CARDS @V305096 03373000
DS 56C 3 PACKED CARDS @V305096 03374000
DS 56C 4 PACKED CARDS @V305096 03375000
RLDCAP EQU *-RLDOPT @V305096 03376000
* 03377000
BYTPCD DC AL2(RLDCAP-16) NO OF BYTES OF INFO/REC @V305096 03378000
* 03379000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 03380000
* 03381000
* MATRIX OF BRANCH ADDRESSES ON CARD TYPE 03382000
* 03383000
MTXOTH DC S(TXTPRC) @V305096 03384000
DC C'TXT' @V305096 03385000
* 03386000
DC S(RLDPRC) @V305096 03387000
DC C'RLD' @V305096 03388000
* 03389000
DC S(REPROC) @V305096 03390000
DC C'REP' @V305096 03391000
* 03392000
DC S(ENDPRC) @V305096 03393000
MODEND DC C'END' @V305096 03394000
* 03395000
EJECT 1 03396000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 03397000
* 03398000
* R15 S/R TO WRITE OUTPUT ON SYSUT1 03399000
* 03400000
* R0 - DESTROYED 03401000
* R1 - DESTROYED 03402000
* R2 - DESTROYED 03403000
* R3 - DESTROYED 03404000
* RE - DESTROYED 03405000
* 03406000
WRS001 EQU * @V305065 03407000
USING FSCBD,R1 @V305065 03408000
LA R1,SYSUT1 POINT TO SYSUT1 DSCB @V305065 03409000
LH R2,FSCBITNO GET PREVIOUS REC NUMBER @V305065 03410000
LA R2,1(,R2) INCREMENT BY ONE @V305065 03411000
LA R3,RLDOPT POINT TO BUFFER @V305065 03412000
BAL RE,WRTUTX GO WRITE RECORD @V305065 03413000
SR R0,R0 CLEAR NUMBER OF BYTES @V305065 03414000
STH R0,RLDOPT+10 ON RLD RECORD @V305065 03415000
BR RF AND RETURN @V305065 03416000
DS 0D @V305096 03417000
* 03418000
** TABLE TO PROVIDE ADDRESSABILITY TO ERROR MESSAGES 03419000
* 03420000
DS 0F @VA05886 03421000
AMSG00 DC YL1(L'MSG00-DEC1) LENGTH OF MESSAGE MIN 1 @VA05886 03422000
DC AL3(MSG00) ADDRESS OF ERROR MESSAGE @VA05886 03423000
AMSG13 DC YL1(L'MSG13-DEC1) LENGTH OF MESSAGE MIN 1 @VA05886 03424000
DC AL3(MSG13) ADDRESS OF ERROR MESSAGE @VA05886 03425000
AMSG47 DC YL1(L'MSG47-DEC1) LENGTH OF MESSAGE MIN 1 @VA05886 03426000
DC AL3(MSG47) ADDRESS OF ERROR MESSAGE @VA05886 03427000
AMSG51 DC YL1(L'MSG51-DEC1) LENGTH OF MESSAGE MIN 1 @VA05886 03428000
DC AL3(MSG51) ADDRESS OF ERROR MESSAGE @VA05886 03429000
AMSG55 DC YL1(L'MSG55-DEC1) LENGTH OF MESSAGE MIN 1 @VA05886 03430000
DC AL3(MSG55) ADDRESS OF ERROR MESSAGE @VA05886 03431000
AMSG56 DC YL1(L'MSG56-DEC1) LENGTH OF MESSAGE MIN 1 @VA05886 03432000
DC AL3(MSG56) ADDRESS OF ERROR MESSAGE @VA05886 03433000
AMSG58 DC YL1(L'MSG58-DEC1) LENGTH OF MESSAGE MIN 1 @VA05886 03434000
DC AL3(MSG58) ADDRESS OF ERROR MESSAGE @VA05886 03435000
TITLE 'DLKSCN SCAN CONTROL CARDS - $LNKEDT - DOS' 03436000
*********************************************************************** 03437000
*********************************************************************** 03438000
* * 03439000
* CSECT DLKSCN - CONTROL STATEMENT PROCESSING * 03440000
* * 03441000
*INPUT - FROM RDNEXT IN CSECT DMSDLK 03442000
* * 03443000
*OUTPUT - N/A * 03444000
* * 03445000
*EXTERNAL ROUTINES - SEE LIST OF SUBROUTINES IN CSECT DMSDLK 03446000
* * 03447000
*ENTRY POINTS - DLKSCN - PROCESSES INCLUDE, PHASE, ENTRY CARDS * 03448000
* * 03449000
* 03450000
*EXITS-NORMAL: TO EXLOAD TO FETCH DLKCTL 03451000
* FROM PHASE PROCESS IF NOAUTO. TO ALNKPR FROM PHASE OR ENTRY PROCES* 03452000
* IF AUTOLINK. TO DLKCTL FROM ENTRY PROCESS IF NOAUTO. * 03453000
* -ERROR - ERROR MSG NOS. RESULTING FROM THIS CSECT ARE 2101-2102 * 03454000
* 2110-2111-2112-2114-2115-2116-2125-2130-2131-2132-2133-2195 03455000
* * 03456000
*TABLES/WORK AREAS - EXPLAINED IN COMMENTS OF CSECT DMSDLK * 03457000
* * 03458000
*ATTRIBUTES - N/A * 03459000
* * 03460000
******************************************************************** 03461000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 03462000
* 03463000
* CONTROL CARD PROCESSOR 03464000
* 03465000
DLKSCN CSECT SCAN CTL CARDS @V305096 03466000
USING *,RD @V305096 03467000
* 03468000
OI ERRNML+1,X'F0' ASSURE NMELST ¬ CLEARED ON ERROR @V305096 03469000
* CONTROL CARD 03470000
* 03471000
LR R6,RA PUT INPUT AREA ADDRESS IN R6@V305096 03472000
LR RB,RA ALSO IN RB @V305065 03473000
LA R0,1 PUT 1 IN R0 FOR UPDATING @V305096 03474000
BAL RF,SKIPB SKIP BLANKS BETWEEN FIELDS @V305096 03475000
CLC 0(6,R6),KENT IF VERB IS ENTRY, @V305096 03476000
BE GETVRB DO NOT SAVE ITS ADDRESS @V305096 03477000
MVC NEWDAD,ONS000 GET NEXT RECORD ADDR @V305065 03478000
MVC PERIDA,NEWDAD ON NXT TRK--THIS FORCES TRUE@V305096 03479000
GETVRB EQU * @V305096 03480000
TM RDS000+1,X'F0' IF DUMMY PHASE CARD CREATD BYPASS@V305096 03481000
BO ALNKGT SCANNER @V305096 03482000
* 03483000
MVI DBLWRD+1,C' ' MAKE SURE FIRST BYTE CLEAR @V305096 03484000
MVI PHCSW,X'00' RESET DELIMITER SWITCH @V305096 03485000
MVI PHVERB,C' ' CLEAR RECIPIENT FIELDS @V305096 03486000
MVC PHVERB+1(31),PHVERB @V305096 03487000
XC DISPLC(4),DISPLC CLEAR DISPLACEMENT FIELD @V305096 03488000
* 03489000
LA R7,PHVERB-1 SET BUCKET ADDR FOR EXTRACTING @V305096 03490000
BAL RE,EXTRCT FIELD AND EXTRACT IT @V305096 03491000
B SEEBLK HOPE IT IS BLANK @V305096 03492000
* 03493000
ERR010 L RB,AMSG10 INVALID DELIMITER @V305096 03494000
ERRNML B ERROR SET->NOP TO ALLOW CLRNG OF NMELST@V305096 03495000
MVI NMELST,C' ' CLEAR NAME LIST @V305096 03496000
MVC NMELST+1(39),NMELST @V305096 03497000
* 03498000
B ERROR @V305096 03499000
* 03500000
SEEBLK CLI 0(R6),C' ' HOPE DELIMITER BLANK @V305096 03501000
BNE ERR010 ILLEGAL DELIMITER @V305096 03502000
BAL RF,SKIPB SKIP TO NEXT FIELD @V305096 03503000
CLC PHVERB(6),KENT IS IT ENTRY @V305096 03504000
BE ENTCRD PROC ENTRY CARD @V305096 03505000
* 03506000
TM MODSTS,X'01' IF MODULE STATUS SW IS SET, THIS @V305096 03507000
L RB,AMSG16 CTL CARD IN MODULE @V305096 03508000
BO ERROR CTL CARD FALLS W/I THE MODULE @V305096 03509000
* 03510000
CLC PHVERB(6),KPHA IS IT PHASE @V305096 03511000
BE PHCRD PROCESS PHASE CARD @V305096 03512000
* 03513000
ST R6,SAVIT @V305096 03514000
BAL R6,PRTLST LIST CONTROL CARD IN I/O AREA @V305096 03515000
L R6,SAVIT @V305096 03516000
LA R0,1 @V305096 03517000
CLC PHVERB(7),KACT IS IT ACTION @V305096 03518000
BE CTLRET BYPASS ACTION CARD BY IGNORING IT@V305096 03519000
CLC PHVERB(7),KCAT IF VERB IS CATALR, @V305096 03520000
BE CTLRET IGNORE IT. @V305096 03521000
CLI INPBLK,C'*' IS IT A COMMENT CARD??? @V305096 03522000
BE CTLRET YES,PLEASE IGNORE IT @V305096 03523000
CLC PHVERB(8),KINC IS IT INCLUDE @V305096 03524000
L RB,AMSG01 INVALID CTL CARD @V305096 03525000
BNE ERROR IF NOT, ERROR @V305096 03526000
EJECT 1 03527000
* 03528000
*** INCLUDE CARD 03529000
* 03530000
LA R9,INCLPR GET ADDRESS OF INCLUDE PROCESSOR @V305096 03531000
MVI NMSBSW,X'00' RESET SWITCH @V305096 03532000
CLC RDCB00,PRVADDR WAS READ FROM SYSRLB @V305096 03533000
BNE INCCRD1 NO @V305096 03534000
OI PERISW,HEX4 FROM SYSRLB @V305096 03535000
INCCRD1 OI PHCSW,X'04' TURN 1ST FIELD IN INCLUDE SWT ON @V305096 03536000
LA R7,PHNAME-1 SET BUCKET ADDRESS FOR EXTRACTED @V305096 03537000
BAL RE,EXTRCT NAME AND EXTRACT IT @V305096 03538000
B FINDND FIND END @V305096 03539000
* 03540000
CLI 0(R6),C'(' IS NEXT POSSIBLE NAMELIST @V305096 03541000
BNE ERR010 INVALID PARAMETER @V305096 03542000
CLI NMELST,C' ' IF NAMELIST IS PRESENT, @V305096 03543000
L RB,AMSG33 NESTED SUBMODULAR @V305096 03544000
BNE ERROR INCLUDE IS INVALID @V305096 03545000
NI ERRNML+1,X'0F' ALLOW CLR'NG OF NMELST ON ERROR @V305096 03546000
AR R6,R0 UPDATE PAST LEFT PAREN @V305096 03547000
LA R5,5 SET COUNT FOR NAMELIST ENTRIES @V305096 03548000
LA R8,NMELST-9 PREPARE TO SET ADDR OF BUCKET @V305096 03549000
LABST LA R8,8(R8) UPDATE TO START OF NEXT ENTRY @V305096 03550000
* 03551000
LR R7,R8 SET ADDR OF BUCKET FOR EXTRACTED @V305096 03552000
BAL RE,EXTRCT FIELD, AND EXTRACT IT @V305096 03553000
B CHKRP CHECK FOR RIGHT PARENTHESIS @V305096 03554000
BCT R5,LABST KEEP MOVING LABELS IN @V305096 03555000
* 03556000
L RB,AMSG14 SUB-MODULAR NAMELIST @V305096 03557000
B ERRNML TOO LONG @V305096 03558000
CHKRP CLI 0(R6),C')' TEST FOR DELIMIT OF NMELST @V305096 03559000
BNE ERR010 ILLEGAL DELIMITER @V305096 03560000
BAL RF,UPDATE UPDATE TO NEXT CHARACTER @V305096 03561000
BAL RE,CMDEL FIND COMMA DELIMITER @V305096 03562000
B FINDND IF NOT SHOULD BE END @V305096 03563000
B ERR010 ILLEGAL DELIMITER @V305096 03564000
FINDND CLI 0(R6),C' ' CHECK FOR BLANK @V305096 03565000
BNE ERR010 ERROR IF NOT END @V305096 03566000
CLI PHNAME,C' ' TEST FOR UNNAMED SUB-MOD ONLY @V305096 03567000
BE SETMDS SET MODULE STATUS FOR SUBMOD@V305096 03568000
BCTR R6,0 BACK UP INPUT POINTER @V305096 03569000
CLI 0(R6),C')' IF CHARACTER IS ), THEN IT MUST @V305096 03570000
BCR 7,R9 BE NAMED SUBMODULAR @V305096 03571000
OI NMSBSW,X'02' TURN ON NEST LIST SWITCH @V305096 03572000
OI SBMDST,X'01' SUB-MODULAR INPUT FLAG @V305096 03573000
BR R9 EXIT TO ADDRESS IN R9 @V305096 03574000
* 03575000
SETMDS OI MODSTS,X'02' SET BIT ON FOR UNAMED SUBMOD@V305096 03576000
B RDNEXT GO TO BUPASS CONTROL CARDS @V305096 03577000
EJECT 1 03578000
* 03579000
*** ENTRY CARD 03580000
* 03581000
ENTCRD TM ALNKSW,X'01' IF AUTOLINK REQUESTED, @V305096 03582000
BO ENTPRT SAVE ADDR OF CARD & GO AUTOLINK @V305096 03583000
* 03584000
SAVCTL MVC CTLSVE,COMNRF @V305096 03585000
B ALNKPR AND GO AUTOLINK @V305096 03586000
* 03587000
ENTPRT ST R6,SAVIT @V305096 03588000
BAL R6,PRTLST PRINT CARD IN I/O AREA @V305096 03589000
L R6,SAVIT @V305096 03590000
LA R0,1 RESTORE CONSTANT @V305096 03591000
* 03592000
LA R9,ALNKGT R9 GETS ADDR OF ENTRY PROC'R @V305096 03593000
LA R7,PHNAME-1 SET BUCKET ADDRESS FOR EXTRACTED @V305096 03594000
BAL RE,EXTRCT NAME AND EXTRACT IT @V305096 03595000
B FINDND FIND END @V305096 03596000
B ERR010 ILLEGAL DELIMITER @V305096 03597000
EJECT 1 03598000
* 03599000
*** PHASE CARD 03600000
* 03601000
PHCRD NI FRSTSW+1,X'00' NOP FIRST TIME THROUGH SW. @V305096 03602000
NI POPTSW,HEXF RESET OPTION SWITCH @V305096 03603000
TM RDALSW+1,X'F0' IF PHASE CARD ENCOUNTERED DURING @V305096 03604000
L RB,AMSG25 @V305096 03605000
BO ERROR AUTOLINK IT IS AN ERROR @V305096 03606000
* 03607000
TM ALNKSW,X'01' IF AUTOLINK REQUESTED, SAVE ADDR @V305096 03608000
BZ SAVCTL OF CARD AND GO AUTOLINK @V305096 03609000
* 03610000
ST R6,SAVIT @V305096 03611000
BAL R6,PRTLST PRINT CARD IN I/O AREA @V305096 03612000
L R6,SAVIT @V305096 03613000
LA R0,1 RESTORE CONSTANT @V305096 03614000
* 03615000
LA R7,PHNAME-1 SET ADDR OF BUCKET FOR EXTRACTED @V305096 03616000
BAL RE,EXTRCT FIELD, AND EXTRACT IT @V305096 03617000
B ERR010 ILLEGAL DELIMITER @V305096 03618000
* 03619000
* VERIFY PHASE NAME - IT MAY ONLY CONTAIN THE FOLLOWING 03620000
* CHARACTERS A - Z, 0 - 9, /, #, $, @ 03621000
* AND MAY NOT BE 'ALL' 03622000
* 03623000
SR R7,RB CALC LENGTH OF NAME - 1 @V305096 03624000
EX R7,TRT VERIFY PHASENAME @V305096 03625000
BZ TSTALL ALL CHARACTERS VALID @V305096 03626000
* 03627000
ERR021 L RB,AMSG21 PHASE NAME @V305096 03628000
B ERROR INVALID @V305096 03629000
* 03630000
TSTALL CLC CHARALL,PHNAME IS PHASE NAME 'ALL' @V305096 03631000
BNE PHCRD1 NO, BRANCH @V305096 03632000
B ERR021 YES, INVALID PHASE NAME @V305096 03633000
* 03634000
PHCRD1 CLI 0(R6),C'+' WAS DELIMITER A PLUS SIGN @V305096 03635000
BNE NTABS NO, THIS IS NOT ABS ADDR @V305096 03636000
* 03637000
DSPRTN BAL RF,UPDATE UPDATE PAST +/- SIGN @V305096 03638000
CLI 0(R6),C'X' HEX DISPLAC @V305096 03639000
BNE DECDSP NO, DECIMAL DISPLACEMENT @V305096 03640000
* 03641000
CLI 1(R6),C'''' NEXT QUOTE @V305096 03642000
BNE ERR010 @V305096 03643000
* 03644000
LA R6,2(R6) UPDATE PAST QUOTE DELIMITER @V305096 03645000
LA R3,7 MAX LENGTH FOR HEX FIELD @V305096 03646000
LA R7,DBLWRD SET BUCKET ADDRESS FOR EXTRACTED @V305096 03647000
BAL RE,EXTRCT+4 FIELD, AND EXTRACT IT @V305096 03648000
B LKQUO LOOK FOR QUO DELIMITER @V305096 03649000
B ERR010 ERROR IF DELIMITED BY COMMA @V305096 03650000
* 03651000
LKQUO CLI 0(R6),C'''' WAS DELIMITER A QUOTE @V305096 03652000
BNE ERR010 ERROR IF NOT DELIMITED BY QUOTE @V305096 03653000
* 03654000
BAL RF,UPDATE UPDATE PAST QUOTE DELIMITER @V305096 03655000
BAL RE,CMDEL CHECK FOR COMMA DELIMITER @V305096 03656000
OI PHCSW,X'01' TURN NON-COMMA DELIMITER SW ON @V305096 03657000
LA R3,DBLWRD+1 SET PTR TO START OF HEX FIEL@V305096 03658000
AR R7,R0 R7 PTS TO LAST CHAR IN BUCKE@V305096 03659000
SR R7,R3 ADD 1 & SUB R3 TO GET LGTH @V305096 03660000
LR R2,R7 SET COUNT FOR CNVHEX ROUTINE@V305096 03661000
* 03662000
BAL RF,CNVHEX CONVERT HEX TO BINARY @V305096 03663000
TSTNEG TM PHCSW,X'02' WAS DISPLACEMENT NEGATIVE @V305096 03664000
BZ STORR5 NO, STORE R5 IN DISP FIELD @V305096 03665000
LNR R5,R5 MAKE THIS MINUS @V305096 03666000
* 03667000
STORR5 ST R5,DISPLC STORE REGISTER 5 @V305096 03668000
TM PHCSW,X'01' WAS DELIMITER NON-COMMA @V305096 03669000
BZ PHCOPTN FIND OPTIONS @V305096 03670000
* 03671000
CLI 0(R6),C' ' WAS DELIMITER BLANK @V305096 03672000
BE ALNKGT YES, GO TO PHASE PROCESSER @V305096 03673000
B ERR010 ILLEGAL DELIMITER @V305096 03674000
* 03675000
DECDSP MVI CNVBUC,C' ' CLEAR BUCKET @V305096 03676000
MVC CNVBUC+1(7),CNVBUC @V305096 03677000
LA R7,CNVBUC-1 SET BUCKET ADDRESS FOR EXTRACTED @V305096 03678000
BAL RE,EXTRCT FIELD AND EXTRACT IT @V305096 03679000
* 03680000
OI PHCSW,X'01' TURN ON NON-COMMA DELIMITER SW @V305096 03681000
LA R4,CNVBUC SET START ADDR OF DEC FIELD @V305096 03682000
L RB,AMSG02 INVALID DEC/HEX @V305096 03683000
CLI 0(R7),C'K' TEST FOR K = 1024 @V305096 03684000
BNE TSTLIM @V305096 03685000
BCTR R7,0 REDUCE LAST CHAR ADDR @V305096 03686000
* 03687000
TSTLIM CLI 0(R4),C'0' LESS THAN ZERO @V305096 03688000
BL ERROR INVALID CHARACTER @V305096 03689000
CLI 0(R4),C'9' GREATER THAN 9 IS AN ERROR @V305096 03690000
BH ERROR INVALID CHARACTER @V305096 03691000
* 03692000
AR R4,R0 INCREASE POINTER BY ONE @V305096 03693000
CR R4,R7 R7 CONTAINS END OF FLD ADDR @V305096 03694000
BNH TSTLIM CONTINUE TESTING LIMITS @V305096 03695000
* 03696000
LR R4,R7 @V305096 03697000
LA R3,CNVBUC GET BEG ADDR AND SUBT END @V305096 03698000
SR R4,R3 ADDRESS TO GET EXECUTE COUNT@V305096 03699000
* 03700000
EX R4,PACK PACK DECIMAL FIELD @V305096 03701000
CVB R5,DBLWRD CONVERT TO BINARY @V305096 03702000
* 03703000
CLI 1(R7),C'K' TEST FOR K = 1024 @V305096 03704000
BNE NOTK @V305096 03705000
MH R5,K1024 MULTIPLY BY 1024 @V305096 03706000
* 03707000
NOTK B TSTNEG TEST FOR NEG DISPL'MT @V305096 03708000
* 03709000
PACK PACK DBLWRD(8),CNVBUC(0) PACK VAR LGTH FIELD @V305096 03710000
* 03711000
NTABS LA R7,SYMBOL-1 SET ADDR OF BUCKET FOR EXTRACTED @V305096 03712000
BAL RE,EXTRCT FIELD, AND EXTRACT IT @V305096 03713000
B FNDDEL NO COMMA, FIND DELIMITER @V305096 03714000
B PHCOPTN COMMA DELIMITER, FIND OPTNS @V305096 03715000
* 03716000
FNDDEL CLI 0(R6),C'(' POSSIBLE QUALIFER @V305096 03717000
BE QUAPRO PROCESS QUALIFIER @V305096 03718000
* 03719000
CRDEND CLI 0(R6),C' ' END TEST @V305096 03720000
BE ALNKGT YES, EXIT @V305096 03721000
* 03722000
CLI 0(R6),C'+' WAS DELIMITER PLUS @V305096 03723000
BE DSPRTN PROCESS DISPLACEMENT @V305096 03724000
* 03725000
CLI 0(R6),C'-' WAS THIS NEG DELIMITER @V305096 03726000
BNE ERR010 ILLEGAL DELIMITER @V305096 03727000
OI PHCSW,X'02' TURN ON NEG DISP SWITCH @V305096 03728000
B DSPRTN BR TO DISPL'MT PROCESSOR @V305096 03729000
* 03730000
QUAPRO BAL RF,UPDATE UPDATE PAST LEFT PAREN @V305096 03731000
LA R7,QUALIF-1 SET BUCKET ADDRESS FOR EXTRACTED @V305096 03732000
BAL RE,EXTRCT FIELD AND EXTRACT IT @V305096 03733000
B CHKRPN CHECK FOR RIGHT PAREN DELIMITER @V305096 03734000
B ERR010 INVALID DELIMITER @V305096 03735000
CHKRPN CLI 0(R6),C')' IF THIS IS NOT RIGHT PAREN @V305096 03736000
BNE ERR010 THEN IT IS AN INVALID DELIMITER @V305096 03737000
BAL RF,UPDATE UPDATE PAST THE RIGHT PAREN @V305096 03738000
BAL RE,CMDEL CHECK FOR COMMA DELIMITER @V305096 03739000
B CRDEND TEST FOR END ON NON-COMMA @V305096 03740000
EJECT 1 03741000
* 03742000
** SCAN FOR OPTIONS NOAUTO,SVA,PBDY IN PHASE CARD 03743000
* 03744000
PHCOPTN MVC DBLWRD,BLANKS CLEAR RECEIVING FIELD @V305096 03745000
LA R7,DBLWRD-DEC1 ADDRESS RECEIVING FIELD @V305096 03746000
BAL RE,EXTRCT GET OPTION @V305096 03747000
B ISITBLNK NON COMMA EXIT @V305096 03748000
BCTR R6,0 POINT R6 TO DELIMITER @V305096 03749000
SPACE 1 03750000
NOAUTCHK CLC DBLWRD,KNOAUTO OPTION NOAUTO ? @V305096 03751000
BNE PBDYCHK NO, CHECK FOR PBDY @V305096 03752000
OI POPTSW,OPTNOAUT SET NOAUTO BIT IN SW @V305096 03753000
B NEXTOPT CHECK LAST DELIMITER @V305096 03754000
SPACE 1 03755000
PBDYCHK CLC DBLWRD,KPBDY OPTION PBDY ? @V305096 03756000
BNE ERR061 NO, SYNTAX ERROR IN OPT @V305096 03757000
OI POPTSW,OPTPBDY SET PBDY BIT IN SWITCH @V305096 03758000
SPACE 1 03759000
NEXTOPT CLI 0(R6),BLANK WAS LAST DEL A BLANK @V305096 03760000
BE PHCEXIT YES, EXIT FROM THIS ROUT@V305096 03761000
AR R6,R0 UPDATE R6 PAST COMMA @V305096 03762000
B PHCOPTN GET NEXT FIELD @V305096 03763000
SPACE 1 03764000
ISITBLNK CLI 0(R6),BLANK WAS DELIMITER A BLANK @V305096 03765000
BNE ERR010 NO, INVALID DELIMITER @V305096 03766000
B NOAUTCHK COMPARE OPTION @V305096 03767000
SPACE 1 03768000
PHCEXIT TM POPTSW,OPTNOAUT WAS NOAUTO OPTION SPECI @V305096 03769000
BZ ALNKGT BRANCH TO PHASE PROCE @V305096 03770000
OI ALNKSW,HEX2 SET AUTOL SW TO NOAUTO @V305096 03771000
B ALNKGT BRANCH TO PHASE PROCE @V305096 03772000
SPACE 1 03773000
ERR061 L RB,AMSG61 LOAD ERROR CODE @V305096 03774000
B ERROR PRINT MESSAGE @V305096 03775000
EJECT 03776000
*** REQUEST AUTOLINK 03777000
* 03778000
ENTALK TM ALNKSW,HEX1 IF AUTOLINK @V305096 03779000
* SAVE ADDRESS 03780000
BZ SAVCTL1 OF CARD AND GO AUTOLINK @V305096 03781000
BAL R6,PRTLST PRINT CARD IN I/O AREA @V305096 03782000
B ALNKGT FETCH CONTROL POST PROCESSER@V305096 03783000
* 03784000
SAVCTL1 MVC CTLSVE,COMNRF SAVE ADDRESS OF THIS CARD @V305096 03785000
B ALNKPR AND GO AUTOLINK @V305096 03786000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 03787000
* 03788000
* R15 S/R TO SKIP BLANKS IN CONTROL CARDS 03789000
* 03790000
* EXITS RF - NORMAL RETURN 03791000
* CTLRET - ON INCLUDE WITH NO OPERAND 03792000
* WRTHDR - ON ENTRY WITH NO OPERAND 03793000
* R0 - SUPPLIES CONSTANT OF 1 03794000
* RA - SUPPLIES ADDRESS BLANK/RETURNS ADDRESS NON-BL 03795000
* R6- SUPPLIES ADDRESS OF COLUMN 72 03796000
* 03797000
SKIPB AR R6,R0 INCREASE R6 BY ONE @V305096 03798000
CLI 0(R6),C' ' IS IT BLANK @V305096 03799000
BCR 7,RF EXIT ON BLANK @V305096 03800000
* 03801000
LA R4,E1+71 SET R4 TO COLUMN 72 @V305096 03802000
CR R6,R4 CHECK FOR END @V305096 03803000
BL SKIPB CONTINUE SKIPPING BLANKS @V305096 03804000
* 03805000
CR RB,RA INITIAL SCAN FOR BLANKS? @V305065 03806000
L RB,AMSG01 SET ERROR MESSAGE IF SO @V305065 03807000
BE CTLRET IGNORE THIS BLANK CARD @V305096 03808000
* 03809000
CLC PHVERB(6),KENT WAS VERB ENTRY @V305096 03810000
BE ENTALK YES EXIT TO ENTRY ROUTINE @V305096 03811000
* 03812000
CLC PHVERB(8),KINC IF THIS WAS AN INCLUDE CARD @V305096 03813000
BE CTLRET IGNORE CARD IF NO OPERANDS @V305096 03814000
* 03815000
CLC PHVERB(6),KPHA IF THIS WAS A PHASE CARD @V305096 03816000
BE ERR012 AN OPERAND IS MISSING @V305096 03817000
BR RF EXIT ON INVALID CONTROL CARD@V305096 03818000
* 03819000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 03820000
* 03821000
* R15 S/R TO CHECK FOR CARD EXTENDING BEYOND COL 71 03822000
* 03823000
* RA - SUPPLIES COLUMN TO TEST/ RETURNS COLUMN+1 03824000
* R6- SUPPLIES ADDRESS OF COLUMN 72 03825000
* 03826000
UPDATE AR R6,R0 UPDATE TO NEXT CHARACTER @V305096 03827000
LA R4,E1+71 GET ADDRESS OF COLUMN 72 @V305096 03828000
CR R6,R4 COLUMN 72 @V305096 03829000
BCR 13,RF EXIT IF NOT HIGH @V305096 03830000
* 03831000
L RB,OTHMTX GET CSECT ADDRESS @VA05886 03832000
USING DLKOTH,RB SET ADDRESSABILITY @VA05886 03833000
L RB,AMSG13 INFORM BEYOND COL 71 @V305096 03834000
DROP RB FREE THE REGISTER @VA05886 03835000
B ERROR @V305096 03836000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 03837000
* 03838000
* R14 S/R TO EXTRACT A FIELD FROM THE CONTROL CARD 03839000
* 03840000
* EXITS RE - NON-COMMA DELIMITER 03841000
* RE+4 - COMMA DELIMITER 03842000
* 03843000
* R0 - SUPPLIES CONSTANT OF 1 03844000
* R1 - WORK REGISTER 03845000
* R3 - SUPPLIES MAXIMUM FIELD LENGTH SPECIFICATION 03846000
* R4 - WORK REGISTER 03847000
* R7 - SUPPLIES ADDRESS OF RECIPIENT BUCKET 03848000
* RETURNS ADDRESS OF LAST BYTE IN BUCKET 03849000
* R6 - ADDRESS TO START EXTRACTION 03850000
* RETURNS ADDRESS NON-COMMA DELIMITER OR 03851000
* RETURNS ADDRESS COMMA DELIMITER+1 03852000
* RF - DESTROYED 03853000
* 03854000
EXTRCT LA R3,9 MAXIMUM VALID CHARACTERS @V305096 03855000
LA RB,1(R7) SAVE ADDRESS OF BUCKET IN WHICH @V305096 03856000
* OPERAND IS STORED AS CHECK FOR ERROR 12. 03857000
RESET LA R4,DELIM ADDRESS OF DELIMIT TABLE @V305096 03858000
LA R1,L'DELIM NUMBER OF DELIMITERS @V305096 03859000
* 03860000
FINDEL CLC 0(1,R6),0(R4) TEST INPUT FOR DELIMITER @V305096 03861000
BE FONDEL FOUND DELIMITER @V305096 03862000
* 03863000
AR R4,R0 UPDATE TO NEXT DELIMITER @V305096 03864000
BCT R1,FINDEL FIND THE DELIMITER @V305096 03865000
* 03866000
MVC 1(1,R7),0(R6) MOVE NON DELIMITER TO BUCKET@V305096 03867000
AR R7,R0 UPDATE BUCKET ADDRESS @V305096 03868000
BAL RF,UPDATE UPDATE INPUT POINTER @V305096 03869000
BCT R3,RESET RESET TABLE AND KEEP GOING @V305096 03870000
* 03871000
L RB,AMSG11 OPERAND TOO LONG @V305096 03872000
B ERRNML @V305096 03873000
* 03874000
FONDEL CLI 0(RB),C' ' HAS ANY THING BEEN MOVED @V305096 03875000
BNE CMDEL TEST FOR COMMA DELIMITER @V305096 03876000
* 03877000
ERR012 L RB,AMSG12 OPERAND MISSING @V305096 03878000
TM PHCSW,X'04' TEST FOR VALID SKIPPED FIELD@V305096 03879000
BZ ERRNML ERROR IF NOT ON @V305096 03880000
NI PHCSW,X'FB' RESET SWITCH IF ON @V305096 03881000
* 03882000
CMDEL CLI 0(R6),C',' WAS DELIMITER A COMMA @V305096 03883000
BCR 7,RE EXIT ON NON COMMA @V305096 03884000
* 03885000
BAL RF,UPDATE UPDATE TO NEXT CHARACTER @V305096 03886000
B 4(RE) EXIT @V305096 03887000
EJECT 03888000
************************************************************** 03889000
* CONSTANTS USED BY CONTROL CARD SCANNER 03890000
************************************************************** 03891000
* 03892000
* TRANSLATE AND TEST INSTRUCTION USED TO VERIFY 03893000
* PHASE NAME 03894000
* 03895000
TRT TRT PHNAME(0),TRTTAB @V305096 03896000
* 03897000
* TABLE USED FOR TRT INSTRUCTION 03898000
* 03899000
TRTTAB DC 256X'FF' . @V305096 03900000
ORG TRTTAB+C'$' VALID CHARACTERS @V305096 03901000
DC 1X'00' $ @V305096 03902000
ORG TRTTAB+C'/' VALID CHARACTERS @V305096 03903000
DC X'00' / @V305096 03904000
ORG TRTTAB+C'#' VALID CHARACTERS @V305096 03905000
DC 2X'00' # @ @V305096 03906000
ORG TRTTAB+C'A' VALID CHARACTERS @V305096 03907000
DC 9X'00' A B C D E F G H I @V305096 03908000
ORG TRTTAB+C'J' VALID CHARACTERS @V305096 03909000
DC 9X'00' J K L M N O P Q R @V305096 03910000
ORG TRTTAB+C'S' VALID CHARACTERS @V305096 03911000
DC 8X'00' S T U V W X Y Z @V305096 03912000
ORG TRTTAB+C'0' VALID CHARACTERS @V305096 03913000
DC 10X'00' 0 1 2 3 4 5 6 7 8 9 @V305096 03914000
* 03915000
* 03916000
ORG , @V305096 03917000
KCAT DC C'CATALR ' @V305096 03918000
KPHA DC C'PHASE ' @V305096 03919000
KACT DC C'ACTION ' @V305096 03920000
KINC DC C'INCLUDE ' @V305096 03921000
KENT DC C'ENTRY ' @V305096 03922000
KNOAUTO DC C'NOAUTO ' CONSTANTS @V305096 03923000
KPBDY DC C'PBDY ' SCAN OF @V305096 03924000
CHARALL DC CL4'ALL' USED TO VALIDATE PH NAME@V305096 03925000
* 03926000
DELIM DC C',= +-()''' SET OF DELIMITERS @V305096 03927000
* 03928000
CNVBUC DC 8C' ' BUCKET FOR STORING DECIMAL CHARS @V305096 03929000
* 03930000
PHCSW DC X'0' PHASE CARD PROCESSER SWITCH @V305096 03931000
* X'01' IF DISP DELIM NON-COMMA 03932000
* X'02' IF DISP SIGN NEGATIVE 03933000
* X'04' IF FIRST FIELD IN INCLUDE OP 03934000
* 03935000
TITLE 'DLKSCN LINKAGE EDITOR PROCESS INCLUDE CARDS - $LNKEDT - DOS' 03936000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 03937000
* 03938000
* INCLUDE PROCESSOR 03939000
* 03940000
INCLPR LA R6,PHNAME NAME OF MODULE TO SEARCH FOR@V305096 03941000
* 03942000
MVC INCSAV(80),E1 IN THE CASE OF ERRORS ON INCLUDE @V305096 03943000
* STATEMENTS, SPECIAL ARRANGEMENTS 03944000
* HAVE TO BE MADE AS THE I/O AREA IS 03945000
* USED TO READ IN DIRECTORY - BUT AS 03946000
* CONTROL CARDS CANNOT BE BLOCKED IT 03947000
* IT IS POSSIBLE TO RETAIN IT FOR 03948000
* LISTING PURPOSES IN CASE OF ERROR 03949000
* 03950000
INCGET NI ALNKSW2+DEC1,HEXF RESET EXLOAD SUBR TO USE @V305096 03951000
* NORMAL ENTRYPOINT 03952000
LA R2,INPBLK RELOCATE THE ADCON IN THE @V305096 03953000
ST R2,READRD CCW TO READ RELOCATABLE @V305096 03954000
MVI READRD,HEX6 DIRECTORY @V305096 03955000
TM RELPVT,X'FE' PRIVATE REL LIB ASSIGNED@V305096 03956000
BO INCGET1 NO, GO TEST FOR CMS TEXT@V305096 03957000
LA R2,RELPVT START ADDR OF PRIV REL LIB @V305096 03958000
MVC DSKCCB,PRVADDR SYSRLB LOGICAL UNIT TO CCB @V305096 03959000
OI PVTSW,X'0F' @VA09417 03959500
B INCGET2 @V305096 03960000
* 03961000
INCGET1 EQU * @V305065 03962000
USING FSCBD,R1 @V305065 03963000
LA R1,DOSTXT POINT TO DOSTXT PLIST @V305065 03964000
LM R2,R3,FSCBFN SAVE PREVIOUS FILENAME @V305065 03965000
MVC FSCBFN,0(R6) GET FILENAME @V305065 03966000
FSSTATE ,FSCB=(1),ERROR=SYSLIB1 CHECK IF FILE EXISTS @V305065 03967000
OI CMSSWT1,DOSTXTSW INDICATE DOS TEXT @V305065 03968000
LR RF,R1 POINT TO FSTB @V305065 03969000
B ALKFND1 @V305065 03970000
SYSLIB1 EQU * @V305065 03971000
STM R2,R3,FSCBFN RESTORE PREV. FILENAME @V305065 03972000
MVC DSKCCB,RESADDR FORCE SYSTEM RELO LIBRARY @V305096 03973000
CLI RELDST,UNASSGN IF RELO LIBRARY NOT ASSIGNED@V305096 03974000
BNE INCGET1A SETUP TO SEARCH SYSTEM RELO @V305096 03975000
MSGSW B ALKERR SWITCH USED FOR CORRECT MSG.@V305096 03976000
OI MSGSW+1,X'F0' RESET SWITCH @V305096 03977000
B INCLERR THERE MUST BE AN INVALID SEARCH @V305096 03978000
* 03979000
INCGET1A LA R2,RELDST START ADDRESS OF REL LIB @V305096 03980000
NI PVTSW,X'00' @VA09417 03980500
INCGET2 MVC CYLFCT(4),FCTREL FACTORS TO OVERFLOW ON @V305096 03981000
MVC DSKWHT(8),READRD CCW TO READ RELOC DIRECTORY @V305096 03982000
* 03983000
LA RA,INPBLK INITIALISE SCAN OF BLOCK @V305096 03984000
LA RA,80(,RA) @V305065 03985000
LA R3,HDFCT1ST 1ST DIR BLK HAS 15 ENTRIES @V305096 03986000
INCREE MVC ADRESS,DEC0(R2) INIT.READING DIR. BLOCK @V305096 03987000
LH R1,DSKCCB GET DEVICE ADDRESS @V305065 03988000
LA RF,1 INDICATE ONE READ @V305065 03989000
BAL RE,DISKRDWR CALL DISKIO S/R @V305096 03990000
* 03991000
CH R3,K15 FIRST DIR. BLOCK? @V305065 03992000
BNE INCLOP BRANCH IF NOT @V305065 03993000
CLC DSKCCB,PRVADDR IS THIS PRIVATE RELOC? @V305065 03994000
BNE INCLOP BRANCH IF NOT @V305065 03995000
CLC RELPVT,INPBLK+2 ARE DISK ADDRESSES THE SAME? @V305065 03996000
BE INCLOP @VA06193 03997000
CLC RELDST,INPBLK+2 CHECK FOR SYSTEM RLB @VA06193 03998000
BNE ERR094 @VA06193 03999000
* 04000000
INCLOP CLC E1(8),0(R6) IF NAMES = GOTO PROC INCLUDE@V305096 04001000
BE ALKFND2 @V305096 04002000
* 04003000
CLI E1,C'*' IF END OF DIR FOUND, BOOK @V305096 04004000
BE SYSLIB REQUESTED NOT IN LIBRARY @V305096 04005000
LA RA,16(RA) CONT LOOPNG IN BLK FOR EQUAL@V305096 04006000
BCT R3,INCLOP UNTIL ALL RECORDS TESTED @V305096 04007000
* 04008000
LA R2,ADRESS POINT TO DISK ADDRESS @V305065 04009000
BAL RE,AD1DSK INCREMENT TO NEXT BLOCK @V305096 04010000
LA R2,NEWDAD DISK ADDR OF NEXT DIR BLK @V305096 04011000
* 04012000
LA RA,INPBLK START OF DIRECTORY BLOCK @V305096 04013000
LA R3,20 REL DIR BLK HAS 20 ENTRIES @V305096 04014000
B INCREE GO TO READ NEXT BLOCK @V305096 04015000
* 04016000
ALKFND1 EQU * @V305065 04017000
TM PERISW,CMSTXT IS THIS DOS TEXT? @V305065 04018000
BZ ALKFND1A BRANCH IF NOT @V305065 04019000
STM R2,R3,PERIDA+2 SAVE DOSTXT NAME @V305065 04020000
LA R1,DOSTXT POINT TO PLIST @V305065 04021000
MVC PERIDA(2),ONS000 SAVE NEXT RECORD NUMBER @V305065 04022000
MVC PERIDA+10(2),ITMCNT SAVE ITEM COUNT @V305065 04023000
ALKFND1A EQU * @V305065 04024000
USING FSTSECT,RF @V305065 04025000
MVC ITMCNT,FSTIC MOVE IN CURRENT TEXT COUNT @V305065 04026000
DROP RF @V305065 04027000
B ALKFND @V305065 04028000
ALKFND2 EQU * @V305065 04029000
TM PERISW,CMSTXT IS THIS DOS TEXT? @V305065 04030000
BZ ALKFND BRANCH IF NOT @V305065 04031000
MVC PERIDA+10(2),ITMCNT SAVE TEXT ITEM COUNT @V305065 04032000
LA R1,DOSTXT POINT TO DOSTXT PLIST @V305065 04033000
MVC PERIDA+2(8),FSCBFN MOVE IN FILENAME @V305065 04034000
MVC PERIDA(2),ONS000 SAVE NEXT RECORD NUMBER @VM03218 04035000
DROP R1 @V305065 04036000
ALKFND CLI PHVERB,C'I' IF INCLUDE VERB IN FIELD @V305096 04037000
BE INCFND INCLUDE STATEMENT SERVICED @V305096 04038000
* 04039000
MVC W1(DEC4),KLIST @V305096 04040000
MVC W8(DEC8),KATLNK IDENTIFY AS AUTOLINK @V305096 04041000
MVC W19(DEC8),0(R6) MODULE NAME @V305096 04042000
BAL R6,PRINT PRINT ONTO SYSLST @V305096 04043000
* 04044000
INCFND TM ENDPER,X'FF' IF ON, THIS INDICATES THAT @V305096 04045000
L RB,AMSG32 @V305096 04046000
BNZ INCERR THERE'S NO ROOM TO PUSH DOWN@V305096 04047000
* 04048000
LA R2,(LNTPRDA+L'PERISW)*NESTNG @V305096 04049000
* LENGTH OF AREA TO BE SHIFTED 04050000
SHIFT6 IC R0,PERIDA-DEC1(R2) LOOP AROUND,LOWERING LEVEL OF@V305096 04051000
STC R0,PERIDA+LNTPRDA(R2) NESTING BY 1 THRU USE OF @V305096 04052000
BCT R2,SHIFT6 THE PUSH DOWN LIST @V305096 04053000
TM CMSSWT1,DOSTXTSW IS THIS CMS TEXT? @V305065 04054000
BZ INCNOTXT BRANCH IF NOT @V305065 04055000
MVC PERIDA(2),K1 MOVE IN RECORD COUNT @V305065 04056000
B INCPERSW @V305065 04057000
INCNOTXT EQU * @V305065 04058000
* 04059000
** E11 CONTAINS DISK ADDRESS OF REL MODULE 04060000
*** IN C2,C1,H,R FORMAT. 04061000
** IT IS MOVED TO PERIDA IN THE FORMAT CCHHR 04062000
* 04063000
MVC PERIDA(DEC1),E12 C1 @V305096 04064000
MVC PERIDA+DEC1(DEC1),E11 C2 @V305096 04065000
MVI PERIDA+DEC2,HEX0 H1 ALLWAYS ZERO @V305096 04066000
MVC PERIDA+DEC3(DEC2),E13 H2,R @V305096 04067000
INCPERSW EQU * @V305065 04068000
MVC PERISW,NMSBSW SAVE SWITCH SHOWING IF THIS @V305096 04069000
* IS A NAMED SUBMODULAR OR AN 04070000
* AUTOLINK INCLUDE 04071000
TM CMSSWT1,FSTSW THIS THE FIRST FILE? @V305065 04072000
BZ SETPER BRANCH IF NOT @V305065 04073000
NI CMSSWT1,255-FSTSW REMOVE FIRST SWITCH @V305065 04074000
OI PERISW,FSTFILE INDICATE IN PERISW @V305065 04075000
SETPER EQU * @V305065 04076000
MVC ONS000,PERIDA CURRENT INPUT IS REL MODULE @V305096 04077000
TM CMSSWT1,DOSTXTSW IS THIS CMS TEXT? @V305065 04078000
BZ NODOSTXT BRANCH IF NOT @V305065 04079000
NI CMSSWT1,255-DOSTXTSW TURN OFF SWITCH @V305065 04080000
MVI RDS00A+1,X'F0' INDICATE CMSREAD @V305065 04081000
OI PERISW,CMSTXT PERISW ALSO @V305065 04082000
B NOPRIV @V305065 04083000
NODOSTXT EQU * @V305065 04084000
MVI RDS00A+1,X'00' REMOVE CMSREAD SWITCH @V305065 04085000
* 04086000
OI RELBSW+1,X'F0' SET SW TO ACCEPT LIB INPUT @V305096 04087000
CLC DSKCCB,PRVADDR TEST FOR PRIV LIBRARY @V305065 04088000
BNE NOPRIV @V305096 04089000
NI PVLBSW+1,X'00' SET SW FOR PRIV LIB INPUT @V305096 04090000
OI PERISW,HEX4 SET SW FOR PRIV LIB INPUT @V305096 04091000
MVC DSKCCB,RESADDR SET UP ADDRESS FOR SYSRES @V305065 04092000
NOPRIV B CTLRET @V305096 04093000
* 04094000
*** ERROR CONDITION IN INCLUDE PROCESSOR 04095000
* 04096000
INCLERR TM PERISW,HEX4 SYSRLB INPUT @V305096 04097000
BZ ALKERR NO.... @V305096 04098000
NI PVLBSW+1,X'00' SET SW. FOR PRIV. RELO. INPUT@V305096 04099000
ALKERR EQU * @V305065 04100000
L RB,AMSG31 POINT TO MESSAGE @V305065 04101000
CLI PHVERB,C'I' FI AUTOLNK IN PROGRESS IGNORE@V305096 04102000
BNE ALNKPR FOUND CONDITIONS @V305096 04103000
* 04104000
INCERR LA RA,INCSAV GIVE ERROR RTNE ADDR OF @V305096 04105000
* THE RETAINED INCLUDE STATEMENT 04106000
CLC PERIDA,ESD000 IF WE HAVE RET'D TO MODULE @V305096 04107000
BNE INCERR1 ON DOSLNK, THEN WE MUST @V305096 04108000
MVC ONS000,NDS000 SKIP TO ITS END. @V305096 04109000
INCERR1 EQU * @V305096 04110000
TM NMSBSW,X'02' IF ERROR ON NAMED SUB-MOD, THEN @V305096 04111000
BZ ERROR THE NAME LIST MUST BE CLEARED. @V305096 04112000
MVI NMELST,C' ' CLEAR NAME LIST @V305096 04113000
MVC NMELST+1(DEC39),NMELST @V305096 04114000
NI SBMDST,X'FF'-HEX1 RESET SBMDST SWITCH @V305096 04115000
B ERROR @V305096 04116000
* 04117000
SYSLIB CLC DSKCCB,PRVADDR TEST FOR PRIVATE REL LIB@V305096 04118000
BNE INCLERR NO,GO PRINT ERROR 04118600
CLI PVTSW,X'0F' PRIVATE OR SYSTEM LIB @VA09417 04119200
BNE INCLERR PRINT ERROR @VA09417 04119800
NI MSGSW+1,X'00' SET SW FOR CORRECT MSG 04120400
OI PVLBSW+1,X'F0' SET SW FOR SYSRES LIB INPUT @V305096 04121000
B INCGET1 BRANCH @V305096 04122000
PVTSW DC X'00' SET TO 0F IF PRIVATE @VA09417 04122500
EJECT 04123000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 04124000
* 04125000
* CONSTANTS USED ONLY BY INCLUDE STATEMENT PROCESSOR 04126000
* 04127000
INCSAV DC CL80' ' SAVEAREA FOR INCLUDE RECS @V305096 04128000
* 04129000
KATLNK DC C'AUTOLINK' @V305096 04130000
* 04131000
* 04132000
** TABLE TO PROVIDE ADDRESSABILITY TO ERROR MESSAGES 04133000
* 04134000
DS 0F @VA05886 04135000
AMSG01 DC YL1(L'MSG01-DEC1) LENGTH OF MESSAGE MIN 1 @VA05886 04136000
DC AL3(MSG01) ADDRESS OF ERROR MESSAGE @VA05886 04137000
AMSG10 DC YL1(L'MSG10-DEC1) LENGTH OF MESSAGE MIN 1 @VA05886 04138000
DC AL3(MSG10) ADDRESS OF ERROR MESSAGE @VA05886 04139000
AMSG11 DC YL1(L'MSG11-DEC1) LENGTH OF MESSAGE MIN 1 @VA05886 04140000
DC AL3(MSG11) ADDRESS OF ERROR MESSAGE @VA05886 04141000
AMSG12 DC YL1(L'MSG12-DEC1) LENGTH OF MESSAGE MIN 1 @VA05886 04142000
DC AL3(MSG12) ADDRESS OF ERROR MESSAGE @VA05886 04143000
AMSG14 DC YL1(L'MSG14-DEC1) LENGTH OF MESSAGE MIN 1 @VA05886 04144000
DC AL3(MSG14) ADDRESS OF ERROR MESSAGE @VA05886 04145000
AMSG21 DC YL1(L'MSG21-DEC1) LENGTH OF MESSAGE MIN 1 @VA05886 04146000
DC AL3(MSG21) ADDRESS OF ERROR MESSAGE @VA05886 04147000
AMSG25 DC YL1(L'MSG25-DEC1) LENGTH OF MESSAGE MIN 1 @VA05886 04148000
DC AL3(MSG25) ADDRESS OF ERROR MESSAGE @VA05886 04149000
AMSG31 DC YL1(L'MSG31-DEC1) LENGTH OF MESSAGE MIN 1 @VA05886 04150000
DC AL3(MSG31) ADDRESS OF ERROR MESSAGE @VA05886 04151000
AMSG32 DC YL1(L'MSG32-DEC1) LENGTH OF MESSAGE MIN 1 @VA05886 04152000
DC AL3(MSG32) ADDRESS OF ERROR MESSAGE @VA05886 04153000
AMSG33 DC YL1(L'MSG33-DEC1) LENGTH OF MESSAGE MIN 1 @VA05886 04154000
DC AL3(MSG33) ADDRESS OF ERROR MESSAGE @VA05886 04155000
AMSG61 DC YL1(L'MSG61-DEC1) LENGTH OF MESSAGE MIN 1 @VA05886 04156000
DC AL3(MSG61) ADDRESS OF ERROR MESSAGE @VA05886 04157000
LTORG , @V305096 04158000
DS 0D @V305096 04159000
TITLE 'DLKCTL - PROCESS PHASE AND ENTRY - $LNKEDT - DOS' 04160000
******************************************************************** 04161000
******************************************************************** 04162000
* 04163000
* CSECT DLKCTL - END OF PHASE/ENTRY PROCESSING 04164000
* CALLED BY DLKSCN * 04165000
*ENTRY POINTS - DLKCTL- BUILDS CURRENT PHASE ENTRY. IF NOT 04166000
* FIRST PHASE IT MOVES THE CURRENT PHASE ENTRY OF PREVIOUS 04167000
* PHASE TO THE CONTROL DICTIONARY. 04168000
* * 04169000
* INPUT - N/A 04170000
* * 04171000
*OUTPUT - PHASE ENTRY IN C/D 04172000
* * 04173000
*EXITS-NORMAL - TO RDNEXT AFTER NEW PHASE 04174000
* TO DLKRLD AFTER ENTRY 04175000
* -ERROR -- ERROR MSG NOS. RESULTING FROM THIS PHASE ARE 2121-2122* 04176000
* 2123-2124-2181-2182-2192-2193 04177000
* * 04178000
*TABLES/WORK AREAS - EXPLAINED IN COMMENTS OF CSECT DMSDLK 04179000
* * 04180000
*ATTRIBUTES - N/A * 04181000
* * 04182000
*********************************************************************** 04183000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 04184000
* 04185000
DLKCTL CSECT PHASE ENTRY PROC @V305096 04186000
USING *,RD @V305096 04187000
* 04188000
CLI PHVERB,E TEST FOR ENTRY CARD @V305096 04189000
BNE FIRSTPH NO, SO IT IS PHASE @V305096 04190000
CLI CTLDNO,HEXFF ANYTHING PROCESSED ? @V305096 04191000
BE ERR081 NO TEXT IN PHASE @V305096 04192000
B MOVENTRY MOVE CURR ENTRY TO C/D @V305096 04193000
* 04194000
FIRSTPH CLI CTLDNO,HEXFF IS IT FIRST PHASE @V305096 04195000
BE PHSPRC YES, BYPASS MOVE @V305096 04196000
* 04197000
** MOVE CURRENT PHASE ENTRY TO C/D 04198000
* 04199000
MOVENTRY L R9,PHSADD LOAD BASE FOR C/D @V305096 04200000
MVC CDENTRY(2*CDLNGTH),CPHENT @V305096 04201000
* 04202000
CLI PHVERB,E TEST FOR ENTRY CARD @V305096 04203000
BE FINPRO GO TO FINAL PROC @V305096 04204000
* 04205000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 04206000
* 04207000
*** PHASE PRE-PROCESSOR 04208000
* 04209000
PHSPRC CLI PHNAME,C'$' IF ANY PHASE IF $ TYPE SET SW @V305096 04210000
BNE *+8 AS INDICATOR FOR PASS 2 @V305096 04211000
OI DPNTSW,X'40' @V305096 04212000
* 04213000
SR R3,R3 ZERO ORIGIN @V305096 04214000
OI MAPSW,HEX8 ASSUME NEW PHASE TO BE RELOC@V305096 04215000
* 04216000
CLI CTLDNO,X'FF' TEST IF 1ST PHASE ENCOUNT'RD@V305096 04217000
BNE NOT1ST @V305096 04218000
* 04219000
CLC SYMBOL(5),KROOT TEST FOR ROOT (SPEC SIGNIF. @V305096 04220000
BNE NTROOT IN 1ST PHASE) @V305096 04221000
* 04222000
MVI ROOTNO+1,X'01' SETUP C/D # VALUES VALID FOR ROOT@V305096 04223000
ST R3,CTLDNO STRUCTURE @V305096 04224000
L R3,EOSPVR FORCE ROOT TO ORIGIN AT EOS @V305096 04225000
B ISROOT ACCEPT ROOT AT EOS ONLY @V305096 04226000
* 04227000
NOT1ST LA R6,PHNAME TEST FOR DUPLICATE PHASE NAMES IN@V305096 04228000
BAL RF,SRCHCD C/D @V305096 04229000
* 04230000
B NTROOT VALID PHASE NAME TO CHECK ORIGIN @V305096 04231000
* 04232000
TM ESDTYPD,PH IF NOT A PHASE @V305096 04233000
BNO SRPCOD CONTINUE SCAN @V305096 04234000
L RB,AMSG20 PHASENAME DUPLICATED @V305096 04235000
B ERROR @V305096 04236000
* 04237000
NTROOT CLI SYMBOL,BLANK CHECK IF ANY BASE ORIGIN @V305096 04238000
BNE SYMBORG YES @V305096 04239000
NI MAPSW,HEXFF-HEX8 NO, NEW PHASE NOT RELOCATABL@V305096 04240000
B ISDISP ABSOL. ADDRESS IN PHASE CARD@V305096 04241000
SYMBORG L R3,EOSPVR ACCEPT S AS MEANING END OF SPVR @V305096 04242000
CLC SYMBOL(2),KS @V305096 04243000
BE CHEKQU @V305096 04244000
* 04245000
L R3,NXPHRG ASSUME END OF PREVIOUS PHASE@V305096 04246000
CLC SYMBOL(2),KASTER IN CASE OF 1ST IT IS EOS @V305096 04247000
BNE SCSYM1 @V305096 04248000
CLI CTLDNO,HEXFF FIRST PHASE @V305096 04249000
BE CHEKQU YES, RELOCATABLE @V305096 04250000
L R9,PHSADD NO,SET BASE FOR CDENTRY @V305096 04251000
TM PHTYPED,RELPHASE OF PREV PHASE. IF NOT @V305096 04252000
BO CHEKQU RELOCATABLE, THE NEW @V305096 04253000
NI MAPSW,HEXFF-HEX8 PHASE WILL ALSO BE @V305096 04254000
* NOT RELOCATABLE 04255000
CHEKQU CLI QUALIF,C' ' DO NOT ACCEPT * OR S IF A @V305096 04256000
BE ISDISP QUALIFIER IS PRESENT @V305096 04257000
* 04258000
*** SYMBOLIC ORIGIN 04259000
* 04260000
SCSYM1 CLI CTLDNO,X'FF' IF SYMBOL PRESENT IN FIRST PHASE @V305096 04261000
BNE SCNSYM SRCHCD CANNOTT HANDLE @V305096 04262000
* 04263000
ERR022 L RB,AMSG22 ORIGIN NOT DEFINED @V305096 04264000
B ERROR @V305096 04265000
* 04266000
SCNSYM LA R6,SYMBOL SEARCH C/D FOR LABEL ORIGIN @V305096 04267000
BAL RF,SRCHCD @V305096 04268000
* 04269000
NODUPL EQU * IF NO DUPLICATE MUST BE ERROR @V305096 04270000
B ERR022 @V305096 04271000
* 04272000
CLI ESDTYPD,SD IF DUPLICATE IS ER @V305096 04273000
BE ACCEPT CM OR AN UN- @V305096 04274000
TM ESDTYPD,PH ASSIGNED LD OR LR @V305096 04275000
BO ACCEPT CONTINUE SCAN @V305096 04276000
CLI ESDTYPD,LD OF C/D AS LABEL @V305096 04277000
BE TSTAS MAY APPEAR AS A @V305096 04278000
CLI ESDTYPD,LR PRIOR ENTRY IN THE @V305096 04279000
BNE SRPCOD C/D ( E G AS A @V305096 04280000
TSTAS TM SWITCHD,UNASSG PHASE ENTRY ) @V305096 04281000
BO SRPCOD BRANCH TO CONT SCAN @V305096 04282000
ACCEPT EQU * @V305096 04283000
* 04284000
STM R8,R9,DBLWRD RETAIN POS. IN C/D, MAY NEED IT @V305096 04285000
L R3,ORPHRGD ASSUME SYMBOL IS PH @V305096 04286000
* AND SAVE ORIGIN 04287000
OI MAPSW,HEX8 ASSUME RELOCATABLE PHASE @V305096 04288000
TM ESDTYPD,PH IF PHASE ENTRY @V305096 04289000
BO CHQUAL CHECK QUALIFIER @V305096 04290000
* 04291000
SR R3,R3 @V305096 04292000
ICM R3,B'0111',ASSORGD SAVE ASSEMBLED ORIGIN @V305096 04293000
CLI ESDTYPD,SD IS IT A CSECT @V305096 04294000
BE EXTRF YES, BRANCH @V305096 04295000
LH R8,CSNUMD EXTRACT R/F @V305096 04296000
LA RF,*+4 IF NOT AN SD, BYPASS MULTI @V305096 04297000
B LTCDNO EXITS @V305096 04298000
EXTRF L R7,RELFACD GET R/F FOR SD @V305096 04299000
AR R3,R7 ADD R/F TO ASSEMBLED ORIGIN @V305096 04300000
* 04301000
BAL RE,XTPHNO EXTRCT PHASE NR C/D ENTRY BELONGS@V305096 04302000
LR R9,R2 TO @V305096 04303000
NI NOSCAGAN+DEC1,HEXF REMEMBER - NO PHASE ENTRY @V305096 04304000
LA RF,*+DEC4 BYPASS MULTI EXITS @V305096 04305000
B LTCDAD ON CALCULATING C/D ENTRY ADDRESS @V305096 04306000
CHQUAL OI NOSCAGAN+DEC1,HEXF0 THIS WAS PHASE ENTRY @V305096 04307000
TM PHTYPED,RELPHASE IS PHASE RELOC. @V305096 04308000
BO CHQUALIF YES @V305096 04309000
NI MAPSW,HEXFF-HEX8 NO,THEN THE NEW PHASE WILL NOT@V305096 04310000
* BE RELOCATABLE EITHER 04311000
CHQUALIF CLI QUALIF,BLANK IF NO QUALIFIER GO TO ACCEPT@V305096 04312000
BE ISDISP DISPLACEMENT @V305096 04313000
* OTHERWISE, AND IF IT WAS A PHASE- 04314000
NOSCAGAN NOP SCAGAN NAME, THERE MUST BE A DUPLICATE* @V305096 04315000
* SD/LR PRIOR TO THIS C/D ENTRY 04316000
CLC QUALIF(DEC8),PHNAMED IF NO PHASENAME, AND @V305096 04317000
BE ISDISP QUALIFIER AGREES, GO TO ACCEPT @V305096 04318000
* DISPLACEMENT 04319000
* 04320000
SCAGAN LM R8,R9,DBLWRD RESTORE SCAN REGISTERS @V305096 04321000
LA RF,NODUPL RESTORE RETURN REGISTER @V305096 04322000
B SRPCOD CONTINUE SCANNING @V305096 04323000
* 04324000
ISDISP A R3,DISPLC ADD DISPLACEMENT TO BASE @V305096 04325000
L RB,AMSG24 ORIGIN IS NEGATIVE @V305096 04326000
BM ERROR @V305096 04327000
SPACE 1 04328000
TM POPTSW,OPTPBDY PBDY IN PHASE CARD ? @V305096 04329000
BZ ALIGNDW ALIGN ON DW BOUND @V305096 04330000
LA R3,DEC2047(R3) ALIGN ADDRESS TO @V305065 04331000
SRL R3,11 PAGE @V305096 04332000
SLL R3,11 BOUNDARY @V305096 04333000
B ISROOT SET UP C/D ENTRY @V305096 04334000
SPACE 1 04335000
ALIGNDW LA R3,DEC7(R3) ALIGN ADDRESS TO @V305096 04336000
SRL R3,DEC3 DOUBLE-WORD @V305096 04337000
SLL R3,DEC3 BOUNDARY @V305096 04338000
SPACE 1 04339000
ISROOT EQU * @V305096 04340000
* 04341000
**************************************************************** 04342000
** SET UP CURRENT C/D ENTRY FOR NEW PHASE 04343000
**************************************************************** 04344000
* 04345000
MVI ESDTYPC,PH @V305096 04346000
MVC PHNAMEC,PHNAME @V305096 04347000
SR R2,R2 CLEAR FIELDS FOR @V305096 04348000
STH R2,RLDITEMS RELOCATABLE PHASES @V305096 04349000
ST R2,LNKSTRT AND @V305096 04350000
ST R2,RLDBLCKS PHTYPE SWITCH @V305096 04351000
ST R3,ORPHRG @V305096 04352000
ST R3,NXPHRG @V305096 04353000
LTR R3,R3 PHASE ORIGIN ZERO @V305096 04354000
BP NOSELF NO, BRANCH @V305096 04355000
OI PHTYPE,SELFRELO YES, PH SELFRELOCATING @V305096 04356000
NOSELF EQU * @V305096 04357000
* 04358000
CL R3,COMSAV IF PHASE LOAD ADDR LOWER @V305096 04359000
BH DROVER THAN ANY PREVIOUS PHASE @V305096 04360000
ST R3,COMSAV LOAD ADDR, THAN SAVE @V305096 04361000
* IT FOR COMMON BASE CALCULATION 04362000
DROVER EQU * @V305096 04363000
* 04364000
FINPRO CLI PHSNO,HEXFF IF NOT FIRST PHASE @V305096 04365000
BNE SETPHS BYPASS TEST @V305096 04366000
* 04367000
CLI PHVERB,C'P' IF THIS IS PHASE CARD IT IS OK TO@V305096 04368000
BE NEWPHS CONTINUE @V305096 04369000
ERR081 L RB,AMSG81 @V305096 04370000
B ABTERR IF ENTRY NOTHING HAS BEEN PROCESSED @V305096 04371000
* 04372000
SETPHS L R9,PHSADD GET BASE FOR C/D ENTRY @V305096 04373000
* OF PREVIOUS PHASE 04374000
L R2,ORPHRGD IF NO TRANSFER @V305096 04375000
* INFORMATION, ACCEPT 04376000
TM TRFRSW,X'01' PHASE LOAD ADDRESS @V305096 04377000
BZ WRTRFR @V305096 04378000
* 04379000
NI TRFRSW,X'FE' RESET TRANSFER ACCEPTED SWITCH @V305096 04380000
L R2,X5 ASSUME ASSEMBLED TRANSFER ADDRESS@V305096 04381000
LH R8,X15 SET UP ESID TO CHECK AGAINST C/D @V305096 04382000
CLI X17,C' ' @V305096 04383000
BE PHXADD @V305096 04384000
* 04385000
*** TRANSFER ADDRESS IS A LABEL 04386000
* 04387000
LA R6,X17 SCAN C/D FOR TRANSFER LABEL @V305096 04388000
BAL RF,SRCHCD @V305096 04389000
* 04390000
B LABINV LABEL IS INVALID @V305096 04391000
* 04392000
CLI ESDTYPD,ER IF DUPLICATE AN ER, @V305096 04393000
BE SRPCOD CM, UNASSIG LD/LR OR @V305096 04394000
CLI ESDTYPD,CM PHASE CONT SCAN @V305096 04395000
BE SRPCOD C/D FOR PRIOR ENTRY @V305096 04396000
TM ESDTYPD,PH @V305096 04397000
BO SRPCOD . @V305096 04398000
TM ESDTYPD,LD @V305096 04399000
BNO GOON1 ... @V305096 04400000
TM SWITCHD,UNASSG @V305096 04401000
BO SRPCOD @V305096 04402000
* 04403000
GOON1 EQU * @V305096 04404000
ICM R2,B'0111',ASSORGD RETAIN ASSORG @V305096 04405000
CLI ESDTYPD,SD IS IT A CSECT @V305096 04406000
BE GETRF YES, BRANCH @V305096 04407000
LH R8,CSNUMD NO, GET C/D NO FOR LD/LR@V305096 04408000
PHXADD LA RF,GETRF-DEC4 BYPASS MULTI EXITS @V305096 04409000
B LTCDNO GET R/F FOR LD/LR @V305096 04410000
GETRF L R7,RELFACD GET R/F FOR SD @V305096 04411000
AR R2,R7 ADD R/F TO ASSEMBLED ORIGIN @V305096 04412000
* 04413000
WRTRFR L R9,PHSADD LOAD ADDR OF CURRENT @V305096 04414000
* C/D ENTRY IN BASE 04415000
ST R2,TRFRADD ACCEPT TRANSFER ADDR @V305096 04416000
* 04417000
*** OBTAIN C.I. BLOCKS INFORMATION 04418000
* 04419000
L R3,NXPHRGD CALC # OF BYTES IN @V305096 04420000
S R3,ORPHRGD PREV PHASE @V305096 04421000
L RB,AMSG23 LAST PHASE NO TEXT @V305096 04422000
BP CINOBL IF REMAINDER, THERE WAS TEXT IN PHAS @V305096 04423000
* 04424000
CLI PHVERB,C'E' IF ENTRY STATEMENT HAS BEEN READ IT @V305096 04425000
BE ERR081 IS IMPOSSIBLE TO CONTINUE READING@V305096 04426000
B ERROR ELSE STANDARD ERROR ROUTINE TO READ @V305096 04427000
* 04428000
CINOBL SR R2,R2 CLEAR HIGH ORDER OF DIVIDEND@V305096 04429000
LH R4,K1024 CALC NO. OF BYTES IN @V305096 04430000
DR R2,R4 LAST @V305096 04431000
* 04432000
LTR R2,R2 IF THERE IS A REMAINDER GO TO ADD AS @V305096 04433000
BNE *+8 AN ADDITIONAL BLOCK @V305096 04434000
* 04435000
LR R2,R4 SET UP LAST BLOCK TO LOOK LIKE @V305096 04436000
BCTR R3,0 MAXIMUM REMAINDER @V305096 04437000
* 04438000
LA R3,1(R3) ADD 1 TO INCLUDE REMAINDER AS A @V305096 04439000
STH R3,NOBLOKD BLOCK AND STORE @V305096 04440000
STH R2,NOBYTED PHASE INFORMATION @V305096 04441000
SR R3,R3 R3 MUST CONTAIN THE NUMBER @V305096 04442000
* OF ADDITIONAL RLD BLOCKS 04443000
SR R8,R8 @V305096 04444000
TM PHTYPED,RELPHASE IF NOT RELOC. @V305096 04445000
BNO HOWMANY NO NEED TO RESERVE SPACE@V305096 04446000
LA R2,3(,R2) ADD THREE BYTES @V305065 04447000
SRL R2,DEC2 ROUND # OF BYTES IN LAST BLOCK @V305096 04448000
SLL R2,DEC2 TO FULL-WORD BOUNDARY @V305096 04449000
LR R3,R2 @V305096 04450000
LH R2,K1024 GET CORE IMAGE BLOCKSIZE @V305096 04451000
LR R4,R2 AND SAVE IT @V305096 04452000
SR R2,R3 CALC. LAST BLOCKS SPACE FOR RLD @V305096 04453000
LH R3,RLDCNT CALC. TOTAL SPACE NECESSARY @V305096 04454000
SLL R3,DEC2 FOR THIS PHASES RLD INFO @V305096 04455000
CR R2,R3 DOES RLD INFO FIT IN LAST BLOCK @V305096 04456000
BL MOREBLK ALAS, NO @V305096 04457000
SR R3,R3 HURRAH, YES, NO EXTRA RLD BLOCKS @V305096 04458000
B STRLD GO TO FILL RLD CONTROL FIELD@V305096 04459000
* 04460000
*** RLD INFO DOES NOT FIT IN LAST BLOCK, SO CALCULATE 04461000
*** NUMBER OF ADDITIONAL CIL BLOCKS REQUIRED 04462000
* 04463000
MOREBLK SR R3,R2 NO. OF BYTES TO BE PUT INTO @V305096 04464000
* ADDITIONAL BLOCK(S) 04465000
SR R2,R2 CLEAR FOR DIVISION @V305096 04466000
DR R2,R4 DIVIDE NO. OF BYTES BY BLKSIZE @V305096 04467000
* TO GET NO. OF BLOCKS 04468000
LTR R2,R2 IF THERE IS A REMAINDER @V305096 04469000
BZ STRLD ADD 1 TO @V305096 04470000
LA R3,DEC1(R3) BLOCKCOUNT @V305096 04471000
STRLD EQU * @V305096 04472000
* TEMPORARY FIX 04473000
COMRG @V305096 04474000
USING BGCOM,R1 @V305096 04475000
L R4,PARTSTRT @V305096 04476000
SH R4,LABLEN @V305096 04477000
DROP R1 @V305096 04478000
ST R4,LINKSTRD COMPLETE C/D ENTRY @V305096 04479000
* OF PREVIOUS PHASE 04480000
MVC RLDITEMD,RLDCNT NO. OF RLD ITEMS @V305096 04481000
STH R3,RLDBLCKD STORE RLD BLOCKCOUNT @V305096 04482000
SPACE 1 04483000
* 04484000
HOWMANY LH R4,NOBLOKD CALC TOT NO OF BLOCKS @V305096 04485000
AR R4,R3 I.E. TEXT AND RLD @V305096 04486000
SR R2,R2 CLEAR REGISTER @V305065 04487000
ICM R2,DEC3,ORPHDAD GET FIRST RECORD NUMBER @V305065 04488000
AR R4,R2 CALC. NEXT PHS FIRST RECORS @V305065 04489000
STCM R4,DEC3,ORPHDA AND STORE IT @V305065 04490000
CLI PHVERB,E IF NOT AN ENTRY CARD GO TO PROCES@V305096 04491000
BNE NEWPHS NEW PHASE-S INFORMATION @V305096 04492000
* 04493000
*** ON ENTRY CARD EXIT FROM PHASE ROUTINE 04494000
* 04495000
TM MODSTS,X'01' IF STILL IN MODULE THEN ENTRY CARD @V305096 04496000
L RB,AMSG82 ENTRY CARD @V305096 04497000
BO ABTERR IS INVALIDLY POSITIONED @V305096 04498000
* 04499000
MVC X17(8),PHNAME RETAIN POSS OVERRIDING TRANSFER @V305096 04500000
L RD,MAPMTX POINTER TO MAP PROC @V305096 04501000
BR RD AND GO THERE @V305096 04502000
* 04503000
NEWPHS CLC K$$A(DEC3),PHNAME IS IT AN A - TRANSIENT @V305096 04504000
BNE NEWPHSS NO @V305096 04505000
NI MAPSW,HEXFF-HEX8 YES, MUST NOT BE RELOCATABLE@V305096 04506000
NEWPHSS TM MAPSW,HEX4+HEX8 IF ACTION REL IS ON AND IF THE @V305096 04507000
BNO RLDCLEAR FORMAT OF THE PHASE CARD ALLOWS @V305096*04508000
IT, INDICATE RELOC @V305096 04509000
OI PHTYPE,RELPHASE PHASE IN C/D @V305096 04510000
OI MAPSW,HEX10 INDICATE RLD PASS 3 NECESSARY @V305096 04511000
SPACE 1 04512000
RLDCLEAR XC RLDCNT,RLDCNT ZERO RLD ITEMS COUNTER @V305096 04513000
* 04514000
LH R0,ALNKSW SET ALNKSW TO SETTING FOR THIS PHASE@V305096 04515000
SRL R0,1 FROM NOAUTO SETTING & RESET NOAUTO @V305096 04516000
STH R0,ALNKSW SETTING @V305096 04517000
* 04518000
LM R8,R9,CTLDNO OBTAIN NEXT VALID ENTRY IN C/D @V305096 04519000
TM ESDTYPD,PH WAS IT PHASE @V305096 04520000
LA R8,1(R8) @V305096 04521000
LA R9,CDLNGTH(R9) GO TO NEXT AVAIL ENTRY @V305096 04522000
BNO CONT3 NO, CONTINUE @V305096 04523000
LA R8,DEC1(R8) @V305096 04524000
LA R9,CDLNGTH(R9) @V305096 04525000
CONT3 EQU * @V305096 04526000
STM R8,R9,CTLDNO @V305096 04527000
* 04528000
STH R8,PHSNO NEW PHASE-S C/D # @V305096 04529000
ST R9,PHSADD C/D ADDR OF NEW PHASE @V305096 04530000
MVI ESDTYPED,PH RESERVE SPACE FOR @V305096 04531000
* PH ENTRY IN C/D 04532000
CTLRET EQU RDNEXT @V305096 04533000
B RDNEXT @V305096 04534000
* 04535000
LABINV OI DPNTSW,X'80' SET SWITCH FOR INVALID LABEL ON END@V305096 04536000
B SETPHS AND PROCESS AS IF NO TRANSFER @V305096 04537000
EJECT 04538000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 04539000
* 04540000
* CONSTANTS USED ONLY BY CONTROL CARD 04541000
* PHASE 04542000
* ENTRY PROCESSORS 04543000
*********************************************************************** 04544000
KROOT DC C'ROOT ' @V305096 04545000
K$$A DC C'$$A' @V305096 04546000
KASTER DC C'* ' @V305096 04547000
* 04548000
* 04549000
** TABLE TO PROVIDE ADDRESSABILITY TO ERROR MESSAGES 04550000
* 04551000
DS 0F @VA05886 04552000
AMSG20 DC YL1(L'MSG20-DEC1) LENGTH OF MESSAGE MIN 1 @VA05886 04553000
DC AL3(MSG20) ADDRESS OF ERROR MESSAGE @VA05886 04554000
AMSG22 DC YL1(L'MSG22-DEC1) LENGTH OF MESSAGE MIN 1 @VA05886 04555000
DC AL3(MSG22) ADDRESS OF ERROR MESSAGE @VA05886 04556000
AMSG23 DC YL1(L'MSG23-DEC1) LENGTH OF MESSAGE MIN 1 @VA05886 04557000
DC AL3(MSG23) ADDRESS OF ERROR MESSAGE @VA05886 04558000
AMSG24 DC YL1(L'MSG24-DEC1) LENGTH OF MESSAGE MIN 1 @VA05886 04559000
DC AL3(MSG24) ADDRESS OF ERROR MESSAGE @VA05886 04560000
AMSG81 DC YL1(L'MSG81-DEC1) LENGTH OF MESSAGE MIN 1 @VA05886 04561000
DC AL3(MSG81) ADDRESS OF ERROR MESSAGE @VA05886 04562000
AMSG82 DC YL1(L'MSG82-DEC1) LENGTH OF MESSAGE MIN 1 @VA05886 04563000
DC AL3(MSG82) ADDRESS OF ERROR MESSAGE @VA05886 04564000
DS 0D @V305096 04565000
TITLE 'DLKMAP LINKAGE EDITOR PRINT MAP - $LNKEDT - DOS' 04566000
*********************************************************************** 04567000
*********************************************************************** 04568000
* * 04569000
* CSECT DLKMAP - PRINT MAP * 04570000
* * 04571000
*ENTRY POINTS - DLKMAP - CALLED BY DLKCTL * 04572000
* DISPLACES PHS LOAD ADDR BY LENGTH OF COMMON, CALC LOAD ADDR * 04573000
* PRINTS MAP IF REQUESTED * 04574000
* * 04575000
*INPUT - N/A * 04576000
* * 04577000
*OUTPUT - SYSLST, SYSLOG * 04578000
* * 04579000
*EXTERNAL ROUTINES - SEE LIST OF SUBROUTINES IN DMSDLK * 04580000
* * 04581000
*EXITS-NORMAL - DLKRLD 04582000
* -ERROR - TO CANCEL THRU SVC 6, OR TO EOJ THRU SVC 14 DEPENDING * 04583000
* ON OPERATOR RESPONSE TO ERROR MSG. - ERROR MSG NOS. PRODUCED BY * 04584000
* THIS CSECT ARE 2185 * 04585000
* * 04586000
*TABLES/WORK AREAS - EXPLAINED IN COMMENTS OF CSECT DMSDLK * 04587000
* * 04588000
*ATTRIBUTES - N/A * 04589000
* * 04590000
*NOTES - N/A * 04591000
* * 04592000
*********************************************************************** 04593000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 04594000
* 04595000
* ENTRY PROCESSOR 04596000
* 04597000
* 1. COLLECT/ASSIGN COMMON 04598000
* 04599000
* 2. OVERRIDE INITIAL TRANSFER POINT IF REQUIRED 04600000
* 04601000
* 3. MODIFY BY SIZE OF COMMON- PHASE LOAD ADDRESS 04602000
* TRANSFER ADRESS 04603000
* HICORE ADDRESS 04604000
* CSECT RELOCATION FCTR 04605000
* 04606000
* 4. PRINT MAP IF REQUIRED 04607000
* 04608000
DLKMAP CSECT MAP PROCESSOR @V305096 04609000
USING *,RD @V305096 04610000
* 04611000
L R9,CDENT1 INITIALISE SCAN @V305096 04612000
LH R8,ROOTNO @V305096 04613000
* 04614000
TM MAPSW,MAPOP WAS MAP SPECIFIED? @V305065 04615000
BZ SAVCOM BRANCH IF NOT @V305065 04616000
MVC HEADER(HEDLNG),HEDING MOVE HEADER FOR MAP @V305096 04617000
MVC HEADER+1(DEC8),DATE SET DATE IN HEADER @V305096 04618000
MVC LINECNT,ZEROH INIT LINECNT TO INSURE @V305096 04619000
* PRINTING OF HEADER 04620000
TM CMSSWT1,MAPPRT WAS PRINT SPECIFIED? @V305065 04621000
BO SAVCOM BRANCH IF YES @V305065 04622000
TM CMSSWT1,MAPTYP WAS TYPE SPECIFIED? @V305065 04623000
BZ DISKHEAD BRANCH IF NOT @V305065 04624000
WRTERM HEADER+1,HEDLNG-1 TYPE HEADER LINE @V305065 04625000
B SAVCOM @V305065 04626000
DISKHEAD EQU * @V305065 04627000
USING FSCBD,R1 @V305065 04628000
FSWRITE ,FSCB=DOSMAP,BUFFER=HEADER+1,ERROR=WRITER @V305065 04629000
MVC FSCBBUFF,=A(W1) RESTORE BUFFER ADDRESS @V305065 04630000
DROP R1 @V305065 04631000
SAVCOM EQU * @V305065 04632000
* 04633000
L R5,COMSAV BASE FOR COMMON CALCULATION @V305096 04634000
* 04635000
SCNCMN C R9,CTLDAD IF NOT END OF C/D CHECK FOR CM @V305096 04636000
BNE COMCHK @V305096 04637000
* 04638000
S R5,COMSAV ALIGN COMMON R/F ATTRIBUTE @V305096 04639000
ST R5,COMNRF AND SAVE IT @V305096 04640000
* 04641000
LH R8,ROOTNO INITIALISE REGISTERS TO SCAN FOR @V305096 04642000
L R9,CDENT1 PHASE @V305096 04643000
OI MPLDSW+1,X'F0' SET SW TO PROC ENTRY-S IN CSECT @V305096 04644000
B PHSTOR @V305096 04645000
* 04646000
COMCHK LA R9,CDLNGTH(R9) IF NOT CM SCAN AGAIN @V305096 04647000
LA R8,1(R8) @V305096 04648000
CLI ESDTYPD,CM @V305096 04649000
BNE SCNCMN @V305096 04650000
ST R5,RELFACD SUPPLY ADDRESS @V305096 04651000
* OF COMMON 04652000
MVC BUCK3(DEC3),LNGTHD GET LENGTH OF CM @V305096 04653000
A R5,BUCK4 ALIGN @V305096 04654000
* ALIGN 04655000
LA R5,DEC7(R5) ALIGN TO @V305096 04656000
SRL R5,DEC3 DOUBLEWORD @V305096 04657000
SLL R5,DEC3 BOUNDARY @V305096 04658000
* 04659000
*** PRINT COMMON 04660000
* 04661000
STM R8,R9,CSBUCK SAVE FOR RETURN FROM ENTRY @V305096 04662000
MVC W1(6),KCOMON IDENTIFY @V305096 04663000
MVC W52(3),KCOMON @V305096 04664000
MVC W62(DEC8),NAMED LABEL @V305096 04665000
* 04666000
L R3,RELFACD CONVERT LOAD ADDRESS @V305096 04667000
LA R1,W72 @V305096 04668000
BAL RF,CNVBIN @V305096 04669000
* 04670000
L R3,LNGTHD-DEC1 CONVERT LENGTH @V305096 04671000
LA R1,W80 @V305096 04672000
BAL RF,CNVBIN @V305096 04673000
* 04674000
TM MAPSW,MAPOP MAP REQUESTED @V305096 04675000
BZ CLRCMN NO, SKIP PRINTING @V305096 04676000
* 04677000
BAL R6,SPACE1 SPACE 1 LINE A PRINT @V305096 04678000
BAL R6,PRINT @V305096 04679000
* 04680000
CLRCMN XC LNGTHD(DEC3),LNGTHD ZERO LENGTH @V305096 04681000
B MAPLDR @V305096 04682000
* 04683000
*** PROCESS PHASE ENTRY 04684000
* 04685000
MAPHAS LM R8,R9,PHSBUK INITIALISE SCAN FOR NEXT PHASE @V305096 04686000
* 04687000
PHSCAN C R9,CTLDAD IF END OF C/D GO TO PRINT EXTERN-S @V305096 04688000
BE PREXTN @V305096 04689000
LA R9,CDLNGTH(R9) IF NOT PHASE, @V305096 04690000
LA R8,1(R8) @V305096 04691000
TM ESDTYPD,PH IF NOT PHASE @V305096 04692000
BNO PHSCAN SCAN AGAIN @V305096 04693000
* 04694000
PHSTOR STM R8,R9,PHSBUK RETAIN REGISTERS FOR SCAN RETURN @V305096 04695000
* 04696000
CLI X17,C' ' IF NO OVERRIDING TRANSFER, BYPASS@V305096 04697000
ADMDSW NOP PHADMD SWITCH SET AFTER FIRST TIME THROUGH @V305096 04698000
BE NOTRFR @V305096 04699000
* 04700000
*** CALCULATE OVERRIDING TRANSFER ADDRESS OFF ENTRY 04701000
* 04702000
LA R6,X17 SCAN C/D FOR DUPLICATE LABEL@V305096 04703000
BAL RF,SRCHCD @V305096 04704000
* 04705000
ESIXTA B ESIXTY LABEL ON ENTRY NOT DEFINED @V305096 04706000
* 04707000
* IF DUPLICATE IS ER, CM, PH OR AN UNASSIGNED LD/LR 04708000
* IT CANNOT BE USED AND SCAN FOR PRIOR ENTRY IS 04709000
* CONTINUED. 04710000
CLI ESDTYPD,SD @V305096 04711000
BE ACCEPTD ACCEPT DUPLICATE @V305096 04712000
CLI ESDTYPD,LD @V305096 04713000
BE TSTASGN TEST IF ASSIGNED @V305096 04714000
CLI ESDTYPD,LR @V305096 04715000
BNE SRPCOD CONTINUE SCAN @V305096 04716000
TSTASGN TM SWITCHD,UNASSG @V305096 04717000
BO SRPCOD @V305096 04718000
ACCEPTD EQU * @V305096 04719000
BAL RE,XTPHNO MAKE SURE LABEL IS IN THE FIRST @V305096 04720000
LA RF,ESIXTA PHASE @V305096 04721000
CH R2,ROOTNO @V305096 04722000
BNE SRPCOD @V305096 04723000
MVC X6(DEC3),ASSORGD SAVE ASSORG @V305096 04724000
* FIND RELOCATION FACTOR 04725000
CLI ESDTYPD,SD IS DUPLICATE SD @V305096 04726000
BE GETREL YES, GET R/F DIRECTLY @V305096 04727000
LH R8,CSNUMD NO, GET R/F FROM CONTROL@V305096 04728000
LA RF,GETREL-DEC4 SECTION TO WHICH @V305096 04729000
B LTCDNO LD / LR BELONGS @V305096 04730000
GETREL L R7,RELFACD @V305096 04731000
* 04732000
A R7,X5 ADD ASSENBLED ORIGIN @V305096 04733000
LM R8,R9,PHSBUK SET BASE FOR CDENTRY @V305096 04734000
ST R7,TRFRADD @V305096 04735000
* 04736000
NOTRFR EQU * @V305096 04737000
OI ADMDSW+1,X'F0' SET AVOID SWITCH @V305096 04738000
* 04739000
TM MAPSW,X'01' IF MAP NOT REQUIRED FETCH PASS 2 @V305096 04740000
BZ FCHRLD IMMEDIATELY @V305096 04741000
* 04742000
*** MODIFY ADDRESSES ACCORDING TO COMMON DISPLACEMENT 04743000
* 04744000
PHADMD EQU * @V305096 04745000
LM R6,R7,ORPHRGD MODIFY LOAD ADDRESS @V305096 04746000
AR R6,R5 LAST BYTE ADDRESS @V305096 04747000
AR R7,R5 BY SIZE OF COMMON AREAS RESERVED @V305096 04748000
* 04749000
CL R6,HIROOT CHECK IF THIS PHASE-S LIMITS OVERLAP @V305096 04750000
BNL TRYROT THOSE OF ROOT PHASE @V305096 04751000
CL R7,LOROOT @V305096 04752000
BL TRYROT @V305096 04753000
* 04754000
MVC W1(7),KOVRLY @V305096 04755000
NI OVRLSW+1,X'0F' SET SWITCH TO PRINT ROOT OVERLAID@V305096 04756000
* 04757000
TRYROT CLC K1(2),PHSBUK+2 IF NOT ROOT PHASE CONTINUE @V305096 04758000
BNE MAPHNM @V305096 04759000
* 04760000
MVC W1(4),KROOT1 IDENTIFY AS ROOT @V305096 04761000
STM R6,R7,LOROOT RETAIN ROOT ADDRESSES @V305096 04762000
* 04763000
MAPHNM MVC W9(DEC8),PHNAMED PHASE NAME @V305096 04764000
* 04765000
L R3,TRFRADD CONVERT XFER ADDRESS @V305096 04766000
AR R3,R5 MODIFY BY LENGTH OF COMMON @V305096 04767000
LA R1,W19 @V305096 04768000
BAL RF,CNVBIN @V305096 04769000
* 04770000
LR R3,R6 CONVERT PHASE ORIGIN @V305096 04771000
LA R1,W27 @V305096 04772000
BAL RF,CNVBIN @V305096 04773000
* 04774000
LR R3,R7 CONVERT LAST BYTE ADDRESS @V305096 04775000
BCTR R3,0 @V305096 04776000
LA R1,W35 @V305096 04777000
BAL RF,CNVBIN @V305096 04778000
* 04779000
ICM R3,B'0011',ORPHDAD @V305096 04780000
LA R1,W43 POS. IN OUTPUT AREA @V305096 04781000
LA R0,DEC3 CREATE THREE HEX CHARACTERS @V305096 04782000
SLDL R2,DEC20 PUT MEANINGFULL 12 BITS LEFT@V305096 04783000
* IN REGISTER 3 04784000
BAL RF,CNVLOP CONVERT TO PRINTABLE HEX @V305096 04785000
* 04786000
IC R3,ORPHDAD+DEC3 CONVERT TRACK ADDR @V305096 04787000
LA R1,W46 PLACE TO PUT CONVERTED CHAR @V305096 04788000
LA R0,2 MODIFY FACTORS TO CONVERT ONLY 1 @V305096 04789000
SLDL R2,24 LONG LEFT SHIFT @V305096 04790000
BAL RF,CNVLOP CONVERT TO PRINTABLE CHAR @V305096 04791000
* 04792000
IC R3,ORPHDAD+DEC4 CONVERT RECORD ADDR @V305096 04793000
LA R1,W48+DEC1 CONVERT RECORD NUMBER @V305096 04794000
LA R0,2 TO @V305096 04795000
SLDL R2,24 PRINTABLE @V305096 04796000
BAL RF,CNVLOP FORMAT @V305096 04797000
* 04798000
SELFRLC TM PHTYPED,SELFRELO IS PHASE SELFRELOCATING @V305096 04799000
BNO RELOC NO, TEST FOR REL @V305096 04800000
MVC W88(L'SELFREL),SELFREL INDICATE SELF RELOCATING@V305096 04801000
B MAPCST @V305096 04802000
SPACE 1 04803000
RELOC TM PHTYPED,RELPHASE IF NOT RELOC @V305096 04804000
BNO NOTREL GO @V305096 04805000
MVC W88(L'RELCAT),RELCAT YES, INDICATE REL @V305096 04806000
B MAPCST AND GO. @V305096 04807000
NOTREL MVC W88(L'NRELCAT),NRELCAT INDICATE NOT RELOCATABLE@V305096 04808000
EJECT 04809000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 04810000
* 04811000
* PROCESS C/S BELONGING TO ABOVE PHASE 04812000
* 04813000
MAPCST LH R8,ROOTNO INITIALISE SCAN OF C/D FOR SD/PC @V305096 04814000
L R9,CDENT1 @V305096 04815000
* 04816000
CSCAN C R9,CTLDAD IF END OF C/D, RETURN TO PROCESS @V305096 04817000
BE MAPHAS OTHER PHASES @V305096 04818000
TM ESDTYPD,PH WAS LAST ENTRY PH @V305096 04819000
LA R9,CDLNGTH(R9) IF NOT SD/PC, SCAN @V305096 04820000
LA R8,1(R8) @V305096 04821000
BNO TSTSP NO, BRANCH @V305096 04822000
LA R8,DEC1(R8) YES, ACCOUNT FOR @V305096 04823000
LA R9,CDLNGTH(R9) DOUBLE LENGTH OF @V305096 04824000
TSTSP EQU * PHASE ENTRY @V305096 04825000
CLI ESDTYPD,SD SCAN C/D FOR @V305096 04826000
BE XTRCT ENTRIES OF TYPE @V305096 04827000
CLI ESDTYPD,PC SD OR PC @V305096 04828000
BNE CSCAN @V305096 04829000
* 04830000
XTRCT EQU * @V305096 04831000
BAL RE,XTPHNO EXTRACT PHASE SD/PC BELONGS TO @V305096 04832000
* 04833000
CL R2,PHSBUK IF SD/PC BELONGS TO ANOTHER PHASE DO @V305096 04834000
BNE CSCAN NOT PROCESS IT @V305096 04835000
* 04836000
STM R8,R9,CSBUCK SAVE RETURN TO SCAN REGISTERS @V305096 04837000
* 04838000
L R3,RELFACD RELOCATION FACTOR @V305096 04839000
* ADD LENGTH OF COMMON TO RELOCATION FACTOR 04840000
AR R3,R5 @V305096 04841000
* 04842000
* PRINT CSECT ON MAP 04843000
* 04844000
MVC W52(5),KCSECT IDENTIFY @V305096 04845000
MVC W62(DEC8),NAMED LABEL @V305096 04846000
* 04847000
LTR R7,R3 SAVE R/F @V305096 04848000
BNM CONV CONVERT @V305096 04849000
MVI W80-1,C'-' INDICATE SO ON MAP @V305096 04850000
* 04851000
* 04852000
CONV LA R1,W80 CONVERT R/F @V305096 04853000
LPR R3,R3 MAKE R/F POSITIV @V305096 04854000
BAL RF,CNVBIN @V305096 04855000
* 04856000
* ADD R/F TO ASSEMBLED ORIGIN 04857000
ICM R3,HEX7,ASSORGD @V305096 04858000
AR R3,R7 CONVERT ASSEMBLED ADDRESS @V305096 04859000
LA R1,W72 @V305096 04860000
BAL RF,CNVBIN @V305096 04861000
* 04862000
BAL R6,SPACE1 SPACE & PRINT @V305096 04863000
BAL R6,PRINT @V305096 04864000
* 04865000
*** PROCESS LD/LR-S BELONGING TO ABOVE CSECT 04866000
* 04867000
MAPLDR L R9,CDENT1 SCAN ENTIRE C/D @V305096 04868000
* 04869000
LDRSCN C R9,CTLDAD IF NOT END OF C/D CONTINUE SCAN FOR @V305096 04870000
BNE LDRGO LD/LR-S @V305096 04871000
* 04872000
LM R8,R9,CSBUCK RESTORE C/S SCAN REGISTERS &@V305096 04873000
MPLDSW NOP CSCAN SWITCH SET ALLOWS CONTINUE WITHIN THIS PH @V305096 04874000
B SCNCMN ALLOW ENTRY PROCESSED WITHIN COMMON @V305096 04875000
* 04876000
LDRGO LA R9,CDLNGTH(R9) IF ENTRY NOT LD/LR @V305096 04877000
CLI ESDTYPD,LD @V305096 04878000
BE LDRTSD @V305096 04879000
CLI ESDTYPD,LR @V305096 04880000
BNE LDRSCN @V305096 04881000
* 04882000
LDRTSD CH R8,CSNUMD IF LD/LR BELONGS @V305096 04883000
* TO ANOTHER CSECT 04884000
BNE LDRSCN CONTINUE SCAN @V305096 04885000
* 04886000
*** PRINT ENTRY ON MAP 04887000
* 04888000
MVC W55(5),KENTRY IDENTIFY @V305096 04889000
MVC W62(DEC8),NAMED LABEL @V305096 04890000
* 04891000
ICM R3,HEX7,ASSORGD @V305096 04892000
AR R3,R7 CONVERT ASSEMBLED ADDRESS @V305096 04893000
LA R1,W72 @V305096 04894000
BAL RF,CNVBIN @V305096 04895000
* 04896000
CLI ESDTYPD,LD IF LD FLAG AS @V305096 04897000
BNE *+8 BEING UNMATCHED @V305096 04898000
MVI W52,C'*' @V305096 04899000
* 04900000
* 04901000
LR R2,R1 SAVE R1 CONTENTS @V305096 04902000
* 04903000
BAL R6,PRINT PRINT @V305096 04904000
* 04905000
B LDRSCN CONTINUE SCAN @V305096 04906000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 04907000
* 04908000
* PRINT EXTRN-S 04909000
* 04910000
PREXTN L R9,CDENT1 INITIALISE SCAN OF C/D @V305096 04911000
* 04912000
EXTSCN CL R9,CTLDAD IF NOT YET END OF C/D, CONTINUE @V305096 04913000
BNE EXTNLP SCANNING FOR EXTRNS @V305096 04914000
* 04915000
OVRLSW B DUPLAB SWITCH SET TO NOP WHEN ROOT OVERLAID @V305096 04916000
* 04917000
MVC W1(KVRTLG),KVROOT SET UP MESSAGE @V305096 04918000
BAL R6,SPACE1 @V305096 04919000
BAL R6,PRINT @V305096 04920000
* 04921000
DUPLAB TM DPNTSW,X'01' IF NO DUPLICATE LABELS CHECK@V305096 04922000
BZ TERSXY IF ENTRY LABEL OK @V305096 04923000
* 04924000
MVC W1(KDPLNG),KDPLBL SET UP MESSAGE @V305096 04925000
BAL R6,SPACE1 @V305096 04926000
BAL R6,PRINT @V305096 04927000
* 04928000
TERSXY TM DPNTSW,X'80' IF NO ERROR ON ENTRY LABEL CHECK @V305096 04929000
BZ UNRSPC THAT SPACE AVAILABLE FOR ADCONS @V305096 04930000
* 04931000
MVC W1(KNGLNG),KNGLBL SET UP MESSAGE @V305096 04932000
BAL R6,SPACE1 @V305096 04933000
BAL R6,PRINT @V305096 04934000
* 04935000
UNRSPC TM DPNTSW,X'02' IF NO ZERO LNG C/S-S GO TO FETCH @V305096 04936000
BZ FCHRLD RLD PROCESSOR @V305096 04937000
* 04938000
MVC W1(L'ZEROCS),ZEROCS SET UP MESG @V305096 04939000
BAL R6,SPACE1 @V305096 04940000
BAL R6,PRINT @V305096 04941000
* 04942000
FCHRLD EQU * @V305096 04943000
* 04944000
*** DECISION ROUTINE TO CONTINUE, BYPASS OR CANCEL 04945000
* 04946000
TM MAPSW,X'80' TEST IF ERRORS HAVE OCCURRED@V305096 04947000
BZ GORLD NO, GO TO RLD PROCESSOR @V305096 04948000
* 04949000
TM MAPSW,X'02' TEST FOR CANCEL OPTION (X'02') @V305096 04950000
BO CANC TO CANCEL IF MAPSW HAS X'02' @V305096 04951000
* 04952000
L RB,AMSG99 ERROR HAS OCCURRED @V305096 04953000
LR R6,RB DURING LINKAGE EDITING @V305096 04954000
LA R6,0(R6) R6 - ADDRESS OF MESSAGE @V305096 04955000
SRL RB,24 RB - LENGTH OF MESSAGE @V305096 04956000
EX RB,MOVE MOVE MESSAGE TO OUTPUT @V305096 04957000
* AREA W0 04958000
LA RB,1(RB) RESTORE LENGTH @V305096 04959000
BAL R6,LOGMSG PRINT MESSAGE ON SYSLOG @V305096 04960000
BAL R6,PRTCLEAR CLEAR OUTPUT BUFFER @V305065 04961000
* 04962000
GORLD EQU * @V305096 04963000
SR RB,RB CLEAR ABORT ERROR REGISTER @V305096 04964000
L RD,RLDMTX POINTER TO RLD PROC @V305096 04965000
BR RD AND GO THERE @V305096 04966000
* 04967000
* 04968000
CANC SR R0,R0 CLEAR REGISTER AND CALL CANCEL @V305096 04969000
B CANCL @V305065 04970000
EJECT 1 04971000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 04972000
* 04973000
*** LOOP AROUND EXTRACTING EXTRN-S 04974000
* 04975000
EXTNLP LA R9,CDLNGTH(R9) @V305096 04976000
CLI ESDTYPD,ER @V305096 04977000
BNE EXTSCN @V305096 04978000
* 04979000
EXTNSW NOP EXTNPR SWITCH SET TO B TO BYPASS @V305096 04980000
BAL R6,SPACE1 ON 1ST EXTRN SPACE, SET UP INDICATOR @V305096 04981000
MVC W1(KNRFLG),KUNREF IDENTIFY AS UNREFERENCED @V305096 04982000
* 04983000
EXTNPR MVC W52(5),KEXTRN IDENTIFY @V305096 04984000
MVC W62(DEC8),NAMED LABEL @V305096 04985000
TM SWITCHD,WXTRN UNRESOLVED WEAK EX @V305096 04986000
BNO PRNOWK NO,DO NOT ALTER E IN W @V305096 04987000
MVI W52,C'W' YES,MAKE IT WXTRN @V305096 04988000
* 04989000
PRNOWK BAL R6,PRINT @V305096 04990000
* 04991000
OI EXTNSW+1,X'F0' @V305096 04992000
B EXTSCN @V305096 04993000
* 04994000
*** LABEL ON ENTRY STATEMENT UNDEFINED SO FLAG ON MAP 04995000
* 04996000
ESIXTY OI DPNTSW,X'80' SET LABEL ERROR SWITCH @V305096 04997000
B NOTRFR @V305096 04998000
EJECT 04999000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 05000000
* 05001000
* R15 S/R TO CONVERT BINARY TO HEX 05002000
* R0 - NO OF HEX CHARACTERS TO CREATE 05003000
* 05004000
* R1 - ADDRESS TO STORE HEX 05005000
* R2 - WORK REGISTER 05006000
* R3 - CONTAINS BYTES TO BE CONVERTED 05007000
* 05008000
CNVBIN LA R0,6 6 HEX OUTPUT CHARACTERS @V305096 05009000
SLDL R2,8 3 BYTES LEFT ORIENTED @V305096 05010000
* 05011000
CNVLOP SR R2,R2 SET UP 1/2 BYTE @V305096 05012000
SLDL R2,4 @V305096 05013000
SH R2,K9 CALC PRINTABLE HEX CHARACTER@V305096 05014000
BP *+8 @V305096 05015000
LA R2,57(R2) @V305096 05016000
LA R2,192(R2) @V305096 05017000
* 05018000
STC R2,0(R1) STORE HEX CHAR IN RECEIVING FIELD @V305096 05019000
LA R1,1(R1) @V305096 05020000
BCT R0,CNVLOP FILL FIELD UNTIL FULL @V305096 05021000
* 05022000
BR RF @V305096 05023000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 05024000
* 05025000
* CONSTANTS REQUIRED BY MAPPING ROUTINE 05026000
* 05027000
HEDING DC C'1**/**/** PHASE XFR-AD LOCORE HICORE DSK-AD ' 05028000
DC C' ESD TYPE LABEL LOADED REL-FR' .@V305096 05029000
HEDLNG EQU *-HEDING NO OF CHARS IN HEADING LINE @V305096 05030000
* 05031000
SELFREL DC C'SELF RELOCATING' @V305096 05032000
NRELCAT DS 0CL15 @V305096 05033000
DC C'NOT ' @V305096 05034000
RELCAT DC C'RELOCATABLE' @V305096 05035000
* 05036000
KCOMON DC C'COMMON' @V305096 05037000
KCSECT DC C'CSECT' @V305096 05038000
KENTRY DC C'ENTRY' @V305096 05039000
KEXTRN DC C'EXTRN' @V305096 05040000
KOVRLY DC C'OVEROOT' @V305096 05041000
KROOT1 DC C'ROOT' @V305096 05042000
* 05043000
KVROOT DC C'ROOT STRUCTURE OVERLAID BY SUCCEEDING PHASE' @V305096 05044000
KVRTLG EQU *-KVROOT @V305096 05045000
* 05046000
KDPLBL DC C'POSSIBLE INVALID ENTRY POINT DUPLICATION IN INPUT' 05047000
KDPLNG EQU *-KDPLBL @V305096 05048000
* 05049000
KUNREF DC C'* UNRESOLVED EXTERNAL REFERENCES' @V305096 05050000
KNRFLG EQU *-KUNREF @V305096 05051000
* 05052000
KNGLBL DC C'INVALID TRANSFER LABEL ON END OR ENTRY STATEMENT ' 05053000
DC C'IGNORED' @V305096 05054000
KNGLNG EQU *-KNGLBL @V305096 05055000
* 05056000
ZEROCS DC C'CONTROL SECTIONS OF ZERO LENGTH IN INPUT' @V305096 05057000
* 05058000
*** CCB AND CCW 05059000
* 05060000
PHSBUK DC 2F'0' PHASE C/D #/ADDRESS @V305096 05061000
CSBUCK DC 2F'0' CSECT C/D #/ADDRESS @V305096 05062000
* 05063000
LOROOT DC F'-1' VALUES IF NO ROOT PHASE WILL ALLOW @V305096 05064000
HIROOT DC F'0' USER TO ORIGIN ANYWHERE @V305096 05065000
* 05066000
* 05067000
** TABLE TO PROVIDE ADDRESSABILITY TO ERROR MESSAGES 05068000
* 05069000
DS 0F @VA05886 05070000
AMSG99 DC YL1(L'MSG99-DEC1) LENGTH OF MESSAGE MIN 1 @VA05886 05071000
DC AL3(MSG99) ADDRESS OF ERROR MESSAGE @VA05886 05072000
LTORG @V305065 05073000
TITLE 'DLKRLD LINK EDITOR RESOLVE RLD''S - $LNKEDT - DOS' 05074000
*********************************************************************** 05075000
* * 05076000
* CSECT DLKRLD - PASS 2 AND 3 RLD PROCESSING 05077000
* * 05078000
*ENTRY POINTS - DLKRLD - PROCESSES R AND P POINTERS AND CONSTANTS. * 05079000
* CREATES THE RLD ITEMS FOR RELOCATABLE PHASES IN THE CIL OR PCIL 05080000
* PROCESSES ABORT ERRORS. 05081000
* * 05082000
*INPUT - SYS001 AND ABTERR IN DMSDLK * 05083000
* * 05084000
*OUTPUT - SYSLST,SYSLOG * 05085000
* * 05086000
*EXTERNAL ROUTINES: SEE LIST OF SUBROUTINES IN DMSDLK * 05087000
* * 05088000
*EXITS-NORMAL - EXIT TO DLKCAT 05089000
* CANCEL THRU SVC 6 IF DLKRLD IS CALLED TO HANDLE ABORT * 05090000
* -ERROR - NONE * 05091000
* * 05092000
*TABLES/WORK AREAS - EXPLAINED IN COMMENTS OF CSECT DMSDLK 05093000
* * 05094000
*ATTRIBUTES - N/A * 05095000
* * 05096000
*********************************************************************** 05097000
* 05098000
DLKRLD CSECT RLD PROCESSOR @V305096 05099000
USING *,RD @V305096 05100000
USING H1,R3 RESTORE DSECT ADDRESSABILITY @V305096 05101000
* 05102000
OI MAPSW,HEX20 SHOW DERDAD S/R THAT @V305096 05103000
* DLKRLD HAS CONTROL 05104000
LTR RB,RB IF ABORT REGISTER HAS A VALUE ACCEPT @V305096 05105000
BNE ABORT THIS AS THE ABORT ERROR NUMBER @V305096 05106000
MVI PHSNO,HEXFF FORCE REINITIALIZATION @V305096 05107000
* 05108000
LH R1,SROTSID MODIFY DERDAD S/R FOR USE BY RLD @V305096 05109000
STH R1,DERDSW+2 ROUTINE TO COUNT ADCONS OUTSIDE @V305096 05110000
STH R1,ERR050+6 PHASE LIMITS @V305096 05111000
* 05112000
RLDPS3 EQU * @V305065 05113000
BAL RF,REPUT1 REPOSITION SYSUT1 TO FILE START @V305096 05114000
* 05115000
RLDRAG BAL RF,RDSUT1 @V305096 05116000
* 05117000
LA R6,INPBLK+12 INIT'IZE SCAN OF NEW CARD AT E17-4 @V305096 05118000
NI RLDSW1+1,X'0F' FORCE PROC R & P ON FIRST ITEM @V305096 05119000
* 05120000
RLDRET LH R2,INPBLK+10 IF END OF CARD REACHED GO TO READ@V305096 05121000
SH R2,RADD4+2 ANOTHER @V305096 05122000
BM RLDRAG @V305096 05123000
STH R2,INPBLK+10 RESTORE DECREMENTED COUNT @V305096 05124000
RADD4 LA R6,4(R6) SCAN TO NEXT ITEM @V305096 05125000
* 05126000
RLDSW1 NOP RLDCON SWITCH IS B WHEN R&P SAME AS PREVIOUS@V305096 05127000
OI RLDSW1+1,X'F0' MUST PROCESS CONSTANT AFTER R&P @V305096 05128000
EJECT 1 05129000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 05130000
* 05131000
* PROCESS R & P POINTERS 05132000
* 05133000
*** - P POINTER 05134000
* 05135000
OI RLDSW3+1,X'F0' IF P PTR CARRIES NEGATIVE C/D @V305096 05136000
LH R9,D19 NO THIS ITEM IS NOT TO BE PROCESSED @V305096 05137000
LTR R9,R9 SO LEAVE SWITCH AT BYPASS SETTING@V305096 05138000
BM RLDRET @V305096 05139000
* 05140000
NI RLDSW3+1,X'0F' ACCEPT ADCON, @V305096 05141000
LA RF,* FIND C/D ENTRY # @V305096 05142000
B LTCDAD @V305096 05143000
ST R7,RFOFP RETAIN R/F OF P @V305096 05144000
* 05145000
* SET UP C/D NO OF PHASE THIS CSECT 05146000
LH R8,PHNUMD BELONGS TO @V305096 05147000
* 05148000
CH R8,PHSNO IF CURRENTLY @V305096 05149000
* PROCESSING IN THIS 05150000
PS3SW1 BE RLDOR PHASE, NO NEW INFO NEEDED @V305096 05151000
* BRANCH ADDRESS CHANGED FOR 05152000
* PASS 3 RLD PROCESSING 05153000
STH R8,PHSNO SAVE FOR CURRENT USE @V305096 05154000
LR R9,R8 FIND C/D ENTRY FOR THIS PHASE @V305096 05155000
LA RF,* @V305096 05156000
B LTCDAD @V305096 05157000
* 05158000
OI MAPSW,HEX8 SET MAPSW TO INDICATE @V305096 05159000
TM PHTYPED,RELPHASE PHASE RELOCATABLE @V305096 05160000
BO PS3SW2 OR @V305096 05161000
NI MAPSW,HEXFF-HEX8 NOT RELOCATABLE @V305096 05162000
* 05163000
PS3SW2 NOP TSTRLD B IF PASS 3 RLD PROCESSING @V305096 05164000
* 05165000
GETCENT MVC CPHENT(2*CDLNGTH),CDENTRY SAVE PHASE ENTRY @V305096 05166000
* IN CURRENT ENTRY 05167000
PS3SW4 NOP READLST IF PASS 3 RLD PROCESSING, GO TO @V305096 05168000
* READ FIRST BLOCK 05169000
EJECT 1 05170000
* 05171000
*** - R POINTER 05172000
* 05173000
RLDOR OI RLDSW2+1,X'F0' IF SWITCH NOT SET IT BYPASSES ER @V305096 05174000
TM D17,X'80' PROCESSING @V305096 05175000
BZ *+12 @V305096 05176000
NI RLDSW2+1,X'0F' ON ER-S ADD ASSMBLD ORIGIN TO R/F@V305096 05177000
NI D17,X'7F' AND CLEAR ER SWITCH IN R POINTER @V305096 05178000
* 05179000
LH R9,D17 GET C/D ENTRY FROM C/D NO @V305096 05180000
LA RF,* @V305096 05181000
B LTCDAD @V305096 05182000
* 05183000
MVC RORIGN+DEC1(DEC3),ASSORGD SAVE ASSORG @V305096 05184000
CLI ESDTYPD,SD IF R POINTS TO @V305096 05185000
BE RLDSW2 A CSECT OR TO PRIVATE @V305096 05186000
CLI ESDTYPD,PC CODE , R/F IS FOUND @V305096 05187000
BE RLDSW2 AND BRANCH IS TAKEN @V305096 05188000
* 05189000
* R DOES NOT POINT DIRECTLY TO SD/PC 05190000
CLI ESDTYPD,CM IF CM, REQ ONLY R/F @V305096 05191000
BE RLDCMN @V305096 05192000
* 05193000
CLI ESDTYPD,ER IF NOT ER,THEN LR @V305096 05194000
BNE RNXTRN @V305096 05195000
* 05196000
RLCTER OI RLDSW3+DEC1,HEXF0 SET SW TO BYPASS PRO'SING RLDS@V305096 05197000
PS3SW5 NOP RLDRET B IF PASS 3 PROCESSING @V305096 05198000
LH R2,UNRESD INCREMENT COUNT OF @V305096 05199000
LA R2,DEC1(R2) UNRESOLVED @V305096 05200000
STH R2,UNRESD EXTERNAL REFERENCES AND GO TO @V305096 05201000
B RLDRET PROCESS NEXT FOUR BYTES @V305096 05202000
* 05203000
RNXTRN TM SWITCHD,UNASSG IF LR UNASSIGNED @V305096 05204000
BO RLCTER WITHIN A C/S COUNT AS EXTRN @V305096 05205000
* 05206000
LH R9,CSNUMD LOCATE SD/PC THIS @V305096 05207000
LA RF,* @V305096 05208000
B LTCDAD LR BELONGS TO @V305096 05209000
* 05210000
* R/F OF R FOUND & RETAINED 05211000
RLDSW2 NOP *+8 SWITCH - ON ER-S ADD ASSEMBLED ORG TO R/F @V305096 05212000
A R7,RORIGN @V305096 05213000
A R7,COMNRF TAKE ACCOUNT OF COMMON R/F ATTRIBUTE @V305096 05214000
* 05215000
RLDCMN ST R7,RFOFR RETAIN R/F OF R & GO TO PROCESS @V305096 05216000
B RLDRET CONSTANT PORTION @V305096 05217000
EJECT 1 05218000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 05219000
* 05220000
* PROCESS RLD CONSTANT 05221000
* 05222000
RLDCON TM D17,X'01' IF DIFFERENT R & P FOLLOW SET SW1 TO @V305096 05223000
BO RLDSW3 ALLOW PROCESSING NEXT R & P @V305096 05224000
NI RLDSW1+1,X'0F' @V305096 05225000
* 05226000
RLDSW3 NOP RLDRET SWITCH IS B WHEN R&P BELONG WRONG PHASE@V305096 05227000
* 05228000
L R4,RFOFR R/F OF R SIGN CONTROLLED BY FLAG @V305096 05229000
TM D17,X'02' @V305096 05230000
BZ *+6 @V305096 05231000
LCR R4,R4 @V305096 05232000
* 05233000
MVC BUCK3(3),D18 ASSEMBLED ADDRESS OF ADCON @V305096 05234000
L R7,BUCK4 @V305096 05235000
A R7,RFOFP @V305096 05236000
* 05237000
IC R8,D17 LENGTH OF REQUIRED ADCON @V305096 05238000
SLL R8,28 @V305096 05239000
SRL R8,30 @V305096 05240000
PS3SW3 NOP RLDPRC3 B IF PASS 3 PROCESSING @V305096 05241000
* 05242000
LA R8,1(R8) @V305096 05243000
LR R9,R8 @V305096 05244000
* 05245000
* MODIFY LOAD CONSTANT IN CI BLOCK 05246000
* 05247000
* RA - WORK (ADCON CONTENTS) R7 - ADDRESS OF ADCON 05248000
* R4 - R/F OF R (ADCON) R8 - LENGTH OF ADCON 05249000
* R5 - ADDRESS IN WKAREA R9 - LENGTH OF ADCON 05250000
* 05251000
NI RLDSW4+1,X'0F' SET SWITCH TO ALLOW ADCON TO BE @V305096 05252000
SR RA,RA EXTRACTED INTO CLEAN REGISTER @V305096 05253000
* 05254000
RLADCN BAL RF,DERDAD @V305096 05255000
* 05256000
L R5,AWKARE CALC LOAD ADDRESS WITHIN WKAREA @V305096 05257000
AR R5,R7 @V305096 05258000
S R5,LOCORE @V305096 05259000
* 05260000
RLDSW4 NOP RESDCN SWITCH - NOP TO EXTRACT/ B TO REPLACE @V305096 05261000
* 05262000
SLL RA,8 SET UP ADCON ONE BYTE AT A TIME IN @V305096 05263000
IC RA,0(R5) WORK REGISTER AND UPDATE ASSEMBLED @V305096 05264000
LA R7,1(R7) ADDRESS, TO ENSURE WORKING IN @V305096 05265000
BCT R8,RLADCN CORRECT BLOCK OF CI @V305096 05266000
* 05267000
* APPLY R/F TO ADCON 05268000
AR RA,R4 ADD R/F TO ADCON, SET SWITCH TO @V305096 05269000
OI RLDSW4+1,X'F0' REPLACE ADCON & SET LOAD ADDRESS @V305096 05270000
BCTR R7,0 CORRECTLY TO LAST BYTE IN ADCON @V305096 05271000
* 05272000
* REPLACE ADCON IN CI BLOCK 05273000
RESDCN STC RA,0(R5) RESTORE ADCON ONE BYTE AT A TIME,@V305096 05274000
SRL RA,8 DECREMENTING ASSEMBLED ADDRESS UNTIL @V305096 05275000
BCTR R7,0 ENTIRELY REPLACED @V305096 05276000
BCT R9,RLADCN @V305096 05277000
* 05278000
B RLDRET @V305096 05279000
* 05280000
*** ROUTINE TO COUNT NO OF ADCONS OUTSIDE PHASE LIMITS 05281000
* 05282000
ROTSID LH R1,ROTCNT ADD 1 TO CURRENT COUNT @V305096 05283000
LA R1,1(R1) @V305096 05284000
STH R1,ROTCNT @V305096 05285000
B RLDRET @V305096 05286000
EJECT 1 05287000
* 05288000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 05289000
* 05290000
* PRINT OUT COUNT OF UNRESOLVED ADCONS ON MAP 05291000
* 05292000
TSTUNR NOP TSTRLDXX B IF PASS 3 PROCESSING @V305096 05293000
OI TSTUNR+DEC1,HEXF0 SET PASS 3 SWITCH @V305096 05294000
* 05295000
TM MAPSW,X'01' IF MAP NOT REQUESTED DO NOT @V305096 05296000
BZ RELROUT SUPPLY THIS INFORMATION @V305096 05297000
* 05298000
LA R2,TSTSID NEXT ROTINE TO GO TO @V305096 05299000
LH R1,UNRESD IF NO UNRESOLVED ADDRESS CONSTANTS @V305096 05300000
TSTCNT LTR R1,R1 CHECK IF OUTSIDE LIMIT ADCONS @V305096 05301000
BCR 8,R2 @V305096 05302000
* 05303000
CVD R1,DBLWRD CONVERT NO OF UNRESOLVED ADCONS @V305096 05304000
OI DBLWRD+7,X'0F' @V305096 05305000
UNPK W1(3),DBLWRD(8) @V305096 05306000
MVC W5(KUNRLG),KUNRSD @V305096 05307000
* 05308000
BAL R6,SPACE1 @V305096 05309000
BAL R6,PRINT @V305096 05310000
* 05311000
BR R2 GO TO NEXT ROUTINE @V305096 05312000
* 05313000
*** PRINT COUNT OF ADCONS OUTSIDE PHASE LIMITS ON MAP 05314000
* 05315000
TSTSID LA R2,RELROUT MODIFY ADDRESS OF NEXT ROUTINE @V305096 05316000
MVC KUNRSD(L'KUNROT),KUNROT NEW MESSAGE LINE SET UP@V305096 05317000
LH R1,ROTCNT COUNT OF ADCONS OUTSIDE LIMITS @V305096 05318000
B TSTCNT DROP THROUGH PRINT ROUTINE @V305096 05319000
* 05320000
W5 EQU W0+5 PRINT POSITION REQUIRED @V305096 05321000
EJECT 1 05322000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 05323000
* 05324000
* INITIALISATION FOR PASS 3 RLD PROCESSING 05325000
* 05326000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 05327000
* 05328000
RELROUT TM MAPSW,HEX10 IF NO RELOCATABLE PHASE PROCESSED,@V305096 05329000
BNO WRLST GO @V305096 05330000
* 05331000
MVI PHSNO,HEXFF FORCE RE-INITIALISATION @V305096 05332000
MVC PS3SW1+DEC2(DEC2),STSTREL2 @V305096 05333000
OI PS3SW2+DEC1,HEXF0 MODIFY FOR THIRD @V305096 05334000
OI PS3SW3+DEC1,HEXF0 PASS RLD @V305096 05335000
OI PS3SW4+DEC1,HEXF0 PROCESSING @V305096 05336000
OI PS3SW5+DEC1,HEXF0 @V305096 05337000
* 05338000
L RA,AWKARE GET ADDRESS @V305096 05339000
AH RA,CILRSIZE OF END @V305096 05340000
ST RA,ENDWKARE WORKAREA @V305096 05341000
SR RA,RA INDICATE NO RLD ITEMS IN @V305096 05342000
B RLDPS3 CURRENT PHASE AND GO @V305096 05343000
EJECT 1 05344000
* 05345000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 05346000
* 05347000
* S/R USED BY THIRD PASS RLD PROCESSOR TO SWITCH PHASES 05348000
* 05349000
TSTRLDXX EQU * @V305096 05350000
OI RLDSW5+DEC1,HEXF0 END OF RLD INPUT @V305096 05351000
TSTRLD LTR RA,RA IF # OF RLD ITEMS INCORRECT @V305096 05352000
BP PDRLD GO HERE @V305096 05353000
RLDSW5 NOP WRLST AT END OF RLD - @V305096 05354000
* INPUT WRITE OUT LAST BLOCK IN CIL 05355000
TM MAPSW,HEXC IF NEXT PHASE REL @V305096 05356000
BO GETCENT GO TO INITIALIZE @V305096 05357000
TSTREL2 TM MAPSW,HEXC IF THIS PHASE RELOCATABLE @V305096 05358000
BO RLDOR GO PROCESS R-POINTER @V305096 05359000
OI RLDSW3+DEC1,HEXF0 SET SWITCH FOR NOT RELOCATABLE@V305096 05360000
B RLDRET TO BYPASS RLD AND RETURN @V305096 05361000
* 05362000
PDRLD C R5,ENDWKARE IF NOT FULL @V305096 05363000
BL STOR00 GO @V305096 05364000
* 05365000
SR R8,R8 WRITE BACK LAST BLOCK @V305096 05366000
L R7,HICORE AND GO TO @V305096 05367000
BAL RF,DERDAD READ NEXT CIL RECORD @V305096 05368000
L R5,AWKARE RESET POINTER @V305096 05369000
* 05370000
STOR00 SR R8,R8 PADD THE RESERVED @V305096 05371000
* RLD SPACE IN 05372000
ST R8,DEC0(R5) THE CORE IMAGE LIBRARY @V305096 05373000
LA R5,DEC4(R5) WITH '00' UNTILL THE @V305096 05374000
BCT RA,PDRLD RLD COUNT IS ZERO, THEN @V305096 05375000
B TSTRLD RETURN @V305096 05376000
EJECT 1 05377000
* 05378000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 05379000
* 05380000
* S/R TO GET LAST CIL BLOCK FOR THIS PHASE 05381000
* 05382000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 05383000
READLST EQU * @V305096 05384000
L R5,AWKARE GET WORKAREA ADDRESS @V305096 05385000
LH RA,RLDITEMS GET NO OF RLD ITEMS @V305096 05386000
* FOR THIS PHASE 05387000
AH R5,NOBYTE GET ALIGNED ADDRESS @V305096 05388000
LA R5,DEC3(R5) FOR THE FIRST @V305096 05389000
SRL R5,DEC2 RLD ITEMS IN @V305096 05390000
SLL R5,DEC2 CIL BLOCK @V305096 05391000
C R5,ENDWKARE IF FIRST RLD ITEM IN A NEW @V305096 05392000
BL SAMEBLCK BLOCK, INITIALIZE FOR @V305096 05393000
L R5,AWKARE RLD IN NEW BLOCK @V305096 05394000
* 05395000
SAMEBLCK L R7,NXPHRG INITIALISE TO GET @V305096 05396000
LA R7,DEC3(R7) CORRECT CIL RECORD IN @V305096 05397000
SRL R7,DEC2 WORKAREA AND A NEW UPPER @V305096 05398000
SLL R7,DEC2 LIMIT, EQUAL TO THE OLD LIMIT@V305096 05399000
LR R8,RA @V305096 05400000
SLL R8,DEC2 PLUS 4 TIMES THE # OF @V305096 05401000
AR R8,R7 RLD ITEMS TO BE STORED @V305096 05402000
ST R8,NXPHRG @V305096 05403000
* 05404000
SR R8,R8 WRITE BACK LAST CIL RECORD AND @V305096 05405000
BAL RF,DERDAD READ NEXT @V305096 05406000
B RLDOR AND RETURN @V305096 05407000
EJECT 1 05408000
* 05409000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 05410000
* 05411000
* S/R TO GENERATE RELOCATION LIST DICTIONARY ITEMS 05412000
* 05413000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 05414000
* 05415000
RLDPRC3 C R7,ORPHRG NO RLD ITEMS WILL BE @V305096 05416000
BL RLDRET GENERATED FOR ADDRESS CONSTANTS @V305096 05417000
* OUTSIDE PHASE LIMITS 05418000
AR R7,R8 ADD LENGTH-1 TO ADDRESS OF ADCON @V305096 05419000
C R7,NXPHRG IF ADDRESS TOO LOW OR TOO HIGH @V305096 05420000
BNL RLDRET RETURN TO PROCESS NEXT ITEM @V305096 05421000
SR R7,R8 OTHERWISE, RE-ESTABLISH ADDRESS OF@V305096 05422000
A R7,COMNRF ADD LENGTH OF COMMONS @V305096 05423000
ST R7,DEC0(R5) ADCON AND STORE INTO THE RLD ITEM @V305096 05424000
SLL R8,DEC3 GET LENGTH CODE AND STORE @V305096 05425000
STC R8,DEC0(R5) IN FLAG BYTE @V305096 05426000
TM D17,HEX2 IF RELOCATION FACTOR POSITIVE@V305096 05427000
BNO CHKCNT GO @V305096 05428000
OI DEC0(R5),HEX1 INDICATE NEGATIVE RF @V305096 05429000
CHKCNT BCT RA,INCRMNT REDUCE RLD COUNT, IF COUNT @V305096 05430000
OI RLDSW3+DEC1,HEXF0 EQUAL TO ZERO, BYPASS @V305096 05431000
* FURTHER RLD FOR THIS PHASE 05432000
INCRMNT LA R5,DEC4(R5) INCREMENT ADDRESS FOR NEXT ITEM @V305096 05433000
L R7,HICORE INIT FOR NEXT BLOCK @V305096 05434000
C R5,ENDWKARE IF NO NEW BLOCK NEEDED @V305096 05435000
BL RLDRET GO @V305096 05436000
SR R8,R8 WRITE FULL BLOCK @V305096 05437000
BAL RF,DERDAD AND READ NEXT BLOCK @V305096 05438000
L R5,AWKARE RESET RLD ITEM BASE @V305096 05439000
B RLDRET RETURN @V305096 05440000
EJECT 1 05441000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 05442000
* 05443000
* WRITE LAST BLOCK IN SYSUT2 05444000
* 05445000
WRLST EQU * @V305065 05446000
LH R2,THPHDA GET RECORD NUMBER @V305065 05447000
L R3,AWKARE AND OUTPUT BUFFER @V305065 05448000
LA R1,SYSUT2 POINT TO FSCB @V305065 05449000
BAL RE,WRTUTX WRITE LAST BLOCK IN SYSUT2 @V305065 05450000
* 05451000
BAL R6,CLOSE CLOSE DOSLNK @V305096 05452000
L RA,CATMTX LOAD BASE OF DLKCAT @V305096 05453000
BR RA AND BRANCH TO IT @V305096 05454000
EJECT 1 05455000
* 05456000
*** ABORT ERROR PROCESSOR 05457000
* 05458000
* ROUTINE PRINTS ERROR MESSAGE AND CANCELS 05459000
* 05460000
* INPUT - RB - BYTE 0 - LENGTH OF ERROR MESSAGE MIN 1 05461000
* BYTES 1, 2, 3 - ADDR OF ERROR MESSAGE 05462000
* 05463000
ABORT LR R6,RB @V305096 05464000
LA R6,0(R6) R6 - ADDR OF MESSAGE @V305096 05465000
ST R6,SAVEREG SAVE FOR LATER USE @V305096 05466000
SRL RB,24 RB - LENGTH OF MESSAGE @V305096 05467000
* MIN ONE 05468000
EX RB,MOVE MOVE MESSAGE TO OUTPUT @V305096 05469000
* AREA W0 05470000
TM MAPSW,MAPOP MAP REQUESTED @V305096 05471000
BZ ABORT10 NO, PRINT ON SYSLOG @V305096 05472000
* 05473000
TM CMSSWT1,MAPPRT IS PRINT OPTION SPECIFIED? @V305065 05474000
BZ ABORT5 BRANCH IF NOT @V305065 05475000
BAL R6,SPACE1 YES, PRINT ERROR @V305096 05476000
BAL R6,PRINT ON SYSLST @V305096 05477000
BAL R6,SPACE1 SPACE 1 @V305096 05478000
L R6,SAVEREG REFILL OUTPUT AREA @V305096 05479000
EX RB,MOVE W0 FOR LOGMSG ROUTINE @V305096 05480000
B ABORT10 @V305065 05481000
ABORT5 EQU * @V305065 05482000
TM CMSSWT1,MAPTYP IS TYPE OPTION SPECIFIED? @V305065 05483000
BO ABORT10 BRANCH IF YES @V305065 05484000
BAL R6,DISK PUT MSG ON DISK @V305065 05485000
ABORT10 EQU * @V305065 05486000
BAL R6,LOGMSG TYPE ERROR MESSAGE @V305065 05487000
MVI ERCODE,ER024 INDICATE TERMINAL ERROR @V305065 05488000
B CANCL CANCEL JOB @V305096 05489000
EJECT 05490000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 05491000
* 05492000
* CONSTANTS AND S/R USED ONLY BY PASS 2 AND 3 RLD PROCESSING 05493000
* 05494000
UNRESD DC H'0' COUNT OF UNRESOLVED RLD ITEMS @V305096 05495000
ROTCNT DC H'0' COUNT OF ADCONS OUTSIDE PHASE LIMITS @V305096 05496000
* 05497000
SROTSID DC S(ROTSID) SWITCH INSTRCTN USED TO MODIFY DERDAD @V305096 05498000
* 05499000
STSTREL2 DC S(TSTREL2) @V305096 05500000
* 05501000
RFOFP DC F'0' R/F OF SD/PC POINTED TO BY P@V305096 05502000
* 05503000
RFOFR DC F'0' R/F OF SD/PC BELONGING TO R POINTER @V305096 05504000
* 05505000
RORIGN DC F'0' ORIGIN OF C/D ENTRY POINTED TO BY R @V305096 05506000
* 05507000
KUNRSD DC C'UNRESOLVED ADDRESS CONSTANTS ' @V305096 05508000
KUNRLG EQU *-KUNRSD @V305096 05509000
* 05510000
KUNROT DC C'ADDRESS CONSTANTS OUTSIDE LIMITS OF PHASE' @V305096 05511000
* 05512000
EJECT 1 05513000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 05514000
* 05515000
* CMS S/R TO READ SEQUENTIALLY OFF SYSUT1 05516000
* 05517000
USING FSCBD,R1 @V305065 05518000
RDSUT1 EQU * @V305065 05519000
ST RF,RFHOLD SAVE RETURN ADDRESS @V305065 05520000
FSREAD ,FSCB=SYSUT1,BUFFER=INPBLK,ERROR=RDSUT1E @V305065 05521000
L RF,RFHOLD RESTORE RETURN ADDRESS @V305065 05522000
BR RF AND RETURN @V305065 05523000
* 05524000
RDSUT1E EQU * @V305065 05525000
CH RF,K12 END OF FILE? @V305065 05526000
BNE RDDSKERR BRANCH IF NOT @V305065 05527000
MVC FSCBITNO,K1 INDICATE SYSUT1 USED @V305065 05528000
B TSTUNR LOOK FOR UNRESOLVED ADCONS @V305065 05529000
* 05530000
RFHOLD DC F'0' @V305065 05531000
EJECT 1 05532000
* 05533000
*** CMS S/R TO REPOSITION SYSUT1 TO START OF FILE 05534000
* 05535000
REPUT1 EQU * @V305065 05536000
LA R1,SYSUT1 POINT TO PLIST @V305065 05537000
CLC FSCBITNO,=H'0' WAS SYSUT1 USED? @V305065 05538000
BE TSTUNR BRANCH IF NOT @V305065 05539000
ST RF,RFHOLD SAVE RETURN REGISTER @V305065 05540000
FSCLOSE ,FSCB=(1) CLOSE SYSUT1 @V305065 05541000
SR RF,RF CLEAR REGISTER @V305065 05542000
STH RF,FSCBITNO INDICATE SEQUENTIAL READ @V305065 05543000
L RF,RFHOLD RESTORE RETURN REGISTER @V305065 05544000
BR RF AND RETURN @V305065 05545000
DROP R1 @V305065 05546000
EJECT 1 05547000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 05548000
* 05549000
*** CMS S/R TO CLOSE DOSLNK AND SYSUT1 05550000
* 05551000
CLOSE EQU * @V305065 05552000
FSCLOSE ,FSCB=DOSLNK CLOSE DOSLNK @V305065 05553000
FSCLOSE ,FSCB=SYSUT1 CLOSE SYSUT1 @V305065 05554000
FSCLOSE ,FSCB=SYSUT2 CLOSE SYSUT2 @V305065 05555000
BR R6 RETURN @V305065 05556000
LTORG , @V305065 05557000
TITLE 'DLKCAT - UPDATE CIL DIRECTORY - $LNKEDT - DOS' 05558000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 05559000
* 05560000
* CSECT DLKCAT - UPDATE CIL DIRECTORY 05561000
* 05562000
* ENTRY POINT - DLKCAT 05563000
* 05564000
* FUNCTION - BUILDS STOW TABLE AND CALLS $MAINDIR TO 05565000
* UPDATE THE CIL DIRECTORY. THE TYPE OF CALL ( C OR L - 05566000
* SEE DSECT STOWENT ) DETERMINES WETHER THE DIRECTORY 05567000
* ENTRIES ARE WRITTEN INTO THE DIRECTORY OF CATALOGED 05568000
* PHASES ( C ) OR INTO THE LINK AREA ( L ). 05569000
* 05570000
* BUILDS STATUS TABLE AND CALLS $LIBSTAT FOR STATUS 05571000
* REPORT OF CIL. 05572000
* 05573000
* INPUT - CONTROL DICTIONARY ( DSECT CDENTRY ) 05574000
* 05575000
* OUTPUT - STOW TABLE ( DSECT STOWENT ) 05576000
* PRESENTED TO $MAINDIR 05577000
* 05578000
* - STATUS TABLE ( DSECT STATTAB ) 05579000
* PRESENTED TO $LIBSTAT 05580000
* 05581000
* EXITS - NORMAL - SVC 14 TO JOB CONTROL 05582000
* 05583000
* - ERROR - CNCL (CANCEL) 05584000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 05585000
* 05586000
DLKCAT CSECT DIRECTORY UPD @V305096 05587000
USING *,RA @V305096 05588000
USING STOWTAB,R4 @V305096 05589000
USING STOWENT,R3 @V305096 05590000
USING BGCOM,R1 @V305096 05591000
* 05592000
USING FSCBD,R6 @V305065 05593000
LA R6,SYSUT2 POINT TO SYSUT2 PLIST @V305065 05594000
SR R4,R4 CLEAR REGISTER @V305065 05595000
STH R4,FSCBITNO INDICATE READ SEQUENTIAL @V305065 05596000
DROP R6 @V305065 05597000
L R4,CTLDAD STOW TABLE STARTS @V305096 05598000
LA R4,2*CDLNGTH(R4) AFTER CONTROL DIC @V305096 05599000
LA R3,HEADLNG(R4) @V305096 05600000
* 05601000
* BUILD STOW TABLE HEADER 05602000
* 05603000
SR R6,R6 @V305096 05604000
MVC LIBCU(DEC1),ZEROH LOGICAL UNIT OF @V305096 05605000
MVC LIBCU+1(DEC1),CILTYPE LIBRARY @V305096 05606000
STH R6,DIRADDR OF CATALOGED PHASES INTO@V305096 05607000
* HEADER 05608000
STH R6,ENTNUM INIT ENTNUM AS ZERO @V305096 05609000
LA R6,1(R6) AND @V305096 05610000
STH R6,REQNUM REQNUM AS ONE @V305096 05611000
* 05612000
************************************************************** 05613000
* ROUTINE TO SCAN CONTROL DICTIONARY FOR PHASE ENTRIES 05614000
************************************************************** 05615000
* 05616000
L R9,CDENT1 ADDR OF FIRST C/D ENTRY @V305096 05617000
LA R6,20(,R4) @V305065 05618000
SCANCD TM ESDTYPD,PH IS IT A PHASE ENTRY @V305096 05619000
BNO CONTSCN NO, CONTINUE SCAN @V305096 05620000
CR R3,R6 END OF ST/T REACHED @V305096 05621000
BNH BUILD NO, BRANCH @V305096 05622000
BAL RE,UPDDIR YES, BUILD LIBRARY @V305096 05623000
BUILD BAL RE,BLDENT ADD ENTRY TO ST/T @V305096 05624000
CONTSCN LA R9,CDLNGTH(R9) GO TO NEXT ENTRY @V305096 05625000
C R9,CTLDAD END OF C/D REACHED @V305096 05626000
BNH SCANCD NO, CONTINUE SCAN @V305096 05627000
BAL RE,UPDDIR BUILD LIBRARY @V305065 05628000
B CANCL AND RETURN TO CMS @V305065 05629000
EJECT 1 05630000
************************************************************** 05631000
** SUBROUTINE TO BUILD STOW TABLE ENTRY 05632000
************************************************************** 05633000
* 05634000
BLDENT EQU * @V305096 05635000
* 05636000
* MODIFY LOAD AND TRANSFER ADDRESS AND LAST BYTE ADDRESS BY 05637000
* LENGTH OF COMMON 05638000
* 05639000
L R5,COMNRF GET LENGTH OF COMMON @V305096 05640000
LM R0,R1,ORPHRGD MODIFY @V305096 05641000
AR R0,R5 @V305096 05642000
AR R1,R5 @V305096 05643000
STM R0,R1,ORPHRGD LOAD ADDRESS @V305096 05644000
L R0,TRFRADD LAST BYTE ADDRESS @V305096 05645000
AR R0,R5 @V305096 05646000
ST R0,TRFRADD TRANSFER ADDRESS @V305096 05647000
* 05648000
LH R7,ENTNUM UPDATE NUMBER OF STOW @V305096 05649000
LA R7,DEC1(R7) TABLE ENTRIES @V305096 05650000
STH R7,ENTNUM @V305096 05651000
* 05652000
* BUILD ENTRY 05653000
* 05654000
LH R8,MINDAT @V305096 05655000
MVC PHSNAME,PHNAMED PHASE NAME @V305096 05656000
MVC PHSADDR,ORPHDAD SET FIRST RECORD NUMBER @V305065 05657000
MVC NOBLOCK,NOBLOKD NUM OF TEXT BLOCKS @V305096 05658000
MVC NOBYTES,NOBYTED NUM OF BYTES IN LST BLK @V305096 05659000
MVC PHSTYPE,PHTYPED PHASE TYPE @V305096 05660000
MVI REQTYPE,C'C' TYPE OF REQUEST @V305096 05661000
* 05662000
TM PHTYPED,SELFRELO IF LOADPNT ZERO ( PHASE @V305096 05663000
BNO NOSELFR SELFRELOCATING ) AND @V305096 05664000
OC TRFRADD,TRFRADD ALSO ENTRYPT ZERO BOTH @V305096 05665000
BNZ NOSELFR WILL NOT BE PRESENT @V305065 05666000
XC LOADPNT(SELFRL),LOADPNT CLEAR REST OF ENTRY @V305065 05667000
B ENDROUT @V305065 05668000
NOSELFR MVC LOADPNT,ORPHRGD+1 LOAD ADDRESS OF PHASE @V305096 05669000
MVC ENTRYPT,TRFRADD+1 TRANSFER ADDRESS @V305096 05670000
LA R8,DEC3(R8) UPDATE NUM OF HLFWORDS @V305096 05671000
* USER DATA 05672000
XC RLDITEM(NONREL),RLDITEM CLEAR RLD CONSTANTS @V305065 05673000
TM PHTYPED,RELPHASE RLDITEM, RLDBLCK, @V305096 05674000
BNO ENDROUT AND PRTSTRT WILL ONLY @V305096 05675000
* BE PRESENT IF THE PHASE 05676000
* IS RELOCATABLE 05677000
MVC RLDITEM,RLDITEMD NUM OF RLD ITEMS @V305096 05678000
MVC RLDBLCK,RLDBLCKD+1 NUM OF EXTRA RLD BLOCKS @V305096 05679000
MVC PRTSTRT,LINKSTRD+1 PARTITION START ADDRESS @V305096 05680000
LA R8,DEC3(R8) UPDATE NUM OF HLFWORDS @V305096 05681000
* USER DATA 05682000
ENDROUT STC R8,USERDAT AND STORE IT @V305096 05683000
LA R8,DEC6(R8) ADD 6 H TO USERDATA @V305096 05684000
SLL R8,1 MULTIPLY BY 2 TO GET @V305096 05685000
* TOTAL LENGTH OF ENTRY 05686000
AR R3,R8 GO TO NEXT ENTRY @V305096 05687000
BR RE RETURN @V305096 05688000
EJECT 1 05689000
************************************************************ 05690000
* 05691000
* CMS SUBROUTINE TO WRITE DOSLIB AND ISSUE STOW 05692000
* 05693000
************************************************************ 05694000
DROP R3 @V305065 05695000
USING STOWENT,R2 @V305065 05696000
UPDDIR EQU * @V305065 05697000
ST RE,RESAVE1 SAVE RETURN REGISTER @V305065 05698000
LA R2,HEADLNG(,R4) POINT TO STOW RECORD @V305065 05699000
LH R7,PHSADDR GET CURRENT PHS FIRST RECNUM @V305065 05700000
SR R8,R8 @V305065 05701000
IC R8,RLDBLCK GET RLD BLOCK COUNT @V305065 05702000
AH R8,NOBLOCK ADD TEXT RECORD COUNT @V305065 05703000
LA R3,STOWENTL GET LENGTH OF STOW @V305065 05704000
BAL RE,WRITE GO WRITE STOW RECORD @V305065 05705000
L R2,AWKARE POINT TO I/O AREA @V305065 05706000
UPDDIR1 EQU * @V305065 05707000
FSREAD ,FSCB=SYSUT2,BUFFER=(2),RECNO=(7),ERROR=UPDERR @V305065 05708000
LR R3,R0 GET RECORD LENGTH @V305065 05709000
DROP R2 @V305065 05710000
USING STOWENT,R1 @V305065 05711000
LA R1,HEADLNG(,R4) POINT TO STOW ENTRY @V305065 05712000
CH R8,K1 IS THIS LAST RECORD? @V305065 05713000
BNE UPDIR1A BRANCH IF NOT @V305065 05714000
LH RF,RLDITEM YES, GET NUM OF RLD ITEMS @V305065 05715000
MH RF,=H'4' TIMES SIZE OF ITEM @V305065 05716000
AH RF,NOBYTES ADD BYTES OF LAST TXT BLK @V305065 05717000
LA RF,3(,RF) ROUND UP TO NEXT FULLWORD @V305065 05718000
SRL RF,DEC2 @V305065 05719000
SLL RF,DEC2 @V305065 05720000
SR RE,RE CLEAR REGISTER @V305065 05721000
DR RE,R0 DIVIDE BY RECORD SIZE @V305065 05722000
LTR RE,RE IS THERE A REMAINDER? @V305065 05723000
BZ UPDIR1A BRANCH IF NOT @V305065 05724000
LR R3,RE YES, GET RESIDUAL @V305065 05725000
UPDIR1A EQU * @V305065 05726000
BAL RE,WRITE WRITE THE RECORD ON DOSLIB @V305065 05727000
LA R7,1(,R7) UPDATE RECORD NUMBER @V305065 05728000
BCT R8,UPDDIR1 GO READ NEXT RECORD @V305065 05729000
UPDDIR2 EQU * @V305065 05730000
FSCLOSE ,FSCB=SYSUT2 CLOSE THE FILE @V305065 05731000
LA R3,HEADLNG(,R4) POINT TO STOW RECORD @V305065 05732000
NI DOSFLAGS,255-DOSSVC TURN OFF DOS SVC INDIC. @V305065 05733000
STOW DOSLIB,(R3),R ISSUE STOW @V305065 05734000
OI DOSFLAGS,DOSSVC INDICATE DOS SVC @V305065 05735000
L RE,RESAVE1 GET RETURN REGISTER @V305065 05736000
BR RE AND RETURN @V305065 05737000
* 05738000
UPDERR EQU * @V305065 05739000
C R9,CTLDAD END OF C/D REACHED? @V305065 05740000
BNH RDDSKERR BRANCH IF NOT @V305065 05741000
CH RF,K12 END OF FILE @V305065 05742000
BNE RDDSKERR BRANCH IF NOT @V305065 05743000
B UPDDIR2 FINISH UP @V305065 05744000
* 05745000
RESAVE1 DC F'0' @V305065 05746000
DROP R1 @V305065 05747000
EJECT 05748000
* 05749000
**************************************************************** 05750000
* CONSTANTS, SWITCHES AND DSECTS 05751000
************************************************************** 05752000
* 05753000
MINDAT DC H'3' MINIMAL NUM OF HLFWRDS @V305096 05754000
* OF USERDATA IN STOW/T 05755000
**************************************************************** 05756000
** DSECT OF STOW TABLE ENTRY 05757000
**************************************************************** 05758000
STOWENT DSECT @V305096 05759000
PHSNAME DS CL8 PHASE NAME @V305096 05760000
PHSADDR DS XL3 TRK ADDR ( RELATIVE TO @V305096 05761000
* BEGIN OF DIRECTORY ) AND 05762000
* RECORD NUMBER (TTR) OF 05763000
* FRST BLK OF PHASE 05764000
USERDAT DS XL1 NUMBER OF HALFWORDS @V305096 05765000
* USER DATA 05766000
NOBLOCK DS H NUM OF TEXT BLOCKS @V305096 05767000
NOBYTES DS H NUM OF BYTES IN LAST @V305096 05768000
* TEXT BLOCK 05769000
PHSTYPE DS XL1 PHASE TYPE SWITCH @V305096 05770000
* X'80' SELFRELOCATING 05771000
* X'40' RELOCATABLE 05772000
* X'20' SVA ELIGIBLE 05773000
REQTYPE DS C TYPE OF REQUEST @V305096 05774000
* C'C' FOR OPTION CATAL 05775000
* C'L' FOR OPTION LINK 05776000
LOADPNT DS XL3 LOAD POINT OF PHASE @V305096 05777000
ENTRYPT DS XL3 ENTRY POINT OF PHASE @V305096 05778000
RLDITEM DS H NUM OF RLD ITEMS @V305096 05779000
RLDBLCK DS XL1 NUM OF RLD BLOCKS @V305096 05780000
PRTSTRT DS XL3 START OF PARTITION @V305096 05781000
STOWENTL EQU *-STOWENT LENGTH OF STOW TABLE @V305096 05782000
* ENTRY 05783000
SELFRL EQU *-LOADPNT @V305065 05784000
NONREL EQU *-RLDITEM @V305065 05785000
**************************************************************** 05786000
** DSECT OF STOW TABLE HEADER 05787000
**************************************************************** 05788000
STOWTAB DSECT @V305096 05789000
LIBCU DS XL2 LOGICAL UNIT OF LIBRARY @V305096 05790000
DIRADDR DS XL6 START ADDR OF DIR @V305096 05791000
* FOR OPTION CATAL DIRADDR CONTAINS THE ADDRESS OF THE 05792000
* DIRECTORY OF CATALOGED PHASES, 05793000
* FOR OPTION LINK THE ADDRESS OF THE LINK AREA OF THE 05794000
* CIL. 05795000
* CIL IS THE SYSTEM CIL IF NO PCIL IS ASSIGNED OR THE 05796000
* UNIQUELY ASSIGNED PCIL OF THE PARTITION. 05797000
REQNUM DS H NUMBER OF REQUEST @V305096 05798000
ENTNUM DS H NUMBER OF FOLLOWING @V305096 05799000
* ENTRIES 05800000
HEADLNG EQU *-STOWTAB LENGTH OF HEADER @V305096 05801000
* 05802000
DLKCAT CSECT RESUME CSECT @V305096 05803000
LTORG , @V305096 05804000
DLKCATND EQU * END OF CSECT DLKCAT @V305096 05805000
TITLE 'DLKINL LINK EDITOR INITIALIZATION - $LNKEDT - DOS' 05806000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 05807000
* 05808000
* CSECT DLKINL - INITIALIZATION AND ACTION CARD PROCESSOR 05809000
* 05810000
* ENTRY POINT - DLKINL - ENTRY FROM JOB CONTROL 05811000
* 05812000
* FUNCTION - INITIALIZES CONSTANTS AND ADDRESSES OF TABLES 05813000
* AND WORKAREAS. RELOCATES ADDRESS CONSTANTS OF CSECT'S 05814000
* DMSDLK AND DLKINL. 05815000
* CHECKS IF PCIL ( IF ASSIGNED ) IS USEABLE. OPENS DOSLNK 05816000
* AND SYS001. 05817000
* PROCESSES ACTION CARDS. 05818000
* 05819000
* INPUT - DOSLNK 05820000
* 05821000
* OUTPUT - N/A 05822000
* 05823000
* EXTERNAL ROUTINES - SEE LIST OF SUBROUTINES IN CSECT DLKINL 05824000
* 05825000
* EXITS - NORMAL TO MAINFLOW IN DMSDLK 05826000
* - ERROR - ERROR MESSAGES RESULTING FROM THIS CSECT 05827000
* ARE 2112, 2113, 2135, 2136, 2184, 2191. 05828000
* 05829000
*TABLES AND WORKAREAS - EXPLAINED IN COMMENTS OF CSECT DMSDLK 05830000
* 05831000
*ATTRIBUTES - N/A 05832000
* 05833000
*************************************************************** 05834000
* 05835000
DLKINL CSECT INITIALIZATION @V305096 05836000
BALR R9,0 INITIALISE BASE REG @V305065 05837000
USING *,R9 @V305065 05838000
USING E1,RA @V305096 05839000
* 05840000
INTPT2 EQU * @V305096 05841000
******************************************************************** 05842000
* COMPUTE THE RELOCATION FACTOR,LOAD THE BASE REGISTER USED FOR 05843000
* THE CONSTANTS,AND SAVE THE RELOCATION FACTOR FOR USE IN DLKRLD. 05844000
* REGISTER 7 WILL HOLD THAT FACTOR FOR LATER USE IN THIS PHASE. 05845000
******************************************************************** 05846000
LR R7,R9 LOAD ADDR IN THE BASE REG @V305096 05847000
LA R7,0(R7) CLEAR HIGH ORDER BYTE @V305096 05848000
S R7,RELOADCN SUBTRACT ABSOLUTE ADDR OF @V305096 05849000
* INSTRUCTION AFTER BALR 05850000
L RC,CNBASE LOAD ABSOLUTE ADDR OF CONSTNT@V305096 05851000
AR RC,R7 ADD RELOCATION FACTOR @V305096 05852000
ST RE,REGSAVE SAVE RETURN REGISTER @V305065 05853000
TM DOSFLAGS,DOSMODE IS DOS ON? @V305065 05854000
BZ NODOS BRANCH IF NOT @V305065 05855000
DMSKEY NUCLEUS SET PROTECTION KEYS @V305065 05856000
* 05857000
BAL RE,PLIST CHECK PLIST OPTIONS @V305065 05858000
EJECT 1 05859000
******************************************************************** 05860000
* IF THE NUMBER OF PARTITIONS SPECIFIED AT SUPVR ASSEMBLY TIME * 05861000
* IS LESS THAN THE ALLOWED MAXIMUM, THIS ROUTINE MAKES THE * 05862000
* ASSOCIATED ENTRIES IN THE 'ACTION OPERAND TABLE' * 05863000
* FOR THE HIGHER PARTITIONS INVALID * 05864000
******************************************************************** 05865000
SPACE 1 05866000
MVI NUMPART+1,DEC1 NUMBER OF PARTITIONS @V305096 05867000
LA R2,ENTLNGTH LENGTH OF ONE ENTRY @V305096 05868000
MH R2,NUMPART MULTIPLIED BY SPECIFIED@V305096X05869000
NUMBER OF PARTITIONS @V305096 05870000
LA R2,OPBG(R2) PLUS ADDR OF ENTRY @V305096X05871000
FOR 1ST PARTITION GIVE ADDR OF 1ST INVALID ENTRY@V305096 05872000
LA R3,(LASTPART+ENTLNGTH-1) GET LENGTH @V305096 05873000
SR R3,R2 FOR INVALIDATE @V305096 05874000
BNP ALLVALID IF LENGTH ZERO, ALL ENTRIES @V305096X05875000
VALID @V305096 05876000
EX R3,NVALID MAKE ENTRIES INVALID @V305096 05877000
ALLVALID EQU * @V305096 05878000
SPACE 05879000
SYSIR (R2,R5,R3,R4),LUB,FG @V305096 05880000
EJECT 1 05881000
************************************************************** 05882000
* THIS ROUTINE CHECKS THE DEVICE TYPE OF THE RELOCATABLE 05883000
* LIBRARY ( = SYSRES DEVICE TYPE ) AND MOVES THE OVERFLOW 05884000
* FACTORS FOR THE RELOCATABLE LIBRARY TO DEVTAB. 05885000
************************************************************** 05886000
USING BGCOM,R4 @V305096 05887000
USING PUBADR,R3 @V305096 05888000
MVC COMNAME(8),DLKNAME MOVE IN DOSLKED NAME @V305065 05889000
SR R3,R3 @V305096 05890000
LR R5,R2 SAVE LUB ADDRESS @V305065 05891000
IC R3,LUBRES GET PUB NO FOR SYSRES @V305096 05892000
CH R3,K255 IS THERE A SYSRES @V305065 05893000
BE DNTCPT BRANCH IF NOT @V305065 05894000
MH R3,=Y(PUBWIT) MULT WITH LENGTH OF PUB @V305096 05895000
AH R3,PUBPT ADD PUB TABLE ADDRESS @V305096 05896000
MVC RESTYP,PUBDEVT MOVE DEVICE TYPE @V305096 05897000
* OF SYSRES 05898000
MVC RESADDR,PUBCUU SAVE SYSRES ADDRESS @V305065 05899000
LA R7,(DEVEND-DEVSTART)/LDEVTAB @V305096 05900000
LA R3,DEVSTART @V305096 05901000
DEVLOOP CLC RESTYP,0(R3) DO DEVICE TYPES MATCH @V305096 05902000
BE MOVERES YES, BRANCH @V305096 05903000
LA R3,LDEVTAB(R3) NO, GO TO NEXT TABLE @V305096 05904000
BCT R7,DEVLOOP IN TABLE OF DEV CONST @V305096 05905000
MOVERES MVC FCTREL(DEC8),DEC1(R3) MOVE CONST FOR REL LIB @V305096 05906000
EJECT 05907000
******************************************************************** 05908000
* SET UP INFORMATION FOR THE RELOCATABLE LIBRARY FROM THE SYSTEM 05909000
* DIRECTORY. 05910000
******************************************************************** 05911000
SPACE 05912000
LH R1,RESADDR GET SYSRES ADDRESS @V305065 05913000
STH R1,DSKCCB SAVE SYSRES ADDRESS @V305065 05914000
LA RF,1 ONE READ @V305065 05915000
MVC ADRESS,RLDINFO SET CCHHR FOR SYSTEM DIRECTORY @V305096 05916000
MVC DSKWHT,READIR READ LIBRARY DESCRIPTION FOR @V305065 05917000
BAL RE,DISKRDWR REL LIBRARY INFORMATION @V305096 05918000
* 05919000
CLI INPBLK,BLANK IF NO RELOCATABLE LIBRARY LEAVE @V305096 05920000
BE DNTCPT SWITCH TO INDICATE SUCH, ELSE @V305096 05921000
LH R1,RESADDR GET SYSRES ADDRESS @V305065 05922000
LA RF,1 ONE READ @V305065 05923000
MVC ADRESS,INPBLK+DEC2 DISK ADDR OF REL LIB DIRCTRY @V305096 05924000
MVC DSKWHT,READRD MOVE IN DIRECTORY CCW @V305065 05925000
BAL RE,DISKRDWR READ REL.DIRECTORY INFO @V305096 05926000
CLC ADRESS,INPBLK+2 ADDRESSES THE SAME? @V305065 05927000
BNE ERR094 BRANCH IF NOT @V305065 05928000
MVC RELDST,INPBLK+DEC2 START ADDR OF REL DIRECTORY @V305096 05929000
DNTCPT EQU * @V305096 05930000
EJECT 05931000
************************************************************* 05932000
* 05933000
* LOCATE DOSLNK IF AVAILABLE. MAKE SURE THAT THE 05934000
* A DISK IS READ / WRITE. 05935000
* 05936000
************************************************************* 05937000
FSSTATE ,FSCB=DOSLNK,ERROR=NODOSLK @V305065 05938000
USING FSTSECT,R1 @V305065 05939000
MVC DOSLNK+24(2),FSTM MOVE IN FILEMODE @V305065 05940000
CLI FSTFV,C'F' IS IT FIXED LENGTH? @V305065 05941000
BNE NOF80 BRANCH IF NOT @V305065 05942000
CLC FSTIL,=F'80' RECORD LENGTH 80? @V305065 05943000
BNE NOF80 BRANCH IF NOT @V305065 05944000
B CHKADSK @V305065 05945000
NODOSLK EQU * @V305065 05946000
CH RF,=H'28' FILE NOT FOUND ERROR? @V305065 05947000
BNE BADDOSLK NO, INVALID PARM @VA08808 05948000
OI CMSSWT1,NODOSLNK+FSTSW NO DOSLNK AVAILABLE @V305065 05949000
DROP R1 @V305065 05950000
USING ADTSECT,R1 @V305065 05951000
CHKADSK EQU * @V305065 05952000
LA R1,DOSMAP POINT TO ANY PLIST @V305065 05953000
L RF,AADTLKP GET ADDRESS OF ADTLKP @V305065 05954000
BALR RE,RF GET ADT FOR A-DISK @V305065 05955000
BP NODISK BRANCH IF NO A-DISK @V305065 05956000
LA RF,DOSMAP SET FOR ERROR ROUTINE @V305065 05957000
TM ADTFLG1,ADTFRW IS IT R/W? @V305065 05958000
BZ NODISK BRANCH IF NOT @V305065 05959000
DROP R1 @V305065 05960000
EJECT 1 05961000
************************************************************* 05962000
* 05963000
* DETERMINE WHICH R/W DISK HAS THE MOST SPACE AVAILABLE 05964000
* AND SEND THE UTILITY FILES THERE. 05965000
* 05966000
************************************************************* 05967000
USING FSCBD,R1 @V305065 05968000
LA R1,SYSUT1 POINT TO SYSUT1 PLIST @V305065 05969000
L RF,AADTLKW GET ADTLKW ROUTINE ADDRESS @V305065 05970000
BALR RE,RF FIND DISK WITH MOST SPACE @V305065 05971000
BP NODISK BRANCH IF NO DISK AVAILABLE @V305065 05972000
DROP R1 @V305065 05973000
USING ADTSECT,R1 @V305065 05974000
MVC SYSUT1+24(1),ADTM MOVE IN MODE LETTER @V305065 05975000
DROP R1 @V305065 05976000
USING FSCBD,R1 @V305065 05977000
LA R1,SYSUT1 POINT TO PLIST @V305065 05978000
MVI FSCBFM+1,C'1' SET MODE NUMBER @V305065 05979000
LA RF,SYSUT2 POINT TO OTHER SYSUT PLIST @V305065 05980000
MVC 24(2,RF),FSCBFM SET ITS FILEMODE @V305065 05981000
MVC FSCBFN,DOSFINM MOVE IN FILENAME @V305065 05982000
FSERASE ,FSCB=(1) ERASE OLD FILE @V305065 05983000
CH RF,=H'24' PARAMETER ERROR? @V305065 05984000
BE INVPARM BRANCH IF YES @V305065 05985000
LA R1,SYSUT2 POINT TO SYSUT2 PLIST @V305065 05986000
MVC FSCBFN,DOSFINM MOVE IN FILENAME @V305065 05987000
FSERASE ,FSCB=(1) ERASE OLD FILE @V305065 05988000
EJECT 1 05989000
************************************************************* 05990000
* 05991000
* SETUP OUTPUT FIELDS 05992000
* 05993000
************************************************************* 05994000
TM CMSSWT1,MAPPRT+MAPTYP TYPE OR PRINT SPECIFIED? @V305065 05995000
BNZ INTS01 BRANCH IF YES @V305065 05996000
LA R1,DOSMAP POINT TO DOSMAP PLIST @V305065 05997000
MVC FSCBFN,DOSLNK+8 MOVE FILENAME TO PLIST @V305065 05998000
FSERASE ,FSCB=(1) ERASE OLD FILE @V305065 05999000
* 06000000
* SET CONSTANTS FOR LINE CONTROL 06001000
* 06002000
INTS01 EQU * @V305065 06003000
MVC LINES+1(DEC1),SYSLINE SAVE SYSLST LINE COUNT @V305065 06004000
OI MAPSW,HEX1 ASSUME MAP @V305065 06005000
EJECT 1 06006000
******************************************************************** 06007000
* HANDLE PRIVATE RELOCATABLE LIBRARY. 06008000
******************************************************************** 06009000
LR R2,R5 RESTORE LUB ADDRESS @V305065 06010000
MVC HEADER+DEC16(DEC8),JOBDATE SET UP DATE @V305096 06011000
MVC DATE,JOBDATE SAVE DATE @V305096 06012000
OI ACTSW,REL/DEC256 ASSUME ACTION REL IS DEFAULT @V305096 06013000
TM LUBRLB,X'FE' IS SYSRLB ASSIGNED? @V305065 06014000
BO NOSYSRLB BRANCH IF NOT @V305065 06015000
SR R3,R3 @V305065 06016000
ICM R3,DEC7,DOSFIRST+1 GET DOSCB CHAIN ADDRESS @V305065 06017000
USING DOSSECT,R3 @V305065 06018000
NXTSYSRL EQU * @V305065 06019000
BZ NOSYSRLB IF ZERO, NO MORE DOSCB @V305065 06020000
CLC DOSDD,=CL8'IJSYSRL' MATCHING DDNAME? @V305065 06021000
BE THSSYSRL BRANCH IF YES @V305065 06022000
ICM R3,DEC7,1(R3) GET NEXT DOSCB ADDRESS @V305065 06023000
B NXTSYSRL AND LOOP @V305065 06024000
THSSYSRL EQU * @V305065 06025000
CLI DOSDEV,DOSDSK IS DEVICE DISK? @V305065 06026000
BNE NOSYSRLB BRANCH IF NOT @V305065 06027000
FSSTATE ,FSCB=DOSOP,ERROR=NOSYSRLB @V305065 06028000
L R3,DOSOSFST GET OSFST FOR PRIV RELO @V305065 06029000
DROP R3 @V305065 06030000
LTR R3,R3 IS THERE AN OSFST? @V305065 06031000
BZ NOSYSRLB BRANCH IF NOT @V305065 06032000
USING OSFST,R3 @V305065 06033000
MVC RELPVT(DEC4),OSFSTXTN+2 SAVE PRIV RELO CCHH @V305065 06034000
MVI RELPVT+4,1 RECORD ONE @V305065 06035000
MVC PRVADDR,OSFSTDSK SAVE PRIV RELOC ADDRESS @V305065 06036000
DROP R3 @V305065 06037000
CLI FCTREL,X'00' IS THERE A DOSRES? @V305065 06038000
BNE NOSYSRLB BRANCH IF YES @V305065 06039000
USING PUBADR,R3 @V305065 06040000
SR R3,R3 @V305065 06041000
IC R3,LUBRLB GET PUB NO FOR SYSRLB @V305065 06042000
MH R3,=Y(PUBWIT) MULT WITH LENGTH OF PUB @V305065 06043000
AH R3,PUBPT ADD PUB TABLE ADDRESS @V305065 06044000
MVC RESTYP,PUBDEVT MOVE DEV TYPE OF SYSRLB @V305065 06045000
LA R7,(DEVEND-DEVSTART)/LDEVTAB @V305065 06046000
LA R3,DEVSTART @V305065 06047000
RLBLOOP EQU * @V305065 06048000
CLC RESTYP,0(R3) DO DEVICE TYPES MATCH? @V305065 06049000
BE MOVERLB BRANCH IF YES @V305065 06050000
LA R3,LDEVTAB(R3) NO, GO TO NEXT TABLE @V305065 06051000
BCT R7,RLBLOOP AND CHECK AGAIN @V305065 06052000
MOVERLB EQU * @V305065 06053000
MVC FCTREL(DEC8),DEC1(R3) MOVE CONST FOR REL LIB @V305065 06054000
DROP R4 @V305065 06055000
DROP R3 @V305065 06056000
NOSYSRLB EQU * @V305065 06057000
EJECT 06058000
******************************************************************** 06059000
* THIS ROUTINE FIGURES THE FIRST USEABLE ADDR IN THE RESIDENT 06060000
* PARTITION. THIS ADDRESS IS USED AS THE DEFAULT ADDRESS IN 06061000
* ACTUAL LINKAGE. 06062000
******************************************************************** 06063000
SPACE 06064000
L R3,H20000 START ADDRESS OF USER REG @V305096 06065000
ST R3,PARTSTRT SAVE PART STARTING ADDR @V305096 06066000
* FOR PROGRAM TO BE LINKED 06067000
* (ALWAYS VIRTUAL PART ) 06068000
L R4,FREELOWE END OF STORAGE ADDRESS @V305096 06069000
LA R4,DEC1(R4) FOR THIS PARTION @V305096 06070000
DROP R2 @V305096 06071000
SH R4,HCDLNGTH SUBTR LNTH OF C/D ENTRY @V305096 06072000
ST R4,TENK SAVE IT IN TENK @V305096 06073000
* LENGTH 06074000
EJECT 06075000
******************************************************************** 06076000
* CALCULATE ADDRESSES FOR LINKAGE TABLE, 06077000
* CONTROL DICTIONARY AND WORK AREA 06078000
******************************************************************** 06079000
* 06080000
* DLKINL WILL BE OVERLAID BY THE TEXT BUFFER, L/T AND C/D 06081000
* 06082000
L R2,VCATND ALIGN TEXT BUFFER @V305096 06083000
LA R2,1023(R2) ON 1K BOUNDARY @V305096 06084000
N R2,ONEKALGN @V305096 06085000
ST R2,AWKARE RETAIN ADDRESS OF WORKAREA @V305096 06086000
AH R2,CILRSIZE INCLUDE SIZE OF WORKAREA IN CALCS @V305096 06087000
LA R2,2047(R2) ALIGN BEGIN OF L/T @V305096 06088000
N R2,PAGEALGN ON PAGE BOUNDARY @V305096 06089000
ST R2,LNKTAD SET UP THE BEGIN @V305096 06090000
LR R5,R2 @V305096 06091000
AH R5,LTABLTH CALCULATE STRT OF C/D @V305096 06092000
ST R5,CDENT1 AND STORE @V305096 06093000
SH R5,HCDLNGTH INIT CURRENT C/D ADDR @V305096 06094000
ST R5,CTLDAD @V305096 06095000
SH R2,HLTLNGTH @V305096 06096000
ST R2,LTMINE @V305065 06097000
EJECT 1 06098000
************************************************************ 06099000
* 06100000
* FILEDEF DOSLIB 06101000
* 06102000
************************************************************ 06103000
LA R1,DOSFIAC POINT TO STATE PLIST @V305065 06104000
SVC 202 STATE DOSLIB @V305065 06105000
DC AL4(*+4) @V305065 06106000
LTR RF,RF ANY ERRORS? @V305065 06107000
BNZ NOLIB BRANCH IF SO @V305065 06108000
L RF,DOSFST POINT TO FST @V305065 06109000
USING FSTSECT,RF @V305065 06110000
TM FSTFB,FSTFRW IS THIS A R/W DISK? @V305065 06111000
BZ LIBNTRW BRANCH IF NOT @V305065 06112000
TM FSTFB,FSTFRWX R/O EXTENSION OF R/W? @V305065 06113000
BO LIBNTRW BRANCH IF YES @V305065 06114000
MVC DOSFIMD,FSTM MOVE IN FILEMODE @V305065 06115000
B LIBEXIS @V305065 06116000
DROP RF @V305065 06117000
NOLIB EQU * @V305065 06118000
OI CMSSWT1,NODOSLIB NO DOSLIB @V305065 06119000
MVC DOSFIMD,=C'A1' DEFAULT MODE TO A DISK @V305065 06120000
LIBEXIS EQU * @V305065 06121000
MVC DOSFIAC,=CL8'DISK' SET UP FILEDEF @V305065 06122000
LA R1,DOSFILDF POINT TO FILEDEF PLIST @V305065 06123000
SVC 202 FILEDEF DOSLIB @V305065 06124000
LTR RF,RF ANY ERRORS? @V305065 06125000
BNZ INVPARM BRANCH IF YES @V305065 06126000
NI DOSFLAGS,255-DOSSVC TURN OFF DOS SVC INDIC. @V305065 06127000
OPEN (DOSLIB,(OUTPUT)) OPEN DOSLIB @V305065 06128000
OI DOSFLAGS,DOSSVC INDICATE DOS SVC @V305065 06129000
LA R1,DOSFILDF POINT TO PLIST @V305065 06130000
TM DOSLIB+48,X'10' WAS OPEN SUCCESSFUL? @V305065 06131000
BZ INVPARM BRANCH IF NOT @V305065 06132000
TM CMSSWT1,NODOSLNK IS THERE A DOSLNK? @V305065 06133000
BO NODSLNK BRANCH IF NOT @V305065 06134000
SR R2,R2 CLEAR RECNO REG. @V305065 06135000
B NXTCARD BRANCH IF FOUND @V305065 06136000
NODSLNK EQU * @V305065 06137000
LA RA,INPBLK POINT TO INPUT AREA @V305065 06138000
MVC INPBLK(9),=CL9' INCLUDE ' SET UP DUMMY @V305065 06139000
MVC INPBLK+9(8),DOSLNK+8 INCLUDE CARD @V305065 06140000
MVI INPBLK+17,C' ' MOVE IN BLANK @V305065 06141000
MVC INPBLK+18(101),INPBLK+17 CLEAR REST OF FIELD @V305065 06142000
MVC RDCB00,KMIN CLEAR UNIT ADDRESS FIELD @V305065 06143000
B NOTACT @V305065 06144000
EJECT 06145000
******************************************************************* 06146000
* 06147000
* ACTION CARD PROCESSOR 06148000
* 06149000
* THIS ROUTINE READS ACTION CARDS 06150000
* THE SYNTAX OF THE ACTION CARD IS CHECKED AND THE APPROPIATE 06151000
* ACTION TAKEN. 06152000
* ERROR MSG NOS. RESULTING FROM THIS ROUTINE ARE 06153000
* 2112-2113-2135-2136 06154000
* 06155000
******************************************************************* 06156000
SPACE 2 06157000
* GET CARD IMAGE FROM DOSLNK AND ADDRESS OF COLUMN 72 06158000
SPACE 1 06159000
NXTCARD EQU * @V305065 06160000
LA R2,1(,R2) DETERMINE NEXT RECORD @V305065 06161000
FSREAD ,FSCB=DOSLNK,RECNO=(2),ERROR=ERR094 @V305065 06162000
LA RA,INPBLK POINT TO RECORD @V305065 06163000
LA R5,E1+71 SET ADDRESS OF COLUMN 72 @V305096 06164000
ST R5,COLUMN72 FOR CHECKING PURPOSE @V305096 06165000
SPACE 1 06166000
* SEARCH THE ACTION VERB, IF FOUND BYPASS IT, OTHERWISE 06167000
* STOP ACTION PROCESSING 06168000
SPACE 1 06169000
CLI E1,BLANK FIRST NOT BLANK, THIS CANNOT BE @V305096 06170000
BNE NOTACT AN ACTION CARD @V305096 06171000
LR R6,RA GET ADDRESS IN R6 @V305096 06172000
FNDVRB LA R6,1(R6) UPDATE TO NEXT CHARACTER @V305096 06173000
CLI 0(R6),BLANK LOOK FOR BLANK @V305096 06174000
BE FNDVRB SKIP BLANKS UNTIL VERB IS FOUND @V305096 06175000
* 06176000
CLC 0(L'KACTION,R6),KACTION IS VERB ACTION @V305096 06177000
BNE NOTACT NO @V305096 06178000
* 06179000
LA R6,DEC6(R6) BYPASS ACTION VERB ON CARD @V305096 06180000
* 06181000
* FIND THE OPERAND FIELD 06182000
SPACE 1 06183000
FNDOPER LA R6,DEC1(R6) BYPASS BLANKS UNTILL @V305096 06184000
CLI 0(R6),BLANK OPERAND FIELD FOUND @V305096 06185000
BE FNDOPER @V305096 06186000
LR R5,R6 GET FIRST OPERAND START ADDR @V305096 06187000
L RB,IPTMTX GET CSECT ADDRESS @VA05886 06188000
USING DLKSCN,RB SET ADDRESSABILITY @VA05886 06189000
L RB,AMSG12 PREPARE ERROR 2112 @V305096 06190000
DROP RB FREE THE REGISTER @VA05886 06191000
C R5,COLUMN72 IF ADDRESS BEYOND COLUMN 72 @V305096 06192000
BNL ERRACT GO TO ERROR ROUTINE @V305096 06193000
SPACE 1 06194000
* FIND OPERAND DELIMITER COMMA OR BLANK 06195000
SPACE 1 06196000
BCTR R6,0 POSITION R6 @V305096 06197000
FNDDELIM LA R6,DEC1(R6) GET NEXT CHARACTER @V305096 06198000
CLI 0(R6),COMMA IS IT COMMA @V305096 06199000
BE DELIMFND YES, DELIMITER IS FOUND @V305096 06200000
CLI 0(R6),BLANK IS IT BLANK @V305096 06201000
BNE FNDDELIM NO, CONTINUE SCAN @V305096 06202000
SPACE 1 06203000
* CHECK THE FOUND OPERAND FOR VALID LENGTH AND CARD LOCATION 06204000
SPACE 1 06205000
DELIMFND C R6,COLUMN72 COLUMN 71 EXCEEDED @V305096 06206000
L RB,OTHMTX GET CSECT ADDRESS @VA05886 06207000
USING DLKOTH,RB SET ADDRESSABILITY @VA05886 06208000
L RB,AMSG13 IF SO, @V305096 06209000
DROP RB FREE THE REGISTER @VA05886 06210000
BH ERRACT GO TO ERROR ROUTINE @V305096 06211000
SPACE 1 06212000
LR R7,R6 GET OPERAND @V305096 06213000
SR R7,R5 LENGTH IN REG 7 @V305096 06214000
BZ NEXTOPER IF LENGTH ZERO,CONTINUE SCAN @V305096 06215000
CH R7,K6 OPERAND LONGER THAN 6 CHAR @V305096 06216000
BNH ACTVALID NO, FIND EQUAL IN OP. LIST @V305096 06217000
OI ACTSW,INVALID/DEC256 INDICATE INVLD OPERAND FND @V305096 06218000
B NEXTOPER SEARCH NEXT OPERAND @V305096 06219000
SPACE 1 06220000
* MOVE THE FOUND OPERAND TO THE LAST ENTRY IN THE OPERAND LIST 06221000
* IF AN EQUAL OPERAND IS FOUND IN THE LIST, THE APPROPRIATE 06222000
* BITS ARE SET IN ACTSW, IF AN EQUAL COMPARE IS FOUND ON THE 06223000
* LAST ENTRY, A BIT IS SET IN ACTSW TO INDICATE AN INVALID 06224000
* OPERAND 06225000
SPACE 1 06226000
ACTVALID MVC LASTENTR(DEC6),BLANKS BLANKS TO LAST ENTRY @V305096 06227000
BCTR R7,0 PREPARE FOR MOVE OF OPERAND @V305096 06228000
EX R7,MOVEOPER MOVE THE OPERAND TO @V305096 06229000
* LAST LIST-ENTRY 06230000
LA R7,ACTLIST-ENTLNGTH PREPARE FOR TABLE SCAN @V305096 06231000
SCAN LA R7,ENTLNGTH(R7) PROCEED TO NEXT ENTRY @V305096 06232000
CLC 0(DEC6,R7),LASTENTR EQUAL OPERAND FOUND @V305096 06233000
BNE SCAN NO, CONTINUE SCAN @V305096 06234000
OC ACTSW,DEC6(R7) YES, SET APPROPRIATE SWITCH @V305096 06235000
NC ACTSW,DEC8(R7) & RESET CONFLICTING OPTIONS @V305096 06236000
SPACE 1 06237000
* PREPARE CARD SEARCH FOR NEXT OPERAND 06238000
SPACE 1 06239000
NEXTOPER CLI 0(R6),COMMA IF PREVIOUS SCAN STOPPED ON @V305096 06240000
* A COMMA THERE ARE MORE OPERANDS ON CURRENT CARD 06241000
LA R5,DEC1(R6) GET START OF NEXT OPERAND @V305096 06242000
BE FNDDELIM AND CONTINUE SCAN @V305096 06243000
SPACE 1 06244000
* IF NO ERRORS OCCURED ON PREVIOUS CARD, PREPARE FOR A 06245000
* NEW CARD. IF ERRORS OCCURED, STOP ACTION PROCESSING 06246000
SPACE 1 06247000
L RB,AMSG35 PREPARE FOR ERROR MSG @V305096 06248000
TM ACTSW,INVALID/DEC256 INVALID OPERAND FOUND @V305096 06249000
BNO NXTCARD NO, GO TO READ NEXT RECORD @V305096 06250000
* SET SWITCHES TO INDICATE ERROR, AFTER THAT FINISH ACTION 06251000
* PROCESSING FOR THE OPERANDS FOUND UNTILL NOW 06252000
SPACE 1 06253000
ERRACT MVI ACTERR+DEC1,HEX0 IF ERROR OCCURS ON ACTION @V305096 06254000
* CARD, WE MUST END ALL ACTION PROCESS 06255000
* AND SET UP AS THE ACTION TAKEN, THAT 06256000
* WHICH WE HAVE ALREADY PROCESSED . 06257000
* THEN WE WILL GO TO THE ERROR 06258000
* PROCESSOR AND PROCESS THE ERROR 06259000
EJECT 06260000
* FINISH ACTION PROCESSING AND TAKE THE NECESSARY ACTIONS 06261000
SPACE 1 06262000
NOTACT LH R5,ACTSW PREPARE SCAN OF ACTSW @V305096 06263000
SLL R5,DEC16 SHIFT OUT MEANINGLESS BITS @V305096 06264000
LA R8,ACTLIST-ENTLNGTH INITIATE LIST POINTER @V305096 06265000
LA R7,(LASTENTR-ACTLIST)/ENTLNGTH NUMBER OF ENTRIES@V305096 06266000
* FOR LOOP CONTROL 06267000
SPACE 1 06268000
* SCAN ACTSW AND BRANCH TO THE APPROPRIATE ACTION ROUTINES 06269000
SPACE 1 06270000
RETOUR LA R8,ENTLNGTH(R8) INCREMENT TO NEXT OPERAND @V305096 06271000
SLL R5,DEC1 CHECK CORRESP. BIT IN ACTSW @V305096 06272000
LTR R5,R5 IF POSITIVE, SWITCH IS OFF @V305096 06273000
BNM ACTRET SO CONTINUE SCAN @V305096 06274000
EX R0,DEC10(R8) BRANCH TO CORRECT SUBROUTINE @V305096 06275000
ACTRET BCT R7,RETOUR CONT. SCAN UNTILL ALL CHECKED @V305096 06276000
SPACE 2 06277000
TM MAPSW,HEX1 ACTION MAP SPECIFIED @V305096 06278000
BO ACTLINE YES, GO TO PRINT @V305096 06279000
* ACTION TAKEN LIN 06280000
B ALIGN4 EXIT @V305096 06281000
SPACE 2 06282000
ACTLINE EQU * @V305096 06283000
LA R4,W1 SET UP PRINT LINE POINTER @V305096 06284000
MVC DEC0(L'ACTTAKEN,R4),ACTTAKEN 'ACTION TAKEN MAP'@V305096 06285000
* TO PRINT AREA 06286000
LA R4,L'ACTTAKEN(R4) AND UPDATE LINE POINTER @V305096 06287000
LH R1,ACTSW PREPARE FOR SCAN OF OPERANDS @V305096 06288000
SLL R1,DEC18 TO BE MOVED TO PRINT LINE @V305096 06289000
* (BYPASS MAP AND NOMAP) 06290000
LA R2,ACTLIST+2*ENTLNGTH ADDR OF FIRST OPERAND TO @V305096 06291000
* BE SCANNED 06292000
LA R6,(LASTENTR-ACTLIST-2*ENTLNGTH)/ENTLNGTH NUMBER@V305096 06293000
* OF ENTRIES TO BE SCANNED 06294000
MVOPRNDS SLL R1,DEC1 WAS THIS OPERAND SPECIFIED @V305096 06295000
LTR R1,R1 IF POSITIVE, @V305096 06296000
BNM NXTENTRY CONTINUE SCAN @V305096 06297000
MVC 0(DEC6,R4),0(R2) MOVE OPERAND TO PRINT AREA @V305096 06298000
LA R4,DEC7(R4) UPDATE LINE POINTER @V305096 06299000
NXTENTRY LA R2,ENTLNGTH(R2) UPDATE TO NEXT ENTRY @V305096 06300000
BCT R6,MVOPRNDS IF COUNT NOT EXCEEDED, RETURN @V305096 06301000
BAL R6,PRINT PRINT ACTION TAKEN LINE @V305096 06302000
SPACE 1 06303000
* GET END OF SUPERVISOR ADDRESS AND FIRST POSSIBLE ORIGIN 06304000
SPACE 1 06305000
ALIGN4 L R3,PARTSTRT GET PARTITION START ADDRESS @V305096 06306000
LA R3,DEC7(R3) ALIGN TO @V305096 06307000
SRL R3,DEC3 DOUBLEWORD @V305096 06308000
SLL R3,DEC3 BOUNDARY @V305096 06309000
* 06310000
ST R3,EOSPVR EFFECTIVE END OF SUPVR ADDRESS@V305096 06311000
ST R3,NXPHRG INIT FOR FIRST POSSIBLE ORIGIN@V305096 06312000
SPACE 1 06313000
* FINISH ACTION PROCESSING, EXIT TO ERROR ROUTINE IF 06314000
* APPLICABLE, OR TO CONTROL CARD SCAN 06315000
SPACE 1 06316000
B MAINFLOW @V305096 06317000
* 06318000
EJECT 06319000
******************************************************************** 06320000
* SUBROUTINE FOR ACTION MAP * 06321000
******************************************************************** 06322000
SPACE 1 06323000
ACTMAP EQU * @V305065 06324000
OI MAPSW,HEX1 INDICATE ACTION MAP @V305096 06325000
B ACTRET RETURN @V305096 06326000
SPACE 1 06327000
******************************************************************** 06328000
* SUBROUTINE FOR ACTION NOMAP * 06329000
******************************************************************** 06330000
SPACE 1 06331000
ACTNOMAP NI MAPSW,HEXFF-HEX1 TURN OFF MAP @V305096 06332000
B ACTRET RETURN @V305096 06333000
SPACE 1 06334000
******************************************************************** 06335000
* SUBROUTINE FOR ACTION NOAUTO * 06336000
******************************************************************** 06337000
SPACE 1 06338000
ACTNOAUT MVI ALNKSW,HEXFF SET SWITCH FOR PROGRAM NOAUTO @V305096 06339000
B ACTRET RETURN @V305096 06340000
SPACE 1 06341000
******************************************************************** 06342000
* SUBROUTINE FOR ACTION CANCEL * 06343000
******************************************************************** 06344000
SPACE 1 06345000
ACTCANCE OI MAPSW,HEX2 TURN ON CANCEL OPTION SWITCH @V305096 06346000
B ACTRET RETURN @V305096 06347000
EJECT 06348000
******************************************************************** 06349000
* SUBROUTINE FOR ACTION CLEAR * 06350000
******************************************************************** 06351000
ACTCLEAR EQU * @V305065 06352000
OI MAPSW,CLEARSW INDICATE CLEAR REQUESTED @V305065 06353000
B ACTRET RETURN @V305096 06354000
******************************************************************** 06355000
* SUBROUTINE FOR ACTION NOREL * 06356000
******************************************************************** 06357000
SPACE 1 06358000
ACTNOREL NI MAPSW,HEXFF-RELSW INDICATE ACTION NOREL @V305096 06359000
B ACTRET RETURN @V305096 06360000
SPACE 1 06361000
******************************************************************** 06362000
* SUBROUTINE FOR ACTION REL * 06363000
******************************************************************** 06364000
SPACE 1 06365000
ACTREL OI MAPSW,RELSW INDICATE ACTION REL @V305096 06366000
B ACTRET RETURN @V305096 06367000
SPACE 1 06368000
******************************************************************** 06369000
* SUBROUTINE FOR ACTION BG F1 F2 F3 AND F4 * 06370000
******************************************************************** 06371000
SPACE 1 06372000
ACTBG B ACTRET @V305096 06373000
EJECT 06374000
************************************************************ 06375000
* CMS SUBROUTINE FOR CHECKING PLIST 06376000
************************************************************ 06377000
PLIST EQU * @V305065 06378000
LA R1,8(,R1) POINT TO PLIST @V305065 06379000
CLI 0(R1),X'FF' IS THERE A PLIST? @V305065 06380000
BE NOFILEN BRANCH IF NOT,ERROR @V305065 06381000
CLI 0(R1),C'(' OPTION LIST? @V305065 06382000
BE NOFILEN BRANCH IF YES, ERROR @V305065 06383000
MVC DOSLNK+8(8),0(R1) MOVE IN DOSLNK FILE NAME @V305065 06384000
CLI 8(R1),C'(' NEXT ITEM LEFT PAREN? @V305065 06385000
BE NODSLIB BRANCH IF YES @V305065 06386000
CLI 8(R1),X'FF' END OF PLIST? @V305065 06387000
BE NODSLIB BRANCH IF YES @V305065 06388000
LA R1,8(,R1) POINT TO LIBNAME @V305065 06389000
NODSLIB EQU * @V305065 06390000
MVC DOSFINM,0(R1) MOVE DOSLIB FILENAME @V305065 06391000
CLI 8(R1),X'FF' END OF PLIST? @V305065 06392000
BE ENDPLIST BRANCH IF YES @V305065 06393000
CLI 8(R1),C'(' LEFT PAREN? @V305065 06394000
BNE INVPARM BRANCH IF NOT, ERROR @V305065 06395000
LA R1,16(,R1) POINT TO ITEM AFTER PAREN @V305065 06396000
CLI 0(R1),X'FF' IS THERE ONE? @V305065 06397000
BE ENDPLIST BRANCH IF NOT @V305065 06398000
CLC 0(8,R1),=CL8'DISK' IS IT DISK? @V305065 06399000
BE CHKEND BRANCH IF YES @V305065 06400000
CLC 0(8,R1),=CL8'PRINT' IS IT PRINT? @V305065 06401000
BNE CHKTYPE BRANCH IF NOT @V305065 06402000
OI CMSSWT1,MAPPRT INDICATE PRINT @V305065 06403000
LA R2,14 ASSUME DEVICE '00E' @V305065 06404000
DC X'832F0024' ISSUE DEVICE TYPE DIAGNOSE @V305065 06405000
CLM RF,4,=X'42' IS PRINTER 3211? @V305065 06406000
BNE CHKEND BRANCH IF NOT @V305065 06407000
OI CMSSWT1,PRT3211 INDICATE 3211 @V305065 06408000
B CHKEND @V305065 06409000
CHKTYPE EQU * @V305065 06410000
CLC 0(8,R1),=CL8'TERM' IS IT TERM? @V305065 06411000
BNE INVOPT ERROR IF NOT @V305065 06412000
OI CMSSWT1,MAPTYP INDICATE TYPE @V305065 06413000
CHKEND EQU * @V305065 06414000
LA R1,8(,R1) POINT TO NEXT ITEM @V305065 06415000
CLI 0(R1),C')' IS THIS RIGHT PAREN? @V305065 06416000
BNE CHKEND1 BRANCH IF NOT @V305065 06417000
LA R1,8(,R1) POINT PAST RIGHT PAREN @V305065 06418000
CHKEND1 EQU * @V305065 06419000
CLI 0(R1),X'FF' END OF PLIST? @V305065 06420000
BNE INVOPT ERROR IF NOT @V305065 06421000
ENDPLIST EQU * @V305065 06422000
BR RE RETURN @V305065 06423000
EJECT 1 06424000
INVOPT EQU * @V305065 06425000
LR R2,R1 POINT TO INVALID OPTION @V305065 06426000
DMSERR NUM=003,LET=E,SUB=(CHARA,(R2)), @V305065*06427000
TEXT='INVALID OPTION ''........''' @V305065 06428000
MVI ERCODE,ER024 SET ERROR CODE @V305065 06429000
B CANCLB @V305065 06430000
EJECT 1 06431000
INVPARM EQU * @V305065 06432000
LA R2,8(,R1) POINT TO INVALID PARM @V305065 06433000
DMSERR NUM=70,LET=E,SUB=(CHARA,(R2)), @V305065*06434000
TEXT='INVALID PARAMETER ''........''' @V305065 06435000
MVI ERCODE,ER024 SET ERROR CODE @V305065 06436000
B CANCL @V305065 06437000
EJECT 1 06438000
NOFILEN EQU * @V305065 06439000
DMSERR NUM=001,LET=E,TEXT='NO FILENAME SPECIFIED' @V305065 06440000
MVI ERCODE,ER024 SET ERROR CODE @V305065 06441000
B CANCLB @V305065 06442000
EJECT 1 06443000
NODOS EQU * @V305065 06444000
DMSERR NUM=099,LET=E, @V305065C06445000
TEXT='CMS/DOS ENVIRONMENT NOT ACTIVE' @V305065 06446000
MVI ERCODE,ER040 SET ERROR CODE @V305065 06447000
B CANCL1 @V305065 06448000
EJECT 1 06449000
NODISK EQU * @V305065 06450000
DMSERR TEXT='NO READ/WRITE ''A'' DISK ACCESSED', @V305065X06451000
NUM=006,LET=E @V305065 06452000
MVI ERCODE,ER032 SET ERROR CODE @V305065 06453000
B CANCLB @V305065 06454000
EJECT 1 06455000
NOF80 EQU * @V305065 06456000
LA R2,DOSLNK+8 POINT TO PLIST @V305065 06457000
DMSERR NUM=007,LET=E,SUB=(CHAR8A,(2)), @V305065X06458000
TEXT='FILE ''....................'' IS NOT FIXED, 80 CHAX06459000
R. RECORDS' @V305065 06460000
MVI ERCODE,ER032 SET ERROR CODE @V305065 06461000
B CANCL @V305065 06462000
EJECT 1 06463000
LIBNTRW EQU * @V305065 06464000
LR RE,RF POINT TO DOSLIB FN & FT IN FST @VM03016 06465000
DMSERR TEXT='LIBRARY ''.................'' IS ON A READ/ONLY D*06466000
ISK',NUM=210,LET=E,SUB=(CHAR8A,(RE)) @VM03016 06467000
MVI ERCODE,ER036 SET ERROR CODE @V305065 06468000
B CANCL @V305065 06469000
BADDOSLK EQU * @VA08808 06470000
STC RF,ERCODE SAVE ERROR CODE @VA08808 06471000
B CANCLB RETURN @VA08808 06472000
EJECT 06473000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 06474000
* 06475000
*** CONSTANTS REQUIRED ONLY DURING INITIALIZATION 06476000
* 06477000
VCATND DC A(DLKCATND) END OF RESIDENT CODE @V305096 06478000
PAGEALGN DC A(X'FFF800') USED TO FORCE TEXT BUFFER ADDR @V305096 06479000
* TO PAGE BOUNDARY 06480000
ONEKALGN DC A(X'FFFFFC00') USED TO ALIGN ON 1K BNDY@V305096 06481000
SPACE 1 06482000
* CONSTANTS AND EQUATES FOR ACTION CARD PROCESSOR 06483000
SPACE 1 06484000
COLUMN72 DS F COLUMN 72 CARD ADDRESS @V305096 06485000
* 06486000
K6 DC H'6' CONSTANT 6 @V305096 06487000
* 06488000
ACTSW DC H'0' SWITCHES FOR ACTION PROCESSOR @V305096 06489000
* 06490000
INVALID EQU X'8000' SWITCH TO INDICATE INVALID OP @V305096 06491000
MAP EQU X'4000' SWITCH TO INDICATE ACTION MAP @V305096 06492000
NOMAP EQU X'2000' SWITCH TO INDICATE ACTION NOMAP @V305096 06493000
CANCEL EQU X'1000' SWITCH TO INDICATE ACTION CANCEL @V305096 06494000
NOAUTO EQU X'0800' SWITCH TO INDICATE ACTION NOAUTO @V305096 06495000
CLEAR EQU X'0400' SWITCH TO INDICATE ACTION CLEAR @V305096 06496000
NOREL EQU X'0200' SWITCH TO INDICATE ACTION NOREL @V305096 06497000
REL EQU X'0100' SWITCH TO INDICATE ACTION REL @V305096 06498000
BG EQU X'0080' SWITCH TO INDICATE ACTION BG@V305096 06499000
F1 EQU X'0040' SWITCH TO INDICATE ACTION F1@V305096 06500000
F2 EQU X'0020' SWITCH TO INDICATE ACTION F2@V305096 06501000
F3 EQU X'0010' SWITCH TO INDICATE ACTION F3@V305096 06502000
F4 EQU X'0008' SWITCH TO INDICATE ACTION F4@V305096 06503000
F5 EQU X'0004' SWITCH TO INDICATE ACTION F5@V505098 06504000
F6 EQU X'0002' SWITCH TO INDICATE ACTION F6@V505098 06505000
* EQU X'0001' FOR FUTURE EXPANSION 06506000
* 06507000
EJECT 06508000
******************************************************************** 06509000
* TABLE WITH VALID ACTION OPERANDS * 06510000
* EACH ENTRY IS BUILT UP AS FOLLOWS * 06511000
* 1 OPERAND FIELD LENGTH 6 BYTES * 06512000
* 2 OR-FIELD LENGTH 2 BYTES USED TO SET * 06513000
* CORRESPONDING BIT IN ACTSW * 06514000
* 3 AND-FIELD LENGTH 2 BYTES USED TO RESET * 06515000
* CONFLICTING OPTIONS * 06516000
* 4 BRANCH INSTRUCTION LENGTH 4 BYTES * 06517000
* SUBJECT INSTRUCTION FOR AN EXECUTE * 06518000
* USED TO BRANCH TO THE APPROPRIATE SUBROUTINE * 06519000
* * 06520000
******************************************************************** 06521000
DS 0H ALIGNMENT @V305096 06522000
KACTION DS 0CL7 USED TO SEARCH ACTION VERB @V305096 06523000
ACTTAKEN DS 0CL18 TO MOVE 'ACTION TAKEN MAP' @V305096 06524000
DC C'ACTION TAKEN ' TO PRINT AREA @V305096 06525000
* 06526000
ACTLIST EQU * START OF TABLE @V305096 06527000
OPMAP DC CL6'MAP' ENTRY FOR MAP @V305096 06528000
DC AL2(MAP) OR FIELD @V305096 06529000
DC AL2(HEXFFFF-NOMAP) AND FIELD @V305096 06530000
B ACTMAP SUBJECT INSTR FOR EXECUTE @V305096 06531000
OPNOMAP DC CL6'NOMAP' ENTRY FOR NOMAP @V305096 06532000
DC AL2(NOMAP) OR FIELD @V305096 06533000
DC AL2(HEXFFFF-MAP) AND FIELD @V305096 06534000
B ACTNOMAP SUBJECT INSTR FOR EXECUTE @V305096 06535000
DC CL6'CANCEL' ENTRY FOR CANCEL @V305096 06536000
DC AL2(CANCEL) OR FIELD @V305096 06537000
DC AL2(HEXFFFF) AND FIELD @V305096 06538000
B ACTCANCE SUBJECT INSTR FOR EXECUTE @V305096 06539000
DC CL6'NOAUTO' ENTRY FOR NOAUTO @V305096 06540000
DC AL2(NOAUTO) OR FIELD @V305096 06541000
DC AL2(HEXFFFF) AND FIELD @V305096 06542000
B ACTNOAUT SUBJECT INSTR FOR EXECUTE @V305096 06543000
DC CL6'CLEAR' ENTRY FOR CLEAR @V305096 06544000
DC AL2(CLEAR) OR FIELD @V305096 06545000
DC AL2(HEXFFFF) AND FIELD @V305096 06546000
B ACTCLEAR SUBJECT INSTR FOR EXECUTE @V305096 06547000
DC CL6'NOREL' ENTRY FOR NOREL @V305096 06548000
DC AL2(NOREL) OR FIELD @V305096 06549000
DC AL2(HEXFFFF-REL) AND FIELD @V305096 06550000
B ACTNOREL SUBJECT INSTR FOR EXECUTE @V305096 06551000
DC CL6'REL' ENTRY FOR REL @V305096 06552000
DC AL2(REL) OR FIELD @V305096 06553000
DC AL2(HEXFFFF-NOREL) AND FIELD @V305096 06554000
B ACTREL SUBJECT INSTR FOR EXECUTE @V305096 06555000
OPBG DC CL6'BG' ENTRY FOR BG @V305096 06556000
DC AL2(BG) OR FIELD @V305096 06557000
DC AL2(HEXFFFF-F1-F2-F3-F4-F5-F6) AND FIELD @V505098 06558000
B ACTBG SUBJECT INSTR FOR EXECUTE @V305096 06559000
DC CL6'F1' ENTRY FOR F1 @V305096 06560000
DC AL2(F1) OR FIELD @V305096 06561000
DC AL2(HEXFFFF-BG-F2-F3-F4-F5-F6) AND FIELD @V505098 06562000
B ACTBG SUBJECT INSTR FOR EXECUTE @V305096 06563000
DC CL6'F2' ENTRY FOR F2 @V305096 06564000
DC AL2(F2) OR FIELD @V305096 06565000
DC AL2(HEXFFFF-BG-F1-F3-F4-F5-F6) AND FIELD @V505098 06566000
B ACTBG SUBJECT INSTR FOR EXECUTE @V305096 06567000
DC CL6'F3' ENTRY FOR F3 @V305096 06568000
DC AL2(F3) OR FIELD @V305096 06569000
DC AL2(HEXFFFF-BG-F1-F2-F4-F5-F6) AND FIELD @V505098 06570000
B ACTBG SUBJECT INSTR FOR EXECUTE @V305096 06571000
DC CL6'F4' ENTRY FOR F4 @V305096 06572000
DC AL2(F4) OR FIELD @V305096 06573000
DC AL2(HEXFFFF-BG-F1-F2-F3-F5-F6) AND FIELD @V505098 06574000
B ACTBG SUBJECT INSTR FOR EXECUTE @V305096 06575000
DC CL6'F5' ENTRY FOR F5 @V505098 06576000
DC AL2(F5) OR FIELD @V505098 06577000
DC AL2(HEXFFFF-BG-F1-F2-F3-F4-F6) AND FIELD @V505098 06578000
B ACTBG SUBJECT INSTR FOR EXECUT@V505098 06579000
LASTPART EQU * HIGHEST PARTION ENTRY @V505098 06580000
DC CL6'F6' ENTRY FOR F6 @V505098 06581000
DC AL2(F6) OR FIELD @V505098 06582000
DC AL2(HEXFFFF-BG-F1-F2-F3-F4-F5) AND FIELD @V505098 06583000
B ACTBG SUBJECT INSTR FOR EXECUT@V505098 06584000
LASTENTR DC CL6' ' USED TO MOVE OPERAND @V305096 06585000
DC AL2(INVALID) FROM ACTION CARD @V305096 06586000
DC AL2(HEXFFFF) WHEN AN EQUAL COMPARE IS@V305096 06587000
* FOUND ON THIS ENTRY, THE OPERAND WAS INVALID 06588000
ENTLNGTH EQU OPNOMAP-OPMAP LENGTH OF ONE ENTRY @V305096 06589000
SPACE 2 06590000
MOVEOPER MVC LASTENTR(DEC0),DEC0(R5) USED BY EX INSTRUCTION @V305096 06591000
* TO MOVE AN ACTION OP TO THE LAST 06592000
* TABLE ENTRY 06593000
SPACE 2 06594000
* EQUATES USED DURING INITIALISATION 06595000
SPACE 1 06596000
HEXFFFF EQU X'FFFF' @V305096 06597000
DEC256 EQU 256 @V305096 06598000
* 06599000
* 06600000
* 06601000
** TABLE TO PROVIDE ADDRESSABILITY TO ERROR MESSAGES 06602000
* 06603000
DS 0F @VA05886 06604000
AMSG35 DC YL1(L'MSG35-DEC1) LENGTH OF MESSAGE MIN 1 @VA05886 06605000
DC AL3(MSG35) ADDRESS OF ERROR MESSAGE @VA05886 06606000
LTORG , @V305096 06607000
EJECT 06608000
******************************************************************** 06609000
* CONSTANTS AND WORK-FIELDS FOR INITIALIZATION 06610000
******************************************************************** 06611000
CNBASE DC A(DMSDLK) BASE USED FOR CONSTANTS & S/R-S AREA @V305096 06612000
* 06613000
RELOADCN DC A(INTPT2) ADDR OF INSTR AFTER @V305096 06614000
* BALR FOR INITIALIZATION PHASE 06615000
READIR CCW X'06',INPBLK,X'00',80 READ LIBRARY @V305096 06616000
RLDINFO DC XL5'0102' DISK ADDR OF REL LIBRARY INFO IN @V305096 06617000
* SYS DIR, USED AT INITIALIZATION 06618000
EJECT 06619000
******************************************************************** 06620000
* OVERFLOW FACTORS FOR DIFFERENT TYPES OF SYSRES 06621000
* DEVICES 06622000
* NOTE1 IF A NEW 2311-COMPATIBLE DEVICE TYPE WILL BE SUPPORTED 06623000
* AS SYSTEM RESIDENCE DEVICE INSERTING A NEW TABLE ENTRY WILL 06624000
* BE ALL THE WORK TO DO 06625000
* NOTE2 FOR A LAY OUT OF THE OVERFLOW FACTORS, SEE DMSDLK 06626000
* NEAR LABEL CYLFCT 06627000
******************************************************************** 06628000
DEVSTART EQU * START OF TABLE @V305096 06629000
* 06630000
* 2314 06631000
* 06632000
TAB2314 DC AL1(DEV2314) . @V305096 06633000
REL2314 DC X'110013EC' RELOCATABLE LIB. DIRECTORY @V305096 06634000
RLL2314 DC X'100013EC' RELOCATABLE LIBRARY @V305096 06635000
LDEVTAB EQU *-TAB2314 @V305096 06636000
* 06637000
* 3330 06638000
* 06639000
TAB3330 DC AL1(DEV3330) . @V305096 06640000
REL3330 DC X'1C0012ED' REL. LIBRARY DIRECTORY @V305096 06641000
RLL3330 DC X'1C0012ED' RELOCATABLE LIBRARY @V305096 06642000
* 06643000
* 3330-11 06644000
* 06645000
TAB333B DC AL1(DEV333B) @V505098 06646000
REL333B DC X'1C0012ED' REL. LIBRARY DIRECTORY @V505098 06647000
RLL333B DC X'1C0012ED' RELOCATABLE LIBRARY @V505098 06648000
* 06649000
* 3340,36MB 06650000
* 06651000
TAB3343 DC AL1(DEV3343) . @V305096 06652000
REL3343 DC X'11000BF4' REL. LIBRARY DIRECTORY @V305096 06653000
RLL3343 DC X'11000BF4' RELOCATABLE LIBRARY @V305096 06654000
* 06655000
* 3340,70MB 06656000
* 06657000
TAB3347 DC AL1(DEV3347) @V305096 06658000
REL3347 DC X'11000BF4' REL. LIBRARY DIRECTORY @V305096 06659000
RLL3347 DC X'11000BF4' RELOCATABLE LIBRARY @V305096 06660000
* 06661000
* 3350 06662000
* 06663000
TAB3350 DC AL1(DEV3350) @V505098 06664000
REL3350 DC X'26001DE2' RELOCTE LIB DIRCTRY @VA08407 06665000
RLL3350 DC X'25001DE2' RELOCTEABLE LIB @VA08407 06666000
DEVEND EQU * END OF TABLE @V305096 06667000
EJECT 06668000
NVALID XC 0(1,R2),0(R2) SUBJ OF EXECUTE INSTRUCTION @V305096 06669000
RESTYP DS C DEV TYPE FOR SYSRES @V305096 06670000
SYSIR DSECT @V305096 06671000
BGCOM @V305065 06672000
MAPPUB @V305096 06673000
PUBWIT EQU *-PUBCUU @V305065 06674000
NUCON @V305065 06675000
DOSCB @V305065 06676000
FSCBD @V305065 06677000
OSFST @V305065 06678000
FSTB @V305065 06679000
ADT @V305065 06680000
DLKINL CSECT @V305096 06681000
PATCH2 DS 0H @V305096 06682000
DC ((PATCH2-INTPT2)/20)X'00' 5% PATCHAREA FOR @V305096 06683000
* INITIALIZATION 06684000
DLKINLND EQU * @V305096 06685000
ENTRY DLKINLND @V305096 06686000
END DLKINL 06687000