Reflection

Displays information about the current location in the stack, like program, moule, procedure, statement id, job id, thread id.

     /**
      * @file who.rpgle
      *
      * Test of who_am_i().
      *
      * Output of WHO:
      * @code
      * DSPLY  Program:         QGPL/WHO
      * DSPLY  Module:          QTEMP/WHO
      * DSPLY  Procedure:       WHO
      * DSPLY  Statement ID:            81
      * DSPLY  Job ID:          TEA       ABC       268988
      * DSPLY  Thread ID:       0000000000000030
      * @endcode
      */
      /if defined(*crtbndrpg)
     h dftactgrp(*no) bnddir('QC2LE')
      /endif
 
 
     D reflection_getLocation...
     D                 PR                  likeds(reflection_location_t)
     D                                     extproc('reflection_getLocation')
     D  invocationLevel...
     D                               10I 0 const options(*nopass)
 
     D reflection_location_t...
     D                 DS                  qualified template
     D  program                      21A
     D  program_library...
     D                               10A   overlay(program)
     D  program_separator...
     D                                1A   overlay(program : *next)
     D  program_name...
     D                               10A   overlay(program : *next)
     D  module                       10A
     D  procedure                   255A
     D  job                          26A
     D  job_name                     10A   overlay(job)
     D  job_user                     10A   overlay(job : *next)
     D  job_number                    6A   overlay(job : *next)
     D  thread                       16A
 
 
 
     /**
      * DS used by who_am_i() to represent program info.
      */
     d pgm_info_t      ds                  qualified
     d     ctx                       10a
     d     name                      10a
 
     /**
      * DS used by who_am_i() to represent module info.
      */
     d module_info_t   ds                  qualified
     d     name                      10a
     d     qualifier                 10a
 
     /**
      * DS used to represent variable length procedure name.
      */
     d proc_name_t     ds                  qualified
     d                                     based(dummy_ptr)
     d     len                        5u 0
     d     name                   32767a
 
     /**
      * DS used to represent statement ID list.
      */
     d stmt_list_t     ds                  qualified
     d                                     based(dummy_ptr)
     d     num                        5u 0
     d     stmt                      10i 0 dim(1024)
 
     /* Job ID and thread ID. */
     d job_id_thread_id_t...
     d                 ds                  qualified
     d     jid                       30a
     d     tid                        8a
 
     /**
      * Who am I?
      *
      * @param [out] pgm_info, returned program info.
      * @param [out] mod_info, returned module info.
      * @param [out] proc_name, returned procedure name.
      * @param [out] stmst, returned statement ID list.
      * @param [out] MI process (job) id and thread id.
      * @param [in]  inv_offset, offset of target invocation.
      *              -1 if no passed, which means who_am_i()'s caller.
      *
      * @return 1-byte invocation type.
      *         hex 00 = Non-bound program
      *         hex 01 = Bound program
      *         hex 02 = Bound service program
      *         hex 04 = Java program
      *         hex FF = invalid input parameters
      */
     d who_am_i        pr             1a
     d     pgm_info                        likeds(pgm_info_t)
     d     mod_info                        likeds(module_info_t)
     d     proc_name                       likeds(proc_name_t)
     d     stmts                           likeds(stmt_list_t)
     d     job_thd_id                      likeds(job_id_thread_id_t)
     d                                     options(*nopass)
     d     inv_offset                10i 0 value options(*nopass)
 
     d cvthc           pr                  extproc('cvthc')
     d     receiver                    *   value
     d     source                      *   value
     d     length                    10i 0 value
 
     D location        DS                  likeds(reflection_location_t)
     D dsp             S             50A
 
      /free
       location = reflection_getLocation();
 
       dsp = location.procedure;
       dsply dsp;
       dsply location.job_user;
       dsply location.job_number;
       dsply location.program;
       dsply location.program_name;
       dsply location.program_library;
 
 
       *inlr = *on;
      /end-free
 
 
     P reflection_getLocation...
     P                 B                   export
     D                 PI                  likeds(reflection_location_t)
     D  pInvocationLevel...
     D                               10I 0 const options(*nopass)
      *
     D invocationLevel...
     D                 S             10I 0 inz(-2)
     D location        DS                  likeds(reflection_location_t)
      *
     D pgm_info        DS                  likeds(pgm_info_t)
     D mod_info        DS                  likeds(module_info_t)
     D proc_name       DS                  likeds(proc_name_t) based(proc_ptr)
     D stmts           DS                  likeds(stmt_list_t) based(stmt_ptr)
     D thread          DS                  likeds(job_id_thread_id_t)
     D tmp             S             16A
      /free
       if (%parms() = 1);
         invocationLevel = pInvocationLevel;
       endif;
 
       clear location;
 
       proc_ptr = %alloc(2 + 255);
       proc_name.len = 255;
 
       stmt_ptr = %alloc(2 + 4 * 0);
       stmts.num = 0;
 
       who_am_i(pgm_info : mod_info : proc_name : stmts : thread :
                invocationLevel );
 
       location.program = pgm_info.ctx + '/' + pgm_info.name;
       location.module = mod_info.name;
       location.procedure = %subst(proc_name.name : 1 : proc_name.len);
       location.job = thread.jid;
       location.thread = thread.tid;
 
       cvthc(%addr(location.thread) : %addr(thread.tid) : 16);
 
       dealloc proc_ptr;
       dealloc stmt_ptr;
 
       return location;
      /end-free
     P                 E
 
 
 
 
 
 
 
     /* implementation of who_am_i */
     p who_am_i        b                   export
 
      /copy mih52
 
     d who_am_i        pi             1a
     d     pgm_info                        likeds(pgm_info_t)
     d     mod_info                        likeds(module_info_t)
     d     proc_name                       likeds(proc_name_t)
     d     stmts                           likeds(stmt_list_t)
     d     job_thd_id                      likeds(job_id_thread_id_t)
     d                                     options(*nopass)
     d     inv_offset                10i 0 value options(*nopass)
 
     d inv_id          ds                  likeds(invocation_id_t)
     d susptr          ds                  likeds(matinvat_ptr_t)
     d sel             ds                  likeds(matinvat_selection_t)
     d ptrd            ds                  likeds(matptrif_susptr_tmpl_t)
     d mask            s              4a
     d pcs_tmpl        ds                  likeds(matpratr_ptr_tmpl_t)
     d matpratr_opt    s              1a   inz(x'25')
     d syp_attr        ds                  likeds(matptr_sysptr_info_t)
 
      /free
           // initialize invocation id
           inv_id = *allx'00';
           if %parms() > 5;
               if inv_offset > 0;
                   return x'FF';
               endif;
               inv_id.src_inv_offset = inv_offset;
           else;
               inv_id.src_inv_offset = -1;  // caller's invocation
           endif;
 
           // materialize suspend pointer of target invocation
           sel = *allx'00';
           sel.num_attr   = 1;
           sel.attr_id    = 24;  // suspend pointer
           sel.rcv_length = 16;
           matinvat2( susptr
                    : inv_id
                    : sel );
 
           // materialize suspend ptr
           ptrd = *allx'00';
           ptrd.bytes_in = %size(ptrd);
           ptrd.proc_name_length_in = proc_name.len;
           ptrd.proc_name_ptr = %addr(proc_name.name);
           ptrd.stmt_ids_in = stmts.num;
           ptrd.stmt_ids_ptr = %addr(stmts.stmt);
           mask = x'5B280000';  // 01011011,00101000,00000000,00000000
             // bit 1 = 1, materialize program type
             // bit 3 = 1, materialize program context
             // bit 4 = 1, materialize program name
             // bit 6 = 1, materialize module name
             // bit 7 = 1, materialize module qualifier
             // bit 10 = 1, materialize procedure name
             // bit 12 = 1, materialize statement id list
           matptrif( ptrd : susptr.ptr : mask );
 
           // set output parameters
           pgm_info.ctx       = ptrd.pgm_ctx;
           pgm_info.name      = ptrd.pgm_name;
           mod_info.name      = ptrd.mod_name;
           mod_info.qualifier = ptrd.mod_qual;
           proc_name.len      = ptrd.proc_name_length_out;
           stmts.num          = ptrd.stmt_ids_out;
 
           // if job id and thread id is requested
           if %parms() > 4;
               exsr rtv_job_thd_id;
           endif;
 
           // return materialized program type
           return ptrd.pgm_type;
 
           // retrieve job id and thread id
           begsr rtv_job_thd_id;
 
               // retrieve the PCS pointer of the current MI process
               pcs_tmpl.bytes_in = %size(pcs_tmpl);
               matpratr1(pcs_tmpl : matpratr_opt);
 
               // retrieve the name of the PCS ptr, aka job ID
               syp_attr.bytes_in = %size(syp_attr);
               matptr(syp_attr : pcs_tmpl.ptr);
               job_thd_id.jid = syp_attr.obj_name;
 
               job_thd_id.tid = retthid(); // thread id
           endsr;
 
      /end-free
     p who_am_i        e