CONFIGURATION SECTION


The CONFIGURATION SECTION describes the computer environment in which the program is compiled and executed. It is an optional section in the COBOL program.

Syntax -

[CONFIGURATION SECTION.
[SOURCE-COMPUTER. computer-name]
[OBJECT-COMPUTER. computer-name]
[SPECIAL-NAMES.   names-entry]]
Note! All statements coded in [ ] are optional.

SOURCE-COMPUTER. {source-computer-entry} -


SOURCE-COMPUTER provides the computer name on which the source program is compiled.

SOURCE-COMPUTER Paragraph
  • computer-name - Source computer name where the program coded.
  • WITH DEBUGGING MODE - It activates a compile-time debugging switch for debugging lines coded in the program.

Debugging Lines -

  • A debugging line is a code with a "D" in column 7. Debugging lines can be coded in the ENVIRONMENT DIVISION, DATA DIVISION, and PROCEDURE DIVISION.
  • If it is coded with DEBUGGING MODE, the code with "D" in the 7th column is considered as code. During the program execution, the code gets executed along with the flow.
  • If it is not coded with DEBUGGING MODE, the code with "D" in the 7th column is not considered as code and is treated as comments.

Practical Example -


Scenario1 - Example to describe how the DEBUGGING MODE is enabled in COBOL programming.

Code -

----+----1----+----2----+----3----+----4----+----5----+
       IDENTIFICATION DIVISION.
       PROGRAM-ID. SCWITHDM.
       AUTHOR. MTH.

       ENVIRONMENT DIVISION.
       CONFIGURATION SECTION. 
       SOURCE-COMPUTER. IBM3278 WITH DEBUGGING MODE.
       OBJECT-COMPUTER. IBM3278.
 
       PROCEDURE DIVISION.

      D    DISPLAY "DISPLAYING DEBUGGING LINE".
           DISPLAY "DISPLAYING NORMAL LINE".

           STOP RUN.

Output -

DISPLAYING DEBUGGING LINE
DISPLAYING NORMAL LINE

Explaining Example -

DEBUGGING MODE is coded on SOURCE-COMPUTER. Thus, all the debugging lines are considered as code during the compilation and executed when we run the program.

Scenario2 - Example to describe how the DEBUGGING MODE is disabled in COBOL programming.

Code -

----+----1----+----2----+----3----+----4----+----5----+
       IDENTIFICATION DIVISION.
       PROGRAM-ID. SCWOUTDM.
       AUTHOR. MTH.

       ENVIRONMENT DIVISION.
       CONFIGURATION SECTION.
       SOURCE-COMPUTER. IBM3278.
       OBJECT-COMPUTER. IBM3278.

       PROCEDURE DIVISION.

      D    DISPLAY "DISPLAYING DEBUGGING LINE". 
           DISPLAY "DISPLAYING NORMAL LINE". 

           STOP RUN.

Output -

DISPLAYING NORMAL LINE

Explaining Example -

DEBUGGING MODE not coded with SOURCE-COMPUTER. i.e., DEBUGGING MODE disabled, and all the debugging lines are considered comments during the compilation and not executed when running the program.

OBJECT-COMPUTER. {object-computer-entry} -


The OBJECT-COMPUTER paragraph specifies the system name where the object program is executed. If it is coded in the program, the program doesn't run on the current machine.

OBJECT-COMPUTER Paragraph
  • Computer-name - Object computer name where the program is executed.
  • PROGRAM COLLATING SEQUENCE IS alphabet-name - A collating sequence is used to change the system collating sequence. The alphabet-name should be defined in the SPECIAL-NAMES paragraph to specify the collating sequence.
Note! The system's default collating sequence is in effect if this clause is not coded.

Practical Example -


Scenario - Example to describe how the PROGRAM COLLATING SEQUENCE is used in COBOL programming.

Code -

