TITLE 'IKJEFT53, UNCHAIN ROUTINE ' 00001000 IKJEFT53 CSECT , 0001 00002000 @MAINENT DS 0H 0001 00003000 USING *,@15 0001 00004000 B @PROLOG 0001 00005000 DC AL1(16) 0001 00006000 DC C'IKJEFT53 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 LM @00,@01,20(@13) 0001 00017000 MVC @PC00001(8),0(@01) 0001 00018000 * CHAIN */ 00019000 * 0009 00020000 * /*****************************************************************/ 00021000 * /* */ 00022000 * /* START EXECUTABLE CODE */ 00023000 * /* */ 00024000 * /*****************************************************************/ 00025000 * 0010 00026000 * R2=ECTSMSG; /* LOCATE ADDRESS OF CHAIN */ 00027000 L @10,ECTPTR(,R1) 0010 00028000 SR R2,R2 0010 00029000 ICM R2,7,ECTSMSG(@10) 0010 00030000 * CHANHEAD=0; /* ZERO ECTMSGF &ECTSMSG */ 00031000 SR @03,@03 0011 00032000 ST @03,CHANHEAD(,@10) 0011 00033000 * SPOOL=78; /* INDICATE SHARD SUBPOOL */ 00034000 MVI SPOOL,X'4E' 0012 00035000 * GOTO ENDLOOP; /* TRAILNG DECISION LOOP */ 00036000 B ENDLOOP 0013 00037000 *FREELOOP: 0014 00038000 * R1=R2; /* ADDRESS OF ELEM TO BE FREED IN 00039000 * REGISTER 1 */ 00040000 FREELOOP LR R1,R2 0014 00041000 * LENGTH=R1->CHAINLL+4; /* AMOUNT TO BE FREED = LENGTH OF 00042000 * MSG + CHAIN'S FORWARD PTR 0015 00043000 * LENGTH */ 00044000 LA @10,4 0015 00045000 AH @10,CHAINLL(,R1) 0015 00046000 STCM @10,7,LENGTH 0015 00047000 * R2=R1->CHAINPTR; /* SAVE ADDR OF NEXT ELEM */ 00048000 SR R2,R2 0016 00049000 ICM R2,7,CHAINPTR(R1) 0016 00050000 * R0=FREMANR0; /* FILL IN REG 0 */ 00051000 L R0,FREMANR0 0017 00052000 * GEN(FREEMAIN R,LV=(0),A=(1)); /* FREE ELEMENT */ 00053000 FREEMAIN R,LV=(0),A=(1) 00054000 *ENDLOOP: 0019 00055000 * IF R2^=0 THEN /* ANOTHER ELEM BRANCH */ 00056000 ENDLOOP LTR R2,R2 0019 00057000 BNZ @RT00019 0019 00058000 * GOTO FREELOOP; 0020 00059000 * END IKJEFT53 0021 00060000 * 0021 00061000 */* THE FOLLOWING INCLUDE STATEMENTS WERE FOUND IN THIS PROGRAM. */ 00062000 */*%INCLUDE SYSLIB (IKJUPT ) */ 00063000 */*%INCLUDE SYSLIB (IKJECT ) */ 00064000 * 0021 00065000 * ; 0021 00066000 @EL00001 DS 0H 0021 00067000 @EF00001 L @00,@SIZDATD 0021 00068000 LR @01,@11 0021 00069000 FREEMAIN R,LV=(0),A=(1) 00070000 @ER00001 LM @14,@12,12(@13) 0021 00071000 BR @14 0021 00072000 @DATA DS 0H 00073000 @DATD DSECT 00074000 DS 0F 00075000 @PC00001 DS 2F 00076000 IKJEFT53 CSECT 00077000 DS 0F 00078000 @DATD DSECT 00079000 DS 0D 00080000 FREMANR0 DS FL4 00081000 ORG FREMANR0 00082000 SPOOL DS AL1 00083000 LENGTH DS AL3 00084000 ORG FREMANR0+4 00085000 ORG *+1-(*-@DATD)/(*-@DATD) INSURE DSECT DATA 00086000 @ENDDATD EQU * 00087000 IKJEFT53 CSECT 00088000 DS 0F 00089000 @SIZDATD DC AL1(1) 00090000 DC AL3(@ENDDATD-@DATD) 00091000 DS 0D 00092000 @00 EQU 00 EQUATES FOR REGISTERS 0-15 00093000 @01 EQU 01 00094000 @02 EQU 02 00095000 @03 EQU 03 00096000 @04 EQU 04 00097000 @05 EQU 05 00098000 @06 EQU 06 00099000 @07 EQU 07 00100000 @08 EQU 08 00101000 @09 EQU 09 00102000 @10 EQU 10 00103000 @11 EQU 11 00104000 @12 EQU 12 00105000 @13 EQU 13 00106000 @14 EQU 14 00107000 @15 EQU 15 00108000 R1 EQU @01 00109000 R0 EQU @00 00110000 R2 EQU @02 00111000 XPRMLIST EQU 0 00112000 UPTPTR EQU XPRMLIST 00113000 ECTPTR EQU XPRMLIST+4 00114000 UPT EQU 0 00115000 UPTSWS EQU UPT+12 00116000 ECT EQU 0 00117000 ECTMSGF EQU ECT+8 00118000 ECTSMSG EQU ECT+9 00119000 ECTSWS EQU ECT+28 00120000 CHAIN EQU 0 00121000 CHAINPTR EQU CHAIN+1 00122000 CHAINLL EQU CHAIN+4 00123000 UPTX EQU 0 00124000 ECTX EQU 0 00125000 CHANHEAD EQU ECTMSGF 00126000 AGO .@UNREFD START UNREFERENCED COMPONENTS 00127000 CHAINTXT EQU CHAIN+8 00128000 CHAINOO EQU CHAIN+6 00129000 @NM00006 EQU CHAIN 00130000 ECTBKPB EQU ECT+36 00131000 ECTUSER EQU ECT+32 00132000 ECTDDNUM EQU ECT+29 00133000 @NM00005 EQU ECTSWS 00134000 ECTBKGRD EQU ECTSWS 00135000 ECTNNOT EQU ECTSWS 00136000 ECTNMAL EQU ECTSWS 00137000 ECTLOGF EQU ECTSWS 00138000 ECTATRM EQU ECTSWS 00139000 @NM00004 EQU ECTSWS 00140000 ECTNOPD EQU ECTSWS 00141000 ECTSCMD EQU ECT+20 00142000 ECTPCMD EQU ECT+12 00143000 ECTIOWA EQU ECT+4 00144000 ECTRTCD EQU ECT+1 00145000 ECTRCDF EQU ECT 00146000 UPTPREFL EQU UPT+23 00147000 UPTPREFX EQU UPT+16 00148000 @NM00003 EQU UPT+15 00149000 UPTLDEL EQU UPT+14 00150000 UPTCDEL EQU UPT+13 00151000 UPTWTP EQU UPTSWS 00152000 UPTMODE EQU UPTSWS 00153000 UPTALD EQU UPTSWS 00154000 UPTPAUS EQU UPTSWS 00155000 UPTNCOM EQU UPTSWS 00156000 UPTMID EQU UPTSWS 00157000 UPTNPRM EQU UPTSWS 00158000 @NM00002 EQU UPTSWS 00159000 UPTUSER EQU UPT+2 00160000 @NM00001 EQU UPT 00161000 .@UNREFD ANOP END UNREFERENCED COMPONENTS 00162000 @RT00019 EQU FREELOOP 00163000 @ENDDATA EQU * 00164000 END IKJEFT53 00165000