TITLE 'EP=BLSCFAMS -- IPCS DAS ACCESS METHOD SERVICES INTERFAC*00001000 CE ' 00002000 * /* CHANGE ACTIVITY 00003000 * THIS MODULE IS WRITTEN FOR @G57LPSR 00004000 BLSCFAMS CSECT , 0002 00005000 @MAINENT DS 0H 0002 00006000 USING *,@15 0002 00007000 B @PROLOG 0002 00008000 DC AL1(16) 0002 00009000 DC C'BLSCFAMS 78.135' 0002 00010000 DROP @15 00011000 @PROLOG STM @14,@12,12(@13) 0002 00012000 BALR @12,0 0002 00013000 @PSTART DS 0H 0002 00014000 USING @PSTART,@12 0002 00015000 L @00,@SIZDATD 0002 00016000 BLSCGETF R,LV=(0) 00017000 LR @11,@01 0002 00018000 USING @DATD,@11 0002 00019000 ST @13,@SA00001+4 0002 00020000 LM @00,@01,20(@13) 0002 00021000 ST @11,8(,@13) 0002 00022000 LR @13,@11 0002 00023000 MVC @PC00001(8),0(@01) 0002 00024000 * 0023 00025000 * /*****************************************************************/ 00026000 * /* */ 00027000 * /* INITIALIZE MODULE STATUS */ 00028000 * /* */ 00029000 * /*****************************************************************/ 00030000 * 0023 00031000 * DMCBPTR=ADDR(DMCBPARM); /* BASE THE DMCB */ 00032000 L DMCBPTR,@PC00001 0023 00033000 * MODNAME=LMODNMC; /* INIT THE MODULE NAME */ 00034000 MVC MODNAME(8),@CC00369 0024 00035000 * RETCODE=F0C; /* INIT THE MODULE RETURN CODE */ 00036000 SLR @10,@10 0025 00037000 ST @10,RETCODE 0025 00038000 * SUBCODE=F0C; /* INIT THE SUBROUTINE RETURN 0026 00039000 * CODE */ 00040000 * 0026 00041000 ST @10,SUBCODE 0026 00042000 * /*****************************************************************/ 00043000 * /* */ 00044000 * /* INITIALIZE IDCAMS PARAMETER LIST ELEMENTS */ 00045000 * /* */ 00046000 * /*****************************************************************/ 00047000 * 0027 00048000 * OPTLLEN=F0C; /* NULL IDCAMS OPTION LIST */ 00049000 STH @10,OPTLLEN 0027 00050000 * DNAMLLEN=F0C; /* NULL IDCAMS DNAME LIST */ 00051000 STH @10,DNAMLLEN 0028 00052000 * PNLLEN=F0C; /* NULL IDCAMS PAGE NUMBER LIST */ 00053000 STH @10,PNLLEN 0029 00054000 * IOLNUM=F2C; /* SYSIN AND SYSPRINT ARE TO BE 00055000 * MANAGED */ 00056000 MVC IOLNUM(4),@CF00076 0030 00057000 * IOLINDDP=ADDR(INDD); /* ADDRESS OF SYSIN DDNAME ENTRY */ 00058000 LA @04,@CC00323 0031 00059000 ST @04,IOLINDDP 0031 00060000 * IOLMINP=ADDR(BLSCAMIN); /* SYSIN IN-CORE GET ROUTINE */ 00061000 L @04,@CV00239 0032 00062000 ST @04,IOLMINP 0032 00063000 * IOLINCBP=ADDR(INCB); /* ADDR OF BLSCAMIN CONTROL BLOCK*/ 00064000 LA @04,INCB 0033 00065000 ST @04,IOLINCBP 0033 00066000 * IOLOUDDP=ADDR(OUDD); /* ADDR OF SYSPRINT DDNAME ENTRY */ 00067000 LA @04,@CC00326 0034 00068000 ST @04,IOLOUDDP 0034 00069000 * IOLMPRP=ADDR(BLSCAMPR); /* SYSPRINT IN-CORE PUT ROUTINE */ 00070000 L @04,@CV00240 0035 00071000 ST @04,IOLMPRP 0035 00072000 * IOLOUCBP=ADDR(OUCB); /* ADDR OF BLSCAMPR CONTROL BLOCK*/ 00073000 LA @04,OUCB 0036 00074000 ST @04,IOLOUCBP 0036 00075000 * OUHEAD=F0C; /* SYSPRINT CONTROL BLOCK */ 00076000 ST @10,OUHEAD 0037 00077000 * OUCUR=F0C; 0038 00078000 ST @10,OUCUR 0038 00079000 * OUTAIL=F0C; 0039 00080000 ST @10,OUTAIL 0039 00081000 * INHEAD=F0C; /* SYSIN CONTROL BLOCK */ 00082000 ST @10,INHEAD 0040 00083000 * INCUR=F0C; 0041 00084000 ST @10,INCUR 0041 00085000 * INTAIL=F0C; 0042 00086000 * 0042 00087000 ST @10,INTAIL 0042 00088000 * /*****************************************************************/ 00089000 * /* */ 00090000 * /* PREPARE IDCAMS SYSIN TEXT STREAM FOR FREE REQUEST */ 00091000 * /* */ 00092000 * /*****************************************************************/ 00093000 * 0043 00094000 * CALL BLDSTR(ADDR(BLSCFMSM),PLIST);/* BUILD IDCAMS SYSIN STREAM 0043 00095000 * FROM FREE(DELETE) MODEL */ 00096000 * 0043 00097000 L @10,@CV00243 0043 00098000 ST @10,@AFTEMPS+12 0043 00099000 LA @10,@AFTEMPS+12 0043 00100000 ST @10,@AL00001 0043 00101000 L @10,@PC00001+4 0043 00102000 ST @10,@AL00001+4 0043 00103000 LA @01,@AL00001 0043 00104000 BAL @14,BLDSTR 0043 00105000 * /*****************************************************************/ 00106000 * /* */ 00107000 * /* INVOKE ACCESS METHOD SERVICES TO FREE SPACE FOR DATA SET */ 00108000 * /* */ 00109000 * /*****************************************************************/ 00110000 * 0044 00111000 * IF RETCODE=F0C THEN /* TEST THAT ALL IS WELL */ 00112000 L @10,RETCODE 0044 00113000 LTR @10,@10 0044 00114000 BNZ @RF00044 0044 00115000 * DO; /* OK TO INVOKE IDCAMS */ 00116000 * CALL INVAMS; /* INVOKE IDCAMS TO GET SPACE FOR 00117000 * VSAM DATA SET */ 00118000 BAL @14,INVAMS 0046 00119000 * END; /* OK TO INVOKE IDCAMS */ 00120000 * 0047 00121000 * /*****************************************************************/ 00122000 * /* */ 00123000 * /* IDCAMS FREE DATA SET COMPLETE, RETURN TO CALLER */ 00124000 * /* */ 00125000 * /*****************************************************************/ 00126000 * 0048 00127000 * RETURN CODE(RETCODE); 0048 00128000 @RF00044 L @10,RETCODE 0048 00129000 L @13,4(,@13) 0048 00130000 L @00,@SIZDATD 0048 00131000 LR @01,@11 0048 00132000 BLSCFREF R,LV=(0),A=(1) 00133000 LR @15,@10 0048 00134000 L @14,12(,@13) 0048 00135000 LM @00,@12,20(@13) 0048 00136000 BR @14 0048 00137000 EJECT 00138000 * 0049 00139000 * /*****************************************************************/ 00140000 * /* */ 00141000 * /* PROCEDURE TO INVOKE IDCAMS TO FREE SPACE FOR VSAM DATA SET */ 00142000 * /* */ 00143000 * /*****************************************************************/ 00144000 * 0049 00145000 *INVAMS: 0049 00146000 * PROCEDURE; /* INVOKE IDCAMS TO FREE SPACE 0049 00147000 * FOR VSAM DATA SET */ 00148000 INVAMS STM @14,@12,@SA00002 0049 00149000 * GEN FLOWS(LINKERR); 0050 00150000 * /* TELL COMPILER ABOUT 00151000 * ERRET(LINKERR) IN LINK MACRO 00152000 * DO; /* LINK EP(LINKNAME) PARAM(AMSOPT 00153000 * L,AMSDNAML,AMSPNL,AMSIOL) VL 00154000 * ERRET(LINKERR) */ 00155000 * I00601='00'X; /* EP/DE FLAG */ 00156000 MVI I00601,X'00' 0052 00157000 * I00602=ADDR(LINKNAME); /* ADDR OF EP/DE */ 00158000 LA @10,@CC00367 0053 00159000 STCM @10,7,I00602 0053 00160000 * I00604=0; /* DCB PTR */ 00161000 SLR @10,@10 0054 00162000 STCM @10,7,I00604 0054 00163000 * I00603='80'X; /* ERRET FLAG */ 00164000 MVI I00603,X'80' 0055 00165000 * I00605=ADDR(LINKERR); /* ERRET PTR */ 00166000 LA @10,LINKERR 0056 00167000 ST @10,I00605 0056 00168000 * IOPTLIST(1)=ADDR(AMSOPTL); /* ADDR OF PROB PROG PARM */ 00169000 LA @10,AMSOPTL 0057 00170000 ST @10,IOPTLIST 0057 00171000 * IOPTLIST(2)=ADDR(AMSDNAML); /* ADDR OF PROB PROG PARM */ 00172000 LA @10,AMSDNAML 0058 00173000 ST @10,IOPTLIST+4 0058 00174000 * IOPTLIST(3)=ADDR(AMSPNL); /* ADDR OF PROB PROG PARM */ 00175000 LA @10,AMSPNL 0059 00176000 ST @10,IOPTLIST+8 0059 00177000 * IOPTLIST(4)=ADDR(AMSIOL); /* ADDR OF PROB PROG PARM */ 00178000 LA @10,AMSIOL 0060 00179000 ST @10,IOPTLIST+12 0060 00180000 * IOPTLIST(4)=IOPTLIST(4)|'80000000'X;/* SET VL BIT */ 00181000 O @10,@CF00386 0061 00182000 ST @10,IOPTLIST+12 0061 00183000 * RESPECIFY 0062 00184000 * (GPR01P) RESTRICTED; 0062 00185000 * GPR01P=ADDR(IOPTLIST); /* ADDR OF OPTLIST */ 00186000 LA GPR01P,IOPTLIST 0063 00187000 * RESPECIFY 0064 00188000 * (GPR15P) RESTRICTED; 0064 00189000 * GPR15P=ADDR(I006); /* ADDR OF LINK LIST */ 00190000 LA GPR15P,I006 0065 00191000 * SVC(6); /* ISSUE LINK SVC */ 00192000 SVC 6 0066 00193000 * RESPECIFY 0067 00194000 * (GPR01P) UNRESTRICTED; 0067 00195000 * RESPECIFY 0068 00196000 * (GPR15P) UNRESTRICTED; 0068 00197000 * END; /* LINK EP(LINKNAME) PARAM(AMSOPT 00198000 * L,AMSDNAML,AMSPNL,AMSIOL) VL 00199000 * ERRET(LINKERR) FREE SPACE FOR 00200000 * VSAM DATA SET */ 00201000 * RFY 0070 00202000 * GPR15F RSTD; 0070 00203000 * SUBCODE=GPR15F; /* SAVE THE RETURN CODE */ 00204000 ST GPR15F,SUBCODE 0071 00205000 * RFY 0072 00206000 * GPR15F UNRSTD; 0072 00207000 * IF SUBCODE^=F0C THEN /* TEST FOR IDCAMS ERROR */ 00208000 L @10,SUBCODE 0073 00209000 LTR @10,@10 0073 00210000 BZ @RF00073 0073 00211000 * DO; /* IDCAMS ERROR */ 00212000 * STATCODE=F3C; /* IDCAMS ERROR */ 00213000 MVC STATCODE(4),@CF00105 0075 00214000 * IF SUBCODEF0C&RETCODE=F0C;/* LOOP THRU IDCAMS TEXT 0162 00636000 * RECORDS */ 00637000 B @DE00162 0162 00638000 @DL00162 DS 0H 0163 00639000 * RECLEN=MAX(LENGTH(INRECF),MVLEN);/* LENGTH OF INREC */ 00640000 LA RECLEN,68 0163 00641000 CR RECLEN,MVLEN 0163 00642000 BNL *+6 00643000 LR RECLEN,MVLEN 0163 00644000 * DO; /* GETMAIN (RC) LV(RECLEN+F4C) 0164 00645000 * SP(DMCBSPID) RTCD(SUBCODE) */ 00646000 * RESPECIFY 0165 00647000 * (GPR01F, 0165 00648000 * GPR15F, 0165 00649000 * GPR00F) RESTRICTED; 0165 00650000 * GPR01F=0; /* REG 1 MUST BE ZERO */ 00651000 SLR GPR01F,GPR01F 0166 00652000 * GPR15F=0; /* RC-TYPE GETMAIN */ 00653000 SLR GPR15F,GPR15F 0167 00654000 * GPR00F=RECLEN+F4C; /* LENGTH REQUESTED */ 00655000 LA GPR00F,4 0168 00656000 ALR GPR00F,RECLEN 0168 00657000 * GPR15F=GPR15F|((DMCBSPID)*256);/* SP IN BYTE 2 */ 00658000 SLR @14,@14 0169 00659000 IC @14,DMCBSPID(,DMCBPTR) 0169 00660000 SLA @14,8 0169 00661000 OR GPR15F,@14 0169 00662000 * SVC(120); /* RC/RU-FORM OF GETMAIN */ 00663000 SVC 120 0170 00664000 * SUBCODE=GPR15F; /* SET RETURN CODE */ 00665000 ST GPR15F,SUBCODE 0171 00666000 * RESPECIFY 0172 00667000 * (GPR01F, 0172 00668000 * GPR15F, 0172 00669000 * GPR00F) UNRESTRICTED; 0172 00670000 * END; /* GETMAIN (RC) LV(RECLEN+F4C) 0173 00671000 * SP(DMCBSPID) RTCD(SUBCODE) 0173 00672000 * SPACE FOR TEXT LINE */ 00673000 * RFY 0174 00674000 * GPR01P RSTD; 0174 00675000 * INPTR=GPR01P; /* ADDRESS OF TEXT LINE */ 00676000 ST GPR01P,INPTR 0175 00677000 * RFY 0176 00678000 * GPR01P UNRSTD; 0176 00679000 * IF SUBCODE^=F0C THEN /* TEST FOR GETMAIN ERROR */ 00680000 L @10,SUBCODE 0177 00681000 LTR @10,@10 0177 00682000 BZ @RF00177 0177 00683000 * DO; /* GETMAIN FAILED */ 00684000 * RETCODE=ERROR; /* NOTIFY CALLER */ 00685000 MVC RETCODE(4),@CF00048 0179 00686000 * CALL BLSCGMF(DMCB,DMCBMSG,MODNAME);/* BUILD GETMAIN 0180 00687000 * FAILURE MESSAGE */ 00688000 ST DMCBPTR,@AL00001 0180 00689000 LA @10,DMCBMSG(,DMCBPTR) 0180 00690000 ST @10,@AL00001+4 0180 00691000 LA @10,MODNAME 0180 00692000 ST @10,@AL00001+8 0180 00693000 L @15,@CV00241 0180 00694000 LA @01,@AL00001 0180 00695000 BALR @14,@15 0180 00696000 * END; /* GETMAIN FAILED */ 00697000 * ELSE 0182 00698000 * DO; /* GETMAIN OK */ 00699000 B @RC00177 0182 00700000 @RF00177 DS 0H 0183 00701000 * IF INHEAD=F0C THEN /* TEST FOR FIRST ENTRY */ 00702000 L @10,INHEAD 0183 00703000 LTR @10,@10 0183 00704000 BNZ @RF00183 0183 00705000 * INHEAD=INPTR; /* INIT TEXT LIST HEADER */ 00706000 L @10,INPTR 0184 00707000 ST @10,INHEAD 0184 00708000 * ELSE 0185 00709000 * DO; /* NOT FIRST SYSIN TEXT LINE */ 00710000 B @RC00183 0185 00711000 @RF00183 DS 0H 0186 00712000 * INTAIL->INNEXT=INPTR;/* HOOK THIS LINE TO LIST */ 00713000 L @10,INPTR 0186 00714000 L @09,INTAIL 0186 00715000 ST @10,INNEXT(,@09) 0186 00716000 * END; /* NOT FIRST SYSIN TEXT LINE */ 00717000 * INTAIL=INPTR; /* END OF LIST */ 00718000 @RC00183 L @10,INPTR 0188 00719000 ST @10,INTAIL 0188 00720000 * INNEXT=F0C; /* MARK END OF LIST */ 00721000 SLR @09,@09 0189 00722000 ST @09,INNEXT(,@10) 0189 00723000 * INRECF=LBLNKC; /* BLANK THE SYSIN TEXT RECORD 0190 00724000 * AREA */ 00725000 MVI INRECF+1(@10),C' ' 0190 00726000 MVC INRECF+2(66,@10),INRECF+1(@10) 0190 00727000 MVI INRECF(@10),C' ' 0190 00728000 * INREC(F1C:MVLEN)=MMAMSREC(F1C:MVLEN);/* MOVE RECORD TO 00729000 * SYSIN LIST */ 00730000 LR @09,MVLEN 0191 00731000 BCTR @09,0 0191 00732000 EX @09,@SM00506 0191 00733000 * INLEN=RECLEN; /* FORCE CORRECT LENGTH FOR 0192 00734000 * FREEMAIN */ 00735000 STH RECLEN,INLEN(,@10) 0192 00736000 * CALL SCANRP(PLEN,PPTR,DSWITCH);/* SEARCH FOR IDCAMS 0193 00737000 * MODEL PARAMETERS TO BE 0193 00738000 * OVERRIDDEN @ZA32131*/ 00739000 LA @10,PLEN 0193 00740000 ST @10,@AL00001 0193 00741000 LA @10,PPTR 0193 00742000 ST @10,@AL00001+4 0193 00743000 LA @10,DSWITCH 0193 00744000 ST @10,@AL00001+8 0193 00745000 LA @01,@AL00001 0193 00746000 BAL @14,SCANRP 0193 00747000 * MAMSLP=MAMSLP+MVLEN; /* BUMP MODEL RECORD BASE */ 00748000 ALR MAMSLP,MVLEN 0194 00749000 * MVLEN=MMAMSLEN; /* NEW RECORD LENGTH */ 00750000 SLR MVLEN,MVLEN 0195 00751000 ICM MVLEN,3,MMAMSLEN(MAMSLP) 0195 00752000 * END; /* GETMAIN OK */ 00753000 * END; /* LOOP THRU IDCAMS TEXT RECORDS */ 00754000 @RC00177 DS 0H 0197 00755000 @DE00162 SLR @10,@10 0197 00756000 CR MVLEN,@10 0197 00757000 BNH @DC00162 0197 00758000 C @10,RETCODE 0197 00759000 BE @DL00162 0197 00760000 @DC00162 DS 0H 0198 00761000 * IF DSWITCH=OFF THEN /* TEST DATA SET MODEL PARM NOT 00762000 * FOUND */ 00763000 TM DSWITCH,B'10000000' 0198 00764000 BNZ @RF00198 0198 00765000 * DO; /* ABEND(F130C) DUMP USER */ 00766000 * RESPECIFY 0200 00767000 * (GPR01F) RESTRICTED; 0200 00768000 * GPR01F=(F130C)&'00000FFF'X;/* COMP CODE IN BITS 20-31 */ 00769000 LA GPR01F,130 0201 00770000 * GPR01F=GPR01F|'80000000'X;/* DUMP/STEP/DUMPOPTS FLAG */ 00771000 O GPR01F,@CF00386 0202 00772000 * SVC(13); /* ISSUE ABEND SVC */ 00773000 SVC 13 0203 00774000 * RESPECIFY 0204 00775000 * (GPR01F) UNRESTRICTED; 0204 00776000 * END; /* ABEND(F130C) DUMP USER DATA 0205 00777000 * SET MODEL PARM NOT FOUND */ 00778000 * END; /* PARMLIST OK */ 00779000 * END BLDSTR; /* BUILD IDCAMS SYSIN STREAM */ 00780000 @EL00003 DS 0H 0207 00781000 @EF00003 DS 0H 0207 00782000 @ER00003 LM @14,@12,@SA00003 0207 00783000 BR @14 0207 00784000 EJECT 00785000 * 0208 00786000 * /*****************************************************************/ 00787000 * /* */ 00788000 * /* OBTAIN PASSWORD PARAMETER FROM LIST */ 00789000 * /* */ 00790000 * /*****************************************************************/ 00791000 * 0208 00792000 *PASSPARM: 0208 00793000 * PROCEDURE(PLISTB,PLENA,PPTRA); 0208 00794000 PASSPARM STM @14,@12,@SA00004 0208 00795000 MVC @PC00004(12),0(@01) 0208 00796000 * DCL 0209 00797000 * PLISTB CHAR(*), /* PASSED FREE KEYWORD PARM LIST */ 00798000 * PLENA BIN(31), /* PASSWORD LENGTH */ 00799000 * PPTRA PTR(31); /* PASSWORD BASE TEMP */ 00800000 SPACE 2 00801000 * ALBAS=ADDR(PLISTB); /* BASE THE PARM LIST */ 00802000 L ALBAS,@PC00004 0210 00803000 * IF ALPTR^=F0C THEN /* TEST FOR OVERRIDE PARM LIST 0211 00804000 * EXISTENCE */ 00805000 L @10,ALPTR(,ALBAS) 0211 00806000 LTR @10,@10 0211 00807000 BZ @RF00211 0211 00808000 * DO; /* PARM LIST EXISTS */ 00809000 * ALSW=OFF; /* INIT LOOP SWITCH */ 00810000 NI ALSW,B'01111111' 0213 00811000 * DO WHILE ALSW=OFF; /* LOOP THROUGH PARM LIST */ 00812000 B @DE00214 0214 00813000 @DL00214 DS 0H 0215 00814000 * ALOPT=ALOP&LHEX7FC; /* MASK LAST ENTRY BIT FROM KEY 00815000 * CODE */ 00816000 LA ALOPT,127 0215 00817000 SLR @10,@10 0215 00818000 IC @10,ALOP(,ALBAS) 0215 00819000 NR ALOPT,@10 0215 00820000 * IF ALOPT=DISPOP THEN /* TEST FOR DISP PARAMETER */ 00821000 C ALOPT,@CF00052 0216 00822000 BNE @RF00216 0216 00823000 * DO; /* DISP PARAMETER */ 00824000 * IF ALPRB4F1=F0C THEN /* TEST FOR INDIRECT DISP PARM */ 00825000 CLI ALPRB4F1(ALBAS),0 0218 00826000 BNE @RF00218 0218 00827000 * ALBAS=ALBAS+F4C; /* INDIRECT DISP PARM */ 00828000 AL ALBAS,@CF00041 0219 00829000 * END; /* DISP PARAMETER */ 00830000 * ELSE 0221 00831000 * IF ALOPT=PASSOP THEN /* TEST FOR PASSWORD PARAMETER */ 00832000 B @RC00216 0221 00833000 @RF00216 C ALOPT,@CF00355 0221 00834000 BNE @RF00221 0221 00835000 * DO; /* PASSWORD PARAMETER */ 00836000 * CALL PASSPROC(PLENA,PPTRA);/* GET PASSWORD POINTER */ 00837000 L @10,@PC00004+4 0223 00838000 ST @10,@AL00001 0223 00839000 L @10,@PC00004+8 0223 00840000 ST @10,@AL00001+4 0223 00841000 LA @01,@AL00001 0223 00842000 BAL @14,PASSPROC 0223 00843000 * END; /* PASSWORD PARAMETER */ 00844000 * ELSE 0225 00845000 * DO; /* INVALID PARAMETER KEY CODE */ 00846000 B @RC00221 0225 00847000 @RF00221 DS 0H 0226 00848000 * CHSTR867=ALOPT; /* GET KEY FIELD */ 00849000 STCM ALOPT,3,CHSTR867 0226 00850000 * CHSTR88=LHEX0FC; /* TRANSLATE IT TO CHARACTER HEX */ 00851000 MVI CHSTR88,X'0F' 0227 00852000 * UNPK(CTEMP,CHSTR8); 0228 00853000 UNPK CTEMP(9),CHSTR8(8) 0228 00854000 * TR(CTEMP,HEXTBL); 0229 00855000 TR CTEMP(9),HEXTBL 0229 00856000 * DO; /* BLSDMSG 0230 00857000 * (ZZ2,F3117C,DMCBMSG,BLSDMSGS) 00858000 * INSERT(MODNAME,CTEMP72) */ 00859000 * IOPTLIST(1)=ADDR(IOPTLIST(4));/* CHAIN TO NEXT 0231 00860000 * INSERT */ 00861000 LA @10,IOPTLIST+12 0231 00862000 ST @10,IOPTLIST 0231 00863000 * IOPTLIST(2)=ADDR(MODNAME);/* INSERT NAME POINTER */ 00864000 LA @10,MODNAME 0232 00865000 ST @10,IOPTLIST+4 0232 00866000 * IOPTLIST(3)=0; /* ZERO RESERVED FIELD */ 00867000 SLR @10,@10 0233 00868000 ST @10,IOPTLIST+8 0233 00869000 * RFY 0234 00870000 * I015F BASED(ADDR(IOPTLIST(3)));/* ACCESS BYTES 0234 00871000 * 1-2 */ 00872000 * I015F=LENGTH(MODNAME);/* INSERT LENGTH */ 00873000 LA @04,IOPTLIST+8 0235 00874000 MVC I015F(2,@04),@CH00048 0235 00875000 * IOPTLIST(4)=0; /* LAST INSERT */ 00876000 ST @10,IOPTLIST+12 0236 00877000 * IOPTLIST(5)=ADDR(CTEMP72);/* INSERT NAME POINTER */ 00878000 LA @04,CTEMP72 0237 00879000 ST @04,IOPTLIST+16 0237 00880000 * IOPTLIST(6)=0; /* ZERO RESERVED FIELD */ 00881000 ST @10,IOPTLIST+20 0238 00882000 * RFY 0239 00883000 * I015F BASED(ADDR(IOPTLIST(6)));/* ACCESS BYTES 0239 00884000 * 1-2 */ 00885000 * I015F=LENGTH(CTEMP72);/* INSERT LENGTH */ 00886000 LA @10,IOPTLIST+20 0240 00887000 MVC I015F(2,@10),@CH00076 0240 00888000 * CALL BLSDMSG0(ZZ2,F3117C,DMCBMSG,BLSDMSGS,'00000000'B 00889000 * ,ADDR(IOPTLIST));/* BUILD MESSAGE */ 00890000 L @10,DMCBTVP(,DMCBPTR) 0241 00891000 ST @10,@AL00001 0241 00892000 LA @10,@CF00350 0241 00893000 ST @10,@AL00001+4 0241 00894000 LA @10,DMCBMSG(,DMCBPTR) 0241 00895000 ST @10,@AL00001+8 0241 00896000 L @10,DMCBMSGS(,DMCBPTR) 0241 00897000 ST @10,@AL00001+12 0241 00898000 LA @10,@CB00398 0241 00899000 ST @10,@AL00001+16 0241 00900000 LA @10,IOPTLIST 0241 00901000 ST @10,@AFTEMPS+4 0241 00902000 LA @10,@AFTEMPS+4 0241 00903000 ST @10,@AL00001+20 0241 00904000 L @15,DMCBMSG0(,DMCBPTR) 0241 00905000 LA @01,@AL00001 0241 00906000 BALR @14,@15 0241 00907000 * END; /* BLSDMSG 0242 00908000 * (ZZ2,F3117C,DMCBMSG,BLSDMSGS) 00909000 * INSERT(MODNAME,CTEMP72) BUILD 00910000 * ERROR MESSAGE */ 00911000 * ALSW=ON; /* SET END OF LOOP */ 00912000 OI ALSW,B'10000000' 0243 00913000 * RETCODE=ERROR; /* MARK ERROR */ 00914000 MVC RETCODE(4),@CF00048 0244 00915000 * DO; /* ABEND(110) DUMP USER */ 00916000 * RESPECIFY 0246 00917000 * (GPR01F) RESTRICTED; 0246 00918000 * GPR01F=(110)&'00000FFF'X;/* COMP CODE IN BITS 20-31*/ 00919000 LA GPR01F,110 0247 00920000 * GPR01F=GPR01F|'80000000'X;/* DUMP/STEP/DUMPOPTS 0248 00921000 * FLAG */ 00922000 O GPR01F,@CF00386 0248 00923000 * SVC(13); /* ISSUE ABEND SVC */ 00924000 SVC 13 0249 00925000 * RESPECIFY 0250 00926000 * (GPR01F) UNRESTRICTED; 0250 00927000 * END; /* ABEND(110) DUMP USER INTERNAL 00928000 * ERROR */ 00929000 * END; /* INVALID PARAMETER KEY CODE */ 00930000 * IF ALSW=ON| /* TEST FOR TERMINATE LOOP */ 00931000 * ALVL=ON THEN /* TEST FOR LAST LIST ELEMENT */ 00932000 @RC00221 DS 0H 0253 00933000 @RC00216 TM ALSW,B'10000000' 0253 00934000 BO @RT00253 0253 00935000 TM ALVL(ALBAS),B'10000000' 0253 00936000 BNO @RF00253 0253 00937000 @RT00253 DS 0H 0254 00938000 * DO; /* LAST LIST ELEMENT */ 00939000 * ALSW=ON; /* TERMINATE LIST PROCESSING */ 00940000 OI ALSW,B'10000000' 0255 00941000 * END; /* LAST LIST ELEMENT */ 00942000 * ELSE 0257 00943000 * ALBAS=ALBAS+F4C; /* SET UP FOR NEXT PLIST ENTRY */ 00944000 B @RC00253 0257 00945000 @RF00253 AL ALBAS,@CF00041 0257 00946000 * END; /* LOOP THROUGH PARM LIST */ 00947000 @RC00253 DS 0H 0258 00948000 @DE00214 TM ALSW,B'10000000' 0258 00949000 BZ @DL00214 0258 00950000 * END; /* PARM LIST EXISTS */ 00951000 * END PASSPARM; 0260 00952000 @EL00004 DS 0H 0260 00953000 @EF00004 DS 0H 0260 00954000 @ER00004 LM @14,@12,@SA00004 0260 00955000 BR @14 0260 00956000 EJECT 00957000 * 0261 00958000 * /*****************************************************************/ 00959000 * /* */ 00960000 * /* INTERNAL PROCEDURE TO OBTAIN THE PASSWORD POINTER */ 00961000 * /* */ 00962000 * /*****************************************************************/ 00963000 * 0261 00964000 *PASSPROC: 0261 00965000 * PROCEDURE(MLEN,PPTRB); 0261 00966000 PASSPROC STM @14,@01,@SA00005 0261 00967000 STM @03,@12,@SA00005+16 0261 00968000 MVC @PC00005(8),0(@01) 0261 00969000 * DCL 0262 00970000 * MLEN BIN(31), /* PASSWORD LENGTH */ 00971000 * PPTRB PTR(31); /* PASSWORD BASE TEMP */ 00972000 * DCL 0263 00973000 * PASSWKY CHAR(8) CONSTANT('PASSWORD'),/* ERROR MESSAGE VALUE */ 00974000 * LIM BIN(31) CONSTANT(8); /* MAX VALID PASSWORD LENGTH */ 00975000 SPACE 2 00976000 * ALBAS=ALBAS+F4C; /* BUMP PLIST BASE TO PARM LENGTH 00977000 * ADDR */ 00978000 LA @10,4 0264 00979000 ALR ALBAS,@10 0264 00980000 * MLEN=ALPTF31; /* GET PASSWORD LENGTH */ 00981000 L @04,@PC00005 0265 00982000 L @03,ALPTR(,ALBAS) 0265 00983000 L @03,ALPTF31(,@03) 0265 00984000 ST @03,MLEN(,@04) 0265 00985000 * ALBAS=ALBAS+F4C; /* BUMP ALPARM BASE TO GET PTR TO 00986000 * VL PARM FIELD */ 00987000 ALR ALBAS,@10 0266 00988000 * IF MLEN^=F0C THEN /* TEST FOR NON-NULL PARAMETER */ 00989000 SLR @10,@10 0267 00990000 CR @03,@10 0267 00991000 BE @RF00267 0267 00992000 * DO; /* LENGTH IS NOT EQUAL ZERO */ 00993000 * IF MLEN<0|MLEN>LIM THEN /* TEST FOR INVALID PARM LENGTH */ 00994000 CR @03,@10 0269 00995000 BL @RT00269 0269 00996000 C @03,@CF00048 0269 00997000 BNH @RF00269 0269 00998000 @RT00269 DS 0H 0270 00999000 * DO; /* INVALID PARAMETER LENGTH */ 01000000 * CHSTR847=MLEN; /* GET PARAMETER LENGTH FIELD */ 01001000 L @10,@PC00005 0271 01002000 MVC CHSTR847(4),MLEN(@10) 0271 01003000 * CHSTR88=LHEX0FC; /* TRANSLATE FIELD TO CHAR HEX */ 01004000 MVI CHSTR88,X'0F' 0272 01005000 * UNPK(CTEMP,CHSTR8); 0273 01006000 UNPK CTEMP(9),CHSTR8(8) 0273 01007000 * TR(CTEMP,HEXTBL); 0274 01008000 TR CTEMP(9),HEXTBL 0274 01009000 * DO; /* BLSDMSG 0275 01010000 * (ZZ2,F3119C,DMCBMSG,BLSDMSGS) 01011000 * INSERT(PASSWKY,MODNAME,PASSWKY 01012000 * ,(ALPTCVL,LIM),CTEMP63) */ 01013000 * IOPTLIST(1)=ADDR(IOPTLIST(4));/* CHAIN TO NEXT INSERT */ 01014000 LA @10,IOPTLIST+12 0276 01015000 ST @10,IOPTLIST 0276 01016000 * IOPTLIST(2)=ADDR(PASSWKY);/* INSERT NAME POINTER */ 01017000 LA @10,@CC00456 0277 01018000 ST @10,IOPTLIST+4 0277 01019000 * IOPTLIST(3)=0; /* ZERO RESERVED FIELD */ 01020000 SLR @04,@04 0278 01021000 ST @04,IOPTLIST+8 0278 01022000 * RFY 0279 01023000 * I015F BASED(ADDR(IOPTLIST(3)));/* ACCESS BYTES 1-2 */ 01024000 * I015F=LENGTH(PASSWKY);/* INSERT LENGTH */ 01025000 LA @03,8 0280 01026000 LA @15,IOPTLIST+8 0280 01027000 STH @03,I015F(,@15) 0280 01028000 * IOPTLIST(4)=ADDR(IOPTLIST(7));/* CHAIN TO NEXT INSERT */ 01029000 LA @15,IOPTLIST+24 0281 01030000 ST @15,IOPTLIST+12 0281 01031000 * IOPTLIST(5)=ADDR(MODNAME);/* INSERT NAME POINTER */ 01032000 LA @15,MODNAME 0282 01033000 ST @15,IOPTLIST+16 0282 01034000 * IOPTLIST(6)=0; /* ZERO RESERVED FIELD */ 01035000 ST @04,IOPTLIST+20 0283 01036000 * RFY 0284 01037000 * I015F BASED(ADDR(IOPTLIST(6)));/* ACCESS BYTES 1-2 */ 01038000 * I015F=LENGTH(MODNAME);/* INSERT LENGTH */ 01039000 LA @15,IOPTLIST+20 0285 01040000 STH @03,I015F(,@15) 0285 01041000 * IOPTLIST(7)=ADDR(IOPTLIST(10));/* CHAIN TO NEXT INSERT */ 01042000 LA @15,IOPTLIST+36 0286 01043000 ST @15,IOPTLIST+24 0286 01044000 * IOPTLIST(8)=ADDR(PASSWKY);/* INSERT NAME POINTER */ 01045000 ST @10,IOPTLIST+28 0287 01046000 * IOPTLIST(9)=0; /* ZERO RESERVED FIELD */ 01047000 ST @04,IOPTLIST+32 0288 01048000 * RFY 0289 01049000 * I015F BASED(ADDR(IOPTLIST(9)));/* ACCESS BYTES 1-2 */ 01050000 * I015F=LENGTH(PASSWKY);/* INSERT LENGTH */ 01051000 LA @10,IOPTLIST+32 0290 01052000 STH @03,I015F(,@10) 0290 01053000 * IOPTLIST(10)=ADDR(IOPTLIST(13));/* CHAIN TO NEXT INSERT*/ 01054000 LA @10,IOPTLIST+48 0291 01055000 ST @10,IOPTLIST+36 0291 01056000 * IOPTLIST(11)=ADDR(ALPTCVL);/* INSERT NAME POINTER */ 01057000 L @10,ALPTR(,ALBAS) 0292 01058000 ST @10,IOPTLIST+40 0292 01059000 * IOPTLIST(12)=0; /* ZERO RESERVED FIELD */ 01060000 ST @04,IOPTLIST+44 0293 01061000 * RFY 0294 01062000 * I015F BASED(ADDR(IOPTLIST(12)));/* ACCESS BYTES 1-2 */ 01063000 * I015F=LIM; /* INSERT LENGTH */ 01064000 LA @10,IOPTLIST+44 0295 01065000 STH @03,I015F(,@10) 0295 01066000 * IOPTLIST(13)=0; /* LAST INSERT */ 01067000 ST @04,IOPTLIST+48 0296 01068000 * IOPTLIST(14)=ADDR(CTEMP63);/* INSERT NAME POINTER */ 01069000 LA @10,CTEMP63 0297 01070000 ST @10,IOPTLIST+52 0297 01071000 * IOPTLIST(15)=0; /* ZERO RESERVED FIELD */ 01072000 ST @04,IOPTLIST+56 0298 01073000 * RFY 0299 01074000 * I015F BASED(ADDR(IOPTLIST(15)));/* ACCESS BYTES 1-2 */ 01075000 * I015F=LENGTH(CTEMP63);/* INSERT LENGTH */ 01076000 LA @10,IOPTLIST+56 0300 01077000 MVC I015F(2,@10),@CH00105 0300 01078000 * CALL BLSDMSG0(ZZ2,F3119C,DMCBMSG,BLSDMSGS,'00000000'B, 01079000 * ADDR(IOPTLIST)); /* BUILD MESSAGE */ 01080000 L @10,DMCBTVP(,DMCBPTR) 0301 01081000 ST @10,@AL00001 0301 01082000 LA @10,@CF00352 0301 01083000 ST @10,@AL00001+4 0301 01084000 LA @10,DMCBMSG(,DMCBPTR) 0301 01085000 ST @10,@AL00001+8 0301 01086000 L @10,DMCBMSGS(,DMCBPTR) 0301 01087000 ST @10,@AL00001+12 0301 01088000 LA @10,@CB00398 0301 01089000 ST @10,@AL00001+16 0301 01090000 LA @10,IOPTLIST 0301 01091000 ST @10,@AFTEMPS+8 0301 01092000 LA @10,@AFTEMPS+8 0301 01093000 ST @10,@AL00001+20 0301 01094000 L @15,DMCBMSG0(,DMCBPTR) 0301 01095000 LA @01,@AL00001 0301 01096000 BALR @14,@15 0301 01097000 * END; /* BLSDMSG 0302 01098000 * (ZZ2,F3119C,DMCBMSG,BLSDMSGS) 01099000 * INSERT(PASSWKY,MODNAME,PASSWKY 01100000 * ,(ALPTCVL,LIM),CTEMP63) BUILD 01101000 * INVALID PASSWORD LENGTH MSG */ 01102000 * RETCODE=ERROR; /* MARK ERROR */ 01103000 MVC RETCODE(4),@CF00048 0303 01104000 * ALSW=ON; /* TERMINATE LIST PROCESSING */ 01105000 OI ALSW,B'10000000' 0304 01106000 * MLEN=F0C; /* MARK PASSWORD LENGTH NULL */ 01107000 L @10,@PC00005 0305 01108000 SLR @04,@04 0305 01109000 ST @04,MLEN(,@10) 0305 01110000 * DO; /* ABEND(110) DUMP USER */ 01111000 * RESPECIFY 0307 01112000 * (GPR01F) RESTRICTED; 0307 01113000 * GPR01F=(110)&'00000FFF'X;/* COMP CODE IN BITS 20-31 */ 01114000 LA GPR01F,110 0308 01115000 * GPR01F=GPR01F|'80000000'X;/* DUMP/STEP/DUMPOPTS FLAG */ 01116000 O GPR01F,@CF00386 0309 01117000 * SVC(13); /* ISSUE ABEND SVC */ 01118000 SVC 13 0310 01119000 * RESPECIFY 0311 01120000 * (GPR01F) UNRESTRICTED; 0311 01121000 * END; /* ABEND(110) DUMP USER INTERNAL 01122000 * ERROR */ 01123000 * END; /* INVALID PARAMETER LENGTH */ 01124000 * ELSE 0314 01125000 * DO; /* VALID PARAMETER LENGTH */ 01126000 B @RC00269 0314 01127000 @RF00269 DS 0H 0315 01128000 * PPTRB=ALBAS; /* REMEMBER THE BASE POINTER */ 01129000 L @10,@PC00005+4 0315 01130000 ST ALBAS,PPTRB(,@10) 0315 01131000 * END; /* VALID PARAMETER LENGTH */ 01132000 * END; /* LENGTH IS NOT EQUAL TO ZERO */ 01133000 * END PASSPROC; /* END INTERNAL PROCEDURE */ 01134000 @EL00005 DS 0H 0318 01135000 @EF00005 DS 0H 0318 01136000 @ER00005 LM @14,@01,@SA00005 0318 01137000 LM @03,@12,@SA00005+16 0318 01138000 BR @14 0318 01139000 EJECT 01140000 * 0319 01141000 * /*****************************************************************/ 01142000 * /* */ 01143000 * /* PROCEDURE TO SCAN IDCAMS MODEL PARAMETER FOR OVERRIDE */ 01144000 * /* */ 01145000 * /*****************************************************************/ 01146000 * 0319 01147000 *SCANRP: 0319 01148000 * PROCEDURE(PLENC,PPTRC,DSWITCHC); 0319 01149000 SCANRP STM @14,@12,12(@13) 0319 01150000 MVC @PC00006(12),0(@01) 0319 01151000 * DCL 0320 01152000 * PLENC BIN(31), /* PASSWORD LENGTH */ 01153000 * PPTRC PTR(31), /* PASSWORD BASE TEMP */ 01154000 * DSWITCHC BIT(1); /* FOUND DATA SET NAME MODEL PARM*/ 01155000 * DCL 0321 01156000 * LSLSHC CHAR(3) CONSTANT(' / ');/* IDCAMS PASSWORD DELIMITER */ 01157000 * DCL 0322 01158000 * LDENDC CHAR(2) CONSTANT(' -');/* IDCAMS DELETE LINE END */ 01159000 * DCL 0323 01160000 * L12345C CHAR(6) CONSTANT(' 12345');/* IDCAMS VERB */ 01161000 * DCL 0324 01162000 * 1 DELTXT DEF(INTEXT), /* DELETE OVERRIDE MAP */ 01163000 * 2 * CHAR(1), /* BYTE 1 */ 01164000 * 2 DELVAL CHAR(44), /* DATA SET NAME */ 01165000 * 2 DELSLSH CHAR(LENGTH(LSLSHC)),/* OPTIONAL SLASH TEXT */ 01166000 * 2 DELPASS CHAR(8), /* PASSWORD (OPTIONAL) */ 01167000 * 2 DELEND CHAR(LENGTH(LDENDC));/* LINE END TEXT */ 01168000 * DCL 0325 01169000 * DELTYP CHAR(LENGTH(L12345C)) DEF(DELTXT);/* DELETE VERB FIELD */ 01170000 SPACE 1 01171000 * IF DELTYP=L12345C THEN /* TEST FOR DELETE VERB */ 01172000 L @10,INPTR 0326 01173000 CLC DELTYP(6,@10),@CC00483 0326 01174000 BNE @RF00326 0326 01175000 * DO; /* BUILD DELETE TEXT RECORD */ 01176000 * DELVAL=DMCBDSN; /* MOVE IN DATA SET NAME */ 01177000 MVC DELVAL(44,@10),DMCBDSN(DMCBPTR) 0328 01178000 * IF PLENC>F0C THEN /* TEST FOR PASSWORD PRESENT */ 01179000 SLR @04,@04 0329 01180000 L @15,@PC00006 0329 01181000 L @14,PLENC(,@15) 0329 01182000 CR @14,@04 0329 01183000 BNH @RF00329 0329 01184000 * DO; /* PASSWORD PRESENT */ 01185000 * ALBAS=PPTRC; /* SET PASSWORD BASE POINTER */ 01186000 L @09,@PC00006+4 0331 01187000 L ALBAS,PPTRC(,@09) 0331 01188000 * DELSLSH=LSLSHC; /* SET PASSWORD DELIMETER */ 01189000 MVC DELSLSH(3,@10),@CC00479 0332 01190000 * DELPASS(F1C:PLENC)=ALPTCVL(F1C:PLENC);/* MOVE IN PASSWORD*/ 01191000 BCTR @14,0 0333 01192000 L @03,ALPTR(,ALBAS) 0333 01193000 EX @14,@SM00509 0333 01194000 * ALBAS=F0C; /* CLEAN UP BEHIND US */ 01195000 SLR ALBAS,ALBAS 0334 01196000 * PPTRC=F0C; /* CLEAN UP BEHIND US */ 01197000 ST @04,PPTRC(,@09) 0335 01198000 * PLENC=F0C; /* CLEAN UP BEHIND US */ 01199000 ST @04,PLENC(,@15) 0336 01200000 * DELEND=LDENDC; /* MOVE IN LINE END */ 01201000 MVC DELEND(2,@10),@CC00481 0337 01202000 * END; /* PASSWORD PRESENT @ZA32131*/ 01203000 * DSWITCHC=ON; /* MARK DATA SET MODEL PARM FOUND*/ 01204000 @RF00329 L @10,@PC00006+8 0339 01205000 OI DSWITCHC(@10),B'10000000' 0339 01206000 * END; /* BUILD DELETE TEXT RECORD */ 01207000 * END SCANRP; 0341 01208000 @EL00006 DS 0H 0341 01209000 @EF00006 DS 0H 0341 01210000 @ER00006 LM @14,@12,12(@13) 0341 01211000 BR @14 0341 01212000 EJECT 01213000 * 0342 01214000 * /*****************************************************************/ 01215000 * /* */ 01216000 * /* END OF EXECUTABLE PROCEDURE STATEMENTS */ 01217000 * /* */ 01218000 * /*****************************************************************/ 01219000 * 0342 01220000 * DECLARE /* GENERAL PURPOSE REGISTERS */ 01221000 * GPR00F FIXED(31) REG(0), 0342 01222000 * GPR01F FIXED(31) REG(1), 0342 01223000 * GPR15F FIXED(31) REG(15), 0342 01224000 * GPR01P PTR(31) REG(1), 0342 01225000 * GPR15P PTR(31) REG(15); 0342 01226000 * DCL 0343 01227000 * 1 I006 DEF(ILIST), /* DEFINE LIST */ 01228000 * 2 I00601 CHAR(1), /* EP/DE FLAG */ 01229000 * 2 I00602 PTR(24), /* EP/DE PTR */ 01230000 * 2 I00603 CHAR(1), /* ERRET FLAG */ 01231000 * 2 I00604 PTR(24), /* DCB PTR */ 01232000 * 2 I00605 PTR(31); /* ERRET PTR */ 01233000 * DECLARE 0344 01234000 * ILIST CHAR(12) BDY(DWORD); /* STANDARD LIST */ 01235000 * DECLARE /* COMMON VARIABLES */ 01236000 * I256C CHAR(256) BASED, 0345 01237000 * I031F FIXED(31) BASED, 0345 01238000 * I031P PTR(31) BASED, 0345 01239000 * I015F FIXED(15) BASED, 0345 01240000 * I015P PTR(15) BASED, 0345 01241000 * I008P PTR(8) BASED, 0345 01242000 * I001C CHAR(1) BASED; 0345 01243000 * DECLARE 0346 01244000 * IOPTLIST(15) PTR(31) BDY(WORD);/* OPTION LIST ARRAY */ 01245000 * DCL 0347 01246000 * 1 DASPATCH LOCAL BDY(DWORD), /* PATCH AREA */ 01247000 * 2 DASPATA(DASPATLN) PTR INIT((DASPATLN)0); 0347 01248000 * GEN DATA DEFS(HEXTBL); 0348 01249000 * END BLSCFAMS 0349 01250000 * 0349 01251000 */* THE FOLLOWING INCLUDE STATEMENTS WERE FOUND IN THIS PROGRAM. */ 01252000 */*%INCLUDE SYSLIB (BLSDMSGD) */ 01253000 */*%INCLUDE SYSLIB (BLSCAMCB) */ 01254000 */*%INCLUDE SYSLIB (BLSCLKR ) */ 01255000 * 0349 01256000 * ; 0349 01257000 @EL00001 L @13,4(,@13) 0349 01258000 @EF00001 L @00,@SIZDATD 0349 01259000 LR @01,@11 0349 01260000 BLSCFREF R,LV=(0),A=(1) 01261000 @ER00001 LM @14,@12,12(@13) 0349 01262000 BR @14 0349 01263000 @DATA DS 0H 01264000 @SM00506 MVC INREC(0,@10),MMAMSREC(MAMSLP) 01265000 @SM00509 MVC DELPASS(0,@10),ALPTCVL(@03) 01266000 @DATD DSECT 01267000 DS 0F 01268000 @SA00001 DS 18F 01269000 @PC00001 DS 2F 01270000 @SA00003 DS 15F 01271000 @PC00003 DS 2F 01272000 @SA00002 DS 15F 01273000 @SA00004 DS 15F 01274000 @PC00004 DS 3F 01275000 @PC00006 DS 3F 01276000 @SA00005 DS 14F 01277000 @PC00005 DS 2F 01278000 @AL00001 DS 6A 01279000 @AFTEMPS DS 4F 01280000 BLSCFAMS CSECT 01281000 DS 0F 01282000 @CF00076 DC F'2' 01283000 @CH00076 EQU @CF00076+2 01284000 @CF00105 DC F'3' 01285000 @CH00105 EQU @CF00105+2 01286000 @CF00041 DC F'4' 01287000 @CF00052 DC F'5' 01288000 @CF00048 DC F'8' 01289000 @CH00048 EQU @CF00048+2 01290000 @CF00355 DC F'80' 01291000 @CF00346 DC F'3110' 01292000 @CF00348 DC F'3111' 01293000 @CF00350 DC F'3117' 01294000 @CF00352 DC F'3119' 01295000 @CF00386 DC XL4'80000000' 01296000 @DATD DSECT 01297000 DS 0D 01298000 PLEN DS F 01299000 PPTR DS A 01300000 MODSTAT DS CL20 01301000 ORG MODSTAT 01302000 MODNAME DS CL8 01303000 RETCODE DS FL4 01304000 STATCODE DS FL4 01305000 SUBCODE DS FL4 01306000 ORG MODSTAT+20 01307000 ALSW DS BL1 01308000 DS CL3 01309000 CHSTR8 DS CL8 01310000 ORG CHSTR8 01311000 @NM00002 DS CL3 01312000 CHSTR847 DS CL4 01313000 ORG CHSTR847 01314000 @NM00003 DS CL2 01315000 CHSTR867 DS CL2 01316000 ORG CHSTR8+7 01317000 CHSTR88 DS CL1 01318000 ORG CHSTR8+8 01319000 CTEMP DS CL9 01320000 ORG CTEMP 01321000 CTEMP18 DS CL8 01322000 ORG CTEMP18 01323000 @NM00004 DS CL5 01324000 CTEMP63 DS CL3 01325000 ORG CTEMP63 01326000 @NM00005 DS CL1 01327000 CTEMP72 DS CL2 01328000 ORG CTEMP+9 01329000 RESULT DS CL8 01330000 DS CL3 01331000 BLSCAMCB DS CL96 01332000 ORG BLSCAMCB 01333000 MCBOPTL DS CL4 01334000 MCBDNAML DS CL4 01335000 MCBPNL DS CL4 01336000 MCBIOL DS CL28 01337000 MCBINCB DS CL24 01338000 MCBOUCB DS CL24 01339000 MCBINPTR DS AL4 01340000 MCBOUPTR DS AL4 01341000 ORG BLSCAMCB+96 01342000 DSWITCH DS BL1 01343000 DS CL3 01344000 ILIST DS CL12 01345000 IOPTLIST DS 15A 01346000 BLSCFAMS CSECT 01347000 DS 0F 01348000 @SIZDATD DC AL1(0) 01349000 DC AL3(@ENDDATD-@DATD) 01350000 @CV00239 DC V(BLSCAMIN) 01351000 @CV00240 DC V(BLSCAMPR) 01352000 @CV00241 DC V(BLSCGMF) 01353000 @CV00242 DC V(BLSCHOK) 01354000 @CV00243 DC V(BLSCFMSM) 01355000 DS 0D 01356000 @CC00323 DC C'DDSYSIN ' 01357000 @CC00326 DC C'DDSYSPRINT' 01358000 @CC00367 DC C'IDCAMS ' 01359000 @CC00369 DC C'BLSCFAMS' 01360000 @CC00456 DC C'PASSWORD' 01361000 @CC00483 DC C' 12345' 01362000 @CC00479 DC C' / ' 01363000 @CC00481 DC C' -' 01364000 @CB00379 DC X'00' 01365000 @CB00398 DC B'00000000' 01366000 DS CL7 01367000 DASPATCH DS CL80 01368000 ORG DASPATCH 01369000 DASPATA DC 20A(0) 01370000 ORG DASPATCH+80 01371000 BLSCFAMS CSECT 01372000 * /* 01373000 HEXTBL EQU *-240 01374000 DC CL16'0123456789ABCDEF' 01375000 @DATD DSECT 01376000 ORG *+1-(*-@DATD)/(*-@DATD) INSURE DSECT DATA 01377000 @ENDDATD EQU * 01378000 BLSCFAMS CSECT 01379000 @00 EQU 00 EQUATES FOR REGISTERS 0-15 01380000 @01 EQU 01 01381000 @02 EQU 02 01382000 @03 EQU 03 01383000 @04 EQU 04 01384000 @05 EQU 05 01385000 @06 EQU 06 01386000 @07 EQU 07 01387000 @08 EQU 08 01388000 @09 EQU 09 01389000 @10 EQU 10 01390000 @11 EQU 11 01391000 @12 EQU 12 01392000 @13 EQU 13 01393000 @14 EQU 14 01394000 @15 EQU 15 01395000 RECLEN EQU @08 01396000 MVLEN EQU @06 01397000 MAMSLP EQU @07 01398000 REASON EQU @04 01399000 ABENDC EQU @06 01400000 ALOPT EQU @03 01401000 ALBAS EQU @02 01402000 OUFPTR EQU @05 01403000 DMCBPTR EQU @05 01404000 GPR01P EQU @01 01405000 GPR15P EQU @15 01406000 GPR15F EQU @15 01407000 GPR01F EQU @01 01408000 GPR00F EQU @00 01409000 DMCB EQU 0 01410000 DMCBTVP EQU DMCB+8 01411000 DMCBFTY EQU DMCB+20 01412000 DMCBOPN EQU DMCB+21 01413000 DMCBRMOD EQU DMCB+23 01414000 DMCBOUT EQU DMCBRMOD 01415000 DMCBOPTS EQU DMCB+24 01416000 DMCBGKY EQU DMCBOPTS 01417000 DMCBMFLG EQU DMCB+28 01418000 DMCBBUFP EQU DMCB+32 01419000 DMCBKEYP EQU DMCB+44 01420000 DMCBMSG EQU DMCB+52 01421000 DMCBRI EQU DMCB+64 01422000 DMCBMSG0 EQU DMCB+68 01423000 DMCBMSGS EQU DMCB+72 01424000 DMCBSPID EQU DMCB+84 01425000 DMCBFRE EQU DMCB+88 01426000 DMCBEOB EQU DMCB+92 01427000 DMCBACBE EQU DMCB+124 01428000 DMCBDSN EQU DMCB+284 01429000 DMCBMODL EQU DMCB+348 01430000 DMCBSPEC EQU DMCB+380 01431000 DMCBAMS EQU DMCB+416 01432000 DMCBAUDT EQU DMCB+568 01433000 DMCBLSCP EQU DMCBAUDT+16 01434000 MMAMSREC EQU 0 01435000 MMAMSLEN EQU MMAMSREC 01436000 MSGDENT EQU 0 01437000 MSGDPRF EQU MSGDENT 01438000 MSGDSPID EQU MSGDPRF 01439000 MSGDFLEN EQU MSGDPRF+1 01440000 MSGDWRT EQU MSGDENT+8 01441000 MSGDMOV EQU MSGDWRT+4 01442000 MSGWENT EQU 0 01443000 MSGWNXT EQU MSGWENT 01444000 MSGWMOV EQU MSGWENT+4 01445000 ALPTR EQU 0 01446000 ALOP EQU ALPTR 01447000 ALVL EQU ALOP 01448000 ALPRB4C1 EQU ALPTR+3 01449000 ALPRB4F1 EQU ALPRB4C1 01450000 ALPTF31 EQU 0 01451000 ALPTCVL EQU 0 01452000 BLSDMSGS EQU 0 01453000 BLSDMSG0 EQU 0 01454000 ZZ2 EQU 0 01455000 INENT EQU 0 01456000 INNEXT EQU INENT 01457000 INLEN EQU INENT+4 01458000 INTEXT EQU INENT+8 01459000 OUENT EQU 0 01460000 I015F EQU 0 01461000 DMCBDMGR EQU 0 01462000 DMCBRQC EQU 0 01463000 I001C EQU 0 01464000 I008P EQU 0 01465000 I015P EQU 0 01466000 I031F EQU 0 01467000 I031P EQU 0 01468000 I256C EQU 0 01469000 DMCBPARM EQU 0 01470000 PLIST EQU 0 01471000 BLDSTRP EQU 0 01472000 PLISTA EQU 0 01473000 PLISTB EQU 0 01474000 PLENA EQU 0 01475000 PPTRA EQU 0 01476000 MLEN EQU 0 01477000 PPTRB EQU 0 01478000 PLENC EQU 0 01479000 PPTRC EQU 0 01480000 DSWITCHC EQU 0 01481000 DMCBVSM EQU DMCBAMS 01482000 DMCBQSM EQU DMCBAMS 01483000 OUPTR EQU MCBOUPTR 01484000 AMSOPTL EQU MCBOPTL 01485000 OPTLLEN EQU AMSOPTL 01486000 AMSDNAML EQU MCBDNAML 01487000 DNAMLLEN EQU AMSDNAML 01488000 AMSPNL EQU MCBPNL 01489000 PNLLEN EQU AMSPNL 01490000 AMSIOL EQU MCBIOL 01491000 IOLNUM EQU AMSIOL 01492000 IOLINDDP EQU AMSIOL+4 01493000 IOLMINP EQU AMSIOL+8 01494000 IOLINCBP EQU AMSIOL+12 01495000 IOLOUDDP EQU AMSIOL+16 01496000 IOLMPRP EQU AMSIOL+20 01497000 IOLOUCBP EQU AMSIOL+24 01498000 INCB EQU MCBINCB 01499000 INHEAD EQU INCB 01500000 INCUR EQU INCB+4 01501000 INTAIL EQU INCB+8 01502000 OUCB EQU MCBOUCB 01503000 OUHEAD EQU OUCB 01504000 OUCUR EQU OUCB+4 01505000 OUTAIL EQU OUCB+8 01506000 INPTR EQU MCBINPTR 01507000 INREC EQU INENT+4 01508000 INRECF EQU INENT+4 01509000 I006 EQU ILIST 01510000 I00601 EQU I006 01511000 I00602 EQU I006+1 01512000 I00603 EQU I006+4 01513000 I00604 EQU I006+5 01514000 I00605 EQU I006+8 01515000 DELTXT EQU INTEXT 01516000 DELVAL EQU DELTXT+1 01517000 DELSLSH EQU DELTXT+45 01518000 DELPASS EQU DELTXT+48 01519000 DELEND EQU DELTXT+56 01520000 DELTYP EQU DELTXT 01521000 OUREC EQU OUENT+4 01522000 AGO .@UNREFD START UNREFERENCED COMPONENTS 01523000 @NM00007 EQU DELTXT 01524000 INTXTF EQU INRECF+4 01525000 @NM00006 EQU INRECF 01526000 OURESV01 EQU OUCB+20 01527000 OUECODE EQU OUCB+16 01528000 OURCODE EQU OUCB+12 01529000 INRESV01 EQU INCB+20 01530000 INECODE EQU INCB+16 01531000 INRCODE EQU INCB+12 01532000 PNLTXT EQU AMSPNL+2 01533000 DNAMLENT EQU AMSDNAML+2 01534000 OPTLTXT EQU AMSOPTL+2 01535000 DMCBRES7 EQU DMCBQSM+96 01536000 DMCBDCB EQU DMCBQSM 01537000 DMCBACB EQU DMCBVSM+76 01538000 DMCBRPL EQU DMCBVSM 01539000 OUTEXT EQU OUENT+8 01540000 OUPAD EQU OUENT+6 01541000 OULEN EQU OUENT+4 01542000 OUNEXT EQU OUENT 01543000 INPAD EQU INENT+6 01544000 @NM00001 EQU ALPTR+1 01545000 MSGWTXT EQU MSGWMOV+4 01546000 MSGWPAD EQU MSGWMOV+2 01547000 MSGWLEN EQU MSGWMOV 01548000 MSGDTXT EQU MSGDMOV+4 01549000 MSGDPAD EQU MSGDMOV+2 01550000 MSGDLEN EQU MSGDMOV 01551000 MSGDNXT EQU MSGDWRT 01552000 MSGDBAK EQU MSGDPRF+4 01553000 MMAMSTXT EQU MMAMSREC+4 01554000 MMAMSPAD EQU MMAMSREC+2 01555000 DMCBWRK EQU DMCB+648 01556000 DMCBRES8 EQU DMCB+640 01557000 DMCBMODN EQU DMCB+632 01558000 DMCBCARY EQU DMCBAUDT+20 01559000 DMCBCLC EQU DMCBAUDT+12 01560000 DMCBOPC EQU DMCBAUDT+8 01561000 DMCBFRC EQU DMCBAUDT+4 01562000 DMCBALC EQU DMCBAUDT 01563000 DMCBFR EQU DMCB+412 01564000 DMCBRES6 EQU DMCB+410 01565000 DMCBIRSC EQU DMCB+408 01566000 DMCBSUBC EQU DMCB+404 01567000 DMCBDRBP EQU DMCB+400 01568000 DMCBRSZM EQU DMCB+398 01569000 DMCBRSZA EQU DMCB+396 01570000 DMCBCISZ EQU DMCB+394 01571000 DMCBDCBL EQU DMCB+392 01572000 DMCBDCLR EQU DMCB+390 01573000 DMCBDCFM EQU DMCB+389 01574000 DMCBRES5 EQU DMCB+388 01575000 DMCBLBRT EQU DMCB+386 01576000 DMCBLBSQ EQU DMCB+384 01577000 DMCBLBPS EQU DMCB+383 01578000 DMCBLBTY EQU DMCB+382 01579000 DMCBRES4 EQU DMCB+381 01580000 DMCBSPRS EQU DMCBSPEC 01581000 DMCBSPRN EQU DMCBSPEC 01582000 DMCBSPCT EQU DMCBSPEC 01583000 DMCBSPRL EQU DMCBSPEC 01584000 DMCBSPSE EQU DMCB+376 01585000 DMCBSPPR EQU DMCB+372 01586000 DMCBSPTY EQU DMCB+369 01587000 DMCBODIS EQU DMCB+368 01588000 DMCBDISP EQU DMCB+367 01589000 DMCBSTAT EQU DMCB+366 01590000 DMCBRES3 EQU DMCB+364 01591000 DMCBMEMB EQU DMCB+356 01592000 DMCBRES9 EQU DMCB+340 01593000 DMCBPID EQU DMCB+332 01594000 DMCBTYPE EQU DMCB+328 01595000 DMCBUNIT EQU DMCB+276 01596000 DMCBDSOR EQU DMCB+274 01597000 DMCBVOL EQU DMCB+268 01598000 DMCBDDNM EQU DMCB+260 01599000 DMCBSYNM EQU DMCB+132 01600000 DMCBRPLF EQU DMCB+128 01601000 DMCBDCBE EQU DMCBACBE 01602000 DMCBARC EQU DMCB+120 01603000 DMCBCPC EQU DMCB+116 01604000 DMCBRET EQU DMCB+112 01605000 DMCBSTL EQU DMCB+96 01606000 DMCBRES2 EQU DMCB+85 01607000 DMCBRESC EQU DMCB+80 01608000 DMCBZZ1P EQU DMCB+76 01609000 DMCBRRL EQU DMCB+60 01610000 DMCBRBA EQU DMCB+56 01611000 DMCBKEYL EQU DMCB+48 01612000 DMCBKPC EQU DMCBKEYP 01613000 DMCBORL EQU DMCB+40 01614000 DMCBBLEN EQU DMCB+36 01615000 DMCBBFPC EQU DMCBBUFP 01616000 DMCBRES1 EQU DMCB+31 01617000 DMCBACCM EQU DMCB+30 01618000 DMCBREJ EQU DMCB+29 01619000 DMCBRESB EQU DMCBMFLG 01620000 DMCBFMOD EQU DMCBMFLG 01621000 DMCBLOPT EQU DMCB+27 01622000 DMCBLRM EQU DMCB+26 01623000 DMCBLRQ EQU DMCB+25 01624000 DMCBOPRS EQU DMCBOPTS 01625000 DMCBLRD EQU DMCBOPTS 01626000 DMCBBWD EQU DMCBOPTS 01627000 DMCBUPD EQU DMCBOPTS 01628000 DMCBAPX EQU DMCBOPTS 01629000 DMCBRNO EQU DMCBGKY 01630000 DMCBKYD EQU DMCBOPTS 01631000 DMCBRMRS EQU DMCBRMOD 01632000 DMCBRM5 EQU DMCBRMOD 01633000 DMCBRM6 EQU DMCBRMOD 01634000 DMCBTMP EQU DMCBOUT 01635000 DMCBRQST EQU DMCB+22 01636000 DMCBRESA EQU DMCBOPN 01637000 DMCBSOUT EQU DMCBOPN 01638000 DMCBSIN EQU DMCBOPN 01639000 DMCBVSF EQU DMCBFTY 01640000 DMCBKSF EQU DMCBFTY 01641000 DMCBFTRS EQU DMCBFTY 01642000 DMCBSHF EQU DMCBFTY 01643000 DMCBIRL EQU DMCB+16 01644000 DMCBRTC EQU DMCB+12 01645000 DMCBNEXT EQU DMCB+4 01646000 DMCBID EQU DMCB 01647000 .@UNREFD ANOP END UNREFERENCED COMPONENTS 01648000 @RC00073 EQU @EL00002 01649000 @RF00156 EQU @EL00003 01650000 @RF00198 EQU @EL00003 01651000 @RF00218 EQU @RC00216 01652000 @RF00211 EQU @EL00004 01653000 @RF00267 EQU @EL00005 01654000 @RC00269 EQU @EL00005 01655000 @RF00326 EQU @EL00006 01656000 @ENDDATA EQU * 01657000 END BLSCFAMS,(C'PLS1737',0701,78135) 01658000