> Tech > Figure II

Figure II

Tech - Par iTPro - Publié le 24 juin 2010
email

Programme de service CallStack

*===================================================================
* = Service Program... CallStack =
* = Description....... Call stack routines =
* = =
* = Compile........... CrtRPGMod Module(YourLib/CallStack) =
* = SrcFile(YourLib/YourSrcFile) =
* = CrtSrvPgm SrvPgm(YourLib/CallStack) =
* = Export(*All) =
* ===================================================================

H NoMain

* ===================================================================
* = Prototypes =

Figure II

* ===================================================================

* ——————————————————————-
* – RtvNbrStkEnt – Retrieve number of call stack entries –
* ——————————————————————-
D RtvNbrStkEnt PR 1à˜I à˜
D 1à˜ Value
D 1à˜ Value
D 6 Value
D 272 Options( *NoPass )

* ——————————————————————-
* – RtvStkEnt – Retrieve call stack entry –
* ——————————————————————-
D RtvStkEnt PR N
D 1à˜ Value
D 1à˜ Value
D 6 Value
D 1à˜I à˜ Value
D 1à˜I à˜
D 1à˜
D 1à˜
D 1à˜
D 1à˜
D 1à˜
D 4à˜96
D 272 Options( *NoPass )

* ——————————————————————-
* – RtvCallStkAPI – Retrieve call stack API –
* ——————————————————————-
D RtvCallStkAPI PR ExtPgm( ‘QWVRCSTK’ )
D 65535
D 1à˜I à˜
D 8
D 56
D 8
D 272

* ===================================================================
* = Procedure….. RtvNbrStkEnt =
* = Description… Retrieve number of call stack entries =
* ===================================================================

.
.
.

D RtvInfoDS DS 65535
D 8
D TotStkEnt 1à˜I à˜
D 4
D NbrStkEnt 1à˜I à˜
D 8
D Status 1

.
.
.

D RtvInfoDS DS 65535
D 8
D TotStkEnt 1à˜I à˜
D FirstEntOff 1à˜I à˜
D NbrStkEnt 1à˜I à˜
D 8
D Status 1

D RtvInfoDSLen S 1à˜I à˜ Inz( %Len( RtvInfoDS ) )
D RtvInfoFmt S 8 Inz( ‘CSTKà˜1à˜à˜’ )

D StkEntDS DS Based( StkEntPtr )
D EntLen 1à˜I à˜
D 8
D PrcDisplace 1à˜I à˜
D PrcNameLen 1à˜I à˜
D RequestLevel 1à˜I à˜
D PgmName 1à˜
D PgmLibName 1à˜
D 4
D ModName 1à˜
D ModLibName 1à˜
D 8
D ActGrpName 1à˜

StkEntPtr S *

PrcNameArea S 4à˜96 Based( PrcNamePtr )
PrcNamePtr S *

D PrcName S 4à˜96

D JobIDInfoDS DS
D JobName 1à˜ Inz( *Blank )
D JobUser 1à˜ Inz( *Blank )
D JobNbr 6 Inz( *Blank )
D 16 Inz( *Blank )
D 2 Inz( *AllX’à˜à˜’ )
D 1à˜I à˜ Inz( 2 )
D 8 Inz( *AllX’à˜à˜’ )

D JobIDFmt S 8 Inz( ‘JIDFà˜1à˜à˜’ )$
D BadStatusError DS
D 1à˜I à˜ Inz( %Size( BadStatusError
D 1à˜I à˜ Inz( 16 )
D 7 Inz( ‘CPF9898′ )
D 1 Inz( X’à˜à˜’ )
D 256 Inz( ‘Unexpected error’ )

D BadEntNbrError DS
D 1à˜I à˜ Inz( %Size( BadEntNbrError ) )
D 1à˜I à˜ Inz( 2à˜ )
D 7 Inz( ‘CPF9898′ )
D 1 Inz( X’à˜à˜’ )
D 256 Inz( ‘Invalid entry number’ )

D RcvSizeError DS
D 1à˜I à˜ Inz( %Size( RcvSizeError ) )
D 1à˜I à˜ Inz( 16 )
D 7 Inz( ‘CPF9898′ )
D 1 Inz( X’à˜à˜’ )
D 256 Inz( ‘Receiver too small’ )

* ——————————————————————-
* – Determine whether API error parameter was passed –
* ——————————————————————-
C If %Parms > 11
C Eval APIErrorPassed = *On
C EndIf

* ——————————————————————-
* – Load input parameters –
* ——————————————————————-
C Eval JobName = JobNameIn
C Eval JobUser = JobUserIn
C Eval JobNbr = JobNbrIn

* ——————————————————————-
* – Retrieve call stack –
* ——————————————————————-
C Reset APIErrorDS
C CallP RtvCallStkAPI(
C R tvInfoDS :
C RtvInfoDSLen:
C RtvInfoFmt :
C JobIDInfoDS :
C JobIDFmt :
C APIErrorDS
C )
C If BytesAvail <> NoAPIError
C ExSr ReturnError
C EndIf

H
I
J
C If EntNbr <= *Zero or
C EntNbr > NbrStkEnt
C Eval APIErrorDS = BadEntNbrError
C ExSr ReturnError
C EndIf

C If Status <> *Blank
C Eval APIErrorDS = BadStatusError
C ExSr ReturnError
C EndIf

C If NbrStkEnt <> TotStkEnt
C Eval APIErrorDS = RcvSizeError
C ExSr ReturnError
C EndIf

* ——————————————————————-
* – Extract call stack entry information –
* ——————————————————————-
C Eval StkEntPtr = %Addr( RtvInfoDS ) +
C FirstEntOff
C Do EntNbr
C Eval PrcNamePtr = StkEntPtr + PrcDisplace
C Eval PrcName = %Subst( PrcNameArea:
C 1 :
C PrcNameLen )
C Eval RtnRqsLvl = RequestLevel
C Eval RtnPgmName = PgmName
C Eval RtnPgmLib = PgmLibName
C Eval RtnModName = ModName
C Eval RtnModLib = ModLibName
C Eval RtnActGrpName = ActGrpName
C Eval RtnPrcName = PrcName
C Eval StkEntPtr = StkEntPtr + EntLen
C EndDo
C Return *Off

* ——————————————————————-
* – Subroutine…. ReturnError –
* – Description… Return error condition to caller –
* ——————————————————————-
C ReturnError BegSr
C If APIErrorPassed
C Eval APIError = APIErrorDS
C EndIf
C Return *On
C EndSr

Téléchargez gratuitement cette ressource

Comment cerner la maturité digitale de votre entreprise ?

Comment cerner la maturité digitale de votre entreprise ?

Conçu pour les directions IT et Métiers, ce guide vous permettra d'évaluer précisément vos processus de communication client, d'identifier vos lacunes et points d'inflexion pour établir un plan d’actions capable de soutenir durablement votre évolution. Bénéficiez maintenant d'une feuille de route complète.

Tech - Par iTPro - Publié le 24 juin 2010