MainframeMaster

COBOL Tutorial

COBOL Subprograms and Modular Programming

Progress0 of 0 lessons

CALL Statement Basics

The CALL statement is the primary mechanism for invoking subprograms in COBOL. It allows a program to transfer control to another program and optionally pass data between them. This forms the foundation of modular programming in COBOL, enabling developers to create reusable code components.

Basic CALL Syntax

cobol
1
2
3
4
5
CALL program-name [USING argument-1 [argument-2 ... ]] [RETURNING identifier-1] [ON EXCEPTION imperative-statement-1] [NOT ON EXCEPTION imperative-statement-2] [END-CALL]

  • program-name - The name of the subprogram to be called
  • USING clause - Specifies arguments to be passed to the subprogram
  • RETURNING clause - Specifies where the return value should be stored
  • ON EXCEPTION - Specifies actions to take if the call fails
  • NOT ON EXCEPTION - Specifies actions to take if the call succeeds
  • END-CALL - Explicit scope terminator (optional in some cases)

Simple CALL Example

cobol
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
IDENTIFICATION DIVISION. PROGRAM-ID. MAINPROG. DATA DIVISION. WORKING-STORAGE SECTION. 01 CUSTOMER-ID PIC 9(5) VALUE 12345. 01 CUSTOMER-NAME PIC X(30). 01 RESULT-CODE PIC 99. PROCEDURE DIVISION. MAIN-LOGIC. DISPLAY "Calling customer lookup subprogram" CALL "CUSTLOOK" USING CUSTOMER-ID, CUSTOMER-NAME RETURNING RESULT-CODE IF RESULT-CODE = 0 DISPLAY "Customer found: " CUSTOMER-NAME ELSE DISPLAY "Customer not found, code: " RESULT-CODE END-IF STOP RUN.

This example shows a main program calling a subprogram named "CUSTLOOK" to look up customer information based on a customer ID. The main program passes the customer ID and a field to receive the customer name, and the subprogram returns a result code.

Static vs. Dynamic CALLs

FeatureStatic CALLDynamic CALL
SyntaxCALL programnameCALL "programname" or CALL literal
Binding TimeCompile/Link timeRuntime
Load ModuleCombined with main programSeparate load module
Memory UsageAlways loadedLoaded only when needed
PerformanceFaster executionSlight overhead for loading
MaintenanceRecompile all for changesCan update subprogram independently
Error HandlingCompile-time resolutionRuntime resolution (ON EXCEPTION)
cobol
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
* Static CALL example CALL CUSTLOOK USING CUSTOMER-ID, CUSTOMER-NAME * Dynamic CALL example CALL "CUSTLOOK" USING CUSTOMER-ID, CUSTOMER-NAME ON EXCEPTION DISPLAY "Program CUSTLOOK not found" NOT ON EXCEPTION DISPLAY "CUSTLOOK executed successfully" END-CALL * Dynamic CALL with variable program name 01 PROGRAM-NAME PIC X(8) VALUE "CUSTLOOK". ... CALL PROGRAM-NAME USING CUSTOMER-ID, CUSTOMER-NAME

Dynamic calls provide more flexibility but require appropriate error handling to manage cases where the subprogram cannot be found or loaded.

CALL Statement Considerations

  • The subprogram must be available to the system at runtime
  • For mainframe environments, the subprogram must be in the program search order
  • Dynamic calls require the ON EXCEPTION clause for proper error handling
  • Control returns to the statement following the CALL after the subprogram completes
  • The CANCEL statement can be used to explicitly unload a dynamically called program
  • CALL statements can be nested (subprograms can call other subprograms)
  • Recursive calls (a program calling itself) may be supported depending on the compiler

USING and RETURNING Clauses

The USING and RETURNING clauses are essential for passing data between programs. The USING clause passes arguments to the subprogram, while the RETURNING clause retrieves a single result value. Understanding these mechanisms is crucial for effective communication between COBOL program modules.

The USING Clause

The USING clause allows the calling program to pass arguments to the called subprogram. These arguments are declared in the LINKAGE SECTION of the subprogram.

