A Matter of Time - Part 2 - COBOL

A Matter of Time - Part 1 - Introduction

Back again to build a version of the TDF_LAP() Timing function in COBOL. This is a set of 21 timing entries used to easily monitor timings for embedded or stand-alone routines or SQL statements.

Above: LEGO Guy inspecting the World Time Zones before warming up with some COBOL.

Flashback: LEGO Guy Loves Assembler

Of course the LEGO Guy loves Assembler - virtually building programs brick by brick - but he also likes to warm up with other languages - this time COBOL. After building the lapse routine - TDF-LAP - he'll give it a quick test run. Just a main process that calls another one - with the nested timings produced for each.

Sample Log Output:

This version displays the level along with BEG/END times, lapsed time and the message.

TDF-LAP Function (Procedure) - TDFPROC.CPY

The input parameters consist of an operation code - BEG or END, a timing level - zero thru 20, and a message to print on the END operation. The routine will also populate output fields for the difference in seconds and the difference in the format HHHH:MI:SS.SSSSS - these can be used as needed (or ignored).

*The function is part of the TDFPROC.CPY Copybook (uses TDFWORK.CPY for working storage)

      *****************************************************************
      *    TDF LAP - LAPSE BETWEEN BEGIN/END TIMES (SQL TIMINGS)      *
      *****************************************************************
      *                                                               *
      *    FIELD              I/O  DESCRIPTION                        *
      *    -----------------  ---  ---------------------------------- *
      *    TDX-LAP-OPER        I   OPERATION TYPE (BEG/END)           *
      *    TDX-LAP-LEV         I   LAPSE INDEX SET (0 THRU 20)        *
      *    TDX-LAP-MSG         I   DISPLAY MESSAGE TEXT               *
      *    TDX-LAP-DIFF        O   BEG/END LAPSE IN SECONDS           *
      *    TDX-LAP-TXT-HMS     O   BEG/END LAPSE IN HHHH:MM:SS.SSSSS  *
      *                                                               *
      *****************************************************************
      *                                                               *
      *    EXAMPLE:                                                   *
      *    ---------------------------------------------------------- *
      *    MOVE 0              TO TDX-LAP-LEV                         *
      *    MOVE 'BEG'          TO TDX-LAP-OPER                        *
      *    PERFORM TDF-LAP                                            *
      *    <snip>                                                     *
      *    MOVE 0              TO TDX-LAP-LEV                         *
      *    MOVE 'END'          TO TDX-LAP-OPER                        *
      *    MOVE 'PROCESS-MAIN' TO TDX-LAP-MSG                         *
      *    PERFORM TDF-LAP                                            *
      *    ---------------------------------------------------------- *
      *    RESULTS:                                                   *
      *    L(00) BEG(2024:12:17_16:41:42) END(2024:12:17_16:41:43) -  *
      *          HMS(0000:00:01.35000) MSG: PROCESS-MAIN              *
      *    ---------------------------------------------------------- *
      *         *SINGLE LINE DISPLAYED FOR EACH NESTED LEVEL*         *
      *****************************************************************

       TDF-LAP.
           
           IF TDX-LAP-LEV-OK
               
              COMPUTE TDX-LAP-IDX         = TDX-LAP-LEV + 1
              
              MOVE FUNCTION CURRENT-DATE TO TDX-LAP-END(TDX-LAP-IDX)
              
              IF TDX-LAP-OPER-END
                 
                 MOVE TDX-LAP-BEG(TDX-LAP-IDX) TO TDX-SEC-IN
                 PERFORM TDF-SECONDS
                 MOVE TDX-SEC-OUT TO TDX-LAP-BEG-SEC
                 
                 MOVE TDX-SEC-IN( 1:4) TO TDX-LAP-TXT-BEG-Y
                 MOVE TDX-SEC-IN( 5:2) TO TDX-LAP-TXT-BEG-M
                 MOVE TDX-SEC-IN( 7:2) TO TDX-LAP-TXT-BEG-D
                 MOVE TDX-SEC-IN( 9:2) TO TDX-LAP-TXT-BEG-H
                 MOVE TDX-SEC-IN(11:2) TO TDX-LAP-TXT-BEG-I
                 MOVE TDX-SEC-IN(13:2) TO TDX-LAP-TXT-BEG-S

                 
                 MOVE TDX-LAP-END(TDX-LAP-IDX) TO TDX-SEC-IN
                 PERFORM TDF-SECONDS
                 MOVE TDX-SEC-OUT TO TDX-LAP-END-SEC
                 
                 MOVE TDX-SEC-IN( 1:4) TO TDX-LAP-TXT-END-Y
                 MOVE TDX-SEC-IN( 5:2) TO TDX-LAP-TXT-END-M
                 MOVE TDX-SEC-IN( 7:2) TO TDX-LAP-TXT-END-D
                 MOVE TDX-SEC-IN( 9:2) TO TDX-LAP-TXT-END-H
                 MOVE TDX-SEC-IN(11:2) TO TDX-LAP-TXT-END-I
                 MOVE TDX-SEC-IN(13:2) TO TDX-LAP-TXT-END-S
                 
                 COMPUTE TDX-LAP-DIFF = TDX-LAP-END-SEC
                                      - TDX-LAP-BEG-SEC
                 
                 MOVE TDX-LAP-DIFF TO TDX-HMS-SEC
                 PERFORM TDF-HMS

                 MOVE TDX-LAP-LEV TO TDX-LAP-TXT-LEV
                 MOVE TDX-HMS-TXT TO TDX-LAP-TXT-HMS
                 MOVE TDX-LAP-MSG TO TDX-LAP-TXT-MSG

                 DISPLAY TDX-LAP-TXT
                 
              END-IF
              
              MOVE FUNCTION CURRENT-DATE TO TDX-LAP-BEG(TDX-LAP-IDX)              
              
           ELSE
              DISPLAY '***ERROR - LEVELS 0 THRU 20 ONLY***'  
           END-IF
           .
       TDF-LAP-EXIT.
           EXIT.

      *****************************************************************

