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(&NUM) VALUE(&NUM - 1)                               
             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