Mainframe Tips, Tricks And Tutorials

Sunday, August 9, 2026

𝗣𝗼𝘁𝗲𝗻𝘁𝗶𝗮𝗹 𝘇/𝗢𝗦 𝟯.2 𝗗𝗲𝗳𝗲𝗰𝘁: 𝗕𝗮𝘀𝗶𝗰 𝗙𝗼𝗿𝗺𝗮𝘁 𝗦𝗲𝗾𝘂𝗲𝗻𝘁𝗶𝗮𝗹 𝗗𝗮𝘁𝗮𝘀𝗲𝘁𝘀 𝗘𝘅𝗰𝗲𝗲𝗱𝗶𝗻𝗴 𝘁𝗵𝗲 𝟲𝟱𝗞 𝗧𝗿𝗮𝗰𝗸 𝗟𝗶𝗺𝗶𝘁

A Mainframe Storage Group reached 99% utilization, resulting in unexpected abends for production jobs utilizing that storage group. As an immediate workaround, additional volumes were added to the storage group to restore capacity and prevent further job failures.

Following the temporary fix, we investigated which datasets were consuming the most space within the storage group. We identified the top storage-consuming datasets and analyzed the jobs responsible for creating them. The investigation revealed that a DB2 Image Copy job was generating these datasets.

The Image Copy job created backup datasets as GDG (Generation Data Group) generations on a daily basis. Since a new generation was created every day, the storage group's utilization continued to grow. To manage disk space, the job included logic to migrate older image copy generations to tape while retaining only the latest generation on disk.

Our analysis showed that most image copy datasets were being successfully migrated to tape. However, a small number of datasets remained on disk and were not being migrated. We further analyzed these datasets and compared the storage group growth trend. The investigation showed that the abnormal growth started after the z/OS 3.1 upgrade.

We then focused on understanding why these specific image copy datasets were not migrating to tape after the z/OS upgrade. The problematic datasets were found to be multi-volume datasets, and occupying more than 65,535 tracks in one or more volumes. These datasets were Basic Format Sequential Datasets.

According to IBM documentation, Basic Format Sequential Datasets are limited to 65,535 tracks per volume. However, these datasets exceeded that limit. As a result, SMS was unable to migrate them to tape, causing the datasets to remain on disk and contributing significantly to the continued growth of the storage group.

Based on the findings, it appears that the z/OS 3.1 was allowing Basic Format Sequential Datasets to exceed the documented 65K track limit per volume. This behavior is likely a defect.

Friday, August 7, 2026

𝗪𝗵𝘆 𝗗𝗦𝗟𝗜𝗦𝗧(𝟯.𝟰) 𝗥𝗲𝗽𝗼𝗿𝘁𝗲𝗱 𝟲% 𝗮𝗻𝗱 𝟯% 𝗨𝘁𝗶𝗹𝗶𝘇𝗮𝘁𝗶𝗼𝗻 𝗼𝗻 𝗙𝘂𝗹𝗹𝘆 𝗢𝗰𝗰𝘂𝗽𝗶𝗲𝗱 𝗠𝘂𝗹𝘁𝗶-𝗩𝗼𝗹𝘂𝗺𝗲 𝗗𝗮𝘁𝗮𝘀𝗲𝘁𝘀: 𝗔 𝗗𝗙𝗦𝗢𝗥𝗧 𝗜𝗻𝘃𝗲𝘀𝘁𝗶𝗴𝗮𝘁𝗶𝗼𝗻

The below dataset spans four volumes, yet DSLIST reports utilization values of only 6% and 3% for the first two volumes. Since sequential datasets normally fill earlier volumes before extending to additional volumes, these figures appeared anomalous and warranted further investigation.

The following DSLIST 3.4 output shows the dataset allocation across four volumes.

Command - Enter "/" to select action                  Message           Volume
      Tracks %     XT Device Dsorg Recfm Lrecl Blksz Created    Referred
