TITLE 'IKJEFT52, CHAIN OUT SUBROUTINE ' 00001000 IKJEFT52 CSECT , 0001 00002000 @MAINENT DS 0H 0001 00003000 USING *,@15 0001 00004000 B @PROLOG 0001 00005000 DC AL1(16) 0001 00006000 DC C'IKJEFT52 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 * 0011 00022000 * /*****************************************************************/ 00023000 * /* */ 00024000 * /* START ECECUTABLE CODE */ 00025000 * /* */ 00026000 * /*****************************************************************/ 00027000 * 0011 00028000 * ECTPTR=XECTPTR; /* SET LOCAL ECT POINTER */ 00029000 L ECTPTR,XECTPTR(,R1) 0011 00030000 * PTPBPTR=XPTPBPTR; /* SET LOCAL PTPB POINTER */ 00031000 L PTPBPTR,XPTPBPTR(,R1) 0012 00032000 * SAVEREG1=R1; /* SAVE REGISTER ONE */ 00033000 LR SAVEREG1,R1 0013 00034000 * SAVEPARM=PARMAOUT; /* SAVE POINTER TO OUTPUT IN PTPB 00035000 * SO THE PTPB CAN BE MODIFIED 0014 00036000 * AND USED FOR TERMINAL OUTPUT 00037000 * OF CHAIN */ 00038000 L SAVEPARM,PARMAOUT(,PTPBPTR) 0014 00039000 * SAVETPUT=PARMOPTN; /* SAVE USERS TPUT OPTIONS */ 00040000 SR SAVETPUT,SAVETPUT 0015 00041000 IC SAVETPUT,PARMOPTN(,PTPBPTR) 0015 00042000 * PARMOPTN=0; /* INDICATE DEFAULT TPUT */ 00043000 MVI PARMOPTN(PTPBPTR),X'00' 0016 00044000 * PARMAOUT=ECTSMSG; /* GET CHAIN POINTER */ 00045000 SR @14,@14 0017 00046000 ICM @14,7,ECTSMSG(ECTPTR) 0017 00047000 ST @14,PARMAOUT(,PTPBPTR) 0017 00048000 * IF ECTMSGF>='80'X| /* IF 2ND LEVEL CHAIN IS FLAGGED 00049000 * FOR DELETION */ 00050000 * PARMAOUT=0 THEN /* OR IF NONE EXISTS THEN */ 00051000 CLI ECTMSGF(ECTPTR),X'80' 0018 00052000 BNL @RT00018 0018 00053000 LTR @14,@14 0018 00054000 BZ @RT00018 0018 00055000 * GO TO TPUTMSG; /* INFORM TERMINAL */ 00056000 * 0019 00057000 * /*****************************************************************/ 00058000 * /* */ 00059000 * /* SET UP PARMS AND PUT CHAIN OUT */ 00060000 * /* */ 00061000 * /*****************************************************************/ 00062000 * 0020 00063000 * PARMMLIN='1'B; /* INDICATE MULTI-LIN OPUT */ 00064000 OI PARMMLIN(PTPBPTR),B'00001000' 0020 00065000 * CALL IKJEFT56; /* GO TO TERMOUT */ 00066000 L @15,@CV00126 0021 00067000 BALR @14,@15 0021 00068000 * RETURNCD=R15; /* SAVE TERMOUTRETRN CODE */ 00069000 LR RETURNCD,R15 0022 00070000 * PARMMLIN='0'B; /* TURN OFF MULTI-LINE BIT */ 00071000 NI PARMMLIN(PTPBPTR),B'11110111' 0023 00072000 *UNCHAIN: 0024 00073000 * CALL IKJEFT53; /* DELETE THE CHAIN AND */ 00074000 UNCHAIN L @15,@CV00129 0024 00075000 BALR @14,@15 0024 00076000 * GOTO EXIT; /* RETURN */ 00077000 B EXIT 0025 00078000 *TPUTMSG: 0026 00079000 * PARMAOUT=ADDR(NOIFRMSG); /* POINT TO MESSAGE */ 00080000 TPUTMSG L @14,@CA00121 0026 00081000 ST @14,PARMAOUT(,PTPBPTR) 0026 00082000 * CALL IKJEFT56; /* PUT OUT NO IFOR MSG */ 00083000 L @15,@CV00126 0027 00084000 BALR @14,@15 0027 00085000 * RETURNCD=R15; /* SAVE RETURN CODE */ 00086000 LR RETURNCD,R15 0028 00087000 * IF ECTMSGF>='80'X THEN /* CHAIN TO BE DELETED */ 00088000 CLI ECTMSGF(ECTPTR),X'80' 0029 00089000 BNL @RT00029 0029 00090000 * GOTO UNCHAIN; 0030 00091000 *EXIT: 0031 00092000 * PARMAOUT=SAVEPARM; /* RESTOR PTR TO OPUT LINE */ 00093000 EXIT ST SAVEPARM,PARMAOUT(,PTPBPTR) 0031 00094000 * PARMOPTN=SAVETPUT; /* RESTORE TPUT OPTION */ 00095000 STC SAVETPUT,PARMOPTN(,PTPBPTR) 0032 00096000 * RETURN CODE(RETURNCD); 0033 00097000 L @13,4(,@13) 0033 00098000 L @00,@SIZDATD 0033 00099000 LR @01,@11 0033 00100000 FREEMAIN R,LV=(0),A=(1) 00101000 LR @15,@04 0033 00102000 L @14,12(,@13) 0033 00103000 LM @00,@12,20(@13) 0033 00104000 BR @14 0033 00105000 * END IKJEFT52 0034 00106000 * 0034 00107000 */* THE FOLLOWING INCLUDE STATEMENTS WERE FOUND IN THIS PROGRAM. */ 00108000 */*%INCLUDE SYSLIB (IKJUPT ) */ 00109000 */*%INCLUDE SYSLIB (IKJECT ) */ 00110000 * 0034 00111000 * ; 0034 00112000 @DATA DS 0H 00113000 @DATD DSECT 00114000 DS 0F 00115000 @SA00001 DS 18F 00116000 @PC00001 DS 4F 00117000 IKJEFT52 CSECT 00118000 DS 0F 00119000 @DATD DSECT 00120000 DS 0D 00121000 ORG *+1-(*-@DATD)/(*-@DATD) INSURE DSECT DATA 00122000 @ENDDATD EQU * 00123000 IKJEFT52 CSECT 00124000 DS 0F 00125000 @SIZDATD DC AL1(1) 00126000 DC AL3(@ENDDATD-@DATD) 00127000 @CA00121 DC A(NOIFRMSG) 00128000 @CV00126 DC V(IKJEFT56) 00129000 @CV00129 DC V(IKJEFT53) 00130000 DS 0D 00131000 @00 EQU 00 EQUATES FOR REGISTERS 0-15 00132000 @01 EQU 01 00133000 @02 EQU 02 00134000 @03 EQU 03 00135000 @04 EQU 04 00136000 @05 EQU 05 00137000 @06 EQU 06 00138000 @07 EQU 07 00139000 @08 EQU 08 00140000 @09 EQU 09 00141000 @10 EQU 10 00142000 @11 EQU 11 00143000 @12 EQU 12 00144000 @13 EQU 13 00145000 @14 EQU 14 00146000 @15 EQU 15 00147000 SAVETPUT EQU @06 00148000 SAVEPARM EQU @05 00149000 RETURNCD EQU @04 00150000 SAVEREG1 EQU @04 00151000 PTPBPTR EQU @02 00152000 ECTPTR EQU @03 00153000 R1 EQU @01 00154000 R0 EQU @00 00155000 R15 EQU @15 00156000 EXTRN NOIFRMSG 00157000 XPRMLIST EQU 0 00158000 UPTPTR EQU XPRMLIST 00159000 XECTPTR EQU XPRMLIST+4 00160000 XPTPBPTR EQU XPRMLIST+12 00161000 UPT EQU 0 00162000 UPTSWS EQU UPT+12 00163000 ECT EQU 0 00164000 ECTMSGF EQU ECT+8 00165000 ECTSMSG EQU ECT+9 00166000 ECTSWS EQU ECT+28 00167000 PTPB EQU 0 00168000 PARMCNTL EQU PTPB 00169000 PARMMLIN EQU PARMCNTL 00170000 PARMTPUT EQU PTPB+2 00171000 PARMOPTN EQU PARMTPUT 00172000 PARMAOUT EQU PTPB+4 00173000 UPTX EQU 0 00174000 ECTX EQU 0 00175000 ECB EQU 0 00176000 PTPBX EQU 0 00177000 AGO .@UNREFD START UNREFERENCED COMPONENTS 00178000 ECBCOMPC EQU ECB 00179000 ECBCBIT EQU ECB 00180000 ECBWBIT EQU ECB 00181000 @NM00006 EQU PARMTPUT+1 00182000 PARMFORM EQU PARMCNTL+1 00183000 PARMDMND EQU PARMCNTL+1 00184000 PARMMODE EQU PARMCNTL+1 00185000 PARMPRMT EQU PARMCNTL 00186000 PARMIFOR EQU PARMCNTL 00187000 PARMMLEV EQU PARMCNTL 00188000 PARMSNGL EQU PARMCNTL 00189000 PARMDTMS EQU PARMCNTL 00190000 PARMPUT EQU PARMCNTL 00191000 PARMPBT0 EQU PARMCNTL 00192000 ECTBKPB EQU ECT+36 00193000 ECTUSER EQU ECT+32 00194000 ECTDDNUM EQU ECT+29 00195000 @NM00005 EQU ECTSWS 00196000 ECTBKGRD EQU ECTSWS 00197000 ECTNNOT EQU ECTSWS 00198000 ECTNMAL EQU ECTSWS 00199000 ECTLOGF EQU ECTSWS 00200000 ECTATRM EQU ECTSWS 00201000 @NM00004 EQU ECTSWS 00202000 ECTNOPD EQU ECTSWS 00203000 ECTSCMD EQU ECT+20 00204000 ECTPCMD EQU ECT+12 00205000 ECTIOWA EQU ECT+4 00206000 ECTRTCD EQU ECT+1 00207000 ECTRCDF EQU ECT 00208000 UPTPREFL EQU UPT+23 00209000 UPTPREFX EQU UPT+16 00210000 @NM00003 EQU UPT+15 00211000 UPTLDEL EQU UPT+14 00212000 UPTCDEL EQU UPT+13 00213000 UPTWTP EQU UPTSWS 00214000 UPTMODE EQU UPTSWS 00215000 UPTALD EQU UPTSWS 00216000 UPTPAUS EQU UPTSWS 00217000 UPTNCOM EQU UPTSWS 00218000 UPTMID EQU UPTSWS 00219000 UPTNPRM EQU UPTSWS 00220000 @NM00002 EQU UPTSWS 00221000 UPTUSER EQU UPT+2 00222000 @NM00001 EQU UPT 00223000 XECBPTR EQU XPRMLIST+8 00224000 .@UNREFD ANOP END UNREFERENCED COMPONENTS 00225000 @RT00018 EQU TPUTMSG 00226000 @RT00029 EQU UNCHAIN 00227000 @ENDDATA EQU * 00228000 END IKJEFT52 00229000