COBOL STATIC Clause - Quick Reference
The STATIC clause in COBOL is used to specify that data items should be allocated static memory and retain their values between program calls. This is useful for maintaining state information, counters, or configuration data that should persist across multiple program invocations.
Primary Use
Specify static memory allocation and retention
Division
DATA DIVISION
Sections
WORKING-STORAGE, LOCAL-STORAGE
Status
Optional clause
Overview
The STATIC clause is used in the DATA DIVISION to specify that data items should be allocated static memory and retain their values between program calls. Unlike regular working-storage items which are reinitialized each time the program is called, STATIC items maintain their values across multiple program invocations. This is particularly useful for maintaining state information, counters, or configuration data.
Syntax
123456789101112131415DATA DIVISION. WORKING-STORAGE SECTION. 01 data-name-1 PIC data-type STATIC. 01 data-name-2 PIC data-type VALUE literal STATIC. * Examples: 01 WS-COUNTER PIC 9(5) VALUE ZERO STATIC. 01 WS-CONFIG-FLAG PIC X(1) VALUE 'N' STATIC. 01 WS-TOTAL-RECORDS PIC 9(8) STATIC. * With complex data structures: 01 WS-STATIC-STRUCTURE STATIC. 05 WS-FIRST-FIELD PIC X(10). 05 WS-SECOND-FIELD PIC 9(5). 05 WS-THIRD-FIELD PIC X(1).
Practical Examples
Basic STATIC Usage
12345678910111213141516171819202122232425262728293031323334* Basic STATIC clause example IDENTIFICATION DIVISION. PROGRAM-ID. STATIC-EXAMPLE. DATA DIVISION. WORKING-STORAGE SECTION. 01 WS-REGULAR-COUNTER PIC 9(3) VALUE ZERO. 01 WS-STATIC-COUNTER PIC 9(3) VALUE ZERO STATIC. 01 WS-CALL-COUNT PIC 9(3) VALUE ZERO STATIC. 01 WS-LAST-CALL-TIME PIC X(8) STATIC. PROCEDURE DIVISION. MAIN-LOGIC. * Increment call counter (this will persist between calls) ADD 1 TO WS-CALL-COUNT * Increment regular counter (this will be reset each call) ADD 1 TO WS-REGULAR-COUNTER * Display current values DISPLAY "Call number: " WS-CALL-COUNT DISPLAY "Regular counter: " WS-REGULAR-COUNTER DISPLAY "Static counter: " WS-STATIC-COUNTER * Update static counter ADD 1 TO WS-STATIC-COUNTER * Store current time MOVE FUNCTION CURRENT-DATE(1:8) TO WS-LAST-CALL-TIME DISPLAY "Last call time: " WS-LAST-CALL-TIME DISPLAY "Static counter value: " WS-STATIC-COUNTER STOP RUN.
Explanation: This example demonstrates basic usage of the STATIC clause. The program defines both regular and static counters. The regular counter (WS-REGULAR-COUNTER) will be reset to zero each time the program is called, while the static counter (WS-STATIC-COUNTER) will retain its value between program calls. The call counter (WS-CALL-COUNT) tracks how many times the program has been called, and the last call time (WS-LAST-CALL-TIME) stores the timestamp of the most recent call.
STATIC Configuration Data
123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354* STATIC configuration data example IDENTIFICATION DIVISION. PROGRAM-ID. STATIC-CONFIG-EXAMPLE. DATA DIVISION. WORKING-STORAGE SECTION. 01 WS-CONFIGURATION STATIC. 05 WS-DEBUG-MODE PIC X(1) VALUE 'N'. 05 WS-LOG-LEVEL PIC 9(1) VALUE 1. 05 WS-MAX-RECORDS PIC 9(6) VALUE 100000. 05 WS-TIMEOUT-VALUE PIC 9(4) VALUE 300. 01 WS-PROCESSING-STATS STATIC. 05 WS-TOTAL-PROCESSED PIC 9(8) VALUE ZERO. 05 WS-SUCCESS-COUNT PIC 9(8) VALUE ZERO. 05 WS-ERROR-COUNT PIC 9(8) VALUE ZERO. 05 WS-LAST-ERROR PIC X(50). PROCEDURE DIVISION. MAIN-LOGIC. DISPLAY "Configuration Settings:" DISPLAY "Debug Mode: " WS-DEBUG-MODE DISPLAY "Log Level: " WS-LOG-LEVEL DISPLAY "Max Records: " WS-MAX-RECORDS DISPLAY "Timeout Value: " WS-TIMEOUT-VALUE DISPLAY "Processing Statistics:" DISPLAY "Total Processed: " WS-TOTAL-PROCESSED DISPLAY "Success Count: " WS-SUCCESS-COUNT DISPLAY "Error Count: " WS-ERROR-COUNT * Simulate some processing PERFORM PROCESS-RECORDS * Update statistics ADD 10 TO WS-TOTAL-PROCESSED ADD 8 TO WS-SUCCESS-COUNT ADD 2 TO WS-ERROR-COUNT MOVE "Sample error message" TO WS-LAST-ERROR DISPLAY "Updated Statistics:" DISPLAY "Total Processed: " WS-TOTAL-PROCESSED DISPLAY "Success Count: " WS-SUCCESS-COUNT DISPLAY "Error Count: " WS-ERROR-COUNT DISPLAY "Last Error: " WS-LAST-ERROR STOP RUN. PROCESS-RECORDS. * Simulate record processing DISPLAY "Processing records..." IF WS-DEBUG-MODE = 'Y' DISPLAY "Debug mode is enabled" END-IF.
Explanation: This example shows how to use STATIC for configuration data and processing statistics. The configuration structure (WS-CONFIGURATION) contains settings that should persist between program calls, such as debug mode, log level, maximum records, and timeout values. The processing statistics structure (WS-PROCESSING-STATS) maintains cumulative statistics across multiple program invocations, including total records processed, success and error counts, and the last error message.
STATIC Caching Example
123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778* STATIC caching example IDENTIFICATION DIVISION. PROGRAM-ID. STATIC-CACHE-EXAMPLE. DATA DIVISION. WORKING-STORAGE SECTION. 01 WS-CACHE-ENTRIES STATIC. 05 WS-CACHE-COUNT PIC 9(2) VALUE ZERO. 05 WS-CACHE-ARRAY OCCURS 10 TIMES. 10 WS-CACHE-KEY PIC X(20). 10 WS-CACHE-VALUE PIC X(50). 10 WS-CACHE-VALID PIC X(1). 01 WS-LOOKUP-KEY PIC X(20). 01 WS-LOOKUP-RESULT PIC X(50). 01 WS-FOUND-FLAG PIC X(1) VALUE 'N'. PROCEDURE DIVISION. MAIN-LOGIC. DISPLAY "STATIC Cache Example" * Try to find a value in cache MOVE "CUSTOMER-001" TO WS-LOOKUP-KEY PERFORM LOOKUP-CACHE IF WS-FOUND-FLAG = 'Y' DISPLAY "Found in cache: " WS-LOOKUP-RESULT ELSE DISPLAY "Not found in cache, adding new entry" PERFORM ADD-TO-CACHE END-IF * Try another lookup MOVE "CUSTOMER-002" TO WS-LOOKUP-KEY PERFORM LOOKUP-CACHE IF WS-FOUND-FLAG = 'Y' DISPLAY "Found in cache: " WS-LOOKUP-RESULT ELSE DISPLAY "Not found in cache, adding new entry" PERFORM ADD-TO-CACHE END-IF * Display cache contents PERFORM DISPLAY-CACHE STOP RUN. LOOKUP-CACHE. MOVE 'N' TO WS-FOUND-FLAG PERFORM VARYING WS-CACHE-COUNT FROM 1 BY 1 UNTIL WS-CACHE-COUNT > 10 OR WS-FOUND-FLAG = 'Y' IF WS-CACHE-KEY(WS-CACHE-COUNT) = WS-LOOKUP-KEY AND WS-CACHE-VALID(WS-CACHE-COUNT) = 'Y' MOVE WS-CACHE-VALUE(WS-CACHE-COUNT) TO WS-LOOKUP-RESULT MOVE 'Y' TO WS-FOUND-FLAG END-IF END-PERFORM. ADD-TO-CACHE. * Add new entry to cache IF WS-CACHE-COUNT < 10 ADD 1 TO WS-CACHE-COUNT MOVE WS-LOOKUP-KEY TO WS-CACHE-KEY(WS-CACHE-COUNT) MOVE "Sample customer data" TO WS-CACHE-VALUE(WS-CACHE-COUNT) MOVE 'Y' TO WS-CACHE-VALID(WS-CACHE-COUNT) MOVE "Sample customer data" TO WS-LOOKUP-RESULT END-IF. DISPLAY-CACHE. DISPLAY "Cache Contents:" PERFORM VARYING WS-CACHE-COUNT FROM 1 BY 1 UNTIL WS-CACHE-COUNT > 10 IF WS-CACHE-VALID(WS-CACHE-COUNT) = 'Y' DISPLAY "Entry " WS-CACHE-COUNT ": " WS-CACHE-KEY(WS-CACHE-COUNT) " = " WS-CACHE-VALUE(WS-CACHE-COUNT) END-IF END-PERFORM.
Explanation: This example demonstrates how to use STATIC for implementing a simple cache. The cache structure (WS-CACHE-ENTRIES) contains an array of cache entries with keys, values, and validity flags. The cache persists between program calls, allowing frequently accessed data to be stored and retrieved without repeated expensive operations. The program includes functions to lookup values in the cache, add new entries, and display the cache contents.
STATIC vs Regular Data Comparison
1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556* STATIC vs Regular data comparison example IDENTIFICATION DIVISION. PROGRAM-ID. STATIC-COMPARISON-EXAMPLE. DATA DIVISION. WORKING-STORAGE SECTION. * Regular data items (reinitialized each call) 01 WS-REGULAR-DATA. 05 WS-REGULAR-COUNTER PIC 9(3) VALUE ZERO. 05 WS-REGULAR-FLAG PIC X(1) VALUE 'N'. 05 WS-REGULAR-TOTAL PIC 9(5) VALUE ZERO. * Static data items (retain values between calls) 01 WS-STATIC-DATA STATIC. 05 WS-STATIC-COUNTER PIC 9(3) VALUE ZERO. 05 WS-STATIC-FLAG PIC X(1) VALUE 'N'. 05 WS-STATIC-TOTAL PIC 9(5) VALUE ZERO. 01 WS-CALL-NUMBER PIC 9(3) VALUE ZERO STATIC. PROCEDURE DIVISION. MAIN-LOGIC. * Increment call counter ADD 1 TO WS-CALL-NUMBER DISPLAY "Program Call Number: " WS-CALL-NUMBER DISPLAY "=== Regular Data (reinitialized each call) ===" DISPLAY "Regular Counter: " WS-REGULAR-COUNTER DISPLAY "Regular Flag: " WS-REGULAR-FLAG DISPLAY "Regular Total: " WS-REGULAR-TOTAL DISPLAY "=== Static Data (retains values between calls) ===" DISPLAY "Static Counter: " WS-STATIC-COUNTER DISPLAY "Static Flag: " WS-STATIC-FLAG DISPLAY "Static Total: " WS-STATIC-TOTAL * Update regular data ADD 1 TO WS-REGULAR-COUNTER MOVE 'Y' TO WS-REGULAR-FLAG ADD 100 TO WS-REGULAR-TOTAL * Update static data ADD 1 TO WS-STATIC-COUNTER MOVE 'Y' TO WS-STATIC-FLAG ADD 100 TO WS-STATIC-TOTAL DISPLAY "=== After Updates ===" DISPLAY "Regular Counter: " WS-REGULAR-COUNTER DISPLAY "Static Counter: " WS-STATIC-COUNTER DISPLAY "Regular Total: " WS-REGULAR-TOTAL DISPLAY "Static Total: " WS-STATIC-TOTAL DISPLAY "Note: Regular data will be reset on next call" DISPLAY "Note: Static data will retain values on next call" STOP RUN.
Explanation: This example compares STATIC and regular data items to illustrate the difference in behavior. Regular data items (WS-REGULAR-DATA) are reinitialized each time the program is called, so their values will always start at their initial values. Static data items (WS-STATIC-DATA) retain their values between program calls, so they will accumulate values across multiple invocations. This demonstrates when to use STATIC for maintaining state information versus regular data for temporary processing variables.
Best Practices and Considerations
Important Considerations
- STATIC data retains values between program calls
- Use STATIC for state information and configuration data
- STATIC data increases memory usage
- Be careful with STATIC data in multi-threaded environments
- Consider initialization requirements for STATIC data
Advantages
- Data persistence between program calls
- Useful for maintaining state information
- Efficient for configuration data
- Supports caching mechanisms
- Reduces reinitialization overhead
Limitations
- Increases memory usage
- May cause issues in multi-threaded environments
- Requires careful initialization management
- Not suitable for temporary processing data
- May persist unwanted data between calls
Best Practices
- • Use STATIC for state information and configuration data
- • Initialize STATIC data appropriately
- • Be mindful of memory usage with large STATIC structures
- • Consider thread safety in multi-threaded environments
- • Document STATIC data usage clearly
Test Your Knowledge
1. What is the primary purpose of the STATIC clause in COBOL?
- To define static variables
- To specify static memory allocation and retention
- To create static files
- To define static procedures
2. In which COBOL division is the STATIC clause typically used?
- IDENTIFICATION DIVISION
- ENVIRONMENT DIVISION
- DATA DIVISION
- PROCEDURE DIVISION
3. What happens to STATIC data between program calls?
- It is reinitialized each time
- It retains its values between calls
- It is deleted after each call
- It is moved to a different location
4. Which section can use the STATIC clause?
- Only WORKING-STORAGE SECTION
- Only LINKAGE SECTION
- WORKING-STORAGE SECTION and LOCAL-STORAGE SECTION
- All sections
5. What is the difference between STATIC and regular working-storage items?
- There is no difference
- STATIC items retain values between calls, regular items are reinitialized
- STATIC items are faster
- STATIC items use less memory