-------------------------------------------------------------------------------
         XY67890.PRODHIST.ORDRARCH.BACK.DATA                             XXX710
       69745   6    16 3390     PS   FB      228 27816 2026/08/07 2026/08/07
-------------------------------------------------------------------------------
         XY67890.PRODHIST.ORDRARCH.BACK.DATA                             XXX674
       67860   3    11 3390     PS   FB      228 27816 2026/08/07 2026/08/07
-------------------------------------------------------------------------------
         XY67890.PRODHIST.ORDRARCH.BACK.DATA                             XXX612
       60320 100    14 3390     PS   FB      228 27816 2026/08/07 2026/08/07
-------------------------------------------------------------------------------
         XY67890.PRODHIST.ORDRARCH.BACK.DATA                             XXX678
       60320 93    11 3390     PS   FB      228 27816 2026/08/07 2026/08/07

                             Data Set Information

Data Set Name . . . . : XY67890.PRODHIST.ORDRARCH.BACK.DATA

General Data                          Current Allocation
  Management class . . : XXXACTX        Allocated megabytes : 13,701
  Storage class . . . : XXXX           Allocated extents . : 52
   Volume serial . . . : XXX710 +
   Device type . . . . : 3390
  Data class . . . . . : DCXXXXX
   Organization . . . : PS            Current Utilization
   Record format . . . : FB             Used megabytes . . : 6,532
   Record length . . . : 228            Used extents . . . : 2
   Block size . . . . : 27816
   1st extent megabytes: 100
   Secondary megabytes : 400           Dates
   Data set name type :                Creation date . . . : 2026/08/07
   Data set encryption : NO             Referenced date . . : 2026/08/07
                                        Expiration date . . : ***None***

The following DFSORT job was used to determine how records are distributed across the dataset's four volumes.

The first DFSORT step reads the entire dataset and provides the total record count. Subsequent DFSORT steps specify VOL=(,,2), VOL=(,,3), and VOL=(,,4), causing processing to begin from the second, third, and fourth volume respectively. By subtracting the resulting record counts, the number of records residing on each individual volume can be derived.

//STEP010 EXEC PGM=SORT
//SORTIN   DD DSN=XY67890.PRODHIST.ORDRARCH.BACK.DATA,DISP=SHR
//SORTOUT DD DUMMY
//SYSOUT   DD SYSOUT=*
//SYSIN    DD *
  SORT FIELDS=COPY
//*
//STEP020 EXEC PGM=SORT
//SORTIN   DD DSN=XY67890.PRODHIST.ORDRARCH.BACK.DATA,DISP=SHR,
//            VOL=(,,2)
//SORTOUT DD DSN=XY67890.PRODHIST.ORDRARCH.BACK.DATA.SNGLVOL2,
//            DISP=(,CATLG),
//            SPACE=(1,(200,200),RLSE),AVGREC=M
//SYSOUT   DD SYSOUT=*
//SYSIN    DD *
  SORT FIELDS=COPY
//*
//STEP030 EXEC PGM=SORT
//SORTIN   DD DSN=XY67890.PRODHIST.ORDRARCH.BACK.DATA,DISP=SHR,
//            VOL=(,,3)
//SORTOUT DD DSN=XY67890.PRODHIST.ORDRARCH.BACK.DATA.SNGLVOL3,
//            DISP=(,CATLG),
//            SPACE=(1,(200,200),RLSE),AVGREC=M
//SYSOUT   DD SYSOUT=*
//SYSIN    DD *
  SORT FIELDS=COPY
//*
//STEP040 EXEC PGM=SORT
//SORTIN   DD DSN=XY67890.PRODHIST.ORDRARCH.BACK.DATA,DISP=SHR,
//            VOL=(,,4)
//SORTOUT DD DSN=XY67890.PRODHIST.ORDRARCH.BACK.DATA.SNGLVOL4,
//            DISP=(,CATLG),
//            SPACE=(1,(200,200),RLSE),AVGREC=M
//SYSOUT   DD SYSOUT=*
//SYSIN    DD *
  SORT FIELDS=COPY
