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