Examples
*.. 1 ...+... 2 ...+... 3 ...+... 4 ...+... 5 ...+... 6 ...+... 7 ...+... 8
DName+++++++++++ETDsFrom+++To/L+++IDc.Keywords+++++++++++++++++++++++++++++
*
* Define a based data structure, array and field.
* If PTR1 is not defined, it will be implicitly defined
* by the compiler.
*
* Note that before these based fields or structures can be used,
* the basing pointer must be set to point to the correct storage
* location.
*
D DSbased DS BASED(PTR1)
D Field1 1 16A
D Field2 2
D
D ARRAY S 20A DIM(12) BASED(PRT2)
D
D Temp_fld S * BASED(PRT3)
D
D PTR2 S * INZ
D PTR3 S * INZ(*NULL)The following shows how you can add and subtract offsets from pointers and also determine the difference in offsets between two pointers.
*.. 1 ...+... 2 ...+... 3 ...+... 4 ...+... 5 ...+... 6 ...+... 7 ...+...8
DName+++++++++++ETDsFrom+++To/L+++IDc.Keywords+++++++++++++++++++++++++++++
D.....................................Keywords+++++++++++++++++++++++++++++
*
D P1 s *
D P2 s *
CL0N01Factor1+++++++Opcode(E)+Factor2+++++++Result++++++++Len++D+HiLoEq....
CL0N01++++++++++++++Opcode(E)+Extended Factor 2++++++++++++++++++++++++++++
*
* Allocate 20 bytes of storage for pointer P1.
C ALLOC 20 P1
* Initialize the storage to 'abcdefghij'
C EVAL %STR(P1:20) = 'abcdefghij'
* Set P2 to point to the 9th byte of this storage.
C EVAL P2 = P1 + 8
* Show that P2 is pointing at 'i'. %STR returns the data that
* the pointer is pointing to up to but not incuding the first
* null-terminator x'00' that it finds, but it only searches for
* the given length, which is 1 in this case.
C EVAL Result = %STR(P2:1)
C DSPLY Result 1
* Set P2 to point to the previous byte
C EVAL P2 = P2 - 1
* Show that P2 is pointing at 'h'
C EVAL Result = %STR(P2:1)
C DSPLY Result
* Find out how far P1 and P2 are apart. (7 bytes)
C EVAL Diff = P2 - P1
C DSPLY Diff 5 0
* Free P1's storage
C DEALLOC P1
C RETURNFigure 3 shows how to obtain the number of days in Julian format, if the Julian date is required.
*..1....+....2....+....3....+....4....+....5....+....6....+....7....+....
HKeywords++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
H DATFMT(*JUL)
DName+++++++++++ETDsFrom+++To/L+++IDc.Keywords+++++++++++++++++++++++++++++
D.....................................Keywords+++++++++++++++++++++++++++++
*
D JulDate S D INZ(D'95/177')
D DATFMT(*JUL)
D JulDS DS BASED(JulPTR)
D Jul_yy 2 0
D Jul_sep 1
D Jul_ddd 3 0
D JulDay S 3 0
CL0N01Factor1+++++++Opcode(E)+Factor2+++++++Result++++++++Len++D+HiLoEq....
CL0N01++++++++++++++Opcode(E)+Extended Factor 2++++++++++++++++++++++++++++
*
* Set the basing pointer for the structure overlaying the
* Julian date.
C EVAL JulPTR = %ADDR(JulDate)
* Extract the day portion of the Julian date
C EVAL JulDay = Jul_dddFigure 4 illustrates the use of pointers, based structures
and system APIs. This program does the following:
- Receives the Library and File name you wish to process
- Creates a User space using the QUSCRTUS API
- Calls an API (QUSLMBR) to list the members in the requested file
- Gets a pointer to the User space using the QUSPTRUS API
- Displays a message with the number of members and the name of the first and last member in the file
*.. 1 ...+... 2 ...+... 3 ...+... 4 ...+... 5 ...+... 6 ...+... 7 ...+... 8
DName+++++++++++ETDsFrom+++To/L+++IDc.Keywords+++++++++++++++++++++++++++++
D.....................................Keywords+++++++++++++++++++++++++++++
*
D SPACENAME DS
D 10 INZ('LISTSPACE')
D 10 INZ('QTEMP')
D ATTRIBUTE S 10 INZ('LSTMBR')
D INIT_SIZE S 9B 0 INZ(9999999)
D AUTHORITY S 10 INZ('*CHANGE')
D TEXT S 50 INZ('File member space')
D SPACE DS BASED(PTR)
D SP1 32767
*
* ARR is used with OFFSET to access the beginning of the
* member information in SP1
*
D ARR 1 OVERLAY(SP1) DIM(32767)
*
* OFFSET is pointing to start of the member information in SP1
*
D OFFSET 9B 0 OVERLAY(SP1:125)
*
* Size has number of member names retrieved
*
D SIZE 9B 0 OVERLAY(SP1:133)
D MBRPTR S *
D MBRARR S 10 BASED(MBRPTR) DIM(32767)
D PTR S *
D FILE_LIB S 20
D FILE S 10
D LIB S 10
D WHICHMBR S 10 INZ('*ALL ')
D OVERRIDE S 1 INZ('1')
D FIRST_LAST S 50 INZ(' MEMBERS, +
D FIRST = , +
D LAST = ')
D IGNERR DS
D 9B 0 INZ(15)
D 9B 0
D 7A*.. 1 ...+... 2 ...+... 3 ...+... 4 ...+... 5 ...+... 6 ...+... 7 ...+... 8
CL0N01Factor1+++++++Opcode(E)+Factor2+++++++Result++++++++Len++D+HiLoEq....
CL0N01++++++++++++++Opcode(E)+Extended Factor 2++++++++++++++++++++++++++++
*
* Receive file and library you want to process
*
C *ENTRY PLIST
C FILE PARM FILEPARM 10
C LIB PARM LIBPARM 10
*
* Delete the user space if it exists
*
C CALL 'QUSDLTUS' 10
C PARM SPACENAME
C PARM IGNERR
*
* Create the user space
*
C CALL 'QUSCRTUS'
C PARM SPACENAME
C PARM ATTRIBUTE
C PARM INIT_SIZE
C PARM ' ' INIT_VALUE 1
C PARM AUTHORITY
C PARM TEXT
*
* Call the API to list the members in the requested file
*
C CALL 'QUSLMBR'
C PARM SPACENAME
C PARM 'MBRL0100' MBR_LIST 8
C PARM FILE_LIB
C PARM WHICHMBR
C PARM OVERRIDE
*
* Get a pointer to the user-space
*
C CALL 'QUSPTRUS'
C PARM SPACENAME
C PARM PTR
*
* Set the basing pointer for the member array
* MBRARR now overlays ARR starting at the beginning of
* the member information.
*
C EVAL MBRPTR = %ADDR(ARR(OFFSET))
C MOVE SIZE CHARSIZE 3
C EVAL %SUBST(FIRST_LAST:1:3) = CHARSIZE
C EVAL %SUBST(FIRST_LAST:23:10) = MBRARR(1)
C EVAL %SUBST(FIRST_LAST:41:10) = MBRARR(SIZE)
C FIRST_LAST DSPLY
C EVAL *INLR = '1'When coding basing pointers, make sure that the pointer is set to storage that is large enough and of the correct type for the based field. Figure 5 shows some examples of how not to code basing pointers.
*.. 1 ...+... 2 ...+... 3 ...+... 4 ...+... 5 ...+... 6 ...+... 7 ...+...
8
DName+++++++++++ETDsFrom+++To/L+++IDc.Keywords+++++++++++++++++++++++++++++
D.....................................Keywords+++++++++++++++++++++++++++++
*
D chr10 S 10a based(ptr1)
D char100 S 100a based(ptr1)
D p1 S 5p 0 based(ptr1)
CL0N01Factor1+++++++Opcode(E)+Factor2+++++++Result++++++++Len++D+HiLoEq....
CL0N01++++++++++++++Opcode(E)+Extended Factor 2++++++++++++++++++++++++++++
*
*
* Set ptr1 to the address of p1, a numeric field
* Set chr10 (which is based on ptr1) to 'abc'
* The data written to p1 will be unreliable because of the data
* type incompatibility.
*
C EVAL ptr1 = %addr(p1)
C EVAL chr10 = 'abc'
*
* Set ptr1 to the address of chr10, a 10-byte field.
* Set chr100, a 100-byte field, all to 'x'
* 10 bytes are written to chr10, and 90 bytes are written in other
* storage, the location being unknown.
*
C EVAL ptr1 = %addr(chr10)
C EVAL chr100 = *all'x'