//*

Below is the SYSOUT of each step

SORTIN   : RECFM=FB   ; LRECL=   228; BLKSIZE= 27816
SORTIN   : DSNAME=XY67890.PRODHIST.ORDRARCH.BACK.DATA
SORTOUT : DSNAME=NULLFILE
RCD IN   62025525, OUT   62025525

SORTIN   : DSNAME=XY67890.PRODHIST.ORDRARCH.BACK.DATA
SORTOUT : DSNAME=XY67890.PRODHIST.ORDRARCH.BACK.DATA.SNGLVOL2
RCD IN   45007745, OUT   45007745

SORTIN   : DSNAME=XY67890.PRODHIST.ORDRARCH.BACK.DATA
SORTOUT : DSNAME=XY67890.PRODHIST.ORDRARCH.BACK.DATA.SNGLVOL3
RCD IN   28449905, OUT   28449905

SORTIN   : DSNAME=XY67890.PRODHIST.ORDRARCH.BACK.DATA
SORTOUT : DSNAME=XY67890.PRODHIST.ORDRARCH.BACK.DATA.SNGLVOL4
RCD IN   13731825, OUT   13731825

Record Distribution Across Volumes

Volume	Record Count Calculation	Records in Volume
XXX710 (Vol 1)	62,025,525 − 45,007,745	17,017,780
XXX674 (Vol 2)	45,007,745 − 28,449,905	16,557,840
XXX612 (Vol 3)	28,449,905 − 13,731,825	14,718,080
XXX678 (Vol 4)	Remaining Records	13,731,825

Dataset Size and Track Usage Calculation

Volume	Dataset Size (Bytes)	Track Calculation	Tracks Used
XXX710(Vol 1)	3,880,053,840	3,880,053,840 ÷ (2 × 27,816)	69,745
XXX674(Vol 2)	3,775,187,520	3,775,187,520 ÷ (2 × 27,816)	67,860
XXX612(Vol 3)	3,355,722,240	3,355,722,240 ÷ (2 × 27,816)	60,320
XXX678(Vol 4)	3,130,856,100	3,130,856,100 ÷ (2 × 27,816)	56,278

Formula Used
Dataset Size (Bytes) = Records × LRECL
Tracks Used = Dataset Size ÷ (2 × BLKSIZE)

where:
LRECL = 228
BLKSIZE = 27816

DSLIST vs. DFSORT Comparison of Volume Utilization

Volume	DSLIST Tracks	DSLIST Used %	Calculated Tracks Used (DFSORT)	Comparison
XXX710	69,745	6%	69,745	Exact match
XXX674	67,860	3%	67,860	Exact match
XXX612	60,320	100%	60,320	Exact match
XXX678	60,320	93%	56,278	Close match. 60,320 × 93% = 56,098 tracks, which is very close to the calculated value of 56,278 tracks

Conclusion

Although DSLIST reports utilization values of only 6% and 3% for volumes XXX710 and XXX674, DFSORT analysis confirms that both volumes are effectively 100% utilized by dataset data. The calculated track usage matches the DSLIST track counts exactly, demonstrating that the reported percentages are misleading and do not reflect the actual occupancy of these volumes.

For basic format sequential datasets, the maximum number of tracks that can be addressed on a single volume is 65,535. When DSLIST encounters an allocation that exceeds this limit, it appears to calculate the utilization percentage using only the tracks beyond 65,535.

Volume XXX710: 69,745 tracks allocated

Excess tracks = 69,745 − 65,535 = 4,210
DSLIST reported utilization = 4,210 / 69,745 ≈ 6%

Volume XXX674: 67,860 tracks allocated

Excess tracks = 67,860 − 65,535 = 2,325
DSLIST reported utilization = 2,325 / 67,860 ≈ 3%

