COBOL Binary search

We had a situation where we loaded a large VSAM file into memory to be searched by online CICS application. We encountered problems trying to emulate the VSAM START verb using COBOL SEARCH ALL verb when the key does not exist in the array. To get around this we had to write our own BINARY SEARCH in COBOL. 

The array which we are searching contains about 240,000 entries. 

We found that the hand coded BINARY SEARCH was significantly more efficient in terms of CPU usage than the COBOL "SEARCH ALL" verb. 

The code was modeled after KNUTH's binary search, see this link 

http://www.z390.org/contest/p21/P21DW1.TXT 

the key to maximizing the performance of the code below was to use PIC S9(8) COMP for all the binary fields. This avoids the check for binary overflow in the generated code. Also we used the compiler option TRUNC(OPT) to avoid the code generated to check for truncation. 

Note --> the IF statement after the PERFORM loop is to check for a "not found" condition. To emulate the VSAM START command we need to position the INDEX to the first row which is >= the search key. 

           MOVE +1                     TO BIN-LOW. 

           MOVE BCNTR-TCA1-ENTRIES-USED 

                                       TO BIN-HIGH. 

           PERFORM WITH TEST AFTER 

               UNTIL BIN-LOW > BIN-HIGH 

               COMPUTE BIN-RANGE = BIN-HIGH - BIN-LOW 

               COMPUTE BIN-MID = (BIN-RANGE / 2) + BIN-LOW 

               SET TCA1-INDEX          TO BIN-MID 

               EVALUATE TRUE 

                   WHEN TCA1-KEY (TCA1-INDEX) = SRCH-TCA1-KEY 

                       MOVE 1          TO BIN-RANGE 

                       COMPUTE BIN-LOW = BIN-HIGH + 1 

                   WHEN TCA1-KEY (TCA1-INDEX) < SRCH-TCA1-KEY 

                       COMPUTE BIN-LOW  = BIN-MID + 1 

                   WHEN OTHER 

                       COMPUTE BIN-HIGH  = BIN-MID - 1 

               END-EVALUATE 

           END-PERFORM. 

           IF TCA1-KEY (TCA1-INDEX) < SRCH-TCA1-KEY 

               SET TCA1-INDEX          UP BY +1 

           END-IF. 

Row-Value-Expression and Quantified Predicates in Db2

Row-Value-Expression in Db2

A row-value-expression allows you to compare multiple columns (or values) at once as a tuple. Instead of writing separate conditions for each column, you can group them together.

General Syntax

(COL1, COL2, COL3) operator (Value1, Value2, Value3)

·        Both sides must have the same number of values.

·        Data types must be compatible.

·        Comparisons are evaluated pair by pair.

·        If any comparison involves NULL, the result may be Unknown.

Operators Explained with Examples

1. Equality (=)

(COL1, COL2, COL3) = (100, 'X', 2000)

·       Row (100, 'X', 2000) → True

·       Row (100, 'Y', 2000) → False

·       Row (100, NULL, 2000) → Unknown

2. Inequality (<>)

(COL1, COL2, COL3) <> (100, 'B', 500)

·       Row (100, 'B', 500) → False (all equal)

·       Row (100, 'C', 500) → True (COL2 <> 'B')

·       Row (101, 'B', 500) → True (COL1 <> 100)

3. Less Than (<)

(COL1, COL2, COL3) < (100, 'B', 500)

·       Row (100, 'A', 500) → True ('A' < 'B')

·       Row (99, 'Z', 999) → True (99 < 100)

·       Row (100, 'B', 400) → True (400 < 500)

4. Greater Than (>)

(COL1, COL2, COL3) > (100, 'B', 500)

·       Row (100, 'C', 500) → True ('C' > 'B')

·       Row (101, 'A', 300) → True (101 > 100)

·       Row (100, 'B', 600) → True (600 > 500)

5. Less Than or Equal (<=)

(COL1, COL2, COL3) <= (100, 'B', 500)

·       Row (100, 'B', 500) → True (exact match)

·       Row (100, 'A', 500) → True ('A' < 'B')

