Programs use variables to store and process data at runtime.

This article gives a brief introduction to COBOL literals, constants and variables including some examples.

Variables are also referred to as Elementary Types.

Literals

Literals occur in the PROCEDURE DIVISION without being declared.

Strings like the text in the following code snippet are considered literals 

Literals in general are considered constants because they remain the same, as long as the program is not altered and recompiled in order to change their value.

This means the value of a constant / literal can never change during the runtime of a program.

1
2
3
4
5
6
7
8
9
PROCEDURE DIVISION
 
PROGRAM-BEGIN.
 
    DISPLAY "Hello World".
 
    DISPLAY 44
 
    DISPLAY 4.56

 The above snippet uses three literals. One String and two numeric constants.

In general there are only two types of literals in COBOL.

  • numeric
  • alphanumeric

Variable Declaration / Elementary Types

COBOL is not a typed language, like Java or C.

Rather than using datatypes, it utilises a "declaration-by-example" strategy. This means the programmer gives an example / a PICTURE of the data he wants to declare a variable for instead of using a predefined type.

Where to place the variable declaration?

Whenever you are working with variables in a COBOL program you will have to declare them in the DATA DIVISION in a section called WORKING-STORAGE DIVISION.

WORKING-STORAGE SECTION. is mandatory when working with variables.

Below a simple example, which reads two numbers from a user and stores the result of their addition in another variable.

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
      ******************************************************************
      * Author:
      * Date:
      * Purpose:
      * Tectonics: cobc
      ******************************************************************
       IDENTIFICATION DIVISION.
       PROGRAM-ID. variables.
       DATA DIVISION.
       FILE SECTION.
       WORKING-STORAGE SECTION.
       01  FIRST-NUMBER    PICTURE IS 99.
       01  SECOND-NUMBER   PICTURE IS 99.
       01  RESULT          PICTURE IS 9999.
       PROCEDURE DIVISION.
       
       MAIN-PROCEDURE.
 
           DISPLAY "Hello, Please enter a two digit number. "
           ACCEPT FIRST-NUMBER.
 
           DISPLAY "Enter a second number."
           ACCEPT SECOND-NUMBER.
 
           COMPUTE RESULT = FIRST-NUMBER +  SECOND-NUMBER.
 
           DISPLAY "The result is:".
           DISPLAY RESULT.
 
           STOP RUN.
       END PROGRAM variables.
 

Syntax

A COBOL variable declaration follows this syntax.

[level number]   [unique name] PICTURE IS [size in bytes]

The level number can be for example 01.

The name can be anything using characters [A-Z] and numbers [0-9], including (-) to separate words.

Followed by the clause "PICTURE IS" to indicate that the programmer wants to provide a data / type PICture.

If you want to declare a numeric variable with two bytes, you type 99. This will declare a numeric variable, which can take the number range 0 through 99. So it is a signed type you defined. Negative numbers either result in an underflow or the minus is ignored.

If you want to declare a numeric variable with four bytes, you type 9999. This will declare a numeric variable with a number range 0 through 9999.

Enter a positive number in above code example, which is too big for one of the variables and you will be rewarded with an overflow.

In older versions of COBOL variable names have been limited to 30 characters.

Newer COBOL compilers have also lost the necessity for upper case names, but I will stick with the old school naming conventions in case I encounter something very old in real life.

COBOL picture clauses

Since it would be very annoying having to type out all positions in a variable, especially for bigger Strings or numbers COBOL allows a shorter syntax for creating PICTURES.

Instead of using PICTURE IS you can abbreviate to PIC.

[level number]    [unique name] PIC [size in bytes].

Furthermore you can use simple patterns to define PICTURES.

[level number]    [unique name] PIC [simple type](size in bytes).

Below comparison shows the advantage of using the abbreviations.

01    A-NAME PICTURE IS 999999999999999999.

01    A-NAME PIC 9(18).

Below you can find an overview of the most common symbols, which can be used in standard picture clauses.

I found this and other very good documentation / tutorial on the web site of the Department of Computer Science & Information Systems of the University of Limerick.

Here you can find the explanation on COBOL datatypes and declaring PICTURES.

http://www.csis.ul.ie/cobol/course/DataDeclaration.htm

Here is a link to the parent COBOL tutorial.