As a result, DSLIST displays 6% and 3% utilization for the first two volumes even though those volumes are effectively full. The percentages reflect only the tracks beyond the 65,535-track threshold rather than the actual space utilization of the volumes.

The dataset XY67890.PRODHIST.ORDRARCH.BACK.DATA is a basic-format sequential dataset. According to IBM documentation,https://www.ibm.com/docs/en/zos/2.1.0?topic=set-types-dasd-sequential-data-sets, a basic-format sequential dataset on a single volume is limited to a maximum of 65,535 tracks.

However, the system appears to allow allocations that exceed this documented limit. This behavior may indicate a z/OS defect.

Sunday, August 2, 2026

𝗨𝗻𝗱𝗲𝗿𝘀𝘁𝗮𝗻𝗱𝗶𝗻𝗴 𝗦𝗕𝟯𝟳 𝗮𝗻𝗱 𝗦𝗘𝟯𝟳 𝗔𝗯𝗲𝗻𝗱𝘀 𝗳𝗼𝗿 𝗦𝗲𝗾𝘂𝗲𝗻𝘁𝗶𝗮𝗹 𝗗𝗮𝘁𝗮𝘀𝗲𝘁𝘀

When a program continuously writes data to an output sequential dataset, SB37 and SE37 abends can occur if additional space is required. Let's examine how these abends occur using the following DD statement:

//OUTFILE DD DSN=USERID.OUTFILE,

// DISP=(,CATLG,CATLG),

// SPACE=(TRK,(1,1),RLSE),

// LRECL=30,RECFM=FB,VOL=(,,,1)

Case 1: SB37 Abend

An SB37 abend occurs when the dataset has exhausted all the space that can be allocated to it according to its space definition, but the program still needs additional space.

For the DD statement shown above:

Primary allocation = 1 track
Secondary allocation = 1 track
Maximum number of extents allowed for a sequential dataset on a volume = 16 (1 primary extent + 15 secondary extents)

Therefore, the maximum space that can be allocated to USERID.OUTFILE on a single volume is:

1 primary track
15 secondary tracks

Total = 16 tracks

If the program continues writing records after all 16 tracks have been allocated, no additional extents can be obtained. As a result, the job terminates with an SB37 abend.

Case 2: SE37 Abend

An SE37 abend occurs when the system attempts to allocate a new secondary extent, but the required space is NOT available on the volume.

Using the same DD statement:

//OUTFILE DD DSN=USERID.OUTFILE,

// DISP=(,CATLG,CATLG),

// SPACE=(TRK,(1,1),RLSE),

// LRECL=30,RECFM=FB,VOL=(,,,1)

Each time the dataset requires additional space, the system attempts to allocate a secondary extent of 1 track. If sufficient free space is not available on the specified volume, the requested secondary extent cannot be allocated.

In this situation, even though the dataset has not yet reached its maximum limit of 16 extents, the allocation request fails and the job abends with SE37.

Note: If the system cannot allocate the requested primary space, the job step will fail with "JCL error" before execution begins. In such cases, the allocation fails with the message: IGD17272I VOLUME SELECTION HAS FAILED FOR INSUFFICIENT SPACE

Monday, July 27, 2026

Building an MQ Queue Depth Alert Program in COBOL

The following COBOL program is an IBM MQ queue monitoring utility that checks the depth of queues and reports queues that are approaching capacity.

The program:

-> Connects to an IBM MQ Queue Manager.

-> Reads a list of queue names from an input file.

-> For each queue:

Opens the queue for inquiry.

Retrieves:

Current Queue Depth

Maximum Queue Depth

-> Calculates 70% of the maximum queue depth.

-> Displays the queue name if the current depth is greater than or equal to 70% of its maximum capacity.

-> Closes the queue.

-> Disconnects from MQ after all queues are processed.

IDENTIFICATION DIVISION.

PROGRAM-ID. INQDEPTH.

ENVIRONMENT DIVISION.