----+----1----+----2----+----3----+----4----+----5----+
       IDENTIFICATION DIVISION. 
       PROGRAM-ID. OCWITHSC. 
       AUTHOR. MTH.
       ENVIRONMENT DIVISION. 
       CONFIGURATION SECTION.
       SOURCE-COMPUTER. IBM3278.
       OBJECT-COMPUTER. IBM3278
                PROGRAM COLLATING SEQUENCE IS TEST-COLLATE.
       SPECIAL-NAMES. ALPHABET TEST-COLLATE IS 'STUVWXY'. 
       DATA DIVISION.
       WORKING-STORAGE SECTION.
       01 WS-VAR        PIC X(01).

       PROCEDURE DIVISION. 

           MOVE LOW-VALUE     TO  WS-VAR.
           DISPLAY "LOWEST VALUE IS:  " WS-VAR.

           STOP RUN. 

Output -

LOWEST VALUE IS:  S

Explaining Example -

TEST COLLATE is the PROGRAM COLLATING SEQUENCE that overrides the ALPHABET system collating sequence. i.e., the EBCDIC character sequence has been overridden by the 'STUVWXY'. Therefore, the LOW-VALUE is 'S,' and the same is displayed in the output.

SPECIAL-NAMES. {special-names-entry} -


SPECIAL-NAMES provide symbolic characters and special functions related to the existing mnemonic names in the source program. The constant entries can be created using SPECIAL-NAMES to validate the fields at a program level. The entries in the SPECIAL-NAMES paragraph can appear in any order.

SPECIAL NAMES Paragraph
  • environment-name-1 - It specifies the system name where the compiler took the actions.
  • mnemonic-name-1 - It is a user-defined name.
  • ALPHABET clause - The ALPHABET clause declares a name with a character code or collating sequence. For example -
    SPECIAL-NAMES. ALPHABET ALPHA-NAME IS EBCDIC.

  • SYMBOLIC CHARACTERS clause - The SYMBOLIC CHARACTERS clause applies a variable to single-byte character sets. Each character represented is an alphanumeric character. For example -
    SPECIAL-NAMES. SYMBOLIC CHARACTERS SC-A IS 97.

  • CURRENCY SIGN clause - The CURRENCY SIGN clause sets the currency symbol in a PICTURE clause. For example -
    SPECIAL-NAMES. CURRENCY SIGN IS "$".

  • DECIMAL-POINT IS COMMA clause - The DECIMAL-POINT IS COMMA clause swaps the functions of the period. Also, change the comma in PICTURE character-strings and numeric literals. For example -
    SPECIAL-NAMES. DECIMAL-POINT IS COMMA.

Practical Example -


Scenario - Example to describe how the SPECIAL NAMES are used in the COBOL program.

Code -

----+----1----+----2----+----3----+----4----+----5----+
       IDENTIFICATION DIVISION.
       PROGRAM-ID. SPECIALN. 
       AUTHOR. MTH.

       ENVIRONMENT DIVISION. 
       CONFIGURATION SECTION.
       SOURCE-COMPUTER. IBM3278.
       OBJECT-COMPUTER. IBM3278.
       SPECIAL-NAMES. CLASS HAS-VALID-CHAR IS "A" THRU "Z" 
                                              "0" THRU "9".
       DATA DIVISION. 
       WORKING-STORAGE SECTION.

       01 WS-VAR        PIC X(10) VALUE "MAINFRAMES". 

       PROCEDURE DIVISION.
 
           IF WS-VAR  HAS-VALID-CHAR 
              DISPLAY "WS-VAR HAS VALID CHARACTERS"
           ELSE
              DISPLAY "WS-VAR HAS INVALID CHARACTERS"
           END-IF. 

           STOP RUN.

Output -

WS-VAR HAS VALID CHARACTERS

Explaining Example -

HAS-VALID-CHAR is a special name defined with valid characters 'A' to 'Z' and 0 to 9. HAS-VALID-CHAR is used to validate WS-VAR with valid characters that are defined in the symbolic name.