·       Row (99, 'Z', 999) → True (99 < 100)

6. Greater Than or Equal (>=)

(COL1, COL2, COL3) >= (100, 'B', 500)

·       Row (100, 'B', 500) → True (exact match)

·       Row (100, 'C', 500) → True ('C' > 'B')

·       Row (101, 'A', 300) → True (101 > 100)

The detailed IBM manual can be found at the following link:

 https://www.ibm.com/docs/en/db2-for-zos/12.0.0?topic=predicates-basic-predicate#db2z_basicpredicate__fnocop

 

Quantified Predicates in Db2

A quantified predicate compares a value (or a row of values) against a set of values returned by a subquery (fullselect). It uses operators together with quantifiers like ALL, SOME, or ANY.

General Syntax

expression operator {ALL | SOME | ANY} (fullselect1)

(row-value-expression) operator {ALL | SOME | ANY} (fullselect2)

·       expression → single value compared against a column of values.

·       row-value-expression → tuple of values compared against multiple columns.

·       fullselect → subquery returning one or more values.

Behavior of Quantifiers

1. ALL

• True if the relationship holds for every value returned by the subquery.
• False if the relationship fails for at least one value.
• Unknown if no comparison is false, but at least one is unknown due to NULL.
• Special case: If the subquery returns no rows, the result is True.

2. SOME / ANY

• True if the relationship holds for at least one value returned by the subquery.
• False if the subquery is empty or the relationship fails for all values.
• Unknown if no comparison is true, but at least one is unknown due to NULL.

Examples

TBLA

COLA
1
2
3
4

TBLB

 

COLB	COLC
2	2
3	–

TBLC

COLB	COLC
2	2

Example 1: ALL

COLA > ALL (SELECT COLB FROM TBLB UNION SELECT COLB FROM TBLC)

·       Subquery returns {2, 3}.

·       Predicate is False for rows 1, 2, 3.

·       True for row 4 (4 > 2 and 4 > 3).

Example 2: ANY

COLA > ANY (SELECT COLB FROM TBLB UNION SELECT COLB FROM TBLC)

·       Subquery returns {2, 3}.

·       Predicate is False for rows 1, 2.

·       True for rows 3, 4 (3 > 2, 4 > 2 or 3).

Example 3: ALL with NULL

COLA > ALL (SELECT COLC FROM TBLB UNION SELECT COLC FROM TBLC)

·       Subquery returns {2, NULL}.

·       Predicate is False for rows 1, 2.

·       Unknown for rows 3, 4 (because of NULL).

Example 4: SOME with NULL

COLA > SOME (SELECT COLC FROM TBLB UNION SELECT COLC FROM TBLC)

·       Subquery returns {2, NULL}.

·       Predicate is Unknown for rows 1, 2.

·       True for rows 3, 4 (3 > 2, 4 > 2).

Example 5: Empty Result with ALL

COLA < ALL (SELECT COLB FROM TBLB WHERE COLB > 3

            UNION

            SELECT COLB FROM TBLC WHERE COLB > 3)

·       Subquery returns empty set.

·       Predicate is True for all rows (special case).

Example 6: Empty Result with ANY

COLA < ANY (SELECT COLB FROM TBLB WHERE COLB > 3

            UNION

            SELECT COLB FROM TBLC WHERE COLB > 3)

·       Subquery returns empty set.

·       Predicate is False for all rows.

The detailed IBM manual can be found at the following link:

https://www.ibm.com/docs/en/db2-for-zos/12.0.0?topic=predicates-quantified-predicate

REXX/JCL to Format DB2 Timeout, Deadlock, and Lock-Related Messages

Below is a simple REXX program and the corresponding JCL used to format the following DB2 messages:

DSNT376I - TIMEOUT

DSNT375I - DEADLOCK

DSNT501I - RESOURCE UNAVAILABLE

DSNI031I - LOCK ESCALATION

DSNJ031I - Unit of Recovery (UR) has written a high volume of log records without a commit or rollback

REXX code : DB2MSGFMT

