Wednesday, June 12, 2019

Using SAMEPOS in data structures

using keyword samepos to position subfields in data structures

Having written about a couple of the Db2 for i (SQL) additions that were made in the latest Technology Refresh, TR6, to IBM i 7.3 I thought I would write about the first of the two new additions to the RPG programming language, the SAMEPOS keyword used in data structures.

We have all created data structures where we have needed to overlay some subfields with another subfield. The way I am use to doing it is to determine at which position of the data structure I wish to start my new subfield, and use the POS to denote where this subfield starts.

01  dcl-ds *n ;
02    SubField1 char(1) ;
03    SubField2 char(1) ;
04    SubField3 char(1) ;
05    SubField4 char(1) ;
06    SubField5 char(3) pos(2) ;
07  end-ds ;

Subfield5, line 6, will overlay Subfield2, Subfield3, and Subfield4.

The SAMEPOS keyword, line 6 below, makes it easier as all I have to give is the data structure subfield I want to start my overlay.

01  dcl-ds *n ;
02    SubField1 char(1) ;
03    SubField2 char(1) ;
04    SubField3 char(1) ;
05    SubField4 char(1) ;
06    SubField5 char(3) samepos(SubField2) ;
07  end-ds ;

When using the SAMEPOS I have to use after the subfield in the parameter has been defined. If not I will get a compile error:

099999   Subfield1 char(4) samepos(Subfield2) ;
======>                            aaaaaaaaa
*RNF0202 20 a  099999  THE PARAMETER FOR SAMEPOS MUST BE A SUBFIELD 
                       PREVIOUSLY SPECIFIED IN THIS DS.

Let me give a "real life" example. I have a file with 12 month fields that I want to have in an array.

A          R TESTFILER
A            COMPANY        3S 0
A            DIVISION       2S 0
A            MONTH01       10P 2
A            MONTH02   R               REFFLD(MONTH01 *SRC)
A            MONTH03   R               REFFLD(MONTH01 *SRC)
A            MONTH04   R               REFFLD(MONTH01 *SRC)
A            MONTH05   R               REFFLD(MONTH01 *SRC)
A            MONTH06   R               REFFLD(MONTH01 *SRC)
A            MONTH07   R               REFFLD(MONTH01 *SRC)
A            MONTH08   R               REFFLD(MONTH01 *SRC)
A            MONTH09   R               REFFLD(MONTH01 *SRC)
A            MONTH10   R               REFFLD(MONTH01 *SRC)
A            MONTH11   R               REFFLD(MONTH01 *SRC)
A            MONTH12   R               REFFLD(MONTH01 *SRC)

But I cannot have the first two fields from the file, COMPANY and DIVISION, in the array.

The following is a much pared down programming to show how to define the data structure to accomplish this result.

01  **free ;
02  dcl-f TESTFILE ;

03  dcl-ds *n extname('TESTFILE') ;
04    Months like(MONTH01) dim(12) samepos(MONTH01) ;
05  end-ds ;

06  read TESTFILER ;
07  *inlr = *on ;

Line 2: This is the definition for my file, which I am treating as input only, and read it not in key sequence.

Line 3 – 5: Is the definition of the data structure.

Line 3: By using the EXTNAME keyword the RPG compiler will define all the fields from the file as data structure subfields.

Line 4: This subfield is added as a subfield after all the subfields defined from the file. Here I am defining Months as an array of 12 elements that will be the same type and size as the file field MONTH01. By using the SAMEPOS keyword the array starts at the data structure subfield MONTH01, which omits the first two subfields, COMPANY and DIVISION, without me having to work out in what position in the data structure MONTH01 starts.

Line 6: This read is performed just to load data into the data structure and the array.

When I compile this program I can see in the compiling listing how the RPG compiler has defined this data structure.

000400 dcl-ds *n extname('TESTFILE') ;
        *----------------------------------------------------
        * Data structure . . . . :
        * External format  . . . : TESTFILER : QTEMP/TESTFILE
        *----------------------------------------------------
000001=D COMPANY                        3S 0
000002=D DIVISION                       2S 0
000003=D MONTH01                       10P 2
000004=D MONTH02                       10P 2
000005=D MONTH03                       10P 2
000006=D MONTH04                       10P 2
000007=D MONTH05                       10P 2
000008=D MONTH06                       10P 2
000009=D MONTH07                       10P 2
000010=D MONTH08                       10P 2
000011=D MONTH09                       10P 2
000012=D MONTH10                       10P 2
000013=D MONTH11                       10P 2
000014=D MONTH12                       10P 2
000500   Months like(MONTH01) dim(12) samepos(MONTH01) ;

Before I call the program I start debug, and add a breakpoint on the last line of the program.

Now when I run the program I can see that the values from the file are now in the array as well.

EVAL months             
MONTHS(1) = 00000001.00 
MONTHS(2) = 00000002.00 
MONTHS(3) = 00000003.00 
MONTHS(4) = 00000004.00 
MONTHS(5) = 00000005.00 
MONTHS(6) = 00000006.00 
MONTHS(7) = 00000007.00 
MONTHS(8) = 00000008.00 
MONTHS(9) = 00000009.00 
MONTHS(10) = 00000010.00
MONTHS(11) = 00000011.00
MONTHS(12) = 00000012.00

Another data structure I overlay subfields in is my display file indicator data structure. As I define ranges of indicators to do things like initialize subfiles or flag errors I can use the SAMEPOS to overlay the individual indicators with a larger character field.

01  dcl-ds Dspf qualified ;
02    Exit ind pos(3) ;
03    PageDown ind pos(25) ;
04    PageUp ind pos(26) ;

05    SflDspCtl ind pos(30) ;
06    SflDsp ind pos(31) ;
07    SflEnd ind pos(32) ;
08    SflClr ind pos(33) ;
09    SflInds char(4) samepos(SflDspCtl) ;

10    ErrCompany ind pos(50) ;
11    ErrDivision ind pos(51) ;
12    ErrCustomer ind pos(52) ;
13    ErrorInds char(10) samepos(ErrCompany) ;
14  end-ds ;

Then in the program I can do things like this when I need to initialize the subfile:

15  Dspf.SflInds = '0001' ;
16  write CTL01 ; 
17  Dspf.SflInds = '1000' ;

Or to set all the error indicators off. And then check if there is an error.

18  ErrorInds = *all'0' ;


19  if (ErrorInds <> *all'0') ;  //There is an error

 

The SAMEPOS is something I will be using in the future, as it make it a whole lot easier to overlay data structures with others. You will be seeing more examples that include SAMEPOS in the future of this blog.

 

You can learn more about RPG's SAMEPOS keyword from the IBM website here.

 

This article was written for IBM i 7.4 and 7.3 TR6.

4 comments:

  1. Hassan M FarooqiJune 12, 2019 at 7:13 AM

    Finally! It was frustrating to not have a free format version of overlay keyword

    ReplyDelete
  2. Hi Simon.
    Great article once again :-)
    Small type in first example :
    Subfield6, line 6, will overlay Subfield2, Subfield3, and Subfield4.
    Should be Subfield5 :-)
    Best Regards

    ReplyDelete
    Replies
    1. Oops. Thank you for letting me know.
      It has now been corrected.
      Thanks

      Delete
  3. Hassan, the OVERLAY keyword is supported in free format.

    ReplyDelete

To prevent "comment spam" all comments are moderated.
Learn about this website's comments policy here.

Some people have reported that they cannot post a comment using certain computers and browsers. If this is you feel free to use the Contact Form to send me the comment and I will post it for you, please include the title of the post so I know which one to post the comment to.