TITLE 'EP=BLSCAMIN -- IPCS DAS IDCAMS SYSIN INTERFACE *00001000 ' 00002000 * /* CHANGE ACTIVITY 00003000 * THIS MODULE IS WRITTEN FOR @G57LPSR 00004000 BLSCAMIN CSECT , 0002 00005000 @MAINENT DS 0H 0002 00006000 USING *,@15 0002 00007000 B @PROLOG 0002 00008000 DC AL1(16) 0002 00009000 DC C'BLSCAMIN 78.062' 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 GETMAIN 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(12),0(@01) 0002 00024000 * 0007 00025000 * /*****************************************************************/ 00026000 * /* */ 00027000 * /* REGISTER DECLARATIONS */ 00028000 * /* */ 00029000 * /*****************************************************************/ 00030000 * 0008 00031000 */* */ 00032000 */*MACRO BLSCDGPR (01P) INVOKED */ 00033000 */* */ 00034000 * 0008 00035000 * 0008 00036000 * /*****************************************************************/ 00037000 * /* */ 00038000 * /* INITIALIZE MODULE STATUS */ 00039000 * /* */ 00040000 * /*****************************************************************/ 00041000 * 0008 00042000 * INRCODE=F0C; /* INIT RETURN CODE */ 00043000 * 0008 00044000 L @10,@PC00001 0008 00045000 SLR @15,@15 0008 00046000 ST @15,INRCODE(,@10) 0008 00047000 * /*****************************************************************/ 00048000 * /* */ 00049000 * /* OPEN FUNCTION */ 00050000 * /* */ 00051000 * /*****************************************************************/ 00052000 * 0009 00053000 * IF IOOPN=F0C THEN /* TEST FOR OPEN FUNCTION */ 00054000 L @15,@PC00001+4 0009 00055000 CLI IOOPN(@15),0 0009 00056000 BNE @RF00009 0009 00057000 * DO; /* DO OPEN FUNCTION */ 00058000 * IF INOPEN=ON& /* TEST IF FILE IS TO BE OPENED 00059000 * FOR INPUT */ 00060000 * DDIOINFO=ON& /* AND IF DDNAME IS SUPPLIED AND */ 00061000 * DNAME=INDDN THEN /* DDNAME = 'SYSIN' */ 00062000 TM INOPEN(@15),B'10100000' 0011 00063000 BNO @RF00011 0011 00064000 L @15,@PC00001+8 0011 00065000 CLC DNAME(8,@15),@CC00168 0011 00066000 BNE @RF00011 0011 00067000 * INOPNFL=ON; /* MARK DATA SET OPEN */ 00068000 OI INOPNFL(@10),B'10000000' 0012 00069000 * ELSE 0013 00070000 * DO; /* OPEN ERROR */ 00071000 B @RC00011 0013 00072000 @RF00011 DS 0H 0014 00073000 * INECODE=INECODE|XF1C; /* MARK OPEN ERROR */ 00074000 L @10,@PC00001 0014 00075000 OC INECODE(4,@10),@CB00156 0014 00076000 * INRCODE=SEVERE; /* OPEN FAILED */ 00077000 MVC INRCODE(4,@10),@CF00053 0015 00078000 * END; /* OPEN ERROR */ 00079000 * END; /* DO OPEN FUNCTION */ 00080000 * 0017 00081000 * /*****************************************************************/ 00082000 * /* */ 00083000 * /* CLOSE FUNCTION */ 00084000 * /* */ 00085000 * /*****************************************************************/ 00086000 * 0018 00087000 * ELSE 0018 00088000 * IF IOOPN=F4C THEN /* TEST FOR CLOSE REQUEST */ 00089000 B @RC00009 0018 00090000 @RF00009 L @10,@PC00001+4 0018 00091000 CLI IOOPN(@10),4 0018 00092000 BNE @RF00018 0018 00093000 * DO; /* DO CLOSE FUNCTION */ 00094000 * CALL FREEREC; /* FREE PREVIOUSLY ACCESSED 0020 00095000 * RECORD IF ANY */ 00096000 BAL @14,FREEREC 0020 00097000 * IF INOPEN=ON THEN /* TEST CLOSE FOR INPUT FILE */ 00098000 L @10,@PC00001+4 0021 00099000 TM INOPEN(@10),B'10000000' 0021 00100000 BNO @RF00021 0021 00101000 * INOPNFL=OFF; /* INDICATE DATA SET CLOSED */ 00102000 L @10,@PC00001 0022 00103000 NI INOPNFL(@10),B'01111111' 0022 00104000 * ELSE 0023 00105000 * DO; /* CLOSE ERROR */ 00106000 B @RC00021 0023 00107000 @RF00021 DS 0H 0024 00108000 * INECODE=INECODE|XF2C; /* MARK CLOSE ERROR */ 00109000 L @10,@PC00001 0024 00110000 OC INECODE(4,@10),@CB00158 0024 00111000 * INRCODE=SEVERE; /* CLOSE ERROR */ 00112000 MVC INRCODE(4,@10),@CF00053 0025 00113000 * END; /* CLOSE ERROR */ 00114000 * END; /* DO CLOSE FUNCTION */ 00115000 EJECT 00116000 * 0028 00117000 * /*****************************************************************/ 00118000 * /* */ 00119000 * /* GET FUNCTION */ 00120000 * /* */ 00121000 * /*****************************************************************/ 00122000 * 0028 00123000 * ELSE 0028 00124000 * IF IOOPN=F8C THEN /* TEST FOR GET REQUEST */ 00125000 B @RC00018 0028 00126000 @RF00018 L @10,@PC00001+4 0028 00127000 CLI IOOPN(@10),8 0028 00128000 BNE @RF00028 0028 00129000 * DO; /* DO GET FUNCTION */ 00130000 * IF INOPNFL=OFF THEN /* TEST FOR DATA SET NOT OPEN */ 00131000 L @10,@PC00001 0030 00132000 TM INOPNFL(@10),B'10000000' 0030 00133000 BNZ @RF00030 0030 00134000 * DO; /* DATA SET NOT OPEN */ 00135000 * INECODE=INECODE|XF4C;/* DATA SET NOT OPEN FOR GET */ 00136000 OC INECODE(4,@10),@CB00160 0032 00137000 * INRCODE=SEVERE; /* MARK ERROR */ 00138000 MVC INRCODE(4,@10),@CF00053 0033 00139000 * END; /* DATA SET NOT OPEN */ 00140000 * ELSE 0035 00141000 * DO; /* DATA SET OPEN FOR GET */ 00142000 B @RC00030 0035 00143000 @RF00030 DS 0H 0036 00144000 * CALL FREEREC; /* FREE PREVIOUS RECORD IF ANY */ 00145000 BAL @14,FREEREC 0036 00146000 * IF INHEAD=F0C THEN /* TEST FOR END OF DATA */ 00147000 L @10,@PC00001 0037 00148000 L @15,INHEAD(,@10) 0037 00149000 LTR @15,@15 0037 00150000 BNZ @RF00037 0037 00151000 * DO; /* END OF DATA */ 00152000 * INECODE=INECODE|XF8C;/* MARK EOD ON GET */ 00153000 OC INECODE(4,@10),@CB00162 0039 00154000 * INRCODE=EOD; /* EOD ON GET */ 00155000 MVC INRCODE(4,@10),@CF00040 0040 00156000 * END; /* END OF DATA */ 00157000 * ELSE 0042 00158000 * DO; /* PASS RECORD TO IDCAMS */ 00159000 B @RC00037 0042 00160000 @RF00037 DS 0H 0043 00161000 * INPTR=INHEAD; /* ADDRESABILITY TO RECORD */ 00162000 L @10,@PC00001 0043 00163000 L INPTR,INHEAD(,@10) 0043 00164000 * INCUR=INPTR; /* UNCHAIN RECORD FROM LIST */ 00165000 ST INPTR,INCUR(,@10) 0044 00166000 * INHEAD=INNEXT; 0045 00167000 L @04,INNEXT(,INPTR) 0045 00168000 ST @04,INHEAD(,@10) 0045 00169000 * RECPTR=ADDR(INTEXT);/* PASS RECORD TO IDCMAS */ 00170000 L @10,@PC00001+8 0046 00171000 LA @04,INTEXT(,INPTR) 0046 00172000 ST @04,RECPTR(,@10) 0046 00173000 * RECLEN=INLEN-F4C;/* PASS RECORD LENGTH */ 00174000 LH @04,INLEN(,INPTR) 0047 00175000 SL @04,@CF00040 0047 00176000 ST @04,RECLEN(,@10) 0047 00177000 * END; /* PASS RECORD TO IDCAMS */ 00178000 * END; /* DATA SET OPEN FOR GET */ 00179000 * END; /* DO GET FUNCTION */ 00180000 * ELSE 0051 00181000 * DO; /* INVALID REQUEST OPCODE */ 00182000 B @RC00028 0051 00183000 @RF00028 DS 0H 0052 00184000 * INECODE=INECODE|XF10C; /* INVALID OPCODE */ 00185000 L @10,@PC00001 0052 00186000 OC INECODE(4,@10),@CB00164 0052 00187000 * INRCODE=SEVERE; /* MARK ERROR */ 00188000 MVC INRCODE(4,@10),@CF00053 0053 00189000 * END; /* INVALID REQUEST OPCODE */ 00190000 * 0054 00191000 * /*****************************************************************/ 00192000 * /* */ 00193000 * /* FUNCTION COMPLETE, RETURN TO CALLER */ 00194000 * /* */ 00195000 * /*****************************************************************/ 00196000 * 0055 00197000 * RETURN CODE(INRCODE); 0055 00198000 @RC00028 DS 0H 0055 00199000 @RC00018 DS 0H 0055 00200000 @RC00009 L @10,@PC00001 0055 00201000 L @10,INRCODE(,@10) 0055 00202000 L @13,4(,@13) 0055 00203000 L @00,@SIZDATD 0055 00204000 LR @01,@11 0055 00205000 FREEMAIN R,LV=(0),A=(1) 00206000 LR @15,@10 0055 00207000 L @14,12(,@13) 0055 00208000 LM @00,@12,20(@13) 0055 00209000 BR @14 0055 00210000 EJECT 00211000 * 0056 00212000 * /*****************************************************************/ 00213000 * /* */ 00214000 * /* INTERNAL PROCEDURE TO FREEMAIN PREVIOUSLY READ RECORD */ 00215000 * /* */ 00216000 * /*****************************************************************/ 00217000 * 0056 00218000 *FREEREC: 0056 00219000 * PROCEDURE; 0056 00220000 FREEREC STM @14,@12,12(@13) 0056 00221000 * IF INCUR^=F0C THEN /* TEST FOR RECORD TO FREE */ 00222000 L @10,@PC00001 0057 00223000 L @10,INCUR(,@10) 0057 00224000 LTR @10,@10 0057 00225000 BZ @RF00057 0057 00226000 * DO; /* FREEMAIN THE RECORD */ 00227000 * INPTR=INCUR; /* SET ADDRESSABILITY TO RECORD */ 00228000 LR INPTR,@10 0059 00229000 * DO; /* FREEMAIN(RC) 0060 00230000 * LV(INLEN+F4C)A(INENT) 0060 00231000 * SP(ZZZSPSHR) */ 00232000 * RESPECIFY 0061 00233000 * (GPR01F, 0061 00234000 * GPR15F, 0061 00235000 * GPR00F) RESTRICTED; 0061 00236000 * GPR01F=0; /* REG 1 MUST BE ZERO */ 00237000 SLR GPR01F,GPR01F 0062 00238000 * GPR15F=1; /* SET TYPE */ 00239000 LA GPR15F,1 0063 00240000 * GPR00F=INLEN+F4C; /* LENGTH REQUESTED */ 00241000 LA GPR00F,4 0064 00242000 AH GPR00F,INLEN(,INPTR) 0064 00243000 * GPR01F=ADDR(INENT); /* SET REGISTER ONE */ 00244000 LR GPR01F,INPTR 0065 00245000 * GPR15F=GPR15F+((ZZZSPSHR)*256);/* SUBPOOL VALUE */ 00246000 AL GPR15F,@CF00192 0066 00247000 * SVC(120); /* RC/RU-FORM OF GETMAIN */ 00248000 SVC 120 0067 00249000 * SUBCODE=GPR15F; 0068 00250000 LR SUBCODE,GPR15F 0068 00251000 * RESPECIFY 0069 00252000 * (GPR01F, 0069 00253000 * GPR15F, 0069 00254000 * GPR00F) UNRESTRICTED; 0069 00255000 * END; /* FREEMAIN(RC) 0070 00256000 * LV(INLEN+F4C)A(INENT) 0070 00257000 * SP(ZZZSPSHR) FREEMAIN IT */ 00258000 * IF SUBCODE^=F0C THEN /* TEST FOR ERROR */ 00259000 LTR SUBCODE,SUBCODE 0071 00260000 BZ @RF00071 0071 00261000 * DO; /* FREEMAIN ERROR */ 00262000 * INECODE=INECODE|XF20C; /* FREEMAIN FAILED */ 00263000 L @10,@PC00001 0073 00264000 L @15,INECODE(,@10) 0073 00265000 O @15,XF20C 0073 00266000 ST @15,INECODE(,@10) 0073 00267000 * INRCODE=ERROR; /* MARK ERROR, BUT IDCAMS CAN 0074 00268000 * CONTINUE */ 00269000 MVC INRCODE(4,@10),@CF00051 0074 00270000 * END; /* FREEMAIN ERROR */ 00271000 * INCUR=F0C; /* MARK IT FREED */ 00272000 @RF00071 L @10,@PC00001 0076 00273000 SLR @15,@15 0076 00274000 ST @15,INCUR(,@10) 0076 00275000 * END; /* FREEMAIN THE RECORD */ 00276000 * END FREEREC; 0078 00277000 @EL00002 DS 0H 0078 00278000 @EF00002 DS 0H 0078 00279000 @ER00002 LM @14,@12,12(@13) 0078 00280000 BR @14 0078 00281000 EJECT 00282000 * 0079 00283000 * /*****************************************************************/ 00284000 * /* */ 00285000 * /* END OF EXECUTABLE PROCEDURE STATEMENTS */ 00286000 * /* */ 00287000 * /*****************************************************************/ 00288000 * 0079 00289000 */*BLSUPEND--MVS IPCS MODULE */ 00290000 * 0079 00291000 * DECLARE /* GENERAL PURPOSE REGISTERS */ 00292000 * GPR00F FIXED(31) REG(0), 0079 00293000 * GPR01F FIXED(31) REG(1), 0079 00294000 * GPR15F FIXED(31) REG(15), 0079 00295000 * GPR01P PTR(31) REG(1); 0079 00296000 * DECLARE /* COMMON VARIABLES */ 00297000 * I256C CHAR(256) BASED, 0080 00298000 * I031F FIXED(31) BASED, 0080 00299000 * I031P PTR(31) BASED, 0080 00300000 * I015F FIXED(15) BASED, 0080 00301000 * I015P PTR(15) BASED, 0080 00302000 * I008P PTR(8) BASED, 0080 00303000 * I001C CHAR(1) BASED; 0080 00304000 * GENERATE NODEFS NOREFS DATA; 0081 00305000 * END; /* BLRPEND THATS ALL FOLKS */ 00306000 @EL00001 L @13,4(,@13) 0082 00307000 @EF00001 L @00,@SIZDATD 0082 00308000 LR @01,@11 0082 00309000 FREEMAIN R,LV=(0),A=(1) 00310000 @ER00001 LM @14,@12,12(@13) 0082 00311000 BR @14 0082 00312000 @DATA DS 0H 00313000 @DATD DSECT 00314000 DS 0F 00315000 @SA00001 DS 18F 00316000 @PC00001 DS 3F 00317000 BLSCAMIN CSECT 00318000 DS 0F 00319000 @CF00040 DC F'4' 00320000 @CF00051 DC F'8' 00321000 @CF00053 DC F'12' 00322000 @CF00192 DC F'19712' 00323000 @DATD DSECT 00324000 DS 0D 00325000 XF20C DS F 00326000 BLSCAMIN CSECT 00327000 DS 0F 00328000 @SIZDATD DC AL1(77) 00329000 DC AL3(@ENDDATD-@DATD) 00330000 DS 0D 00331000 @CC00168 DC C'SYSIN ' 00332000 @CB00156 DC X'00000001' 00333000 @CB00158 DC X'00000002' 00334000 @CB00160 DC X'00000004' 00335000 @CB00162 DC X'00000008' 00336000 @CB00164 DC X'00000010' 00337000 @DATD DSECT 00338000 SPACE 2 00339000 *********************************************************************** 00340000 * THE FOLLOWING AREA, BLRPATCH, IS RESERVED FOR PATCH APPLICATION * 00341000 * TO OBTAIN PATCH ROOM IN THE @DATD AUTOMATIC STORAGE AREA, MODIFY * 00342000 * CONSTANT @SIZDATD TO REFLECT THE DESIRED @DATD SIZE * 00343000 *********************************************************************** 00344000 SPACE 00345000 BLSCAMIN CSECT 00346000 ORG 00347000 DS 0D 00348000 BLRPATCH DC CL8'ZAPAREA',(((*-BLSCAMIN+19)/20+7)/8)CL8'BLSCAMIN' 00349000 @DATD DSECT 00350000 SPACE 2 00351000 *********************************************************************** 00352000 * ALIGN END OF DATA ON A DOUBLEWORD BOUNDARY * 00353000 *********************************************************************** 00354000 SPACE 00355000 DS 0D 00356000 @DATD DSECT 00357000 ORG *+1-(*-@DATD)/(*-@DATD) INSURE DSECT DATA 00358000 @ENDDATD EQU * 00359000 BLSCAMIN CSECT 00360000 @00 EQU 00 EQUATES FOR REGISTERS 0-15 00361000 @01 EQU 01 00362000 @02 EQU 02 00363000 @03 EQU 03 00364000 @04 EQU 04 00365000 @05 EQU 05 00366000 @06 EQU 06 00367000 @07 EQU 07 00368000 @08 EQU 08 00369000 @09 EQU 09 00370000 @10 EQU 10 00371000 @11 EQU 11 00372000 @12 EQU 12 00373000 @13 EQU 13 00374000 @14 EQU 14 00375000 @15 EQU 15 00376000 SUBCODE EQU @05 00377000 INPTR EQU @05 00378000 GPR01F EQU @01 00379000 GPR15F EQU @15 00380000 GPR00F EQU @00 00381000 GPR01P EQU @01 00382000 INENT EQU 0 00383000 INNEXT EQU INENT 00384000 INLEN EQU INENT+4 00385000 INTEXT EQU INENT+8 00386000 I001C EQU 0 00387000 I008P EQU 0 00388000 I015F EQU 0 00389000 I015P EQU 0 00390000 I031F EQU 0 00391000 I031P EQU 0 00392000 I256C EQU 0 00393000 USERDATA EQU 0 00394000 INHEAD EQU USERDATA 00395000 INCUR EQU USERDATA+4 00396000 INRCODE EQU USERDATA+12 00397000 INECODE EQU USERDATA+16 00398000 INOPNFL EQU INECODE 00399000 IOFLAGS EQU 0 00400000 IOOPN EQU IOFLAGS 00401000 FLAGS EQU IOFLAGS+1 00402000 INOPEN EQU FLAGS 00403000 DDIOINFO EQU FLAGS 00404000 IOINFO EQU 0 00405000 RECPTR EQU IOINFO 00406000 RECLEN EQU IOINFO+4 00407000 DNAME EQU IOINFO 00408000 DSNAME EQU IOINFO 00409000 INREC EQU INENT+4 00410000 AGO .@UNREFD START UNREFERENCED COMPONENTS 00411000 PUTRECTY EQU IOFLAGS+2 00412000 DSIOINFO EQU FLAGS 00413000 OUTOPEN EQU FLAGS 00414000 LISTHD EQU USERDATA+20 00415000 OUOPNFL EQU INECODE 00416000 INTAIL EQU USERDATA+8 00417000 INPAD EQU INENT+6 00418000 .@UNREFD ANOP END UNREFERENCED COMPONENTS 00419000 @RC00011 EQU @RC00009 00420000 @RC00021 EQU @RC00018 00421000 @RC00030 EQU @RC00028 00422000 @RC00037 EQU @RC00028 00423000 @RF00057 EQU @EL00002 00424000 @ENDDATA EQU * 00425000 END BLSCAMIN,(C'PLS1835',0701,78062) 00426000