TDF-SECONDS Function - Convert Full Date/Time to Seconds

An additional function - TDF-SECONDS - is used to convert the dates to seconds. The intrinsic function INTEGER-OF-DATE returns the number of days since January 1, 1601 for both BEG/END values. The days are converted to seconds with a full day being removed. The time (Hours, minutes, seconds) are then converted and added to the total seconds. This allows an accurate lapsed time to be calculated by the TDF-LAP primary function.Yet one more function is utilized to convert the lapsed seconds into HHHH:MI.SS.SSSSS format - TDF-HMS.

      *****************************************************************
      *    TDF SECONDS - CONVERT FULL DATE FIELD TO SECONDS           *
      *****************************************************************
      *                                                               *
      *    FIELD              I/O  DESCRIPTION                        *
      *    -----------------  ---  ---------------------------------- *
      *    TDX-SEC-IN          I   FULL 20 CHARACTER DATE/TIME FIELD  *
      *    TDX-SEC-OUT         O   CONVERSION TO SECONDS              *
      *                                                               *
      *****************************************************************
      *                                                               *
      *    EXAMPLE:                                                   *
      *    ---------------------------------------------------------- *
      *    MOVE FUNCTION CURRENT-DATE TO TDX-SEC-IN                   *
      *    PERFORM TDF-SECONDS                                        *
      *    DISPLAY 'SECONDS: ' TDX-SEC-OUT                            *
      *    ---------------------------------------------------------- *
      *    RESULTS: 2024121715132474+050 => 013379008404.74000        *
      *                                                               *
      *****************************************************************
               
       TDF-SECONDS.
           
           COMPUTE TDX-SEC-INT
                 = FUNCTION INTEGER-OF-DATE(TDX-SEC-DATE)

           COMPUTE TDX-SEC-OUT
                 = (TDX-SEC-INT * (24*60*60))
                 - (24*60*60)
                 + (TDX-SEC-HH * 3600)
                 + (TDX-SEC-MI * 60)
                 + (TDX-SEC-SS)
                 + (TDX-SEC-MS / 100)
           .
       TDF-SECONDS-EXIT.
           EXIT.

      *****************************************************************

 

TDF-HMS Function - Format Lapsed Seconds (HMS)

