Programmbibliothek in einem Cobol oder CL Programm ermitteln

[Fuerchau]

Das ist kein Systemmodul sondern eine stinknormale MI-Anweisung, die im RPG/LE ausgeführt wird (MATPTR).

[schatte]

Das RPG Programm als Modul einzubinden ist kein Problem und funktioniert auch einwandfrei. Hatte ich schonmal getestet. Da wir aber nicht mit RPG programmieren, kann ich diese Lösung leider nicht verwenden.

[Fuerchau]

Nun, ob du nun ein API verwendest oder ein CLLE-Modul oder ein RPGLE-Modul tut der Sache an Sich keinen Abbruch.

Die Idee, ein kleines RPGLE-Modul einzubinden und als Funktion aufzurufen "call procedure ... returning ..." ist doch gar nicht so übel.
Man muss nur sagen, dass dies ein API ist.

[BenderD]

QBaldur: Falls du die PSDS meinst, das muss ein Variablen Export aus der Runtime sein, die ist ohne jeden Aufruf immer aktuell gefüllt

Das ist kein Systemmodul sondern eine stinknormale MI-Anweisung, die im RPG/LE ausgeführt wird (MATPTR).

[DVE]

@Schatte
Habe vor zwei Jahre wissen wollen wie mein Programmstack aussieht. Ich wollte nämlich einen rekursiven Aufruf verhindern. Da es eine API zu dem Thema gibt, schrieb ich ein Programm und fertig.
Wenn deine Frage darauf abzieht zu wissen, welches Programm (/Bibliothek) gerade ausgeführt wird, sollte diese API die Lösung sein, oder ??
Gruß
DVE

[schatte]

Hast du ein Programmbeispiel zu diesem API?

Gruß
Matthias

[DVE]

Habe das Programm etwas modifiziert, da es bei mir einen etwas anderen Zweck erfüllt.
Brauchtst es nur als RPGLE umzuwandeln und fertisch.
Das Programm liefert den Programmname/Bibliothek des aufrufenden Programmes zurück.
Gruß
DVE

     *
     D GetCaller       PR                  Extpgm('QWVRCSTK')                                       
     D                             2000                                                             
     D                               10I 0                                                          
     D                                8    CONST                                                    
     D                               56                                                             
     D                                8    CONST                                                    
     D                               15                                                             
     **                                                                     --**                    
     D Var             DS         65534                                                             
     D  BytAvl                       10I 0                                                          
     D  BytRtn                       10I 0                                                          
     D  Entries                      10I 0                                                          
     D  Offset                       10I 0                                                          
     D  EntryCount                   10I 0                                                          
     D VarLen          S             10I 0 Inz(%size(Var))                                          
     D APIErrorDS      DS                                                                           
     D                               10I 0 Inz( %Size( APIErrorDS ) )                               
     D  BytesAvail                   10I 0 Inz( *Zero )                                             
     D                                7    Inz( *Blanks )                                           
     D                                1    Inz( X'00' )                                             
     D  errmsg                 9     15                                                             
     D                              256    Inz( *Blanks )                                           
     **                                                                     --**                    
     D JobIdInf        DS                                                                           
     D  JIDQName                     26    Inz( *Blank )                                            
     D  JIDIntID                     16                                                             
     D  JIDRes3                       2    Inz(*Allx'00')                                           
     D  JIDThreadInd                 10I 0 Inz(2)                                                   
     D  JIDThread                     8    Inz(*Allx'00')                                           
     ** beginn hauptprogramm                                                --**                    
     D ReaStack        DS           256                                                             
     D  EntryLen                     10I 0                                                          
     D  PgmName                      10    Overlay(ReaStack:25)                                     
     D  PgmLib                       10    Overlay(ReaStack:35)                                     
     D  QWVSI01                      10    OVERLAY(ReaStack:117)                                    
     D                                                                                              
     D ProgramName     DS            20                                                             
     D  Programm                     10                                                             
     D  Library                      10                                                             
      *                                                                                             
     D                SDS                                                                           
     D  ThisPgm                1     10                                                             
      *                                                                                             
     ** beginn hauptprogramm                                                --**                    
     c     *entry        plist                                                                      
     c                   parm                    ReturnCode        7                                
     c                   parm                    ProgramName      20                                
      *                                                                                             
     c                   movel(p)  '*'           JIDQName                                           
     c                   movel(p)  *BLANKS       ReturnCode                                         
      *                                                                                             
     c                   z-add     0             timea             6 0                              
     c                   z-add     0             zahl              6 0                              
     c     errmsg        doueq     *blanks                                                          
     c     errmsg        oreq      'CPF3C53'                                                        
     c     zahl          orge      3                                                                
     c                   reset                   APIErrorDS                                         
     C                   CallP     GetCaller(Var:VarLen:'CSTK0100':JobIdInf                         
     C                             :'JIDF0100':APIErrorDS)                                          
     c                   time                    timeb             6 0                              
     c     timea         ifne      timeb                                                            
     c                   add       1             zahl                                               
     c                   z-add     timeb         timea                                              
     c                   endif                                                                      
     c                   enddo                                                                      
     c     errmsg        ifeq      *BLANKS                                                          
     c                   movel     *BLANKS       ProgramName                                        
     C                   Do        Entries                                                          
     C                   Eval      ReaStack  = %subst(Var:Offset + 1)                               
     C                   Eval      Offset    = Offset + EntryLen                                    
      * programm und programmlib nach array                                                         
     c     PgmName       ifne      'QCMD'                                                           
     c     PgmName       andne     ThisPgm                                                          
     c     ProgramName   andeq     *BLANKS                                                          
     c                   movel(p)  PgmName       Programm                                           
     c                   movel(p)  Pgmlib        Library                                            
     c                   endif                                                                      
      *                                                                                             
     C                   Enddo                                                                      
     c                   else                                                                       
     c                   movel     *blanks       ProgramName                                        
     c     '*'           cat       errmsg:0      ProgramName                                        
     c                   movel(p)  errmsg        ReturnCode                                         
     c                   endif                                                                      
      *                                                                                             
     C                   return 

[schatte]

Vielen Dank für dein Programmbeispiel!