http://www.csis.ul.ie/cobol/course/Default.htm

Symbol Description
9 Used to indicate that in this position of a picture a number is expected.
X Any character from the character set in this position of a picture is expected.
A Any alphabetic character (A to Z plus blank) at this position in the picture.
V

The position of the decimal point in a numeric value. The decimal point is not actually stored. The numbers are just treated as if they have a decimal point in this "assumed position".

S Indicates a sign and can only be used at the beginning of a picture.

Basic Datatypes

COBOL really only knows three simple datatypes.

  • numeric
  • alphanumeric
  • alphabetic

In addition COBOL compilers allow non-numeric data to be assigned to variables, which have been declared numeric.

GnuCOBOL is throwing at least warnings during compilation and I guess most modern compilers will do the same.

However, the following program will run just fine in e.g. GnuCOBOL.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
      ******************************************************************
      * Author:
      * Date:
      * Purpose:
      * Tectonics: cobc
      ******************************************************************
       IDENTIFICATION DIVISION.
       PROGRAM-ID. YOUR-PROGRAM-NAME.
       DATA DIVISION.
       FILE SECTION.
       WORKING-STORAGE SECTION.
       01  SIGNED-VAR PICTURE 99.
       01  A-VAR PICTURE 99.
       PROCEDURE DIVISION.
       MAIN-PROCEDURE.
           ACCEPT SIGNED-VAR.
           DISPLAY SIGNED-VAR.
           MOVE "1A" TO SIGNED-VAR.
           DISPLAY SIGNED-VAR.
           STOP RUN.
       END PROGRAM YOUR-PROGRAM-NAME.
 

Numeric

All numeric datatypes / pictures in COBOL are signed by default.

Numeric datatypes / PICTURES are limited to 18 digits.

If you want to declare a variable only holding integers, you use the character "9".

01    A-NUMBER PICTURE IS 9999.

A floating point variable is declared by using the character "V" in the position you assume the decimal point to be located.

01    A-DEC-NUMBER PICTURE IS 999V99.

Un-Signed datatypes are pictured using the "S" character. It must only appear at the begging of a PICTURE.

01    A-SIGNED-NUMBER PICTURE IS S99.

Below is an example written in GnuCOBOL, which will demonstrate the behaviour of the above PICTURE.

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
      ******************************************************************
      * Author:
      * Date:
      * Purpose:
      * Tectonics: cobc
      ******************************************************************
       IDENTIFICATION DIVISION.
       PROGRAM-ID. YOUR-PROGRAM-NAME.
       DATA DIVISION.
       FILE SECTION.
       WORKING-STORAGE SECTION.
       01  SIGNED-VAR PICTURE 99.
       01  UN-SIGNED-VAR PICTURE S99.
           
       PROCEDURE DIVISION.
       MAIN-PROCEDURE.
           ACCEPT SIGNED-VAR.
           DISPLAY SIGNED-VAR.
           MOVE -99 TO UN-SIGNED-VAR.
           DISPLAY UN-SIGNED-VAR.
           MOVE 99 TO UN-SIGNED-VAR.
           DISPLAY UN-SIGNED-VAR.
           STOP RUN.
       END PROGRAM YOUR-PROGRAM-NAME.
 

Provide a negative number upon start of the program and the output will look somewhat like the following.

/Users/misterx/Documents/cobol/bin/signedVars

-1

01

-99

+99

Process finished with exit code 0

The minus sign in your input is simply ignored and the negative number is replaced with its positive equivalent. 

Using the proper PICTURE with the S-prefix we are able to process also negative numbers in variables.

Alphanumeric (String)

To declare Strings you can to use the character X instead of the number 9 in the declaration.

01   A-STRING-NAME PICTURE IS XXXXXXXXXX.

or

01    A-STRING-NAME PIC X(10).

The above will declare a String variable, which is able to hold up to 10 alphanumeric values.

If you assign a String with more than 10 characters to such a variable, all characters with an index greater than 9 will be truncated.

