*.. 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 99 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 100 illustrates the use of pointers, based structures and system APIs. This program does the following:
*.. 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 101 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'