INPUT-OUTPUT SECTION.

FILE-CONTROL.

SELECT INPUT-FILE ASSIGN TO INFILE.

DATA DIVISION.

FILE SECTION.

FD INPUT-FILE.

01 INPUT-REC PIC X(48).

WORKING-STORAGE SECTION.

01 WS-EOF PIC X(01) VALUE 'N'.

01 WS-CUR-DEPTH PIC 9(9).

01 WS-MAX-DEPTH PIC 9(9).

01 WS-CALC PIC 9(9).

01 MQ-QM-NAME PIC X(48) VALUE SPACES.

01 MQ-HCONN PIC S9(9) COMP-5 VALUE ZERO.

01 MQ-RC PIC S9(9) BINARY.

01 MQ-RSN PIC S9(9) BINARY.

01 MQ-HOBJ PIC S9(9) BINARY.

01 WS-OPTIONS PIC S9(9) BINARY.

01 WS-SELECTORCOUNT PIC S9(9) BINARY VALUE 2.

01 WS-SELECTORS-TABLE.

05 WS-SELECTORS PIC S9(9) BINARY OCCURS 2 TIMES.

01 WS-INTATTRCOUNT PIC S9(9) BINARY VALUE 2.

01 WS-INTATTRS-TABLE.

05 WS-INTATTRS PIC S9(09) BINARY OCCURS 2 TIMES.

01 WS-CHARATTRLENGTH PIC S9(9) BINARY VALUE ZERO.

01 WS-CHARATTRS PIC X(01) VALUE LOW-VALUES.

01 MQM-OBJECT-DESCRIPTOR.

COPY CMQODV.

01 MQM-MESSAGE-DESCRIPTOR.

COPY CMQMDV.

01 MQM-PUT-MESSAGE-OPTIONS.

COPY CMQPMOV.

01 MQM-GET-MESSAGE-OPTIONS.

COPY CMQGMOV.

01 MQM-CONSTANTS.

COPY CMQV SUPPRESS.

PROCEDURE DIVISION.

0000-MAIN.

PERFORM 1000-INITIALIZATION

PERFORM 2000-PROCESS

THRU 2000-PROCESS-EXIT

UNTIL WS-EOF = 'Y'

PERFORM 3000-TERMINATION

GOBACK.

1000-INITIALIZATION.

ACCEPT MQ-QM-NAME.

CALL 'MQCONN' USING

MQ-QM-NAME

MQ-HCONN

MQ-RC

MQ-RSN

IF MQ-RC = MQCC-FAILED

DISPLAY 'MQCONN MQ-RC: ' MQ-RC ' MQ-RSN: ' MQ-RSN

END-IF.

OPEN INPUT INPUT-FILE.

2000-PROCESS.

READ INPUT-FILE

AT END MOVE 'Y' TO WS-EOF

END-READ

IF WS-EOF = 'Y'

GO TO 2000-PROCESS-EXIT

END-IF

PERFORM 2100-OPEN-FOR-INQ

IF MQ-RC NOT = MQCC-OK

GO TO 2000-PROCESS-EXIT

END-IF

MOVE MQIA-CURRENT-Q-DEPTH TO WS-SELECTORS(1)

MOVE MQIA-MAX-Q-DEPTH TO WS-SELECTORS(2)

MOVE 2 TO WS-INTATTRCOUNT

WS-SELECTORCOUNT

CALL 'MQINQ' USING MQ-HCONN

MQ-HOBJ

WS-SELECTORCOUNT

WS-SELECTORS-TABLE

WS-INTATTRCOUNT

WS-INTATTRS-TABLE

WS-CHARATTRLENGTH

WS-CHARATTRS

MQ-RC

MQ-RSN.

IF MQ-RC NOT = MQCC-OK

DISPLAY 'QUEUE: ' INPUT-REC

DISPLAY 'MQINQ MQ-RC: ' MQ-RC ' MQ-RSN: ' MQ-RSN