cobol
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
* In the calling program: CALL "CALCINTEREST" USING PRINCIPAL, RATE, TERM, INTEREST * In the called subprogram: IDENTIFICATION DIVISION. PROGRAM-ID. CALCINTEREST. DATA DIVISION. LINKAGE SECTION. 01 LS-PRINCIPAL PIC 9(7)V99. 01 LS-RATE PIC 9(2)V99. 01 LS-TERM PIC 9(2). 01 LS-INTEREST PIC 9(7)V99. PROCEDURE DIVISION USING LS-PRINCIPAL, LS-RATE, LS-TERM, LS-INTEREST. MAIN-PARAGRAPH. COMPUTE LS-INTEREST = LS-PRINCIPAL * LS-RATE * LS-TERM / 100 GOBACK.

  • The LINKAGE SECTION describes data passed from the calling program
  • The PROCEDURE DIVISION USING clause must list parameters in the same order as the CALL USING clause
  • Names can be different between the calling and called programs
  • The data items in both programs must be compatible in size and type
  • By default, parameters are passed BY REFERENCE (address sharing)

The RETURNING Clause

The RETURNING clause allows a subprogram to pass a single value back to the calling program. This is ideal for returning status codes, calculation results, or other single-value returns.

cobol
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
* In the calling program: 01 RESULT-VALUE PIC 9(5) COMP. ... CALL "FACTORIAL" USING INPUT-NUMBER RETURNING RESULT-VALUE * In the called subprogram: IDENTIFICATION DIVISION. PROGRAM-ID. FACTORIAL. DATA DIVISION. WORKING-STORAGE SECTION. 01 WS-COUNTER PIC 9(2) COMP. 01 WS-RESULT PIC 9(5) COMP VALUE 1. LINKAGE SECTION. 01 LS-NUMBER PIC 9(2) COMP. PROCEDURE DIVISION USING LS-NUMBER RETURNING WS-RESULT. MAIN-PARAGRAPH. IF LS-NUMBER = 0 OR LS-NUMBER = 1 MOVE 1 TO WS-RESULT ELSE PERFORM VARYING WS-COUNTER FROM 1 BY 1 UNTIL WS-COUNTER > LS-NUMBER COMPUTE WS-RESULT = WS-RESULT * WS-COUNTER END-PERFORM END-IF GOBACK.

  • The RETURNING identifier must be defined in the WORKING-STORAGE SECTION or LINKAGE SECTION
  • Only one value can be returned using the RETURNING clause
  • For multiple return values, use output parameters in the USING clause
  • The returned value must be compatible with the receiving field in the calling program
  • The RETURNING clause is often used alongside the USING clause

Parameter Passing Methods

MethodSyntaxDescriptionUse Case
BY REFERENCEUSING BY REFERENCE data-itemPasses the address; changes affect the originalDefault method; for input/output parameters
BY CONTENTUSING BY CONTENT data-itemPasses a copy; changes don't affect the originalFor input-only parameters that shouldn't be modified
BY VALUEUSING BY VALUE data-itemPasses the actual value; more efficient for small dataFor small elementary items (numerics, single chars)
cobol
1
2
3
4
5
6
7
8
9
* In the calling program: CALL "PROCDATA" USING BY REFERENCE CUSTOMER-RECORD BY CONTENT TRANSACTION-DATE BY VALUE ACTION-CODE * In the subprogram: PROCEDURE DIVISION USING BY REFERENCE LS-CUSTOMER BY CONTENT LS-DATE BY VALUE LS-ACTION.

Choosing the appropriate parameter passing method enhances program security and prevents unintended side effects. BY REFERENCE is the default and most common method, but the others have important use cases.

Best Practices for Parameter Passing

  • Use BY REFERENCE for data that needs to be returned to the calling program
  • Use BY CONTENT for input-only parameters to protect them from modification
  • Use BY VALUE for small elementary items like flags, codes, or counters
  • Document the purpose of each parameter (input, output, or both)
  • Match parameter types and sizes between programs to avoid truncation or data corruption
  • Consider grouping related parameters into a single group item for simpler interfaces
  • Use RETURNING for the primary result of a function-like subprogram
  • Maintain consistent parameter order across similar subprograms
  • Implement validation for input parameters at the beginning of the subprogram

CANCEL Statement and the LINKAGE SECTION

The CANCEL statement and the LINKAGE SECTION are important components of COBOL's subprogram infrastructure. The CANCEL statement releases resources associated with a called subprogram, while the LINKAGE SECTION provides the interface for data communication between programs.

The CANCEL Statement

The CANCEL statement releases the resources associated with a dynamically called subprogram and forces a fresh load on the next CALL to that program.

