TITLE 'EP=BLSCABLD - IPCS DAS BUILD SVC99 TUS FROM ALLOCATE PL*00001000 LIST ' 00002000 * /* CHANGE ACTIVITY 00003000 * THIS MODULE IS WRITTEN FOR @G57LPSR 00004000 BLSCABLD CSECT , 0002 00005000 @MAINENT DS 0H 0002 00006000 USING *,@15 0002 00007000 B @PROLOG 0002 00008000 DC AL1(16) 0002 00009000 DC C'BLSCABLD 78.062' 0002 00010000 DROP @15 00011000 @PROLOG STM @14,@12,12(@13) 0002 00012000 BALR @11,0 0002 00013000 @PSTART LA @12,4095(,@11) 0002 00014000 USING @PSTART,@11 0002 00015000 USING @PSTART+4095,@12 0002 00016000 L @00,@SIZDATD 0002 00017000 BLSCGETS R,LV=(0) 00018000 LR @10,@01 0002 00019000 USING @DATD,@10 0002 00020000 ST @13,@SA00001+4 0002 00021000 LM @00,@01,20(@13) 0002 00022000 ST @10,8(,@13) 0002 00023000 LR @13,@10 0002 00024000 * DMCBPTR=GPR01P; /* BASE THE DMCB AND DMAL */ 00025000 LR DMCBPTR,GPR01P 0041 00026000 * RFY 0042 00027000 * GPR01P UNRSTD; 0042 00028000 * MODNAME=LMODNMC; 0043 00029000 MVC MODNAME(8),@CC00680 0043 00030000 * RETCODE=F0C; 0044 00031000 SLR @05,@05 0044 00032000 ST @05,RETCODE 0044 00033000 * SUBCODE=F0C; 0045 00034000 ST @05,SUBCODE 0045 00035000 * S99TUFP=F0C; /* INIT THE TEXT UNIT MULTIPLE 0046 00036000 * ENTRY BASE (UNUSED VARIABLE) */ 00037000 * 0046 00038000 SLR S99TUFP,S99TUFP 0046 00039000 * /*****************************************************************/ 00040000 * /* */ 00041000 * /* CONSTRUCT DYNALLOC PARM LIST ENTRIES FROM THE ALLOCATION MODEL*/ 00042000 * /* OVERRIDE PARAMETERS */ 00043000 * /* */ 00044000 * /*****************************************************************/ 00045000 * 0047 00046000 * ALSW=OFF; /* SET ALPARM LIST END SWITCH OFF*/ 00047000 NI ALSW,B'01111111' 0047 00048000 * ALBAS=DMALPRMP; /* SET ALPARM BASE TO PLIST START*/ 00049000 L ALBAS,DMALPRMP(,DMCBPTR) 0048 00050000 * IF ALBAS=F0C THEN /* TEST FOR NO OVERRIDE PARMS */ 00051000 CR ALBAS,@05 0049 00052000 BNE @RF00049 0049 00053000 * ALSW=ON; /* NO OVERRIDE PARAMETERS SO 0050 00054000 * THERE IS NOTHING TO DO */ 00055000 OI ALSW,B'10000000' 0050 00056000 * DMALTUPM=F0C; /* OVERRIDE PARM COUNT = 0 */ 00057000 @RF00049 SLR @05,@05 0051 00058000 ST @05,DMALTUPM(,DMCBPTR) 0051 00059000 * DMALTUBS=ADDR(DMALTUS); /* POINT MERGE TEXT UNIT AREA TO 00060000 * BEGINNING OF TXT UNIT SPACE */ 00061000 LA @05,DMALTUS(,DMCBPTR) 0052 00062000 ST @05,DMALTUBS(,DMCBPTR) 0052 00063000 * S99TXTPP=ADDR(DMALTUPL); /* SET DYNALLOC TU PTR LIST BASE */ 00064000 LA @15,DMALTUPL(,DMCBPTR) 0053 00065000 ST @15,S99TXTPP(,DMCBPTR) 0053 00066000 * S99TUPLX=F1C; /* INIT THE S99 TU PTR LIST INDEX*/ 00067000 LA S99TUPLX,1 0054 00068000 * S99TUBAS=ADDR(DMALTUS); /* START OF TEXT UNIT AREA */ 00069000 LR S99TUBAS,@05 0055 00070000 * S99TUPLM=F0C; /* LAST USED TEXT UNIT PTR INDEX */ 00071000 SLR S99TUPLM,S99TUPLM 0056 00072000 * DO WHILE ALSW=OFF; /* PROCESS ALPARM LIST TO BUILD 00073000 * TEXT UNITS */ 00074000 B @DE00057 0057 00075000 @DL00057 DS 0H 0058 00076000 * MLEN=F0C; /* INIT TEXT UNIT VALUE MOVE LEN */ 00077000 SLR MLEN,MLEN 0058 00078000 * TLEN=F0C; /* INIT TEXT UNIT LENGTH */ 00079000 SLR TLEN,TLEN 0059 00080000 * ALOPT=ALOP&LHEX7FC; /* ELIMINATE LAST ENTRY BIT FROM 00081000 * KEY CODE */ 00082000 LA ALOPT,127 0060 00083000 SLR @09,@09 0060 00084000 IC @09,ALOP(,ALBAS) 0060 00085000 NR ALOPT,@09 0060 00086000 * IF ALOPT<=F0C|ALOPT>ALMSVGP THEN/* TEST FOR INVALID KEY */ 00087000 LTR ALOPT,ALOPT 0061 00088000 BNP @RT00061 0061 00089000 C ALOPT,@CF00517 0061 00090000 BNH @RF00061 0061 00091000 @RT00061 DS 0H 0062 00092000 * DO; /* INVALID ALLOCATION MODEL 0062 00093000 * OVERRIDE PARAMETER KEY */ 00094000 * CHSTR867=ALOPT; /* GET KEY FIELD */ 00095000 STCM ALOPT,3,CHSTR867 0063 00096000 * CHSTR88=LHEX0FC; /* TRANSLATE IT TO CHARACTER HEX */ 00097000 MVI CHSTR88,X'0F' 0064 00098000 * UNPK(CTEMP,CHSTR8); 0065 00099000 UNPK CTEMP(9),CHSTR8(8) 0065 00100000 * TR(CTEMP,HEXTBL); 0066 00101000 TR CTEMP(9),HEXTBL 0066 00102000 * DO; /* BLSDMSG 0067 00103000 * (ZZ2,F3102C,DMCBMSG,BLSDMSGS) 00104000 * INSERT(DMCBMODL,CTEMP72) */ 00105000 * IOPTLIST(1)=ADDR(IOPTLIST(4));/* CHAIN TO NEXT INSERT */ 00106000 LA @06,IOPTLIST+12 0068 00107000 ST @06,IOPTLIST 0068 00108000 * IOPTLIST(2)=ADDR(DMCBMODL);/* INSERT NAME POINTER */ 00109000 LA @06,DMCBMODL(,DMCBPTR) 0069 00110000 ST @06,IOPTLIST+4 0069 00111000 * IOPTLIST(3)=0; /* ZERO RESERVED FIELD */ 00112000 SLR @06,@06 0070 00113000 ST @06,IOPTLIST+8 0070 00114000 * RFY 0071 00115000 * I015F BASED(ADDR(IOPTLIST(3)));/* ACCESS BYTES 1-2 */ 00116000 * I015F=LENGTH(DMCBMODL); /* INSERT LENGTH */ 00117000 LA @05,IOPTLIST+8 0072 00118000 MVC I015F(2,@05),@CH00046 0072 00119000 * IOPTLIST(4)=0; /* LAST INSERT */ 00120000 ST @06,IOPTLIST+12 0073 00121000 * IOPTLIST(5)=ADDR(CTEMP72);/* INSERT NAME POINTER */ 00122000 LA @05,CTEMP72 0074 00123000 ST @05,IOPTLIST+16 0074 00124000 * IOPTLIST(6)=0; /* ZERO RESERVED FIELD */ 00125000 ST @06,IOPTLIST+20 0075 00126000 * RFY 0076 00127000 * I015F BASED(ADDR(IOPTLIST(6)));/* ACCESS BYTES 1-2 */ 00128000 * I015F=LENGTH(CTEMP72); /* INSERT LENGTH */ 00129000 LA @06,IOPTLIST+20 0077 00130000 MVC I015F(2,@06),@CH00074 0077 00131000 * CALL BLSDMSG0(ZZ2,F3102C,DMCBMSG,BLSDMSGS,'00000000'B,ADDR( 00132000 * IOPTLIST)); /* BUILD MESSAGE */ 00133000 L @06,DMCBTVP(,DMCBPTR) 0078 00134000 ST @06,@AL00001 0078 00135000 LA @06,@CF00646 0078 00136000 ST @06,@AL00001+4 0078 00137000 LA @06,DMCBMSG(,DMCBPTR) 0078 00138000 ST @06,@AL00001+8 0078 00139000 L @06,DMCBMSGS(,DMCBPTR) 0078 00140000 ST @06,@AL00001+12 0078 00141000 LA @06,@CB00712 0078 00142000 ST @06,@AL00001+16 0078 00143000 LA @06,IOPTLIST 0078 00144000 ST @06,@AFTEMPS+16 0078 00145000 LA @06,@AFTEMPS+16 0078 00146000 ST @06,@AL00001+20 0078 00147000 L @15,DMCBMSG0(,DMCBPTR) 0078 00148000 LA @01,@AL00001 0078 00149000 BALR @14,@15 0078 00150000 * END; /* BLSDMSG 0079 00151000 * (ZZ2,F3102C,DMCBMSG,BLSDMSGS) 00152000 * INSERT(DMCBMODL,CTEMP72) BUILD 00153000 * INVALID KEYCODE MESSAGE */ 00154000 * RETCODE=ERROR; /* MARK ERROR */ 00155000 MVC RETCODE(4),@CF00046 0080 00156000 * END; /* INVALID ALLOCATION MODEL 0081 00157000 * OVERRIDE PARAMETER KEY */ 00158000 * ELSE 0082 00159000 * CALL VALPROC; /* PROCESS VALID ALLOCATION 0082 00160000 * OVERRIDE KEY */ 00161000 B @RC00061 0082 00162000 @RF00061 BAL @14,VALPROC 0082 00163000 * END; /* PROCESS ALPARM LIST TO BUILD 00164000 * TEXT UNITS */ 00165000 * 0083 00166000 @RC00061 DS 0H 0083 00167000 @DE00057 TM ALSW,B'10000000' 0083 00168000 BZ @DL00057 0083 00169000 * /*****************************************************************/ 00170000 * /* */ 00171000 * /* BUILD OF DYNALLOC TEXT UNITS COMPLETE, RETURN TO CALLER */ 00172000 * /* */ 00173000 * /*****************************************************************/ 00174000 * 0084 00175000 * IF RETCODE^=F0C THEN /* TEST FOR ERROR */ 00176000 SLR @05,@05 0084 00177000 C @05,RETCODE 0084 00178000 BE @RF00084 0084 00179000 * DMCBDRBP=F0C; /* MARK DYNALLOC PLIST NOT USABLE*/ 00180000 ST @05,DMCBDRBP(,DMCBPTR) 0085 00181000 * RETURN CODE(RETCODE); 0086 00182000 @RF00084 L @09,RETCODE 0086 00183000 L @13,4(,@13) 0086 00184000 L @00,@SIZDATD 0086 00185000 LR @01,@10 0086 00186000 BLSCFRES R,LV=(0),A=(1) 00187000 LR @15,@09 0086 00188000 L @14,12(,@13) 0086 00189000 LM @00,@12,20(@13) 0086 00190000 BR @14 0086 00191000 * 0087 00192000 * /*****************************************************************/ 00193000 * /* */ 00194000 * /* PROCEDURE TO PROCESS A VALID ALLOCATION OVERRIDE KEY */ 00195000 * /* */ 00196000 * /*****************************************************************/ 00197000 * 0087 00198000 *VALPROC: 0087 00199000 * PROCEDURE; /* VALID ALLOCATION MODEL 0087 00200000 * OVERRIDE PARAMETER KEY */ 00201000 VALPROC STM @14,@01,@SA00002 0087 00202000 STM @04,@06,@SA00002+16 0087 00203000 STM @08,@12,@SA00002+28 0087 00204000 * CALL KEYPROC; /* DO OVERRIDE KEY PROCESSING */ 00205000 BAL @14,KEYPROC 0088 00206000 * IF RETCODE=F0C THEN /* TEST FOR VALID KEY PROCESSING */ 00207000 L @09,RETCODE 0089 00208000 LTR @09,@09 0089 00209000 BNZ @RF00089 0089 00210000 * DO; /* UPDATE LIST CONTROLS */ 00211000 * S99TUPLM=S99TUPLX; /* SAVE LAST USED TU PTR INDEX */ 00212000 LR S99TUPLM,S99TUPLX 0091 00213000 * S99TUBAS=S99TUBAS+MLEN+TLEN+F1C&LHWORDC;/* BUMP TU BASE TO 0092 00214000 * NEXT AVAILABLE HALF WORD */ 00215000 LR @09,S99TUBAS 0092 00216000 ALR @09,MLEN 0092 00217000 ALR @09,TLEN 0092 00218000 AL @09,@CF00048 0092 00219000 N @09,@CF00664 0092 00220000 LR S99TUBAS,@09 0092 00221000 * IF ALVL=ON THEN /* TEST FOR LAST LIST ELEMENT */ 00222000 TM ALVL(ALBAS),B'10000000' 0093 00223000 BNO @RF00093 0093 00224000 * DO; /* LAST LIST ELEMENT */ 00225000 * ALSW=ON; /* TERMINATE LIST PROCESSING */ 00226000 OI ALSW,B'10000000' 0095 00227000 * DMALTUPM=S99TUPLM; /* REMEMBER LAST USED TU PTR INDX*/ 00228000 ST S99TUPLM,DMALTUPM(,DMCBPTR) 0096 00229000 * DMALTUBS=S99TUBAS; /* REMEMBER NXT AVAILABLE TU SPCE*/ 00230000 ST S99TUBAS,DMALTUBS(,DMCBPTR) 0097 00231000 * END; /* LAST LIST ELEMENT */ 00232000 * ELSE 0099 00233000 * CALL SETNEXT; /* SET UP FOR NEXT PLIST ENTRY */ 00234000 B @RC00093 0099 00235000 @RF00093 BAL @14,SETNEXT 0099 00236000 * END; /* UPDATE LIST CONTROLS */ 00237000 * END VALPROC; /* VALID ALLOCATION MODEL 0101 00238000 * OVERRIDE PARAMETER KEY */ 00239000 @EL00002 DS 0H 0101 00240000 @EF00002 DS 0H 0101 00241000 @ER00002 LM @14,@01,@SA00002 0101 00242000 LM @04,@06,@SA00002+16 0101 00243000 LM @08,@12,@SA00002+28 0101 00244000 BR @14 0101 00245000 * 0102 00246000 * /*****************************************************************/ 00247000 * /* */ 00248000 * /* PROCEDURE TO SET UP FOR NEXT ALLOC OVERRIDE PLIST ENTRY */ 00249000 * /* */ 00250000 * /*****************************************************************/ 00251000 * 0102 00252000 *SETNEXT: 0102 00253000 * PROCEDURE; /* SETUP FOR NEXT PLIST ENTRY */ 00254000 SETNEXT STM @14,@02,@SA00003 0102 00255000 STM @04,@06,@SA00003+20 0102 00256000 STM @08,@12,@SA00003+32 0102 00257000 * S99TUPLX=S99TUPLX+F1C; /* BUMP TO NEXT TU PTR SLOT */ 00258000 AL S99TUPLX,@CF00048 0103 00259000 * ALBAS=ALBAS+F4C; /* BUMP TO NEXT PLIST ENTRY */ 00260000 AL ALBAS,@CF00039 0104 00261000 * IF S99TUPLX>DIM(DMALTUPL) THEN /* TEST FOR TOO MANY TU PTRS */ 00262000 C S99TUPLX,@CF00086 0105 00263000 BNH @RF00105 0105 00264000 * DO; /* TOO MANY TU PTRS */ 00265000 * DO; /* BLSDMSG 0107 00266000 * (ZZ2,F3106C,DMCBMSG,BLSDMSGS) 00267000 * INSERT(MODNAME,DMCBMODL) */ 00268000 * IOPTLIST(1)=ADDR(IOPTLIST(4));/* CHAIN TO NEXT INSERT */ 00269000 LA @06,IOPTLIST+12 0108 00270000 ST @06,IOPTLIST 0108 00271000 * IOPTLIST(2)=ADDR(MODNAME);/* INSERT NAME POINTER */ 00272000 LA @06,MODNAME 0109 00273000 ST @06,IOPTLIST+4 0109 00274000 * IOPTLIST(3)=0; /* ZERO RESERVED FIELD */ 00275000 SLR @06,@06 0110 00276000 ST @06,IOPTLIST+8 0110 00277000 * RFY 0111 00278000 * I015F BASED(ADDR(IOPTLIST(3)));/* ACCESS BYTES 1-2 */ 00279000 * I015F=LENGTH(MODNAME); /* INSERT LENGTH */ 00280000 LA @05,8 0112 00281000 LA @15,IOPTLIST+8 0112 00282000 STH @05,I015F(,@15) 0112 00283000 * IOPTLIST(4)=0; /* LAST INSERT */ 00284000 ST @06,IOPTLIST+12 0113 00285000 * IOPTLIST(5)=ADDR(DMCBMODL);/* INSERT NAME POINTER */ 00286000 LA @15,DMCBMODL(,DMCBPTR) 0114 00287000 ST @15,IOPTLIST+16 0114 00288000 * IOPTLIST(6)=0; /* ZERO RESERVED FIELD */ 00289000 ST @06,IOPTLIST+20 0115 00290000 * RFY 0116 00291000 * I015F BASED(ADDR(IOPTLIST(6)));/* ACCESS BYTES 1-2 */ 00292000 * I015F=LENGTH(DMCBMODL); /* INSERT LENGTH */ 00293000 LA @06,IOPTLIST+20 0117 00294000 STH @05,I015F(,@06) 0117 00295000 * CALL BLSDMSG0(ZZ2,F3106C,DMCBMSG,BLSDMSGS,'00000000'B,ADDR( 00296000 * IOPTLIST)); /* BUILD MESSAGE */ 00297000 L @06,DMCBTVP(,DMCBPTR) 0118 00298000 ST @06,@AL00001 0118 00299000 LA @06,@CF00652 0118 00300000 ST @06,@AL00001+4 0118 00301000 LA @06,DMCBMSG(,DMCBPTR) 0118 00302000 ST @06,@AL00001+8 0118 00303000 L @06,DMCBMSGS(,DMCBPTR) 0118 00304000 ST @06,@AL00001+12 0118 00305000 LA @06,@CB00712 0118 00306000 ST @06,@AL00001+16 0118 00307000 LA @06,IOPTLIST 0118 00308000 ST @06,@AFTEMPS 0118 00309000 LA @06,@AFTEMPS 0118 00310000 ST @06,@AL00001+20 0118 00311000 L @15,DMCBMSG0(,DMCBPTR) 0118 00312000 LA @01,@AL00001 0118 00313000 BALR @14,@15 0118 00314000 * END; /* BLSDMSG 0119 00315000 * (ZZ2,F3106C,DMCBMSG,BLSDMSGS) 00316000 * INSERT(MODNAME,DMCBMODL) BUILD 00317000 * TOO MANY TU PTRS MESSAGE */ 00318000 * RETCODE=ERROR; /* MARK ERROR */ 00319000 MVC RETCODE(4),@CF00046 0120 00320000 * ALSW=ON; /* TERMINATE LIST PROCESSING */ 00321000 OI ALSW,B'10000000' 0121 00322000 * END; /* TOO MANY TU PTRS */ 00323000 * IF S99TUBAS>ADDR(DMALEND) THEN /* TEST FOR OUT OF TU SPACE */ 00324000 @RF00105 LA @06,DMALEND(,DMCBPTR) 0123 00325000 CR S99TUBAS,@06 0123 00326000 BNH @RF00123 0123 00327000 * DO; /* OUT OF TU SPACE */ 00328000 * DO; /* BLSDMSG 0125 00329000 * (ZZ2,F3107C,DMCBMSG,BLSDMSGS) 00330000 * INSERT(MODNAME,DMCBMODL) */ 00331000 * IOPTLIST(1)=ADDR(IOPTLIST(4));/* CHAIN TO NEXT INSERT */ 00332000 LA @06,IOPTLIST+12 0126 00333000 ST @06,IOPTLIST 0126 00334000 * IOPTLIST(2)=ADDR(MODNAME);/* INSERT NAME POINTER */ 00335000 LA @06,MODNAME 0127 00336000 ST @06,IOPTLIST+4 0127 00337000 * IOPTLIST(3)=0; /* ZERO RESERVED FIELD */ 00338000 SLR @06,@06 0128 00339000 ST @06,IOPTLIST+8 0128 00340000 * RFY 0129 00341000 * I015F BASED(ADDR(IOPTLIST(3)));/* ACCESS BYTES 1-2 */ 00342000 * I015F=LENGTH(MODNAME); /* INSERT LENGTH */ 00343000 LA @05,8 0130 00344000 LA @15,IOPTLIST+8 0130 00345000 STH @05,I015F(,@15) 0130 00346000 * IOPTLIST(4)=0; /* LAST INSERT */ 00347000 ST @06,IOPTLIST+12 0131 00348000 * IOPTLIST(5)=ADDR(DMCBMODL);/* INSERT NAME POINTER */ 00349000 LA @15,DMCBMODL(,DMCBPTR) 0132 00350000 ST @15,IOPTLIST+16 0132 00351000 * IOPTLIST(6)=0; /* ZERO RESERVED FIELD */ 00352000 ST @06,IOPTLIST+20 0133 00353000 * RFY 0134 00354000 * I015F BASED(ADDR(IOPTLIST(6)));/* ACCESS BYTES 1-2 */ 00355000 * I015F=LENGTH(DMCBMODL); /* INSERT LENGTH */ 00356000 LA @06,IOPTLIST+20 0135 00357000 STH @05,I015F(,@06) 0135 00358000 * CALL BLSDMSG0(ZZ2,F3107C,DMCBMSG,BLSDMSGS,'00000000'B,ADDR( 00359000 * IOPTLIST)); /* BUILD MESSAGE */ 00360000 L @06,DMCBTVP(,DMCBPTR) 0136 00361000 ST @06,@AL00001 0136 00362000 LA @06,@CF00654 0136 00363000 ST @06,@AL00001+4 0136 00364000 LA @06,DMCBMSG(,DMCBPTR) 0136 00365000 ST @06,@AL00001+8 0136 00366000 L @06,DMCBMSGS(,DMCBPTR) 0136 00367000 ST @06,@AL00001+12 0136 00368000 LA @06,@CB00712 0136 00369000 ST @06,@AL00001+16 0136 00370000 LA @06,IOPTLIST 0136 00371000 ST @06,@AFTEMPS 0136 00372000 LA @06,@AFTEMPS 0136 00373000 ST @06,@AL00001+20 0136 00374000 L @15,DMCBMSG0(,DMCBPTR) 0136 00375000 LA @01,@AL00001 0136 00376000 BALR @14,@15 0136 00377000 * END; /* BLSDMSG 0137 00378000 * (ZZ2,F3107C,DMCBMSG,BLSDMSGS) 00379000 * INSERT(MODNAME,DMCBMODL) BUILD 00380000 * OUT OF TU SPACE MESSAGE */ 00381000 * RETCODE=ERROR; /* MARK ERROR */ 00382000 MVC RETCODE(4),@CF00046 0138 00383000 * ALSW=ON; /* TERMINATE LIST PROCESSING */ 00384000 OI ALSW,B'10000000' 0139 00385000 * END; /* OUT OF TU SPACE */ 00386000 * END SETNEXT; /* SETUP FOR NEXT PLIST ENTRY */ 00387000 @EL00003 DS 0H 0141 00388000 @EF00003 DS 0H 0141 00389000 @ER00003 LM @14,@02,@SA00003 0141 00390000 LM @04,@06,@SA00003+20 0141 00391000 LM @08,@12,@SA00003+32 0141 00392000 BR @14 0141 00393000 * 0142 00394000 * /*****************************************************************/ 00395000 * /* */ 00396000 * /* PROCEDURE TO DO OVERRIDE KEY PROCESSING */ 00397000 * /* */ 00398000 * /*****************************************************************/ 00399000 * 0142 00400000 *KEYPROC: 0142 00401000 * PROCEDURE; 0142 00402000 KEYPROC STM @14,@02,@SA00004 0142 00403000 ST @04,@SA00004+20 0142 00404000 STM @06,@07,@SA00004+24 0142 00405000 STM @09,@12,@SA00004+32 0142 00406000 *DSNAL: 0143 00407000 * DO; /* DSNAL:CASE(ALOPT)NAMES(DDNAMC, 00408000 * DSNAMC,MEMBRC,STATSC,NDISPC,CD 00409000 * ISPC,TRKC,CYLC,BLKLNC,PRIMEC,S 00410000 * ECNDC,BAD,RLSEC,SPFRMC,ROUNDC, 00411000 * VLSERC,BAD,BAD,BAD,BAD,UNITC,B 00412000 * AD,BAD,SYSOUC,SPGNMC,SFMNOC,OU 00413000 * TLMC,BAD,COPYSC,LABELC,DSSEQC, 00414000 * PASPRC,BAD,BAD,RETPDC,BAD,BAD, 00415000 * BAD,BAD,BAD,BAD,BAD,BAD,BAD,BA 00416000 * D,BAD,BAD,BLKSZC,BAD,BAD,BAD,B 00417000 * AD,BAD,BAD,BAD,BAD,BAD,BAD,BAD 00418000 * ,BAD,BAD,BAD,BAD,BAD,BAD,LRECL 00419000 * C,BAD,BAD,BAD,BAD,BAD,BAD,RECF 00420000 * MC,BAD,BAD,BAD,BAD,BAD,BAD,PAS 00421000 * SWC,BAD,BAD,BAD,BAD,BAD,BAD,BA 00422000 * D,SUSERC,SHOLDC,BAD,BAD,BAD,BA 00423000 * D,BAD) */ 00424000 DSNAL DS 0H 0144 00425000 * DCL 0144 00426000 * CL0001@ LABEL BASED(CP0001@(ALOPT)) VALUERANGE(DDNAMC,DSNAMC, 00427000 * MEMBRC,STATSC,NDISPC,CDISPC,TRKC,CYLC,BLKLNC,PRIMEC,SECNDC, 00428000 * BAD,RLSEC,SPFRMC,ROUNDC,VLSERC,BAD,BAD,BAD,BAD,UNITC,BAD, 00429000 * BAD,SYSOUC,SPGNMC,SFMNOC,OUTLMC,BAD,COPYSC,LABELC,DSSEQC, 00430000 * PASPRC,BAD,BAD,RETPDC,BAD,BAD,BAD,BAD,BAD,BAD,BAD,BAD,BAD, 00431000 * BAD,BAD,BAD,BLKSZC,BAD,BAD,BAD,BAD,BAD,BAD,BAD,BAD,BAD,BAD, 00432000 * BAD,BAD,BAD,BAD,BAD,BAD,BAD,LRECLC,BAD,BAD,BAD,BAD,BAD,BAD, 00433000 * RECFMC,BAD,BAD,BAD,BAD,BAD,BAD,PASSWC,BAD,BAD,BAD,BAD,BAD, 00434000 * BAD,BAD,SUSERC,SHOLDC,BAD,BAD,BAD,BAD,BAD);/* BRANCH 0144 00435000 * TARGET */ 00436000 * DCL 0145 00437000 * CP0001@(94) PTR(31) INIT(ADDR(DDNAMC),ADDR(DSNAMC),ADDR(MEMBRC) 00438000 * ,ADDR(STATSC),ADDR(NDISPC),ADDR(CDISPC),ADDR(TRKC),ADDR( 00439000 * CYLC),ADDR(BLKLNC),ADDR(PRIMEC),ADDR(SECNDC),ADDR(BAD),ADDR 00440000 * (RLSEC),ADDR(SPFRMC),ADDR(ROUNDC),ADDR(VLSERC),ADDR(BAD), 00441000 * ADDR(BAD),ADDR(BAD),ADDR(BAD),ADDR(UNITC),ADDR(BAD),ADDR( 00442000 * BAD),ADDR(SYSOUC),ADDR(SPGNMC),ADDR(SFMNOC),ADDR(OUTLMC), 00443000 * ADDR(BAD),ADDR(COPYSC),ADDR(LABELC),ADDR(DSSEQC),ADDR( 0145 00444000 * PASPRC),ADDR(BAD),ADDR(BAD),ADDR(RETPDC),ADDR(BAD),ADDR(BAD 00445000 * ),ADDR(BAD),ADDR(BAD),ADDR(BAD),ADDR(BAD),ADDR(BAD),ADDR( 00446000 * BAD),ADDR(BAD),ADDR(BAD),ADDR(BAD),ADDR(BAD),ADDR(BLKSZC), 00447000 * ADDR(BAD),ADDR(BAD),ADDR(BAD),ADDR(BAD),ADDR(BAD),ADDR(BAD) 00448000 * ,ADDR(BAD),ADDR(BAD),ADDR(BAD),ADDR(BAD),ADDR(BAD),ADDR(BAD 00449000 * ),ADDR(BAD),ADDR(BAD),ADDR(BAD),ADDR(BAD),ADDR(BAD),ADDR( 00450000 * LRECLC),ADDR(BAD),ADDR(BAD),ADDR(BAD),ADDR(BAD),ADDR(BAD), 00451000 * ADDR(BAD),ADDR(RECFMC),ADDR(BAD),ADDR(BAD),ADDR(BAD),ADDR( 00452000 * BAD),ADDR(BAD),ADDR(BAD),ADDR(PASSWC),ADDR(BAD),ADDR(BAD), 00453000 * ADDR(BAD),ADDR(BAD),ADDR(BAD),ADDR(BAD),ADDR(BAD),ADDR( 00454000 * SUSERC),ADDR(SHOLDC),ADDR(BAD),ADDR(BAD),ADDR(BAD),ADDR(BAD 00455000 * ),ADDR(BAD)); 0145 00456000 * GOTO CL0001@; /* BRANCH TO SELECTED CASE 5D - 00457000 * 5E */ 00458000 LR @09,ALOPT 0146 00459000 SLA @09,2 0146 00460000 L @09,CP0001@-4(@09) 0146 00461000 BR @09 0146 00462000 * 0147 00463000 * /***************************************************************/ 00464000 * /* */ 00465000 * /* PROCESS DDNAME KEY */ 00466000 * /* */ 00467000 * /***************************************************************/ 00468000 * 0147 00469000 *DDNAMC: 0147 00470000 * DO; /* SUBCASE DDNAME PROCESSING */ 00471000 DDNAMC DS 0H 0148 00472000 * CALL BLDVLTU(DALDDNAM,F8C); /* BUILD DDNAME TEXT UNIT */ 00473000 LA @01,@AL00148 0148 00474000 BAL @14,BLDVLTU 0148 00475000 * IF ALSW=OFF&MLEN>F0C THEN /* TEST THAT TEXT UNIT IS VALID */ 00476000 TM ALSW,B'10000000' 0149 00477000 BNZ @RF00149 0149 00478000 LTR MLEN,MLEN 0149 00479000 BNP @RF00149 0149 00480000 * DO; /* MOVE DDNAME TO DMCB */ 00481000 * RFY 0151 00482000 * S99TUNIT BASED(S99TUBAS); 0151 00483000 * DMCBDDNM=''; /* INIT THE DDNAME ENTRY */ 00484000 MVI DMCBDDNM(DMCBPTR),C' ' 0152 00485000 MVC DMCBDDNM+1(7,DMCBPTR),DMCBDDNM(DMCBPTR) 0152 00486000 * DMCBDDNM(F1C:MLEN)=S99TUPAR(F1C:MLEN);/* MOVE IN THE 0153 00487000 * DDNAME */ 00488000 LR @09,MLEN 0153 00489000 BCTR @09,0 0153 00490000 EX @09,@SM00938 0153 00491000 * END; /* MOVE DDNAME TO DMCB */ 00492000 * GOTO CE0001@; /* BRANCH TO END OF CASE */ 00493000 B CE0001@ 0155 00494000 * END DDNAMC; /* END OF SUBCASE */ 00495000 * 0156 00496000 * /***************************************************************/ 00497000 * /* */ 00498000 * /* PROCESS DSNAME KEY */ 00499000 * /* */ 00500000 * /***************************************************************/ 00501000 * 0157 00502000 *DSNAMC: 0157 00503000 * DO; /* SUBCASE DSNAME PROCESSING */ 00504000 DSNAMC DS 0H 0158 00505000 * CALL BLDVLTU(DALDSNAM,F44C);/* BUILD DSNAME TEXT UNIT */ 00506000 LA @01,@AL00158 0158 00507000 BAL @14,BLDVLTU 0158 00508000 * IF ALSW=OFF&MLEN>F0C THEN /* TEST THAT TEXT UNIT IS VALID */ 00509000 TM ALSW,B'10000000' 0159 00510000 BNZ @RF00159 0159 00511000 LTR MLEN,MLEN 0159 00512000 BNP @RF00159 0159 00513000 * DO; /* MOVE DSNAME TO DMCB */ 00514000 * RFY 0161 00515000 * S99TUNIT BASED(S99TUBAS); 0161 00516000 * DMCBDSN=''; /* INIT THE DSN ENTRY */ 00517000 MVI DMCBDSN(DMCBPTR),C' ' 0162 00518000 MVC DMCBDSN+1(43,DMCBPTR),DMCBDSN(DMCBPTR) 0162 00519000 * DMCBDSN(F1C:MLEN)=S99TUPAR(F1C:MLEN);/* MOVE IN THE 0163 00520000 * DSNAME */ 00521000 LR @09,MLEN 0163 00522000 BCTR @09,0 0163 00523000 EX @09,@SM00940 0163 00524000 * END; /* MOVE DSNAME TO DMCB */ 00525000 * GOTO CE0001@; /* BRANCH TO END OF CASE */ 00526000 B CE0001@ 0165 00527000 * END DSNAMC; /* END OF SUBCASE */ 00528000 * 0166 00529000 * /***************************************************************/ 00530000 * /* */ 00531000 * /* PROCESS MEMBER KEY */ 00532000 * /* */ 00533000 * /***************************************************************/ 00534000 * 0167 00535000 *MEMBRC: 0167 00536000 * DO; /* SUBCASE MEMBER PROCESSING */ 00537000 MEMBRC DS 0H 0168 00538000 * CALL BLDVLTU(DALMEMBR,F8C); /* BUILD MEMBER TEXT UNIT */ 00539000 LA @01,@AL00168 0168 00540000 BAL @14,BLDVLTU 0168 00541000 * IF ALSW=OFF&MLEN>F0C THEN /* TEST THAT TEXT UNIT IS VALID */ 00542000 TM ALSW,B'10000000' 0169 00543000 BNZ @RF00169 0169 00544000 LTR MLEN,MLEN 0169 00545000 BNP @RF00169 0169 00546000 * DO; /* MOVE MEMBER TO DMCB */ 00547000 * RFY 0171 00548000 * S99TUNIT BASED(S99TUBAS); 0171 00549000 * DMCBMEMB=''; /* INIT THE MEMBER ENTRY */ 00550000 MVI DMCBMEMB(DMCBPTR),C' ' 0172 00551000 MVC DMCBMEMB+1(7,DMCBPTR),DMCBMEMB(DMCBPTR) 0172 00552000 * DMCBMEMB(F1C:MLEN)=S99TUPAR(F1C:MLEN);/* MOVE IN THE 0173 00553000 * MEMBER */ 00554000 LR @09,MLEN 0173 00555000 BCTR @09,0 0173 00556000 EX @09,@SM00942 0173 00557000 * END; /* MOVE MEMBER TO DMCB */ 00558000 * GOTO CE0001@; /* BRANCH TO END OF CASE */ 00559000 B CE0001@ 0175 00560000 * END MEMBRC; /* END OF SUBCASE */ 00561000 * 0176 00562000 * /***************************************************************/ 00563000 * /* */ 00564000 * /* PROCESS DISP STATUS KEY */ 00565000 * /* */ 00566000 * /***************************************************************/ 00567000 * 0177 00568000 *STATSC: 0177 00569000 * DO; /* SUBCASE STATUS CODE PROCESSING*/ 00570000 STATSC DS 0H 0178 00571000 * IF ALPRB4F1^=F0C THEN /* TEST FOR IMMEDIATE TEXT UNIT 00572000 * KEY VALUE */ 00573000 CLI ALPRB4F1(ALBAS),0 0178 00574000 BE @RF00178 0178 00575000 * CALL BLDV1TU(DALSTATS,ALPRB4C1);/* BUILD DISP STATUS TEXT 00576000 * UNIT */ 00577000 LA @09,@CB00337 0179 00578000 ST @09,@AL00001 0179 00579000 LA @09,ALPRB4C1(,ALBAS) 0179 00580000 ST @09,@AL00001+4 0179 00581000 LA @01,@AL00001 0179 00582000 BAL @14,BLDV1TU 0179 00583000 * ELSE 0180 00584000 * DO; /* BUILD DISP STATUS TEXT UNIT 0180 00585000 * FROM INDIRECT PARM FIELD */ 00586000 B @RC00178 0180 00587000 @RF00178 DS 0H 0181 00588000 * ALBAS=ALBAS+F4C; /* BUMP PLIST BASE TO PARM VALUE 00589000 * ADDRESS */ 00590000 AL ALBAS,@CF00039 0181 00591000 * IF ALPTC1^=LBLNKC THEN /* TEST FOR NON-NULL PARM VALUE */ 00592000 L @09,ALPTR(,ALBAS) 0182 00593000 CLI ALPTC1(@09),C' ' 0182 00594000 BE @RF00182 0182 00595000 * DO; /* NON-NULL PARM VALUE FIELD, 0183 00596000 * OBTAIN TEXT UNIT PARM VALUE */ 00597000 * CALL MATCH(STATSP,LENGTH(STATSTR),STATSTR,FTMP8);/* 00598000 * GET TU PARM */ 00599000 ST @09,@AL00001 0184 00600000 LA @09,@CF00184 0184 00601000 ST @09,@AL00001+4 0184 00602000 LA @09,STATSTR 0184 00603000 ST @09,@AL00001+8 0184 00604000 LA @09,FTMP8 0184 00605000 ST @09,@AL00001+12 0184 00606000 LA @01,@AL00001 0184 00607000 BAL @14,MATCH 0184 00608000 * IF FTMP8^=F0C THEN /* TEST FOR VALID PARM VALUE */ 00609000 CLI FTMP8,0 0185 00610000 BE @RF00185 0185 00611000 * CALL BLDV1TU(DALSTATS,FTMP8);/* BUILD DISP STATUS 00612000 * TEXT UNIT */ 00613000 LA @09,@CB00337 0186 00614000 ST @09,@AL00001 0186 00615000 LA @09,FTMP8 0186 00616000 ST @09,@AL00001+4 0186 00617000 LA @01,@AL00001 0186 00618000 BAL @14,BLDV1TU 0186 00619000 * ELSE 0187 00620000 * DO; /* INVALID PARM VALUE */ 00621000 B @RC00185 0187 00622000 @RF00185 DS 0H 0188 00623000 * ALSW=ON; /* TERMINATE LIST PROCESSING */ 00624000 OI ALSW,B'10000000' 0188 00625000 * CALL PARMERR(LENGTH(DMCBMODL),DMCBMODL,LENGTH( 0189 00626000 * DISPSTKY),DISPSTKY,LENGTH(STATSP),STATSP);/* 00627000 * ISSUE ERROR MESSAGE */ 00628000 MVC @AL00001(20),@AL00189 0189 00629000 LA @09,DMCBMODL(,DMCBPTR) 0189 00630000 ST @09,@AL00001+4 0189 00631000 L @09,ALPTR(,ALBAS) 0189 00632000 ST @09,@AL00001+20 0189 00633000 LA @01,@AL00001 0189 00634000 BAL @14,PARMERR 0189 00635000 * END; /* INVALID PARM VALUE */ 00636000 * END; /* NON-NULL PARM VALUE FIELD, 0191 00637000 * OBTAIN TEXT UNIT PARM VALUE */ 00638000 @RC00185 DS 0H 0192 00639000 * END; /* BUILD DISP STATUS TEXT UNIT 0192 00640000 * FROM INDIRECT PARM FIELD */ 00641000 @RF00182 DS 0H 0193 00642000 * IF ALSW=OFF THEN /* TEST THAT TEXT UNIT IS VALID */ 00643000 @RC00178 TM ALSW,B'10000000' 0193 00644000 BNZ @RF00193 0193 00645000 * DO; /* MOVE DS STATUS TO DMCB */ 00646000 * RFY 0195 00647000 * S99TUNIT BASED(S99TUBAS); 0195 00648000 * DMCBSTAT=S99TUPR1; /* MOVE IN THE DS STATUS */ 00649000 MVC DMCBSTAT(1,DMCBPTR),S99TUPR1(S99TUBAS) 0196 00650000 * IF DMCBVSF=ON& /* TEST FOR VSAM DATA SET */ 00651000 * (DMCBSTAT=STATNEW| /* AND FOR DS STATUS = NEW OR MOD*/ 00652000 * DMCBSTAT=STATMOD) THEN 0197 00653000 TM DMCBVSF(DMCBPTR),B'00000001' 0197 00654000 BNO @RF00197 0197 00655000 CLI DMCBSTAT(DMCBPTR),4 0197 00656000 BE @RT00197 0197 00657000 CLI DMCBSTAT(DMCBPTR),2 0197 00658000 BNE @RF00197 0197 00659000 @RT00197 DS 0H 0198 00660000 * S99TUPR1=STATSHR; /* FORCE DS STATUS TO SHARE */ 00661000 MVI S99TUPR1(S99TUBAS),X'08' 0198 00662000 * END; /* MOVE DS STATUS TO DMCB */ 00663000 * GOTO CE0001@; /* BRANCH TO END OF CASE */ 00664000 B CE0001@ 0200 00665000 * END STATSC; /* END OF SUBCASE */ 00666000 * 0201 00667000 * /***************************************************************/ 00668000 * /* */ 00669000 * /* PROCESS NORMAL DISPOSITION KEY */ 00670000 * /* */ 00671000 * /***************************************************************/ 00672000 * 0202 00673000 *NDISPC: 0202 00674000 * DO; /* SUBCASE NORMAL DISPOSITION 0202 00675000 * PROCESSING */ 00676000 NDISPC DS 0H 0203 00677000 * IF ALPRB4F1^=F0C THEN /* TEST FOR IMMEDIATE TEXT UNIT 00678000 * KEY VALUE */ 00679000 CLI ALPRB4F1(ALBAS),0 0203 00680000 BE @RF00203 0203 00681000 * CALL BLDV1TU(DALNDISP,ALPRB4C1);/* BUILD NORMAL DISP TEXT 00682000 * UNIT */ 00683000 LA @09,@CB00339 0204 00684000 ST @09,@AL00001 0204 00685000 LA @09,ALPRB4C1(,ALBAS) 0204 00686000 ST @09,@AL00001+4 0204 00687000 LA @01,@AL00001 0204 00688000 BAL @14,BLDV1TU 0204 00689000 * ELSE 0205 00690000 * DO; /* BUILD NORMAL DISPOSITION TEXT 00691000 * UNIT FROM INDIRECT PARM FIELD */ 00692000 B @RC00203 0205 00693000 @RF00203 DS 0H 0206 00694000 * ALBAS=ALBAS+F4C; /* BUMP PLIST BASE TO PARM VALUE 00695000 * ADDRESS */ 00696000 AL ALBAS,@CF00039 0206 00697000 * IF ALPTC1^=LBLNKC THEN /* TEST FOR NON-NULL PARM VALUE */ 00698000 L @09,ALPTR(,ALBAS) 0207 00699000 CLI ALPTC1(@09),C' ' 0207 00700000 BE @RF00207 0207 00701000 * DO; /* NON-NULL PARM VALUE FIELD, 0208 00702000 * OBTAIN TEXT UNIT PARM VALUE */ 00703000 * CALL MATCH(NDISPP,LENGTH(DISPSTR),DISPSTR,FTMP8);/* 00704000 * GET TU PARM */ 00705000 ST @09,@AL00001 0209 00706000 LA @09,@CF00929 0209 00707000 ST @09,@AL00001+4 0209 00708000 LA @09,DISPSTR 0209 00709000 ST @09,@AL00001+8 0209 00710000 LA @09,FTMP8 0209 00711000 ST @09,@AL00001+12 0209 00712000 LA @01,@AL00001 0209 00713000 BAL @14,MATCH 0209 00714000 * IF FTMP8^=F0C THEN /* TEST FOR VALID PARM VALUE */ 00715000 CLI FTMP8,0 0210 00716000 BE @RF00210 0210 00717000 * CALL BLDV1TU(DALNDISP,FTMP8);/* BUILD NORMAL 0211 00718000 * DISPOSITION TEXT UNIT */ 00719000 LA @09,@CB00339 0211 00720000 ST @09,@AL00001 0211 00721000 LA @09,FTMP8 0211 00722000 ST @09,@AL00001+4 0211 00723000 LA @01,@AL00001 0211 00724000 BAL @14,BLDV1TU 0211 00725000 * ELSE 0212 00726000 * DO; /* INVALID PARM VALUE */ 00727000 B @RC00210 0212 00728000 @RF00210 DS 0H 0213 00729000 * ALSW=ON; /* TERMINATE LIST PROCESSING */ 00730000 OI ALSW,B'10000000' 0213 00731000 * CALL PARMERR(LENGTH(DMCBMODL),DMCBMODL,LENGTH( 0214 00732000 * NDISPKY),NDISPKY,LENGTH(NDISPP),NDISPP);/* 0214 00733000 * ISSUE ERROR MESSAGE */ 00734000 MVC @AL00001(20),@AL00214 0214 00735000 LA @09,DMCBMODL(,DMCBPTR) 0214 00736000 ST @09,@AL00001+4 0214 00737000 L @09,ALPTR(,ALBAS) 0214 00738000 ST @09,@AL00001+20 0214 00739000 LA @01,@AL00001 0214 00740000 BAL @14,PARMERR 0214 00741000 * END; /* INVALID PARM VALUE */ 00742000 * END; /* NON-NULL PARM VALUE FIELD, 0216 00743000 * OBTAIN TEXT UNIT PARM VALUE */ 00744000 @RC00210 DS 0H 0217 00745000 * END; /* BUILD NORMAL DISPOSITION TEXT 00746000 * UNIT FROM INDIRECT PARM FIELD */ 00747000 @RF00207 DS 0H 0218 00748000 * IF ALSW=OFF THEN /* TEST THAT TEXT UNIT IS VALID */ 00749000 @RC00203 TM ALSW,B'10000000' 0218 00750000 BNZ @RF00218 0218 00751000 * DO; /* MOVE DS NORMAL DISP TO DMCB */ 00752000 * RFY 0220 00753000 * S99TUNIT BASED(S99TUBAS); 0220 00754000 * DMCBDISP=S99TUPR1; /* MOVE IN THE DS NORMAL DISP */ 00755000 MVC DMCBDISP(1,DMCBPTR),S99TUPR1(S99TUBAS) 0221 00756000 * IF DMCBVSF=ON THEN /* TEST FOR VSAM DATA SET */ 00757000 TM DMCBVSF(DMCBPTR),B'00000001' 0222 00758000 BNO @RF00222 0222 00759000 * S99TUPR1=DISPKEEP; /* FORCE TEXT UNIT DS NORMAL DISP 00760000 * TO KEEP */ 00761000 MVI S99TUPR1(S99TUBAS),X'08' 0223 00762000 * END; /* MOVE DS NORMAL DISP TO DMCB */ 00763000 * GOTO CE0001@; /* BRANCH TO END OF CASE */ 00764000 B CE0001@ 0225 00765000 * END NDISPC; /* END OF SUBCASE */ 00766000 * 0226 00767000 * /***************************************************************/ 00768000 * /* */ 00769000 * /* PROCESS CONDITIONAL DISPOSITION KEY */ 00770000 * /* */ 00771000 * /***************************************************************/ 00772000 * 0227 00773000 *CDISPC: 0227 00774000 * DO; /* SUBCASE CONDITIONAL 0227 00775000 * DISPOSITION PROCESSING */ 00776000 CDISPC DS 0H 0228 00777000 * IF ALPRB4F1^=F0C THEN /* TEST FOR IMMEDIATE TEXT UNIT 00778000 * KEY VALUE */ 00779000 CLI ALPRB4F1(ALBAS),0 0228 00780000 BE @RF00228 0228 00781000 * CALL BLDV1TU(DALCDISP,ALPRB4C1);/* BUILD CONDITIONAL DISP 00782000 * TEXT UNIT */ 00783000 LA @09,@CB00341 0229 00784000 ST @09,@AL00001 0229 00785000 LA @09,ALPRB4C1(,ALBAS) 0229 00786000 ST @09,@AL00001+4 0229 00787000 LA @01,@AL00001 0229 00788000 BAL @14,BLDV1TU 0229 00789000 * ELSE 0230 00790000 * DO; /* BUILD CONDITIONAL DISP TEXT 0230 00791000 * UNIT FROM INDIRECT PARM FIELD */ 00792000 B @RC00228 0230 00793000 @RF00228 DS 0H 0231 00794000 * ALBAS=ALBAS+F4C; /* BUMP PLIST BASE TO PARM VALUE 00795000 * ADDRESS */ 00796000 AL ALBAS,@CF00039 0231 00797000 * IF ALPTC1^=LBLNKC THEN /* TEST FOR NON-NULL PARM VALUE */ 00798000 L @09,ALPTR(,ALBAS) 0232 00799000 CLI ALPTC1(@09),C' ' 0232 00800000 BE @RF00232 0232 00801000 * DO; /* NON-NULL PARM VALUE FIELD, 0233 00802000 * OBTAIN TEXT UNIT PARM VALUE */ 00803000 * CALL MATCH(CDISPP,LENGTH(DISPSTR),DISPSTR,FTMP8);/* 00804000 * GET TU PARM */ 00805000 ST @09,@AL00001 0234 00806000 LA @09,@CF00929 0234 00807000 ST @09,@AL00001+4 0234 00808000 LA @09,DISPSTR 0234 00809000 ST @09,@AL00001+8 0234 00810000 LA @09,FTMP8 0234 00811000 ST @09,@AL00001+12 0234 00812000 LA @01,@AL00001 0234 00813000 BAL @14,MATCH 0234 00814000 * IF FTMP8^=F0C THEN /* TEST FOR VALID PARM VALUE */ 00815000 CLI FTMP8,0 0235 00816000 BE @RF00235 0235 00817000 * CALL BLDV1TU(DALCDISP,FTMP8);/* BUILD CONDITIONAL 00818000 * DISP TEXT UNIT */ 00819000 LA @09,@CB00341 0236 00820000 ST @09,@AL00001 0236 00821000 LA @09,FTMP8 0236 00822000 ST @09,@AL00001+4 0236 00823000 LA @01,@AL00001 0236 00824000 BAL @14,BLDV1TU 0236 00825000 * ELSE 0237 00826000 * DO; /* INVALID PARM VALUE */ 00827000 B @RC00235 0237 00828000 @RF00235 DS 0H 0238 00829000 * ALSW=ON; /* TERMINATE LIST PROCESSING */ 00830000 OI ALSW,B'10000000' 0238 00831000 * CALL PARMERR(LENGTH(DMCBMODL),DMCBMODL,LENGTH( 0239 00832000 * CDISPKY),CDISPKY,LENGTH(CDISPP),CDISPP);/* 0239 00833000 * ISSUE ERROR MESSAGE */ 00834000 MVC @AL00001(20),@AL00239 0239 00835000 LA @09,DMCBMODL(,DMCBPTR) 0239 00836000 ST @09,@AL00001+4 0239 00837000 L @09,ALPTR(,ALBAS) 0239 00838000 ST @09,@AL00001+20 0239 00839000 LA @01,@AL00001 0239 00840000 BAL @14,PARMERR 0239 00841000 * END; /* INVALID PARM VALUE */ 00842000 * END; /* NON-NULL PARM VALUE FIELD, 0241 00843000 * OBTAIN TEXT UNIT PARM VALUE */ 00844000 @RC00235 DS 0H 0242 00845000 * END; /* BUILD CONDITIONAL DISP TEXT 0242 00846000 * UNIT FROM INDIRECT PARM FIELD */ 00847000 @RF00232 DS 0H 0243 00848000 * RFY 0243 00849000 * S99TUNIT BASED(S99TUBAS); 0243 00850000 @RC00228 DS 0H 0244 00851000 * IF ALSW=OFF& /* TEST THAT TEXT UNIT IS VALID */ 00852000 * DMCBVSF=ON THEN /* AND FOR VSAM DATA SET */ 00853000 TM ALSW,B'10000000' 0244 00854000 BNZ @RF00244 0244 00855000 TM DMCBVSF(DMCBPTR),B'00000001' 0244 00856000 BNO @RF00244 0244 00857000 * S99TUPR1=DISPKEEP; /* FORCE TEXT UNIT DS CONDITIONAL 00858000 * DISP TO KEEP */ 00859000 MVI S99TUPR1(S99TUBAS),X'08' 0245 00860000 * GOTO CE0001@; /* BRANCH TO END OF CASE */ 00861000 B CE0001@ 0246 00862000 * END CDISPC; /* END OF SUBCASE */ 00863000 * 0247 00864000 * /***************************************************************/ 00865000 * /* */ 00866000 * /* PROCESS TRACK ALLOCATION KEY */ 00867000 * /* */ 00868000 * /***************************************************************/ 00869000 * 0248 00870000 *TRKC: 0248 00871000 * DO; /* SUBCASE TRK ALLOCATION */ 00872000 TRKC DS 0H 0249 00873000 * CALL BLDV0TU(DALTRK); /* BUILD DS TRACK ALLOCATION TEXT 00874000 * UNIT */ 00875000 LA @01,@AL00249 0249 00876000 BAL @14,BLDV0TU 0249 00877000 * DMCBSPTY=LTRKC; /* SET DMCB SPACE TYPE FIELD */ 00878000 MVC DMCBSPTY(3,DMCBPTR),@CC00676 0250 00879000 * GOTO CE0001@; /* BRANCH TO END OF CASE */ 00880000 B CE0001@ 0251 00881000 * END TRKC; /* END OF SUBCASE */ 00882000 * 0252 00883000 * /***************************************************************/ 00884000 * /* */ 00885000 * /* PROCESS CYLINDER ALLOCATION KEY */ 00886000 * /* */ 00887000 * /***************************************************************/ 00888000 * 0253 00889000 *CYLC: 0253 00890000 * DO; /* SUBCASE CYLINDER ALLOCATION */ 00891000 CYLC DS 0H 0254 00892000 * CALL BLDV0TU(DALCYL); /* BUILD DS CYLINDER ALLOCATION 00893000 * TEXT UNIT */ 00894000 LA @01,@AL00254 0254 00895000 BAL @14,BLDV0TU 0254 00896000 * DMCBSPTY=LCYLC; /* SET DMCB SPACE TYPE FIELD */ 00897000 MVC DMCBSPTY(3,DMCBPTR),@CC00674 0255 00898000 * GOTO CE0001@; /* BRANCH TO END OF CASE */ 00899000 B CE0001@ 0256 00900000 * END CYLC; /* END OF SUBCASE */ 00901000 * 0257 00902000 * /***************************************************************/ 00903000 * /* */ 00904000 * /* PROCESS BLOCK LENGTH ALLOCATION KEY */ 00905000 * /* */ 00906000 * /***************************************************************/ 00907000 * 0258 00908000 *BLKLNC: 0258 00909000 * DO; /* SUBCASE BLOCK LENGTH 0258 00910000 * ALLOCATION */ 00911000 BLKLNC DS 0H 0259 00912000 * ALBAS=ALBAS+F4C; /* BUMP PLIST BASE TO PARM VALUE 00913000 * ADDR */ 00914000 AL ALBAS,@CF00039 0259 00915000 * CALL BLDP3TU(DALBLKLN); /* BUILD DS BLOCK LENGTH ALLOC 0260 00916000 * TEXT UNIT */ 00917000 LA @01,@AL00260 0260 00918000 BAL @14,BLDP3TU 0260 00919000 * DMCBSPTY=ALPTB2C3; /* SET DMCB SPACE TYPE FIELD */ 00920000 L @09,ALPTR(,ALBAS) 0261 00921000 MVC DMCBSPTY(3,DMCBPTR),ALPTB2C3(@09) 0261 00922000 * GOTO CE0001@; /* BRANCH TO END OF CASE */ 00923000 B CE0001@ 0262 00924000 * END BLKLNC; /* END OF SUBCASE */ 00925000 * 0263 00926000 * /***************************************************************/ 00927000 * /* */ 00928000 * /* PROCESS PRIMARY ALLOCATION VALUE KEY */ 00929000 * /* */ 00930000 * /***************************************************************/ 00931000 * 0264 00932000 *PRIMEC: 0264 00933000 * DO; /* SUBCASE PRIMARY ALLOCATION 0264 00934000 * VALUE */ 00935000 PRIMEC DS 0H 0265 00936000 * ALBAS=ALBAS+F4C; /* BUMP PLIST BASE TO PARM VALUE 00937000 * ADDR */ 00938000 AL ALBAS,@CF00039 0265 00939000 * IF ALPTF31>F0C THEN /* TEST FOR NON-NULL PARM VALUE */ 00940000 L @09,ALPTR(,ALBAS) 0266 00941000 L @09,ALPTF31(,@09) 0266 00942000 LTR @09,@09 0266 00943000 BNP @RF00266 0266 00944000 * CALL BLDP3TU(DALPRIME); /* BUILD DS PRIMARY SPACE ALLOC 00945000 * TEXT UNIT */ 00946000 LA @01,@AL00267 0267 00947000 BAL @14,BLDP3TU 0267 00948000 * DMCBSPPR=ALPTF31; /* SET DMCB PRIMARY SPACE VALUE */ 00949000 @RF00266 L @09,ALPTR(,ALBAS) 0268 00950000 L @09,ALPTF31(,@09) 0268 00951000 ST @09,DMCBSPPR(,DMCBPTR) 0268 00952000 * GOTO CE0001@; /* BRANCH TO END OF CASE */ 00953000 B CE0001@ 0269 00954000 * END PRIMEC; /* END OF SUBCASE */ 00955000 * 0270 00956000 * /***************************************************************/ 00957000 * /* */ 00958000 * /* PROCESS SECONDARY ALLOCATION VALUE KEY */ 00959000 * /* */ 00960000 * /***************************************************************/ 00961000 * 0271 00962000 *SECNDC: 0271 00963000 * DO; /* SUBCASE SECONDARY ALLOCATION 00964000 * VALUE */ 00965000 SECNDC DS 0H 0272 00966000 * ALBAS=ALBAS+F4C; /* BUMP PLIST BASE TO PARM VALUE 00967000 * ADDR */ 00968000 AL ALBAS,@CF00039 0272 00969000 * IF ALPTF31>=F0C THEN /* TEST FOR NON-NULL PARM VALUE */ 00970000 L @09,ALPTR(,ALBAS) 0273 00971000 L @09,ALPTF31(,@09) 0273 00972000 LTR @09,@09 0273 00973000 BM @RF00273 0273 00974000 * CALL BLDP3TU(DALSECND); /* BUILD DS SECONDARY SPACE ALLOC 00975000 * TEXT UNIT */ 00976000 LA @01,@AL00274 0274 00977000 BAL @14,BLDP3TU 0274 00978000 * DMCBSPSE=ALPTF31; /* SET DMCB SECONDARY SPACE VALUE*/ 00979000 @RF00273 L @09,ALPTR(,ALBAS) 0275 00980000 L @09,ALPTF31(,@09) 0275 00981000 ST @09,DMCBSPSE(,DMCBPTR) 0275 00982000 * GOTO CE0001@; /* BRANCH TO END OF CASE */ 00983000 B CE0001@ 0276 00984000 * END SECNDC; /* END OF SUBCASE SECONDARY 0277 00985000 * ALLOCATION VALUE */ 00986000 * 0277 00987000 * /***************************************************************/ 00988000 * /* */ 00989000 * /* PROCESS RELEASE UNUSED SPACE AT UNALLOCATION KEY */ 00990000 * /* */ 00991000 * /***************************************************************/ 00992000 * 0278 00993000 *RLSEC: 0278 00994000 * DO; /* SUBCASE ALLOCATION RELEASE 0278 00995000 * UNUSED SPACE AT UNALLOCATION */ 00996000 RLSEC DS 0H 0279 00997000 * CALL BLDV0TU(DALRLSE); /* BUILD ALLOCATION RELEASE SPACE 00998000 * TEXT UNIT */ 00999000 LA @01,@AL00279 0279 01000000 BAL @14,BLDV0TU 0279 01001000 * DMCBSPRL=ON; /* SET DMCB RELEASE SPACE VALUE */ 01002000 OI DMCBSPRL(DMCBPTR),B'10000000' 0280 01003000 * GOTO CE0001@; /* BRANCH TO END OF CASE */ 01004000 B CE0001@ 0281 01005000 * END RLSEC; /* END OF SUBCASE ALLOCATION 0282 01006000 * RELEASE UNUSED SPACE AT 0282 01007000 * UNALLOCATION */ 01008000 * 0282 01009000 * /***************************************************************/ 01010000 * /* */ 01011000 * /* PROCESS ALLOCATION SPACE FORMAT KEY */ 01012000 * /* */ 01013000 * /***************************************************************/ 01014000 * 0283 01015000 *SPFRMC: 0283 01016000 * DO; /* SUBCASE ALLOCATION SPACE 0283 01017000 * FORMAT */ 01018000 SPFRMC DS 0H 0284 01019000 * CALL BLDV1TU(DALSPFRM,ALPRB4C1);/* BUILD DS SPACE FORMAT TXT 01020000 * UNIT */ 01021000 LA @09,@CB00357 0284 01022000 ST @09,@AL00001 0284 01023000 LA @09,ALPRB4C1(,ALBAS) 0284 01024000 ST @09,@AL00001+4 0284 01025000 LA @01,@AL00001 0284 01026000 BAL @14,BLDV1TU 0284 01027000 * DMCBSPCT=ON; /* DMCB CONTIGUOUS SPACE VALUE */ 01028000 OI DMCBSPCT(DMCBPTR),B'01000000' 0285 01029000 * GOTO CE0001@; /* BRANCH TO END OF CASE */ 01030000 B CE0001@ 0286 01031000 * END SPFRMC; /* END OF SUBCASE ALLOCATION 0287 01032000 * SPACE FORMAT */ 01033000 * 0287 01034000 * /***************************************************************/ 01035000 * /* */ 01036000 * /* PROCESS ROUND TO CYLINDER KEY */ 01037000 * /* */ 01038000 * /***************************************************************/ 01039000 * 0288 01040000 *ROUNDC: 0288 01041000 * DO; /* SUBCASE ALLOCATION ROUND TO 0288 01042000 * CYLINDER */ 01043000 ROUNDC DS 0H 0289 01044000 * CALL BLDV0TU(DALROUND); /* BUILD ALLOCATION ROUND TO CYL 01045000 * TEXT UNIT */ 01046000 LA @01,@AL00289 0289 01047000 BAL @14,BLDV0TU 0289 01048000 * DMCBSPRN=ON; /* DMCB ROUND SPACE TO CYL VALUE */ 01049000 OI DMCBSPRN(DMCBPTR),B'00100000' 0290 01050000 * GOTO CE0001@; /* BRANCH TO END OF CASE */ 01051000 B CE0001@ 0291 01052000 * END ROUNDC; /* END OF SUBCASE ALLOCATION 0292 01053000 * ROUND TO CYLINDER */ 01054000 * 0292 01055000 * /***************************************************************/ 01056000 * /* */ 01057000 * /* PROCESS VOLUME SERIAL KEY */ 01058000 * /* */ 01059000 * /***************************************************************/ 01060000 * 0293 01061000 *VLSERC: 0293 01062000 * DO; /* SUBCASE VOLUME SERIAL 0293 01063000 * PROCESSING */ 01064000 VLSERC DS 0H 0294 01065000 * CALL BLDVLTU(DALVLSER,F6C); /* BUILD VOLUME SERIAL TEXT UNIT */ 01066000 LA @01,@AL00294 0294 01067000 BAL @14,BLDVLTU 0294 01068000 * IF ALSW=OFF&MLEN>F0C THEN /* TEST THAT TEXT UNIT IS VALID */ 01069000 TM ALSW,B'10000000' 0295 01070000 BNZ @RF00295 0295 01071000 LTR MLEN,MLEN 0295 01072000 BNP @RF00295 0295 01073000 * DO; /* MOVE VOLUME SERIAL TO DMCB */ 01074000 * RFY 0297 01075000 * S99TUNIT BASED(S99TUBAS); 0297 01076000 * DMCBVOL=''; /* INIT THE VOLUME SERIAL ENTRY */ 01077000 MVI DMCBVOL(DMCBPTR),C' ' 0298 01078000 MVC DMCBVOL+1(5,DMCBPTR),DMCBVOL(DMCBPTR) 0298 01079000 * DMCBVOL(F1C:MLEN)=S99TUPAR(F1C:MLEN);/* MOVE IN THE VOL 01080000 * SER */ 01081000 LR @09,MLEN 0299 01082000 BCTR @09,0 0299 01083000 EX @09,@SM00946 0299 01084000 * END; /* MOVE VOLUME SERIAL TO DMCB */ 01085000 * GOTO CE0001@; /* BRANCH TO END OF CASE */ 01086000 B CE0001@ 0301 01087000 * END VLSERC; /* END OF SUBCASE VOLUME SERIAL 01088000 * PROCESSING */ 01089000 * 0302 01090000 * /***************************************************************/ 01091000 * /* */ 01092000 * /* PROCESS UNIT NAME KEY */ 01093000 * /* */ 01094000 * /***************************************************************/ 01095000 * 0303 01096000 *UNITC: 0303 01097000 * DO; /* SUBCASE UNIT NAME PROCESSING */ 01098000 UNITC DS 0H 0304 01099000 * CALL BLDVLTU(DALUNIT,F8C); /* BUILD UNIT NAME TEXT UNIT */ 01100000 LA @01,@AL00304 0304 01101000 BAL @14,BLDVLTU 0304 01102000 * IF ALSW=OFF&MLEN>F0C THEN /* TEST THAT TEXT UNIT IS VALID */ 01103000 TM ALSW,B'10000000' 0305 01104000 BNZ @RF00305 0305 01105000 LTR MLEN,MLEN 0305 01106000 BNP @RF00305 0305 01107000 * DO; /* MOVE UNITNAME TO DMCB */ 01108000 * RFY 0307 01109000 * S99TUNIT BASED(S99TUBAS); 0307 01110000 * DMCBUNIT=''; /* INIT THE UNITNAME ENTRY */ 01111000 MVI DMCBUNIT(DMCBPTR),C' ' 0308 01112000 MVC DMCBUNIT+1(7,DMCBPTR),DMCBUNIT(DMCBPTR) 0308 01113000 * DMCBUNIT(F1C:MLEN)=S99TUPAR(F1C:MLEN);/* MOVE IN THE 0309 01114000 * UNITNAME */ 01115000 LR @09,MLEN 0309 01116000 BCTR @09,0 0309 01117000 EX @09,@SM00948 0309 01118000 * END; /* MOVE UNITNAME TO DMCB */ 01119000 * GOTO CE0001@; /* BRANCH TO END OF CASE */ 01120000 B CE0001@ 0311 01121000 * END UNITC; /* END OF SUBCASE UNIT NAME 0312 01122000 * PROCESSING */ 01123000 * 0312 01124000 * /***************************************************************/ 01125000 * /* */ 01126000 * /* PROCESS SYSOUT CLASS KEY */ 01127000 * /* */ 01128000 * /***************************************************************/ 01129000 * 0313 01130000 *SYSOUC: 0313 01131000 * DO; /* SUBCASE SYSOUT CLASS 0313 01132000 * PROCESSING */ 01133000 SYSOUC DS 0H 0314 01134000 * CALL BLDPVTU(DALSYSOU,F1C); /* BUILD SYSOUT CLASS TEXT UNIT */ 01135000 LA @01,@AL00314 0314 01136000 BAL @14,BLDPVTU 0314 01137000 * GOTO CE0001@; /* BRANCH TO END OF CASE */ 01138000 B CE0001@ 0315 01139000 * END SYSOUC; /* END OF SUBCASE SYSOUT CLASS 0316 01140000 * PROCESSING */ 01141000 * 0316 01142000 * /***************************************************************/ 01143000 * /* */ 01144000 * /* PROCESS SYSOUT PROGRAM NAME KEY */ 01145000 * /* */ 01146000 * /***************************************************************/ 01147000 * 0317 01148000 *SPGNMC: 0317 01149000 * DO; /* SUBCASE SYSOUT PROGRAM NAME 0317 01150000 * PROCESSING */ 01151000 SPGNMC DS 0H 0318 01152000 * CALL BLDPVTU(DALSPGNM,F8C); /* BUILD PROGRAM NAME TEXT UNIT */ 01153000 LA @01,@AL00318 0318 01154000 BAL @14,BLDPVTU 0318 01155000 * GOTO CE0001@; /* BRANCH TO END OF CASE */ 01156000 B CE0001@ 0319 01157000 * END SPGNMC; /* END OF SUBCASE SYSOUT PROGRAM 01158000 * NAME PROCESSING */ 01159000 * 0320 01160000 * /***************************************************************/ 01161000 * /* */ 01162000 * /* PROCESS SYSOUT FORM NUMBER KEY */ 01163000 * /* */ 01164000 * /***************************************************************/ 01165000 * 0321 01166000 *SFMNOC: 0321 01167000 * DO; /* SUBCASE SYSOUT FORM NUMBER 0321 01168000 * PROCESSING */ 01169000 SFMNOC DS 0H 0322 01170000 * CALL BLDPVTU(DALSFMNO,F4C); /* BUILD FORM NUMBER TEXT UNIT */ 01171000 LA @01,@AL00322 0322 01172000 BAL @14,BLDPVTU 0322 01173000 * GOTO CE0001@; /* BRANCH TO END OF CASE */ 01174000 B CE0001@ 0323 01175000 * END SFMNOC; /* END OF SUBCASE SYSOUT FORM 0324 01176000 * NUMBER PROCESSING */ 01177000 * 0324 01178000 * /***************************************************************/ 01179000 * /* */ 01180000 * /* PROCESS SYSOUT OUTPUT LIMIT KEY */ 01181000 * /* */ 01182000 * /***************************************************************/ 01183000 * 0325 01184000 *OUTLMC: 0325 01185000 * DO; /* SUBCASE SYSOUT OUTPUT LIMIT 0325 01186000 * PROCESSING */ 01187000 OUTLMC DS 0H 0326 01188000 * ALBAS=ALBAS+F4C; /* BUMP PLIST BASE TO PARM VALUE 01189000 * ADDR */ 01190000 AL ALBAS,@CF00039 0326 01191000 * IF ALPTF31>F0C THEN /* TEST FOR NON-NULL PARM VALUE */ 01192000 L @09,ALPTR(,ALBAS) 0327 01193000 L @09,ALPTF31(,@09) 0327 01194000 LTR @09,@09 0327 01195000 BNP @RF00327 0327 01196000 * CALL BLDP3TU(DALOUTLM); /* BUILD OUTPUT LIMIT TEXT UNIT */ 01197000 LA @01,@AL00328 0328 01198000 BAL @14,BLDP3TU 0328 01199000 * GOTO CE0001@; /* BRANCH TO END OF CASE */ 01200000 B CE0001@ 0329 01201000 * END OUTLMC; /* END OF SUBCASE SYSOUT OUTPUT 01202000 * LIMIT PROCESSING */ 01203000 * 0330 01204000 * /***************************************************************/ 01205000 * /* */ 01206000 * /* PROCESS SYSOUT COPIES KEY */ 01207000 * /* */ 01208000 * /***************************************************************/ 01209000 * 0331 01210000 *COPYSC: 0331 01211000 * DO; /* SUBCASE SYSOUT COPIES 0331 01212000 * PROCESSING */ 01213000 COPYSC DS 0H 0332 01214000 * ALBAS=ALBAS+F4C; /* BUMP PLIST BASE TO PARM VALUE 01215000 * ADDR */ 01216000 AL ALBAS,@CF00039 0332 01217000 * IF ALPTF31>F0C THEN /* TEST FOR NON-NULL PARM VALUE */ 01218000 L @09,ALPTR(,ALBAS) 0333 01219000 L @06,ALPTF31(,@09) 0333 01220000 LTR @06,@06 0333 01221000 BNP @RF00333 0333 01222000 * CALL BLDV1TU(DALCOPYS,ALPTB4C1);/* BUILD SYSOUT COPIES TEXT 01223000 * UNIT */ 01224000 LA @06,@CB00387 0334 01225000 ST @06,@AL00001 0334 01226000 LA @09,ALPTB4C1(,@09) 0334 01227000 ST @09,@AL00001+4 0334 01228000 LA @01,@AL00001 0334 01229000 BAL @14,BLDV1TU 0334 01230000 * GOTO CE0001@; /* BRANCH TO END OF CASE */ 01231000 B CE0001@ 0335 01232000 * END COPYSC; /* END OF SUBCASE SYSOUT COPIES 01233000 * PROCESSING */ 01234000 * 0336 01235000 * /***************************************************************/ 01236000 * /* */ 01237000 * /* PROCESS LABEL TYPE KEY */ 01238000 * /* */ 01239000 * /***************************************************************/ 01240000 * 0337 01241000 *LABELC: 0337 01242000 * DO; /* SUBCASE LABEL TYPE PROCESSING */ 01243000 LABELC DS 0H 0338 01244000 * IF ALPRB4F1^=F0C THEN /* TEST FOR IMMEDIATE TEXT UNIT 01245000 * KEY VALUE */ 01246000 CLI ALPRB4F1(ALBAS),0 0338 01247000 BE @RF00338 0338 01248000 * DO; /* BUILD LABEL TYPE TEXT UNIT 0339 01249000 * FROM DIRECT PARM FIELD */ 01250000 * CALL BLDV1TU(DALLABEL,ALPRB4C1);/* BUILD LABEL TYPE TEXT 01251000 * UNIT */ 01252000 LA @09,@CB00389 0340 01253000 ST @09,@AL00001 0340 01254000 LA @09,ALPRB4C1(,ALBAS) 0340 01255000 ST @09,@AL00001+4 0340 01256000 LA @01,@AL00001 0340 01257000 BAL @14,BLDV1TU 0340 01258000 * DMCBLBTY=ALPRB4C1; /* DMCB LABEL TYPE FIELD VALUE */ 01259000 MVC DMCBLBTY(1,DMCBPTR),ALPRB4C1(ALBAS) 0341 01260000 * END; /* BUILD LABEL TYPE TEXT UNIT 0342 01261000 * FROM DIRECT PARM FIELD */ 01262000 * ELSE 0343 01263000 * DO; /* BUILD LABEL TYPE TEXT UNIT 0343 01264000 * FROM INDIRECT PARM FIELD */ 01265000 B @RC00338 0343 01266000 @RF00338 DS 0H 0344 01267000 * ALBAS=ALBAS+F4C; /* BUMP PLIST BASE TO PARM VALUE 01268000 * ADDRESS */ 01269000 AL ALBAS,@CF00039 0344 01270000 * IF ALPTC1^=LBLNKC THEN /* TEST FOR NON-NULL PARM VALUE */ 01271000 L @09,ALPTR(,ALBAS) 0345 01272000 CLI ALPTC1(@09),C' ' 0345 01273000 BE @RF00345 0345 01274000 * DO; /* NON-NULL PARM VALUE FIELD, 0346 01275000 * OBTAIN TEXT UNIT PARM VALUE */ 01276000 * CALL MATCH(LTYPEP,LENGTH(LTYPESTR),LTYPESTR,FTMP8);/* 01277000 * GET TU PARM */ 01278000 ST @09,@AL00001 0347 01279000 LA @09,@CF00930 0347 01280000 ST @09,@AL00001+4 0347 01281000 LA @09,LTYPESTR 0347 01282000 ST @09,@AL00001+8 0347 01283000 LA @09,FTMP8 0347 01284000 ST @09,@AL00001+12 0347 01285000 LA @01,@AL00001 0347 01286000 BAL @14,MATCH 0347 01287000 * IF FTMP8^=F0C THEN /* TEST FOR VALID PARM VALUE */ 01288000 CLI FTMP8,0 0348 01289000 BE @RF00348 0348 01290000 * DO; /* VALID PARM VALUE */ 01291000 * CALL BLDV1TU(DALLABEL,FTMP8);/* BUILD LABEL TYPE 01292000 * T U */ 01293000 LA @09,@CB00389 0350 01294000 ST @09,@AL00001 0350 01295000 LA @09,FTMP8 0350 01296000 ST @09,@AL00001+4 0350 01297000 LA @01,@AL00001 0350 01298000 BAL @14,BLDV1TU 0350 01299000 * DMCBLBTY=BTMP8; /* DMCB LABEL TYPE FIELD */ 01300000 MVC DMCBLBTY(1,DMCBPTR),BTMP8 0351 01301000 * END; /* VALID PARM VALUE */ 01302000 * ELSE 0353 01303000 * DO; /* INVALID PARM VALUE */ 01304000 B @RC00348 0353 01305000 @RF00348 DS 0H 0354 01306000 * ALSW=ON; /* TERMINATE LIST PROCESSING */ 01307000 OI ALSW,B'10000000' 0354 01308000 * CALL PARMERR(LENGTH(DMCBMODL),DMCBMODL,LENGTH( 0355 01309000 * LTYPEKY),LTYPEKY,LENGTH(LTYPEP),LTYPEP);/* 0355 01310000 * ISSUE ERROR MESSAGE */ 01311000 MVC @AL00001(20),@AL00355 0355 01312000 LA @09,DMCBMODL(,DMCBPTR) 0355 01313000 ST @09,@AL00001+4 0355 01314000 L @09,ALPTR(,ALBAS) 0355 01315000 ST @09,@AL00001+20 0355 01316000 LA @01,@AL00001 0355 01317000 BAL @14,PARMERR 0355 01318000 * END; /* INVALID PARM VALUE */ 01319000 * END; /* NON-NULL PARM VALUE FIELD, 0357 01320000 * OBTAIN TEXT UNIT PARM VALUE */ 01321000 * ELSE 0358 01322000 * DMCBLBTY=LHEX0C; /* DMCB LABEL TYPE FIELD */ 01323000 B @RC00345 0358 01324000 @RF00345 MVI DMCBLBTY(DMCBPTR),X'00' 0358 01325000 * END; /* BUILD LABEL TYPE TEXT UNIT 0359 01326000 * FROM INDIRECT PARM FIELD */ 01327000 * GOTO CE0001@; /* BRANCH TO END OF CASE */ 01328000 B CE0001@ 0360 01329000 * END LABELC; /* END OF SUBCASE LABEL TYPE 0361 01330000 * PROCESSING */ 01331000 * 0361 01332000 * /***************************************************************/ 01333000 * /* */ 01334000 * /* PROCESS LABEL DATA SET SEQUENCE NUMBER KEY */ 01335000 * /* */ 01336000 * /***************************************************************/ 01337000 * 0362 01338000 *DSSEQC: 0362 01339000 * DO; /* SUBCASE DATA SET SEQUENCE 0362 01340000 * NUMBER PROCESSING */ 01341000 DSSEQC DS 0H 0363 01342000 * IF ALPTF31>=F0C THEN /* TEST FOR NON-NULL PARM VALUE */ 01343000 L @09,ALPTR(,ALBAS) 0363 01344000 L @09,ALPTF31(,@09) 0363 01345000 LTR @09,@09 0363 01346000 BM @RF00363 0363 01347000 * CALL BLDP2TU(DALDSSEQ); /* BUILD DS SEQUENCE NUMBER TEXT 01348000 * UNIT */ 01349000 LA @01,@AL00364 0364 01350000 BAL @14,BLDP2TU 0364 01351000 * DMCBLBSQ=ALPTF31; /* DMCB DS SEQNO FIELD VALUE */ 01352000 @RF00363 L @09,ALPTR(,ALBAS) 0365 01353000 L @09,ALPTF31(,@09) 0365 01354000 STH @09,DMCBLBSQ(,DMCBPTR) 0365 01355000 * GOTO CE0001@; /* BRANCH TO END OF CASE */ 01356000 B CE0001@ 0366 01357000 * END DSSEQC; /* END OF SUBCASE DATA SET 0367 01358000 * SEQUENCE NUMBER PROCESSING */ 01359000 * 0367 01360000 * /***************************************************************/ 01361000 * /* */ 01362000 * /* PROCESS LABEL PASSWORD PROTECT MODE KEY */ 01363000 * /* */ 01364000 * /***************************************************************/ 01365000 * 0368 01366000 *PASPRC: 0368 01367000 * DO; /* SUBCASE PASSWORD PROTECT MODE 01368000 * PROCESSING */ 01369000 PASPRC DS 0H 0369 01370000 * IF ALPRB4F1^=F0C THEN /* TEST FOR IMMEDIATE TEXT UNIT 01371000 * KEY VALUE */ 01372000 CLI ALPRB4F1(ALBAS),0 0369 01373000 BE @RF00369 0369 01374000 * DO; /* BUILD PASSW PROT MODE TXT UNIT 01375000 * FROM DIRECT PARM FIELD */ 01376000 * CALL BLDV1TU(DALPASPR,ALPRB4C1);/* BUILD PASSW PROT MODE 01377000 * TEXT UNIT */ 01378000 LA @09,@CB00393 0371 01379000 ST @09,@AL00001 0371 01380000 LA @09,ALPRB4C1(,ALBAS) 0371 01381000 ST @09,@AL00001+4 0371 01382000 LA @01,@AL00001 0371 01383000 BAL @14,BLDV1TU 0371 01384000 * DMCBLBPS=ALPRB4C1; /* DMCB PASSW PROT MODE VALUE */ 01385000 MVC DMCBLBPS(1,DMCBPTR),ALPRB4C1(ALBAS) 0372 01386000 * END; /* BUILD PASSW PROT MODE TXT UNIT 01387000 * FROM DIRECT PARM FIELD */ 01388000 * ELSE 0374 01389000 * DO; /* BUILD PASSW PROT MODE TEXT 0374 01390000 * UNIT FROM INDIRECT PARM FIELD */ 01391000 B @RC00369 0374 01392000 @RF00369 DS 0H 0375 01393000 * ALBAS=ALBAS+F4C; /* BUMP PLIST BASE TO PARM VALUE 01394000 * ADDRESS */ 01395000 AL ALBAS,@CF00039 0375 01396000 * IF ALPTC1^=LBLNKC THEN /* TEST FOR NON-NULL PARM VALUE */ 01397000 L @09,ALPTR(,ALBAS) 0376 01398000 CLI ALPTC1(@09),C' ' 0376 01399000 BE @RF00376 0376 01400000 * DO; /* NON-NULL PARM VALUE FIELD, 0377 01401000 * OBTAIN TEXT UNIT PARM VALUE */ 01402000 * CALL MATCH(LPASPRP,LENGTH(LPSPRSTR),LPSPRSTR,FTMP8); 01403000 ST @09,@AL00001 0378 01404000 LA @09,@CF00184 0378 01405000 ST @09,@AL00001+4 0378 01406000 LA @09,LPSPRSTR 0378 01407000 ST @09,@AL00001+8 0378 01408000 LA @09,FTMP8 0378 01409000 ST @09,@AL00001+12 0378 01410000 LA @01,@AL00001 0378 01411000 BAL @14,MATCH 0378 01412000 * /* GET TU PARM */ 01413000 * IF FTMP8^=F0C THEN /* TEST FOR VALID PARM VALUE */ 01414000 CLI FTMP8,0 0379 01415000 BE @RF00379 0379 01416000 * DO; /* VALID PARM VALUE */ 01417000 * CALL BLDV1TU(DALPASPR,FTMP8);/* BUILD PASSW PROT 01418000 * MODE TEXT UNIT */ 01419000 LA @09,@CB00393 0381 01420000 ST @09,@AL00001 0381 01421000 LA @09,FTMP8 0381 01422000 ST @09,@AL00001+4 0381 01423000 LA @01,@AL00001 0381 01424000 BAL @14,BLDV1TU 0381 01425000 * DMCBLBPS=BTMP8; /* DMCB PASSW PROT MODE FIELD */ 01426000 MVC DMCBLBPS(1,DMCBPTR),BTMP8 0382 01427000 * END; /* VALID PARM VALUE */ 01428000 * ELSE 0384 01429000 * DO; /* INVALID PARM VALUE */ 01430000 B @RC00379 0384 01431000 @RF00379 DS 0H 0385 01432000 * ALSW=ON; /* TERMINATE LIST PROCESSING */ 01433000 OI ALSW,B'10000000' 0385 01434000 * CALL PARMERR(LENGTH(DMCBMODL),DMCBMODL,LENGTH( 0386 01435000 * LPASPRKY),LPASPRKY,LENGTH(LPASPRP),LPASPRP); 01436000 MVC @AL00001(20),@AL00386 0386 01437000 LA @09,DMCBMODL(,DMCBPTR) 0386 01438000 ST @09,@AL00001+4 0386 01439000 L @09,ALPTR(,ALBAS) 0386 01440000 ST @09,@AL00001+20 0386 01441000 LA @01,@AL00001 0386 01442000 BAL @14,PARMERR 0386 01443000 * /* ISSUE ERROR MESSAGE */ 01444000 * END; /* INVALID PARM VALUE */ 01445000 * END; /* NON-NULL PARM VALUE FIELD, 0388 01446000 * OBTAIN TEXT UNIT PARM VALUE */ 01447000 * ELSE 0389 01448000 * DMCBLBPS=LHEX0C; /* DMCB PASSW PROT MODE FIELD */ 01449000 B @RC00376 0389 01450000 @RF00376 MVI DMCBLBPS(DMCBPTR),X'00' 0389 01451000 * END; /* BUILD PASSW PROT MODE TEXT 0390 01452000 * UNIT FROM INDIRECT PARM FIELD */ 01453000 * GOTO CE0001@; /* BRANCH TO END OF CASE */ 01454000 B CE0001@ 0391 01455000 * END PASPRC; /* END OF SUBCASE PASSWORD 0392 01456000 * PROTECT MODE PROCESSING */ 01457000 * 0392 01458000 * /***************************************************************/ 01459000 * /* */ 01460000 * /* PROCESS LABEL RETENTION PERIOD KEY */ 01461000 * /* */ 01462000 * /***************************************************************/ 01463000 * 0393 01464000 *RETPDC: 0393 01465000 * DO; /* SUBCASE RETENTION PERIOD 0393 01466000 * PROCESSING */ 01467000 RETPDC DS 0H 0394 01468000 * IF ALPTF31>F0C THEN /* TEST FOR NON-NULL PARM VALUE */ 01469000 L @09,ALPTR(,ALBAS) 0394 01470000 L @09,ALPTF31(,@09) 0394 01471000 LTR @09,@09 0394 01472000 BNP @RF00394 0394 01473000 * CALL BLDP2TU(DALRETPD); /* BUILD DS RETENTION PERIOD TEXT 01474000 * UNIT */ 01475000 LA @01,@AL00395 0395 01476000 BAL @14,BLDP2TU 0395 01477000 * DMCBLBRT=ALPTF31; /* DMCB DS RET PERIOD FIELD */ 01478000 @RF00394 L @09,ALPTR(,ALBAS) 0396 01479000 L @09,ALPTF31(,@09) 0396 01480000 STH @09,DMCBLBRT(,DMCBPTR) 0396 01481000 * GOTO CE0001@; /* BRANCH TO END OF CASE */ 01482000 B CE0001@ 0397 01483000 * END RETPDC; /* END OF SUBCASE RETENTION 0398 01484000 * PERIOD PROCESSING */ 01485000 * 0398 01486000 * /***************************************************************/ 01487000 * /* */ 01488000 * /* PROCESS DCB BLOCKSIZE KEY */ 01489000 * /* */ 01490000 * /***************************************************************/ 01491000 * 0399 01492000 *BLKSZC: 0399 01493000 * DO; /* SUBCASE DCB BLKSIZE PROCESSING*/ 01494000 BLKSZC DS 0H 0400 01495000 * IF ALPTF31>F0C THEN /* TEST FOR NON-NULL PARM VALUE */ 01496000 L @09,ALPTR(,ALBAS) 0400 01497000 L @09,ALPTF31(,@09) 0400 01498000 LTR @09,@09 0400 01499000 BNP @RF00400 0400 01500000 * CALL BLDP2TU(DALBLKSZ); /* BUILD DCB BLKSIZE TEXT UNIT */ 01501000 LA @01,@AL00401 0401 01502000 BAL @14,BLDP2TU 0401 01503000 * DMCBDCBL=ALPTF31; /* DMCB DCB BLOCKSIZE FIELD VALUE*/ 01504000 @RF00400 L @09,ALPTR(,ALBAS) 0402 01505000 L @09,ALPTF31(,@09) 0402 01506000 STH @09,DMCBDCBL(,DMCBPTR) 0402 01507000 * GOTO CE0001@; /* BRANCH TO END OF CASE */ 01508000 B CE0001@ 0403 01509000 * END BLKSZC; /* END OF SUBCASE DCB BLKSIZE 0404 01510000 * PROCESSING */ 01511000 * 0404 01512000 * /***************************************************************/ 01513000 * /* */ 01514000 * /* PROCESS DCB LRECL KEY */ 01515000 * /* */ 01516000 * /***************************************************************/ 01517000 * 0405 01518000 *LRECLC: 0405 01519000 * DO; /* SUBCASE DCB LRECL PROCESSING */ 01520000 LRECLC DS 0H 0406 01521000 * IF ALPTF31>F0C THEN /* TEST FOR NON-NULL PARM VALUE */ 01522000 L @09,ALPTR(,ALBAS) 0406 01523000 L @09,ALPTF31(,@09) 0406 01524000 LTR @09,@09 0406 01525000 BNP @RF00406 0406 01526000 * CALL BLDP2TU(DALLRECL); /* BUILD DCB LOGICAL RECORD LEN 01527000 * TEXT UNIT */ 01528000 LA @01,@AL00407 0407 01529000 BAL @14,BLDP2TU 0407 01530000 * DMCBDCLR=ALPTF31; /* DMCB DCB LRECL FIELD VALUE */ 01531000 @RF00406 L @09,ALPTR(,ALBAS) 0408 01532000 L @09,ALPTF31(,@09) 0408 01533000 STH @09,DMCBDCLR(,DMCBPTR) 0408 01534000 * GOTO CE0001@; /* BRANCH TO END OF CASE */ 01535000 B CE0001@ 0409 01536000 * END LRECLC; /* END OF SUBCASE DCB LRECL 0410 01537000 * PROCESSING */ 01538000 * 0410 01539000 * /***************************************************************/ 01540000 * /* */ 01541000 * /* PROCESS DCB RECFM KEY */ 01542000 * /* */ 01543000 * /***************************************************************/ 01544000 * 0411 01545000 *RECFMC: 0411 01546000 * DO; /* SUBCASE DCB RECORD FORMAT 0411 01547000 * PROCESSING */ 01548000 RECFMC DS 0H 0412 01549000 * ALBAS=ALBAS+F4C; /* BUMP BASE TO RECFM PARM FIELD */ 01550000 AL ALBAS,@CF00039 0412 01551000 * IF ALPTC1^=LBLNKC THEN /* TEST FOR NON-BLANK RECFM FIELD*/ 01552000 L @09,ALPTR(,ALBAS) 0413 01553000 CLI ALPTC1(@09),C' ' 0413 01554000 BE @RF00413 0413 01555000 * DO; /* NON-BLANK RECFM PARM */ 01556000 * CTMP=LHEX0C; /* ZERO THE RECFM TRANSLATE FIELD*/ 01557000 MVI CTMP,X'00' 0415 01558000 * DO I=F1C TO LENGTH(RECFMP);/* LOOP TO CHECK SOURCE FIELD 01559000 * BYTES */ 01560000 LA I,1 0416 01561000 @DL00416 DS 0H 0417 01562000 * IF RECFMP(I)^=LBLNKC THEN/* TEST FOR NON-BLANK FIELD 0417 01563000 * BYTE */ 01564000 L @09,ALPTR(,ALBAS) 0417 01565000 LR @01,@09 0417 01566000 ALR @01,I 0417 01567000 BCTR @01,0 0417 01568000 CLI RECFMP(@01),C' ' 0417 01569000 BE @RF00417 0417 01570000 * DO; /* NON-BLANK FIELD BYTE */ 01571000 * CALL MATCH(RECFMP(I),LENGTH(RECFMSTR),RECFMSTR,CTMPA) 01572000 * ; /* GET TU PARM */ 01573000 BCTR @09,0 0419 01574000 LA @09,RECFMP(I,@09) 0419 01575000 ST @09,@AL00001 0419 01576000 LA @09,@CF00931 0419 01577000 ST @09,@AL00001+4 0419 01578000 LA @09,RECFMSTR 0419 01579000 ST @09,@AL00001+8 0419 01580000 LA @09,CTMPA 0419 01581000 ST @09,@AL00001+12 0419 01582000 LA @01,@AL00001 0419 01583000 BAL @14,MATCH 0419 01584000 * IF CTMPA=LHEX0C THEN/* TEST FOR INVALID CHARACTER 01585000 * IN SOURCE FIELD */ 01586000 CLI CTMPA,X'00' 0420 01587000 BNE @RF00420 0420 01588000 * DO; /* INVALID CHARACTER IN SOURCE 0421 01589000 * FIELD */ 01590000 * CALL PARMERR(LENGTH(DMCBMODL),DMCBMODL,LENGTH( 01591000 * RECFMKY),RECFMKY,LENGTH(RECFMP),RECFMP);/* 01592000 * ISSUE ERROR MESSAGE */ 01593000 MVC @AL00001(20),@AL00422 0422 01594000 LA @09,DMCBMODL(,DMCBPTR) 0422 01595000 ST @09,@AL00001+4 0422 01596000 L @09,ALPTR(,ALBAS) 0422 01597000 ST @09,@AL00001+20 0422 01598000 LA @01,@AL00001 0422 01599000 BAL @14,PARMERR 0422 01600000 * ALSW=ON; /* TERMINATE LIST PROCESSING */ 01601000 OI ALSW,B'10000000' 0423 01602000 * END; /* INVALID CHARACTER IN SOURCE 0424 01603000 * FIELD */ 01604000 * ELSE 0425 01605000 * CTMP=CTMP|CTMPA;/* VALID SOURCE CHAR, MOVE XLATED 01606000 * VALUE TO PARM */ 01607000 B @RC00420 0425 01608000 @RF00420 OC CTMP(1),CTMPA 0425 01609000 * END; /* NON-BLANK FIELD BYTE */ 01610000 @RC00420 DS 0H 0427 01611000 * END; /* LOOP TO CHECK SOURCE FIELD 0427 01612000 * BYTES */ 01613000 @RF00417 AL I,@CF00048 0427 01614000 C I,@CF00103 0427 01615000 BNH @DL00416 0427 01616000 * IF ALSW=OFF& /* TEST THAT PROCESSING IS NOT 0428 01617000 * TERMINATED */ 01618000 * CTMP^=LHEX0C THEN /* AND FOR NON-NULL SOURCE FIELD */ 01619000 TM ALSW,B'10000000' 0428 01620000 BNZ @RF00428 0428 01621000 CLI CTMP,X'00' 0428 01622000 BE @RF00428 0428 01623000 * DO; /* VALID PARM VALUE */ 01624000 * CALL BLDV1TU(DALRECFM,CTMP);/* BUILD DCB RECFM TEXT 01625000 * UNIT */ 01626000 LA @09,@CB00475 0430 01627000 ST @09,@AL00001 0430 01628000 LA @09,CTMP 0430 01629000 ST @09,@AL00001+4 0430 01630000 LA @01,@AL00001 0430 01631000 BAL @14,BLDV1TU 0430 01632000 * DMCBDCFM=CTMP; /* DMCB LABEL TYPE FIELD */ 01633000 MVC DMCBDCFM(1,DMCBPTR),CTMP 0431 01634000 * END; /* VALID PARM VALUE */ 01635000 * END; /* NON-BLANK RECFM PARM */ 01636000 * ELSE 0434 01637000 * DO; /* NULL DCB RECFM PARM */ 01638000 B @RC00413 0434 01639000 @RF00413 DS 0H 0435 01640000 * DMCBDCFM=LHEX0C; /* DMCB DCB RECFM FIELD */ 01641000 MVI DMCBDCFM(DMCBPTR),X'00' 0435 01642000 * END; /* NULL DCB RECFM PARM */ 01643000 * GOTO CE0001@; /* BRANCH TO END OF CASE */ 01644000 B CE0001@ 0437 01645000 * END RECFMC; /* END OF SUBCASE DCB RECORD 0438 01646000 * FORMAT PROCESSING */ 01647000 * 0438 01648000 * /***************************************************************/ 01649000 * /* */ 01650000 * /* PROCESS PASSWORD KEY */ 01651000 * /* */ 01652000 * /***************************************************************/ 01653000 * 0439 01654000 *PASSWC: 0439 01655000 * DO; /* SUBCASE PASSWORD PROCESSING */ 01656000 PASSWC DS 0H 0440 01657000 * CALL BLDVLTU(DALPASSW,F8C); /* BUILD PASSWORD TEXT UNIT */ 01658000 LA @01,@AL00440 0440 01659000 BAL @14,BLDVLTU 0440 01660000 * GOTO CE0001@; /* BRANCH TO END OF CASE */ 01661000 B CE0001@ 0441 01662000 * END PASSWC; /* END OF SUBCASE PASSWORD 0442 01663000 * PROCESSING */ 01664000 * 0442 01665000 * /***************************************************************/ 01666000 * /* */ 01667000 * /* PROCESS SYSOUT REMOTE USER KEY */ 01668000 * /* */ 01669000 * /***************************************************************/ 01670000 * 0443 01671000 *SUSERC: 0443 01672000 * DO; /* SUBCASE SYSOUT REMOTE USER 0443 01673000 * PROCESSING */ 01674000 SUSERC DS 0H 0444 01675000 * CALL BLDPVTU(DALSUSER,F7C); /* BUILD REMOTE USER TEXT UNIT */ 01676000 LA @01,@AL00444 0444 01677000 BAL @14,BLDPVTU 0444 01678000 * GOTO CE0001@; /* BRANCH TO END OF CASE */ 01679000 B CE0001@ 0445 01680000 * END SUSERC; /* END OF SUBCASE SYSOUT REMOTE 01681000 * USER PROCESSING */ 01682000 * 0446 01683000 * /***************************************************************/ 01684000 * /* */ 01685000 * /* PROCESS SYSOUT HOLD QUEUE KEY */ 01686000 * /* */ 01687000 * /***************************************************************/ 01688000 * 0447 01689000 *SHOLDC: 0447 01690000 * DO; /* SUBCASE SYSOUT HOLD QUEUE 0447 01691000 * PROCESSING */ 01692000 SHOLDC DS 0H 0448 01693000 * ALBAS=ALBAS+F4C; /* BUMP PLIST TO PARM VALUE ADDR */ 01694000 AL ALBAS,@CF00039 0448 01695000 * IF SHOLDP=LYESC THEN /* TEST FOR 'YES' VALUE */ 01696000 L @09,ALPTR(,ALBAS) 0449 01697000 CLC SHOLDP(3,@09),@CC00678 0449 01698000 BNE @RF00449 0449 01699000 * CALL BLDV0TU(DALSHOLD); /* MARK SYSOUT FOR HOLD QUEUE */ 01700000 LA @01,@AL00450 0450 01701000 BAL @14,BLDV0TU 0450 01702000 * GOTO CE0001@; /* BRANCH TO END OF CASE */ 01703000 B CE0001@ 0451 01704000 * END SHOLDC; /* END OF SUBCASE SYSOUT HOLD 0452 01705000 * QUEUE PROCESSING */ 01706000 * 0452 01707000 * /***************************************************************/ 01708000 * /* */ 01709000 * /* PROCESS UNDEFINED KEY */ 01710000 * /* */ 01711000 * /***************************************************************/ 01712000 * 0453 01713000 *BAD: 0453 01714000 * DO; /* SUBCASE UNDEFINED OPCODE 0453 01715000 * PROCESSING */ 01716000 BAD DS 0H 0454 01717000 * CHSTR867=ALOPT; /* GET KEY FIELD */ 01718000 STCM ALOPT,3,CHSTR867 0454 01719000 * CHSTR88='0F'X; /* TRANSLATE IT TO CHARACTER HEX */ 01720000 MVI CHSTR88,X'0F' 0455 01721000 * UNPK(CTEMP,CHSTR8); 0456 01722000 UNPK CTEMP(9),CHSTR8(8) 0456 01723000 * TR(CTEMP,HEXTBL); 0457 01724000 TR CTEMP(9),HEXTBL 0457 01725000 * DO; /* BLSDMSG 0458 01726000 * (ZZ2,F3102C,DMCBMSG,BLSDMSGS) 01727000 * INSERT(DMCBMODL,CTEMP72) */ 01728000 * IOPTLIST(1)=ADDR(IOPTLIST(4));/* CHAIN TO NEXT INSERT */ 01729000 LA @09,IOPTLIST+12 0459 01730000 ST @09,IOPTLIST 0459 01731000 * IOPTLIST(2)=ADDR(DMCBMODL);/* INSERT NAME POINTER */ 01732000 LA @09,DMCBMODL(,DMCBPTR) 0460 01733000 ST @09,IOPTLIST+4 0460 01734000 * IOPTLIST(3)=0; /* ZERO RESERVED FIELD */ 01735000 SLR @09,@09 0461 01736000 ST @09,IOPTLIST+8 0461 01737000 * RFY 0462 01738000 * I015F BASED(ADDR(IOPTLIST(3)));/* ACCESS BYTES 1-2 */ 01739000 * I015F=LENGTH(DMCBMODL); /* INSERT LENGTH */ 01740000 LA @15,IOPTLIST+8 0463 01741000 MVC I015F(2,@15),@CH00046 0463 01742000 * IOPTLIST(4)=0; /* LAST INSERT */ 01743000 ST @09,IOPTLIST+12 0464 01744000 * IOPTLIST(5)=ADDR(CTEMP72);/* INSERT NAME POINTER */ 01745000 LA @15,CTEMP72 0465 01746000 ST @15,IOPTLIST+16 0465 01747000 * IOPTLIST(6)=0; /* ZERO RESERVED FIELD */ 01748000 ST @09,IOPTLIST+20 0466 01749000 * RFY 0467 01750000 * I015F BASED(ADDR(IOPTLIST(6)));/* ACCESS BYTES 1-2 */ 01751000 * I015F=LENGTH(CTEMP72); /* INSERT LENGTH */ 01752000 LA @09,IOPTLIST+20 0468 01753000 MVC I015F(2,@09),@CH00074 0468 01754000 * CALL BLSDMSG0(ZZ2,F3102C,DMCBMSG,BLSDMSGS,'00000000'B,ADDR( 01755000 * IOPTLIST)); /* BUILD MESSAGE */ 01756000 L @09,DMCBTVP(,DMCBPTR) 0469 01757000 ST @09,@AL00001 0469 01758000 LA @09,@CF00646 0469 01759000 ST @09,@AL00001+4 0469 01760000 LA @09,DMCBMSG(,DMCBPTR) 0469 01761000 ST @09,@AL00001+8 0469 01762000 L @09,DMCBMSGS(,DMCBPTR) 0469 01763000 ST @09,@AL00001+12 0469 01764000 LA @09,@CB00712 0469 01765000 ST @09,@AL00001+16 0469 01766000 LA @09,IOPTLIST 0469 01767000 ST @09,@AFTEMPS+4 0469 01768000 LA @09,@AFTEMPS+4 0469 01769000 ST @09,@AL00001+20 0469 01770000 L @15,DMCBMSG0(,DMCBPTR) 0469 01771000 LA @01,@AL00001 0469 01772000 BALR @14,@15 0469 01773000 * END; /* BLSDMSG 0470 01774000 * (ZZ2,F3102C,DMCBMSG,BLSDMSGS) 01775000 * INSERT(DMCBMODL,CTEMP72) BUILD 01776000 * INVALID KEY MESSAGE */ 01777000 * RETCODE=ERROR; /* MARK ERROR */ 01778000 MVC RETCODE(4),@CF00046 0471 01779000 * ALSW=ON; /* TERMINATE LIST PROCESSING */ 01780000 OI ALSW,B'10000000' 0472 01781000 * GOTO CE0001@; /* BRANCH TO END OF CASE */ 01782000 B CE0001@ 0473 01783000 * END BAD; /* END OF SUBCASE UNDEFINED 0474 01784000 * OPCODE PROCESSING */ 01785000 *CE0001@: 0475 01786000 * END DSNAL; /* END OF CASE ALLOCATION 0475 01787000 * PARAMETER CASE STATEMENT */ 01788000 * END KEYPROC; 0476 01789000 @EL00004 DS 0H 0476 01790000 @EF00004 DS 0H 0476 01791000 @ER00004 LM @14,@02,@SA00004 0476 01792000 L @04,@SA00004+20 0476 01793000 LM @06,@07,@SA00004+24 0476 01794000 LM @09,@12,@SA00004+32 0476 01795000 BR @14 0476 01796000 * 0477 01797000 * /*****************************************************************/ 01798000 * /* */ 01799000 * /* INTERNAL PROCEDURE TO BUILD A VARIABLE LENGTH TEXT UNIT */ 01800000 * /* */ 01801000 * /*****************************************************************/ 01802000 * 0477 01803000 *BLDVLTU: 0477 01804000 * PROCEDURE(OP,LIM); 0477 01805000 BLDVLTU STM @14,@02,@SA00005 0477 01806000 ST @04,@SA00005+20 0477 01807000 STM @06,@07,@SA00005+24 0477 01808000 STM @09,@12,@SA00005+32 0477 01809000 MVC @PC00005(8),0(@01) 0477 01810000 * DCL 0478 01811000 * OP BIT(16); /* TEMP FOR TEXT UNIT KEY */ 01812000 * DCL 0479 01813000 * LIM BIN(31); /* TEMP FOR MAX VALID MOVE LENGTH*/ 01814000 * ALBAS=ALBAS+F4C; /* BUMP PLIST BASE TO PARM LENGTH 01815000 * ADDR */ 01816000 LA @09,4 0480 01817000 ALR ALBAS,@09 0480 01818000 * MLEN=ALPTF31; /* GET MOVE LENGTH */ 01819000 L @01,ALPTR(,ALBAS) 0481 01820000 L MLEN,ALPTF31(,@01) 0481 01821000 * ALBAS=ALBAS+F4C; /* BUMP ALPARM BASE TO GET PTR TO 01822000 * VL PARM FIELD */ 01823000 ALR ALBAS,@09 0482 01824000 * IF MLEN^=F0C THEN /* TEST FOR NON-NULL PARAMETER */ 01825000 SLR @09,@09 0483 01826000 CR MLEN,@09 0483 01827000 BE @RF00483 0483 01828000 * DO; /* LENGTH IS NOT EQUAL ZERO */ 01829000 * IF MLEN<0|MLEN>LIM THEN /* TEST FOR INVALID PARM LENGTH */ 01830000 CR MLEN,@09 0485 01831000 BL @RT00485 0485 01832000 L @09,@PC00005+4 0485 01833000 C MLEN,LIM(,@09) 0485 01834000 BNH @RF00485 0485 01835000 @RT00485 DS 0H 0486 01836000 * DO; /* INVALID PARAMETER LENGTH */ 01837000 * CHSTR867=ALOPT; /* GET KEY FIELD */ 01838000 STCM ALOPT,3,CHSTR867 0487 01839000 * CHSTR88=LHEX0FC; /* TRANSLATE FIELD TO CHAR HEX */ 01840000 MVI CHSTR88,X'0F' 0488 01841000 * UNPK(CTEMP,CHSTR8); 0489 01842000 UNPK CTEMP(9),CHSTR8(8) 0489 01843000 * TR(CTEMP,HEXTBL); 0490 01844000 TR CTEMP(9),HEXTBL 0490 01845000 * CTMPB=CTEMP72; /* SAVE KEY VALUE FOR MESSAGE */ 01846000 MVC CTMPB(2),CTEMP72 0491 01847000 * CHSTR847=MLEN; /* GET PARAMETER LENGTH FIELD */ 01848000 STCM MLEN,15,CHSTR847 0492 01849000 * CHSTR88=LHEX0FC; /* TRANSLATE FIELD TO CHAR HEX */ 01850000 MVI CHSTR88,X'0F' 0493 01851000 * UNPK(CTEMP,CHSTR8); 0494 01852000 UNPK CTEMP(9),CHSTR8(8) 0494 01853000 * TR(CTEMP,HEXTBL); 0495 01854000 TR CTEMP(9),HEXTBL 0495 01855000 * DO; /* BLSDMSG 0496 01856000 * (ZZ2,F3104C,DMCBMSG,BLSDMSGS) 01857000 * INSERT(DMCBMODL,CTMPB,(ALPTCVL 01858000 * ,LIM),CTEMP63) */ 01859000 * IOPTLIST(1)=ADDR(IOPTLIST(4));/* CHAIN TO NEXT INSERT */ 01860000 LA @09,IOPTLIST+12 0497 01861000 ST @09,IOPTLIST 0497 01862000 * IOPTLIST(2)=ADDR(DMCBMODL);/* INSERT NAME POINTER */ 01863000 LA @09,DMCBMODL(,DMCBPTR) 0498 01864000 ST @09,IOPTLIST+4 0498 01865000 * IOPTLIST(3)=0; /* ZERO RESERVED FIELD */ 01866000 SLR @09,@09 0499 01867000 ST @09,IOPTLIST+8 0499 01868000 * RFY 0500 01869000 * I015F BASED(ADDR(IOPTLIST(3)));/* ACCESS BYTES 1-2 */ 01870000 * I015F=LENGTH(DMCBMODL);/* INSERT LENGTH */ 01871000 LA @15,IOPTLIST+8 0501 01872000 MVC I015F(2,@15),@CH00046 0501 01873000 * IOPTLIST(4)=ADDR(IOPTLIST(7));/* CHAIN TO NEXT INSERT */ 01874000 LA @15,IOPTLIST+24 0502 01875000 ST @15,IOPTLIST+12 0502 01876000 * IOPTLIST(5)=ADDR(CTMPB);/* INSERT NAME POINTER */ 01877000 LA @15,CTMPB 0503 01878000 ST @15,IOPTLIST+16 0503 01879000 * IOPTLIST(6)=0; /* ZERO RESERVED FIELD */ 01880000 ST @09,IOPTLIST+20 0504 01881000 * RFY 0505 01882000 * I015F BASED(ADDR(IOPTLIST(6)));/* ACCESS BYTES 1-2 */ 01883000 * I015F=LENGTH(CTMPB); /* INSERT LENGTH */ 01884000 LA @15,IOPTLIST+20 0506 01885000 MVC I015F(2,@15),@CH00074 0506 01886000 * IOPTLIST(7)=ADDR(IOPTLIST(10));/* CHAIN TO NEXT INSERT */ 01887000 LA @15,IOPTLIST+36 0507 01888000 ST @15,IOPTLIST+24 0507 01889000 * IOPTLIST(8)=ADDR(ALPTCVL);/* INSERT NAME POINTER */ 01890000 L @15,ALPTR(,ALBAS) 0508 01891000 ST @15,IOPTLIST+28 0508 01892000 * IOPTLIST(9)=0; /* ZERO RESERVED FIELD */ 01893000 ST @09,IOPTLIST+32 0509 01894000 * RFY 0510 01895000 * I015F BASED(ADDR(IOPTLIST(9)));/* ACCESS BYTES 1-2 */ 01896000 * I015F=LIM; /* INSERT LENGTH */ 01897000 LA @15,IOPTLIST+32 0511 01898000 L @14,@PC00005+4 0511 01899000 L @14,LIM(,@14) 0511 01900000 STH @14,I015F(,@15) 0511 01901000 * IOPTLIST(10)=0; /* LAST INSERT */ 01902000 ST @09,IOPTLIST+36 0512 01903000 * IOPTLIST(11)=ADDR(CTEMP63);/* INSERT NAME POINTER */ 01904000 LA @15,CTEMP63 0513 01905000 ST @15,IOPTLIST+40 0513 01906000 * IOPTLIST(12)=0; /* ZERO RESERVED FIELD */ 01907000 ST @09,IOPTLIST+44 0514 01908000 * RFY 0515 01909000 * I015F BASED(ADDR(IOPTLIST(12)));/* ACCESS BYTES 1-2 */ 01910000 * I015F=LENGTH(CTEMP63);/* INSERT LENGTH */ 01911000 LA @09,IOPTLIST+44 0516 01912000 MVC I015F(2,@09),@CH00103 0516 01913000 * CALL BLSDMSG0(ZZ2,F3104C,DMCBMSG,BLSDMSGS,'00000000'B, 01914000 * ADDR(IOPTLIST)); /* BUILD MESSAGE */ 01915000 L @09,DMCBTVP(,DMCBPTR) 0517 01916000 ST @09,@AL00001 0517 01917000 LA @09,@CF00650 0517 01918000 ST @09,@AL00001+4 0517 01919000 LA @09,DMCBMSG(,DMCBPTR) 0517 01920000 ST @09,@AL00001+8 0517 01921000 L @09,DMCBMSGS(,DMCBPTR) 0517 01922000 ST @09,@AL00001+12 0517 01923000 LA @09,@CB00712 0517 01924000 ST @09,@AL00001+16 0517 01925000 LA @09,IOPTLIST 0517 01926000 ST @09,@AFTEMPS+8 0517 01927000 LA @09,@AFTEMPS+8 0517 01928000 ST @09,@AL00001+20 0517 01929000 L @15,DMCBMSG0(,DMCBPTR) 0517 01930000 LA @01,@AL00001 0517 01931000 BALR @14,@15 0517 01932000 * END; /* BLSDMSG 0518 01933000 * (ZZ2,F3104C,DMCBMSG,BLSDMSGS) 01934000 * INSERT(DMCBMODL,CTMPB,(ALPTCVL 01935000 * ,LIM),CTEMP63) BUILD INVALID 01936000 * VARIABLE LENGTH TEXT UNIT 0518 01937000 * PARAMETER MESSAGE */ 01938000 * RETCODE=ERROR; /* MARK ERROR */ 01939000 MVC RETCODE(4),@CF00046 0519 01940000 * ALSW=ON; /* TERMINATE LIST PROCESSING */ 01941000 OI ALSW,B'10000000' 0520 01942000 * END; /* INVALID PARAMETER LENGTH */ 01943000 * ELSE 0522 01944000 * DO; /* VALID PARAMETER LENGTH */ 01945000 B @RC00485 0522 01946000 @RF00485 DS 0H 0523 01947000 * TLEN=F6C; /* TEXT UNIT LENGTH */ 01948000 LA TLEN,6 0523 01949000 * S99TUPTR(S99TUPLX)=S99TUBAS;/* INIT TU PTR TO START OF TU*/ 01950000 LR @09,S99TUPLX 0524 01951000 SLA @09,2 0524 01952000 L @06,S99TXTPP(,DMCBPTR) 0524 01953000 AL @06,@CF00950 0524 01954000 ST S99TUBAS,S99TUPTR(@09,@06) 0524 01955000 * RFY 0525 01956000 * S99TUNIT BASED(S99TUBAS);/* BASE THE TEXT UNIT */ 01957000 * S99TUKEY=OP; /* INIT THE KEY */ 01958000 L @09,@PC00005 0526 01959000 MVC S99TUKEY(2,S99TUBAS),OP(@09) 0526 01960000 * S99TUNUM=F1C; /* NUMBER OF TU ENTRIES */ 01961000 MVC S99TUNUM(2,S99TUBAS),@CH00048 0527 01962000 * S99TULNG=MLEN; /* ENTRY LENGTH */ 01963000 STCM MLEN,3,S99TULNG(S99TUBAS) 0528 01964000 * S99TUPAR(F1C:MLEN)=ALPTCVL(F1C:MLEN);/* MOVE IN VL PARM */ 01965000 LR @09,MLEN 0529 01966000 BCTR @09,0 0529 01967000 L @01,ALPTR(,ALBAS) 0529 01968000 EX @09,@SM00951 0529 01969000 * END; /* VALID PARAMETER LENGTH */ 01970000 * END; /* LENGTH IS NOT EQUAL TO ZERO */ 01971000 * END BLDVLTU; /* END INTERNAL PROCEDURE */ 01972000 @EL00005 DS 0H 0532 01973000 @EF00005 DS 0H 0532 01974000 @ER00005 LM @14,@02,@SA00005 0532 01975000 L @04,@SA00005+20 0532 01976000 LM @06,@07,@SA00005+24 0532 01977000 LM @09,@12,@SA00005+32 0532 01978000 BR @14 0532 01979000 * 0533 01980000 * /*****************************************************************/ 01981000 * /* */ 01982000 * /* INTERNAL PROCEDURE TO BUILD A 0 BYTE PARAMETER TEXT UNIT */ 01983000 * /* */ 01984000 * /*****************************************************************/ 01985000 * 0533 01986000 *BLDV0TU: 0533 01987000 * PROCEDURE(OPA); 0533 01988000 BLDV0TU STM @14,@07,12(@13) 0533 01989000 STM @09,@12,56(@13) 0533 01990000 MVC @PC00006(4),0(@01) 0533 01991000 * DCL 0534 01992000 * OPA BIT(16); /* TEMP FOR TEXT UNIT KEY */ 01993000 * TLEN=F4C; /* TEXT UNIT LENGTH */ 01994000 LA TLEN,4 0535 01995000 * S99TUPTR(S99TUPLX)=S99TUBAS; /* INIT TU PTR TO START OF TU */ 01996000 LR @09,S99TUPLX 0536 01997000 SLA @09,2 0536 01998000 L @06,S99TXTPP(,DMCBPTR) 0536 01999000 AL @06,@CF00950 0536 02000000 ST S99TUBAS,S99TUPTR(@09,@06) 0536 02001000 * RFY 0537 02002000 * S99TUNIT BASED(S99TUBAS); /* BASE THE TEXT UNIT */ 02003000 * S99TUKEY=OPA; /* INIT THE KEY */ 02004000 L @09,@PC00006 0538 02005000 MVC S99TUKEY(2,S99TUBAS),OPA(@09) 0538 02006000 * S99TUNUM=F0C; /* NUMBER OF TU ENTRIES */ 02007000 SLR @09,@09 0539 02008000 STCM @09,3,S99TUNUM(S99TUBAS) 0539 02009000 * END BLDV0TU; /* END INTERNAL PROCEDURE */ 02010000 * 0540 02011000 @EL00006 DS 0H 0540 02012000 @EF00006 DS 0H 0540 02013000 @ER00006 LM @14,@07,12(@13) 0540 02014000 LM @09,@12,56(@13) 0540 02015000 BR @14 0540 02016000 * /*****************************************************************/ 02017000 * /* */ 02018000 * /* INTERNAL PROCEDURE TO BUILD A 1 BYTE PARAMETER TEXT UNIT */ 02019000 * /* */ 02020000 * /*****************************************************************/ 02021000 * 0541 02022000 *BLDV1TU: 0541 02023000 * PROCEDURE(OPB,VALC1); 0541 02024000 BLDV1TU STM @14,@07,12(@13) 0541 02025000 STM @09,@12,56(@13) 0541 02026000 MVC @PC00007(8),0(@01) 0541 02027000 * DCL 0542 02028000 * OPB BIT(16), /* TEXT UNIT KEY */ 02029000 * VALC1 CHAR(1); /* TEXT UNIT PARAMETER VALUE */ 02030000 * TLEN=F7C; /* TEXT UNIT LENGTH */ 02031000 LA TLEN,7 0543 02032000 * S99TUPTR(S99TUPLX)=S99TUBAS; /* INIT TU PTR TO START OF TU */ 02033000 LR @09,S99TUPLX 0544 02034000 SLA @09,2 0544 02035000 L @06,S99TXTPP(,DMCBPTR) 0544 02036000 AL @06,@CF00950 0544 02037000 ST S99TUBAS,S99TUPTR(@09,@06) 0544 02038000 * RFY 0545 02039000 * S99TUNIT BASED(S99TUBAS); /* BASE THE TEXT UNIT */ 02040000 * S99TUKEY=OPB; /* INIT THE KEY */ 02041000 L @09,@PC00007 0546 02042000 MVC S99TUKEY(2,S99TUBAS),OPB(@09) 0546 02043000 * S99TUNUM=F1C; /* NUMBER OF TU ENTRIES */ 02044000 LA @09,1 0547 02045000 STCM @09,3,S99TUNUM(S99TUBAS) 0547 02046000 * S99TULNG=F1C; /* ENTRY LENGTH */ 02047000 STCM @09,3,S99TULNG(S99TUBAS) 0548 02048000 * S99TUPR1=VALC1; /* MOVE IN PARM */ 02049000 L @09,@PC00007+4 0549 02050000 MVC S99TUPR1(1,S99TUBAS),VALC1(@09) 0549 02051000 * END BLDV1TU; /* END INTERNAL PROCEDURE */ 02052000 @EL00007 DS 0H 0550 02053000 @EF00007 DS 0H 0550 02054000 @ER00007 LM @14,@07,12(@13) 0550 02055000 LM @09,@12,56(@13) 0550 02056000 BR @14 0550 02057000 * 0551 02058000 * /*****************************************************************/ 02059000 * /* */ 02060000 * /* INTERNAL PROCEDURE TO BUILD A 2 BYTE PARAMETER TEXT UNIT */ 02061000 * /* */ 02062000 * /*****************************************************************/ 02063000 * 0551 02064000 *BLDP2TU: 0551 02065000 * PROCEDURE(OPC); 0551 02066000 BLDP2TU STM @14,@02,12(@13) 0551 02067000 STM @04,@07,36(@13) 0551 02068000 STM @09,@12,56(@13) 0551 02069000 MVC @PC00008(4),0(@01) 0551 02070000 * DCL 0552 02071000 * OPC BIT(16); /* TEMP FOR TEXT UNIT KEY */ 02072000 * ALBAS=ALBAS+F4C; /* BUMP PLIST BASE TO PARM VALUE 02073000 * ADDR */ 02074000 AL ALBAS,@CF00039 0553 02075000 * TLEN=F8C; /* TEXT UNIT LENGTH */ 02076000 LA TLEN,8 0554 02077000 * S99TUPTR(S99TUPLX)=S99TUBAS; /* INIT TU PTR TO START OF TU */ 02078000 LR @09,S99TUPLX 0555 02079000 SLA @09,2 0555 02080000 L @06,S99TXTPP(,DMCBPTR) 0555 02081000 AL @06,@CF00950 0555 02082000 ST S99TUBAS,S99TUPTR(@09,@06) 0555 02083000 * RFY 0556 02084000 * S99TUNIT BASED(S99TUBAS); /* BASE THE TEXT UNIT */ 02085000 * S99TUKEY=OPC; /* INIT THE KEY */ 02086000 L @09,@PC00008 0557 02087000 MVC S99TUKEY(2,S99TUBAS),OPC(@09) 0557 02088000 * S99TUNUM=F1C; /* NUMBER OF TU ENTRIES */ 02089000 MVC S99TUNUM(2,S99TUBAS),@CH00048 0558 02090000 * S99TULNG=F2C; /* ENTRY LENGTH */ 02091000 MVC S99TULNG(2,S99TUBAS),@CH00074 0559 02092000 * S99TUPR2=ALPTB3C2; /* MOVE IN PARM */ 02093000 L @09,ALPTR(,ALBAS) 0560 02094000 MVC S99TUPR2(2,S99TUBAS),ALPTB3C2(@09) 0560 02095000 * END BLDP2TU; /* END INTERNAL PROCEDURE */ 02096000 * 0561 02097000 @EL00008 DS 0H 0561 02098000 @EF00008 DS 0H 0561 02099000 @ER00008 LM @14,@02,12(@13) 0561 02100000 LM @04,@07,36(@13) 0561 02101000 LM @09,@12,56(@13) 0561 02102000 BR @14 0561 02103000 * /*****************************************************************/ 02104000 * /* */ 02105000 * /* INTERNAL PROCEDURE TO BUILD A 3 BYTE PARAMETER TEXT UNIT */ 02106000 * /* */ 02107000 * /*****************************************************************/ 02108000 * 0562 02109000 *BLDP3TU: 0562 02110000 * PROCEDURE(OPD); 0562 02111000 BLDP3TU STM @14,@07,12(@13) 0562 02112000 STM @09,@12,56(@13) 0562 02113000 MVC @PC00009(4),0(@01) 0562 02114000 * DCL 0563 02115000 * OPD BIT(16); /* TEMP FOR TEXT UNIT KEY */ 02116000 * TLEN=F9C; /* TEXT UNIT LENGTH */ 02117000 LA TLEN,9 0564 02118000 * S99TUPTR(S99TUPLX)=S99TUBAS; /* INIT TU PTR TO START OF TU */ 02119000 LR @09,S99TUPLX 0565 02120000 SLA @09,2 0565 02121000 L @06,S99TXTPP(,DMCBPTR) 0565 02122000 AL @06,@CF00950 0565 02123000 ST S99TUBAS,S99TUPTR(@09,@06) 0565 02124000 * RFY 0566 02125000 * S99TUNIT BASED(S99TUBAS); /* BASE THE TEXT UNIT */ 02126000 * S99TUKEY=OPD; /* INIT THE KEY */ 02127000 L @09,@PC00009 0567 02128000 MVC S99TUKEY(2,S99TUBAS),OPD(@09) 0567 02129000 * S99TUNUM=F1C; /* NUMBER OF TU ENTRIES */ 02130000 MVC S99TUNUM(2,S99TUBAS),@CH00048 0568 02131000 * S99TULNG=F3C; /* ENTRY LENGTH */ 02132000 MVC S99TULNG(2,S99TUBAS),@CH00103 0569 02133000 * S99TUPR3=ALPTB2C3; /* MOVE IN PARM */ 02134000 L @09,ALPTR(,ALBAS) 0570 02135000 MVC S99TUPR3(3,S99TUBAS),ALPTB2C3(@09) 0570 02136000 * END BLDP3TU; /* END INTERNAL PROCEDURE */ 02137000 @EL00009 DS 0H 0571 02138000 @EF00009 DS 0H 0571 02139000 @ER00009 LM @14,@07,12(@13) 0571 02140000 LM @09,@12,56(@13) 0571 02141000 BR @14 0571 02142000 * 0572 02143000 * /*****************************************************************/ 02144000 * /* */ 02145000 * /* INTERNAL PROCEDURE TO BUILD A VARIABLE LENGTH TEXT UNIT FROM */ 02146000 * /* LEFT JUSTIFIED FIELD PADDED WITH BLANKS. THE MAXIMUM LENGTH OF*/ 02147000 * /* THE FIELD IS IS SUPPLIED IN MAXL */ 02148000 * /* */ 02149000 * /*****************************************************************/ 02150000 * 0572 02151000 *BLDPVTU: 0572 02152000 * PROCEDURE(OPE,MAXL); 0572 02153000 BLDPVTU STM @14,@02,12(@13) 0572 02154000 ST @04,36(,@13) 0572 02155000 STM @06,@07,44(@13) 0572 02156000 STM @09,@12,56(@13) 0572 02157000 MVC @PC00010(8),0(@01) 0572 02158000 * DCL 0573 02159000 * OPE BIT(16); /* TEMP FOR TEXT UNIT KEY */ 02160000 * DCL 0574 02161000 * MAXL BIN(31); /* TEMP FOR MAXIMUM MOVE LENGTH */ 02162000 * DCL 0575 02163000 * II BIN(31); /* TEMP FOR DO LOOP COUNT */ 02164000 * ALBAS=ALBAS+F4C; /* BUMP PLIST BASE TO PARM VALUE 02165000 * ADDR */ 02166000 AL ALBAS,@CF00039 0576 02167000 * DO II=F1C TO MAXL WHILE ALPTCVL(II)^=LBLNKC;/* FIND END OF STRING*/ 02168000 LA II,1 0577 02169000 B @DE00577 0577 02170000 @DL00577 L @09,ALPTR(,ALBAS) 0577 02171000 ALR @09,II 0577 02172000 BCTR @09,0 0577 02173000 CLI ALPTCVL(@09),C' ' 0577 02174000 BE @DC00577 0577 02175000 * END; 0578 02176000 AL II,@CF00048 0578 02177000 @DE00577 L @09,@PC00010+4 0578 02178000 C II,MAXL(,@09) 0578 02179000 BNH @DL00577 0578 02180000 @DC00577 DS 0H 0579 02181000 * MLEN=II-F1C; /* GET MOVE LENGTH */ 02182000 LR MLEN,II 0579 02183000 BCTR MLEN,0 0579 02184000 * IF MLEN^=F0C THEN /* TEST FOR NON-NULL PARAMETER */ 02185000 LTR MLEN,MLEN 0580 02186000 BZ @RF00580 0580 02187000 * DO; /* LENGTH IS NOT EQUAL ZERO */ 02188000 * TLEN=F6C; /* TEXT UNIT LENGTH */ 02189000 LA TLEN,6 0582 02190000 * S99TUPTR(S99TUPLX)=S99TUBAS;/* INIT TU PTR TO START OF TU */ 02191000 LR @09,S99TUPLX 0583 02192000 SLA @09,2 0583 02193000 L @06,S99TXTPP(,DMCBPTR) 0583 02194000 AL @06,@CF00950 0583 02195000 ST S99TUBAS,S99TUPTR(@09,@06) 0583 02196000 * RFY 0584 02197000 * S99TUNIT BASED(S99TUBAS); /* BASE THE TEXT UNIT */ 02198000 * S99TUKEY=OPE; /* INIT THE KEY */ 02199000 L @09,@PC00010 0585 02200000 MVC S99TUKEY(2,S99TUBAS),OPE(@09) 0585 02201000 * S99TUNUM=F1C; /* NUMBER OF TU ENTRIES */ 02202000 MVC S99TUNUM(2,S99TUBAS),@CH00048 0586 02203000 * S99TULNG=MLEN; /* ENTRY LENGTH */ 02204000 STCM MLEN,3,S99TULNG(S99TUBAS) 0587 02205000 * S99TUPAR(F1C:MLEN)=ALPTCVL(F1C:MLEN);/* MOVE IN VL PARM */ 02206000 LR @09,MLEN 0588 02207000 BCTR @09,0 0588 02208000 L @01,ALPTR(,ALBAS) 0588 02209000 EX @09,@SM00951 0588 02210000 * END; /* LENGTH IS NOT EQUAL TO ZERO */ 02211000 * END BLDPVTU; /* END INTERNAL PROCEDURE */ 02212000 @EL00010 DS 0H 0590 02213000 @EF00010 DS 0H 0590 02214000 @ER00010 LM @14,@02,12(@13) 0590 02215000 L @04,36(,@13) 0590 02216000 LM @06,@07,44(@13) 0590 02217000 LM @09,@12,56(@13) 0590 02218000 BR @14 0590 02219000 * 0591 02220000 * /*****************************************************************/ 02221000 * /* */ 02222000 * /* PROCEDURE TO MATCH A VARIABLE LENGTH FIELD VALUE WITH A LIST */ 02223000 * /* OF VALID VALUES AND RETURN A ONE BYTE TEXT UNIT PARAMETER */ 02224000 * /* VALUE */ 02225000 * /* */ 02226000 * /*****************************************************************/ 02227000 * 0591 02228000 *MATCH: 0591 02229000 * PROCEDURE(MATFLD,MATSTRL,MATSTR,MATVAL); 0591 02230000 MATCH STM @14,@12,12(@13) 0591 02231000 MVC @PC00011(16),0(@01) 0591 02232000 * DCL 0592 02233000 * MATFLD CHAR(*), /* PARAMETER FIELD VALUE TO BE 0592 02234000 * EXAMINED */ 02235000 * MATSTRL BIN(31), /* LENGTH OF VALID VALUE STRING */ 02236000 * MATSTR CHAR(*), /* TEXT OF VALID VALUE STRING */ 02237000 * MATVAL CHAR(1), /* TEXT UNIT PARAMETER VALUE 0592 02238000 * RETURNED */ 02239000 * MATLEN BIN(31), /* LOCAL COPY OF MATSTRL */ 02240000 * MATSW BIT(1), /* 1 IF MATCH FOUND */ 02241000 * MATSK BIT(1), /* 1 IF NO MATCH WITH CURRENT 0592 02242000 * VALID VALUE */ 02243000 * MATI BIN(31), /* VALID VALUE STRING INDEX */ 02244000 * MATJ BIN(31), /* PARM FIELD VALUE INDEX */ 02245000 * MATHEX0 BIT(8) CONSTANT('00'X),/* LITERAL HEX 0 */ 02246000 * MATSTARC CHAR(1) CONSTANT('*');/* LITERAL '*' */ 02247000 * MATVAL=MATHEX0; /* INIT RETURN VALUE TO NOT FOUND*/ 02248000 L @05,@PC00011+12 0593 02249000 MVI MATVAL(@05),X'00' 0593 02250000 * MATLEN=MATSTRL; /* MAKE LOCAL COPY OF STRING 0594 02251000 * LENGTH */ 02252000 L @02,@PC00011+4 0594 02253000 L MATLEN,MATSTRL(,@02) 0594 02254000 * MATSW=OFF; /* INIT MATCH FOUND SWITCH */ 02255000 NI MATSW,B'01111111' 0595 02256000 * MATSK=OFF; /* INIT CURRENT NO MATCH SWITCH */ 02257000 NI MATSK,B'01111111' 0596 02258000 * MATJ=F1C; /* INIT PARM FIELD INDEX */ 02259000 LA @05,1 0597 02260000 LR MATJ,@05 0597 02261000 * DO MATI=F1C TO MATLEN WHILE MATSW=OFF;/* SCAN VALID VALUE STRING */ 02262000 LR MATI,@05 0598 02263000 B @DE00598 0598 02264000 @DL00598 TM MATSW,B'10000000' 0598 02265000 BNZ @DC00598 0598 02266000 * IF MATSW=OFF THEN /* TEST THAT CURRENT VALID VALUE 02267000 * STRING MATCHES */ 02268000 TM MATSW,B'10000000' 0599 02269000 BNZ @RF00599 0599 02270000 * DO; /* CURRENT VALID VALUE STRING 0600 02271000 * MATCHES SO FAR */ 02272000 * IF MATSTR(MATI)=MATSTARC THEN/* TEST VALID VALUE DELIMITER */ 02273000 L @05,@PC00011+8 0601 02274000 LR @01,@05 0601 02275000 ALR @01,MATI 0601 02276000 BCTR @01,0 0601 02277000 CLI MATSTR(@01),C'*' 0601 02278000 BNE @RF00601 0601 02279000 * DO; /* MATCH FOUND */ 02280000 * MATSW=ON; /* PARM FIELD AND VALID VALUE 0603 02281000 * MATCH */ 02282000 OI MATSW,B'10000000' 0603 02283000 * MATI=MATI+F1C; /* BUMP VALID VALUE STRING TO 0604 02284000 * RETURN VALUE */ 02285000 AL MATI,@CF00048 0604 02286000 * MATVAL=MATSTR(MATI); /* RETURN TEXT UNIT PARAMETER 0605 02287000 * VALUE */ 02288000 L @15,@PC00011+12 0605 02289000 ALR @05,MATI 0605 02290000 BCTR @05,0 0605 02291000 MVC MATVAL(1,@15),MATSTR(@05) 0605 02292000 * END; /* MATCH FOUND */ 02293000 * ELSE 0607 02294000 * DO; /* MATCH NOT FOUND */ 02295000 B @RC00601 0607 02296000 @RF00601 DS 0H 0608 02297000 * IF MATFLD(MATJ)=MATSTR(MATI) THEN/* TEST BYTE FOR MATCH*/ 02298000 L @05,@PC00011 0608 02299000 L @15,@PC00011+8 0608 02300000 ALR @05,MATJ 0608 02301000 BCTR @05,0 0608 02302000 ALR @15,MATI 0608 02303000 BCTR @15,0 0608 02304000 CLC MATFLD(1,@05),MATSTR(@15) 0608 02305000 BNE @RF00608 0608 02306000 * DO; /* BYTES MATCH */ 02307000 * MATJ=MATJ+F1C; /* BUMP PARM FIELD INDEX TO NEXT 02308000 * BYTE */ 02309000 AL MATJ,@CF00048 0610 02310000 * END; /* BYTES MATCH */ 02311000 * ELSE 0612 02312000 * DO; /* BYTES DO NOT MATCH */ 02313000 B @RC00608 0612 02314000 @RF00608 DS 0H 0613 02315000 * MATSK=ON; /* CURRENT VALID VALUE DOES NOT 02316000 * MATCH */ 02317000 OI MATSK,B'10000000' 0613 02318000 * MATJ=F1C; /* RESET THE PARMFIELD INDEX FOR 02319000 * NEXT MATCH TEST */ 02320000 LA MATJ,1 0614 02321000 * END; /* BYTES DO NOT MATCH */ 02322000 * END; /* MATCH NOT FOUND */ 02323000 @RC00608 DS 0H 0617 02324000 * END; /* CURRENT VALID VALUE STRING 0617 02325000 * MATCHES SO FAR */ 02326000 @RC00601 DS 0H 0618 02327000 * IF MATSK=ON& /* TEST FOR CURRENT VALID VALUE 02328000 * DOES NOT MATCH */ 02329000 * MATSTR(MATI)=MATSTARC THEN/* AND FOR VALID VALUE DELIMETER */ 02330000 @RF00599 TM MATSK,B'10000000' 0618 02331000 BNO @RF00618 0618 02332000 L @05,@PC00011+8 0618 02333000 ALR @05,MATI 0618 02334000 BCTR @05,0 0618 02335000 CLI MATSTR(@05),C'*' 0618 02336000 BNE @RF00618 0618 02337000 * DO; /* END OF CURRENT VALUE, SET UP 02338000 * TO TEST NEXT VALUE */ 02339000 * MATI=MATI+F1C; /* SKIP INDEX OVER RETURN VALUE */ 02340000 AL MATI,@CF00048 0620 02341000 * MATSK=OFF; /* STOP SKIPPING OVER NO MATCH 0621 02342000 * VALUE */ 02343000 NI MATSK,B'01111111' 0621 02344000 * END; /* END OF CURRENT VALUE, SET UP 02345000 * TO TEST NEXT VALUE */ 02346000 * END; /* SCAN VALID VALUE STRING */ 02347000 @RF00618 AL MATI,@CF00048 0623 02348000 @DE00598 CR MATI,MATLEN 0623 02349000 BNH @DL00598 0623 02350000 @DC00598 DS 0H 0624 02351000 * END MATCH; /* END PROCEDURE */ 02352000 @EL00011 DS 0H 0624 02353000 @EF00011 DS 0H 0624 02354000 @ER00011 LM @14,@12,12(@13) 0624 02355000 BR @14 0624 02356000 * 0625 02357000 * /*****************************************************************/ 02358000 * /* */ 02359000 * /* PROCEDURE TO ISSUE A PARM VALUE ERROR MESSAGE */ 02360000 * /* */ 02361000 * /*****************************************************************/ 02362000 * 0625 02363000 *PARMERR: 0625 02364000 * PROCEDURE(PARMODLL,PARMODL,PARKEYL,PARKEY,PARPARML,PARPARM); 0625 02365000 PARMERR STM @14,@12,@SA00012 0625 02366000 MVC @PC00012(24),0(@01) 0625 02367000 * DCL 0626 02368000 * PARMODLL BIN(31), /* ALLOCATION MODEL NAME INSERT 02369000 * LENGTH */ 02370000 * PARMODL CHAR(*), /* ALLOCATION MODEL NAME INSERT 02371000 * TEXT */ 02372000 * PARKEYL BIN(31), /* PARAMETER KEY NAME INSERT 0626 02373000 * LENGTH */ 02374000 * PARKEY CHAR(*), /* PARAMETER KEY NAME INSERT TEXT*/ 02375000 * PARPARML BIN(31), /* PARMAETER FIELD INSERT LENGTH */ 02376000 * PARPARM CHAR(*); /* PARAMETER FIELD INSERT TEXT */ 02377000 * RETCODE=ERROR; /* MARK ERROR */ 02378000 MVC RETCODE(4),@CF00046 0627 02379000 * DO; /* BLSDMSG 0628 02380000 * (ZZ2,F3103C,DMCBMSG,BLSDMSGS) 02381000 * INSERT((PARKEY,PARKEYL),(PARMO 02382000 * DL,PARMODLL),(PARKEY,PARKEYL), 02383000 * (PARPARM,PARPARML)) */ 02384000 * IOPTLIST(1)=ADDR(IOPTLIST(4));/* CHAIN TO NEXT INSERT */ 02385000 LA @05,IOPTLIST+12 0629 02386000 ST @05,IOPTLIST 0629 02387000 * IOPTLIST(2)=ADDR(PARKEY); /* INSERT NAME POINTER */ 02388000 L @05,@PC00012+12 0630 02389000 ST @05,IOPTLIST+4 0630 02390000 * IOPTLIST(3)=0; /* ZERO RESERVED FIELD */ 02391000 SLR @15,@15 0631 02392000 ST @15,IOPTLIST+8 0631 02393000 * RFY 0632 02394000 * I015F BASED(ADDR(IOPTLIST(3)));/* ACCESS BYTES 1-2 */ 02395000 * I015F=PARKEYL; /* INSERT LENGTH */ 02396000 LA @14,IOPTLIST+8 0633 02397000 L @09,@PC00012+8 0633 02398000 L @09,PARKEYL(,@09) 0633 02399000 STH @09,I015F(,@14) 0633 02400000 * IOPTLIST(4)=ADDR(IOPTLIST(7));/* CHAIN TO NEXT INSERT */ 02401000 LA @14,IOPTLIST+24 0634 02402000 ST @14,IOPTLIST+12 0634 02403000 * IOPTLIST(5)=ADDR(PARMODL); /* INSERT NAME POINTER */ 02404000 L @14,@PC00012+4 0635 02405000 ST @14,IOPTLIST+16 0635 02406000 * IOPTLIST(6)=0; /* ZERO RESERVED FIELD */ 02407000 ST @15,IOPTLIST+20 0636 02408000 * RFY 0637 02409000 * I015F BASED(ADDR(IOPTLIST(6)));/* ACCESS BYTES 1-2 */ 02410000 * I015F=PARMODLL; /* INSERT LENGTH */ 02411000 LA @14,IOPTLIST+20 0638 02412000 L @08,@PC00012 0638 02413000 L @08,PARMODLL(,@08) 0638 02414000 STH @08,I015F(,@14) 0638 02415000 * IOPTLIST(7)=ADDR(IOPTLIST(10));/* CHAIN TO NEXT INSERT */ 02416000 LA @14,IOPTLIST+36 0639 02417000 ST @14,IOPTLIST+24 0639 02418000 * IOPTLIST(8)=ADDR(PARKEY); /* INSERT NAME POINTER */ 02419000 ST @05,IOPTLIST+28 0640 02420000 * IOPTLIST(9)=0; /* ZERO RESERVED FIELD */ 02421000 ST @15,IOPTLIST+32 0641 02422000 * RFY 0642 02423000 * I015F BASED(ADDR(IOPTLIST(9)));/* ACCESS BYTES 1-2 */ 02424000 * I015F=PARKEYL; /* INSERT LENGTH */ 02425000 LA @05,IOPTLIST+32 0643 02426000 STH @09,I015F(,@05) 0643 02427000 * IOPTLIST(10)=0; /* LAST INSERT */ 02428000 ST @15,IOPTLIST+36 0644 02429000 * IOPTLIST(11)=ADDR(PARPARM); /* INSERT NAME POINTER */ 02430000 L @05,@PC00012+20 0645 02431000 ST @05,IOPTLIST+40 0645 02432000 * IOPTLIST(12)=0; /* ZERO RESERVED FIELD */ 02433000 ST @15,IOPTLIST+44 0646 02434000 * RFY 0647 02435000 * I015F BASED(ADDR(IOPTLIST(12)));/* ACCESS BYTES 1-2 */ 02436000 * I015F=PARPARML; /* INSERT LENGTH */ 02437000 LA @05,IOPTLIST+44 0648 02438000 L @15,@PC00012+16 0648 02439000 L @15,PARPARML(,@15) 0648 02440000 STH @15,I015F(,@05) 0648 02441000 * CALL BLSDMSG0(ZZ2,F3103C,DMCBMSG,BLSDMSGS,'00000000'B,ADDR( 0649 02442000 * IOPTLIST)); /* BUILD MESSAGE */ 02443000 L @05,DMCBTVP(,DMCBPTR) 0649 02444000 ST @05,@AL00001 0649 02445000 LA @05,@CF00648 0649 02446000 ST @05,@AL00001+4 0649 02447000 LA @05,DMCBMSG(,DMCBPTR) 0649 02448000 ST @05,@AL00001+8 0649 02449000 L @05,DMCBMSGS(,DMCBPTR) 0649 02450000 ST @05,@AL00001+12 0649 02451000 LA @05,@CB00712 0649 02452000 ST @05,@AL00001+16 0649 02453000 LA @05,IOPTLIST 0649 02454000 ST @05,@AFTEMPS+12 0649 02455000 LA @05,@AFTEMPS+12 0649 02456000 ST @05,@AL00001+20 0649 02457000 L @15,DMCBMSG0(,DMCBPTR) 0649 02458000 LA @01,@AL00001 0649 02459000 BALR @14,@15 0649 02460000 * END; /* BLSDMSG 0650 02461000 * (ZZ2,F3103C,DMCBMSG,BLSDMSGS) 02462000 * INSERT((PARKEY,PARKEYL),(PARMO 02463000 * DL,PARMODLL),(PARKEY,PARKEYL), 02464000 * (PARPARM,PARPARML)) ISSUE PARM 02465000 * VALUE ERROR MESSAGE */ 02466000 * END PARMERR; /* ISSUE PARM VALUE ERROR MESSAGE*/ 02467000 * 0651 02468000 @EL00012 DS 0H 0651 02469000 @EF00012 DS 0H 0651 02470000 @ER00012 LM @14,@12,@SA00012 0651 02471000 BR @14 0651 02472000 * /*****************************************************************/ 02473000 * /* */ 02474000 * /* END OF EXECUTABLE PROCEDURE STATEMENTS */ 02475000 * /* */ 02476000 * /*****************************************************************/ 02477000 * 0652 02478000 * DECLARE /* GENERAL PURPOSE REGISTERS */ 02479000 * GPR01P PTR(31) REG(1); 0652 02480000 * DECLARE /* COMMON VARIABLES */ 02481000 * I256C CHAR(256) BASED, 0653 02482000 * I031F FIXED(31) BASED, 0653 02483000 * I031P PTR(31) BASED, 0653 02484000 * I015F FIXED(15) BASED, 0653 02485000 * I015P PTR(15) BASED, 0653 02486000 * I008P PTR(8) BASED, 0653 02487000 * I001C CHAR(1) BASED; 0653 02488000 * DECLARE 0654 02489000 * IOPTLIST(12) PTR(31) BDY(WORD);/* OPTION LIST ARRAY */ 02490000 * DCL 0655 02491000 * 1 DASPATCH LOCAL BDY(DWORD), /* PATCH AREA */ 02492000 * 2 DASPATA(DASPATLN) PTR INIT((DASPATLN)0); 0655 02493000 * GEN DATA DEFS(HEXTBL); 0656 02494000 * END BLSCABLD 0657 02495000 * 0657 02496000 */* THE FOLLOWING INCLUDE STATEMENTS WERE FOUND IN THIS PROGRAM. */ 02497000 */*%INCLUDE SYSLIB (IEFZB4D0) */ 02498000 */*%INCLUDE SYSLIB (IEFZB4D2) */ 02499000 * 0657 02500000 * ; 0657 02501000 @EL00001 L @13,4(,@13) 0657 02502000 @EF00001 L @00,@SIZDATD 0657 02503000 LR @01,@10 0657 02504000 BLSCFRES R,LV=(0),A=(1) 02505000 @ER00001 LM @14,@12,12(@13) 0657 02506000 BR @14 0657 02507000 @DATA DS 0H 02508000 @CH00074 DC H'2' 02509000 @SM00938 MVC DMCBDDNM(0,DMCBPTR),S99TUPAR(S99TUBAS) 02510000 @SM00940 MVC DMCBDSN(0,DMCBPTR),S99TUPAR(S99TUBAS) 02511000 @SM00942 MVC DMCBMEMB(0,DMCBPTR),S99TUPAR(S99TUBAS) 02512000 @SM00946 MVC DMCBVOL(0,DMCBPTR),S99TUPAR(S99TUBAS) 02513000 @SM00948 MVC DMCBUNIT(0,DMCBPTR),S99TUPAR(S99TUBAS) 02514000 @SM00951 MVC S99TUPAR(0,S99TUBAS),ALPTCVL(@01) 02515000 DS 0F 02516000 @AL00148 DC A(@CB00331) LIST WITH 2 ARGUMENT(S) 02517000 DC A(@CF00046) 02518000 @AL00158 DC A(@CB00333) LIST WITH 2 ARGUMENT(S) 02519000 DC A(@CF00121) 02520000 @AL00168 DC A(@CB00335) LIST WITH 2 ARGUMENT(S) 02521000 DC A(@CF00046) 02522000 @AL00189 DC A(@CF00046) LIST WITH 5 ARGUMENT(S) 02523000 @AL00249 DC A(@CB00343) LIST WITH 1 ARGUMENT(S) 02524000 DC A(@CF00034) 02525000 DC A(@CC00682) 02526000 DC A(@CF00103) 02527000 @AL00214 DC A(@CF00046) LIST WITH 5 ARGUMENT(S) 02528000 @AL00254 DC A(@CB00345) LIST WITH 1 ARGUMENT(S) 02529000 DC A(@CF00325) 02530000 DC A(@CC00685) 02531000 DC A(@CF00081) 02532000 @AL00239 DC A(@CF00046) LIST WITH 5 ARGUMENT(S) 02533000 @AL00260 DC A(@CB00347) LIST WITH 1 ARGUMENT(S) 02534000 DC A(@CF00325) 02535000 DC A(@CC00688) 02536000 DC A(@CF00081) 02537000 @AL00267 DC A(@CB00349) LIST WITH 1 ARGUMENT(S) 02538000 @AL00274 DC A(@CB00351) LIST WITH 1 ARGUMENT(S) 02539000 @AL00279 DC A(@CB00355) LIST WITH 1 ARGUMENT(S) 02540000 @AL00289 DC A(@CB00359) LIST WITH 1 ARGUMENT(S) 02541000 @AL00294 DC A(@CB00361) LIST WITH 2 ARGUMENT(S) 02542000 DC A(@CF00057) 02543000 @AL00304 DC A(@CB00371) LIST WITH 2 ARGUMENT(S) 02544000 DC A(@CF00046) 02545000 @AL00314 DC A(@CB00377) LIST WITH 2 ARGUMENT(S) 02546000 DC A(@CF00048) 02547000 @AL00318 DC A(@CB00379) LIST WITH 2 ARGUMENT(S) 02548000 DC A(@CF00046) 02549000 @AL00322 DC A(@CB00381) LIST WITH 2 ARGUMENT(S) 02550000 DC A(@CF00039) 02551000 @AL00328 DC A(@CB00383) LIST WITH 1 ARGUMENT(S) 02552000 @AL00355 DC A(@CF00046) LIST WITH 5 ARGUMENT(S) 02553000 @AL00364 DC A(@CB00391) LIST WITH 1 ARGUMENT(S) 02554000 DC A(@CF00642) 02555000 DC A(@CC00691) 02556000 DC A(@CF00103) 02557000 @AL00386 DC A(@CF00046) LIST WITH 5 ARGUMENT(S) 02558000 @AL00395 DC A(@CB00399) LIST WITH 1 ARGUMENT(S) 02559000 DC A(@CF00694) 02560000 DC A(@CC00695) 02561000 DC A(@CF00046) 02562000 @AL00401 DC A(@CB00425) LIST WITH 1 ARGUMENT(S) 02563000 @AL00407 DC A(@CB00461) LIST WITH 1 ARGUMENT(S) 02564000 @AL00422 DC A(@CF00046) LIST WITH 5 ARGUMENT(S) 02565000 @AL00450 DC A(@CB00507) LIST WITH 1 ARGUMENT(S) 02566000 DC A(@CF00325) 02567000 DC A(@CC00698) 02568000 DC A(@CF00103) 02569000 @AL00440 DC A(@CB00489) LIST WITH 2 ARGUMENT(S) 02570000 DC A(@CF00046) 02571000 @AL00444 DC A(@CB00505) LIST WITH 2 ARGUMENT(S) 02572000 DC A(@CF00081) 02573000 @DATD DSECT 02574000 DS 0F 02575000 @SA00001 DS 18F 02576000 @SA00002 DS 12F 02577000 @SA00004 DS 12F 02578000 @SA00003 DS 13F 02579000 @SA00005 DS 12F 02580000 @PC00005 DS 2F 02581000 @PC00007 DS 2F 02582000 @PC00011 DS 4F 02583000 @SA00012 DS 15F 02584000 @PC00012 DS 6F 02585000 @PC00006 DS 1F 02586000 @PC00009 DS 1F 02587000 @PC00010 DS 2F 02588000 @PC00008 DS 1F 02589000 @AL00001 DS 6A 02590000 @AFTEMPS DS 5F 02591000 BLSCABLD CSECT 02592000 DS 0F 02593000 @CF00048 DC F'1' 02594000 @CH00048 EQU @CF00048+2 02595000 @CF00103 DC F'3' 02596000 @CH00103 EQU @CF00103+2 02597000 @CF00039 DC F'4' 02598000 @CF00057 DC F'6' 02599000 @CF00081 DC F'7' 02600000 @CF00046 DC F'8' 02601000 @CH00046 EQU @CF00046+2 02602000 @CF00325 DC F'9' 02603000 @CF00642 DC F'10' 02604000 @CF00034 DC F'11' 02605000 @CF00694 DC F'17' 02606000 @CF00184 DC F'20' 02607000 @CF00931 DC F'21' 02608000 @CF00930 DC F'22' 02609000 @CF00929 DC F'30' 02610000 @CF00086 DC F'32' 02611000 @CF00121 DC F'44' 02612000 @CF00646 DC F'3102' 02613000 @CF00648 DC F'3103' 02614000 @CF00650 DC F'3104' 02615000 @CF00652 DC F'3106' 02616000 @CF00654 DC F'3107' 02617000 @CF00950 DC F'-4' 02618000 @CF00664 DC XL4'FFFFFFFE' 02619000 @CF00517 DC XL4'005E' 02620000 @DATD DSECT 02621000 DS 0D 02622000 FTMP8 DS FL1 02623000 ORG FTMP8 02624000 BTMP8 DS BL1 02625000 ORG FTMP8+1 02626000 DS CL3 02627000 MODSTAT DS CL16 02628000 ORG MODSTAT 02629000 MODNAME DS CL8 02630000 RETCODE DS FL4 02631000 SUBCODE DS FL4 02632000 ORG MODSTAT+16 02633000 ALSW DS BL1 02634000 CTMP DS CL1 02635000 CTMPA DS CL1 02636000 CTMPB DS CL2 02637000 DS CL7 02638000 CHSTR8 DS CL8 02639000 ORG CHSTR8 02640000 @NM00005 DS CL3 02641000 CHSTR847 DS CL4 02642000 ORG CHSTR847 02643000 @NM00006 DS CL2 02644000 CHSTR867 DS CL2 02645000 ORG CHSTR8+8 02646000 CTEMP DS CL9 02647000 ORG CTEMP 02648000 @NM00007 DS CL5 02649000 CTEMP63 DS CL3 02650000 ORG CTEMP63 02651000 @NM00008 DS CL1 02652000 CTEMP72 DS CL2 02653000 ORG CTEMP+9 02654000 MATSW DS BL1 02655000 MATSK DS BL1 02656000 DS CL1 02657000 IOPTLIST DS 12A 02658000 BLSCABLD CSECT 02659000 DS 0F 02660000 @SIZDATD DC AL1(0) 02661000 DC AL3(@ENDDATD-@DATD) 02662000 DS 0D 02663000 @CC00695 DC C'LABEL PASSPR MODE' 02664000 @CC00682 DC C'DISP STATUS' 02665000 @CC00691 DC C'LABEL TYPE' 02666000 @CC00685 DC C'NORM DISP' 02667000 @CC00688 DC C'COND DISP' 02668000 @CC00698 DC C'DCB RECFM' 02669000 @CC00680 DC C'BLSCABLD' 02670000 @CC00674 DC C'CYL' 02671000 @CC00676 DC C'TRK' 02672000 @CC00678 DC C'YES' 02673000 @CB00331 DC X'0001' 02674000 @CB00333 DC X'0002' 02675000 @CB00335 DC X'0003' 02676000 @CB00337 DC X'0004' 02677000 @CB00339 DC X'0005' 02678000 @CB00341 DC X'0006' 02679000 @CB00343 DC X'0007' 02680000 @CB00345 DC X'0008' 02681000 @CB00347 DC X'0009' 02682000 @CB00349 DC X'000A' 02683000 @CB00351 DC X'000B' 02684000 @CB00355 DC X'000D' 02685000 @CB00357 DC X'000E' 02686000 @CB00359 DC X'000F' 02687000 @CB00361 DC X'0010' 02688000 @CB00371 DC X'0015' 02689000 @CB00377 DC X'0018' 02690000 @CB00379 DC X'0019' 02691000 @CB00381 DC X'001A' 02692000 @CB00383 DC X'001B' 02693000 @CB00387 DC X'001D' 02694000 @CB00389 DC X'001E' 02695000 @CB00391 DC X'001F' 02696000 @CB00393 DC X'0020' 02697000 @CB00399 DC X'0023' 02698000 @CB00425 DC X'0030' 02699000 @CB00461 DC X'0042' 02700000 @CB00475 DC X'0049' 02701000 @CB00489 DC X'0050' 02702000 @CB00505 DC X'0058' 02703000 @CB00507 DC X'0059' 02704000 @CB00712 DC B'00000000' 02705000 STATSTR DS CL20 02706000 ORG STATSTR 02707000 @NM00009 DC CL4'OLD*' 02708000 @NM00010 DC X'01' 02709000 @NM00011 DC CL4'MOD*' 02710000 @NM00012 DC X'02' 02711000 @NM00013 DC CL4'NEW*' 02712000 @NM00014 DC X'04' 02713000 @NM00015 DC CL4'SHR*' 02714000 @NM00016 DC X'08' 02715000 ORG STATSTR+20 02716000 DISPSTR DS CL30 02717000 ORG DISPSTR 02718000 @NM00017 DC CL8'UNCATLG*' 02719000 @NM00018 DC X'01' 02720000 @NM00019 DC CL6'CATLG*' 02721000 @NM00020 DC X'02' 02722000 @NM00021 DC CL7'DELETE*' 02723000 @NM00022 DC X'04' 02724000 @NM00023 DC CL5'KEEP*' 02725000 @NM00024 DC X'08' 02726000 ORG DISPSTR+30 02727000 LTYPESTR DS CL22 02728000 ORG LTYPESTR 02729000 @NM00025 DC CL3'NL*' 02730000 @NM00026 DC X'01' 02731000 @NM00027 DC CL3'NL*' 02732000 @NM00028 DC X'01' 02733000 @NM00029 DC CL3'SL*' 02734000 @NM00030 DC X'02' 02735000 @NM00031 DC CL4'BLP*' 02736000 @NM00032 DC X'10' 02737000 @NM00033 DC CL4'LTM*' 02738000 @NM00034 DC X'21' 02739000 ORG LTYPESTR+22 02740000 LPSPRSTR DS CL20 02741000 ORG LPSPRSTR 02742000 @NM00035 DC CL9'PASSWORD*' 02743000 @NM00036 DC X'10' 02744000 @NM00037 DC CL9'NOPWREAD*' 02745000 @NM00038 DC X'30' 02746000 ORG LPSPRSTR+20 02747000 RECFMSTR DS CL21 02748000 ORG RECFMSTR 02749000 @NM00039 DC CL2'A*' 02750000 @NM00040 DC X'04' 02751000 @NM00041 DC CL2'B*' 02752000 @NM00042 DC X'10' 02753000 @NM00043 DC CL2'F*' 02754000 @NM00044 DC X'80' 02755000 @NM00045 DC CL2'M*' 02756000 @NM00046 DC X'02' 02757000 @NM00047 DC CL2'S*' 02758000 @NM00048 DC X'08' 02759000 @NM00049 DC CL2'U*' 02760000 @NM00050 DC X'C0' 02761000 @NM00051 DC CL2'V*' 02762000 @NM00052 DC X'40' 02763000 ORG RECFMSTR+21 02764000 DS CL6 02765000 DASPATCH DS CL256 02766000 ORG DASPATCH 02767000 DASPATA DC 64A(0) 02768000 ORG DASPATCH+256 02769000 CP0001@ DC AL4(DDNAMC) 02770000 DC AL4(DSNAMC) 02771000 DC AL4(MEMBRC) 02772000 DC AL4(STATSC) 02773000 DC AL4(NDISPC) 02774000 DC AL4(CDISPC) 02775000 DC AL4(TRKC) 02776000 DC AL4(CYLC) 02777000 DC AL4(BLKLNC) 02778000 DC AL4(PRIMEC) 02779000 DC AL4(SECNDC) 02780000 DC AL4(BAD) 02781000 DC AL4(RLSEC) 02782000 DC AL4(SPFRMC) 02783000 DC AL4(ROUNDC) 02784000 DC AL4(VLSERC) 02785000 DC AL4(BAD) 02786000 DC AL4(BAD) 02787000 DC AL4(BAD) 02788000 DC AL4(BAD) 02789000 DC AL4(UNITC) 02790000 DC AL4(BAD) 02791000 DC AL4(BAD) 02792000 DC AL4(SYSOUC) 02793000 DC AL4(SPGNMC) 02794000 DC AL4(SFMNOC) 02795000 DC AL4(OUTLMC) 02796000 DC AL4(BAD) 02797000 DC AL4(COPYSC) 02798000 DC AL4(LABELC) 02799000 DC AL4(DSSEQC) 02800000 DC AL4(PASPRC) 02801000 DC AL4(BAD) 02802000 DC AL4(BAD) 02803000 DC AL4(RETPDC) 02804000 DC AL4(BAD) 02805000 DC AL4(BAD) 02806000 DC AL4(BAD) 02807000 DC AL4(BAD) 02808000 DC AL4(BAD) 02809000 DC AL4(BAD) 02810000 DC AL4(BAD) 02811000 DC AL4(BAD) 02812000 DC AL4(BAD) 02813000 DC AL4(BAD) 02814000 DC AL4(BAD) 02815000 DC AL4(BAD) 02816000 DC AL4(BLKSZC) 02817000 DC AL4(BAD) 02818000 DC AL4(BAD) 02819000 DC AL4(BAD) 02820000 DC AL4(BAD) 02821000 DC AL4(BAD) 02822000 DC AL4(BAD) 02823000 DC AL4(BAD) 02824000 DC AL4(BAD) 02825000 DC AL4(BAD) 02826000 DC AL4(BAD) 02827000 DC AL4(BAD) 02828000 DC AL4(BAD) 02829000 DC AL4(BAD) 02830000 DC AL4(BAD) 02831000 DC AL4(BAD) 02832000 DC AL4(BAD) 02833000 DC AL4(BAD) 02834000 DC AL4(LRECLC) 02835000 DC AL4(BAD) 02836000 DC AL4(BAD) 02837000 DC AL4(BAD) 02838000 DC AL4(BAD) 02839000 DC AL4(BAD) 02840000 DC AL4(BAD) 02841000 DC AL4(RECFMC) 02842000 DC AL4(BAD) 02843000 DC AL4(BAD) 02844000 DC AL4(BAD) 02845000 DC AL4(BAD) 02846000 DC AL4(BAD) 02847000 DC AL4(BAD) 02848000 DC AL4(PASSWC) 02849000 DC AL4(BAD) 02850000 DC AL4(BAD) 02851000 DC AL4(BAD) 02852000 DC AL4(BAD) 02853000 DC AL4(BAD) 02854000 DC AL4(BAD) 02855000 DC AL4(BAD) 02856000 DC AL4(SUSERC) 02857000 DC AL4(SHOLDC) 02858000 DC AL4(BAD) 02859000 DC AL4(BAD) 02860000 DC AL4(BAD) 02861000 DC AL4(BAD) 02862000 DC AL4(BAD) 02863000 BLSCABLD CSECT 02864000 * /* 02865000 HEXTBL EQU *-240 02866000 DC CL16'0123456789ABCDEF' 02867000 @DATD DSECT 02868000 ORG *+1-(*-@DATD)/(*-@DATD) INSURE DSECT DATA 02869000 @ENDDATD EQU * 02870000 BLSCABLD CSECT 02871000 @00 EQU 00 EQUATES FOR REGISTERS 0-15 02872000 @01 EQU 01 02873000 @02 EQU 02 02874000 @03 EQU 03 02875000 @04 EQU 04 02876000 @05 EQU 05 02877000 @06 EQU 06 02878000 @07 EQU 07 02879000 @08 EQU 08 02880000 @09 EQU 09 02881000 @10 EQU 10 02882000 @11 EQU 11 02883000 @12 EQU 12 02884000 @13 EQU 13 02885000 @14 EQU 14 02886000 @15 EQU 15 02887000 MATJ EQU @03 02888000 MATI EQU @02 02889000 MATLEN EQU @04 02890000 II EQU @06 02891000 I EQU @06 02892000 S99TUPLM EQU @06 02893000 S99TUBAS EQU @02 02894000 S99TUPLX EQU @07 02895000 ALOPT EQU @06 02896000 TLEN EQU @08 02897000 MLEN EQU @05 02898000 ALBAS EQU @03 02899000 S99TUFP EQU @03 02900000 DMCBPTR EQU @04 02901000 GPR01P EQU @01 02902000 DMCB EQU 0 02903000 DMCBTVP EQU DMCB+8 02904000 DMCBFTY EQU DMCB+20 02905000 DMCBVSF EQU DMCBFTY 02906000 DMCBOPN EQU DMCB+21 02907000 DMCBRMOD EQU DMCB+23 02908000 DMCBOUT EQU DMCBRMOD 02909000 DMCBOPTS EQU DMCB+24 02910000 DMCBGKY EQU DMCBOPTS 02911000 DMCBMFLG EQU DMCB+28 02912000 DMCBBUFP EQU DMCB+32 02913000 DMCBKEYP EQU DMCB+44 02914000 DMCBMSG EQU DMCB+52 02915000 DMCBRI EQU DMCB+64 02916000 DMCBMSG0 EQU DMCB+68 02917000 DMCBMSGS EQU DMCB+72 02918000 DMCBFRE EQU DMCB+88 02919000 DMCBEOB EQU DMCB+92 02920000 DMCBACBE EQU DMCB+124 02921000 DMCBDDNM EQU DMCB+260 02922000 DMCBVOL EQU DMCB+268 02923000 DMCBUNIT EQU DMCB+276 02924000 DMCBDSN EQU DMCB+284 02925000 DMCBMODL EQU DMCB+348 02926000 DMCBMEMB EQU DMCB+356 02927000 DMCBSTAT EQU DMCB+366 02928000 DMCBDISP EQU DMCB+367 02929000 DMCBSPTY EQU DMCB+369 02930000 DMCBSPPR EQU DMCB+372 02931000 DMCBSPSE EQU DMCB+376 02932000 DMCBSPEC EQU DMCB+380 02933000 DMCBSPRL EQU DMCBSPEC 02934000 DMCBSPCT EQU DMCBSPEC 02935000 DMCBSPRN EQU DMCBSPEC 02936000 DMCBLBTY EQU DMCB+382 02937000 DMCBLBPS EQU DMCB+383 02938000 DMCBLBSQ EQU DMCB+384 02939000 DMCBLBRT EQU DMCB+386 02940000 DMCBDCFM EQU DMCB+389 02941000 DMCBDCLR EQU DMCB+390 02942000 DMCBDCBL EQU DMCB+392 02943000 DMCBDRBP EQU DMCB+400 02944000 DMCBAMS EQU DMCB+416 02945000 DMCBAUDT EQU DMCB+568 02946000 DMCBLSCP EQU DMCBAUDT+16 02947000 DMCBWRK EQU DMCB+648 02948000 S99TUPL EQU 0 02949000 S99TUPTR EQU S99TUPL 02950000 S99TUP EQU 0 02951000 S99TUNIT EQU 0 02952000 S99TUKEY EQU S99TUNIT 02953000 S99TUNUM EQU S99TUNIT+2 02954000 S99TUENT EQU S99TUNIT+4 02955000 S99TULNG EQU S99TUENT 02956000 S99TUPAR EQU S99TUENT+2 02957000 S99TUFLD EQU 0 02958000 BLSDMSGS EQU 0 02959000 BLSDMSG0 EQU 0 02960000 ZZ2 EQU 0 02961000 ALPTR EQU 0 02962000 ALOP EQU ALPTR 02963000 ALVL EQU ALOP 02964000 ALPRB4C1 EQU ALPTR+3 02965000 ALPRB4F1 EQU ALPRB4C1 02966000 ALPTF31 EQU 0 02967000 ALPTB2C3 EQU ALPTF31+1 02968000 ALPTB3C2 EQU ALPTB2C3+1 02969000 ALPTB4C1 EQU ALPTB3C2+1 02970000 ALPTC1 EQU 0 02971000 ALPTCVL EQU 0 02972000 STATSP EQU 0 02973000 NDISPP EQU 0 02974000 CDISPP EQU 0 02975000 LTYPEP EQU 0 02976000 LPASPRP EQU 0 02977000 RECFMP EQU 0 02978000 SHOLDP EQU 0 02979000 I015F EQU 0 02980000 CL0001@ EQU 0 02981000 DMCBDMGR EQU 0 02982000 DMCBRQC EQU 0 02983000 I001C EQU 0 02984000 I008P EQU 0 02985000 I015P EQU 0 02986000 I031F EQU 0 02987000 I031P EQU 0 02988000 I256C EQU 0 02989000 MODELNAM EQU 0 02990000 SFMNOP EQU 0 02991000 SPGNMP EQU 0 02992000 SUSERP EQU 0 02993000 SYSOUP EQU 0 02994000 OP EQU 0 02995000 LIM EQU 0 02996000 OPA EQU 0 02997000 OPB EQU 0 02998000 VALC1 EQU 0 02999000 OPC EQU 0 03000000 OPD EQU 0 03001000 OPE EQU 0 03002000 MAXL EQU 0 03003000 MATFLD EQU 0 03004000 MATSTRL EQU 0 03005000 MATSTR EQU 0 03006000 MATVAL EQU 0 03007000 PARMODLL EQU 0 03008000 PARMODL EQU 0 03009000 PARKEYL EQU 0 03010000 PARKEY EQU 0 03011000 PARPARML EQU 0 03012000 PARPARM EQU 0 03013000 DMCBVSM EQU DMCBAMS 03014000 DMCBQSM EQU DMCBAMS 03015000 DMAL EQU DMCBWRK 03016000 DMALMODA EQU DMAL+4 03017000 DMALPRMP EQU DMAL+8 03018000 DMALDYRB EQU DMAL+16 03019000 DMALTUPM EQU DMAL+36 03020000 DMALTUBS EQU DMAL+40 03021000 DMALTUPL EQU DMAL+44 03022000 DMALTUS EQU DMAL+172 03023000 DMALEND EQU DMAL+1196 03024000 S99RBPTR EQU DMCBDRBP 03025000 S99RB EQU DMALDYRB 03026000 S99FLAG1 EQU S99RB+2 03027000 S99FLG11 EQU S99FLAG1 03028000 S99RSC EQU S99RB+4 03029000 S99TXTPP EQU S99RB+8 03030000 S99FLAG2 EQU S99RB+16 03031000 S99FLG21 EQU S99FLAG2 03032000 S99FLG22 EQU S99FLAG2+1 03033000 S99TUPR1 EQU S99TUPAR 03034000 S99TUPR2 EQU S99TUPAR 03035000 S99TUPR3 EQU S99TUPAR 03036000 CHSTR88 EQU CHSTR8+7 03037000 AGO .@UNREFD START UNREFERENCED COMPONENTS 03038000 S99FLG24 EQU S99FLAG2+3 03039000 S99FLG23 EQU S99FLAG2+2 03040000 S99PCINT EQU S99FLG22 03041000 S99UDEVT EQU S99FLG22 03042000 S99MOUNT EQU S99FLG21 03043000 S99CATLG EQU S99FLG21 03044000 S99TIONQ EQU S99FLG21 03045000 S99OFFLN EQU S99FLG21 03046000 S99WTUNT EQU S99FLG21 03047000 S99NORES EQU S99FLG21 03048000 S99WTDSN EQU S99FLG21 03049000 S99WTVOL EQU S99FLG21 03050000 S99RSV01 EQU S99RB+12 03051000 S99INFO EQU S99RSC+2 03052000 S99ERROR EQU S99RSC 03053000 S99FLG12 EQU S99FLAG1+1 03054000 S99JBSYS EQU S99FLG11 03055000 S99NOMNT EQU S99FLG11 03056000 S99NOCNV EQU S99FLG11 03057000 S99ONCNV EQU S99FLG11 03058000 S99VERB EQU S99RB+1 03059000 S99RBLN EQU S99RB 03060000 S99RBPND EQU S99RBPTR 03061000 DMALMODP EQU DMAL+12 03062000 DMALID EQU DMAL 03063000 DMCBRES7 EQU DMCBQSM+96 03064000 DMCBDCB EQU DMCBQSM 03065000 DMCBACB EQU DMCBVSM+76 03066000 DMCBRPL EQU DMCBVSM 03067000 @NM00004 EQU ALPTB3C2 03068000 @NM00003 EQU ALPTB2C3 03069000 @NM00002 EQU ALPTF31 03070000 @NM00001 EQU ALPTR+1 03071000 S99TUPRM EQU S99TUFLD+2 03072000 S99TULEN EQU S99TUFLD 03073000 S99TUPND EQU S99TUP 03074000 S99TUPLN EQU S99TUPTR 03075000 DMCBRES8 EQU DMCB+640 03076000 DMCBMODN EQU DMCB+632 03077000 DMCBCARY EQU DMCBAUDT+20 03078000 DMCBCLC EQU DMCBAUDT+12 03079000 DMCBOPC EQU DMCBAUDT+8 03080000 DMCBFRC EQU DMCBAUDT+4 03081000 DMCBALC EQU DMCBAUDT 03082000 DMCBFR EQU DMCB+412 03083000 DMCBRES6 EQU DMCB+410 03084000 DMCBIRSC EQU DMCB+408 03085000 DMCBSUBC EQU DMCB+404 03086000 DMCBRSZM EQU DMCB+398 03087000 DMCBRSZA EQU DMCB+396 03088000 DMCBCISZ EQU DMCB+394 03089000 DMCBRES5 EQU DMCB+388 03090000 DMCBRES4 EQU DMCB+381 03091000 DMCBSPRS EQU DMCBSPEC 03092000 DMCBODIS EQU DMCB+368 03093000 DMCBRES3 EQU DMCB+364 03094000 DMCBRES9 EQU DMCB+340 03095000 DMCBPID EQU DMCB+332 03096000 DMCBTYPE EQU DMCB+328 03097000 DMCBDSOR EQU DMCB+274 03098000 DMCBSYNM EQU DMCB+132 03099000 DMCBRPLF EQU DMCB+128 03100000 DMCBDCBE EQU DMCBACBE 03101000 DMCBARC EQU DMCB+120 03102000 DMCBCPC EQU DMCB+116 03103000 DMCBRET EQU DMCB+112 03104000 DMCBSTL EQU DMCB+96 03105000 DMCBRES2 EQU DMCB+85 03106000 DMCBSPID EQU DMCB+84 03107000 DMCBRESC EQU DMCB+80 03108000 DMCBZZ1P EQU DMCB+76 03109000 DMCBRRL EQU DMCB+60 03110000 DMCBRBA EQU DMCB+56 03111000 DMCBKEYL EQU DMCB+48 03112000 DMCBKPC EQU DMCBKEYP 03113000 DMCBORL EQU DMCB+40 03114000 DMCBBLEN EQU DMCB+36 03115000 DMCBBFPC EQU DMCBBUFP 03116000 DMCBRES1 EQU DMCB+31 03117000 DMCBACCM EQU DMCB+30 03118000 DMCBREJ EQU DMCB+29 03119000 DMCBRESB EQU DMCBMFLG 03120000 DMCBFMOD EQU DMCBMFLG 03121000 DMCBLOPT EQU DMCB+27 03122000 DMCBLRM EQU DMCB+26 03123000 DMCBLRQ EQU DMCB+25 03124000 DMCBOPRS EQU DMCBOPTS 03125000 DMCBLRD EQU DMCBOPTS 03126000 DMCBBWD EQU DMCBOPTS 03127000 DMCBUPD EQU DMCBOPTS 03128000 DMCBAPX EQU DMCBOPTS 03129000 DMCBRNO EQU DMCBGKY 03130000 DMCBKYD EQU DMCBOPTS 03131000 DMCBRMRS EQU DMCBRMOD 03132000 DMCBRM5 EQU DMCBRMOD 03133000 DMCBRM6 EQU DMCBRMOD 03134000 DMCBTMP EQU DMCBOUT 03135000 DMCBRQST EQU DMCB+22 03136000 DMCBRESA EQU DMCBOPN 03137000 DMCBSOUT EQU DMCBOPN 03138000 DMCBSIN EQU DMCBOPN 03139000 DMCBKSF EQU DMCBFTY 03140000 DMCBFTRS EQU DMCBFTY 03141000 DMCBSHF EQU DMCBFTY 03142000 DMCBIRL EQU DMCB+16 03143000 DMCBRTC EQU DMCB+12 03144000 DMCBNEXT EQU DMCB+4 03145000 DMCBID EQU DMCB 03146000 .@UNREFD ANOP END UNREFERENCED COMPONENTS 03147000 @RF00089 EQU @EL00002 03148000 @RC00093 EQU @EL00002 03149000 @RF00123 EQU @EL00003 03150000 CE0001@ EQU @EL00004 03151000 @RF00483 EQU @EL00005 03152000 @RC00485 EQU @EL00005 03153000 @RF00580 EQU @EL00010 03154000 @RF00149 EQU CE0001@ 03155000 @RF00159 EQU CE0001@ 03156000 @RF00169 EQU CE0001@ 03157000 @RF00193 EQU CE0001@ 03158000 @RF00197 EQU CE0001@ 03159000 @RF00218 EQU CE0001@ 03160000 @RF00222 EQU CE0001@ 03161000 @RF00244 EQU CE0001@ 03162000 @RF00295 EQU CE0001@ 03163000 @RF00305 EQU CE0001@ 03164000 @RF00327 EQU CE0001@ 03165000 @RF00333 EQU CE0001@ 03166000 @RC00338 EQU CE0001@ 03167000 @RC00345 EQU CE0001@ 03168000 @RC00369 EQU CE0001@ 03169000 @RC00376 EQU CE0001@ 03170000 @RC00413 EQU CE0001@ 03171000 @RF00449 EQU CE0001@ 03172000 @RC00348 EQU @RC00345 03173000 @RC00379 EQU @RC00376 03174000 @RF00428 EQU @RC00413 03175000 @ENDDATA EQU * 03176000 END BLSCABLD,(C'PLS1948',0701,78062) 03177000