SYMBOLS
The symbols used in this section conform mainly to the COBOL standards, with a
few exceptions.
LITERALS
IDENTIFICATION DIVISION. PROGRAM-ID. program-name. [identification entries.] ENVIRONMENT DIVISION. CONFIGURATION SECTION. [optional configuration entries.] INPUT-OUTPUT SECTION. [optional input-output entries.] DATA DIVISION. FILE SECTION. [ FD file-description. 01 record-description.] ... WORKING-STORAGE SECTION. [data-description.] LINKAGE SECTION. [data-description.] SCREEN SECTION. [screen-field-description.] PROCEDURE DIVISION. [procedural statements.]
The Identification Division and the Program-id paragraph are mandatory
entries, and must be the first two lines of the program. The other divisions
and sections are all optional, but where included, they must appear in the
sequence shown.
Entries within each section are accepted in any sequence except where
indicated in the notes for each section.
A program without a Procedure Division will compile without error, but if run,
it will exit with a error code of 1. This feature is provided for testing
purposes during program development.
IDENTIFICATION DIVISION.
PROGRAM-ID. program-name.
[AUTHOR. [comment]...]
[INSTALLATION. [comment]...]]
[DATE-WRITTEN. [comment]...]]
[DATE-COMPILED. [comment]...]
[SECURITY. [comment]...]]
The Identification Division must be the first line of the program, immediately
followed by the Program-Id paragraph. The contents of this paragraph are not
significant; the program is identified by the name of the source file. All
other paragraphs are optional and each may contain one or more sentences.
COPY file-name
The copy statement may be included anywhere in the program after the
Identification Division, to include a separate source file at that point in
the compilation. File-name is the file path of the file of source statements
which is to be included. Copied files may ®not¯ include the COPY statement.
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
[SOURCE-COMPUTER. [comment [WITH DEBUGGING MODE].]
[OBJECT-COMPUTER. [comment.]]
[SPECIAL-NAMES.
[CURRENCY SIGN IS char]
[SYMBOLIC CHARACTERS {sym-name IS char}...]
[DECIMAL-POINT IS COMMA]
[DATE IS literal]
.
INPUT-OUTPUT SECTION.
[FILE-CONTROL.
[file-control-entries.] ]
[I-O-CONTROL.
[i-o-control entries.] ]
The File-control entries are described separately later, for each file type.
The I-O-control entries have no effect on the program; they are ignored by the
compiler.
DATA DIVISION.
FILE SECTION.
FD file-description. * each file
01 record-description.
WORKING-STORAGE SECTION.
[data-description.]...]
LINKAGE SECTION.
[data-description.]...]
SCREEN SECTION.
[screen-field-description.]...]
The File section contains an entry for each file defined with a SELECT
statement. These are described separately later for each file type.
The Working-storage section define the data and the data fields, in addition to the file records, which are used by the program.
The Linkage section is used only by programs which are to be called by another program. These is the data which will be passed from the calling program. If the program is run directly without being called, the contents of these fields is undefined.
The Screen section defines the fields to be displayed and accepted on the
video screen. This section is described separately in the Screen module.
lvl-no [|data-name | FILLER|]
[REDEFINES other-data-name]
[PICTURE IS edit-string]
[USAGE IS] |BINARY
|COMPUTATIONAL
|COMP
|COMPUTATIONAL-3
|COMP-3
|DISPLAY
|INDEX
|PACKED-DECIMAL
|DATE |
[JUSTIFIED RIGHT]
[BLANK WHEN ZERO]
[VALUE IS literal]
[OCCURS [min TO] max TIMES [DEPENDING ON count]
[INDEXED BY {index-name}...
[|ASCENDING | DESCENDING | KEY IS key-name] ] ]
.
66 new-name RENAMES first-name [THRU last-name].
88 condition-name
|VALUE IS | VALUES ARE| {value [THRU high-value]}... .
DISPLAY A X 9 (at least one A or X) NUMERIC S 9 V (at least one 9) ALPHA-EDITED A X 9 B / 0 NUMERIC-EDITED B / 0 9 . $ + - , * Z CR DBAny other combinations are invalid.
DATA NAME FORMAT
data-name [|subscript ... | indexing|] [reference modification]
condition-name [|subscript ... | indexing|]
Subscript: (|num-data [|+ | -| num-literal] | num-literal|)
Indexing: (index-name [|+ | -| num-literal])
Reference modification: ([position] : [length])
CONDITIONS
Relation Condition
Subject Relation Object
data-item IS [NOT] |GREATER THAN| |data-item|
| > | |literal |
|LESS THAN |
| < |
|EQUAL TO |
| = |
Class or Numeric Condition
data-item IS [NOT] |NUMERIC |
|ALPHABETIC |
|ALPHABETIC-UPPER|
|ALPHABETIC-LOWER|
|POSITIVE |
|NEGATIVE |
|ZERO |
Condition-name Condition
[NOT] condition-name
Combined Conditions
condition { |AND | OR| condition } ...
Abbreviated Combined Relations Conditions
subject relation object { |AND | OR| [relation] object} ...
Bracketed Conditions Brackets are assumed to begin and end at an OR. OR conditions may be contained within brackets to change the logic.
Example:
IF True AND True OR False AND False
Assumed:
IF (True AND True) OR (False AND False) = True
With brackets:
IF True AND (True OR False) AND False = False
SCOPE OF STATEMENTS - USE OF END-verb
The END-verb statement is used with those statements which contain a
condition, to limit the scope of the statement.
Between the verb and the END-verb, there may be any number of statements of
any kind, including further conditional statements of the same or another
type, each terminated by its own END-verb.
There are two types of such statements.
PROCEDURE DIVISION [ USING {dataname}...]. {[section-name SECTION.] paragraph name. procedural statements}...The Procedure Division contains the procedural statements which comprise the program actions.
USING
This optional phrase is used only with programs which are to be called as
subprograms. It identifies the data names in the Linkage Section which are to
be supplied from - and returned to -the calling program, and the sequence in
which they will be passed by the calling program.
SECTION
The use of sections as a subdivision of the Procedure Division is optional,
but is recommended. If Sections are used, a Section must be defined
immediately after the Procedure Division statement. Each section definition
must immediately be followed by a paragraph name.
PROCEDURAL STATEMENTS
The procedural statements follow in alphabetic sequence, with the following exceptions.
ACCEPT dataname FROM |DATE | |TIME | |DAY-OF-WEEK | |PARAMETERS | |[NEXT] FILE-ID |
DATE
Current system date, stored in date format in a date field, or as
8 digits with the format ccyymmdd in any other field.
TIME
Current system time, stored as hhmmssdd.
DAY-OF-WEEK
Current day of week, stored as 1 through 7 for Sunday through
Saturday.
PARAMETERS
Stores the next parameter from the RUN call line.
E.g., RUN progname parameter1 parameter2 ...
Each successive parameter is passed in turn; when none are
left, the dataname is set to spaces, or to zero if it is
numeric.
FILE-ID
Returns the first file-path matching the file-path in dataname,
or spaces if not found.
NEXT
Returns the next matching file-path, or spaces if not found.
ARITHMETIC
ADD srcnum TO srcnum GIVING {result [ROUNDED]}...
ADD {srcnum}... TO {numval [ROUNDED]}...
ADD srcnum {srcnum}... GIVING {result [ROUNDED]}...
SUBTRACT {srcnum}... FROM srcnum GIVING {result [ROUNDED]}...
SUBTRACT {srcnum}... FROM {numval [ROUNDED]}...
DIVIDE srcnum | BY srcnum GIVING result |
| INTO |srcnum | numval| GIVING result |
[ |ROUNDED | REMAINDER result| ]
MULTIPLY srcnum BY srcnum GIVING result [ROUNDED]
MULTIPLY srcnum BY numval [ROUNDED]
Srcnum may be any numeric data item or literal.
Numval may be any numeric data item.
Result may be any numeric or edited numeric data item.
Where GIVING is not included, the result is contained in numval.
Each arithmetic statement may be followed by this optional clause:
ON SIZE ERROR statements
[ELSE statements]
END-verb
If overflow occurs for any result and SIZE ERROR is included, the valid
results are set correctly, but any overflowing result field is not changed and
the SIZE ERROR option is taken. If SIZE ERROR is not included, the result is
truncated to fit within the field. However, if an attempt is made to divide
by zero, the result is set to zero and the remainder is set equal to the
dividend regardless of whether SIZE ERROR is included.
For optimum performance with MULTIPLY, the first operand (the multiplier)
should have less digits than the second operand.
CALL program-name [USING {dataname} ... ]
ALTER Not implemented.
Loads a .RUN or .COM program if not already loaded, and transfers control to
it. Program-name may be a full pathname to the program file; the extension
may be omitted if it is .RUN, but it is required if it is .COM.
Up to ten programs may be simultaneously loaded, including the main program,
if memory permits.
A called program is in its initial state if it is actually loaded by this
command. If the program is already loaded, the program remains unchanged from
its state when it was last executed.
Called programs may call other programs, but they cannot call a program which
has already been called and which has not yet returned to its calling program.
USING.
This is used to identify fields in the calling program which are to be
transferred to the LINKAGE SECTION fields of the called program. They are
associated by sequence of specification
with the fields in the USING phrase of the PROCEDURE DIVISION statement of the
called program. The fields are transferred to the called program without any
conversion, and are truncated if necessary. They may be any data fields
defined in the calling program, but they may not be indexed, subscripted, or
reference modified. On return to the calling program, these fields are
returned from the called program.
.COM Programs
On entry to a called .COM program, the following conditions apply.
CANCEL program-name
This statement removes a previously called program from the run, and frees the
memory area for assignment to further programs.
The program concerned may subsequently be called again, in which case it will
be reloaded in its initial state.
A program which has called another program and that called program has not yet
returned to it may not be cancelled.
An attempt to cancel a program which is not currently loaded has no effect;
it is not treated as an error.
CANCEL TRANSACTION Refer to the Files description.
CLOSE Refer to the Files description.
COMPUTE Not implemented.
CONTINUE
This is used to indicate that no action is required at this logical point in
the program.
Example:
READ FILE-NAME AT END CONTINUE
DELETE file-name RECORD Refer to the Files description.
DELETE FILE file-path
This is a non-standard statement. Its function is to delete a file from disk.
File-path may be a display dataname or literal identifiying the file to be
deleted. If the file is not found, no action is taken and the program
continues.
DISPLAY | AT |llcc|llcc-field| |
| ATTRIBUTE |"fb"|attribute-field| |
| BELL |
| dataname |
| literal | ...
This statement is used mainly for program testing; The Format and Screen
Modules are used for general screen display.
AT
llcc is the line and column number in the same format as in the
Format Module. llcc-field must be a 4-digit numeric item
containing an llcc value.
Each separate DISPLAY statement has a default llcc of 0101.
ATTRIBUTE
"fb" is the foreground and background colour codes in the same
format as in the Format Module. attribute-field is a two-
character field containing the colur codes.
The default attribute at the first DISPLAY statement is "NW" -
black on white, but a specified attribute continues for
successive DISPLAY statements.
BELL
Sound the beeper.
Datanames and literals are any valid data fields to be displayed. Numeric fields are displayed with a floating minus sign and an inserted decimal point.
See also the STOP statement.
DISPLAY FORMAT Refer to the Format Module Description
DIVIDE Refer to ARITHMETIC.
END TRANSACTION Refer to the Files description.
EVALUATE data-item
{WHEN compare-item [WHEN compare-item]...
statements}...
[WHEN OTHER
statements ]
END-EVALUATE
Data-item is the field which is to be compared to the compare-items in the
following WHEN clauses.
EVALUATE must immediately be followed by a WHEN statement.
There may be more than one consecutive WHEN phrases, each with its own
compare-item, all of which are in an OR relationship. Thus:
WHEN 2 WHEN 3 is interpreted as WHEN 2 OR 3.
If the data-item matches one of the compare-items in a WHEN or consecutive WHEN statements, the statements following are executed down to the next WHEN or the END-EVALUATE statement. If the data-item is not matched in a WHEN statement, control passes immediately to the next WHEN statement, or to the END-EVALUATE statement if this was the last WHEN statement.
The statements following the WHEN OTHER statement are executed only for a
data-item which is unmatched in any of the preceding WHEN statements. If
there is no WHEN OTHER statement, the EVALUATE procedure executes no
statements for an unmatched data-item.
EXIT
Specifies an end point for a performed set of procedures. This statement must
appear in a sentence by itself. If the set of procedures logically ended by
an EXIT statement is not currently being performed, the EXIT statement does
nothing; processing continues with the next logical statement in the program.
EXIT PROGRAM
This statement in a called program causes control to be returned to the
program which called it. If this is encountered in a program which has not
been called, the action is the same as the STOP RUN statement, and the current
run is terminated.
EXIT PERFORM
This is a non-standard statement. It causes control to be passed to the
statement following the current inline perform, regardless of the specified
control of the perform statement. It is mainly used with PERFORM UNTIL EXIT
but may be used with any inline perform. An inline perform is one without the
[ first-proc [ THRU end-proc ] ] phrase.
GO TO proc-name
GO TO {proc-name}... DEPENDING ON numeric-item
IF {condition}... [THEN]
statements
[ELSE statements]
[END-IF]
INSPECT src-string | Tallying-clause [Replacing-clause] |
| Replacing-clause |
Tallying-clause
TALLYING {tally-count FOR
{|ALL char|LEADING char| CHARACTERS|
[Limits-phrase]}...}...
Tally-count
Any numeric data item; its value is not initialised before the tallying
commences.
Char
A single character literal or data item.
ALL char
All 'char' within the limits are tallied.
LEADING char
Only those 'char' at the start of the limited field are tallied.
CHARACTERS
All characters in the limited field are tallied.
Replacing-clause
REPLACING {|ALL char |
|LEADING char |
|FIRST char |
|CHARACTERS |
BY char [Limits-phrase]}...
Char
Each is a single character literal or data item.
ALL char
All 'char' within the limits are replaced by the second 'char'.
LEADING char
Only those 'char' at the start of the limited field are replaced by the
second 'char'.
FIRST char
Only the first 'char' in the limited field is replaced by the second 'char'.
CHARACTERS
All characters in the limited field are replaced by 'char'.
INSPECT src-string
CONVERTING |from-string TO to-string |
|TO ALPHABETIC-UPPER |
|TO ALPHABETIC-LOWER |
[Limits-phrase]
From-string and to-string are both literal or display data items. Each
character in from-string is replaced by the corresponding character from to-
string in the src-string, wherever it is found in the limited field. To-
string must be at least as long as from-string, and any characters in excess
of the length of from-string are ignored.
ALPHABETIC-UPPER ALPHABETIC-LOWER
All alphabetic characters in the limited src-string are converted to upper or
lower case respectively.
Limits-phrase
| BEFORE INITIAL string [AFTER INITIAL string] |
| AFTER INITIAL string [BEFORE INITIAL string] |
String
A character literal or data item of one or more characters.
The AFTER string determines the start of the limited string; the BEFORE
string determines the end of the limited string.
INSPECT src-string CONVERTING INITIALS
This is a non-standard statement. This statement converts the ascii data in
src-string to lower case, then converts the following letters to upper case:
MOVE source-item TO {dest-item} ...The following table summarises the result of the various move combinations.
Source item | Destination item | ||||
---|---|---|---|---|---|
DISPLAY | NUMERIC | DATE | |||
PIC X's | Edited | Unedited | Edited | ||
DISPLAY PIC X's Edited Symbolic | Move | Edit | De-edit | Invalid | De-edit |
DISPLAY 9's integer | Move | Edit | Convert | Edit | De-edit |
NUMERIC unedited | Invalid | Invalid | Convert | Edit | Invalid |
ZERO | Fill | Edit | Move | Move | Move |
HIGH/LOW-VALUES SPACES ALL "x" Symbolic | Fill | Edit | Invalid | Invalid | Invalid |
DATE | Edit | Invalid | Weekday | Invalid | Move |
Move
Move data with appropriate alignment, space-filled.
Edit
Edit source data into defined destination edit picture.
De-edit
The source is assumed to contain an edited value of the destination
type, which is extracted and stored in the destination item. The
result is zero if a valid value is not found.
Convert
The numeric value is converted and aligned on the decimal place.
Fill
The destination item is filled with the source character or value.
Invalid
Incompatible data types for the MOVE statement.
See the separate description for date fields moves.
MULTIPLY Refer to ARITHMETIC.
OPEN Refer to the Files description.
PERFORM [ first-proc [|THRU|THROUGH| end-proc ] ]
[repeat TIMES ]
[statements
END-PERFORM ]
Repeat may range from zero through to 65535, the number of times the Perform
will be repeated, in default of which there will be one perform.
PERFORM UNTIL EXIT
statements
END-PERFORM
This is a non-standard option which commences a block of inline statements
which are executed continuously through to END-PERFORM until the EXIT PERFORM
statement is executed.
PERFORM [ first-proc [ THRU THROUGH| end-proc] ]
[ WITH TEST |BEFORE|AFTER| ] UNTIL condition
[ statements
END-PERFORM ]
PERFORM [ first-proc [ |THRU|THROUGH| end-proc ] ]
[ WITH TEST |BEFORE|AFTER| ]
VARYING var-field FROM initial BY increment UNTIL condition
[ AFTER var-field FROM initial BY increment UNTIL condition ]...
[ statements
END-PERFORM ]
WITH TEST BEFORE is the default condition; if the condition is true at the
start of the perform, the action is not performed.
VARYING is the primary phrase; successive AFTER phrases are in sequence, the
least significant last.
Example:
PERFORM display-times
VARYING hour FROM ZERO BY 1 UNTIL hour > 23
AFTER minute FROM ZERO BY 1 UNTIL minute >60
AFTER second FROM ZERO BY 1 UNTIL second > 60
END-PERFORM
See also EXIT PERFORM.
READ Refer to the Files description.
REWRITE Refer to the Files description.
SEARCH table-entry [ VARYING pointer ]
[ AT END statements ]
{WHEN condition |statements|CONTINUE| }...
[ END-SEARCH ]
Serial search, commencing from the current table-entry as located by the
defined index for that table-entry.
Table-entry
The entries to be searched. Its description includes the OCCURS clause and
the INDEXED BY phrase. Table-entry is not indexed, subscripted, or reference
modified in the statement. If table-entry is subordinate to higher level
OCCURS clauses, those OCCURS clauses must include the INDEXED BY phrase, and
the value of those indexes will be used in the evaluation.
VARYING Pointer
The pointer may reference one of four data items.
AT END
The number of entries in the table is controlled by the DEPENDING ON data
item, or the OCCURS number by default. If the current location is beyond the
last entry in the table, or this point is reached before any condition is
true, the AT AND statements are performed and control passes to END-SEARCH
(unless the last statement is GO TO). If there is no AT END clause and no
condition is found to be true, control passes to END-SEARCH.
WHEN condition
Condition may be any valid conditional statement. On the first and each
subsequent iteration, the first condition which is found to be true will
execute the associated statements, then pass control to END-SEARCH (unless the
last statement is GO TO). Thus, only one (if any) WHEN condition is found to
be true.
SEARCH ALL table-entry [AT END statements]
WHEN entry-key IS |EQUAL TO|=| compare-item
|statements|CONTINUE|
[END-SEARCH]
Binary search of a complete table of entries which must contain the KEY IS
clause.
Table-entry
The same as for the serial search, but in addition the OCCURS clause must
contain the KEY IS phrase. If the keys are not in the defined ascending or
descending sequence, the results are unpredictable. If there is more than one
table-entry containing the required key, the particular table-entry with the
required key which is found is also unpredictable.
AT END
The same as for the serial search. The first defined index for the table-
entry is used in the search.
WHEN
Only one WHEN clause is permitted. The entry-key is the data item which is
the object of the KEY IS phrase, and must be indexed by the first defined
index for the table. If the table -entry is subordinate to higher level
OCCURS clauses, Those higher level indexes must also be included. Compare-
item may be any data item or literal which may validly be compared to entry-
key, but it may not be indexed by the index in the KEY IS phrase.
Example:
01 BRANCH-TABLE.
05 BRANCH-ITEM OCCURS 120 TIMES INDEXED BY BRTX
ASCENDING KEY IS BRANCH-CODE.
10 BRANCH-CODE PIC XX.
10 BRANCH-TOTAL PIC 9(4)V99 COMP-3.
...
SEARCH ALL BRANCH-ITEM
AT END ADD TRANSACTION-AMOUNT TO UNMATCHED-TOTAL
WHEN BRANCH-CODE (BRTX) IS EQUAL TO TRANSACTION-BRANCH
ADD TRANSACTION-AMOUNT TO BRANCH-TOTAL (BRTX)
END-SEARCH
SET | index-data TO indexed-by-name |
| integer TO index-by-name |
| indexed-by-name TO |integer|index-data | |
| indexed-by-name |UP|DOWN| BY integer |
Integer is treated as a subscript of the table to which the indexed-by-name
belongs.
Index-data is moved to or from indexed-by-name without any conversion.
SET {condition-name}... TO |TRUE|FALSE|
TRUE
If there is more than one value for the condition-name, the
corresponding field is set to the first value.
FALSE
This is a non-standard option. The first character of the
corresponding field is set to hexadecimal 00, regardless of the
actual condition.
SET DIRECTORY TO pathname
Pathname is a literal or data-item containing a directory path.
SET DATE TO date-field
A non-standard statement to set the system date.
Refer also to the Screen Module for further SET statements.
START Refer to the Files description.
STOP | AT |llcc|llcc-field| |
| ATTRIBUTE |"fb"|attribute-field| |
| BELL |
| dataname |
| literal | ...
This statement is provided solely for program testing. Its operands are the
same as for the DISPLAY statement. Unlike the DISPLAY statement however, when
this statement is complete the program waits for the user to respond on the
keyboard:
STOP RUNThis statement terminates the run. This will also occur if the statement is in a called program.
STRING Not implemented. UNSTRING Not implemented. SUBTRACT Refer to ARITHMETIC. USE Refer to the Files description. WRITE Refer to the Files description.