FCDE TITLE 'BLSSCDE--FIND CONTENTS DIRECTORY ENTRY (CDE) *00001000 ' 00002000 */* CHANGE ACTIVITY -------------------------------------------------*/ 00003000 */* THIS MODULE WAS WRITTEN FOR @G57LPRW */ 00004000 */*------------------------------------------------------------------*/ 00005000 BLSSCDE CSECT , 01S0002 00006000 @MAINENT DS 0H 01S0002 00007000 USING *,@15 01S0002 00008000 B @PROLOG 01S0002 00009000 DC AL1(16) 01S0002 00010000 DC C'BLSSCDE 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 01S0152 00027000 * ESBAPTR=ADDR(ESPA); /* ->ESBA (ALIAS FOR ESPA) */ 00028000 L ESBAPTR,@PC00001+4 01S0153 00029000 * PGMNAME=SYMB; /* PROGRAM NAME */ 00030000 MVC PGMNAME(8),SYMB(ESBAPTR) 01S0154 00031000 * TR(PGMNAME,ZZ1TRUPC); /* EBCDIC LOWER CASE=>UPPER CASE */ 00032000 L @14,ZZ2ZZ1P(,R9) 01S0155 00033000 TR PGMNAME(8),ZZ1TRUPC(@14) 01S0155 00034000 * IF /* IMPROPER NAME FOR A CDE */ 00035000 * SYMA^='CDE'| /* REQUIRED PREFIX */ 00036000 * PGMNAME^=SYMB| /* INVALID PROGRAM NAME */ 00037000 * SYMB=ZZZPGM40| /* BLANK PROGRAM NAME */ 00038000 * ESBASYM(LENGTH(SYM)+1:ZZZSYML)^=BLANKSUF THEN/* SUFFIX */ 00039000 CLC SYMA(3,ESBAPTR),@CC01916 01S0156 00040000 BNE @RT00156 01S0156 00041000 CLC PGMNAME(8),SYMB(ESBAPTR) 01S0156 00042000 BNE @RT00156 01S0156 00043000 CLC SYMB(8,ESBAPTR),@CC00162 01S0156 00044000 BE @RT00156 01S0156 00045000 CLC ESBASYM+11(20,ESBAPTR),BLANKSUF 01S0156 00046000 BNE @RT00156 01S0156 00047000 * GO TO EXIT; /* COMMON EXIT PATH */ 00048000 * ESAUSYM=DTCVTD; /* SYMBOL */ 00049000 MVC ESAUSYM(31),DTCVTD 01S0158 00050000 * ESAUDT=DTCVT; /* DATA TYPE */ 00051000 MVC ESAUDT(34),DTCVT 01S0159 00052000 * CALL BLSRESGU(ZZ2,ESAU); /* LOCATE THE SYSTEM CVT */ 00053000 ST R9,@AL00001 01S0160 00054000 LA @14,ESAU 01S0160 00055000 ST @14,@AL00001+4 01S0160 00056000 L @10,ZZ2RVTP(,R9) 01S0160 00057000 L @15,RVTESGUP(,@10) 01S0160 00058000 LA @01,@AL00001 01S0160 00059000 BALR @14,@15 01S0160 00060000 * RETC=RF; /* RETURN CODE */ 00061000 LR RETC,RF 01S0161 00062000 * IF RF>ZZZFLAGE THEN /* CVT NOT FOUND */ 00063000 CH RF,@CH00054 01S0162 00064000 BH @RT00162 01S0162 00065000 * GO TO EXIT; /* COMMON EXIT PATH */ 00066000 * ESAUSYM='CVTQLPAQ'; /* SYMBOL */ 00067000 MVI ESAUSYM+8,C' ' 01S0164 00068000 MVC ESAUSYM+9(22),ESAUSYM+8 01S0164 00069000 MVC ESAUSYM(8),@CC01973 01S0164 00070000 * ESAUD=DATCQ; /* DATA CHARACTERISTICS */ 00071000 MVC ESAUD(60),DATCQ 01S0165 00072000 * CALL BLSRACC(ZZ2,ESAU,ESAULAD); /* RETRIEVE CVT.CVTQLPAQ */ 00073000 ST R9,@AL00001 01S0166 00074000 LA @14,ESAU 01S0166 00075000 ST @14,@AL00001+4 01S0166 00076000 LA @14,ESAULAD 01S0166 00077000 ST @14,@AL00001+8 01S0166 00078000 L @10,ZZ2RVTP(,R9) 01S0166 00079000 L @15,RVTRACCP(,@10) 01S0166 00080000 LA @01,@AL00001 01S0166 00081000 BALR @14,@15 01S0166 00082000 * IF RF=ZZZFLAGI THEN /* CVT.CVTQLPAQ IMAGE RETRIEVED */ 00083000 * 01S0167 00084000 SLR @14,@14 01S0167 00085000 CR RF,@14 01S0167 00086000 BNE @RF00167 01S0167 00087000 * /***************************************************************/ 00088000 * /* */ 00089000 * /* CVT.CVTQLPAQ IMAGE RETRIEVED */ 00090000 * /* */ 00091000 * /***************************************************************/ 00092000 * 01S0168 00093000 * DO; /* CVT.CVTQLPAQ IMAGE RETRIEVED */ 00094000 * ESAUAS=DATS; /* MASTER ADDRESS SPACE */ 00095000 MVC ESAUAS(16),DATS 01S0169 00096000 * ESAUAS1=ZZ6DQA1; /* PREFERRED CPU ADDRESS */ 00097000 L @10,ZZ2AZZ6P(,R9) 01S0170 00098000 MVC ESAUAS1(4),ZZ6DQA1(@10) 01S0170 00099000 * ESAUSYM='CDEPTR'; /* SYMBOL */ 00100000 MVI ESAUSYM+6,C' ' 01S0171 00101000 MVC ESAUSYM+7(24),ESAUSYM+6 01S0171 00102000 MVC ESAUSYM(6),@CC01974 01S0171 00103000 * ESAUDOF=0; /* NO OFFSET */ 00104000 ST @14,ESAUDOF 01S0172 00105000 * CALL BLSRACC(ZZ2,ESAU,ESBALAD);/* RETRIEVE CDEPTR */ 00106000 ST R9,@AL00001 01S0173 00107000 LA @14,ESAU 01S0173 00108000 ST @14,@AL00001+4 01S0173 00109000 LA @14,ESBALAD(,ESBAPTR) 01S0173 00110000 ST @14,@AL00001+8 01S0173 00111000 L @10,ZZ2RVTP(,R9) 01S0173 00112000 L @15,RVTRACCP(,@10) 01S0173 00113000 LA @01,@AL00001 01S0173 00114000 BALR @14,@15 01S0173 00115000 * END; /* CVT.CVTQLPAQ IMAGE RETRIEVED */ 00116000 * IF RF^=ZZZFLAGI THEN /* IMAGE RETRIEVAL ERROR */ 00117000 * 01S0175 00118000 @RF00167 LTR RF,RF 01S0175 00119000 BZ @RF00175 01S0175 00120000 * /***************************************************************/ 00121000 * /* */ 00122000 * /* IMAGE RETRIEVAL ERROR */ 00123000 * /* */ 00124000 * /***************************************************************/ 00125000 * 01S0176 00126000 * DO; /* IMAGE RETRIEVAL ERROR */ 00127000 * RETC=MAX(RF,ZZZFLAGS); /* RETURN CODE */ 00128000 LA RETC,12 01S0177 00129000 CR RETC,RF 01S0177 00130000 BNL *+6 00131000 LR RETC,RF 01S0177 00132000 * GO TO EXIT; /* COMMON EXIT PATH */ 00133000 B EXIT 01S0178 00134000 * END; /* IMAGE RETRIEVAL ERROR */ 00135000 * FLAG='00'X; /* PROCESSING CONTROL FLAGS */ 00136000 @RF00175 MVI FLAG,X'00' 01S0180 00137000 * CDENTPTR=ADDR(BUF); /* ->CDE IMAGE BUFFER */ 00138000 LA CDENTPTR,BUF 01S0181 00139000 * DATCC=DATCS; /* STORAGE CHARACTERISTICS */ 00140000 MVC DATCC(60),DATCS 01S0182 00141000 * DATCCT=ESBADT; /* CDE DATA TYPE */ 00142000 * 01S0183 00143000 MVC DATCCT(34),ESBADT(ESBAPTR) 01S0183 00144000 * /*****************************************************************/ 00145000 * /* */ 00146000 * /* SEARCH CDE CHAIN */ 00147000 * /* */ 00148000 * /*****************************************************************/ 00149000 * 01S0184 00150000 * DO UNTIL(FLAGEND=ZZZ1); /* SEARCH CDE CHAIN */ 00151000 @DL00184 DS 0H 01S0185 00152000 * ESBAAS=DATS; /* MASTER ADDRESS SPACE */ 00153000 MVC ESBAAS(16,ESBAPTR),DATS 01S0185 00154000 * ESBAAS1=ZZ6DQA1; /* PREFERRED CPU ADDRESS */ 00155000 L @14,ZZ2AZZ6P(,R9) 01S0186 00156000 MVC ESBAAS1(4,ESBAPTR),ZZ6DQA1(@14) 01S0186 00157000 * ESBAD=DATCC; /* STORAGE CHARACTERISTICS */ 00158000 MVC ESBAD(60,ESBAPTR),DATCC 01S0187 00159000 * CALL BLSRSAGU(ZZ2,SAAU,ESBA); /* PROCESS SA RECORD */ 00160000 ST R9,@AL00001 01S0188 00161000 LA @14,SAAU 01S0188 00162000 ST @14,@AL00001+4 01S0188 00163000 ST ESBAPTR,@AL00001+8 01S0188 00164000 L @10,ZZ2RVTP(,R9) 01S0188 00165000 L @15,RVTSAGUP(,@10) 01S0188 00166000 LA @01,@AL00001 01S0188 00167000 BALR @14,@15 01S0188 00168000 * RETC=MAX(RETC,RF,SAAUSRC); /* RETURN CODE */ 00169000 LR @14,RF 01S0189 00170000 CR @14,RETC 01S0189 00171000 BNL *+6 00172000 LR @14,RETC 01S0189 00173000 SLR @10,@10 01S0189 00174000 IC @10,SAAUSRC 01S0189 00175000 CR @14,@10 01S0189 00176000 BNL *+6 00177000 LR @14,@10 01S0189 00178000 LR RETC,@14 01S0189 00179000 * IF RETCZZZFLAGE THEN /* SERIOUS PROCESSING ERROR */ 00217000 * 01S0200 00218000 @RF00190 CH RETC,@CH00054 01S0200 00219000 BNH @RF00200 01S0200 00220000 * /*************************************************************/ 00221000 * /* */ 00222000 * /* SERIOUS PROCESSING ERROR */ 00223000 * /* */ 00224000 * /*************************************************************/ 00225000 * 01S0201 00226000 * DO; /* SERIOUS PROCESSING ERROR */ 00227000 * SYMB=PGMNAME; /* PROGRAM NAME */ 00228000 MVC SYMB(8,ESBAPTR),PGMNAME 01S0202 00229000 * FLAGEND=ZZZ1; /* END CDE PROCESSING */ 00230000 OI FLAGEND,B'10000000' 01S0203 00231000 * END; /* SERIOUS PROCESSING ERROR */ 00232000 * ELSE /* EXAMINE CDE */ 00233000 * 01S0205 00234000 * /*************************************************************/ 00235000 * /* */ 00236000 * /* EXAMINE CDE */ 00237000 * /* */ 00238000 * /*************************************************************/ 00239000 * 01S0205 00240000 * DO; /* EXAMINE CDE */ 00241000 B @RC00200 01S0205 00242000 @RF00200 DS 0H 01S0206 00243000 * SYMB=CDNAME; /* PROGRAM NAME */ 00244000 MVC SYMB(8,ESBAPTR),CDNAME(CDENTPTR) 01S0206 00245000 * ESBAD=ESAUD; /* STORAGE ATTRIBUTES */ 00246000 MVC ESBAD(60,ESBAPTR),ESAUD 01S0207 00247000 * IF CDNAME=PGMNAME THEN /* REQUESTED CDE FOUND */ 00248000 CLC CDNAME(8,CDENTPTR),PGMNAME 01S0208 00249000 BNE @RF00208 01S0208 00250000 * FLAGEND=ZZZ1; /* END CDE PROCESSING */ 00251000 OI FLAGEND,B'10000000' 01S0209 00252000 * ELSE /* REQUESTED CDE NOT YET FOUND */ 00253000 * 01S0210 00254000 * /*********************************************************/ 00255000 * /* */ 00256000 * /* REQUESTED CDE NOT YET FOUND */ 00257000 * /* */ 00258000 * /*********************************************************/ 00259000 * 01S0210 00260000 * DO; /* REQUESTED CDE NOT YET FOUND */ 00261000 B @RC00208 01S0210 00262000 @RF00208 DS 0H 01S0211 00263000 * CALL BLSRESAR(ZZ2,ESBA);/* ADD/REPLACE ES RECORD */ 00264000 ST R9,@AL00001 01S0211 00265000 ST ESBAPTR,@AL00001+4 01S0211 00266000 L @10,ZZ2RVTP(,R9) 01S0211 00267000 L @15,RVTESARP(,@10) 01S0211 00268000 LA @01,@AL00001 01S0211 00269000 BALR @14,@15 01S0211 00270000 * ESBALAD=CDCHAIN; /* ->NEXT CDE ON THE CHAIN */ 00271000 L @14,CDCHAIN(,CDENTPTR) 01S0212 00272000 ST @14,ESBALAD(,ESBAPTR) 01S0212 00273000 * IF ESBALAD=ZZZZNULL THEN/* REQUESTED CDE NOT FOUND */ 00274000 * 01S0213 00275000 LTR @14,@14 01S0213 00276000 BNZ @RF00213 01S0213 00277000 * /*****************************************************/ 00278000 * /* */ 00279000 * /* REQUESTED CDE NOT FOUND */ 00280000 * /* */ 00281000 * /*****************************************************/ 00282000 * 01S0214 00283000 * DO; /* REQUESTED CDE NOT FOUND */ 00284000 * FLAGEND=ZZZ1; /* END CDE PROCESSING */ 00285000 OI FLAGEND,B'10000000' 01S0215 00286000 * RETC=ZZZFLAGS; /* RETURN CODE */ 00287000 LA RETC,12 01S0216 00288000 * END; /* REQUESTED CDE NOT FOUND */ 00289000 * ELSE /* ANOTHER CDE ON THE CHAIN */ 00290000 * SYMB=ZZZPGM40; /* NEUTRAL NAME FOR NEXT CDE */ 00291000 B @RC00213 01S0218 00292000 @RF00213 MVC SYMB(8,ESBAPTR),@CC00162 01S0218 00293000 * END; 01S0219 00294000 @RC00213 DS 0H 01S0220 00295000 * END; 01S0220 00296000 @RC00208 DS 0H 01S0221 00297000 * END; 01S0221 00298000 @RC00200 DS 0H 01S0221 00299000 @DE00184 TM FLAGEND,B'10000000' 01S0221 00300000 BNO @DL00184 01S0221 00301000 * IF RETC