This stand-alone function simply converts seconds into a more readable format - Hours, Minutes and Seconds. This will appear on the TDF-LAP Timing Log Output.

      *****************************************************************
      *    TDF HMS - CONVERT SECONDS TO HHHH:MM:SS.SSSSS FORMAT       *
      *****************************************************************
      *                                                               *
      *    FIELD              I/O  DESCRIPTION                        *
      *    -----------------  ---  ---------------------------------- *
      *    TDX-HMS-SEC         I   NUMBER OF SECONDS                  *
      *    TDX-HMS-TXT         O   OUTPUT STRING: HHHH:MM:SS.SSSSS    *
      *                                                               *
      *****************************************************************
      *                                                               *
      *    EXAMPLE:                                                   *
      *    ---------------------------------------------------------- *
      *    MOVE 22506.256          TO TDX-HMS-SEC                     *
      *    PERFORM TDF-HMS                                            *
      *    DISPLAY " OUT: " TDX-HMS-TXT                               *
      *    ---------------------------------------------------------- *
      *    RESULTS:  0006:15:06.25600 (22506.256 SECONDS)             *
      *                                                               *
      *****************************************************************

        TDF-HMS.

           COMPUTE TDX-HMS-HH  = TDX-HMS-SEC / 3600
           
           COMPUTE TDX-HMS-SEC = TDX-HMS-SEC
                               - (TDX-HMS-HH * 3600)
                               
           COMPUTE TDX-HMS-MM  = TDX-HMS-SEC / 60
           
           COMPUTE TDX-HMS-SEC = TDX-HMS-SEC
                               - (TDX-HMS-MM * 60)
           
           COMPUTE TDX-HMS-SS  = TDX-HMS-SEC

           MOVE TDX-HMS-HH    TO TDX-HMS-TXT-HH
           MOVE TDX-HMS-MM    TO TDX-HMS-TXT-MM
           MOVE TDX-HMS-SS    TO TDX-HMS-TXT-SS
                      
           .
       TDF-HMS-EXIT.
           EXIT.

      *****************************************************************

 

TDFWORK.CPY - Supporting Fields for TDFPROC.CPY Routines.

The working storage fields/arrays are contained in the TDFWORK.CPY copybook.

      *****************************************************************
      *    TDF FUNCTION PARAMETERS / WORKING STORAGE                  *
      *****************************************************************

       01  TDX-HMS-PARMS.
           05  TDX-HMS-SEC            PIC 9(12)V9(5) COMP-3.
           05  TDX-HMS-HH             PIC 9(6)       COMP-3.
           05  TDX-HMS-MM             PIC 9(3)       COMP-3.
           05  TDX-HMS-SS             PIC 9(3)V9(5)  COMP-3.
           05  TDX-HMS-TXT.
               10  TDX-HMS-TXT-HH     PIC 9(4).
               10  FILLER             PIC X          VALUE ':'.
               10  TDX-HMS-TXT-MM     PIC 9(2).
               10  FILLER             PIC X          VALUE ':'.
               10  TDX-HMS-TXT-SS     PIC 9(2).9(5).

       01  TDX-SECONDS-PARMS.
           05  TDX-SEC-INT            PIC  9(8).
           05  TDX-SEC-OUT            PIC  9(16)V9(5) COMP-3.
           05  TDX-SEC-IN.
               10  TDX-SEC-DATE       PIC  9(8).
               10  TDX-SEC-TIME.
                   15  TDX-SEC-HH     PIC  9(2).
                   15  TDX-SEC-MI     PIC  9(2).
                   15  TDX-SEC-SS     PIC  9(2).
                   15  TDX-SEC-MS     PIC  9(2).
               10  TDX-SEC-GMT        PIC S9(4).

       01  TDX-LAP-PARMS.
           05  TDX-LAP-OPER           PIC  X(3).
               88  TDX-LAP-OPER-BEG   VALUE 'BEG'.
               88  TDX-LAP-OPER-END   VALUE 'END'.
           05  TDX-LAP-LEV            PIC  99.
               88  TDX-LAP-LEV-OK     VALUES 0 THRU 20.
           05  TDX-LAP-MSG            PIC  X(50).
           05  TDX-LAP-BEG-SEC        PIC  9(12)V9(5) COMP-3.
           05  TDX-LAP-END-SEC        PIC  9(12)V9(5) COMP-3.
           05  TDX-LAP-DIFF           PIC  9(12)V9(5) COMP-3.
           05  TDX-LAP-IDX            PIC  99.
           05  TDX-LAP-MTX            OCCURS 21 TIMES.
               10  TDX-LAP-BEG        PIC  X(20).
               10  TDX-LAP-END        PIC  X(20).
           05  TDX-LAP-TXT.
               10  FILLER             PIC  X(2) VALUE 'L('.
               10  TDX-LAP-TXT-LEV    PIC  99.
               10  FILLER             PIC  X(6) VALUE ') BEG('.
               10  TDX-LAP-TXT-BEG-Y  PIC  9999.
               10  FILLER             PIC  X    VALUE ':'.
               10  TDX-LAP-TXT-BEG-M  PIC  99.
               10  FILLER             PIC  X    VALUE ':'.
               10  TDX-LAP-TXT-BEG-D  PIC  99.
               10  FILLER             PIC  X    VALUE '_'.
               10  TDX-LAP-TXT-BEG-H  PIC  99.
               10  FILLER             PIC  X    VALUE ':'.
               10  TDX-LAP-TXT-BEG-I  PIC  99.
               10  FILLER             PIC  X    VALUE ':'.
               10  TDX-LAP-TXT-BEG-S  PIC  99.
               10  FILLER             PIC  X(6) VALUE ') END('.
               10  TDX-LAP-TXT-END-Y  PIC  9999.
               10  FILLER             PIC  X    VALUE ':'.
               10  TDX-LAP-TXT-END-M  PIC  99.
               10  FILLER             PIC  X    VALUE ':'.
               10  TDX-LAP-TXT-END-D  PIC  99.
               10  FILLER             PIC  X    VALUE '_'.
               10  TDX-LAP-TXT-END-H  PIC  99.
               10  FILLER             PIC  X    VALUE ':'.
               10  TDX-LAP-TXT-END-I  PIC  99.
               10  FILLER             PIC  X    VALUE ':'.
               10  TDX-LAP-TXT-END-S  PIC  99.
               10  FILLER             PIC  X(6) VALUE ') HMS('.
               10  TDX-LAP-TXT-HMS    PIC  X(16).
               10  FILLER             PIC  X(7) VALUE ') MSG: '.
               10  TDX-LAP-TXT-MSG    PIC  X(50).

      *****************************************************************

