问题
Can anyone provide any interesting usage examples of these?
回答1:
jjujuma,
For a trivial example you could use this to implement some Object Oriented style procedure like Draw. You'd call a Circle_Draw procedure for a Circle or a Square_Draw procedure for a Square by assigning the appropriate %PADDR of the Circle_Draw or Square_Draw to your Draw procedure pointer. When calling the Draw procedure pointer you hide which procedure (Circle_Draw or Square_Draw) you're calling.
回答2:
For a practical example, this can be used when implementing callbacks. A common callback can be found in the qsort() function in C. Yes, you can call that from ILERPG.
The C specification for qsort() is:
#include <stdlib.h>
void qsort(void *base, size_t num, size_t width,
int(*compare)(const void *key, const void *element));
The RPGLE prototype would look like:
dcl-pr qsort ExtName('qsort');
array Pointer value;
num Uns(10) value;
width Uns(10) value;
compare Pointer(*proc) value;
end-pr;
Here is a simple program that uses qsort():
ctl-opt DftActGrp(*No) Actgrp(*New);
dcl-pr qsort ExtProc('qsort');
array Pointer value;
num Uns(10) value;
width Uns(10) value;
compare Pointer(*Proc) value;
end-pr;
dcl-s strings Varchar(10) Dim(20);
strings(1) = 'Does';
strings(2) = 'this';
strings(3) = 'array';
strings(4) = 'sort';
strings(5) = 'properly?';
qsort(%addr(strings): 5: %size(strings): %paddr(compareStrings));
dsply strings(1);
dsply strings(2);
dsply strings(3);
dsply strings(4);
dsply strings(5);
return;
dcl-proc compareStrings;
dcl-pi *n Int(10);
key Like(strings);
element Like(strings);
end-pi;
dcl-s result Int(10);
if key < element;
result = -1;
elseif key = element;
result = 0;
else;
result = 1;
endif;
return result;
end-proc;
If you run it, the output will be:
DSPLY array
DSPLY properly?
DSPLY sort
DSPLY this
DSPLY Does
回答3:
I have used procedure pointers to encapsulate the logic for searching spooled files into its own service program named SPLFFUNC for make it easier to iterate over them.
In the calling program you can use code like:
ForEachSPLF(%paddr(ProcessSPLA0100) :
'SPLA0100' : // desired format, can be SPLF0100, SPLF0300, or SPLA0100
*BLANKS : // filter for all user names
ToUpper(SendQueue) : // out queue
ToUpper(SendQueueLib) : // out queue library
*BLANKS : // filter for all form types
*BLANKS ); // filter for any user data
and
P ProcessSPLA0100...
P B
D PI
D SPLA LIKEDS(SPLA0100)
P E
The pointed to procedure will get called one time for each spooled file matching the requested criteria. This lets you return a lazy enumerable instead of an array. I like this because it is reusable, it is not beholden to a specific size of array (since I never know how much to allocate), and it has a much smaller memory footprint since you only ever store one data structure at a time. This is roughly equivalent to what you would do with a lambda in a language like C#. Since the pointed to procedure can access any global variables in the client program, it closes over them to perform the real work of the client program.
The code in the service program handles all the gory detail of calling the APIs, reading the userspace object etc. This detail can thus be kept out of the client program.
Note that RPG does not provide compile-type type checking for this kind of technique so you must make sure that the format you request and the data structure defined in the pointed to procedure match.
Service Program:
H NOMAIN
H DEBUG(*YES)
H THREAD(*SERIALIZE)
H BNDDIR('ERRFUNC')
H OPTION(*SrcStmt:*NoDebugIO)
H TEXT('Services for looping through spooled files')
* To compile:
*
* CRTRPGMOD MODULE(QGPL/SPLFFUNC) SRCFILE(QGPL/QRPGLESRC)
*
* CRTSRVPGM SRVPGM(QGPL/SPLFFUNC) EXPORT(*SRCFILE)
/copy QRPGLESRC,SPLFFUNCPR
/copy QRPGLESRC,ERRFUNCPR
********************************************************************
P ForEachSPLF B EXPORT
D PI
D ExecProcedure * VALUE PROCPTR
D Format 10A VALUE
D UserName 10A VALUE
D OutQueue 10A VALUE
D OutQueueLib 10A VALUE
D FormType 10A VALUE
D UserData 10A VALUE
D CrtUserSpace PR EXTPGM('QUSCRTUS')
D 20A CONST Name
D 10A CONST Attribute
D 10I 0 CONST Intial size
D 1A CONST Initial value
D 10A CONST Authority
D 50A CONST Text
D 10A CONST OPTIONS(*nopass) Replace existing
D 32767A OPTIONS(*varsize:*nopass) Error feedback
D GetPointer PR EXTPGM('QUSPTRUS')
D 20A CONST User space name
D * Pointer
D 32767A OPTIONS(*varsize:*nopass) Error feedback
D DltUserSpace PR EXTPGM('QUSDLTUS')
D QUSPTRUS 20A CONST User space name
D 32767A OPTIONS(*varsize:*nopass) Error feedback
/copy qsysinc/qrpglesrc,qusec
D ListSplFiles PR EXTPGM('QUSLSPL')
D 20A CONST userspace library
D 8A CONST format
D 10A CONST user name
D 20A CONST output queue
D 10A CONST form type
D 10A CONST user data
D 32767A OPTIONS(*varsize:*nopass)
D GetSplfAttrib PR EXTPGM('QUSRSPLA')
D receiver LIKEDS(SPLA0100) receiver structure
D 10I 0 CONST receiver length
D 8A CONST format
D 26A CONST qualified job name
D 16A CONST internal job ID
D 16A CONST internal SPLF ID
D 10A CONST file name
D 10I 0 CONST file number
D 32767A OPTIONS(*varsize:*nopass)
* Generic header format 0100
D GenericHeader DS BASED(UserSpacePointer) QUALIFIED
D ListOffset 10I 0 OVERLAY(GenericHeader:125)
D ListCount 10I 0 OVERLAY(GenericHeader:133)
D ListEachSize 10I 0 OVERLAY(GenericHeader:137)
D SPLF1 DS LIKEDS(SPLF0100) BASED(FieldPointer)
D SPLF3 DS LIKEDS(SPLF0300) BASED(FieldPointer)
D SPLA1 DS LIKEDS(SPLA0100)
D I S 5I 0
D SpaceName S 20A
D FileNum S 10I 0 INZ(0)
D reqFormat S 10A
D ptrSPLF0100 S * PROCPTR
D procSPLF0100 PR EXTPROC(ptrSPLF0100)
D SPLF LIKEDS(SPLF0100)
D ptrSPLF0300 S * PROCPTR
D procSPLF0300 PR EXTPROC(ptrSPLF0300)
D SPLF LIKEDS(SPLF0300)
D ptrSPLA0100 S * PROCPTR
D procSPLA0100 PR EXTPROC(ptrSPLA0100)
D SPLF LIKEDS(SPLA0100)
* Validate Parameters
ptrSPLF0100 = ExecProcedure;
ptrSPLF0300 = ExecProcedure;
ptrSPLA0100 = ExecProcedure;
IF Format <> 'SPLF0100' AND Format <> 'SPLF0300' AND
Format <> 'SPLA0100';
ThrowError('Spooled file information format must be -
''SPLF0100'', ''SPLF0300'', or ''SPLA0100''.');
ENDIF;
IF OutQueue = *BLANKS;
OutQueue = '*ALL';
OutQueueLib = *BLANKS;
ELSE;
IF OutQueueLib = *BLANKS;
OutQueueLib = '*LIBL';
ENDIF;
ENDIF;
IF UserName = *BLANKS;
UserName = '*ALL';
ENDIF;
IF FormType = *BLANKS;
FormType = '*ALL';
ENDIF;
IF UserData = *BLANKS;
UserData = '*ALL';
ENDIF;
* To view this user space object:
*
* DSPF STMF('/QSYS.lib/QTEMP.lib/@SPOOLSPC.usrspc')
* or
* DMPOBJ OBJ(QTEMP/@SPOOLSPC) OBJTYPE(*USRSPC)
SpaceName = '@SPOOLSPC QTEMP';
CrtUserSpace(SpaceName : '' : 131072 : x'00' :
'*ALL':'List of spooled files':'*YES':QUSEC);
* DSPLY ('ListSplFiles' + SpaceName + Format + UserName);
* DSPLY (OutQueue + OutQueueLib + FormType + UserData);
IF Format = 'SPLF0300';
reqFormat = Format;
ELSE;
reqFormat = 'SPLF0100';
ENDIF;
ListSplFiles(SpaceName : reqFormat : UserName :
OutQueue + OutQueueLib : FormType : UserData : QUSEC);
GetPointer(SpaceName : UserSpacePointer) ;
FOR I = 1 to GenericHeader.ListCount ;
FieldPointer = UserSpacePointer
+ GenericHeader.ListOffset
+ (GenericHeader.ListEachSize * (I - 1)) ;
IF Format = 'SPLF0100';
procSPLF0100(SPLF1);
ELSEIF Format = 'SPLF0300';
procSPLF0300(SPLF3);
ELSEIF Format = 'SPLA0100';
GetSplfAttrib(SPLA1 : %size(SPLA1) : 'SPLA0100' : '*INT' :
SPLF1.InternalJobID : SPLF1.InternalSplID :
'*INT' : FileNum : QUSEC);
procSPLA0100(SPLA1);
ENDIF;
ENDFOR;
DltUserSpace(SpaceName : QUSEC) ;
RETURN;
P E
Service Program Prototypes:
D ForEachSPLF PR EXTPROC('ForEachSPLF')
D ExecProcedure * VALUE PROCPTR
D Format 10A VALUE
D UserName 10A VALUE
D OutQueue 10A VALUE
D OutQueueLib 10A VALUE
D FormType 10A VALUE
D UserData 10A VALUE
********************************************************************
D SPLF0100 DS TEMPLATE QUALIFIED INZ
D UserName 10A OVERLAY(SPLF0100:1)
D OutQName 10A OVERLAY(SPLF0100:11)
D OutQLibrary 10A OVERLAY(SPLF0100:21)
D FormType 10A OVERLAY(SPLF0100:31)
D UserSpecData 10A OVERLAY(SPLF0100:41)
D InternalJobID 16A OVERLAY(SPLF0100:51)
D InternalSplID 16A OVERLAY(SPLF0100:67)
D Reserved 2A OVERLAY(SPLF0100:83)
D AuxStorage 10I 0 OVERLAY(SPLF0100:85)
********************************************************************
D SPLF0300 DS TEMPLATE QUALIFIED INZ
D JobName 10A OVERLAY(SPLF0300:1)
D UserName 10A OVERLAY(SPLF0300:11)
D JobNumber 6A OVERLAY(SPLF0300:21)
D FileName 10A OVERLAY(SPLF0300:27)
D FileNumber 9B 0 OVERLAY(SPLF0300:37)
D FileStatus 9B 0 OVERLAY(SPLF0300:41)
D DateCreated 7A OVERLAY(SPLF0300:45)
D TimeCreated 6A OVERLAY(SPLF0300:52)
D Schedule 1A OVERLAY(SPLF0300:58)
D FileSysName 10A OVERLAY(SPLF0300:59)
D UserData 10A OVERLAY(SPLF0300:69)
D FormType 10A OVERLAY(SPLF0300:79)
D OutQName 10A OVERLAY(SPLF0300:89)
D OutQLibrary 10A OVERLAY(SPLF0300:99)
D AuxStorePool 9B 0 OVERLAY(SPLF0300:109)
D Size 9B 0 OVERLAY(SPLF0300:113)
D SizeMult 9B 0 OVERLAY(SPLF0300:117)
D Pages 9B 0 OVERLAY(SPLF0300:121)
D CopiesLeft 9B 0 OVERLAY(SPLF0300:125)
D Priority 1A OVERLAY(SPLF0300:129)
D Reserved 3A OVERLAY(SPLF0300:130)
D InterPrintID 9B 0 OVERLAY(SPLF0300:133)
********************************************************************
D SPLA0100 DS TEMPLATE QUALIFIED INZ
D BytesReturned 10I 0 OVERLAY(SPLA0100:1)
D BytesAvail 10I 0 OVERLAY(SPLA0100:5)
D InternalJobID 16A OVERLAY(SPLA0100:9)
D InternalSplID 16A OVERLAY(SPLA0100:25)
D JobName 10A OVERLAY(SPLA0100:41)
D UserName 10A OVERLAY(SPLA0100:51)
D JobNumber 6A OVERLAY(SPLA0100:61)
D FileName 10A OVERLAY(SPLA0100:67)
D FileNumber 10I 0 OVERLAY(SPLA0100:77)
D FormType 10A OVERLAY(SPLA0100:81)
D UserData 10A OVERLAY(SPLA0100:91)
D Status 10A OVERLAY(SPLA0100:101)
D FileAvailable 10A OVERLAY(SPLA0100:111)
D HoldBefore 10A OVERLAY(SPLA0100:121)
D SaveAfter 10A OVERLAY(SPLA0100:131)
D TotalPages 10I 0 OVERLAY(SPLA0100:141)
D PageWritten 10I 0 OVERLAY(SPLA0100:145)
D StartingPage 10I 0 OVERLAY(SPLA0100:149)
D EndingPage 10I 0 OVERLAY(SPLA0100:153)
D LastPagePrint 10I 0 OVERLAY(SPLA0100:157)
D Restart 10I 0 OVERLAY(SPLA0100:161)
D TotalCopies 10I 0 OVERLAY(SPLA0100:165)
D CopiesLeft 10I 0 OVERLAY(SPLA0100:169)
D LinesPerInch 10I 0 OVERLAY(SPLA0100:173)
D CharsPerInch 10I 0 OVERLAY(SPLA0100:177)
D OutPriority 2A OVERLAY(SPLA0100:181)
D OutQueueName 10A OVERLAY(SPLA0100:183)
D OutQueueLib 10A OVERLAY(SPLA0100:193)
D DateCreated 7A OVERLAY(SPLA0100:203)
D TimeCreated 6A OVERLAY(SPLA0100:210)
D DeviceFileName...
D 10A OVERLAY(SPLA0100:216)
D DeviceFileLib 10A OVERLAY(SPLA0100:226)
D ProgramName 10A OVERLAY(SPLA0100:236)
D ProgramLib 10A OVERLAY(SPLA0100:246)
D AccountingCde 15A OVERLAY(SPLA0100:256)
D PrintText 30A OVERLAY(SPLA0100:271)
D RecordLength 10I 0 OVERLAY(SPLA0100:301)
D MaxRecords 10I 0 OVERLAY(SPLA0100:305)
D DeviceType 10A OVERLAY(SPLA0100:309)
D PrinterType 10A OVERLAY(SPLA0100:319)
D DocumentName 12A OVERLAY(SPLA0100:329)
D FolderName 64A OVERLAY(SPLA0100:341)
D Sys36ProcName 8A OVERLAY(SPLA0100:405)
D PrintFidelity 10A OVERLAY(SPLA0100:413)
D ReplaceUnprintable...
D 1A OVERLAY(SPLA0100:423)
D ReplacementChar...
D 1A OVERLAY(SPLA0100:424)
D PageLength 10I 0 OVERLAY(SPLA0100:425)
D PageWidth 10I 0 OVERLAY(SPLA0100:429)
D NumSeparators 10I 0 OVERLAY(SPLA0100:433)
D OverflowLine 10I 0 OVERLAY(SPLA0100:437)
D MultiByteData 10A OVERLAY(SPLA0100:441)
D DBCSExtenChar 10A OVERLAY(SPLA0100:451)
D DBCSShiftOut 10A OVERLAY(SPLA0100:461)
D DBCSCharRot 10A OVERLAY(SPLA0100:471)
D DBCSCPI 10I 0 OVERLAY(SPLA0100:481)
D GraphCharSet 10A OVERLAY(SPLA0100:485)
D CodePage 10A OVERLAY(SPLA0100:495)
D FormDefName 10A OVERLAY(SPLA0100:505)
D FormDefLib 10A OVERLAY(SPLA0100:515)
D SourceDrawer 10I 0 OVERLAY(SPLA0100:525)
D PrinterFont 10A OVERLAY(SPLA0100:529)
D Sys36SPLFID 6A OVERLAY(SPLA0100:539)
D PageRotation 10I 0 OVERLAY(SPLA0100:545)
D Justification 10I 0 OVERLAY(SPLA0100:549)
D PrintDuplex 10A OVERLAY(SPLA0100:553)
D FoldRecords 10A OVERLAY(SPLA0100:563)
D ControlChar 10A OVERLAY(SPLA0100:573)
D AlignForms 10A OVERLAY(SPLA0100:583)
D PrintQuality 10A OVERLAY(SPLA0100:593)
D FormFeed 10A OVERLAY(SPLA0100:603)
D VolumesArray 71A OVERLAY(SPLA0100:613)
D FileLabelID 17A OVERLAY(SPLA0100:684)
D ExchangeType 10A OVERLAY(SPLA0100:701)
D CharacterCode 10A OVERLAY(SPLA0100:711)
D TotalRecords 10I 0 OVERLAY(SPLA0100:721)
D PagesPerSide 10I 0 OVERLAY(SPLA0100:725)
D FrontOvlName 10A OVERLAY(SPLA0100:729)
D FrontOvlLib 10A OVERLAY(SPLA0100:739)
D FrontOvlOffsetDown...
D 15P 5 OVERLAY(SPLA0100:749)
D FrontOvlOffsetAcross...
D 15P 5 OVERLAY(SPLA0100:757)
D BackOvlName 10A OVERLAY(SPLA0100:765)
D BackOvlLib 10A OVERLAY(SPLA0100:775)
D BackOvlOffsetDown...
D 15P 5 OVERLAY(SPLA0100:785)
D BackOvlOffsetAcross...
D 15P 5 OVERLAY(SPLA0100:793)
D UnitOfMeasure 10A OVERLAY(SPLA0100:801)
D PageDefName 10A OVERLAY(SPLA0100:811)
D PageDefLib 10A OVERLAY(SPLA0100:821)
D LineSpacing 10A OVERLAY(SPLA0100:831)
D PointSize 15P 5 OVERLAY(SPLA0100:841)
D FrontMarginOffsetDown...
D 15P 5 OVERLAY(SPLA0100:849)
D FrontMarginOffsetAcross...
D 15P 5 OVERLAY(SPLA0100:857)
D BackMarginOffsetDown...
D 15P 5 OVERLAY(SPLA0100:865)
D BackMarginOffsetAcross...
D 15P 5 OVERLAY(SPLA0100:873)
D LengthOfPage 15P 5 OVERLAY(SPLA0100:881)
D WidthOfPage 15P 5 OVERLAY(SPLA0100:889)
D MeasurementMethod...
D 10A OVERLAY(SPLA0100:897)
D AFPResource 1A OVERLAY(SPLA0100:907)
D CharSetName 10A OVERLAY(SPLA0100:908)
D CharSetLib 10A OVERLAY(SPLA0100:918)
D CodePageName 10A OVERLAY(SPLA0100:928)
D CodePageLib 10A OVERLAY(SPLA0100:938)
D CodedFontName 10A OVERLAY(SPLA0100:948)
D CodedFontLib 10A OVERLAY(SPLA0100:958)
D DBCSFontName 10A OVERLAY(SPLA0100:968)
D DBCSFontLib 10A OVERLAY(SPLA0100:978)
D UserDefFile 10A OVERLAY(SPLA0100:988)
D ReduceOutput 10A OVERLAY(SPLA0100:998)
D ConstBackOvl 1A OVERLAY(SPLA0100:1008)
D OutputBin 10I 0 OVERLAY(SPLA0100:1009)
D CCSID 10I 0 OVERLAY(SPLA0100:1013)
D UserDefText 100A OVERLAY(SPLA0100:1017)
D CreatedSystem 8A OVERLAY(SPLA0100:1117)
D CreatedID 8A OVERLAY(SPLA0100:1125)
D CreatedUser 10A OVERLAY(SPLA0100:1133)
D 2A OVERLAY(SPLA0100:1143)
D OffsetUserDef 10I 0 OVERLAY(SPLA0100:1145)
D NumberUserDef 10I 0 OVERLAY(SPLA0100:1149)
D LengthUserDef 10I 0 OVERLAY(SPLA0100:1153)
D UsrDefData 255A OVERLAY(SPLA0100:1157)
D UsrDefObjName 10A OVERLAY(SPLA0100:1412)
D UsrDefObjLib 10A OVERLAY(SPLA0100:1422)
D UsrObjType 10A OVERLAY(SPLA0100:1432)
D 3A OVERLAY(SPLA0100:1442)
D CharSetPtSz 15P 5 OVERLAY(SPLA0100:1445)
D CodedFontPtSz 15P 5 OVERLAY(SPLA0100:1453)
D DBCSFontPtSz 15P 5 OVERLAY(SPLA0100:1461)
D AuxStorPool 10I 0 OVERLAY(SPLA0100:1469)
D SPLFSize 10I 0 OVERLAY(SPLA0100:1473)
D SPLFSizeMult 10I 0 OVERLAY(SPLA0100:1477)
D IPJobID 10I 0 OVERLAY(SPLA0100:1481)
D SPLFSecurity 1A OVERLAY(SPLA0100:1485)
D SPLFAuthent 1A OVERLAY(SPLA0100:1486)
D WriterDateBeg 7A OVERLAY(SPLA0100:1487)
D WriterTimeBeg 6A OVERLAY(SPLA0100:1494)
D WriterDateEnd 7A OVERLAY(SPLA0100:1500)
D WriterTimeEnd 6A OVERLAY(SPLA0100:1507)
D JobSysName 8A OVERLAY(SPLA0100:1513)
D AuxStorPoolDv 10A OVERLAY(SPLA0100:1521)
D ExpireDate 7A OVERLAY(SPLA0100:1531)
回答4:
For example, CEEHDLR/CEEHDLU (un)registers a user-written condition handler for the current stack (entry) frame.
来源：https://stackoverflow.com/questions/756290/procedure-pointers-in-rpgle-procptr