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