Test all 21 nested timings:

Here's a simple COBOL procedure that loops 21 times to populate BEG times for nested levels 0 thru 20. Then it loops an additional 21 times to populate the END times for levels 20 down to 0. A log entry will be printed for each END operation. The LAPSE-LOOP just creates a delay - otherwise the timings will vary in microseconds only.

           MOVE 0               TO TDX-LAP-LEV
           PERFORM UNTIL TDX-LAP-LEV > 20
              MOVE 'BEG'        TO TDX-LAP-OPER
              PERFORM TDF-LAP
              ADD 1             TO TDX-LAP-LEV
              PERFORM LAPSE-LOOP
           END-PERFORM

           PERFORM LAPSE-LOOP

           MOVE 21              TO TDX-LAP-LEV
           PERFORM UNTIL TDX-LAP-LEV <= 0
              PERFORM LAPSE-LOOP
              SUBTRACT 1      FROM TDX-LAP-LEV
              MOVE 'END'        TO TDX-LAP-OPER
              MOVE 'LEVEL TEST' TO TDX-LAP-MSG
              PERFORM TDF-LAP
           END-PERFORM

Full Test Output:

Running the test program TDDATE through OpenCobolIDE - the results are printed to the log.

Success! BEG/END times are registered for each level along with lapsed time. The first test loop set the BEG times while the second test loop marked the END and produced the output. Each level listed is a subset of the next with 20 being the lowest nest and 0 the primary. The entry levels can be used in any fashion - nested or not.

That's the end of the COBOL Timing Demonstration - Up next PC/370 Assembler.

A Matter of Time - Part 1 - Intro

It was only a matter of time before I posted an article about my TDF_LAP() function - which is literally a "matter of time". I created this useful function to measure the timings of routines and SQL statements in SQR batch processes. It's actually a set of timing entries that can be nested - levels 0 thru 20. In general, a simple BEG and END call will calculate the elapsed time in between and print the results on a log.

Above: LEGO Guy returns - he's going to replicate the TDF_LAP function in Asssembler. Stay tuned...

Flashback: LEGO Guy loves Assembler