/* REXX */

 "EXECIO * DISKR IN (FINIS STEM IN_REC."

 TMO_CNT = 0

 DED_CNT = 0

 RSC_CNT = 0

 UCM_CNT = 0

 ESC_CNT = 0

 CALL WRITE_HEADERS

 TRACE N

 DO I = 1 TO IN_REC.0

    IF SUBSTR(IN_REC.I,19,5) = '----' &,

       SUBSTR(IN_REC.I,47,5) = '----' THEN

    DO

       DT = SUBSTR(IN_REC.I,35,11)

       ITERATE

    END

    IF SUBSTR(IN_REC.I,20,8) = 'DSNT376I' THEN

    DO

       CALL EXTRACT_DATA

       CALL WRITE_TIME_OUT_DATA

       ITERATE

    END

    IF SUBSTR(IN_REC.I,20,8) = 'DSNT375I' THEN

    DO

       CALL EXTRACT_DATA

       CALL WRITE_DEADLOCK_DATA

       ITERATE

    END

    IF SUBSTR(IN_REC.I,20,8) = 'DSNT501I' THEN

    DO

       CALL CONCAT_LINES

       PARSE VAR BG_LN . 'CORRELATION-ID=' CORR1 .,

                         'CONNECTION-ID='  CONN1 .,

                         'LUW-ID='         LUW1  .,

                         'REASON'          RSN1  .,

                         'TYPE'            TYP1  .,

                         'NAME'            RSC1  .

       CALL WRITE_RESOURCE_DATA

       ITERATE

    END

    IF SUBSTR(IN_REC.I,20,8) = 'DSNJ031I' THEN

    DO

       CALL CONCAT_LINES

       PARSE VAR BG_LN . 'HAS WRITTEN '        CNT1  .,

                         'CORRELATION NAME = ' CORR1 .,

                         'CONNECTION ID  = '   CONN1 .,

                         'LUWID = '            LUW1  .,

                         'PLAN NAME = '        PLN1  .,

                         'AUTHID = '           AUTH1 .,

                         'END USER ID = '      USR1  .,

                         'TRANSACTION NAME = ' XTN1  .,

                         'WORKSTATION NAME = ' WST1  .

       CALL WRITE_UNCOMMIT_LOG_DATA

       ITERATE

    END

    IF SUBSTR(IN_REC.I,20,8) = 'DSNI031I' THEN

    DO

       CALL CONCAT_LINES

       PARSE VAR BG_LN . 'RESOURCE NAME = '    RSC1  .,

                         'LOCK STATE = '       STAT1 .,

       'PLAN NAME : PACKAGE NAME = ' PLN1 ':' PKG1   .,

                         'COLLECTION-ID = '    COLL1 .,

                         'CORRELATION-ID = '   CORR1 .,

                         'CONNECTION-ID = '    CONN1 .,

                         'LUW-ID = '           LUW1  .,

                         'THREAD-INFO = '      THD1  .,

                         'PARTITION-INFO = '   MSG1  ,

                         'ESCALATED'                 .

       CALL WRITE_LOCK_ESC_DATA

       ITERATE

    END

 END

 IF TMO_CNT > 0 THEN

 DO

    TMO_REC.0 = TMO_CNT

    "EXECIO * DISKW TMO (FINIS STEM TMO_REC."

 END

 IF DED_CNT > 0 THEN

 DO

    DED_REC.0 = DED_CNT

    "EXECIO * DISKW DED (FINIS STEM DED_REC."

 END

 IF RSC_CNT > 0 THEN

 DO

    RSC_REC.0 = RSC_CNT

    "EXECIO * DISKW RSC (FINIS STEM RSC_REC."

 END

 IF UCM_CNT > 0 THEN

 DO

    UCM_REC.0 = UCM_CNT

    "EXECIO * DISKW UCM (FINIS STEM UCM_REC."

 END

 IF ESC_CNT > 0 THEN

 DO

    ESC_REC.0 = ESC_CNT

    "EXECIO * DISKW ESC (FINIS STEM ESC_REC."

 END

 EXIT

 WRITE_TIME_OUT_DATA:

    TMO_CNT = TMO_CNT + 1

    TMO_REC.TMO_CNT = DT TM          || ','||,

                      STRIP(PLN1)    || ','||,

                      STRIP(CORR1)   || ','||,

                      STRIP(CONN1)   || ','||,

                      STRIP(LUW1)    || ','||,

                      STRIP(THRD1)   || ','||,

                      STRIP(PLN2)    || ','||,

                      STRIP(CORR2)   || ','||,

                      STRIP(CONN2)   || ','||,

                      STRIP(LUW2)    || ','||,

                      STRIP(THRD2)

 RETURN

 WRITE_DEADLOCK_DATA:

    DED_CNT = DED_CNT + 1

    DED_REC.DED_CNT = DT TM          || ','||,

                      STRIP(PLN1)    || ','||,

                      STRIP(CORR1)   || ','||,

                      STRIP(CONN1)   || ','||,

                      STRIP(LUW1)    || ','||,

                      STRIP(THRD1)   || ','||,

                      STRIP(PLN2)    || ','||,

                      STRIP(CORR2)   || ','||,

                      STRIP(CONN2)   || ','||,

                      STRIP(LUW2)    || ','||,

                      STRIP(THRD2)

 RETURN

 WRITE_RESOURCE_DATA:

    RSC_CNT = RSC_CNT + 1

    RSN1 = ''''||STRIP(RSN1)

    TYP1 = ''''||STRIP(TYP1)

    RSC_REC.RSC_CNT = DT TM          || ','||,

                      STRIP(CORR1)   || ','||,

                      STRIP(CONN1)   || ','||,

                      STRIP(LUW1)    || ','||,

                      RSN1           || ','||,

                      TYP1           || ','||,

                      STRIP(RSC1)

 RETURN

 WRITE_UNCOMMIT_LOG_DATA:

    UCM_CNT = UCM_CNT + 1

    UCM_REC.UCM_CNT = DT TM          || ','||,

                      STRIP(CORR1)   || ','||,

                      STRIP(CONN1)   || ','||,

                      STRIP(LUW1)    || ','||,

                      STRIP(PLN1)    || ','||,

                      STRIP(AUTH1)   || ','||,

                      STRIP(USR1)    || ','||,

                      STRIP(XTN1)    || ','||,

                      STRIP(WST1)    || ','||,

                      'HAS WRITTEN 'CNT1' LOG RECORDS'

 RETURN

 WRITE_LOCK_ESC_DATA:

    ESC_CNT = ESC_CNT + 1

    ESC_REC.ESC_CNT = DT TM          || ','||,

                      STRIP(PLN1)    || ','||,

                      STRIP(PKG1)    || ','||,

                      STRIP(COLL1)   || ','||,

                      STRIP(CORR1)   || ','||,

                      STRIP(CONN1)   || ','||,

                      STRIP(LUW1)    || ','||,

                      STRIP(THD1)    || ','||,

                      STRIP(RSC1)    || ','||,

                      STRIP(STAT1)   || ','||,

                      MSG1 'ESCALATED'

 RETURN

