XTLS TITLE 'BLSSXTLS--FIND EXTENT LIST (XTLST) *00001000 ' 00002000 */* CHANGE ACTIVITY -------------------------------------------------*/ 00003000 */* THIS MODULE WAS WRITTEN FOR @G57LPRW */ 00004000 */*------------------------------------------------------------------*/ 00005000 BLSSXTLS CSECT , 01S0002 00006000 @MAINENT DS 0H 01S0002 00007000 USING *,@15 01S0002 00008000 B @PROLOG 01S0002 00009000 DC AL1(16) 01S0002 00010000 DC C'BLSSXTLS 78.080' 01S0002 00011000 DROP @15 00012000 @PROLOG STM @14,@12,12(@13) 01S0002 00013000 BALR @12,0 01S0002 00014000 @PSTART DS 0H 01S0002 00015000 USING @PSTART,@12 01S0002 00016000 L @00,@SIZDATD 01S0002 00017000 BLSUALLS R,LV=(0) 00018000 LR @11,@01 01S0002 00019000 USING @DATD,@11 01S0002 00020000 ST @13,@SA00001+4 01S0002 00021000 LM @00,@01,20(@13) 01S0002 00022000 ST @11,8(,@13) 01S0002 00023000 LR @13,@11 01S0002 00024000 MVC @PC00001(8),0(@01) 01S0002 00025000 * RETC=ZZZFLAGS; /* RETURN CODE */ 00026000 LA RETC,12 01S0144 00027000 * ESBAPTR=ADDR(ESPA); /* ->ESBA (ALIAS FOR ESPA) */ 00028000 L ESBAPTR,@PC00001+4 01S0145 00029000 * PGMNAME=SYMXB; /* PROGRAM NAME */ 00030000 MVC PGMNAME(8),SYMXB(ESBAPTR) 01S0146 00031000 * TR(PGMNAME,ZZ1TRUPC); /* EBCDIC LOWER CASE=>UPPER CASE */ 00032000 L @14,ZZ2ZZ1P(,R9) 01S0147 00033000 TR PGMNAME(8),ZZ1TRUPC(@14) 01S0147 00034000 * IF /* IMPROPER NAME FOR AN XTLST */ 00035000 * SYMXA^='XL'| /* REQUIRED PREFIX */ 00036000 * PGMNAME^=SYMXB| /* INVALID PROGRAM NAME */ 00037000 * SYMXB=BLANKPGM| /* BLANK PROGRAM NAME */ 00038000 * ESBASYM(LENGTH(SYMX)+1:ZZZSYML)^=BLANKSUF THEN/* SUFFIX */ 00039000 CLC SYMXA(2,ESBAPTR),@CC01239 01S0148 00040000 BNE @RT00148 01S0148 00041000 CLC PGMNAME(8),SYMXB(ESBAPTR) 01S0148 00042000 BNE @RT00148 01S0148 00043000 CLC SYMXB(8,ESBAPTR),BLANKPGM 01S0148 00044000 BE @RT00148 01S0148 00045000 CLC ESBASYM+10(21,ESBAPTR),BLANKSUF 01S0148 00046000 BNE @RT00148 01S0148 00047000 * GO TO EXIT; /* COMMON EXIT PATH */ 00048000 * SYMCA='CDE'; /* SYMBOL--PREFIX */ 00049000 MVC SYMCA(3),@CC01235 01S0150 00050000 * SYMCB=PGMNAME; /* SYMBOL--PROGRAM NAME */ 00051000 MVC SYMCB(8),PGMNAME 01S0151 00052000 * ESAUSYM(LENGTH(SYMC)+1:ZZZSYML)=BLANKC;/* SYMBOL--SUFFIX */ 00053000 MVC ESAUSYM+11(20),BLANKC 01S0152 00054000 * ESAUDT=DATCT; /* DATA TYPE */ 00055000 MVC ESAUDT(34),DATCT 01S0153 00056000 * CALL BLSRESGU(ZZ2,ESAU); /* LOCATE THE CDE FOR THE PROGRAM*/ 00057000 ST R9,@AL00001 01S0154 00058000 LA @14,ESAU 01S0154 00059000 ST @14,@AL00001+4 01S0154 00060000 L @10,ZZ2RVTP(,R9) 01S0154 00061000 L @15,RVTESGUP(,@10) 01S0154 00062000 LA @01,@AL00001 01S0154 00063000 BALR @14,@15 01S0154 00064000 * RETC=RF; /* RETURN CODE */ 00065000 LR RETC,RF 01S0155 00066000 * IF RF>ZZZFLAGE THEN /* UNABLE TO LOCATE THE CDE */ 00067000 CH RF,@CH00054 01S0156 00068000 BH @RT00156 01S0156 00069000 * GO TO EXIT; /* COMMON EXIT PATH */ 00070000 * CDENTPTR=ADDR(BUF); /* ->CDE IMAGE BUFFER */ 00071000 LA CDENTPTR,BUF 01S0158 00072000 * ESAUD=DATC; /* STORAGE ATTRIBUTES */ 00073000 MVC ESAUD(60),DATC 01S0159 00074000 * CALL BLSRACC(ZZ2,ESAU,CDENTRY); /* RETRIEVE IMAGE OF CDE */ 00075000 ST R9,@AL00001 01S0160 00076000 LA @14,ESAU 01S0160 00077000 ST @14,@AL00001+4 01S0160 00078000 ST CDENTPTR,@AL00001+8 01S0160 00079000 L @10,ZZ2RVTP(,R9) 01S0160 00080000 L @15,RVTRACCP(,@10) 01S0160 00081000 LA @01,@AL00001 01S0160 00082000 BALR @14,@15 01S0160 00083000 * IF RF^=ZZZFLAGI THEN /* ERROR RETRIEVING CDE IMAGE */ 00084000 * 01S0161 00085000 LTR RF,RF 01S0161 00086000 BZ @RF00161 01S0161 00087000 * /***************************************************************/ 00088000 * /* */ 00089000 * /* ERROR RETRIEVING CDE IMAGE */ 00090000 * /* */ 00091000 * /***************************************************************/ 00092000 * 01S0162 00093000 * DO; /* ERROR RETRIEVING CDE IMAGE */ 00094000 * RETC=MAX(RF,ZZZFLAGS); /* RETURN CODE */ 00095000 LA RETC,12 01S0163 00096000 CR RETC,RF 01S0163 00097000 BNL *+6 00098000 LR RETC,RF 01S0163 00099000 * GO TO EXIT; /* COMMON EXIT PATH */ 00100000 B EXIT 01S0164 00101000 * END; /* ERROR RETRIEVING CDE IMAGE */ 00102000 * IF CDMIN=ZZZ1 THEN /* MINOR ENTRY POINT */ 00103000 * 01S0166 00104000 @RF00161 TM CDMIN(CDENTPTR),B'00000100' 01S0166 00105000 BNO @RF00166 01S0166 00106000 * /***************************************************************/ 00107000 * /* */ 00108000 * /* MINOR ENTRY POINT */ 00109000 * /* */ 00110000 * /***************************************************************/ 00111000 * 01S0167 00112000 * DO; /* MINOR ENTRY POINT */ 00113000 * SYMCB=BLANKPGM; /* NEUTRAL NAME FOR CDE */ 00114000 MVC SYMCB(8),BLANKPGM 01S0168 00115000 * ESAULAD=CDXLMJP; /* ->CDE FOR MAJOR ENTRY POINT */ 00116000 MVC ESAULAD(4),CDXLMJP(CDENTPTR) 01S0169 00117000 * CALL BLSRSAGU(ZZ2,SAAU,ESAU);/* SCAN CDE */ 00118000 ST R9,@AL00001 01S0170 00119000 LA @14,SAAU 01S0170 00120000 ST @14,@AL00001+4 01S0170 00121000 LA @14,ESAU 01S0170 00122000 ST @14,@AL00001+8 01S0170 00123000 L @10,ZZ2RVTP(,R9) 01S0170 00124000 L @15,RVTSAGUP(,@10) 01S0170 00125000 LA @01,@AL00001 01S0170 00126000 BALR @14,@15 01S0170 00127000 * RETC=MAX(RETC,RF,SAAUSRC); /* RETURN CODE */ 00128000 LR @14,RF 01S0171 00129000 CR @14,RETC 01S0171 00130000 BNL *+6 00131000 LR @14,RETC 01S0171 00132000 SLR @10,@10 01S0171 00133000 IC @10,SAAUSRC 01S0171 00134000 CR @14,@10 01S0171 00135000 BNL *+6 00136000 LR @14,@10 01S0171 00137000 LR RETC,@14 01S0171 00138000 * IF RETC>ZZZFLAGE THEN /* SERIOUS ERROR DURING SCAN */ 00139000 CH RETC,@CH00054 01S0172 00140000 BH @RT00172 01S0172 00141000 * GO TO EXIT; /* COMMON EXIT PATH */ 00142000 * ESAUD=DATC; /* STORAGE ATTRIBUTES */ 00143000 MVC ESAUD(60),DATC 01S0174 00144000 * CALL BLSRACC(ZZ2,ESAU,CDENTRY);/* RETRIEVE IMAGE OF CDE */ 00145000 ST R9,@AL00001 01S0175 00146000 LA @14,ESAU 01S0175 00147000 ST @14,@AL00001+4 01S0175 00148000 ST CDENTPTR,@AL00001+8 01S0175 00149000 L @10,ZZ2RVTP(,R9) 01S0175 00150000 L @15,RVTRACCP(,@10) 01S0175 00151000 LA @01,@AL00001 01S0175 00152000 BALR @14,@15 01S0175 00153000 * IF RF^=ZZZFLAGI THEN /* ERROR RETRIEVING MAJOR CDE */ 00154000 * 01S0176 00155000 LTR RF,RF 01S0176 00156000 BZ @RF00176 01S0176 00157000 * /***********************************************************/ 00158000 * /* */ 00159000 * /* ERROR RETRIEVING MAJOR CDE */ 00160000 * /* */ 00161000 * /***********************************************************/ 00162000 * 01S0177 00163000 * DO; /* ERROR RETRIEVING MAJOR CDE */ 00164000 * RETC=MAX(RF,ZZZFLAGS); /* RETURN CODE */ 00165000 LA RETC,12 01S0178 00166000 CR RETC,RF 01S0178 00167000 BNL *+6 00168000 LR RETC,RF 01S0178 00169000 * GO TO EXIT; /* COMMON EXIT PATH */ 00170000 B EXIT 01S0179 00171000 * END; /* ERROR RETRIEVING MAJOR CDE */ 00172000 * END; /* MINOR ENTRY POINT */ 00173000 @RF00176 DS 0H 01S0182 00174000 * IF /* NORMAL CDE */ 00175000 * CDNIC=ZZZ0& /* LOAD NOT IN PROGRESS */ 00176000 * CDMIN=ZZZ0& /* MAJOR CDE */ 00177000 * CDXLE=ZZZ1 THEN /* EXTENT LIST CONSTRUCTED */ 00178000 * 01S0182 00179000 @RF00166 TM CDNIC(CDENTPTR),B'01000100' 01S0182 00180000 BNZ @RF00182 01S0182 00181000 TM CDXLE(CDENTPTR),B'00100000' 01S0182 00182000 BNO @RF00182 01S0182 00183000 * /***************************************************************/ 00184000 * /* */ 00185000 * /* NORMAL CDE */ 00186000 * /* */ 00187000 * /***************************************************************/ 00188000 * 01S0183 00189000 * DO; /* NORMAL CDE */ 00190000 * ESBAAS=ESAUAS; /* ADDRESS SPACE */ 00191000 MVC ESBAAS(16,ESBAPTR),ESAUAS 01S0184 00192000 * ESBALAD=CDXLMJP; /* ->EXTENT LIST */ 00193000 MVC ESBALAD(4,ESBAPTR),CDXLMJP(CDENTPTR) 01S0185 00194000 * CALL BLSRSAGU(ZZ2,SAAU,ESBA);/* SCAN EXTENT LIST */ 00195000 ST R9,@AL00001 01S0186 00196000 LA @14,SAAU 01S0186 00197000 ST @14,@AL00001+4 01S0186 00198000 ST ESBAPTR,@AL00001+8 01S0186 00199000 L @10,ZZ2RVTP(,R9) 01S0186 00200000 L @15,RVTSAGUP(,@10) 01S0186 00201000 LA @01,@AL00001 01S0186 00202000 BALR @14,@15 01S0186 00203000 * RETC=MAX(RETC,RF,SAAUSRC); /* RETURN CODE */ 00204000 LR @14,RF 01S0187 00205000 CR @14,RETC 01S0187 00206000 BNL *+6 00207000 LR @14,RETC 01S0187 00208000 SLR @10,@10 01S0187 00209000 IC @10,SAAUSRC 01S0187 00210000 CR @14,@10 01S0187 00211000 BNL *+6 00212000 LR @14,@10 01S0187 00213000 LR RETC,@14 01S0187 00214000 * IF RETC