cobol
1
2
3
4
5
6
7
8
* Basic CANCEL syntax CANCEL program-name-1 [program-name-2 ...] * Examples CANCEL "SUBPROG1" * Cancel a single program CANCEL "SUBPROG1" "SUBPROG2" * Cancel multiple programs CANCEL PROGRAM-NAME * Cancel using a variable name

  • CANCEL applies only to dynamically called programs
  • After CANCEL, the next CALL loads a fresh copy of the program
  • Any data in the subprogram's WORKING-STORAGE is reinitialized
  • Multiple program names can be specified in a single CANCEL statement
  • Use for memory management in large applications

CANCEL Use Cases

cobol
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
* Memory management in a large application PERFORM PROCESS-CUSTOMER-DATA CANCEL "CUSTPROC" "CUSTVAL" "CUSTRPT" PERFORM PROCESS-INVENTORY-DATA CANCEL "INVPROC" "INVVAL" "INVRPT" * Forcing reinitialization of working storage CALL "COUNTER" USING COUNT-VALUE * ... later in the program CANCEL "COUNTER" * Forces reinitialization of counter's working storage CALL "COUNTER" USING COUNT-VALUE * Fresh start with initial values * Implementing a form of "recursive" calling 01 RECURSION-LIMIT PIC 9(2) VALUE 10. 01 RECURSION-COUNTER PIC 9(2) VALUE ZERO. ... PERFORM HANDLE-RECURSIVE-CASE ... HANDLE-RECURSIVE-CASE. ADD 1 TO RECURSION-COUNTER IF RECURSION-COUNTER < RECURSION-LIMIT CANCEL "RECURSIVE" * Clear the state CALL "RECURSIVE" USING NEW-PARAMETER END-IF SUBTRACT 1 FROM RECURSION-COUNTER.

These examples show how CANCEL can be used to manage memory in large applications, force reinitialization of a subprogram's state, and simulate recursion in environments that don't directly support it.

The LINKAGE SECTION

The LINKAGE SECTION is where subprograms define the data items passed from the calling program. It serves as the interface between programs.

cobol
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
DATA DIVISION. WORKING-STORAGE SECTION. 01 WS-WORK-FIELDS. 05 WS-CALC-RESULT PIC 9(5)V99. 05 WS-ERROR-FLAG PIC X. 88 WS-ERROR-FOUND VALUE "Y". LINKAGE SECTION. 01 LS-INPUT-PARAMS. 05 LS-CUSTOMER-ID PIC X(8). 05 LS-TRANSACTION-AMT PIC 9(5)V99. 05 LS-TRANSACTION-DATE. 10 LS-YEAR PIC 9(4). 10 LS-MONTH PIC 9(2). 10 LS-DAY PIC 9(2). 01 LS-RESULT-FIELDS. 05 LS-PROCESSED-AMT PIC 9(5)V99. 05 LS-STATUS-CODE PIC XX. 01 LS-ERROR-MESSAGE PIC X(50). PROCEDURE DIVISION USING LS-INPUT-PARAMS, LS-RESULT-FIELDS, LS-ERROR-MESSAGE.

  • LINKAGE SECTION items represent data passed from the calling program
  • No storage is allocated for LINKAGE SECTION items in the subprogram
  • Data structure can be different between calling and called programs
  • Parameters must match in size, order, and compatible data types
  • Initial values (VALUE clause) are ignored in LINKAGE SECTION

Common LINKAGE SECTION Patterns

cobol
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
* Pattern 1: Simple parameter list LINKAGE SECTION. 01 LS-PARAM1 PIC X(10). 01 LS-PARAM2 PIC 9(5). 01 LS-PARAM3 PIC X. ... PROCEDURE DIVISION USING LS-PARAM1, LS-PARAM2, LS-PARAM3. * Pattern 2: Single group item containing all parameters LINKAGE SECTION. 01 LS-PARAMETERS. 05 LS-INPUT-FIELDS. 10 LS-CUSTOMER-ID PIC X(10). 10 LS-AMOUNT PIC 9(5)V99. 05 LS-OUTPUT-FIELDS. 10 LS-RESULT PIC 9(5)V99. 10 LS-STATUS PIC XX. ... PROCEDURE DIVISION USING LS-PARAMETERS. * Pattern 3: Input, output, and I/O parameters LINKAGE SECTION. 01 LS-INPUT-PARAMS. 05 LS-CUST-ID PIC X(10). 05 LS-TRANS-DATE PIC X(8). 01 LS-OUTPUT-PARAMS. 05 LS-RESULT-AMT PIC 9(7)V99. 05 LS-STATUS-CODE PIC XX. 01 LS-INOUT-PARAMS. 05 LS-BALANCE PIC S9(7)V99. 05 LS-TRANSACTION PIC X(50). ... PROCEDURE DIVISION USING LS-INPUT-PARAMS, LS-OUTPUT-PARAMS, LS-INOUT-PARAMS.