EXTRACT_DATA:

 CALL CONCAT_LINES

 PARSE VAR BG_LN . 'PLAN='           PLN1  .,

                   'CORRELATION-ID=' CORR1 .,

                   'CONNECTION-ID='  CONN1 .,

                   'LUW-ID='         LUW1  .,

                   'THREAD-INFO='    THRD1 .,

                   'PLAN='           PLN2  .,

                   'CORRELATION-ID=' CORR2 .,

                   'CONNECTION-ID='  CONN2 .,

                   'LUW-ID='         LUW2  .,

                   'THREAD-INFO='    THRD2 .

 RETURN

CONCAT_LINES:

 TM = SUBSTR(IN_REC.I,1,8)

 BG_LN = STRIP(IN_REC.I)

 C_NUM = SUBSTR(BG_LN,LENGTH(BG_LN)-2,3)

 DO J = I + 1 TO IN_REC.0

    IF SUBSTR(IN_REC.J,3,1) = ' ' &,

       SUBSTR(IN_REC.J,7,1) = ' ' THEN

       NUM = SUBSTR(IN_REC.J,4,3)

    ELSE

       NUM = '###'

    IF C_NUM = NUM THEN

    DO

       BG_LN = BG_LN || SUBSTR(IN_REC.J,20,69)

       I = J

    END

    ELSE

      LEAVE

 END

 RETURN

 WRITE_HEADERS:

    TMO_CNT = TMO_CNT + 1

    TMO_REC.TMO_CNT = 'TIME,'                ||,

                      'FAILING PLAN,'        ||,

                      'FAILING  CORRID,'     ||,

                      'FAILING  CONNID,'     ||,

                      'FAILING  LUW_ID,'     ||,

                      'FAILING  THREAD INFO,'||,

                      'HOLDING PLAN,'        ||,

                      'HOLDING CORRID,'      ||,

                      'HOLDING CONNID,'      ||,

                      'HOLDING LUW_ID,'      ||,

                      'HOLDING THREAD INFO'

    DED_CNT = DED_CNT + 1

    DED_REC.DED_CNT = TMO_REC.TMO_CNT

    RSC_CNT = RSC_CNT + 1

    RSC_REC.RSC_CNT = 'TIME,'                ||,

                      'FAILING  CORRID,'     ||,

                      'FAILING  CONNID,'     ||,

                      'FAILING  LUW_ID,'     ||,

                      'REASON,'              ||,

                      'TYPE,'                ||,

                      'RESOURCE NAME'

    UCM_CNT = UCM_CNT + 1

    UCM_REC.UCM_CNT = 'TIME,'                ||,

                      'CORRID,'              ||,

                      'CONNID,'              ||,

                      'LUW_ID,'              ||,

                      'PLAN,'                ||,

                      'AUTHID,'              ||,

                      'END_USER_ID,'         ||,

                      'TRANSACTION_NAME,'    ||,

                      'WORKSTATION_NAME,'    ||,

                      MESSAGE

    ESC_CNT = ESC_CNT + 1

    ESC_REC.ESC_CNT = 'TIME,'                ||,

                      'PLAN,'                ||,

                      'PACKAGE,'             ||,

                      'COLL_ID,'             ||,

                      'CORRID,'              ||,

                      'CONNID,'              ||,

                      'LUW_ID,'              ||,

                      'THREAD INFO,'         ||,

                      'RESOURCE NAME,'       ||,

                      'LOCK_STATE,'          ||,

                      MESSAGE

 RETURN

