TITLE 'IEFJDIRD - PSEUDO ACCESS METHOD PERFORM A DIRECT READ' 00001000 IEFJDIRD CSECT , 0001 00002000 @MAINENT DS 0H 0001 00003000 USING *,@15 0001 00004000 B @PROLOG 0001 00005000 DC AL1(16) 0001 00006000 DC C'IEFJDIRD 73.020' 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 * 0004 00013000 */* PHYSICAL ERROR CONDITIONS (REGISTER 15 = 12) */ 00014000 */* SET UP BASED VARIABLES */ 00015000 * 0005 00016000 * RPLPTR=R1; /* SAVE THE POINTER IN R1 POINTS 00017000 * TO THE RPL */ 00018000 LR RPLPTR,R1 0005 00019000 * RFY 0006 00020000 * IFGRPL BASED(RPLPTR); /* THE RPL IS BASED ON CONTENTS 00021000 * OF RPLPTR */ 00022000 * RFY 0007 00023000 * IEFJAREA BASED(RPLDDDP-8); /* POINT TO THE BEGINNING OF THE 00024000 * RECORD */ 00025000 * 0007 00026000 * /*****************************************************************/ 00027000 * /* */ 00028000 * /* PERFORM A DIRECT READ */ 00029000 * /* */ 00030000 * /*****************************************************************/ 00031000 * 0008 00032000 * NEWLGTH=LGTH-8; /* GET THE LGTH OF THE TEXT ONLY */ 00033000 LA @10,8 0008 00034000 L @07,RPLARG(,RPLPTR) 0008 00035000 L @07,RPLDDDP(,@07) 0008 00036000 SR @07,@10 0008 00037000 LCR @10,@10 0008 00038000 A @10,LGTH(,@07) 0008 00039000 LR NEWLGTH,@10 0008 00040000 * TEXTPTR=RPLAREA; /* TEXTPTR NOW POINTS TO THE AREA 00041000 * THAT THE REC WILL BE READ INTO*/ 00042000 L TEXTPTR,RPLAREA(,RPLPTR) 0009 00043000 * RECPTR=ADDR(IEFJAREA); /* RECPTR POINTS TO THE REC TO BE 00044000 * READ */ 00045000 LR RECPTR,@07 0010 00046000 * IF NEWLGTH<=256 THEN /* CHECK LENGTH OF REC IF > 256 00047000 * MORE THAN ONE MOVE IS 0011 00048000 * NECESSARY */ 00049000 CH NEWLGTH,@CH00134 0011 00050000 BH @RF00011 0011 00051000 * TEXTAREA(1:NEWLGTH)=RECTEXT(1:NEWLGTH);/* LESS THAN 256 MOVE 0012 00052000 * AND END */ 00053000 LR @10,NEWLGTH 0012 00054000 BCTR @10,0 0012 00055000 EX @10,@SM00136 0012 00056000 * ELSE 0013 00057000 * DO; 0013 00058000 B @RC00011 0013 00059000 @RF00011 DS 0H 0014 00060000 * CTR=NEWLGTH/256; /* SET CTR TO THE NUMBER OF MOVES 00061000 * NECESSARY */ 00062000 LR @08,NEWLGTH 0014 00063000 SRDA @08,32 0014 00064000 D @08,@CF00134 0014 00065000 LR CTR,@09 0014 00066000 * DO WHILE CTR>0; /* EXECUTE UNTIL ALL 256 BYTE 0015 00067000 * BLOCKS HAVE BEEN MOVED */ 00068000 B @DE00015 0015 00069000 @DL00015 DS 0H 0016 00070000 * TEXTAREA(1:256)=RECPTR->RECTEXT(1:256);/* MOVE 256 BYTES AT 00071000 * A TIME */ 00072000 MVC TEXTAREA(256,TEXTPTR),RECTEXT(RECPTR) 0016 00073000 * TEXTPTR=TEXTPTR+256; /* UPDATE POINTER */ 00074000 LA @10,256 0017 00075000 AR TEXTPTR,@10 0017 00076000 * RECPTR=RECPTR+256; /* UPDATE POINTER */ 00077000 AR RECPTR,@10 0018 00078000 * CTR=CTR-1; /* DECREMENT COUNTER */ 00079000 BCTR CTR,0 0019 00080000 * END; 0020 00081000 @DE00015 LTR CTR,CTR 0020 00082000 BP @DL00015 0020 00083000 * CTR=NEWLGTH//256; /* SET REMAINING LENGTH IN CTR */ 00084000 LR CTR,NEWLGTH 0021 00085000 N CTR,@CF00138 0021 00086000 * TEXTAREA(1:CTR)=RECPTR->RECTEXT(1:CTR);/* MOVE REMAINING 0022 00087000 * LENGTH */ 00088000 LR @10,CTR 0022 00089000 BCTR @10,0 0022 00090000 EX @10,@SM00139 0022 00091000 * END; 0023 00092000 * RPLDDDD=RPLDDDP; /* RETURN THE ADDR OF THE RECORD 00093000 * MOVED */ 00094000 @RC00011 L @10,RPLARG(,RPLPTR) 0024 00095000 MVC RPLDDDD(4,RPLPTR),RPLDDDP(@10) 0024 00096000 * END IEFJDIRD /* RETURN TO THE CALLER */ 00097000 * 0025 00098000 */* THE FOLLOWING INCLUDE STATEMENTS WERE FOUND IN THIS PROGRAM. */ 00099000 */*%INCLUDE SYSLIB (IEFJAREA) */ 00100000 */*%INCLUDE SYSLIB (IFGRPL ) */ 00101000 * 0025 00102000 * ; 0025 00103000 @EL00001 DS 0H 0025 00104000 @EF00001 DS 0H 0025 00105000 @ER00001 LM @14,@12,12(@13) 0025 00106000 BR @14 0025 00107000 @DATA DS 0H 00108000 @SM00136 MVC TEXTAREA(0,TEXTPTR),RECTEXT(@07) 00109000 @SM00139 MVC TEXTAREA(0,TEXTPTR),RECTEXT(RECPTR) 00110000 @DATD DSECT 00111000 DS 0F 00112000 IEFJDIRD CSECT 00113000 DS 0F 00114000 @CF00138 DC F'255' 00115000 @CF00134 DC F'256' 00116000 @CH00134 EQU @CF00134+2 00117000 @DATD DSECT 00118000 DS 0D 00119000 @ENDDATD EQU * 00120000 IEFJDIRD CSECT 00121000 NOPR ((@ENDDATD-@DATD)*16) 00122000 DS 0F 00123000 @SIZDATD DC AL1(0) 00124000 DC AL3(@ENDDATD-@DATD) 00125000 DS 0D 00126000 PTCHDIRD DC X'00' 00127000 DS 9XL1 00128000 @00 EQU 00 EQUATES FOR REGISTERS 0-15 00129000 @01 EQU 01 00130000 @02 EQU 02 00131000 @03 EQU 03 00132000 @04 EQU 04 00133000 @05 EQU 05 00134000 @06 EQU 06 00135000 @07 EQU 07 00136000 @08 EQU 08 00137000 @09 EQU 09 00138000 @10 EQU 10 00139000 @11 EQU 11 00140000 @12 EQU 12 00141000 @13 EQU 13 00142000 @14 EQU 14 00143000 @15 EQU 15 00144000 NEWLGTH EQU @05 00145000 RPLPTR EQU @03 00146000 RECPTR EQU @06 00147000 CTR EQU @02 00148000 TEXTPTR EQU @04 00149000 R1 EQU @01 00150000 TEXTAREA EQU 0 00151000 RPLRBAP EQU 0 00152000 RPLDDDP EQU RPLRBAP+4 00153000 IEFJAREA EQU 0 00154000 LGTH EQU IEFJAREA+4 00155000 RECTEXT EQU IEFJAREA+8 00156000 IFGRPL EQU 0 00157000 RPLIDWD EQU IFGRPL 00158000 RPLECB EQU IFGRPL+8 00159000 RPLSTAT EQU IFGRPL+12 00160000 RPLFDBK EQU IFGRPL+13 00161000 RPLRTNCD EQU RPLFDBK 00162000 RPLCNDCD EQU RPLFDBK+1 00163000 RPLKEYLE EQU IFGRPL+16 00164000 RPLAREA EQU IFGRPL+32 00165000 RPLARG EQU IFGRPL+36 00166000 RPLOPTCD EQU IFGRPL+40 00167000 RPLOPT1 EQU RPLOPTCD 00168000 RPLOPT2 EQU RPLOPTCD+1 00169000 RPLADR EQU RPLOPT2 00170000 RPLOPT3 EQU RPLOPTCD+2 00171000 RPLNXTRP EQU IFGRPL+44 00172000 RPLRBAR EQU IFGRPL+60 00173000 RPL6RBA EQU RPLRBAR+2 00174000 RPLDDDD EQU RPL6RBA+2 00175000 AGO .@UNREFD START UNREFERENCED COMPONENTS 00176000 RPLERMSA EQU IFGRPL+72 00177000 RPLEMLEN EQU IFGRPL+70 00178000 @NM00005 EQU IFGRPL+68 00179000 RPLS2S2 EQU RPL6RBA 00180000 RPLS1S1 EQU RPLRBAR 00181000 @NM00004 EQU IFGRPL+56 00182000 RPLBUFL EQU IFGRPL+52 00183000 RPLRLEN EQU IFGRPL+48 00184000 RPLCHAIN EQU RPLNXTRP 00185000 RPLOPT4 EQU RPLOPTCD+3 00186000 RPLALIGN EQU RPLOPT3 00187000 RPLFMT EQU RPLOPT3 00188000 RPLFLD EQU RPLOPT3 00189000 RPLVFY EQU RPLOPT3 00190000 RPLBLK EQU RPLOPT3 00191000 RPLSFORM EQU RPLOPT3 00192000 RPLEODS EQU RPLOPT3 00193000 RPLNSP EQU RPLOPT2 00194000 RPLUPD EQU RPLOPT2 00195000 @NM00003 EQU RPLOPT2 00196000 RPLCNV EQU RPLOPT2 00197000 RPLADD EQU RPLADR 00198000 RPLKEY EQU RPLOPT2 00199000 RPLECBSW EQU RPLOPT1 00200000 RPLGEN EQU RPLOPT1 00201000 RPLKGE EQU RPLOPT1 00202000 RPLASY EQU RPLOPT1 00203000 RPLSKP EQU RPLOPT1 00204000 RPLSEQ EQU RPLOPT1 00205000 RPLDIR EQU RPLOPT1 00206000 RPLLOC EQU RPLOPT1 00207000 RPLTCBPT EQU IFGRPL+28 00208000 RPLDACB EQU IFGRPL+24 00209000 RPLCCHAR EQU IFGRPL+20 00210000 RPLSTRID EQU IFGRPL+18 00211000 RPLKEYL EQU RPLKEYLE 00212000 RPLERRCD EQU RPLCNDCD+1 00213000 RPLCMPON EQU RPLCNDCD 00214000 RPLERREG EQU RPLRTNCD 00215000 @NM00002 EQU RPLSTAT 00216000 RPLEDRQI EQU RPLSTAT 00217000 RPLCHKI EQU RPLSTAT 00218000 RPLACTIV EQU RPLSTAT 00219000 RPLPOST EQU RPLECB 00220000 RPLWAIT EQU RPLECB 00221000 RPLPLHPT EQU IFGRPL+4 00222000 RPLLEN EQU RPLIDWD+3 00223000 RPLREQ EQU RPLIDWD+2 00224000 RPLSTYP EQU RPLIDWD+1 00225000 RPLID EQU RPLIDWD 00226000 NEXTPTR EQU IEFJAREA 00227000 @NM00001 EQU RPLRBAP 00228000 .@UNREFD ANOP END UNREFERENCED COMPONENTS 00229000 @ENDDATA EQU * 00230000 END IEFJDIRD 00231000