These patterns show different ways to organize the LINKAGE SECTION. Choose the pattern that best fits your application's needs and organizational standards.

Best Practices for LINKAGE SECTION

  • Prefix LINKAGE SECTION items with "LS-" for clarity
  • Group related parameters together for easier maintenance
  • Document the purpose of each parameter (input, output, or both)
  • Validate input parameters before using them
  • Avoid unnecessary copying of data between LINKAGE and WORKING-STORAGE
  • Maintain compatibility with calling programs when modifying interfaces
  • Consider using data dictionaries or copybooks for shared structures
  • Keep interfaces consistent across related subprograms
  • Implement version compatibility for frequently used subprograms

Modular Programming Concepts

Modular programming is an approach where an application is divided into smaller, manageable, and reusable components called modules. In COBOL, these modules are typically implemented as subprograms. This section explores the concepts and benefits of modular programming in COBOL.

Benefits of Modular Programming

BenefitDescription
ReusabilityCommon functionality can be implemented once and used in multiple programs
MaintainabilitySmaller programs are easier to understand, debug, and maintain
CollaborationDifferent programmers can work on different modules simultaneously
TestingModules can be tested independently before integration
FlexibilityModules can be replaced or upgraded without affecting the entire system
Memory EfficiencyDynamic loading allows optimized memory usage
AbstractionImplementation details are hidden behind interfaces

Module Types in COBOL

COBOL applications typically employ several types of modules or subprograms, each with a specific purpose:

  • Main Programs: Control the overall flow of application execution
  • Subprograms: Handle specific business functions or processes
  • Utility Modules: Provide common services (date conversion, validation, etc.)
  • I/O Modules: Handle file access and database operations
  • Screen Handling Modules: Manage user interface elements
  • Report Modules: Generate and format reports
  • Error Handling Modules: Process and report exceptions

Designing a Modular COBOL Application

cobol
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
* Main program structure in a modular application IDENTIFICATION DIVISION. PROGRAM-ID. MAINAPP. DATA DIVISION. WORKING-STORAGE SECTION. 01 MENU-SELECTION PIC 9. 01 CUSTOMER-MASTER. 05 CUST-ID PIC X(8). 05 CUST-NAME PIC X(30). 05 CUST-ADDRESS PIC X(50). 01 TRANSACTION-DATA. 05 TRANS-TYPE PIC X. 05 TRANS-AMOUNT PIC 9(7)V99. 01 STATUS-CODE PIC 99. PROCEDURE DIVISION. MAIN-PROCESS. PERFORM INITIALIZATION PERFORM DISPLAY-MENU PERFORM PROCESS-SELECTION UNTIL MENU-SELECTION = 0 PERFORM TERMINATION STOP RUN. INITIALIZATION. CALL "INITMOD" USING STATUS-CODE IF STATUS-CODE NOT = 0 DISPLAY "Initialization failed, code: " STATUS-CODE MOVE 0 TO MENU-SELECTION END-IF. DISPLAY-MENU. CALL "MENUMOD" USING MENU-SELECTION. PROCESS-SELECTION. EVALUATE MENU-SELECTION WHEN 1 CALL "CUSTMAINT" USING CUSTOMER-MASTER, STATUS-CODE WHEN 2 CALL "TRANSMOD" USING TRANSACTION-DATA, CUSTOMER-MASTER, STATUS-CODE WHEN 3 CALL "RPTMOD" USING STATUS-CODE WHEN OTHER DISPLAY "Invalid selection" END-EVALUATE PERFORM DISPLAY-MENU. TERMINATION. CALL "TERMMOD" USING STATUS-CODE.

This example shows a main program that coordinates various subprograms to implement a complete application. Each subprogram handles a specific aspect of the application's functionality.

Module Interface Design

Well-designed module interfaces are crucial for effective modular programming:

