WRKACTJOB で 「11. 呼び出しスタックの表示」 によってコール・スタックを表示することが
できるが、ユーザー・プログラムを使って自分で直接、スタックの内容を検索したい場合がある。
上位のプログラムの名前を知りたい場合もあるからである。
スタックの内容を検索したいという要求は多くあるのだが、手軽に検索できる方法はこれまで
紹介されてこなかった。

最も簡単な方法としては

DSPJOB     JOB(*) OUTPUT(*PRINT) OPTION(*PGMSTK)

としてスタックの内容をスプールに出力し、自分でそのスプールの内容を検索する方法がある。
しかし OS400 のスプール出力は OS400リリースによって予告なしに変更されることが多いので将来をサポートする方法としては適切ではない。
特に V5R3M0 では癖がある。

そこで、ここでは V5R1M0 から使用可能なスタック検索 API : QWVRCSTK を使って行う
スタックの検索方法を紹介する。

             PGM                                                       
/*---------------------------------------------------------*/          
/*   RTVCALSTK   :    コール・スタックの検索               */          
/*---------------------------------------------------------*/          
             DCL        VAR(&MSG) TYPE(*CHAR) LEN(80)                  
             DCL        VAR(&RCVVAR) TYPE(*CHAR) LEN(1024)             
             DCL        VAR(&RCVLEN) TYPE(*CHAR) LEN(4)                
             DCL        VAR(&JIDF0100) TYPE(*CHAR) LEN(60)             
             DCL        VAR(&JOB) TYPE(*CHAR) LEN(10) +                
                          VALUE('*         ')                          
             DCL        VAR(&USER) TYPE(*CHAR) LEN(10)                 
             DCL        VAR(&JOBNBR) TYPE(*CHAR) LEN(6)                
             DCL        VAR(&JOBID) TYPE(*CHAR) LEN(16)                
             DCL        VAR(&THIND) TYPE(*CHAR) LEN(4)                 
             DCL        VAR(&THREAD) TYPE(*CHAR) LEN(8) +              
                          VALUE(X'0000000000000000')                   
             DCL        VAR(&APIERR) TYPE(*CHAR) LEN(4) +              
                          VALUE(X'00000000') /* 2 進数  */             
             DCL        VAR(&RESERVE) TYPE(*CHAR) LEN(2) VALUE(X'0000')
             DCL        VAR(&NUM_BIN) TYPE(*CHAR) LEN(4)               
             DCL        VAR(&NUM) TYPE(*DEC) LEN(8 0)                  
             DCL        VAR(&N) TYPE(*DEC) LEN(8 0) VALUE(1)           
             DCL        VAR(&OFFSET_BIN) TYPE(*CHAR) LEN(4)            
             DCL        VAR(&OFFSET) TYPE(*DEC) LEN(8 0)               
             DCL        VAR(&SIZE_BIN) TYPE(*CHAR) LEN(4)              
             DCL        VAR(&SIZE) TYPE(*DEC) LEN(8 0)                 
             DCL        VAR(&STACK) TYPE(*CHAR) LEN(512)               
             DCL        VAR(&PGM) TYPE(*CHAR) LEN(10)                  
             DCL        VAR(&PGMLIB) TYPE(*CHAR) LEN(10)               
             MONMSG     MSGID(CPF0000) EXEC(GOTO CMDLBL(ERROR))        
                                                                       
             CHGVAR     VAR(%BIN(&RCVLEN)) VALUE(1024)                 
             CHGVAR     VAR(%BIN(&THIND)) VALUE(2)                     
             CHGVAR     VAR(&JIDF0100) VALUE(&JOB *CAT &USER *CAT +    
                          &JOBNBR *CAT &JOBID *CAT &RESERVE *CAT +     
                          &THIND *CAT &THREAD)                         
             CALL       PGM(QWVRCSTK) PARM(&RCVVAR &RCVLEN +           
                          'CSTK0100' &JIDF0100 'JIDF0100' &APIERR)     
             CHGVAR     VAR(&NUM_BIN) VALUE(%SST(&RCVVAR 9 4))         
             CHGVAR     VAR(&NUM) VALUE(%BIN(&NUM_BIN))                
             CHGVAR     VAR(&OFFSET_BIN) VALUE(%SST(&RCVVAR 13 4))     
              CHGVAR     VAR(&OFFSET) VALUE(%BIN(&OFFSET_BIN))        
              CHGVAR     VAR(&OFFSET) VALUE(&OFFSET + 1)              
 LOOP:                                                                
              CHGVAR     VAR(&SIZE_BIN) VALUE(%SST(&RCVVAR &OFFSET 4))
              CHGVAR     VAR(&SIZE) VALUE(%BIN(&SIZE_BIN))            
              CHGVAR     VAR(&STACK) VALUE(%SST(&RCVVAR &OFFSET +     
                           &SIZE))                                    
              CHGVAR     VAR(&PGM) VALUE(%SST(&STACK 25 10))          
              CHGVAR     VAR(&PGMLIB) VALUE(%SST(&STACK 35 10))       
              SNDPGMMSG  MSG('PGM    = ' *CAT &PGM) MSGTYPE(*COMP)    
              SNDPGMMSG  MSG('PGMLIB = ' *CAT &PGMLIB) MSGTYPE(*COMP) 
              IF         COND(&N *LT &NUM) THEN(DO)                   
              CHGVAR     VAR(&N) VALUE(&N + 1)                        
              CHGVAR     VAR(&OFFSET) VALUE(&OFFSET + &SIZE)          
              GOTO       LOOP                                         
              ENDDO                                                   
              RETURN                                                  
                                                                      
  ERROR:      RCVMSG     RMV(*NO) MSG(&MSG)                           
  SNDMSG:     SNDPGMMSG  MSG(&MSG) MSGTYPE(*DIAG)                     
              ENDPGM            

【 解説 】