TITLE 'EP=BLSCAMPR -- IPCS DAS IDCAMS SYSPRINT INTERFACE *00001000 ' 00002000 * /* CHANGE ACTIVITY 00003000 * THIS MODULE IS WRITTEN FOR @G57LPSR 00004000 BLSCAMPR CSECT , 0002 00005000 @MAINENT DS 0H 0002 00006000 USING *,@15 0002 00007000 B @PROLOG 0002 00008000 DC AL1(16) 0002 00009000 DC C'BLSCAMPR 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 * 0008 00025000 * /*****************************************************************/ 00026000 * /* */ 00027000 * /* REGISTER DECLARATIONS */ 00028000 * /* */ 00029000 * /*****************************************************************/ 00030000 * 0009 00031000 */* */ 00032000 */*MACRO BLSCDGPR (01P) INVOKED */ 00033000 */* */ 00034000 * 0009 00035000 * /* DECLARE EXPLICITLY USED 0009 00036000 * REGISTERS */ 00037000 * 0009 00038000 * /*****************************************************************/ 00039000 * /* */ 00040000 * /* INITIALIZE MODULE STATUS */ 00041000 * /* */ 00042000 * /*****************************************************************/ 00043000 * 0009 00044000 * OURCODE=F0C; /* INIT RETURN CODE */ 00045000 * 0009 00046000 L @10,@PC00001 0009 00047000 SLR @15,@15 0009 00048000 ST @15,OURCODE(,@10) 0009 00049000 * /*****************************************************************/ 00050000 * /* */ 00051000 * /* OPEN FUNCTION */ 00052000 * /* */ 00053000 * /*****************************************************************/ 00054000 * 0010 00055000 * IF IOOPN=F0C THEN /* TEST FOR OPEN FUNCTION */ 00056000 L @15,@PC00001+4 0010 00057000 CLI IOOPN(@15),0 0010 00058000 BNE @RF00010 0010 00059000 * DO; /* DO OPEN FUNCTION */ 00060000 * IF OUTOPEN=ON& /* TEST THAT FILE IS TO BE OPENED 00061000 * FOR OUTPUT */ 00062000 * DDIOINFO=ON& /* AND IF DDNAME IS SUPPLIED AND */ 00063000 * DNAME=OUDDN THEN /* DDNAME = 'SYSPRINT' */ 00064000 TM OUTOPEN(@15),B'01100000' 0012 00065000 BNO @RF00012 0012 00066000 L @15,@PC00001+8 0012 00067000 CLC DNAME(8,@15),@CC00187 0012 00068000 BNE @RF00012 0012 00069000 * OUOPNFL=ON; /* MARK DATA SET OPEN */ 00070000 OI OUOPNFL(@10),B'01000000' 0013 00071000 * ELSE 0014 00072000 * DO; /* OPEN ERROR */ 00073000 B @RC00012 0014 00074000 @RF00012 DS 0H 0015 00075000 * OUECODE=OUECODE|XF1C; /* MARK OPEN ERROR */ 00076000 L @10,@PC00001 0015 00077000 OC OUECODE(4,@10),@CB00175 0015 00078000 * OURCODE=SEVERE; /* OPEN FAILED */ 00079000 MVC OURCODE(4,@10),@CF00053 0016 00080000 * END; /* OPEN ERROR */ 00081000 * END; /* DO OPEN FUNCTION */ 00082000 * 0018 00083000 * /*****************************************************************/ 00084000 * /* */ 00085000 * /* CLOSE FUNCTION */ 00086000 * /* */ 00087000 * /*****************************************************************/ 00088000 * 0019 00089000 * ELSE 0019 00090000 * IF IOOPN=F4C THEN /* TEST FOR CLOSE REQUEST */ 00091000 B @RC00010 0019 00092000 @RF00010 L @10,@PC00001+4 0019 00093000 CLI IOOPN(@10),4 0019 00094000 BNE @RF00019 0019 00095000 * DO; /* DO CLOSE FUNCTION */ 00096000 * IF OUTOPEN=ON THEN /* TEST CLOSE OF OUTPUT FILE */ 00097000 TM OUTOPEN(@10),B'01000000' 0021 00098000 BNO @RF00021 0021 00099000 * OUOPNFL=OFF; /* INDICATE DATA SET CLOSED */ 00100000 L @10,@PC00001 0022 00101000 NI OUOPNFL(@10),B'10111111' 0022 00102000 * ELSE 0023 00103000 * DO; /* CLOSE ERROR */ 00104000 B @RC00021 0023 00105000 @RF00021 DS 0H 0024 00106000 * OUECODE=OUECODE|XF2C; /* MARK CLOSE ERROR */ 00107000 L @10,@PC00001 0024 00108000 OC OUECODE(4,@10),@CB00177 0024 00109000 * OURCODE=SEVERE; /* CLOSE ERROR */ 00110000 MVC OURCODE(4,@10),@CF00053 0025 00111000 * END; /* CLOSE ERROR */ 00112000 * END; /* DO CLOSE FUNCTION */ 00113000 EJECT 00114000 * 0028 00115000 * /*****************************************************************/ 00116000 * /* */ 00117000 * /* PUT FUNCTION */ 00118000 * /* */ 00119000 * /*****************************************************************/ 00120000 * 0028 00121000 * ELSE 0028 00122000 * IF IOOPN=F12C THEN /* TEST FOR PUT REQUEST */ 00123000 B @RC00019 0028 00124000 @RF00019 L @10,@PC00001+4 0028 00125000 CLI IOOPN(@10),12 0028 00126000 BNE @RF00028 0028 00127000 * DO; /* DO PUT FUNCTION */ 00128000 * IF OUOPNFL=OFF THEN /* TEST FOR DATA SET NOT OPEN */ 00129000 L @10,@PC00001 0030 00130000 TM OUOPNFL(@10),B'01000000' 0030 00131000 BNZ @RF00030 0030 00132000 * DO; /* DATA SET NOT OPEN */ 00133000 * OUECODE=OUECODE|XF4C;/* DATA SET NOT OPEN FOR PUT */ 00134000 OC OUECODE(4,@10),@CB00179 0032 00135000 * OURCODE=SEVERE; /* MARK ERROR */ 00136000 MVC OURCODE(4,@10),@CF00053 0033 00137000 * END; /* DATA SET NOT OPEN */ 00138000 * ELSE 0035 00139000 * DO; /* DATA SET OPEN FOR PUT */ 00140000 B @RC00030 0035 00141000 @RF00030 DS 0H 0036 00142000 * OUFLEN=(RECLEN+LENGTH(MSGDENT)+F7C)&XDWBDYC;/* SET 0036 00143000 * GETMAIN LENGTH */ 00144000 L @10,@PC00001+8 0036 00145000 LA OUFLEN,23 0036 00146000 AL OUFLEN,RECLEN(,@10) 0036 00147000 N OUFLEN,@CF00185 0036 00148000 * DO; /* GETMAIN (RC) LV(OUFLEN) 0037 00149000 * SP(ZZZSPEXC) RTCD(SUBCODE) */ 00150000 * RESPECIFY 0038 00151000 * (GPR01F, 0038 00152000 * GPR15F, 0038 00153000 * GPR00F) RESTRICTED; 0038 00154000 * GPR01F=0; /* REG 1 MUST BE ZERO */ 00155000 SLR GPR01F,GPR01F 0039 00156000 * GPR15F=0; /* RC-TYPE GETMAIN */ 00157000 SLR GPR15F,GPR15F 0040 00158000 * GPR00F=OUFLEN; /* LENGTH REQUESTED */ 00159000 LR GPR00F,OUFLEN 0041 00160000 * GPR15F=GPR15F|((ZZZSPEXC)*256);/* SP IN BYTE 2 */ 00161000 O GPR15F,@CF00194 0042 00162000 * SVC(120); /* RC/RU-FORM OF GETMAIN */ 00163000 SVC 120 0043 00164000 * SUBCODE=GPR15F; /* SET RETURN CODE */ 00165000 LR SUBCODE,GPR15F 0044 00166000 * RESPECIFY 0045 00167000 * (GPR01F, 0045 00168000 * GPR15F, 0045 00169000 * GPR00F) UNRESTRICTED; 0045 00170000 * END; /* GETMAIN (RC) LV(OUFLEN) 0046 00171000 * SP(ZZZSPEXC) RTCD(SUBCODE) GET 00172000 * SPACE FOR RECORD */ 00173000 * RFY 0047 00174000 * GPR01P RSTD; 0047 00175000 * OUPTR=GPR01P; /* ADDRESABILITY TO RECORD */ 00176000 LR OUPTR,GPR01P 0048 00177000 * RFY 0049 00178000 * GPR01P UNRSTD; 0049 00179000 * IF SUBCODE^=0 THEN /* TEST FOR GETMAIN ERROR */ 00180000 LTR SUBCODE,SUBCODE 0050 00181000 BZ @RF00050 0050 00182000 * DO; /* GETMAIN ERROR */ 00183000 * OUECODE=OUECODE|XF8C;/* GETMAIN FAILED */ 00184000 L @10,@PC00001 0052 00185000 OC OUECODE(4,@10),@CB00181 0052 00186000 * OURCODE=SEVERE; /* MARK ERROR */ 00187000 MVC OURCODE(4,@10),@CF00053 0053 00188000 * END; /* GETMAIN ERROR */ 00189000 * ELSE 0055 00190000 * DO; /* GETMAIN OK, CHAIN RECORD TO 0055 00191000 * LIST */ 00192000 B @RC00050 0055 00193000 @RF00050 DS 0H 0056 00194000 * MSGDENT(F1C:OUFLEN)=MSGDENT(F1C:OUFLEN)&&MSGDENT( 00195000 * F1C:OUFLEN);/* CLEAR REC */ 00196000 LR @10,OUFLEN 0056 00197000 BCTR @10,0 0056 00198000 EX @10,@SX00209 0056 00199000 * MSGDSPID=ZZZSPEXC;/* SUBPOOL ID FOR FREEMAIN */ 00200000 MVI MSGDSPID(OUPTR),X'01' 0057 00201000 * MSGDFLEN=OUFLEN;/* MESSAGE FREEMAIN LENGTH */ 00202000 STCM OUFLEN,7,MSGDFLEN(OUPTR) 0058 00203000 * MSGDLEN=RECLEN+LENGTH(MSGDMOV);/* BUILD SYSPRINT 00204000 * RECORD */ 00205000 L @10,@PC00001+8 0059 00206000 L @04,RECLEN(,@10) 0059 00207000 LA @03,4 0059 00208000 ALR @03,@04 0059 00209000 STH @03,MSGDLEN(,OUPTR) 0059 00210000 * MSGDTXT(1:RECLEN)=RECORD(1:RECLEN); 0060 00211000 BCTR @04,0 0060 00212000 L @10,RECPTR(,@10) 0060 00213000 EX @04,@SM00211 0060 00214000 * OUWPTR=OUPTR+LENGTH(MSGDPRF);/* SET MESSAGE CHAIN 00215000 * POINTER */ 00216000 LA OUWPTR,8 0061 00217000 ALR OUWPTR,OUPTR 0061 00218000 * IF OUHEAD=F0C THEN/* TEST FOR NULL LIST */ 00219000 L @10,@PC00001 0062 00220000 L @04,OUHEAD(,@10) 0062 00221000 LTR @04,@04 0062 00222000 BNZ @RF00062 0062 00223000 * OUHEAD=OUWPTR;/* FIRST RECORD */ 00224000 ST OUWPTR,OUHEAD(,@10) 0063 00225000 * ELSE 0064 00226000 * DO; /* NON-NULL LIST */ 00227000 B @RC00062 0064 00228000 @RF00062 DS 0H 0065 00229000 * OUTAIL->MSGWNXT=OUWPTR;/* HOOK NEW RECORD TO 00230000 * PREVIOUS RECORD */ 00231000 L @10,@PC00001 0065 00232000 L @10,OUTAIL(,@10) 0065 00233000 ST OUWPTR,MSGWNXT(,@10) 0065 00234000 * MSGDBAK=OUTAIL-LENGTH(MSGDPRF);/* BACKCHAIN 00235000 * PREVIOUS REC TO NEW REC */ 00236000 SL @10,@CF00051 0066 00237000 ST @10,MSGDBAK(,OUPTR) 0066 00238000 * END; /* NON-NULL LIST */ 00239000 * DHEAD=OUHEAD-LENGTH(MSGDPRF); 0068 00240000 @RC00062 L @10,@PC00001 0068 00241000 L DHEAD,OUHEAD(,@10) 0068 00242000 SL DHEAD,@CF00051 0068 00243000 * DHEAD->MSGDBAK=OUPTR;/* BACKCHAIN NEW REC TO HEAD*/ 00244000 ST OUPTR,MSGDBAK(,DHEAD) 0069 00245000 * OUTAIL=OUWPTR; /* NEW LIST END */ 00246000 ST OUWPTR,OUTAIL(,@10) 0070 00247000 * END; /* GETMAIN OK, CHAIN RECORD TO 0071 00248000 * LIST */ 00249000 * END; /* DATA SET OPEN FOR PUT */ 00250000 * END; /* DO PUT FUNCTION */ 00251000 * ELSE 0074 00252000 * DO; /* INVALID REQUEST OPCODE */ 00253000 B @RC00028 0074 00254000 @RF00028 DS 0H 0075 00255000 * OUECODE=OUECODE|XF10C; /* INVALID OPCODE */ 00256000 L @10,@PC00001 0075 00257000 OC OUECODE(4,@10),@CB00183 0075 00258000 * OURCODE=SEVERE; /* MARK ERROR */ 00259000 MVC OURCODE(4,@10),@CF00053 0076 00260000 * END; /* INVALID REQUEST OPCODE */ 00261000 * 0077 00262000 * /*****************************************************************/ 00263000 * /* */ 00264000 * /* FUNCTION COMPLETE, RETURN TO CALLER */ 00265000 * /* */ 00266000 * /*****************************************************************/ 00267000 * 0078 00268000 * RETURN CODE(OURCODE); 0078 00269000 @RC00028 DS 0H 0078 00270000 @RC00019 DS 0H 0078 00271000 @RC00010 L @10,@PC00001 0078 00272000 L @10,OURCODE(,@10) 0078 00273000 L @13,4(,@13) 0078 00274000 L @00,@SIZDATD 0078 00275000 LR @01,@11 0078 00276000 FREEMAIN R,LV=(0),A=(1) 00277000 LR @15,@10 0078 00278000 L @14,12(,@13) 0078 00279000 LM @00,@12,20(@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 * 0082 00307000 */* THE FOLLOWING INCLUDE STATEMENTS WERE FOUND IN THIS PROGRAM. */ 00308000 */*%INCLUDE SYSLIB (BLSDMSGD) */ 00309000 * 0082 00310000 * ; 0082 00311000 @EL00001 L @13,4(,@13) 0082 00312000 @EF00001 L @00,@SIZDATD 0082 00313000 LR @01,@11 0082 00314000 FREEMAIN R,LV=(0),A=(1) 00315000 @ER00001 LM @14,@12,12(@13) 0082 00316000 BR @14 0082 00317000 @DATA DS 0H 00318000 @SX00209 XC MSGDENT(0,OUPTR),MSGDENT(OUPTR) 00319000 @SM00211 MVC MSGDTXT(0,OUPTR),RECORD(@10) 00320000 @DATD DSECT 00321000 DS 0F 00322000 @SA00001 DS 18F 00323000 @PC00001 DS 3F 00324000 BLSCAMPR CSECT 00325000 DS 0F 00326000 @CF00051 DC F'8' 00327000 @CF00053 DC F'12' 00328000 @CF00194 DC F'256' 00329000 @CF00185 DC XL4'FFFFFFF8' 00330000 @DATD DSECT 00331000 DS 0D 00332000 BLSCAMPR CSECT 00333000 DS 0F 00334000 @SIZDATD DC AL1(77) 00335000 DC AL3(@ENDDATD-@DATD) 00336000 DS 0D 00337000 @CC00187 DC C'SYSPRINT' 00338000 @CB00175 DC X'00000001' 00339000 @CB00177 DC X'00000002' 00340000 @CB00179 DC X'00000004' 00341000 @CB00181 DC X'00000008' 00342000 @CB00183 DC X'00000010' 00343000 @DATD DSECT 00344000 SPACE 2 00345000 *********************************************************************** 00346000 * THE FOLLOWING AREA, BLRPATCH, IS RESERVED FOR PATCH APPLICATION * 00347000 * TO OBTAIN PATCH ROOM IN THE @DATD AUTOMATIC STORAGE AREA, MODIFY * 00348000 * CONSTANT @SIZDATD TO REFLECT THE DESIRED @DATD SIZE * 00349000 *********************************************************************** 00350000 SPACE 00351000 BLSCAMPR CSECT 00352000 ORG 00353000 DS 0D 00354000 BLRPATCH DC CL8'ZAPAREA',(((*-BLSCAMPR+19)/20+7)/8)CL8'BLSCAMPR' 00355000 @DATD DSECT 00356000 SPACE 2 00357000 *********************************************************************** 00358000 * ALIGN END OF DATA ON A DOUBLEWORD BOUNDARY * 00359000 *********************************************************************** 00360000 SPACE 00361000 DS 0D 00362000 @DATD DSECT 00363000 ORG *+1-(*-@DATD)/(*-@DATD) INSURE DSECT DATA 00364000 @ENDDATD EQU * 00365000 BLSCAMPR CSECT 00366000 @00 EQU 00 EQUATES FOR REGISTERS 0-15 00367000 @01 EQU 01 00368000 @02 EQU 02 00369000 @03 EQU 03 00370000 @04 EQU 04 00371000 @05 EQU 05 00372000 @06 EQU 06 00373000 @07 EQU 07 00374000 @08 EQU 08 00375000 @09 EQU 09 00376000 @10 EQU 10 00377000 @11 EQU 11 00378000 @12 EQU 12 00379000 @13 EQU 13 00380000 @14 EQU 14 00381000 @15 EQU 15 00382000 DHEAD EQU @03 00383000 OUFLEN EQU @06 00384000 SUBCODE EQU @07 00385000 OUWPTR EQU @02 00386000 OUPTR EQU @05 00387000 GPR01F EQU @01 00388000 GPR15F EQU @15 00389000 GPR00F EQU @00 00390000 GPR01P EQU @01 00391000 RECORD EQU 0 00392000 MSGDENT EQU 0 00393000 MSGDPRF EQU MSGDENT 00394000 MSGDSPID EQU MSGDPRF 00395000 MSGDFLEN EQU MSGDPRF+1 00396000 MSGDBAK EQU MSGDPRF+4 00397000 MSGDWRT EQU MSGDENT+8 00398000 MSGDMOV EQU MSGDWRT+4 00399000 MSGDLEN EQU MSGDMOV 00400000 MSGDTXT EQU MSGDMOV+4 00401000 MSGWENT EQU 0 00402000 MSGWNXT EQU MSGWENT 00403000 MSGWMOV EQU MSGWENT+4 00404000 I001C EQU 0 00405000 I008P EQU 0 00406000 I015F EQU 0 00407000 I015P EQU 0 00408000 I031F EQU 0 00409000 I031P EQU 0 00410000 I256C EQU 0 00411000 USERDATA EQU 0 00412000 OUHEAD EQU USERDATA 00413000 OUTAIL EQU USERDATA+8 00414000 OURCODE EQU USERDATA+12 00415000 OUECODE EQU USERDATA+16 00416000 OUOPNFL EQU OUECODE 00417000 IOFLAGS EQU 0 00418000 IOOPN EQU IOFLAGS 00419000 FLAGS EQU IOFLAGS+1 00420000 OUTOPEN EQU FLAGS 00421000 DDIOINFO EQU FLAGS 00422000 IOINFO EQU 0 00423000 RECPTR EQU IOINFO 00424000 RECLEN EQU IOINFO+4 00425000 DNAME EQU IOINFO 00426000 DSNAME EQU IOINFO 00427000 AGO .@UNREFD START UNREFERENCED COMPONENTS 00428000 PUTRECTY EQU IOFLAGS+2 00429000 DSIOINFO EQU FLAGS 00430000 INOPEN EQU FLAGS 00431000 LISTHD EQU USERDATA+20 00432000 INOPNFL EQU OUECODE 00433000 OUCUR EQU USERDATA+4 00434000 MSGWTXT EQU MSGWMOV+4 00435000 MSGWPAD EQU MSGWMOV+2 00436000 MSGWLEN EQU MSGWMOV 00437000 MSGDPAD EQU MSGDMOV+2 00438000 MSGDNXT EQU MSGDWRT 00439000 .@UNREFD ANOP END UNREFERENCED COMPONENTS 00440000 @RC00012 EQU @RC00010 00441000 @RC00021 EQU @RC00019 00442000 @RC00030 EQU @RC00028 00443000 @RC00050 EQU @RC00028 00444000 @ENDDATA EQU * 00445000 END BLSCAMPR,(C'PLS1845',0701,78062) 00446000