Below is a simple example program for you to test this.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
      ******************************************************************
      * Author:
      * Date:
      * Purpose:
      * Tectonics: cobc
      ******************************************************************
       IDENTIFICATION DIVISION.
       PROGRAM-ID. stringVars.
       DATA DIVISION.
       FILE SECTION.
       WORKING-STORAGE SECTION.
       01  YOUR-NAME   PICTURE IS XXXXXXXXXX.
       PROCEDURE DIVISION.
 
       MAIN-PROCEDURE.
 
           DISPLAY "Hello, Please enter your name."
           ACCEPT YOUR-NAME.
 
           DISPLAY "Hello " YOUR-NAME.
 
           STOP RUN.
       END PROGRAM stringVars.
 

Depending on the COBOL compiler you are using the size of alphanumeric variables is limited to more or less characters.

Thus the limit of Strings is system dependent.

Alphabetic (text only)

Another version for declaration of variables for text alone is the alphabetic type.

This type is defined for Strings with characters A through Z only, so no numbers.

01    A-STRING-NAME PICTURE IS AAAAAAAAAA.

or

01    A-STRING-NAME PIC A(10).

VALUE assignment at declaration time

For elementary types it is possible to assign values at declaration time using the VALUE clause.

[level number]    [unique name] PIC [PIC Symbol](n) VALUE [a valid value]

It is possible to use the VALUE IS clause to assign a value at declaration time, but the IS is optional.

Here is one example written in GnuCOBOL.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
      ******************************************************************
      * Author:
      * Date:
      * Purpose:
      * Tectonics: cobc
      ******************************************************************
       IDENTIFICATION DIVISION.
       PROGRAM-ID. DECLARE-AND-ASSIGN.
       DATA DIVISION.
       FILE SECTION.
       WORKING-STORAGE SECTION.
       01  A-NUMBER PIC 99 VALUE 80.
       PROCEDURE DIVISION.
       MAIN-PROCEDURE.
            DISPLAY "Hello world " A-NUMBER.
            STOP RUN.
       END PROGRAM DECLARE-AND-ASSIGN.
 

You can also use some constants to assign values at declaration time.

Below code shows the use of the two reserved words ZEROS and SPACES.

No matter if you initialize a variable using the constants or the values " " and "0", it will be filled with spaces and zeros.

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
      ******************************************************************
      * Author:
      * Date:
      * Purpose:
      * Tectonics: cobc
      ******************************************************************
       IDENTIFICATION DIVISION.
       PROGRAM-ID. VAL-IS.
       DATA DIVISION.
       FILE SECTION.
       WORKING-STORAGE SECTION.
       01  A PIC X(10) VALUE SPACES.
       01  B PIC X(10) VALUE " ".
       01  C PIC 9(30) VALUE 0.
       01  D PIC 9(30) VALUE ZEROS.
       
       PROCEDURE DIVISION.
       MAIN-PROCEDURE.
            DISPLAY A "A".
            DISPLAY B "B".
            DISPLAY C "C".
            DISPLAY D "D".
            STOP RUN.
       END PROGRAM VAL-IS.
 

The output of above program will be as follows.

/home/abolte/Documents/GnuCOBOL/bin/bin/valueIs 

           A

           B

000000000000000000000000000000C

000000000000000000000000000000D

 

Process finished with exit code 0

Truncated Values

The following program shows how values are truncated in COBOL, if values do not fit into a declared variable.

As you can see, there is no overflow or underflow. Values are simply truncated from the right for alphanumeric types and from the left for numeric types.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
      ******************************************************************
      * Author:
      * Date:
      * Purpose:
      * Tectonics: cobc
      ******************************************************************
       IDENTIFICATION DIVISION.
       PROGRAM-ID. TRUNCATE-ME.
       DATA DIVISION.
       FILE SECTION.
       WORKING-STORAGE SECTION.
       01  A PIC X(5) VALUE "HELLO".
       01  B PIC X(3) VALUE "HELLO".
       01  C PIC 9(3) VALUE 123.
       01  D PIC 9(1) VALUE 123.
       PROCEDURE DIVISION.
       MAIN-PROCEDURE.
            DISPLAY A
            DISPLAY B
            DISPLAY C
            DISPLAY D
            STOP RUN.
       END PROGRAM TRUNCATE-ME.
 

Below is the output of above program.

/home/abolte/Documents/GnuCOBOL/bin/bin/truncateMe 

HELLO

HEL

123

3

 

Process finished with exit code 0

Hope it helps.