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 =
* ===================================================================
* ——————————————————————-
* – 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 cette ressource
Etude « RSE 2023 » avec Atos et son entité sustainability EcoAct
La réglementation qui oblige désormais les entreprises à agir vertueusement envers le climat, va se renforcer pour évaluer les efforts et la communication de leurs actions et leur suivi. L’enquête d’Atos vise à déterminer la connaissance des entreprises sur les réglementations et les obligations qui leur incombent. Votre entreprise est-elle équipée efficacement pour répondre à ces défis, à la réglementation et aux nouvelles attentes ? Voici 10 questions qui vous permettront de faire un état des lieux.