JCL to run the above REXX code

//DELETES  EXEC PGM=IDCAMS

//SYSPRINT DD SYSOUT=*

//SYSIN    DD *

  DEL 'USERID.DED.OUT'

  DEL 'USERID.TMO.OUT'

  DEL 'USERID.RSC.OUT'

  DEL 'USERID.UCM.OUT'

  DEL 'USERID.ESC.OUT'

  SET MAXCC=0

//*

//STEP01   EXEC PGM=IKJEFT01

//SYSTSPRT DD SYSOUT=*

//SYSOUT   DD SYSOUT=*

//IN       DD DISP=SHR,DSN=File that holds the DB2 master started task’s JESMSGLG output

//DED      DD DSN=USERID.DED.OUT,

//         DISP=(,CATLG,DELETE),

//         DCB=(LRECL=400,RECFM=FB),

//         SPACE=(CYL,(10,10),RLSE)

//TMO      DD DSN=USERID.TMO.OUT,

//         DISP=(,CATLG,DELETE),

//         DCB=(LRECL=400,RECFM=FB),

//         SPACE=(CYL,(10,10),RLSE)

//UCM      DD DSN=USERID.UCM.OUT,

//         DISP=(,CATLG,DELETE),

//         DCB=(LRECL=400,RECFM=FB),

//         SPACE=(CYL,(10,10),RLSE)

//ESC      DD DSN=USERID.ESC.OUT,

//         DISP=(,CATLG,DELETE),

