ponteiros procedimento em RPGLE (PROCPTR)
https://stackoverflow.com/questions/756290
-
09-09-2019 - |
italiano
english
français
española
中国
日本の
العربية
Deutsch
한국어
Português
RussianPergunta
Alguém pode fornecer quaisquer exemplos de uso interessante desses?
Solução
jjujuma,
Para um exemplo trivial, você poderia usar isso para implementar algum procedimento estilo Orientada a Objetos como Draw. Você chamaria de um procedimento Circle_Draw para um círculo ou um procedimento Square_Draw para uma praça, atribuindo o paddr apropriado% do Circle_Draw ou Square_Draw para o ponteiro procedimento Draw. Ao chamar o ponteiro procedimento chamar-lhe esconder que procedimento (Circle_Draw ou Square_Draw) que você está chamando.
Outras dicas
Para um exemplo prático, isso pode ser usado ao implementar retornos de chamada. Um retorno de chamada comum pode ser encontrada na função qsort () em C. Sim, você pode chamar isso de ILERPG.
A especificação C para qsort () é:
#include <stdlib.h>
void qsort(void *base, size_t num, size_t width,
int(*compare)(const void *key, const void *element));
O protótipo RPGLE seria parecido com:
dcl-pr qsort ExtName('qsort');
array Pointer value;
num Uns(10) value;
width Uns(10) value;
compare Pointer(*proc) value;
end-pr;
Aqui é um programa simples que usa 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;
Se você executá-lo, a saída será:
DSPLY array
DSPLY properly?
DSPLY sort
DSPLY this
DSPLY Does
Eu usei ponteiros procedimento para encapsular a lógica para pesquisar arquivos em spool em seu próprio programa de serviço SPLFFUNC nomeado para tornar mais fácil para iterar sobre eles.
No programa de chamada, você pode usar um código como:
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
O pontiagudo para procedimento será chamado uma vez para cada ficheiro em spool correspondem aos critérios solicitados. Isso permite que você retornar um enumeráveis ??preguiçoso em vez de uma matriz. I como este, porque é reutilizável, não está em dívida com um tamanho específico de array (desde que eu nunca sabe quanto alocar), e tem uma pegada de memória muito menor desde que você sempre apenas armazenar uma estrutura de dados de cada vez. Isto é aproximadamente equivalente ao que você faria com um lambda em uma linguagem como C #. Desde o pontiagudo para procedimento pode acessar quaisquer variáveis ??globais no programa cliente, ele fecha sobre eles para realizar o trabalho real do programa cliente.
O código nas alças de programa de serviço todos os detalhes sangrentos de chamar as APIs, a leitura do objeto userspace etc. Este detalhe pode assim ser mantido fora do programa cliente.
Note que RPG não fornece verificação de tipo do tipo de compilação para este tipo de técnica que você deve certificar-se de que o formato que você solicitar e a estrutura de dados definida no pontiagudo para jogo procedimento.
Programa de Serviço:
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
serviço do programa Protótipos:
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)
Por exemplo, CEEHDLR / CEEHDLU (un) registra um manipulador condição escrita pelo usuário para a pilha (entrada) do quadro atual.
Licenciado em: CC-BY-SA com atribuição
Não afiliado a StackOverflow
