./ ADD SSI=40221450,NAME=HMASMAPA,SOURCE=1 COMPON=DN611 TITLE 'HMASMAPA - SMP APPLY / ACCEPT ROUTINE *00001000 ' 00002000 HMASMAPA CSECT , 0001 00003000 @MAINENT DS 0H 0001 00004000 USING *,@15 0001 00005000 B @PROLOG 0001 00006000 DC AL1(16) 0001 00007000 DC C'HMASMAPA 74.022' 0001 00008000 DROP @15 00009000 @PROLOG STM @14,@12,12(@13) 0001 00010000 BALR @12,0 0001 00011000 @PSTART LA @10,4095(,@12) 0001 00012000 USING @PSTART,@12 0001 00013000 USING @PSTART+4095,@10 0001 00014000 ST @13,@SA00001+4 0001 00015000 LA @14,@SA00001 0001 00016000 ST @14,8(,@13) 0001 00017000 LR @13,@14 0001 00018000 * */ 00019000 * 0146 00020000 * /*****************************************************************/ 00021000 * /* */ 00022000 * /* PROGRAM INITIALIZATION */ 00023000 * /* */ 00024000 * /*****************************************************************/ 00025000 * 0146 00026000 * IOPPTR=CCAIOPTR; /* INITIALIZE THE IOP POINTER */ 00027000 MVC IOPPTR(4),CCAIOPTR(CCAPTR) 0146 00028000 * SWITCH1=CLEAR; /* SET PROGRAM SWITCH TO ZERO */ 00029000 MVI SWITCH1,X'00' 0147 00030000 * MACPTF=ON; /* SET PTF/NOLIB IND ON */ 00031000 OI MACPTF,B'00001000' 0148 00032000 * MGPMGNO2=CLEAR; /* SET SECONDARY AND TERTIARY */ 00033000 MVI MGPMGNO2,X'00' 0149 00034000 * MGPMGNO3=CLEAR; /* MSG NUMBERS TO ZERO */ 00035000 MVI MGPMGNO3,X'00' 0150 00036000 * MGPFLAGS=CLEAR; /* CLEAR MESSAGE FLAG BYTE */ 00037000 MVI MGPFLAGS,X'00' 0151 00038000 * MGPPRINT=ON; /* SET IND TO PUT MSG ON SYSOUT */ 00039000 OI MGPPRINT,B'10000000' 0152 00040000 * FUNCTION=ACC; /* ASSUME 'ACCEPT' FUNCTION */ 00041000 MVC FUNCTION(7),ACC 0153 00042000 * IF CCAAPPLY=ON /* IF THIS IS THE APPLY FUNCTION */ 00043000 * THEN 0154 00044000 TM CCAAPPLY(CCAPTR),B'01000000' 0154 00045000 BNO @RF00154 0154 00046000 * DO; 0155 00047000 * FUNCTION=APP; /* SETUP APPLY FUNCTION FOR MSG */ 00048000 MVC FUNCTION(7),APP 0156 00049000 * IF CCANCPTF=ON /* IF THE NUCLEUS IS AFFECTED */ 00050000 * THEN 0157 00051000 TM CCANCPTF(CCAPTR),B'01000000' 0157 00052000 BNO @RF00157 0157 00053000 * IF CCANUCIDª=ONE /* AND IS IS TO BE SAVED */ 00054000 * THEN 0158 00055000 CLI CCANUCID(CCAPTR),C'1' 0158 00056000 BE @RF00158 0158 00057000 * DO; 0159 00058000 * 0159 00059000 * /*******************************************************/ 00060000 * /* */ 00061000 * /* OPEN SYS1.NUCLEUS IF THE NUCLEUS IS TO BE SAVED. */ 00062000 * /* */ 00063000 * /*******************************************************/ 00064000 * 0160 00065000 * GENERATE; 0160 00066000 OPEN (NUCDCB,OUTPUT) OPEN SYS1.NUCLEUS 00067000 * IF DCBOFOPN=OFF /* IF OPEN FAILED */ 00068000 * THEN 0161 00069000 LA @14,40 0161 00070000 AL @14,DCBPTR 0161 00071000 TM DCBOFOPN(@14),B'00010000' 0161 00072000 BNZ @RF00161 0161 00073000 * DO; 0162 00074000 * CCATERM=ON; /* SET THE TERMINATE BIT ON */ 00075000 OI CCATERM(CCAPTR),B'00000100' 0163 00076000 * NAME=DCBDDNAM; /* GET NAME OF DCB FOR MSG */ 00077000 MVC NAME(8),DCBDDNAM(@14) 0164 00078000 * MGPMGNO1=P02; /* PRIMARY MESSAGE NUMBER */ 00079000 MVI MGPMGNO1,X'02' 0165 00080000 * MGPVARPT(1)=ADDR(NAME);/* ADDR OF DD NAME */ 00081000 LA @14,NAME 0166 00082000 ST @14,MGPVARPT 0166 00083000 * CALL MSGROUT; /* ISSUE ERROR MESSAGE NO. 201 */ 00084000 BAL @14,MSGROUT 0167 00085000 * GO TO EXIT2; /* RETURN TO THE DRIVER */ 00086000 B EXIT2 0168 00087000 * END; 0169 00088000 * 0169 00089000 * /*******************************************************/ 00090000 * /* */ 00091000 * /* PERFORM A BLDL ON IEANUC01 TO EXTRACT THE TTR OF */ 00092000 * /* SAME FOR A STOW REPLACE OPERATION. */ 00093000 * /* */ 00094000 * /*******************************************************/ 00095000 * 0170 00096000 * GENERATE; 0170 00097000 @RF00161 DS 0H 0170 00098000 BLDL NUCDCB,NUCBLDL DO A BLDL ON IEANUC01 00099000 * LIB=NUCLIB; /* INIT LIBRARY TYPE IF ERROR */ 00100000 MVC LIB(8),NUCLIB 0171 00101000 * IF RTNCODEª=ZERO /* IF THE BLDL FAILED */ 00102000 * THEN 0172 00103000 CH RTNCODE,ZERO 0172 00104000 BE @RF00172 0172 00105000 * DO; 0173 00106000 * CCATERM=ON; /* SET THE TERMINATE BIT ON */ 00107000 OI CCATERM(CCAPTR),B'00000100' 0174 00108000 * MGPMGNO1=P29; /* (IEANUC01 NOT FOUND ON NUCLEUS*/ 00109000 MVI MGPMGNO1,X'1D' 0175 00110000 * MGPMGNO2=S16; /* LIBRARY) MESSAGE */ 00111000 MVI MGPMGNO2,X'10' 0176 00112000 * MGPVARPT(1)=ADDR(LIB);/* GET ADDR OF LIBRARY TYPE */ 00113000 LA @14,LIB 0177 00114000 ST @14,MGPVARPT 0177 00115000 * CALL MSGROUT; /* ISSUE ERROR MESSAGE NO. 228 */ 00116000 BAL @14,MSGROUT 0178 00117000 * GO TO EXIT2; /* RETURN TO THE DRIVER */ 00118000 B EXIT2 0179 00119000 * END; 0180 00120000 * 0180 00121000 * /*******************************************************/ 00122000 * /* */ 00123000 * /* SETUP TO PERFORM A STOW REPLACE OPERATION WHICH WILL*/ 00124000 * /* BUILD A NEW DIRECTORY ENTRY POINTING TO IEANUC01 */ 00125000 * /* USING THE NEW NUCLEUS NAME. */ 00126000 * /* */ 00127000 * /*******************************************************/ 00128000 * 0181 00129000 * DIGIT1=CCANUCID; /* GET NUCLEUS NAME FOR STOW OPER*/ 00130000 @RF00172 MVC DIGIT1(1),CCANUCID(CCAPTR) 0181 00131000 * DCBRELAD(1:3)=NUCTTR; /* INIT DCB TTR ADDR FIELD */ 00132000 L @14,DCBPTR 0182 00133000 MVC DCBRELAD(3,@14),NUCTTR 0182 00134000 * STOWLEN=UDLEN; /* INIT THE STOW LIST WITH THE */ 00135000 MVC STOWLEN(1),UDLEN 0183 00136000 * UDATA=USERDATA; /* DATA FROM THE BLDL LIST */ 00137000 MVC UDATA(62),USERDATA 0184 00138000 * GENERATE; 0185 00139000 STOW NUCDCB,STOWLIST,R CREATE A NEW DIRECTORY ENTRY 00140000 * CCANCPTF=OFF; /* NUCLEUS INDICATOR OFF */ 00141000 NI CCANCPTF(CCAPTR),B'10111111' 0186 00142000 * MGPVARPT(1)=ADDR(NUCNAME);/* GET ADDRESSES OF THE */ 00143000 LA @14,NUCNAME 0187 00144000 ST @14,MGPVARPT 0187 00145000 * MGPVARPT(2)=ADDR(LIB);/* NUCLEUS AND LIBRARY NAMES */ 00146000 LA @14,LIB 0188 00147000 ST @14,MGPVARPT+4 0188 00148000 * IF RTNCODE>EIGHT /* IF AN I/O ERROR OCCURRED */ 00149000 * THEN 0189 00150000 CH RTNCODE,EIGHT 0189 00151000 BNH @RF00189 0189 00152000 * DO; 0190 00153000 * MGPHLDS=ON; /* ISSUE MESSAGE TO HLDS ALSO */ 00154000 OI MGPHLDS,B'01000000' 0191 00155000 * CCATERM=ON; /* SET TERMINATE BIT ON */ 00156000 OI CCATERM(CCAPTR),B'00000100' 0192 00157000 * MGPMGNO1=P69; /* (I/O ERROR ATTEMPTING TO STORE*/ 00158000 MVI MGPMGNO1,X'45' 0193 00159000 * MGPMGNO2=S50; /* MEMBER IEANUC0- ON NUCLEUS */ 00160000 MVI MGPMGNO2,X'32' 0194 00161000 * MGPMGNO3=T02; /* LIBRARY) MESSAGE */ 00162000 MVI MGPMGNO3,X'02' 0195 00163000 * CALL MSGROUT; /* ISSUE ERROR MESSAGE NO. 268 */ 00164000 BAL @14,MSGROUT 0196 00165000 * GO TO EXIT2; /* RETURN TO THE DRIVER */ 00166000 B EXIT2 0197 00167000 * END; 0198 00168000 * MGPMGNO1=P19; /* (SUCCESSFULLY STORED MEMBER */ 00169000 @RF00189 MVI MGPMGNO1,X'13' 0199 00170000 * MGPMGNO2=S50; /* IEANUC0- ON NUCLEUS LIBRARY) */ 00171000 MVI MGPMGNO2,X'32' 0200 00172000 * MGPMGNO3=T02; /* MESSAGE */ 00173000 MVI MGPMGNO3,X'02' 0201 00174000 * CALL MSGROUT; /* ISSUE OK MESSAGE NO. 218 */ 00175000 BAL @14,MSGROUT 0202 00176000 * GENERATE; 0203 00177000 CLOSE NUCDCB CLOSE SYS1.NUCLEUS 00178000 * END; 0204 00179000 * END; 0205 00180000 @RF00158 DS 0H 0205 00181000 @RF00157 DS 0H 0206 00182000 * 0206 00183000 * /*****************************************************************/ 00184000 * /* */ 00185000 * /* CALL THE PTFSCAN ROUTINE TO PROCESS A PTF(S) THAT MAY HAVE A */ 00186000 * /* MACRO, NOLIB, OR PTF FOUND ON THE ACDS SITUATION IN WHICH CASE*/ 00187000 * /* THE PTF IN PROCESS AND COMPLETE BITS HAVE BEEN SET IN THE */ 00188000 * /* BUILD TABLE ROUTINE. */ 00189000 * /* */ 00190000 * /*****************************************************************/ 00191000 * 0206 00192000 * CALL PTFSCAN; /* PROCESS ANY COMPLETED PTFS 0206 00193000 * */ 00194000 @RF00154 BAL @14,PTFSCAN 0206 00195000 * 0207 00196000 * /*****************************************************************/ 00197000 * /* */ 00198000 * /* EXIT IS MADE TO HMASMZAP TO APPLY OR ACCEPT ZAPS BY TESTING */ 00199000 * /* THE ZAP BIT IN THE CCA. ALL ZAPS WILL BE DONE BY HMASMZAP WITH*/ 00200000 * /* ONE CALL. ON RETURN FROM HMASMZAP, THE PTF SCAN ROUTINE WILL */ 00201000 * /* BE INVOKED TO CHECK FOR ANY PTFS THAT ARE IN ERROR OR IF A PTF*/ 00202000 * /* WAS COMPLETED SO THAT THE CDS CAN BE UPDATED AS SOON AS */ 00203000 * /* POSSIBLE. */ 00204000 * /* */ 00205000 * /*****************************************************************/ 00206000 * 0207 00207000 * IF CCAZAPP=ON /* IF THERE ARE ZAPS TO DO */ 00208000 * THEN 0207 00209000 TM CCAZAPP(CCAPTR),B'10000000' 0207 00210000 BNO @RF00207 0207 00211000 * DO; 0208 00212000 * CALL HMASMZAP; /* CALL THE ZAP INTERFACE SUBROUT*/ 00213000 L @15,@CV00640 0209 00214000 BALR @14,@15 0209 00215000 * CALL PTFSCAN; /* PROCESS ANY COMPLETED PTFS */ 00216000 BAL @14,PTFSCAN 0210 00217000 * CCAZAPP=OFF; /* RESET ZAP BIT WHEN ZAPS DONE */ 00218000 NI CCAZAPP(CCAPTR),B'01111111' 0211 00219000 * END; 0212 00220000 * 0212 00221000 * /*****************************************************************/ 00222000 * /* */ 00223000 * /* EXIT IS MADE TO HMASMCPI IF THERE ARE ANY COPIES TO PERFORM, */ 00224000 * /* OTHERWISE THE COPY EXIT IS BYPASSED. ALL COPIES TO DO WILL BE */ 00225000 * /* DONE WITH ONE INVOKATION OF THE COPY INTERFACE SUBROUTINE. ANY*/ 00226000 * /* ERRORS ARE CHECKED FOR IN THE PTF TABLE. */ 00227000 * /* */ 00228000 * /*****************************************************************/ 00229000 * 0213 00230000 * IF CCACOPYP=ON /* IF THERE ARE ANY COPIES TO DO */ 00231000 * THEN 0213 00232000 @RF00207 TM CCACOPYP(CCAPTR),B'00100000' 0213 00233000 BNO @RF00213 0213 00234000 * DO; 0214 00235000 * CALL HMASMCPI; /* CALL THE COPY INTERFACE ROUT. */ 00236000 L @15,@CV00642 0215 00237000 BALR @14,@15 0215 00238000 * CALL PTFSCAN; /* PROCESS ANY COMPLETED PTFS */ 00239000 BAL @14,PTFSCAN 0216 00240000 * CCACOPYP=OFF; /* RESET COPY BIT WHEN DONE */ 00241000 NI CCACOPYP(CCAPTR),B'11011111' 0217 00242000 * END; 0218 00243000 *LINKCALL: 0219 00244000 * 0219 00245000 * /*****************************************************************/ 00246000 * /* */ 00247000 * /* EXIT IS MADE TO HMASMLKI IF THERE ARE ANY LINKEDITS TO PERFORM*/ 00248000 * /* , OTHERWISE RETURN IS MADE TO THE DRIVER (HMASMDRV). A RETURN */ 00249000 * /* CODE OF 4 INDICATES THAT ALL LINKEDIT OPERATIONS ARE COMPLETED*/ 00250000 * /* , OTHERWISE ANOTHER RETURN TO HMASMLKI MUST BE MADE. */ 00251000 * /* PROCESSING CONTINUES REGARDLESS IF ANY ERRORS OCCURR SO AS TO */ 00252000 * /* COMPLETE AS MANY OF THE PTFS AS POSSIBLE. */ 00253000 * /* */ 00254000 * /*****************************************************************/ 00255000 * 0219 00256000 * IF CCALINKP=ON /* ARE THERE ANY LINKEDITS TO DO */ 00257000 * THEN 0219 00258000 @RF00213 DS 0H 0219 00259000 LINKCALL TM CCALINKP(CCAPTR),B'01000000' 0219 00260000 BNO @RF00219 0219 00261000 * DO; 0220 00262000 * LNKTIME=ON; /* SET LINKEDIT TIME IND. ON */ 00263000 OI LNKTIME,B'01000000' 0221 00264000 * CALL HMASMLKI; /* CALL THE LINKEDIT SUBROUT. */ 00265000 L @15,@CV00641 0222 00266000 BALR @14,@15 0222 00267000 * CALL PTFSCAN; /* PROCESS ANY COMPLETED PTFS */ 00268000 BAL @14,PTFSCAN 0223 00269000 * IF RTNCODEª=FOUR /* IF LINKEDITS ARE NOT DONE */ 00270000 * THEN 0224 00271000 CH RTNCODE,FOUR 0224 00272000 BNE @RT00224 0224 00273000 * GO TO LINKCALL; /* RETURN TO HMASMLKI */ 00274000 * END; 0226 00275000 * CCALINKP=OFF; /* RESET LINK BIT WHEN LINKS DONE 00276000 * */ 00277000 @RF00219 NI CCALINKP(CCAPTR),B'10111111' 0227 00278000 * 0228 00279000 * /*****************************************************************/ 00280000 * /* */ 00281000 * /* EXIT ROUTINE. THIS ROUTINE RELEASES MAIN STORAGE IF A GETMAIN */ 00282000 * /* WAS ISSUED, INVOKES IEHIOSUP IF THE SVCLIB WAS AFFECTED AND */ 00283000 * /* RETURNS TO THE DRIVER WITH THE APPROPRIATE RETURN CODE. */ 00284000 * /* */ 00285000 * /*****************************************************************/ 00286000 * 0228 00287000 *EXIT1: 0228 00288000 * IF GMAIN=ON /* IF GETMAIN WAS ISSUED */ 00289000 * THEN 0228 00290000 EXIT1 TM GMAIN,B'00100000' 0228 00291000 BNO @RF00228 0228 00292000 * DO; 0229 00293000 * RFY 0230 00294000 * LINKREG RSTD; 0230 00295000 * LINKREG=CCAPESIZ+L20; /* SIZE OF CORE TO FREEMAIN */ 00296000 LA LINKREG,20 0231 00297000 AL LINKREG,CCAPESIZ(,CCAPTR) 0231 00298000 * GENERATE; 0232 00299000 FREEMAIN E,LV=(LINKREG),A=PECORE FREE SECOND IOP 00300000 * GMAIN=OFF; /* RESET 'GETMAIN' INDICATOR */ 00301000 NI GMAIN,B'11011111' 0233 00302000 * RFY 0234 00303000 * LINKREG UNRSTD; 0234 00304000 * END; 0235 00305000 * 0235 00306000 * /*****************************************************************/ 00307000 * /* */ 00308000 * /* IF SVCLIB HAS BEEN AFFECTED, IEHIOSUP IS INITIATED. */ 00309000 * /* */ 00310000 * /*****************************************************************/ 00311000 * 0236 00312000 * IF CCASVCLB=ON /* INITIATE IOSUP IF SVCLIB HAS */ 00313000 * THEN /* BEEN AFFECTED */ 00314000 @RF00228 TM CCASVCLB(CCAPTR),B'00001000' 0236 00315000 BNO @RF00236 0236 00316000 * DO; 0237 00317000 * RFY 0238 00318000 * LINKREG RSTD; 0238 00319000 * LINKREG=CCAIOSUP; /* ADDR OF IOSUP BLDL */ 00320000 L LINKREG,CCAIOSUP(,CCAPTR) 0239 00321000 * IF CCASPDCB=ZERO /* IF NO DCB FOR IOSUP LINK */ 00322000 * THEN /* GO AHEAD AND LINK */ 00323000 L @14,CCASPDCB(,CCAPTR) 0240 00324000 CH @14,ZERO 0240 00325000 BNE @RF00240 0240 00326000 * IF CCATSO=ON /* IF THE TSO BIT IS ON */ 00327000 * THEN 0241 00328000 TM CCATSO(CCAPTR),B'00010000' 0241 00329000 BNO @RF00241 0241 00330000 * GENERATE; 0242 00331000 LINK DE=(LINKREG),PARAM=(SUPPARM,PARMLIST),VL=1 EXEC IOSUP 00332000 * ELSE 0243 00333000 * GENERATE; 0243 00334000 B @RC00241 0243 00335000 @RF00241 DS 0H 0243 00336000 LINK DE=(LINKREG),PARAM=(0,PARMLIST),VL=1 EXECUTE IOSUP 00337000 * ELSE /* OTHERWISE - MUST PASS DCB TO 00338000 * LINK */ 00339000 * DO; 0244 00340000 B @RC00240 0244 00341000 @RF00240 DS 0H 0245 00342000 * RFY 0245 00343000 * SPDCBRG RSTD; 0245 00344000 * SPDCBRG=CCASPDCB; /* GET DCB ADDR FROM CCA */ 00345000 L SPDCBRG,CCASPDCB(,CCAPTR) 0246 00346000 * IF CCATSO=ON /* IF THE TSO BIT IS ON */ 00347000 * THEN 0247 00348000 TM CCATSO(CCAPTR),B'00010000' 0247 00349000 BNO @RF00247 0247 00350000 * GENERATE; 0248 00351000 LINK DE=(LINKREG),PARAM=(SUPPARM,PARMLIST),DCB=(SPDCBRG),VL=1 00352000 * ELSE 0249 00353000 * GENERATE; 0249 00354000 B @RC00247 0249 00355000 @RF00247 DS 0H 0249 00356000 LINK DE=(LINKREG),PARAM=(0,PARMLIST),DCB=(SPDCBRG),VL=1 00357000 * RFY 0250 00358000 * SPDCBRG UNRSTD; 0250 00359000 @RC00247 DS 0H 0251 00360000 * END; 0251 00361000 * RFY 0252 00362000 * LINKREG UNRSTD; 0252 00363000 @RC00240 DS 0H 0253 00364000 * CVD(RTNCODE,DBLWRD); /* CONVERT RETURN CODE TO DECIMAL*/ 00365000 CVD RTNCODE,DBLWRD 0253 00366000 * UNPK(SUPCODE,DBLWRD); /* UNPACK THE RETURN CODE */ 00367000 UNPK SUPCODE(2),DBLWRD(8) 0254 00368000 * SUPDIG=SUPDIG³MAKPRINT; /* MAKE IT PRINTABLE */ 00369000 OI SUPDIG,X'F0' 0255 00370000 * MGPVARPT(1)=ADDR(SUPCODE); /* SET VARIABLE SECTION */ 00371000 LA @14,SUPCODE 0256 00372000 ST @14,MGPVARPT 0256 00373000 * MGPMGNO1=P31; /* SET PRIMARY MESSAGE NUMBER */ 00374000 MVI MGPMGNO1,X'1F' 0257 00375000 * MGPMGNO2=S09; /* SET SECONDARY - RETURN CODE */ 00376000 MVI MGPMGNO2,X'09' 0258 00377000 * CALL MSGROUT; /* WRITE MESSAGE TO PRINTER */ 00378000 BAL @14,MSGROUT 0259 00379000 * IF RTNCODEª=ZERO /* WAS RETURN CODE BAD? */ 00380000 * THEN /* YES - SET BAD RETURN INDICATOR*/ 00381000 CH RTNCODE,ZERO 0260 00382000 BE @RF00260 0260 00383000 * CCATERM=ON; /* INDICATE STOP SMP */ 00384000 OI CCATERM(CCAPTR),B'00000100' 0261 00385000 * CCASVCLB=OFF; /* RESET IOSUP INDICATOR */ 00386000 @RF00260 NI CCASVCLB(CCAPTR),B'11110111' 0262 00387000 * END; 0263 00388000 *EXIT2: 0264 00389000 * IF CCATERM=ON /* IF ERROR OCCURRED */ 00390000 * THEN 0264 00391000 @RF00236 DS 0H 0264 00392000 EXIT2 TM CCATERM(CCAPTR),B'00000100' 0264 00393000 BNO @RF00264 0264 00394000 * RETURN CODE(EIGHT); /* RETURN WITH ERROR CODE */ 00395000 LH @15,EIGHT 0265 00396000 L @13,4(,@13) 0265 00397000 L @14,12(,@13) 0265 00398000 LM @00,@12,20(@13) 0265 00399000 BR @14 0265 00400000 * ELSE 0266 00401000 * RETURN CODE(ZERO); /* RETURN WITH OK CODE 0266 00402000 * */ 00403000 @RF00264 LH @15,ZERO 0266 00404000 L @13,4(,@13) 0266 00405000 L @14,12(,@13) 0266 00406000 LM @00,@12,20(@13) 0266 00407000 BR @14 0266 00408000 *PTFSCAN: 0267 00409000 * 0267 00410000 * /*****************************************************************/ 00411000 * /* */ 00412000 * /* THIS ROUTINE SCANS THE PTF SECTION OF THE ICT LOOKING FOR ANY */ 00413000 * /* PTFS WITH THE 'IN PROCESS' AND 'PTF COMPLETE' BITS ON. IF BOTH*/ 00414000 * /* BITS ARE ON, THE CDS WILL NOW BE UPDATED BY DOING A LOCATE ON */ 00415000 * /* THE PTF ENTRY IN THE CDS. THE APPROPRIATE BIT IS SET AND IF */ 00416000 * /* THIS IS AN APPLY FUNCTION THE PTF ENTRY IS THEN WRITTEN BACK */ 00417000 * /* VIA A STOW REPLACE, OTHERWISE THE ENTRIES IN THE PTF ARE */ 00418000 * /* SCANNED LOOKING FOR ANY MACROS. IF ANY MACROS ARE PRESENT, THE*/ 00419000 * /* MACRO IS THEN LOCATED IN THE CDS TO EXTRACT THE MODULES IT */ 00420000 * /* AFFECTS. THE MODULES ARE THEN DELETED FROM THE PTS. THE OLD */ 00421000 * /* COPY OF THE MACRO IS THEN DELETED ALSO. */ 00422000 * /* */ 00423000 * /*****************************************************************/ 00424000 * 0267 00425000 * PROCEDURE OPTIONS(SAVEAREA); 0267 00426000 @EL00001 L @13,4(,@13) 0267 00427000 @EF00001 DS 0H 0267 00428000 @ER00001 LM @14,@12,12(@13) 0267 00429000 BR @14 0267 00430000 @PB00001 DS 0H 0267 00431000 PTFSCAN STM @14,@12,12(@13) 0267 00432000 ST @13,@SA00002+4 0267 00433000 LA @14,@SA00002 0267 00434000 ST @14,8(,@13) 0267 00435000 LR @13,@14 0267 00436000 * RFY 0268 00437000 * (ICTPTF) BASED(CCAICPTF); 0268 00438000 * RFY 0269 00439000 * (ICTIXPF) BASED(ICTPCHN(I)); 0269 00440000 * DO I=1 TO MAX /* SCAN THE PTFS IN THE ICT. */ 00441000 * WHILE ICTPEND(I)ª=TBLEND; 0270 00442000 LA @14,1 0270 00443000 B @DE00270 0270 00444000 @DL00270 MH @14,@CH00032 0270 00445000 L @09,CCAICPTF(,CCAPTR) 0270 00446000 ST @14,@TF00001 0270 00447000 ALR @14,@09 0270 00448000 AL @14,@CF00834 0270 00449000 CLC ICTPEND(2,@14),TBLEND 0270 00450000 BE @DC00270 0270 00451000 * IF ICTPROCS(I)=ON /* IF PTF HAS 'IN PROCESS' */ 00452000 * &ICTPCPL(I)=ON /* AND 'COMPLETE' BITS ON */ 00453000 * THEN 0271 00454000 LR @14,@09 0271 00455000 AL @14,@TF00001 0271 00456000 AL @14,@CF00835 0271 00457000 TM ICTPROCS-8(@14),B'00010001' 0271 00458000 BNO @RF00271 0271 00459000 * DO; 0272 00460000 * IF ICTPNOGO(I)=ON /* IF THIS IS A NO GO PTF */ 00461000 * THEN 0273 00462000 AL @09,@TF00001 0273 00463000 AL @09,@CF00835 0273 00464000 TM ICTPNOGO-8(@09),B'00000100' 0273 00465000 BNO @RF00273 0273 00466000 * DO; 0274 00467000 * MSG229=ON; /* INDICATE TERMINATE MESSAGE */ 00468000 OI MSG229,B'00010000' 0275 00469000 * IF LNKTIME=ON /* IF THIS IS LINKEDIT TIME */ 00470000 * THEN 0276 00471000 TM LNKTIME,B'01000000' 0276 00472000 BNO @RF00276 0276 00473000 * DO; 0277 00474000 * LNKERR=ON; /* THEN SET LINK ERROR BIT ON */ 00475000 OI LNKERR,B'10000000' 0278 00476000 * CCATERM=ON; /* SET THE TERMINATE BIT ON */ 00477000 OI CCATERM(CCAPTR),B'00000100' 0279 00478000 * END; 0280 00479000 * END; 0281 00480000 @RF00276 DS 0H 0282 00481000 * 0282 00482000 * /***********************************************************/ 00483000 * /* */ 00484000 * /* SETUP THE IOP TO LOCATE AND RETRIEVE THE PTF ENTRY IN */ 00485000 * /* THE CDS. */ 00486000 * /* */ 00487000 * /***********************************************************/ 00488000 * 0282 00489000 * IOPDSID=IOPCDSM; /* INDICATE CDS MAIN */ 00490000 @RF00273 L @14,IOPPTR 0282 00491000 MVI IOPDSID(@14),X'02' 0282 00492000 * IOPFUNCT=IOPLOC; /* INDICATE LOCATE OPERATION */ 00493000 MVI IOPFUNCT(@14),X'03' 0283 00494000 * IOPNAME2=ICTPTFS(I); /* PTF ENTRY TO BE LOCATED */ 00495000 L @09,I 0284 00496000 MH @09,@CH00032 0284 00497000 L @08,CCAICPTF(,CCAPTR) 0284 00498000 ST @09,@TF00001 0284 00499000 ALR @09,@08 0284 00500000 AL @09,@CF00834 0284 00501000 MVC IOPNAME2(7,@14),ICTPTFS(@09) 0284 00502000 * NUMBER=ICTPTFS(I); /* GET PTF NUMBER FOR MSG */ 00503000 MVI NUMBER+7,C' ' 0285 00504000 AL @08,@TF00001 0285 00505000 AL @08,@CF00834 0285 00506000 MVC NUMBER(7),ICTPTFS(@08) 0285 00507000 * IOPTYPE=IOPCPTF; /* INDICATE ENTRY TYPE AS PTF */ 00508000 MVI IOPTYPE(@14),C'9' 0286 00509000 * CALL HMASMIO(HMASMIOP); /* LOCATE PTF ENTRY IN THE CDS */ 00510000 ST @14,@AL00001 0287 00511000 L @15,@CV00638 0287 00512000 LA @01,@AL00001 0287 00513000 BALR @14,@15 0287 00514000 * IF IOPRETRNª=ZERO /* IF ANY ERRORS */ 00515000 * THEN 0288 00516000 L @14,IOPPTR 0288 00517000 SLR @09,@09 0288 00518000 IC @09,IOPRETRN(,@14) 0288 00519000 CH @09,ZERO 0288 00520000 BE @RF00288 0288 00521000 * DO; 0289 00522000 * CCATERM=ON; /* SET THE TERMINATE BIT ON */ 00523000 OI CCATERM(CCAPTR),B'00000100' 0290 00524000 * MSG229=ON; /* SET TERMINATE MSG IND ON */ 00525000 OI MSG229,B'00010000' 0291 00526000 * RECTYPE=PTF; /* 'PTF--- NOT FOUND ON CDSLIB' */ 00527000 MVC RECTYPE(6),PTF 0292 00528000 * NAME=NUMBER; /* MESSAGE */ 00529000 MVC NAME(8),NUMBER 0293 00530000 * LIB=CDSLIB; /* *** */ 00531000 MVC LIB(8),CDSLIB 0294 00532000 * MGPMGNO1=P36; /* PRIMARY MESSAGE NUMBER */ 00533000 MVI MGPMGNO1,X'24' 0295 00534000 * MGPVARPT(1)=ADDR(NAME);/* ADDR OF 1ST MSG INSERT 0296 00535000 * @VS05284*/ 00536000 LA @14,NAME 0296 00537000 ST @14,MGPVARPT 0296 00538000 * CALL MSGROUT; /* ISSUE ERROR MESSAGE */ 00539000 BAL @14,MSGROUT 0297 00540000 * GO TO RESET; /* BYPASS THIS PTF */ 00541000 B RESET 0298 00542000 * END; 0299 00543000 * IF CCAAPPLY=ON /* IF THIS IS THE APPLY FUNCTION */ 00544000 * THEN 0300 00545000 @RF00288 TM CCAAPPLY(CCAPTR),B'01000000' 0300 00546000 BNO @RF00300 0300 00547000 * DO; 0301 00548000 * IOPAPP=ON; /* SET THE APPLY INDICATOR ON */ 00549000 L @14,IOPPTR 0302 00550000 OI IOPAPP(@14),B'10000000' 0302 00551000 * GO TO UPDATE; /* GO UPDATE THE CDS ENTRY */ 00552000 B UPDATE 0303 00553000 * END; 0304 00554000 * IOPACC=ON; /* SET THE ACCEPT INDICATOR ON */ 00555000 @RF00300 L @14,IOPPTR 0305 00556000 OI IOPACC(@14),B'01000000' 0305 00557000 * IF LNKERR=ON /* IF A LINKEDIT ERROR OCCURRED */ 00558000 * THEN 0306 00559000 TM LNKERR,B'10000000' 0306 00560000 BO @RT00306 0306 00561000 * GO TO UPDATE; /* UPDATE CDS AND SKIP REST OF */ 00562000 * ELSE /* PTF 0308 00563000 * */ 00564000 * IF GMAIN=OFF /* IF GETMAIN WASNT ISSUED */ 00565000 * THEN 0308 00566000 TM GMAIN,B'00100000' 0308 00567000 BNZ @RF00308 0308 00568000 * DO; 0309 00569000 * RFY 0310 00570000 * LINKREG RSTD; 0310 00571000 * LINKREG=CCAPESIZ+L20;/* AMOUNT OF CORE TO GET */ 00572000 LA LINKREG,20 0311 00573000 AL LINKREG,CCAPESIZ(,CCAPTR) 0311 00574000 * GENERATE; 0312 00575000 GETMAIN EC,LV=(LINKREG),A=PECORE GET STORAGE FOR 2ND IOP. 00576000 * RFY 0313 00577000 * LINKREG UNRSTD; 0313 00578000 * IF RTNCODEª=ZERO /* IF GETMAIN FAILED */ 00579000 * THEN 0314 00580000 CH RTNCODE,ZERO 0314 00581000 BE @RF00314 0314 00582000 * DO; 0315 00583000 * CCATERM=ON; /* SET THE TERMINATE BIT ON */ 00584000 OI CCATERM(CCAPTR),B'00000100' 0316 00585000 * MGPMGNO1=P03; /* PRIMARY MESSAGE NUMBER */ 00586000 MVI MGPMGNO1,X'03' 0317 00587000 * ICTPNOGO(I)=ON; /* MARK THIS PTF NOGO */ 00588000 * ICTPCPL(I)=ON; /* AND COMPLETE */ 00589000 L @14,I 0319 00590000 MH @14,@CH00032 0319 00591000 L @01,CCAICPTF(,CCAPTR) 0319 00592000 ALR @01,@14 0319 00593000 AL @01,@CF00835 0319 00594000 OI ICTPNOGO-8(@01),B'00000101' 0319 00595000 * CALL MSGROUT; /* ISSUE ERROR MESSAGE NO. 202 */ 00596000 BAL @14,MSGROUT 0320 00597000 * RETURN TO EXIT1;/* RETURN TO THE DRIVER */ 00598000 LA @14,EXIT1 0321 00599000 L @13,4(,@13) 0321 00600000 LM @15,@12,16(@13) 0321 00601000 BR @14 0321 00602000 * END; 0322 00603000 * ELSE 0323 00604000 * GMAIN=ON; /* SET THE GETMAIN IND. ON */ 00605000 @RF00314 OI GMAIN,B'00100000' 0323 00606000 * END; 0324 00607000 * 0325 00608000 * /***********************************************************/ 00609000 * /* */ 00610000 * /* SCAN THE PTF ENTRY FOR ANY MACROS. IF ANY FOUND, SETUP */ 00611000 * /* TO LOCATE AND RETRIEVE SAME IN THE CDS FOR POSSIBLE */ 00612000 * /* UPDATE AND DELETING THE PTS ENTRIES ASSOCIATED WITH */ 00613000 * /* SAME. */ 00614000 * /* */ 00615000 * /***********************************************************/ 00616000 * 0325 00617000 * DO J=1 TO MAX /* SCAN MODULE / MACROS IN */ 00618000 * WHILE IOPPMODS(J,1)ª=IOPEOLST;/* THE PTF ENTRY */ 00619000 @RF00308 LA @14,1 0325 00620000 B @DE00325 0325 00621000 @DL00325 L @09,IOPPTR 0325 00622000 MH @14,@CH00124 0325 00623000 SLR @08,@08 0325 00624000 IC @08,IOPPMODS-9(@14,@09) 0325 00625000 CH @08,@CH00159 0325 00626000 BE @DC00325 0325 00627000 * IF IOPPIND(J)=IOPPMACR /* IF THIS IS A MACRO */ 00628000 * THEN 0326 00629000 SLR @08,@08 0326 00630000 IC @08,IOPPIND-9(@14,@09) 0326 00631000 CH @08,@CH00130 0326 00632000 BNE @RF00326 0326 00633000 * DO; 0327 00634000 * MACBUCK=IOPPMODS(J);/* SAVE MACRO NAME */ 00635000 ALR @09,@14 0328 00636000 MVC MACBUCK(8),IOPPMODS-9(@09) 0328 00637000 * RFY 0329 00638000 * HMASMIOP BASED(IOPPTR2); 0329 00639000 * IOPDSID=IOPCDSM; /* INDICATE CDS MAIN */ 00640000 L @14,IOPPTR2 0330 00641000 MVI IOPDSID(@14),X'02' 0330 00642000 * IOPFUNCT=IOPLOC; /* INDICATE LOCATE OPERATION */ 00643000 MVI IOPFUNCT(@14),X'03' 0331 00644000 * IOPNAME=MACBUCK; /* NAME OF MACRO TO LOCATE */ 00645000 MVC IOPNAME(8,@14),MACBUCK 0332 00646000 * IOPCDTYP=IOPCMAC; /* INDICATE ENTRY TYPE AS MACRO */ 00647000 NI IOPCDTYP(@14),B'10111111' 0333 00648000 OI IOPCDTYP(@14),B'10000000' 0333 00649000 * CALL HMASMIO(HMASMIOP);/* LOCATE MACRO IN THE CDS */ 00650000 ST @14,@AL00001 0334 00651000 L @15,@CV00638 0334 00652000 LA @01,@AL00001 0334 00653000 BALR @14,@15 0334 00654000 * IF IOPRETRNª=ZERO /* IF ANY ERRORS */ 00655000 * THEN 0335 00656000 L @14,IOPPTR2 0335 00657000 SLR @09,@09 0335 00658000 IC @09,IOPRETRN(,@14) 0335 00659000 CH @09,ZERO 0335 00660000 BE @RF00335 0335 00661000 * DO; 0336 00662000 * CCATERM=ON; /* SET THE TERMINATE BIT ON */ 00663000 OI CCATERM(CCAPTR),B'00000100' 0337 00664000 * MSG229=ON; /* SET TERMINATE MSG IND ON */ 00665000 OI MSG229,B'00010000' 0338 00666000 * NAME=MACBUCK; /* SMPCDS FOR PTF---' */ 00667000 MVC NAME(8),MACBUCK 0339 00668000 * LIB=CDSLIB; /* MESSAGE */ 00669000 MVC LIB(8),CDSLIB 0340 00670000 * MGPMGNO1=P65; /* PRIMARY MESSAGE NUMBER */ 00671000 MVI MGPMGNO1,X'41' 0341 00672000 * MGPMGNO2=S11; /* SECONDARY MESSAGE NUMBER */ 00673000 MVI MGPMGNO2,X'0B' 0342 00674000 * MGPMGNO3=T5; /* TERTIARY MESSAGE NUMBER */ 00675000 MVI MGPMGNO3,X'05' 0343 00676000 * MGPVARPT(1)=ADDR(NAME);/* PARM LIST WITH */ 00677000 LA @14,NAME 0344 00678000 ST @14,MGPVARPT 0344 00679000 * MGPVARPT(2)=ADDR(NUMBER);/* INSERTS */ 00680000 LA @14,NUMBER 0345 00681000 ST @14,MGPVARPT+4 0345 00682000 * MGPVARPT(3)=ADDR(LIB);/* ADDR OF MSG */ 00683000 LA @14,LIB 0346 00684000 ST @14,MGPVARPT+8 0346 00685000 * CALL MSGROUT; /* ISSUE ERROR MESSAGE NO. 235 */ 00686000 BAL @14,MSGROUT 0347 00687000 * GO TO UPDATE; /* UPDATE THE CDS AND BYPASS THE 00688000 * REST OF THIS PTF */ 00689000 B UPDATE 0348 00690000 * END; 0349 00691000 * 0350 00692000 * /*****************************************************/ 00693000 * /* */ 00694000 * /* IF THE MACRO ID AND THE PTF ID,S ARE NOT EQUAL, */ 00695000 * /* SET THE NEW ID IN THE MACRO ENTRY AND UPDATE SAME */ 00696000 * /* IN THE CDS. */ 00697000 * /* */ 00698000 * /*****************************************************/ 00699000 * 0350 00700000 * IF ICTPMID(I)ª=IOPMODID/* IF MACRO AND PTF IDS */ 00701000 * THEN /* ARE NOT EQUAL */ 00702000 @RF00335 L @14,I 0350 00703000 MH @14,@CH00032 0350 00704000 L @09,CCAICPTF(,CCAPTR) 0350 00705000 L @08,IOPPTR2 0350 00706000 ST @14,@TF00001 0350 00707000 ALR @14,@09 0350 00708000 AL @14,@CF00834 0350 00709000 CLC ICTPMID(2,@14),IOPMODID(@08) 0350 00710000 BE @RF00350 0350 00711000 * DO; 0351 00712000 * IOPMODID=ICTPMID(I);/* SET NEW MACRO ID */ 00713000 AL @09,@TF00001 0352 00714000 AL @09,@CF00834 0352 00715000 MVC IOPMODID(2,@08),ICTPMID(@09) 0352 00716000 * IOPFUNCT=IOPSTOWR;/* IND STOW REPLACE OPR */ 00717000 MVI IOPFUNCT(@08),X'08' 0353 00718000 * CALL HMASMIO(HMASMIOP);/* UPDTE MACRO ENTRY */ 00719000 ST @08,@AL00001 0354 00720000 L @15,@CV00638 0354 00721000 LA @01,@AL00001 0354 00722000 BALR @14,@15 0354 00723000 * IF IOPRETRNª=ZERO/* IF ANY ERRORS */ 00724000 * THEN 0355 00725000 L @14,IOPPTR2 0355 00726000 SLR @09,@09 0355 00727000 IC @09,IOPRETRN(,@14) 0355 00728000 CH @09,ZERO 0355 00729000 BE @RF00355 0355 00730000 * DO; 0356 00731000 * CCATERM=ON; /* SET TERMINATE BIT ON */ 00732000 OI CCATERM(CCAPTR),B'00000100' 0357 00733000 * MSG229=ON; /* SET TERMINATE MSG IND */ 00734000 OI MSG229,B'00010000' 0358 00735000 * RECTYPE=MAC;/* (SMPCDS LIBRARY MACRO */ 00736000 MVC RECTYPE(6),MAC 0359 00737000 * NAME=MACBUCK;/* ENTRY--- UPDATE FAIL- ED FOR 00738000 * PTF--- DUE TO ERROR) MESSAGE */ 00739000 MVC NAME(8),MACBUCK 0360 00740000 * MGPMGNO1=P38;/* INITIALIZE PRIMARY, */ 00741000 MVI MGPMGNO1,X'26' 0361 00742000 * MGPMGNO2=S11;/* SECONDARY AND */ 00743000 MVI MGPMGNO2,X'0B' 0362 00744000 * MGPMGNO3=T01;/* TERTIARY MSG NUMBERS */ 00745000 MVI MGPMGNO3,X'01' 0363 00746000 * MGPVARPT(1)=ADDR(RECTYPE);/* INIT */ 00747000 LA @14,RECTYPE 0364 00748000 ST @14,MGPVARPT 0364 00749000 * MGPVARPT(2)=ADDR(NAME);/* PARM LIST */ 00750000 LA @14,NAME 0365 00751000 ST @14,MGPVARPT+4 0365 00752000 * MGPVARPT(3)=ADDR(NUMBER);/* WITH ADDR OF MSG 00753000 * INSERTS */ 00754000 LA @14,NUMBER 0366 00755000 ST @14,MGPVARPT+8 0366 00756000 * CALL MSGROUT;/* ISSUE ERR MSG NO. 237 */ 00757000 BAL @14,MSGROUT 0367 00758000 * GO TO UPDATE;/* UPDATE THE CDS AND */ 00759000 B UPDATE 0368 00760000 * END; /* BYPASS REST OF PTF */ 00761000 * END; 0370 00762000 @RF00355 DS 0H 0371 00763000 * 0371 00764000 * /*****************************************************/ 00765000 * /* */ 00766000 * /* LOOP THROUGH THE MODULE ASSEMBLIES IN THE MACRO */ 00767000 * /* ENTRY AND DELETE EACH ONE FROM THE PTS. */ 00768000 * /* */ 00769000 * /*****************************************************/ 00770000 * 0371 00771000 * DO K=1 TO MAX /* SCAN MODULE ASSEMBLIES IN THE */ 00772000 * WHILE IOPASMOD(K,1)ª=IOPEOLST;/* MACRO ENTRY */ 00773000 @RF00350 LA @14,1 0371 00774000 B @DE00371 0371 00775000 @DL00371 L @09,IOPPTR2 0371 00776000 SLA @14,3 0371 00777000 SLR @08,@08 0371 00778000 IC @08,IOPASMOD-8(@14,@09) 0371 00779000 CH @08,@CH00159 0371 00780000 BE @DC00371 0371 00781000 * IOPDSID=IOPPTS; /* INDICATE PTS DATA SET */ 00782000 MVI IOPDSID(@09),X'06' 0372 00783000 * IOPFUNCT=IOPSTOWD;/* INDICATE STOW DELETE OPR */ 00784000 MVI IOPFUNCT(@09),X'07' 0373 00785000 * IOPNAME=IOPASMOD(K);/* NAME OF ASSEMBLY TO DEL. */ 00786000 ALR @14,@09 0374 00787000 MVC IOPNAME(8,@09),IOPASMOD-8(@14) 0374 00788000 * CALL HMASMIO(HMASMIOP);/* DELETE PTS ASSMB. MOD */ 00789000 ST @09,@AL00001 0375 00790000 L @15,@CV00638 0375 00791000 LA @01,@AL00001 0375 00792000 BALR @14,@15 0375 00793000 * IF IOPRETRN>EIGHT /* IF I/O ERROR */ 00794000 * THEN 0376 00795000 L @14,IOPPTR2 0376 00796000 SLR @09,@09 0376 00797000 IC @09,IOPRETRN(,@14) 0376 00798000 CH @09,EIGHT 0376 00799000 BNH @RF00376 0376 00800000 * DO; 0377 00801000 * CCATERM=ON; /* SET THE TERMINATE BIT ONE */ 00802000 OI CCATERM(CCAPTR),B'00000100' 0378 00803000 * MSG229=ON; /* SET TERMINATE MSG BIT ON */ 00804000 OI MSG229,B'00010000' 0379 00805000 * RECTYPE=MOD; /* (MODULE--- NOT DELETED */ 00806000 MVC RECTYPE(6),MOD 0380 00807000 * NAME=IOPNAME; /* FROM SMPPTS LIBRARY FOR */ 00808000 MVC NAME(8),IOPNAME(@14) 0381 00809000 * LIB=PTSLIB; /* PTF--- DUE TO ERROR) MSG */ 00810000 MVC LIB(8),PTSLIB 0382 00811000 * MGPMGNO1=P34; /* INITIALIZE MSG PARM WITH */ 00812000 MVI MGPMGNO1,X'22' 0383 00813000 * MGPMGNO2=S11; /* PRIMARY, SECONDARY AND */ 00814000 MVI MGPMGNO2,X'0B' 0384 00815000 * MGPMGNO3=T01; /* TERTIARY MSG NUMBERS */ 00816000 MVI MGPMGNO3,X'01' 0385 00817000 * MGPVARPT(1)=ADDR(RECTYPE);/* INITIALIZE */ 00818000 LA @14,RECTYPE 0386 00819000 ST @14,MGPVARPT 0386 00820000 * MGPVARPT(2)=ADDR(NAME);/* MSG PARM LIST */ 00821000 LA @14,NAME 0387 00822000 ST @14,MGPVARPT+4 0387 00823000 * MGPVARPT(3)=ADDR(LIB);/* WITH ADDR OF */ 00824000 LA @14,LIB 0388 00825000 ST @14,MGPVARPT+8 0388 00826000 * MGPVARPT(4)=ADDR(NUMBER);/* MSG INSERTS */ 00827000 LA @14,NUMBER 0389 00828000 ST @14,MGPVARPT+12 0389 00829000 * CALL MSGROUT; /* ISSUE ERROR MSG NO. 233 */ 00830000 BAL @14,MSGROUT 0390 00831000 * GO TO UPDATE; /* UPDATE THE CDS AND */ 00832000 B UPDATE 0391 00833000 * END; /* BYPASS REST OF THIS PTF */ 00834000 * END; 0393 00835000 @RF00376 LA @14,1 0393 00836000 AL @14,K 0393 00837000 @DE00371 ST @14,K 0393 00838000 CH @14,MAX 0393 00839000 BNH @DL00371 0393 00840000 @DC00371 DS 0H 0394 00841000 * 0394 00842000 * /*****************************************************/ 00843000 * /* */ 00844000 * /* SETUP THE IOP AND SEE THAT THE UPDATED (NEW) */ 00845000 * /* VERSION OF THE MACRO IS ON THE MACRO LIBRARY */ 00846000 * /* BEFORE DELETING THE ORIGINAL (OLD) COPY. */ 00847000 * /* */ 00848000 * /*****************************************************/ 00849000 * 0394 00850000 * IOPDSID=IOPMACL; /* INDICATE MACRO LIBRARY */ 00851000 L @14,IOPPTR2 0394 00852000 MVI IOPDSID(@14),X'05' 0394 00853000 * IOPFUNCT=IOPLOC; /* INDICATE LOCATE OPERATION */ 00854000 MVI IOPFUNCT(@14),X'03' 0395 00855000 * IOPNAME=MACBUCK; /* NAME OF MACRO TO LOCATE */ 00856000 MVC IOPNAME(8,@14),MACBUCK 0396 00857000 * IOPMACID=ONE; /* SET MACRO LIB INDEX TO 1 */ 00858000 MVI IOPMACID(@14),X'F1' 0397 00859000 * CALL HMASMIO(HMASMIOP);/* LOCATE NEW MACRO */ 00860000 ST @14,@AL00001 0398 00861000 L @15,@CV00638 0398 00862000 LA @01,@AL00001 0398 00863000 BALR @14,@15 0398 00864000 * IF IOPRETRNª=ZERO /* IF ANY ERRORS */ 00865000 * THEN 0399 00866000 L @14,IOPPTR2 0399 00867000 SLR @09,@09 0399 00868000 IC @09,IOPRETRN(,@14) 0399 00869000 CH @09,ZERO 0399 00870000 BE @RF00399 0399 00871000 * DO; 0400 00872000 * CCATERM=ON; /* SET THE TERMINATE BIT ON */ 00873000 OI CCATERM(CCAPTR),B'00000100' 0401 00874000 * MSG229=ON; /* SET THE MSG TERMINATE BIT */ 00875000 OI MSG229,B'00010000' 0402 00876000 * MACTYP=NEW; /* (UPDATED MACRO---NOT FOUND */ 00877000 MVC MACTYP(8),NEW 0403 00878000 * NAME=IOPNAME; /* ON MACLIB FOR PTF---) MESSAGE */ 00879000 MVC NAME(8),IOPNAME(@14) 0404 00880000 * MGPMGNO1=P37; /* INITIALIZE THE MSG PARM */ 00881000 MVI MGPMGNO1,X'25' 0405 00882000 * MGPMGNO2=S11; /* LIST WITH PRIMARY AND 0406 00883000 * SECONDARY MSG NUMBERS */ 00884000 MVI MGPMGNO2,X'0B' 0406 00885000 * MGPVARPT(1)=ADDR(MACTYP);/* INITIALIZE MSG */ 00886000 LA @14,MACTYP 0407 00887000 ST @14,MGPVARPT 0407 00888000 * MGPVARPT(2)=ADDR(NAME);/* PARM LIST WITH */ 00889000 LA @14,NAME 0408 00890000 ST @14,MGPVARPT+4 0408 00891000 * MGPVARPT(3)=ADDR(NUMBER);/* ADDRS OF MSG INSERTS */ 00892000 LA @14,NUMBER 0409 00893000 ST @14,MGPVARPT+8 0409 00894000 * CALL MSGROUT; /* ISSUE ERROR MESSAGE NO. 236 */ 00895000 BAL @14,MSGROUT 0410 00896000 * GO TO UPDATE; /* UPDATE THE CDS AND BYPASS */ 00897000 B UPDATE 0411 00898000 * END; /* THE REST OF THIS PTF 0412 00899000 * */ 00900000 * 0413 00901000 * /*****************************************************/ 00902000 * /* */ 00903000 * /* SETUP THE IOP AND DELETE THE ORIGINAL(OLD) COPY OF*/ 00904000 * /* THE MACRO AFTER INSURING THE PRESENCE OF THE */ 00905000 * /* UPDATED(NEW) COPY. */ 00906000 * /* */ 00907000 * /*****************************************************/ 00908000 * 0413 00909000 * IOPFUNCT=IOPSTOWD; /* IND. STOW DELETE OPERATION */ 00910000 @RF00399 L @14,IOPPTR2 0413 00911000 MVI IOPFUNCT(@14),X'07' 0413 00912000 * LOWCASE=OFF; /* CONVERT TO OLD MACRO NAME */ 00913000 NI LOWCASE,B'10111111' 0414 00914000 * IOPNAME=MACBUCK; /* MOVE NAME TO THE IOP */ 00915000 MVC IOPNAME(8,@14),MACBUCK 0415 00916000 * CALL HMASMIO(HMASMIOP);/* DELETE OLD MACRO */ 00917000 ST @14,@AL00001 0416 00918000 L @15,@CV00638 0416 00919000 LA @01,@AL00001 0416 00920000 BALR @14,@15 0416 00921000 * IF IOPRETRN>EIGHT /* IF I/O ERROR */ 00922000 * THEN 0417 00923000 L @14,IOPPTR2 0417 00924000 SLR @09,@09 0417 00925000 IC @09,IOPRETRN(,@14) 0417 00926000 CH @09,EIGHT 0417 00927000 BNH @RF00417 0417 00928000 * DO; 0418 00929000 * CCATERM=ON; /* SET THE TERMINATE BIT ON */ 00930000 OI CCATERM(CCAPTR),B'00000100' 0419 00931000 * MSG229=ON; /* SET TERMINATE MSG IND ON */ 00932000 OI MSG229,B'00010000' 0420 00933000 * RECTYPE=MAC; /* (MACRO--- NOT DELETED FROM */ 00934000 MVC RECTYPE(6),MAC 0421 00935000 * LOWCASE=ON; /* MAKE MAC NAME PRINTABLE */ 00936000 OI LOWCASE,B'01000000' 0422 00937000 * NAME=MACBUCK; /* MACLIB LIBRARY FOR PTF--- */ 00938000 MVC NAME(8),MACBUCK 0423 00939000 * LIB=MACLIB; /* DUE TO ERROR) MESSAGE */ 00940000 MVC LIB(8),MACLIB 0424 00941000 * MGPMGNO1=P34; /* INITIALIZE THE MSG PARM */ 00942000 MVI MGPMGNO1,X'22' 0425 00943000 * MGPMGNO2=S11; /* LIST WITH PRIMARY, SECOND- */ 00944000 MVI MGPMGNO2,X'0B' 0426 00945000 * MGPMGNO3=T01; /* ARY AND TERTIARY MSG NO.S */ 00946000 MVI MGPMGNO3,X'01' 0427 00947000 * MGPVARPT(1)=ADDR(RECTYPE);/* INITIALIZE */ 00948000 LA @14,RECTYPE 0428 00949000 ST @14,MGPVARPT 0428 00950000 * MGPVARPT(2)=ADDR(NAME);/* MSG PARM LIST */ 00951000 LA @14,NAME 0429 00952000 ST @14,MGPVARPT+4 0429 00953000 * MGPVARPT(3)=ADDR(LIB);/* WITH ADDRS OF */ 00954000 LA @14,LIB 0430 00955000 ST @14,MGPVARPT+8 0430 00956000 * MGPVARPT(4)=ADDR(NUMBER);/* MSG INSERTS */ 00957000 LA @14,NUMBER 0431 00958000 ST @14,MGPVARPT+12 0431 00959000 * CALL MSGROUT; /* ISSUE ERROR MESSAGE NO. 233 */ 00960000 BAL @14,MSGROUT 0432 00961000 * GO TO UPDATE; /* UPDATE THE CDS AND BYPASS */ 00962000 B UPDATE 0433 00963000 * END; /* THE REST OF THIS PTF */ 00964000 * END; 0435 00965000 * ELSE 0436 00966000 * DO; 0436 00967000 B @RC00326 0436 00968000 @RF00326 DS 0H 0437 00969000 * 0437 00970000 * /*****************************************************/ 00971000 * /* */ 00972000 * /* SETUP THE IOP FOR MODULE LOCATE AND RETRIVIAL IF */ 00973000 * /* THE MODULE ID IS NOT EQUAL TO THE PTF ID. */ 00974000 * /* */ 00975000 * /*****************************************************/ 00976000 * 0437 00977000 * RFY 0437 00978000 * (ICTMOD) BASED(CCAICMOD); 0437 00979000 * RFY 0438 00980000 * (ICTPTF) BASED(CCAICT+ICTPPTR(M)); 0438 00981000 * RFY 0439 00982000 * (ICTIXMF) BASED(ICTMCHN(M)); 0439 00983000 * RFY 0440 00984000 * HMASMIOP BASED(IOPPTR); 0440 00985000 * DO M=1 TO MAX /* SCAN MODULE SECT. OF THE ICT */ 00986000 * WHILE ICTMEND(M)ª=TBLEND; 0441 00987000 LA @14,1 0441 00988000 B @DE00441 0441 00989000 @DL00441 MH @14,@CH00820 0441 00990000 L @09,CCAICMOD(,CCAPTR) 0441 00991000 ST @14,@TF00001 0441 00992000 ALR @14,@09 0441 00993000 AL @14,@CF00838 0441 00994000 CLC ICTMEND(2,@14),TBLEND 0441 00995000 BE @DC00441 0441 00996000 * IF IOPPMODS(J)=ICTMNAME(M)/* IF MODULE NAMES ARE */ 00997000 * THEN 0442 00998000 L @14,IOPPTR 0442 00999000 L @08,J 0442 01000000 MH @08,@CH00124 0442 01001000 ST @08,@TF00002 0442 01002000 ALR @08,@14 0442 01003000 LR @01,@09 0442 01004000 AL @01,@TF00001 0442 01005000 AL @01,@CF00838 0442 01006000 CLC IOPPMODS-9(8,@08),ICTMNAME(@01) 0442 01007000 BNE @RF00442 0442 01008000 * DO; 0443 01009000 * MACBUCK=IOPPMODS(J);/* SAVE MODULE NAME */ 01010000 AL @14,@TF00002 0444 01011000 MVC MACBUCK(8),IOPPMODS-9(@14) 0444 01012000 * IF ICTPMID(1)ª=ICTMID(M)/* EQUAL AND THE PTF */ 01013000 * THEN /* MODULE IDS ARE NOT */ 01014000 LR @14,@09 0445 01015000 AL @14,@TF00001 0445 01016000 AL @14,@CF00839 0445 01017000 MVC @ZT00002+2(2),ICTPPTR-21(@14) 0445 01018000 L @14,@ZT00002 0445 01019000 AL @14,CCAICT(,CCAPTR) 0445 01020000 AL @09,@TF00001 0445 01021000 AL @09,@CF00840 0445 01022000 CLC ICTPMID(2,@14),ICTMID-11(@09) 0445 01023000 BE @RF00445 0445 01024000 * DO; /* EQUAL */ 01025000 * RFY 0447 01026000 * HMASMIOP BASED(IOPPTR2); 0447 01027000 * IOPDSID=IOPCDSM;/* INDICATE CDS MAIN */ 01028000 L @14,IOPPTR2 0448 01029000 MVI IOPDSID(@14),X'02' 0448 01030000 * IOPFUNCT=IOPLOC;/* IND. LOCATE OPERATION */ 01031000 MVI IOPFUNCT(@14),X'03' 0449 01032000 * IOPNAME=MACBUCK;/* NAME OF MODULE TO LOCATE*/ 01033000 MVC IOPNAME(8,@14),MACBUCK 0450 01034000 * IOPCDTYP=IOPCMOD;/* IND. ENTRY TYPE AS 0451 01035000 * MODULE */ 01036000 OI IOPCDTYP(@14),B'11000000' 0451 01037000 * CALL HMASMIO(HMASMIOP);/* LOCATE MODULE 0452 01038000 * ENTRY IN THE CDS */ 01039000 ST @14,@AL00001 0452 01040000 L @15,@CV00638 0452 01041000 LA @01,@AL00001 0452 01042000 BALR @14,@15 0452 01043000 * IF IOPRETRN=ZERO/* IF ANY ERRORS */ 01044000 * THEN 0453 01045000 L @14,IOPPTR2 0453 01046000 SLR @09,@09 0453 01047000 IC @09,IOPRETRN(,@14) 0453 01048000 CH @09,ZERO 0453 01049000 BNE @RF00453 0453 01050000 * DO; 0454 01051000 * 0455 01052000 * /***************************************/ 01053000 * /* */ 01054000 * /* SET NEW MODULE OWNERSHIP ID AND */ 01055000 * /* UPDATE SAME IN THE CDS. */ 01056000 * /* */ 01057000 * /***************************************/ 01058000 * 0455 01059000 * IOPMODID=ICTPMID(1);/* SET NEW MODULE 01060000 * OWNER- SHIP ID */ 01061000 L @09,M 0455 01062000 MH @09,@CH00820 0455 01063000 L @01,CCAICMOD(,CCAPTR) 0455 01064000 ALR @01,@09 0455 01065000 AL @01,@CF00839 0455 01066000 MVC @ZT00002+2(2),ICTPPTR-21(@01) 0455 01067000 L @09,@ZT00002 0455 01068000 AL @09,CCAICT(,CCAPTR) 0455 01069000 MVC IOPMODID(2,@14),ICTPMID(@09) 0455 01070000 * IOPFUNCT=IOPSTOWR;/* IND STOW REPLACE 01071000 * OPER. */ 01072000 MVI IOPFUNCT(@14),X'08' 0456 01073000 * CALL HMASMIO(HMASMIOP);/* UPDATE MODULE 01074000 * ENTRY */ 01075000 ST @14,@AL00001 0457 01076000 L @15,@CV00638 0457 01077000 LA @01,@AL00001 0457 01078000 BALR @14,@15 0457 01079000 * IF IOPRETRNª=ZERO/* IF ANY ERRORS */ 01080000 * THEN 0458 01081000 L @14,IOPPTR2 0458 01082000 SLR @09,@09 0458 01083000 IC @09,IOPRETRN(,@14) 0458 01084000 CH @09,ZERO 0458 01085000 BE @RF00458 0458 01086000 * DO; 0459 01087000 * CCATERM=ON;/* SET THE TERMINATE BIT 01088000 * ON */ 01089000 OI CCATERM(CCAPTR),B'00000100' 0460 01090000 * MSG229=ON;/* SET TERMINATE MSG IND 01091000 * ON */ 01092000 OI MSG229,B'00010000' 0461 01093000 * RECTYPE=MOD;/* (SMPCDS LIBRARY 0462 01094000 * MODULE */ 01095000 MVC RECTYPE(6),MOD 0462 01096000 * NAME=IOPNAME;/* ENTRY--- UPDATE 0463 01097000 * FAILED FOR PTF--- DUE TO 0463 01098000 * ERROR) MESSAGE */ 01099000 MVC NAME(8),IOPNAME(@14) 0463 01100000 * MGPMGNO1=P38;/* INITIALIZE THE MSG */ 01101000 MVI MGPMGNO1,X'26' 0464 01102000 * MGPMGNO2=S11;/* PARM LIST WITH 0465 01103000 * PRIMARY */ 01104000 MVI MGPMGNO2,X'0B' 0465 01105000 * MGPMGNO3=T01;/* , SECONDARY AND 0466 01106000 * TERTIARY MSG NUMBERS */ 01107000 MVI MGPMGNO3,X'01' 0466 01108000 * MGPVARPT(1)=ADDR(RECTYPE);/* INIT. */ 01109000 LA @14,RECTYPE 0467 01110000 ST @14,MGPVARPT 0467 01111000 * MGPVARPT(2)=ADDR(NAME);/* MSG PARM */ 01112000 LA @14,NAME 0468 01113000 ST @14,MGPVARPT+4 0468 01114000 * MGPVARPT(3)=ADDR(NUMBER);/* LIST 0469 01115000 * WITH ADDRS OF MSG INSERTS */ 01116000 LA @14,NUMBER 0469 01117000 ST @14,MGPVARPT+8 0469 01118000 * CALL MSGROUT;/* ISSUE ERROR MSG NO. 01119000 * 237 */ 01120000 BAL @14,MSGROUT 0470 01121000 * GO TO UPDATE;/* UPDATE THE CDS AND */ 01122000 B UPDATE 0471 01123000 * END;/* BYPASS REST OF THIS PTF */ 01124000 * END; 0473 01125000 @RF00458 DS 0H 0474 01126000 * END; 0474 01127000 @RF00453 DS 0H 0475 01128000 * 0475 01129000 * /***********************************************/ 01130000 * /* */ 01131000 * /* SETUP THE IOP TO DELETE THE ABOVE MODULES */ 01132000 * /* FROM THE PTS. */ 01133000 * /* */ 01134000 * /***********************************************/ 01135000 * 0475 01136000 * IF ICTPNOGO(I)=OFF/* IF PTF NOT BEEN MARKED 0475 01137000 * NOGO */ 01138000 * THEN /* GO AHEAD AND DEL PTS ENTRIES */ 01139000 @RF00445 L @14,I 0475 01140000 MH @14,@CH00032 0475 01141000 L @09,M 0475 01142000 MH @09,@CH00820 0475 01143000 L @01,CCAICMOD(,CCAPTR) 0475 01144000 ALR @01,@09 0475 01145000 AL @01,@CF00839 0475 01146000 MVC @ZT00002+2(2),ICTPPTR-21(@01) 0475 01147000 L @09,@ZT00002 0475 01148000 AL @09,CCAICT(,CCAPTR) 0475 01149000 ALR @09,@14 0475 01150000 AL @09,@CF00835 0475 01151000 TM ICTPNOGO-8(@09),B'00000100' 0475 01152000 BNZ @RF00475 0475 01153000 * DO; 0476 01154000 * IOPNAME=MACBUCK;/* NAME OF MODULE TO DELETE*/ 01155000 L @14,IOPPTR2 0477 01156000 MVC IOPNAME(8,@14),MACBUCK 0477 01157000 * IOPDSID=IOPPTS;/* INDICATE PTS DATA SET */ 01158000 MVI IOPDSID(@14),X'06' 0478 01159000 * IOPFUNCT=IOPSTOWD;/* IND. STOW DELETE OPER.*/ 01160000 MVI IOPFUNCT(@14),X'07' 0479 01161000 * CALL HMASMIO(HMASMIOP);/* DELETE PTS MODULE*/ 01162000 ST @14,@AL00001 0480 01163000 L @15,@CV00638 0480 01164000 LA @01,@AL00001 0480 01165000 BALR @14,@15 0480 01166000 * IF IOPRETRN>EIGHT/* IF I/O ERROR */ 01167000 * THEN 0481 01168000 L @14,IOPPTR2 0481 01169000 SLR @09,@09 0481 01170000 IC @09,IOPRETRN(,@14) 0481 01171000 CH @09,EIGHT 0481 01172000 BNH @RF00481 0481 01173000 * DO; 0482 01174000 * CCATERM=ON;/* SET TERMINATE BIT ON */ 01175000 OI CCATERM(CCAPTR),B'00000100' 0483 01176000 * MSG229=ON;/* SET TERMINATE MSG IND ON */ 01177000 OI MSG229,B'00010000' 0484 01178000 * RECTYPE=MOD;/* (MODULE--- NOT DELETED */ 01179000 MVC RECTYPE(6),MOD 0485 01180000 * NAME=IOPNAME;/* FROM SMPPTS LIBRARY FOR*/ 01181000 MVC NAME(8),IOPNAME(@14) 0486 01182000 * LIB=PTSLIB;/* PTF--- DUE TO ERROR) 0487 01183000 * MESSAGE */ 01184000 MVC LIB(8),PTSLIB 0487 01185000 * MGPMGNO1=P34;/* INITIALIZE THE MSG */ 01186000 MVI MGPMGNO1,X'22' 0488 01187000 * MGPMGNO2=S11;/* PARM LIST WITH PRIMARY */ 01188000 MVI MGPMGNO2,X'0B' 0489 01189000 * MGPMGNO3=T01;/* , SECONDARY AND 0490 01190000 * TERTIARY MSG NUMBERS */ 01191000 MVI MGPMGNO3,X'01' 0490 01192000 * MGPVARPT(1)=ADDR(RECTYPE);/* INIT. */ 01193000 LA @14,RECTYPE 0491 01194000 ST @14,MGPVARPT 0491 01195000 * MGPVARPT(2)=ADDR(NAME);/* MSG PARM */ 01196000 LA @14,NAME 0492 01197000 ST @14,MGPVARPT+4 0492 01198000 * MGPVARPT(3)=ADDR(LIB);/* LIST WITH */ 01199000 LA @14,LIB 0493 01200000 ST @14,MGPVARPT+8 0493 01201000 * MGPVARPT(4)=ADDR(NUMBER);/* ADDRS OF 0494 01202000 * MSG INSERTS */ 01203000 LA @14,NUMBER 0494 01204000 ST @14,MGPVARPT+12 0494 01205000 * CALL MSGROUT;/* ISSUE ERROR MSG NO. 233*/ 01206000 BAL @14,MSGROUT 0495 01207000 * GO TO UPDATE;/* UPDATE CDS AND BYPASS */ 01208000 B UPDATE 0496 01209000 * END; /* THE REST OF THIS PTF */ 01210000 * END; 0498 01211000 @RF00481 DS 0H 0499 01212000 * END; 0499 01213000 @RF00475 DS 0H 0500 01214000 * END; 0500 01215000 @RF00442 LA @14,1 0500 01216000 AL @14,M 0500 01217000 @DE00441 ST @14,M 0500 01218000 CH @14,MAX 0500 01219000 BNH @DL00441 0500 01220000 @DC00441 DS 0H 0501 01221000 * END; 0501 01222000 * END; 0502 01223000 @RC00326 LA @14,1 0502 01224000 AL @14,J 0502 01225000 @DE00325 ST @14,J 0502 01226000 CH @14,MAX 0502 01227000 BNH @DL00325 0502 01228000 @DC00325 DS 0H 0503 01229000 * 0503 01230000 * /***********************************************************/ 01231000 * /* */ 01232000 * /* UPDATE ROUTINE. THIS ROUTINE SETS UP THE IOP AND */ 01233000 * /* REPLACES THE UPDATED PTF BACK IN THE CDS. */ 01234000 * /* */ 01235000 * /***********************************************************/ 01236000 * 0503 01237000 * RFY 0503 01238000 * (ICTPTF) BASED(CCAICPTF); 0503 01239000 * RFY 0504 01240000 * (ICTIXPF) BASED(ICTPCHN(I)); 0504 01241000 *UPDATE: 0505 01242000 * RFY 0505 01243000 * HMASMIOP BASED(IOPPTR); 0505 01244000 UPDATE DS 0H 0506 01245000 * IF CCAZAPP=OFF /* ARE ZAPS BEING PROCESSED */ 01246000 * ³ICTPNOGO(I)=OFF /* OR NOGO SITUATION? */ 01247000 * THEN /* VERIFY REJECT WILL NOT UPDATE */ 01248000 TM CCAZAPP(CCAPTR),B'10000000' 0506 01249000 BZ @RT00506 0506 01250000 L @14,I 0506 01251000 MH @14,@CH00032 0506 01252000 L @01,CCAICPTF(,CCAPTR) 0506 01253000 ALR @01,@14 0506 01254000 AL @01,@CF00835 0506 01255000 TM ICTPNOGO-8(@01),B'00000100' 0506 01256000 BNZ @RF00506 0506 01257000 @RT00506 DS 0H 0507 01258000 * DO; /* THE CDS WITH STATUS */ 01259000 * IOPDSID=IOPCDSM; /* INDICATE CDS MAIN */ 01260000 L @14,IOPPTR 0508 01261000 MVI IOPDSID(@14),X'02' 0508 01262000 * IOPFUNCT=IOPSTOWR; /* INDICATE STOW REPLACE OPER. */ 01263000 MVI IOPFUNCT(@14),X'08' 0509 01264000 * IOPTYPE=IOPCPTF; /* INDICATE ENTRY TYPE AS PTF */ 01265000 MVI IOPTYPE(@14),C'9' 0510 01266000 * CALL HMASMIO(HMASMIOP);/* UPDATE PTF ENTRY IN THE CDS */ 01267000 ST @14,@AL00001 0511 01268000 L @15,@CV00638 0511 01269000 LA @01,@AL00001 0511 01270000 BALR @14,@15 0511 01271000 * IF IOPRETRNª=ZERO /* IF ANY ERRORS */ 01272000 * THEN 0512 01273000 L @14,IOPPTR 0512 01274000 SLR @09,@09 0512 01275000 IC @09,IOPRETRN(,@14) 0512 01276000 CH @09,ZERO 0512 01277000 BE @RF00512 0512 01278000 * DO; 0513 01279000 * CCATERM=ON; /* SET THE TERMINATE BIT ON */ 01280000 OI CCATERM(CCAPTR),B'00000100' 0514 01281000 * MSG229=ON; /* SET TERMINATE MSG IND ON */ 01282000 OI MSG229,B'00010000' 0515 01283000 * RECTYPE=PTF; /* (SMPCDS LIBRARY PTF ENTRY--- */ 01284000 MVC RECTYPE(6),PTF 0516 01285000 * NAME=NUMBER; /* UPDATE FAILED FOR PTF--- DUE 01286000 * TO ERROR) MESSAGE */ 01287000 MVC NAME(8),NUMBER 0517 01288000 * MGPMGNO1=P38; /* INITIALIZE THE MSG PARM LIST */ 01289000 MVI MGPMGNO1,X'26' 0518 01290000 * MGPMGNO2=S11; /* WITH PRIMARY, SECONDARY AND */ 01291000 MVI MGPMGNO2,X'0B' 0519 01292000 * MGPMGNO3=T01; /* TERTIARY MSG NUMBERS */ 01293000 MVI MGPMGNO3,X'01' 0520 01294000 * MGPVARPT(1)=ADDR(RECTYPE);/* INITIALIZE MSG */ 01295000 LA @14,RECTYPE 0521 01296000 ST @14,MGPVARPT 0521 01297000 * MGPVARPT(2)=ADDR(NAME);/* PARM LIST WITH */ 01298000 LA @14,NAME 0522 01299000 ST @14,MGPVARPT+4 0522 01300000 * MGPVARPT(3)=ADDR(NUMBER);/* ADDRS OF MSG INSERTS */ 01301000 LA @14,NUMBER 0523 01302000 ST @14,MGPVARPT+8 0523 01303000 * CALL MSGROUT; /* ISSUE ERROR MESSAGE NO. 237 */ 01304000 BAL @14,MSGROUT 0524 01305000 * END; 0525 01306000 * 0526 01307000 * /*******************************************************/ 01308000 * /* */ 01309000 * /* FOLLOWING CODE ADDED TO STORE THE ALTERNATE CDS */ 01310000 * /* ENTRY FOR THE PTF IF IT IS BEING ACCEPTED. */ 01311000 * /* */ 01312000 * /*******************************************************/ 01313000 * 0526 01314000 * IF FUNCTION=ACC /* IS IT ACCEPT FUNCTION? */ 01315000 * THEN /* YES - STORE ALTERNATE CDS */ 01316000 @RF00512 CLC FUNCTION(7),ACC 0526 01317000 BNE @RF00526 0526 01318000 * DO; /* ENTRY FOR THIS PTF */ 01319000 * IOPDSID=IOPCDSA; /* INDICATE ALTERNATE CDS */ 01320000 L @14,IOPPTR 0528 01321000 MVI IOPDSID(@14),X'0C' 0528 01322000 * CALL HMASMIO(HMASMIOP);/* STORE THE ENTRY */ 01323000 ST @14,@AL00001 0529 01324000 L @15,@CV00638 0529 01325000 LA @01,@AL00001 0529 01326000 BALR @14,@15 0529 01327000 * IF IOPRETRNª=ZERO /* SUCCESSFUL? */ 01328000 * THEN /* NO - ISSUE ERROR MESSAGE */ 01329000 L @14,IOPPTR 0530 01330000 SLR @09,@09 0530 01331000 IC @09,IOPRETRN(,@14) 0530 01332000 CH @09,ZERO 0530 01333000 BE @RF00530 0530 01334000 * DO; 0531 01335000 * CCATERM=ON; /* INDICATE ERROR */ 01336000 OI CCATERM(CCAPTR),B'00000100' 0532 01337000 * MGPMGNO1=P62; /* SET MSG NO ( STORE FAILED) */ 01338000 MVI MGPMGNO1,X'3E' 0533 01339000 * MGPMGNO2=S11; /* INDICATE PTF NUMBER */ 01340000 MVI MGPMGNO2,X'0B' 0534 01341000 * MGPMGNO3=T16; /* INDICATE LIBRARY NAME */ 01342000 MVI MGPMGNO3,X'10' 0535 01343000 * MGPVARPT(1)=ADDR(NUMBER);/* INDICATE PTF NUMBER*/ 01344000 LA @14,NUMBER 0536 01345000 ST @14,MGPVARPT 0536 01346000 * MGPVARPT(2)=ADDR(ACDSLIB);/* PT TO ALTERNATE 0537 01347000 * CDS NM */ 01348000 LA @14,ACDSLIB 0537 01349000 ST @14,MGPVARPT+4 0537 01350000 * CALL MSGROUT; /* WRITE MESSAGE NO. 263 */ 01351000 BAL @14,MSGROUT 0538 01352000 * END; 0539 01353000 * END; 0540 01354000 @RF00530 DS 0H 0541 01355000 * END; 0541 01356000 @RF00526 DS 0H 0542 01357000 * 0542 01358000 * /***********************************************************/ 01359000 * /* */ 01360000 * /* ASSUME PTF WAS GOOD AND SET UP MESSAGE PARAMETERS */ 01361000 * /* ACCORDINGLY. */ 01362000 * /* */ 01363000 * /***********************************************************/ 01364000 * 0542 01365000 * MGPHLDS=ON; /* ISSUE MESSAGE TO HLDS ALSO */ 01366000 @RF00506 OI MGPHLDS,B'01000000' 0542 01367000 * MGPMGNO1=P28; /* INITIALIZE THE MSG PARM LIST */ 01368000 MVI MGPMGNO1,X'1C' 0543 01369000 * MGPMGNO2=S11; /* WITH PRIMARY AND SECONDARY MSG 01370000 * NUMBERS */ 01371000 MVI MGPMGNO2,X'0B' 0544 01372000 * MGPVARPT(1)=ADDR(FUNCTION);/* INITIALIZE MSG */ 01373000 LA @14,FUNCTION 0545 01374000 ST @14,MGPVARPT 0545 01375000 * MGPVARPT(2)=ADDR(NUMBER); /* PARM LIST WITH ADDRS OF MSG 0546 01376000 * INSERTS */ 01377000 LA @14,NUMBER 0546 01378000 ST @14,MGPVARPT+4 0546 01379000 * IF MSG229=ON /* DOES TERMINATE PTF MESSAGE */ 01380000 * THEN /* HAVE TO BE ISSUED */ 01381000 TM MSG229,B'00010000' 0547 01382000 BNO @RF00547 0547 01383000 * DO; /* YES, SETUP MSG PARAMETERS */ 01384000 * MGPMGNO1=P27; /* INITIALIZE THE MSG PARM LIST */ 01385000 MVI MGPMGNO1,X'1B' 0549 01386000 * MGPMGNO3=T01; /* TERTIARY MSG NUMBERS */ 01387000 MVI MGPMGNO3,X'01' 0550 01388000 * END; 0551 01389000 * CALL MSGROUT; /* ISSUE ERROR MESSAGE NO. 226 */ 01390000 @RF00547 BAL @14,MSGROUT 0552 01391000 *RESET: 0553 01392000 * MSG229=OFF; /* RESET 'TERMINATE MSG' IND */ 01393000 RESET DS 0H 0554 01394000 * LNKERR=OFF; /* RESET LINKERROR BIT */ 01395000 * MACPTF=OFF; /* RESET THE PTF MACRO/NOLIB IND */ 01396000 NI MSG229,B'01100111' 0555 01397000 * ICTPROCS(I)=OFF; /* RESET 'IN PROCESS' BIT */ 01398000 L @14,I 0556 01399000 MH @14,@CH00032 0556 01400000 L @01,CCAICPTF(,CCAPTR) 0556 01401000 ALR @01,@14 0556 01402000 AL @01,@CF00835 0556 01403000 NI ICTPROCS-8(@01),B'11101111' 0556 01404000 * END; 0557 01405000 * END; 0558 01406000 @RF00271 LA @14,1 0558 01407000 AL @14,I 0558 01408000 @DE00270 ST @14,I 0558 01409000 CH @14,MAX 0558 01410000 BNH @DL00270 0558 01411000 @DC00270 DS 0H 0559 01412000 * END PTFSCAN; 0559 01413000 @EL00002 L @13,4(,@13) 0559 01414000 @EF00002 DS 0H 0559 01415000 @ER00002 LM @14,@12,12(@13) 0559 01416000 BR @14 0559 01417000 *MSGROUT: 0560 01418000 * PROCEDURE OPTIONS(SAVEAREA); 0560 01419000 * 0560 01420000 MSGROUT STM @14,@12,12(@13) 0560 01421000 ST @13,@SA00003+4 0560 01422000 LA @14,@SA00003 0560 01423000 ST @14,8(,@13) 0560 01424000 LR @13,@14 0560 01425000 * /*****************************************************************/ 01426000 * /* */ 01427000 * /* THE MESSAGE ROUTINE ISSUES THE CALL TO HMASMMSG TO HAVE THE */ 01428000 * /* MESSAGE PRINTED EITHER ON THE HISTORY LOG OR SYSOUT. THE */ 01429000 * /* MESSAGE PARAMETERS ARE ALREADY INITIALIZED WITH ALL THE */ 01430000 * /* INFORMATION PRIOR TO ENTERING THIS ROUTINE. THIS ROUTINE */ 01431000 * /* HOWEVER WILL DEFAULT THE MESSAGES TO THE SYSOUT PRINTER, SET */ 01432000 * /* THE APPROPRIATE INDICATORS AND CLEAR THE NECESSARY PARAMETERS.*/ 01433000 * /* */ 01434000 * /*****************************************************************/ 01435000 * 0561 01436000 * CALL HMASMMSG(HMASMMGP); /* CALL THE MESSAGE WRITER ROUT. */ 01437000 L @15,@CV00639 0561 01438000 LA @01,@AL00561 0561 01439000 BALR @14,@15 0561 01440000 * MGPHLDS=OFF; /* SET HISTORY LOG IND OFF */ 01441000 * MGPPRINT=ON; /* SET IND TO PUT MSG ON SYSOUT */ 01442000 OI MGPPRINT,B'10000000' 0563 01443000 NI MGPHLDS,B'10111111' 0563 01444000 * MGPMGNO2=CLEAR; /* CLEAR SECONDARY */ 01445000 MVI MGPMGNO2,X'00' 0564 01446000 * MGPMGNO3=CLEAR; /* CLEAR TERTIARY */ 01447000 MVI MGPMGNO3,X'00' 0565 01448000 * END MSGROUT; 0566 01449000 @EL00003 L @13,4(,@13) 0566 01450000 @EF00003 DS 0H 0566 01451000 @ER00003 LM @14,@12,12(@13) 0566 01452000 BR @14 0566 01453000 * END HMASMAPA 0567 01454000 * 0567 01455000 */* THE FOLLOWING INCLUDE STATEMENTS WERE FOUND IN THIS PROGRAM. */ 01456000 */*%INCLUDE SYSLIB (HMASMCCA) */ 01457000 */*%INCLUDE SYSLIB (HMASMIOP) */ 01458000 */*%INCLUDE SYSLIB (HMASMICT) */ 01459000 */*%INCLUDE SYSLIB (HMASMMGP) */ 01460000 */*%INCLUDE SYSLIB (IHADCBDF) */ 01461000 */*%INCLUDE SYSLIB (IHADCB ) */ 01462000 * 0567 01463000 * ; 0567 01464000 @DATA DS 0H 01465000 @CH00130 DC H'0' 01466000 @CH00124 DC H'9' 01467000 @CH00032 DC H'12' 01468000 @CH00820 DC H'26' 01469000 @CH00159 DC H'255' 01470000 DS 0F 01471000 @AL00561 DC A(HMASMMGP) LIST WITH 1 ARGUMENT(S) 01472000 DS 0F 01473000 @SA00001 DS 18F 01474000 @SA00003 DS 18F 01475000 @SA00002 DS 18F 01476000 @AL00001 DS 1A 01477000 @TF00001 DS F 01478000 @TF00002 DS F 01479000 @ZTEMPS DS 0F 01480000 @ZT00002 DC F'0' 01481000 @ZTEMPND EQU * 01482000 @ZLEN EQU @ZTEMPND-@ZTEMPS 01483000 DS 0F 01484000 @CF00838 DC F'-26' 01485000 @CF00840 DC F'-15' 01486000 @CF00834 DC F'-12' 01487000 @CF00839 DC F'-5' 01488000 @CF00835 DC F'-4' 01489000 @CV00638 DC V(HMASMIO) 01490000 @CV00639 DC V(HMASMMSG) 01491000 @CV00640 DC V(HMASMZAP) 01492000 @CV00641 DC V(HMASMLKI) 01493000 @CV00642 DC V(HMASMCPI) 01494000 DS 0D 01495000 IOPPTR DC A(0) 01496000 DCBPTR DC AL4(NUCDCB) 01497000 I DC A(0) 01498000 J DC A(0) 01499000 K DC A(0) 01500000 M DC A(0) 01501000 ZERO DC H'0' 01502000 FOUR DC H'4' 01503000 EIGHT DC H'8' 01504000 MAX DC H'999' 01505000 HMASMMGP DS CL20 01506000 ORG HMASMMGP 01507000 MGPMGNO1 DS FL1 01508000 MGPMGNO2 DS FL1 01509000 MGPMGNO3 DS FL1 01510000 MGPFLAGS DS BL1 01511000 ORG MGPFLAGS 01512000 MGPPRINT DS BL1 01513000 MGPHLDS EQU MGPFLAGS+0 01514000 @NM00017 EQU MGPFLAGS+0 01515000 ORG HMASMMGP+4 01516000 MGPVARPT DS 4A 01517000 ORG HMASMMGP+20 01518000 NUCBLDL DS CL80 01519000 ORG NUCBLDL 01520000 @NM00043 DC H'1' 01521000 @NM00044 DC H'76' 01522000 @NM00045 DC CL8'IEANUC01' 01523000 NUCTTR DS AL3 01524000 @NM00046 DS CL2 01525000 UDLEN DS CL1 01526000 USERDATA DS CL62 01527000 ORG NUCBLDL+80 01528000 STOWLIST DS CL74 01529000 ORG STOWLIST 01530000 NUCNAME DS CL8 01531000 ORG NUCNAME 01532000 @NM00047 DC CL7'IEANUC0' 01533000 DIGIT1 DC AL1(1) 01534000 ORG STOWLIST+8 01535000 @NM00048 DC AL3(0) 01536000 STOWLEN DS CL1 01537000 UDATA DS CL62 01538000 ORG STOWLIST+74 01539000 DS CL2 01540000 PECORE DS CL4 01541000 ORG PECORE 01542000 IOPPTR2 DC A(0) 01543000 ORG PECORE+4 01544000 PARMLIST DS CL66 01545000 ORG PARMLIST 01546000 @NM00049 DC H'64' 01547000 @NM00050 DC X'0000000000000000' 01548000 DC X'0000000000000000' 01549000 DC X'0000000000000000' 01550000 DC X'0000000000000000' 01551000 DC X'0000000000000000' 01552000 DC X'0000000000000000' 01553000 DC X'0000000000000000' 01554000 DC CL8'SVCLIB ' 01555000 ORG PARMLIST+66 01556000 SUPPARM DS CL9 01557000 ORG SUPPARM 01558000 SUPLEN DC H'7' 01559000 @NM00051 DC CL7'TSO=YES' 01560000 ORG SUPPARM+9 01561000 TBLEND DC X'FFFF' 01562000 SWITCH1 DC X'00' 01563000 ORG SWITCH1 01564000 LNKERR DS BL1 01565000 LNKTIME EQU SWITCH1+0 01566000 GMAIN EQU SWITCH1+0 01567000 MSG229 EQU SWITCH1+0 01568000 MACPTF EQU SWITCH1+0 01569000 ORG SWITCH1+1 01570000 MACBUCK DS CL8 01571000 ORG MACBUCK 01572000 ALPHA1 DS BL1 01573000 ORG ALPHA1 01574000 @NM00052 DS BL1 01575000 LOWCASE EQU ALPHA1+0 01576000 ORG MACBUCK+8 01577000 RECTYPE DC CL6' ' 01578000 LIB DC CL8' ' 01579000 FUNCTION DC CL7' ' 01580000 NUMBER DC CL8' ' 01581000 NAME DC CL8' ' 01582000 MACTYP DC CL8' ' 01583000 ACC DC CL7'ACCEPT ' 01584000 APP DC CL7'APPLY ' 01585000 PTF DC CL6'PTF ' 01586000 MAC DC CL6'MACRO ' 01587000 MOD DC CL6'MODULE' 01588000 CDSLIB DC CL8'SMPCDS' 01589000 ACDSLIB DC CL8'SMPACDS' 01590000 MACLIB DC CL8'MACLIB' 01591000 PTSLIB DC CL8'SMPPTS' 01592000 NUCLIB DC CL8'NUCLEUS ' 01593000 NEW DC CL8'UPDATED ' 01594000 DS CL1 01595000 DBLWRD DS CL8 01596000 SUPCODE DS CL2 01597000 ORG SUPCODE 01598000 @NM00053 DS CL1 01599000 SUPDIG DS BL1 01600000 ORG SUPCODE+2 01601000 PATCH DC 12CL6'PATCH*' 01602000 HMASMAPA CSECT 01603000 NUCDCB DCB DDNAME=NUCLEUS, X01604000 MACRF=(R,W), X01605000 DSORG=PO, X01606000 DEVD=DA 01607000 HMASMAPA CSECT 01608000 @00 EQU 00 EQUATES FOR REGISTERS 0-15 01609000 @01 EQU 01 01610000 @02 EQU 02 01611000 @03 EQU 03 01612000 @04 EQU 04 01613000 @05 EQU 05 01614000 @06 EQU 06 01615000 @07 EQU 07 01616000 @08 EQU 08 01617000 @09 EQU 09 01618000 @10 EQU 10 01619000 @11 EQU 11 01620000 @12 EQU 12 01621000 @13 EQU 13 01622000 @14 EQU 14 01623000 @15 EQU 15 01624000 CCAPTR EQU @11 01625000 RTNCODE EQU @15 01626000 LINKREG EQU @02 01627000 SPDCBRG EQU @03 01628000 HMASMCCA EQU 0 01629000 CCAIOPTR EQU HMASMCCA+8 01630000 CCAICT EQU HMASMCCA+12 01631000 CCAICPTF EQU HMASMCCA+16 01632000 CCAICMOD EQU HMASMCCA+20 01633000 CCAICLMD EQU HMASMCCA+24 01634000 CCAPESIZ EQU HMASMCCA+28 01635000 CCAIOSUP EQU HMASMCCA+48 01636000 CCAOPT EQU HMASMCCA+76 01637000 CCAFLAG1 EQU HMASMCCA+77 01638000 CCAAPPLY EQU CCAFLAG1 01639000 CCAFLAG2 EQU HMASMCCA+78 01640000 CCANCPTF EQU CCAFLAG2 01641000 CCATSO EQU CCAFLAG2 01642000 CCASVCLB EQU CCAFLAG2 01643000 CCATERM EQU CCAFLAG2 01644000 CCAFLAG3 EQU HMASMCCA+79 01645000 CCAZAPP EQU CCAFLAG3 01646000 CCALINKP EQU CCAFLAG3 01647000 CCACOPYP EQU CCAFLAG3 01648000 CCANUCID EQU HMASMCCA+80 01649000 CCASPDCB EQU HMASMCCA+88 01650000 HMASMIOP EQU 0 01651000 IOPDSID EQU HMASMIOP 01652000 IOPFUNCT EQU HMASMIOP+1 01653000 IOPRETRN EQU HMASMIOP+2 01654000 IOPMACID EQU HMASMIOP+3 01655000 IOPNAME EQU HMASMIOP+8 01656000 IOPTYPE EQU IOPNAME 01657000 IOPCDTYP EQU IOPTYPE 01658000 IOPNAME2 EQU IOPNAME+1 01659000 IOPTTR EQU HMASMIOP+16 01660000 IOPUDATA EQU HMASMIOP+20 01661000 HMASMICT EQU 0 01662000 ICTCORE EQU HMASMICT 01663000 ICTSPLEN EQU ICTCORE 01664000 ICTPTF EQU 0 01665000 ICTPTFS EQU ICTPTF 01666000 ICTPMID EQU ICTPTFS 01667000 ICTPEND EQU ICTPMID 01668000 ICTPFLG1 EQU ICTPTF+7 01669000 ICTPIFLG EQU ICTPTF+8 01670000 ICTPROCS EQU ICTPIFLG 01671000 ICTPNOGO EQU ICTPIFLG 01672000 ICTPCPL EQU ICTPIFLG 01673000 ICTPCHN EQU ICTPTF+9 01674000 ICTIXPF EQU 0 01675000 ICTMOD EQU 0 01676000 ICTMNAME EQU ICTMOD 01677000 ICTMEND EQU ICTMNAME 01678000 ICTMFLG1 EQU ICTMOD+8 01679000 ICTMIFLG EQU ICTMOD+9 01680000 ICTMLEPR EQU ICTMOD+10 01681000 ICTMID EQU ICTMOD+11 01682000 ICTPPTR EQU ICTMOD+21 01683000 ICTMCHN EQU ICTMOD+23 01684000 ICTIXMF EQU 0 01685000 ICTLMOD EQU 0 01686000 ICTLMNAM EQU ICTLMOD 01687000 ICTLFLG1 EQU ICTLMOD+8 01688000 ICTLFLG2 EQU ICTLMOD+9 01689000 ICTLIFLG EQU ICTLMOD+10 01690000 ICTTGIND EQU ICTLIFLG 01691000 ICTTGLIB EQU ICTLMOD+11 01692000 ICTLCHN EQU ICTLMOD+30 01693000 ICTIXLF EQU 0 01694000 IHADCB EQU 0 01695000 IHADCS00 EQU 0 01696000 DCBRELAD EQU IHADCS00 01697000 DCBFDAD EQU IHADCS00+5 01698000 IHADCS01 EQU 0 01699000 DCBDVTBL EQU IHADCS01 01700000 IHADCS11 EQU 0 01701000 DCBRELB EQU IHADCS11 01702000 DCBREL EQU DCBRELB+1 01703000 DCBBUFCB EQU IHADCS11+4 01704000 DCBDSORG EQU IHADCS11+10 01705000 DCBDSRG1 EQU DCBDSORG 01706000 DCBDSRG2 EQU DCBDSORG+1 01707000 DCBIOBAD EQU IHADCS11+12 01708000 DCBODEB EQU DCBIOBAD 01709000 DCBLNP EQU DCBODEB 01710000 DCBQSLM EQU DCBLNP 01711000 DCBIOBAA EQU DCBODEB+1 01712000 IHADCS50 EQU 0 01713000 DCBSVCXL EQU IHADCS50 01714000 DCBEODAD EQU IHADCS50+4 01715000 DCBBFALN EQU DCBEODAD 01716000 DCBHIARC EQU DCBBFALN 01717000 DCBBFTEK EQU DCBHIARC 01718000 DCBBFT EQU DCBBFTEK 01719000 DCBEXLST EQU IHADCS50+8 01720000 DCBRECFM EQU DCBEXLST 01721000 DCBRECLA EQU DCBRECFM 01722000 IHADCS24 EQU 0 01723000 DCBDDNAM EQU IHADCS24 01724000 DCBOFLGS EQU IHADCS24+8 01725000 DCBOFLWR EQU DCBOFLGS 01726000 DCBOFOPN EQU DCBOFLGS 01727000 DCBIFLG EQU IHADCS24+9 01728000 DCBMACR EQU IHADCS24+10 01729000 DCBMACR1 EQU DCBMACR 01730000 DCBMRFE EQU DCBMACR1 01731000 DCBMRGET EQU DCBMRFE 01732000 DCBMRAPG EQU DCBMACR1 01733000 DCBMRRD EQU DCBMRAPG 01734000 DCBMRCI EQU DCBMACR1 01735000 DCBMRMVG EQU DCBMRCI 01736000 DCBMRLCG EQU DCBMACR1 01737000 DCBMRABC EQU DCBMACR1 01738000 DCBMRPT1 EQU DCBMRABC 01739000 DCBMRSBG EQU DCBMRPT1 01740000 DCBMRCRL EQU DCBMACR1 01741000 DCBMRCHK EQU DCBMRCRL 01742000 DCBMRRDX EQU DCBMRCHK 01743000 DCBMRDMG EQU DCBMACR1 01744000 DCBMACR2 EQU DCBMACR+1 01745000 DCBMRPUT EQU DCBMACR2 01746000 DCBMRWRT EQU DCBMACR2 01747000 DCBMRMVP EQU DCBMACR2 01748000 DCBMR5WD EQU DCBMACR2 01749000 DCBMRLDM EQU DCBMR5WD 01750000 DCBMRLCP EQU DCBMRLDM 01751000 DCBMR4WD EQU DCBMACR2 01752000 DCBMRPT2 EQU DCBMR4WD 01753000 DCBMRTMD EQU DCBMRPT2 01754000 DCBMR3WD EQU DCBMACR2 01755000 DCBMRCTL EQU DCBMR3WD 01756000 DCBMRSTK EQU DCBMRCTL 01757000 DCBMR1WD EQU DCBMACR2 01758000 DCBMRSWA EQU DCBMR1WD 01759000 DCBMRDMD EQU DCBMRSWA 01760000 IHADCS25 EQU 0 01761000 DCBMACRF EQU IHADCS25+2 01762000 DCBMACF1 EQU DCBMACRF 01763000 DCBMFFE EQU DCBMACF1 01764000 DCBMFGET EQU DCBMFFE 01765000 DCBMFAPG EQU DCBMACF1 01766000 DCBMFRD EQU DCBMFAPG 01767000 DCBMFCI EQU DCBMACF1 01768000 DCBMFMVG EQU DCBMFCI 01769000 DCBMFLCG EQU DCBMACF1 01770000 DCBMFABC EQU DCBMACF1 01771000 DCBMFPT1 EQU DCBMFABC 01772000 DCBMFSBG EQU DCBMFPT1 01773000 DCBMFCRL EQU DCBMACF1 01774000 DCBMFCHK EQU DCBMFCRL 01775000 DCBMFDMG EQU DCBMACF1 01776000 DCBMACF2 EQU DCBMACRF+1 01777000 DCBMFPUT EQU DCBMACF2 01778000 DCBMFWRT EQU DCBMACF2 01779000 DCBMFMVP EQU DCBMACF2 01780000 DCBMF5WD EQU DCBMACF2 01781000 DCBMFLDM EQU DCBMF5WD 01782000 DCBMFLCP EQU DCBMFLDM 01783000 DCBMF4WD EQU DCBMACF2 01784000 DCBMFPT2 EQU DCBMF4WD 01785000 DCBMFTMD EQU DCBMFPT2 01786000 DCBMF3WD EQU DCBMACF2 01787000 DCBMFCTL EQU DCBMF3WD 01788000 DCBMFSTK EQU DCBMFCTL 01789000 DCBMF1WD EQU DCBMACF2 01790000 DCBMFSWA EQU DCBMF1WD 01791000 DCBMFDMD EQU DCBMFSWA 01792000 DCBDEBAD EQU IHADCS25+4 01793000 DCBIFLGS EQU DCBDEBAD 01794000 IHADCS26 EQU 0 01795000 DCBWRITE EQU IHADCS26 01796000 IHADCS27 EQU 0 01797000 DCBGET EQU IHADCS27 01798000 IHADCS36 EQU 0 01799000 DCBGERR EQU IHADCS36 01800000 DCBPERR EQU DCBGERR 01801000 DCBCHECK EQU DCBPERR 01802000 DCBOPTCD EQU DCBCHECK 01803000 DCBOPTH EQU DCBOPTCD 01804000 DCBOPTO EQU DCBOPTH 01805000 DCBOPTZ EQU DCBOPTCD 01806000 DCBGERRA EQU DCBCHECK+1 01807000 DCBPERRA EQU DCBGERRA 01808000 DCBSYNAD EQU IHADCS36+4 01809000 DCBCIND1 EQU IHADCS36+8 01810000 DCBCIND2 EQU IHADCS36+9 01811000 DCBCICB EQU IHADCS36+20 01812000 IHADCS52 EQU 0 01813000 DCBDIRCT EQU IHADCS52 01814000 DCBQSWS EQU DCBDIRCT 01815000 DCBUSASI EQU DCBQSWS 01816000 DCBQADFS EQU DCBUSASI 01817000 DCBBUFOF EQU DCBDIRCT+1 01818000 IHADCS38 EQU 0 01819000 DCBEOBR EQU IHADCS38 01820000 DCBPOINT EQU IHADCS38+12 01821000 DCBCNTRL EQU DCBPOINT 01822000 IHADCS40 EQU 0 01823000 DCBEOBAD EQU IHADCS40 01824000 DCBCCCW EQU IHADCS40+4 01825000 DCBRECAD EQU DCBCCCW 01826000 DCBRECBT EQU DCBRECAD 01827000 DCBRCREL EQU DCBRECBT 01828000 @NM00039 EQU IHADCS40+12 01829000 DCBEROPT EQU @NM00039 01830000 IOPMOCDS EQU IOPUDATA 01831000 IOPMODID EQU IOPMOCDS 01832000 IOPLMCDS EQU IOPUDATA 01833000 IOPFLGS2 EQU IOPLMCDS 01834000 IOPFLGS3 EQU IOPLMCDS+1 01835000 IOPMACDS EQU IOPUDATA 01836000 IOPASMOD EQU IOPMACDS+2 01837000 IOPPTCDS EQU IOPUDATA 01838000 IOPFLGS5 EQU IOPPTCDS 01839000 IOPSTAT EQU IOPFLGS5 01840000 IOPAPP EQU IOPSTAT 01841000 IOPACC EQU IOPSTAT 01842000 IOPPNTRY EQU IOPPTCDS+4 01843000 IOPPMODS EQU IOPPNTRY 01844000 IOPPIND EQU IOPPNTRY+8 01845000 IOPDLCDS EQU IOPUDATA 01846000 IOPSYCDS EQU IOPUDATA 01847000 IOPFLGS7 EQU IOPSYCDS 01848000 IOPSTCMP EQU IOPUDATA 01849000 IOPPTSNT EQU IOPUDATA 01850000 IOPPFLG1 EQU IOPPTSNT 01851000 IOPPLEPR EQU IOPPTSNT+1 01852000 IOPPNUM EQU IOPPTSNT+2 01853000 AGO .@UNREFD START UNREFERENCED COMPONENTS 01854000 IOPALISL EQU IOPPTSNT+22 01855000 IOPINDLB EQU IOPPTSNT+14 01856000 IOPDISTN EQU IOPPTSNT+7 01857000 IOPPDIG EQU IOPPNUM+2 01858000 IOPPID EQU IOPPNUM 01859000 IOPPNE EQU IOPPLEPR 01860000 IOPPDC EQU IOPPLEPR 01861000 IOPPREFR EQU IOPPLEPR 01862000 IOPPOVLY EQU IOPPLEPR 01863000 IOPPSCTR EQU IOPPLEPR 01864000 IOPPREUS EQU IOPPLEPR 01865000 IOPPRENT EQU IOPPLEPR 01866000 @NM00010 EQU IOPPLEPR 01867000 @NM00009 EQU IOPPFLG1 01868000 IOPLEFND EQU IOPPFLG1 01869000 IOPDALIS EQU IOPPFLG1 01870000 IOPTALIS EQU IOPPFLG1 01871000 IOPLIBTX EQU IOPPFLG1 01872000 IOPLIBLK EQU IOPPFLG1 01873000 IOPSTNEW EQU IOPSTCMP+8 01874000 IOPSTOLD EQU IOPSTCMP 01875000 IOPPDLM EQU IOPSYCDS+8 01876000 IOPPEMAX EQU IOPSYCDS+6 01877000 IOPNUCID EQU IOPSYCDS+5 01878000 IOPSREL EQU IOPSYCDS+1 01879000 @NM00008 EQU IOPFLGS7 01880000 IOPTSO EQU IOPFLGS7 01881000 IOPDSYS EQU IOPDLCDS 01882000 IOPDATE EQU IOPPTCDS+1 01883000 @NM00007 EQU IOPFLGS5 01884000 IOPDUMMP EQU IOPSTAT 01885000 IOPFORCE EQU IOPSTAT 01886000 @NM00006 EQU IOPMACDS 01887000 IOPSYSLB EQU IOPLMCDS+2 01888000 @NM00005 EQU IOPFLGS3 01889000 IOPCHREP EQU IOPFLGS3 01890000 IOPLINK EQU IOPFLGS3 01891000 IOPCOPY EQU IOPFLGS3 01892000 IOPNE EQU IOPFLGS2 01893000 IOPDC EQU IOPFLGS2 01894000 IOPREFR EQU IOPFLGS2 01895000 IOPOVLY EQU IOPFLGS2 01896000 IOPSCTR EQU IOPFLGS2 01897000 IOPREUS EQU IOPFLGS2 01898000 IOPRENT EQU IOPFLGS2 01899000 @NM00004 EQU IOPFLGS2 01900000 IOPLMODS EQU IOPMOCDS+9 01901000 IOPDLIB EQU IOPMOCDS+2 01902000 DCBEOB EQU IHADCS40+20 01903000 DCBPRECL EQU IHADCS40+18 01904000 @NM00042 EQU IHADCS40+16 01905000 @NM00041 EQU @NM00039+1 01906000 @NM00040 EQU DCBEROPT 01907000 DCBERABE EQU DCBEROPT 01908000 DCBERSKP EQU DCBEROPT 01909000 DCBERACC EQU DCBEROPT 01910000 @NM00038 EQU IHADCS40+10 01911000 @NM00037 EQU IHADCS40+9 01912000 @NM00036 EQU IHADCS40+8 01913000 DCBRECA EQU DCBRECAD+1 01914000 @NM00035 EQU DCBRECBT 01915000 DCBRCFGT EQU DCBRCREL 01916000 DCBRCTRU EQU DCBRCREL 01917000 DCBLCCW EQU DCBEOBAD 01918000 DCBNOTE EQU DCBCNTRL 01919000 DCBLRECL EQU IHADCS38+10 01920000 @NM00034 EQU IHADCS38+8 01921000 DCBEOBW EQU IHADCS38+4 01922000 DCBEOBRA EQU DCBEOBR+1 01923000 DCBNCP EQU DCBEOBR 01924000 DCBDIRCQ EQU DCBBUFOF 01925000 DCBQSTRU EQU DCBUSASI 01926000 @NM00033 EQU DCBUSASI 01927000 DCBQADF3 EQU DCBQADFS 01928000 DCBQADF2 EQU DCBQADFS 01929000 DCBQADF1 EQU DCBQADFS 01930000 DCBBLBP EQU DCBUSASI 01931000 @NM00032 EQU DCBUSASI 01932000 DCBCICBA EQU DCBCICB+1 01933000 @NM00031 EQU DCBCICB 01934000 DCBIOBA EQU IHADCS36+16 01935000 DCBOFFSW EQU IHADCS36+15 01936000 DCBOFFSR EQU IHADCS36+14 01937000 DCBWCPL EQU IHADCS36+13 01938000 DCBWCPO EQU IHADCS36+12 01939000 DCBBLKSI EQU IHADCS36+10 01940000 DCBCNQSM EQU DCBCIND2 01941000 DCBCNFEO EQU DCBCIND2 01942000 DCBCNCHS EQU DCBCIND2 01943000 DCBCNBFP EQU DCBCIND2 01944000 DCBCNIOE EQU DCBCIND2 01945000 DCBCNCLO EQU DCBCIND2 01946000 DCBCNWRO EQU DCBCIND2 01947000 DCBCNSTO EQU DCBCIND2 01948000 DCBCNEXB EQU DCBCIND1 01949000 @NM00030 EQU DCBCIND1 01950000 DCBCNBRM EQU DCBCIND1 01951000 @NM00029 EQU DCBCIND1 01952000 DCBCNEVA EQU DCBCIND1 01953000 DCBCNEVB EQU DCBCIND1 01954000 DCBCNSRD EQU DCBCIND1 01955000 DCBCNTOV EQU DCBCIND1 01956000 DCBSYNA EQU DCBSYNAD+1 01957000 DCBIOBL EQU DCBSYNAD 01958000 DCBCHCKA EQU DCBPERRA 01959000 @NM00028 EQU DCBOPTCD 01960000 DCBOPTT EQU DCBOPTCD 01961000 DCBSRCHD EQU DCBOPTZ 01962000 DCBOPTQ EQU DCBOPTCD 01963000 DCBBCKPT EQU DCBOPTO 01964000 DCBOPTC EQU DCBOPTCD 01965000 DCBOPTU EQU DCBOPTCD 01966000 DCBOPTW EQU DCBOPTCD 01967000 DCBPUT EQU DCBGET 01968000 DCBREAD EQU DCBWRITE 01969000 DCBDEBA EQU DCBDEBAD+1 01970000 @NM00027 EQU DCBIFLGS 01971000 DCBIFIOE EQU DCBIFLGS 01972000 DCBIFPCT EQU DCBIFLGS 01973000 DCBIFEC EQU DCBIFLGS 01974000 DCBMFSTI EQU DCBMFDMD 01975000 DCBMFAWR EQU DCBMFSTK 01976000 DCBMFUIP EQU DCBMFTMD 01977000 DCBMFIDW EQU DCBMFLCP 01978000 DCBMFWRK EQU DCBMFMVP 01979000 DCBMFRDQ EQU DCBMFWRT 01980000 DCBMFGTQ EQU DCBMFPUT 01981000 DCBMFSTL EQU DCBMACF2 01982000 DCBMFCK EQU DCBMFDMG 01983000 DCBMFRDX EQU DCBMFCHK 01984000 DCBMFDBF EQU DCBMFSBG 01985000 DCBMFRDI EQU DCBMFLCG 01986000 DCBMFRDK EQU DCBMFMVG 01987000 DCBMFWRQ EQU DCBMFRD 01988000 DCBMFPTQ EQU DCBMFGET 01989000 DCBMFECP EQU DCBMACF1 01990000 DCBTIOT EQU IHADCS25 01991000 DCBMRSTI EQU DCBMRDMD 01992000 DCBMRAWR EQU DCBMRSTK 01993000 DCBMRUIP EQU DCBMRTMD 01994000 DCBMRIDW EQU DCBMRLCP 01995000 DCBMRWRK EQU DCBMRMVP 01996000 DCBMRRDQ EQU DCBMRWRT 01997000 DCBMRGTQ EQU DCBMRPUT 01998000 DCBMRSTL EQU DCBMACR2 01999000 DCBMRCK EQU DCBMRDMG 02000000 DCBPGFXA EQU DCBMRRDX 02001000 DCBMRDBF EQU DCBMRSBG 02002000 DCBMRRDI EQU DCBMRLCG 02003000 DCBMRRDK EQU DCBMRMVG 02004000 DCBMRWRQ EQU DCBMRRD 02005000 DCBMRPTQ EQU DCBMRGET 02006000 DCBMRECP EQU DCBMACR1 02007000 @NM00026 EQU DCBIFLG 02008000 DCBIBIOE EQU DCBIFLG 02009000 DCBIBPCT EQU DCBIFLG 02010000 DCBIBEC EQU DCBIFLG 02011000 DCBOFIOF EQU DCBOFLGS 02012000 DCBOFUEX EQU DCBOFLGS 02013000 DCBOFTM EQU DCBOFLGS 02014000 DCBOFPPC EQU DCBOFLGS 02015000 DCBOFEOV EQU DCBOFLGS 02016000 DCBOFLRB EQU DCBOFLGS 02017000 DCBOFIOD EQU DCBOFLWR 02018000 DCBEXLSA EQU DCBEXLST+1 02019000 DCBRECKL EQU DCBRECFM 02020000 DCBRECCC EQU DCBRECFM 02021000 DCBRECSB EQU DCBRECFM 02022000 DCBRECBR EQU DCBRECFM 02023000 DCBRECTO EQU DCBRECLA 02024000 DCBRECL EQU DCBRECLA 02025000 DCBEODA EQU DCBEODAD+1 02026000 DCBBFA EQU DCBBFTEK 02027000 DCBH0 EQU DCBBFTEK 02028000 DCBBFTKD EQU DCBBFTEK 02029000 DCBBFTE EQU DCBBFT 02030000 DCBBFTKR EQU DCBBFT 02031000 DCBBFTS EQU DCBBFT 02032000 DCBH1 EQU DCBBFTEK 02033000 DCBSVCXA EQU DCBSVCXL+1 02034000 @NM00025 EQU DCBSVCXL 02035000 DCBODEBA EQU DCBIOBAA 02036000 @NM00024 EQU DCBQSLM 02037000 DCBUPDBT EQU DCBQSLM 02038000 DCBUPDCM EQU DCBQSLM 02039000 DCB1DVDS EQU DCBQSLM 02040000 @NM00023 EQU DCBDSRG2 02041000 DCBACBM EQU DCBDSRG2 02042000 @NM00022 EQU DCBDSRG2 02043000 DCBDSGTQ EQU DCBDSRG2 02044000 DCBDSGTX EQU DCBDSRG2 02045000 DCBDSGGS EQU DCBDSRG2 02046000 DCBDSGU EQU DCBDSRG1 02047000 DCBDSGPO EQU DCBDSRG1 02048000 DCBDSGMQ EQU DCBDSRG1 02049000 DCBDSGCQ EQU DCBDSRG1 02050000 DCBDSGCX EQU DCBDSRG1 02051000 DCBDSGDA EQU DCBDSRG1 02052000 DCBDSGPS EQU DCBDSRG1 02053000 DCBDSGIS EQU DCBDSRG1 02054000 DCBBUFL EQU IHADCS11+8 02055000 DCBBUFCA EQU DCBBUFCB+1 02056000 DCBBUFNO EQU DCBBUFCB 02057000 DCBDEVT EQU DCBREL 02058000 DCBKEYLE EQU DCBRELB 02059000 DCBTRBAL EQU IHADCS01+6 02060000 @NM00021 EQU IHADCS01+5 02061000 @NM00020 EQU IHADCS01+4 02062000 DCBDVTBA EQU DCBDVTBL+1 02063000 @NM00019 EQU DCBDVTBL 02064000 DCBKEYCN EQU IHADCS00+4 02065000 @NM00018 EQU IHADCB 02066000 ICTIXL EQU ICTIXLF 02067000 ICTLTTR EQU ICTLMOD+27 02068000 ICTTG2 EQU ICTTGLIB+8 02069000 ICTTG1 EQU ICTTGLIB 02070000 ICTLCPL EQU ICTLIFLG 02071000 ICTLNOGO EQU ICTLIFLG 02072000 ICTLPROC EQU ICTLIFLG 02073000 ICTLALIS EQU ICTLIFLG 02074000 @NM00016 EQU ICTLIFLG 02075000 ICTINCLD EQU ICTLIFLG 02076000 ICTTIND2 EQU ICTTGIND 02077000 ICTTIND1 EQU ICTTGIND 02078000 @NM00015 EQU ICTLFLG2 02079000 ICTLINK EQU ICTLFLG2 02080000 ICTCOPY EQU ICTLFLG2 02081000 ICTNE EQU ICTLFLG1 02082000 ICTDC EQU ICTLFLG1 02083000 ICTREFR EQU ICTLFLG1 02084000 ICTOVLY EQU ICTLFLG1 02085000 ICTSCTR EQU ICTLFLG1 02086000 ICTREUS EQU ICTLFLG1 02087000 ICTRENT EQU ICTLFLG1 02088000 @NM00014 EQU ICTLFLG1 02089000 ICTLEND EQU ICTLMNAM 02090000 ICTIXM EQU ICTIXMF 02091000 ICTFMLIB EQU ICTMOD+13 02092000 ICTMPRMS EQU ICTMLEPR 02093000 ICTMCPL EQU ICTMIFLG 02094000 ICTCRLIB EQU ICTMIFLG 02095000 ICTMNOGO EQU ICTMIFLG 02096000 ICTMIS EQU ICTMIFLG 02097000 ICTNOM EQU ICTMIFLG 02098000 ICTMZAP EQU ICTMIFLG 02099000 ICTMMAC EQU ICTMIFLG 02100000 ICTMPROC EQU ICTMIFLG 02101000 @NM00013 EQU ICTMFLG1 02102000 ICTMALIS EQU ICTMFLG1 02103000 ICTLIBTX EQU ICTMFLG1 02104000 ICTLIBLK EQU ICTMFLG1 02105000 ICTIXP EQU ICTIXPF 02106000 ICTPLNK EQU ICTPIFLG 02107000 ICTFORCE EQU ICTPIFLG 02108000 ICTZAP EQU ICTPIFLG 02109000 ICTPMAC EQU ICTPIFLG 02110000 @NM00012 EQU ICTPIFLG 02111000 @NM00011 EQU ICTPFLG1 02112000 ICTDUMMP EQU ICTPFLG1 02113000 ICTFREC EQU ICTPFLG1 02114000 ICTACC EQU ICTPFLG1 02115000 ICTAPP EQU ICTPFLG1 02116000 ICTPNO EQU ICTPTFS+2 02117000 ICTLEN EQU ICTSPLEN+1 02118000 ICTSP EQU ICTSPLEN 02119000 IOPUSERL EQU HMASMIOP+19 02120000 IOPBLKSI EQU IOPTTR 02121000 IOPBUFAD EQU HMASMIOP+4 02122000 CCABLKSZ EQU HMASMCCA+92 02123000 CCADATE EQU HMASMCCA+85 02124000 CCASREL EQU HMASMCCA+81 02125000 @NM00003 EQU CCAFLAG3 02126000 @NM00002 EQU CCAFLAG2 02127000 CCAICSB EQU CCAFLAG2 02128000 CCACPYCP EQU CCAFLAG2 02129000 CCALSCDS EQU CCAFLAG2 02130000 CCALSLOG EQU CCAFLAG1 02131000 CCAUPDU EQU CCAFLAG1 02132000 CCAUPDJ EQU CCAFLAG1 02133000 CCARES EQU CCAFLAG1 02134000 CCAREJ EQU CCAFLAG1 02135000 CCAACCPT EQU CCAFLAG1 02136000 CCAREC EQU CCAFLAG1 02137000 @NM00001 EQU CCAOPT 02138000 CCACPOPT EQU CCAOPT 02139000 CCALKOPT EQU CCAOPT 02140000 CCABFPMX EQU HMASMCCA+74 02141000 CCABFMMX EQU HMASMCCA+72 02142000 CCAPEMAX EQU HMASMCCA+70 02143000 CCAMXERR EQU HMASMCCA+68 02144000 CCAJFPTS EQU HMASMCCA+64 02145000 CCAJFCDS EQU HMASMCCA+60 02146000 CCALKSIZ EQU HMASMCCA+56 02147000 CCAUPDTE EQU HMASMCCA+52 02148000 CCASPZAP EQU HMASMCCA+44 02149000 CCACOPY EQU HMASMCCA+40 02150000 CCAASM EQU HMASMCCA+36 02151000 CCALKED EQU HMASMCCA+32 02152000 CCABUFAD EQU HMASMCCA+4 02153000 CCAID EQU HMASMCCA 02154000 .@UNREFD ANOP END UNREFERENCED COMPONENTS 02155000 @RT00224 EQU LINKCALL 02156000 @RC00241 EQU @RC00240 02157000 @RT00306 EQU UPDATE 02158000 @RF00417 EQU @RC00326 02159000 @PB00003 EQU @EL00001 02160000 @PB00002 EQU @PB00003 02161000 @ENDDATA EQU * 02162000 END HMASMAPA 02163000 ./ ADD SSI=33620487,NAME=HMASMASI,SOURCE=1 COMPON=DN611 TITLE 'HMASMASI - SMP ASSEMBLER INTERFACE MODULE *00001000 ' 00002000 HMASMASI CSECT , 0001 00003000 @MAINENT DS 0H 0001 00004000 USING *,@15 0001 00005000 B @PROLOG 0001 00006000 DC AL1(16) 0001 00007000 DC C'HMASMASI 73.362' 0001 00008000 DROP @15 00009000 @PROLOG STM @14,@12,12(@13) 0001 00010000 BALR @12,0 0001 00011000 @PSTART DS 0H 0001 00012000 USING @PSTART,@12 0001 00013000 ST @13,@SA00001+4 0001 00014000 LA @14,@SA00001 0001 00015000 ST @14,8(,@13) 0001 00016000 LR @13,@14 0001 00017000 MVC @PC00001(4),0(@01) 0001 00018000 * */ 00019000 * 0101 00020000 * /*****************************************************************/ 00021000 * /* */ 00022000 * /* LOCATE ASSEM ENTRY IN THE CDS */ 00023000 * /* */ 00024000 * /*****************************************************************/ 00025000 * 0101 00026000 * IOPDSID=IOPCDSM; /* INDICATE CDS DATA SET */ 00027000 L @14,IOPPTR 0101 00028000 MVI IOPDSID(@14),X'02' 0101 00029000 * IOPFUNCT=IOPLOC; /* LOCATE OPERATION */ 00030000 MVI IOPFUNCT(@14),X'03' 0102 00031000 * IOPNAME=ASMNAME; /* PUT ASSEM NAME IN THE IOP */ 00032000 L @10,@PC00001 0103 00033000 MVC IOPNAME(8,@14),ASMNAME(@10) 0103 00034000 * IOPCDTYP=IOPCASM; /* INDICATE ASSEM TYPE */ 00035000 NI IOPCDTYP(@14),B'00111111' 0104 00036000 * CALL HMASMIO(HMASMIOP); /* LOCATE ASSEM IN CDS */ 00037000 ST @14,@AL00001 0105 00038000 L @15,@CV00864 0105 00039000 LA @01,@AL00001 0105 00040000 BALR @14,@15 0105 00041000 * IF IOPRETRN=NOTFOUND /* IS MEMBER NOT THERE? */ 00042000 * THEN /* YES - ABSENT FROM CDS */ 00043000 L @14,IOPPTR 0106 00044000 CLI IOPRETRN(@14),4 0106 00045000 BNE @RF00106 0106 00046000 * RETURN CODE(GOOD); /* DON'T DO ANYTHING */ 00047000 SLR @15,@15 0107 00048000 L @13,4(,@13) 0107 00049000 L @14,12(,@13) 0107 00050000 LM @00,@12,20(@13) 0107 00051000 BR @14 0107 00052000 * IF IOPRETRN>NOTFOUND /* I/O ERROR? */ 00053000 * THEN /* YES - FATAL RETURN */ 00054000 @RF00106 L @14,IOPPTR 0108 00055000 CLI IOPRETRN(@14),4 0108 00056000 BNH @RF00108 0108 00057000 * RETURN CODE(ASMFATAL); /* GIVE CALLER FATAL RTN */ 00058000 LA @15,16 0109 00059000 L @13,4(,@13) 0109 00060000 L @14,12(,@13) 0109 00061000 LM @00,@12,20(@13) 0109 00062000 BR @14 0109 00063000 * JFCBPTR=ADDR(JFCBAREA); /* INITIALIZE PTR TO JFCB */ 00064000 @RF00108 LA @14,JFCBAREA 0110 00065000 ST @14,@TF00001 0110 00066000 MVC JFCBPTR(3),@TF00001+1 0110 00067000 * MGPVARPT(1)=ADDR(SMPPTS); /* INITIALIZE PTR TO SMPPTS */ 00068000 LA @14,SMPPTS 0111 00069000 ST @14,MGPVARPT 0111 00070000 * MGPVARPT(2)=ADDR(RETURNCD); /* INITIALIZE PTR TO RET CODE */ 00071000 LA @14,RETURNCD 0112 00072000 ST @14,MGPVARPT+4 0112 00073000 * CCAJFCBP=CCAJFPTS; /* GET ADDRESS OF SMPPTS JFCB */ 00074000 L CCAJFCBP,CCAJFPTS(,CCAPTR) 0113 00075000 * DCBPTR=ADDR(PTSDCB); /* INITIALIZE DCB PTR TO SMPPTS */ 00076000 LA DCBPTR,PTSDCB 0114 00077000 * IOPFUNCT=IOPCLOSE; /* INDICATE CLOSE OPERATION */ 00078000 L @14,IOPPTR 0115 00079000 MVI IOPFUNCT(@14),X'04' 0115 00080000 * IOPDSID=IOPPTS; /* INDICATE PTS */ 00081000 MVI IOPDSID(@14),X'06' 0116 00082000 * CALL HMASMIO(HMASMIOP); /* CLOSE THE PTS DATA SET */ 00083000 ST @14,@AL00001 0117 00084000 L @15,@CV00864 0117 00085000 LA @01,@AL00001 0117 00086000 BALR @14,@15 0117 00087000 *ALTJFCB: /* ALTER JFCB */ 00088000 * JFCBAREA=CCAJFCB; /* MOVE JFCB */ 00089000 ALTJFCB MVC JFCBAREA(176),CCAJFCB(CCAJFCBP) 0118 00090000 * JFCBELNM=ASMNAME; /* MOVE ASSEM NAME TO JFCB */ 00091000 MVC @ZT00001+1(3),JFCBPTR 0119 00092000 L @14,@ZT00001 0119 00093000 L @10,@PC00001 0119 00094000 MVC JFCBELNM(8,@14),ASMNAME(@10) 0119 00095000 * JFCBOPSW=ON; /* REWRITE THE JFCB DURING OPEN */ 00096000 OI JFCBOPSW(@14),B'10000000' 0120 00097000 * JFCPDS=ON; /* INDICATE MEMBER OF PDS */ 00098000 OI JFCPDS(@14),B'00000001' 0121 00099000 * IF DCBPTR=ADDR(CDSDCB) /* WORKING WITH THE CDS NOW ?? */ 00100000 * THEN 0122 00101000 LA @10,CDSDCB 0122 00102000 CR DCBPTR,@10 0122 00103000 BNE @RF00122 0122 00104000 * NAMETYPE=IOPCASM; /* YES - MODIFY THE NAME */ 00105000 NI NAMETYPE(@14),B'00111111' 0123 00106000 * CALL OPENRTN; /* OPEN AND CLOSE FILE */ 00107000 @RF00122 BAL @14,OPENRTN 0124 00108000 * IF DCBPTR=ADDR(CDSDCB) THEN /* CHECK IF SMPCDS */ 00109000 LA @14,CDSDCB 0125 00110000 CR DCBPTR,@14 0125 00111000 BE @RT00125 0125 00112000 * GO TO ASSMLINK; /* LINK TO THE ASSEMBLER */ 00113000 * MGPVARPT(1)=ADDR(SMPCDS); /* POINT TO SMPCDS FOR MSG */ 00114000 LA @14,SMPCDS 0127 00115000 ST @14,MGPVARPT 0127 00116000 * DCBPTR=ADDR(CDSDCB); /* INITIALIZE PTR TO SMPCDS DCB */ 00117000 LA DCBPTR,CDSDCB 0128 00118000 * CCAJFCBP=CCAJFCDS; /* GET ADDRESS OF SMPCDS JFCB */ 00119000 L CCAJFCBP,CCAJFCDS(,CCAPTR) 0129 00120000 * GO TO ALTJFCB; /* ALTER JFCB */ 00121000 B ALTJFCB 0130 00122000 *ASSMLINK: /* LINK TO THE ASSEMBLER */ 00123000 * LNKREG=CCAASM; /* POINT TO ADDRESS OF ASSEMBLER */ 00124000 ASSMLINK L LNKREG,CCAASM(,CCAPTR) 0131 00125000 * GEN; 0132 00126000 LINK DE=(LNKREG),PARAM=(OPLIST,DDLIST),VL=1 LINK TO ASSEM 00127000 * RCODE=RTNCODE; /* SAVE RETURN CODE */ 00128000 ST RTNCODE,RCODE 0133 00129000 * CVD(RTNCODE,DECNO); /* CONVERT RETURN CODE TO DECIMAL*/ 00130000 CVD RTNCODE,DECNO 0134 00131000 * UNPK(RETURNCD(1:2),DECNO(7:8)); /* UNPACK NUMBER */ 00132000 UNPK RETURNCD(2),DECNO+6(2) 0135 00133000 * RETURNCD(2)=RETURNCD(2)³ZONE; /* OR IN ZONE */ 00134000 OI RETURNCD+1,C'0' 0136 00135000 * MSGMAP=MSG40; /* INITIALIZE MSG PARAMETER LIST */ 00136000 MVC MSGMAP(4),MSG40 0137 00137000 * MGPVARPT(1)=ADDR(ASMNAME); /* POINT TO MODULE NAME */ 00138000 L @14,@PC00001 0138 00139000 ST @14,MGPVARPT 0138 00140000 * CALL HMASMMSG(HMASMMGP); /* CALL MSG MODULE TO PRINT MSG */ 00141000 L @15,@CV00863 0139 00142000 LA @01,@AL00139 0139 00143000 BALR @14,@15 0139 00144000 * JFCBPTR=CCAJFPTS; /* RESTORE SMPPTS JFCB */ 00145000 L @14,CCAJFPTS(,CCAPTR) 0140 00146000 ST @14,@TF00001 0140 00147000 MVC JFCBPTR(3),@TF00001+1 0140 00148000 * JFCBOPSW=ON; /* INDICATE REWRITE JFCB */ 00149000 OI JFCBOPSW(@14),B'10000000' 0141 00150000 * DCBPTR=ADDR(PTSDCB); /* RESTORE SMPPTS DCB */ 00151000 LA DCBPTR,PTSDCB 0142 00152000 * CALL OPENRTN; /* OPEN AND CLOSE SMPPTS */ 00153000 BAL @14,OPENRTN 0143 00154000 * JFCBPTR=CCAJFCDS; /* RESTORE SMPCDS JFCB */ 00155000 L @14,CCAJFCDS(,CCAPTR) 0144 00156000 ST @14,@TF00001 0144 00157000 MVC JFCBPTR(3),@TF00001+1 0144 00158000 * JFCBOPSW=ON; /* INDICATE REWRITE JFCB */ 00159000 OI JFCBOPSW(@14),B'10000000' 0145 00160000 * DCBPTR=ADDR(CDSDCB); /* RESTORE SMPCDS DCB */ 00161000 LA DCBPTR,CDSDCB 0146 00162000 * CALL OPENRTN; /* OPEN AND CLOSE SMPCDS */ 00163000 BAL @14,OPENRTN 0147 00164000 * RETURN CODE(RCODE); 0148 00165000 L @15,RCODE 0148 00166000 L @13,4(,@13) 0148 00167000 L @14,12(,@13) 0148 00168000 LM @00,@12,20(@13) 0148 00169000 BR @14 0148 00170000 *OPENRTN: 0149 00171000 * PROCEDURE; /* OPEN SUBROUTINE TO OPEN THE 0149 00172000 * CDS AND PTS */ 00173000 @EL00001 L @13,4(,@13) 0149 00174000 @EF00001 DS 0H 0149 00175000 @ER00001 LM @14,@12,12(@13) 0149 00176000 BR @14 0149 00177000 @PB00001 DS 0H 0149 00178000 OPENRTN STM @14,@12,@SA00002 0149 00179000 * IF DCBPTR=ADDR(CDSDCB) /* IS IT THE CDS ? */ 00180000 * THEN 0150 00181000 LA @14,CDSDCB 0150 00182000 CR DCBPTR,@14 0150 00183000 BNE @RF00150 0150 00184000 * GEN(OPEN ((DCBPTR),INPUT),TYPE=J);/* OPEN FOR INPUT */ 00185000 OPEN ((DCBPTR),INPUT),TYPE=J 00186000 * ELSE 0152 00187000 * GEN(OPEN ((DCBPTR),OUTPUT),TYPE=J);/* OPEN PTS OUTPUT */ 00188000 B @RC00150 0152 00189000 @RF00150 DS 0H 0152 00190000 OPEN ((DCBPTR),OUTPUT),TYPE=J 00191000 * IF DCBOFOPN=ON /* DID IT OPEN ? */ 00192000 * THEN 0153 00193000 @RC00150 TM DCBOFOPN+40(DCBPTR),B'00010000' 0153 00194000 BNO @RF00153 0153 00195000 * GEN(CLOSE ((DCBPTR))); 0154 00196000 CLOSE ((DCBPTR)) 00197000 * ELSE 0155 00198000 * DO; 0155 00199000 B @RC00153 0155 00200000 @RF00153 DS 0H 0156 00201000 * MSGMAP=MSG01; 0156 00202000 MVC MSGMAP(4),MSG01 0156 00203000 * CALL HMASMMSG(HMASMMGP); /* ISSUE THE MESSAGE */ 00204000 L @15,@CV00863 0157 00205000 LA @01,@AL00157 0157 00206000 BALR @14,@15 0157 00207000 * END; 0158 00208000 * END OPENRTN; 0159 00209000 @EL00002 DS 0H 0159 00210000 @EF00002 DS 0H 0159 00211000 @ER00002 LM @14,@12,@SA00002 0159 00212000 BR @14 0159 00213000 * END HMASMASI 0160 00214000 * 0160 00215000 */* THE FOLLOWING INCLUDE STATEMENTS WERE FOUND IN THIS PROGRAM. */ 00216000 */*%INCLUDE SYSLIB (IHADCBDF) */ 00217000 */*%INCLUDE SYSLIB (IHADCB ) */ 00218000 */*%INCLUDE SYSLIB (IEFJFCBN) */ 00219000 */*%INCLUDE SYSLIB (HMASMCCA) */ 00220000 */*%INCLUDE SYSLIB (HMASMIOP) */ 00221000 */*%INCLUDE SYSLIB (HMASMMGP) */ 00222000 * 0160 00223000 * ; 0160 00224000 @DATA DS 0H 00225000 DS 0F 00226000 @AL00139 EQU * LIST WITH 1 ARGUMENT(S) 00227000 @AL00157 DC A(HMASMMGP) LIST WITH 1 ARGUMENT(S) 00228000 DS 0F 00229000 @SA00001 DS 18F 00230000 @PC00001 DS 1F 00231000 @SA00002 DS 15F 00232000 @AL00001 DS 1A 00233000 @TF00001 DS F 00234000 @ZTEMPS DS 0F 00235000 @ZT00001 DC F'0' 00236000 @ZTEMPND EQU * 00237000 @ZLEN EQU @ZTEMPND-@ZTEMPS 00238000 DS 0F 00239000 @CV00863 DC V(HMASMMSG) 00240000 @CV00864 DC V(HMASMIO) 00241000 DS 0D 00242000 IOPPTR DC AL4(CLOSIOP) 00243000 RCODE DS F 00244000 HMASMMGP DS CL12 00245000 ORG HMASMMGP 00246000 MGPMGNO1 DS FL1 00247000 MGPMGNO2 DS FL1 00248000 MGPMGNO3 DS FL1 00249000 MGPFLAGS DS BL1 00250000 ORG MGPFLAGS 00251000 MGPPRINT DS BL1 00252000 MGPHLDS EQU MGPFLAGS+0 00253000 @NM00062 EQU MGPFLAGS+0 00254000 ORG HMASMMGP+4 00255000 MGPVARPT DS 2A 00256000 ORG HMASMMGP+12 00257000 MSG01 DS CL4 00258000 ORG MSG01 00259000 @NM00063 DC AL1(2) 00260000 @NM00064 DC AL1(0) 00261000 @NM00065 DC AL1(0) 00262000 @NM00066 DC X'80' 00263000 ORG MSG01+4 00264000 MSG40 DS CL4 00265000 ORG MSG40 00266000 @NM00067 DC AL1(41) 00267000 @NM00068 DC AL1(12) 00268000 @NM00069 DC AL1(9) 00269000 @NM00070 DC X'80' 00270000 ORG MSG40+4 00271000 OPLIST DS CL18 00272000 ORG OPLIST 00273000 OPTLNG DC H'16' 00274000 AOPTIONS DC CL16'XREF,LOAD,NODECK' 00275000 ORG OPLIST+18 00276000 DDLIST DS CL90 00277000 ORG DDLIST 00278000 DDLNG DC H'88' 00279000 DDNAMES DS CL88 00280000 ORG DDNAMES 00281000 @NM00073 DC X'0000000000000000' 00282000 @NM00074 DC X'0000000000000000' 00283000 @NM00075 DC X'0000000000000000' 00284000 SYSLIB DC CL8'SYSLIB ' 00285000 SMPCDS DC CL8'SMPCDS ' 00286000 SYSPRINT DC CL8'SYSPRINT' 00287000 SYSPUNCH DC X'0000000000000000' 00288000 @NM00076 DC X'0000000000000000' 00289000 @NM00077 DC X'0000000000000000' 00290000 @NM00078 DC X'0000000000000000' 00291000 SMPPTS DC CL8'SMPPTS ' 00292000 ORG DDLIST+90 00293000 DECNO DS CL8 00294000 RETURNCD DS CL2 00295000 JFCBAREA DS CL176 00296000 DS CL2 00297000 EXLIST DS CL4 00298000 ORG EXLIST 00299000 @NM00079 DC X'87' 00300000 JFCBPTR DC AL3(JFCBAREA) 00301000 ORG EXLIST+4 00302000 CLOSIOP DS CL20 00303000 PATCH DC 50X'FF' 00304000 HMASMASI CSECT 00305000 PTSDCB DCB DEVD=DA,MACRF=W,DSORG=PO,DDNAME=SMPPTS,EXLST=EXLIST 00306000 CDSDCB DCB DEVD=DA,MACRF=R,DSORG=PO,DDNAME=SMPCDS,EXLST=EXLIST 00307000 HMASMASI CSECT 00308000 @00 EQU 00 EQUATES FOR REGISTERS 0-15 00309000 @01 EQU 01 00310000 @02 EQU 02 00311000 @03 EQU 03 00312000 @04 EQU 04 00313000 @05 EQU 05 00314000 @06 EQU 06 00315000 @07 EQU 07 00316000 @08 EQU 08 00317000 @09 EQU 09 00318000 @10 EQU 10 00319000 @11 EQU 11 00320000 @12 EQU 12 00321000 @13 EQU 13 00322000 @14 EQU 14 00323000 @15 EQU 15 00324000 CCAJFCBP EQU @04 00325000 DCBPTR EQU @02 00326000 CCAPTR EQU @11 00327000 LNKREG EQU @03 00328000 RTNCODE EQU @15 00329000 IHADCB EQU 0 00330000 IHADCS00 EQU 0 00331000 DCBFDAD EQU IHADCS00+5 00332000 IHADCS01 EQU 0 00333000 DCBDVTBL EQU IHADCS01 00334000 IHADCS11 EQU 0 00335000 DCBRELB EQU IHADCS11 00336000 DCBREL EQU DCBRELB+1 00337000 DCBBUFCB EQU IHADCS11+4 00338000 DCBDSORG EQU IHADCS11+10 00339000 DCBDSRG1 EQU DCBDSORG 00340000 DCBDSRG2 EQU DCBDSORG+1 00341000 DCBIOBAD EQU IHADCS11+12 00342000 DCBODEB EQU DCBIOBAD 00343000 DCBLNP EQU DCBODEB 00344000 DCBQSLM EQU DCBLNP 00345000 DCBIOBAA EQU DCBODEB+1 00346000 IHADCS50 EQU 0 00347000 DCBSVCXL EQU IHADCS50 00348000 DCBEODAD EQU IHADCS50+4 00349000 DCBBFALN EQU DCBEODAD 00350000 DCBHIARC EQU DCBBFALN 00351000 DCBBFTEK EQU DCBHIARC 00352000 DCBBFT EQU DCBBFTEK 00353000 DCBEXLST EQU IHADCS50+8 00354000 DCBRECFM EQU DCBEXLST 00355000 DCBRECLA EQU DCBRECFM 00356000 IHADCS24 EQU 0 00357000 DCBOFLGS EQU IHADCS24+8 00358000 DCBOFLWR EQU DCBOFLGS 00359000 DCBOFOPN EQU DCBOFLGS 00360000 DCBIFLG EQU IHADCS24+9 00361000 DCBMACR EQU IHADCS24+10 00362000 DCBMACR1 EQU DCBMACR 00363000 DCBMRFE EQU DCBMACR1 00364000 DCBMRGET EQU DCBMRFE 00365000 DCBMRAPG EQU DCBMACR1 00366000 DCBMRRD EQU DCBMRAPG 00367000 DCBMRCI EQU DCBMACR1 00368000 DCBMRMVG EQU DCBMRCI 00369000 DCBMRLCG EQU DCBMACR1 00370000 DCBMRABC EQU DCBMACR1 00371000 DCBMRPT1 EQU DCBMRABC 00372000 DCBMRSBG EQU DCBMRPT1 00373000 DCBMRCRL EQU DCBMACR1 00374000 DCBMRCHK EQU DCBMRCRL 00375000 DCBMRRDX EQU DCBMRCHK 00376000 DCBMRDMG EQU DCBMACR1 00377000 DCBMACR2 EQU DCBMACR+1 00378000 DCBMRPUT EQU DCBMACR2 00379000 DCBMRWRT EQU DCBMACR2 00380000 DCBMRMVP EQU DCBMACR2 00381000 DCBMR5WD EQU DCBMACR2 00382000 DCBMRLDM EQU DCBMR5WD 00383000 DCBMRLCP EQU DCBMRLDM 00384000 DCBMR4WD EQU DCBMACR2 00385000 DCBMRPT2 EQU DCBMR4WD 00386000 DCBMRTMD EQU DCBMRPT2 00387000 DCBMR3WD EQU DCBMACR2 00388000 DCBMRCTL EQU DCBMR3WD 00389000 DCBMRSTK EQU DCBMRCTL 00390000 DCBMR1WD EQU DCBMACR2 00391000 DCBMRSWA EQU DCBMR1WD 00392000 DCBMRDMD EQU DCBMRSWA 00393000 IHADCS25 EQU 0 00394000 DCBMACRF EQU IHADCS25+2 00395000 DCBMACF1 EQU DCBMACRF 00396000 DCBMFFE EQU DCBMACF1 00397000 DCBMFGET EQU DCBMFFE 00398000 DCBMFAPG EQU DCBMACF1 00399000 DCBMFRD EQU DCBMFAPG 00400000 DCBMFCI EQU DCBMACF1 00401000 DCBMFMVG EQU DCBMFCI 00402000 DCBMFLCG EQU DCBMACF1 00403000 DCBMFABC EQU DCBMACF1 00404000 DCBMFPT1 EQU DCBMFABC 00405000 DCBMFSBG EQU DCBMFPT1 00406000 DCBMFCRL EQU DCBMACF1 00407000 DCBMFCHK EQU DCBMFCRL 00408000 DCBMFDMG EQU DCBMACF1 00409000 DCBMACF2 EQU DCBMACRF+1 00410000 DCBMFPUT EQU DCBMACF2 00411000 DCBMFWRT EQU DCBMACF2 00412000 DCBMFMVP EQU DCBMACF2 00413000 DCBMF5WD EQU DCBMACF2 00414000 DCBMFLDM EQU DCBMF5WD 00415000 DCBMFLCP EQU DCBMFLDM 00416000 DCBMF4WD EQU DCBMACF2 00417000 DCBMFPT2 EQU DCBMF4WD 00418000 DCBMFTMD EQU DCBMFPT2 00419000 DCBMF3WD EQU DCBMACF2 00420000 DCBMFCTL EQU DCBMF3WD 00421000 DCBMFSTK EQU DCBMFCTL 00422000 DCBMF1WD EQU DCBMACF2 00423000 DCBMFSWA EQU DCBMF1WD 00424000 DCBMFDMD EQU DCBMFSWA 00425000 DCBDEBAD EQU IHADCS25+4 00426000 DCBIFLGS EQU DCBDEBAD 00427000 IHADCS26 EQU 0 00428000 DCBWRITE EQU IHADCS26 00429000 IHADCS27 EQU 0 00430000 DCBGET EQU IHADCS27 00431000 IHADCS36 EQU 0 00432000 DCBGERR EQU IHADCS36 00433000 DCBPERR EQU DCBGERR 00434000 DCBCHECK EQU DCBPERR 00435000 DCBOPTCD EQU DCBCHECK 00436000 DCBOPTH EQU DCBOPTCD 00437000 DCBOPTO EQU DCBOPTH 00438000 DCBOPTZ EQU DCBOPTCD 00439000 DCBGERRA EQU DCBCHECK+1 00440000 DCBPERRA EQU DCBGERRA 00441000 DCBSYNAD EQU IHADCS36+4 00442000 DCBCIND1 EQU IHADCS36+8 00443000 DCBCIND2 EQU IHADCS36+9 00444000 DCBCICB EQU IHADCS36+20 00445000 IHADCS52 EQU 0 00446000 DCBDIRCT EQU IHADCS52 00447000 DCBQSWS EQU DCBDIRCT 00448000 DCBUSASI EQU DCBQSWS 00449000 DCBQADFS EQU DCBUSASI 00450000 DCBBUFOF EQU DCBDIRCT+1 00451000 IHADCS38 EQU 0 00452000 DCBEOBR EQU IHADCS38 00453000 DCBPOINT EQU IHADCS38+12 00454000 DCBCNTRL EQU DCBPOINT 00455000 IHADCS40 EQU 0 00456000 DCBEOBAD EQU IHADCS40 00457000 DCBCCCW EQU IHADCS40+4 00458000 DCBRECAD EQU DCBCCCW 00459000 DCBRECBT EQU DCBRECAD 00460000 DCBRCREL EQU DCBRECBT 00461000 @NM00022 EQU IHADCS40+12 00462000 DCBEROPT EQU @NM00022 00463000 INFMJFCB EQU 0 00464000 JFCBDSNM EQU INFMJFCB 00465000 JFCBELNM EQU INFMJFCB+44 00466000 JFCBTSDM EQU INFMJFCB+52 00467000 JFCBSYSC EQU INFMJFCB+53 00468000 JFCBLTYP EQU INFMJFCB+66 00469000 JFCBOTTR EQU INFMJFCB+67 00470000 JFCBUFOF EQU JFCBOTTR 00471000 JFCBFLSQ EQU JFCBOTTR+1 00472000 JFCFUNC EQU JFCBFLSQ 00473000 JFCBMASK EQU INFMJFCB+72 00474000 JFCBOPS1 EQU JFCBMASK 00475000 JFCBFLG1 EQU JFCBMASK+5 00476000 JFCBFLG2 EQU JFCBMASK+6 00477000 JFCBIND1 EQU INFMJFCB+86 00478000 JFCPDS EQU JFCBIND1 00479000 JFCBIND2 EQU INFMJFCB+87 00480000 JFCBUFNO EQU INFMJFCB+88 00481000 JFCBUFIN EQU JFCBUFNO 00482000 JFCBFOUT EQU JFCBUFIN 00483000 JFCBHIAR EQU INFMJFCB+89 00484000 JFCBFALN EQU JFCBHIAR 00485000 JFCBFTEK EQU JFCBFALN 00486000 JFCEROPT EQU INFMJFCB+92 00487000 JFCTRTCH EQU INFMJFCB+93 00488000 JFCKEYLE EQU 0 00489000 JFCCODE EQU JFCKEYLE 00490000 JFCSTACK EQU 0 00491000 JFCMODE EQU JFCSTACK 00492000 JFCSPPRT EQU 0 00493000 JFCLIMCT EQU JFCSPPRT+2 00494000 JFCDSORG EQU JFCSPPRT+5 00495000 JFCDSRG1 EQU JFCDSORG 00496000 JFCDSRG2 EQU JFCDSORG+1 00497000 JFCRECFM EQU JFCSPPRT+7 00498000 JFCFMRC EQU JFCRECFM 00499000 JFCOPTCD EQU JFCSPPRT+8 00500000 JFCWVCSP EQU JFCOPTCD 00501000 JFCWVCIS EQU JFCWVCSP 00502000 JFCWVCBD EQU JFCWVCIS 00503000 JFCALLOW EQU JFCOPTCD 00504000 @NM00038 EQU JFCALLOW 00505000 JFCOVER EQU @NM00038 00506000 JFCPCIBT EQU JFCOPTCD 00507000 JFCMAST EQU JFCPCIBT 00508000 JFCEXT EQU JFCMAST 00509000 JFCBCKPT EQU JFCOPTCD 00510000 JFCIND EQU JFCBCKPT 00511000 @NM00039 EQU JFCOPTCD 00512000 JFCCYL EQU @NM00039 00513000 JFCACT EQU JFCCYL 00514000 JFCREDUC EQU JFCOPTCD 00515000 @NM00040 EQU JFCREDUC 00516000 @NM00041 EQU @NM00040 00517000 @NM00042 EQU JFCOPTCD 00518000 JFCDEL EQU @NM00042 00519000 @NM00044 EQU JFCOPTCD 00520000 JFCREORG EQU @NM00044 00521000 JFCBLKSI EQU JFCSPPRT+9 00522000 JFCNCP EQU JFCSPPRT+13 00523000 JFCNTM EQU JFCSPPRT+14 00524000 JFCPCI EQU JFCNTM 00525000 JFCRKP EQU JFCSPPRT+15 00526000 JFCUCSEG EQU 0 00527000 JFCUCSOP EQU JFCUCSEG+4 00528000 JFCOUTLI EQU JFCUCSEG+5 00529000 JFCTHRSH EQU JFCOUTLI 00530000 JFCCPRI EQU JFCTHRSH 00531000 JFCBCTRI EQU JFCUCSEG+47 00532000 HMASMCCA EQU 0 00533000 CCAASM EQU HMASMCCA+36 00534000 CCAJFCDS EQU HMASMCCA+60 00535000 CCAJFPTS EQU HMASMCCA+64 00536000 CCAOPT EQU HMASMCCA+76 00537000 CCAFLAG1 EQU HMASMCCA+77 00538000 CCAFLAG2 EQU HMASMCCA+78 00539000 CCAFLAG3 EQU HMASMCCA+79 00540000 HMASMIOP EQU 0 00541000 IOPDSID EQU HMASMIOP 00542000 IOPFUNCT EQU HMASMIOP+1 00543000 IOPRETRN EQU HMASMIOP+2 00544000 IOPNAME EQU HMASMIOP+8 00545000 IOPTYPE EQU IOPNAME 00546000 IOPCDTYP EQU IOPTYPE 00547000 IOPTTR EQU HMASMIOP+16 00548000 IOPUDATA EQU HMASMIOP+20 00549000 CCAJFCB EQU 0 00550000 ASMNAME EQU 0 00551000 IOPMOCDS EQU IOPUDATA 00552000 IOPLMCDS EQU IOPUDATA 00553000 IOPFLGS2 EQU IOPLMCDS 00554000 IOPFLGS3 EQU IOPLMCDS+1 00555000 IOPMACDS EQU IOPUDATA 00556000 IOPPTCDS EQU IOPUDATA 00557000 IOPFLGS5 EQU IOPPTCDS 00558000 IOPSTAT EQU IOPFLGS5 00559000 IOPPNTRY EQU IOPPTCDS+4 00560000 IOPDLCDS EQU IOPUDATA 00561000 IOPSYCDS EQU IOPUDATA 00562000 IOPFLGS7 EQU IOPSYCDS 00563000 IOPSTCMP EQU IOPUDATA 00564000 IOPPTSNT EQU IOPUDATA 00565000 IOPPFLG1 EQU IOPPTSNT 00566000 IOPPLEPR EQU IOPPTSNT+1 00567000 IOPPNUM EQU IOPPTSNT+2 00568000 @NM00071 EQU JFCBOPS1+4 00569000 @NM00072 EQU @NM00071 00570000 JFCBOPSW EQU @NM00072 00571000 MSGMAP EQU MGPMGNO1 00572000 @NM00080 EQU JFCBELNM 00573000 @NM00081 EQU @NM00080 00574000 NAMETYPE EQU @NM00081 00575000 AGO .@UNREFD START UNREFERENCED COMPONENTS 00576000 IOPALISL EQU IOPPTSNT+22 00577000 IOPINDLB EQU IOPPTSNT+14 00578000 IOPDISTN EQU IOPPTSNT+7 00579000 IOPPDIG EQU IOPPNUM+2 00580000 IOPPID EQU IOPPNUM 00581000 IOPPNE EQU IOPPLEPR 00582000 IOPPDC EQU IOPPLEPR 00583000 IOPPREFR EQU IOPPLEPR 00584000 IOPPOVLY EQU IOPPLEPR 00585000 IOPPSCTR EQU IOPPLEPR 00586000 IOPPREUS EQU IOPPLEPR 00587000 IOPPRENT EQU IOPPLEPR 00588000 @NM00061 EQU IOPPLEPR 00589000 @NM00060 EQU IOPPFLG1 00590000 IOPLEFND EQU IOPPFLG1 00591000 IOPDALIS EQU IOPPFLG1 00592000 IOPTALIS EQU IOPPFLG1 00593000 IOPLIBTX EQU IOPPFLG1 00594000 IOPLIBLK EQU IOPPFLG1 00595000 IOPSTNEW EQU IOPSTCMP+8 00596000 IOPSTOLD EQU IOPSTCMP 00597000 IOPPDLM EQU IOPSYCDS+8 00598000 IOPPEMAX EQU IOPSYCDS+6 00599000 IOPNUCID EQU IOPSYCDS+5 00600000 IOPSREL EQU IOPSYCDS+1 00601000 @NM00059 EQU IOPFLGS7 00602000 IOPTSO EQU IOPFLGS7 00603000 IOPDSYS EQU IOPDLCDS 00604000 IOPPIND EQU IOPPNTRY+8 00605000 IOPPMODS EQU IOPPNTRY 00606000 IOPDATE EQU IOPPTCDS+1 00607000 @NM00058 EQU IOPFLGS5 00608000 IOPDUMMP EQU IOPSTAT 00609000 IOPFORCE EQU IOPSTAT 00610000 IOPACC EQU IOPSTAT 00611000 IOPAPP EQU IOPSTAT 00612000 IOPASMOD EQU IOPMACDS+2 00613000 @NM00057 EQU IOPMACDS 00614000 IOPSYSLB EQU IOPLMCDS+2 00615000 @NM00056 EQU IOPFLGS3 00616000 IOPCHREP EQU IOPFLGS3 00617000 IOPLINK EQU IOPFLGS3 00618000 IOPCOPY EQU IOPFLGS3 00619000 IOPNE EQU IOPFLGS2 00620000 IOPDC EQU IOPFLGS2 00621000 IOPREFR EQU IOPFLGS2 00622000 IOPOVLY EQU IOPFLGS2 00623000 IOPSCTR EQU IOPFLGS2 00624000 IOPREUS EQU IOPFLGS2 00625000 IOPRENT EQU IOPFLGS2 00626000 @NM00055 EQU IOPFLGS2 00627000 IOPLMODS EQU IOPMOCDS+9 00628000 IOPDLIB EQU IOPMOCDS+2 00629000 IOPMODID EQU IOPMOCDS 00630000 IOPUSERL EQU HMASMIOP+19 00631000 IOPBLKSI EQU IOPTTR 00632000 IOPNAME2 EQU IOPNAME+1 00633000 IOPBUFAD EQU HMASMIOP+4 00634000 IOPMACID EQU HMASMIOP+3 00635000 CCABLKSZ EQU HMASMCCA+92 00636000 CCASPDCB EQU HMASMCCA+88 00637000 CCADATE EQU HMASMCCA+85 00638000 CCASREL EQU HMASMCCA+81 00639000 CCANUCID EQU HMASMCCA+80 00640000 @NM00054 EQU CCAFLAG3 00641000 CCACOPYP EQU CCAFLAG3 00642000 CCALINKP EQU CCAFLAG3 00643000 CCAZAPP EQU CCAFLAG3 00644000 @NM00053 EQU CCAFLAG2 00645000 CCAICSB EQU CCAFLAG2 00646000 CCATERM EQU CCAFLAG2 00647000 CCASVCLB EQU CCAFLAG2 00648000 CCATSO EQU CCAFLAG2 00649000 CCACPYCP EQU CCAFLAG2 00650000 CCANCPTF EQU CCAFLAG2 00651000 CCALSCDS EQU CCAFLAG2 00652000 CCALSLOG EQU CCAFLAG1 00653000 CCAUPDU EQU CCAFLAG1 00654000 CCAUPDJ EQU CCAFLAG1 00655000 CCARES EQU CCAFLAG1 00656000 CCAREJ EQU CCAFLAG1 00657000 CCAACCPT EQU CCAFLAG1 00658000 CCAAPPLY EQU CCAFLAG1 00659000 CCAREC EQU CCAFLAG1 00660000 @NM00052 EQU CCAOPT 00661000 CCACPOPT EQU CCAOPT 00662000 CCALKOPT EQU CCAOPT 00663000 CCABFPMX EQU HMASMCCA+74 00664000 CCABFMMX EQU HMASMCCA+72 00665000 CCAPEMAX EQU HMASMCCA+70 00666000 CCAMXERR EQU HMASMCCA+68 00667000 CCALKSIZ EQU HMASMCCA+56 00668000 CCAUPDTE EQU HMASMCCA+52 00669000 CCAIOSUP EQU HMASMCCA+48 00670000 CCASPZAP EQU HMASMCCA+44 00671000 CCACOPY EQU HMASMCCA+40 00672000 CCALKED EQU HMASMCCA+32 00673000 CCAPESIZ EQU HMASMCCA+28 00674000 CCAICLMD EQU HMASMCCA+24 00675000 CCAICMOD EQU HMASMCCA+20 00676000 CCAICPTF EQU HMASMCCA+16 00677000 CCAICT EQU HMASMCCA+12 00678000 CCAIOPTR EQU HMASMCCA+8 00679000 CCABUFAD EQU HMASMCCA+4 00680000 CCAID EQU HMASMCCA 00681000 JFCBEND EQU JFCUCSEG+68 00682000 JFCBSPTN EQU JFCUCSEG+67 00683000 JFCBVLCT EQU JFCUCSEG+66 00684000 JFCBDRLH EQU JFCUCSEG+63 00685000 JFCBSBNM EQU JFCUCSEG+60 00686000 JFCBABST EQU JFCUCSEG+58 00687000 JFCBSPNM EQU JFCUCSEG+55 00688000 JFCBDQTY EQU JFCUCSEG+52 00689000 @NM00051 EQU JFCUCSEG+51 00690000 JFCBSQTY EQU JFCUCSEG+48 00691000 JFCROUND EQU JFCBCTRI 00692000 JFCALX EQU JFCBCTRI 00693000 JFCMIXG EQU JFCBCTRI 00694000 JFCONTIG EQU JFCBCTRI 00695000 @NM00050 EQU JFCBCTRI 00696000 @NM00049 EQU JFCBCTRI 00697000 JFCBSPAC EQU JFCBCTRI 00698000 JFCBPQTY EQU JFCUCSEG+44 00699000 JFCBEXAD EQU JFCUCSEG+41 00700000 JFCBEXTL EQU JFCUCSEG+40 00701000 JFCBVOLS EQU JFCUCSEG+10 00702000 JFCBNVOL EQU JFCUCSEG+9 00703000 JFCBNTCS EQU JFCUCSEG+8 00704000 JFCSOWA EQU JFCUCSEG+6 00705000 @NM00048 EQU JFCCPRI 00706000 JFCRECV EQU JFCCPRI 00707000 JFCEQUAL EQU JFCCPRI 00708000 JFCSEND EQU JFCCPRI 00709000 @NM00047 EQU JFCUCSOP 00710000 JFCFCBVR EQU JFCUCSOP 00711000 JFCFCBAL EQU JFCUCSOP 00712000 JFCVER EQU JFCUCSOP 00713000 @NM00046 EQU JFCUCSOP 00714000 JFCFOLD EQU JFCUCSOP 00715000 @NM00045 EQU JFCUCSOP 00716000 JFCUCSID EQU JFCUCSEG 00717000 JFCINTVL EQU JFCSPPRT+19 00718000 JFCDBUFN EQU JFCSPPRT+18 00719000 JFCCYLOF EQU JFCSPPRT+17 00720000 JFCRESRV EQU JFCRKP 00721000 JFCPCIR2 EQU JFCPCI 00722000 JFCPCIR1 EQU JFCPCI 00723000 JFCPCIN2 EQU JFCPCI 00724000 JFCPCIN1 EQU JFCPCI 00725000 JFCPCIA2 EQU JFCPCI 00726000 JFCPCIA1 EQU JFCPCI 00727000 JFCPCIX2 EQU JFCPCI 00728000 JFCPCIX1 EQU JFCPCI 00729000 JFCBUFMX EQU JFCNCP 00730000 JFCLRECL EQU JFCSPPRT+11 00731000 JFCBUFSI EQU JFCBLKSI 00732000 JFCREL EQU JFCREORG 00733000 @NM00043 EQU JFCDEL 00734000 JFCSRCHD EQU @NM00041 00735000 JFCOPTQ EQU JFCACT 00736000 JFCFEED EQU JFCIND 00737000 JFCCBWU EQU JFCEXT 00738000 JFCWUMSG EQU JFCOVER 00739000 JFCSDNAM EQU JFCWVCBD 00740000 @NM00037 EQU JFCRECFM 00741000 JFCCHAR EQU JFCRECFM 00742000 JFCRFS EQU JFCRECFM 00743000 JFCRFB EQU JFCRECFM 00744000 JFCRFO EQU JFCFMRC 00745000 JFCFMREC EQU JFCFMRC 00746000 @NM00036 EQU JFCDSRG2 00747000 JFCORGGS EQU JFCDSRG2 00748000 JFCORGU EQU JFCDSRG1 00749000 JFCORGPO EQU JFCDSRG1 00750000 @NM00035 EQU JFCDSRG1 00751000 JFCORGDA EQU JFCDSRG1 00752000 JFCORGPS EQU JFCDSRG1 00753000 JFCORGIS EQU JFCDSRG1 00754000 JFCTRKBL EQU JFCLIMCT+1 00755000 @NM00034 EQU JFCLIMCT 00756000 JFCDEN EQU JFCSPPRT+1 00757000 JFCPRTSP EQU JFCSPPRT 00758000 JFCONE EQU JFCMODE 00759000 JFCTWO EQU JFCMODE 00760000 @NM00033 EQU JFCMODE 00761000 JFCMODER EQU JFCMODE 00762000 JFCMODEO EQU JFCMODE 00763000 JFCEBCD EQU JFCMODE 00764000 JFCBIN EQU JFCMODE 00765000 @NM00032 EQU JFCCODE 00766000 JFCTTY EQU JFCCODE 00767000 JFCASCII EQU JFCCODE 00768000 JFCNCR EQU JFCCODE 00769000 JFCBUR EQU JFCCODE 00770000 JFCFRI EQU JFCCODE 00771000 JFCBCD EQU JFCCODE 00772000 JFCNOCON EQU JFCCODE 00773000 @NM00031 EQU JFCEROPT 00774000 JFCABN EQU JFCEROPT 00775000 JFCSKP EQU JFCEROPT 00776000 JFCACC EQU JFCEROPT 00777000 JFCBUFL EQU INFMJFCB+90 00778000 JFCFWORD EQU JFCBFTEK 00779000 JFCDWORD EQU JFCBFTEK 00780000 JFCHIER1 EQU JFCBFTEK 00781000 JFCDYN EQU JFCBFTEK 00782000 JFCEXC EQU JFCBFTEK 00783000 JFCSIM EQU JFCBFTEK 00784000 JFCBUFRQ EQU JFCBFOUT 00785000 JFCTEMP EQU JFCBIND2 00786000 JFCREQ EQU JFCBIND2 00787000 JFCENT EQU JFCBIND2 00788000 JFCSHARE EQU JFCBIND2 00789000 JFCSECUR EQU JFCBIND2 00790000 JFCDISP EQU JFCBIND2 00791000 JFCGDG EQU JFCBIND1 00792000 JFCADDED EQU JFCBIND1 00793000 JFCLOC EQU JFCBIND1 00794000 JFCRLSE EQU JFCBIND1 00795000 JFCBXPDT EQU INFMJFCB+83 00796000 JFCBCRDT EQU INFMJFCB+80 00797000 JFCBOPS2 EQU JFCBMASK+7 00798000 JFCRCTLG EQU JFCBFLG2 00799000 JFCBBUFF EQU JFCBFLG2 00800000 JFCTRACE EQU JFCBFLG2 00801000 JFCSDRPS EQU JFCBFLG2 00802000 JFCMODNW EQU JFCBFLG2 00803000 JFCDEFER EQU JFCBFLG2 00804000 JFCOUTOP EQU JFCBFLG2 00805000 JFCINOP EQU JFCBFLG2 00806000 JFCOPEN EQU JFCBFLG1 00807000 JFCDUAL EQU JFCBFLG1 00808000 JFCSLDES EQU JFCBFLG1 00809000 JFCSLCRE EQU JFCBFLG1 00810000 JFCSTAND EQU JFCBFLG1 00811000 JFCBPTTR EQU JFCBOPS1+4 00812000 @NM00030 EQU JFCBOPS1+4 00813000 @NM00029 EQU JFCBOPS1 00814000 JFCBVLSQ EQU INFMJFCB+70 00815000 @NM00028 EQU JFCFUNC 00816000 JFCFNCBT EQU JFCFUNC 00817000 JFCFNCBX EQU JFCFUNC 00818000 JFCFNCBD EQU JFCFUNC 00819000 JFCFNCBW EQU JFCFUNC 00820000 JFCFNCBP EQU JFCFUNC 00821000 JFCFNCBR EQU JFCFUNC 00822000 JFCFNCBI EQU JFCFUNC 00823000 JFCBFOFL EQU JFCBUFOF 00824000 JFCNL EQU JFCBLTYP 00825000 JFCSL EQU JFCBLTYP 00826000 JFCNSL EQU JFCBLTYP 00827000 JFCSUL EQU JFCBLTYP 00828000 JFCBLP EQU JFCBLTYP 00829000 JFCBLTM EQU JFCBLTYP 00830000 JFCBAL EQU JFCBLTYP 00831000 @NM00027 EQU JFCBLTYP 00832000 @NM00026 EQU JFCBSYSC+7 00833000 JFCFCBID EQU JFCBSYSC+3 00834000 JFCBDSCB EQU JFCBSYSC 00835000 JFCPAT EQU JFCBTSDM 00836000 JFCNDCB EQU JFCBTSDM 00837000 JFCNDSCB EQU JFCBTSDM 00838000 JFCNWRIT EQU JFCBTSDM 00839000 JFCTTR EQU JFCBTSDM 00840000 JFCSDS EQU JFCBTSDM 00841000 JFCVSL EQU JFCBTSDM 00842000 JFCCAT EQU JFCBTSDM 00843000 JFCIPLTX EQU JFCBELNM 00844000 JFCBQNAM EQU JFCBDSNM 00845000 DCBEOB EQU IHADCS40+20 00846000 DCBPRECL EQU IHADCS40+18 00847000 @NM00025 EQU IHADCS40+16 00848000 @NM00024 EQU @NM00022+1 00849000 @NM00023 EQU DCBEROPT 00850000 DCBERABE EQU DCBEROPT 00851000 DCBERSKP EQU DCBEROPT 00852000 DCBERACC EQU DCBEROPT 00853000 @NM00021 EQU IHADCS40+10 00854000 @NM00020 EQU IHADCS40+9 00855000 @NM00019 EQU IHADCS40+8 00856000 DCBRECA EQU DCBRECAD+1 00857000 @NM00018 EQU DCBRECBT 00858000 DCBRCFGT EQU DCBRCREL 00859000 DCBRCTRU EQU DCBRCREL 00860000 DCBLCCW EQU DCBEOBAD 00861000 DCBNOTE EQU DCBCNTRL 00862000 DCBLRECL EQU IHADCS38+10 00863000 @NM00017 EQU IHADCS38+8 00864000 DCBEOBW EQU IHADCS38+4 00865000 DCBEOBRA EQU DCBEOBR+1 00866000 DCBNCP EQU DCBEOBR 00867000 DCBDIRCQ EQU DCBBUFOF 00868000 DCBQSTRU EQU DCBUSASI 00869000 @NM00016 EQU DCBUSASI 00870000 DCBQADF3 EQU DCBQADFS 00871000 DCBQADF2 EQU DCBQADFS 00872000 DCBQADF1 EQU DCBQADFS 00873000 DCBBLBP EQU DCBUSASI 00874000 @NM00015 EQU DCBUSASI 00875000 DCBCICBA EQU DCBCICB+1 00876000 @NM00014 EQU DCBCICB 00877000 DCBIOBA EQU IHADCS36+16 00878000 DCBOFFSW EQU IHADCS36+15 00879000 DCBOFFSR EQU IHADCS36+14 00880000 DCBWCPL EQU IHADCS36+13 00881000 DCBWCPO EQU IHADCS36+12 00882000 DCBBLKSI EQU IHADCS36+10 00883000 DCBCNQSM EQU DCBCIND2 00884000 DCBCNFEO EQU DCBCIND2 00885000 DCBCNCHS EQU DCBCIND2 00886000 DCBCNBFP EQU DCBCIND2 00887000 DCBCNIOE EQU DCBCIND2 00888000 DCBCNCLO EQU DCBCIND2 00889000 DCBCNWRO EQU DCBCIND2 00890000 DCBCNSTO EQU DCBCIND2 00891000 DCBCNEXB EQU DCBCIND1 00892000 @NM00013 EQU DCBCIND1 00893000 DCBCNBRM EQU DCBCIND1 00894000 @NM00012 EQU DCBCIND1 00895000 DCBCNEVA EQU DCBCIND1 00896000 DCBCNEVB EQU DCBCIND1 00897000 DCBCNSRD EQU DCBCIND1 00898000 DCBCNTOV EQU DCBCIND1 00899000 DCBSYNA EQU DCBSYNAD+1 00900000 DCBIOBL EQU DCBSYNAD 00901000 DCBCHCKA EQU DCBPERRA 00902000 @NM00011 EQU DCBOPTCD 00903000 DCBOPTT EQU DCBOPTCD 00904000 DCBSRCHD EQU DCBOPTZ 00905000 DCBOPTQ EQU DCBOPTCD 00906000 DCBBCKPT EQU DCBOPTO 00907000 DCBOPTC EQU DCBOPTCD 00908000 DCBOPTU EQU DCBOPTCD 00909000 DCBOPTW EQU DCBOPTCD 00910000 DCBPUT EQU DCBGET 00911000 DCBREAD EQU DCBWRITE 00912000 DCBDEBA EQU DCBDEBAD+1 00913000 @NM00010 EQU DCBIFLGS 00914000 DCBIFIOE EQU DCBIFLGS 00915000 DCBIFPCT EQU DCBIFLGS 00916000 DCBIFEC EQU DCBIFLGS 00917000 DCBMFSTI EQU DCBMFDMD 00918000 DCBMFAWR EQU DCBMFSTK 00919000 DCBMFUIP EQU DCBMFTMD 00920000 DCBMFIDW EQU DCBMFLCP 00921000 DCBMFWRK EQU DCBMFMVP 00922000 DCBMFRDQ EQU DCBMFWRT 00923000 DCBMFGTQ EQU DCBMFPUT 00924000 DCBMFSTL EQU DCBMACF2 00925000 DCBMFCK EQU DCBMFDMG 00926000 DCBMFRDX EQU DCBMFCHK 00927000 DCBMFDBF EQU DCBMFSBG 00928000 DCBMFRDI EQU DCBMFLCG 00929000 DCBMFRDK EQU DCBMFMVG 00930000 DCBMFWRQ EQU DCBMFRD 00931000 DCBMFPTQ EQU DCBMFGET 00932000 DCBMFECP EQU DCBMACF1 00933000 DCBTIOT EQU IHADCS25 00934000 DCBMRSTI EQU DCBMRDMD 00935000 DCBMRAWR EQU DCBMRSTK 00936000 DCBMRUIP EQU DCBMRTMD 00937000 DCBMRIDW EQU DCBMRLCP 00938000 DCBMRWRK EQU DCBMRMVP 00939000 DCBMRRDQ EQU DCBMRWRT 00940000 DCBMRGTQ EQU DCBMRPUT 00941000 DCBMRSTL EQU DCBMACR2 00942000 DCBMRCK EQU DCBMRDMG 00943000 DCBPGFXA EQU DCBMRRDX 00944000 DCBMRDBF EQU DCBMRSBG 00945000 DCBMRRDI EQU DCBMRLCG 00946000 DCBMRRDK EQU DCBMRMVG 00947000 DCBMRWRQ EQU DCBMRRD 00948000 DCBMRPTQ EQU DCBMRGET 00949000 DCBMRECP EQU DCBMACR1 00950000 @NM00009 EQU DCBIFLG 00951000 DCBIBIOE EQU DCBIFLG 00952000 DCBIBPCT EQU DCBIFLG 00953000 DCBIBEC EQU DCBIFLG 00954000 DCBOFIOF EQU DCBOFLGS 00955000 DCBOFUEX EQU DCBOFLGS 00956000 DCBOFTM EQU DCBOFLGS 00957000 DCBOFPPC EQU DCBOFLGS 00958000 DCBOFEOV EQU DCBOFLGS 00959000 DCBOFLRB EQU DCBOFLGS 00960000 DCBOFIOD EQU DCBOFLWR 00961000 DCBDDNAM EQU IHADCS24 00962000 DCBEXLSA EQU DCBEXLST+1 00963000 DCBRECKL EQU DCBRECFM 00964000 DCBRECCC EQU DCBRECFM 00965000 DCBRECSB EQU DCBRECFM 00966000 DCBRECBR EQU DCBRECFM 00967000 DCBRECTO EQU DCBRECLA 00968000 DCBRECL EQU DCBRECLA 00969000 DCBEODA EQU DCBEODAD+1 00970000 DCBBFA EQU DCBBFTEK 00971000 DCBH0 EQU DCBBFTEK 00972000 DCBBFTKD EQU DCBBFTEK 00973000 DCBBFTE EQU DCBBFT 00974000 DCBBFTKR EQU DCBBFT 00975000 DCBBFTS EQU DCBBFT 00976000 DCBH1 EQU DCBBFTEK 00977000 DCBSVCXA EQU DCBSVCXL+1 00978000 @NM00008 EQU DCBSVCXL 00979000 DCBODEBA EQU DCBIOBAA 00980000 @NM00007 EQU DCBQSLM 00981000 DCBUPDBT EQU DCBQSLM 00982000 DCBUPDCM EQU DCBQSLM 00983000 DCB1DVDS EQU DCBQSLM 00984000 @NM00006 EQU DCBDSRG2 00985000 DCBACBM EQU DCBDSRG2 00986000 @NM00005 EQU DCBDSRG2 00987000 DCBDSGTQ EQU DCBDSRG2 00988000 DCBDSGTX EQU DCBDSRG2 00989000 DCBDSGGS EQU DCBDSRG2 00990000 DCBDSGU EQU DCBDSRG1 00991000 DCBDSGPO EQU DCBDSRG1 00992000 DCBDSGMQ EQU DCBDSRG1 00993000 DCBDSGCQ EQU DCBDSRG1 00994000 DCBDSGCX EQU DCBDSRG1 00995000 DCBDSGDA EQU DCBDSRG1 00996000 DCBDSGPS EQU DCBDSRG1 00997000 DCBDSGIS EQU DCBDSRG1 00998000 DCBBUFL EQU IHADCS11+8 00999000 DCBBUFCA EQU DCBBUFCB+1 01000000 DCBBUFNO EQU DCBBUFCB 01001000 DCBDEVT EQU DCBREL 01002000 DCBKEYLE EQU DCBRELB 01003000 DCBTRBAL EQU IHADCS01+6 01004000 @NM00004 EQU IHADCS01+5 01005000 @NM00003 EQU IHADCS01+4 01006000 DCBDVTBA EQU DCBDVTBL+1 01007000 @NM00002 EQU DCBDVTBL 01008000 DCBKEYCN EQU IHADCS00+4 01009000 DCBRELAD EQU IHADCS00 01010000 @NM00001 EQU IHADCB 01011000 .@UNREFD ANOP END UNREFERENCED COMPONENTS 01012000 @RT00125 EQU ASSMLINK 01013000 @RC00153 EQU @EL00002 01014000 @PB00002 EQU @EL00001 01015000 @ENDDATA EQU * 01016000 END HMASMASI 01017000 ./ ADD SSI=33620488,NAME=HMASMASM,SOURCE=1 COMPON=DN611 TITLE 'HMASMASM - ASSEMBLY SYSGEN SCAN ROUTINE OF SMP *00001000 ' 00002000 HMASMASM CSECT , 0001 00003000 @MAINENT DS 0H 0001 00004000 USING *,@15 0001 00005000 B @PROLOG 0001 00006000 DC AL1(16) 0001 00007000 DC C'HMASMASM 73.362' 0001 00008000 DROP @15 00009000 @PROLOG STM @14,@12,12(@13) 0001 00010000 BALR @12,0 0001 00011000 @PSTART DS 0H 0001 00012000 USING @PSTART,@12 0001 00013000 ST @13,@SA00001+4 0001 00014000 LA @14,@SA00001 0001 00015000 ST @14,8(,@13) 0001 00016000 LR @13,@14 0001 00017000 MVC @PC00001(8),0(@01) 0001 00018000 * 0101 00019000 */********************************************************************/ 00020000 */* */ 00021000 */* INITIALIZE TABLES AND WORK AREAS */ 00022000 */* */ 00023000 */********************************************************************/ 00024000 * 0101 00025000 * IOPPTR=CCAIOPTR; /* SET POINTER TO THE IOP */ 00026000 MVC IOPPTR(3),CCAIOPTR+1(CCAPTR) 0101 00027000 * CONTINSW=OFF; /* INITIALIZE CONTINUATION SW */ 00028000 NI CONTINSW,B'01111111' 0102 00029000 * BUFBASE=ADDR(MACTBL); /* SET TO BASE BUFFER */ 00030000 LA @14,MACTBL 0103 00031000 ST @14,@TF00001 0103 00032000 MVC BUFBASE(3),@TF00001+1 0103 00033000 * MACNXT=ZERO; /* CLEAR CHAIN POINTER */ 00034000 SLR @10,@10 0104 00035000 ST @10,@TF00001 0104 00036000 MVC MACNXT(3,@14),@TF00001+1 0104 00037000 * MACCTR=ZERO; /* INITIALIZE MACRO COUNTER */ 00038000 MVI MACCTR(@14),X'00' 0105 00039000 * MODNAME=BLANK; /* BLANK OUT MODULE NAMS */ 00040000 MVI MODNAME+1,C' ' 0106 00041000 MVC MODNAME+2(6),MODNAME+1 0106 00042000 MVI MODNAME,C' ' 0106 00043000 * SCPSRCH=ADDR(MODK); /* INIT PTR TO FIRST ARGUMENT */ 00044000 LA @14,MODK 0107 00045000 ST @14,SCPSRCH 0107 00046000 * SCPIORTN=ZERO; /* ZERO I/O RTN ADDR */ 00047000 SLR @14,@14 0108 00048000 ST @14,SCPIORTN 0108 00049000 * SCPINLN=MAXJCL*JCLLRECL; /* SET INPUT RECORD LENGTH */ 00050000 L @14,@PC00001+4 0109 00051000 LH @14,MAXJCL(,@14) 0109 00052000 MH @14,@CH00062 0109 00053000 STH @14,SCPINLN 0109 00054000 * SCPCHAR=ADDR(BUFFER); /* SET INPUT LIST RECORD PTR */ 00055000 L @14,@PC00001 0110 00056000 ST @14,SCPCHAR 0110 00057000 * RTNCODE=ZERO; /* INITIALIZE RETURN CODE */ 00058000 * 0111 00059000 MVI RTNCODE,X'00' 0111 00060000 * /*****************************************************************/ 00061000 * /* */ 00062000 * /* CALL HMASMSCN TO SCAN THE JCL LOOKING FOR MOD= KEYWORD OR */ 00063000 * /* SYSPUNCH DD STATEMENT FOR DSN. THIS WILL PRODUCE THE ASSEMBLY */ 00064000 * /* NAME UNDER WHICH THE ASSEMBLER INPUT IS EVENTUALLY STORED. */ 00065000 * /* */ 00066000 * /*****************************************************************/ 00067000 * 0112 00068000 * CALL HMASMSCN(HMASMSCP); /* SCAN THE JCL STATEMENT */ 00069000 L @15,@CV00104 0112 00070000 LA @01,@AL00112 0112 00071000 BALR @14,@15 0112 00072000 * IF SCPRETª=GOOD /* SYNTAX ERROR? */ 00073000 * ³MODNAME(1)=BLANK /* OR MODULE NAME NOT FOUND */ 00074000 * THEN /* YES - RETURN SYNTAX ERROR */ 00075000 CLI SCPRET,0 0113 00076000 BNE @RT00113 0113 00077000 CLI MODNAME,C' ' 0113 00078000 BNE @RF00113 0113 00079000 @RT00113 DS 0H 0114 00080000 * RETURN CODE(SYNTERR); /* EXIT TO CALLER 0114 00081000 * */ 00082000 LA @15,4 0114 00083000 L @13,4(,@13) 0114 00084000 L @14,12(,@13) 0114 00085000 LM @00,@12,20(@13) 0114 00086000 BR @14 0114 00087000 * 0115 00088000 * /*****************************************************************/ 00089000 * /* */ 00090000 * /* SCAN ASSEMBLY RECORDS FOR POSSIBLE MACRO CALLS. THE ASSUMPTION*/ 00091000 * /* IS MADE THAT A VALID MACRO CALL MUST BE LONGER THAN 5 */ 00092000 * /* CHARACTERS AND LESS THAN 9. THIS IS TO AVOID SCAN AND ANALYSIS*/ 00093000 * /* OF EVERY VALID ASSEMBLER OP CODE. THE ONLY KNOWN EXCEPTION TO */ 00094000 * /* THE ABOVE RULE IS THE CVT. */ 00095000 * /* */ 00096000 * /*****************************************************************/ 00097000 * 0115 00098000 * SEQNO=ZERO; /* RESET SEQUENCE NUMBER */ 00099000 @RF00113 SLR @14,@14 0115 00100000 ST @14,SEQNO 0115 00101000 * SCPSRCH=ADDR(MACSTART); /* INITIALIZE ARGUMENT FOR SCAN */ 00102000 LA @14,MACSTART 0116 00103000 ST @14,SCPSRCH 0116 00104000 * SCPINLN=ASMLRECL; /* SET INPUT RECORD LENGTH */ 00105000 MVC SCPINLN(2),@CH00064 0117 00106000 * DO WHILE IOPBUFAD->SCNSTR(1:2)ª=SLASHAST/* LOOP TILL EOF */ 00107000 * &RTNCODE=ZERO; /* AND NOT AN ERROR CONDITION */ 00108000 B @DE00118 0118 00109000 @DL00118 DS 0H 0119 00110000 * SEQNO=SEQNO+SEQINCR; /* BUMP SEQENCE NUMBER */ 00111000 LA @14,100 0119 00112000 AL @14,SEQNO 0119 00113000 ST @14,SEQNO 0119 00114000 * CVD(SEQNO,SEQPACK); /* CONVERT NUMBER */ 00115000 CVD @14,SEQPACK 0120 00116000 * UNPK(SEQUENCE,SEQPACK); /* PUT NUMBER INTO RECORD */ 00117000 L @14,IOPPTR-1 0121 00118000 LA @14,0(,@14) 0121 00119000 L @10,IOPBUFAD(,@14) 0121 00120000 UNPK SEQUENCE(8,@10),SEQPACK(8) 0121 00121000 * LASTDIG=LASTDIG³MAKPRINT; /* MAKE PRINTABLE */ 00122000 OI LASTDIG(@10),X'F0' 0122 00123000 * IOPDSID=IOPCDSM; /* INDICATE CONTROL DATA SET */ 00124000 MVI IOPDSID(@14),X'02' 0123 00125000 * IOPFUNCT=IOPWRITE; /* INDICATE WRITE OPERATION */ 00126000 MVI IOPFUNCT(@14),X'05' 0124 00127000 * CALL HMASMIO(HMASMIOP); /* WRITE ASSEMBLER RECORD TO CDS */ 00128000 ST @14,@AL00001 0125 00129000 L @15,@CV00103 0125 00130000 LA @01,@AL00001 0125 00131000 BALR @14,@15 0125 00132000 * IF IOPRETRNª=GOOD /* SUCCESSFUL I/O? */ 00133000 * THEN /* NO - ERROR CONDITION */ 00134000 L @14,IOPPTR-1 0126 00135000 LA @14,0(,@14) 0126 00136000 CLI IOPRETRN(@14),0 0126 00137000 BE @RF00126 0126 00138000 * RETURN CODE(IOERR); /* INDICATE ERROR TO CALLER */ 00139000 LA @15,12 0127 00140000 L @13,4(,@13) 0127 00141000 L @14,12(,@13) 0127 00142000 LM @00,@12,20(@13) 0127 00143000 BR @14 0127 00144000 * IF CONTINSW=OFF /* IS CONTINUATION PENDING? */ 00145000 * THEN /* NO - THEN OK TO SCAN */ 00146000 @RF00126 TM CONTINSW,B'10000000' 0128 00147000 BNZ @RF00128 0128 00148000 * DO; /* GO AHEAD AND SCAN STMT */ 00149000 * SCPCHAR=IOPBUFAD; /* RESET RECORD ADDRESS */ 00150000 L @14,IOPPTR-1 0130 00151000 LA @14,0(,@14) 0130 00152000 MVC SCPCHAR(4),IOPBUFAD(@14) 0130 00153000 * CALL HMASMSCN(HMASMSCP); /* SCAN ASSEMBLER RECORD */ 00154000 L @15,@CV00104 0131 00155000 LA @01,@AL00131 0131 00156000 BALR @14,@15 0131 00157000 * IF SCPRETª=GOOD /* SYNTAX ERROR? */ 00158000 * THEN /* YES - RETURN TO CALLER */ 00159000 CLI SCPRET,0 0132 00160000 BE @RF00132 0132 00161000 * IF EXCERR=ON /* MACRO TABLE EXCEEDED? */ 00162000 * THEN /* YES - INDICATE ERROR */ 00163000 TM EXCERR,B'01000000' 0133 00164000 BNO @RF00133 0133 00165000 * RETURN CODE(TBLEXC); /* TO CALLER */ 00166000 LA @15,16 0134 00167000 L @13,4(,@13) 0134 00168000 L @14,12(,@13) 0134 00169000 LM @00,@12,20(@13) 0134 00170000 BR @14 0134 00171000 * ELSE /* OTHERWISE SYNTAX ERROR */ 00172000 * RETURN CODE(SYNTERR); /* INDICATE SYNTAX ERROR */ 00173000 @RF00133 LA @15,4 0135 00174000 L @13,4(,@13) 0135 00175000 L @14,12(,@13) 0135 00176000 LM @00,@12,20(@13) 0135 00177000 BR @14 0135 00178000 * END; 0136 00179000 @RF00132 DS 0H 0137 00180000 * IF IOPBUFAD->SCNSTR(CONTCOL)=BLANK/* COL 72 BLANK? */ 00181000 * THEN /* YES - INDICATE NO CONTIN */ 00182000 @RF00128 L @14,IOPPTR-1 0137 00183000 LA @14,0(,@14) 0137 00184000 L @14,IOPBUFAD(,@14) 0137 00185000 CLI SCNSTR+71(@14),C' ' 0137 00186000 BNE @RF00137 0137 00187000 * CONTINSW=OFF; /* TURN OFF CONTIN. SWITCH */ 00188000 NI CONTINSW,B'01111111' 0138 00189000 * ELSE /* CONTINUATION IS PENDING */ 00190000 * CONTINSW=ON; /* INDICATE CONTINUATION PEND */ 00191000 B @RC00137 0139 00192000 @RF00137 OI CONTINSW,B'10000000' 0139 00193000 * IOPDSID=IOPSGTAP; /* INDICATE SYSGEN TAPE */ 00194000 @RC00137 L @14,IOPPTR-1 0140 00195000 LA @14,0(,@14) 0140 00196000 MVI IOPDSID(@14),X'07' 0140 00197000 * IOPFUNCT=IOPREAD; /* INDICATE READ OPERATION */ 00198000 MVI IOPFUNCT(@14),X'01' 0141 00199000 * CALL HMASMIO(HMASMIOP); /* READ A SYSGEN TAPE RECORD */ 00200000 ST @14,@AL00001 0142 00201000 L @15,@CV00103 0142 00202000 LA @01,@AL00001 0142 00203000 BALR @14,@15 0142 00204000 * IF IOPRETRN=EOF /* END OF FILE ALREADY? */ 00205000 * THEN /* YES - ERROR CONDITION */ 00206000 L @14,IOPPTR-1 0143 00207000 LA @14,0(,@14) 0143 00208000 CLI IOPRETRN(@14),4 0143 00209000 BNE @RF00143 0143 00210000 * RTNCODE=PREMEOF; /* INDICATE PREMATURE END OF FILE*/ 00211000 MVI RTNCODE,X'08' 0144 00212000 * IF IOPRETRN>EOF /* I/O ERROR??? */ 00213000 * THEN /* YES - ANOTHER ERROR */ 00214000 @RF00143 L @14,IOPPTR-1 0145 00215000 LA @14,0(,@14) 0145 00216000 CLI IOPRETRN(@14),4 0145 00217000 BNH @RF00145 0145 00218000 * RETURN CODE(IOERR); /* INDICATE I/O ERROR */ 00219000 LA @15,12 0146 00220000 L @13,4(,@13) 0146 00221000 L @14,12(,@13) 0146 00222000 LM @00,@12,20(@13) 0146 00223000 BR @14 0146 00224000 * IF IOPBUFAD->SCNSTR(1:2)=TWOSLASH/* WAS JCL ENCOUNTERED */ 00225000 * THEN 0147 00226000 @RF00145 L @14,IOPPTR-1 0147 00227000 LA @14,0(,@14) 0147 00228000 L @14,IOPBUFAD(,@14) 0147 00229000 CLC SCNSTR(2,@14),@CC00072 0147 00230000 BNE @RF00147 0147 00231000 * RTNCODE=JCLENC; /* SET UP JCL RC */ 00232000 MVI RTNCODE,X'14' 0148 00233000 * END; 0149 00234000 @RF00147 DS 0H 0149 00235000 @DE00118 L @14,IOPPTR-1 0149 00236000 LA @14,0(,@14) 0149 00237000 L @14,IOPBUFAD(,@14) 0149 00238000 CLC SCNSTR(2,@14),@CC00070 0149 00239000 BE @DC00118 0149 00240000 CLI RTNCODE,0 0149 00241000 BE @DL00118 0149 00242000 @DC00118 DS 0H 0150 00243000 * 0150 00244000 * /*****************************************************************/ 00245000 * /* */ 00246000 * /* THE ASSEMBLY HAS ALL BEEN WRITTEN TO THE CDS AND MACROS HAVE */ 00247000 * /* BEEN PICKED OFF THE STATEMENTS AND STORED IN AN ARRAY FIRST, */ 00248000 * /* THE ASSEMBLER INPUT IS STORED IN THE CDS */ 00249000 * /* */ 00250000 * /*****************************************************************/ 00251000 * 0150 00252000 * IOPDSID=IOPCDSM; /* INDICATE CDS */ 00253000 L @14,IOPPTR-1 0150 00254000 LA @14,0(,@14) 0150 00255000 MVI IOPDSID(@14),X'02' 0150 00256000 * IOPNAME=MODNAME; /* PUT MODULE NAME IN STOW LS */ 00257000 MVC IOPNAME(8,@14),MODNAME 0151 00258000 * IOPCDTYP=IOPCASM; /* INDICATE ASSEMBLY */ 00259000 NI IOPCDTYP(@14),B'00111111' 0152 00260000 * IOPFUNCT=IOPSTOWR; /* INDICATE STOW REPLACE */ 00261000 MVI IOPFUNCT(@14),X'08' 0153 00262000 * CALL HMASMIO(HMASMIOP); /* STOW CALLING BOOK IN CDS */ 00263000 ST @14,@AL00001 0154 00264000 L @15,@CV00103 0154 00265000 LA @01,@AL00001 0154 00266000 BALR @14,@15 0154 00267000 * IF IOPRETRNª=GOOD /* GOOD RETURN? */ 00268000 * THEN /* NO - I/O ERROR */ 00269000 L @14,IOPPTR-1 0155 00270000 LA @14,0(,@14) 0155 00271000 CLI IOPRETRN(@14),0 0155 00272000 BE @RF00155 0155 00273000 * RETURN CODE(IOERR); /* INDICATE ERROR TO CALLER 0156 00274000 * */ 00275000 LA @15,12 0156 00276000 L @13,4(,@13) 0156 00277000 L @14,12(,@13) 0156 00278000 LM @00,@12,20(@13) 0156 00279000 BR @14 0156 00280000 * 0157 00281000 */********************************************************************/ 00282000 */* */ 00283000 */* ADD MEMBERS IN THE MACRO LIST TO THE CDS, IF THEY DON'T */ 00284000 */* ALREADY EXIST IN THE MACRO LIST OR THE CDS. THE INCORE */ 00285000 */* ENTRIES ARE FIRST CHECKED, THEN THE CDS. THE ASSEMBLY NAME */ 00286000 */* IS ADDED TO THE LIST FOR A MACRO IF IT IS FOUND. */ 00287000 */* */ 00288000 */********************************************************************/ 00289000 * 0157 00290000 * BUFBASE=ADDR(MACTBL); /* POINT TO BASE BUFFER */ 00291000 @RF00155 LA @14,MACTBL 0157 00292000 ST @14,@TF00001 0157 00293000 MVC BUFBASE(3),@TF00001+1 0157 00294000 *MACSCAN: 0158 00295000 * DO I=1 TO MACCTR; /* LOOP THROUGH MACRO LIST */ 00296000 MACSCAN LA @14,1 0158 00297000 B @DE00158 0158 00298000 @DL00158 DS 0H 0159 00299000 * IOPFUNCT=IOPLOC; /* INDICATE BLDL OPERATION */ 00300000 L @10,IOPPTR-1 0159 00301000 LA @10,0(,@10) 0159 00302000 MVI IOPFUNCT(@10),X'03' 0159 00303000 * IOPNAME=MACCALL(I); /* PUT MACRO NAME IN IOP */ 00304000 SLA @14,3 0160 00305000 L @01,BUFBASE-1 0160 00306000 LA @01,0(,@01) 0160 00307000 ALR @01,@14 0160 00308000 AL @01,@CF00357 0160 00309000 MVC IOPNAME(8,@10),MACCALL-4(@01) 0160 00310000 * IOPCDTYP=IOPCMAC; /* INDICATE MACRO TYPE */ 00311000 NI IOPCDTYP(@10),B'10111111' 0161 00312000 OI IOPCDTYP(@10),B'10000000' 0161 00313000 * IOPMODID=BLANK; /* INDICATE NO MODIFIER ID */ 00314000 MVI IOPMODID+1(@10),C' ' 0162 00315000 MVI IOPMODID(@10),C' ' 0162 00316000 * CALL HMASMIO(HMASMIOP); /* LOCATE MEMBER IN THE CDS */ 00317000 ST @10,@AL00001 0163 00318000 L @15,@CV00103 0163 00319000 LA @01,@AL00001 0163 00320000 BALR @14,@15 0163 00321000 * IF IOPRETRN>NOTTHERE /* SERIOUS CDS ERROR? */ 00322000 * THEN /* YES - EXIT BADLY */ 00323000 L @14,IOPPTR-1 0164 00324000 LA @14,0(,@14) 0164 00325000 CLI IOPRETRN(@14),4 0164 00326000 BNH @RF00164 0164 00327000 * RETURN CODE(IOERR); /* INDICATE ERROR TO CALLER */ 00328000 LA @15,12 0165 00329000 L @13,4(,@13) 0165 00330000 L @14,12(,@13) 0165 00331000 LM @00,@12,20(@13) 0165 00332000 BR @14 0165 00333000 * K=1; /* INITIALIZE COUNT FOR NOT FND */ 00334000 @RF00164 LA @14,1 0166 00335000 LR K,@14 0166 00336000 * IF IOPRETRN=GOOD /* SUCCESSFUL LOCATE (FOUND) */ 00337000 * THEN /* YES - CHECK IF ON LIST(CDS) */ 00338000 L @10,IOPPTR-1 0167 00339000 LA @10,0(,@10) 0167 00340000 CLI IOPRETRN(@10),0 0167 00341000 BNE @RF00167 0167 00342000 * DO K=1 BY 1 /* CHECK ASSEM LIST IN CDS NTRY */ 00343000 * WHILE IOPASMOD(K,1)ª=IOPEOLST;/* TILL END OF LIST */ 00344000 LR K,@14 0168 00345000 B @DE00168 0168 00346000 @DL00168 DS 0H 0169 00347000 * IF IOPASMOD(K,1)=IOPEOLST /* END OF LIST? */ 00348000 * THEN 0169 00349000 L @14,IOPPTR-1 0169 00350000 LA @14,0(,@14) 0169 00351000 LR @10,K 0169 00352000 SLA @10,3 0169 00353000 SLR @03,@03 0169 00354000 IC @03,IOPASMOD-8(@10,@14) 0169 00355000 CH @03,@CH00074 0169 00356000 BE @RT00169 0169 00357000 * GO TO CONTIN10; /* YES - ADD THIS MACRO */ 00358000 * IF IOPASMOD(K)=MODNAME /* MACRO ALREADY HERE */ 00359000 * THEN 0171 00360000 ALR @14,@10 0171 00361000 CLC IOPASMOD-8(8,@14),MODNAME 0171 00362000 BE @RT00171 0171 00363000 * GO TO CONTIN20; /* YES - IGNORE MACRO */ 00364000 * END; 0173 00365000 * 0173 00366000 AH K,@CH00043 0173 00367000 @DE00168 LR @14,K 0173 00368000 SLA @14,3 0173 00369000 L @10,IOPPTR-1 0173 00370000 LA @10,0(,@10) 0173 00371000 SLR @03,@03 0173 00372000 IC @03,IOPASMOD-8(@14,@10) 0173 00373000 CH @03,@CH00074 0173 00374000 BNE @DL00168 0173 00375000 */********************************************************************/ 00376000 */* */ 00377000 */* ADD THE MACRO TO THE ASSEMBLY ENTRY */ 00378000 */* */ 00379000 */********************************************************************/ 00380000 * 0174 00381000 *CONTIN10: 0174 00382000 * IOPASMOD(K)=MODNAME; /* ADD THIS ASSEMBLY TO MACRO */ 00383000 @RF00167 DS 0H 0174 00384000 CONTIN10 L @14,IOPPTR-1 0174 00385000 LA @14,0(,@14) 0174 00386000 LR @10,K 0174 00387000 SLA @10,3 0174 00388000 ST @10,@TF00001 0174 00389000 ALR @10,@14 0174 00390000 MVC IOPASMOD-8(8,@10),MODNAME 0174 00391000 * IOPASMOD(K+1,1)=IOPEOLST; /* INDICATE NEW END OF LIST */ 00392000 LA @10,255 0175 00393000 L @03,@TF00001 0175 00394000 STC @10,IOPASMOD(@03,@14) 0175 00395000 * IOPFUNCT=IOPSTOWR; /* INDICATE STOW OPERATION */ 00396000 MVI IOPFUNCT(@14),X'08' 0176 00397000 * CALL HMASMIO(HMASMIOP); /* STOW UPDATE MACRO ENTRY */ 00398000 ST @14,@AL00001 0177 00399000 L @15,@CV00103 0177 00400000 LA @01,@AL00001 0177 00401000 BALR @14,@15 0177 00402000 * IF IOPRETRNª=GOOD /* SUCCESSFUL STOW? */ 00403000 * THEN /* NO - EXIT BADLY */ 00404000 L @14,IOPPTR-1 0178 00405000 LA @14,0(,@14) 0178 00406000 CLI IOPRETRN(@14),0 0178 00407000 BE @RF00178 0178 00408000 * RETURN CODE(IOERR); /* INDICATE ERROR TO CALLER */ 00409000 LA @15,12 0179 00410000 L @13,4(,@13) 0179 00411000 L @14,12(,@13) 0179 00412000 LM @00,@12,20(@13) 0179 00413000 BR @14 0179 00414000 *CONTIN20: 0180 00415000 * END; 0180 00416000 @RF00178 DS 0H 0180 00417000 CONTIN20 LA @14,1 0180 00418000 MVC @ZT00001+1(3),I 0180 00419000 AL @14,@ZT00001 0180 00420000 @DE00158 ST @14,@TF00001 0180 00421000 MVC I(3),@TF00001+1 0180 00422000 L @10,BUFBASE-1 0180 00423000 LA @10,0(,@10) 0180 00424000 MVC @ZT00003+3(1),MACCTR(@10) 0180 00425000 C @14,@ZT00003 0180 00426000 BNH @DL00158 0180 00427000 * IF MACNXTª=ZERO /* ARE ANY BUFFERS CHAINED ? */ 00428000 * THEN 0181 00429000 L @14,BUFBASE-1 0181 00430000 LA @14,0(,@14) 0181 00431000 MVC @ZT00001+1(3),MACNXT(@14) 0181 00432000 L @10,@ZT00001 0181 00433000 LTR @10,@10 0181 00434000 BZ @RF00181 0181 00435000 * DO; /* YES - SET UP TO OUTPUT THEM */ 00436000 * BUFBASE=MACNXT; /* CHAIN TO NEXT BUFFER */ 00437000 MVC @ZT00001+1(3),MACNXT(@14) 0183 00438000 L @14,@ZT00001 0183 00439000 ST @14,@TF00001 0183 00440000 MVC BUFBASE(3),@TF00001+1 0183 00441000 * GO TO MACSCAN; /* CONTINUE THE SCAN */ 00442000 B MACSCAN 0184 00443000 * END; 0185 00444000 *FREEBUF: /* NO MORE BUFFERS TO SCAN - FREE 00445000 * THEM */ 00446000 * BUFBASE=ADDR(MACTBL); /* SET TO BASE BUFFER */ 00447000 @RF00181 DS 0H 0186 00448000 FREEBUF LA @14,MACTBL 0186 00449000 ST @14,@TF00001 0186 00450000 MVC BUFBASE(3),@TF00001+1 0186 00451000 * BUFBASE=MACNXT; /* NOW TO NEXT BUFFER */ 00452000 MVC @ZT00001+1(3),MACNXT(@14) 0187 00453000 L @14,@ZT00001 0187 00454000 ST @14,@TF00001 0187 00455000 MVC BUFBASE(3),@TF00001+1 0187 00456000 * DO WHILE BUFBASEª=ZERO; /* LOOP THRU ALL GM'D BUFFERS */ 00457000 B @DE00188 0188 00458000 @DL00188 DS 0H 0189 00459000 * NXTBUF=BUFBASE; /* SET ADDRESS TO FREEMAIN */ 00460000 L @14,BUFBASE-1 0189 00461000 LA @14,0(,@14) 0189 00462000 ST @14,NXTBUF 0189 00463000 * BUFBASE=MACNXT; /* PICK UP CHAINED BUFFER */ 00464000 MVC @ZT00001+1(3),MACNXT(@14) 0190 00465000 L @14,@ZT00001 0190 00466000 ST @14,@TF00001 0190 00467000 MVC BUFBASE(3),@TF00001+1 0190 00468000 * GEN(FREEMAIN E,LV=84,A=NXTBUF);/* FREE THE BUFFER */ 00469000 FREEMAIN E,LV=84,A=NXTBUF 00470000 * END; 0192 00471000 @DE00188 L @14,BUFBASE-1 0192 00472000 LA @14,0(,@14) 0192 00473000 LTR @14,@14 0192 00474000 BNZ @DL00188 0192 00475000 * BUFBASE=ADDR(MACTBL); /* RESET TO BASE BUFFER */ 00476000 LA @14,MACTBL 0193 00477000 ST @14,@TF00001 0193 00478000 MVC BUFBASE(3),@TF00001+1 0193 00479000 * MACCTR=ZERO; /* CLEAR COUNTER */ 00480000 MVI MACCTR(@14),X'00' 0194 00481000 * MACNXT=ZERO; /* CLEAR CHAIN POINTER */ 00482000 SLR @10,@10 0195 00483000 ST @10,@TF00001 0195 00484000 MVC MACNXT(3,@14),@TF00001+1 0195 00485000 * RETURN CODE(RTNCODE); /* EXIT WITH GOOD RETURN CODE 0196 00486000 * */ 00487000 SLR @15,@15 0196 00488000 IC @15,RTNCODE 0196 00489000 L @13,4(,@13) 0196 00490000 L @14,12(,@13) 0196 00491000 LM @00,@12,20(@13) 0196 00492000 BR @14 0196 00493000 * 0197 00494000 * /*****************************************************************/ 00495000 * /* */ 00496000 * /* THE FOLLOWING SUBROUTINE IS ENTERED FROM SCAN TO INCREMENT THE*/ 00497000 * /* SCAN PTR FOR JCL SEARCH. */ 00498000 * /* */ 00499000 * /*****************************************************************/ 00500000 * 0197 00501000 *BUMP010: 0197 00502000 * PROCEDURE; 0197 00503000 @EL00001 L @13,4(,@13) 0197 00504000 @EF00001 DS 0H 0197 00505000 @ER00001 LM @14,@12,12(@13) 0197 00506000 BR @14 0197 00507000 @PB00001 DS 0H 0197 00508000 BUMP010 STM @14,@12,12(@13) 0197 00509000 * IF SCNSTR(1)=EOLST /* END OF JCL BUFFER REACHED? */ 00510000 * THEN /* YES - ERROR CONDITION */ 00511000 L @14,SCPCHAR 0198 00512000 CLI SCNSTR(@14),255 0198 00513000 BNE @RF00198 0198 00514000 * SCPRET=SCNERR; /* INDICATE ERROR TO SCAN */ 00515000 MVI SCPRET,X'08' 0199 00516000 * ELSE /* NO - EVERYTHING OK */ 00517000 * SCPRET=GOOD; /* INDICATE SUCCESS */ 00518000 B @RC00198 0200 00519000 @RF00198 MVI SCPRET,X'00' 0200 00520000 * IF SCPPMLN=ZERO /* IF PASSBACK LENGTH IS ZERO */ 00521000 * THEN /* THEN BUMP SO NO LOOP OCCURS */ 00522000 @RC00198 LH @14,SCPPMLN 0201 00523000 LTR @14,@14 0201 00524000 BNZ @RF00201 0201 00525000 * SCPPMLN=ONE; /* RESET LENGTH */ 00526000 MVC SCPPMLN(2),@CH00043 0202 00527000 * END BUMP010; /* RETURN TO CONTINUE SCAN */ 00528000 * 0203 00529000 @EL00002 DS 0H 0203 00530000 @EF00002 DS 0H 0203 00531000 @ER00002 LM @14,@12,12(@13) 0203 00532000 BR @14 0203 00533000 * /*****************************************************************/ 00534000 * /* */ 00535000 * /* THE FOLLOWING SUBROUTINE IS ENTERED TO SAVE THE MODULE WHEN */ 00536000 * /* FOUND IN THE SEARCH OF THE JCL. SCAN STOPS AT THIS POINT. */ 00537000 * /* */ 00538000 * /*****************************************************************/ 00539000 * 0204 00540000 *SAVMOD10: 0204 00541000 * PROCEDURE; 0204 00542000 SAVMOD10 STM @14,@12,12(@13) 0204 00543000 * MODNAME=SCNSTR(1:SCPPMLN); /* SAVE MODULE NAME */ 00544000 MVI MODNAME+1,C' ' 0205 00545000 MVC MODNAME+2(6),MODNAME+1 0205 00546000 LH @14,SCPPMLN 0205 00547000 BCTR @14,0 0205 00548000 L @10,SCPCHAR 0205 00549000 EX @14,@SM00359 0205 00550000 * SCPRET=GOOD; /* INDICATE GOOD RETURN */ 00551000 MVI SCPRET,X'00' 0206 00552000 * END SAVMOD10; /* RETURN TO SCAN 0207 00553000 * */ 00554000 @EL00003 DS 0H 0207 00555000 @EF00003 DS 0H 0207 00556000 @ER00003 LM @14,@12,12(@13) 0207 00557000 BR @14 0207 00558000 * 0208 00559000 * /*****************************************************************/ 00560000 * /* */ 00561000 * /* THE FOLLOWING SUBROUTINE IS INVOKED FROM SCAN OF ASSEMBLER */ 00562000 * /* INPUT FOR THE PURPOSE OF LABEL VERIFICATION. COMMENTS, AND */ 00563000 * /* OTHER UNLIKELY CANDIDATES FOR MACRO CALLS ARE ELIMINATED HERE.*/ 00564000 * /* */ 00565000 * /*****************************************************************/ 00566000 * 0208 00567000 *LABELCK: 0208 00568000 * PROCEDURE; 0208 00569000 LABELCK STM @14,@12,12(@13) 0208 00570000 * IF SCPPMLN=ZERO /* ZERO LABEL LENGTH? */ 00571000 * THEN /* YES - NON-ALPHANUMERIC */ 00572000 LH @14,SCPPMLN 0209 00573000 LTR @14,@14 0209 00574000 BNZ @RF00209 0209 00575000 * SCPRET=STOPCODE; /* SKIP IT... NOT A CANDIDATE */ 00576000 MVI SCPRET,X'04' 0210 00577000 * ELSE /* OTHERWISE - JUST SKIP PAST */ 00578000 * SCPRET=GOOD; /* THE LABEL AND CONTINUE */ 00579000 B @RC00209 0211 00580000 @RF00209 MVI SCPRET,X'00' 0211 00581000 * END LABELCK; /* RETURN TO SCAN */ 00582000 * 0212 00583000 @EL00004 DS 0H 0212 00584000 @EF00004 DS 0H 0212 00585000 @ER00004 LM @14,@12,12(@13) 0212 00586000 BR @14 0212 00587000 * /*****************************************************************/ 00588000 * /* */ 00589000 * /* THE FOLLOWING SUBROUTINE IS INVOKED FROM SCAN OF ASSEMBLER */ 00590000 * /* INPUT FOR THE PURPOSE OF SAVING MACRO CALLS IN AN ARRAY */ 00591000 * /* */ 00592000 * /*****************************************************************/ 00593000 * 0213 00594000 *MACSV010: 0213 00595000 * PROCEDURE; 0213 00596000 MACSV010 STM @14,@12,@SA00005 0213 00597000 * SCPRET=GOOD; /* INSURE RETURN CODE */ 00598000 MVI SCPRET,X'00' 0214 00599000 * IF(SCPPMLN<=HIGHLIM /* HIGH LIMIT EXCEEDED? */ 00600000 * &SCPPMLN>=LOWLIM) /* LOW LIMIT EXCEEDED? */ 00601000 * ³SCNSTR(1:LENGTH(CVT))=CVT /* OR THIS IS THE CVT */ 00602000 * THEN /* WANT TO LOOK AT THIS ONE */ 00603000 LH @14,SCPPMLN 0215 00604000 CH @14,@CH00040 0215 00605000 BH @GL00003 0215 00606000 CH @14,@CH00077 0215 00607000 BNL @RT00215 0215 00608000 @GL00003 L @14,SCPCHAR 0215 00609000 CLC SCNSTR(4,@14),@CC00079 0215 00610000 BNE @RF00215 0215 00611000 @RT00215 DS 0H 0216 00612000 * DO; /* ADD MACRO TO THE LIST */ 00613000 * MACSAVE=SCNSTR(1:SCPPMLN); /* SAVE THE NAME */ 00614000 MVI MACSAVE+1,C' ' 0217 00615000 MVC MACSAVE+2(6),MACSAVE+1 0217 00616000 LH @14,SCPPMLN 0217 00617000 BCTR @14,0 0217 00618000 L @10,SCPCHAR 0217 00619000 EX @14,@SM00361 0217 00620000 * BUFBASE=ADDR(MACTBL); /* SET TO BASE BUFFER */ 00621000 LA @14,MACTBL 0218 00622000 ST @14,@TF00001 0218 00623000 MVC BUFBASE(3),@TF00001+1 0218 00624000 *MACLOOP: 0219 00625000 * DO I=1 TO MACCTR; /* LOOK AT ALL NAMES IN BUFFER */ 00626000 MACLOOP LA @14,1 0219 00627000 B @DE00219 0219 00628000 @DL00219 DS 0H 0220 00629000 * IF MACCALL(I)=MACSAVE /* IS IT THE SAME NAME ? */ 00630000 * THEN 0220 00631000 LR @10,@14 0220 00632000 SLA @10,3 0220 00633000 L @01,BUFBASE-1 0220 00634000 LA @01,0(,@01) 0220 00635000 ALR @01,@10 0220 00636000 AL @01,@CF00357 0220 00637000 CLC MACCALL-4(8,@01),MACSAVE 0220 00638000 BE @RT00220 0220 00639000 * RETURN; /* YES - RETURN TO SCAN */ 00640000 * END; 0222 00641000 AH @14,@CH00043 0222 00642000 @DE00219 ST @14,@TF00001 0222 00643000 MVC I(3),@TF00001+1 0222 00644000 L @10,BUFBASE-1 0222 00645000 LA @10,0(,@10) 0222 00646000 MVC @ZT00003+3(1),MACCTR(@10) 0222 00647000 C @14,@ZT00003 0222 00648000 BNH @DL00219 0222 00649000 * IF MACCTR=MACLIM /* OUT OF ROOM IN THIS BUFFER ? */ 00650000 * THEN 0223 00651000 L @14,BUFBASE-1 0223 00652000 LA @14,0(,@14) 0223 00653000 CLI MACCTR(@14),10 0223 00654000 BNE @RF00223 0223 00655000 * DO; 0224 00656000 * IF MACNXTª=ZERO /* IS THERE A NEXT BUFFER ? */ 00657000 * THEN 0225 00658000 MVC @ZT00001+1(3),MACNXT(@14) 0225 00659000 L @10,@ZT00001 0225 00660000 LTR @10,@10 0225 00661000 BZ @RF00225 0225 00662000 * DO; 0226 00663000 * BUFBASE=MACNXT; /* POINT TO NEXT BUFFER */ 00664000 MVC @ZT00001+1(3),MACNXT(@14) 0227 00665000 L @14,@ZT00001 0227 00666000 ST @14,@TF00001 0227 00667000 MVC BUFBASE(3),@TF00001+1 0227 00668000 * GO TO MACLOOP; /* YES - CONTINUE */ 00669000 B MACLOOP 0228 00670000 * END; 0229 00671000 * ELSE 0230 00672000 * DO; 0230 00673000 @RF00225 DS 0H 0231 00674000 * GEN(GETMAIN EC,LV=84,A=NXTBUF); 0231 00675000 GETMAIN EC,LV=84,A=NXTBUF 00676000 * IF RTNCDEª=GOOD /* IS STORAGE AVAILABLE ? */ 00677000 * THEN 0232 00678000 LTR RTNCDE,RTNCDE 0232 00679000 BZ @RF00232 0232 00680000 * DO; /* NO - SET UP FOR ERROR */ 00681000 * EXCERR=ON; /* SET ERROR INDICATOR */ 00682000 OI EXCERR,B'01000000' 0234 00683000 * SCPRET=SCNERR; /* TELL SCAN TO STOP */ 00684000 MVI SCPRET,X'08' 0235 00685000 * RETURN; /* RETURN TO SCAN */ 00686000 @EL00005 DS 0H 0236 00687000 @EF00005 DS 0H 0236 00688000 @ER00005 LM @14,@12,@SA00005 0236 00689000 BR @14 0236 00690000 * END; 0237 00691000 * MACNXT=NXTBUF; /* CHAIN IN THE NEW BUFFER */ 00692000 @RF00232 L @14,BUFBASE-1 0238 00693000 LA @14,0(,@14) 0238 00694000 MVC MACNXT(3,@14),NXTBUF+1 0238 00695000 * BUFBASE=MACNXT; /* PICK UP ADDRESSABILITY */ 00696000 MVC @ZT00001+1(3),MACNXT(@14) 0239 00697000 L @14,@ZT00001 0239 00698000 ST @14,@TF00001 0239 00699000 MVC BUFBASE(3),@TF00001+1 0239 00700000 * MACCTR=ZERO; /* RESET NAME COUNTER */ 00701000 L @14,BUFBASE-1 0240 00702000 LA @14,0(,@14) 0240 00703000 MVI MACCTR(@14),X'00' 0240 00704000 * MACNXT=ZERO; /* AND ITS CHAIN POINTER */ 00705000 SLR @10,@10 0241 00706000 ST @10,@TF00001 0241 00707000 MVC MACNXT(3,@14),@TF00001+1 0241 00708000 * END; 0242 00709000 * END; 0243 00710000 * MACCTR=MACCTR+1; /* BUMP THE NAME COUNT */ 00711000 @RF00223 L @14,BUFBASE-1 0244 00712000 LA @14,0(,@14) 0244 00713000 LA @10,1 0244 00714000 MVC @ZT00003+3(1),MACCTR(@14) 0244 00715000 AL @10,@ZT00003 0244 00716000 STC @10,MACCTR(,@14) 0244 00717000 * MACCALL(MACCTR)=MACSAVE; /* INSERT THE NAME */ 00718000 SLA @10,3 0245 00719000 ALR @14,@10 0245 00720000 AL @14,@CF00357 0245 00721000 MVC MACCALL-4(8,@14),MACSAVE 0245 00722000 * SCPRET=GOOD; /* INDICATE ALL OK TO SCAN */ 00723000 MVI SCPRET,X'00' 0246 00724000 * END; 0247 00725000 * ELSE /* INDICATE STOP SCAN */ 00726000 * SCPRET=STOPCODE; /* INDICATE NO MACRO CALL */ 00727000 B @RC00215 0248 00728000 @RF00215 MVI SCPRET,X'04' 0248 00729000 * END MACSV010; /* RETURN TO SCAN */ 00730000 B @EL00005 0249 00731000 * END HMASMASM 0250 00732000 * 0250 00733000 */* THE FOLLOWING INCLUDE STATEMENTS WERE FOUND IN THIS PROGRAM. */ 00734000 */*%INCLUDE SYSLIB (HMASMIOP) */ 00735000 */*%INCLUDE SYSLIB (HMASMCCA) */ 00736000 */*%INCLUDE SYSLIB (HMASMSCP) */ 00737000 * 0250 00738000 * ; 0250 00739000 @DATA DS 0H 00740000 @CH00043 DC H'1' 00741000 @CH00077 DC H'6' 00742000 @CH00040 DC H'8' 00743000 @CH00064 DC H'71' 00744000 @CH00062 DC H'80' 00745000 @CH00074 DC H'255' 00746000 @SM00359 MVC MODNAME(0),SCNSTR(@10) 00747000 @SM00361 MVC MACSAVE(0),SCNSTR(@10) 00748000 DS 0F 00749000 @AL00112 EQU * LIST WITH 1 ARGUMENT(S) 00750000 @AL00131 DC A(HMASMSCP) LIST WITH 1 ARGUMENT(S) 00751000 DS 0F 00752000 @SA00001 DS 18F 00753000 @PC00001 DS 2F 00754000 @SA00005 DS 15F 00755000 @AL00001 DS 1A 00756000 @TF00001 DS F 00757000 @ZTEMPS DS 0F 00758000 @ZT00001 DC F'0' 00759000 @ZT00003 DC F'0' 00760000 @ZTEMPND EQU * 00761000 @ZLEN EQU @ZTEMPND-@ZTEMPS 00762000 DS 0F 00763000 @CF00357 DC F'-4' 00764000 @CV00103 DC V(HMASMIO) 00765000 @CV00104 DC V(HMASMSCN) 00766000 DS 0D 00767000 SEQNO DS F 00768000 NXTBUF DC A(0) 00769000 DS CL1 00770000 IOPPTR DS AL3 00771000 DS CL1 00772000 I DS AL3 00773000 RTNCODE DC AL1(0) 00774000 BUFBASE DC AL3(0) 00775000 @CC00070 DC C'/*' 00776000 @CC00072 DC C'//' 00777000 @CC00079 DC C'CVT ' 00778000 DS CL4 00779000 SEQPACK DS CL8 00780000 MACSAVE DS CL8 00781000 MODNAME DS CL8 00782000 SWITCHES DS BL1 00783000 ORG SWITCHES 00784000 CONTINSW DS BL1 00785000 EXCERR EQU SWITCHES+0 00786000 @NM00001 EQU SWITCHES+0 00787000 ORG SWITCHES+1 00788000 MACTBL DS CL84 00789000 DS CL3 00790000 HMASMSCP DS CL22 00791000 ORG HMASMSCP 00792000 SCPCHAR DS AL4 00793000 SCPSRCH DS AL4 00794000 SCPWKAR DS AL4 00795000 SCPIORTN DS AL4 00796000 SCPINLN DS FL2 00797000 SCPPMLN DS FL2 00798000 SCPEOR DS BL1 00799000 ORG SCPEOR 00800000 SCPCONT DS BL1 00801000 SCPNOCT EQU SCPEOR+0 00802000 SCPCOMNT EQU SCPEOR+0 00803000 @NM00014 EQU SCPEOR+0 00804000 ORG HMASMSCP+21 00805000 SCPRET DS FL1 00806000 ORG HMASMSCP+22 00807000 ZAPAREA DC 50X'FF' 00808000 HMASMASM CSECT 00809000 * TABLES FOR JCL SCAN FOR MODULE NAME 00810000 MODK DSCAN KEY='MOD=',SUCC=MODSV,ALT=SYSPK 00811000 MODSV DSCAN ROUT=SAVMOD10 00812000 SYSPK DSCAN KEY='SYSPUNCH',SUCC=DSNLOOK,ALT=BUMP1 00813000 BUMP1 DSCAN ROUT=BUMP010,SUCC=MODK,MINLEN=0 00814000 DSNLOOK DSCAN KEY='DSN',ALT=BUMP2,SUCC=LPARENK 00815000 BUMP2 DSCAN ROUT=BUMP010,SUCC=DSNLOOK,MINLEN=0 00816000 LPARENK DSCAN KEY='(',ALT=BUMP3,SUCC=MODSV 00817000 BUMP3 DSCAN ROUT=BUMP010,SUCC=LPARENK,MINLEN=0 00818000 * TABLES FOR ASSEMBLER INPUT SCAN FOR MACRO NAMES 00819000 MACSTART DSCAN KEY=' ',BLANKS=ON,SUCC=OPSV,ALT=MLABELK 00820000 MLABELK DSCAN KEY='.',ALT=LABELK,SUCC=ASTERCK 00821000 ASTERCK DSCAN KEY='*',ALT=LABELK 00822000 LABELK DSCAN SUCC=OPSV,MINLEN=0,ROUT=LABELCK 00823000 OPSV DSCAN ROUT=MACSV010,MINLEN=0 00824000 HMASMASM CSECT 00825000 @00 EQU 00 EQUATES FOR REGISTERS 0-15 00826000 @01 EQU 01 00827000 @02 EQU 02 00828000 @03 EQU 03 00829000 @04 EQU 04 00830000 @05 EQU 05 00831000 @06 EQU 06 00832000 @07 EQU 07 00833000 @08 EQU 08 00834000 @09 EQU 09 00835000 @10 EQU 10 00836000 @11 EQU 11 00837000 @12 EQU 12 00838000 @13 EQU 13 00839000 @14 EQU 14 00840000 @15 EQU 15 00841000 K EQU @02 00842000 CCAPTR EQU @11 00843000 RTNCDE EQU @15 00844000 SCNSTR EQU 0 00845000 ASMREC EQU 0 00846000 SEQUENCE EQU ASMREC+72 00847000 LASTDIG EQU SEQUENCE+7 00848000 MACBUF EQU 0 00849000 MACCTR EQU MACBUF 00850000 MACNXT EQU MACBUF+1 00851000 MACCALL EQU MACBUF+4 00852000 HMASMIOP EQU 0 00853000 IOPDSID EQU HMASMIOP 00854000 IOPFUNCT EQU HMASMIOP+1 00855000 IOPRETRN EQU HMASMIOP+2 00856000 IOPBUFAD EQU HMASMIOP+4 00857000 IOPNAME EQU HMASMIOP+8 00858000 IOPTYPE EQU IOPNAME 00859000 IOPCDTYP EQU IOPTYPE 00860000 IOPTTR EQU HMASMIOP+16 00861000 IOPUDATA EQU HMASMIOP+20 00862000 HMASMCCA EQU 0 00863000 CCAIOPTR EQU HMASMCCA+8 00864000 CCAOPT EQU HMASMCCA+76 00865000 CCAFLAG1 EQU HMASMCCA+77 00866000 CCAFLAG2 EQU HMASMCCA+78 00867000 CCAFLAG3 EQU HMASMCCA+79 00868000 BUFFER EQU 0 00869000 MAXJCL EQU 0 00870000 IOPMOCDS EQU IOPUDATA 00871000 IOPMODID EQU IOPMOCDS 00872000 IOPLMCDS EQU IOPUDATA 00873000 IOPFLGS2 EQU IOPLMCDS 00874000 IOPFLGS3 EQU IOPLMCDS+1 00875000 IOPMACDS EQU IOPUDATA 00876000 IOPASMOD EQU IOPMACDS+2 00877000 IOPPTCDS EQU IOPUDATA 00878000 IOPFLGS5 EQU IOPPTCDS 00879000 IOPSTAT EQU IOPFLGS5 00880000 IOPPNTRY EQU IOPPTCDS+4 00881000 IOPDLCDS EQU IOPUDATA 00882000 IOPSYCDS EQU IOPUDATA 00883000 IOPFLGS7 EQU IOPSYCDS 00884000 IOPSTCMP EQU IOPUDATA 00885000 IOPPTSNT EQU IOPUDATA 00886000 IOPPFLG1 EQU IOPPTSNT 00887000 IOPPLEPR EQU IOPPTSNT+1 00888000 IOPPNUM EQU IOPPTSNT+2 00889000 AGO .@UNREFD START UNREFERENCED COMPONENTS 00890000 IOPALISL EQU IOPPTSNT+22 00891000 IOPINDLB EQU IOPPTSNT+14 00892000 IOPDISTN EQU IOPPTSNT+7 00893000 IOPPDIG EQU IOPPNUM+2 00894000 IOPPID EQU IOPPNUM 00895000 IOPPNE EQU IOPPLEPR 00896000 IOPPDC EQU IOPPLEPR 00897000 IOPPREFR EQU IOPPLEPR 00898000 IOPPOVLY EQU IOPPLEPR 00899000 IOPPSCTR EQU IOPPLEPR 00900000 IOPPREUS EQU IOPPLEPR 00901000 IOPPRENT EQU IOPPLEPR 00902000 @NM00010 EQU IOPPLEPR 00903000 @NM00009 EQU IOPPFLG1 00904000 IOPLEFND EQU IOPPFLG1 00905000 IOPDALIS EQU IOPPFLG1 00906000 IOPTALIS EQU IOPPFLG1 00907000 IOPLIBTX EQU IOPPFLG1 00908000 IOPLIBLK EQU IOPPFLG1 00909000 IOPSTNEW EQU IOPSTCMP+8 00910000 IOPSTOLD EQU IOPSTCMP 00911000 IOPPDLM EQU IOPSYCDS+8 00912000 IOPPEMAX EQU IOPSYCDS+6 00913000 IOPNUCID EQU IOPSYCDS+5 00914000 IOPSREL EQU IOPSYCDS+1 00915000 @NM00008 EQU IOPFLGS7 00916000 IOPTSO EQU IOPFLGS7 00917000 IOPDSYS EQU IOPDLCDS 00918000 IOPPIND EQU IOPPNTRY+8 00919000 IOPPMODS EQU IOPPNTRY 00920000 IOPDATE EQU IOPPTCDS+1 00921000 @NM00007 EQU IOPFLGS5 00922000 IOPDUMMP EQU IOPSTAT 00923000 IOPFORCE EQU IOPSTAT 00924000 IOPACC EQU IOPSTAT 00925000 IOPAPP EQU IOPSTAT 00926000 @NM00006 EQU IOPMACDS 00927000 IOPSYSLB EQU IOPLMCDS+2 00928000 @NM00005 EQU IOPFLGS3 00929000 IOPCHREP EQU IOPFLGS3 00930000 IOPLINK EQU IOPFLGS3 00931000 IOPCOPY EQU IOPFLGS3 00932000 IOPNE EQU IOPFLGS2 00933000 IOPDC EQU IOPFLGS2 00934000 IOPREFR EQU IOPFLGS2 00935000 IOPOVLY EQU IOPFLGS2 00936000 IOPSCTR EQU IOPFLGS2 00937000 IOPREUS EQU IOPFLGS2 00938000 IOPRENT EQU IOPFLGS2 00939000 @NM00004 EQU IOPFLGS2 00940000 IOPLMODS EQU IOPMOCDS+9 00941000 IOPDLIB EQU IOPMOCDS+2 00942000 CCABLKSZ EQU HMASMCCA+92 00943000 CCASPDCB EQU HMASMCCA+88 00944000 CCADATE EQU HMASMCCA+85 00945000 CCASREL EQU HMASMCCA+81 00946000 CCANUCID EQU HMASMCCA+80 00947000 @NM00013 EQU CCAFLAG3 00948000 CCACOPYP EQU CCAFLAG3 00949000 CCALINKP EQU CCAFLAG3 00950000 CCAZAPP EQU CCAFLAG3 00951000 @NM00012 EQU CCAFLAG2 00952000 CCAICSB EQU CCAFLAG2 00953000 CCATERM EQU CCAFLAG2 00954000 CCASVCLB EQU CCAFLAG2 00955000 CCATSO EQU CCAFLAG2 00956000 CCACPYCP EQU CCAFLAG2 00957000 CCANCPTF EQU CCAFLAG2 00958000 CCALSCDS EQU CCAFLAG2 00959000 CCALSLOG EQU CCAFLAG1 00960000 CCAUPDU EQU CCAFLAG1 00961000 CCAUPDJ EQU CCAFLAG1 00962000 CCARES EQU CCAFLAG1 00963000 CCAREJ EQU CCAFLAG1 00964000 CCAACCPT EQU CCAFLAG1 00965000 CCAAPPLY EQU CCAFLAG1 00966000 CCAREC EQU CCAFLAG1 00967000 @NM00011 EQU CCAOPT 00968000 CCACPOPT EQU CCAOPT 00969000 CCALKOPT EQU CCAOPT 00970000 CCABFPMX EQU HMASMCCA+74 00971000 CCABFMMX EQU HMASMCCA+72 00972000 CCAPEMAX EQU HMASMCCA+70 00973000 CCAMXERR EQU HMASMCCA+68 00974000 CCAJFPTS EQU HMASMCCA+64 00975000 CCAJFCDS EQU HMASMCCA+60 00976000 CCALKSIZ EQU HMASMCCA+56 00977000 CCAUPDTE EQU HMASMCCA+52 00978000 CCAIOSUP EQU HMASMCCA+48 00979000 CCASPZAP EQU HMASMCCA+44 00980000 CCACOPY EQU HMASMCCA+40 00981000 CCAASM EQU HMASMCCA+36 00982000 CCALKED EQU HMASMCCA+32 00983000 CCAPESIZ EQU HMASMCCA+28 00984000 CCAICLMD EQU HMASMCCA+24 00985000 CCAICMOD EQU HMASMCCA+20 00986000 CCAICPTF EQU HMASMCCA+16 00987000 CCAICT EQU HMASMCCA+12 00988000 CCABUFAD EQU HMASMCCA+4 00989000 CCAID EQU HMASMCCA 00990000 IOPUSERL EQU HMASMIOP+19 00991000 IOPBLKSI EQU IOPTTR 00992000 IOPNAME2 EQU IOPNAME+1 00993000 IOPMACID EQU HMASMIOP+3 00994000 @NM00003 EQU SEQUENCE 00995000 @NM00002 EQU ASMREC 00996000 .@UNREFD ANOP END UNREFERENCED COMPONENTS 00997000 @RT00169 EQU CONTIN10 00998000 @RT00171 EQU CONTIN20 00999000 @RF00201 EQU @EL00002 01000000 @RC00209 EQU @EL00004 01001000 @RT00220 EQU @EL00005 01002000 @RC00215 EQU @EL00005 01003000 @PB00005 EQU @EL00001 01004000 @PB00004 EQU @PB00005 01005000 @PB00003 EQU @PB00004 01006000 @PB00002 EQU @PB00003 01007000 @ENDDATA EQU * 01008000 END HMASMASM 01009000 ./ ADD SSI=33620490,NAME=HMASMCPI,SOURCE=1 COMPON=DN611 TITLE 'HMASMCPI - SMP COPY ROUTINE INTERFACE *00001000 ' 00002000 HMASMCPI CSECT , 0001 00003000 @MAINENT DS 0H 0001 00004000 USING *,@15 0001 00005000 B @PROLOG 0001 00006000 DC AL1(16) 0001 00007000 DC C'HMASMCPI 73.362' 0001 00008000 DROP @15 00009000 @PROLOG STM @14,@12,12(@13) 0001 00010000 BALR @12,0 0001 00011000 @PSTART LA @10,4095(,@12) 0001 00012000 USING @PSTART,@12 0001 00013000 USING @PSTART+4095,@10 0001 00014000 ST @13,@SA00001+4 0001 00015000 LA @14,@SA00001 0001 00016000 ST @14,8(,@13) 0001 00017000 LR @13,@14 0001 00018000 * */ 00019000 * 0112 00020000 * /*****************************************************************/ 00021000 * /* */ 00022000 * /* PROGRAM INITIALIZATION */ 00023000 * /* */ 00024000 * /*****************************************************************/ 00025000 * 0112 00026000 * IOPPTR=CCAIOPTR; /* ADDRESSIBILITY FOR IOP */ 00027000 MVC IOPPTR(4),CCAIOPTR(CCAPTR) 0112 00028000 * RFY 0113 00029000 * (ICTLMOD) BASED(CCAICLMD); 0113 00030000 * RFY 0114 00031000 * (ICTIXLF) BASED(ICTLCHN(I)); 0114 00032000 * RFY 0115 00033000 * (ICTMOD) BASED(CCAICT+ICTIXL(J)); 0115 00034000 * RFY 0116 00035000 * (ICTPTF) BASED(CCAICT+ICTPPTR(1)); 0116 00036000 * 0116 00037000 * /*****************************************************************/ 00038000 * /* */ 00039000 * /* THIS IS THE MAIN LOOP THRU THE ICT FROM THE LOAD MODULE TO THE*/ 00040000 * /* PTF. PURPOSE IS TO SELECT THE LOAD MODULE TO PROCESS WITH THE */ 00041000 * /* ASSOCIATED MODULES. IT CHECKS TO SEE IS A NEW COPY STATEMENT */ 00042000 * /* IS NEEDED AND CREATES ONE IF SO. AFTER ALL THE LOAD MODULES TO*/ 00043000 * /* BE COPIED HAVE BEEN PROCESSED IEBCOPY IS INVOKED. FINALLY THE */ 00044000 * /* RETURN CODE TO BE PASSED TO THE CALLING ROUTINE AND CONTROL IS*/ 00045000 * /* RETURNED. */ 00046000 * /* */ 00047000 * /*****************************************************************/ 00048000 * 0117 00049000 * DO I=1 TO TBLEND WHILE ICTLEND(I)ª=TBLEND;/* LOOP THRU LOAD MODS */ 00050000 LA @14,1 0117 00051000 B @DE00117 0117 00052000 @DL00117 MH @14,@CH00543 0117 00053000 L @09,CCAICLMD(,CCAPTR) 0117 00054000 ST @14,@TF00001 0117 00055000 ALR @14,@09 0117 00056000 AL @14,@CF00554 0117 00057000 CLC ICTLEND(2,@14),TBLEND 0117 00058000 BE @DC00117 0117 00059000 * IF ICTLINK(I)=OFF&ICTLCPL(I)=OFF/* COPY FUNCT AND NOT COMPLETE */ 00060000 * THEN 0118 00061000 LR @14,@09 0118 00062000 AL @14,@TF00001 0118 00063000 AL @14,@CF00555 0118 00064000 TM ICTLINK-9(@14),B'01000000' 0118 00065000 BNZ @RF00118 0118 00066000 AL @09,@TF00001 0118 00067000 AL @09,@CF00556 0118 00068000 TM ICTLCPL-10(@09),B'00000001' 0118 00069000 BNZ @RF00118 0118 00070000 * DO J=1 TO TBLEND WHILE ICTIXL(J)ª=TBLEND;/* LOOP THRU MODS */ 00071000 LA @14,1 0119 00072000 B @DE00119 0119 00073000 @DL00119 ALR @14,@14 0119 00074000 L @09,I 0119 00075000 MH @09,@CH00543 0119 00076000 L @08,CCAICLMD(,CCAPTR) 0119 00077000 ST @09,@TF00001 0119 00078000 ALR @09,@08 0119 00079000 AL @09,@CF00557 0119 00080000 MVC @ZT00001+1(3),ICTLCHN-30(@09) 0119 00081000 L @09,@ZT00001 0119 00082000 ST @14,@TF00002 0119 00083000 ALR @14,@09 0119 00084000 AL @14,@CF00558 0119 00085000 CLC ICTIXL(2,@14),TBLEND 0119 00086000 BE @DC00119 0119 00087000 * ICTPROCS(1)=ON; /* SET PTF INPROCESS BIT ON */ 00088000 L @14,CCAICT(,CCAPTR) 0120 00089000 AL @09,@TF00002 0120 00090000 AL @09,@CF00558 0120 00091000 MVC @ZT00002+2(2),ICTIXL(@09) 0120 00092000 L @09,@ZT00002 0120 00093000 ALR @09,@14 0120 00094000 MVC @ZT00002+2(2),ICTPPTR(@09) 0120 00095000 L @09,@ZT00002 0120 00096000 ALR @09,@14 0120 00097000 OI ICTPROCS(@09),B'00010000' 0120 00098000 * ICTLPROC(I)=ON; /* SET LM INPROCESS BIT ON */ 00099000 LR @09,@08 0121 00100000 AL @09,@TF00001 0121 00101000 AL @09,@CF00556 0121 00102000 OI ICTLPROC-10(@09),B'00000100' 0121 00103000 * ICTMPROC(1)=ON; /* SET MOD INPROCESS BIT ON */ 00104000 AL @08,@TF00001 0122 00105000 AL @08,@CF00557 0122 00106000 MVC @ZT00001+1(3),ICTLCHN-30(@08) 0122 00107000 L @01,@ZT00001 0122 00108000 AL @01,@TF00002 0122 00109000 AL @01,@CF00558 0122 00110000 MVC @ZT00002+2(2),ICTIXL(@01) 0122 00111000 AL @14,@ZT00002 0122 00112000 OI ICTMPROC(@14),B'10000000' 0122 00113000 *BLDCPY: 0123 00114000 * IF INPUTDDª=ICTFMLIB(1)³OUTPUTDDª=ICTTG1(I)/* SAME LIBS */ 00115000 * THEN 0123 00116000 BLDCPY L @14,J 0123 00117000 ALR @14,@14 0123 00118000 L @09,I 0123 00119000 MH @09,@CH00543 0123 00120000 L @08,CCAICLMD(,CCAPTR) 0123 00121000 ST @09,@TF00001 0123 00122000 ALR @09,@08 0123 00123000 AL @09,@CF00557 0123 00124000 MVC @ZT00001+1(3),ICTLCHN-30(@09) 0123 00125000 L @01,@ZT00001 0123 00126000 ALR @01,@14 0123 00127000 AL @01,@CF00558 0123 00128000 MVC @ZT00002+2(2),ICTIXL(@01) 0123 00129000 L @14,@ZT00002 0123 00130000 AL @14,CCAICT(,CCAPTR) 0123 00131000 CLC INPUTDD(8),ICTFMLIB(@14) 0123 00132000 BNE @RT00123 0123 00133000 AL @08,@TF00001 0123 00134000 AL @08,@CF00562 0123 00135000 CLC OUTPUTDD(8),ICTTG1-11(@08) 0123 00136000 BE @RF00123 0123 00137000 @RT00123 DS 0H 0124 00138000 * DO; 0124 00139000 * INPUTDD=ICTFMLIB(1); /* NO SET LIB FOR NEW CPY VERB */ 00140000 L @14,J 0125 00141000 ALR @14,@14 0125 00142000 L @09,I 0125 00143000 MH @09,@CH00543 0125 00144000 L @08,CCAICLMD(,CCAPTR) 0125 00145000 ST @09,@TF00001 0125 00146000 ALR @09,@08 0125 00147000 AL @09,@CF00557 0125 00148000 MVC @ZT00001+1(3),ICTLCHN-30(@09) 0125 00149000 L @01,@ZT00001 0125 00150000 ALR @01,@14 0125 00151000 AL @01,@CF00558 0125 00152000 MVC @ZT00002+2(2),ICTIXL(@01) 0125 00153000 L @14,@ZT00002 0125 00154000 AL @14,CCAICT(,CCAPTR) 0125 00155000 MVC INPUTDD(8),ICTFMLIB(@14) 0125 00156000 * OUTPUTDD=ICTTG1(I); /* SET LIB FOR NEW COPY VERB */ 00157000 AL @08,@TF00001 0126 00158000 AL @08,@CF00562 0126 00159000 MVC OUTPUTDD(8),ICTTG1-11(@08) 0126 00160000 * CALL WTRCOPY; /* WRITE COPY VERB */ 00161000 BAL @14,WTRCOPY 0127 00162000 * IF ICTLNOGO(I)=ON /* NOGO FLAG ON */ 00163000 * THEN 0128 00164000 L @14,I 0128 00165000 MH @14,@CH00543 0128 00166000 L @01,CCAICLMD(,CCAPTR) 0128 00167000 ALR @01,@14 0128 00168000 AL @01,@CF00556 0128 00169000 TM ICTLNOGO-10(@01),B'00000010' 0128 00170000 BO @RT00128 0128 00171000 * GOTO NEXTLM; /* SKIP FURTHER PROCESSING */ 00172000 * END; 0130 00173000 * IF ICTMNAME(1)=ICTLMNAM(I)/* MOD AND LM NAMES SAME */ 00174000 * THEN 0131 00175000 @RF00123 L @14,J 0131 00176000 ALR @14,@14 0131 00177000 L @09,I 0131 00178000 MH @09,@CH00543 0131 00179000 L @08,CCAICLMD(,CCAPTR) 0131 00180000 ST @09,@TF00001 0131 00181000 ALR @09,@08 0131 00182000 AL @09,@CF00557 0131 00183000 MVC @ZT00001+1(3),ICTLCHN-30(@09) 0131 00184000 L @01,@ZT00001 0131 00185000 ALR @01,@14 0131 00186000 AL @01,@CF00558 0131 00187000 MVC @ZT00002+2(2),ICTIXL(@01) 0131 00188000 L @14,@ZT00002 0131 00189000 AL @14,CCAICT(,CCAPTR) 0131 00190000 LR @09,@08 0131 00191000 AL @09,@TF00001 0131 00192000 AL @09,@CF00554 0131 00193000 CLC ICTMNAME(8,@14),ICTLMNAM(@09) 0131 00194000 BNE @RF00131 0131 00195000 * DO; 0132 00196000 * SELMOD=ICTLMNAM(I); /* INDICATE MOD TO BE SELECTED */ 00197000 AL @08,@TF00001 0133 00198000 AL @08,@CF00554 0133 00199000 MVC SELMOD(8),ICTLMNAM(@08) 0133 00200000 * CALL SELECT1; /* YES, CALL SELECT ROUTINE 1 */ 00201000 BAL @14,SELECT1 0134 00202000 * IF ICTLNOGO(I)=ON /* NOGO FLAG ON */ 00203000 * THEN 0135 00204000 L @14,I 0135 00205000 MH @14,@CH00543 0135 00206000 L @01,CCAICLMD(,CCAPTR) 0135 00207000 ALR @01,@14 0135 00208000 AL @01,@CF00556 0135 00209000 TM ICTLNOGO-10(@01),B'00000010' 0135 00210000 BO @RT00135 0135 00211000 * GOTO NEXTLM; /* SKIP FURTHER PROCESSING */ 00212000 * END; 0137 00213000 * ELSE 0138 00214000 * DO; 0138 00215000 B @RC00131 0138 00216000 @RF00131 DS 0H 0139 00217000 * MODNAME=ICTMNAME(1); /* STORE MOD NAME */ 00218000 L @14,J 0139 00219000 ALR @14,@14 0139 00220000 L @09,I 0139 00221000 MH @09,@CH00543 0139 00222000 L @01,CCAICLMD(,CCAPTR) 0139 00223000 ALR @01,@09 0139 00224000 AL @01,@CF00557 0139 00225000 MVC @ZT00001+1(3),ICTLCHN-30(@01) 0139 00226000 L @01,@ZT00001 0139 00227000 ALR @01,@14 0139 00228000 AL @01,@CF00558 0139 00229000 MVC @ZT00002+2(2),ICTIXL(@01) 0139 00230000 L @14,@ZT00002 0139 00231000 AL @14,CCAICT(,CCAPTR) 0139 00232000 MVC MODNAME(8),ICTMNAME(@14) 0139 00233000 * CALL SELECT2; /* CALL SELECT ROUTINE 2 */ 00234000 BAL @14,SELECT2 0140 00235000 * IF ICTLNOGO(I)=ON /* NOGO FLAG ON */ 00236000 * THEN 0141 00237000 L @14,I 0141 00238000 MH @14,@CH00543 0141 00239000 L @01,CCAICLMD(,CCAPTR) 0141 00240000 ALR @01,@14 0141 00241000 AL @01,@CF00556 0141 00242000 TM ICTLNOGO-10(@01),B'00000010' 0141 00243000 BO @RT00141 0141 00244000 * GOTO NEXTLM; /* SKIP FURTHER PROCESSING */ 00245000 * END; 0143 00246000 * IF ICTMALIS(1)=ON /* MOD HAVE ALIAS ENTRIES */ 00247000 * THEN 0144 00248000 @RC00131 L @14,J 0144 00249000 ALR @14,@14 0144 00250000 L @09,I 0144 00251000 MH @09,@CH00543 0144 00252000 L @01,CCAICLMD(,CCAPTR) 0144 00253000 ALR @01,@09 0144 00254000 AL @01,@CF00557 0144 00255000 MVC @ZT00001+1(3),ICTLCHN-30(@01) 0144 00256000 L @01,@ZT00001 0144 00257000 ALR @01,@14 0144 00258000 AL @01,@CF00558 0144 00259000 MVC @ZT00002+2(2),ICTIXL(@01) 0144 00260000 L @14,@ZT00002 0144 00261000 AL @14,CCAICT(,CCAPTR) 0144 00262000 TM ICTMALIS(@14),B'00100000' 0144 00263000 BNO @RF00144 0144 00264000 * CALL ALIAS; /* YES, CALL ALIAS */ 00265000 BAL @14,ALIAS 0145 00266000 * IF ICTTG2(I)ª=BLANKS /* MULTIPLE TARGET LIBRARIES */ 00267000 * THEN 0146 00268000 @RF00144 L @14,I 0146 00269000 MH @14,@CH00543 0146 00270000 L @09,CCAICLMD(,CCAPTR) 0146 00271000 ST @14,@TF00001 0146 00272000 ALR @14,@09 0146 00273000 AL @14,@CF00563 0146 00274000 CLC ICTTG2-19(8,@14),BLANKS 0146 00275000 BE @RF00146 0146 00276000 * DO; 0147 00277000 * ICTTG1(I)=ICTTG2(I); /* SET TARGET TO FIRST */ 00278000 LR @14,@09 0148 00279000 AL @14,@TF00001 0148 00280000 AL @14,@CF00562 0148 00281000 LR @08,@09 0148 00282000 AL @08,@TF00001 0148 00283000 AL @08,@CF00563 0148 00284000 MVC ICTTG1-11(8,@14),ICTTG2-19(@08) 0148 00285000 * ICTTG2(I)=BLANKS; /* SECOND TARGET IS BLANK */ 00286000 AL @09,@TF00001 0149 00287000 AL @09,@CF00563 0149 00288000 MVC ICTTG2-19(8,@09),BLANKS 0149 00289000 * GO TO BLDCPY; /* COPY INTO NEXT LIBRARY */ 00290000 B BLDCPY 0150 00291000 * END; 0151 00292000 * END; 0152 00293000 @RF00146 LA @14,1 0152 00294000 AL @14,J 0152 00295000 @DE00119 ST @14,J 0152 00296000 MVC @ZT00002+2(2),TBLEND 0152 00297000 C @14,@ZT00002 0152 00298000 BNH @DL00119 0152 00299000 @DC00119 DS 0H 0153 00300000 *NEXTLM: 0153 00301000 * END; 0153 00302000 @RF00118 DS 0H 0153 00303000 NEXTLM LA @14,1 0153 00304000 AL @14,I 0153 00305000 @DE00117 ST @14,I 0153 00306000 MVC @ZT00002+2(2),TBLEND 0153 00307000 C @14,@ZT00002 0153 00308000 BNH @DL00117 0153 00309000 @DC00117 DS 0H 0154 00310000 * CALL CLOSE; /* CALL CLOSE ROUTINE */ 00311000 BAL @14,CLOSE 0154 00312000 * RFY 0155 00313000 * LINKREG RSTD; 0155 00314000 * LINKREG=CCACOPY; /* ADDR OF BLDL ENTRY-IEBCOPY */ 00315000 L LINKREG,CCACOPY(,CCAPTR) 0156 00316000 * GENERATE; 0157 00317000 LINK DE=(LINKREG),PARAM=(0,DDNAMES),VL=1 EXEC IEBCOPY */ 00318000 * RFY 0158 00319000 * LINKREG UNRSTD; 0158 00320000 * IF RTNCODE>L4 /* SUCCESSFUL RETURN */ 00321000 * THEN 0159 00322000 CH RTNCODE,@CH00356 0159 00323000 BNH @RF00159 0159 00324000 * DO; 0160 00325000 * COPYERR=ON; /* INDICATE ERROR */ 00326000 OI COPYERR,B'10000000' 0161 00327000 * MGPMGNO3=M09; /* INDICATE TERTIARY SECTION */ 00328000 MVI MGPMGNO3,X'09' 0162 00329000 * CVD(RTNCODE,SAVE1); /* CONVERT TO DECIMAL */ 00330000 CVD RTNCODE,@TS00001 0163 00331000 MVC SAVE1(8),@TS00001 0163 00332000 * UNPK(SAVE2,SAVE1); /* UNPACK */ 00333000 UNPK SAVE2(8),SAVE1(8) 0164 00334000 * SIGN=MASK; /* ELIMINATE SIGN BIT */ 00335000 OI SIGN,B'11110000' 0165 00336000 * MGPVARPT(4)=ADDR(LINKRTN); /* ADDR OF RETURN CODE */ 00337000 LA @14,LINKRTN 0166 00338000 ST @14,MGPVARPT+12 0166 00339000 * CALL ERROR; /* CALL ERROR ROUTINE */ 00340000 BAL @14,ERROR 0167 00341000 * END; 0168 00342000 * ELSE 0169 00343000 * DO; 0169 00344000 B @RC00159 0169 00345000 @RF00159 DS 0H 0170 00346000 * MGPMGNO3=M09; /* INDICATE TERTIARY SECTION */ 00347000 MVI MGPMGNO3,X'09' 0170 00348000 * CVD(RTNCODE,SAVE1); /* CONVERT TO DECIMAL */ 00349000 CVD RTNCODE,@TS00001 0171 00350000 MVC SAVE1(8),@TS00001 0171 00351000 * UNPK(SAVE2,SAVE1); /* UNPACK */ 00352000 UNPK SAVE2(8),SAVE1(8) 0172 00353000 * SIGN=MASK; /* ELIMINATE SIGN BIT */ 00354000 OI SIGN,B'11110000' 0173 00355000 * MGPVARPT(4)=ADDR(LINKRTN); /* ADDR OF RETURN CODE */ 00356000 LA @14,LINKRTN 0174 00357000 ST @14,MGPVARPT+12 0174 00358000 * CALL COMPMSG; /* ISSUE COMPLETED MESSAGE */ 00359000 BAL @14,COMPMSG 0175 00360000 * CALL COMPLETE; /* COMPLETE ALL PTFS */ 00361000 BAL @14,COMPLETE 0176 00362000 * END; 0177 00363000 * RETURN CODE(FINISH); 0178 00364000 @RC00159 L @15,FINISH 0178 00365000 L @13,4(,@13) 0178 00366000 L @14,12(,@13) 0178 00367000 LM @00,@12,20(@13) 0178 00368000 BR @14 0178 00369000 * 0179 00370000 * /*****************************************************************/ 00371000 * /* */ 00372000 * /* THIS PROCEDURE SETS UP THE SELECT MEMBER= STATEMENT FOR MODULE*/ 00373000 * /* AND LOAD MODULE WITH IDENTICAL NAMES. */ 00374000 * /* */ 00375000 * /*****************************************************************/ 00376000 * 0179 00377000 *SELECT1: 0179 00378000 * PROCEDURE OPTIONS(SAVEAREA); 0179 00379000 @EL00001 L @13,4(,@13) 0179 00380000 @EF00001 DS 0H 0179 00381000 @ER00001 LM @14,@12,12(@13) 0179 00382000 BR @14 0179 00383000 @PB00001 DS 0H 0179 00384000 SELECT1 STM @14,@12,12(@13) 0179 00385000 ST @13,@SA00002+4 0179 00386000 LA @14,@SA00002 0179 00387000 ST @14,8(,@13) 0179 00388000 LR @13,@14 0179 00389000 * BUFFER=BLANK; /* CLEAR BUFFER AREA */ 00390000 L @14,IOPPTR 0180 00391000 L @14,IOPBUFAD(,@14) 0180 00392000 MVI BUFFER+1(@14),C' ' 0180 00393000 MVC BUFFER+2(78,@14),BUFFER+1(@14) 0180 00394000 MVI BUFFER(@14),C' ' 0180 00395000 * BUFFER(L2:L17)=SELECT; /* MOVE SELECT VERB */ 00396000 MVC BUFFER+1(16,@14),SELECT 0181 00397000 * LX=L8; /* SET LENGTH FIELD */ 00398000 LA @14,8 0182 00399000 ST @14,LX 0182 00400000 *CHECK: 0183 00401000 * IF SELMOD(LX)=BLANK /* LAST POSITION BLANK */ 00402000 * THEN 0183 00403000 CHECK L @14,LX 0183 00404000 LA @01,SELMOD-1(@14) 0183 00405000 CLI 0(@01),C' ' 0183 00406000 BNE @RF00183 0183 00407000 * DO; 0184 00408000 * LX=LX-L1; /* CK NEXT POSITION */ 00409000 BCTR @14,0 0185 00410000 ST @14,LX 0185 00411000 * GOTO CHECK; /* BRANCH BACK TO TEST */ 00412000 B CHECK 0186 00413000 * END; 0187 00414000 * LY=L17+LX; /* CALC DISP IN BUFFER */ 00415000 @RF00183 LA @14,17 0188 00416000 AL @14,LX 0188 00417000 ST @14,LY 0188 00418000 * BUFFER(L18:LY)=SELMOD; /* MOVE LM NAME */ 00419000 L @01,IOPPTR 0189 00420000 L @09,IOPBUFAD(,@01) 0189 00421000 LR @08,@14 0189 00422000 SH @08,@CH00545 0189 00423000 EX @08,@SM00565 0189 00424000 * LZ=LY+L5; /* CALC PLACE TO MOVE FIELDS */ 00425000 LA @08,5 0190 00426000 ALR @08,@14 0190 00427000 ST @08,LZ 0190 00428000 * LY=LY+L1; /* CALC PLACE TO MOVE FIELDS */ 00429000 AH @14,@CH00352 0191 00430000 ST @14,LY 0191 00431000 * BUFFER(LY:LZ)=REPLACE; /* MOVE IN SELECT PARM FIELDS */ 00432000 ALR @09,@14 0192 00433000 AL @09,@CF00567 0192 00434000 SLR @08,@14 0192 00435000 EX @08,@SM00568 0192 00436000 * CALL IORTN; /* CALL IOP ROUTINE */ 00437000 BAL @14,IORTN 0193 00438000 * END SELECT1; 0194 00439000 @EL00002 L @13,4(,@13) 0194 00440000 @EF00002 DS 0H 0194 00441000 @ER00002 LM @14,@12,12(@13) 0194 00442000 BR @14 0194 00443000 * 0195 00444000 * /*****************************************************************/ 00445000 * /* */ 00446000 * /* THIS PROCEDURE SETS UP THE SELECT MEMBER= STATEMENT FOR MODULE*/ 00447000 * /* AND LOAD MODULE WITH DIFFERENT NAMES. */ 00448000 * /* */ 00449000 * /*****************************************************************/ 00450000 * 0195 00451000 *SELECT2: 0195 00452000 * PROCEDURE OPTIONS(SAVEAREA); 0195 00453000 SELECT2 STM @14,@12,12(@13) 0195 00454000 ST @13,@SA00003+4 0195 00455000 LA @14,@SA00003 0195 00456000 ST @14,8(,@13) 0195 00457000 LR @13,@14 0195 00458000 * BUFFER=BLANK; /* CLEAR BUFFER AREA */ 00459000 L @14,IOPPTR 0196 00460000 L @14,IOPBUFAD(,@14) 0196 00461000 MVI BUFFER+1(@14),C' ' 0196 00462000 MVC BUFFER+2(78,@14),BUFFER+1(@14) 0196 00463000 MVI BUFFER(@14),C' ' 0196 00464000 * BUFFER(L2:L17)=SELECT; /* MOVE SELECT VERB */ 00465000 MVC BUFFER+1(16,@14),SELECT 0197 00466000 * LX=L8; /* SET LENGTH FIELD */ 00467000 LA @14,8 0198 00468000 ST @14,LX 0198 00469000 *CHECK1: 0199 00470000 * IF MODNAME(LX)=BLANK /* LAST CHAR BLANK */ 00471000 * THEN 0199 00472000 CHECK1 L @14,LX 0199 00473000 LA @01,MODNAME-1(@14) 0199 00474000 CLI 0(@01),C' ' 0199 00475000 BNE @RF00199 0199 00476000 * DO; 0200 00477000 * LX=LX-L1; /* CHECK NEXT POSITION */ 00478000 BCTR @14,0 0201 00479000 ST @14,LX 0201 00480000 * GOTO CHECK1; /* BRANCH BACK TO TEST */ 00481000 B CHECK1 0202 00482000 * END; 0203 00483000 * LY=L17+LX; /* CALC DISPLACEMENT */ 00484000 @RF00199 LA @14,17 0204 00485000 AL @14,LX 0204 00486000 ST @14,LY 0204 00487000 * BUFFER(L18:LY)=MODNAME; /* MOVE IN MOD NAME */ 00488000 L @01,IOPPTR 0205 00489000 L @09,IOPBUFAD(,@01) 0205 00490000 LR @08,@14 0205 00491000 SH @08,@CH00545 0205 00492000 EX @08,@SM00570 0205 00493000 * LY=LY+L1; /* CALC DISPLACEMENT */ 00494000 AH @14,@CH00352 0206 00495000 ST @14,LY 0206 00496000 * BUFFER(LY)=COMMA; /* MOVE IN A COMMA */ 00497000 ALR @09,@14 0207 00498000 AL @09,@CF00567 0207 00499000 MVC BUFFER(1,@09),COMMA 0207 00500000 * LX=L8; /* RESET LENGTH FIELD */ 00501000 LA @14,8 0208 00502000 ST @14,LX 0208 00503000 *CHECK2: 0209 00504000 * IF ICTLMNAM(I,LX)=BLANK /* LAST CHARACTER BLANK */ 00505000 * THEN 0209 00506000 CHECK2 L @14,LX 0209 00507000 L @09,I 0209 00508000 MH @09,@CH00543 0209 00509000 ALR @09,@14 0209 00510000 L @01,CCAICLMD(,CCAPTR) 0209 00511000 ALR @01,@09 0209 00512000 AL @01,@CF00572 0209 00513000 CLI ICTLMNAM(@01),C' ' 0209 00514000 BNE @RF00209 0209 00515000 * DO; 0210 00516000 * LX=LX-L1; /* CHECK NEXT CHARACTER */ 00517000 BCTR @14,0 0211 00518000 ST @14,LX 0211 00519000 * GOTO CHECK2; /* BRANCH BACK TO TEST */ 00520000 B CHECK2 0212 00521000 * END; 0213 00522000 * LZ=LY+LX; /* CALC DISPLACEMENT */ 00523000 @RF00209 L @14,LY 0214 00524000 LR @09,@14 0214 00525000 AL @09,LX 0214 00526000 ST @09,LZ 0214 00527000 * LY=LY+L1; /* CALC DISPLACEMENT */ 00528000 LA @08,1 0215 00529000 ALR @14,@08 0215 00530000 ST @14,LY 0215 00531000 * BUFFER(LY:LZ)=ICTLMNAM(I); /* MOVE IN LMOD NAME */ 00532000 L @01,IOPPTR 0216 00533000 L @07,IOPBUFAD(,@01) 0216 00534000 ALR @14,@07 0216 00535000 AL @14,@CF00567 0216 00536000 L @06,LY 0216 00537000 LCR @06,@06 0216 00538000 ALR @06,@09 0216 00539000 L @05,I 0216 00540000 MH @05,@CH00543 0216 00541000 L @01,CCAICLMD(,CCAPTR) 0216 00542000 ALR @01,@05 0216 00543000 AL @01,@CF00554 0216 00544000 EX @06,@SM00573 0216 00545000 * LY=LZ+L4; /* CALC DISPLACEMENT */ 00546000 LA @14,4 0217 00547000 ALR @14,@09 0217 00548000 ST @14,LY 0217 00549000 * LZ=LZ+L1; /* CALC DISPLACEMENT */ 00550000 ALR @09,@08 0218 00551000 ST @09,LZ 0218 00552000 * BUFFER(LZ:LY)=REPL; /* MOVE IN SELECT PARM FLDS */ 00553000 ALR @07,@09 0219 00554000 AL @07,@CF00567 0219 00555000 SLR @14,@09 0219 00556000 EX @14,@SM00575 0219 00557000 * CALL IORTN; /* CALL IOP ROUTINE */ 00558000 BAL @14,IORTN 0220 00559000 * END SELECT2; 0221 00560000 @EL00003 L @13,4(,@13) 0221 00561000 @EF00003 DS 0H 0221 00562000 @ER00003 LM @14,@12,12(@13) 0221 00563000 BR @14 0221 00564000 * 0222 00565000 * /*****************************************************************/ 00566000 * /* */ 00567000 * /* THIS PROCEDURE ISSUES A WRITE REQUEST TO THE SCR1 SCRATCH DATA*/ 00568000 * /* SET. */ 00569000 * /* */ 00570000 * /*****************************************************************/ 00571000 * 0222 00572000 *IORTN: 0222 00573000 * PROCEDURE OPTIONS(SAVEAREA); 0222 00574000 IORTN STM @14,@12,12(@13) 0222 00575000 ST @13,@SA00004+4 0222 00576000 LA @14,@SA00004 0222 00577000 ST @14,8(,@13) 0222 00578000 LR @13,@14 0222 00579000 * IOPDSID=IOPSCR1; /* SET DATA SET ID */ 00580000 L @14,IOPPTR 0223 00581000 MVI IOPDSID(@14),X'03' 0223 00582000 * IOPFUNCT=IOPWRITE; /* SET I/O FUNCTION FOR WRITE */ 00583000 MVI IOPFUNCT(@14),X'05' 0224 00584000 * CALL HMASMIO(HMASMIOP); /* CALL I/O ROUTINE */ 00585000 ST @14,@AL00001 0225 00586000 L @15,@CV00331 0225 00587000 LA @01,@AL00001 0225 00588000 BALR @14,@15 0225 00589000 * IF IOPRETRN=ZERO /* I/O SUCCESSFUL */ 00590000 * THEN 0226 00591000 L @14,IOPPTR 0226 00592000 SLR @09,@09 0226 00593000 IC @09,IOPRETRN(,@14) 0226 00594000 C @09,ZERO 0226 00595000 BE @RT00226 0226 00596000 * RETURN; /* YES, CONTINUE */ 00597000 * ELSE 0228 00598000 * DO; 0228 00599000 * COPYERR=ON; /* INDICATE ERROR */ 00600000 OI COPYERR,B'10000000' 0229 00601000 * MGPMGNO3=M01; /* INDICATE TERTIARY SECTION */ 00602000 MVI MGPMGNO3,X'01' 0230 00603000 * CALL ERROR; /* CALL ERROR ROUTINE */ 00604000 BAL @14,ERROR 0231 00605000 * END; 0232 00606000 * END IORTN; 0233 00607000 * 0233 00608000 @EL00004 L @13,4(,@13) 0233 00609000 @EF00004 DS 0H 0233 00610000 @ER00004 LM @14,@12,12(@13) 0233 00611000 BR @14 0233 00612000 * /*****************************************************************/ 00613000 * /* */ 00614000 * /* THIS PROCEDURE SETS UP THE COPY OUTDD=,INDD= STATEMENT. */ 00615000 * /* */ 00616000 * /*****************************************************************/ 00617000 * 0234 00618000 *WTRCOPY: 0234 00619000 * PROCEDURE OPTIONS(SAVEAREA); 0234 00620000 WTRCOPY STM @14,@12,12(@13) 0234 00621000 ST @13,@SA00005+4 0234 00622000 LA @14,@SA00005 0234 00623000 ST @14,8(,@13) 0234 00624000 LR @13,@14 0234 00625000 * BUFFER=BLANK; /* CLEAR BUFFER AREA */ 00626000 L @14,IOPPTR 0235 00627000 L @14,IOPBUFAD(,@14) 0235 00628000 MVI BUFFER+1(@14),C' ' 0235 00629000 MVC BUFFER+2(78,@14),BUFFER+1(@14) 0235 00630000 MVI BUFFER(@14),C' ' 0235 00631000 * BUFFER(L2:L12)=COPY; /* MOVE COPY AND OUTDD VERBS */ 00632000 MVC BUFFER+1(11,@14),COPY 0236 00633000 * LX=L8; /* SET LENGTH FIELD */ 00634000 LA @14,8 0237 00635000 ST @14,LX 0237 00636000 *CHECK3: 0238 00637000 * IF OUTPUTDD(LX)=BLANK /* LAST POSITION BLANK */ 00638000 * THEN 0238 00639000 CHECK3 L @14,LX 0238 00640000 LA @01,OUTPUTDD-1(@14) 0238 00641000 CLI 0(@01),C' ' 0238 00642000 BNE @RF00238 0238 00643000 * DO; 0239 00644000 * LX=LX-L1; /* CK NEXT POSITION */ 00645000 BCTR @14,0 0240 00646000 ST @14,LX 0240 00647000 * GOTO CHECK3; /* BRANCH BACK TO TEST */ 00648000 B CHECK3 0241 00649000 * END; 0242 00650000 * LY=L12+LX; /* CALC DISP IN BUFFER */ 00651000 @RF00238 LA @14,12 0243 00652000 AL @14,LX 0243 00653000 ST @14,LY 0243 00654000 * BUFFER(L13:LY)=OUTPUTDD; /* MOVE OUTPUT DD NAME */ 00655000 L @01,IOPPTR 0244 00656000 L @09,IOPBUFAD(,@01) 0244 00657000 LR @08,@14 0244 00658000 SH @08,@CH00547 0244 00659000 EX @08,@SM00577 0244 00660000 * LZ=LY+L6; /* CALC DISPLACEMENT */ 00661000 LA @08,6 0245 00662000 ALR @08,@14 0245 00663000 ST @08,LZ 0245 00664000 * LY=LY+L1; /* CALC DISPLACEMENT */ 00665000 LA @07,1 0246 00666000 ALR @14,@07 0246 00667000 ST @14,LY 0246 00668000 * BUFFER(LY:LZ)=INPUT; /* MOVE INDD VERB */ 00669000 ALR @14,@09 0247 00670000 AL @14,@CF00567 0247 00671000 L @06,LY 0247 00672000 LCR @06,@06 0247 00673000 ALR @06,@08 0247 00674000 EX @06,@SM00579 0247 00675000 * LY=LZ+L8; /* CALC DISPLACEMENT */ 00676000 LA @14,8 0248 00677000 ALR @14,@08 0248 00678000 ST @14,LY 0248 00679000 * LZ=LZ+L1; /* CALC DISPLACEMENT */ 00680000 ALR @08,@07 0249 00681000 ST @08,LZ 0249 00682000 * BUFFER(LZ:LY)=INPUTDD; /* MOVE INPUT DD NAME */ 00683000 ALR @09,@08 0250 00684000 AL @09,@CF00567 0250 00685000 SLR @14,@08 0250 00686000 EX @14,@SM00581 0250 00687000 * CALL IORTN; /* CALL IOP ROUTINE */ 00688000 BAL @14,IORTN 0251 00689000 * END WTRCOPY; 0252 00690000 @EL00005 L @13,4(,@13) 0252 00691000 @EF00005 DS 0H 0252 00692000 @ER00005 LM @14,@12,12(@13) 0252 00693000 BR @14 0252 00694000 * 0253 00695000 * /*****************************************************************/ 00696000 * /* */ 00697000 * /* THIS PROCEDURE ISSUES A CLOSE REQUEST FOR THE SCR1 SCRATCH */ 00698000 * /* DATA SET. */ 00699000 * /* */ 00700000 * /*****************************************************************/ 00701000 * 0253 00702000 *CLOSE: 0253 00703000 * PROCEDURE OPTIONS(SAVEAREA); 0253 00704000 CLOSE STM @14,@12,12(@13) 0253 00705000 ST @13,@SA00006+4 0253 00706000 LA @14,@SA00006 0253 00707000 ST @14,8(,@13) 0253 00708000 LR @13,@14 0253 00709000 * IOPDSID=IOPSCR1; /* INDICATE SCRATCH DS */ 00710000 L @14,IOPPTR 0254 00711000 MVI IOPDSID(@14),X'03' 0254 00712000 * IOPFUNCT=IOPCLOSE; /* CLOSE OPERATION */ 00713000 MVI IOPFUNCT(@14),X'04' 0255 00714000 * CALL HMASMIO(HMASMIOP); /* CALL I/O ROUTINE */ 00715000 ST @14,@AL00001 0256 00716000 L @15,@CV00331 0256 00717000 LA @01,@AL00001 0256 00718000 BALR @14,@15 0256 00719000 * IF IOPRETRN=ZERO /* I/O SUCCESSFUL */ 00720000 * THEN 0257 00721000 L @14,IOPPTR 0257 00722000 SLR @09,@09 0257 00723000 IC @09,IOPRETRN(,@14) 0257 00724000 C @09,ZERO 0257 00725000 BE @RT00257 0257 00726000 * RETURN; /* YES, CONTINUE */ 00727000 * ELSE 0259 00728000 * DO; 0259 00729000 * COPYERR=ON; /* INDICATE ERROR */ 00730000 OI COPYERR,B'10000000' 0260 00731000 * MGPMGNO3=M01; /* INDICATE TERTIARY SECTION */ 00732000 MVI MGPMGNO3,X'01' 0261 00733000 * CALL ERROR; /* CALL ERROR ROUTINE */ 00734000 BAL @14,ERROR 0262 00735000 * END; 0263 00736000 * END CLOSE; 0264 00737000 @EL00006 L @13,4(,@13) 0264 00738000 @EF00006 DS 0H 0264 00739000 @ER00006 LM @14,@12,12(@13) 0264 00740000 BR @14 0264 00741000 * 0265 00742000 * /*****************************************************************/ 00743000 * /* */ 00744000 * /* THIS PROCEDURE CHECKS FOR ALIAS ENTRIES AND SETS UP THE */ 00745000 * /* APPROPRIATE COPY AND SELECT STATEMENTS TO PROCESS THE ALIAS. */ 00746000 * /* */ 00747000 * /*****************************************************************/ 00748000 * 0265 00749000 *ALIAS: 0265 00750000 * PROCEDURE OPTIONS(SAVEAREA); 0265 00751000 ALIAS STM @14,@12,12(@13) 0265 00752000 ST @13,@SA00007+4 0265 00753000 LA @14,@SA00007 0265 00754000 ST @14,8(,@13) 0265 00755000 LR @13,@14 0265 00756000 * IOPDSID=IOPPTS; /* DATA SET ID */ 00757000 L @14,IOPPTR 0266 00758000 MVI IOPDSID(@14),X'06' 0266 00759000 * IOPFUNCT=IOPLOC; /* SET I/O FUNCT FOR LOCATE */ 00760000 MVI IOPFUNCT(@14),X'03' 0267 00761000 * IOPNAME=ICTMNAME(J); /* SET MOD NAME FOR LOC */ 00762000 L @09,J 0268 00763000 LR @08,@09 0268 00764000 MH @08,@CH00548 0268 00765000 ALR @09,@09 0268 00766000 L @07,I 0268 00767000 MH @07,@CH00543 0268 00768000 L @01,CCAICLMD(,CCAPTR) 0268 00769000 ALR @01,@07 0268 00770000 AL @01,@CF00557 0268 00771000 MVC @ZT00001+1(3),ICTLCHN-30(@01) 0268 00772000 L @01,@ZT00001 0268 00773000 ALR @01,@09 0268 00774000 AL @01,@CF00558 0268 00775000 MVC @ZT00002+2(2),ICTIXL(@01) 0268 00776000 L @09,@ZT00002 0268 00777000 AL @09,CCAICT(,CCAPTR) 0268 00778000 ALR @09,@08 0268 00779000 AL @09,@CF00583 0268 00780000 MVC IOPNAME(8,@14),ICTMNAME(@09) 0268 00781000 * CALL HMASMIO(HMASMIOP); /* CALL I/O ROUTINE */ 00782000 ST @14,@AL00001 0269 00783000 L @15,@CV00331 0269 00784000 LA @01,@AL00001 0269 00785000 BALR @14,@15 0269 00786000 * IF IOPRETRNª=ZERO /* I/O SUCCESSFUL */ 00787000 * THEN 0270 00788000 L @14,IOPPTR 0270 00789000 SLR @09,@09 0270 00790000 IC @09,IOPRETRN(,@14) 0270 00791000 C @09,ZERO 0270 00792000 BE @RF00270 0270 00793000 * DO; 0271 00794000 * MGPMGNO3=M01; /* INDICATE TERTIARY SECTION */ 00795000 MVI MGPMGNO3,X'01' 0272 00796000 * CALL ERROR; /* CALL ERROR ROUTINE */ 00797000 BAL @14,ERROR 0273 00798000 * RETURN; /* SKIP TO PROCESS NEXT LM */ 00799000 @EL00007 L @13,4(,@13) 0274 00800000 @EF00007 DS 0H 0274 00801000 @ER00007 LM @14,@12,12(@13) 0274 00802000 BR @14 0274 00803000 * END; 0275 00804000 * ELSE 0276 00805000 * DO A=1 TO TBLEND WHILE IOPALISL(A,1)ª=IOPEOLST;/* PROCESS ALIAS 00806000 * NAMES */ 00807000 @RF00270 LA A,1 0276 00808000 B @DE00276 0276 00809000 @DL00276 L @14,IOPPTR 0276 00810000 LR @02,A 0276 00811000 SLA @02,3 0276 00812000 SLR @09,@09 0276 00813000 IC @09,IOPALISL-8(@02,@14) 0276 00814000 CH @09,@CH00159 0276 00815000 BE @DC00276 0276 00816000 * SELMOD=IOPALISL(A); /* GET ALIAS NAME */ 00817000 ALR @14,@02 0277 00818000 MVC SELMOD(8),IOPALISL-8(@14) 0277 00819000 * CALL SELECT1; /* BUILD A SELECT STATEMENT */ 00820000 BAL @14,SELECT1 0278 00821000 * END; 0279 00822000 AH A,@CH00063 0279 00823000 @DE00276 MVC @ZT00002+2(2),TBLEND 0279 00824000 C A,@ZT00002 0279 00825000 BNH @DL00276 0279 00826000 @DC00276 DS 0H 0280 00827000 * END ALIAS; 0280 00828000 B @EL00007 0280 00829000 * RFY 0281 00830000 * (ICTPTF) BASED(CCAICPTF); 0281 00831000 * RFY 0282 00832000 * (ICTIXPF) BASED(ICTPCHN(K)); 0282 00833000 * RFY 0283 00834000 * (ICTMOD) BASED(CCAICT+ICTIXP(L)); 0283 00835000 * RFY 0284 00836000 * (ICTIXMF) BASED(ICTMCHN(1)); 0284 00837000 * RFY 0285 00838000 * (ICTLMOD) BASED(CCAICT+ICTIXM(M)); 0285 00839000 * 0286 00840000 * /*****************************************************************/ 00841000 * /* */ 00842000 * /* THIS PROCEDURE IS INVOKED WHEN AN ERROR OCCURS. IT SCANS THE */ 00843000 * /* ICT TO MARK ALL RELATED PTFS, MODULES, AND LOAD MODULES-- */ 00844000 * /* NOGO, INPROCESS, AND COMPLETE AND THEN ISSUES ERROR MESSAGES */ 00845000 * /* TO RECORD THE ERROR. */ 00846000 * /* */ 00847000 * /*****************************************************************/ 00848000 * 0286 00849000 *ERROR: 0286 00850000 * PROCEDURE OPTIONS(SAVEAREA); 0286 00851000 ERROR STM @14,@12,12(@13) 0286 00852000 ST @13,@SA00008+4 0286 00853000 LA @14,@SA00008 0286 00854000 ST @14,8(,@13) 0286 00855000 LR @13,@14 0286 00856000 * DO K=1 TO TBLEND WHILE ICTPEND(K)ª=TBLEND;/* LOOP THRU PTF */ 00857000 LA @14,1 0287 00858000 B @DE00287 0287 00859000 @DL00287 MH @14,@CH00032 0287 00860000 L @09,CCAICPTF(,CCAPTR) 0287 00861000 ST @14,@TF00001 0287 00862000 ALR @14,@09 0287 00863000 AL @14,@CF00584 0287 00864000 CLC ICTPEND(2,@14),TBLEND 0287 00865000 BE @DC00287 0287 00866000 * IF ICTPROCS(K)=ON&ICTPCPL(K)=OFF/* INPROCESS-NOT COMPLETE */ 00867000 * THEN 0288 00868000 LR @14,@09 0288 00869000 AL @14,@TF00001 0288 00870000 AL @14,@CF00585 0288 00871000 TM ICTPROCS-8(@14),B'00010000' 0288 00872000 BNO @RF00288 0288 00873000 TM ICTPCPL-8(@14),B'00000001' 0288 00874000 BNZ @RF00288 0288 00875000 * DO; 0289 00876000 * IF COPYERR=ON /* ERROR */ 00877000 * THEN 0290 00878000 TM COPYERR,B'10000000' 0290 00879000 BNO @RF00290 0290 00880000 * ICTPNOGO(K)=ON; /* SET NOGO BIT IN PTF */ 00881000 AL @09,@TF00001 0291 00882000 AL @09,@CF00585 0291 00883000 OI ICTPNOGO-8(@09),B'00000100' 0291 00884000 * DO L=1 TO TBLEND WHILE ICTIXP(L)ª=TBLEND;/* SEARCH MODS */ 00885000 @RF00290 LA @14,1 0292 00886000 B @DE00292 0292 00887000 @DL00292 ALR @14,@14 0292 00888000 L @09,K 0292 00889000 MH @09,@CH00032 0292 00890000 L @01,CCAICPTF(,CCAPTR) 0292 00891000 ALR @01,@09 0292 00892000 AL @01,@CF00557 0292 00893000 MVC @ZT00001+1(3),ICTPCHN-9(@01) 0292 00894000 L @09,@ZT00001 0292 00895000 ST @14,@TF00001 0292 00896000 ALR @14,@09 0292 00897000 AL @14,@CF00558 0292 00898000 CLC ICTIXP(2,@14),TBLEND 0292 00899000 BE @DC00292 0292 00900000 * IF COPYERR=ON /* ERROR */ 00901000 * THEN 0293 00902000 TM COPYERR,B'10000000' 0293 00903000 BNO @RF00293 0293 00904000 * ICTMNOGO(1)=ON; /* SET NOGO BIT IN MOD */ 00905000 AL @09,@TF00001 0294 00906000 AL @09,@CF00558 0294 00907000 MVC @ZT00002+2(2),ICTIXP(@09) 0294 00908000 L @14,@ZT00002 0294 00909000 AL @14,CCAICT(,CCAPTR) 0294 00910000 OI ICTMNOGO(@14),B'00000100' 0294 00911000 * ICTMPROC(1)=ON; /* SET INPROCESS BIT IN MOD */ 00912000 @RF00293 L @14,L 0295 00913000 ALR @14,@14 0295 00914000 L @09,K 0295 00915000 MH @09,@CH00032 0295 00916000 L @01,CCAICPTF(,CCAPTR) 0295 00917000 ALR @01,@09 0295 00918000 AL @01,@CF00557 0295 00919000 MVC @ZT00001+1(3),ICTPCHN-9(@01) 0295 00920000 L @01,@ZT00001 0295 00921000 ALR @01,@14 0295 00922000 AL @01,@CF00558 0295 00923000 MVC @ZT00002+2(2),ICTIXP(@01) 0295 00924000 L @14,@ZT00002 0295 00925000 AL @14,CCAICT(,CCAPTR) 0295 00926000 OI ICTMPROC(@14),B'10000000' 0295 00927000 * DO M=1 TO TBLEND WHILE ICTIXM(M)ª=TBLEND;/* SEARCH LMS */ 00928000 LA M,1 0296 00929000 B @DE00296 0296 00930000 @DL00296 LR @14,M 0296 00931000 ALR @14,@14 0296 00932000 L @02,CCAICT(,CCAPTR) 0296 00933000 L @09,L 0296 00934000 ALR @09,@09 0296 00935000 L @08,K 0296 00936000 MH @08,@CH00032 0296 00937000 L @01,CCAICPTF(,CCAPTR) 0296 00938000 ALR @01,@08 0296 00939000 AL @01,@CF00557 0296 00940000 MVC @ZT00001+1(3),ICTPCHN-9(@01) 0296 00941000 L @01,@ZT00001 0296 00942000 ALR @01,@09 0296 00943000 AL @01,@CF00558 0296 00944000 MVC @ZT00002+2(2),ICTIXP(@01) 0296 00945000 L @09,@ZT00002 0296 00946000 ALR @09,@02 0296 00947000 MVC @ZT00001+1(3),ICTMCHN(@09) 0296 00948000 L @09,@ZT00001 0296 00949000 ST @14,@TF00001 0296 00950000 ALR @14,@09 0296 00951000 AL @14,@CF00558 0296 00952000 CLC ICTIXM(2,@14),TBLEND 0296 00953000 BE @DC00296 0296 00954000 * IF COPYERR=ON /* ERROR */ 00955000 * THEN 0297 00956000 TM COPYERR,B'10000000' 0297 00957000 BNO @RF00297 0297 00958000 * ICTLNOGO(1)=ON; /* SET NOGO BIT IN LM */ 00959000 AL @09,@TF00001 0298 00960000 AL @09,@CF00558 0298 00961000 MVC @ZT00002+2(2),ICTIXM(@09) 0298 00962000 AL @02,@ZT00002 0298 00963000 OI ICTLNOGO(@02),B'00000010' 0298 00964000 * ICTLPROC(1)=ON; /* SET INPROCESS BIT IN LM */ 00965000 @RF00297 L @14,CCAICT(,CCAPTR) 0299 00966000 LR @02,M 0299 00967000 ALR @02,@02 0299 00968000 L @09,L 0299 00969000 ALR @09,@09 0299 00970000 L @08,K 0299 00971000 MH @08,@CH00032 0299 00972000 L @01,CCAICPTF(,CCAPTR) 0299 00973000 ALR @01,@08 0299 00974000 AL @01,@CF00557 0299 00975000 MVC @ZT00001+1(3),ICTPCHN-9(@01) 0299 00976000 L @01,@ZT00001 0299 00977000 ALR @01,@09 0299 00978000 AL @01,@CF00558 0299 00979000 MVC @ZT00002+2(2),ICTIXP(@01) 0299 00980000 L @09,@ZT00002 0299 00981000 ALR @09,@14 0299 00982000 MVC @ZT00001+1(3),ICTMCHN(@09) 0299 00983000 L @01,@ZT00001 0299 00984000 ALR @01,@02 0299 00985000 AL @01,@CF00558 0299 00986000 MVC @ZT00002+2(2),ICTIXM(@01) 0299 00987000 AL @14,@ZT00002 0299 00988000 OI ICTLPROC(@14),B'00000100' 0299 00989000 * END; 0300 00990000 AH M,@CH00063 0300 00991000 @DE00296 MVC @ZT00002+2(2),TBLEND 0300 00992000 C M,@ZT00002 0300 00993000 BNH @DL00296 0300 00994000 @DC00296 DS 0H 0301 00995000 * END; 0301 00996000 LA @14,1 0301 00997000 AL @14,L 0301 00998000 @DE00292 ST @14,L 0301 00999000 MVC @ZT00002+2(2),TBLEND 0301 01000000 C @14,@ZT00002 0301 01001000 BNH @DL00292 0301 01002000 @DC00292 DS 0H 0302 01003000 * END; 0302 01004000 * END; 0303 01005000 @RF00288 LA @14,1 0303 01006000 AL @14,K 0303 01007000 @DE00287 ST @14,K 0303 01008000 MVC @ZT00002+2(2),TBLEND 0303 01009000 C @14,@ZT00002 0303 01010000 BNH @DL00287 0303 01011000 @DC00287 DS 0H 0304 01012000 * RFY 0304 01013000 * (ICTLMOD) BASED(CCAICLMD); 0304 01014000 * RFY 0305 01015000 * (ICTIXLF) BASED(ICTLCHN(K)); 0305 01016000 * RFY 0306 01017000 * (ICTMOD) BASED(CCAICT+ICTIXL(L)); 0306 01018000 * RFY 0307 01019000 * (ICTPTF) BASED(CCAICT+ICTPPTR(1)); 0307 01020000 * DO K=1 TO TBLEND WHILE ICTLEND(K)ª=TBLEND;/* LOOP THRU LM */ 01021000 LA @14,1 0308 01022000 B @DE00308 0308 01023000 @DL00308 MH @14,@CH00543 0308 01024000 L @09,CCAICLMD(,CCAPTR) 0308 01025000 ST @14,@TF00001 0308 01026000 ALR @14,@09 0308 01027000 AL @14,@CF00554 0308 01028000 CLC ICTLEND(2,@14),TBLEND 0308 01029000 BE @DC00308 0308 01030000 * IF ICTLPROC(K)=ON&ICTLCPL(K)=OFF&ICTLINK(K)=OFF/* INPROCESS-NOT 01031000 * COMPLETE-COPY */ 01032000 * THEN 0309 01033000 LR @14,@09 0309 01034000 AL @14,@TF00001 0309 01035000 AL @14,@CF00556 0309 01036000 TM ICTLPROC-10(@14),B'00000100' 0309 01037000 BNO @RF00309 0309 01038000 TM ICTLCPL-10(@14),B'00000001' 0309 01039000 BNZ @RF00309 0309 01040000 AL @09,@TF00001 0309 01041000 AL @09,@CF00555 0309 01042000 TM ICTLINK-9(@09),B'01000000' 0309 01043000 BNZ @RF00309 0309 01044000 * DO; 0310 01045000 * L=L1; /* ACCESS TO FIRST MOD */ 01046000 LA @14,1 0311 01047000 ST @14,L 0311 01048000 * MGPMGNO1=M40; /* INDICATE PRIMARY SECTION */ 01049000 MVI MGPMGNO1,X'28' 0312 01050000 * MGPMGNO2=M29; /* INDICATE SECONDARY SECTION */ 01051000 MVI MGPMGNO2,X'1D' 0313 01052000 * CALL LMMSG; /* ISSUE LM ERROR MSG */ 01053000 BAL @14,LMMSG 0314 01054000 * DO L=1 TO TBLEND WHILE ICTIXL(L)ª=TBLEND;/* SEARCH MODS */ 01055000 LA @14,1 0315 01056000 B @DE00315 0315 01057000 @DL00315 ALR @14,@14 0315 01058000 L @09,K 0315 01059000 MH @09,@CH00543 0315 01060000 L @01,CCAICLMD(,CCAPTR) 0315 01061000 ALR @01,@09 0315 01062000 AL @01,@CF00557 0315 01063000 MVC @ZT00001+1(3),ICTLCHN-30(@01) 0315 01064000 L @09,@ZT00001 0315 01065000 ST @14,@TF00001 0315 01066000 ALR @14,@09 0315 01067000 AL @14,@CF00558 0315 01068000 CLC ICTIXL(2,@14),TBLEND 0315 01069000 BE @DC00315 0315 01070000 * IF ICTMZAP(1)=OFF /* MOD CONTAIN SZAP */ 01071000 * THEN 0316 01072000 AL @09,@TF00001 0316 01073000 AL @09,@CF00558 0316 01074000 MVC @ZT00002+2(2),ICTIXL(@09) 0316 01075000 L @14,@ZT00002 0316 01076000 AL @14,CCAICT(,CCAPTR) 0316 01077000 TM ICTMZAP(@14),B'00100000' 0316 01078000 BNZ @RF00316 0316 01079000 * DO; 0317 01080000 * MGPMGNO1=M40; /* INDICATE PRIMARY SECTION */ 01081000 MVI MGPMGNO1,X'28' 0318 01082000 * MGPMGNO2=M46; /* INDICATE SECONDARY SECTION */ 01083000 MVI MGPMGNO2,X'2E' 0319 01084000 * CALL MODMSG; /* ISSUE MOD ERROR MSG */ 01085000 BAL @14,MODMSG 0320 01086000 * END; 0321 01087000 * END; 0322 01088000 @RF00316 LA @14,1 0322 01089000 AL @14,L 0322 01090000 @DE00315 ST @14,L 0322 01091000 MVC @ZT00002+2(2),TBLEND 0322 01092000 C @14,@ZT00002 0322 01093000 BNH @DL00315 0322 01094000 @DC00315 DS 0H 0323 01095000 * END; 0323 01096000 * END; 0324 01097000 @RF00309 LA @14,1 0324 01098000 AL @14,K 0324 01099000 @DE00308 ST @14,K 0324 01100000 MVC @ZT00002+2(2),TBLEND 0324 01101000 C @14,@ZT00002 0324 01102000 BNH @DL00308 0324 01103000 @DC00308 DS 0H 0325 01104000 * RFY 0325 01105000 * (ICTPTF) BASED(CCAICPTF); 0325 01106000 * RFY 0326 01107000 * (ICTIXPF) BASED(ICTPCHN(K)); 0326 01108000 * RFY 0327 01109000 * (ICTMOD) BASED(CCAICT+ICTIXP(L)); 0327 01110000 * RFY 0328 01111000 * (ICTIXMF) BASED(ICTMCHN(1)); 0328 01112000 * RFY 0329 01113000 * (ICTLMOD) BASED(CCAICT+ICTIXM(M)); 0329 01114000 * DO K=1 TO TBLEND WHILE ICTPEND(K)ª=TBLEND;/* LOOP THRU PTF */ 01115000 LA @14,1 0330 01116000 B @DE00330 0330 01117000 @DL00330 MH @14,@CH00032 0330 01118000 L @09,CCAICPTF(,CCAPTR) 0330 01119000 ST @14,@TF00001 0330 01120000 ALR @14,@09 0330 01121000 AL @14,@CF00584 0330 01122000 CLC ICTPEND(2,@14),TBLEND 0330 01123000 BE @DC00330 0330 01124000 * IF ICTPROCS(K)=ON&ICTPCPL(K)=OFF/* INPROCESS-NOT COMPLETE */ 01125000 * THEN 0331 01126000 LR @14,@09 0331 01127000 AL @14,@TF00001 0331 01128000 AL @14,@CF00585 0331 01129000 TM ICTPROCS-8(@14),B'00010000' 0331 01130000 BNO @RF00331 0331 01131000 TM ICTPCPL-8(@14),B'00000001' 0331 01132000 BNZ @RF00331 0331 01133000 * DO; 0332 01134000 * ICTPCPL(K)=ON; /* SET COMPLETE BIT IN PTF */ 01135000 AL @09,@TF00001 0333 01136000 AL @09,@CF00585 0333 01137000 OI ICTPCPL-8(@09),B'00000001' 0333 01138000 * DO L=1 TO TBLEND WHILE ICTIXP(L)ª=TBLEND;/* SEARCH MODS */ 01139000 LA @14,1 0334 01140000 B @DE00334 0334 01141000 @DL00334 ALR @14,@14 0334 01142000 L @09,K 0334 01143000 MH @09,@CH00032 0334 01144000 L @01,CCAICPTF(,CCAPTR) 0334 01145000 ALR @01,@09 0334 01146000 AL @01,@CF00557 0334 01147000 MVC @ZT00001+1(3),ICTPCHN-9(@01) 0334 01148000 L @09,@ZT00001 0334 01149000 ST @14,@TF00001 0334 01150000 ALR @14,@09 0334 01151000 AL @14,@CF00558 0334 01152000 CLC ICTIXP(2,@14),TBLEND 0334 01153000 BE @DC00334 0334 01154000 * ICTMCPL(1)=ON; /* SET COMPLETE BIT IN MOD */ 01155000 AL @09,@TF00001 0335 01156000 AL @09,@CF00558 0335 01157000 MVC @ZT00002+2(2),ICTIXP(@09) 0335 01158000 L @14,@ZT00002 0335 01159000 AL @14,CCAICT(,CCAPTR) 0335 01160000 OI ICTMCPL(@14),B'00000001' 0335 01161000 * DO M=1 TO TBLEND WHILE ICTIXM(M)ª=TBLEND;/* SEARCH LMS */ 01162000 LA M,1 0336 01163000 B @DE00336 0336 01164000 @DL00336 LR @14,M 0336 01165000 ALR @14,@14 0336 01166000 L @02,CCAICT(,CCAPTR) 0336 01167000 L @09,L 0336 01168000 ALR @09,@09 0336 01169000 L @08,K 0336 01170000 MH @08,@CH00032 0336 01171000 L @01,CCAICPTF(,CCAPTR) 0336 01172000 ALR @01,@08 0336 01173000 AL @01,@CF00557 0336 01174000 MVC @ZT00001+1(3),ICTPCHN-9(@01) 0336 01175000 L @01,@ZT00001 0336 01176000 ALR @01,@09 0336 01177000 AL @01,@CF00558 0336 01178000 MVC @ZT00002+2(2),ICTIXP(@01) 0336 01179000 L @09,@ZT00002 0336 01180000 ALR @09,@02 0336 01181000 MVC @ZT00001+1(3),ICTMCHN(@09) 0336 01182000 L @09,@ZT00001 0336 01183000 ST @14,@TF00001 0336 01184000 ALR @14,@09 0336 01185000 AL @14,@CF00558 0336 01186000 CLC ICTIXM(2,@14),TBLEND 0336 01187000 BE @DC00336 0336 01188000 * ICTLCPL(1)=ON; /* SET COMPLETE BIT IN LM */ 01189000 AL @09,@TF00001 0337 01190000 AL @09,@CF00558 0337 01191000 MVC @ZT00002+2(2),ICTIXM(@09) 0337 01192000 AL @02,@ZT00002 0337 01193000 OI ICTLCPL(@02),B'00000001' 0337 01194000 * END; 0338 01195000 AH M,@CH00063 0338 01196000 @DE00336 MVC @ZT00002+2(2),TBLEND 0338 01197000 C M,@ZT00002 0338 01198000 BNH @DL00336 0338 01199000 @DC00336 DS 0H 0339 01200000 * END; 0339 01201000 LA @14,1 0339 01202000 AL @14,L 0339 01203000 @DE00334 ST @14,L 0339 01204000 MVC @ZT00002+2(2),TBLEND 0339 01205000 C @14,@ZT00002 0339 01206000 BNH @DL00334 0339 01207000 @DC00334 DS 0H 0340 01208000 * END; 0340 01209000 * END; 0341 01210000 @RF00331 LA @14,1 0341 01211000 AL @14,K 0341 01212000 @DE00330 ST @14,K 0341 01213000 MVC @ZT00002+2(2),TBLEND 0341 01214000 C @14,@ZT00002 0341 01215000 BNH @DL00330 0341 01216000 @DC00330 DS 0H 0342 01217000 * COPYERR=OFF; /* RESET ERROR INDICATOR */ 01218000 NI COPYERR,B'01111111' 0342 01219000 * END ERROR; 0343 01220000 @EL00008 L @13,4(,@13) 0343 01221000 @EF00008 DS 0H 0343 01222000 @ER00008 LM @14,@12,12(@13) 0343 01223000 BR @14 0343 01224000 * 0344 01225000 * /*****************************************************************/ 01226000 * /* */ 01227000 * /* THIS PROCEDURE IS INVOKED WHEN A COPY HAS BEEN SUCCESSFULLY */ 01228000 * /* COMPLETED. MESSAGES ARE ISSUED FOR ALL LOAD MODS AND MODS THAT*/ 01229000 * /* WERE COPIED AND MARKS THE PTF, MODULE, AND LOAD MOD COMPLETE. */ 01230000 * /* */ 01231000 * /*****************************************************************/ 01232000 * 0344 01233000 *COMPMSG: 0344 01234000 * PROCEDURE OPTIONS(SAVEAREA); 0344 01235000 COMPMSG STM @14,@12,12(@13) 0344 01236000 ST @13,@SA00009+4 0344 01237000 LA @14,@SA00009 0344 01238000 ST @14,8(,@13) 0344 01239000 LR @13,@14 0344 01240000 * RFY 0345 01241000 * (ICTLMOD) BASED(CCAICLMD); 0345 01242000 * RFY 0346 01243000 * (ICTIXLF) BASED(ICTLCHN(K)); 0346 01244000 * RFY 0347 01245000 * (ICTMOD) BASED(CCAICT+ICTIXL(L)); 0347 01246000 * RFY 0348 01247000 * (ICTPTF) BASED(CCAICT+ICTPPTR(1)); 0348 01248000 * DO K=1 TO TBLEND WHILE ICTLEND(K)ª=TBLEND;/* LOOP THRU LM */ 01249000 LA @14,1 0349 01250000 B @DE00349 0349 01251000 @DL00349 MH @14,@CH00543 0349 01252000 L @09,CCAICLMD(,CCAPTR) 0349 01253000 ST @14,@TF00001 0349 01254000 ALR @14,@09 0349 01255000 AL @14,@CF00554 0349 01256000 CLC ICTLEND(2,@14),TBLEND 0349 01257000 BE @DC00349 0349 01258000 * IF ICTLPROC(K)=ON&ICTLCPL(K)=OFF/* INPROCESS-NOT COMP */ 01259000 * THEN 0350 01260000 AL @09,@TF00001 0350 01261000 AL @09,@CF00556 0350 01262000 TM ICTLPROC-10(@09),B'00000100' 0350 01263000 BNO @RF00350 0350 01264000 TM ICTLCPL-10(@09),B'00000001' 0350 01265000 BNZ @RF00350 0350 01266000 * DO; 0351 01267000 * L=L1; /* ACCESS TO FIRST MOD */ 01268000 LA @14,1 0352 01269000 ST @14,L 0352 01270000 * MGPMGNO1=M39; /* INDICATE PRIMARY SECTION */ 01271000 MVI MGPMGNO1,X'27' 0353 01272000 * MGPMGNO2=M29; /* INDICATE SECONDARY SECTION */ 01273000 MVI MGPMGNO2,X'1D' 0354 01274000 * CALL LMMSG; /* ISSUE LM COMPLETE MSG */ 01275000 BAL @14,LMMSG 0355 01276000 * DO L=1 TO TBLEND WHILE ICTIXL(L)ª=TBLEND;/* SEARCH MOD */ 01277000 LA @14,1 0356 01278000 B @DE00356 0356 01279000 @DL00356 ALR @14,@14 0356 01280000 L @09,K 0356 01281000 MH @09,@CH00543 0356 01282000 L @01,CCAICLMD(,CCAPTR) 0356 01283000 ALR @01,@09 0356 01284000 AL @01,@CF00557 0356 01285000 MVC @ZT00001+1(3),ICTLCHN-30(@01) 0356 01286000 L @09,@ZT00001 0356 01287000 ST @14,@TF00001 0356 01288000 ALR @14,@09 0356 01289000 AL @14,@CF00558 0356 01290000 CLC ICTIXL(2,@14),TBLEND 0356 01291000 BE @DC00356 0356 01292000 * IF ICTMCPL(1)=OFF /* MOD COMPLETE */ 01293000 * THEN 0357 01294000 AL @09,@TF00001 0357 01295000 AL @09,@CF00558 0357 01296000 MVC @ZT00002+2(2),ICTIXL(@09) 0357 01297000 L @14,@ZT00002 0357 01298000 AL @14,CCAICT(,CCAPTR) 0357 01299000 TM ICTMCPL(@14),B'00000001' 0357 01300000 BNZ @RF00357 0357 01301000 * DO; 0358 01302000 * MGPMGNO1=M39; /* INDICATE PRIMARY SECTION */ 01303000 MVI MGPMGNO1,X'27' 0359 01304000 * MGPMGNO2=M46; /* INDICATE SECONDARY SECTION */ 01305000 MVI MGPMGNO2,X'2E' 0360 01306000 * CALL MODMSG; /* ISSUE MOD COMPLETE MSG */ 01307000 BAL @14,MODMSG 0361 01308000 * ICTMCPL(1)=ON; /* SET COMPLETE BIT IN MOD */ 01309000 * ICTMPROC(1)=ON; /* SET INPROCESS BIT IN MOD */ 01310000 L @14,L 0363 01311000 ALR @14,@14 0363 01312000 L @09,K 0363 01313000 MH @09,@CH00543 0363 01314000 L @01,CCAICLMD(,CCAPTR) 0363 01315000 ALR @01,@09 0363 01316000 AL @01,@CF00557 0363 01317000 MVC @ZT00001+1(3),ICTLCHN-30(@01) 0363 01318000 L @01,@ZT00001 0363 01319000 ALR @01,@14 0363 01320000 AL @01,@CF00558 0363 01321000 MVC @ZT00002+2(2),ICTIXL(@01) 0363 01322000 L @14,@ZT00002 0363 01323000 AL @14,CCAICT(,CCAPTR) 0363 01324000 OI ICTMCPL(@14),B'10000001' 0363 01325000 * END; 0364 01326000 * END; 0365 01327000 @RF00357 LA @14,1 0365 01328000 AL @14,L 0365 01329000 @DE00356 ST @14,L 0365 01330000 MVC @ZT00002+2(2),TBLEND 0365 01331000 C @14,@ZT00002 0365 01332000 BNH @DL00356 0365 01333000 @DC00356 DS 0H 0366 01334000 * ICTLCPL(K)=ON; /* SET COMPLETE BIT IN LM */ 01335000 L @14,K 0366 01336000 MH @14,@CH00543 0366 01337000 L @01,CCAICLMD(,CCAPTR) 0366 01338000 ALR @01,@14 0366 01339000 AL @01,@CF00556 0366 01340000 OI ICTLCPL-10(@01),B'00000001' 0366 01341000 * END; 0367 01342000 * END; 0368 01343000 @RF00350 LA @14,1 0368 01344000 AL @14,K 0368 01345000 @DE00349 ST @14,K 0368 01346000 MVC @ZT00002+2(2),TBLEND 0368 01347000 C @14,@ZT00002 0368 01348000 BNH @DL00349 0368 01349000 @DC00349 DS 0H 0369 01350000 * END COMPMSG; 0369 01351000 @EL00009 L @13,4(,@13) 0369 01352000 @EF00009 DS 0H 0369 01353000 @ER00009 LM @14,@12,12(@13) 0369 01354000 BR @14 0369 01355000 * 0370 01356000 * /*****************************************************************/ 01357000 * /* */ 01358000 * /* THIS PROCEDURE ISSUES THE ACTUAL LOAD MOD MESSAGES INDICATED */ 01359000 * /* BY THE CALLING PROCEDURE. */ 01360000 * /* */ 01361000 * /*****************************************************************/ 01362000 * 0370 01363000 *LMMSG: 0370 01364000 * PROCEDURE OPTIONS(SAVEAREA); 0370 01365000 LMMSG STM @14,@12,12(@13) 0370 01366000 ST @13,@SA00010+4 0370 01367000 LA @14,@SA00010 0370 01368000 ST @14,8(,@13) 0370 01369000 LR @13,@14 0370 01370000 * MGPPRINT=ON; /* INDICATE PRINTER */ 01371000 * MGPHLDS=OFF; /* INDICATE NO HISTORY LOG */ 01372000 OI MGPPRINT,B'10000000' 0372 01373000 NI MGPHLDS,B'10111111' 0372 01374000 * MGPVARPT(1)=ADDR(CPY); /* ADDR OF COPY VARIABLE */ 01375000 LA @14,CPY 0373 01376000 ST @14,MGPVARPT 0373 01377000 * MGPVARPT(2)=ADDR(ICTLMNAM(K)); /* ADDR OF LM NAME */ 01378000 L @14,K 0374 01379000 MH @14,@CH00543 0374 01380000 L @09,CCAICLMD(,CCAPTR) 0374 01381000 LA @01,0(@14,@09) 0374 01382000 AL @01,@CF00554 0374 01383000 ST @01,MGPVARPT+4 0374 01384000 * MGPVARPT(3)=ADDR(ICTPTFS(1)); /* ADDR OF PTF NUMBER */ 01385000 L @08,CCAICT(,CCAPTR) 0375 01386000 L @07,L 0375 01387000 ALR @07,@07 0375 01388000 ALR @09,@14 0375 01389000 AL @09,@CF00557 0375 01390000 MVC @ZT00001+1(3),ICTLCHN-30(@09) 0375 01391000 L @14,@ZT00001 0375 01392000 ALR @14,@07 0375 01393000 AL @14,@CF00558 0375 01394000 MVC @ZT00002+2(2),ICTIXL(@14) 0375 01395000 L @14,@ZT00002 0375 01396000 ALR @14,@08 0375 01397000 MVC @ZT00002+2(2),ICTPPTR(@14) 0375 01398000 AL @08,@ZT00002 0375 01399000 ST @08,MGPVARPT+8 0375 01400000 * CALL HMASMMSG(HMASMMGP); /* CALL MSG ROUTINE */ 01401000 L @15,@CV00332 0376 01402000 LA @01,@AL00376 0376 01403000 BALR @14,@15 0376 01404000 * END LMMSG; 0377 01405000 * 0377 01406000 @EL00010 L @13,4(,@13) 0377 01407000 @EF00010 DS 0H 0377 01408000 @ER00010 LM @14,@12,12(@13) 0377 01409000 BR @14 0377 01410000 * /*****************************************************************/ 01411000 * /* */ 01412000 * /* THIS PROCEDURE ISSUES THE ACTUAL MODULE MESSAGES INDICATED BY */ 01413000 * /* THE CALLING PROCEDURE. */ 01414000 * /* */ 01415000 * /*****************************************************************/ 01416000 * 0378 01417000 *MODMSG: 0378 01418000 * PROCEDURE OPTIONS(SAVEAREA); 0378 01419000 MODMSG STM @14,@12,12(@13) 0378 01420000 ST @13,@SA00011+4 0378 01421000 LA @14,@SA00011 0378 01422000 ST @14,8(,@13) 0378 01423000 LR @13,@14 0378 01424000 * MGPPRINT=ON; /* INDICATE PRINTER */ 01425000 * MGPHLDS=OFF; /* INDICATE NO HISTORY LOG */ 01426000 OI MGPPRINT,B'10000000' 0380 01427000 NI MGPHLDS,B'10111111' 0380 01428000 * MGPVARPT(1)=ADDR(CPY); /* ADDR OF COPY VARIABLE */ 01429000 LA @14,CPY 0381 01430000 ST @14,MGPVARPT 0381 01431000 * MGPVARPT(2)=ADDR(ICTMNAME(L)); /* ADDR OF MOD NAME */ 01432000 L @14,L 0382 01433000 LR @09,@14 0382 01434000 MH @09,@CH00548 0382 01435000 L @08,CCAICT(,CCAPTR) 0382 01436000 ALR @14,@14 0382 01437000 L @07,K 0382 01438000 MH @07,@CH00543 0382 01439000 L @01,CCAICLMD(,CCAPTR) 0382 01440000 ALR @01,@07 0382 01441000 AL @01,@CF00557 0382 01442000 MVC @ZT00001+1(3),ICTLCHN-30(@01) 0382 01443000 L @01,@ZT00001 0382 01444000 ALR @01,@14 0382 01445000 AL @01,@CF00558 0382 01446000 MVC @ZT00002+2(2),ICTIXL(@01) 0382 01447000 L @14,@ZT00002 0382 01448000 ALR @14,@08 0382 01449000 AL @09,@CF00583 0382 01450000 LA @09,ICTMNAME(@09,@14) 0382 01451000 ST @09,MGPVARPT+4 0382 01452000 * MGPVARPT(3)=ADDR(ICTPTFS(1)); /* ADDR OF PTF NUMBER */ 01453000 MVC @ZT00002+2(2),ICTPPTR(@14) 0383 01454000 AL @08,@ZT00002 0383 01455000 ST @08,MGPVARPT+8 0383 01456000 * CALL HMASMMSG(HMASMMGP); /* CALL MSG ROUTINE */ 01457000 L @15,@CV00332 0384 01458000 LA @01,@AL00384 0384 01459000 BALR @14,@15 0384 01460000 * END MODMSG; 0385 01461000 @EL00011 L @13,4(,@13) 0385 01462000 @EF00011 DS 0H 0385 01463000 @ER00011 LM @14,@12,12(@13) 0385 01464000 BR @14 0385 01465000 * 0386 01466000 * /*****************************************************************/ 01467000 * /* */ 01468000 * /* THIS PROCEDURE IS INVOKED TO COMPLETE ALL PTFS DURING ONE */ 01469000 * /* INVOCATION OF HMASMCPI. */ 01470000 * /* */ 01471000 * /*****************************************************************/ 01472000 * 0386 01473000 *COMPLETE: 0386 01474000 * PROCEDURE; 0386 01475000 COMPLETE STM @14,@12,12(@13) 0386 01476000 * RFY 0387 01477000 * ICTPTF BASED(CCAICPTF); 0387 01478000 * RFY 0388 01479000 * ICTIXPF BASED(ICTPCHN(I)); 0388 01480000 * RFY 0389 01481000 * ICTMOD BASED(CCAICT+ICTIXP(J)); 0389 01482000 * DO I=1 TO TBLEND WHILE ICTPEND(I)ª=TBLEND;/* SEARCH THRU PTFS */ 01483000 LA @14,1 0390 01484000 B @DE00390 0390 01485000 @DL00390 MH @14,@CH00032 0390 01486000 L @09,CCAICPTF(,CCAPTR) 0390 01487000 ST @14,@TF00001 0390 01488000 ALR @14,@09 0390 01489000 AL @14,@CF00584 0390 01490000 CLC ICTPEND(2,@14),TBLEND 0390 01491000 BE @DC00390 0390 01492000 * IF ICTPROCS(I)=ON /* IF THIS PTF IS IN PROCESS */ 01493000 * THEN /* THEN SEARCH ITS MODS */ 01494000 AL @09,@TF00001 0391 01495000 AL @09,@CF00585 0391 01496000 TM ICTPROCS-8(@09),B'00010000' 0391 01497000 BNO @RF00391 0391 01498000 * DO; 0392 01499000 * DO J=1 TO TBLEND WHILE ICTIXP(J)ª=TBLEND;/* SRCH MODS */ 01500000 LA @14,1 0393 01501000 B @DE00393 0393 01502000 @DL00393 LR @09,@14 0393 01503000 ALR @09,@09 0393 01504000 L @08,I 0393 01505000 MH @08,@CH00032 0393 01506000 L @01,CCAICPTF(,CCAPTR) 0393 01507000 ALR @01,@08 0393 01508000 AL @01,@CF00557 0393 01509000 MVC @ZT00001+1(3),ICTPCHN-9(@01) 0393 01510000 L @08,@ZT00001 0393 01511000 ST @09,@TF00001 0393 01512000 ALR @09,@08 0393 01513000 AL @09,@CF00558 0393 01514000 CLC ICTIXP(2,@09),TBLEND 0393 01515000 BE @DC00393 0393 01516000 * IF ICTMCPL(1)=OFF /* IF ANY ONE MOD NOT COMPLETE */ 01517000 * ³ICTMNOGO(1)=ON /* OR MARKED NOGO */ 01518000 * THEN /* THEN SKIP MARKING PTF COMPLETE*/ 01519000 AL @08,@TF00001 0394 01520000 AL @08,@CF00558 0394 01521000 MVC @ZT00002+2(2),ICTIXP(@08) 0394 01522000 L @09,@ZT00002 0394 01523000 AL @09,CCAICT(,CCAPTR) 0394 01524000 TM ICTMNOGO(@09),B'00000100' 0394 01525000 BNZ @RT00394 0394 01526000 TM ICTMCPL(@09),B'00000001' 0394 01527000 BNO @RT00394 0394 01528000 * GO TO NXTPTF; /* SKIP THIS PTF */ 01529000 * END; 0396 01530000 AH @14,@CH00063 0396 01531000 @DE00393 ST @14,J 0396 01532000 MVC @ZT00002+2(2),TBLEND 0396 01533000 C @14,@ZT00002 0396 01534000 BNH @DL00393 0396 01535000 @DC00393 DS 0H 0397 01536000 * ICTPCPL(I)=ON; /* MARK THIS PTF COMPLETE */ 01537000 L @14,I 0397 01538000 MH @14,@CH00032 0397 01539000 L @01,CCAICPTF(,CCAPTR) 0397 01540000 ALR @01,@14 0397 01541000 AL @01,@CF00585 0397 01542000 OI ICTPCPL-8(@01),B'00000001' 0397 01543000 * END; 0398 01544000 *NXTPTF: 0399 01545000 * END; 0399 01546000 @RF00391 DS 0H 0399 01547000 NXTPTF LA @14,1 0399 01548000 AL @14,I 0399 01549000 @DE00390 ST @14,I 0399 01550000 MVC @ZT00002+2(2),TBLEND 0399 01551000 C @14,@ZT00002 0399 01552000 BNH @DL00390 0399 01553000 @DC00390 DS 0H 0400 01554000 * END COMPLETE; 0400 01555000 @EL00012 DS 0H 0400 01556000 @EF00012 DS 0H 0400 01557000 @ER00012 LM @14,@12,12(@13) 0400 01558000 BR @14 0400 01559000 * END HMASMCPI 0401 01560000 * 0401 01561000 */* THE FOLLOWING INCLUDE STATEMENTS WERE FOUND IN THIS PROGRAM. */ 01562000 */*%INCLUDE SYSLIB (HMASMCCA) */ 01563000 */*%INCLUDE SYSLIB (HMASMIOP) */ 01564000 */*%INCLUDE SYSLIB (HMASMICT) */ 01565000 */*%INCLUDE SYSLIB (HMASMMGP) */ 01566000 * 0401 01567000 * ; 0401 01568000 @DATA DS 0H 01569000 @CH00063 DC H'1' 01570000 @CH00032 DC H'12' 01571000 @CH00547 DC H'13' 01572000 @CH00545 DC H'18' 01573000 @CH00548 DC H'26' 01574000 @CH00543 DC H'33' 01575000 @CH00159 DC H'255' 01576000 @CH00352 DC XL2'01' 01577000 @CH00356 DC XL2'04' 01578000 @SM00565 MVC BUFFER+17(0,@09),SELMOD 01579000 @SM00568 MVC BUFFER(0,@09),REPLACE 01580000 @SM00570 MVC BUFFER+17(0,@09),MODNAME 01581000 @SM00573 MVC BUFFER(0,@14),ICTLMNAM(@01) 01582000 @SM00575 MVC BUFFER(0,@07),REPL 01583000 @SM00577 MVC BUFFER+12(0,@09),OUTPUTDD 01584000 @SM00579 MVC BUFFER(0,@14),INPUT 01585000 @SM00581 MVC BUFFER(0,@09),INPUTDD 01586000 DS 0F 01587000 @AL00376 EQU * LIST WITH 1 ARGUMENT(S) 01588000 @AL00384 DC A(HMASMMGP) LIST WITH 1 ARGUMENT(S) 01589000 DS 0F 01590000 @SA00001 DS 18F 01591000 @SA00005 DS 18F 01592000 @SA00002 DS 18F 01593000 @SA00003 DS 18F 01594000 @SA00007 DS 18F 01595000 @SA00006 DS 18F 01596000 @SA00008 DS 18F 01597000 @SA00009 DS 18F 01598000 @SA00004 DS 18F 01599000 @SA00010 DS 18F 01600000 @SA00011 DS 18F 01601000 @AL00001 DS 1A 01602000 @TF00001 DS F 01603000 @TF00002 DS F 01604000 @ZTEMPS DS 0F 01605000 @ZT00001 DC F'0' 01606000 @ZT00002 DC F'0' 01607000 @ZTEMPND EQU * 01608000 @ZLEN EQU @ZTEMPND-@ZTEMPS 01609000 DS 0F 01610000 @CF00572 DC F'-34' 01611000 @CF00554 DC F'-33' 01612000 @CF00583 DC F'-26' 01613000 @CF00555 DC F'-24' 01614000 @CF00556 DC F'-23' 01615000 @CF00562 DC F'-22' 01616000 @CF00563 DC F'-14' 01617000 @CF00584 DC F'-12' 01618000 @CF00585 DC F'-4' 01619000 @CF00557 DC F'-3' 01620000 @CF00558 DC F'-2' 01621000 @CF00567 DC F'-1' 01622000 @CV00331 DC V(HMASMIO) 01623000 @CV00332 DC V(HMASMMSG) 01624000 DS 0D 01625000 IOPPTR DC A(0) 01626000 I DC A(0) 01627000 J DC A(0) 01628000 K DC A(0) 01629000 L DC A(0) 01630000 ZERO DC F'0' 01631000 FINISH DC F'0' 01632000 LX DC A(0) 01633000 LY DC A(0) 01634000 LZ DC A(0) 01635000 DS 0D 01636000 @TS00001 DS CL8 01637000 HMASMMGP DS CL20 01638000 ORG HMASMMGP 01639000 MGPMGNO1 DS FL1 01640000 MGPMGNO2 DS FL1 01641000 MGPMGNO3 DS FL1 01642000 MGPFLAGS DS BL1 01643000 ORG MGPFLAGS 01644000 MGPPRINT DS BL1 01645000 MGPHLDS EQU MGPFLAGS+0 01646000 @NM00017 EQU MGPFLAGS+0 01647000 ORG HMASMMGP+4 01648000 MGPVARPT DS 4A 01649000 ORG HMASMMGP+20 01650000 SELECT DC CL16'SELECT MEMBER=((' 01651000 CPY DC CL4'COPY' 01652000 REPLACE DC CL5',,R))' 01653000 COMMA DC CL1',' 01654000 REPL DC CL4',R))' 01655000 COPY DC CL11'COPY OUTDD=' 01656000 INPUT DC CL6',INDD=' 01657000 LPAREN DC CL1'(' 01658000 INPUTDD DC CL8' ' 01659000 OUTPUTDD DC CL8' ' 01660000 DDNAMES DS CL90 01661000 ORG DDNAMES 01662000 DDCOUNT DC XL2'58' 01663000 DD1 DC 32X'00' 01664000 DD2 DC CL8'SYSUT1 ' 01665000 DD3 DC 32X'00' 01666000 DD4 DC CL8'SYSUT2 ' 01667000 DD5 DC CL8'SYSUT3 ' 01668000 ORG DDNAMES+90 01669000 DS CL2 01670000 WORKAREA DS CL16 01671000 ORG WORKAREA 01672000 SAVE1 DS CL8 01673000 SAVE2 DS CL8 01674000 ORG SAVE2 01675000 @NM00018 DS CL6 01676000 LINKRTN DS CL2 01677000 ORG LINKRTN 01678000 @NM00019 DS CL1 01679000 @NM00020 DS CL1 01680000 ORG @NM00020 01681000 SIGN DS BL1 01682000 ORG WORKAREA+16 01683000 TBLEND DC X'FFFF' 01684000 MODNAME DC CL8' ' 01685000 FLAGS DC X'00' 01686000 ORG FLAGS 01687000 COPYERR DS BL1 01688000 @NM00021 EQU FLAGS+0 01689000 ORG FLAGS+1 01690000 BLANKS DC CL8' ' 01691000 SELMOD DS CL8 01692000 PATCH DC 16CL6'PATCH*' 01693000 @00 EQU 00 EQUATES FOR REGISTERS 0-15 01694000 @01 EQU 01 01695000 @02 EQU 02 01696000 @03 EQU 03 01697000 @04 EQU 04 01698000 @05 EQU 05 01699000 @06 EQU 06 01700000 @07 EQU 07 01701000 @08 EQU 08 01702000 @09 EQU 09 01703000 @10 EQU 10 01704000 @11 EQU 11 01705000 @12 EQU 12 01706000 @13 EQU 13 01707000 @14 EQU 14 01708000 @15 EQU 15 01709000 M EQU @03 01710000 A EQU @03 01711000 CCAPTR EQU @11 01712000 LINKREG EQU @02 01713000 RTNCODE EQU @15 01714000 HMASMCCA EQU 0 01715000 CCAIOPTR EQU HMASMCCA+8 01716000 CCAICT EQU HMASMCCA+12 01717000 CCAICPTF EQU HMASMCCA+16 01718000 CCAICMOD EQU HMASMCCA+20 01719000 CCAICLMD EQU HMASMCCA+24 01720000 CCACOPY EQU HMASMCCA+40 01721000 CCAOPT EQU HMASMCCA+76 01722000 CCAFLAG1 EQU HMASMCCA+77 01723000 CCAFLAG2 EQU HMASMCCA+78 01724000 CCAFLAG3 EQU HMASMCCA+79 01725000 HMASMIOP EQU 0 01726000 IOPDSID EQU HMASMIOP 01727000 IOPFUNCT EQU HMASMIOP+1 01728000 IOPRETRN EQU HMASMIOP+2 01729000 IOPBUFAD EQU HMASMIOP+4 01730000 IOPNAME EQU HMASMIOP+8 01731000 IOPTYPE EQU IOPNAME 01732000 IOPTTR EQU HMASMIOP+16 01733000 IOPUDATA EQU HMASMIOP+20 01734000 HMASMICT EQU 0 01735000 ICTCORE EQU HMASMICT 01736000 ICTSPLEN EQU ICTCORE 01737000 ICTPTF EQU 0 01738000 ICTPTFS EQU ICTPTF 01739000 ICTPMID EQU ICTPTFS 01740000 ICTPEND EQU ICTPMID 01741000 ICTPFLG1 EQU ICTPTF+7 01742000 ICTPIFLG EQU ICTPTF+8 01743000 ICTPROCS EQU ICTPIFLG 01744000 ICTPNOGO EQU ICTPIFLG 01745000 ICTPCPL EQU ICTPIFLG 01746000 ICTPCHN EQU ICTPTF+9 01747000 ICTIXPF EQU 0 01748000 ICTIXP EQU ICTIXPF 01749000 ICTMOD EQU 0 01750000 ICTMNAME EQU ICTMOD 01751000 ICTMFLG1 EQU ICTMOD+8 01752000 ICTMALIS EQU ICTMFLG1 01753000 ICTMIFLG EQU ICTMOD+9 01754000 ICTMPROC EQU ICTMIFLG 01755000 ICTMZAP EQU ICTMIFLG 01756000 ICTMNOGO EQU ICTMIFLG 01757000 ICTMCPL EQU ICTMIFLG 01758000 ICTMLEPR EQU ICTMOD+10 01759000 ICTFMLIB EQU ICTMOD+13 01760000 ICTPPTR EQU ICTMOD+21 01761000 ICTMCHN EQU ICTMOD+23 01762000 ICTIXMF EQU 0 01763000 ICTIXM EQU ICTIXMF 01764000 ICTLMOD EQU 0 01765000 ICTLMNAM EQU ICTLMOD 01766000 ICTLEND EQU ICTLMNAM 01767000 ICTLFLG1 EQU ICTLMOD+8 01768000 ICTLFLG2 EQU ICTLMOD+9 01769000 ICTLINK EQU ICTLFLG2 01770000 ICTLIFLG EQU ICTLMOD+10 01771000 ICTTGIND EQU ICTLIFLG 01772000 ICTLPROC EQU ICTLIFLG 01773000 ICTLNOGO EQU ICTLIFLG 01774000 ICTLCPL EQU ICTLIFLG 01775000 ICTTGLIB EQU ICTLMOD+11 01776000 ICTTG1 EQU ICTTGLIB 01777000 ICTTG2 EQU ICTTGLIB+8 01778000 ICTLCHN EQU ICTLMOD+30 01779000 ICTIXLF EQU 0 01780000 ICTIXL EQU ICTIXLF 01781000 BUFFER EQU 0 01782000 IOPMOCDS EQU IOPUDATA 01783000 IOPLMCDS EQU IOPUDATA 01784000 IOPFLGS2 EQU IOPLMCDS 01785000 IOPFLGS3 EQU IOPLMCDS+1 01786000 IOPMACDS EQU IOPUDATA 01787000 IOPPTCDS EQU IOPUDATA 01788000 IOPFLGS5 EQU IOPPTCDS 01789000 IOPSTAT EQU IOPFLGS5 01790000 IOPPNTRY EQU IOPPTCDS+4 01791000 IOPDLCDS EQU IOPUDATA 01792000 IOPSYCDS EQU IOPUDATA 01793000 IOPFLGS7 EQU IOPSYCDS 01794000 IOPSTCMP EQU IOPUDATA 01795000 IOPPTSNT EQU IOPUDATA 01796000 IOPPFLG1 EQU IOPPTSNT 01797000 IOPPLEPR EQU IOPPTSNT+1 01798000 IOPPNUM EQU IOPPTSNT+2 01799000 IOPALISL EQU IOPPTSNT+22 01800000 AGO .@UNREFD START UNREFERENCED COMPONENTS 01801000 IOPINDLB EQU IOPPTSNT+14 01802000 IOPDISTN EQU IOPPTSNT+7 01803000 IOPPDIG EQU IOPPNUM+2 01804000 IOPPID EQU IOPPNUM 01805000 IOPPNE EQU IOPPLEPR 01806000 IOPPDC EQU IOPPLEPR 01807000 IOPPREFR EQU IOPPLEPR 01808000 IOPPOVLY EQU IOPPLEPR 01809000 IOPPSCTR EQU IOPPLEPR 01810000 IOPPREUS EQU IOPPLEPR 01811000 IOPPRENT EQU IOPPLEPR 01812000 @NM00010 EQU IOPPLEPR 01813000 @NM00009 EQU IOPPFLG1 01814000 IOPLEFND EQU IOPPFLG1 01815000 IOPDALIS EQU IOPPFLG1 01816000 IOPTALIS EQU IOPPFLG1 01817000 IOPLIBTX EQU IOPPFLG1 01818000 IOPLIBLK EQU IOPPFLG1 01819000 IOPSTNEW EQU IOPSTCMP+8 01820000 IOPSTOLD EQU IOPSTCMP 01821000 IOPPDLM EQU IOPSYCDS+8 01822000 IOPPEMAX EQU IOPSYCDS+6 01823000 IOPNUCID EQU IOPSYCDS+5 01824000 IOPSREL EQU IOPSYCDS+1 01825000 @NM00008 EQU IOPFLGS7 01826000 IOPTSO EQU IOPFLGS7 01827000 IOPDSYS EQU IOPDLCDS 01828000 IOPPIND EQU IOPPNTRY+8 01829000 IOPPMODS EQU IOPPNTRY 01830000 IOPDATE EQU IOPPTCDS+1 01831000 @NM00007 EQU IOPFLGS5 01832000 IOPDUMMP EQU IOPSTAT 01833000 IOPFORCE EQU IOPSTAT 01834000 IOPACC EQU IOPSTAT 01835000 IOPAPP EQU IOPSTAT 01836000 IOPASMOD EQU IOPMACDS+2 01837000 @NM00006 EQU IOPMACDS 01838000 IOPSYSLB EQU IOPLMCDS+2 01839000 @NM00005 EQU IOPFLGS3 01840000 IOPCHREP EQU IOPFLGS3 01841000 IOPLINK EQU IOPFLGS3 01842000 IOPCOPY EQU IOPFLGS3 01843000 IOPNE EQU IOPFLGS2 01844000 IOPDC EQU IOPFLGS2 01845000 IOPREFR EQU IOPFLGS2 01846000 IOPOVLY EQU IOPFLGS2 01847000 IOPSCTR EQU IOPFLGS2 01848000 IOPREUS EQU IOPFLGS2 01849000 IOPRENT EQU IOPFLGS2 01850000 @NM00004 EQU IOPFLGS2 01851000 IOPLMODS EQU IOPMOCDS+9 01852000 IOPDLIB EQU IOPMOCDS+2 01853000 IOPMODID EQU IOPMOCDS 01854000 ICTLTTR EQU ICTLMOD+27 01855000 ICTLALIS EQU ICTLIFLG 01856000 @NM00016 EQU ICTLIFLG 01857000 ICTINCLD EQU ICTLIFLG 01858000 ICTTIND2 EQU ICTTGIND 01859000 ICTTIND1 EQU ICTTGIND 01860000 @NM00015 EQU ICTLFLG2 01861000 ICTCOPY EQU ICTLFLG2 01862000 ICTNE EQU ICTLFLG1 01863000 ICTDC EQU ICTLFLG1 01864000 ICTREFR EQU ICTLFLG1 01865000 ICTOVLY EQU ICTLFLG1 01866000 ICTSCTR EQU ICTLFLG1 01867000 ICTREUS EQU ICTLFLG1 01868000 ICTRENT EQU ICTLFLG1 01869000 @NM00014 EQU ICTLFLG1 01870000 ICTMID EQU ICTMOD+11 01871000 ICTMPRMS EQU ICTMLEPR 01872000 ICTCRLIB EQU ICTMIFLG 01873000 ICTMIS EQU ICTMIFLG 01874000 ICTNOM EQU ICTMIFLG 01875000 ICTMMAC EQU ICTMIFLG 01876000 @NM00013 EQU ICTMFLG1 01877000 ICTLIBTX EQU ICTMFLG1 01878000 ICTLIBLK EQU ICTMFLG1 01879000 ICTMEND EQU ICTMNAME 01880000 ICTPLNK EQU ICTPIFLG 01881000 ICTFORCE EQU ICTPIFLG 01882000 ICTZAP EQU ICTPIFLG 01883000 ICTPMAC EQU ICTPIFLG 01884000 @NM00012 EQU ICTPIFLG 01885000 @NM00011 EQU ICTPFLG1 01886000 ICTDUMMP EQU ICTPFLG1 01887000 ICTFREC EQU ICTPFLG1 01888000 ICTACC EQU ICTPFLG1 01889000 ICTAPP EQU ICTPFLG1 01890000 ICTPNO EQU ICTPTFS+2 01891000 ICTLEN EQU ICTSPLEN+1 01892000 ICTSP EQU ICTSPLEN 01893000 IOPUSERL EQU HMASMIOP+19 01894000 IOPBLKSI EQU IOPTTR 01895000 IOPNAME2 EQU IOPNAME+1 01896000 IOPCDTYP EQU IOPTYPE 01897000 IOPMACID EQU HMASMIOP+3 01898000 CCABLKSZ EQU HMASMCCA+92 01899000 CCASPDCB EQU HMASMCCA+88 01900000 CCADATE EQU HMASMCCA+85 01901000 CCASREL EQU HMASMCCA+81 01902000 CCANUCID EQU HMASMCCA+80 01903000 @NM00003 EQU CCAFLAG3 01904000 CCACOPYP EQU CCAFLAG3 01905000 CCALINKP EQU CCAFLAG3 01906000 CCAZAPP EQU CCAFLAG3 01907000 @NM00002 EQU CCAFLAG2 01908000 CCAICSB EQU CCAFLAG2 01909000 CCATERM EQU CCAFLAG2 01910000 CCASVCLB EQU CCAFLAG2 01911000 CCATSO EQU CCAFLAG2 01912000 CCACPYCP EQU CCAFLAG2 01913000 CCANCPTF EQU CCAFLAG2 01914000 CCALSCDS EQU CCAFLAG2 01915000 CCALSLOG EQU CCAFLAG1 01916000 CCAUPDU EQU CCAFLAG1 01917000 CCAUPDJ EQU CCAFLAG1 01918000 CCARES EQU CCAFLAG1 01919000 CCAREJ EQU CCAFLAG1 01920000 CCAACCPT EQU CCAFLAG1 01921000 CCAAPPLY EQU CCAFLAG1 01922000 CCAREC EQU CCAFLAG1 01923000 @NM00001 EQU CCAOPT 01924000 CCACPOPT EQU CCAOPT 01925000 CCALKOPT EQU CCAOPT 01926000 CCABFPMX EQU HMASMCCA+74 01927000 CCABFMMX EQU HMASMCCA+72 01928000 CCAPEMAX EQU HMASMCCA+70 01929000 CCAMXERR EQU HMASMCCA+68 01930000 CCAJFPTS EQU HMASMCCA+64 01931000 CCAJFCDS EQU HMASMCCA+60 01932000 CCALKSIZ EQU HMASMCCA+56 01933000 CCAUPDTE EQU HMASMCCA+52 01934000 CCAIOSUP EQU HMASMCCA+48 01935000 CCASPZAP EQU HMASMCCA+44 01936000 CCAASM EQU HMASMCCA+36 01937000 CCALKED EQU HMASMCCA+32 01938000 CCAPESIZ EQU HMASMCCA+28 01939000 CCABUFAD EQU HMASMCCA+4 01940000 CCAID EQU HMASMCCA 01941000 .@UNREFD ANOP END UNREFERENCED COMPONENTS 01942000 @RT00128 EQU NEXTLM 01943000 @RT00135 EQU NEXTLM 01944000 @RT00141 EQU NEXTLM 01945000 @RT00226 EQU @EL00004 01946000 @RT00257 EQU @EL00006 01947000 @RT00394 EQU NXTPTF 01948000 @PB00012 EQU @EL00001 01949000 @PB00011 EQU @PB00012 01950000 @PB00010 EQU @PB00011 01951000 @PB00009 EQU @PB00010 01952000 @PB00008 EQU @PB00009 01953000 @PB00007 EQU @PB00008 01954000 @PB00006 EQU @PB00007 01955000 @PB00005 EQU @PB00006 01956000 @PB00004 EQU @PB00005 01957000 @PB00003 EQU @PB00004 01958000 @PB00002 EQU @PB00003 01959000 @ENDDATA EQU * 01960000 END HMASMCPI 01961000 ./ ADD SSI=33620492,NAME=HMASMCPY,SOURCE=1 COMPON=DN611 TITLE 'HMASMCPY - IEBCOPY SYSGEN SCAN ROUTINE OF SMP *00001000 ' 00002000 HMASMCPY CSECT , 0001 00003000 @MAINENT DS 0H 0001 00004000 USING *,@15 0001 00005000 B @PROLOG 0001 00006000 DC AL1(16) 0001 00007000 DC C'HMASMCPY 73.362' 0001 00008000 DROP @15 00009000 @PROLOG STM @14,@12,12(@13) 0001 00010000 BALR @12,0 0001 00011000 @PSTART DS 0H 0001 00012000 USING @PSTART,@12 0001 00013000 ST @13,@SA00001+4 0001 00014000 LA @14,@SA00001 0001 00015000 ST @14,8(,@13) 0001 00016000 LR @13,@14 0001 00017000 * 0086 00018000 */********************************************************************/ 00019000 */* */ 00020000 */* SCAN DRIVING ROUTINE */ 00021000 */* */ 00022000 */********************************************************************/ 00023000 * 0086 00024000 * IOPPTR=CCAIOPTR; /* SET ADDRESS OF THE IOP */ 00025000 MVC IOPPTR(3),CCAIOPTR+1(CCAPTR) 0086 00026000 * SCPSRCH=ADDR(COPYK); /* SET STARTING SEARCH ARGUMENT */ 00027000 LA @14,COPYK 0087 00028000 ST @14,SCPSRCH 0087 00029000 * SCPIORTN=ZERO; /* ZERO THE I/O ROUTINE ADDR */ 00030000 SLR @14,@14 0088 00031000 ST @14,SCPIORTN 0088 00032000 * SCPINLN=LRECL; /* SET RECORD LENGTH */ 00033000 MVC SCPINLN(2),@CH00068 0089 00034000 * SCPEOR=BINZERO; /* ZERO THE FLAGS */ 00035000 MVI SCPEOR,X'00' 0090 00036000 * SWITCHES=BINZERO; /* INITIALIZE ALL SWITCHES */ 00037000 MVI SWITCHES,X'00' 0091 00038000 *COPYSC10: 0092 00039000 * SCPCHAR=IOPBUFAD; /* INITIALIZE INPUT LIST ADDR */ 00040000 COPYSC10 L @14,IOPPTR-1 0092 00041000 LA @14,0(,@14) 0092 00042000 MVC SCPCHAR(4),IOPBUFAD(@14) 0092 00043000 * CALL HMASMSCN(HMASMSCP); /* SCAN IEBCOPY STMT */ 00044000 L @15,@CV00078 0093 00045000 LA @01,@AL00093 0093 00046000 BALR @14,@15 0093 00047000 * IF SCPRETª=GOOD /* RETURN GOOD? */ 00048000 * THEN 0094 00049000 CLI SCPRET,0 0094 00050000 BE @RF00094 0094 00051000 * RETURN CODE(SYNTERR); /* NO - INDICATE SYNTAX ERROR */ 00052000 LA @15,4 0095 00053000 L @13,4(,@13) 0095 00054000 L @14,12(,@13) 0095 00055000 LM @00,@12,20(@13) 0095 00056000 BR @14 0095 00057000 * IOPDSID=IOPSGTAP; /* INDICATE SYSGEN TAPE */ 00058000 @RF00094 L @14,IOPPTR-1 0096 00059000 LA @14,0(,@14) 0096 00060000 MVI IOPDSID(@14),X'07' 0096 00061000 * IOPFUNCT=IOPREAD; /* INDICATE READ OPERATION */ 00062000 MVI IOPFUNCT(@14),X'01' 0097 00063000 * CALL HMASMIO(HMASMIOP); /* READ INPUT TAPE RECORD */ 00064000 ST @14,@AL00001 0098 00065000 L @15,@CV00079 0098 00066000 LA @01,@AL00001 0098 00067000 BALR @14,@15 0098 00068000 * IF IOPRETRN>EOF /* I/O ERROR? */ 00069000 * THEN 0099 00070000 L @14,IOPPTR-1 0099 00071000 LA @14,0(,@14) 0099 00072000 CLI IOPRETRN(@14),4 0099 00073000 BNH @RF00099 0099 00074000 * RETURN CODE(IOERR); /* INDICATE I/O ERROR */ 00075000 LA @15,12 0100 00076000 L @13,4(,@13) 0100 00077000 L @14,12(,@13) 0100 00078000 LM @00,@12,20(@13) 0100 00079000 BR @14 0100 00080000 * IF BUFFER(1:2)ª=SLASHAST /* END OF FILE? */ 00081000 * &BUFFER(1:2)ª=TWOSLASH /* OR JCL ENCOUNTERED ? */ 00082000 * &IOPRETRN=GOOD /* AND NOT END OF FILE */ 00083000 * THEN 0101 00084000 @RF00099 L @14,IOPPTR-1 0101 00085000 LA @14,0(,@14) 0101 00086000 L @10,IOPBUFAD(,@14) 0101 00087000 CLC BUFFER(2,@10),@CC00054 0101 00088000 BE @RF00101 0101 00089000 CLC BUFFER(2,@10),@CC00056 0101 00090000 BE @RF00101 0101 00091000 CLI IOPRETRN(@14),0 0101 00092000 BE @RT00101 0101 00093000 * GO TO COPYSC10; /* NO - CONTINUE SCAN */ 00094000 * IF SELECTSW=ON /* IS THIS A DLIB ENTRY */ 00095000 * THEN /* YES - MUST CREATE ENTRY */ 00096000 @RF00101 TM SELECTSW,B'10000000' 0103 00097000 BNO @RF00103 0103 00098000 * IF IGNORESW=OFF /* IF NOT TO IGNORE THIS DLIB */ 00099000 * THEN 0104 00100000 TM IGNORESW,B'01000000' 0104 00101000 BNZ @RF00104 0104 00102000 * DO; /* MAKE A DLIB ENTRY */ 00103000 * CALL DLIBSTR; /* STORE DLIB ENTRY */ 00104000 BAL @14,DLIBSTR 0106 00105000 * IF RTNCDE=BADO /* I/O ERROR? */ 00106000 * THEN 0107 00107000 CH RTNCDE,@CH00046 0107 00108000 BNE @RF00107 0107 00109000 * RETURN CODE(IOERR); /* YES - INDICATE */ 00110000 LA @15,12 0108 00111000 L @13,4(,@13) 0108 00112000 L @14,12(,@13) 0108 00113000 LM @00,@12,20(@13) 0108 00114000 BR @14 0108 00115000 * END; 0109 00116000 @RF00107 DS 0H 0110 00117000 * IF IOPRETRN=EOF /* HAS END OF FILE BEEN FOUND? */ 00118000 * THEN 0110 00119000 @RF00104 DS 0H 0110 00120000 @RF00103 L @14,IOPPTR-1 0110 00121000 LA @14,0(,@14) 0110 00122000 CLI IOPRETRN(@14),4 0110 00123000 BNE @RF00110 0110 00124000 * RETURN CODE(PREMEOF); /* YES - IND PREMATURE EOF */ 00125000 LA @15,8 0111 00126000 L @13,4(,@13) 0111 00127000 L @14,12(,@13) 0111 00128000 LM @00,@12,20(@13) 0111 00129000 BR @14 0111 00130000 * IF BUFFER(1:2)=TWOSLASH /* WAS JCL FOUND ? */ 00131000 * THEN 0112 00132000 @RF00110 L @14,IOPPTR-1 0112 00133000 LA @14,0(,@14) 0112 00134000 L @14,IOPBUFAD(,@14) 0112 00135000 CLC BUFFER(2,@14),@CC00056 0112 00136000 BNE @RF00112 0112 00137000 * RETURN CODE(JCLENC); /* YES - INDICATE TO DRIVER */ 00138000 LA @15,20 0113 00139000 L @13,4(,@13) 0113 00140000 L @14,12(,@13) 0113 00141000 LM @00,@12,20(@13) 0113 00142000 BR @14 0113 00143000 * ELSE 0114 00144000 * RETURN CODE(GOOD); /* RETURN WITH GOOD CODE 0114 00145000 * */ 00146000 @RF00112 SLR @15,@15 0114 00147000 L @13,4(,@13) 0114 00148000 L @14,12(,@13) 0114 00149000 LM @00,@12,20(@13) 0114 00150000 BR @14 0114 00151000 * 0115 00152000 */********************************************************************/ 00153000 */* */ 00154000 */* OUTPUT LIBRARY FOUND - SAVE VALUE */ 00155000 */* */ 00156000 */********************************************************************/ 00157000 * 0115 00158000 *SYSLR010: 0115 00159000 * PROCEDURE OPTIONS(SAVEAREA); 0115 00160000 @EL00001 L @13,4(,@13) 0115 00161000 @EF00001 DS 0H 0115 00162000 @ER00001 LM @14,@12,12(@13) 0115 00163000 BR @14 0115 00164000 @PB00001 DS 0H 0115 00165000 SYSLR010 STM @14,@12,12(@13) 0115 00166000 ST @13,@SA00002+4 0115 00167000 LA @14,@SA00002 0115 00168000 ST @14,8(,@13) 0115 00169000 LR @13,@14 0115 00170000 * IF SELECTSW=ON /* IF THIS IS A DLIB ENTRY */ 00171000 * THEN 0116 00172000 TM SELECTSW,B'10000000' 0116 00173000 BNO @RF00116 0116 00174000 * IF IGNORESW=OFF /* AND NOT TO IGNORE THIS */ 00175000 * THEN /* DLIB ENTRY */ 00176000 TM IGNORESW,B'01000000' 0117 00177000 BNZ @RF00117 0117 00178000 * DO; /* GO STORE THE DLIB ENTRY */ 00179000 * CALL DLIBSTR; /* STORE THE ENTRY */ 00180000 BAL @14,DLIBSTR 0119 00181000 * IF RTNCDE=BADO /* BAD RETURN? */ 00182000 * THEN /* YES - INDICATE TO SCAN */ 00183000 CH RTNCDE,@CH00046 0120 00184000 BNE @RF00120 0120 00185000 * DO; 0121 00186000 * SCPRET=REALBAD; /* INDICATE ERROR */ 00187000 MVI SCPRET,X'08' 0122 00188000 * RETURN; /* RETURN TO SCAN */ 00189000 @EL00002 L @13,4(,@13) 0123 00190000 @EF00002 DS 0H 0123 00191000 @ER00002 LM @14,@12,12(@13) 0123 00192000 BR @14 0123 00193000 * END; 0124 00194000 * END; 0125 00195000 @RF00120 DS 0H 0126 00196000 * SYSLIBSV=STRING(1:SCPPMLN); /* SAVE SYSTEM LIBRARY */ 00197000 @RF00117 DS 0H 0126 00198000 @RF00116 MVI SYSLIBSV+1,C' ' 0126 00199000 MVC SYSLIBSV+2(6),SYSLIBSV+1 0126 00200000 LH @14,SCPPMLN 0126 00201000 BCTR @14,0 0126 00202000 L @10,SCPCHAR 0126 00203000 EX @14,@SM00331 0126 00204000 * SELECTSW=ON; /* INDICATE COPY STMT */ 00205000 OI SELECTSW,B'10000000' 0127 00206000 * SCPRET=GOOD; /* SET GOOD RETURN */ 00207000 MVI SCPRET,X'00' 0128 00208000 * END SYSLR010; /* RETURN */ 00209000 B @EL00002 0129 00210000 */********************************************************************/ 00211000 */* */ 00212000 */* INPUT DLIB FOUND - SAVE IN CDS ENTRY */ 00213000 */* */ 00214000 */********************************************************************/ 00215000 * 0130 00216000 *DLIBR010: 0130 00217000 * PROCEDURE; 0130 00218000 DLIBR010 STM @14,@12,12(@13) 0130 00219000 * IF SCPPMLN>DLIBLMAX /* DOES LENGTH EXCEED DLIB MAX? */ 00220000 * ³STRING(1:UTLN)=SYSUT /* OR IS THIS SYSUT LIBRARY? */ 00221000 * THEN 0131 00222000 LH @14,SCPPMLN 0131 00223000 CH @14,@CH00074 0131 00224000 BH @RT00131 0131 00225000 L @14,SCPCHAR 0131 00226000 CLC STRING(5,@14),@CC00072 0131 00227000 BNE @RF00131 0131 00228000 @RT00131 DS 0H 0132 00229000 * IGNORESW=ON; /* YES - MUST IGNORE THIS ONE */ 00230000 OI IGNORESW,B'01000000' 0132 00231000 * ELSE /* ELSE SAVE VALUE */ 00232000 * DO; 0133 00233000 B @RC00131 0133 00234000 @RF00131 DS 0H 0134 00235000 * IGNORESW=OFF; /* INDICATE NOT TO IGNORE */ 00236000 NI IGNORESW,B'10111111' 0134 00237000 * DLIBSV=STRING(1:SCPPMLN); /* SAVE DLIB NAME */ 00238000 MVI DLIBSV+1,C' ' 0135 00239000 MVC DLIBSV+2(5),DLIBSV+1 0135 00240000 LH @14,SCPPMLN 0135 00241000 BCTR @14,0 0135 00242000 L @10,SCPCHAR 0135 00243000 EX @14,@SM00336 0135 00244000 * END; 0136 00245000 * SCPRET=GOOD; /* INDICATE SUCCESS */ 00246000 @RC00131 MVI SCPRET,X'00' 0137 00247000 * END DLIBR010; /* RETURN TO SCAN 0138 00248000 * */ 00249000 @EL00003 DS 0H 0138 00250000 @EF00003 DS 0H 0138 00251000 @ER00003 LM @14,@12,12(@13) 0138 00252000 BR @14 0138 00253000 * 0139 00254000 */********************************************************************/ 00255000 */* */ 00256000 */* MEMBER NAME FOUND FOR POSSIBLE RENAME */ 00257000 */* */ 00258000 */********************************************************************/ 00259000 * 0139 00260000 *MEMNM010: 0139 00261000 * PROCEDURE; 0139 00262000 MEMNM010 STM @14,@12,12(@13) 0139 00263000 * IOPNAME=STRING(1:SCPPMLN); /* MOVE MODULE NAME TO IOP */ 00264000 L @14,IOPPTR-1 0140 00265000 LA @14,0(,@14) 0140 00266000 MVI IOPNAME+1(@14),C' ' 0140 00267000 MVC IOPNAME+2(6,@14),IOPNAME+1(@14) 0140 00268000 LH @10,SCPPMLN 0140 00269000 BCTR @10,0 0140 00270000 L @01,SCPCHAR 0140 00271000 EX @10,@SM00338 0140 00272000 * LOADMDSV=IOPNAME; /* SAVE LOAD MODULE NAME */ 00273000 MVC LOADMDSV(8),IOPNAME(@14) 0141 00274000 * SCPRET=GOOD; /* INDICATE SUCCESS */ 00275000 MVI SCPRET,X'00' 0142 00276000 * END MEMNM010; /* RETURN */ 00277000 @EL00004 DS 0H 0143 00278000 @EF00004 DS 0H 0143 00279000 @ER00004 LM @14,@12,12(@13) 0143 00280000 BR @14 0143 00281000 */********************************************************************/ 00282000 */* */ 00283000 */* RENAME SPECIFIED - CHANGE LM NAME IN CDS */ 00284000 */* */ 00285000 */********************************************************************/ 00286000 * 0144 00287000 *MEMNM020: 0144 00288000 * PROCEDURE; 0144 00289000 MEMNM020 STM @14,@12,12(@13) 0144 00290000 * LOADMDSV=STRING(1:SCPPMLN); /* MEMBER RENAMED - UPDATED LMOD */ 00291000 MVI LOADMDSV+1,C' ' 0145 00292000 MVC LOADMDSV+2(6),LOADMDSV+1 0145 00293000 LH @14,SCPPMLN 0145 00294000 BCTR @14,0 0145 00295000 L @10,SCPCHAR 0145 00296000 EX @14,@SM00340 0145 00297000 * SCPRET=GOOD; /* INDICATE SUCCESS */ 00298000 MVI SCPRET,X'00' 0146 00299000 * END MEMNM020; /* RETURN TO CONTINUE SCAN */ 00300000 @EL00005 DS 0H 0147 00301000 @EF00005 DS 0H 0147 00302000 @ER00005 LM @14,@12,12(@13) 0147 00303000 BR @14 0147 00304000 */********************************************************************/ 00305000 */* */ 00306000 */* ONLY ONE MEMBER ON SELECT STMT */ 00307000 */* */ 00308000 */********************************************************************/ 00309000 * 0148 00310000 *MEMNM030: 0148 00311000 * PROCEDURE OPTIONS(SAVEAREA); 0148 00312000 MEMNM030 STM @14,@12,12(@13) 0148 00313000 ST @13,@SA00006+4 0148 00314000 LA @14,@SA00006 0148 00315000 ST @14,8(,@13) 0148 00316000 LR @13,@14 0148 00317000 * IOPNAME=STRING(1:SCPPMLN); /* SAVE MODULE NAME */ 00318000 L @14,IOPPTR-1 0149 00319000 LA @14,0(,@14) 0149 00320000 MVI IOPNAME+1(@14),C' ' 0149 00321000 MVC IOPNAME+2(6,@14),IOPNAME+1(@14) 0149 00322000 LH @10,SCPPMLN 0149 00323000 BCTR @10,0 0149 00324000 L @01,SCPCHAR 0149 00325000 EX @10,@SM00338 0149 00326000 * LOADMDSV=IOPNAME; /* SAVE LOAD MODULE NAME */ 00327000 MVC LOADMDSV(8),IOPNAME(@14) 0150 00328000 * CALL CDSWRT10; /* WRITE MEMBER */ 00329000 BAL @14,CDSWRT10 0151 00330000 * END MEMNM030; /* PASS RTN CDE TO SCAN 0152 00331000 * */ 00332000 @EL00006 L @13,4(,@13) 0152 00333000 @EF00006 DS 0H 0152 00334000 @ER00006 LM @14,@12,12(@13) 0152 00335000 BR @14 0152 00336000 * 0153 00337000 */********************************************************************/ 00338000 */* */ 00339000 */* SELECT STMT COMPLETE - OUTPUT ENTRY OF CDS */ 00340000 */* */ 00341000 */********************************************************************/ 00342000 * 0153 00343000 *CDSWRT10: 0153 00344000 * PROCEDURE OPTIONS(SAVEAREA); 0153 00345000 CDSWRT10 STM @14,@12,12(@13) 0153 00346000 ST @13,@SA00007+4 0153 00347000 LA @14,@SA00007 0153 00348000 ST @14,8(,@13) 0153 00349000 LR @13,@14 0153 00350000 * IF IGNORESW=ON /* IGNORE THIS STATEMENT? */ 00351000 * THEN /* YES - SKIP OUTPUT */ 00352000 TM IGNORESW,B'01000000' 0154 00353000 BNO @RF00154 0154 00354000 * DO; 0155 00355000 * SCPRET=GOOD; /* INDICATE SUCCESS TO SCAN */ 00356000 MVI SCPRET,X'00' 0156 00357000 * RETURN; /* EXIT TO CONTINUE */ 00358000 @EL00007 L @13,4(,@13) 0157 00359000 @EF00007 DS 0H 0157 00360000 @ER00007 LM @14,@12,12(@13) 0157 00361000 BR @14 0157 00362000 * END; 0158 00363000 * SELECTSW=OFF; /* INDICATE SELECT STMT FOUND */ 00364000 * 0159 00365000 @RF00154 NI SELECTSW,B'01111111' 0159 00366000 * /*****************************************************************/ 00367000 * /* */ 00368000 * /* LOCATE MODULE IN THE CDS */ 00369000 * /* */ 00370000 * /*****************************************************************/ 00371000 * 0160 00372000 * IOPCDTYP=IOPCMOD; /* INDICATE CSECT ENTRY */ 00373000 L @14,IOPPTR-1 0160 00374000 LA @14,0(,@14) 0160 00375000 OI IOPCDTYP(@14),B'11000000' 0160 00376000 * IOPDSID=IOPCDSM; /* INDICATE CDS */ 00377000 MVI IOPDSID(@14),X'02' 0161 00378000 * IOPFUNCT=IOPLOC; /* INDICATE LOCATE OPERATION */ 00379000 MVI IOPFUNCT(@14),X'03' 0162 00380000 * IOPMODID=BLANK; /* INDICATE NO MODIFIER ID */ 00381000 MVI IOPMODID+1(@14),C' ' 0163 00382000 MVI IOPMODID(@14),C' ' 0163 00383000 * CALL HMASMIO(HMASMIOP); /* FIND MODULE ENTRY */ 00384000 ST @14,@AL00001 0164 00385000 L @15,@CV00079 0164 00386000 LA @01,@AL00001 0164 00387000 BALR @14,@15 0164 00388000 * IF IOPRETRN>NOTFOUND /* I/O ERROR? */ 00389000 * THEN 0165 00390000 L @14,IOPPTR-1 0165 00391000 LA @14,0(,@14) 0165 00392000 CLI IOPRETRN(@14),4 0165 00393000 BH @RT00165 0165 00394000 * GO TO CDSRTNBD; /* YES - EXIT BADLY TO SCAN */ 00395000 * I=1; /* SET POSITION INDICATOR */ 00396000 * 0167 00397000 LA @10,1 0167 00398000 LR I,@10 0167 00399000 * /*****************************************************************/ 00400000 * /* */ 00401000 * /* LOOK FOR LOAD MODULE ALREADY PRESENT IN LOCATED ENTRY */ 00402000 * /* */ 00403000 * /*****************************************************************/ 00404000 * 0168 00405000 * IF IOPRETRN=FOUND /* MODULE ENTRY FOUND? */ 00406000 * THEN /* YES - CHECK LOAD MOD LIST */ 00407000 CLI IOPRETRN(@14),0 0168 00408000 BNE @RF00168 0168 00409000 * DO I=1 TO LISTLIM /* LOOP THROUGH LOAD MODULES */ 00410000 * WHILE IOPLMODS(I,1)ª=IOPEOLST;/* LOOKING FOR A */ 00411000 LR I,@10 0169 00412000 @DL00169 L @14,IOPPTR-1 0169 00413000 LA @14,0(,@14) 0169 00414000 LR @10,I 0169 00415000 SLA @10,3 0169 00416000 SLR @03,@03 0169 00417000 IC @03,IOPLMODS-8(@10,@14) 0169 00418000 CH @03,@CH00215 0169 00419000 BE @DC00169 0169 00420000 * IF IOPLMODS(I)=LOADMDSV /* THIS MEMBER ON LIST? */ 00421000 * THEN 0170 00422000 ALR @14,@10 0170 00423000 CLC IOPLMODS-8(8,@14),LOADMDSV 0170 00424000 BE @RT00170 0170 00425000 * GO TO BYPASS10; /* YES - SKIP ADD */ 00426000 * END; 0172 00427000 AH I,@CH00036 0172 00428000 CH I,@CH00044 0172 00429000 BNH @DL00169 0172 00430000 @DC00169 DS 0H 0173 00431000 * IF I>LISTLIM /* EXCEEDED MAX NUMBER IN LIST */ 00432000 * THEN 0173 00433000 @RF00168 CH I,@CH00044 0173 00434000 BH @RT00173 0173 00435000 * GO TO CDSRTNBD; /* EXIT BADLY TO SCAN 0174 00436000 * */ 00437000 * 0175 00438000 * /*****************************************************************/ 00439000 * /* */ 00440000 * /* BUILD MODULE ENTRY AND STORE IN THE CDS */ 00441000 * /* */ 00442000 * /*****************************************************************/ 00443000 * 0175 00444000 * IOPLMODS(I)=LOADMDSV; /* PUT LOAD MOD NAME IN LIST */ 00445000 L @14,IOPPTR-1 0175 00446000 LA @14,0(,@14) 0175 00447000 LR @10,I 0175 00448000 SLA @10,3 0175 00449000 ST @10,@TF00001 0175 00450000 ALR @10,@14 0175 00451000 MVC IOPLMODS-8(8,@10),LOADMDSV 0175 00452000 * IOPLMODS(I+1,1)=IOPEOLST; /* INDICATE NEW END TO LIST */ 00453000 LA @10,255 0176 00454000 L @03,@TF00001 0176 00455000 STC @10,IOPLMODS(@03,@14) 0176 00456000 * IOPDLIB=DLIBSV; /* PUT DIST LIB INTO ENTRY */ 00457000 MVC IOPDLIB(7,@14),DLIBSV 0177 00458000 * IOPFUNCT=IOPSTOWR; /* INDICATE STOW OPERATION */ 00459000 MVI IOPFUNCT(@14),X'08' 0178 00460000 * CALL HMASMIO(HMASMIOP); /* STOW UPDATED MODULE ENTRY */ 00461000 ST @14,@AL00001 0179 00462000 L @15,@CV00079 0179 00463000 LA @01,@AL00001 0179 00464000 BALR @14,@15 0179 00465000 * IF IOPRETRNª=GOOD /* SUCCESSFUL I/O? */ 00466000 * THEN 0180 00467000 L @14,IOPPTR-1 0180 00468000 LA @14,0(,@14) 0180 00469000 CLI IOPRETRN(@14),0 0180 00470000 BNE @RT00180 0180 00471000 * GO TO CDSRTNBD; /* NO - RETURN BADLY TO SCAN */ 00472000 * 0181 00473000 * /*****************************************************************/ 00474000 * /* */ 00475000 * /* LOCATE LOAD MODULE IN THE CDS */ 00476000 * /* */ 00477000 * /*****************************************************************/ 00478000 * 0182 00479000 *BYPASS10: 0182 00480000 * IOPNAME=LOADMDSV; /* PUT LOAD MOD NAME IN LIST */ 00481000 BYPASS10 L @14,IOPPTR-1 0182 00482000 LA @14,0(,@14) 0182 00483000 MVC IOPNAME(8,@14),LOADMDSV 0182 00484000 * IOPCDTYP=IOPCLMOD; /* INDICATE LOAD MODULE TYPE */ 00485000 NI IOPCDTYP(@14),B'01111111' 0183 00486000 OI IOPCDTYP(@14),B'01000000' 0183 00487000 * IOPFUNCT=IOPLOC; /* INDICATE LOCATE OPERATION */ 00488000 MVI IOPFUNCT(@14),X'03' 0184 00489000 * IOPMODID=BLANK; /* INDICATE NO MODIFIER ID */ 00490000 MVI IOPMODID+1(@14),C' ' 0185 00491000 MVI IOPMODID(@14),C' ' 0185 00492000 * CALL HMASMIO(HMASMIOP); /* FIND LOAD MODULE ENTRY */ 00493000 ST @14,@AL00001 0186 00494000 L @15,@CV00079 0186 00495000 LA @01,@AL00001 0186 00496000 BALR @14,@15 0186 00497000 * IF IOPRETRN>NOTFOUND /* I/O ERROR? */ 00498000 * THEN 0187 00499000 L @14,IOPPTR-1 0187 00500000 LA @14,0(,@14) 0187 00501000 CLI IOPRETRN(@14),4 0187 00502000 BH @RT00187 0187 00503000 * GO TO CDSRTNBD; /* YES - EXIT BADLY */ 00504000 * 0188 00505000 * /*****************************************************************/ 00506000 * /* */ 00507000 * /* LOOK FOR SYSTEM LIB PRESENT IN LOCATED ENTRY */ 00508000 * /* */ 00509000 * /*****************************************************************/ 00510000 * 0189 00511000 * IF IOPRETRN=FOUND /* LOAD MODULE FOUND? */ 00512000 * THEN /* YES - CHECK IF LIBRARY HERE */ 00513000 CLI IOPRETRN(@14),0 0189 00514000 BNE @RF00189 0189 00515000 * DO; 0190 00516000 * IF IOPSYSLB(1)=SYSLIBSV /* IS THIS THE LIBRARY NAME? */ 00517000 * ³IOPSYSLB(2)=SYSLIBSV /* OR THIS? */ 00518000 * THEN /* YES - IGNORE STOW */ 00519000 CLC IOPSYSLB(8,@14),SYSLIBSV 0191 00520000 BE @RT00191 0191 00521000 CLC IOPSYSLB+8(8,@14),SYSLIBSV 0191 00522000 BNE @RF00191 0191 00523000 @RT00191 DS 0H 0192 00524000 * DO; 0192 00525000 * SCPRET=GOOD; /* INDICATE GOOD RETURN */ 00526000 MVI SCPRET,X'00' 0193 00527000 * RETURN; /* RETURN AND IGNORE STOW */ 00528000 B @EL00007 0194 00529000 * END; 0195 00530000 * I=2; /* SET STORE INDEX FOR SYSLIB */ 00531000 @RF00191 LA I,2 0196 00532000 * END; 0197 00533000 * ELSE /* NOT FOUND..... */ 00534000 * I=1; /* SET STORE INDEX FOR NOT FOUND */ 00535000 B @RC00189 0198 00536000 @RF00189 LA I,1 0198 00537000 * IOPSYSLB(I)=SYSLIBSV; /* SAVE SYSLIB IN PROPER PLASE */ 00538000 @RC00189 L @14,IOPPTR-1 0199 00539000 LA @14,0(,@14) 0199 00540000 LR @10,I 0199 00541000 SLA @10,3 0199 00542000 ST @10,@TF00001 0199 00543000 ALR @10,@14 0199 00544000 MVC IOPSYSLB-8(8,@10),SYSLIBSV 0199 00545000 * IOPSYSLB(I+1,1)=IOPEOLST; /* INDICATE NEW END OF LIST 0200 00546000 * */ 00547000 LA @10,255 0200 00548000 L @03,@TF00001 0200 00549000 STC @10,IOPSYSLB(@03,@14) 0200 00550000 * 0201 00551000 * /*****************************************************************/ 00552000 * /* */ 00553000 * /* BUILD LOAD MODULE ENTRY AND STORE IN THE CDS */ 00554000 * /* */ 00555000 * /*****************************************************************/ 00556000 * 0201 00557000 * IOPFLGS2=BINZERO; /* ZERO FLAGS IN ENTRY */ 00558000 MVI IOPFLGS2(@14),X'00' 0201 00559000 * IOPFLGS3=BINZERO; /* ZERO ENTRY FLAGS */ 00560000 MVI IOPFLGS3(@14),X'00' 0202 00561000 * IOPCOPY=ON; /* INDICATE IEBCOPY RUN */ 00562000 OI IOPCOPY(@14),B'10000000' 0203 00563000 * IOPFUNCT=IOPSTOWR; /* INDICATE STOW OPERATION */ 00564000 MVI IOPFUNCT(@14),X'08' 0204 00565000 * CALL HMASMIO(HMASMIOP); /* WRITE LOAD MOD ENTRY TO CDS */ 00566000 ST @14,@AL00001 0205 00567000 L @15,@CV00079 0205 00568000 LA @01,@AL00001 0205 00569000 BALR @14,@15 0205 00570000 * IF IOPRETRNª=GOOD /* SUCCESSFUL STOW? */ 00571000 * THEN 0206 00572000 L @14,IOPPTR-1 0206 00573000 LA @14,0(,@14) 0206 00574000 CLI IOPRETRN(@14),0 0206 00575000 BNE @RT00206 0206 00576000 * GO TO CDSRTNBD; /* NO - EXIT BADLY TO SCAN */ 00577000 * SCPRET=GOOD; /* INDICATE CONTINUE SCAN */ 00578000 MVI SCPRET,X'00' 0208 00579000 * RETURN; /* RETURN TO SCAN */ 00580000 B @EL00007 0209 00581000 *CDSRTNBD: /* BAD RETURN TO SCAN */ 00582000 * SCPRET=REALBAD; /* INDICATE ERROR */ 00583000 CDSRTNBD MVI SCPRET,X'08' 0210 00584000 * END CDSWRT10; /* RETURN TO SCAN 0211 00585000 * */ 00586000 B @EL00007 0211 00587000 *DLIBSTR: 0212 00588000 * PROCEDURE OPTIONS(SAVEAREA); 0212 00589000 * 0212 00590000 DLIBSTR STM @14,@12,12(@13) 0212 00591000 ST @13,@SA00008+4 0212 00592000 LA @14,@SA00008 0212 00593000 ST @14,8(,@13) 0212 00594000 LR @13,@14 0212 00595000 * /*****************************************************************/ 00596000 * /* */ 00597000 * /* THIS SUBROUTINE IS INVOKED TO STORE CDS DLIB ENTRIES. FIRST */ 00598000 * /* LOCATE THE MEMBER IN THE CDS */ 00599000 * /* */ 00600000 * /*****************************************************************/ 00601000 * 0213 00602000 * IOPDSID=IOPCDSM; /* INDICATE CDS */ 00603000 L @14,IOPPTR-1 0213 00604000 LA @14,0(,@14) 0213 00605000 MVI IOPDSID(@14),X'02' 0213 00606000 * IOPFUNCT=IOPLOC; /* INDICATE LOCATE OPERATION */ 00607000 MVI IOPFUNCT(@14),X'03' 0214 00608000 * IOPNAME2=DLIBSV; /* PUT DIST LIB NAME IN IOP */ 00609000 MVC IOPNAME2(7,@14),DLIBSV 0215 00610000 * IOPTYPE=IOPCDLIB; /* INDICATE DLIB TYPE OF ENTRY */ 00611000 MVI IOPTYPE(@14),C'0' 0216 00612000 * CALL HMASMIO(HMASMIOP); /* LOCATE DLIB MEMBER */ 00613000 ST @14,@AL00001 0217 00614000 L @15,@CV00079 0217 00615000 LA @01,@AL00001 0217 00616000 BALR @14,@15 0217 00617000 * IF IOPRETRN>NOTFOUND /* I/O ERROR? */ 00618000 * THEN 0218 00619000 L @14,IOPPTR-1 0218 00620000 LA @14,0(,@14) 0218 00621000 CLI IOPRETRN(@14),4 0218 00622000 BNH @RF00218 0218 00623000 * RETURN CODE(BADO); /* YES - EXIT BADLY */ 00624000 * 0219 00625000 LA @15,4 0219 00626000 L @13,4(,@13) 0219 00627000 L @14,12(,@13) 0219 00628000 LM @00,@12,20(@13) 0219 00629000 BR @14 0219 00630000 * /*****************************************************************/ 00631000 * /* */ 00632000 * /* IF LOCATED, CHECK IF THIS SYSLIB IS ALREADY THERE. */ 00633000 * /* */ 00634000 * /*****************************************************************/ 00635000 * 0220 00636000 * IF IOPRETRN=FOUND /* MEMBER FOUND? */ 00637000 * THEN /* YES... */ 00638000 @RF00218 L @14,IOPPTR-1 0220 00639000 LA @14,0(,@14) 0220 00640000 CLI IOPRETRN(@14),0 0220 00641000 BNE @RF00220 0220 00642000 * DO; /* CHECK IF SYSLIB SAME */ 00643000 * IF IOPDSYS(1)=SYSLIBSV /* IS THIS PROPER SYSLIB */ 00644000 * ³IOPDSYS(2)=SYSLIBSV /* OR THIS ONE??? */ 00645000 * THEN 0222 00646000 CLC IOPDSYS(8,@14),SYSLIBSV 0222 00647000 BE @RT00222 0222 00648000 CLC IOPDSYS+8(8,@14),SYSLIBSV 0222 00649000 BNE @RF00222 0222 00650000 @RT00222 DS 0H 0223 00651000 * RETURN CODE(GOOD); /* YES - DON'T UPDATE NTRY */ 00652000 SLR @15,@15 0223 00653000 L @13,4(,@13) 0223 00654000 L @14,12(,@13) 0223 00655000 LM @00,@12,20(@13) 0223 00656000 BR @14 0223 00657000 * I=2; /* SET STORE INDEX */ 00658000 @RF00222 LA I,2 0224 00659000 * END; 0225 00660000 * ELSE /* MEMBER NOT FOUND */ 00661000 * I=1; /* SET STORE INDEX FNOT FND */ 00662000 * 0226 00663000 B @RC00220 0226 00664000 @RF00220 LA I,1 0226 00665000 * /*****************************************************************/ 00666000 * /* */ 00667000 * /* BUILD AND STORE UPDATED DLIB CDS ENTRY */ 00668000 * /* */ 00669000 * /*****************************************************************/ 00670000 * 0227 00671000 * IOPDSYS(I)=SYSLIBSV; /* PUT SYSTEM LIB IN ENTRY */ 00672000 @RC00220 L @14,IOPPTR-1 0227 00673000 LA @14,0(,@14) 0227 00674000 LR @10,I 0227 00675000 SLA @10,3 0227 00676000 ST @10,@TF00001 0227 00677000 ALR @10,@14 0227 00678000 MVC IOPDSYS-8(8,@10),SYSLIBSV 0227 00679000 * IOPDSYS(I+1,1)=IOPEOLST; /* INDICATE NEW END OF LIST */ 00680000 LA @10,255 0228 00681000 L @03,@TF00001 0228 00682000 STC @10,IOPDSYS(@03,@14) 0228 00683000 * IOPFUNCT=IOPSTOWR; /* INDICATE STOW OPERATION */ 00684000 MVI IOPFUNCT(@14),X'08' 0229 00685000 * CALL HMASMIO(HMASMIOP); /* STOW UPDATED DLIB MEMBER */ 00686000 ST @14,@AL00001 0230 00687000 L @15,@CV00079 0230 00688000 LA @01,@AL00001 0230 00689000 BALR @14,@15 0230 00690000 * IF IOPRETRNª=GOOD /* I/O ERROR? */ 00691000 * THEN 0231 00692000 L @14,IOPPTR-1 0231 00693000 LA @14,0(,@14) 0231 00694000 CLI IOPRETRN(@14),0 0231 00695000 BE @RF00231 0231 00696000 * RETURN CODE(BADO); /* YES - EXIT BADLY */ 00697000 LA @15,4 0232 00698000 L @13,4(,@13) 0232 00699000 L @14,12(,@13) 0232 00700000 LM @00,@12,20(@13) 0232 00701000 BR @14 0232 00702000 * RETURN CODE(GOOD); /* EXIT TO CALLER */ 00703000 @RF00231 SLR @15,@15 0233 00704000 L @13,4(,@13) 0233 00705000 L @14,12(,@13) 0233 00706000 LM @00,@12,20(@13) 0233 00707000 BR @14 0233 00708000 * END DLIBSTR; 0234 00709000 * END HMASMCPY 0235 00710000 * 0235 00711000 */* THE FOLLOWING INCLUDE STATEMENTS WERE FOUND IN THIS PROGRAM. */ 00712000 */*%INCLUDE SYSLIB (HMASMCCA) */ 00713000 */*%INCLUDE SYSLIB (HMASMSCP) */ 00714000 */*%INCLUDE SYSLIB (HMASMIOP) */ 00715000 * 0235 00716000 * ; 0235 00717000 @DATA DS 0H 00718000 @CH00036 DC H'1' 00719000 @CH00046 DC H'4' 00720000 @CH00074 DC H'7' 00721000 @CH00044 DC H'40' 00722000 @CH00068 DC H'71' 00723000 @CH00215 DC H'255' 00724000 @SM00331 MVC SYSLIBSV(0),STRING(@10) 00725000 @SM00336 MVC DLIBSV(0),STRING(@10) 00726000 @SM00338 MVC IOPNAME(0,@14),STRING(@01) 00727000 @SM00340 MVC LOADMDSV(0),STRING(@10) 00728000 DS 0F 00729000 @AL00093 DC A(HMASMSCP) LIST WITH 1 ARGUMENT(S) 00730000 DS 0F 00731000 @SA00001 DS 18F 00732000 @SA00008 DS 18F 00733000 @SA00002 DS 18F 00734000 @SA00006 DS 18F 00735000 @SA00007 DS 18F 00736000 @AL00001 DS 1A 00737000 @TF00001 DS F 00738000 DS 0F 00739000 @CV00078 DC V(HMASMSCN) 00740000 @CV00079 DC V(HMASMIO) 00741000 DS 0D 00742000 DS CL1 00743000 IOPPTR DS AL3 00744000 @CC00054 DC C'/*' 00745000 @CC00056 DC C'//' 00746000 @CC00072 DC C'SYSUT' 00747000 SYSLIBSV DS CL8 00748000 DLIBSV DS CL7 00749000 LOADMDSV DS CL8 00750000 HMASMSCP DS CL22 00751000 ORG HMASMSCP 00752000 SCPCHAR DS AL4 00753000 SCPSRCH DS AL4 00754000 SCPWKAR DS AL4 00755000 SCPIORTN DS AL4 00756000 SCPINLN DS FL2 00757000 SCPPMLN DS FL2 00758000 SCPEOR DS BL1 00759000 ORG SCPEOR 00760000 SCPCONT DS BL1 00761000 SCPNOCT EQU SCPEOR+0 00762000 SCPCOMNT EQU SCPEOR+0 00763000 @NM00004 EQU SCPEOR+0 00764000 ORG HMASMSCP+21 00765000 SCPRET DS FL1 00766000 ORG HMASMSCP+22 00767000 SWITCHES DS BL1 00768000 ORG SWITCHES 00769000 SELECTSW DS BL1 00770000 IGNORESW EQU SWITCHES+0 00771000 ORG SWITCHES+1 00772000 ZAPAREA DC 50X'FF' 00773000 HMASMCPY CSECT 00774000 COPYK DSCAN KEY='COPY',ALT=CK,SUCC=OUTDDK 00775000 CK DSCAN KEY='C',ALT=SELK,SUCC=OUTDDK 00776000 OUTDDK DSCAN KEY='OUTDD=',SUCC=DDN1P,ALT=OK 00777000 OK DSCAN KEY='O=',SUCC=DDN1P,ALT=INDD 00778000 DDN1P DSCAN SUCC=COMMA1,ROUT=SYSLR010 00779000 COMMA1 DSCAN KEY=',',SUCC=INDDK 00780000 INDDK DSCAN KEY='INDD=',SUCC=LPAREN1,ALT=IK 00781000 IK DSCAN KEY='I=',SUCC=LPAREN1 00782000 LPAREN1 DSCAN KEY='(',ALT=DDN2P,SUCC=LPAREN1 00783000 DDN2P DSCAN ROUT=DLIBR010 00784000 INDD DSCAN KEY='INDD=',ALT=INDDS,SUCC=LPAREN1A 00785000 INDDS DSCAN KEY='I=',SUCC=LPAREN1A 00786000 LPAREN1A DSCAN KEY='(',ALT=DDN2P1,SUCC=LPAREN1A 00787000 DDN2P1 DSCAN ROUT=DLIBR010,SUCC=RPAREN 00788000 RPAREN DSCAN KEY=')',ALT=RSCAN,SUCC=RPAREN 00789000 RSCAN DSCAN KEY=',R',ALT=COMMA1A,SUCC=RPAREN 00790000 COMMA1A DSCAN KEY=',',SUCC=OUTDDK1 00791000 OUTDDK1 DSCAN KEY='OUTDD=',ALT=OK1,SUCC=DDN1P1 00792000 OK1 DSCAN KEY='O=',SUCC=DDN1P1 00793000 DDN1P1 DSCAN ROUT=SYSLR010 00794000 SELK DSCAN KEY='SELECT',ALT=SK,SUCC=MEMK 00795000 SK DSCAN KEY='S',SUCC=MEMK,ALT=EXCLK 00796000 EXCLK DSCAN 00797000 MEMK DSCAN KEY='MEMBER=',ALT=MK,SUCC=LPAREN2 00798000 MK DSCAN KEY='M=',SUCC=LPAREN2 00799000 LPAREN2 DSCAN KEY='(',SUCC=LPAREN3,ALT=ONLYONE 00800000 LPAREN3 DSCAN KEY='(',SUCC=M1P,ALT=M3P 00801000 M1P DSCAN SUCC=COMMA2,ROUT=MEMNM010 00802000 COMMA2 DSCAN KEY=',',SUCC=COMMA3,ALT=RPAREN1 00803000 COMMA3 DSCAN KEY=',',SUCC=RK,ALT=M2P 00804000 RK DSCAN KEY='R',SUCC=RPAREN1 00805000 RPAREN1 DSCAN KEY=')',SUCC=RPAREN2 00806000 RPAREN2 DSCAN KEY=')',ALT=COMMA4,ROUT=CDSWRT10 00807000 M2P DSCAN SUCC=COMMA6,ROUT=MEMNM020 00808000 M3P DSCAN SUCC=COMMA5,ROUT=MEMNM010 00809000 COMMA4 DSCAN KEY=',',SUCC=LPAREN3,ROUT=CDSWRT10 00810000 COMMA5 DSCAN KEY=',',SUCC=LPAREN3,ALT=RPAREN2,ROUT=CDSWRT10 00811000 COMMA6 DSCAN KEY=',',SUCC=RK,ALT=RPAREN1 00812000 ONLYONE DSCAN ROUT=MEMNM030 00813000 HMASMCPY CSECT 00814000 @00 EQU 00 EQUATES FOR REGISTERS 0-15 00815000 @01 EQU 01 00816000 @02 EQU 02 00817000 @03 EQU 03 00818000 @04 EQU 04 00819000 @05 EQU 05 00820000 @06 EQU 06 00821000 @07 EQU 07 00822000 @08 EQU 08 00823000 @09 EQU 09 00824000 @10 EQU 10 00825000 @11 EQU 11 00826000 @12 EQU 12 00827000 @13 EQU 13 00828000 @14 EQU 14 00829000 @15 EQU 15 00830000 I EQU @02 00831000 RTNCDE EQU @15 00832000 CCAPTR EQU @11 00833000 HMASMCCA EQU 0 00834000 CCAIOPTR EQU HMASMCCA+8 00835000 CCAOPT EQU HMASMCCA+76 00836000 CCAFLAG1 EQU HMASMCCA+77 00837000 CCAFLAG2 EQU HMASMCCA+78 00838000 CCAFLAG3 EQU HMASMCCA+79 00839000 HMASMIOP EQU 0 00840000 IOPDSID EQU HMASMIOP 00841000 IOPFUNCT EQU HMASMIOP+1 00842000 IOPRETRN EQU HMASMIOP+2 00843000 IOPBUFAD EQU HMASMIOP+4 00844000 IOPNAME EQU HMASMIOP+8 00845000 IOPTYPE EQU IOPNAME 00846000 IOPCDTYP EQU IOPTYPE 00847000 IOPNAME2 EQU IOPNAME+1 00848000 IOPTTR EQU HMASMIOP+16 00849000 IOPUDATA EQU HMASMIOP+20 00850000 BUFFER EQU 0 00851000 STRING EQU 0 00852000 IOPMOCDS EQU IOPUDATA 00853000 IOPMODID EQU IOPMOCDS 00854000 IOPDLIB EQU IOPMOCDS+2 00855000 IOPLMODS EQU IOPMOCDS+9 00856000 IOPLMCDS EQU IOPUDATA 00857000 IOPFLGS2 EQU IOPLMCDS 00858000 IOPFLGS3 EQU IOPLMCDS+1 00859000 IOPCOPY EQU IOPFLGS3 00860000 IOPSYSLB EQU IOPLMCDS+2 00861000 IOPMACDS EQU IOPUDATA 00862000 IOPPTCDS EQU IOPUDATA 00863000 IOPFLGS5 EQU IOPPTCDS 00864000 IOPSTAT EQU IOPFLGS5 00865000 IOPPNTRY EQU IOPPTCDS+4 00866000 IOPDLCDS EQU IOPUDATA 00867000 IOPDSYS EQU IOPDLCDS 00868000 IOPSYCDS EQU IOPUDATA 00869000 IOPFLGS7 EQU IOPSYCDS 00870000 IOPSTCMP EQU IOPUDATA 00871000 IOPPTSNT EQU IOPUDATA 00872000 IOPPFLG1 EQU IOPPTSNT 00873000 IOPPLEPR EQU IOPPTSNT+1 00874000 IOPPNUM EQU IOPPTSNT+2 00875000 AGO .@UNREFD START UNREFERENCED COMPONENTS 00876000 IOPALISL EQU IOPPTSNT+22 00877000 IOPINDLB EQU IOPPTSNT+14 00878000 IOPDISTN EQU IOPPTSNT+7 00879000 IOPPDIG EQU IOPPNUM+2 00880000 IOPPID EQU IOPPNUM 00881000 IOPPNE EQU IOPPLEPR 00882000 IOPPDC EQU IOPPLEPR 00883000 IOPPREFR EQU IOPPLEPR 00884000 IOPPOVLY EQU IOPPLEPR 00885000 IOPPSCTR EQU IOPPLEPR 00886000 IOPPREUS EQU IOPPLEPR 00887000 IOPPRENT EQU IOPPLEPR 00888000 @NM00011 EQU IOPPLEPR 00889000 @NM00010 EQU IOPPFLG1 00890000 IOPLEFND EQU IOPPFLG1 00891000 IOPDALIS EQU IOPPFLG1 00892000 IOPTALIS EQU IOPPFLG1 00893000 IOPLIBTX EQU IOPPFLG1 00894000 IOPLIBLK EQU IOPPFLG1 00895000 IOPSTNEW EQU IOPSTCMP+8 00896000 IOPSTOLD EQU IOPSTCMP 00897000 IOPPDLM EQU IOPSYCDS+8 00898000 IOPPEMAX EQU IOPSYCDS+6 00899000 IOPNUCID EQU IOPSYCDS+5 00900000 IOPSREL EQU IOPSYCDS+1 00901000 @NM00009 EQU IOPFLGS7 00902000 IOPTSO EQU IOPFLGS7 00903000 IOPPIND EQU IOPPNTRY+8 00904000 IOPPMODS EQU IOPPNTRY 00905000 IOPDATE EQU IOPPTCDS+1 00906000 @NM00008 EQU IOPFLGS5 00907000 IOPDUMMP EQU IOPSTAT 00908000 IOPFORCE EQU IOPSTAT 00909000 IOPACC EQU IOPSTAT 00910000 IOPAPP EQU IOPSTAT 00911000 IOPASMOD EQU IOPMACDS+2 00912000 @NM00007 EQU IOPMACDS 00913000 @NM00006 EQU IOPFLGS3 00914000 IOPCHREP EQU IOPFLGS3 00915000 IOPLINK EQU IOPFLGS3 00916000 IOPNE EQU IOPFLGS2 00917000 IOPDC EQU IOPFLGS2 00918000 IOPREFR EQU IOPFLGS2 00919000 IOPOVLY EQU IOPFLGS2 00920000 IOPSCTR EQU IOPFLGS2 00921000 IOPREUS EQU IOPFLGS2 00922000 IOPRENT EQU IOPFLGS2 00923000 @NM00005 EQU IOPFLGS2 00924000 IOPUSERL EQU HMASMIOP+19 00925000 IOPBLKSI EQU IOPTTR 00926000 IOPMACID EQU HMASMIOP+3 00927000 CCABLKSZ EQU HMASMCCA+92 00928000 CCASPDCB EQU HMASMCCA+88 00929000 CCADATE EQU HMASMCCA+85 00930000 CCASREL EQU HMASMCCA+81 00931000 CCANUCID EQU HMASMCCA+80 00932000 @NM00003 EQU CCAFLAG3 00933000 CCACOPYP EQU CCAFLAG3 00934000 CCALINKP EQU CCAFLAG3 00935000 CCAZAPP EQU CCAFLAG3 00936000 @NM00002 EQU CCAFLAG2 00937000 CCAICSB EQU CCAFLAG2 00938000 CCATERM EQU CCAFLAG2 00939000 CCASVCLB EQU CCAFLAG2 00940000 CCATSO EQU CCAFLAG2 00941000 CCACPYCP EQU CCAFLAG2 00942000 CCANCPTF EQU CCAFLAG2 00943000 CCALSCDS EQU CCAFLAG2 00944000 CCALSLOG EQU CCAFLAG1 00945000 CCAUPDU EQU CCAFLAG1 00946000 CCAUPDJ EQU CCAFLAG1 00947000 CCARES EQU CCAFLAG1 00948000 CCAREJ EQU CCAFLAG1 00949000 CCAACCPT EQU CCAFLAG1 00950000 CCAAPPLY EQU CCAFLAG1 00951000 CCAREC EQU CCAFLAG1 00952000 @NM00001 EQU CCAOPT 00953000 CCACPOPT EQU CCAOPT 00954000 CCALKOPT EQU CCAOPT 00955000 CCABFPMX EQU HMASMCCA+74 00956000 CCABFMMX EQU HMASMCCA+72 00957000 CCAPEMAX EQU HMASMCCA+70 00958000 CCAMXERR EQU HMASMCCA+68 00959000 CCAJFPTS EQU HMASMCCA+64 00960000 CCAJFCDS EQU HMASMCCA+60 00961000 CCALKSIZ EQU HMASMCCA+56 00962000 CCAUPDTE EQU HMASMCCA+52 00963000 CCAIOSUP EQU HMASMCCA+48 00964000 CCASPZAP EQU HMASMCCA+44 00965000 CCACOPY EQU HMASMCCA+40 00966000 CCAASM EQU HMASMCCA+36 00967000 CCALKED EQU HMASMCCA+32 00968000 CCAPESIZ EQU HMASMCCA+28 00969000 CCAICLMD EQU HMASMCCA+24 00970000 CCAICMOD EQU HMASMCCA+20 00971000 CCAICPTF EQU HMASMCCA+16 00972000 CCAICT EQU HMASMCCA+12 00973000 CCABUFAD EQU HMASMCCA+4 00974000 CCAID EQU HMASMCCA 00975000 .@UNREFD ANOP END UNREFERENCED COMPONENTS 00976000 @RT00101 EQU COPYSC10 00977000 @RT00165 EQU CDSRTNBD 00978000 @RT00170 EQU BYPASS10 00979000 @RT00173 EQU CDSRTNBD 00980000 @RT00180 EQU CDSRTNBD 00981000 @RT00187 EQU CDSRTNBD 00982000 @RT00206 EQU CDSRTNBD 00983000 @PB00008 EQU @EL00001 00984000 @PB00007 EQU @PB00008 00985000 @PB00006 EQU @PB00007 00986000 @PB00005 EQU @PB00006 00987000 @PB00004 EQU @PB00005 00988000 @PB00003 EQU @PB00004 00989000 @PB00002 EQU @PB00003 00990000 @ENDDATA EQU * 00991000 END HMASMCPY 00992000 ./ ADD SSI=40280047,NAME=HMASMDRV,SOURCE=1 COMPON=DN611 TITLE 'HMASMDRV - SMP DRIVER ROUTINE *00001000 ' 00002000 HMASMDRV CSECT , 0001 00003000 @MAINENT DS 0H 0001 00004000 USING *,@15 0001 00005000 B @PROLOG 0001 00006000 DC AL1(16) 0001 00007000 DC C'HMASMDRV 74.028' 0001 00008000 DROP @15 00009000 @PROLOG STM @14,@12,12(@13) 0001 00010000 BALR @12,0 0001 00011000 @PSTART LA @10,4095(,@12) 0001 00012000 USING @PSTART,@12 0001 00013000 USING @PSTART+4095,@10 0001 00014000 ST @13,@SA00001+4 0001 00015000 LA @14,@SA00001 0001 00016000 ST @14,8(,@13) 0001 00017000 LR @13,@14 0001 00018000 MVC @PC00001(4),0(@01) 0001 00019000 * 0179 00020000 * /*****************************************************************/ 00021000 * /* */ 00022000 * /* INITIALIZE SOME FIELDS IN THE CCA AND SET */ 00023000 * /* */ 00024000 * /*****************************************************************/ 00025000 * 0179 00026000 * CCAPTR=ADDR(HMASMCCA); /* SET ADDR OF CCA IN REG */ 00027000 LA CCAPTR,HMASMCCA 0179 00028000 * HMASMCCA=HMASMCCA&&HMASMCCA; /* ZERO THE CCA */ 00029000 XC HMASMCCA(94),HMASMCCA 0180 00030000 * CCAID=IDCCA; /* DUMP ID INTO THE CCA */ 00031000 MVC CCAID(4),@CC00095 0181 00032000 * CCAMXERR=DFTMXERR; /* SET DEFAULT MAX ERRORS/PTF */ 00033000 MVC CCAMXERR(2),@CH00034 0182 00034000 * SEFLAGS(1)=ZERO; /* SET INDICATORS IN SET */ 00035000 * 0183 00036000 L @14,SETPTR 0183 00037000 MVI SEFLAGS(@14),X'00' 0183 00038000 * /*****************************************************************/ 00039000 * /* */ 00040000 * /* GET TODAYS DATE FROM THE SYSTEM. THEN ASK OPERATOR IF IT IS */ 00041000 * /* CORRECT. THE SYSTEM TIME MAY BE WRONG DUE TO EXPIRATION DATES */ 00042000 * /* ON DATA SETS. THE OPERATOR MAY SET THE DATE WRONG AT IPL TIME.*/ 00043000 * /* */ 00044000 * /*****************************************************************/ 00045000 * 0184 00046000 * GEN(TIME DEC); /* GET CURRENT DATE AND TIME */ 00047000 TIME DEC 00048000 * RFY 0185 00049000 * R1 RSTD; 0185 00050000 * CCADATE=R1; /* PUT DATE IN THE CCA */ 00051000 ST R1,@TF00001 0186 00052000 MVC CCADATE(3),@TF00001+1 0186 00053000 * RFY 0187 00054000 * R1 UNRSTD; 0187 00055000 * MGPMGNO1=WTORMSG; /* INDICATE WTOR MESSAGE */ 00056000 MVI MGPMGNO1,X'00' 0188 00057000 * MGPMGNO2=ZERO; /* INDICATE NO SECONDARY MESSAGE */ 00058000 MVI MGPMGNO2,X'00' 0189 00059000 * MGPMGNO3=ZERO; /* INDICATE NO TERTIARY MESSAGE */ 00060000 MVI MGPMGNO3,X'00' 0190 00061000 * MGPVARPT(1)=ADDR(DATEOP); /* POINT TO REPLY AREA */ 00062000 LA @14,DATEOP 0191 00063000 ST @14,MGPVARPT 0191 00064000 * MGPFLAGS=ZERO; /* ZERO INDICATORS */ 00065000 MVI MGPFLAGS,X'00' 0192 00066000 *DATEMSG: 0193 00067000 * ; 0193 00068000 DATEMSG DS 0H 0194 00069000 * CALL HMASMMSG(HMASMMGP); /* ASK OPERATOR FOR THE DATE */ 00070000 L @15,@CV00174 0194 00071000 LA @01,@AL00194 0194 00072000 BALR @14,@15 0194 00073000 * DATEOP(1)=DATEOP(1)³UPCASE; /* MAKE DATE UPPER CASE */ 00074000 OI DATEOP,X'40' 0195 00075000 * IF DATEOP(1)ª=USEIT /* DID HE ENTER A NEW DATE? */ 00076000 * THEN /* YES - UPDATE THE CCA */ 00077000 CLI DATEOP,C'U' 0196 00078000 BE @RF00196 0196 00079000 * DO; 0197 00080000 * DO I=1 TO LENGTH(DATEOP); /* LOOP TO VERIFY NUMERIC ON DATE*/ 00081000 LA @14,1 0198 00082000 ST @14,I 0198 00083000 @DL00198 DS 0H 0199 00084000 * IF DATEOP(I)MEMNAME(J) /* THIS MEMBER HIGHER? */ 00178000 * THEN /* YES - SWITCH POSITIONS */ 00179000 LA @14,74 0226 00180000 L @01,I 0226 00181000 MR @00,@14 0226 00182000 LR @05,@14 0226 00183000 MR @04,J 0226 00184000 LA @14,MEMNAME-74(@01) 0226 00185000 LA @04,MEMNAME-74(@05) 0226 00186000 CLC 0(8,@14),0(@04) 0226 00187000 BNH @RF00226 0226 00188000 * DO; /* FOR BUBBLE SORT */ 00189000 * TEMP=MEMPOS(I); /* SAVE ONE FOR SWITCH */ 00190000 LA @14,MEMPOS-74(@01) 0228 00191000 MVC TEMP(10),0(@14) 0228 00192000 * MEMPOS(I)=MEMPOS(J); /* SWITCH ONE */ 00193000 LA @14,MEMPOS-74(@01) 0229 00194000 LA @04,MEMPOS-74(@05) 0229 00195000 MVC @TS00001(10),0(@04) 0229 00196000 MVC 0(10,@14),@TS00001 0229 00197000 * MEMPOS(J)=TEMP; /* SWITCH THE OTHER */ 00198000 LA @14,MEMPOS-74(@05) 0230 00199000 MVC 0(10,@14),TEMP 0230 00200000 * END; 0231 00201000 * END; 0232 00202000 @RF00226 AH J,@CH00040 0232 00203000 @DE00225 CH J,@CH00048 0232 00204000 BNH @DL00225 0232 00205000 * BLDLCCA(POSITN(I))=ADDR(MEMNAME(I));/* SET CCA ADDR */ 00206000 L @14,I 0233 00207000 LR @03,@14 0233 00208000 MH @03,@CH00187 0233 00209000 LA @01,POSITN-74(@03) 0233 00210000 MVC @TF00001(2),0(@01) 0233 00211000 LH @09,@TF00001 0233 00212000 SLA @09,2 0233 00213000 LA @03,MEMNAME-74(@03) 0233 00214000 ST @03,BLDLCCA-4(@09) 0233 00215000 * END; 0234 00216000 * 0234 00217000 AH @14,@CH00040 0234 00218000 ST @14,I 0234 00219000 CH @14,@CH00048 0234 00220000 BNH @DL00224 0234 00221000 * /*****************************************************************/ 00222000 * /* */ 00223000 * /* BLDL FOR PROGRAMS ON LINK OR STEPLIB */ 00224000 * /* */ 00225000 * /*****************************************************************/ 00226000 * 0235 00227000 * GEN(BLDL 0,BLDLLIST); /* BLDL FOR PROGRAMS TO USE */ 00228000 BLDL 0,BLDLLIST 00229000 * IF RCODREGª=ZERO /* DID ALL GET LOCATED? */ 00230000 * THEN /* NO - PROGRAM IS MISSING */ 00231000 LTR RCODREG,RCODREG 0236 00232000 BZ @RF00236 0236 00233000 * DO; /* ISSUE MESSAGE AND EXIT */ 00234000 * MGPMGNO1=PGMMISS; /* INDICATE MESSAGE ID */ 00235000 MVI MGPMGNO1,X'23' 0238 00236000 * DO I=1 TO NUMELMT; /* LOOP OUTPUTTING PROGRAM NAMES */ 00237000 LA @14,1 0239 00238000 ST @14,I 0239 00239000 @DL00239 DS 0H 0240 00240000 * IF MEMREC(I)=ZERO /* THIS PROGRAM FOUND? */ 00241000 * THEN /* NO - PUT OUT MESSAGE */ 00242000 SLR @03,@03 0240 00243000 MH @14,@CH00187 0240 00244000 LA @01,MEMREC-74(@14) 0240 00245000 MVC @ZT00003+3(1),0(@01) 0240 00246000 C @03,@ZT00003 0240 00247000 BNE @RF00240 0240 00248000 * IF MEMNAME(I)=IEHIOSUP /* IS THIS IOSUP BLDL ENTRY? */ 00249000 * THEN /* YES - INDICATE NO IOSUP */ 00250000 LA @01,MEMNAME-74(@14) 0241 00251000 CLC 0(8,@01),@CC00091 0241 00252000 BNE @RF00241 0241 00253000 * CCAIOSUP=ZERO; /* INDICATE NO BLDL ENTRY */ 00254000 ST @03,CCAIOSUP 0242 00255000 * ELSE /* OTHERWISE - ERROR CONDITION */ 00256000 * DO; 0243 00257000 B @RC00241 0243 00258000 @RF00241 DS 0H 0244 00259000 * MGPVARPT(1)=ADDR(MEMNAME(I));/* PT TO NAME */ 00260000 L @14,I 0244 00261000 MH @14,@CH00187 0244 00262000 LA @14,MEMNAME-74(@14) 0244 00263000 ST @14,MGPVARPT 0244 00264000 * CALL HMASMMSG(HMASMMGP);/* WRITE MESSAGE */ 00265000 L @15,@CV00174 0245 00266000 LA @01,@AL00245 0245 00267000 BALR @14,@15 0245 00268000 * RTNCODE=PGMMISCD; /* SET RETURN CODE */ 00269000 MVI RTNCODE,X'04' 0246 00270000 * END; 0247 00271000 * END; 0248 00272000 @RC00241 DS 0H 0248 00273000 @RF00240 LA @14,1 0248 00274000 AL @14,I 0248 00275000 ST @14,I 0248 00276000 CH @14,@CH00048 0248 00277000 BNH @DL00239 0248 00278000 * IF RTNCODE>ZERO /* WAS ERROR FOUND? */ 00279000 * THEN /* YES - EXIT */ 00280000 CLI RTNCODE,0 0249 00281000 BH @RT00249 0249 00282000 * GO TO FINAL; /* RETURN */ 00283000 * END; 0251 00284000 * 0252 00285000 * /*****************************************************************/ 00286000 * /* */ 00287000 * /* LOCATE THE SYSTEM ENTRY IN THE CDS. IF FOUND, THEN THE CCA IS */ 00288000 * /* UPDATED WITH INFORMATION FROM THE CDS. */ 00289000 * /* */ 00290000 * /*****************************************************************/ 00291000 * 0252 00292000 * IOPTYPE=IOPCSYS; /* INDICATE SYSTEM ENTRY */ 00293000 @RF00236 L @14,IOPPTR 0252 00294000 MVI IOPTYPE(@14),C'1' 0252 00295000 * IOPNAME2=SYSTEM; /* INDICATE SYSTEM ENTRY NAME */ 00296000 MVC IOPNAME2(7,@14),@CC00051 0253 00297000 * IOPDSID=IOPCDSM; /* INDICATE CONTROL DATA SET */ 00298000 MVI IOPDSID(@14),X'02' 0254 00299000 * IOPFUNCT=IOPLOC; /* INDICATE LOCATE OPERATION */ 00300000 MVI IOPFUNCT(@14),X'03' 0255 00301000 * CALL HMASMIO(HMASMIOP); /* LOCATE SYSTEM ENTRY ON CDS */ 00302000 ST @14,@AL00001 0256 00303000 L @15,@CV00173 0256 00304000 LA @01,@AL00001 0256 00305000 BALR @14,@15 0256 00306000 * IF IOPRETRN=GOOD /* IS IT LOCATED? */ 00307000 * THEN /* YES - SET CCA FIELDS */ 00308000 L @14,IOPPTR 0257 00309000 CLI IOPRETRN(@14),0 0257 00310000 BNE @RF00257 0257 00311000 * DO; /* FROM INFORMATION THERE */ 00312000 * IF IOPTSO=ON /* DOES SYSTEM HAVE TSO? */ 00313000 * THEN /* YES - TELL CCA */ 00314000 TM IOPTSO(@14),B'10000000' 0259 00315000 BNO @RF00259 0259 00316000 * CCATSO=ON; /* INDICATE TSO IN CCA */ 00317000 OI CCATSO,B'00010000' 0260 00318000 * ELSE /* OTHERWISE - NO TSO */ 00319000 * CCATSO=OFF; /* INDICATE NO TSO IN CCA */ 00320000 B @RC00259 0261 00321000 @RF00259 NI CCATSO,B'11101111' 0261 00322000 * CCASREL=IOPSREL; /* PUT SYSTEM/RELEASE IN CCA */ 00323000 @RC00259 L @14,IOPPTR 0262 00324000 MVC CCASREL(4),IOPSREL(@14) 0262 00325000 * CCANUCID=IOPNUCID; /* PUT NUCLEUS ID IN CCA */ 00326000 MVC CCANUCID(1),IOPNUCID(@14) 0263 00327000 * CCAPEMAX=IOPPEMAX; /* PUT PTF ELEMENT MAX IN CCA */ 00328000 MVC CCAPEMAX(2),IOPPEMAX(@14) 0264 00329000 * END; 0265 00330000 * 0265 00331000 * /*****************************************************************/ 00332000 * /* */ 00333000 * /* THE SYSTEM ENTRY IS NOT FOUND. SET DEFAULTS IN CCA */ 00334000 * /* */ 00335000 * /*****************************************************************/ 00336000 * 0266 00337000 * ELSE /* OTHERWISE - USE DEFAULT VALUES*/ 00338000 * DO; 0266 00339000 B @RC00257 0266 00340000 @RF00257 DS 0H 0267 00341000 * CCATSO=OFF; /* NO TSO */ 00342000 NI CCATSO,B'11101111' 0267 00343000 * CCASREL=BLANK; /* INDICATE NO SREL */ 00344000 MVI CCASREL+1,C' ' 0268 00345000 MVC CCASREL+2(2),CCASREL+1 0268 00346000 MVI CCASREL,C' ' 0268 00347000 * CCANUCID=CHARONE; /* IEANUC01 DEFAULT */ 00348000 MVI CCANUCID,C'1' 0269 00349000 * CCAPEMAX=PEMAXDFT; /* SET PEMAX DEFAULT */ 00350000 MVC CCAPEMAX(2),@CH00058 0270 00351000 * END; 0271 00352000 * IF IOPRETRN>NOTFND /* DID SERIOUS ERROR OCCUR */ 00353000 * THEN /* YES - EXIT */ 00354000 @RC00257 L @14,IOPPTR 0272 00355000 CLI IOPRETRN(@14),4 0272 00356000 BNH @RF00272 0272 00357000 * DO; 0273 00358000 * RTNCODE=IOERRCD; /* INDICATE ERROR RETURN */ 00359000 MVI RTNCODE,X'0C' 0274 00360000 * GO TO FINAL; /* EXIT */ 00361000 B FINAL 0275 00362000 * END; 0276 00363000 * 0277 00364000 * /*****************************************************************/ 00365000 * /* */ 00366000 * /* GET CORE FOR THE IOP (BASED ON SYSTEM ENTRY INFO) */ 00367000 * /* */ 00368000 * /*****************************************************************/ 00369000 * 0277 00370000 * SIZE=(LENGTH(IOPPNTRY)*CCAPEMAX)/* USE PTF CDS ENTRY AS BASE */ 00371000 * +LENGTH(IOPFLGS5)+LENGTH(IOPDATE)+ONE;/* FOR SIZE. */ 00372000 @RF00272 LH SIZE,CCAPEMAX 0277 00373000 MH SIZE,@CH00169 0277 00374000 AH SIZE,@CH00033 0277 00375000 * REMAINDR=(SIZE-DIRCTSZ)//LRECL; /* GET MULTIPLE OF LRECL FOR 0278 00376000 * DIRECTORY EXTENSIONS */ 00377000 LR @00,SIZE 0278 00378000 SH @00,@CH00062 0278 00379000 SRDA @00,32 0278 00380000 D @00,@CF00064 0278 00381000 LR REMAINDR,@00 0278 00382000 * CCAPESIZ=SIZE+REMAINDR; /* SET SIZE IN THE CCA */ 00383000 LR @14,SIZE 0279 00384000 ALR @14,REMAINDR 0279 00385000 ST @14,CCAPESIZ 0279 00386000 * SIZE=CCAPESIZ+FIXIOP; /* ADD FIXED PORTION OF THE IOP */ 00387000 AH @14,@CH00066 0280 00388000 LR SIZE,@14 0280 00389000 * GEN(GETMAIN EC,LV=(SIZE),A=CCAIOPTR);/* GET CORE FOR IOP */ 00390000 GETMAIN EC,LV=(SIZE),A=CCAIOPTR 00391000 * IF RCODREGª=GOOD /* NOT ENOUGH ROOM? */ 00392000 * THEN /* NO - ISSUE MESSAGE AND LEAVE */ 00393000 LTR RCODREG,RCODREG 0282 00394000 BZ @RF00282 0282 00395000 * DO; 0283 00396000 * MGPMGNO1=NOSPACE; /* SET MESSAGE INDICATOR */ 00397000 MVI MGPMGNO1,X'03' 0284 00398000 * CALL HMASMMSG(HMASMMGP); /* PUT MESSAGE TO PRINTER */ 00399000 L @15,@CV00174 0285 00400000 LA @01,@AL00285 0285 00401000 BALR @14,@15 0285 00402000 * RTNCODE=NOSPACD; /* SET RETURN CODE */ 00403000 MVI RTNCODE,X'04' 0286 00404000 * GO TO FINAL; /* TERMINATE THE RUN */ 00405000 B FINAL 0287 00406000 * END; 0288 00407000 * IOPPTR=CCAIOPTR; /* USE NEW IOP IN THE FUTURE */ 00408000 @RF00282 L @14,CCAIOPTR 0289 00409000 ST @14,IOPPTR 0289 00410000 * IOPBUFAD=ADDR(BUFFRIOP); /* SET BUFAD IN NEW IOP 0290 00411000 * */ 00412000 LA @03,BUFFRIOP 0290 00413000 ST @03,IOPBUFAD(,@14) 0290 00414000 * 0291 00415000 * /*****************************************************************/ 00416000 * /* */ 00417000 * /* READ THE JOB FILE CONTROL BLOCKS FOR THE PTS AND THE CDS SO */ 00418000 * /* THAT THE ASSEMBLER INTERFACE CAN DO OPEN TYPE=J */ 00419000 * /* */ 00420000 * /*****************************************************************/ 00421000 * 0291 00422000 * GEN(RDJFCB JFCDCB); /* READ CDS JFCB */ 00423000 RDJFCB JFCDCB 00424000 * CCAJFCDS=ADDR(CDSJFCB); /* SET CCA PTR TO CDS JFCB */ 00425000 LA @14,CDSJFCB 0292 00426000 ST @14,CCAJFCDS 0292 00427000 * DCBDDNAM=PTSNAME; /* PUT PTS NAME IN DCB */ 00428000 L @14,DCBPTR 0293 00429000 MVC DCBDDNAM+40(8,@14),@CC00076 0293 00430000 * JFCBPTR=ADDR(PTSJFCB); /* SET EXIT LIST JFCB ADDR */ 00431000 LA @14,PTSJFCB 0294 00432000 ST @14,@TF00001 0294 00433000 MVC JFCBPTR(3),@TF00001+1 0294 00434000 * GEN(RDJFCB JFCDCB); /* READ PTS JFCB */ 00435000 RDJFCB JFCDCB 00436000 * CCAJFPTS=ADDR(PTSJFCB); /* SET CCA PTR TO PTS JFCB */ 00437000 * 0296 00438000 LA @14,PTSJFCB 0296 00439000 ST @14,CCAJFPTS 0296 00440000 * /*****************************************************************/ 00441000 * /* */ 00442000 * /* CHECK FOR LINKLIB DD STATEMENT PRESENT. IF THERE, USE IOSUP */ 00443000 * /* FROM THAT LIBRARY. IF DD MISSING, THEN SKIP BLDL ON LIBRARY. A*/ 00444000 * /* RDJFCB IS ISSUED TO PREVENT DD STATEMENT MISSING MESSAGE. */ 00445000 * /* */ 00446000 * /*****************************************************************/ 00447000 * 0297 00448000 * DCBDDNAM=LINKNAME; /* PUT LINKLIB IN DCB */ 00449000 L @14,DCBPTR 0297 00450000 MVC DCBDDNAM+40(8,@14),@CC00093 0297 00451000 * JFCBPTR=ADDR(SUPJFCB); /* SET JFCBADDR TO IOSUP JFCB */ 00452000 LA @14,SUPJFCB 0298 00453000 ST @14,@TF00001 0298 00454000 MVC JFCBPTR(3),@TF00001+1 0298 00455000 * JFCBDSNM(1)=BLANK; /* BLANK THE DATA SET NAME */ 00456000 MVI JFCBDSNM(@14),C' ' 0299 00457000 * GEN(RDJFCB JFCDCB); /* READ JFCB */ 00458000 RDJFCB JFCDCB 00459000 * IF JFCBDSNM(1)ª=BLANK /* WAS THERE A LINKLIB DD? */ 00460000 * THEN /* YES - OPEN AND BLDL */ 00461000 MVC @ZT00001+1(3),JFCBPTR 0301 00462000 L @14,@ZT00001 0301 00463000 CLI JFCBDSNM(@14),C' ' 0301 00464000 BE @RF00301 0301 00465000 * DO; 0302 00466000 * GEN(OPEN (JFCDCB,INPUT),TYPE=J);/* OPEN LINKLIB */ 00467000 OPEN (JFCDCB,INPUT),TYPE=J 00468000 * IF DCBOFOPN=ON /* DID IT OPEN? */ 00469000 * THEN /* YES - LOCATE IOSUP */ 00470000 L @14,DCBPTR 0304 00471000 TM DCBOFOPN+40(@14),B'00010000' 0304 00472000 BNO @RF00304 0304 00473000 * DO; 0305 00474000 * GEN(BLDL JFCDCB,SUPBLDL);/* LOCATE IOSUP ON LINKLIB */ 00475000 BLDL JFCDCB,SUPBLDL 00476000 * IF RCODREGª=ZERO /* NOT FOUND? */ 00477000 * THEN /* NO - INDICATE NO IOSUP */ 00478000 SLR @14,@14 0307 00479000 CR RCODREG,@14 0307 00480000 BE @RF00307 0307 00481000 * CCAIOSUP=ZERO; /* ZERO BLDL LIST PTR FOR IOSUP */ 00482000 ST @14,CCAIOSUP 0308 00483000 * ELSE /* OTHERWISE - SET TO BLDL LIST */ 00484000 * DO; 0309 00485000 B @RC00307 0309 00486000 @RF00307 DS 0H 0310 00487000 * CCASPDCB=ADDR(JFCDCB);/* PASS DCB FOR APA AND RES */ 00488000 LA @14,JFCDCB 0310 00489000 ST @14,CCASPDCB 0310 00490000 * CCAIOSUP=ADDR(SUPNAME);/* POINT TO BLDL LIST */ 00491000 LA @14,SUPNAME 0311 00492000 ST @14,CCAIOSUP 0311 00493000 * END; 0312 00494000 * END; 0313 00495000 @RC00307 DS 0H 0314 00496000 * END; 0314 00497000 @RF00304 DS 0H 0315 00498000 * 0315 00499000 * /*****************************************************************/ 00500000 * /* */ 00501000 * /* OPEN THE PTS AND MACLIB TO DETERMINE BLOCKSIZE. GET CORE FOR */ 00502000 * /* THE BLOCK BUFFER, IF EITHER ONE IS BLOCKED */ 00503000 * /* */ 00504000 * /*****************************************************************/ 00505000 * 0315 00506000 * IOPDSID=IOPMACL; /* INDICATE MACLIB */ 00507000 @RF00301 L @14,IOPPTR 0315 00508000 MVI IOPDSID(@14),X'05' 0315 00509000 * IOPMACID=STARTMAC; /* SET STARTING MACLIB ID */ 00510000 MVI IOPMACID(@14),X'F1' 0316 00511000 * IOPFUNCT=IOPOPEN; /* INDICATE OPEN OPERATION */ 00512000 MVI IOPFUNCT(@14),X'00' 0317 00513000 * CALL HMASMIO(HMASMIOP); /* OPEN MACRO LIBRARY */ 00514000 ST @14,@AL00001 0318 00515000 L @15,@CV00173 0318 00516000 LA @01,@AL00001 0318 00517000 BALR @14,@15 0318 00518000 * IF IOPRETRN=GOOD /* DID IT GET OPENED? */ 00519000 * THEN /* YES - SAVE BLKSIZE */ 00520000 L @14,IOPPTR 0319 00521000 CLI IOPRETRN(@14),0 0319 00522000 BNE @RF00319 0319 00523000 * SIZE=IOPBLKSI; /* FROM THE IOP */ 00524000 MVC @TF00001(2),IOPBLKSI(@14) 0320 00525000 LH SIZE,@TF00001 0320 00526000 * ELSE /* OTHERWISE - USE LRECL */ 00527000 * SIZE=LRECL; /* PUT LRECL AS SIZE */ 00528000 B @RC00319 0321 00529000 @RF00319 LA SIZE,80 0321 00530000 * CCABFMMX=SIZE/LRECL; /* SET MAX RECS IN CCA FOR MACRO */ 00531000 @RC00319 LR @00,SIZE 0322 00532000 SRDA @00,32 0322 00533000 D @00,@CF00064 0322 00534000 STH @01,CCABFMMX 0322 00535000 * IOPDSID=IOPPTS; /* INDICATE PTS */ 00536000 L @14,IOPPTR 0323 00537000 MVI IOPDSID(@14),X'06' 0323 00538000 * CALL HMASMIO(HMASMIOP); /* OPEN PTS */ 00539000 ST @14,@AL00001 0324 00540000 L @15,@CV00173 0324 00541000 LA @01,@AL00001 0324 00542000 BALR @14,@15 0324 00543000 * IF IOPRETRN=GOOD /* DID IT GET OPENED? */ 00544000 * THEN /* YES - SAVE BLKSIZE */ 00545000 L @14,IOPPTR 0325 00546000 CLI IOPRETRN(@14),0 0325 00547000 BNE @RF00325 0325 00548000 * SIZE=IOPBLKSI; /* SET SIZE TO BLKSIZE */ 00549000 MVC @TF00001(2),IOPBLKSI(@14) 0326 00550000 LH SIZE,@TF00001 0326 00551000 * ELSE /* OTHERWISE - USE LRECL */ 00552000 * SIZE=LRECL; /* SET SIZE FROM LRECL */ 00553000 B @RC00325 0327 00554000 @RF00325 LA SIZE,80 0327 00555000 * CCABFPMX=SIZE/LRECL; /* SET MAX RECS IN CCA FOR PTS */ 00556000 @RC00325 LR @00,SIZE 0328 00557000 SRDA @00,32 0328 00558000 D @00,@CF00064 0328 00559000 STH @01,CCABFPMX 0328 00560000 * IF CCABFPMX>CCABFMMX /* IS PTS BLKSIZE LARGER? */ 00561000 * THEN /* YES - USE IT FOR GETMAIN */ 00562000 CH @01,CCABFMMX 0329 00563000 BNH @RF00329 0329 00564000 * SIZE=CCABFPMX; /* SET MAX SIZE FROM PTS */ 00565000 LR SIZE,@01 0330 00566000 * ELSE /* OTHERWISE, USE MACRO BLKSIZE */ 00567000 * SIZE=CCABFMMX; /* SET MAX SIZE FROM MACLIB */ 00568000 B @RC00329 0331 00569000 @RF00329 LH SIZE,CCABFMMX 0331 00570000 * IF SIZE=ONE /* NEITHER PTS OR MACLIB IS */ 00571000 * THEN /* BLOCKED? */ 00572000 @RC00329 CH SIZE,@CH00040 0332 00573000 BNE @RF00332 0332 00574000 * CCABUFAD=IOPBUFAD; /* SET PTRS EQUAL-NO BLOCK BUFF */ 00575000 L @14,IOPPTR 0333 00576000 MVC CCABUFAD(4),IOPBUFAD(@14) 0333 00577000 * ELSE /* ELSE, GET CORE FOR BLOCK BUFF */ 00578000 * DO; 0334 00579000 B @RC00332 0334 00580000 @RF00332 DS 0H 0335 00581000 * SIZE=SIZE*LRECL; /* GET SIZE OF BUFFER */ 00582000 LR @14,SIZE 0335 00583000 MH @14,@CH00064 0335 00584000 LR SIZE,@14 0335 00585000 * CCABLKSZ=SIZE; /* SAVE SIZE OF BLOCK BUFFER */ 00586000 STH SIZE,CCABLKSZ 0336 00587000 * GEN(GETMAIN EC,LV=(SIZE),A=CCABUFAD);/* GET CORE FOR BUFF */ 00588000 GETMAIN EC,LV=(SIZE),A=CCABUFAD 00589000 * IF RCODREGª=GOOD /* NO ROOM? */ 00590000 * THEN /* NO - ISSUE MESSAGE AND LEAVE */ 00591000 SLR @14,@14 0338 00592000 CR RCODREG,@14 0338 00593000 BE @RF00338 0338 00594000 * DO; 0339 00595000 * CCABLKSZ=ZERO; /* RESET BLOCKSIZE SO NO FREEMAIN*/ 00596000 STH @14,CCABLKSZ 0340 00597000 * MGPMGNO1=NOSPACE; /* INDICATE NO SPACE MESSAGE */ 00598000 MVI MGPMGNO1,X'03' 0341 00599000 * CALL HMASMMSG(HMASMMGP);/* WRITE MESSAGE TO PRINTER */ 00600000 L @15,@CV00174 0342 00601000 LA @01,@AL00342 0342 00602000 BALR @14,@15 0342 00603000 * RTNCODE=NOSPACD; /* SET RETURN CODE */ 00604000 MVI RTNCODE,X'04' 0343 00605000 * GO TO FINAL; /* EXIT */ 00606000 B FINAL 0344 00607000 * END; 0345 00608000 * END; 0346 00609000 @RF00338 DS 0H 0347 00610000 * 0347 00611000 * /*****************************************************************/ 00612000 * /* */ 00613000 * /* READ AND SCAN CONTROL CARDS TO DETERMINE OPERATION SCAN */ 00614000 * /* RETURNS AT SUBROUTINES TO INVOKE THE VARIOUS SMP VERB */ 00615000 * /* PROCESSORS */ 00616000 * /* */ 00617000 * /*****************************************************************/ 00618000 * 0347 00619000 * SCPSRCH=ADDR(RECK); /* SET START SEARCH FOR SCAN */ 00620000 @RC00332 LA @14,RECK 0347 00621000 ST @14,SCPSRCH 0347 00622000 * SCPIORTN=ADDR(DRVIO); /* SET PTR TO I/O ROUTINE */ 00623000 LA @14,DRVIO 0348 00624000 ST @14,SCPIORTN 0348 00625000 * SCPINLN=CONTSIZ; /* SET INPUT RECORD LENGTH */ 00626000 MVC SCPINLN(2),@CH00070 0349 00627000 * SCPEOR=ZERO; /* ZERO THE EOR FLAGS */ 00628000 MVI SCPEOR,X'00' 0350 00629000 * SCPCOMNT=ON; /* INDICATE COMMENTS OCCUR */ 00630000 OI SCPCOMNT,B'00100000' 0351 00631000 *DRVSCAN: 0352 00632000 * ; 0352 00633000 DRVSCAN DS 0H 0353 00634000 * CALL DRVIO; /* READ AND PRINT A STATEMENT */ 00635000 BAL @14,DRVIO 0353 00636000 * IF SCPRETª=GOOD /* WAS ERROR OR EOF FOUND? */ 00637000 * THEN /* YES - ALL DONE */ 00638000 CLI SCPRET,0 0354 00639000 BNE @RT00354 0354 00640000 * GO TO FINAL; /* EXIT */ 00641000 * CALL HMASMSCN(HMASMSCP); /* SCAN CONTROL STATEMENT */ 00642000 L @15,@CV00176 0356 00643000 LA @01,@AL00356 0356 00644000 BALR @14,@15 0356 00645000 * IF SCPRET=GOOD /* NO SYNTAX ERROR OR OTHER? */ 00646000 * THEN 0357 00647000 CLI SCPRET,0 0357 00648000 BNE @RF00357 0357 00649000 * IF EOFFLAG=ON /* AND END OF FILE? */ 00650000 * THEN /* OK TO CONTINUE */ 00651000 TM EOFFLAG,B'10000000' 0358 00652000 BNO @RF00358 0358 00653000 * DO; /* ERROR - INCOMPLETE VERB */ 00654000 * MGPMGNO1=NOVERB; /* INDICATE INCOMPLETE STMT */ 00655000 MVI MGPMGNO1,X'35' 0360 00656000 * CALL HMASMMSG(HMASMMGP); /* WRITE MESSAGE */ 00657000 L @15,@CV00174 0361 00658000 LA @01,@AL00361 0361 00659000 BALR @14,@15 0361 00660000 * RTNCODE=SYNTERR; /* INDICATE ERROR RETURN */ 00661000 MVI RTNCODE,X'04' 0362 00662000 * GO TO FINAL; /* EXIT */ 00663000 B FINAL 0363 00664000 * END; 0364 00665000 * IF SCPRETª=GOOD /* IS THERE AN ERROR? */ 00666000 * ³(SESELECT(1)=OFF&CCARES=ON)/* MASS RESTORE NOT ALLOWED */ 00667000 * THEN /* YES - CHECK IT OUT */ 00668000 @RF00358 DS 0H 0365 00669000 @RF00357 CLI SCPRET,0 0365 00670000 BNE @RT00365 0365 00671000 L @14,SETPTR 0365 00672000 TM SESELECT(@14),B'10000000' 0365 00673000 BNZ @RF00365 0365 00674000 TM CCARES,B'00001000' 0365 00675000 BNO @RF00365 0365 00676000 @RT00365 DS 0H 0366 00677000 * DO; 0366 00678000 * 0367 00679000 * /*************************************************************/ 00680000 * /* */ 00681000 * /* AN ERROR HAS OCCURRED. IT MAY BE SYNTAX ERROR OR I/O ERROR*/ 00682000 * /* IF RTNCODE HAS A VALUE, THEN THE CAUSE OF THE ERROR HAS */ 00683000 * /* ALREADY BEEN DETERMINED, OTHERWISE IT IS A SYNTAX ERROR IN*/ 00684000 * /* A CONTROL STATEMENT. */ 00685000 * /* */ 00686000 * /*************************************************************/ 00687000 * 0367 00688000 * FLUSHSW=ON; /* INDICATE FLUSH MODE */ 00689000 OI FLUSHSW,B'01000000' 0367 00690000 * IF RTNERR=ON /* HAS ERROR OCCURRED IN ROUT? */ 00691000 * THEN /* YES - NOT SYNTAX ERROR */ 00692000 TM RTNERR,B'00001000' 0368 00693000 BNO @RF00368 0368 00694000 * DO; 0369 00695000 * RTNERR=OFF; /* RESET ROUTINE SWITCH */ 00696000 NI RTNERR,B'11110111' 0370 00697000 * GO TO CLEANUP; /* SCAN NEXT RECORD */ 00698000 B CLEANUP 0371 00699000 * END; 0372 00700000 * ERRCOL=SCPCHAR-IOPBUFAD+1; /* CALCULATE COLUMN FOR ERROR */ 00701000 @RF00368 L ERRCOL,SCPCHAR 0373 00702000 L @14,IOPPTR 0373 00703000 SL ERRCOL,IOPBUFAD(,@14) 0373 00704000 AH ERRCOL,@CH00040 0373 00705000 * CVD(ERRCOL,DBLWRD); /* MAKE DECIMAL */ 00706000 CVD ERRCOL,DBLWRD 0374 00707000 * UNPK(CHARCOL,DBLWRD); /* MAKE EBCDIC */ 00708000 UNPK CHARCOL(2),DBLWRD(8) 0375 00709000 * LASTDIG=LASTDIG³MAKPRINT; /* MAKE PRINTABLE */ 00710000 OI LASTDIG,X'F0' 0376 00711000 * MGPMGNO1=SYNTAX; /* INDICATE SYNTAX ERROR */ 00712000 MVI MGPMGNO1,X'04' 0377 00713000 * MGPMGNO2=DRVIND; /* INDICATE DRIVER */ 00714000 MVI MGPMGNO2,X'15' 0378 00715000 * MGPMGNO3=COLNO; /* ADD IN COLUMN PART */ 00716000 MVI MGPMGNO3,X'1A' 0379 00717000 * MGPVARPT(1)=ADDR(CHARCOL); /* POINT TO VARIABLE MESSAGE */ 00718000 LA @14,CHARCOL 0380 00719000 ST @14,MGPVARPT 0380 00720000 * CALL HMASMMSG(HMASMMGP); /* ISSUE MESSAGE */ 00721000 L @15,@CV00174 0381 00722000 LA @01,@AL00381 0381 00723000 BALR @14,@15 0381 00724000 * MGPMGNO2=ZERO; /* RESET SECONDARY */ 00725000 MVI MGPMGNO2,X'00' 0382 00726000 * MGPMGNO3=ZERO; /* RESET FOR LATER MESSAGES */ 00727000 MVI MGPMGNO3,X'00' 0383 00728000 * IF EOFFLAG=ON /* END OF FILE FOUND? */ 00729000 * THEN /* YES - EXIT */ 00730000 TM EOFFLAG,B'10000000' 0384 00731000 BO @RT00384 0384 00732000 * GO TO FINAL; /* WE ARE DONE */ 00733000 * ELSE /* OTHERWISE - READ ANOTHER */ 00734000 * GO TO CLEANUP; /* CLEANUP AND CONTINUE */ 00735000 B CLEANUP 0386 00736000 * END; 0387 00737000 * 0388 00738000 * /*****************************************************************/ 00739000 * /* */ 00740000 * /* SCAN HAS COMPLETED A VERB - CHECK TYPE AND EXIT TO PROPER VERB*/ 00741000 * /* HANDLER. THE FOLLOWING ROUTINE IS INVOKED TO PROCESS LIST LOG */ 00742000 * /* VERB */ 00743000 * /* */ 00744000 * /*****************************************************************/ 00745000 * 0388 00746000 * IF CCALSLOG=ON /* IS IT LIST LOG? */ 00747000 * THEN /* YES - PROCESS THE VERB */ 00748000 @RF00365 TM CCALSLOG,B'00000001' 0388 00749000 BNO @RF00388 0388 00750000 * DO; 0389 00751000 * CALL HMASMLOG(LOGPARM); /* LIST LOG ROUTINE CALL */ 00752000 L @15,@CV00181 0390 00753000 LA @01,@AL00390 0390 00754000 BALR @14,@15 0390 00755000 * IF RCODREGª=GOOD /* ERROR FOUND? */ 00756000 * ³CCATERM=ON /* SMP MARKED FOR TERMINATE? */ 00757000 * THEN /* YES - INDICATE ERROR */ 00758000 LTR RCODREG,RCODREG 0391 00759000 BNZ @RT00391 0391 00760000 TM CCATERM,B'00000100' 0391 00761000 BO @RT00391 0391 00762000 * GO TO BADEND; /* TERMINATE RUN */ 00763000 * CCALSLOG=OFF; /* NO MORE LIST LOG */ 00764000 NI CCALSLOG,B'11111110' 0393 00765000 * GO TO DRVSCAN; /* GO SCAN NEXT STATEMENT */ 00766000 B DRVSCAN 0394 00767000 * END; 0395 00768000 * 0396 00769000 * /*****************************************************************/ 00770000 * /* */ 00771000 * /* THE FOLLOWING ROUTINE IS INVOKED FOR LIST CDS OR PARTIAL LIST */ 00772000 * /* OF CDS MEMBERS. */ 00773000 * /* */ 00774000 * /*****************************************************************/ 00775000 * 0396 00776000 * IF CCALSCDS=ON /* IS IT LIST CDS? */ 00777000 * THEN /* YES - PROCESS LIST */ 00778000 @RF00388 TM CCALSCDS,B'10000000' 0396 00779000 BNO @RF00396 0396 00780000 * DO; 0397 00781000 * CALL HMASMLCD(LCDPARM); /* CALL CDS LIST ROUTINE */ 00782000 L @15,@CV00180 0398 00783000 LA @01,@AL00398 0398 00784000 BALR @14,@15 0398 00785000 * IF RCODREGª=GOOD /* ERROR FOUND? */ 00786000 * ³CCATERM=ON /* SMP MARKED FOR TERMINATE? */ 00787000 * THEN /* YES - INDICATE ERROR */ 00788000 LTR RCODREG,RCODREG 0399 00789000 BNZ @RT00399 0399 00790000 TM CCATERM,B'00000100' 0399 00791000 BO @RT00399 0399 00792000 * GO TO BADEND; /* TERMINATE THE RUN */ 00793000 * LCDPARM=ZERO; /* ZERO THE FLAGS */ 00794000 MVI LCDPARM,X'00' 0401 00795000 * CCALSCDS=OFF; /* NO MORE LIST CDS */ 00796000 NI CCALSCDS,B'01111111' 0402 00797000 * GO TO DRVSCAN; /* GO SCAN NEXT STATEMENT */ 00798000 B DRVSCAN 0403 00799000 * END; 0404 00800000 * 0405 00801000 * /*****************************************************************/ 00802000 * /* */ 00803000 * /* FOLLOWING CODE IS TO HANDLE LOG VERB - WRITE MESSAGE */ 00804000 * /* */ 00805000 * /*****************************************************************/ 00806000 * 0405 00807000 * IF LOGVERB=ON /* IS IT LOG VERB? */ 00808000 * THEN /* YES - WRITE MESSAGE */ 00809000 @RF00396 TM LOGVERB,B'00010000' 0405 00810000 BNO @RF00405 0405 00811000 * DO; 0406 00812000 * IOPDSID=IOPHLDS; /* INDICATE HISTORY LOG DS */ 00813000 L @14,IOPPTR 0407 00814000 MVI IOPDSID(@14),X'01' 0407 00815000 * IOPFUNCT=IOPWRITE; /* INDICATE WRITE OPERATION */ 00816000 MVI IOPFUNCT(@14),X'05' 0408 00817000 * PRLRLEN=LOGLNTH+TEN; /* SET RECORD LENGTH */ 00818000 L @03,IOPBUFAD(,@14) 0409 00819000 LH @09,LOGLNTH 0409 00820000 LA @08,10 0409 00821000 ALR @08,@09 0409 00822000 STH @08,PRLRLEN(,@03) 0409 00823000 * PRLDATA(1:LOGLNTH)=LOGMSG; /* PUT MESSAGE IN PRL */ 00824000 BCTR @09,0 0410 00825000 EX @09,@SM01306 0410 00826000 * CALL HMASMIO(HMASMIOP); /* WRITE MESSAGE TO HLDS */ 00827000 ST @14,@AL00001 0411 00828000 L @15,@CV00173 0411 00829000 LA @01,@AL00001 0411 00830000 BALR @14,@15 0411 00831000 * IF IOPRETRNª=GOOD /* ERROR ON WRITE? */ 00832000 * THEN /* YES - ERROR EXIT */ 00833000 L @14,IOPPTR 0412 00834000 CLI IOPRETRN(@14),0 0412 00835000 BE @RF00412 0412 00836000 * DO; /* INDICATE AND LEAVE */ 00837000 * RTNCODE=ROUTERR; /* TELL MAIN ROUTING OF ERROR */ 00838000 MVI RTNCODE,X'10' 0414 00839000 * GO TO FINAL; /* TERMINATE THE RUN */ 00840000 B FINAL 0415 00841000 * END; 0416 00842000 * LOGVERB=OFF; /* NO MORE LOG VERB */ 00843000 @RF00412 NI LOGVERB,B'11101111' 0417 00844000 * GO TO DRVSCAN; /* GO SCAN NEXT VERB */ 00845000 B DRVSCAN 0418 00846000 * END; 0419 00847000 * 0420 00848000 * /*****************************************************************/ 00849000 * /* */ 00850000 * /* THIS ROUTINE IS INVOKED AT THE END OF THE VERBS UCLIN,JCLIN */ 00851000 * /* APPLY,ACCEPT,RECEIVE,REJECT, AND RESTORE. IT INVOKES THE */ 00852000 * /* PROPER ROUTINE TO HANDLE THE VERB. THIS ROUTINE PRINTS A BLANK*/ 00853000 * /* LINE AFTER THE STATEMENT. */ 00854000 * /* */ 00855000 * /*****************************************************************/ 00856000 * 0420 00857000 * IOPDSID=IOPPRINT; /* INDICATE PRINTER */ 00858000 @RF00405 L @14,IOPPTR 0420 00859000 MVI IOPDSID(@14),X'0B' 0420 00860000 * IOPFUNCT=IOPWRITE; /* INDICATE WRITE OPERATION */ 00861000 MVI IOPFUNCT(@14),X'05' 0421 00862000 * PRLHEAD=OFF; /* INDICATE NO HEADING */ 00863000 * PRLHEADO=OFF; /* INDICATE NOT TO CLEAR HEAD */ 00864000 * PRLBLANK=ON; /* INDICATE BLANK LINE */ 00865000 L @03,IOPBUFAD(,@14) 0424 00866000 OI PRLBLANK(@03),B'00100000' 0424 00867000 NI PRLHEAD(@03),B'00111111' 0424 00868000 * CALL HMASMIO(HMASMIOP); /* PRINT BLANK LINE */ 00869000 ST @14,@AL00001 0425 00870000 L @15,@CV00173 0425 00871000 LA @01,@AL00001 0425 00872000 BALR @14,@15 0425 00873000 * IF IOPRETRNª=GOOD /* ERROR RETURN? */ 00874000 * THEN /* YES - EXIT WITH ERROR */ 00875000 L @14,IOPPTR 0426 00876000 CLI IOPRETRN(@14),0 0426 00877000 BE @RF00426 0426 00878000 * DO; 0427 00879000 * RTNCODE=ROUTERR; /* SET ERROR CODE */ 00880000 MVI RTNCODE,X'10' 0428 00881000 * GO TO FINAL; /* TERMINATE THE RUN */ 00882000 B FINAL 0429 00883000 * END; 0430 00884000 * 0431 00885000 * /*****************************************************************/ 00886000 * /* */ 00887000 * /* THIS ROUTINE IS FOR THE UCLIN AND JCLIN VERBS */ 00888000 * /* */ 00889000 * /*****************************************************************/ 00890000 * 0431 00891000 * IF CCAUPDU=ON /* IS IT UCLIN? */ 00892000 * THEN /* YES CALL PROCESSOR */ 00893000 @RF00426 TM CCAUPDU,B'00000010' 0431 00894000 BNO @RF00431 0431 00895000 * DO; 0432 00896000 * CALL HMASMUCL; /* CALL UCL HANDLER */ 00897000 L @15,@CV00178 0433 00898000 BALR @14,@15 0433 00899000 * IOPPTR=CCAIOPTR; /* RESET IOPPTR IN CASE UPDATED */ 00900000 MVC IOPPTR(4),CCAIOPTR 0434 00901000 * IF RCODREGª=GOOD /* BAD RETURN FROM ROUTINE? */ 00902000 * ³CCATERM=ON /* OR SMP MARKED FOR TERMINATE? */ 00903000 * THEN /* YES - GO INTO FLUSH MODE */ 00904000 LTR RCODREG,RCODREG 0435 00905000 BNZ @RT00435 0435 00906000 TM CCATERM,B'00000100' 0435 00907000 BO @RT00435 0435 00908000 * GO TO BADEND; /* SET RETURN CODE AND CONTINUE */ 00909000 * CCAUPDU=OFF; /* NO MORE UCLIN */ 00910000 NI CCAUPDU,B'11111101' 0437 00911000 * GO TO HEADCLR; /* GO CLEAR HEADINGS - EXIT */ 00912000 B HEADCLR 0438 00913000 * END; 0439 00914000 * IF CCAUPDJ=ON /* IS IT JCLIN? */ 00915000 * THEN /* YES - CALL PROCESSOR */ 00916000 @RF00431 TM CCAUPDJ,B'00000100' 0440 00917000 BNO @RF00440 0440 00918000 * DO; 0441 00919000 * CALL HMASMUPD; /* INVOKE JCL PROCESSOR */ 00920000 L @15,@CV00179 0442 00921000 BALR @14,@15 0442 00922000 * IF RCODREGª=GOOD /* BAD RETURN FROM ROUTINE? */ 00923000 * ³CCATERM=ON /* OR SMP MARKED FOR TERMINATE? */ 00924000 * THEN /* YES - GO INTO FLUSH MODE */ 00925000 LTR RCODREG,RCODREG 0443 00926000 BNZ @RT00443 0443 00927000 TM CCATERM,B'00000100' 0443 00928000 BO @RT00443 0443 00929000 * GO TO BADEND; /* SET RETURN CODE AND CONTINUE */ 00930000 * CCAUPDJ=OFF; /* NO MORE JCLIN */ 00931000 NI CCAUPDJ,B'11111011' 0445 00932000 * GO TO HEADCLR; /* GO CLEAR HEADINGS - EXIT */ 00933000 B HEADCLR 0446 00934000 * END; 0447 00935000 * 0447 00936000 * /*****************************************************************/ 00937000 * /* */ 00938000 * /* INDICATE LAST PTF IN SET FOR ALL FOLLOWING VERBS */ 00939000 * /* */ 00940000 * /*****************************************************************/ 00941000 * 0448 00942000 * SELAST(SECTR)=ON; /* INDICATE THIS IS LAST 0448 00943000 * */ 00944000 @RF00440 L @14,SECTR 0448 00945000 SLA @14,3 0448 00946000 L @03,SETPTR 0448 00947000 ALR @03,@14 0448 00948000 AL @03,@CF01310 0448 00949000 OI SELAST(@03),B'00000001' 0448 00950000 * 0449 00951000 * /*****************************************************************/ 00952000 * /* */ 00953000 * /* RECEIVE PROCESSING */ 00954000 * /* */ 00955000 * /*****************************************************************/ 00956000 * 0449 00957000 * IF FLUSHSW=ON /* ARE WE IN FLUSH MODE? */ 00958000 * THEN /* YES - CLEANUP */ 00959000 TM FLUSHSW,B'01000000' 0449 00960000 BNO @RF00449 0449 00961000 * DO; 0450 00962000 * MGPMGNO1=FLUSHMSG; /* INDICATE FLUSHED STMT MSG */ 00963000 MVI MGPMGNO1,X'1E' 0451 00964000 * CALL HMASMMSG(HMASMMGP); /* WRITE MESSAGE */ 00965000 L @15,@CV00174 0452 00966000 LA @01,@AL00452 0452 00967000 BALR @14,@15 0452 00968000 * GO TO CLEANUP; /* SKIP PAST VERB */ 00969000 B CLEANUP 0453 00970000 * END; 0454 00971000 * IF CCAREC=ON /* IS IT RECEIVE VERB? */ 00972000 * THEN /* YES - INVOKE RECEIVE PROCESSOR*/ 00973000 @RF00449 TM CCAREC,B'10000000' 0455 00974000 BNO @RF00455 0455 00975000 * DO; 0456 00976000 * CALL HMASMREC(HMASMSET); /* HANDLE RECEIVE VERB */ 00977000 L @14,SETPTR 0457 00978000 ST @14,@AL00001 0457 00979000 L @15,@CV00175 0457 00980000 LA @01,@AL00001 0457 00981000 BALR @14,@15 0457 00982000 * IF RCODREGª=GOOD /* ERROR ENCOUNTERED? */ 00983000 * ³CCATERM=ON /* DURING RECEIVE */ 00984000 * THEN /* YES - GO SET ERROR FLGS */ 00985000 LTR RCODREG,RCODREG 0458 00986000 BNZ @RT00458 0458 00987000 TM CCATERM,B'00000100' 0458 00988000 BO @RT00458 0458 00989000 * GO TO BADEND; /* EXIT BADLY */ 00990000 * GO TO CLEANUP; /* CLEANUP PROCESSING */ 00991000 B CLEANUP 0460 00992000 * END; 0461 00993000 * 0462 00994000 * /*****************************************************************/ 00995000 * /* */ 00996000 * /* THE FOLLOWING IS TO HANDLE APPLY, ACCEPT, REJECT, AND RESTORE */ 00997000 * /* VERBS. */ 00998000 * /* */ 00999000 * /*****************************************************************/ 01000000 * 0462 01001000 * IF TBLNOLIB=OFF /* WAS NO LIB SPECIFIED */ 01002000 * &TBLLIBNM(1)=BLANK /* NO, AND NO OTHER LIB SPECIFIED*/ 01003000 * THEN /* NO, INDICATE USE DIST */ 01004000 @RF00455 TM TBLNOLIB,B'00000100' 0462 01005000 BNZ @RF00462 0462 01006000 CLI TBLLIBNM,C' ' 0462 01007000 BNE @RF00462 0462 01008000 * TBLDIST=ON; /* SET DISTRIBUTION LIB FLAG */ 01009000 OI TBLDIST,B'00001000' 0463 01010000 * CALL HMASMTBL(HMASMSET,TBLPARM);/* BUILD INCORE CDS TABLE(ICT) */ 01011000 @RF00462 L @14,SETPTR 0464 01012000 ST @14,@AL00001 0464 01013000 LA @14,TBLPARM 0464 01014000 ST @14,@AL00001+4 0464 01015000 L @15,@CV00177 0464 01016000 LA @01,@AL00001 0464 01017000 BALR @14,@15 0464 01018000 * IF RCODREGª=GOOD /* BAD TABLE BUILT? */ 01019000 * ³CCATERM=ON /* OR I/O ERROR FOUND */ 01020000 * THEN /* NO - EXIT BADLY */ 01021000 LTR RCODREG,RCODREG 0465 01022000 BNZ @RT00465 0465 01023000 TM CCATERM,B'00000100' 0465 01024000 BO @RT00465 0465 01025000 * GO TO BADEND; /* INDICATE ERROR */ 01026000 * IF CCAAPPLY=ON /* IS THIS APPLY VERB */ 01027000 * ³CCAACCPT=ON /* OR ACCEPT VERB */ 01028000 * THEN /* YES - INVOKE APA PROCESSOR */ 01029000 TM CCAAPPLY,B'01100000' 0467 01030000 BZ @RF00467 0467 01031000 * CALL HMASMAPA; /* HANDLE APPLY/ACCEPT VERB */ 01032000 L @15,@CV00171 0468 01033000 BALR @14,@15 0468 01034000 * ELSE /* OTHERWISE, REJECT/RESTORE */ 01035000 * CALL HMASMRES; /* CALL REJECT/RESTORE ROUTINE */ 01036000 B @RC00467 0469 01037000 @RF00467 L @15,@CV00172 0469 01038000 BALR @14,@15 0469 01039000 * IF RCODREGª=GOOD /* ERROR ENCOUNTERED BY APA */ 01040000 * ³CCATERM=ON /* OR SOMEONE ELSE */ 01041000 * THEN 0470 01042000 @RC00467 LTR RCODREG,RCODREG 0470 01043000 BNZ @RT00470 0470 01044000 TM CCATERM,B'00000100' 0470 01045000 BO @RT00470 0470 01046000 * GO TO BADEND; /* YES - EXIT BADLY */ 01047000 * ELSE /* OTHERWISE - OK */ 01048000 * GO TO CLEANUP; /* CLEANUP PROCESSING */ 01049000 * 0472 01050000 B CLEANUP 0472 01051000 * /*****************************************************************/ 01052000 * /* */ 01053000 * /* ERROR ENCOUNTERED IN VERB */ 01054000 * /* */ 01055000 * /*****************************************************************/ 01056000 * 0473 01057000 *BADEND: 0473 01058000 * ; 0473 01059000 BADEND DS 0H 0474 01060000 * IF RCODREG>RTNCODE /* THIS RETURN HIGHER THAN LAST? */ 01061000 * THEN /* YES - SAVE IT */ 01062000 MVC @ZT00003+3(1),RTNCODE 0474 01063000 C RCODREG,@ZT00003 0474 01064000 BNH @RF00474 0474 01065000 * RTNCODE=RCODREG; /* SET RETURN CODE */ 01066000 STC RCODREG,RTNCODE 0475 01067000 * IF CCATERM=ON /* TERMINATE SMP? */ 01068000 * &RTNCODE=ZERO /* AND NOT OTHER RETURN CODE? */ 01069000 * THEN /* YES - SET HIGHER RETURN CODE */ 01070000 @RF00474 TM CCATERM,B'00000100' 0476 01071000 BNO @RF00476 0476 01072000 CLI RTNCODE,0 0476 01073000 BNE @RF00476 0476 01074000 * RTNCODE=ROUTERR; /* INDICATE ERROR */ 01075000 MVI RTNCODE,X'10' 0477 01076000 * FLUSHSW=ON; /* INDICATE FLUSH MODE 0478 01077000 * */ 01078000 @RF00476 OI FLUSHSW,B'01000000' 0478 01079000 * 0479 01080000 * /*****************************************************************/ 01081000 * /* */ 01082000 * /* CLEANUP PROCESSING FROM RECEIVE, APPLY, ACCEPT, REJECT, AND */ 01083000 * /* RESTORE. */ 01084000 * /* */ 01085000 * /*****************************************************************/ 01086000 * 0479 01087000 *CLEANUP: 0479 01088000 * ; 0479 01089000 CLEANUP DS 0H 0480 01090000 * CCAFLAG1=ZERO; /* RESET FLAGS IN THE CCA */ 01091000 MVI CCAFLAG1,X'00' 0480 01092000 * IF NSETADDRª=ZERO /* HAS SET GETMAIN BEEN DONE? */ 01093000 * THEN /* YES - FREE OLD ONE */ 01094000 L @14,NSETADDR 0481 01095000 LTR @14,@14 0481 01096000 BZ @RF00481 0481 01097000 * DO; 0482 01098000 * SIZE=SEMAX*LENGTH(HMASMSET);/* CALCULATE SIZE OF THE SET */ 01099000 L SIZE,SEMAX 0483 01100000 SLA SIZE,3 0483 01101000 * GEN(FREEMAIN E,LV=(SIZE),A=NSETADDR);/* FREE OLD SET */ 01102000 FREEMAIN E,LV=(SIZE),A=NSETADDR 01103000 * NSETADDR=ZERO; /* RESET SET ADDR FIELD */ 01104000 SLR @14,@14 0485 01105000 ST @14,NSETADDR 0485 01106000 * END; 0486 01107000 * IF CCAICTª=ZERO /* IS THERE AN ICT? */ 01108000 * THEN /* YES - FREE IT */ 01109000 @RF00481 L @14,CCAICT 0487 01110000 LTR @14,@14 0487 01111000 BZ @RF00487 0487 01112000 * DO; 0488 01113000 * SIZE=ICTSPLEN; /* GET CORE SIZE */ 01114000 L SIZE,ICTSPLEN(,@14) 0489 01115000 * GEN(FREEMAIN E,LV=(SIZE),A=CCAICT);/* FREE THE ICT */ 01116000 FREEMAIN E,LV=(SIZE),A=CCAICT 01117000 * CCAICT=ZERO; /* INDICATE NO ICT */ 01118000 SLR @14,@14 0491 01119000 ST @14,CCAICT 0491 01120000 * END; 0492 01121000 * SECTR=ZERO; /* RESET SEL/EXCLUDE COUNTER */ 01122000 @RF00487 SLR @14,@14 0493 01123000 ST @14,SECTR 0493 01124000 * SEMAX=INCR; /* RESET MAX NUMBER OF SEL/EXC */ 01125000 MVC SEMAX(4),@CF00058 0494 01126000 * SETPTR=ADDR(SET); /* RESET SET ADDR TO SET BASE */ 01127000 LA @14,SET 0495 01128000 ST @14,SETPTR 0495 01129000 * SEFLAGS(1)=ZERO; /* RESET FLAG INDICATORS */ 01130000 MVI SEFLAGS(@14),X'00' 0496 01131000 * LCDPARM=ZERO; /* RESET LCD PARM LIST */ 01132000 MVI LCDPARM,X'00' 0497 01133000 * CCALSCDS=OFF; /* NO MORE LIST CDS */ 01134000 NI CCALSCDS,B'01111111' 0498 01135000 * TBLFLAGS=ZERO; /* ZERO TBL PARM LIST */ 01136000 MVI TBLFLAGS,X'00' 0499 01137000 * TBLLIBNM=BLANK; /* BLANK THE LIBRARY NAME */ 01138000 MVI TBLLIBNM+1,C' ' 0500 01139000 MVC TBLLIBNM+2(6),TBLLIBNM+1 0500 01140000 MVI TBLLIBNM,C' ' 0500 01141000 * IF OLDNUCIDª=BLANK /* WAS NUCLEUS SAVED? */ 01142000 * THEN /* YES - RESTORE IT */ 01143000 CLI OLDNUCID,C' ' 0501 01144000 BE @RF00501 0501 01145000 * DO; 0502 01146000 * CCANUCID=OLDNUCID; /* RESTORE NUCID TO CCA */ 01147000 MVC CCANUCID(1),OLDNUCID 0503 01148000 * OLDNUCID=BLANK; /* RESET SAVED ID TO BLANK */ 01149000 MVI OLDNUCID,C' ' 0504 01150000 * END; 0505 01151000 * 0506 01152000 * /*****************************************************************/ 01153000 * /* */ 01154000 * /* PRINT A COUPLE BLANK LINES FOLLOWING VERB TO SET IT OFF */ 01155000 * /* */ 01156000 * /*****************************************************************/ 01157000 * 0506 01158000 *HEADCLR: 0506 01159000 * ; 0506 01160000 @RF00501 DS 0H 0506 01161000 HEADCLR DS 0H 0507 01162000 * PRLHEADO=OFF; /* CLEAR ALL PRIOR HEADINGS */ 01163000 * PRLHEAD=OFF; /* INDICATE NO NEW HEADING */ 01164000 L @14,IOPPTR 0508 01165000 L @03,IOPBUFAD(,@14) 0508 01166000 NI PRLHEADO(@03),B'00111111' 0508 01167000 * IOPFUNCT=IOPWRITE; /* INDICATE WRITE OPERATION */ 01168000 MVI IOPFUNCT(@14),X'05' 0509 01169000 * IOPDSID=IOPPRINT; /* INDICATE PRINTER */ 01170000 MVI IOPDSID(@14),X'0B' 0510 01171000 * PRLBLANK=ON; /* INDICATE BLANK LINE */ 01172000 OI PRLBLANK(@03),B'00100000' 0511 01173000 * CALL HMASMIO(HMASMIOP); /* WRITE A BLANK LINE */ 01174000 ST @14,@AL00001 0512 01175000 L @15,@CV00173 0512 01176000 LA @01,@AL00001 0512 01177000 BALR @14,@15 0512 01178000 * IF IOPRETRNª=GOOD /* ERROR RETURN? */ 01179000 * THEN /* YES - INDICATE ERROR */ 01180000 L @14,IOPPTR 0513 01181000 CLI IOPRETRN(@14),0 0513 01182000 BE @RF00513 0513 01183000 * DO; 0514 01184000 * RTNCODE=ROUTERR; /* SET ERROR CODE */ 01185000 MVI RTNCODE,X'10' 0515 01186000 * GO TO FINAL; /* TERMINATE THE RUN */ 01187000 B FINAL 0516 01188000 * END; 0517 01189000 * CALL HMASMIO(HMASMIOP); /* WRITE A BLANK LINE */ 01190000 @RF00513 L @14,IOPPTR 0518 01191000 ST @14,@AL00001 0518 01192000 L @15,@CV00173 0518 01193000 LA @01,@AL00001 0518 01194000 BALR @14,@15 0518 01195000 * IF IOPRETRN=GOOD /* SUCCESS? */ 01196000 * THEN /* YES - SCAN ANOTHER */ 01197000 L @14,IOPPTR 0519 01198000 CLI IOPRETRN(@14),0 0519 01199000 BE @RT00519 0519 01200000 * GO TO DRVSCAN; /* RETURN TO PROCESS NEXT STMT */ 01201000 * RTNCODE=ROUTERR; /* INDICATE ERROR AND FALL THRU 01202000 * */ 01203000 MVI RTNCODE,X'10' 0521 01204000 * 0522 01205000 * /*****************************************************************/ 01206000 * /* */ 01207000 * /* THIS ROUTINE IS INVOKED AT THE END OF THE RUN TO PRINT THE */ 01208000 * /* RETURN CODE AND EXIT */ 01209000 * /* */ 01210000 * /*****************************************************************/ 01211000 * 0522 01212000 *FINAL: 0522 01213000 * ; 0522 01214000 FINAL DS 0H 0523 01215000 * IF RTNCODE=ZERO /* IS RETURN CODE STILL ZERO */ 01216000 * &FLUSHSW=ON /* AND WE ARE IN FLUSH MODE */ 01217000 * THEN /* YES - INDICATE SYNTAX ERROR */ 01218000 CLI RTNCODE,0 0523 01219000 BNE @RF00523 0523 01220000 TM FLUSHSW,B'01000000' 0523 01221000 BNO @RF00523 0523 01222000 * RTNCODE=SYNTERR; /* SET SYNTAX ERROR RETURN */ 01223000 MVI RTNCODE,X'04' 0524 01224000 * CVD(RTNCODE,DBLWRD); /* CONVER RETURN CODE FOR PRINT */ 01225000 @RF00523 SLR @14,@14 0525 01226000 IC @14,RTNCODE 0525 01227000 CVD @14,DBLWRD 0525 01228000 * UNPK(CHARCOL,DBLWRD); /* MAKE EBCDIC */ 01229000 UNPK CHARCOL(2),DBLWRD(8) 0526 01230000 * LASTDIG=LASTDIG³MAKPRINT; /* MAKE PRINTABLE */ 01231000 OI LASTDIG,X'F0' 0527 01232000 * MGPVARPT(1)=ADDR(CHARCOL); /* SET PTR TO VARIABLE SECTION */ 01233000 LA @14,CHARCOL 0528 01234000 ST @14,MGPVARPT 0528 01235000 * MGPMGNO1=ENDMSG; /* INDICATE END MESSAGE */ 01236000 MVI MGPMGNO1,X'06' 0529 01237000 * CALL HMASMMSG(HMASMMGP); /* WRITE MESSAGE TO PRINTER */ 01238000 L @15,@CV00174 0530 01239000 LA @01,@AL00530 0530 01240000 BALR @14,@15 0530 01241000 * IOPFUNCT=IOPCLOSA; /* INDICATE CLOSE ALL FILES */ 01242000 L @14,IOPPTR 0531 01243000 MVI IOPFUNCT(@14),X'0B' 0531 01244000 * CALL HMASMIO(HMASMIOP); /* CLOSE ALL OPEN FILES */ 01245000 ST @14,@AL00001 0532 01246000 L @15,@CV00173 0532 01247000 LA @01,@AL00001 0532 01248000 BALR @14,@15 0532 01249000 * IF CCAIOPTRª=ZERO /* IF THERE IS AN IOP */ 01250000 * THEN /* THEN FREE IT */ 01251000 L @14,CCAIOPTR 0533 01252000 LTR @14,@14 0533 01253000 BZ @RF00533 0533 01254000 * DO; 0534 01255000 * SIZE=CCAPESIZ+FIXIOP; /* GET SIZE OF IOP */ 01256000 LA SIZE,20 0535 01257000 AL SIZE,CCAPESIZ 0535 01258000 * GEN(FREEMAIN E,LV=(SIZE),A=CCAIOPTR);/* FREE THE IOP */ 01259000 FREEMAIN E,LV=(SIZE),A=CCAIOPTR 01260000 * END; 0537 01261000 * IF CCABLKSZª=ZERO /* IS THERE A BLOCK BUFFER */ 01262000 * THEN /* YES - FREE IT */ 01263000 @RF00533 LH @14,CCABLKSZ 0538 01264000 LTR @14,@14 0538 01265000 BZ @RF00538 0538 01266000 * DO; 0539 01267000 * SIZE=CCABLKSZ; /* GET BLOCK BUFF SIZE TO REG */ 01268000 LR SIZE,@14 0540 01269000 * GEN(FREEMAIN E,LV=(SIZE),A=CCABUFAD);/* FREE THE BLK BUFF */ 01270000 FREEMAIN E,LV=(SIZE),A=CCABUFAD 01271000 * END; 0542 01272000 * IF DCBOFOPN=ON /* WAS LINKLIB DCB OPENED? */ 01273000 * THEN /* YES - CLOSE IT */ 01274000 @RF00538 L @14,DCBPTR 0543 01275000 TM DCBOFOPN+40(@14),B'00010000' 0543 01276000 BNO @RF00543 0543 01277000 * GEN(CLOSE (JFCDCB)); /* CLOSE LINKLIB DCB */ 01278000 CLOSE (JFCDCB) 01279000 * RETURN CODE(RTNCODE); /* EXIT - END OF RUN 0545 01280000 * */ 01281000 @RF00543 SLR @15,@15 0545 01282000 IC @15,RTNCODE 0545 01283000 L @13,4(,@13) 0545 01284000 L @14,12(,@13) 0545 01285000 LM @00,@12,20(@13) 0545 01286000 BR @14 0545 01287000 * 0546 01288000 * /*****************************************************************/ 01289000 * /* */ 01290000 * /* THIS ROUTINE SAVES THE START OF THE SIZE PARM VALUE */ 01291000 * /* */ 01292000 * /*****************************************************************/ 01293000 * 0546 01294000 *SIZBEG: 0546 01295000 * PROCEDURE; 0546 01296000 @EL00001 L @13,4(,@13) 0546 01297000 @EF00001 DS 0H 0546 01298000 @ER00001 LM @14,@12,12(@13) 0546 01299000 BR @14 0546 01300000 @PB00001 DS 0H 0546 01301000 SIZBEG STM @14,@12,12(@13) 0546 01302000 * CCALKSIZ=SCPCHAR-2; /* SAVE START OF PARM */ 01303000 L @14,SCPCHAR 0547 01304000 BCTR @14,0 0547 01305000 BCTR @14,0 0547 01306000 ST @14,CCALKSIZ 0547 01307000 * SCPRET=GOOD; /* INDICATE CONTINUE SCAN */ 01308000 MVI SCPRET,X'00' 0548 01309000 * END SIZBEG; 0549 01310000 * 0549 01311000 @EL00002 DS 0H 0549 01312000 @EF00002 DS 0H 0549 01313000 @ER00002 LM @14,@12,12(@13) 0549 01314000 BR @14 0549 01315000 * /*****************************************************************/ 01316000 * /* */ 01317000 * /* THIS ROUTINE IS INVOKED TO PICK OFF THE LKED SIZE PARM VALUES */ 01318000 * /* AND STORE PARM ENTRY FOR LKED INVOCATION LATER */ 01319000 * /* */ 01320000 * /*****************************************************************/ 01321000 * 0550 01322000 *SIZEND: 0550 01323000 * PROCEDURE; 0550 01324000 SIZEND STM @14,@12,12(@13) 0550 01325000 * CCALKSIZ->STRING(1:2)=SCPCHAR-CCALKSIZ-ONE;/* SET LENGTH */ 01326000 L @14,CCALKSIZ 0551 01327000 L @03,SCPCHAR 0551 01328000 SLR @03,@14 0551 01329000 BCTR @03,0 0551 01330000 ST @03,@TF00001 0551 01331000 MVC STRING(2,@14),@TF00001+2 0551 01332000 * SCPRET=GOOD; /* INDICATE CONTINUE SCAN */ 01333000 MVI SCPRET,X'00' 0552 01334000 * END SIZEND; 0553 01335000 @EL00003 DS 0H 0553 01336000 @EF00003 DS 0H 0553 01337000 @ER00003 LM @14,@12,12(@13) 0553 01338000 BR @14 0553 01339000 * 0554 01340000 * /*****************************************************************/ 01341000 * /* */ 01342000 * /* THE FOLLOWING ROUTINES SAVE UPDATED PROGRAM NAMES */ 01343000 * /* */ 01344000 * /*****************************************************************/ 01345000 * 0554 01346000 *PGMNAME: 0554 01347000 * PROCEDURE; 0554 01348000 * 0554 01349000 PGMNAME STM @14,@12,12(@13) 0554 01350000 * /*****************************************************************/ 01351000 * /* */ 01352000 * /* THIS ROUTINE IS INVOKED FROM SCAN TO SAVE THE NAME OF THE */ 01353000 * /* LINKAGE EDITOR TO USE */ 01354000 * /* */ 01355000 * /*****************************************************************/ 01356000 * 0555 01357000 *LKEDSAV: 0555 01358000 * ENTRY; 0555 01359000 B @EC00555 0555 01360000 LKEDSAV STM @14,@12,12(@13) 0555 01361000 @EC00555 DS 0H 0556 01362000 * I=LKEDNDX; /* SET INDEX FOR LKED */ 01363000 MVC I(4),@CF00040 0556 01364000 * GO TO NMCHNG; /* GO CHANGE THE NAME */ 01365000 * 0557 01366000 B NMCHNG 0557 01367000 * /*****************************************************************/ 01368000 * /* */ 01369000 * /* THIS ROUTINE IS INVOKED TO SAVE THE NAME OF THE ASSEMBLER TO */ 01370000 * /* USE FOR FUTURE INVOCATIONS */ 01371000 * /* */ 01372000 * /*****************************************************************/ 01373000 * 0558 01374000 *ASMSAV: 0558 01375000 * ENTRY; 0558 01376000 ASMSAV STM @14,@12,12(@13) 0558 01377000 * I=ASMNDX; /* SET INDEX FOR THE ASSEMBLER */ 01378000 MVC I(4),@CF00087 0559 01379000 * GO TO NMCHNG; /* GO CHANGE THE NAME */ 01380000 * 0560 01381000 B NMCHNG 0560 01382000 * /*****************************************************************/ 01383000 * /* */ 01384000 * /* THIS ROUTINE IS INVOKED TO SAVE THE NAME OF HMASPZAP TO USE */ 01385000 * /* */ 01386000 * /*****************************************************************/ 01387000 * 0561 01388000 *ZAPSAV: 0561 01389000 * ENTRY; 0561 01390000 ZAPSAV STM @14,@12,12(@13) 0561 01391000 * I=ZAPNDX; /* SET INDEX FOR SUPERZAP */ 01392000 MVC I(4),@CF00055 0562 01393000 *NMCHNG: 0563 01394000 * ; 0563 01395000 NMCHNG DS 0H 0564 01396000 * MEMNAME(I)=STRING(1:SCPPMLN); /* CHANGE MEMBER NAME IN BLDL LST*/ 01397000 L @14,I 0564 01398000 MH @14,@CH00187 0564 01399000 LA @03,MEMNAME-74(@14) 0564 01400000 MVI 1(@03),C' ' 0564 01401000 MVC 2(6,@03),1(@03) 0564 01402000 LH @14,SCPPMLN 0564 01403000 BCTR @14,0 0564 01404000 L @01,SCPCHAR 0564 01405000 EX @14,@SM01313 0564 01406000 * SCPRET=GOOD; /* INDICATE CONTINUE SCAN */ 01407000 MVI SCPRET,X'00' 0565 01408000 * END PGMNAME; /* RETURN TO SCAN 0566 01409000 * */ 01410000 @EL00004 DS 0H 0566 01411000 @EF00004 DS 0H 0566 01412000 @ER00004 LM @14,@12,12(@13) 0566 01413000 BR @14 0566 01414000 * 0567 01415000 * /*****************************************************************/ 01416000 * /* */ 01417000 * /* THE FOLLOWING ROUTINES ARE INVOKED WHEN SCAN ENCOUNTERS THE */ 01418000 * /* ASSOCIATED CONTROL VERB IN THE INPUT STREAM. */ 01419000 * /* */ 01420000 * /*****************************************************************/ 01421000 * 0567 01422000 *VERBSETS: 0567 01423000 * PROCEDURE; 0567 01424000 * 0567 01425000 VERBSETS STM @14,@12,12(@13) 0567 01426000 * /*****************************************************************/ 01427000 * /* */ 01428000 * /* THIS ROUTINE IS INVOKED FOR RECEIVE OPERATIONS */ 01429000 * /* */ 01430000 * /*****************************************************************/ 01431000 * 0568 01432000 *RECSAV: 0568 01433000 * ENTRY; 0568 01434000 B @EC00568 0568 01435000 RECSAV STM @14,@12,12(@13) 0568 01436000 @EC00568 DS 0H 0569 01437000 * IF RECSW=ON /* HAS RECEIVE ALREADY BEEN? */ 01438000 * THEN /* YES - SYNTAX ERROR */ 01439000 TM RECSW,B'00100000' 0569 01440000 BNO @RF00569 0569 01441000 * DO; /* ONLY ONE RECEIVE PER RUN */ 01442000 * SCPRET=SCNERR; /* INDICATE ERROR */ 01443000 MVI SCPRET,X'08' 0571 01444000 * RETURN; /* RETURN TO SCAN */ 01445000 @EL00005 DS 0H 0572 01446000 @EF00005 DS 0H 0572 01447000 @ER00005 LM @14,@12,12(@13) 0572 01448000 BR @14 0572 01449000 * END; 0573 01450000 * RECSW=ON; /* INDICATE RECEIVE FOUND */ 01451000 @RF00569 OI RECSW,B'00100000' 0574 01452000 * CCAREC=ON; /* INDICATE RECEIVE VERB */ 01453000 OI CCAREC,B'10000000' 0575 01454000 * GO TO VERBEXIT; /* RETURN */ 01455000 * 0576 01456000 B VERBEXIT 0576 01457000 * /*****************************************************************/ 01458000 * /* */ 01459000 * /* THIS ROUTINE IS INVOKED FOR THE APPLY VERB */ 01460000 * /* */ 01461000 * /*****************************************************************/ 01462000 * 0577 01463000 *APPSAV: 0577 01464000 * ENTRY; 0577 01465000 APPSAV STM @14,@12,12(@13) 0577 01466000 * CCAAPPLY=ON; /* INDICATE APPLY VERB */ 01467000 OI CCAAPPLY,B'01000000' 0578 01468000 * GO TO VERBEXIT; /* RETURN */ 01469000 * 0579 01470000 B VERBEXIT 0579 01471000 * /*****************************************************************/ 01472000 * /* */ 01473000 * /* THIS ROUTINE IS INVOKED FOR THE ACCEPT VERB */ 01474000 * /* */ 01475000 * /*****************************************************************/ 01476000 * 0580 01477000 *ACCSAV: 0580 01478000 * ENTRY; 0580 01479000 ACCSAV STM @14,@12,12(@13) 0580 01480000 * CCAACCPT=ON; /* INDICATE ACCEPT VERB */ 01481000 OI CCAACCPT,B'00100000' 0581 01482000 * GO TO VERBEXIT; /* RETURN 0582 01483000 * */ 01484000 B VERBEXIT 0582 01485000 * 0583 01486000 * /*****************************************************************/ 01487000 * /* */ 01488000 * /* THIS ROUTINE IS INVOKED FOR THE REJECT VERB */ 01489000 * /* */ 01490000 * /*****************************************************************/ 01491000 * 0583 01492000 *REJSAV: 0583 01493000 * ENTRY; 0583 01494000 REJSAV STM @14,@12,12(@13) 0583 01495000 * CCAREJ=ON; /* INDICATE REJECT VERB */ 01496000 OI CCAREJ,B'00010000' 0584 01497000 * GO TO VERBEXIT; /* RETURN */ 01498000 * 0585 01499000 B VERBEXIT 0585 01500000 * /*****************************************************************/ 01501000 * /* */ 01502000 * /* THIS ROUTINE IS INVOKED FOR THE RESTORE VERB */ 01503000 * /* */ 01504000 * /*****************************************************************/ 01505000 * 0586 01506000 *RESSAV: 0586 01507000 * ENTRY; 0586 01508000 RESSAV STM @14,@12,12(@13) 0586 01509000 * CCARES=ON; /* INDICATE RESTORE VERB */ 01510000 OI CCARES,B'00001000' 0587 01511000 * GO TO VERBEXIT; /* RETURN */ 01512000 * 0588 01513000 B VERBEXIT 0588 01514000 * /*****************************************************************/ 01515000 * /* */ 01516000 * /* THIS ROUTINE IS INVOKED FOR THE UCLIN VERB */ 01517000 * /* */ 01518000 * /*****************************************************************/ 01519000 * 0589 01520000 *UCLSAV: 0589 01521000 * ENTRY; 0589 01522000 UCLSAV STM @14,@12,12(@13) 0589 01523000 * CCAUPDU=ON; /* INDICATE UCL VERB */ 01524000 OI CCAUPDU,B'00000010' 0590 01525000 * GO TO VERBEXIT; /* RETURN */ 01526000 * 0591 01527000 B VERBEXIT 0591 01528000 * /*****************************************************************/ 01529000 * /* */ 01530000 * /* THIS ROUTINE IS INVOKED FOR THE JCLIN VERB */ 01531000 * /* */ 01532000 * /*****************************************************************/ 01533000 * 0592 01534000 *JCLSAV: 0592 01535000 * ENTRY; 0592 01536000 JCLSAV STM @14,@12,12(@13) 0592 01537000 * CCAUPDJ=ON; /* INDICATE JCLIN VERB */ 01538000 OI CCAUPDJ,B'00000100' 0593 01539000 *VERBEXIT: 0594 01540000 * ; 0594 01541000 VERBEXIT DS 0H 0595 01542000 * SCPRET=GOOD; /* INDICATE CONTINUE SCAN */ 01543000 MVI SCPRET,X'00' 0595 01544000 * END VERBSETS; 0596 01545000 B @EL00005 0596 01546000 * 0597 01547000 * /*****************************************************************/ 01548000 * /* */ 01549000 * /* THIS ROUTINE IS INVOKED TO INDICATE SELECT FOUND */ 01550000 * /* */ 01551000 * /*****************************************************************/ 01552000 * 0597 01553000 *SELSAV: 0597 01554000 * PROCEDURE; 0597 01555000 SELSAV STM @14,@12,12(@13) 0597 01556000 * IF SEEXCLUD(1)=OFF /* NO EXCLUDE? */ 01557000 * &SESELECT(1)=OFF /* AND NOT ALREADY SELECT */ 01558000 * THEN /* YES - THEN OK FOR SELECT */ 01559000 L @14,SETPTR 0598 01560000 TM SEEXCLUD(@14),B'11000000' 0598 01561000 BNZ @RF00598 0598 01562000 * DO; 0599 01563000 * SESELECT(1)=ON; /* INDICATE SELECT */ 01564000 OI SESELECT(@14),B'10000000' 0600 01565000 * SCPRET=GOOD; /* INDICATE CONTINUE */ 01566000 MVI SCPRET,X'00' 0601 01567000 * END; 0602 01568000 * ELSE 0603 01569000 * SCPRET=SCNERR; /* INDICATE SYNTAX ERROR */ 01570000 B @RC00598 0603 01571000 @RF00598 MVI SCPRET,X'08' 0603 01572000 * END SELSAV; 0604 01573000 * 0604 01574000 @EL00006 DS 0H 0604 01575000 @EF00006 DS 0H 0604 01576000 @ER00006 LM @14,@12,12(@13) 0604 01577000 BR @14 0604 01578000 * /*****************************************************************/ 01579000 * /* */ 01580000 * /* THIS ROUTINE IS INVOKED TO INDICATE EXCLUDE FOUND */ 01581000 * /* */ 01582000 * /*****************************************************************/ 01583000 * 0605 01584000 *EXCSAV: 0605 01585000 * PROCEDURE; 0605 01586000 EXCSAV STM @14,@12,12(@13) 0605 01587000 * IF SESELECT(1)=OFF /* IF NO SELECT */ 01588000 * &SEEXCLUD(1)=OFF /* AND NOT ALREADY EXCLUDE */ 01589000 * THEN /* THEN EXCLUDE OK, AS LONG AS */ 01590000 L @14,SETPTR 0606 01591000 TM SESELECT(@14),B'11000000' 0606 01592000 BNZ @RF00606 0606 01593000 * IF CCARES=OFF /* NOT A RESTORE FUNCTION */ 01594000 * THEN /* OK TO DO EXCLUDE */ 01595000 TM CCARES,B'00001000' 0607 01596000 BNZ @RF00607 0607 01597000 * DO; 0608 01598000 * SEEXCLUD(1)=ON; /* INDICATE EXCLUDE */ 01599000 OI SEEXCLUD(@14),B'01000000' 0609 01600000 * SCPRET=GOOD; /* INDICATE CONTINUE */ 01601000 MVI SCPRET,X'00' 0610 01602000 * END; 0611 01603000 * ELSE /* SYNTAX ERROR, OTHERWISE */ 01604000 * SCPRET=SCNERR; /* INDICATE ERROR TO SCAN */ 01605000 B @RC00607 0612 01606000 @RF00607 MVI SCPRET,X'08' 0612 01607000 * END EXCSAV; 0613 01608000 @EL00007 DS 0H 0613 01609000 @EF00007 DS 0H 0613 01610000 @ER00007 LM @14,@12,12(@13) 0613 01611000 BR @14 0613 01612000 * 0614 01613000 * /*****************************************************************/ 01614000 * /* */ 01615000 * /* THIS ROUTINE IS INVOKED FOR THE SELECT & EXCLUDE STATEMENTS */ 01616000 * /* */ 01617000 * /*****************************************************************/ 01618000 * 0614 01619000 *SESAV: 0614 01620000 * PROCEDURE; 0614 01621000 SESAV STM @14,@12,@SA00008 0614 01622000 * SCPRET=GOOD; /* PRESET SCAN RETURN CODE */ 01623000 MVI SCPRET,X'00' 0615 01624000 * SECTR=SECTR+1; /* BUMP SELECT COUNTER */ 01625000 LA @14,1 0616 01626000 AL @14,SECTR 0616 01627000 ST @14,SECTR 0616 01628000 * IF SECTR>SEMAX /* HAS MAX BEEN EXCEEDED? */ 01629000 * THEN /* YES - MUST GET MORE CORE */ 01630000 L @03,SEMAX 0617 01631000 CR @14,@03 0617 01632000 BNH @RF00617 0617 01633000 * DO; /* GET A NEW SET */ 01634000 * SEMAX=SEMAX+INCR; /* BUMP MAX SELECTS BY INCREMENT */ 01635000 AH @03,@CH00058 0619 01636000 ST @03,SEMAX 0619 01637000 * SIZE=SEMAX*LENGTH(HMASMSET);/* CALCULATE SIZE OF NEW SET */ 01638000 SLA @03,3 0620 01639000 LR SIZE,@03 0620 01640000 * GEN(GETMAIN EC,LV=(SIZE),A=NSETADDR);/* GET CORE FOR SET */ 01641000 GETMAIN EC,LV=(SIZE),A=NSETADDR 01642000 * IF RCODREGª=GOOD /* NOT ENOUGH ROOM? */ 01643000 * THEN /* NO - ISSUE MESSAGE */ 01644000 LTR RCODREG,RCODREG 0622 01645000 BZ @RF00622 0622 01646000 * DO; 0623 01647000 * MGPMGNO1=NOSPACE; /* INDICATE NO SPACE MESSAGE */ 01648000 MVI MGPMGNO1,X'03' 0624 01649000 * CALL HMASMMSG(HMASMMGP);/* WRITE MESSAGE TO PRINTER */ 01650000 L @15,@CV00174 0625 01651000 LA @01,@AL00625 0625 01652000 BALR @14,@15 0625 01653000 * SCPRET=SCNERR; /* INDICATE SCAN ERROR */ 01654000 MVI SCPRET,X'08' 0626 01655000 * RTNCODE=NOSPACD; /* SET RETURN CODE */ 01656000 MVI RTNCODE,X'04' 0627 01657000 * RTNERR=ON; /* INDICATE ERROR IN ROUT */ 01658000 OI RTNERR,B'00001000' 0628 01659000 * RETURN; /* GO BACK TO SCAN */ 01660000 @EL00008 DS 0H 0629 01661000 @EF00008 DS 0H 0629 01662000 @ER00008 LM @14,@12,@SA00008 0629 01663000 BR @14 0629 01664000 * END; 0630 01665000 * DO I=1 TO SECTR-1; /* MOVE OVER SET ENTRIES */ 01666000 @RF00622 LA @14,1 0631 01667000 B @DE00631 0631 01668000 @DL00631 DS 0H 0632 01669000 * NSETADDR->HMASMSET(I)=HMASMSET(I);/* MOVE ENTRY */ 01670000 LR @03,@14 0632 01671000 SLA @03,3 0632 01672000 L @01,NSETADDR 0632 01673000 ALR @01,@03 0632 01674000 AL @01,@CF01310 0632 01675000 L @09,SETPTR 0632 01676000 ALR @09,@03 0632 01677000 AL @09,@CF01310 0632 01678000 MVC HMASMSET(8,@01),HMASMSET(@09) 0632 01679000 * END; 0633 01680000 AH @14,@CH00040 0633 01681000 @DE00631 ST @14,I 0633 01682000 L @03,SECTR 0633 01683000 BCTR @03,0 0633 01684000 CR @14,@03 0633 01685000 BNH @DL00631 0633 01686000 * IF SECTR>SEMAX+ONE /* HAS A GETMAIN BEEN DONE */ 01687000 * THEN /* YES - MUST FREE OLD ONE */ 01688000 L @14,SEMAX 0634 01689000 LA @03,1 0634 01690000 ALR @03,@14 0634 01691000 C @03,SECTR 0634 01692000 BNL @RF00634 0634 01693000 * DO; 0635 01694000 * SIZE=(SEMAX-INCR)*LENGTH(HMASMSET);/* CALC SIZE TO FREE */ 01695000 SH @14,@CH00058 0636 01696000 SLA @14,3 0636 01697000 LR SIZE,@14 0636 01698000 * GEN(FREEMAIN E,LV=(SIZE),A=SETPTR);/* FREE THE OLD SET */ 01699000 FREEMAIN E,LV=(SIZE),A=SETPTR 01700000 * END; 0638 01701000 * SETPTR=NSETADDR; /* USE NEW SET FROM NOW ON */ 01702000 @RF00634 MVC SETPTR(4),NSETADDR 0639 01703000 * END; 0640 01704000 * SEPTFNO(SECTR)=STRING(1:SCPPMLN);/* PUT PTF NUMBER IN LIST */ 01705000 @RF00617 L @14,SETPTR 0641 01706000 L @03,SECTR 0641 01707000 SLA @03,3 0641 01708000 ST @03,@TF00001 0641 01709000 ALR @03,@14 0641 01710000 AL @03,@CF01317 0641 01711000 MVI SEPTFNO(@03),C' ' 0641 01712000 MVC SEPTFNO+1(5,@03),SEPTFNO(@03) 0641 01713000 LH @09,SCPPMLN 0641 01714000 BCTR @09,0 0641 01715000 L @01,SCPCHAR 0641 01716000 EX @09,@SM01318 0641 01717000 * SELAST(SECTR)=OFF; /* INDICATE THIS IS NOT LAST PTF */ 01718000 * SEFOUND(SECTR)=OFF; /* TURN OFF FOUND INDICATOR */ 01719000 AL @14,@TF00001 0643 01720000 AL @14,@CF01310 0643 01721000 NI SELAST(@14),B'11111100' 0643 01722000 * END SESAV; 0644 01723000 B @EL00008 0644 01724000 * 0645 01725000 * /*****************************************************************/ 01726000 * /* */ 01727000 * /* THIS ROUTINE IS INVOKED TO INDICATE FORCE */ 01728000 * /* */ 01729000 * /*****************************************************************/ 01730000 * 0645 01731000 *FORSAV: 0645 01732000 * PROCEDURE; 0645 01733000 FORSAV STM @14,@12,12(@13) 0645 01734000 * IF(CCAAPPLY=ON /* FORCE ONLY OK FOR APPLY */ 01735000 * ³CCAACCPT=ON) /* OR ACCEPT */ 01736000 * &SEFORCE(1)=OFF /* NOT FORCE ALREADY */ 01737000 * THEN /* ONE OF THE ABOVE, THEN */ 01738000 TM CCAAPPLY,B'01100000' 0646 01739000 BZ @RF00646 0646 01740000 L @14,SETPTR 0646 01741000 TM SEFORCE(@14),B'00100000' 0646 01742000 BNZ @RF00646 0646 01743000 * DO; 0647 01744000 * SEFORCE(1)=ON; /* INDICATE FORCE OPTION */ 01745000 OI SEFORCE(@14),B'00100000' 0648 01746000 * SCPRET=GOOD; /* INDICATE CONTINUE */ 01747000 MVI SCPRET,X'00' 0649 01748000 * END; 0650 01749000 * ELSE /* OTHERWISE - SYNTAX ERROR */ 01750000 * SCPRET=SCNERR; /* INDICATE ERROR */ 01751000 B @RC00646 0651 01752000 @RF00646 MVI SCPRET,X'08' 0651 01753000 * END FORSAV; 0652 01754000 * 0652 01755000 @EL00009 DS 0H 0652 01756000 @EF00009 DS 0H 0652 01757000 @ER00009 LM @14,@12,12(@13) 0652 01758000 BR @14 0652 01759000 * /*****************************************************************/ 01760000 * /* */ 01761000 * /* THIS ROUTINE IS INVOKED TO SAVE THE LIBRARY NAME FOR LIB */ 01762000 * /* */ 01763000 * /*****************************************************************/ 01764000 * 0653 01765000 *LIBSAV: 0653 01766000 * PROCEDURE; 0653 01767000 LIBSAV STM @14,@12,12(@13) 0653 01768000 * IF(CCAACCPT=ON /* LIB ONLY VALID FOR ACCEPT */ 01769000 * ³CCARES=ON) /* OR RESTORE */ 01770000 * &TBLNOLIB=OFF /* NOLIB NOT ALREADY SPECIFIED */ 01771000 * &TBLLIBNM(1)=BLANK /* LIB NOT SPECIFIED ALREADY? */ 01772000 * THEN /* ONE OF THE ABOVE - OK */ 01773000 TM CCAACCPT,B'00101000' 0654 01774000 BZ @RF00654 0654 01775000 TM TBLNOLIB,B'00000100' 0654 01776000 BNZ @RF00654 0654 01777000 CLI TBLLIBNM,C' ' 0654 01778000 BNE @RF00654 0654 01779000 * DO; 0655 01780000 * TBLLIBNM=STRING(1:SCPPMLN); /* SAVE LIBRARY NAME */ 01781000 MVI TBLLIBNM+1,C' ' 0656 01782000 MVC TBLLIBNM+2(6),TBLLIBNM+1 0656 01783000 LH @14,SCPPMLN 0656 01784000 BCTR @14,0 0656 01785000 L @03,SCPCHAR 0656 01786000 EX @14,@SM01320 0656 01787000 * SCPRET=GOOD; /* INDICATE CONTINUE */ 01788000 MVI SCPRET,X'00' 0657 01789000 * END; 0658 01790000 * ELSE /* OTHERWISE, SYNTAX ERROR */ 01791000 * SCPRET=SCNERR; /* INDICATE ERROR TO SCAN */ 01792000 B @RC00654 0659 01793000 @RF00654 MVI SCPRET,X'08' 0659 01794000 * END LIBSAV; 0660 01795000 @EL00010 DS 0H 0660 01796000 @EF00010 DS 0H 0660 01797000 @ER00010 LM @14,@12,12(@13) 0660 01798000 BR @14 0660 01799000 * 0661 01800000 * /*****************************************************************/ 01801000 * /* */ 01802000 * /* THIS ROUTINE IS INVOKED TO SAVE THE NUCID */ 01803000 * /* */ 01804000 * /*****************************************************************/ 01805000 * 0661 01806000 *NUCSAV: 0661 01807000 * PROCEDURE; 0661 01808000 NUCSAV STM @14,@12,12(@13) 0661 01809000 * IF CCAAPPLY=ON /* MUST BE APPLY FOR NUCID */ 01810000 * &OLDNUCID=BLANK /* HAS NUC BEEN SAVED YET? */ 01811000 * THEN /* NO - GO AHEAD AND SAVE IT */ 01812000 TM CCAAPPLY,B'01000000' 0662 01813000 BNO @RF00662 0662 01814000 CLI OLDNUCID,C' ' 0662 01815000 BNE @RF00662 0662 01816000 * DO; 0663 01817000 * OLDNUCID=CCANUCID; /* SAVE NUCID FROM THE CCA */ 01818000 MVC OLDNUCID(1),CCANUCID 0664 01819000 * CCANUCID=STRING(1); /* SET NEW NUCID */ 01820000 L @14,SCPCHAR 0665 01821000 MVC CCANUCID(1),STRING(@14) 0665 01822000 * SCPRET=GOOD; /* INDICATE CONTINUE SCAN */ 01823000 MVI SCPRET,X'00' 0666 01824000 * END; 0667 01825000 * ELSE /* OTHERWISE - SYNTAX ERROR */ 01826000 * SCPRET=SCNERR; /* INDICATE ERROR */ 01827000 B @RC00662 0668 01828000 @RF00662 MVI SCPRET,X'08' 0668 01829000 * END NUCSAV; 0669 01830000 * 0669 01831000 @EL00011 DS 0H 0669 01832000 @EF00011 DS 0H 0669 01833000 @ER00011 LM @14,@12,12(@13) 0669 01834000 BR @14 0669 01835000 * /*****************************************************************/ 01836000 * /* */ 01837000 * /* THIS ROUTINE IS INVOKED TO INDICATE NO LIBRARY */ 01838000 * /* */ 01839000 * /*****************************************************************/ 01840000 * 0670 01841000 *NOLIBSAV: 0670 01842000 * PROCEDURE; 0670 01843000 NOLIBSAV STM @14,@12,12(@13) 0670 01844000 * IF CCAACCPT=ON /* MUST BE APPLY VERB */ 01845000 * &TBLNOLIB=OFF /* NOLIB NOT SPECIFIED ALREADY */ 01846000 * &TBLLIBNM(1)=BLANK /* AND LIB NOT SPECIFIED */ 01847000 * THEN /* FOR NOLIB SPECIFIED */ 01848000 TM CCAACCPT,B'00100000' 0671 01849000 BNO @RF00671 0671 01850000 TM TBLNOLIB,B'00000100' 0671 01851000 BNZ @RF00671 0671 01852000 CLI TBLLIBNM,C' ' 0671 01853000 BNE @RF00671 0671 01854000 * DO; 0672 01855000 * TBLNOLIB=ON; /* INDICATE NO LINK LIBRARY */ 01856000 OI TBLNOLIB,B'00000100' 0673 01857000 * SCPRET=GOOD; /* INDICATE CONTINUE SCAN */ 01858000 MVI SCPRET,X'00' 0674 01859000 * END; 0675 01860000 * ELSE 0676 01861000 * SCPRET=SCNERR; /* OTHERWISE , SYNTAX ERROR */ 01862000 B @RC00671 0676 01863000 @RF00671 MVI SCPRET,X'08' 0676 01864000 * END NOLIBSAV; 0677 01865000 @EL00012 DS 0H 0677 01866000 @EF00012 DS 0H 0677 01867000 @ER00012 LM @14,@12,12(@13) 0677 01868000 BR @14 0677 01869000 * 0678 01870000 * /*****************************************************************/ 01871000 * /* */ 01872000 * /* THE FOLLOWING ROUTINE IS INVOKED TO INDICATE LIST LOG VERB */ 01873000 * /* */ 01874000 * /*****************************************************************/ 01875000 * 0678 01876000 *LLOGALL: 0678 01877000 * PROCEDURE; 0678 01878000 LLOGALL STM @14,@12,12(@13) 0678 01879000 * BMM=ALLOGIND; /* SET LIST LOG ALL INDICATOR */ 01880000 MVC BMM(2),@CB00081 0679 01881000 *LLOGPART: 0680 01882000 * ENTRY; 0680 01883000 B @EC00680 0680 01884000 LLOGPART STM @14,@12,12(@13) 0680 01885000 @EC00680 DS 0H 0681 01886000 * CCALSLOG=ON; /* INDICATE LIST LOG */ 01887000 OI CCALSLOG,B'00000001' 0681 01888000 * SCPRET=GOOD; /* INDICATE CONTINUE SCAN */ 01889000 MVI SCPRET,X'00' 0682 01890000 * END LLOGALL; /* RETURN TO SCAN */ 01891000 * 0683 01892000 @EL00013 DS 0H 0683 01893000 @EF00013 DS 0H 0683 01894000 @ER00013 LM @14,@12,12(@13) 0683 01895000 BR @14 0683 01896000 * /*****************************************************************/ 01897000 * /* */ 01898000 * /* THE FOLLOWING ROUTINE SAVES THE DATE RANGE FOR LIST LOG */ 01899000 * /* */ 01900000 * /*****************************************************************/ 01901000 * 0684 01902000 *LOGSAV: 0684 01903000 * PROCEDURE; 0684 01904000 LOGSAV STM @14,@12,12(@13) 0684 01905000 *BMONSAV: 0685 01906000 * ENTRY; 0685 01907000 B @EC00685 0685 01908000 BMONSAV STM @14,@12,12(@13) 0685 01909000 @EC00685 DS 0H 0686 01910000 * BMM=STRING(1:SCPPMLN); /* SAVE BEGINNING MONTH */ 01911000 MVI BMM+1,C' ' 0686 01912000 LH @14,SCPPMLN 0686 01913000 BCTR @14,0 0686 01914000 L @03,SCPCHAR 0686 01915000 EX @14,@SM01322 0686 01916000 * GO TO LOGEXIT; /* RETURN */ 01917000 B LOGEXIT 0687 01918000 *BDAYSAV: 0688 01919000 * ENTRY; 0688 01920000 BDAYSAV STM @14,@12,12(@13) 0688 01921000 * BDD=STRING(1:SCPPMLN); /* SAVE BEGINNING DAY */ 01922000 MVI BDD+1,C' ' 0689 01923000 LH @14,SCPPMLN 0689 01924000 BCTR @14,0 0689 01925000 L @03,SCPCHAR 0689 01926000 EX @14,@SM01324 0689 01927000 * GO TO LOGEXIT; /* RETURN */ 01928000 B LOGEXIT 0690 01929000 *BYEARSAV: 0691 01930000 * ENTRY; 0691 01931000 BYEARSAV STM @14,@12,12(@13) 0691 01932000 * BYY=STRING(1:SCPPMLN); /* SAVE BEGINNING YEAR */ 01933000 MVI BYY+1,C' ' 0692 01934000 LH @14,SCPPMLN 0692 01935000 BCTR @14,0 0692 01936000 L @03,SCPCHAR 0692 01937000 EX @14,@SM01326 0692 01938000 * GO TO LOGEXIT; /* RETURN */ 01939000 B LOGEXIT 0693 01940000 *EMONSAV: 0694 01941000 * ENTRY; 0694 01942000 EMONSAV STM @14,@12,12(@13) 0694 01943000 * EMM=STRING(1:SCPPMLN); /* SAVE ENDING MONTH */ 01944000 MVI EMM+1,C' ' 0695 01945000 LH @14,SCPPMLN 0695 01946000 BCTR @14,0 0695 01947000 L @03,SCPCHAR 0695 01948000 EX @14,@SM01328 0695 01949000 * GO TO LOGEXIT; /* RETURN */ 01950000 B LOGEXIT 0696 01951000 *EDAYSAV: 0697 01952000 * ENTRY; 0697 01953000 EDAYSAV STM @14,@12,12(@13) 0697 01954000 * EDD=STRING(1:SCPPMLN); /* SAVE ENDING DAY */ 01955000 MVI EDD+1,C' ' 0698 01956000 LH @14,SCPPMLN 0698 01957000 BCTR @14,0 0698 01958000 L @03,SCPCHAR 0698 01959000 EX @14,@SM01330 0698 01960000 * GO TO LOGEXIT; /* RETURN */ 01961000 B LOGEXIT 0699 01962000 *EYEARSAV: 0700 01963000 * ENTRY; 0700 01964000 EYEARSAV STM @14,@12,12(@13) 0700 01965000 * EYY=STRING(1:SCPPMLN); /* SAVE ENDING YEAR */ 01966000 MVI EYY+1,C' ' 0701 01967000 LH @14,SCPPMLN 0701 01968000 BCTR @14,0 0701 01969000 L @03,SCPCHAR 0701 01970000 EX @14,@SM01332 0701 01971000 *LOGEXIT: 0702 01972000 * ; 0702 01973000 LOGEXIT DS 0H 0703 01974000 * SCPRET=GOOD; /* INDICATE CONTINUE */ 01975000 MVI SCPRET,X'00' 0703 01976000 * END LOGSAV; /* RETURN TO SCAN 0704 01977000 * */ 01978000 @EL00014 DS 0H 0704 01979000 @EF00014 DS 0H 0704 01980000 @ER00014 LM @14,@12,12(@13) 0704 01981000 BR @14 0704 01982000 * 0705 01983000 * /*****************************************************************/ 01984000 * /* */ 01985000 * /* THE FOLLOWING ROUTINES INDICATE PARAMETERS FROM THE LIST VERB.*/ 01986000 * /* */ 01987000 * /*****************************************************************/ 01988000 * 0705 01989000 *LISTSAV: 0705 01990000 * PROCEDURE; 0705 01991000 * 0705 01992000 LISTSAV STM @14,@12,12(@13) 0705 01993000 * /*****************************************************************/ 01994000 * /* */ 01995000 * /* ROUTINE FOR CDS */ 01996000 * /* */ 01997000 * /*****************************************************************/ 01998000 * 0706 01999000 *CDSSAV: 0706 02000000 * ENTRY; 0706 02001000 B @EC00706 0706 02002000 CDSSAV STM @14,@12,12(@13) 0706 02003000 @EC00706 DS 0H 0707 02004000 * LISTALL=ON; /* TURN ALL LIST FLGS ON */ 02005000 OI LISTALL,B'10000000' 0707 02006000 * GO TO LISTEXIT; /* RETURN */ 02007000 * 0708 02008000 B LISTEXIT 0708 02009000 * /*****************************************************************/ 02010000 * /* */ 02011000 * /* ROUTINE FOR PTF */ 02012000 * /* */ 02013000 * /*****************************************************************/ 02014000 * 0709 02015000 *PTFSAV: 0709 02016000 * ENTRY; 0709 02017000 PTFSAV STM @14,@12,12(@13) 0709 02018000 * LISTPTF=ON; /* INDICATE PTFS TO BE LISTED */ 02019000 OI LISTPTF,B'00001000' 0710 02020000 * GO TO LISTEXIT; /* RETURN */ 02021000 * 0711 02022000 B LISTEXIT 0711 02023000 * /*****************************************************************/ 02024000 * /* */ 02025000 * /* ROUTINE FOR MODS */ 02026000 * /* */ 02027000 * /*****************************************************************/ 02028000 * 0712 02029000 *MODSAV: 0712 02030000 * ENTRY; 0712 02031000 MODSAV STM @14,@12,12(@13) 0712 02032000 * LISTMOD=ON; /* INDICATE MODULES TO BE LISTED */ 02033000 OI LISTMOD,B'01000000' 0713 02034000 * GO TO LISTEXIT; /* RETURN */ 02035000 * 0714 02036000 B LISTEXIT 0714 02037000 * /*****************************************************************/ 02038000 * /* */ 02039000 * /* ROUTINE FOR MACS */ 02040000 * /* */ 02041000 * /*****************************************************************/ 02042000 * 0715 02043000 *MACSAV: 0715 02044000 * ENTRY; 0715 02045000 MACSAV STM @14,@12,12(@13) 0715 02046000 * LISTMAC=ON; /* INDICATE MACROS TO BE LISTED */ 02047000 OI LISTMAC,B'00000010' 0716 02048000 * GO TO LISTEXIT; /* RETURN 0717 02049000 * */ 02050000 B LISTEXIT 0717 02051000 * 0718 02052000 * /*****************************************************************/ 02053000 * /* */ 02054000 * /* ROUTINE FOR LMODS */ 02055000 * /* */ 02056000 * /*****************************************************************/ 02057000 * 0718 02058000 *LMODSAV: 0718 02059000 * ENTRY; 0718 02060000 LMODSAV STM @14,@12,12(@13) 0718 02061000 * LISTLMOD=ON; /* INDICATE LMODS TO BE LISTED */ 02062000 OI LISTLMOD,B'00100000' 0719 02063000 * GO TO LISTEXIT; /* RETURN */ 02064000 * 0720 02065000 B LISTEXIT 0720 02066000 * /*****************************************************************/ 02067000 * /* */ 02068000 * /* ROUTINE FOR ASSEMS */ 02069000 * /* */ 02070000 * /*****************************************************************/ 02071000 * 0721 02072000 *ASSEMSAV: 0721 02073000 * ENTRY; 0721 02074000 ASSEMSAV STM @14,@12,12(@13) 0721 02075000 * LISTASM=ON; /* INDICATE ASSEMBLIES */ 02076000 OI LISTASM,B'00000100' 0722 02077000 * GO TO LISTEXIT; /* RETURN */ 02078000 * 0723 02079000 B LISTEXIT 0723 02080000 * /*****************************************************************/ 02081000 * /* */ 02082000 * /* ROUTINE FOR DLIBS */ 02083000 * /* */ 02084000 * /*****************************************************************/ 02085000 * 0724 02086000 *DLIBSAV: 0724 02087000 * ENTRY; 0724 02088000 DLIBSAV STM @14,@12,12(@13) 0724 02089000 * LISTDLIB=ON; /* INDICATE DLIBS TO BE LISTED */ 02090000 OI LISTDLIB,B'00010000' 0725 02091000 * GO TO LISTEXIT; /* RETURN */ 02092000 * 0726 02093000 B LISTEXIT 0726 02094000 * /*****************************************************************/ 02095000 * /* */ 02096000 * /* ROUTINE FOR SYSTEM ENTRY */ 02097000 * /* */ 02098000 * /*****************************************************************/ 02099000 * 0727 02100000 *SYSSAV: 0727 02101000 * ENTRY; 0727 02102000 SYSSAV STM @14,@12,12(@13) 0727 02103000 * LISTSYS=ON; /* INDICATE LIST SYSTEM ENTRY */ 02104000 OI LISTSYS,B'00000001' 0728 02105000 *LISTEXIT: 0729 02106000 * ; 0729 02107000 LISTEXIT DS 0H 0730 02108000 * SCPRET=GOOD; /* INDICATE SUCCESS */ 02109000 MVI SCPRET,X'00' 0730 02110000 * CCALSCDS=ON; /* INDICATE LIST CDS FOUND */ 02111000 OI CCALSCDS,B'10000000' 0731 02112000 * END LISTSAV; 0732 02113000 @EL00015 DS 0H 0732 02114000 @EF00015 DS 0H 0732 02115000 @ER00015 LM @14,@12,12(@13) 0732 02116000 BR @14 0732 02117000 * 0733 02118000 * /*****************************************************************/ 02119000 * /* */ 02120000 * /* THE FOLLOWING ROUTINES HANDLE WRITING TO THE HISTORY LOG */ 02121000 * /* THROUGH THE LOG VERB. */ 02122000 * /* */ 02123000 * /*****************************************************************/ 02124000 * 0733 02125000 *LOGSTART: 0733 02126000 * PROCEDURE; 0733 02127000 * 0733 02128000 LOGSTART STM @14,@12,12(@13) 0733 02129000 * /*****************************************************************/ 02130000 * /* */ 02131000 * /* RESET FIELDS FOR LOG MESSAGE */ 02132000 * /* */ 02133000 * /*****************************************************************/ 02134000 * 0734 02135000 * LOGLNTH=ZERO; /* SET LENGTH TO ZERO */ 02136000 SLR @14,@14 0734 02137000 STH @14,LOGLNTH 0734 02138000 * LOGVERB=ON; /* INDICATE LOG VERB BEING PROC */ 02139000 OI LOGVERB,B'00010000' 0735 02140000 * SCPRET=GOOD; /* INDICATE CONTINUE */ 02141000 MVI SCPRET,X'00' 0736 02142000 * END LOGSTART; 0737 02143000 * 0737 02144000 @EL00016 DS 0H 0737 02145000 @EF00016 DS 0H 0737 02146000 @ER00016 LM @14,@12,12(@13) 0737 02147000 BR @14 0737 02148000 * /*****************************************************************/ 02149000 * /* */ 02150000 * /* BUMP THE LOG MESSAGE LENGTH AND SAVE THIS PORTION */ 02151000 * /* */ 02152000 * /*****************************************************************/ 02153000 * 0738 02154000 *LOGBUMP: 0738 02155000 * PROCEDURE; 0738 02156000 LOGBUMP STM @14,@12,12(@13) 0738 02157000 * SCPRET=GOOD; /* PRESET RETURN TO SCAN */ 02158000 MVI SCPRET,X'00' 0739 02159000 * IF SCPPMLN=ZERO /* ZERO LENGTH ON PARM? */ 02160000 * THEN /* YES - MAKE IT ONE */ 02161000 LH @14,SCPPMLN 0740 02162000 LTR @14,@14 0740 02163000 BNZ @RF00740 0740 02164000 * SCPPMLN=ONE; /* TO SKIP BY SPECIAL CHARACTER */ 02165000 MVC SCPPMLN(2),@CH00040 0741 02166000 * IF LOGLNTH+SCPPMLN>LOGMAX /* EXCEEDED RECORD SIZE FOR LOG? */ 02167000 * THEN /* YES - TRUNCATE */ 02168000 @RF00740 LH @14,LOGLNTH 0742 02169000 LH @03,SCPPMLN 0742 02170000 LR @09,@14 0742 02171000 ALR @09,@03 0742 02172000 CH @09,@CH00084 0742 02173000 BH @RT00742 0742 02174000 * RETURN; /* IGNORE THIS UPDATE */ 02175000 * LOGMSG(LOGLNTH+ONE:LOGLNTH+SCPPMLN)=STRING(1:SCPPMLN);/* ADD */ 02176000 LA @01,LOGMSG(@14) 0744 02177000 BCTR @03,0 0744 02178000 L @14,SCPCHAR 0744 02179000 EX @03,@SM01334 0744 02180000 * LOGLNTH=LOGLNTH+SCPPMLN; /* BUMP MESSAGE LENGTH */ 02181000 STH @09,LOGLNTH 0745 02182000 * END LOGBUMP; /* RETURN TO SCAN */ 02183000 * 0746 02184000 @EL00017 DS 0H 0746 02185000 @EF00017 DS 0H 0746 02186000 @ER00017 LM @14,@12,12(@13) 0746 02187000 BR @14 0746 02188000 * /*****************************************************************/ 02189000 * /* */ 02190000 * /* THIS ROUTINE IS INVOKED WHEN SCAN FINDS SOMETHING FOLLOWING */ 02191000 * /* THE PERIOD FOR A VERB. IT IS AN INSTANT SYNTAX ERROR */ 02192000 * /* */ 02193000 * /*****************************************************************/ 02194000 * 0747 02195000 *XTRAINFO: 0747 02196000 * PROCEDURE; 0747 02197000 XTRAINFO STM @14,@12,12(@13) 0747 02198000 * SCPRET=SCNERR; /* INDICATE ERROR */ 02199000 MVI SCPRET,X'08' 0748 02200000 * END XTRAINFO; /* RETURN TO SCAN 0749 02201000 * */ 02202000 @EL00018 DS 0H 0749 02203000 @EF00018 DS 0H 0749 02204000 @ER00018 LM @14,@12,12(@13) 0749 02205000 BR @14 0749 02206000 * 0750 02207000 * /*****************************************************************/ 02208000 * /* */ 02209000 * /* THIS IS THE DRIVER I/O ROUTINE FOR THE CONTROL CARD READS AND */ 02210000 * /* PRINTS */ 02211000 * /* */ 02212000 * /*****************************************************************/ 02213000 * 0750 02214000 *DRVIO: 0750 02215000 * PROCEDURE OPTIONS(SAVEAREA); 0750 02216000 DRVIO STM @14,@12,12(@13) 0750 02217000 ST @13,@SA00019+4 0750 02218000 LA @14,@SA00019 0750 02219000 ST @14,8(,@13) 0750 02220000 LR @13,@14 0750 02221000 * IOPDSID=IOPCONTR; /* INDICATE CONTROL CARD DS */ 02222000 L @14,IOPPTR 0751 02223000 MVI IOPDSID(@14),X'09' 0751 02224000 * IOPFUNCT=IOPREAD; /* INDICATE INPUT OPERATION */ 02225000 MVI IOPFUNCT(@14),X'01' 0752 02226000 * CALL HMASMIO(HMASMIOP); /* READ A RECORD */ 02227000 ST @14,@AL00001 0753 02228000 L @15,@CV00173 0753 02229000 LA @01,@AL00001 0753 02230000 BALR @14,@15 0753 02231000 * IF IOPRETRN>EOF /* I/O ERROR? */ 02232000 * THEN /* YES - INDICATE ERROR AND */ 02233000 L @14,IOPPTR 0754 02234000 CLI IOPRETRN(@14),4 0754 02235000 BNH @RF00754 0754 02236000 * DO; /* LEAVE ROUTINE */ 02237000 * RTNCODE=IOERRCD; /* INDICATE I/O ERROR */ 02238000 MVI RTNCODE,X'0C' 0756 02239000 * SCPRET=SCNERR; /* INDICATE STOP SCAN */ 02240000 MVI SCPRET,X'08' 0757 02241000 * RETURN; /* EXIT */ 02242000 @EL00019 L @13,4(,@13) 0758 02243000 @EF00019 DS 0H 0758 02244000 @ER00019 LM @14,@12,12(@13) 0758 02245000 BR @14 0758 02246000 * END; 0759 02247000 * IF IOPRETRN=EOF /* IS IT END OF FILE? */ 02248000 * THEN /* YES - SET INDICATOR */ 02249000 @RF00754 L @14,IOPPTR 0760 02250000 CLI IOPRETRN(@14),4 0760 02251000 BNE @RF00760 0760 02252000 * DO; 0761 02253000 * EOFFLAG=ON; /* INDICATE END OF FILE */ 02254000 OI EOFFLAG,B'10000000' 0762 02255000 * SCPRET=STOPSCAN; /* INDICATE STOP SCAN */ 02256000 MVI SCPRET,X'04' 0763 02257000 * RETURN; /* EXIT */ 02258000 B @EL00019 0764 02259000 * END; 0765 02260000 * TEMPSAV=CRDBUFF; /* SAVE RECORD */ 02261000 @RF00760 L @14,IOPPTR 0766 02262000 L @03,IOPBUFAD(,@14) 0766 02263000 MVC TEMPSAV(80),CRDBUFF(@03) 0766 02264000 * PRLDATA(1:LRECL)=TEMPSAV; /* PREPARE STATEMENT FOR PRINT */ 02265000 MVC PRLDATA(80,@03),TEMPSAV 0767 02266000 * PRLRLEN=LRECL; /* SET RECORD LENGTH IN PRL */ 02267000 MVC PRLRLEN(2,@03),@CH00064 0768 02268000 * PRLSPAN=ZERO; /* ZERO INDICATORS */ 02269000 SLR @09,@09 0769 02270000 ST @09,@TF00001 0769 02271000 MVC PRLSPAN(2,@03),@TF00001+2 0769 02272000 * IOPDSID=IOPPRINT; /* INDICATE PRINTER */ 02273000 MVI IOPDSID(@14),X'0B' 0770 02274000 * IOPFUNCT=IOPWRITE; /* INDICATE WRITE OPERATION */ 02275000 MVI IOPFUNCT(@14),X'05' 0771 02276000 * CALL HMASMIO(HMASMIOP); /* WRITE STATEMENT TO SYSOUT */ 02277000 ST @14,@AL00001 0772 02278000 L @15,@CV00173 0772 02279000 LA @01,@AL00001 0772 02280000 BALR @14,@15 0772 02281000 * IF IOPRETRNª=GOOD /* I/O ERROR? */ 02282000 * THEN /* YES - INDICATE ERROR */ 02283000 L @14,IOPPTR 0773 02284000 CLI IOPRETRN(@14),0 0773 02285000 BE @RF00773 0773 02286000 * DO; 0774 02287000 * RTNCODE=IOERRCD; /* INDICATE ERROR */ 02288000 MVI RTNCODE,X'0C' 0775 02289000 * SCPRET=SCNERR; /* INDICATE STOP SCAN WITH ERR */ 02290000 MVI SCPRET,X'08' 0776 02291000 * RETURN; 0777 02292000 B @EL00019 0777 02293000 * END; 0778 02294000 * SCPCHAR=IOPBUFAD; /* RESET SCAN PTR */ 02295000 @RF00773 L @14,IOPPTR 0779 02296000 L @14,IOPBUFAD(,@14) 0779 02297000 ST @14,SCPCHAR 0779 02298000 * CRDBUFF=TEMPSAV; /* RESTORE RECORD */ 02299000 MVC CRDBUFF(80,@14),TEMPSAV 0780 02300000 * SCPRET=GOOD; /* INDICATE CONTINUE */ 02301000 MVI SCPRET,X'00' 0781 02302000 * END DRVIO; 0782 02303000 B @EL00019 0782 02304000 * END HMASMDRV 0783 02305000 * 0783 02306000 */* THE FOLLOWING INCLUDE STATEMENTS WERE FOUND IN THIS PROGRAM. */ 02307000 */*%INCLUDE SYSLIB (HMASMCCA) */ 02308000 */*%INCLUDE SYSLIB (HMASMSCP) */ 02309000 */*%INCLUDE SYSLIB (HMASMMGP) */ 02310000 */*%INCLUDE SYSLIB (HMASMIOP) */ 02311000 */*%INCLUDE SYSLIB (HMASMSET) */ 02312000 */*%INCLUDE SYSLIB (HMASMPRL) */ 02313000 */*%INCLUDE SYSLIB (HMASMICT) */ 02314000 */*%INCLUDE SYSLIB (IEFJFCBN) */ 02315000 */*%INCLUDE SYSLIB (IHADCBDF) */ 02316000 */*%INCLUDE SYSLIB (IHADCB ) */ 02317000 * 0783 02318000 * ; 0783 02319000 @DATA DS 0H 02320000 @CH00115 DC H'5' 02321000 @CH00048 DC H'6' 02322000 @CH00169 DC H'9' 02323000 @CH00034 DC H'10' 02324000 @CH00033 DC H'12' 02325000 @CH00066 DC H'20' 02326000 @CH00062 DC H'62' 02327000 @CH00070 DC H'72' 02328000 @CH00187 DC H'74' 02329000 @CH00084 DC H'250' 02330000 @SM01306 MVC PRLDATA(0,@03),LOGMSG 02331000 @SM01313 MVC 0(0,@03),STRING(@01) 02332000 @SM01318 MVC SEPTFNO-1(0,@03),STRING(@01) 02333000 @SM01320 MVC TBLLIBNM(0),STRING(@03) 02334000 @SM01322 MVC BMM(0),STRING(@03) 02335000 @SM01324 MVC BDD(0),STRING(@03) 02336000 @SM01326 MVC BYY(0),STRING(@03) 02337000 @SM01328 MVC EMM(0),STRING(@03) 02338000 @SM01330 MVC EDD(0),STRING(@03) 02339000 @SM01332 MVC EYY(0),STRING(@03) 02340000 @SM01334 MVC 0(0,@01),STRING(@14) 02341000 DS 0F 02342000 @AL00194 EQU * LIST WITH 1 ARGUMENT(S) 02343000 @AL00219 EQU * LIST WITH 1 ARGUMENT(S) 02344000 @AL00245 EQU * LIST WITH 1 ARGUMENT(S) 02345000 @AL00285 EQU * LIST WITH 1 ARGUMENT(S) 02346000 @AL00342 EQU * LIST WITH 1 ARGUMENT(S) 02347000 @AL00361 EQU * LIST WITH 1 ARGUMENT(S) 02348000 @AL00381 EQU * LIST WITH 1 ARGUMENT(S) 02349000 @AL00452 EQU * LIST WITH 1 ARGUMENT(S) 02350000 @AL00530 EQU * LIST WITH 1 ARGUMENT(S) 02351000 @AL00625 DC A(HMASMMGP) LIST WITH 1 ARGUMENT(S) 02352000 @AL00215 EQU * LIST WITH 1 ARGUMENT(S) 02353000 @AL00356 DC A(HMASMSCP) LIST WITH 1 ARGUMENT(S) 02354000 @AL00390 DC A(LOGPARM) LIST WITH 1 ARGUMENT(S) 02355000 @AL00398 DC A(LCDPARM) LIST WITH 1 ARGUMENT(S) 02356000 DS 0F 02357000 @SA00001 DS 18F 02358000 @PC00001 DS 1F 02359000 @SA00019 DS 18F 02360000 @SA00008 DS 15F 02361000 @AL00001 DS 2A 02362000 @TF00001 DS F 02363000 @ZTEMPS DS 0F 02364000 @ZT00001 DC F'0' 02365000 @ZT00003 DC F'0' 02366000 @ZTEMPND EQU * 02367000 @ZLEN EQU @ZTEMPND-@ZTEMPS 02368000 DS 0F 02369000 @CF00040 DC F'1' 02370000 @CH00040 EQU @CF00040+2 02371000 @CF00087 DC F'2' 02372000 @CF00055 DC F'4' 02373000 @CF00058 DC F'50' 02374000 @CH00058 EQU @CF00058+2 02375000 @CF00064 DC F'80' 02376000 @CH00064 EQU @CF00064+2 02377000 @CF01310 DC F'-8' 02378000 @CF01317 DC F'-7' 02379000 @CV00171 DC V(HMASMAPA) 02380000 @CV00172 DC V(HMASMRES) 02381000 @CV00173 DC V(HMASMIO) 02382000 @CV00174 DC V(HMASMMSG) 02383000 @CV00175 DC V(HMASMREC) 02384000 @CV00176 DC V(HMASMSCN) 02385000 @CV00177 DC V(HMASMTBL) 02386000 @CV00178 DC V(HMASMUCL) 02387000 @CV00179 DC V(HMASMUPD) 02388000 @CV00180 DC V(HMASMLCD) 02389000 @CV00181 DC V(HMASMLOG) 02390000 DS 0D 02391000 I DS F 02392000 IOPPTR DC AL4(SYSIOP) 02393000 DCBPTR DC AL4(JFCDCB) 02394000 SECTR DC F'0' 02395000 SEMAX DC F'50' 02396000 NSETADDR DC A(0) 02397000 SETPTR DC AL4(SET) 02398000 BUFFSV DS A 02399000 LOGLNTH DS H 02400000 RTNCODE DC AL1(0) 02401000 @TS00001 DS CL10 02402000 @CC00095 DC C'CCA ' 02403000 @CC00051 DC C'SYSTEM ' 02404000 @CC00076 DC C'SMPPTS ' 02405000 @CC00091 DC C'IEHIOSUP' 02406000 @CC00093 DC C'LINKLIB ' 02407000 @CB00081 DC X'FFFF' 02408000 DATEOP DC CL5' ' 02409000 TEMP DS CL10 02410000 SYSIOP DS CL30 02411000 BUFFRIOP DS CL264 02412000 CDSJFCB DS CL176 02413000 PTSJFCB DS CL176 02414000 SUPJFCB DS CL176 02415000 LOGMSG DS CL250 02416000 DS CL7 02417000 DBLWRD DS CL8 02418000 TEMPSAV DS CL80 02419000 OLDNUCID DC CL1' ' 02420000 DS CL1 02421000 BLDLLIST DS CL448 02422000 ORG BLDLLIST 02423000 @NM00001 DC H'6' 02424000 @NM00002 DC H'74' 02425000 BLDLELMT DS CL74 02426000 ORG BLDLELMT+0 02427000 MEMPOS DS CL10 02428000 ORG MEMPOS+0 02429000 MEMNAME DC CL8'IEWL' 02430000 POSITN DC FL2'1' 02431000 ORG BLDLELMT+10 02432000 MEMREC DC AL1(0) 02433000 ORG BLDLELMT+74 02434000 ORG BLDLELMT+74 02435000 ORG MEMPOS+74 02436000 DC CL8'ASMBLR' 02437000 DC FL2'2' 02438000 ORG BLDLELMT+148 02439000 ORG BLDLELMT+148 02440000 ORG MEMPOS+148 02441000 DC CL8'IEBCOPY' 02442000 DC FL2'3' 02443000 ORG BLDLELMT+222 02444000 ORG BLDLELMT+222 02445000 ORG MEMPOS+222 02446000 DC CL8'IMASPZAP' 02447000 DC FL2'4' 02448000 ORG BLDLELMT+296 02449000 ORG BLDLELMT+296 02450000 ORG MEMPOS+296 02451000 DC CL8'IEHIOSUP' 02452000 DC FL2'5' 02453000 ORG BLDLELMT+370 02454000 ORG BLDLELMT+370 02455000 ORG MEMPOS+370 02456000 DC CL8'IEBUPDTE' 02457000 DC FL2'6' 02458000 ORG BLDLLIST+448 02459000 DS CL2 02460000 JFCEXLST DS CL4 02461000 ORG JFCEXLST 02462000 @NM00003 DC X'87' 02463000 JFCBPTR DC AL3(CDSJFCB) 02464000 ORG JFCEXLST+4 02465000 SUPBLDL DS CL78 02466000 ORG SUPBLDL 02467000 @NM00004 DC H'1' 02468000 @NM00005 DC H'74' 02469000 SUPNAME DC CL8'IEHIOSUP' 02470000 @NM00006 DS CL66 02471000 ORG SUPBLDL+78 02472000 FLAGS DC AL1(0) 02473000 ORG FLAGS 02474000 EOFFLAG DS BL1 02475000 FLUSHSW EQU FLAGS+0 02476000 RECSW EQU FLAGS+0 02477000 LOGVERB EQU FLAGS+0 02478000 RTNERR EQU FLAGS+0 02479000 ORG FLAGS+1 02480000 CHARCOL DS CL2 02481000 ORG CHARCOL 02482000 @NM00007 DS CL1 02483000 LASTDIG DS CL1 02484000 ORG CHARCOL+2 02485000 TBLPARM DS CL9 02486000 ORG TBLPARM 02487000 TBLFLAGS DC AL1(0) 02488000 ORG TBLFLAGS 02489000 @NM00008 DS BL1 02490000 TBLDIST EQU TBLFLAGS+0 02491000 TBLNOLIB EQU TBLFLAGS+0 02492000 @NM00009 EQU TBLFLAGS+0 02493000 ORG TBLPARM+1 02494000 TBLLIBNM DC CL8' ' 02495000 ORG TBLPARM+9 02496000 LOGPARM DS CL14 02497000 ORG LOGPARM 02498000 BMM DS CL2 02499000 BDD DS CL2 02500000 BYY DS CL2 02501000 @NM00010 DC CL1'0' 02502000 EMM DS CL2 02503000 EDD DS CL2 02504000 EYY DS CL2 02505000 @NM00011 DC CL1'0' 02506000 ORG LOGPARM+14 02507000 LCDPARM DC AL1(0) 02508000 ORG LCDPARM 02509000 LISTALL DS BL1 02510000 LISTMOD EQU LCDPARM+0 02511000 LISTLMOD EQU LCDPARM+0 02512000 LISTDLIB EQU LCDPARM+0 02513000 LISTPTF EQU LCDPARM+0 02514000 LISTASM EQU LCDPARM+0 02515000 LISTMAC EQU LCDPARM+0 02516000 LISTSYS EQU LCDPARM+0 02517000 ORG LCDPARM+1 02518000 DS CL3 02519000 HMASMCCA DS CL94 02520000 ORG HMASMCCA 02521000 CCAID DS CL4 02522000 CCABUFAD DS AL4 02523000 CCAIOPTR DS AL4 02524000 CCAICT DS AL4 02525000 CCAICPTF DS AL4 02526000 CCAICMOD DS AL4 02527000 CCAICLMD DS AL4 02528000 CCAPESIZ DS AL4 02529000 CCALKED DS AL4 02530000 CCAASM DS AL4 02531000 CCACOPY DS AL4 02532000 CCASPZAP DS AL4 02533000 CCAIOSUP DS AL4 02534000 CCAUPDTE DS AL4 02535000 CCALKSIZ DS AL4 02536000 CCAJFCDS DS AL4 02537000 CCAJFPTS DS AL4 02538000 CCAMXERR DS FL2 02539000 CCAPEMAX DS FL2 02540000 CCABFMMX DS FL2 02541000 CCABFPMX DS FL2 02542000 CCAOPT DS BL1 02543000 ORG CCAOPT 02544000 CCALKOPT DS BL1 02545000 CCACPOPT EQU CCAOPT+0 02546000 @NM00012 EQU CCAOPT+0 02547000 ORG HMASMCCA+77 02548000 CCAFLAG1 DS BL1 02549000 ORG CCAFLAG1 02550000 CCAREC DS BL1 02551000 CCAAPPLY EQU CCAFLAG1+0 02552000 CCAACCPT EQU CCAFLAG1+0 02553000 CCAREJ EQU CCAFLAG1+0 02554000 CCARES EQU CCAFLAG1+0 02555000 CCAUPDJ EQU CCAFLAG1+0 02556000 CCAUPDU EQU CCAFLAG1+0 02557000 CCALSLOG EQU CCAFLAG1+0 02558000 ORG HMASMCCA+78 02559000 CCAFLAG2 DS BL1 02560000 ORG CCAFLAG2 02561000 CCALSCDS DS BL1 02562000 CCANCPTF EQU CCAFLAG2+0 02563000 CCACPYCP EQU CCAFLAG2+0 02564000 CCATSO EQU CCAFLAG2+0 02565000 CCASVCLB EQU CCAFLAG2+0 02566000 CCATERM EQU CCAFLAG2+0 02567000 CCAICSB EQU CCAFLAG2+0 02568000 @NM00013 EQU CCAFLAG2+0 02569000 ORG HMASMCCA+79 02570000 CCAFLAG3 DS BL1 02571000 ORG CCAFLAG3 02572000 CCAZAPP DS BL1 02573000 CCALINKP EQU CCAFLAG3+0 02574000 CCACOPYP EQU CCAFLAG3+0 02575000 @NM00014 EQU CCAFLAG3+0 02576000 ORG HMASMCCA+80 02577000 CCANUCID DS CL1 02578000 CCASREL DS CL4 02579000 CCADATE DS CL3 02580000 CCASPDCB DS AL4 02581000 CCABLKSZ DS FL2 02582000 ORG HMASMCCA+94 02583000 DS CL2 02584000 HMASMSCP DS CL22 02585000 ORG HMASMSCP 02586000 SCPCHAR DS AL4 02587000 SCPSRCH DS AL4 02588000 SCPWKAR DS AL4 02589000 SCPIORTN DS AL4 02590000 SCPINLN DS FL2 02591000 SCPPMLN DS FL2 02592000 SCPEOR DS BL1 02593000 ORG SCPEOR 02594000 SCPCONT DS BL1 02595000 SCPNOCT EQU SCPEOR+0 02596000 SCPCOMNT EQU SCPEOR+0 02597000 @NM00015 EQU SCPEOR+0 02598000 ORG HMASMSCP+21 02599000 SCPRET DS FL1 02600000 ORG HMASMSCP+22 02601000 DS CL2 02602000 HMASMMGP DS CL8 02603000 ORG HMASMMGP 02604000 MGPMGNO1 DS FL1 02605000 MGPMGNO2 DS FL1 02606000 MGPMGNO3 DS FL1 02607000 MGPFLAGS DS BL1 02608000 ORG MGPFLAGS 02609000 MGPPRINT DS BL1 02610000 MGPHLDS EQU MGPFLAGS+0 02611000 @NM00016 EQU MGPFLAGS+0 02612000 ORG HMASMMGP+4 02613000 MGPVARPT DS 1A 02614000 ORG HMASMMGP+8 02615000 SET DS 50CL8 02616000 PATCH DC 9CL8'DRVPATCH' 02617000 HMASMDRV CSECT 02618000 JFCDCB DCB DEVD=DA,MACRF=R,DSORG=PO,DDNAME=SMPCDS,EXLST=JFCEXLST 02619000 HMASMDRV CSECT 02620000 SIZEK DSCAN KEY='SIZE=',ALT=LKEDK,SUCC=LPAREN1,ROUT=SIZBEG 02621000 LKEDK DSCAN KEY='LKED=',ALT=ASMK,SUCC=LKEDP 02622000 ASMK DSCAN KEY='ASM=',ALT=ZAPK,SUCC=ASMP 02623000 ZAPK DSCAN KEY='ZAP=',SUCC=ZAPP 02624000 LKEDP DSCAN MAXLEN=8,SUCC=COMMA1,ROUT=LKEDSAV 02625000 ASMP DSCAN MAXLEN=8,SUCC=COMMA1,ROUT=ASMSAV 02626000 ZAPP DSCAN MAXLEN=8,SUCC=COMMA1,ROUT=ZAPSAV 02627000 COMMA1 DSCAN KEY=',',IO=NO,SUCC=SIZEK 02628000 LPAREN1 DSCAN KEY='(',SUCC=SIZVAL1 02629000 SIZVAL1 DSCAN SUCC=COMMA2 02630000 COMMA2 DSCAN KEY=',',SUCC=SIZVAL2 02631000 SIZVAL2 DSCAN SUCC=RPAREN1 02632000 RPAREN1 DSCAN KEY=')',SUCC=COMMA1,ROUT=SIZEND 02633000 HMASMDRV CSECT 02634000 ******** MAIN VERBS *********** 02635000 RECK DSCAN KEY='RECEIVE',ALT=APPK,SUCC=SELK,ROUT=RECSAV 02636000 APPK DSCAN KEY='APPLY',ALT=ACCK,SUCC=SELK,ROUT=APPSAV 02637000 ACCK DSCAN KEY='ACCEPT',ALT=REJK,SUCC=SELK,ROUT=ACCSAV 02638000 REJK DSCAN KEY='REJECT',ALT=RESK,SUCC=SELK,ROUT=REJSAV 02639000 RESK DSCAN KEY='RESTORE',ALT=LISTK,SUCC=SELK,ROUT=RESSAV 02640000 LISTK DSCAN KEY='LIST',ALT=UCLINK,SUCC=PREPER 02641000 UCLINK DSCAN KEY='UCLIN',ALT=JCLINK,SUCC=PERIOD2,ROUT=UCLSAV 02642000 JCLINK DSCAN KEY='JCLIN',ALT=LOGK,SUCC=PERIOD2,ROUT=JCLSAV 02643000 LOGK DSCAN KEY='LOG',SUCC=LPAREN2 02644000 ******** SELECT/EXCLUDE TABLES *********** 02645000 SELK DSCAN KEY='SELECT',ALT=SK,SUCC=LPAREN3,ROUT=SELSAV 02646000 SK DSCAN KEY='S',ALT=EXCLK,SUCC=LPAREN3,ROUT=SELSAV 02647000 EXCLK DSCAN KEY='EXCLUDE',ALT=EK,SUCC=LPAREN3,ROUT=EXCSAV 02648000 EK DSCAN KEY='E',ALT=FORCEK,SUCC=LPAREN3,ROUT=EXCSAV 02649000 LPAREN3 DSCAN KEY='(',SUCC=PTFNO 02650000 PTFNO DSCAN MINLEN=7,MAXLEN=7,ROUT=SESAV,SUCC=RPAREN3 02651000 RPAREN3 DSCAN KEY=')',ALT=COMMA3,SUCC=FORCEK 02652000 COMMA3 DSCAN KEY=',',ALT=PTFNO,SUCC=PTFNO 02653000 ********* FORCE OPTION ******* 02654000 FORCEK DSCAN KEY='FORCE',ALT=NUCIDK,SUCC=SELK,ROUT=FORSAV 02655000 ********* NUCID SPECIFIED ********* 02656000 NUCIDK DSCAN KEY='NUCID',ALT=LIBK,SUCC=LPAREN4 02657000 LPAREN4 DSCAN KEY='(',SUCC=NUCVAL 02658000 NUCVAL DSCAN MINLEN=1,MAXLEN=1,ROUT=NUCSAV,SUCC=RPAREN4 02659000 RPAREN4 DSCAN KEY=')',SUCC=SELK 02660000 *********** LIB SPECIFIED *********** 02661000 LIBK DSCAN KEY='LIB',ALT=NOLIBK,SUCC=LPAREN5 02662000 LPAREN5 DSCAN KEY='(',SUCC=LIBVAL 02663000 LIBVAL DSCAN MINLEN=1,MAXLEN=7,ROUT=LIBSAV,SUCC=RPAREN5 02664000 RPAREN5 DSCAN KEY=')',SUCC=SELK 02665000 ************* NOLIB SPECIFIED ********* 02666000 NOLIBK DSCAN KEY='NOLIB',ROUT=NOLIBSAV,SUCC=SELK,ALT=PERIOD2 02667000 ************* END OF STATEMENT ********* 02668000 PERIOD2 DSCAN KEY='.',SUCC=EOCARD 02669000 ************ LIST OPTIONS ******** 02670000 PREPER DSCAN KEY='.',ALT=CDSK,ROUT=XTRAINFO 02671000 CDSK DSCAN KEY='CDS',ALT=LOGPK,ROUT=CDSSAV,SUCC=PERIOD3 02672000 LOGPK DSCAN KEY='LOG',ALT=MODK,SUCC=LPAREN6 02673000 LPAREN6 DSCAN KEY='(',ALT=PERIOD4,SUCC=BEGMON,ROUT=LLOGPART 02674000 BEGMON DSCAN MINLEN=1,MAXLEN=2,ROUT=BMONSAV,TYPE=N,SUCC=BEGDAY 02675000 BEGDAY DSCAN MINLEN=1,MAXLEN=2,ROUT=BDAYSAV,TYPE=N,SUCC=BEGYEAR 02676000 BEGYEAR DSCAN MINLEN=2,MAXLEN=2,ROUT=BYEARSAV,TYPE=N,SUCC=COMMA6 02677000 COMMA6 DSCAN KEY=',',ALT=ENDMON,SUCC=ENDMON 02678000 ENDMON DSCAN MINLEN=1,MAXLEN=2,ROUT=EMONSAV,TYPE=N,SUCC=ENDDAY 02679000 ENDDAY DSCAN MINLEN=1,MAXLEN=2,ROUT=EDAYSAV,TYPE=N,SUCC=ENDYEAR 02680000 ENDYEAR DSCAN MINLEN=2,MAXLEN=2,ROUT=EYEARSAV,TYPE=N,SUCC=RPAREN6 02681000 RPAREN6 DSCAN KEY=')',SUCC=PERIOD3 02682000 PERIOD4 DSCAN KEY='.',SUCC=EOCARD,ROUT=LLOGALL 02683000 PERIOD3 DSCAN KEY='.',SUCC=EOCARD 02684000 ********* LIST PARMS (OTHER THAN CDS OR LOG) ********* 02685000 MODK DSCAN KEY='MOD',ALT=MACK,SUCC=MACK,ROUT=MODSAV 02686000 MACK DSCAN KEY='MAC',ALT=LMODK,SUCC=MODK,ROUT=MACSAV 02687000 LMODK DSCAN KEY='LMOD',ALT=ASSEMK,SUCC=MODK,ROUT=LMODSAV 02688000 ASSEMK DSCAN KEY='ASSEM',ALT=PTFK,SUCC=MODK,ROUT=ASSEMSAV 02689000 PTFK DSCAN KEY='PTF',ALT=SYSK,SUCC=MODK,ROUT=PTFSAV 02690000 SYSK DSCAN KEY='SYS',ALT=DLIBK,SUCC=MODK,ROUT=SYSSAV 02691000 DLIBK DSCAN KEY='DLIB',ALT=PERIOD3,SUCC=MODK,ROUT=DLIBSAV 02692000 ******** LOG VERB ************* 02693000 LPAREN2 DSCAN KEY='(',SUCC=LOGLPAR,ROUT=LOGSTART 02694000 LOGLPAR DSCAN KEY='(',ALT=RPAREN2,SUCC=LOGRPAR,BLANKS=ON,ROUT=LOGBUMP 02695000 LOGRPAR DSCAN KEY=')',ALT=LOGDAT1,SUCC=LOGLPAR,BLANKS=ON,ROUT=LOGBUMP 02696000 LOGDAT1 DSCAN MINLEN=0,ROUT=LOGBUMP,SUCC=LOGRPAR,BLANKS=ON 02697000 RPAREN2 DSCAN KEY=')',ALT=LOGDAT2,SUCC=PERIOD5,BLANKS=ON 02698000 LOGDAT2 DSCAN MINLEN=0,ROUT=LOGBUMP,SUCC=LOGLPAR,BLANKS=ON 02699000 PERIOD5 DSCAN KEY='.',SUCC=EOCARD 02700000 ****** CHECK CONTINUED COMMENTS ********** 02701000 EOCARD DSCAN MINLEN=0,IO=NO,ROUT=XTRAINFO 02702000 HMASMDRV CSECT 02703000 @00 EQU 00 EQUATES FOR REGISTERS 0-15 02704000 @01 EQU 01 02705000 @02 EQU 02 02706000 @03 EQU 03 02707000 @04 EQU 04 02708000 @05 EQU 05 02709000 @06 EQU 06 02710000 @07 EQU 07 02711000 @08 EQU 08 02712000 @09 EQU 09 02713000 @10 EQU 10 02714000 @11 EQU 11 02715000 @12 EQU 12 02716000 @13 EQU 13 02717000 @14 EQU 14 02718000 @15 EQU 15 02719000 ERRCOL EQU @03 02720000 REMAINDR EQU @03 02721000 J EQU @03 02722000 R1 EQU @01 02723000 RCODREG EQU @15 02724000 CCAPTR EQU @11 02725000 SIZE EQU @02 02726000 STRING EQU 0 02727000 CRDBUFF EQU 0 02728000 HMASMIOP EQU 0 02729000 IOPDSID EQU HMASMIOP 02730000 IOPFUNCT EQU HMASMIOP+1 02731000 IOPRETRN EQU HMASMIOP+2 02732000 IOPMACID EQU HMASMIOP+3 02733000 IOPBUFAD EQU HMASMIOP+4 02734000 IOPNAME EQU HMASMIOP+8 02735000 IOPTYPE EQU IOPNAME 02736000 IOPNAME2 EQU IOPNAME+1 02737000 IOPTTR EQU HMASMIOP+16 02738000 IOPBLKSI EQU IOPTTR 02739000 IOPUDATA EQU HMASMIOP+20 02740000 HMASMSET EQU 0 02741000 SEFLAGS EQU HMASMSET 02742000 SESELECT EQU SEFLAGS 02743000 SEEXCLUD EQU SEFLAGS 02744000 SEFORCE EQU SEFLAGS 02745000 SEFOUND EQU SEFLAGS 02746000 SELAST EQU SEFLAGS 02747000 SEPTFNO EQU HMASMSET+1 02748000 HMASMPRL EQU 0 02749000 PRLRLEN EQU HMASMPRL 02750000 PRLSPAN EQU HMASMPRL+2 02751000 PRLFLGS EQU PRLSPAN 02752000 PRLHEAD EQU PRLFLGS 02753000 PRLHEADO EQU PRLFLGS 02754000 PRLBLANK EQU PRLFLGS 02755000 PRLDATE EQU HMASMPRL+4 02756000 PRLTIME EQU HMASMPRL+7 02757000 PRLDATA EQU HMASMPRL+10 02758000 HMASMICT EQU 0 02759000 ICTCORE EQU HMASMICT 02760000 ICTSPLEN EQU ICTCORE 02761000 ICTPTF EQU 0 02762000 ICTPTFS EQU ICTPTF 02763000 ICTPMID EQU ICTPTFS 02764000 ICTPFLG1 EQU ICTPTF+7 02765000 ICTPIFLG EQU ICTPTF+8 02766000 ICTPCHN EQU ICTPTF+9 02767000 ICTIXPF EQU 0 02768000 ICTMOD EQU 0 02769000 ICTMNAME EQU ICTMOD 02770000 ICTMFLG1 EQU ICTMOD+8 02771000 ICTMIFLG EQU ICTMOD+9 02772000 ICTMLEPR EQU ICTMOD+10 02773000 ICTMCHN EQU ICTMOD+23 02774000 ICTIXMF EQU 0 02775000 ICTLMOD EQU 0 02776000 ICTLMNAM EQU ICTLMOD 02777000 ICTLFLG1 EQU ICTLMOD+8 02778000 ICTLFLG2 EQU ICTLMOD+9 02779000 ICTLIFLG EQU ICTLMOD+10 02780000 ICTTGIND EQU ICTLIFLG 02781000 ICTTGLIB EQU ICTLMOD+11 02782000 ICTLCHN EQU ICTLMOD+30 02783000 ICTIXLF EQU 0 02784000 INFMJFCB EQU 0 02785000 JFCBDSNM EQU INFMJFCB 02786000 JFCBELNM EQU INFMJFCB+44 02787000 JFCBTSDM EQU INFMJFCB+52 02788000 JFCBSYSC EQU INFMJFCB+53 02789000 JFCBLTYP EQU INFMJFCB+66 02790000 JFCBOTTR EQU INFMJFCB+67 02791000 JFCBUFOF EQU JFCBOTTR 02792000 JFCBFLSQ EQU JFCBOTTR+1 02793000 JFCFUNC EQU JFCBFLSQ 02794000 JFCBMASK EQU INFMJFCB+72 02795000 JFCBOPS1 EQU JFCBMASK 02796000 JFCBFLG1 EQU JFCBMASK+5 02797000 JFCBFLG2 EQU JFCBMASK+6 02798000 JFCBIND1 EQU INFMJFCB+86 02799000 JFCBIND2 EQU INFMJFCB+87 02800000 JFCBUFNO EQU INFMJFCB+88 02801000 JFCBUFIN EQU JFCBUFNO 02802000 JFCBFOUT EQU JFCBUFIN 02803000 JFCBHIAR EQU INFMJFCB+89 02804000 JFCBFALN EQU JFCBHIAR 02805000 JFCBFTEK EQU JFCBFALN 02806000 JFCEROPT EQU INFMJFCB+92 02807000 JFCTRTCH EQU INFMJFCB+93 02808000 JFCKEYLE EQU 0 02809000 JFCCODE EQU JFCKEYLE 02810000 JFCSTACK EQU 0 02811000 JFCMODE EQU JFCSTACK 02812000 JFCSPPRT EQU 0 02813000 JFCLIMCT EQU JFCSPPRT+2 02814000 JFCDSORG EQU JFCSPPRT+5 02815000 JFCDSRG1 EQU JFCDSORG 02816000 JFCDSRG2 EQU JFCDSORG+1 02817000 JFCRECFM EQU JFCSPPRT+7 02818000 JFCFMRC EQU JFCRECFM 02819000 JFCOPTCD EQU JFCSPPRT+8 02820000 JFCWVCSP EQU JFCOPTCD 02821000 JFCWVCIS EQU JFCWVCSP 02822000 JFCWVCBD EQU JFCWVCIS 02823000 JFCALLOW EQU JFCOPTCD 02824000 @NM00045 EQU JFCALLOW 02825000 JFCOVER EQU @NM00045 02826000 JFCPCIBT EQU JFCOPTCD 02827000 JFCMAST EQU JFCPCIBT 02828000 JFCEXT EQU JFCMAST 02829000 JFCBCKPT EQU JFCOPTCD 02830000 JFCIND EQU JFCBCKPT 02831000 @NM00046 EQU JFCOPTCD 02832000 JFCCYL EQU @NM00046 02833000 JFCACT EQU JFCCYL 02834000 JFCREDUC EQU JFCOPTCD 02835000 @NM00047 EQU JFCREDUC 02836000 @NM00048 EQU @NM00047 02837000 @NM00049 EQU JFCOPTCD 02838000 JFCDEL EQU @NM00049 02839000 @NM00051 EQU JFCOPTCD 02840000 JFCREORG EQU @NM00051 02841000 JFCBLKSI EQU JFCSPPRT+9 02842000 JFCNCP EQU JFCSPPRT+13 02843000 JFCNTM EQU JFCSPPRT+14 02844000 JFCPCI EQU JFCNTM 02845000 JFCRKP EQU JFCSPPRT+15 02846000 JFCUCSEG EQU 0 02847000 JFCUCSOP EQU JFCUCSEG+4 02848000 JFCOUTLI EQU JFCUCSEG+5 02849000 JFCTHRSH EQU JFCOUTLI 02850000 JFCCPRI EQU JFCTHRSH 02851000 JFCBCTRI EQU JFCUCSEG+47 02852000 IHADCB EQU 0 02853000 IHADCS00 EQU 0 02854000 DCBFDAD EQU IHADCS00+5 02855000 IHADCS01 EQU 0 02856000 DCBDVTBL EQU IHADCS01 02857000 IHADCS11 EQU 0 02858000 DCBRELB EQU IHADCS11 02859000 DCBREL EQU DCBRELB+1 02860000 DCBBUFCB EQU IHADCS11+4 02861000 DCBDSORG EQU IHADCS11+10 02862000 DCBDSRG1 EQU DCBDSORG 02863000 DCBDSRG2 EQU DCBDSORG+1 02864000 DCBIOBAD EQU IHADCS11+12 02865000 DCBODEB EQU DCBIOBAD 02866000 DCBLNP EQU DCBODEB 02867000 DCBQSLM EQU DCBLNP 02868000 DCBIOBAA EQU DCBODEB+1 02869000 IHADCS50 EQU 0 02870000 DCBSVCXL EQU IHADCS50 02871000 DCBEODAD EQU IHADCS50+4 02872000 DCBBFALN EQU DCBEODAD 02873000 DCBHIARC EQU DCBBFALN 02874000 DCBBFTEK EQU DCBHIARC 02875000 DCBBFT EQU DCBBFTEK 02876000 DCBEXLST EQU IHADCS50+8 02877000 DCBRECFM EQU DCBEXLST 02878000 DCBRECLA EQU DCBRECFM 02879000 IHADCS24 EQU 0 02880000 DCBDDNAM EQU IHADCS24 02881000 DCBOFLGS EQU IHADCS24+8 02882000 DCBOFLWR EQU DCBOFLGS 02883000 DCBOFOPN EQU DCBOFLGS 02884000 DCBIFLG EQU IHADCS24+9 02885000 DCBMACR EQU IHADCS24+10 02886000 DCBMACR1 EQU DCBMACR 02887000 DCBMRFE EQU DCBMACR1 02888000 DCBMRGET EQU DCBMRFE 02889000 DCBMRAPG EQU DCBMACR1 02890000 DCBMRRD EQU DCBMRAPG 02891000 DCBMRCI EQU DCBMACR1 02892000 DCBMRMVG EQU DCBMRCI 02893000 DCBMRLCG EQU DCBMACR1 02894000 DCBMRABC EQU DCBMACR1 02895000 DCBMRPT1 EQU DCBMRABC 02896000 DCBMRSBG EQU DCBMRPT1 02897000 DCBMRCRL EQU DCBMACR1 02898000 DCBMRCHK EQU DCBMRCRL 02899000 DCBMRRDX EQU DCBMRCHK 02900000 DCBMRDMG EQU DCBMACR1 02901000 DCBMACR2 EQU DCBMACR+1 02902000 DCBMRPUT EQU DCBMACR2 02903000 DCBMRWRT EQU DCBMACR2 02904000 DCBMRMVP EQU DCBMACR2 02905000 DCBMR5WD EQU DCBMACR2 02906000 DCBMRLDM EQU DCBMR5WD 02907000 DCBMRLCP EQU DCBMRLDM 02908000 DCBMR4WD EQU DCBMACR2 02909000 DCBMRPT2 EQU DCBMR4WD 02910000 DCBMRTMD EQU DCBMRPT2 02911000 DCBMR3WD EQU DCBMACR2 02912000 DCBMRCTL EQU DCBMR3WD 02913000 DCBMRSTK EQU DCBMRCTL 02914000 DCBMR1WD EQU DCBMACR2 02915000 DCBMRSWA EQU DCBMR1WD 02916000 DCBMRDMD EQU DCBMRSWA 02917000 IHADCS25 EQU 0 02918000 DCBMACRF EQU IHADCS25+2 02919000 DCBMACF1 EQU DCBMACRF 02920000 DCBMFFE EQU DCBMACF1 02921000 DCBMFGET EQU DCBMFFE 02922000 DCBMFAPG EQU DCBMACF1 02923000 DCBMFRD EQU DCBMFAPG 02924000 DCBMFCI EQU DCBMACF1 02925000 DCBMFMVG EQU DCBMFCI 02926000 DCBMFLCG EQU DCBMACF1 02927000 DCBMFABC EQU DCBMACF1 02928000 DCBMFPT1 EQU DCBMFABC 02929000 DCBMFSBG EQU DCBMFPT1 02930000 DCBMFCRL EQU DCBMACF1 02931000 DCBMFCHK EQU DCBMFCRL 02932000 DCBMFDMG EQU DCBMACF1 02933000 DCBMACF2 EQU DCBMACRF+1 02934000 DCBMFPUT EQU DCBMACF2 02935000 DCBMFWRT EQU DCBMACF2 02936000 DCBMFMVP EQU DCBMACF2 02937000 DCBMF5WD EQU DCBMACF2 02938000 DCBMFLDM EQU DCBMF5WD 02939000 DCBMFLCP EQU DCBMFLDM 02940000 DCBMF4WD EQU DCBMACF2 02941000 DCBMFPT2 EQU DCBMF4WD 02942000 DCBMFTMD EQU DCBMFPT2 02943000 DCBMF3WD EQU DCBMACF2 02944000 DCBMFCTL EQU DCBMF3WD 02945000 DCBMFSTK EQU DCBMFCTL 02946000 DCBMF1WD EQU DCBMACF2 02947000 DCBMFSWA EQU DCBMF1WD 02948000 DCBMFDMD EQU DCBMFSWA 02949000 DCBDEBAD EQU IHADCS25+4 02950000 DCBIFLGS EQU DCBDEBAD 02951000 IHADCS26 EQU 0 02952000 DCBWRITE EQU IHADCS26 02953000 IHADCS27 EQU 0 02954000 DCBGET EQU IHADCS27 02955000 IHADCS36 EQU 0 02956000 DCBGERR EQU IHADCS36 02957000 DCBPERR EQU DCBGERR 02958000 DCBCHECK EQU DCBPERR 02959000 DCBOPTCD EQU DCBCHECK 02960000 DCBOPTH EQU DCBOPTCD 02961000 DCBOPTO EQU DCBOPTH 02962000 DCBOPTZ EQU DCBOPTCD 02963000 DCBGERRA EQU DCBCHECK+1 02964000 DCBPERRA EQU DCBGERRA 02965000 DCBSYNAD EQU IHADCS36+4 02966000 DCBCIND1 EQU IHADCS36+8 02967000 DCBCIND2 EQU IHADCS36+9 02968000 DCBCICB EQU IHADCS36+20 02969000 IHADCS52 EQU 0 02970000 DCBDIRCT EQU IHADCS52 02971000 DCBQSWS EQU DCBDIRCT 02972000 DCBUSASI EQU DCBQSWS 02973000 DCBQADFS EQU DCBUSASI 02974000 DCBBUFOF EQU DCBDIRCT+1 02975000 IHADCS38 EQU 0 02976000 DCBEOBR EQU IHADCS38 02977000 DCBPOINT EQU IHADCS38+12 02978000 DCBCNTRL EQU DCBPOINT 02979000 IHADCS40 EQU 0 02980000 DCBEOBAD EQU IHADCS40 02981000 DCBCCCW EQU IHADCS40+4 02982000 DCBRECAD EQU DCBCCCW 02983000 DCBRECBT EQU DCBRECAD 02984000 DCBRCREL EQU DCBRECBT 02985000 @NM00080 EQU IHADCS40+12 02986000 DCBEROPT EQU @NM00080 02987000 PARMLIST EQU 0 02988000 PLLEN EQU PARMLIST 02989000 PDATA EQU PARMLIST+2 02990000 BLDLCCA EQU CCALKED 02991000 IOPMOCDS EQU IOPUDATA 02992000 IOPLMCDS EQU IOPUDATA 02993000 IOPFLGS2 EQU IOPLMCDS 02994000 IOPFLGS3 EQU IOPLMCDS+1 02995000 IOPMACDS EQU IOPUDATA 02996000 IOPPTCDS EQU IOPUDATA 02997000 IOPFLGS5 EQU IOPPTCDS 02998000 IOPSTAT EQU IOPFLGS5 02999000 IOPDATE EQU IOPPTCDS+1 03000000 IOPPNTRY EQU IOPPTCDS+4 03001000 IOPDLCDS EQU IOPUDATA 03002000 IOPSYCDS EQU IOPUDATA 03003000 IOPFLGS7 EQU IOPSYCDS 03004000 IOPTSO EQU IOPFLGS7 03005000 IOPSREL EQU IOPSYCDS+1 03006000 IOPNUCID EQU IOPSYCDS+5 03007000 IOPPEMAX EQU IOPSYCDS+6 03008000 IOPSTCMP EQU IOPUDATA 03009000 IOPPTSNT EQU IOPUDATA 03010000 IOPPFLG1 EQU IOPPTSNT 03011000 IOPPLEPR EQU IOPPTSNT+1 03012000 IOPPNUM EQU IOPPTSNT+2 03013000 AGO .@UNREFD START UNREFERENCED COMPONENTS 03014000 IOPALISL EQU IOPPTSNT+22 03015000 IOPINDLB EQU IOPPTSNT+14 03016000 IOPDISTN EQU IOPPTSNT+7 03017000 IOPPDIG EQU IOPPNUM+2 03018000 IOPPID EQU IOPPNUM 03019000 IOPPNE EQU IOPPLEPR 03020000 IOPPDC EQU IOPPLEPR 03021000 IOPPREFR EQU IOPPLEPR 03022000 IOPPOVLY EQU IOPPLEPR 03023000 IOPPSCTR EQU IOPPLEPR 03024000 IOPPREUS EQU IOPPLEPR 03025000 IOPPRENT EQU IOPPLEPR 03026000 @NM00023 EQU IOPPLEPR 03027000 @NM00022 EQU IOPPFLG1 03028000 IOPLEFND EQU IOPPFLG1 03029000 IOPDALIS EQU IOPPFLG1 03030000 IOPTALIS EQU IOPPFLG1 03031000 IOPLIBTX EQU IOPPFLG1 03032000 IOPLIBLK EQU IOPPFLG1 03033000 IOPSTNEW EQU IOPSTCMP+8 03034000 IOPSTOLD EQU IOPSTCMP 03035000 IOPPDLM EQU IOPSYCDS+8 03036000 @NM00021 EQU IOPFLGS7 03037000 IOPDSYS EQU IOPDLCDS 03038000 IOPPIND EQU IOPPNTRY+8 03039000 IOPPMODS EQU IOPPNTRY 03040000 @NM00020 EQU IOPFLGS5 03041000 IOPDUMMP EQU IOPSTAT 03042000 IOPFORCE EQU IOPSTAT 03043000 IOPACC EQU IOPSTAT 03044000 IOPAPP EQU IOPSTAT 03045000 IOPASMOD EQU IOPMACDS+2 03046000 @NM00019 EQU IOPMACDS 03047000 IOPSYSLB EQU IOPLMCDS+2 03048000 @NM00018 EQU IOPFLGS3 03049000 IOPCHREP EQU IOPFLGS3 03050000 IOPLINK EQU IOPFLGS3 03051000 IOPCOPY EQU IOPFLGS3 03052000 IOPNE EQU IOPFLGS2 03053000 IOPDC EQU IOPFLGS2 03054000 IOPREFR EQU IOPFLGS2 03055000 IOPOVLY EQU IOPFLGS2 03056000 IOPSCTR EQU IOPFLGS2 03057000 IOPREUS EQU IOPFLGS2 03058000 IOPRENT EQU IOPFLGS2 03059000 @NM00017 EQU IOPFLGS2 03060000 IOPLMODS EQU IOPMOCDS+9 03061000 IOPDLIB EQU IOPMOCDS+2 03062000 IOPMODID EQU IOPMOCDS 03063000 DCBEOB EQU IHADCS40+20 03064000 DCBPRECL EQU IHADCS40+18 03065000 @NM00083 EQU IHADCS40+16 03066000 @NM00082 EQU @NM00080+1 03067000 @NM00081 EQU DCBEROPT 03068000 DCBERABE EQU DCBEROPT 03069000 DCBERSKP EQU DCBEROPT 03070000 DCBERACC EQU DCBEROPT 03071000 @NM00079 EQU IHADCS40+10 03072000 @NM00078 EQU IHADCS40+9 03073000 @NM00077 EQU IHADCS40+8 03074000 DCBRECA EQU DCBRECAD+1 03075000 @NM00076 EQU DCBRECBT 03076000 DCBRCFGT EQU DCBRCREL 03077000 DCBRCTRU EQU DCBRCREL 03078000 DCBLCCW EQU DCBEOBAD 03079000 DCBNOTE EQU DCBCNTRL 03080000 DCBLRECL EQU IHADCS38+10 03081000 @NM00075 EQU IHADCS38+8 03082000 DCBEOBW EQU IHADCS38+4 03083000 DCBEOBRA EQU DCBEOBR+1 03084000 DCBNCP EQU DCBEOBR 03085000 DCBDIRCQ EQU DCBBUFOF 03086000 DCBQSTRU EQU DCBUSASI 03087000 @NM00074 EQU DCBUSASI 03088000 DCBQADF3 EQU DCBQADFS 03089000 DCBQADF2 EQU DCBQADFS 03090000 DCBQADF1 EQU DCBQADFS 03091000 DCBBLBP EQU DCBUSASI 03092000 @NM00073 EQU DCBUSASI 03093000 DCBCICBA EQU DCBCICB+1 03094000 @NM00072 EQU DCBCICB 03095000 DCBIOBA EQU IHADCS36+16 03096000 DCBOFFSW EQU IHADCS36+15 03097000 DCBOFFSR EQU IHADCS36+14 03098000 DCBWCPL EQU IHADCS36+13 03099000 DCBWCPO EQU IHADCS36+12 03100000 DCBBLKSI EQU IHADCS36+10 03101000 DCBCNQSM EQU DCBCIND2 03102000 DCBCNFEO EQU DCBCIND2 03103000 DCBCNCHS EQU DCBCIND2 03104000 DCBCNBFP EQU DCBCIND2 03105000 DCBCNIOE EQU DCBCIND2 03106000 DCBCNCLO EQU DCBCIND2 03107000 DCBCNWRO EQU DCBCIND2 03108000 DCBCNSTO EQU DCBCIND2 03109000 DCBCNEXB EQU DCBCIND1 03110000 @NM00071 EQU DCBCIND1 03111000 DCBCNBRM EQU DCBCIND1 03112000 @NM00070 EQU DCBCIND1 03113000 DCBCNEVA EQU DCBCIND1 03114000 DCBCNEVB EQU DCBCIND1 03115000 DCBCNSRD EQU DCBCIND1 03116000 DCBCNTOV EQU DCBCIND1 03117000 DCBSYNA EQU DCBSYNAD+1 03118000 DCBIOBL EQU DCBSYNAD 03119000 DCBCHCKA EQU DCBPERRA 03120000 @NM00069 EQU DCBOPTCD 03121000 DCBOPTT EQU DCBOPTCD 03122000 DCBSRCHD EQU DCBOPTZ 03123000 DCBOPTQ EQU DCBOPTCD 03124000 DCBBCKPT EQU DCBOPTO 03125000 DCBOPTC EQU DCBOPTCD 03126000 DCBOPTU EQU DCBOPTCD 03127000 DCBOPTW EQU DCBOPTCD 03128000 DCBPUT EQU DCBGET 03129000 DCBREAD EQU DCBWRITE 03130000 DCBDEBA EQU DCBDEBAD+1 03131000 @NM00068 EQU DCBIFLGS 03132000 DCBIFIOE EQU DCBIFLGS 03133000 DCBIFPCT EQU DCBIFLGS 03134000 DCBIFEC EQU DCBIFLGS 03135000 DCBMFSTI EQU DCBMFDMD 03136000 DCBMFAWR EQU DCBMFSTK 03137000 DCBMFUIP EQU DCBMFTMD 03138000 DCBMFIDW EQU DCBMFLCP 03139000 DCBMFWRK EQU DCBMFMVP 03140000 DCBMFRDQ EQU DCBMFWRT 03141000 DCBMFGTQ EQU DCBMFPUT 03142000 DCBMFSTL EQU DCBMACF2 03143000 DCBMFCK EQU DCBMFDMG 03144000 DCBMFRDX EQU DCBMFCHK 03145000 DCBMFDBF EQU DCBMFSBG 03146000 DCBMFRDI EQU DCBMFLCG 03147000 DCBMFRDK EQU DCBMFMVG 03148000 DCBMFWRQ EQU DCBMFRD 03149000 DCBMFPTQ EQU DCBMFGET 03150000 DCBMFECP EQU DCBMACF1 03151000 DCBTIOT EQU IHADCS25 03152000 DCBMRSTI EQU DCBMRDMD 03153000 DCBMRAWR EQU DCBMRSTK 03154000 DCBMRUIP EQU DCBMRTMD 03155000 DCBMRIDW EQU DCBMRLCP 03156000 DCBMRWRK EQU DCBMRMVP 03157000 DCBMRRDQ EQU DCBMRWRT 03158000 DCBMRGTQ EQU DCBMRPUT 03159000 DCBMRSTL EQU DCBMACR2 03160000 DCBMRCK EQU DCBMRDMG 03161000 DCBPGFXA EQU DCBMRRDX 03162000 DCBMRDBF EQU DCBMRSBG 03163000 DCBMRRDI EQU DCBMRLCG 03164000 DCBMRRDK EQU DCBMRMVG 03165000 DCBMRWRQ EQU DCBMRRD 03166000 DCBMRPTQ EQU DCBMRGET 03167000 DCBMRECP EQU DCBMACR1 03168000 @NM00067 EQU DCBIFLG 03169000 DCBIBIOE EQU DCBIFLG 03170000 DCBIBPCT EQU DCBIFLG 03171000 DCBIBEC EQU DCBIFLG 03172000 DCBOFIOF EQU DCBOFLGS 03173000 DCBOFUEX EQU DCBOFLGS 03174000 DCBOFTM EQU DCBOFLGS 03175000 DCBOFPPC EQU DCBOFLGS 03176000 DCBOFEOV EQU DCBOFLGS 03177000 DCBOFLRB EQU DCBOFLGS 03178000 DCBOFIOD EQU DCBOFLWR 03179000 DCBEXLSA EQU DCBEXLST+1 03180000 DCBRECKL EQU DCBRECFM 03181000 DCBRECCC EQU DCBRECFM 03182000 DCBRECSB EQU DCBRECFM 03183000 DCBRECBR EQU DCBRECFM 03184000 DCBRECTO EQU DCBRECLA 03185000 DCBRECL EQU DCBRECLA 03186000 DCBEODA EQU DCBEODAD+1 03187000 DCBBFA EQU DCBBFTEK 03188000 DCBH0 EQU DCBBFTEK 03189000 DCBBFTKD EQU DCBBFTEK 03190000 DCBBFTE EQU DCBBFT 03191000 DCBBFTKR EQU DCBBFT 03192000 DCBBFTS EQU DCBBFT 03193000 DCBH1 EQU DCBBFTEK 03194000 DCBSVCXA EQU DCBSVCXL+1 03195000 @NM00066 EQU DCBSVCXL 03196000 DCBODEBA EQU DCBIOBAA 03197000 @NM00065 EQU DCBQSLM 03198000 DCBUPDBT EQU DCBQSLM 03199000 DCBUPDCM EQU DCBQSLM 03200000 DCB1DVDS EQU DCBQSLM 03201000 @NM00064 EQU DCBDSRG2 03202000 DCBACBM EQU DCBDSRG2 03203000 @NM00063 EQU DCBDSRG2 03204000 DCBDSGTQ EQU DCBDSRG2 03205000 DCBDSGTX EQU DCBDSRG2 03206000 DCBDSGGS EQU DCBDSRG2 03207000 DCBDSGU EQU DCBDSRG1 03208000 DCBDSGPO EQU DCBDSRG1 03209000 DCBDSGMQ EQU DCBDSRG1 03210000 DCBDSGCQ EQU DCBDSRG1 03211000 DCBDSGCX EQU DCBDSRG1 03212000 DCBDSGDA EQU DCBDSRG1 03213000 DCBDSGPS EQU DCBDSRG1 03214000 DCBDSGIS EQU DCBDSRG1 03215000 DCBBUFL EQU IHADCS11+8 03216000 DCBBUFCA EQU DCBBUFCB+1 03217000 DCBBUFNO EQU DCBBUFCB 03218000 DCBDEVT EQU DCBREL 03219000 DCBKEYLE EQU DCBRELB 03220000 DCBTRBAL EQU IHADCS01+6 03221000 @NM00062 EQU IHADCS01+5 03222000 @NM00061 EQU IHADCS01+4 03223000 DCBDVTBA EQU DCBDVTBL+1 03224000 @NM00060 EQU DCBDVTBL 03225000 DCBKEYCN EQU IHADCS00+4 03226000 DCBRELAD EQU IHADCS00 03227000 @NM00059 EQU IHADCB 03228000 JFCBEND EQU JFCUCSEG+68 03229000 JFCBSPTN EQU JFCUCSEG+67 03230000 JFCBVLCT EQU JFCUCSEG+66 03231000 JFCBDRLH EQU JFCUCSEG+63 03232000 JFCBSBNM EQU JFCUCSEG+60 03233000 JFCBABST EQU JFCUCSEG+58 03234000 JFCBSPNM EQU JFCUCSEG+55 03235000 JFCBDQTY EQU JFCUCSEG+52 03236000 @NM00058 EQU JFCUCSEG+51 03237000 JFCBSQTY EQU JFCUCSEG+48 03238000 JFCROUND EQU JFCBCTRI 03239000 JFCALX EQU JFCBCTRI 03240000 JFCMIXG EQU JFCBCTRI 03241000 JFCONTIG EQU JFCBCTRI 03242000 @NM00057 EQU JFCBCTRI 03243000 @NM00056 EQU JFCBCTRI 03244000 JFCBSPAC EQU JFCBCTRI 03245000 JFCBPQTY EQU JFCUCSEG+44 03246000 JFCBEXAD EQU JFCUCSEG+41 03247000 JFCBEXTL EQU JFCUCSEG+40 03248000 JFCBVOLS EQU JFCUCSEG+10 03249000 JFCBNVOL EQU JFCUCSEG+9 03250000 JFCBNTCS EQU JFCUCSEG+8 03251000 JFCSOWA EQU JFCUCSEG+6 03252000 @NM00055 EQU JFCCPRI 03253000 JFCRECV EQU JFCCPRI 03254000 JFCEQUAL EQU JFCCPRI 03255000 JFCSEND EQU JFCCPRI 03256000 @NM00054 EQU JFCUCSOP 03257000 JFCFCBVR EQU JFCUCSOP 03258000 JFCFCBAL EQU JFCUCSOP 03259000 JFCVER EQU JFCUCSOP 03260000 @NM00053 EQU JFCUCSOP 03261000 JFCFOLD EQU JFCUCSOP 03262000 @NM00052 EQU JFCUCSOP 03263000 JFCUCSID EQU JFCUCSEG 03264000 JFCINTVL EQU JFCSPPRT+19 03265000 JFCDBUFN EQU JFCSPPRT+18 03266000 JFCCYLOF EQU JFCSPPRT+17 03267000 JFCRESRV EQU JFCRKP 03268000 JFCPCIR2 EQU JFCPCI 03269000 JFCPCIR1 EQU JFCPCI 03270000 JFCPCIN2 EQU JFCPCI 03271000 JFCPCIN1 EQU JFCPCI 03272000 JFCPCIA2 EQU JFCPCI 03273000 JFCPCIA1 EQU JFCPCI 03274000 JFCPCIX2 EQU JFCPCI 03275000 JFCPCIX1 EQU JFCPCI 03276000 JFCBUFMX EQU JFCNCP 03277000 JFCLRECL EQU JFCSPPRT+11 03278000 JFCBUFSI EQU JFCBLKSI 03279000 JFCREL EQU JFCREORG 03280000 @NM00050 EQU JFCDEL 03281000 JFCSRCHD EQU @NM00048 03282000 JFCOPTQ EQU JFCACT 03283000 JFCFEED EQU JFCIND 03284000 JFCCBWU EQU JFCEXT 03285000 JFCWUMSG EQU JFCOVER 03286000 JFCSDNAM EQU JFCWVCBD 03287000 @NM00044 EQU JFCRECFM 03288000 JFCCHAR EQU JFCRECFM 03289000 JFCRFS EQU JFCRECFM 03290000 JFCRFB EQU JFCRECFM 03291000 JFCRFO EQU JFCFMRC 03292000 JFCFMREC EQU JFCFMRC 03293000 @NM00043 EQU JFCDSRG2 03294000 JFCORGGS EQU JFCDSRG2 03295000 JFCORGU EQU JFCDSRG1 03296000 JFCORGPO EQU JFCDSRG1 03297000 @NM00042 EQU JFCDSRG1 03298000 JFCORGDA EQU JFCDSRG1 03299000 JFCORGPS EQU JFCDSRG1 03300000 JFCORGIS EQU JFCDSRG1 03301000 JFCTRKBL EQU JFCLIMCT+1 03302000 @NM00041 EQU JFCLIMCT 03303000 JFCDEN EQU JFCSPPRT+1 03304000 JFCPRTSP EQU JFCSPPRT 03305000 JFCONE EQU JFCMODE 03306000 JFCTWO EQU JFCMODE 03307000 @NM00040 EQU JFCMODE 03308000 JFCMODER EQU JFCMODE 03309000 JFCMODEO EQU JFCMODE 03310000 JFCEBCD EQU JFCMODE 03311000 JFCBIN EQU JFCMODE 03312000 @NM00039 EQU JFCCODE 03313000 JFCTTY EQU JFCCODE 03314000 JFCASCII EQU JFCCODE 03315000 JFCNCR EQU JFCCODE 03316000 JFCBUR EQU JFCCODE 03317000 JFCFRI EQU JFCCODE 03318000 JFCBCD EQU JFCCODE 03319000 JFCNOCON EQU JFCCODE 03320000 @NM00038 EQU JFCEROPT 03321000 JFCABN EQU JFCEROPT 03322000 JFCSKP EQU JFCEROPT 03323000 JFCACC EQU JFCEROPT 03324000 JFCBUFL EQU INFMJFCB+90 03325000 JFCFWORD EQU JFCBFTEK 03326000 JFCDWORD EQU JFCBFTEK 03327000 JFCHIER1 EQU JFCBFTEK 03328000 JFCDYN EQU JFCBFTEK 03329000 JFCEXC EQU JFCBFTEK 03330000 JFCSIM EQU JFCBFTEK 03331000 JFCBUFRQ EQU JFCBFOUT 03332000 JFCTEMP EQU JFCBIND2 03333000 JFCREQ EQU JFCBIND2 03334000 JFCENT EQU JFCBIND2 03335000 JFCSHARE EQU JFCBIND2 03336000 JFCSECUR EQU JFCBIND2 03337000 JFCDISP EQU JFCBIND2 03338000 JFCPDS EQU JFCBIND1 03339000 JFCGDG EQU JFCBIND1 03340000 JFCADDED EQU JFCBIND1 03341000 JFCLOC EQU JFCBIND1 03342000 JFCRLSE EQU JFCBIND1 03343000 JFCBXPDT EQU INFMJFCB+83 03344000 JFCBCRDT EQU INFMJFCB+80 03345000 JFCBOPS2 EQU JFCBMASK+7 03346000 JFCRCTLG EQU JFCBFLG2 03347000 JFCBBUFF EQU JFCBFLG2 03348000 JFCTRACE EQU JFCBFLG2 03349000 JFCSDRPS EQU JFCBFLG2 03350000 JFCMODNW EQU JFCBFLG2 03351000 JFCDEFER EQU JFCBFLG2 03352000 JFCOUTOP EQU JFCBFLG2 03353000 JFCINOP EQU JFCBFLG2 03354000 JFCOPEN EQU JFCBFLG1 03355000 JFCDUAL EQU JFCBFLG1 03356000 JFCSLDES EQU JFCBFLG1 03357000 JFCSLCRE EQU JFCBFLG1 03358000 JFCSTAND EQU JFCBFLG1 03359000 JFCBPTTR EQU JFCBOPS1+4 03360000 @NM00037 EQU JFCBOPS1+4 03361000 @NM00036 EQU JFCBOPS1 03362000 JFCBVLSQ EQU INFMJFCB+70 03363000 @NM00035 EQU JFCFUNC 03364000 JFCFNCBT EQU JFCFUNC 03365000 JFCFNCBX EQU JFCFUNC 03366000 JFCFNCBD EQU JFCFUNC 03367000 JFCFNCBW EQU JFCFUNC 03368000 JFCFNCBP EQU JFCFUNC 03369000 JFCFNCBR EQU JFCFUNC 03370000 JFCFNCBI EQU JFCFUNC 03371000 JFCBFOFL EQU JFCBUFOF 03372000 JFCNL EQU JFCBLTYP 03373000 JFCSL EQU JFCBLTYP 03374000 JFCNSL EQU JFCBLTYP 03375000 JFCSUL EQU JFCBLTYP 03376000 JFCBLP EQU JFCBLTYP 03377000 JFCBLTM EQU JFCBLTYP 03378000 JFCBAL EQU JFCBLTYP 03379000 @NM00034 EQU JFCBLTYP 03380000 @NM00033 EQU JFCBSYSC+7 03381000 JFCFCBID EQU JFCBSYSC+3 03382000 JFCBDSCB EQU JFCBSYSC 03383000 JFCPAT EQU JFCBTSDM 03384000 JFCNDCB EQU JFCBTSDM 03385000 JFCNDSCB EQU JFCBTSDM 03386000 JFCNWRIT EQU JFCBTSDM 03387000 JFCTTR EQU JFCBTSDM 03388000 JFCSDS EQU JFCBTSDM 03389000 JFCVSL EQU JFCBTSDM 03390000 JFCCAT EQU JFCBTSDM 03391000 JFCIPLTX EQU JFCBELNM 03392000 JFCBQNAM EQU JFCBDSNM 03393000 ICTIXL EQU ICTIXLF 03394000 ICTLTTR EQU ICTLMOD+27 03395000 ICTTG2 EQU ICTTGLIB+8 03396000 ICTTG1 EQU ICTTGLIB 03397000 ICTLCPL EQU ICTLIFLG 03398000 ICTLNOGO EQU ICTLIFLG 03399000 ICTLPROC EQU ICTLIFLG 03400000 ICTLALIS EQU ICTLIFLG 03401000 @NM00032 EQU ICTLIFLG 03402000 ICTINCLD EQU ICTLIFLG 03403000 ICTTIND2 EQU ICTTGIND 03404000 ICTTIND1 EQU ICTTGIND 03405000 @NM00031 EQU ICTLFLG2 03406000 ICTLINK EQU ICTLFLG2 03407000 ICTCOPY EQU ICTLFLG2 03408000 ICTNE EQU ICTLFLG1 03409000 ICTDC EQU ICTLFLG1 03410000 ICTREFR EQU ICTLFLG1 03411000 ICTOVLY EQU ICTLFLG1 03412000 ICTSCTR EQU ICTLFLG1 03413000 ICTREUS EQU ICTLFLG1 03414000 ICTRENT EQU ICTLFLG1 03415000 @NM00030 EQU ICTLFLG1 03416000 ICTLEND EQU ICTLMNAM 03417000 ICTIXM EQU ICTIXMF 03418000 ICTPPTR EQU ICTMOD+21 03419000 ICTFMLIB EQU ICTMOD+13 03420000 ICTMID EQU ICTMOD+11 03421000 ICTMPRMS EQU ICTMLEPR 03422000 ICTMCPL EQU ICTMIFLG 03423000 ICTCRLIB EQU ICTMIFLG 03424000 ICTMNOGO EQU ICTMIFLG 03425000 ICTMIS EQU ICTMIFLG 03426000 ICTNOM EQU ICTMIFLG 03427000 ICTMZAP EQU ICTMIFLG 03428000 ICTMMAC EQU ICTMIFLG 03429000 ICTMPROC EQU ICTMIFLG 03430000 @NM00029 EQU ICTMFLG1 03431000 ICTMALIS EQU ICTMFLG1 03432000 ICTLIBTX EQU ICTMFLG1 03433000 ICTLIBLK EQU ICTMFLG1 03434000 ICTMEND EQU ICTMNAME 03435000 ICTIXP EQU ICTIXPF 03436000 ICTPCPL EQU ICTPIFLG 03437000 ICTPLNK EQU ICTPIFLG 03438000 ICTPNOGO EQU ICTPIFLG 03439000 ICTFORCE EQU ICTPIFLG 03440000 ICTPROCS EQU ICTPIFLG 03441000 ICTZAP EQU ICTPIFLG 03442000 ICTPMAC EQU ICTPIFLG 03443000 @NM00028 EQU ICTPIFLG 03444000 @NM00027 EQU ICTPFLG1 03445000 ICTDUMMP EQU ICTPFLG1 03446000 ICTFREC EQU ICTPFLG1 03447000 ICTACC EQU ICTPFLG1 03448000 ICTAPP EQU ICTPFLG1 03449000 ICTPNO EQU ICTPTFS+2 03450000 ICTPEND EQU ICTPMID 03451000 ICTLEN EQU ICTSPLEN+1 03452000 ICTSP EQU ICTSPLEN 03453000 PRLCONC EQU PRLTIME+2 03454000 @NM00026 EQU PRLTIME 03455000 PRLHDADR EQU PRLDATE 03456000 @NM00025 EQU PRLFLGS 03457000 @NM00024 EQU SEFLAGS 03458000 IOPUSERL EQU HMASMIOP+19 03459000 IOPCDTYP EQU IOPTYPE 03460000 .@UNREFD ANOP END UNREFERENCED COMPONENTS 03461000 @RT00249 EQU FINAL 03462000 @RT00354 EQU FINAL 03463000 @RT00384 EQU FINAL 03464000 @RF00384 EQU CLEANUP 03465000 @RT00391 EQU BADEND 03466000 @RT00399 EQU BADEND 03467000 @RT00435 EQU BADEND 03468000 @RT00443 EQU BADEND 03469000 @RT00458 EQU BADEND 03470000 @RT00465 EQU BADEND 03471000 @RT00470 EQU BADEND 03472000 @RF00470 EQU CLEANUP 03473000 @RT00519 EQU DRVSCAN 03474000 @RC00598 EQU @EL00006 03475000 @RC00607 EQU @EL00007 03476000 @RF00606 EQU @EL00007 03477000 @RC00646 EQU @EL00009 03478000 @RC00654 EQU @EL00010 03479000 @RC00662 EQU @EL00011 03480000 @RC00671 EQU @EL00012 03481000 @RT00742 EQU @EL00017 03482000 @PB00019 EQU @EL00001 03483000 @PB00018 EQU @PB00019 03484000 @PB00017 EQU @PB00018 03485000 @PB00016 EQU @PB00017 03486000 @PB00015 EQU @PB00016 03487000 @PB00014 EQU @PB00015 03488000 @PB00013 EQU @PB00014 03489000 @PB00012 EQU @PB00013 03490000 @PB00011 EQU @PB00012 03491000 @PB00010 EQU @PB00011 03492000 @PB00009 EQU @PB00010 03493000 @PB00008 EQU @PB00009 03494000 @PB00007 EQU @PB00008 03495000 @PB00006 EQU @PB00007 03496000 @PB00005 EQU @PB00006 03497000 @PB00004 EQU @PB00005 03498000 @PB00003 EQU @PB00004 03499000 @PB00002 EQU @PB00003 03500000 @ENDDATA EQU * 03501000 END HMASMDRV 03502000 ./ ADD SSI=40141109,NAME=HMASMEXT,SOURCE=1 COMPON=DN611 TITLE 'HMASMEXT - DUMMY SMP USER EXIT - RECEIVE *00001000 ' 00002000 HMASMEXT CSECT , 0001 00003000 @PROLOG DS 0H 0002 00004000 * RETURN CODE(ZERO); /* RETURN TO RECEIVE VERB */ 00005000 SLR @15,@15 0003 00006000 @EL00001 DS 0H 0003 00007000 @EF00001 DS 0H 0003 00008000 @ER00001 BR @14 0003 00009000 * END HMASMEXT; 0004 00010000 @DATA DS 0H 00011000 DS 0F 00012000 DS 0F 00013000 DS 0D 00014000 @00 EQU 00 EQUATES FOR REGISTERS 0-15 00015000 @01 EQU 01 00016000 @02 EQU 02 00017000 @03 EQU 03 00018000 @04 EQU 04 00019000 @05 EQU 05 00020000 @06 EQU 06 00021000 @07 EQU 07 00022000 @08 EQU 08 00023000 @09 EQU 09 00024000 @10 EQU 10 00025000 @11 EQU 11 00026000 @12 EQU 12 00027000 @13 EQU 13 00028000 @14 EQU 14 00029000 @15 EQU 15 00030000 @ENDDATA EQU * 00031000 END HMASMEXT 00032000 ./ ADD SSI=40141111,NAME=HMASMIC,SOURCE=1 COMPON=DN611 TITLE 'HMASMIC - INCORE STOW/BLDL ROUTINE OF SMP *00001000 ' 00002000 HMASMIC CSECT , 0001 00003000 @MAINENT DS 0H 0001 00004000 USING *,@15 0001 00005000 B @PROLOG 0001 00006000 DC AL2(@EP00001-@MAINENT) 00007000 DC AL1(16) 0001 00008000 DC C'HMASMIC 74.014' 0001 00009000 HMASMICI DS 0H 0001 00010000 USING *,@15 0001 00011000 B @PROLOG 0001 00012000 DC AL2(@EP00105-HMASMICI) 00013000 ENTRY HMASMICI 00014000 HMASMICB DS 0H 0001 00015000 USING *,@15 0001 00016000 B @PROLOG 0001 00017000 DC AL2(@EP00141-HMASMICB) 00018000 ENTRY HMASMICB 00019000 HMASMICS DS 0H 0001 00020000 USING *,@15 0001 00021000 B @PROLOG 0001 00022000 DC AL2(@EP00153-HMASMICS) 00023000 ENTRY HMASMICS 00024000 HMASMICC DS 0H 0001 00025000 USING *,@15 0001 00026000 B @PROLOG 0001 00027000 DC AL2(@EP00171-HMASMICC) 00028000 ENTRY HMASMICC 00029000 DROP @15 00030000 @PROLOG STM @14,@12,12(@13) 0001 00031000 BALR @12,0 0001 00032000 @PSTART DS 0H 0001 00033000 USING @PSTART,@12 0001 00034000 ST @13,@SA00001+4 0001 00035000 LA @14,@SA00001 0001 00036000 ST @14,8(,@13) 0001 00037000 LR @13,@14 0001 00038000 AH @15,4(,@15) 0001 00039000 BR @15 0001 00040000 @EP00001 DS 0H 0002 00041000 * */ 00042000 * 0105 00043000 * /*****************************************************************/ 00044000 * /* */ 00045000 * /* ENTER HERE TO INITIALIZE THE INCORE DIRECTORY */ 00046000 * /* */ 00047000 * /*****************************************************************/ 00048000 * 0105 00049000 *HMASMICI: 0105 00050000 * ENTRY; 0105 00051000 @EP00105 DS 0H 0106 00052000 * MGPMGNO2=ZERO; /* ZERO SECONDARY */ 00053000 MVI MGPMGNO2,X'00' 0106 00054000 * MGPMGNO3=ZERO; /* ZERO TERTIARY */ 00055000 MVI MGPMGNO3,X'00' 0107 00056000 * MGPFLAGS=ZERO; /* ZERO THE FLAGS */ 00057000 MVI MGPFLAGS,X'00' 0108 00058000 * MGPPRINT=ON; /* INDICATE PRINTER */ 00059000 OI MGPPRINT,B'10000000' 0109 00060000 * GEN(GETMAIN VC,LA=RANGE,A=DIRADDR);/* GET CORE FOR DIRECTORY */ 00061000 GETMAIN VC,LA=RANGE,A=DIRADDR 00062000 * IF DIRSIZEOF /* WAS THERE AN I/O ERROR? */ 00153000 * THEN /* YES - ERROR RETURN */ 00154000 L @14,IOPPTR 0131 00155000 CLI IOPRETRN(@14),4 0131 00156000 BNH @RF00131 0131 00157000 * DO; 0132 00158000 * GEN(FREEMAIN V,A=DIRADDR); /* FREE DIRECTORY */ 00159000 FREEMAIN V,A=DIRADDR 00160000 * RETURN CODE(BADO); /* RETURN TO CALLER */ 00161000 LA @15,4 0134 00162000 L @13,4(,@13) 0134 00163000 L @14,12(,@13) 0134 00164000 LM @00,@12,20(@13) 0134 00165000 BR @14 0134 00166000 * END; 0135 00167000 * DSKEND=I-1; /* SET END OF DIRECTORY VALUE */ 00168000 @RF00131 LR @14,I 0136 00169000 BCTR @14,0 0136 00170000 ST @14,DSKEND 0136 00171000 * IOPFUNCT=IOPCLOSE; /* INDICATE CLOSE OPERATION */ 00172000 L @14,IOPPTR 0137 00173000 MVI IOPFUNCT(@14),X'04' 0137 00174000 * CALL HMASMIO(HMASMIOP); /* CLOSE DIRECTORY DATA SET */ 00175000 ST @14,@AL00001 0138 00176000 L @15,@CV00300 0138 00177000 LA @01,@AL00001 0138 00178000 BALR @14,@15 0138 00179000 * CCAICSB=ON; /* INDICATE GOING IN-CORE */ 00180000 OI CCAICSB(CCAPTR),B'00000010' 0139 00181000 * RETURN CODE(GOOD); /* RETURN TO CALLER 0140 00182000 * */ 00183000 SLR @15,@15 0140 00184000 L @13,4(,@13) 0140 00185000 L @14,12(,@13) 0140 00186000 LM @00,@12,20(@13) 0140 00187000 BR @14 0140 00188000 * 0141 00189000 * /*****************************************************************/ 00190000 * /* */ 00191000 * /* ENTER HERE FOR BLDL OPERATIONS */ 00192000 * /* */ 00193000 * /*****************************************************************/ 00194000 * 0141 00195000 *HMASMICB: 0141 00196000 * ENTRY(BLDLLIST); 0141 00197000 @EP00141 MVC @PC00001(4),0(@01) 0141 00198000 * INPNAME=BLDLNAME; /* SAVE NAME FOR SEARCH */ 00199000 L @14,@PC00001 0142 00200000 MVC INPNAME(8),BLDLNAME(@14) 0142 00201000 * CALL MEMLOC; /* LOCATE MEMBER IN DIRECTORY */ 00202000 BAL @14,MEMLOC 0143 00203000 * IF RTNCODE=FOUND /* IS MEMBER FOUND? */ 00204000 * THEN /* YES - PASS BACK INCORE NTRY */ 00205000 SLR @14,@14 0144 00206000 CR RTNCODE,@14 0144 00207000 BNE @RF00144 0144 00208000 * DO; 0145 00209000 * BLDLTTR=STWARTTR(I); /* PASS TTR TO REQUESTOR */ 00210000 L @10,@PC00001 0146 00211000 L @09,DIRADDR 0146 00212000 LR @08,I 0146 00213000 MH @08,@CH00246 0146 00214000 ST @08,@TF00001 0146 00215000 ALR @08,@09 0146 00216000 AL @08,@CF00410 0146 00217000 MVC BLDLTTR(3,@10),STWARTTR-8(@08) 0146 00218000 * UDATLEN=(STWARUL(I)&NOALIAS)*2;/* CALC USER DATA LENGTH */ 00219000 L @08,@TF00001 0147 00220000 AL @08,@CF00411 0147 00221000 SLR @07,@07 0147 00222000 IC @07,STWARUL-11(@08,@09) 0147 00223000 LA UDATLEN,127 0147 00224000 NR UDATLEN,@07 0147 00225000 ALR UDATLEN,UDATLEN 0147 00226000 * BLDLULEN=STWARUL(I); /* PASS USER DATA LENGTH BACK */ 00227000 STC @07,BLDLULEN(,@10) 0148 00228000 * IF UDATLEN>ZERO /* IS THERE USER DATA? */ 00229000 * THEN /* YES - PASS IT BACK */ 00230000 CR UDATLEN,@14 0149 00231000 BNH @RF00149 0149 00232000 * BLDLUSER(1:UDATLEN)=STWARUS(I,1:UDATLEN);/* PASS USER DATA */ 00233000 LR @14,UDATLEN 0150 00234000 BCTR @14,0 0150 00235000 AL @09,@TF00001 0150 00236000 AL @09,@CF00412 0150 00237000 EX @14,@SM00413 0150 00238000 * END; 0151 00239000 @RF00149 DS 0H 0152 00240000 * RETURN CODE(RTNCODE); /* RETURN CODE TO REQUESTOR 0152 00241000 * */ 00242000 @RF00144 L @13,4(,@13) 0152 00243000 L @14,12(,@13) 0152 00244000 LM @00,@12,20(@13) 0152 00245000 BR @14 0152 00246000 * 0153 00247000 * /*****************************************************************/ 00248000 * /* */ 00249000 * /* ENTER HERE FOR STOW OPERATIONS. */ 00250000 * /* */ 00251000 * /*****************************************************************/ 00252000 * 0153 00253000 *HMASMICS: 0153 00254000 * ENTRY(STOWLIST); 0153 00255000 * 0153 00256000 @EP00153 MVC @PC00001+4(4),0(@01) 0153 00257000 * /*****************************************************************/ 00258000 * /* */ 00259000 * /* LOCATE BLOCK WHERE MEMBER OCCURS (OR SHOULD OCCUR) */ 00260000 * /* */ 00261000 * /*****************************************************************/ 00262000 * 0154 00263000 * INPNAME=STWNAME; /* PUT NAME FROM STOW LIST */ 00264000 L @14,@PC00001+4 0154 00265000 MVC INPNAME(8),STWNAME(@14) 0154 00266000 * CALL MEMLOC; /* IN LOCATE PARM LIST - LOC MEM */ 00267000 BAL @14,MEMLOC 0155 00268000 * IF RTNCODE=FOUND /* WAS MEMBER FOUND? */ 00269000 * THEN /* YES - REPLACE IN CORE */ 00270000 SLR @14,@14 0156 00271000 CR RTNCODE,@14 0156 00272000 BNE @RF00156 0156 00273000 * DO; 0157 00274000 * STWARRAY(I)=STOWLIST; /* REPLACE WITH NEW ENTRY */ 00275000 LR @10,I 0158 00276000 MH @10,@CH00246 0158 00277000 L @03,DIRADDR 0158 00278000 ALR @03,@10 0158 00279000 AL @03,@CF00415 0158 00280000 L @10,@PC00001+4 0158 00281000 MVC STWARRAY(74,@03),STOWLIST(@10) 0158 00282000 * RETURN CODE(GOOD); /* INDICATE SUCCESSFUL STOW */ 00283000 LR @15,@14 0159 00284000 L @13,4(,@13) 0159 00285000 L @14,12(,@13) 0159 00286000 LM @00,@12,20(@13) 0159 00287000 BR @14 0159 00288000 * END; 0160 00289000 * 0160 00290000 * /*****************************************************************/ 00291000 * /* */ 00292000 * /* MEMBER NOT FOUND IN CORE - ADD TO ARRAY VARIABLE I NOW POINTS */ 00293000 * /* TO ENTRY WHERE NEW ONE SHOULD GO */ 00294000 * /* */ 00295000 * /*****************************************************************/ 00296000 * 0161 00297000 * DO J=DIRTOP TO I BY-1; /* LOOP THROUGH ARRAY */ 00298000 @RF00156 L J,DIRTOP 0161 00299000 B @DE00161 0161 00300000 @DL00161 DS 0H 0162 00301000 * STWARRAY(J+1)=STWARRAY(J); /* SHIFT EVERYTHING UP ONE */ 00302000 L @14,DIRADDR 0162 00303000 LR @10,J 0162 00304000 MH @10,@CH00246 0162 00305000 ST @10,@TF00001 0162 00306000 ALR @10,@14 0162 00307000 AL @14,@TF00001 0162 00308000 AL @14,@CF00415 0162 00309000 MVC STWARRAY(74,@10),STWARRAY(@14) 0162 00310000 * END; 0163 00311000 BCTR J,0 0163 00312000 @DE00161 CR J,I 0163 00313000 BNL @DL00161 0163 00314000 * STWARRAY(I)=STOWLIST; /* ADD NEW ENTRY */ 00315000 LR @14,I 0164 00316000 MH @14,@CH00246 0164 00317000 L @10,DIRADDR 0164 00318000 ALR @10,@14 0164 00319000 AL @10,@CF00415 0164 00320000 L @14,@PC00001+4 0164 00321000 MVC STWARRAY(74,@10),STOWLIST(@14) 0164 00322000 * DIRTOP=DIRTOP+1; /* BUMP END OF DIRECTORY PTR */ 00323000 LA @14,1 0165 00324000 AL @14,DIRTOP 0165 00325000 ST @14,DIRTOP 0165 00326000 * IF DIRTOPZERO /* ARE THERE MEMBERS TO STOW? */ 00365000 * THEN /* YES - STOW THEM */ 00366000 L @14,DIRTOP 0172 00367000 LTR @14,@14 0172 00368000 BNP @RF00172 0172 00369000 * CALL STOW; /* STOW REMAINING ENTRIES */ 00370000 BAL @14,STOW 0173 00371000 * CCAICSB=OFF; /* NO MORE IN-CORE OPERATION */ 00372000 @RF00172 NI CCAICSB(CCAPTR),B'11111101' 0174 00373000 * GEN(FREEMAIN V,A=DIRADDR); /* FREE GOTTEN CORE */ 00374000 FREEMAIN V,A=DIRADDR 00375000 * RETURN CODE(RTNCODE); /* RETURN TO CALLER 0176 00376000 * */ 00377000 L @13,4(,@13) 0176 00378000 L @14,12(,@13) 0176 00379000 LM @00,@12,20(@13) 0176 00380000 BR @14 0176 00381000 * 0177 00382000 * /*****************************************************************/ 00383000 * /* */ 00384000 * /* THE FOLLOWING SUBROUTINE IS INVOKED TO LOCATE MEMBERS IN THE */ 00385000 * /* INCORE DIRECTORY. */ 00386000 * /* */ 00387000 * /*****************************************************************/ 00388000 * 0177 00389000 *MEMLOC: 0177 00390000 * PROCEDURE; 0177 00391000 @EL00001 L @13,4(,@13) 0177 00392000 @EF00001 DS 0H 0177 00393000 @ER00001 LM @14,@12,12(@13) 0177 00394000 BR @14 0177 00395000 @PB00001 DS 0H 0177 00396000 MEMLOC STM @14,@01,12(@13) 0177 00397000 STM @03,@12,32(@13) 0177 00398000 * DECLARE 0178 00399000 * HINDX FIXED(31); /* HIGH SEARCH VALUE */ 00400000 * DECLARE 0179 00401000 * LONDX FIXED(31); /* LOW SEARCH VALUE */ 00402000 * DECLARE 0180 00403000 * MNDX FIXED(31); /* MIDDLE SEARCH VALUE */ 00404000 * HINDX=DIRTOP; /* SET HI AT MAXIMUM */ 00405000 L HINDX,DIRTOP 0181 00406000 * LONDX=ONE; /* SET LO AT LAST INDEX */ 00407000 * 0182 00408000 LA LONDX,1 0182 00409000 * /*****************************************************************/ 00410000 * /* */ 00411000 * /* BINARY SEARCH THROUGH KEYS UNTIL WITHIN RANGE */ 00412000 * /* */ 00413000 * /*****************************************************************/ 00414000 * 0183 00415000 * DO WHILE HINDX>LONDX+RNGLMT; /* SEARCH TILL CLOSE */ 00416000 B @DE00183 0183 00417000 @DL00183 DS 0H 0184 00418000 * MNDX=HINDX-LONDX; /* CALC MIDDLE INDEX */ 00419000 LR MNDX,HINDX 0184 00420000 SLR MNDX,LONDX 0184 00421000 * MNDX=LONDX+MNDX/2; /* CALC MIDDLE INDEX */ 00422000 LR @00,MNDX 0185 00423000 SRDA @00,32 0185 00424000 D @00,@CF00105 0185 00425000 ALR @01,LONDX 0185 00426000 LR MNDX,@01 0185 00427000 * IF INPNAME>STWARNM(MNDX) /* IS INPUT NAME HIGHER? */ 00428000 * THEN /* YES - RESET LOW */ 00429000 LR @14,MNDX 0186 00430000 MH @14,@CH00246 0186 00431000 L @10,DIRADDR 0186 00432000 ALR @10,@14 0186 00433000 AL @10,@CF00415 0186 00434000 CLC INPNAME(8),STWARNM(@10) 0186 00435000 BNH @RF00186 0186 00436000 * LONDX=MNDX; /* CHECK OUT HIGH RANGE */ 00437000 LR LONDX,MNDX 0187 00438000 * ELSE /* OTHERWISE - RESET HIGH */ 00439000 * HINDX=MNDX; /* CONSIDER LOW RANGE */ 00440000 B @RC00186 0188 00441000 @RF00186 LR HINDX,MNDX 0188 00442000 * END; 0189 00443000 @RC00186 DS 0H 0189 00444000 @DE00183 LA @14,10 0189 00445000 ALR @14,LONDX 0189 00446000 CR HINDX,@14 0189 00447000 BH @DL00183 0189 00448000 * 0190 00449000 * /*****************************************************************/ 00450000 * /* */ 00451000 * /* AT THIS POINT, SEARCH IS WITHIN RNGLMT OF PROPER BLOCK. USE */ 00452000 * /* LOW AND INDEX THROUGH BLOCKS. */ 00453000 * /* */ 00454000 * /*****************************************************************/ 00455000 * 0190 00456000 * DO I=LONDX TO HINDX; /* LOOK THRU REMAINING BLOCKS */ 00457000 LR I,LONDX 0190 00458000 B @DE00190 0190 00459000 @DL00190 DS 0H 0191 00460000 * IF STWARNM(I)=INPNAME /* IS THIS THE ELEMENT? */ 00461000 * THEN /* YES - FOUND IT */ 00462000 LR @14,I 0191 00463000 MH @14,@CH00246 0191 00464000 L @10,DIRADDR 0191 00465000 ALR @10,@14 0191 00466000 AL @10,@CF00415 0191 00467000 CLC STWARNM(8,@10),INPNAME 0191 00468000 BNE @RF00191 0191 00469000 * RETURN CODE(FOUND); /* INDICATE MEMBER FOUND */ 00470000 SLR @15,@15 0192 00471000 L @14,12(,@13) 0192 00472000 LM @00,@01,20(@13) 0192 00473000 LM @03,@12,32(@13) 0192 00474000 BR @14 0192 00475000 * IF STWARNM(I)>INPNAME /* HAVE WE PASSED IT? */ 00476000 * THEN /* YES - GONE TOO FAR */ 00477000 @RF00191 LR @14,I 0193 00478000 MH @14,@CH00246 0193 00479000 L @10,DIRADDR 0193 00480000 ALR @10,@14 0193 00481000 AL @10,@CF00415 0193 00482000 CLC STWARNM(8,@10),INPNAME 0193 00483000 BNH @RF00193 0193 00484000 * RETURN CODE(NOTFND); /* INDICATE NOT FOUND */ 00485000 LA @15,4 0194 00486000 L @14,12(,@13) 0194 00487000 LM @00,@01,20(@13) 0194 00488000 LM @03,@12,32(@13) 0194 00489000 BR @14 0194 00490000 * END; 0195 00491000 @RF00193 AH I,@CH00061 0195 00492000 @DE00190 CR I,HINDX 0195 00493000 BNH @DL00190 0195 00494000 * RETURN CODE(NOTFND); /* INDICATE NOT FOUND */ 00495000 LA @15,4 0196 00496000 L @14,12(,@13) 0196 00497000 LM @00,@01,20(@13) 0196 00498000 LM @03,@12,32(@13) 0196 00499000 BR @14 0196 00500000 * END MEMLOC; 0197 00501000 * 0198 00502000 * /*****************************************************************/ 00503000 * /* */ 00504000 * /* THE FOLLOWING SUBROUTINE IS INVOKED TO CALCULATE THE SIZE OF A*/ 00505000 * /* DIRECTORY ENTRY. */ 00506000 * /* */ 00507000 * /*****************************************************************/ 00508000 * 0198 00509000 *ENTSIZE: 0198 00510000 * PROCEDURE(CALCNTRY) OPTIONS(SAVE(14)); 0198 00511000 ENTSIZE ST @14,12(,@13) 0198 00512000 MVC @PC00003(4),0(@01) 0198 00513000 * DECLARE 0199 00514000 * 1 CALCNTRY, /* ENTRY TO CALCULATE */ 00515000 * 3 * CHAR(11), /* FILLER */ 00516000 * 3 ULEN FIXED(8); /* USER DATA LENGTH */ 00517000 * MVSIZE=(ULEN&NOALIAS)*2+DIRBASE;/* CALCULATE LENGTH */ 00518000 L @14,@PC00003 0200 00519000 LA MVSIZE,127 0200 00520000 MVC @ZT00003+3(1),ULEN(@14) 0200 00521000 N MVSIZE,@ZT00003 0200 00522000 ALR MVSIZE,MVSIZE 0200 00523000 AH MVSIZE,@CH00128 0200 00524000 * END ENTSIZE; /* RETURN 0201 00525000 * */ 00526000 @EL00003 DS 0H 0201 00527000 @EF00003 DS 0H 0201 00528000 @ER00003 L @14,12(,@13) 0201 00529000 BR @14 0201 00530000 * 0202 00531000 * /*****************************************************************/ 00532000 * /* */ 00533000 * /* THE FOLLOWING SUBROUTINE IS INVOKED TO MOVE RECORDS INTO THE */ 00534000 * /* OUTPUT STOW BUFFER FROM THE INPUT STOW BUFFER OR SOME OTHER */ 00535000 * /* LOCATION INDICATED BY MOVEPTR. */ 00536000 * /* */ 00537000 * /*****************************************************************/ 00538000 * 0202 00539000 *ONEMOVE: 0202 00540000 * PROCEDURE(MOVEPTR) OPTIONS(SAVEAREA); 0202 00541000 ONEMOVE STM @14,@03,12(@13) 0202 00542000 STM @06,@12,44(@13) 0202 00543000 ST @13,@SA00004+4 0202 00544000 LA @14,@SA00004 0202 00545000 ST @14,8(,@13) 0202 00546000 LR @13,@14 0202 00547000 MVC @PC00004(4),0(@01) 0202 00548000 * DECLARE 0203 00549000 * MOVEPTR PTR(31); /* ADDR OF RECORD TO MOVE */ 00550000 * DECLARE 0204 00551000 * INMEM CHAR(*) BASED(MOVEPTR); /* INPUT RECORD TO MOVE */ 00552000 * IF MVSIZE>UNUSEDSP /* WILL THIS ENTRY FIT IN OUTBUF?*/ 00553000 * THEN /* NO - GET ANOTHER BLOCK */ 00554000 CR MVSIZE,UNUSEDSP 0205 00555000 BNH @RF00205 0205 00556000 * DO; 0206 00557000 * CALL BLKWRITE; /* WRITE OUT CURRENT BLOCK */ 00558000 BAL @14,BLKWRITE 0207 00559000 * IF RTNCODEª=GOOD /* WAS THERE AN ERROR? */ 00560000 * THEN /* YES - RETURN ERROR */ 00561000 LTR RTNCODE,RTNCODE 0208 00562000 BZ @RF00208 0208 00563000 * RETURN CODE(RTNCODE); /* PASS ON RETURN CODE */ 00564000 L @13,4(,@13) 0209 00565000 L @14,12(,@13) 0209 00566000 LM @00,@03,20(@13) 0209 00567000 LM @06,@12,44(@13) 0209 00568000 BR @14 0209 00569000 * END; 0210 00570000 @RF00208 DS 0H 0211 00571000 * UNUSEDSP=UNUSEDSP-MVSIZE; /* DECREMENT UNUSED SPACE IN BUFF*/ 00572000 @RF00205 SLR UNUSEDSP,MVSIZE 0211 00573000 * OUTMEM(1:MVSIZE)=INMEM(1:MVSIZE);/* MOVE RECORD TO BUFFER */ 00574000 LR @14,MVSIZE 0212 00575000 BCTR @14,0 0212 00576000 L @10,@PC00004 0212 00577000 L @02,MOVEPTR(,@10) 0212 00578000 EX @14,@SM00417 0212 00579000 * OUTKEY=OUTMEM(1:8); /* PUT KEY IN OUTPUT RECORD */ 00580000 MVC OUTKEY(8),OUTMEM(FILLPTR) 0213 00581000 * FILLPTR=FILLPTR+MVSIZE; /* BUMP OUTPUT FILL ADDRESS */ 00582000 ALR FILLPTR,MVSIZE 0214 00583000 * MOVEPTR=MOVEPTR+MVSIZE; /* BUMP INPUT MOVE ADDRESS */ 00584000 ALR @02,MVSIZE 0215 00585000 ST @02,MOVEPTR(,@10) 0215 00586000 * RETURN CODE(GOOD); /* INDICATE SUCCESS */ 00587000 SLR @15,@15 0216 00588000 L @13,4(,@13) 0216 00589000 L @14,12(,@13) 0216 00590000 LM @00,@03,20(@13) 0216 00591000 LM @06,@12,44(@13) 0216 00592000 BR @14 0216 00593000 * END ONEMOVE; /* RETURN TO CALLER 0217 00594000 * */ 00595000 * 0218 00596000 * /*****************************************************************/ 00597000 * /* */ 00598000 * /* THE FOLLOWING ROUTINE IS INVOKED TO OBTAIN A NEW BLOCK FROM */ 00599000 * /* THE DIRECTORY AND WRITE THE UPDATED BLOCK. */ 00600000 * /* */ 00601000 * /*****************************************************************/ 00602000 * 0218 00603000 *BLKWRITE: 0218 00604000 * PROCEDURE OPTIONS(SAVEAREA); 0218 00605000 BLKWRITE STM @14,@03,12(@13) 0218 00606000 STM @06,@12,44(@13) 0218 00607000 ST @13,@SA00005+4 0218 00608000 LA @14,@SA00005 0218 00609000 ST @14,8(,@13) 0218 00610000 LR @13,@14 0218 00611000 * OUTBLKSZ=LENGTH(OUTFILL)-UNUSEDSP+LENGTH(OUTBLKSZ);/* CALC SZ */ 00612000 LA @14,254 0219 00613000 SLR @14,UNUSEDSP 0219 00614000 AH @14,@CH00105 0219 00615000 ST @14,@TF00001 0219 00616000 MVC OUTBLKSZ(2),@TF00001+2 0219 00617000 * DSKNDX=DSKNDX+1; /* BUMP COUNT OF WRITTEN BLOCKS */ 00618000 LA @14,1 0220 00619000 AL @14,DSKNDX 0220 00620000 ST @14,DSKNDX 0220 00621000 * IOPDSID=IOPSCR2; /* INDICATE DIRECTORY */ 00622000 L @14,IOPPTR 0221 00623000 MVI IOPDSID(@14),X'04' 0221 00624000 * IOPFUNCT=IOPWRITE; /* FUNCTION IS WRITE */ 00625000 MVI IOPFUNCT(@14),X'05' 0222 00626000 * IOPBUFAD=ADDR(OUTBUF); /* POINT TO DIRECT OUTBUFF */ 00627000 LA @10,OUTBUF 0223 00628000 ST @10,IOPBUFAD(,@14) 0223 00629000 * CALL HMASMIO(HMASMIOP); /* WRITE OUTPUT BUFFER */ 00630000 ST @14,@AL00001 0224 00631000 L @15,@CV00300 0224 00632000 LA @01,@AL00001 0224 00633000 BALR @14,@15 0224 00634000 * IF IOPRETRNª=GOOD /* I/O ERROR? */ 00635000 * THEN /* YES - ERROR CONDITION */ 00636000 L @14,IOPPTR 0225 00637000 CLI IOPRETRN(@14),0 0225 00638000 BE @RF00225 0225 00639000 * RETURN CODE(BADO); /* RETURN BAD CODE */ 00640000 LA @15,4 0226 00641000 L @13,4(,@13) 0226 00642000 L @14,12(,@13) 0226 00643000 LM @00,@03,20(@13) 0226 00644000 LM @06,@12,44(@13) 0226 00645000 BR @14 0226 00646000 * UNUSEDSP=LENGTH(OUTFILL); /* RESET UNUSED SPACE SIZE */ 00647000 @RF00225 LA UNUSEDSP,254 0227 00648000 * FILLPTR=ADDR(OUTFILL); /* RESET PTR TO FILL POSITION */ 00649000 LA FILLPTR,OUTFILL 0228 00650000 * RETURN CODE(GOOD); /* RETURN SUCCESSFUL */ 00651000 SLR @15,@15 0229 00652000 L @13,4(,@13) 0229 00653000 L @14,12(,@13) 0229 00654000 LM @00,@03,20(@13) 0229 00655000 LM @06,@12,44(@13) 0229 00656000 BR @14 0229 00657000 * END BLKWRITE; 0230 00658000 * 0231 00659000 * /*****************************************************************/ 00660000 * /* */ 00661000 * /* ENTER HERE TO READ A NEW DIRECTORY BLOCK INTO INPUT BUFFER */ 00662000 * /* THIS MAY ENTAIL AN ACTUAL PHYSICAL READ FROM THE DISK DIRECT- */ 00663000 * /* ORY, OR A LOGICAL READ FROM A BUFFER IN WHICH ENTRIES ARE */ 00664000 * /* SAVED PRIOR TO A WRITE OPERATION (WHICH WOULD OVERLAY THE */ 00665000 * /* BLOCK ABOUT TO BE READ IN). */ 00666000 * /* */ 00667000 * /*****************************************************************/ 00668000 * 0231 00669000 *BLKREAD: 0231 00670000 * PROCEDURE OPTIONS(SAVEAREA); 0231 00671000 BLKREAD STM @14,@12,12(@13) 0231 00672000 ST @13,@SA00006+4 0231 00673000 LA @14,@SA00006 0231 00674000 ST @14,8(,@13) 0231 00675000 LR @13,@14 0231 00676000 * IF EODFLG=ON /* WAS END OF DIRECT JUST FOUND? */ 00677000 * THEN /* YES - DONE WITH READS */ 00678000 TM EODFLG,B'01000000' 0232 00679000 BNO @RF00232 0232 00680000 * DO; 0233 00681000 * EODFLG=OFF; /* RESET EOD FLAG */ 00682000 * EODRCHD=ON; /* INDICATE END OF DIRECTORY */ 00683000 OI EODRCHD,B'10000000' 0235 00684000 NI EODFLG,B'10111111' 0235 00685000 * RETURN CODE(GOOD); /* RETURN TO CALLER */ 00686000 SLR @15,@15 0236 00687000 L @13,4(,@13) 0236 00688000 L @14,12(,@13) 0236 00689000 LM @00,@12,20(@13) 0236 00690000 BR @14 0236 00691000 * END; 0237 00692000 * IOPDSID=IOPCDSDR; /* INDICATE DIRECTORY */ 00693000 @RF00232 L @14,IOPPTR 0238 00694000 MVI IOPDSID(@14),X'08' 0238 00695000 * IOPFUNCT=IOPREAD; /* READ OPERATION */ 00696000 MVI IOPFUNCT(@14),X'01' 0239 00697000 * IOPBUFAD=ADDR(INBUF); /* POINT TO INPUT BUFFER */ 00698000 LA @10,INBUF 0240 00699000 ST @10,IOPBUFAD(,@14) 0240 00700000 * CALL HMASMIO(HMASMIOP); /* READ IN INPUT DIRECTORY */ 00701000 ST @14,@AL00001 0241 00702000 L @15,@CV00300 0241 00703000 LA @01,@AL00001 0241 00704000 BALR @14,@15 0241 00705000 * IF IOPRETRNª=GOOD /* I/O ERROR? */ 00706000 * THEN /* YES - PASS ON ERROR */ 00707000 L @14,IOPPTR 0242 00708000 CLI IOPRETRN(@14),0 0242 00709000 BE @RF00242 0242 00710000 * RETURN CODE(BADO); /* INDICATE ERROR TO CALLER 0243 00711000 * */ 00712000 LA @15,4 0243 00713000 L @13,4(,@13) 0243 00714000 L @14,12(,@13) 0243 00715000 LM @00,@12,20(@13) 0243 00716000 BR @14 0243 00717000 * 0244 00718000 * /*****************************************************************/ 00719000 * /* */ 00720000 * /* DIRECTORY MEMBER HAS BEEN PLACED IN INBUF.. */ 00721000 * /* */ 00722000 * /*****************************************************************/ 00723000 * 0244 00724000 * IF INKEY=EODIRCT /* IS THIS LAST DIRECTORY BLOCK? */ 00725000 * THEN /* YES - SET END INDICATOR */ 00726000 @RF00242 CLC INKEY(8),EODIRCT 0244 00727000 BNE @RF00244 0244 00728000 * EODFLG=ON; /* SO NEXT READ WILL YIELD EOF */ 00729000 OI EODFLG,B'01000000' 0245 00730000 * MOVEADDR=ADDR(INNAME); /* RESET INPUT MOVE ADDR */ 00731000 @RF00244 LA @14,INNAME 0246 00732000 ST @14,MOVEADDR 0246 00733000 * REMAINSZ=INBLK-LENGTH(INBLK); /* SET SIZE OF BUFFER */ 00734000 MVC @TF00001(2),INBLK 0247 00735000 LH @14,@TF00001 0247 00736000 BCTR @14,0 0247 00737000 BCTR @14,0 0247 00738000 STH @14,REMAINSZ 0247 00739000 * RETURN CODE(GOOD); /* RETURN TO CALLER */ 00740000 SLR @15,@15 0248 00741000 L @13,4(,@13) 0248 00742000 L @14,12(,@13) 0248 00743000 LM @00,@12,20(@13) 0248 00744000 BR @14 0248 00745000 * END BLKREAD; 0249 00746000 * 0250 00747000 * /*****************************************************************/ 00748000 * /* */ 00749000 * /* THIS ROUTINE IS INVOKED TO STOW MEMBERS ONTO DISK FROM THE */ 00750000 * /* IN-CORE DIRECTORY ARRAY. THE DIRECTORY ON DISK IS READ AND */ 00751000 * /* REWRITTEN UNTIL THE IN-CORE ARRAY IS EXHAUSTED OR THE DISK */ 00752000 * /* DIRECTORY IS FILLED. */ 00753000 * /* */ 00754000 * /*****************************************************************/ 00755000 * 0250 00756000 *STOW: 0250 00757000 * PROCEDURE OPTIONS(SAVEAREA); 0250 00758000 STOW STM @14,@12,12(@13) 0250 00759000 ST @13,@SA00007+4 0250 00760000 LA @14,@SA00007 0250 00761000 ST @14,8(,@13) 0250 00762000 LR @13,@14 0250 00763000 * DSKNDX=ZERO; /* RESET INDEX FOR DISK READ */ 00764000 SLR @14,@14 0251 00765000 ST @14,DSKNDX 0251 00766000 * INKEY(1)=ZERO; /* SET KEY FOR FOLLOWING LOOP */ 00767000 STC @14,INKEY 0252 00768000 * DO WHILE INKEY=STWARNM(1) /* SHOULD THIS BLOCK BE WRITN? */ 00783000 * THEN /* NO - DONE WITH FLUSH */ 00784000 @RF00255 L @14,DIRADDR 0257 00785000 CLC INKEY(8),STWARNM(@14) 0257 00786000 BNL @RT00257 0257 00787000 * GO TO FLUSHOUT; /* EXIT FROM LOOP */ 00788000 * IOPDSID=IOPSCR2; /* INDICATE SCRATCH FILE */ 00789000 L @14,IOPPTR 0259 00790000 MVI IOPDSID(@14),X'04' 0259 00791000 * IOPFUNCT=IOPWRITE; /* INDICATE WRITE OPERATION */ 00792000 MVI IOPFUNCT(@14),X'05' 0260 00793000 * DSKNDX=DSKNDX+1; /* BUMP DISK INDEX */ 00794000 LA @10,1 0261 00795000 AL @10,DSKNDX 0261 00796000 ST @10,DSKNDX 0261 00797000 * CALL HMASMIO(HMASMIOP); /* WRITE OUT BLOCK */ 00798000 ST @14,@AL00001 0262 00799000 L @15,@CV00300 0262 00800000 LA @01,@AL00001 0262 00801000 BALR @14,@15 0262 00802000 * IF IOPRETRNª=GOOD /* ERROR ON WRITE? */ 00803000 * THEN /* YES - PASS IT ON */ 00804000 L @14,IOPPTR 0263 00805000 CLI IOPRETRN(@14),0 0263 00806000 BE @RF00263 0263 00807000 * RETURN CODE(BADO); /* RETURN CODE TO CALLER */ 00808000 LA @15,4 0264 00809000 L @13,4(,@13) 0264 00810000 L @14,12(,@13) 0264 00811000 LM @00,@12,20(@13) 0264 00812000 BR @14 0264 00813000 * END; 0265 00814000 @RF00263 DS 0H 0265 00815000 @DE00253 L @14,DIRADDR 0265 00816000 CLC INKEY(8),STWARNM(@14) 0265 00817000 BL @DL00253 0265 00818000 *FLUSHOUT: 0266 00819000 * 0266 00820000 * /*****************************************************************/ 00821000 * /* */ 00822000 * /* DIRECTORY HAS BEEN READ TO POINT WHERE 1ST MEMBER SHOULD BE */ 00823000 * /* ADDED. FROM THIS POINT, THE DIRECTORY MUST BE RE-WRITTEN */ 00824000 * /* */ 00825000 * /*****************************************************************/ 00826000 * 0266 00827000 * FILLPTR=ADDR(OUTFILL); /* INIT PTR INTO OUTPUT BUFFER */ 00828000 FLUSHOUT LA FILLPTR,OUTFILL 0266 00829000 * UNUSEDSP=LENGTH(OUTFILL); /* SET LENGTH OF UNUSED OUTBUF */ 00830000 LA UNUSEDSP,254 0267 00831000 * I=1; /* SET INDEX FOR INCORE ARRAY 0268 00832000 * */ 00833000 LA I,1 0268 00834000 * 0269 00835000 * /*****************************************************************/ 00836000 * /* */ 00837000 * /* MOVE EITHER RECORD FROM INPUT BUFFER OR RECORD FROM IN-CORE */ 00838000 * /* ARRAY TO OUTPUT BUFFER AND WRITE IT WHEN FILLED. THE INPUT */ 00839000 * /* BUFFER IS CONTINUALLY FILLED WHEN EMPTY FROM READ OPERATIONS */ 00840000 * /* TO THE ON-DISK DIRECTORY. */ 00841000 * /* */ 00842000 * /*****************************************************************/ 00843000 * 0269 00844000 * DO WHILE I<=DIRTOP; /* LOOP THRU IN-CORE DIRECT */ 00845000 B @DE00269 0269 00846000 @DL00269 DS 0H 0270 00847000 * IF MVNAMEDSKEND /* WILL NEW DIRECTORY OVERFLOW? */ 01073000 * THEN /* YES - ISSUE MESSAGE AND RETURN*/ 01074000 L @14,DSKNDX 0326 01075000 C @14,DSKEND 0326 01076000 BNH @RF00326 0326 01077000 * DO; 0327 01078000 * MGPMGNO1=DIREXC; /* INDICATE DIRECT EXCEEDED */ 01079000 MVI MGPMGNO1,X'53' 0328 01080000 * CALL HMASMMSG(HMASMMGP); /* WRITE OUT MESSAGE */ 01081000 L @15,@CV00301 0329 01082000 LA @01,@AL00329 0329 01083000 BALR @14,@15 0329 01084000 * RETURN CODE(BADO); /* EXIT BADLY */ 01085000 LA @15,4 0330 01086000 L @13,4(,@13) 0330 01087000 L @14,12(,@13) 0330 01088000 LM @00,@12,20(@13) 0330 01089000 BR @14 0330 01090000 * END; 0331 01091000 * DO I=1 TO 100000; /* INFINITE LOOP TO COPY RECORDS */ 01092000 @RF00326 LA I,1 0332 01093000 @DL00332 DS 0H 0333 01094000 * IOPBUFAD=ADDR(INBUF); /* POINT TO INPUT BUFFER */ 01095000 L @14,IOPPTR 0333 01096000 LA @10,INBUF 0333 01097000 ST @10,IOPBUFAD(,@14) 0333 01098000 * IOPFUNCT=IOPREAD; /* READ DIRECTORY BLOCK */ 01099000 MVI IOPFUNCT(@14),X'01' 0334 01100000 * IOPDSID=IOPSCR2; /* INDICATE SCRATCH FILE */ 01101000 MVI IOPDSID(@14),X'04' 0335 01102000 * CALL HMASMIO(HMASMIOP); /* READ FROM SCRATCH */ 01103000 ST @14,@AL00001 0336 01104000 L @15,@CV00300 0336 01105000 LA @01,@AL00001 0336 01106000 BALR @14,@15 0336 01107000 * IF IOPRETRN=EOF /* END OF DATA SET? */ 01108000 * THEN /* YES - EXIT FROM LOOP */ 01109000 L @14,IOPPTR 0337 01110000 CLI IOPRETRN(@14),4 0337 01111000 BE @RT00337 0337 01112000 * GO TO CLOSEUP; /* EXIT DONE */ 01113000 * IF IOPRETRNª=GOOD /* I/O ERROR? */ 01114000 * THEN /* YES - RETURN BADLY */ 01115000 CLI IOPRETRN(@14),0 0339 01116000 BE @RF00339 0339 01117000 * RETURN CODE(BADO); /* PASS ON ERROR */ 01118000 LA @15,4 0340 01119000 L @13,4(,@13) 0340 01120000 L @14,12(,@13) 0340 01121000 LM @00,@12,20(@13) 0340 01122000 BR @14 0340 01123000 * IOPBUFAD=ADDR(OUTBUF); /* POINT TO OUTPUT BUFFER */ 01124000 @RF00339 L @14,IOPPTR 0341 01125000 LA @10,OUTBUF 0341 01126000 ST @10,IOPBUFAD(,@14) 0341 01127000 * IOPDSID=IOPCDSDR; /* DIRECTORY FIRST */ 01128000 MVI IOPDSID(@14),X'08' 0342 01129000 * CALL HMASMIO(HMASMIOP); /* PERFORM DUMMY READ */ 01130000 ST @14,@AL00001 0343 01131000 L @15,@CV00300 0343 01132000 LA @01,@AL00001 0343 01133000 BALR @14,@15 0343 01134000 * IF IOPRETRN>EOF /* I/O ERROR? */ 01135000 * THEN /* YES - RETURN BADLY */ 01136000 L @14,IOPPTR 0344 01137000 CLI IOPRETRN(@14),4 0344 01138000 BNH @RF00344 0344 01139000 * RETURN CODE(BADO); /* PASS ON ERROR */ 01140000 LA @15,4 0345 01141000 L @13,4(,@13) 0345 01142000 L @14,12(,@13) 0345 01143000 LM @00,@12,20(@13) 0345 01144000 BR @14 0345 01145000 * IOPBUFAD=ADDR(INBUF); /* POINT TO INPUT BUFFER */ 01146000 @RF00344 L @14,IOPPTR 0346 01147000 LA @10,INBUF 0346 01148000 ST @10,IOPBUFAD(,@14) 0346 01149000 * IOPFUNCT=IOPWRITE; /* INDICATE WRITE OPERATION */ 01150000 MVI IOPFUNCT(@14),X'05' 0347 01151000 * IOPDSID=IOPCDSDR; /* INDICATE DIRECTORY */ 01152000 MVI IOPDSID(@14),X'08' 0348 01153000 * CALL HMASMIO(HMASMIOP); /* OVERLAY DIRECT BLOCK */ 01154000 ST @14,@AL00001 0349 01155000 L @15,@CV00300 0349 01156000 LA @01,@AL00001 0349 01157000 BALR @14,@15 0349 01158000 * IF IOPRETRNª=GOOD /* I/O ERROR? */ 01159000 * THEN /* YES - RETURN BADLY */ 01160000 L @14,IOPPTR 0350 01161000 CLI IOPRETRN(@14),0 0350 01162000 BE @RF00350 0350 01163000 * RETURN CODE(BADO); /* PASS ON ERROR */ 01164000 LA @15,4 0351 01165000 L @13,4(,@13) 0351 01166000 L @14,12(,@13) 0351 01167000 LM @00,@12,20(@13) 0351 01168000 BR @14 0351 01169000 * END; 0352 01170000 @RF00350 AH I,@CH00061 0352 01171000 C I,@CF00351 0352 01172000 BNH @DL00332 0352 01173000 *CLOSEUP: 0353 01174000 * IOPDSID=IOPCDSDR; /* INDICATE DIRECTORY */ 01175000 CLOSEUP L @14,IOPPTR 0353 01176000 MVI IOPDSID(@14),X'08' 0353 01177000 * IOPFUNCT=IOPCLOSE; /* CLOSE OPERATION */ 01178000 MVI IOPFUNCT(@14),X'04' 0354 01179000 * CALL HMASMIO(HMASMIOP); /* CLOSE DIRECTORY DATA SET */ 01180000 ST @14,@AL00001 0355 01181000 L @15,@CV00300 0355 01182000 LA @01,@AL00001 0355 01183000 BALR @14,@15 0355 01184000 * IOPDSID=IOPSCR2; /* INDICATE SCRATCH FILE */ 01185000 L @14,IOPPTR 0356 01186000 MVI IOPDSID(@14),X'04' 0356 01187000 * CALL HMASMIO(HMASMIOP); /* CLOSE SCRATCH FILE */ 01188000 ST @14,@AL00001 0357 01189000 L @15,@CV00300 0357 01190000 LA @01,@AL00001 0357 01191000 BALR @14,@15 0357 01192000 * RETURN CODE(GOOD); /* PASS GOOD RETURN TO CALLER */ 01193000 SLR @15,@15 0358 01194000 L @13,4(,@13) 0358 01195000 L @14,12(,@13) 0358 01196000 LM @00,@12,20(@13) 0358 01197000 BR @14 0358 01198000 * END STOW; /* RETURN TO CALLER */ 01199000 * END HMASMIC 0360 01200000 * 0360 01201000 */* THE FOLLOWING INCLUDE STATEMENTS WERE FOUND IN THIS PROGRAM. */ 01202000 */*%INCLUDE SYSLIB (HMASMCCA) */ 01203000 */*%INCLUDE SYSLIB (HMASMIOP) */ 01204000 */*%INCLUDE SYSLIB (HMASMMGP) */ 01205000 * 0360 01206000 * ; 0360 01207000 @DATA DS 0H 01208000 @CH00061 DC H'1' 01209000 @CH00128 DC H'12' 01210000 @CH00341 DC H'254' 01211000 @CH00244 DC H'12288' 01212000 @CH00264 DC H'19688' 01213000 @SM00413 MVC BLDLUSER(0,@10),STWARUS-12(@09) 01214000 @SM00417 MVC OUTMEM(0,FILLPTR),INMEM(@02) 01215000 DS 0F 01216000 @AL00114 EQU * LIST WITH 1 ARGUMENT(S) 01217000 @AL00329 DC A(HMASMMGP) LIST WITH 1 ARGUMENT(S) 01218000 @AL00273 EQU * LIST WITH 1 ARGUMENT(S) 01219000 @AL00307 DC A(MOVEADDR) LIST WITH 1 ARGUMENT(S) 01220000 @AL00299 DC A(STWADDR) LIST WITH 1 ARGUMENT(S) 01221000 DS 0F 01222000 @SA00001 DS 18F 01223000 @PC00001 DS 2F 01224000 @SA00007 DS 18F 01225000 @PC00003 DS 1F 01226000 @SA00004 DS 18F 01227000 @PC00004 DS 1F 01228000 @SA00005 DS 18F 01229000 @SA00006 DS 18F 01230000 @AL00001 DS 1A 01231000 @TF00001 DS F 01232000 @ZTEMPS DS 0F 01233000 @ZT00003 DC F'0' 01234000 @ZTEMPND EQU * 01235000 @ZLEN EQU @ZTEMPND-@ZTEMPS 01236000 DS 0F 01237000 @CF00105 DC F'2' 01238000 @CH00105 EQU @CF00105+2 01239000 @CF00246 DC F'74' 01240000 @CH00246 EQU @CF00246+2 01241000 @CF00351 DC F'100000' 01242000 @CF00415 DC F'-74' 01243000 @CF00410 DC F'-66' 01244000 @CF00411 DC F'-63' 01245000 @CF00412 DC F'-62' 01246000 @CV00300 DC V(HMASMIO) 01247000 @CV00301 DC V(HMASMMSG) 01248000 DS 0D 01249000 IOPPTR DC AL4(DIRIOP) 01250000 MOVEADDR DS A 01251000 STWADDR DS A 01252000 DIREND DS F 01253000 DIRTOP DC F'0' 01254000 DSKEND DC F'0' 01255000 DSKNDX DC F'0' 01256000 MEMPTR DS A 01257000 STWPTR DS A 01258000 REMAINSZ DS H 01259000 DS CL2 01260000 HMASMMGP DS CL8 01261000 ORG HMASMMGP 01262000 MGPMGNO1 DS FL1 01263000 MGPMGNO2 DS FL1 01264000 MGPMGNO3 DS FL1 01265000 MGPFLAGS DS BL1 01266000 ORG MGPFLAGS 01267000 MGPPRINT DS BL1 01268000 MGPHLDS EQU MGPFLAGS+0 01269000 @NM00011 EQU MGPFLAGS+0 01270000 ORG HMASMMGP+4 01271000 MGPVARPT DS 1A 01272000 ORG HMASMMGP+8 01273000 DIRIOP DS CL8 01274000 INPNAME DS CL8 01275000 EODIRCT DC X'FFFFFFFFFFFFFFFF' 01276000 @NM00012 DC AL1(0) 01277000 ORG @NM00012 01278000 EODRCHD DS BL1 01279000 EODFLG EQU @NM00012+0 01280000 ORG @NM00012+1 01281000 DS CL3 01282000 RANGE DS CL8 01283000 ORG RANGE 01284000 @NM00017 DC F'19688' 01285000 @NM00018 DC F'300000' 01286000 ORG RANGE+8 01287000 @NM00019 DS CL8 01288000 ORG @NM00019 01289000 DIRADDR DC A(0) 01290000 DIRSIZ DC F'0' 01291000 ORG @NM00019+8 01292000 @NM00020 DS CL8 01293000 ORG @NM00020 01294000 FREEADDR DS AL4 01295000 FREELEN DS FL4 01296000 ORG @NM00020+8 01297000 INBUF DS CL264 01298000 ORG INBUF 01299000 INKEY DS CL8 01300000 INDATA DS CL256 01301000 ORG INDATA 01302000 INBLK DS FL2 01303000 INNAME DS CL8 01304000 ORG INBUF+264 01305000 OUTBUF DS CL264 01306000 ORG OUTBUF 01307000 OUTKEY DS CL8 01308000 OUTDATA DS CL256 01309000 ORG OUTDATA 01310000 OUTBLKSZ DS FL2 01311000 OUTFILL DS CL254 01312000 ORG OUTBUF+264 01313000 PATCH DC 60X'FF' 01314000 @00 EQU 00 EQUATES FOR REGISTERS 0-15 01315000 @01 EQU 01 01316000 @02 EQU 02 01317000 @03 EQU 03 01318000 @04 EQU 04 01319000 @05 EQU 05 01320000 @06 EQU 06 01321000 @07 EQU 07 01322000 @08 EQU 08 01323000 @09 EQU 09 01324000 @10 EQU 10 01325000 @11 EQU 11 01326000 @12 EQU 12 01327000 @13 EQU 13 01328000 @14 EQU 14 01329000 @15 EQU 15 01330000 MNDX EQU @02 01331000 LONDX EQU @04 01332000 HINDX EQU @03 01333000 J EQU @03 01334000 UDATLEN EQU @03 01335000 I EQU @02 01336000 UNUSEDSP EQU @04 01337000 MVSIZE EQU @03 01338000 FILLPTR EQU @05 01339000 CCAPTR EQU @11 01340000 RTNCODE EQU @15 01341000 HMASMCCA EQU 0 01342000 CCAOPT EQU HMASMCCA+76 01343000 CCAFLAG1 EQU HMASMCCA+77 01344000 CCAFLAG2 EQU HMASMCCA+78 01345000 CCAICSB EQU CCAFLAG2 01346000 CCAFLAG3 EQU HMASMCCA+79 01347000 HMASMIOP EQU 0 01348000 IOPDSID EQU HMASMIOP 01349000 IOPFUNCT EQU HMASMIOP+1 01350000 IOPRETRN EQU HMASMIOP+2 01351000 IOPBUFAD EQU HMASMIOP+4 01352000 IOPNAME EQU HMASMIOP+8 01353000 IOPTYPE EQU IOPNAME 01354000 IOPTTR EQU HMASMIOP+16 01355000 IOPUDATA EQU HMASMIOP+20 01356000 OUTMEM EQU 0 01357000 MVNTRY EQU 0 01358000 MVNAME EQU MVNTRY 01359000 STWARRAY EQU 0 01360000 STWARNM EQU STWARRAY 01361000 STWARTTR EQU STWARRAY+8 01362000 STWARUL EQU STWARRAY+11 01363000 STWARUS EQU STWARRAY+12 01364000 INMEM EQU 0 01365000 BLDLLIST EQU 0 01366000 BLDLNAME EQU BLDLLIST+4 01367000 BLDLTTR EQU BLDLLIST+12 01368000 BLDLULEN EQU BLDLLIST+17 01369000 BLDLUSER EQU BLDLLIST+18 01370000 STOWLIST EQU 0 01371000 STWNAME EQU STOWLIST 01372000 CALCNTRY EQU 0 01373000 ULEN EQU CALCNTRY+11 01374000 MOVEPTR EQU 0 01375000 IOPMOCDS EQU IOPUDATA 01376000 IOPLMCDS EQU IOPUDATA 01377000 IOPFLGS2 EQU IOPLMCDS 01378000 IOPFLGS3 EQU IOPLMCDS+1 01379000 IOPMACDS EQU IOPUDATA 01380000 IOPPTCDS EQU IOPUDATA 01381000 IOPFLGS5 EQU IOPPTCDS 01382000 IOPSTAT EQU IOPFLGS5 01383000 IOPPNTRY EQU IOPPTCDS+4 01384000 IOPDLCDS EQU IOPUDATA 01385000 IOPSYCDS EQU IOPUDATA 01386000 IOPFLGS7 EQU IOPSYCDS 01387000 IOPSTCMP EQU IOPUDATA 01388000 IOPPTSNT EQU IOPUDATA 01389000 IOPPFLG1 EQU IOPPTSNT 01390000 IOPPLEPR EQU IOPPTSNT+1 01391000 IOPPNUM EQU IOPPTSNT+2 01392000 AGO .@UNREFD START UNREFERENCED COMPONENTS 01393000 IOPALISL EQU IOPPTSNT+22 01394000 IOPINDLB EQU IOPPTSNT+14 01395000 IOPDISTN EQU IOPPTSNT+7 01396000 IOPPDIG EQU IOPPNUM+2 01397000 IOPPID EQU IOPPNUM 01398000 IOPPNE EQU IOPPLEPR 01399000 IOPPDC EQU IOPPLEPR 01400000 IOPPREFR EQU IOPPLEPR 01401000 IOPPOVLY EQU IOPPLEPR 01402000 IOPPSCTR EQU IOPPLEPR 01403000 IOPPREUS EQU IOPPLEPR 01404000 IOPPRENT EQU IOPPLEPR 01405000 @NM00010 EQU IOPPLEPR 01406000 @NM00009 EQU IOPPFLG1 01407000 IOPLEFND EQU IOPPFLG1 01408000 IOPDALIS EQU IOPPFLG1 01409000 IOPTALIS EQU IOPPFLG1 01410000 IOPLIBTX EQU IOPPFLG1 01411000 IOPLIBLK EQU IOPPFLG1 01412000 IOPSTNEW EQU IOPSTCMP+8 01413000 IOPSTOLD EQU IOPSTCMP 01414000 IOPPDLM EQU IOPSYCDS+8 01415000 IOPPEMAX EQU IOPSYCDS+6 01416000 IOPNUCID EQU IOPSYCDS+5 01417000 IOPSREL EQU IOPSYCDS+1 01418000 @NM00008 EQU IOPFLGS7 01419000 IOPTSO EQU IOPFLGS7 01420000 IOPDSYS EQU IOPDLCDS 01421000 IOPPIND EQU IOPPNTRY+8 01422000 IOPPMODS EQU IOPPNTRY 01423000 IOPDATE EQU IOPPTCDS+1 01424000 @NM00007 EQU IOPFLGS5 01425000 IOPDUMMP EQU IOPSTAT 01426000 IOPFORCE EQU IOPSTAT 01427000 IOPACC EQU IOPSTAT 01428000 IOPAPP EQU IOPSTAT 01429000 IOPASMOD EQU IOPMACDS+2 01430000 @NM00006 EQU IOPMACDS 01431000 IOPSYSLB EQU IOPLMCDS+2 01432000 @NM00005 EQU IOPFLGS3 01433000 IOPCHREP EQU IOPFLGS3 01434000 IOPLINK EQU IOPFLGS3 01435000 IOPCOPY EQU IOPFLGS3 01436000 IOPNE EQU IOPFLGS2 01437000 IOPDC EQU IOPFLGS2 01438000 IOPREFR EQU IOPFLGS2 01439000 IOPOVLY EQU IOPFLGS2 01440000 IOPSCTR EQU IOPFLGS2 01441000 IOPREUS EQU IOPFLGS2 01442000 IOPRENT EQU IOPFLGS2 01443000 @NM00004 EQU IOPFLGS2 01444000 IOPLMODS EQU IOPMOCDS+9 01445000 IOPDLIB EQU IOPMOCDS+2 01446000 IOPMODID EQU IOPMOCDS 01447000 @NM00021 EQU CALCNTRY 01448000 @NM00016 EQU BLDLLIST+16 01449000 @NM00015 EQU BLDLLIST+15 01450000 @NM00014 EQU BLDLLIST+2 01451000 @NM00013 EQU BLDLLIST 01452000 IOPUSERL EQU HMASMIOP+19 01453000 IOPBLKSI EQU IOPTTR 01454000 IOPNAME2 EQU IOPNAME+1 01455000 IOPCDTYP EQU IOPTYPE 01456000 IOPMACID EQU HMASMIOP+3 01457000 CCABLKSZ EQU HMASMCCA+92 01458000 CCASPDCB EQU HMASMCCA+88 01459000 CCADATE EQU HMASMCCA+85 01460000 CCASREL EQU HMASMCCA+81 01461000 CCANUCID EQU HMASMCCA+80 01462000 @NM00003 EQU CCAFLAG3 01463000 CCACOPYP EQU CCAFLAG3 01464000 CCALINKP EQU CCAFLAG3 01465000 CCAZAPP EQU CCAFLAG3 01466000 @NM00002 EQU CCAFLAG2 01467000 CCATERM EQU CCAFLAG2 01468000 CCASVCLB EQU CCAFLAG2 01469000 CCATSO EQU CCAFLAG2 01470000 CCACPYCP EQU CCAFLAG2 01471000 CCANCPTF EQU CCAFLAG2 01472000 CCALSCDS EQU CCAFLAG2 01473000 CCALSLOG EQU CCAFLAG1 01474000 CCAUPDU EQU CCAFLAG1 01475000 CCAUPDJ EQU CCAFLAG1 01476000 CCARES EQU CCAFLAG1 01477000 CCAREJ EQU CCAFLAG1 01478000 CCAACCPT EQU CCAFLAG1 01479000 CCAAPPLY EQU CCAFLAG1 01480000 CCAREC EQU CCAFLAG1 01481000 @NM00001 EQU CCAOPT 01482000 CCACPOPT EQU CCAOPT 01483000 CCALKOPT EQU CCAOPT 01484000 CCABFPMX EQU HMASMCCA+74 01485000 CCABFMMX EQU HMASMCCA+72 01486000 CCAPEMAX EQU HMASMCCA+70 01487000 CCAMXERR EQU HMASMCCA+68 01488000 CCAJFPTS EQU HMASMCCA+64 01489000 CCAJFCDS EQU HMASMCCA+60 01490000 CCALKSIZ EQU HMASMCCA+56 01491000 CCAUPDTE EQU HMASMCCA+52 01492000 CCAIOSUP EQU HMASMCCA+48 01493000 CCASPZAP EQU HMASMCCA+44 01494000 CCACOPY EQU HMASMCCA+40 01495000 CCAASM EQU HMASMCCA+36 01496000 CCALKED EQU HMASMCCA+32 01497000 CCAPESIZ EQU HMASMCCA+28 01498000 CCAICLMD EQU HMASMCCA+24 01499000 CCAICMOD EQU HMASMCCA+20 01500000 CCAICPTF EQU HMASMCCA+16 01501000 CCAICT EQU HMASMCCA+12 01502000 CCAIOPTR EQU HMASMCCA+8 01503000 CCABUFAD EQU HMASMCCA+4 01504000 CCAID EQU HMASMCCA 01505000 .@UNREFD ANOP END UNREFERENCED COMPONENTS 01506000 @RT00257 EQU FLUSHOUT 01507000 @RF00277 EQU @RC00270 01508000 @RF00280 EQU @RC00270 01509000 @RT00337 EQU CLOSEUP 01510000 @PB00007 EQU @EL00001 01511000 @PB00006 EQU @PB00007 01512000 @PB00005 EQU @PB00006 01513000 @PB00004 EQU @PB00005 01514000 @PB00003 EQU @PB00004 01515000 @PB00002 EQU @PB00003 01516000 @ENDDATA EQU * 01517000 END HMASMIC 01518000 ./ ADD SSI=40250059,NAME=HMASMIO,SOURCE=1 COMPON=DN611 TITLE 'HMASMIO - INPUT/OUTPUT ROUTINE OF SMP *00001000 ' 00002000 HMASMIO CSECT , 0001 00003000 @MAINENT DS 0H 0001 00004000 USING *,@15 0001 00005000 B @PROLOG 0001 00006000 DC AL1(16) 0001 00007000 DC C'HMASMIO 74.025' 0001 00008000 DROP @15 00009000 @PROLOG STM @14,@12,12(@13) 0001 00010000 BALR @12,0 0001 00011000 @PSTART LA @10,4095(,@12) 0001 00012000 USING @PSTART,@12 0001 00013000 USING @PSTART+4095,@10 0001 00014000 MVC @PC00001(4),0(@01) 0001 00015000 * */ 00016000 * 0214 00017000 * /*****************************************************************/ 00018000 * /* */ 00019000 * /* CHECK FOR ENTERED BEFORE AND ADJUST SAVE AREAS */ 00020000 * /* */ 00021000 * /*****************************************************************/ 00022000 * 0214 00023000 * IOPPTR=ADDR(PASSIOP); /* SET UP ADDR OF IOP */ 00024000 L IOPPTR,@PC00001 0214 00025000 * ENTRYCT=ENTRYCT+1; /* BUMP ENTRY COUNTER */ 00026000 LA @04,1 0215 00027000 AH @04,ENTRYCT 0215 00028000 STH @04,ENTRYCT 0215 00029000 * IF ENTRYCT>ENTLMT /* EXCEEDED MAX NUM OF NTRYS */ 00030000 * THEN /* YES - EXIT */ 00031000 CH @04,@CH00103 0216 00032000 BNH @RF00216 0216 00033000 * DO; 0217 00034000 * ENTRYCT=ENTRYCT-1; /* DECR COUNTER */ 00035000 BCTR @04,0 0218 00036000 STH @04,ENTRYCT 0218 00037000 * CCATERM=ON; /* INDICATE TERM SMP */ 00038000 OI CCATERM(CCAPTR),B'00000100' 0219 00039000 * IOPRETRN=IOERRIND; /* SET I/O ERROR */ 00040000 MVI IOPRETRN(IOPPTR),X'08' 0220 00041000 * RETURN; /* EXIT */ 00042000 @EL00001 DS 0H 0221 00043000 @EF00001 DS 0H 0221 00044000 @ER00001 LM @14,@12,12(@13) 0221 00045000 BR @14 0221 00046000 * END; 0222 00047000 * IF ENTRYCT>1 /* IS THIS RE-ENTRY? */ 00048000 * THEN /* YES - GET A SV AREA */ 00049000 @RF00216 LH @04,ENTRYCT 0223 00050000 CH @04,@CH00045 0223 00051000 BNH @RF00223 0223 00052000 * DO; 0224 00053000 * GEN(GETMAIN EC,LV=72,A=GOTCORE);/* GET SAVE AREA */ 00054000 GETMAIN EC,LV=72,A=GOTCORE 00055000 * RFY 0226 00056000 * RTNCDE RSTD; 0226 00057000 * IF RTNCDEª=ZERO /* GOT IT? */ 00058000 * THEN /* NO - EXIT BADLY */ 00059000 LTR RTNCDE,RTNCDE 0227 00060000 BZ @RF00227 0227 00061000 * DO; 0228 00062000 * CCATERM=ON; /* INDICATE TERMINATE */ 00063000 OI CCATERM(CCAPTR),B'00000100' 0229 00064000 * IOPRETRN=IOERRIND; /* INDICATE ERROR */ 00065000 MVI IOPRETRN(IOPPTR),X'08' 0230 00066000 * ENTRYCT=ENTRYCT-1; /* DECREMENT ENTRY COUNTER */ 00067000 LH @14,ENTRYCT 0231 00068000 BCTR @14,0 0231 00069000 STH @14,ENTRYCT 0231 00070000 * RETURN; /* EXIT */ 00071000 B @EL00001 0232 00072000 * END; 0233 00073000 * RFY 0234 00074000 * RTNCDE UNRSTD; 0234 00075000 @RF00227 DS 0H 0235 00076000 * ENTSAVE(ENTRYCT-1)=GOTCORE; /* SAVE ADDR OF GOTTEN CORE */ 00077000 L @04,GOTCORE 0235 00078000 LH @15,ENTRYCT 0235 00079000 SLA @15,2 0235 00080000 ST @04,ENTSAVE-8(@15) 0235 00081000 * R1=GOTCORE; /* SET ADDR OF CORE FOR CHAIN */ 00082000 LR R1,@04 0236 00083000 * END; 0237 00084000 * ELSE /* OTHERWISE - USE REGULAR SV AR */ 00085000 * R1=ADDR(SVAREA1); /* SET PTR TO DCLED AREA */ 00086000 B @RC00223 0238 00087000 @RF00223 LA R1,SVAREA1 0238 00088000 * SVBACK=R13; /* CHAIN BACKWARDS */ 00089000 @RC00223 ST R13,SVBACK(,R1) 0239 00090000 * RFY 0240 00091000 * SVAREAS BASED(R13); 0240 00092000 * SVFWRD=R1; /* CHAIN FORWARDS */ 00093000 ST R1,SVFWRD(,R13) 0241 00094000 * R13=R1; /* SET UP NEW SAVE AREA */ 00095000 LR R13,R1 0242 00096000 * RFY 0243 00097000 * (R1) UNRSTD; 0243 00098000 * 0243 00099000 * /*****************************************************************/ 00100000 * /* */ 00101000 * /* INITIALIZE MGP FIELDS */ 00102000 * /* */ 00103000 * /*****************************************************************/ 00104000 * 0244 00105000 * MGPMGNO2=BINZERO; /* ZERO SECONDARY */ 00106000 MVI MGPMGNO2,X'00' 0244 00107000 * MGPMGNO3=BINZERO; /* ZERO TERIARTY */ 00108000 MVI MGPMGNO3,X'00' 0245 00109000 * MGPFLAGS=BINZERO; /* ZERO FLAG BYTE 0246 00110000 * */ 00111000 MVI MGPFLAGS,X'00' 0246 00112000 * 0247 00113000 * /*****************************************************************/ 00114000 * /* */ 00115000 * /* CHECK FOR CLOSE ALL FUNCTION - LOOP CLOSING ALL OPEN FILES */ 00116000 * /* */ 00117000 * /*****************************************************************/ 00118000 * 0247 00119000 * IF IOPFUNCT=IOPCLOSA /* IS IT CLOSE ALL FUNCTION */ 00120000 * THEN /* YES - CLOSE */ 00121000 CLI IOPFUNCT(IOPPTR),11 0247 00122000 BNE @RF00247 0247 00123000 * DO; 0248 00124000 * DO DCBNO=1 TO NUMOPENS; /* LOOP THRU DCB LIST */ 00125000 LA DCBNO,1 0249 00126000 @DL00249 DS 0H 0250 00127000 * DCBPTR=DCBS(DCBNO); /* GET DCB ADDR */ 00128000 LR @07,DCBNO 0250 00129000 SLA @07,2 0250 00130000 L DCBPTR,DCBS-4(@07) 0250 00131000 * IF DCBOFOPN=ON /* IS THIS DCB OPEN? */ 00132000 * THEN /* YES - CLOSE IT */ 00133000 TM DCBOFOPN+40(DCBPTR),B'00010000' 0251 00134000 BNO @RF00251 0251 00135000 * GEN(CLOSE ((DCBPTR))); /* CLOSE THE DCB */ 00136000 CLOSE ((DCBPTR)) 00137000 * END; 0253 00138000 @RF00251 AH DCBNO,@CH00045 0253 00139000 CH DCBNO,@CH00041 0253 00140000 BNH @DL00249 0253 00141000 * GO TO GOODEXIT; /* RETURN TO CALLER */ 00142000 B GOODEXIT 0254 00143000 * END; 0255 00144000 * 0255 00145000 */********************************************************************/ 00146000 */* */ 00147000 */* DETERMINE DCB NUMBER FROM THE DSID... */ 00148000 */* IF THE DCB CAN HAVE MULTIPLE MODES - THEN DETERMINE TYPE */ 00149000 */* */ 00150000 */********************************************************************/ 00151000 * 0256 00152000 * BUFFSV=IOPBUFAD; /* SAVE BUFFER ADDR */ 00153000 @RF00247 L BUFFSV,IOPBUFAD(,IOPPTR) 0256 00154000 *IOINIT: 0257 00155000 * ; 0257 00156000 IOINIT DS 0H 0258 00157000 * DCBNO=IOPDSID; /* GET DCB NUMBER FROM DSID */ 00158000 SLR DCBNO,DCBNO 0258 00159000 IC DCBNO,IOPDSID(,IOPPTR) 0258 00160000 * IF DCBNOIOPCLOSE /* IS THIS AN OUTPUT OPERATION */ 00165000 * THEN /* YES - BUMP DCB PTR */ 00166000 CLI IOPFUNCT(IOPPTR),4 0260 00167000 BNH @RF00260 0260 00168000 * DCBNO=DCBNO+NUMDCBS; /* TO POINT TO OUTPUT NTRY */ 00169000 AH DCBNO,@CH00033 0261 00170000 *IOCLOSCK: 0262 00171000 * ; 0262 00172000 @RF00260 DS 0H 0262 00173000 @RF00259 DS 0H 0262 00174000 IOCLOSCK DS 0H 0263 00175000 * DCBPTR=DCBS(DCBNO); /* GET PROPER DCB ADDR */ 00176000 LR @04,DCBNO 0263 00177000 SLA @04,2 0263 00178000 L DCBPTR,DCBS-4(@04) 0263 00179000 */********************************************************************/ 00180000 */* */ 00181000 */* DETERMINE IF OP IS CLOSE - IF SO, CLOSE DCB AND EXIT */ 00182000 */* */ 00183000 */********************************************************************/ 00184000 * 0264 00185000 * IF IOPFUNCT=IOPCLOSE /* IS THIS CLOSE OPERATION? */ 00186000 * THEN /* YES - */ 00187000 CLI IOPFUNCT(IOPPTR),4 0264 00188000 BNE @RF00264 0264 00189000 * DO; /* CLOSE THE DCB */ 00190000 * IF DCBOFOPN=ON /* IS THIS DCB OPEN? */ 00191000 * THEN /* YES - THEN OK TO CLOSE */ 00192000 TM DCBOFOPN+40(DCBPTR),B'00010000' 0266 00193000 BNO @RF00266 0266 00194000 * GEN(CLOSE ((DCBPTR))); /* CLOSE THE DCB */ 00195000 CLOSE ((DCBPTR)) 00196000 * IF DCBNOIOPCLOSE /* IS THIS AN OUTPUT OPERATION */ 00492000 * THEN /* YES - DO PROPER OUTPUT OP */ 00493000 @RC00351 DS 0H 0354 00494000 @RC00349 DS 0H 0354 00495000 @RC00347 DS 0H 0354 00496000 @RC00345 DS 0H 0354 00497000 @RC00343 DS 0H 0354 00498000 @RC00341 DS 0H 0354 00499000 @RF00340 CLI IOPFUNCT(IOPPTR),4 0354 00500000 BNH @RF00354 0354 00501000 * DO; 0355 00502000 * 0356 00503000 * /*************************************************************/ 00504000 * /* */ 00505000 * /* FUNCTION IS STOW CHANGE OR DELETE */ 00506000 * /* */ 00507000 * /*************************************************************/ 00508000 * 0356 00509000 * IF IOPFUNCT=IOPSTOWC³ /* IS THIS STOW CHANGE OPERATION */ 00510000 * IOPFUNCT=IOPSTOWD /* OR STOW DELETE OPERATION? */ 00511000 * THEN /* YES - PERFORM OPERATION */ 00512000 CLI IOPFUNCT(IOPPTR),6 0356 00513000 BE @RT00356 0356 00514000 CLI IOPFUNCT(IOPPTR),7 0356 00515000 BNE @RF00356 0356 00516000 @RT00356 DS 0H 0357 00517000 * DO; 0357 00518000 * CALL STOW; /* DELETE OR CHANGE THE ENTRY */ 00519000 BAL @14,STOW 0358 00520000 * GO TO EXIT; /* RETURN TO REQUESTOR */ 00521000 B EXIT 0359 00522000 * END; 0360 00523000 * 0360 00524000 * /*************************************************************/ 00525000 * /* */ 00526000 * /* FUNCTION IS WRITE TO CDS */ 00527000 * /* */ 00528000 * /*************************************************************/ 00529000 * 0361 00530000 * IF IOPFUNCT=IOPWRITE /* IS IT A WRITE OPERATION? */ 00531000 * THEN /* YES - DO WRITE OPERATION */ 00532000 @RF00356 CLI IOPFUNCT(IOPPTR),5 0361 00533000 BNE @RF00361 0361 00534000 * DO; 0362 00535000 * CALL WRITE; /* WRITE RECORD TO THE CDS */ 00536000 BAL @14,WRITE 0363 00537000 * WRITESW=ON; /* INDICATE WRITE PERFORMED */ 00538000 OI WRITESW,B'10000000' 0364 00539000 * GO TO EXIT; /* RETURN WITH GOOD RC */ 00540000 B EXIT 0365 00541000 * END; 0366 00542000 * 0367 00543000 */********************************************************************/ 00544000 */* */ 00545000 */* CDS MEMBER IS TO BE REPLACED - CHECK TYPE OF ENTRY. THE MEMBER */ 00546000 */* MAY CONSISTS ENTIRELY OF A DIRECTORY ENTRY (WITH INFORMATION */ 00547000 */* TOTALLY CONTAINED WITHIN THE USER DATA, OR THE ENTRY MAY HAVE */ 00548000 */* A DIRECTORY EXTENTION ON THE CDS. THE ENTRY MAY ALSO HAVE DATA */ 00549000 */* IN THE CASE OF ASSEMBLIES AND LOAD MODULES. */ 00550000 */* */ 00551000 */********************************************************************/ 00552000 * 0367 00553000 * IF IOPCDTYP=IOPCLMOD³ /* IS THIS A LOAD MOD ENTRY? */ 00554000 * IOPCDTYP=IOPCASM /* OR A ASSEM ENTRY? */ 00555000 * THEN 0367 00556000 @RF00361 TM IOPCDTYP(IOPPTR),B'01000000' 0367 00557000 BNO @GL00006 0367 00558000 TM IOPCDTYP(IOPPTR),B'10000000' 0367 00559000 BZ @RT00367 0367 00560000 @GL00006 TM IOPCDTYP(IOPPTR),B'11000000' 0367 00561000 BZ @RT00367 0367 00562000 * ; 0368 00563000 * ELSE /* IF NOT, THEN THE DATA SET IS */ 00564000 * DO; /* CONTAINED IN THE DIRECTORY */ 00565000 * DO I=1 TO CCAPESIZ; /* LOOP TO FIND END OF DIRECTORY */ 00566000 LA I,1 0370 00567000 B @DE00370 0370 00568000 @DL00370 DS 0H 0371 00569000 * IF DIRCHAR(I)=IOPEOLST/* IS THIS THE END? */ 00570000 * THEN /* YES - MUST EXIT FROM LOOP */ 00571000 SLR @04,@04 0371 00572000 IC @04,DIRCHAR-1(I,IOPPTR) 0371 00573000 CH @04,@CH00342 0371 00574000 BE @RT00371 0371 00575000 * GO TO CALCDISP; /* GO CALCULATE SIZE OF DIR */ 00576000 * END; 0373 00577000 AH I,@CH00045 0373 00578000 @DE00370 C I,CCAPESIZ(,CCAPTR) 0373 00579000 BNH @DL00370 0373 00580000 * 0374 00581000 */********************************************************************/ 00582000 */* */ 00583000 */* IF THE DIRECTORY IS EXTENDED, THEN THE PORTION OF THE */ 00584000 */* DIRECTORY WHICH WILL NOT FIT IN THE USER DATA FIELD IS */ 00585000 */* WRITTEN TO THE CONTROL DATA SET */ 00586000 */*