//         DCB=(LRECL=400,RECFM=FB),

//         SPACE=(CYL,(10,10),RLSE)

//RSC      DD DSN=USERID.RSC.OUT,

//         DISP=(,CATLG,DELETE),

//         DCB=(LRECL=150,RECFM=FB),

//         SPACE=(CYL,(10,10),RLSE)

//SYSTSIN  DD   *

 EX 'USERID.REXX.LIB(DB2MSGFMT)'

/*

//*

//XMITIP  EXEC PGM=IKJEFT1B,DYNAMNBR=50

//SYSEXEC  DD DISP=SHR,DSN=xmitip.library

//DED      DD DISP=SHR,DSN=USERID.DED.OUT

//TMO      DD DISP=SHR,DSN=USERID.TMO.OUT

//RSC      DD DISP=SHR,DSN=USERID.RSC.OUT

//UCM      DD DISP=SHR,DSN=USERID.UCM.OUT

//ESC      DD DISP=SHR,DSN=USERID.ESC.OUT

//SYSPRINT DD  SYSOUT=*

//SYSTSPRT DD  SYSOUT=*

//SYSTSIN DD   *

%xmitip xxx.xxx@zzz.com +

        MSGT 'CSV files for DB2 log msgs' +

        From xxx.xxx@zzz.com +

        Subject 'csv files' +

        FILEDD (DED TMO RSC UCM ESC) +

        FILENAME (DED.CSV TMO.CSV RSC.CSV UCM.CSV ESC.CSV)

/*

Extracting SMF records : SORT vs IFASMFDP

The below job demonstrates two approaches to extracting SMF record types 70 to 79 from a weekly SMF dataset.

The goal is to compare the performance of the SORT utility and the IFASMFDP utility.
 
Test job
 
//SORT    EXEC PGM=SORT                                     
//SORTIN DD   DISP=SHR,DSN=SMF.WEEKLY.FILE          
//SORTOUT  DD DSN=USERID.SMF7079.SORT,                     
//            DISP=(NEW,CATLG,DELETE),                      
//            DATACLAS=DCTLARGE,                            
//            SPACE=(CYL,(100,100),RLSE),                   
//            DCB=(RECFM=VBS,BLKSIZE=0,LRECL=32760,DSORG=PS)
//SYSOUT DD SYSOUT=*                                        
//SYSIN DD *                                                
 OPTION COPY,VLSHRT                                         
 INCLUDE COND=(06,1,CH,GE,X'46',AND,    SMF TYPE 70         
               06,1,CH,LE,X'4F')        SMF TYPE 79         
//*                                                         
//IFASMFDP   EXEC PGM=IFASMFDP                                
//SYSPRINT DD SYSOUT=*                                      
//INDD1    DD DISP=SHR,DSN=SMF.WEEKLY.FILE          
//OUTDD1   DD DSN=USERID.SMF7079.IFASMFDP,                 
//            DISP=(NEW,CATLG,DELETE),                      
//            DATACLAS=DCTLARGE,                            
//            SPACE=(CYL,(100,100),RLSE),                   
//            DCB=(RECFM=VBS,BLKSIZE=0,LRECL=32760,DSORG=PS)
//SYSIN    DD *                                            
 INDD(INDD1,OPTIONS(ALL))                                  
 OUTDD(OUTDD1,TYPE(70:79))                                 
 START(0000)                                               
 END(2359)                                                 
/*                                                         
 
Job performance data
 

Step	EXCP	Conn	TCB Time	Elapsed Time	CPU Time
SORT	93,346	209K	6.64 sec	3:47.52	6.75 sec
IFASMFDP	1,403,000	308K	12.09 sec	6:40.17	16.16 sec

 
 

• SORT completed in nearly half the time of IFASMFDP.
• CPU usage for IFASMFDP was more than double that of SORT.
• EXCP count (I/O operations) was significantly higher for IFASMFDP

 
Use SORT for quick and lightweight SMF record extraction.
Of course if you need complex SMF record extraction, you would need go with IFASMFDP.