Sample Log Output - AP Vendor/Sourcing Extract

Process_Main uses timing set number 1 and contains all the other routines which use the stand-alone level of zero. The nested levels end and appear first followed by the high level Process_Main routine which displays the total BEG/END information.

 

 

 

TDF_LAP() Function

Below are the usage notes & parameter descriptions for the TDF_LAP() function. The LOG Y/N option is useful if a routine or SQL statement is executed multiple times - say 1000 or more. The calculated lapsed time (#O_sec) can then be aggregated & printed after all instances have executed instead of printing 1000+ log entries.

!**********************************************************************
!*       LAPSE Between Begin/End Times                                *
!**********************************************************************
!*                                                                    *
!*        INPUT: $I_oper    - Operation Type (BEG/END)                *
!*               #I_idx     - Lapse Index Set (0 thru 20)             *
!*               $I_log     - Display Log Output? (Y/N)               *
!*               $I_msg     - Message Text                            *
!*       OUTPUT: #O_sec     - Lapsed in seconds                       *
!*               $O_hms     - Lapsed in HH:MI:SS Format               *
!*                                                                    *
!**********************************************************************
!*                                                                    *
!*      EXAMPLE: do TDF_LAP('BEG', 0, 'N','', #O_sec, $O_hms)         *
!*               ...                                                  *
!*               do TDF_LAP('END', 0, 'Y', 'Lapsed', #O_sec, $O_hms)  *
!*                                                                    *
!*      RESULTS: Displays Duration between BEG/END times.             *
!*               Returns Duration in both seconds and HH:MI:SS.       *
!*               Resets BEG time to END time for next lapse message.  *
!*               Index Set 0 used for timings (0 thru 20 available) - *
!*               use different sets for nested timings (otherwise 0). *
!*                                                                    *
!**********************************************************************

Sample - Nested Timings

The routine below is part of a much larger process - a custom Voucher Edit/Build module. The routine NSS_Edit_AP_Invoice_Dup will use timing levels 7, 8 and 9 to track each nested component of the routine.

!**********************************************************************
!*       NSS Edit AP Invoice Duplicate                                *
!**********************************************************************

begin-procedure NSS_Edit_AP_Invoice_Dup

do TDF_LAP('BEG', 7, 'N', '', #O_sec, $O_hms)

let $DUP_VNDR               = ' and a.vendor_setid  = ~<SETID>~ '   ||
                              ' and a.vendor_id     = u.vendor_id '

let $DUP_VNDR               = replace($DUP_VNDR, '<SETID>', $NSS_setid_vendor)
let $DUP_VNDR               = replace($DUP_VNDR, '~', chr(39))

create-array name=DUPmtx size=5 field=DUPsql:char

let DUPmtx.DUPsql (0)       = ' and a.business_unit = u.business_unit '
let DUPmtx.DUPsql (1)       = $DUP_vndr
let DUPmtx.DUPsql (2)       = ' and a.invoice_id    = u.invoice_id '
let DUPmtx.DUPsql (3)       = ' and a.invoice_dt    = u.invoice_dt '
let DUPmtx.DUPsql (4)       = ' and a.gross_amt     = u.invoice_amount '

!   Initialize Defaults at Origin/BU Levels

let #DUPdef                 = #OPT_dup_inv_comb_code

!   Update Staging Detail with Specified/Default Combination Options

let $SQL_proc               = 'NSS_Edit_AP_Invoice_Dup (Options)'
let $SQL_action             = 'Update'
let $SQL_table              = 'XX_API_STG_DTL'

do TDF_LAP('BEG', 8, 'N', '', #O_sec, $O_hms)

begin-sql On-Error=Error-Routine

update ps_xx_api_stg_dtl      u
   set (u.dup_invoice_ind,
        u.dup_inv_comb_code) =
       (select a.dup_invoice_ind,
               decode(a.dup_invoice_ind,
               'D', #DUPdef,
                 decode(a.dup_invoice_action,
                   'K',a.dup_inv_comb_code,0))
          from ps_vendor_invoice   a
         where a.setid           = $NSS_setid_vendor
           and a.vendor_id       = u.vendor_id
           and a.effdt           =
               (select max(a2.effdt)
                  from ps_vendor_invoice   a2
                 where a2.setid          = a.setid
                   and a2.vendor_id      = a.vendor_id
                   and a2.effdt         <= sysdate))
 where u.business_unit      = $NSS_business_unit
   and u.xx_batch_type      = $NSS_xx_batch_type
   and u.xx_batch_id        = #NSS_xx_batch_id
   and u.xx_line_status     = 'P'
   and exists
       (select 'X'
          from ps_vendor_invoice   a
         where a.setid           = $NSS_setid_vendor
           and a.vendor_id       = u.vendor_id
           and a.effdt          <= sysdate)

end-sql

do TDF_LAP('END', 8, 'Y', $SQL_proc, #O_sec, $O_hms)

!    Cycle Thru Distinct Combinations (Dynamic SQL)

do TDF_LAP('BEG', 8, 'N', '', #O_sec, $O_hms)

begin-select

dup.dup_inv_comb_code

  let $DUPwhere             = ''
  let #DUPcode              = &dup.dup_inv_comb_code
  let #DUPmap               = &dup.dup_inv_comb_code
  while #DUPmap             > 0
     do TDF_ERRBIT(#DUPmap, #DUPidx, #DUPval)
     let $DUPsql            = DUPmtx.DUPsql (#DUPidx)
     let $DUPwhere          = $DUPwhere || $DUPsql
  end-while

  do NSS_Edit_AP_Invoice_Dup_SQL

 from ps_xx_api_stg_dtl       dup
where dup.business_unit     = $NSS_business_unit
  and dup.xx_batch_type     = $NSS_xx_batch_type
  and dup.xx_batch_id       = #NSS_xx_batch_id
  and dup.xx_line_status    = 'P'
  and dup.dup_inv_comb_code > 0
group by dup.dup_inv_comb_code

end-select

let $SQL_proc               = 'NSS_Edit_AP_Invoice_Dup [SQL Cycles]'

do TDF_LAP('END', 8, 'Y', $SQL_proc, #O_sec, $O_hms)

let $SQL_proc               = 'NSS_Edit_AP_Invoice_Dup (Total)'

do TDF_LAP('END', 7, 'Y', $SQL_proc, #O_sec, $O_hms)

end-procedure

!**********************************************************************
!*       NSS Edit AP Invoice Duplicates (per SQL Combination)         *
!**********************************************************************

begin-procedure NSS_Edit_AP_Invoice_Dup_SQL

let $SQL_proc              = 'NSS_Edit_AP_Invoice_Dup_SQL'
let $SQL_action            = 'Update'
let $SQL_table             = 'XX_API_STG_DTL'

do TDF_LAP('BEG', 9, 'N', '', #O_sec, $O_hms)

begin-sql On-Error=Error-Routine

update ps_xx_api_stg_dtl     u
   set u.xx_err_ap         = u.xx_err_ap + {ERR_AP_duplicate},
       u.xx_errors         = u.xx_errors + 1
 where u.business_unit     = $NSS_business_unit
   and u.xx_batch_type     = $NSS_xx_batch_type
   and u.xx_batch_id       = #NSS_xx_batch_id
   and u.xx_line_status    = 'P'
   and u.dup_inv_comb_code = #DUPcode
   and exists
      (select 'X'
         from ps_voucher        a
        where 1 = 1
         [$DUPwhere]
          and a.business_unit in
              (select z.setcntrlvalue
                 from ps_set_cntrl_rec   z
                where z.setid          = $NSS_setid_vendor
                  and z.recname        = 'VENDOR')
          and a.invoice_id    = u.invoice_id
          and a.entry_status <> 'X'
          and a.close_status <> 'C');

commit;

end-sql

let $SQL_proc              = $SQL_proc || ' [' || to_char(#DUPcode) || ']'

do TDF_LAP('END', 9, 'Y', $SQL_proc, #O_sec, $O_hms)

end-procedure

!**********************************************************************

Portion of LOG Output:

 

The TDF_LAP() calls are highlighted in the code above. The 'nested' timings use levels 7, 8 and 9 in this example. The entire routine took .49 micro-seconds as shown by the last line (level 7 timing). The two nested level 8 entries show .32 and .17 microseconds - level 9 is a subset of the second level 8 entry at .06 microseconds.

The TDF_LAP() function is a staple in all my SQR processes.

Coming up - COBOL and Assembler/370 versions.