cobol
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
* Example of well-designed subprogram interface IDENTIFICATION DIVISION. PROGRAM-ID. DATEVAL. * Purpose: Validates and formats dates * Input: Date in YYYYMMDD format * Output: Formatted date and validation status DATA DIVISION. WORKING-STORAGE SECTION. 01 WS-MONTH-TABLE. 05 FILLER PIC X(3) VALUE "Jan". 05 FILLER PIC X(3) VALUE "Feb". 05 FILLER PIC X(3) VALUE "Mar". 05 FILLER PIC X(3) VALUE "Apr". 05 FILLER PIC X(3) VALUE "May". 05 FILLER PIC X(3) VALUE "Jun". 05 FILLER PIC X(3) VALUE "Jul". 05 FILLER PIC X(3) VALUE "Aug". 05 FILLER PIC X(3) VALUE "Sep". 05 FILLER PIC X(3) VALUE "Oct". 05 FILLER PIC X(3) VALUE "Nov". 05 FILLER PIC X(3) VALUE "Dec". 01 WS-MONTHS REDEFINES WS-MONTH-TABLE. 05 WS-MONTH-NAME PIC X(3) OCCURS 12 TIMES. 01 WS-WORK-FIELDS. 05 WS-YEAR PIC 9(4). 05 WS-MONTH PIC 99. 05 WS-DAY PIC 99. 05 WS-LEAP-YEAR PIC X. 88 IS-LEAP-YEAR VALUE "Y". LINKAGE SECTION. 01 LS-INPUT-DATE PIC X(8). * YYYYMMDD 01 LS-OUTPUT-STRUCT. 05 LS-FORMATTED-DATE PIC X(11). * DD-Mon-YYYY 05 LS-STATUS PIC 9. 88 LS-DATE-VALID VALUE 0. 88 LS-INVALID-YEAR VALUE 1. 88 LS-INVALID-MONTH VALUE 2. 88 LS-INVALID-DAY VALUE 3. PROCEDURE DIVISION USING LS-INPUT-DATE, LS-OUTPUT-STRUCT. * Clear consistent interface documentation * Validation and processing logic * Proper error handling * Status codes for all outcomes * Well-structured output GOBACK.

This example demonstrates a well-designed subprogram interface with:

  • Clear header documentation describing purpose and parameters
  • Simple, focused functionality (date validation and formatting)
  • Well-structured input and output parameters
  • Status codes with condition names for error reporting
  • Descriptive variable names with consistent prefixes

Module Communication Patterns

PatternDescriptionUse Case
SequentialMain program calls modules in sequenceSimple batch processing applications
HierarchicalModules call other modules in a tree structureComplex applications with layered functionality
Menu-drivenMain module displays menu, calls modules based on selectionInteractive applications with multiple functions
PipelineOutput from one module becomes input to the nextData transformation and processing chains
CallbackModule A passes a routine name to Module B to call backEvent handling and customizable processing

Best Practices for Modular COBOL Applications

  • Design modules around business functions rather than technical considerations
  • Keep modules focused on a single responsibility (Single Responsibility Principle)
  • Create stable, well-documented interfaces between modules
  • Use COPY statements to share common data definitions across programs
  • Implement error handling consistently across all modules
  • Develop testing harnesses for each module to enable independent testing
  • Document module dependencies clearly
  • Use dynamic calls for flexibility when appropriate
  • Consider memory usage when designing large applications
  • Create utility modules for frequently used operations
  • Implement clear versioning for modules that evolve over time
  • Establish naming conventions for modules and their interfaces

Test Your Knowledge

1. What statement is used to invoke a subprogram in COBOL?

  • EXECUTE
  • CALL
  • PERFORM
  • INVOKE

2. Which of the following indicates a dynamic CALL in COBOL?

  • CALL SUBPROG
  • CALL "SUBPROG"
  • DYNAMIC CALL SUBPROG
  • CALL DYNAMIC SUBPROG

3. In COBOL, where do subprograms define the parameters passed from the calling program?

  • WORKING-STORAGE SECTION
  • LOCAL-STORAGE SECTION
  • LINKAGE SECTION
  • PARAMETER SECTION

4. What is the purpose of the USING clause in a CALL statement?

  • To specify which subprogram to call
  • To pass data to the called subprogram
  • To determine how long the subprogram will run
  • To specify which operating system to use

5. What statement can be used to release resources associated with a dynamically called subprogram?

  • RELEASE
  • FREE
  • CANCEL
  • DEALLOCATE

Frequently Asked Questions