|
This actually never made it to the list. I don't know how well it will show because of the long lines and general layout, but I'll give it a try. To reiterate: the SEPT solution is way inferior to an IBM API, but if you ain't got an API... > -----Original Message----- > From: Leif Svalgaard > Sent: Wednesday, February 16, 2000 4:16 PM > To: 'Colin Williams' > Subject: RE: QDBGETM proper parameters/lengths/etc > > Although I said I was an MI Moron, tell me what to do and I can do it, > if these things are relatively easy to figure out. > Where do I start. > > [Leif Svalgaard] start with a simple RPG program: > > 100 FAA0500 IF E K DISK > 05/21/99 > 200 * > 05/21/99 > 300 C *ENTRY PLIST > 05/21/99 > 400 C PARM IKEY 16 > 05/21/99 > 500 C PARM ODATA 10 > 05/21/99 > 600 * > 05/21/99 > 700 C IKEY CHAINAA0500R 70 70=N/F > 1 05/21/99 > 800 * > 05/21/99 > 900 C *IN70 IFEQ *ON > B001 05/21/99 > 1000 C MOVE *BLANKS DATA > 001 05/21/99 > 1100 C ENDIF > E001 05/21/99 > 1200 * > 05/21/99 > 1300 C MOVE *ON *INLR > 05/21/99 > 1400 C RETRN > 05/21/99 > > Compile it with *LIST for the code. Look at the spool file for the > compilation, e.g. for line 700 > where the read is: > > 00241 BRK '700 ' > ; 700 > /* PHASE - QRGIC > DATE - 01/15/98 */ 700 > /*SVP*/ > 700 > 00242 > ; 700 > 00243 0038 000164 10B2 0017 000F CPYBLA *IN70,*OFF > /*ZSETIND*/ ; 700 > 00244 0039 00016A 10B2 01D2 00A1 CPYBLA .F01XSET > ,C'00000CHAINR*DETC 700 AA0500R ' 700 > > /*ZIOSUA*/ ; 700 > 00245 003A 000170 0082 00B5 018F SETSPP .FIBPTR,.F01FIB > /* LOCATE FIB */ 700 > > /*ZIOSUB*/ ; 700 > 00246 003B 000176 10B2 01A7 000F CPYBLA .F01EIND ,*OFF > /* SET ERROR INDIC COND */ 700 > > /*ZIOB*/ ; 700 > 00247 003C 00017C 1CC2 4000 01AF 000F CMPBLA(B) > .F01OPEN,*OFF/EQ(.DMEXL2) /* ERROR IF NOT OPEN*/ 700 > 0232 > /*ZIOSUPA*/ ; 700 > 00248 003D 000186 10B2 0200 00A2 CPYBLA > .EXTRECN,C'AA0500R ' /*ZEXT*/ ; 700 > 00249 003E 00018C 1042 001D 2001 CPYNV .WORKB3,0001 > /*NUM FLDS IN KEY*/ 700 > > /*ZNOKLST*/ ; 700 > 00250 003F 000192 10B2 6202 2001 2010 CPYBLA > .KEY(0001:0016),IKEY /*MOVE IN KEY FLD*/ 700 > 0019 > /*ZBLDKLC*/ ; 700 > 00251 0040 00019C 1042 001C 2010 CPYNV .WORKB2,0016 > /*KEY LENGTH*/ 700 > > /*ZIOD*/ ; 700 > 00252 0041 0001A2 0293 0216 0000 00C1 CALLI > .XRVRC01,*,.DRIVRTN /*ZICALLI*/ ; 700 > 00253 0042 0001AA 3C46 C000 01C4 00A3 CMPNV(B) > .F01XSTS,P'00012'/NEQ(.OID0002) /*ERROR OCURRED*/ ; 700 > 00A4 > 700 > 00254 0043 0001B4 10B2 0017 000E CPYBLA *IN70,*ON > /* SET ON ERROR INDICATOR 700 > > */ ; 700 > 00255 0044 0001BA 1011 00A7 B .IOD0002 > ; 700 > 00256 .OID0002: > /*ZIO7*/ ; 700 > 00257 0045 0001BE 3022 0092 00A5 SETIP .DRTRTN,.IOD0003 > ; 700 > 00258 0046 0001C4 1011 4093 0198 B .DRTYPE(.F01NDRT) > /*DETERMINE RECORD TYPE*/ ; 700 > 00259 .IOD0003: > /*ZIO6*/ ; 700 > 00260 0047 0001CA 30B2 8010 0194 000E CPYBLA > .F01RIDP->.INDIC,*ON /* SET RECORD ID */ ; 700 > 00261 0048 0001D2 1022 0094 00A6 SETIP .IEFRTN,.OID0001 > ; 700 > 00262 0049 0001D8 1011 00AD B .IF0001E > /*ZIO6C*/ 700 > > 700 > > /* EXTRACT FIELDS */ 700 > > 700 > > /*ZIO6A*/ ; 700 > 00263 .OID0001: > /*ZLABL*/ ; 700 > 00264 .IOD0002: > /*ZLABL*/ ; 700 > > 700 > /* QRGGC 11/30/96 */ > 700 > 00265 > ; 700 > > > [Leif Svalgaard] the call to internal routine CALLI .XRVRC01 is where the > I/O > is done. Find that place in the listing. > > ;.DRVRC01: > ;ENTRY .XRVRC01 INT > ;CPYBLA .RN01001,.EXTRECN /* RECORD NAME */ > ;B .DR01001 > ;.DRVFC01: /*READ FILE*/ > ;ENTRY .XRVFC01 INT > ;CPYBLA .RN01001,' '/* CONTROL LIST*/ > ;.DR01001: > ;SETSPP .CO01001,.OC01001 /* USE CONTROL LIST *//*ZBRD1*/ > > ;XOR(S) .KC01001,.KC01001/*SET TO HEX ZERO*/ > ;CPYBLA .KC01001,.KEY(1:.WORKB2) /*KEY TO CONTROL LIST*/ > ;CPYNV .KF01001,.WORKB3/*NUM FLDS IN KEY*//*ZKEYSET*/ > > ;CPYBWP .UFCBPTR,.FIBUFCB /* LOCATE UFCB*/ > ;CPYBWP .ODPBPTR,.UCBODPB /* LOCATE ODP*/ > ;CPYNV .DMCLINK,.DMCGETK(.UCBINDX)/* DM INDEX */ > ;CPYBWP .IOEPTR,.DMCENTR(.DMCLINK) /* DM ENTRY*/ > ;CPYBLA .DMIOSW,*ON /*INDICATE I/O OPERATION*/ > ;CALLX .IOEPTR,.OL01001,* /*I/O REQUEST */ > ;CPYBLA .DMIOSW,*OFF/*RESET INDICATION *//*ZACALLX*/ > > etc . etc. etc. > > +--- | This is the MI Programmers Mailing List! | To submit a new message, send your mail to MI400@midrange.com. | To subscribe to this list send email to MI400-SUB@midrange.com. | To unsubscribe from this list send email to MI400-UNSUB@midrange.com. | Questions should be directed to the list owner/operator: dr2@cssas400.com +---
As an Amazon Associate we earn from qualifying purchases.
This mailing list archive is Copyright 1997-2024 by midrange.com and David Gibbs as a compilation work. Use of the archive is restricted to research of a business or technical nature. Any other uses are prohibited. Full details are available on our policy page. If you have questions about this, please contact [javascript protected email address].
Operating expenses for this site are earned using the Amazon Associate program and Google Adsense.
midrange.com
