puntatori Procedura in RPGLE (PROCPTR)
-
09-09-2019 - |
Domanda
Qualcuno può fornire eventuali esempi di utilizzo interessante di queste?
Soluzione
jjujuma,
Per un esempio banale si potrebbe usare questo per attuare alcune Object Oriented procedura di stile come Draw. Si potrebbe chiamare una procedura Circle_Draw per un cerchio o di una procedura per uno Square_Draw Piazza assegnando il PADDR appropriata% del Circle_Draw o Square_Draw al puntatore del procedimento Draw. Quando si chiama il puntatore procedura di Draw si nasconde quale procedura (Circle_Draw o Square_Draw) si sta chiamando.
Altri suggerimenti
Per un esempio pratico, questo può essere utilizzato per implementare callback. Una callback comune può essere trovata nella funzione qsort () in C. Sì, è possibile chiamare che dal ILERPG.
La specifica C
per qsort () è il seguente:
#include <stdlib.h>
void qsort(void *base, size_t num, size_t width,
int(*compare)(const void *key, const void *element));
Il prototipo RPGLE
sarà simile:
dcl-pr qsort ExtName('qsort');
array Pointer value;
num Uns(10) value;
width Uns(10) value;
compare Pointer(*proc) value;
end-pr;
Ecco un semplice programma che qsort () utilizza:
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;
Se lo si esegue, l'uscita sarà:
DSPLY array
DSPLY properly?
DSPLY sort
DSPLY this
DSPLY Does
Ho usato i puntatori procedura per incapsulare la logica per la ricerca di file di spool in un proprio programma di servizio chiamato SPLFFUNC
per rendere più facile per scorrere su di loro.
Nel programma chiamante è possibile utilizzare il codice:
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
e
P ProcessSPLA0100...
P B
D PI
D SPLA LIKEDS(SPLA0100)
P E
La punta di procedura verrà chiamato una volta per ogni file di spool corrispondenti ai criteri richiesti. Questo consente di tornare un enumerabile pigro, invece di un array. Mi piace questo perché è riutilizzabile, non è grato a una dimensione specifica di array (dal momento che so mai quanto di assegnare), ed ha un ingombro di memoria molto più piccolo dal momento che sempre e solo memorizzare una struttura di dati alla volta. Questo è più o meno equivalente a quello che si potrebbe fare con un lambda in un linguaggio come C #. Dal momento che la punta di procedimento possono accedere tutte le variabili globali nel programma client, si chiude su di loro di svolgere il vero lavoro del programma client.
Il codice del programma di servizio gestisce tutti i dettagli scabrosi di chiamare le API, leggere l'oggetto userspace ecc Questo dettaglio può quindi essere tenuto fuori del programma client.
Si noti che RPG non fornisce il tipo in fase di compilazione tipo controllo per questo tipo di tecnica quindi è necessario fare in modo che il formato si richiede e la struttura dati definita nel appuntito procedura di partita.
del servizio del programma:
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
Servizio Programma Prototipi:
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)
Per esempio, CEEHDLR / CEEHDLU (ONU) registra un gestore condizione di scritto dall'utente per lo stack (ingresso) frame corrente.