ELSE

MOVE WS-INTATTRS (1) TO WS-CUR-DEPTH

MOVE WS-INTATTRS (2) TO WS-MAX-DEPTH

IF WS-CUR-DEPTH > 0

COMPUTE WS-CALC = WS-MAX-DEPTH * 0.7

IF WS-CUR-DEPTH >= WS-CALC

DISPLAY INPUT-REC ' ' WS-CUR-DEPTH ' ' WS-MAX-DEPTH

END-IF

PERFORM 2200-CLOSE-QUEUE.

2000-PROCESS-EXIT.

EXIT.

2100-OPEN-FOR-INQ.

MOVE MQOT-Q TO MQOD-OBJECTTYPE

MOVE INPUT-REC TO MQOD-OBJECTNAME

COMPUTE WS-OPTIONS = MQOO-INQUIRE +

MQOO-FAIL-IF-QUIESCING.

CALL 'MQOPEN' USING MQ-HCONN

MQOD

WS-OPTIONS

MQ-HOBJ

MQ-RC

MQ-RSN.

IF MQ-RC NOT = MQCC-OK

DISPLAY 'QUEUE: ' INPUT-REC

DISPLAY 'MQOPEN MQ-RC: ' MQ-RC ' MQ-RSN: ' MQ-RSN

END-IF.

2100-OPEN-FOR-INQ-EXIT.

EXIT.

2200-CLOSE-QUEUE.

CALL 'MQCLOSE' USING MQ-HCONN

MQ-HOBJ

MQCO-NONE

MQ-RC

MQ-RSN.

IF MQ-RC NOT = MQCC-OK

DISPLAY 'QUEUE: ' INPUT-REC

DISPLAY 'MQCLOSE MQ-RC: ' MQ-RC ' MQ-RSN: ' MQ-RSN

END-IF.

2200-CLOSE-QUEUE-EXIT.

EXIT.

3000-TERMINATION.

CALL 'MQDISC' USING

MQ-HCONN

MQ-RC

MQ-RSN.

IF MQ-RC = MQCC-FAILED

DISPLAY 'MQDISC MQ-RC: ' MQ-RC ' MQ-RSN: ' MQ-RSN

END-IF.

CLOSE INPUT-FILE.

3000-TERMINATION-EXIT.

EXIT.

𝗣𝗿𝗲𝘃𝗲𝗻𝘁𝗶𝗻𝗴 𝗗𝗕𝟮 𝗧𝗮𝗯𝗹𝗲 𝗖𝗼𝗻𝘁𝗲𝗻𝘁𝗶𝗼𝗻 𝗕𝗲𝘁𝘄𝗲𝗲𝗻 𝗦𝗘𝗟𝗘𝗖𝗧 𝗚𝗿𝗼𝘂𝗽𝘀 𝗮𝗻𝗱 𝗨𝗽𝗱𝗮𝘁𝗲 𝗝𝗼𝗯𝘀 𝗶𝗻 𝗘𝗦𝗣

