Variable control in COBOL involves managing variable scope (where variables can be accessed), lifetime (when variables exist in memory), and initialization (how variables get their initial values). Understanding variable control is essential for writing correct, efficient, and maintainable COBOL programs, especially when dealing with reentrant programs, parameter passing, and memory management.
Variable control encompasses three key aspects:
COBOL provides three main storage sections, each with different characteristics for variable control:
| Storage Section | Scope | Lifetime | Initialization |
|---|---|---|---|
| WORKING-STORAGE | Entire program | Program duration (persists across calls) | Once at program start (or each entry if INITIAL) |
| LOCAL-STORAGE | Entire program | Program invocation (reinitialized on each call) | Each time program is invoked |
| LINKAGE | Entire program | Managed by calling program | Set by calling program |
WORKING-STORAGE variables are allocated when the program starts and persist for the entire program execution. They maintain their values between procedure calls unless the program has the INITIAL attribute.
123456789101112131415161718192021222324252627282930313233DATA DIVISION. WORKING-STORAGE SECTION. *> Program-level variables that persist 01 WS-PROGRAM-CONTROL. 05 WS-PROGRAM-NAME PIC X(8) VALUE 'MAINPROG'. 05 WS-EXECUTION-COUNT PIC 9(6) VALUE ZERO. 05 WS-START-TIME PIC X(8). *> Constants initialized once 01 WS-CONSTANTS. 05 WS-MAX-RECORDS PIC 9(6) VALUE 100000. 05 WS-TIMEOUT-VALUE PIC 9(4) VALUE 3000. 05 WS-SUCCESS-CODE PIC X(2) VALUE '00'. *> Work areas that persist across calls 01 WS-WORK-AREAS. 05 WS-ACCUMULATOR PIC S9(15)V99 COMP-3 VALUE ZERO. 05 WS-RECORD-COUNT PIC 9(8) VALUE ZERO. 05 WS-ERROR-COUNT PIC 9(6) VALUE ZERO. PROCEDURE DIVISION. MAIN-PROCESS. *> These variables maintain values across procedure calls ADD 1 TO WS-EXECUTION-COUNT PERFORM PROCESS-DATA *> WS-EXECUTION-COUNT still has the incremented value PERFORM PROCESS-DATA *> WS-EXECUTION-COUNT continues to accumulate PROCESS-DATA. *> Can access all WORKING-STORAGE variables ADD 1 TO WS-RECORD-COUNT *> WS-RECORD-COUNT persists between calls to this procedure.
Programs with the INITIAL attribute reinitialize WORKING-STORAGE on each program entry:
123456789101112131415IDENTIFICATION DIVISION. PROGRAM-ID. REENTRANT-PROG INITIAL. *> INITIAL attribute causes WORKING-STORAGE to be *> reinitialized each time the program is called DATA DIVISION. WORKING-STORAGE SECTION. 01 WS-COUNTER PIC 9(6) VALUE ZERO. *> This will be reset to ZERO on each program entry PROCEDURE DIVISION. *> Each time this program is called, WS-COUNTER starts at ZERO ADD 1 TO WS-COUNTER *> Process data EXEC CICS RETURN END-EXEC.
LOCAL-STORAGE variables are allocated each time the program is invoked and deallocated when the program exits. This provides fresh values on each program call, making it ideal for reentrant programs.
123456789101112131415161718192021222324252627282930DATA DIVISION. LOCAL-STORAGE SECTION. *> Variables reinitialized on each program call 01 LS-TEMPORARY-WORK. 05 LS-TEMP-BUFFER PIC X(1000). 05 LS-CALCULATION-AREA PIC S9(15)V99 COMP-3. 05 LS-INDEX PIC 9(4) VALUE ZERO. *> Reentrant program data 01 LS-PROCESSING-DATA. 05 LS-INPUT-RECORD PIC X(200). 05 LS-OUTPUT-RECORD PIC X(200). 05 LS-PROCESSING-FLAG PIC X VALUE 'N'. 88 LS-PROCESSING VALUE 'Y'. 88 LS-NOT-PROCESSING VALUE 'N'. PROCEDURE DIVISION. MAIN-PROCESS. *> Each time program is called, LS-INDEX starts at ZERO *> LS-PROCESSING-FLAG starts at 'N' *> All LOCAL-STORAGE variables are fresh PERFORM PROCESS-DATA *> When program exits, LOCAL-STORAGE is deallocated *> Next invocation gets fresh values again PROCESS-DATA. *> Can access all LOCAL-STORAGE variables ADD 1 TO LS-INDEX *> LS-INDEX is fresh on each program invocation.
LINKAGE SECTION defines variables that reference storage allocated by the calling program. These variables don't have storage allocated within the program itself.
123456789101112131415161718192021222324252627282930313233343536DATA DIVISION. LINKAGE SECTION. *> Parameters passed from calling program 01 PARAMETER-LIST. 05 PARM-LENGTH PIC S9(4) COMP. 05 PARM-DATA PIC X(100). *> Return area shared with caller 01 RETURN-AREA. 05 RETURN-CODE PIC 9(4) COMP. 05 RETURN-MESSAGE PIC X(50). *> Shared data area 01 SHARED-DATA. 05 SHARED-VARIABLE PIC 9(6). 05 SHARED-FLAG PIC X. PROCEDURE DIVISION USING PARAMETER-LIST RETURN-AREA SHARED-DATA. *> These variables reference storage allocated by caller *> Changes to these variables affect the calling program *> No storage is allocated within this program *> Access parameters IF PARM-LENGTH > 0 PERFORM PROCESS-PARAMETERS END-IF *> Set return values MOVE 0 TO RETURN-CODE MOVE 'SUCCESS' TO RETURN-MESSAGE *> Modify shared data ADD 1 TO SHARED-VARIABLE *> This change is visible to the calling program.
Understanding when and how variables are initialized is crucial for variable control.
| Method | When | Applies To |
|---|---|---|
| VALUE clause | At allocation time | WORKING-STORAGE, LOCAL-STORAGE |
| INITIALIZE statement | Explicitly in program code | Any storage section |
| MOVE statement | Explicitly in program code | Any storage section |
| Calling program | Before program call | LINKAGE SECTION |
1234567891011121314151617181920212223242526DATA DIVISION. WORKING-STORAGE SECTION. *> Initialized with VALUE clause at program start 01 WS-COUNTER PIC 9(6) VALUE ZERO. 01 WS-FLAG PIC X VALUE 'N'. 01 WS-NAME PIC X(30) VALUE SPACES. *> Not initialized - may have undefined values 01 WS-UNINITIALIZED PIC 9(6). 01 WS-BUFFER PIC X(100). PROCEDURE DIVISION. MAIN-PROCESS. *> Explicit initialization using INITIALIZE INITIALIZE WS-UNINITIALIZED INITIALIZE WS-BUFFER *> Explicit initialization using MOVE MOVE ZERO TO WS-COUNTER MOVE 'Y' TO WS-FLAG MOVE SPACES TO WS-NAME *> Initialize group item INITIALIZE WS-DATA-GROUP REPLACING NUMERIC DATA BY ZERO ALPHABETIC DATA BY SPACES.
The AUTOMATIC clause provides automatic storage management, allocating storage when first accessed and deallocating when out of scope.
12345678910111213141516DATA DIVISION. WORKING-STORAGE SECTION. *> Automatic storage - allocated when first accessed 01 WS-AUTOMATIC-VAR PIC 9(6) AUTOMATIC VALUE ZERO. LOCAL-STORAGE SECTION. *> Automatic storage in LOCAL-STORAGE 01 LS-AUTOMATIC-BUFFER PIC X(200) AUTOMATIC. PROCEDURE DIVISION. MAIN-PROCESS. *> Storage allocated when first accessed ADD 1 TO WS-AUTOMATIC-VAR *> Storage automatically managed *> Deallocated when program exits (for LOCAL-STORAGE) *> Or when out of scope (for AUTOMATIC items).
| Requirement | Use This Section | Reason |
|---|---|---|
| Variables that persist across procedure calls | WORKING-STORAGE | Maintains values throughout program execution |
| Reentrant program (fresh values on each call) | LOCAL-STORAGE | Reinitialized on each program invocation |
| Parameters passed from calling program | LINKAGE SECTION | References external storage from caller |
| Temporary work areas | LOCAL-STORAGE | Fresh values, automatically cleaned up |
| Program-level counters and accumulators | WORKING-STORAGE | Persist and accumulate across calls |
| Shared data between programs | LINKAGE SECTION | References storage managed by caller |
In COBOL, variables declared in WORKING-STORAGE, LOCAL-STORAGE, or LINKAGE sections are accessible throughout the entire program. COBOL doesn't have block-level scope like some languages.
12345678910111213141516171819202122DATA DIVISION. WORKING-STORAGE SECTION. 01 WS-GLOBAL-VAR PIC 9(6) VALUE ZERO. PROCEDURE DIVISION. MAIN-PROCESS. *> WS-GLOBAL-VAR is accessible here ADD 1 TO WS-GLOBAL-VAR PERFORM SUB-PROCESS-1 PERFORM SUB-PROCESS-2 *> WS-GLOBAL-VAR is still accessible and retains its value SUB-PROCESS-1. *> WS-GLOBAL-VAR is accessible here too ADD 10 TO WS-GLOBAL-VAR *> Changes are visible to all procedures SUB-PROCESS-2. *> WS-GLOBAL-VAR is accessible here as well *> Can see changes made in SUB-PROCESS-1 DISPLAY 'Value: ' WS-GLOBAL-VAR.
Choose the storage section that matches your variable's lifetime and initialization requirements. Use WORKING-STORAGE for persistent state, LOCAL-STORAGE for reentrant programs, and LINKAGE for parameters.
Always initialize variables explicitly using VALUE clauses or INITIALIZE statements. Don't rely on undefined initial values.
If your program needs to be reentrant (can be called by multiple tasks simultaneously), use LOCAL-STORAGE to ensure each invocation gets fresh values.
Add comments explaining why you chose a particular storage section, especially for complex programs where variable lifetime is critical.
Avoid using WORKING-STORAGE for task-specific data in reentrant programs, as it can cause data corruption when multiple tasks execute the program simultaneously.
12345678910111213*> Use WORKING-STORAGE for program-level state WORKING-STORAGE SECTION. 01 WS-PROGRAM-STATE. 05 WS-RECORD-COUNT PIC 9(8) VALUE ZERO. 05 WS-TOTAL-AMOUNT PIC S9(15)V99 COMP-3 VALUE ZERO. 05 WS-ERROR-COUNT PIC 9(6) VALUE ZERO. PROCEDURE DIVISION. *> These variables accumulate across all procedure calls PERFORM PROCESS-RECORDS *> WS-RECORD-COUNT, WS-TOTAL-AMOUNT persist PERFORM GENERATE-REPORT *> Can use accumulated values.
1234567891011*> Use LOCAL-STORAGE for reentrant programs LOCAL-STORAGE SECTION. 01 LS-PROCESSING-DATA. 05 LS-INPUT-BUFFER PIC X(200). 05 LS-OUTPUT-BUFFER PIC X(200). 05 LS-TEMP-VALUES PIC 9(6) VALUE ZERO. PROCEDURE DIVISION. *> Each program invocation gets fresh values *> Multiple tasks can call this program simultaneously *> Each gets its own copy of LOCAL-STORAGE variables.
1234567891011121314*> Use LINKAGE SECTION for parameters LINKAGE SECTION. 01 INPUT-PARAMETERS. 05 PARM-LENGTH PIC S9(4) COMP. 05 PARM-DATA PIC X(100). 01 OUTPUT-RESULTS. 05 RESULT-CODE PIC 9(4) COMP. 05 RESULT-MESSAGE PIC X(50). PROCEDURE DIVISION USING INPUT-PARAMETERS OUTPUT-RESULTS. *> Parameters reference storage from calling program *> Changes to OUTPUT-RESULTS are visible to caller.
Imagine you have different types of boxes for your toys:
WORKING-STORAGE is like a big box in your room that stays there all the time. You put toys in it, and they stay there even when you're not playing. The next time you play, your toys are still in the box where you left them.
LOCAL-STORAGE is like a temporary box you get each time you start playing. When you're done playing, the box goes away. The next time you play, you get a brand new empty box to start fresh.
LINKAGE is like sharing a box with your friend. You both use the same box, and if you put something in it, your friend can see it too. The box belongs to your friend, but you can use it together.
Just like you choose different boxes for different toys, COBOL programs choose different storage sections for different types of data!
For each scenario, choose the appropriate storage section:
1234567891011*> 1. Counter - use WORKING-STORAGE (persists) WORKING-STORAGE SECTION. 01 WS-ACCUMULATOR PIC 9(8) VALUE ZERO. *> 2. Parameters - use LINKAGE SECTION LINKAGE SECTION. 01 INPUT-PARMS PIC X(100). *> 3. Temporary work - use LOCAL-STORAGE (fresh each call) LOCAL-STORAGE SECTION. 01 LS-TEMP-AREA PIC X(200).
Write code to properly initialize a group of variables including numeric, alphabetic, and mixed data types.
1234567891011WORKING-STORAGE SECTION. 01 WS-DATA-GROUP. 05 WS-NUMERIC-FIELD PIC 9(6). 05 WS-ALPHABETIC-FIELD PIC X(30). 05 WS-MIXED-FIELD PIC X(10). PROCEDURE DIVISION. *> Initialize all fields INITIALIZE WS-DATA-GROUP REPLACING NUMERIC DATA BY ZERO ALPHABETIC DATA BY SPACES.
1. When are WORKING-STORAGE variables initialized?
2. What is the main difference between WORKING-STORAGE and LOCAL-STORAGE?
3. What does the LINKAGE SECTION contain?
4. When should you use LOCAL-STORAGE instead of WORKING-STORAGE?
5. What does the AUTOMATIC clause do?