TITLE 'IKJEFT56, TERMINAL OUTPUT ROUTINE ' 00001000 IKJEFT56 CSECT , 0001 00002000 @MAINENT DS 0H 0001 00003000 USING *,@15 0001 00004000 B @PROLOG 0001 00005000 DC AL1(16) 0001 00006000 DC C'IKJEFT56 73.151' 0001 00007000 DROP @15 00008000 @PROLOG STM @14,@12,12(@13) 0001 00009000 BALR @12,0 0001 00010000 @PSTART DS 0H 0001 00011000 USING @PSTART,@12 0001 00012000 L @00,@SIZDATD 0001 00013000 GETMAIN R,LV=(0) 00014000 LR @11,@01 0001 00015000 USING @DATD,@11 0001 00016000 ST @13,@SA00001+4 0001 00017000 LM @00,@01,20(@13) 0001 00018000 ST @11,8(,@13) 0001 00019000 LR @13,@11 0001 00020000 MVC @PC00001(16),0(@01) 0001 00021000 * 0017 00022000 * /*****************************************************************/ 00023000 * /* */ 00024000 * /* START EXECUTABLE CODE */ 00025000 * /* */ 00026000 * /*****************************************************************/ 00027000 * 0017 00028000 * SAVEREG1=R1; /* SAVE REGISTER ONE */ 00029000 LR SAVEREG1,R1 0017 00030000 * PTPBPTR=PTPBPTRX; /* ESTABLISH REG POINTER */ 00031000 L PTPBPTR,PTPBPTRX(,R1) 0018 00032000 * IF TPUTTGET='1'B THEN /* IF TGET IS INDICATED */ 00033000 TM TPUTTGET(PTPBPTR),B'10000000' 0019 00034000 BO @RT00019 0019 00035000 * GOTO INVALID; 0020 00036000 * TPUTOPTN=PARMOPTN; /* FILL IN TPUT OPTON BYTE */ 00037000 MVC TPUTOPTN(1),PARMOPTN(PTPBPTR) 0021 00038000 * APOINTR=0; /* ZERO OUT TEMP POINTER */ 00039000 SR @14,@14 0022 00040000 ST @14,APOINTR 0022 00041000 * IF PARMMLIN='1'B THEN /* IS MULTILINE BIT ON ? */ 00042000 TM PARMMLIN(PTPBPTR),B'00001000' 0023 00043000 BNO @RF00023 0023 00044000 * DO; 0024 00045000 *MULTLINE: 0025 00046000 * APOINTR=CHAINPTR; /* POINT TO NEXT LINE */ 00047000 MULTLINE L @14,PARMAOUT(,PTPBPTR) 0025 00048000 MVC APOINTR(4),CHAINPTR(@14) 0025 00049000 * IF PARMDTMS='1'B THEN /* IF THIS IS A DATA */ 00050000 TM PARMDTMS(PTPBPTR),B'00100000' 0026 00051000 BO @RT00026 0026 00052000 * GOTO MDATA; 0027 00053000 * MSGLEN=PARMAOUT->CHAINLL-4; /* CALCULATE TEXT LENGTH */ 00054000 LH MSGLEN,CHAINLL(,@14) 0028 00055000 SH MSGLEN,@CH00164 0028 00056000 * DO MSGIDLEN=1 TO MSGLEN; /* SEARCH FOR FIRST BLANK */ 00057000 LA MSGIDLEN,1 0029 00058000 B @DE00029 0029 00059000 @DL00029 DS 0H 0030 00060000 * IF PARMAOUT->CHAINTXT(MSGIDLEN)=' ' THEN 0030 00061000 L @14,PARMAOUT(,PTPBPTR) 0030 00062000 ALR @14,MSGIDLEN 0030 00063000 CLI CHAINTXT-1(@14),C' ' 0030 00064000 BE @RT00030 0030 00065000 * GOTO CONTINUE; /* IF BLANK IS FOUND EXIT */ 00066000 * END; /* END MSG-ID LENGTH LOOP */ 00067000 AH MSGIDLEN,@CH00036 0032 00068000 @DE00029 CR MSGIDLEN,MSGLEN 0032 00069000 BNH @DL00029 0032 00070000 * GOTO INVALID; /* IF NO BLANK FOUND */ 00071000 B INVALID 0033 00072000 *CONTINUE: 0034 00073000 * IF MSGIDLEN=1 THEN /* IF NO MSG ID INDICATION */ 00074000 CONTINUE CH MSGIDLEN,@CH00036 0034 00075000 BE @RT00034 0034 00076000 * GOTO STRIPID1; 0035 00077000 * IF UPTMID='1'B THEN /* IF NO MESSAGE I.D. */ 00078000 L @14,UPTPTR(,R1) 0036 00079000 TM UPTMID(@14),B'00100000' 0036 00080000 BNO @RF00036 0036 00081000 * DO; /* STRIPPING IS REQUESTED. */ 00082000 *MDATA: 0038 00083000 * LENGTH=CHAINLL-4; /* USE LENGTH IN HEADER-4 */ 00084000 MDATA L @14,PARMAOUT(,PTPBPTR) 0038 00085000 LH @10,CHAINLL(,@14) 0038 00086000 SH @10,@CH00164 0038 00087000 ST @10,LENGTH 0038 00088000 * TBUFADR=PARMAOUT+(4+4); /* TEXT BEGINS 8 BYTES BEGINNING 00089000 * OF CHAINELEM */ 00090000 AH @14,@CH00069 0039 00091000 STCM @14,7,TBUFADR 0039 00092000 * GOTO SETUPPUT; 0040 00093000 B SETUPPUT 0040 00094000 * END; /* END NO-STRIP PROCESSING */ 00095000 *STRIPID1: 0042 00096000 * LENGTH=CHAINLL-(4+MSGIDLEN);/* LENGTH OF OUTPUT LINE = THE 0042 00097000 * LENGTH OF ENTIRE RECORD - THE 00098000 * THE LENGTH OF THE MSG-ID + 4 */ 00099000 @RF00036 DS 0H 0042 00100000 STRIPID1 L @14,PARMAOUT(,PTPBPTR) 0042 00101000 LA @10,4 0042 00102000 AR @10,MSGIDLEN 0042 00103000 LCR @10,@10 0042 00104000 AH @10,CHAINLL(,@14) 0042 00105000 ST @10,LENGTH 0042 00106000 * TBUFADR=PARMAOUT+(4+4+MSGIDLEN);/* THE ADDRESS OF THE OUT PUT 00107000 * LINE = THE ADDRESS OF THE 0043 00108000 * CHAIN ELEMENT + THE LENGTH OF 00109000 * THE CHAIN FORWARD POINTER + 0043 00110000 * THE LENGTH OF THE MSG-ID + 4 00111000 * (HEADR OF VRIABLE RCRD */ 00112000 LA @10,8 0043 00113000 AR @10,MSGIDLEN 0043 00114000 AR @14,@10 0043 00115000 STCM @14,7,TBUFADR 0043 00116000 * GOTO SETUPPUT; 0044 00117000 * 0044 00118000 B SETUPPUT 0044 00119000 * /*************************************************************/ 00120000 * /* */ 00121000 * /* END STRIP ID PROCESSING */ 00122000 * /* */ 00123000 * /*************************************************************/ 00124000 * 0045 00125000 * END; /* END MULT-LINE PROCESING */ 00126000 * IF PARMDTMS='1'B THEN /* IF THIS IS A DATA LINE */ 00127000 @RF00023 TM PARMDTMS(PTPBPTR),B'00100000' 0046 00128000 BO @RT00046 0046 00129000 * GOTO DATALINE; 0047 00130000 * 0047 00131000 * /*****************************************************************/ 00132000 * /* */ 00133000 * /* SINGLE LEVEL MESSAGE PROCESSING */ 00134000 * /* */ 00135000 * /*****************************************************************/ 00136000 * 0048 00137000 * MSGLEN=PARMAOUT->MSGLL-4; 0048 00138000 L @14,PARMAOUT(,PTPBPTR) 0048 00139000 LH MSGLEN,MSGLL(,@14) 0048 00140000 SH MSGLEN,@CH00164 0048 00141000 * DO MSGIDLEN=1 TO MSGLEN; /* FIND FIRST BLANK */ 00142000 LA MSGIDLEN,1 0049 00143000 B @DE00049 0049 00144000 @DL00049 DS 0H 0050 00145000 * IF PARMAOUT->MSGTEXT(MSGIDLEN)=' ' THEN/* BLANK FOUND BRANCH */ 00146000 L @14,PARMAOUT(,PTPBPTR) 0050 00147000 ALR @14,MSGIDLEN 0050 00148000 CLI MSGTEXT-1(@14),C' ' 0050 00149000 BE @RT00050 0050 00150000 * GOTO CONTINU2; 0051 00151000 * END; /* END DETERMINE LENGTH LOOP */ 00152000 AH MSGIDLEN,@CH00036 0052 00153000 @DE00049 CR MSGIDLEN,MSGLEN 0052 00154000 BNH @DL00049 0052 00155000 * GOTO INVALID; /* IF NO BLANK IS FOUND */ 00156000 B INVALID 0053 00157000 *CONTINU2: 0054 00158000 * IF MSGIDLEN=1 THEN 0054 00159000 CONTINU2 CH MSGIDLEN,@CH00036 0054 00160000 BE @RT00054 0054 00161000 * GOTO STRIPID; 0055 00162000 * IF UPTMID='0'B THEN /* DISPLAY ID BIT OFF */ 00163000 L @14,UPTPTR(,R1) 0056 00164000 TM UPTMID(@14),B'00100000' 0056 00165000 BNZ @RF00056 0056 00166000 * DO; 0057 00167000 *STRIPID: 0058 00168000 * LENGTH=MSGLL-(4+MSGIDLEN); /* LENGTH OF OUTPUT LINE = LENGHT 00169000 * OF MESSAGE BUFFER - THE LENGTH 00170000 * OF THE MSG ID + 4 */ 00171000 STRIPID L @14,PARMAOUT(,PTPBPTR) 0058 00172000 LA @10,4 0058 00173000 AR @10,MSGIDLEN 0058 00174000 LH @04,MSGLL(,@14) 0058 00175000 SR @04,@10 0058 00176000 ST @04,LENGTH 0058 00177000 * TBUFADR=PARMAOUT+(4+MSGIDLEN);/* ADDRESS OF THE OUTPUT LINE = 00178000 * ADDRESS OF MSG BUFFER + THE 0059 00179000 * LENGTH OF THE MSGID + 4 */ 00180000 AR @14,@10 0059 00181000 STCM @14,7,TBUFADR 0059 00182000 * GOTO SETUPPUT; 0060 00183000 B SETUPPUT 0060 00184000 * END; 0061 00185000 * 0061 00186000 * /*****************************************************************/ 00187000 * /* */ 00188000 * /* NO MESSAGE I.D. STRIPPING REQUIRED */ 00189000 * /* */ 00190000 * /*****************************************************************/ 00191000 * 0062 00192000 * ELSE 0062 00193000 * DO; 0062 00194000 @RF00056 DS 0H 0063 00195000 *DATALINE: 0063 00196000 * LENGTH=MSGLL-4; /* LENGTH OF OUTPUT LINE = LENGTH 00197000 * OF OUTPUT RECORD - 4 */ 00198000 DATALINE LA @14,4 0063 00199000 L @10,PARMAOUT(,PTPBPTR) 0063 00200000 LH @04,MSGLL(,@10) 0063 00201000 SR @04,@14 0063 00202000 ST @04,LENGTH 0063 00203000 * TBUFADR=PARMAOUT+4; /* ADDRESS OF OUTPUT LINE = 0064 00204000 * ADDRESS OF OUTPUT RECORD + 4 */ 00205000 AR @10,@14 0064 00206000 STCM @10,7,TBUFADR 0064 00207000 * END; 0065 00208000 *SETUPPUT: 0066 00209000 * IF ECBCBIT='1'B THEN /* FLUSH BIT ON */ 00210000 SETUPPUT L @14,@PC00001+8 0066 00211000 TM ECBCBIT(@14),B'01000000' 0066 00212000 BNO @RF00066 0066 00213000 * DO; 0067 00214000 * RETURNCD=4; /* SET RETURN CODE */ 00215000 LA RETURNCD,4 0068 00216000 * GOTO EXIT; 0069 00217000 B EXIT 0069 00218000 * END; 0070 00219000 * IF INSOTDD='1'B THEN /* IF IN BACKGROUND MODE */ 00220000 @RF00066 L @14,ECTPTR(,R1) 0071 00221000 L @10,ECTIOWA(,@14) 0071 00222000 L @10,IOSTELM(,@10) 0071 00223000 TM INSOTDD(@10),B'00010000' 0071 00224000 BNO @RF00071 0071 00225000 * CALL IKJRBBMC(TBUFADR,LENGTH,ECT,1); 0072 00226000 LA @10,TBUFADR 0072 00227000 ST @10,@AL00001 0072 00228000 LA @10,LENGTH 0072 00229000 ST @10,@AL00001+4 0072 00230000 ST @14,@AL00001+8 0072 00231000 LA @14,@CF00036 0072 00232000 ST @14,@AL00001+12 0072 00233000 L @15,@CV00181 0072 00234000 LA @01,@AL00001 0072 00235000 BALR @14,@15 0072 00236000 * ELSE 0073 00237000 * DO; 0073 00238000 B @RC00071 0073 00239000 @RF00071 DS 0H 0074 00240000 * R0=LENGTH; /* FILL IN PARM REGISTERS */ 00241000 L R0,LENGTH 0074 00242000 * R1=TPUTPARM; 0075 00243000 L R1,TPUTPARM 0075 00244000 * GEN(TPUT (1),(0),R); /* TPUT LINE TO TERMINAL */ 00245000 TPUT (1),(0),R 00246000 * END; 0077 00247000 * TPUTCODE=R15; /* SAVE RETURN CODE */ 00248000 @RC00071 LR TPUTCODE,R15 0078 00249000 * R1=SAVEREG1; /* RESTORE PARM REG */ 00250000 LR R1,SAVEREG1 0079 00251000 * IF TPUTCODE^=0 /* IF ERROR FROM TPUT Y02996*/ 00252000 * THEN 0080 00253000 LTR TPUTCODE,TPUTCODE 0080 00254000 BZ @RF00080 0080 00255000 * DO; 0081 00256000 * IF TPUTCODE=8 /* ATTN INTERRUPT Y02996*/ 00257000 * THEN 0082 00258000 CH TPUTCODE,@CH00069 0082 00259000 BNE @RF00082 0082 00260000 * DO; 0083 00261000 * RETURNCD=4; /* SET ATTN RETURNCD Y02996*/ 00262000 LA RETURNCD,4 0084 00263000 * GO TO EXIT; /* END Y02996*/ 00264000 B EXIT 0085 00265000 * END; 0086 00266000 * IF TPUTCODE=4 THEN /* NO WAIT ERROR */ 00267000 @RF00082 CH TPUTCODE,@CH00164 0087 00268000 BNE @RF00087 0087 00269000 * DO; 0088 00270000 * RETURNCD=8; /* INDICATE NOWAIT ERROR */ 00271000 LA RETURNCD,8 0089 00272000 * GOTO EXIT; 0090 00273000 B EXIT 0090 00274000 * END; 0091 00275000 * IF TPUTCODE=20 /* IF LINEDROP SET Y02996*/ 00276000 * THEN 0092 00277000 @RF00087 LA @14,20 0092 00278000 CR TPUTCODE,@14 0092 00279000 BNE @RF00092 0092 00280000 * RETURNCD=20; /* LINEDROP RC Y02996*/ 00281000 LR RETURNCD,@14 0093 00282000 * ELSE /* ELSE SET INVAL Y02996*/ 00283000 *INVALID: 0094 00284000 * RETURNCD=12; /* PARMS RC Y02996*/ 00285000 B @RC00092 0094 00286000 @RF00092 DS 0H 0094 00287000 INVALID LA RETURNCD,12 0094 00288000 * GOTO EXIT; /* END Y02996*/ 00289000 B EXIT 0095 00290000 * END; 0096 00291000 * IF APOINTER^=0 THEN /* END OF MULTI-LINE CHAIN */ 00292000 @RF00080 ICM @14,7,APOINTER 0097 00293000 BZ @RF00097 0097 00294000 * DO; 0098 00295000 * PARMAOUT=APOINTR; /* POINT TO NEXT LINE */ 00296000 MVC PARMAOUT(4,PTPBPTR),APOINTR 0099 00297000 * GOTO MULTLINE; 0100 00298000 B MULTLINE 0100 00299000 * END; 0101 00300000 * RETURNCD=0; /* INDICATE NORMAL END */ 00301000 @RF00097 SR RETURNCD,RETURNCD 0102 00302000 *EXIT: 0103 00303000 * RETURN CODE(RETURNCD); 0103 00304000 EXIT L @13,4(,@13) 0103 00305000 L @00,@SIZDATD 0103 00306000 LR @01,@11 0103 00307000 FREEMAIN R,LV=(0),A=(1) 00308000 LR @15,@02 0103 00309000 L @14,12(,@13) 0103 00310000 LM @00,@12,20(@13) 0103 00311000 BR @14 0103 00312000 * END IKJEFT56 0104 00313000 * 0104 00314000 */* THE FOLLOWING INCLUDE STATEMENTS WERE FOUND IN THIS PROGRAM. */ 00315000 */*%INCLUDE SYSLIB (IKJUPT ) */ 00316000 */*%INCLUDE SYSLIB (IKJECT ) */ 00317000 * 0104 00318000 * ; 0104 00319000 @DATA DS 0H 00320000 @CH00164 DC H'4' 00321000 @CH00069 DC H'8' 00322000 @DATD DSECT 00323000 DS 0F 00324000 @SA00001 DS 18F 00325000 @PC00001 DS 4F 00326000 @AL00001 DS 4A 00327000 IKJEFT56 CSECT 00328000 DS 0F 00329000 @CF00036 DC F'1' 00330000 @CH00036 EQU @CF00036+2 00331000 @DATD DSECT 00332000 DS 0D 00333000 TPUTPARM DS AL4 00334000 ORG TPUTPARM 00335000 TPUTOPTN DS AL1 00336000 TBUFADR DS AL3 00337000 ORG TPUTPARM+4 00338000 APOINTR DS AL4 00339000 ORG APOINTR 00340000 @NM00007 DS AL1 00341000 APOINTER DS AL3 00342000 ORG APOINTR+4 00343000 LENGTH DS F 00344000 ORG *+1-(*-@DATD)/(*-@DATD) INSURE DSECT DATA 00345000 @ENDDATD EQU * 00346000 IKJEFT56 CSECT 00347000 DS 0F 00348000 @SIZDATD DC AL1(1) 00349000 DC AL3(@ENDDATD-@DATD) 00350000 @CV00181 DC V(IKJRBBMC) 00351000 DS 0D 00352000 PATCH DC 10F'0' 00353000 @00 EQU 00 EQUATES FOR REGISTERS 0-15 00354000 @01 EQU 01 00355000 @02 EQU 02 00356000 @03 EQU 03 00357000 @04 EQU 04 00358000 @05 EQU 05 00359000 @06 EQU 06 00360000 @07 EQU 07 00361000 @08 EQU 08 00362000 @09 EQU 09 00363000 @10 EQU 10 00364000 @11 EQU 11 00365000 @12 EQU 12 00366000 @13 EQU 13 00367000 @14 EQU 14 00368000 @15 EQU 15 00369000 RETURNCD EQU @02 00370000 SAVEREG1 EQU @05 00371000 MSGIDLEN EQU @03 00372000 MSGLEN EQU @04 00373000 TPUTCODE EQU @03 00374000 PTPBPTR EQU @02 00375000 R1 EQU @01 00376000 R0 EQU @00 00377000 R15 EQU @15 00378000 XPRMLIST EQU 0 00379000 UPTPTR EQU XPRMLIST 00380000 ECTPTR EQU XPRMLIST+4 00381000 PTPBPTRX EQU XPRMLIST+12 00382000 UPT EQU 0 00383000 UPTSWS EQU UPT+12 00384000 UPTMID EQU UPTSWS 00385000 ECT EQU 0 00386000 ECTIOWA EQU ECT+4 00387000 ECTSWS EQU ECT+28 00388000 PTPB EQU 0 00389000 PARMCNTL EQU PTPB 00390000 PARMDTMS EQU PARMCNTL 00391000 PARMMLIN EQU PARMCNTL 00392000 PARMTPUT EQU PTPB+2 00393000 PARMOPTN EQU PARMTPUT 00394000 TPUTTGET EQU PARMOPTN 00395000 PARMAOUT EQU PTPB+4 00396000 CHAIN EQU 0 00397000 CHAINPTR EQU CHAIN 00398000 CHAINLL EQU CHAIN+4 00399000 CHAINTXT EQU CHAIN+8 00400000 MESSAGE EQU 0 00401000 MSGLL EQU MESSAGE 00402000 MSGTEXT EQU MESSAGE+4 00403000 IOSRL EQU 0 00404000 IOSTELM EQU IOSRL 00405000 INSTACK EQU 0 00406000 INSCODE EQU INSTACK 00407000 INSOTDD EQU INSCODE 00408000 UPTX EQU 0 00409000 ECTX EQU 0 00410000 ECB EQU 0 00411000 ECBCBIT EQU ECB 00412000 PTPBX EQU 0 00413000 AGO .@UNREFD START UNREFERENCED COMPONENTS 00414000 ECBCOMPC EQU ECB 00415000 ECBWBIT EQU ECB 00416000 INSADLSD EQU INSTACK+1 00417000 INSLIST EQU INSCODE 00418000 INSPROC EQU INSCODE 00419000 INSPROM EQU INSCODE 00420000 INSRSVD EQU INSCODE 00421000 INSINDD EQU INSCODE 00422000 INSSTOR EQU INSCODE 00423000 INSTERM EQU INSCODE 00424000 IOSUNUSD EQU IOSRL+12 00425000 IOSNELM EQU IOSRL+10 00426000 IOSTLEN EQU IOSRL+8 00427000 IOSBELM EQU IOSRL+4 00428000 MSGOO EQU MESSAGE+2 00429000 CHAINOO EQU CHAIN+6 00430000 @NM00006 EQU PARMTPUT+1 00431000 PARMFORM EQU PARMCNTL+1 00432000 PARMDMND EQU PARMCNTL+1 00433000 PARMMODE EQU PARMCNTL+1 00434000 PARMPRMT EQU PARMCNTL 00435000 PARMIFOR EQU PARMCNTL 00436000 PARMMLEV EQU PARMCNTL 00437000 PARMSNGL EQU PARMCNTL 00438000 PARMPUT EQU PARMCNTL 00439000 PARMPBT0 EQU PARMCNTL 00440000 ECTBKPB EQU ECT+36 00441000 ECTUSER EQU ECT+32 00442000 ECTDDNUM EQU ECT+29 00443000 @NM00005 EQU ECTSWS 00444000 ECTBKGRD EQU ECTSWS 00445000 ECTNNOT EQU ECTSWS 00446000 ECTNMAL EQU ECTSWS 00447000 ECTLOGF EQU ECTSWS 00448000 ECTATRM EQU ECTSWS 00449000 @NM00004 EQU ECTSWS 00450000 ECTNOPD EQU ECTSWS 00451000 ECTSCMD EQU ECT+20 00452000 ECTPCMD EQU ECT+12 00453000 ECTSMSG EQU ECT+9 00454000 ECTMSGF EQU ECT+8 00455000 ECTRTCD EQU ECT+1 00456000 ECTRCDF EQU ECT 00457000 UPTPREFL EQU UPT+23 00458000 UPTPREFX EQU UPT+16 00459000 @NM00003 EQU UPT+15 00460000 UPTLDEL EQU UPT+14 00461000 UPTCDEL EQU UPT+13 00462000 UPTWTP EQU UPTSWS 00463000 UPTMODE EQU UPTSWS 00464000 UPTALD EQU UPTSWS 00465000 UPTPAUS EQU UPTSWS 00466000 UPTNCOM EQU UPTSWS 00467000 UPTNPRM EQU UPTSWS 00468000 @NM00002 EQU UPTSWS 00469000 UPTUSER EQU UPT+2 00470000 @NM00001 EQU UPT 00471000 ECBPTR EQU XPRMLIST+8 00472000 .@UNREFD ANOP END UNREFERENCED COMPONENTS 00473000 @RT00019 EQU INVALID 00474000 @RT00026 EQU MDATA 00475000 @RT00030 EQU CONTINUE 00476000 @RT00034 EQU STRIPID1 00477000 @RT00046 EQU DATALINE 00478000 @RT00050 EQU CONTINU2 00479000 @RT00054 EQU STRIPID 00480000 @RC00092 EQU EXIT 00481000 @ENDDATA EQU * 00482000 END IKJEFT56 00483000