We encountered a batch processing scenario where a group of jobs (let's call them the "SELECT Group") performed read-only SELECT operations against a DB2 table. These jobs were allowed to run concurrently with each other, but they could not run at the same time as a specific update job (JOBX) that modified the same table, as doing so could result in table contention and job abend.

Initial Approach: Mutual Exclusion with NOTWITH

ESP provides the NOTWITH statement to define mutually exclusive jobs. One option was to configure every job in the SELECT Group with NOTWITH(JOBX) so they would never run concurrently with JOBX.

JOB JOB1

RUN WORKDAYS

NOTWITH(JOBX)

ENDJOB

JOB JOB2

RUN WORKDAYS

NOTWITH(JOBX)

ENDJOB

JOB JOB3

RUN WORKDAYS

NOTWITH(JOBX)

ENDJOB

...

JOB JOB99

RUN WORKDAYS

NOTWITH(JOBX)

ENDJOB

To make the exclusion fully bidirectional, JOBX would also need to specify all SELECT jobs in its NOTWITH list:

JOB JOBX

RUN WORKDAYS

NOTWITH(JOB1,JOB2,JOB3,...JOB99)

ENDJOB

While this approach works, it becomes difficult to maintain as the number of jobs grows.

Solution with ESP Renewable Resources

The RESOURCE statement allows jobs to reserve and release resources before execution. We defined a virtual renewable resource called MY_TABLE with a maximum count of 99.

The SELECT Group jobs each required 1 unit of MY_TABLE before they could run. Once a job completed, the resource unit was automatically returned to the pool.

JOB JOB1

RUN WORKDAYS

RESOURCE (1,MY_TABLE)

ENDJOB

JOB JOB2

RUN WORKDAYS

RESOURCE (1,MY_TABLE)

ENDJOB

JOB JOB3

RUN WORKDAYS

RESOURCE (1,MY_TABLE)

ENDJOB

...

JOB JOB99

RUN WORKDAYS

RESOURCE (1,MY_TABLE)

ENDJOB

To ensure exclusive access, JOBX was configured to reserve all 99 units of the resource:

JOB JOBX

RUN WORKDAYS

RESOURCE (99,MY_TABLE)

ENDJOB

When JOBX starts, it consumes the entire MY_TABLE resource pool, preventing any SELECT Group jobs from obtaining the single resource unit they require. Conversely, if one or more SELECT jobs are running and holding resource units, JOBX cannot acquire all 99 units and must wait.

This approach effectively creates a synchronization mechanism where:

Multiple SELECT jobs can run concurrently.
JOBX runs exclusively.
No SELECT job can run while JOBX is running.
No lengthy NOTWITH statements are required.

Final Solution

Another elegant way to handle this requirement is by using ESP ENQUEUE, which allows a job to request either shared or exclusive access to a resource without requiring the resource to be predefined. ESP automatically prevents jobs with conflicting enqueue requests from running simultaneously, similar to how z/OS enqueues operate.

In our case, we defined a logical resource named MY_TABLE. All jobs in the SELECT Group requested this resource in SHARED mode, allowing them to run concurrently with one another while accessing the table.

JOB JOB1

RUN WORKDAYS

ENQUEUE NAME(MY_TABLE) SHARED

ENDJOB

JOB JOB2

RUN WORKDAYS

ENQUEUE NAME(MY_TABLE) SHARED

ENDJOB

JOB JOB3

RUN WORKDAYS

ENQUEUE NAME(MY_TABLE) SHARED

ENDJOB

...

JOB JOB99

RUN WORKDAYS

ENQUEUE NAME(MY_TABLE) SHARED

ENDJOB

The Update Job (JOBX) was configured to request EXCLUSIVE ownership of the same resource:

JOB JOBX

RUN WORKDAYS

ENQUEUE NAME(MY_TABLE) EXCLUSIVE

ENDJOB

With this configuration:

Multiple SELECT Group jobs can run simultaneously because they all hold a SHARED enqueue on MY_TABLE.
JOBX cannot start while any SELECT job is running because it requires EXCLUSIVE access.
Likewise, no SELECT job can start while JOBX holds the exclusive enqueue.
The solution is simple, scalable, and requires minimal maintenance as SELECT jobs are added or removed.

𝗦𝗰𝗮𝗻𝗻𝗶𝗻𝗴 𝗮 𝟰𝟬 𝗞𝗕 𝗗𝗮𝘁𝗮 𝗔𝗿𝗲𝗮 𝗳𝗼𝗿 𝗟𝗼𝘄𝗲𝗿𝗰𝗮𝘀𝗲 𝗖𝗵𝗮𝗿𝗮𝗰𝘁𝗲𝗿𝘀: 𝗔 𝟱𝟬-𝗠𝗜𝗣𝗦 𝗢𝗽𝘁𝗶𝗺𝗶𝘇𝗮𝘁𝗶𝗼𝗻 𝗦𝘁𝗼𝗿𝘆

A CICS transaction was executing across approximately 150 CICS regions. As part of the transaction flow, a COBOL program contained the code shown below to check for the presence of lowercase alphabetic characters within a 40 KB data area. This code was consuming about 50 MIPS during peak CPU utilization.

MOVE 'N' TO WS-LC-FOUND

PERFORM VARYING WS-SUB1 FROM 1 BY 1

UNTIL WS-SUB1 > LENGTH OF WS-DATA

OR WS-LC-FOUND = 'Y'

IF WS-DATA (WS-SUB1:1) = 'a' OR 'b' OR 'c' OR 'd' OR

'e' OR 'f' OR 'g' OR 'h' OR

'i' OR 'j' OR 'k' OR 'l' OR

'm' OR 'n' OR 'o' OR 'p' OR

'q' OR 'r' OR 's' OR 't' OR

'u' OR 'v' OR 'w' OR 'x' OR

'y' OR'z'

MOVE 'Y' TO WS-LC-FOUND

END-IF

END-PEFORM

Initial Optimization Approach

To address the CPU overhead, I developed an assembler-based alternative that used the TRT instruction to perform the lowercase character check far more efficiently than the original COBOL implementation. While the approach achieved significant performance improvements, the customer declined to implement it because assembler code was considered difficult to maintain and support.

Revised Solution

To address the customer's maintainability concerns, I developed an alternative solution using standard COBOL code, shown below. The COBOL compiler internally generated code that leveraged the assembler TRT (Translate and Test) instruction to scan for lowercase characters efficiently. The customer accepted this approach because it avoided the need to maintain assembler source code while still delivering the desired performance benefits. After implementation in production, the solution reduced CPU consumption by approximately 50 MIPS.

In the EBCDIC character set, the hexadecimal values for lowercase alphabetic characters are:

• 'a' through 'i': X'81' through X'89'

• 'j' through 'r': X'91' through X'99'

• 's' through 'z': X'A2' through X'A9'

These three contiguous ranges represent all lowercase letters from a to z.

This solution involved defining a custom data type, VALID-DATA, containing every possible byte value except lowercase alphabetic characters (a through z). A PERFORM loop then scanned the data area in 256-byte chunks, verifying that each segment contained only characters defined in VALID-DATA. This coding approach enabled the COBOL compiler to make use of assembler TRT instruction.

ENVIRONMENT DIVISION.

CONFIGURATION SECTION.

SPECIAL-NAMES.

CLASS VALID-DATA IS X'00' THRU X'80',

X'8A' THRU X'90',

X'9A' THRU X'A1',

X'AA' THRU X'FF'.

WORKING-STORAGE SECTION.

01 WS-DATA PIC X(40000).

01 WS-SUB1 PIC S9(8) COMP.

01 WS-SUB2 PIC S9(8) COMP.

01 WS-QUO PIC S9(8) COMP.

01 WS-REM PIC S9(8) COMP.

01 WS-LC-FOUND PIC X(01).

PROCEDURE DIVISION.

MOVE 'N' TO WS-LC-FOUND

DIVIDE LENGTH OF WS-DATA BY 256 GIVING WS-QUO

REMAINDER WS-REM

MOVE 1 TO WS-SUB2

PERFORM VARYING WS-SUB1 FROM 1 BY 1

UNTIL WS-SUB1 > WS-QUO

OR WS-LC-FOUND = 'Y'

IF WS-DATA (WS-SUB2:256) IS VALID-DATA

CONTINUE

ELSE

MOVE 'Y' TO WS-LC-FOUND

END-IF

ADD 256 TO WS-SUB2

END-PERFORM

IF WS-DATA (WS-SUB2:WS-REM) IS VALID-DATA

CONTINUE

ELSE

MOVE 'Y' TO WS-LC-FOUND

END-IF