TITLE 'EP=BLSCRFM - IPCS DAS REFORMAT TSO MESSAGE TO DAS FORMA*00001000 AT ' 00002000 * /* CHANGE ACTIVITY 00003000 * THIS MODULE IS WRITTEN FOR @G57LPSR 00004000 BLSCRFM CSECT , 0002 00005000 @MAINENT DS 0H 0002 00006000 USING *,@15 0002 00007000 B @PROLOG 0002 00008000 DC AL1(16) 0002 00009000 DC C'BLSCRFM 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 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(12),0(@01) 0002 00024000 EJECT 00025000 * 0015 00026000 * /*****************************************************************/ 00027000 * /* */ 00028000 * /* INITIALIZE MODULE STATUS */ 00029000 * /* */ 00030000 * /*****************************************************************/ 00031000 * 0015 00032000 * DMCBPTR=ADDR(DMCBPARM); /* BASE THE DMCB */ 00033000 L DMCBPTR,@PC00001 0015 00034000 * MODNAME=LMODNMC; /* INIT THE MODULE NAME */ 00035000 MVC MODNAME(8),@CC00317 0016 00036000 * RETCODE=F0C; /* INIT THE MODULE RETURN CODE */ 00037000 SLR @10,@10 0017 00038000 ST @10,RETCODE 0017 00039000 * SUBCODE=F0C; /* INIT THE SUBROUTINE RETURN 0018 00040000 * CODE */ 00041000 * 0018 00042000 ST @10,SUBCODE 0018 00043000 * /*****************************************************************/ 00044000 * /* */ 00045000 * /* REFORMAT MESSAGE */ 00046000 * /* */ 00047000 * /*****************************************************************/ 00048000 * 0019 00049000 * RFMVLEN=MTBUFLEN; /* PICK UP TSO MESSAGE LENGTH */ 00050000 L @10,@PC00001+8 0019 00051000 L @10,BUFP(,@10) 0019 00052000 LH RFMVLEN,MTBUFLEN(,@10) 0019 00053000 * IF RFMVLEN>F4C THEN /* TEST FOR MESSAGE PRESENT */ 00054000 LA @10,4 0020 00055000 CR RFMVLEN,@10 0020 00056000 BNH @RF00020 0020 00057000 * DO; /* MESSAGE IS PRESENT */ 00058000 * RFMVLEN=MIN(RFMVLEN-(LENGTH(MTBUFLEN)+LENGTH(MTBUFOFF)),LENGTH( 00059000 * MTBUFTXT)-LENGTH(CARRC));/* ADJUST MOVE LENGTH FOR TEXT 00060000 * PLUS CARRIAGE CONTROL 0022 00061000 * CHARACTER AND TRUNCATE TO 0022 00062000 * MAXIMUM MESSAGE LENGTH */ 00063000 LCR @10,@10 0022 00064000 ALR @10,RFMVLEN 0022 00065000 LA @04,250 0022 00066000 CR @10,@04 0022 00067000 BNH *+6 00068000 LR @10,@04 0022 00069000 LR RFMVLEN,@10 0022 00070000 * RFMFLEN=(RFMVLEN+LENGTH(MSGDPRF)+LENGTH(MSGDNXT)+LENGTH(MSGDLEN 00071000 * )+LENGTH(MSGDPAD)+LENGTH(CARRC)+F7C)&XDWBDYC;/* CALCULATE 00072000 * GETMAIN LENGTH */ 00073000 LA RFMFLEN,24 0023 00074000 ALR RFMFLEN,RFMVLEN 0023 00075000 N RFMFLEN,@CF00319 0023 00076000 * DO; /* GETMAIN (RC) LV(RFMFLEN) 0024 00077000 * SP(ZZZSPEXC) RTCD(SUBCODE) */ 00078000 * RESPECIFY 0025 00079000 * (GPR01F, 0025 00080000 * GPR15F, 0025 00081000 * GPR00F) RESTRICTED; 0025 00082000 * GPR01F=0; /* REG 1 MUST BE ZERO */ 00083000 SLR GPR01F,GPR01F 0026 00084000 * GPR15F=0; /* RC-TYPE GETMAIN */ 00085000 SLR GPR15F,GPR15F 0027 00086000 * GPR00F=RFMFLEN; /* LENGTH REQUESTED */ 00087000 LR GPR00F,RFMFLEN 0028 00088000 * GPR15F=GPR15F|((ZZZSPEXC)*256);/* SP IN BYTE 2 */ 00089000 O GPR15F,@CF00326 0029 00090000 * SVC(120); /* RC/RU-FORM OF GETMAIN */ 00091000 SVC 120 0030 00092000 * SUBCODE=GPR15F; /* SET RETURN CODE */ 00093000 ST GPR15F,SUBCODE 0031 00094000 * RESPECIFY 0032 00095000 * (GPR01F, 0032 00096000 * GPR15F, 0032 00097000 * GPR00F) UNRESTRICTED; 0032 00098000 * END; /* GETMAIN (RC) LV(RFMFLEN) 0033 00099000 * SP(ZZZSPEXC) RTCD(SUBCODE) 0033 00100000 * SPACE FOR TEXT LINE */ 00101000 * RFY 0034 00102000 * GPR01P RSTD; 0034 00103000 * RFMSGP=GPR01P; /* ADDRESS OF TEXT LINE */ 00104000 ST GPR01P,RFMSGP 0035 00105000 * RFY 0036 00106000 * GPR01P UNRSTD; 0036 00107000 * IF SUBCODE^=0 THEN /* TEST FOR GETMAIN ERROR */ 00108000 L @10,SUBCODE 0037 00109000 LTR @10,@10 0037 00110000 BZ @RF00037 0037 00111000 * DO; /* GETMAIN FAILED */ 00112000 * RETCODE=SEVERE; /* NOTIFY CALLER */ 00113000 MVC RETCODE(4),@CF00054 0039 00114000 * CALL BLSCGMF(DMCB,ANCH,MODNAME);/* BUILD GETMAIN FAILURE 00115000 * MESSAGE */ 00116000 ST DMCBPTR,@AL00001 0040 00117000 L @10,@PC00001+4 0040 00118000 ST @10,@AL00001+4 0040 00119000 LA @10,MODNAME 0040 00120000 ST @10,@AL00001+8 0040 00121000 L @15,@CV00300 0040 00122000 LA @01,@AL00001 0040 00123000 BALR @14,@15 0040 00124000 * END; /* GETMAIN FAILED */ 00125000 * ELSE 0042 00126000 * DO; /* GETMAIN OK */ 00127000 B @RC00037 0042 00128000 @RF00037 DS 0H 0043 00129000 * MSGDSPID=ZZZSPEXC; /* SUBPOOL ID FOR FREEMAIN */ 00130000 L @10,RFMSGP 0043 00131000 MVI MSGDSPID(@10),X'01' 0043 00132000 * MSGDFLEN=RFMFLEN; /* MESSAGE FREEMAIN LENGTH */ 00133000 STCM RFMFLEN,7,MSGDFLEN(@10) 0044 00134000 * MSGDBAK=RFMSGP; /* MESSAGE BACK CHAIN */ 00135000 ST @10,MSGDBAK(,@10) 0045 00136000 * MSGDNXT=F0C; /* MARK END OF MESSAGE CHAIN */ 00137000 SLR @06,@06 0046 00138000 ST @06,MSGDNXT(,@10) 0046 00139000 * MSGDLEN=RFMVLEN+LENGTH(MSGDLEN)+LENGTH(MSGDPAD)+LENGTH( 00140000 * CARRC); /* SET MESSAGE LENGTH */ 00141000 LA @04,5 0047 00142000 ALR @04,RFMVLEN 0047 00143000 STH @04,MSGDLEN(,@10) 0047 00144000 * MSGDPAD=F0C; /* ZERO THE MSG PAD */ 00145000 STH @06,MSGDPAD(,@10) 0048 00146000 * MSGDTXT(F1C)=CARRC; /* INSERT CARRIAGE CONTROL 0049 00147000 * CHARACTER */ 00148000 MVI MSGDTXT(@10),C' ' 0049 00149000 * MSGDTXT(F2C:RFMVLEN+F1C)=MTBUFTXT(F1C:RFMVLEN);/* MOVE 0050 00150000 * MESSAGE TO OUTPUT */ 00151000 LR @06,RFMVLEN 0050 00152000 BCTR @06,0 0050 00153000 L @04,@PC00001+8 0050 00154000 L @04,BUFP(,@04) 0050 00155000 EX @06,@SM00339 0050 00156000 * RFMSGP=RFMSGP+LENGTH(MSGDPRF);/* BASE MESSAGE FOR HOOK */ 00157000 AL @10,@CF00052 0051 00158000 ST @10,RFMSGP 0051 00159000 * CALL BLSCHOK(DMCB,ANCH,RFMSGP);/* HOOK MESSAGE TO CHAIN */ 00160000 ST DMCBPTR,@AL00001 0052 00161000 L @10,@PC00001+4 0052 00162000 ST @10,@AL00001+4 0052 00163000 LA @10,RFMSGP 0052 00164000 ST @10,@AL00001+8 0052 00165000 L @15,@CV00301 0052 00166000 LA @01,@AL00001 0052 00167000 BALR @14,@15 0052 00168000 * END; /* GETMAIN OK */ 00169000 * END; /* MESSAGE IS PRESENT */ 00170000 @RC00037 DS 0H 0055 00171000 * RETURN CODE(RETCODE); 0055 00172000 @RF00020 L @10,RETCODE 0055 00173000 L @13,4(,@13) 0055 00174000 L @00,@SIZDATD 0055 00175000 LR @01,@11 0055 00176000 BLSCFREF R,LV=(0),A=(1) 00177000 LR @15,@10 0055 00178000 L @14,12(,@13) 0055 00179000 LM @00,@12,20(@13) 0055 00180000 BR @14 0055 00181000 * 0056 00182000 * /*****************************************************************/ 00183000 * /* */ 00184000 * /* PROCEDURE STATEMENTS END */ 00185000 * /* */ 00186000 * /*****************************************************************/ 00187000 * 0056 00188000 */*BLSUPEND--MVS IPCS MODULE */ 00189000 * 0056 00190000 * DECLARE /* GENERAL PURPOSE REGISTERS */ 00191000 * GPR00F FIXED(31) REG(0), 0056 00192000 * GPR01F FIXED(31) REG(1), 0056 00193000 * GPR15F FIXED(31) REG(15), 0056 00194000 * GPR01P PTR(31) REG(1); 0056 00195000 * DECLARE /* COMMON VARIABLES */ 00196000 * I256C CHAR(256) BASED, 0057 00197000 * I031F FIXED(31) BASED, 0057 00198000 * I031P PTR(31) BASED, 0057 00199000 * I015F FIXED(15) BASED, 0057 00200000 * I015P PTR(15) BASED, 0057 00201000 * I008P PTR(8) BASED, 0057 00202000 * I001C CHAR(1) BASED; 0057 00203000 * GENERATE NODEFS NOREFS DATA; 0058 00204000 * END /* BLRPEND THATS ALL FOLKS */ 00205000 * 0059 00206000 */* THE FOLLOWING INCLUDE STATEMENTS WERE FOUND IN THIS PROGRAM. */ 00207000 */*%INCLUDE SYSLIB (BLSDMSGD) */ 00208000 * 0059 00209000 * ; 0059 00210000 @EL00001 L @13,4(,@13) 0059 00211000 @EF00001 L @00,@SIZDATD 0059 00212000 LR @01,@11 0059 00213000 BLSCFREF R,LV=(0),A=(1) 00214000 @ER00001 LM @14,@12,12(@13) 0059 00215000 BR @14 0059 00216000 @DATA DS 0H 00217000 @SM00339 MVC MSGDTXT+1(0,@10),MTBUFTXT(@04) 00218000 @DATD DSECT 00219000 DS 0F 00220000 @SA00001 DS 18F 00221000 @PC00001 DS 3F 00222000 @AL00001 DS 3A 00223000 BLSCRFM CSECT 00224000 DS 0F 00225000 @CF00052 DC F'8' 00226000 @CF00054 DC F'12' 00227000 @CF00326 DC F'256' 00228000 @CF00319 DC XL4'FFFFFFF8' 00229000 @DATD DSECT 00230000 DS 0D 00231000 RFMSGP DS A 00232000 MODSTAT DS CL16 00233000 ORG MODSTAT 00234000 MODNAME DS CL8 00235000 RETCODE DS FL4 00236000 SUBCODE DS FL4 00237000 ORG MODSTAT+16 00238000 BLSCRFM CSECT 00239000 DS 0F 00240000 @SIZDATD DC AL1(0) 00241000 DC AL3(@ENDDATD-@DATD) 00242000 @CV00300 DC V(BLSCGMF) 00243000 @CV00301 DC V(BLSCHOK) 00244000 DS 0D 00245000 @CC00317 DC C'BLSCRFM ' 00246000 @DATD DSECT 00247000 SPACE 2 00248000 *********************************************************************** 00249000 * THE FOLLOWING AREA, BLRPATCH, IS RESERVED FOR PATCH APPLICATION * 00250000 * TO OBTAIN PATCH ROOM IN THE @DATD AUTOMATIC STORAGE AREA, MODIFY * 00251000 * CONSTANT @SIZDATD TO REFLECT THE DESIRED @DATD SIZE * 00252000 *********************************************************************** 00253000 SPACE 00254000 BLSCRFM CSECT 00255000 ORG 00256000 DS 0D 00257000 BLRPATCH DC CL8'ZAPAREA',(((*-BLSCRFM+19)/20+7)/8)CL8'BLSCRFM' 00258000 @DATD DSECT 00259000 SPACE 2 00260000 *********************************************************************** 00261000 * ALIGN END OF DATA ON A DOUBLEWORD BOUNDARY * 00262000 *********************************************************************** 00263000 SPACE 00264000 DS 0D 00265000 @DATD DSECT 00266000 ORG *+1-(*-@DATD)/(*-@DATD) INSURE DSECT DATA 00267000 @ENDDATD EQU * 00268000 BLSCRFM CSECT 00269000 @00 EQU 00 EQUATES FOR REGISTERS 0-15 00270000 @01 EQU 01 00271000 @02 EQU 02 00272000 @03 EQU 03 00273000 @04 EQU 04 00274000 @05 EQU 05 00275000 @06 EQU 06 00276000 @07 EQU 07 00277000 @08 EQU 08 00278000 @09 EQU 09 00279000 @10 EQU 10 00280000 @11 EQU 11 00281000 @12 EQU 12 00282000 @13 EQU 13 00283000 @14 EQU 14 00284000 @15 EQU 15 00285000 RFMFLEN EQU @06 00286000 RFMVLEN EQU @05 00287000 DMCBPTR EQU @07 00288000 GPR01F EQU @01 00289000 GPR15F EQU @15 00290000 GPR00F EQU @00 00291000 GPR01P EQU @01 00292000 DMCB EQU 0 00293000 DMCBFTY EQU DMCB+20 00294000 DMCBOPN EQU DMCB+21 00295000 DMCBRMOD EQU DMCB+23 00296000 DMCBOUT EQU DMCBRMOD 00297000 DMCBOPTS EQU DMCB+24 00298000 DMCBGKY EQU DMCBOPTS 00299000 DMCBMFLG EQU DMCB+28 00300000 DMCBBUFP EQU DMCB+32 00301000 DMCBKEYP EQU DMCB+44 00302000 DMCBRI EQU DMCB+64 00303000 DMCBFRE EQU DMCB+88 00304000 DMCBEOB EQU DMCB+92 00305000 DMCBACBE EQU DMCB+124 00306000 DMCBSPEC EQU DMCB+380 00307000 DMCBAMS EQU DMCB+416 00308000 DMCBAUDT EQU DMCB+568 00309000 DMCBLSCP EQU DMCBAUDT+16 00310000 MSGDENT EQU 0 00311000 MSGDPRF EQU MSGDENT 00312000 MSGDSPID EQU MSGDPRF 00313000 MSGDFLEN EQU MSGDPRF+1 00314000 MSGDBAK EQU MSGDPRF+4 00315000 MSGDWRT EQU MSGDENT+8 00316000 MSGDNXT EQU MSGDWRT 00317000 MSGDMOV EQU MSGDWRT+4 00318000 MSGDLEN EQU MSGDMOV 00319000 MSGDPAD EQU MSGDMOV+2 00320000 MSGDTXT EQU MSGDMOV+4 00321000 MSGWENT EQU 0 00322000 MSGWMOV EQU MSGWENT+4 00323000 MTBUF EQU 0 00324000 MTBUFLEN EQU MTBUF 00325000 MTBUFOFF EQU MTBUF+2 00326000 MTBUFTXT EQU MTBUF+4 00327000 DMCBDMGR EQU 0 00328000 DMCBRQC EQU 0 00329000 I001C EQU 0 00330000 I008P EQU 0 00331000 I015F EQU 0 00332000 I015P EQU 0 00333000 I031F EQU 0 00334000 I031P EQU 0 00335000 I256C EQU 0 00336000 DMCBPARM EQU 0 00337000 ANCH EQU 0 00338000 BUFP EQU 0 00339000 DMCBVSM EQU DMCBAMS 00340000 DMCBQSM EQU DMCBAMS 00341000 AGO .@UNREFD START UNREFERENCED COMPONENTS 00342000 DMCBRES7 EQU DMCBQSM+96 00343000 DMCBDCB EQU DMCBQSM 00344000 DMCBACB EQU DMCBVSM+76 00345000 DMCBRPL EQU DMCBVSM 00346000 MSGWTXT EQU MSGWMOV+4 00347000 MSGWPAD EQU MSGWMOV+2 00348000 MSGWLEN EQU MSGWMOV 00349000 MSGWNXT EQU MSGWENT 00350000 DMCBWRK EQU DMCB+648 00351000 DMCBRES8 EQU DMCB+640 00352000 DMCBMODN EQU DMCB+632 00353000 DMCBCARY EQU DMCBAUDT+20 00354000 DMCBCLC EQU DMCBAUDT+12 00355000 DMCBOPC EQU DMCBAUDT+8 00356000 DMCBFRC EQU DMCBAUDT+4 00357000 DMCBALC EQU DMCBAUDT 00358000 DMCBFR EQU DMCB+412 00359000 DMCBRES6 EQU DMCB+410 00360000 DMCBIRSC EQU DMCB+408 00361000 DMCBSUBC EQU DMCB+404 00362000 DMCBDRBP EQU DMCB+400 00363000 DMCBRSZM EQU DMCB+398 00364000 DMCBRSZA EQU DMCB+396 00365000 DMCBCISZ EQU DMCB+394 00366000 DMCBDCBL EQU DMCB+392 00367000 DMCBDCLR EQU DMCB+390 00368000 DMCBDCFM EQU DMCB+389 00369000 DMCBRES5 EQU DMCB+388 00370000 DMCBLBRT EQU DMCB+386 00371000 DMCBLBSQ EQU DMCB+384 00372000 DMCBLBPS EQU DMCB+383 00373000 DMCBLBTY EQU DMCB+382 00374000 DMCBRES4 EQU DMCB+381 00375000 DMCBSPRS EQU DMCBSPEC 00376000 DMCBSPRN EQU DMCBSPEC 00377000 DMCBSPCT EQU DMCBSPEC 00378000 DMCBSPRL EQU DMCBSPEC 00379000 DMCBSPSE EQU DMCB+376 00380000 DMCBSPPR EQU DMCB+372 00381000 DMCBSPTY EQU DMCB+369 00382000 DMCBODIS EQU DMCB+368 00383000 DMCBDISP EQU DMCB+367 00384000 DMCBSTAT EQU DMCB+366 00385000 DMCBRES3 EQU DMCB+364 00386000 DMCBMEMB EQU DMCB+356 00387000 DMCBMODL EQU DMCB+348 00388000 DMCBRES9 EQU DMCB+340 00389000 DMCBPID EQU DMCB+332 00390000 DMCBTYPE EQU DMCB+328 00391000 DMCBDSN EQU DMCB+284 00392000 DMCBUNIT EQU DMCB+276 00393000 DMCBDSOR EQU DMCB+274 00394000 DMCBVOL EQU DMCB+268 00395000 DMCBDDNM EQU DMCB+260 00396000 DMCBSYNM EQU DMCB+132 00397000 DMCBRPLF EQU DMCB+128 00398000 DMCBDCBE EQU DMCBACBE 00399000 DMCBARC EQU DMCB+120 00400000 DMCBCPC EQU DMCB+116 00401000 DMCBRET EQU DMCB+112 00402000 DMCBSTL EQU DMCB+96 00403000 DMCBRES2 EQU DMCB+85 00404000 DMCBSPID EQU DMCB+84 00405000 DMCBRESC EQU DMCB+80 00406000 DMCBZZ1P EQU DMCB+76 00407000 DMCBMSGS EQU DMCB+72 00408000 DMCBMSG0 EQU DMCB+68 00409000 DMCBRRL EQU DMCB+60 00410000 DMCBRBA EQU DMCB+56 00411000 DMCBMSG EQU DMCB+52 00412000 DMCBKEYL EQU DMCB+48 00413000 DMCBKPC EQU DMCBKEYP 00414000 DMCBORL EQU DMCB+40 00415000 DMCBBLEN EQU DMCB+36 00416000 DMCBBFPC EQU DMCBBUFP 00417000 DMCBRES1 EQU DMCB+31 00418000 DMCBACCM EQU DMCB+30 00419000 DMCBREJ EQU DMCB+29 00420000 DMCBRESB EQU DMCBMFLG 00421000 DMCBFMOD EQU DMCBMFLG 00422000 DMCBLOPT EQU DMCB+27 00423000 DMCBLRM EQU DMCB+26 00424000 DMCBLRQ EQU DMCB+25 00425000 DMCBOPRS EQU DMCBOPTS 00426000 DMCBLRD EQU DMCBOPTS 00427000 DMCBBWD EQU DMCBOPTS 00428000 DMCBUPD EQU DMCBOPTS 00429000 DMCBAPX EQU DMCBOPTS 00430000 DMCBRNO EQU DMCBGKY 00431000 DMCBKYD EQU DMCBOPTS 00432000 DMCBRMRS EQU DMCBRMOD 00433000 DMCBRM5 EQU DMCBRMOD 00434000 DMCBRM6 EQU DMCBRMOD 00435000 DMCBTMP EQU DMCBOUT 00436000 DMCBRQST EQU DMCB+22 00437000 DMCBRESA EQU DMCBOPN 00438000 DMCBSOUT EQU DMCBOPN 00439000 DMCBSIN EQU DMCBOPN 00440000 DMCBVSF EQU DMCBFTY 00441000 DMCBKSF EQU DMCBFTY 00442000 DMCBFTRS EQU DMCBFTY 00443000 DMCBSHF EQU DMCBFTY 00444000 DMCBIRL EQU DMCB+16 00445000 DMCBRTC EQU DMCB+12 00446000 DMCBTVP EQU DMCB+8 00447000 DMCBNEXT EQU DMCB+4 00448000 DMCBID EQU DMCB 00449000 .@UNREFD ANOP END UNREFERENCED COMPONENTS 00450000 @ENDDATA EQU * 00451000 END BLSCRFM,(C'PLS1942',0701,78062) 00452000