Browsable IBM VS COBOL II Grammar

CC-BY

Grammar extracted by Vadim Zaytsev, see the Grammar Zoo entry for details: cobol/vscobolii/prolog/extracted
Source used for this grammar: Ralf Lämmel, IBM VS COBOL II, ibm-transformed.pl, 4 June 2003 [Explore]

Summary

Syntax

statement_verb ::=
	"ACCEPT"
	"ADD"
	"ALTER"
	"CALL"
	"CANCEL"
	"CLOSE"
	"COMPUTE"
	"CONTINUE"
	"DELETE"
	"DISPLAY"
	"DIVIDE"
	"ENTRY"
	"EVALUATE"
	"EXIT"
	"GOBACK"
	"GO"
	"IF"
	"INITIALIZE"
	"INSPECT"
	"MERGE"
	"MOVE"
	"MULTIPLY"
	"OPEN"
	"PERFORM"
	"READ"
	"RELEASE"
	"RETURN"
	"REWRITE"
	"SEARCH"
	"SET"
	"SORT"
	"START"
	"STOP"
	"STRING"
	"SUBTRACT"
	"UNSTRING"
	"WRITE"
	"EXAMINE"
	"COPY"
copy_directive_without_period ::=
	"COPY" (text_name | literal) (("OF" | "IN") (library_name | literal) | ε) ("SUPPRESS" | ε) ("REPLACING" (copy_operand "BY" copy_operand)+ | ε)
statements ::=
	accept_statement (statement_verb statements | ε)
	add_statement (statement_verb statements | "END-ADD" (statement_verb statements | ε) | size_error_phrases ("END-ADD" (statement_verb statements | ε) | ε) | ε)
	alter_statement (statement_verb statements | ε)
	call_statement_format_i (statement_verb statements | "END-CALL" (statement_verb statements | ε) | on_overflow ("END-CALL" (statement_verb statements | ε) | ε) | ε)
	call_statement_format_ii (statement_verb statements | "END-CALL" (statement_verb statements | ε) | exception_phrases ("END-CALL" (statement_verb statements | ε) | ε) | ε)
	cancel_statement (statement_verb statements | ε)
	close_statement (statement_verb statements | ε)
	compute_statement (statement_verb statements | "END-COMPUTE" (statement_verb statements | ε) | size_error_phrases ("END-COMPUTE" (statement_verb statements | ε) | ε) | ε)
	continue_statement (statement_verb statements | ε)
	delete_statement (statement_verb statements | "END-DELETE" (statement_verb statements | ε) | invalid_key_phrases ("END-DELETE" (statement_verb statements | ε) | ε) | ε)
	display_statement (statement_verb statements | ε)
	divide_statement (statement_verb statements | "END-DIVIDE" (statement_verb statements | ε) | size_error_phrases ("END-DIVIDE" (statement_verb statements | ε) | ε) | ε)
	entry_statement (statement_verb statements | ε)
	evaluate_statement ("END-EVALUATE" (statement_verb statements | ε) | ε)
	exit_statement (statement_verb statements | ε)
	exit_program_statement (statement_verb statements | ε)
	goback_statement (statement_verb statements | ε)
	go_to_statement (statement_verb statements | ε)
	if_statement ("END-IF" (statement_verb statements | ε) | ε)
	initialize_statement (statement_verb statements | ε)
	inspect_statement (statement_verb statements | ε)
	merge_statement (statement_verb statements | ε)
	move_statement (statement_verb statements | ε)
	multiply_statement (statement_verb statements | "END-MULTIPLY" (statement_verb statements | ε) | size_error_phrases ("END-MULTIPLY" (statement_verb statements | ε) | ε) | ε)
	open_statement (statement_verb statements | ε)
	perform_statement (statement_verb statements | ε)
	read_statement_format_i (statement_verb statements | "END-READ" (statement_verb statements | ε) | at_end_phrases ("END-READ" (statement_verb statements | ε) | ε) | ε)
	read_statement_format_ii (statement_verb statements | "END-READ" (statement_verb statements | ε) | invalid_key_phrases ("END-READ" (statement_verb statements | ε) | ε) | ε)
	release_statement (statement_verb statements | ε)
	return_statement ("END-RETURN" (statement_verb statements | ε) | ε)
	rewrite_statement (statement_verb statements | "END-REWRITE" (statement_verb statements | ε) | invalid_key_phrases ("END-REWRITE" (statement_verb statements | ε) | ε) | ε)
	search_statement ("END-SEARCH" (statement_verb statements | ε) | ε)
	set_statement (statement_verb statements | ε)
	sort_statement (statement_verb statements | ε)
	start_statement (statement_verb statements | "END-START" (statement_verb statements | ε) | invalid_key_phrases ("END-START" (statement_verb statements | ε) | ε) | ε)
	stop_statement (statement_verb statements | ε)
	string_statement (statement_verb statements | "END-STRING" (statement_verb statements | ε) | overflow_phrases ("END-STRING" (statement_verb statements | ε) | ε) | ε)
	subtract_statement (statement_verb statements | "END-SUBTRACT" (statement_verb statements | ε) | size_error_phrases ("END-SUBTRACT" (statement_verb statements | ε) | ε) | ε)
	unstring_statement (statement_verb statements | "END-UNSTRING" (statement_verb statements | ε) | overflow_phrases ("END-UNSTRING" (statement_verb statements | ε) | ε) | ε)
	write_statement_format_i (statement_verb statements | "END-WRITE" (statement_verb statements | ε) | write_before_after (statement_verb statements | "END-WRITE" (statement_verb statements | ε) | w_phrase ("END-WRITE" (statement_verb statements | ε) | ε) | ε) | invalid_key_phrases ("END-WRITE" (statement_verb statements | ε) | ε) | ε)
	examine_statement (statement_verb statements | ε)
	copy_directive (statement_verb statements | ε)
overflow_phrases ::=
	(on_overflow | ε) (not_on_overflow | ε)
invalid_key_phrases ::=
	invalid_key
	not_invalid_key
	invalid_key not_invalid_key
at_end_phrases ::=
	at_end
	not_at_end
	at_end not_at_end
exception_phrases ::=
	on_exception
	not_on_exception
	on_exception not_on_exception
size_error_phrases ::=
	on_size_error
	not_on_size_error
	on_size_error not_on_size_error
examine_statement ::=
	"EXAMINE" identifier "TALLYING" ("ALL" | "LEADING") literal
not_at_eop ::=
	"NOT" ("AT" | ε) ("END-OF-PAGE" | "EOP") series_of_imperative_statements
at_eop ::=
	("AT" | ε) ("END-OF-PAGE" | "EOP") series_of_imperative_statements
write_before_after ::=
	("BEFORE" | "AFTER") ("ADVANCING" | ε) ((identifier | integer) ("LINE" | "LINES" | ε) | mnemonic_name | "PAGE")
	ε
not_at_end ::=
	"NOT" ("AT" | ε) "END" series_of_imperative_statements
at_end ::=
	("AT" | ε) "END" series_of_imperative_statements
inspect_replacing_phrase ::=
	"REPLACING" ("CHARACTERS" "BY" (identifier | literal) before_after_phrase* | ("ALL" | "LEADING" | "FIRST") ((identifier | literal) "BY" (identifier | literal) before_after_phrase*)+)+
inspect_tallying_phrase ::=
	"TALLYING" (identifier "FOR" ("CHARACTERS" before_after_phrase* | ("ALL" | "LEADING") ((identifier | literal) before_after_phrase*)+)+)+
before_after_phrase ::=
	("BEFORE" | "AFTER") ("INITIAL" | ε) (identifier | literal)
when_other_phrase ::=
	"WHEN" "OTHER" series_of_imperative_statements
when_phrase ::=
	("WHEN" e_phrase ("ALSO" e_phrase)*)+ series_of_imperative_statements
e_phrase ::=
	"ANY"
	condition
	"TRUE"
	"FALSE"
	("NOT" | ε) (identifier | literal | arithmetic_expression) (("THROUGH" | "THRU") (identifier | literal | arithmetic_expression) | ε)
invalid_key ::=
	"INVALID" ("KEY" | ε) series_of_imperative_statements
not_invalid_key ::=
	"NOT" "INVALID" ("KEY" | ε) series_of_imperative_statements
not_on_exception ::=
	"NOT" ("ON" | ε) "EXCEPTION" series_of_imperative_statements
on_exception ::=
	("ON" | ε) "EXCEPTION" series_of_imperative_statements
not_on_overflow ::=
	"NOT" ("ON" | ε) "OVERFLOW" series_of_imperative_statements
on_overflow ::=
	("ON" | ε) "OVERFLOW" series_of_imperative_statements
not_on_size_error ::=
	"NOT" ("ON" | ε) "SIZE" "ERROR" series_of_imperative_statements
on_size_error ::=
	("ON" | ε) "SIZE" "ERROR" series_of_imperative_statements
use_directive ::=
	use_directive_format_i
	use_directive_format_ii
	use_directive_format_iii
subtract_statement ::=
	subtract_statement_format_i
	subtract_statement_format_ii
	subtract_statement_format_iii
set_statement ::=
	set_statement_format_i
	set_statement_format_ii
	set_statement_format_iii
	set_statement_format_iv
	set_statement_format_v
search_statement ::=
	search_statement_format_i
	search_statement_format_ii
perform_statement ::=
	perform_statement_format_i
	perform_statement_format_ii
	perform_statement_format_iii
	perform_statement_format_iv
open_statement ::=
	open_statement_format_i
	open_statement_format_ii
multiply_statement ::=
	multiply_statement_format_i
	multiply_statement_format_ii
move_statement ::=
	move_statement_format_i
	move_statement_format_ii
inspect_statement ::=
	inspect_statement_format_i
	inspect_statement_format_ii
	inspect_statement_format_iii
	inspect_statement_format_iv
go_to_statement ::=
	go_to_statement_format_i
	go_to_statement_format_ii
	altered_go_to
	go_to_statement_format_iv
divide_statement ::=
	divide_statement_format_i
	divide_statement_format_ii
	divide_statement_format_iii
	divide_statement_format_iv
	divide_statement_format_v
close_statement ::=
	close_statement_format_i
	close_statement_format_ii
add_statement ::=
	add_statement_format_i
	add_statement_format_ii
	add_statement_format_iii
accept_statement ::=
	accept_statement_format_i
	accept_statement_format_ii
call_using_phrase ::=
	"USING" ((("BY" | ε) "REFERENCE" | ε) (identifier | "ADDRESS" "OF" identifier | file_name)+ | ("BY" | ε) "CONTENT" (("LENGTH" "OF" | ε) identifier | "ADDRESS" "OF" identifier | literal)+)+
altered_go_to ::=
	"GO" ("TO" | ε)
occurs_clause ::=
	occurs_clause_format_ii
	occurs_clause_format_i
data_clauses ::=
	(blank_when_zero_clause | external_clause | global_clause | justified_clause | occurs_clause | picture_clause | sign_clause | synchronized_clause | usage_clause | value_clause_format_i)*
data_description_entry ::=
	data_description_entry_format_i
	data_description_entry_format_ii
	data_description_entry_format_iii
	copy_directive
code_set_clause ::=
	"CODE-SET" ("IS" | ε) alphabet_name
recording_mode_clause ::=
	"RECORDING" ("MODE" | ε) ("IS" | ε) mode
linage_area_clause ::=
	(("WITH" | ε) "FOOTING" ("AT" | ε) (data_name | integer) | ε) (("LINES" | ε) ("AT" | ε) "TOP" (data_name | integer) | ε) (("LINES" | ε) ("AT" | ε) "BOTTOM" (data_name | integer) | ε)
linage_clause ::=
	"LINAGE" ("IS" | ε) (qualified_data_name | integer) ("LINES" | ε) linage_area_clause
data_records_clause ::=
	"DATA" ("RECORD" | "RECORDS") ("IS" | "ARE" | ε) qualified_data_name+
value_of_clause ::=
	"VALUE" "OF" (system_name ("IS" | ε) (qualified_data_name | literal))+
label_records_clause ::=
	"LABEL" ("RECORD" | "RECORDS") ("IS" | "ARE" | ε) ("STANDARD" | "OMITTED" | qualified_data_name+)
record_varying_clause ::=
	("IS" | ε) "VARYING" ("IN" | ε) ("SIZE" | ε) (("FROM" | ε) integer | ε) ("TO" integer | ε) ("CHARACTERS" | ε)
record_clause ::=
	"RECORD" (("CONTAINS" | ε) integer ("CHARACTERS" | ε) | ("CONTAINS" | ε) integer "TO" integer ("CHARACTERS" | ε) | record_varying_clause ("DEPENDING" ("ON" | ε) qualified_data_name | ε))
block_contains_clause ::=
	"BLOCK" ("CONTAINS" | ε) (integer "TO" | ε) integer ("CHARACTERS" | "RECORDS" | "RECORD" | ε)
global_clause ::=
	("IS" | ε) "GLOBAL"
external_clause ::=
	("IS" | ε) "EXTERNAL"
file_clauses ::=
	(external_clause | global_clause | block_contains_clause | record_clause | label_records_clause | value_of_clause | data_records_clause | linage_clause | recording_mode_clause | code_set_clause)*
file_description_entry ::=
	("FD" | "SD") file_name file_clauses ";"
status_clause ::=
	("FILE" | ε) "STATUS" ("IS" | ε) qualified_data_name (qualified_data_name | ε)
relative_key ::=
	"RELATIVE" ("KEY" | ε) ("IS" | ε) qualified_data_name
record_key ::=
	"RECORD" ("KEY" | ε) ("IS" | ε) qualified_data_name (password_clause | ε) idx_entry*
password_clause ::=
	"PASSWORD" ("IS" | ε) qualified_data_name
key_clause ::=
	record_key
	relative_key
access_mode_clause ::=
	("ACCESS" ("MODE" | ε) ("IS" | ε) | ε) ("SEQUENTIAL" | "RANDOM" | "DYNAMIC")
record_delimiter_clause ::=
	"RECORD" "DELIMITER" ("IS" | ε) ("STANDARD-1" | assignment_name)
padding_character_clause ::=
	"PADDING" ("CHARACTER" | ε) ("IS" | ε) (qualified_data_name | literal)
organisation_clause ::=
	("ORGANIZATION" ("IS" | ε) | ε) ("SEQUENTIAL" | "INDEXED" | "RELATIVE")
reserve_clause ::=
	"RESERVE" integer ("AREA" | "AREAS" | ε)
file_control_clauses ::=
	(reserve_clause | organisation_clause | padding_character_clause | record_delimiter_clause | access_mode_clause | key_clause | password_clause | status_clause)*
assign_clause ::=
	"ASSIGN" ("TO" | ε) (assignment_name | literal)+
select_clause ::=
	"SELECT" ("OPTIONAL" | ε) file_name
file_control_entry ::=
	select_clause assign_clause file_control_clauses ";"
special_names_clauses ::=
	(environment_clause | alphabet_clause | symbolic_clause | class_clause | currency_clause)*
currency_clause ::=
	"CURRENCY" ("SIGN" | ε) ("IS" | ε) literal
	"DECIMAL-POINT" ("IS" | ε) "COMMA"
	"CURRENCY" ("SIGN" | ε) ("IS" | ε) literal "DECIMAL-POINT" ("IS" | ε) "COMMA"
class_clause ::=
	"CLASS" class_name ("IS" | ε) (literal (("THROUGH" | "THRU") literal | ε))+
symbolic_clause ::=
	"SYMBOLIC" ("CHARACTERS" | ε) (symbolic_character+ ("ARE" | "IS" | ε) integer+)+ ("IN" alphabet_name | ε)
alphabet_clause ::=
	"ALPHABET" alphabet_name ("IS" | ε) ("STANDARD-1" | "STANDARD-2" | "NATIVE" | "EBCDIC" | (literal (("THROUGH" | "THRU") literal | ("ALSO" literal)+ | ε))+)
environment_clause ::=
	environment_name ("IS" | ε) mnemonic_name
	environment_name (("IS" | ε) mnemonic_name (snp_entry | ε) | snp_entry)
computer_paragraphs ::=
	(source_computer_paragraph | object_computer_paragraph)*
sentence ::=
	statements ";"
series_of_imperative_statements ::=
	statements
procedure_division_content ::=
	("DECLARATIVES" ";" (sect ";" use_directive ";" para)+ "END" "DECLARATIVES" ";" | ε) (para | ε) section*
section ::=
	section_name "SECTION" (priority_number | ε) ";" para
using_phrase ::=
	"USING" data_name+
record_description_entry ::=
	data_description_entry
data_division_content ::=
	("FILE" "SECTION" ";" (file_description_entry record_description_entry+)* | ε) ("WORKING-STORAGE" "SECTION" ";" data_description_entry* | ε) ("LINKAGE" "SECTION" ";" data_description_entry* | ε)
environment_division_content ::=
	(configuration_section | ε) (input_output_section | ε)
identification_division_content ::=
	("AUTHOR" (";" | ε) comment_entry* | "INSTALLATION" (";" | ε) comment_entry* | "DATE-WRITTEN" (";" | ε) comment_entry* | "DATE-COMPILED" (";" | ε) comment_entry* | "SECURITY" (";" | ε) comment_entry* | "REMARKS" ";" comment_entry*)*
copy_operand ::=
	quoted_pseudo_text
	identifier
	literal
	cobol_word
abbreviation_rest ::=
	(("AND" | "OR") ("NOT" | ε) (relational_operator | ε) (object | "(" object abbreviation_rest ")"))+
object ::=
	arithmetic_expression
relational_operator ::=
	("IS" | "NOT" | "IS" "NOT" | "NOT" "IS" | ε) ("GREATER" ("THAN" | ε) | ">" | "LESS" ("THAN" | ε) | "<" | "EQUAL" ("TO" | ε) | "=" | "GREATER" ("THAN" | ε) "OR" "EQUAL" ("TO" | ε) | ">=" | "LESS" ("THAN" | ε) "OR" "EQUAL" ("TO" | ε) | "<=")
operand ::=
	arithmetic_expression
simple_condition ::=
	class_condition
	condition_name_condition
	relation_condition
	sign_condition
	switch_status_condition
	"(" condition ")"
combinable_condition ::=
	simple_condition
	negated_simple_condition
	abbreviated_combined_relation_condition
condition ::=
	combinable_condition
	combined_condition
basis ::=
	identifier
	literal
	"(" arithmetic_expression ")"
power ::=
	("+" | "-" | ε) basis ("**" basis)*
times_div ::=
	power (("*" | "/") power)*
arithmetic_expression ::=
	times_div (("+" | "-") times_div)*
mode ::=
	"F"
	"V"
	"U"
	"S"
special_register ::=
	"ADDRESS" "OF" data_name
	"DEBUG-ITEM"
	"LENGTH" "OF" identifier
	"RETURN-CODE"
	"SHIFT-OUT"
	"SHIFT-IN"
	"SORT-CONTROL"
	"SORT-CORE-SIZE"
	"SORT-FILE-SIZE"
	"SORT-MESSAGE"
	"SORT-MODE-SIZE"
	"SORT-RETURN"
	"TALLY"
	"WHEN-COMPILED"
literal ::=
	nonnumeric
	numeric
	dbcs
	figurative_constant
figurative_constant ::=
	"ZERO"
	"ZEROS"
	"ZEROES"
	"SPACE"
	"SPACES"
	"HIGH-VALUE"
	"HIGH-VALUES"
	"LOW-VALUE"
	"LOW-VALUES"
	"QUOTE"
	"QUOTES"
	"ALL" literal
	"NULL"
	"NULLS"
assignment_name ::=
	system_name
environment_name ::=
	system_name
computer_name ::=
	system_name
section_name ::=
	user_defined_word
paragraph_name ::=
	user_defined_word
text_name ::=
	user_defined_word
program_name ::=
	user_defined_word
library_name ::=
	user_defined_word
symbolic_character ::=
	alphabetic_user_defined_word
record_name ::=
	qualified_data_name
mnemonic_name ::=
	alphabetic_user_defined_word
index_name ::=
	alphabetic_user_defined_word
file_name ::=
	alphabetic_user_defined_word
data_name ::=
	alphabetic_user_defined_word
condition_name ::=
	alphabetic_user_defined_word
class_name ::=
	alphabetic_user_defined_word
alphabet_name ::=
	alphabetic_user_defined_word
mod_length ::=
	arithmetic_expression
leftmost_character_position ::=
	arithmetic_expression
condition_name_reference ::=
	condition_name_in_data_division
	condition_name_in_special_names_paragraph
subscript ::=
	integer
	identifier (("+" | "-") integer | ε)
	index_name (("+" | "-") integer | ε)
	("+" | "-") integer
qualified_data_name ::=
	data_name (("IN" | "OF") data_name)* (("IN" | "OF") file_name | ε)
identifier ::=
	identifier_format_i
	identifier_format_ii
	special_register
procedure_name ::=
	reference_to_procedure_division_name_format_i
	reference_to_procedure_division_name_format_ii
abbreviated_combined_relation_condition ::=
	relation_condition abbreviation_rest
	arithmetic_expression relational_operator "(" ("NOT" | ε) arithmetic_expression abbreviation_rest ")"
	arithmetic_expression "(" ("NOT" | ε) (relational_operator | ε) arithmetic_expression abbreviation_rest ")"
accept_statement_format_i ::=
	"ACCEPT" identifier ("FROM" (mnemonic_name | environment_name) | ε)
accept_statement_format_ii ::=
	"ACCEPT" identifier "FROM" ("DATE" | "DAY" | "DAY-OF-WEEK" | "TIME")
add_statement_format_i ::=
	"ADD" (identifier | literal)+ "TO" (identifier ("ROUNDED" | ε))+
add_statement_format_ii ::=
	"ADD" (identifier | literal)+ ("TO" | ε) (identifier | literal) "GIVING" (identifier ("ROUNDED" | ε))+
add_statement_format_iii ::=
	"ADD" ("CORRESPONDING" | "CORR") identifier "TO" identifier ("ROUNDED" | ε)
after_phrase ::=
	("AFTER" (identifier | index_name) "FROM" (identifier | index_name | literal) "BY" (identifier | literal) "UNTIL" condition)*
alter_statement ::=
	"ALTER" (procedure_name "TO" ("PROCEED" "TO" | ε) procedure_name)+
blank_when_zero_clause ::=
	"BLANK" ("WHEN" | ε) ("ZERO" | "ZEROS" | "ZEROES")
call_statement_format_i ::=
	"CALL" (identifier | literal) (call_using_phrase (copy_directive_without_period | ε) | ε)
call_statement_format_ii ::=
	"CALL" (identifier | literal) (call_using_phrase (copy_directive_without_period | ε) | ε)
cancel_statement ::=
	"CANCEL" (identifier | literal)+
class_condition ::=
	identifier ("IS" | "NOT" | "IS" "NOT" | "NOT" "IS" | ε) ("NUMERIC" | "ALPHABETIC" | "ALPHABETIC-LOWER" | "ALPHABETIC-UPPER" | class_name | "DBCS" | "KANJI")
close_statement_format_i ::=
	"CLOSE" (file_name (("REEL" | "UNIT") (("FOR" | ε) "REMOVAL" | ("WITH" | ε) "NO" "REWIND" | ε) | ("WITH" | ε) ("NO" "REWIND" | "LOCK") | ε))+
close_statement_format_ii ::=
	"CLOSE" (file_name (("WITH" | ε) "LOCK" | ε))+
cobol_source_program ::=
	("IDENTIFICATION" | "ID") "DIVISION" ";" "PROGRAM-ID" (";" | ε) program_name (("IS" | ε) "INITIAL" ("PROGRAM" | ε) | ε) (";" | ε) (identification_division_content | ε) ("ENVIRONMENT" "DIVISION" ";" environment_division_content | ε) ("DATA" "DIVISION" ";" data_division_content | ε) ("PROCEDURE" "DIVISION" ((using_phrase | ε) ";" | copy_directive | "USING" data_name* copy_directive) procedure_division_content | ε) (nested_source_program* "END" "PROGRAM" program_name ";" | ε)
combined_condition ::=
	combinable_condition (("AND" | "OR") combinable_condition)+
compute_statement ::=
	"COMPUTE" (identifier ("ROUNDED" | ε))+ ("=" | "EQUAL") arithmetic_expression
condition_name_condition ::=
	condition_name_reference
condition_name_in_data_division ::=
	condition_name (("IN" | "OF") data_name)* (("IN" | "OF") file_name | ε) ("(" subscript ")")*
condition_name_in_special_names_paragraph ::=
	condition_name (("IN" | "OF") mnemonic_name)*
configuration_section ::=
	"CONFIGURATION" "SECTION" ";" computer_paragraphs (special_names_paragraph | ε)
continue_statement ::=
	"CONTINUE"
copy_directive ::=
	copy_directive_without_period ";"
data_description_entry_format_i ::=
	level_number (data_name | "FILLER" | ε) (redefines_clause | ε) data_clauses (";" | ε)
data_description_entry_format_ii ::=
	"66" data_name renames_clause (";" | ε)
data_description_entry_format_iii ::=
	"88" condition_name value_clause_format_ii (";" | ε)
delete_statement ::=
	"DELETE" file_name ("RECORD" | ε)
display_statement ::=
	"DISPLAY" (identifier | literal)+ ("UPON" (mnemonic_name | environment_name) | ε) (("WITH" | ε) "NO" "ADVANCING" | ε)
divide_statement_format_i ::=
	"DIVIDE" (identifier | literal) "INTO" (identifier ("ROUNDED" | ε))+
divide_statement_format_ii ::=
	"DIVIDE" (identifier | literal) "INTO" (identifier | literal) "GIVING" (identifier ("ROUNDED" | ε))+
divide_statement_format_iii ::=
	"DIVIDE" (identifier | literal) "BY" (identifier | literal) "GIVING" (identifier ("ROUNDED" | ε))+
divide_statement_format_iv ::=
	"DIVIDE" (identifier | literal) "INTO" (identifier | literal) "GIVING" identifier ("ROUNDED" | ε) "REMAINDER" identifier
divide_statement_format_v ::=
	"DIVIDE" (identifier | literal) "BY" (identifier | literal) "GIVING" identifier ("ROUNDED" | ε) "REMAINDER" identifier
entry_statement ::=
	"ENTRY" literal ("USING" data_name+ | ε)
evaluate_statement ::=
	"EVALUATE" (identifier | literal | arithmetic_expression | condition | "TRUE" | "FALSE") ("ALSO" (identifier | literal | arithmetic_expression | condition | "TRUE" | "FALSE"))* when_phrase+ (when_other_phrase | ε)
exit_program_statement ::=
	"EXIT" "PROGRAM"
exit_statement ::=
	"EXIT"
file_control_paragraph ::=
	"FILE-CONTROL" ";" file_control_entry*
go_to_statement_format_i ::=
	"GO" ("TO" | ε) procedure_name
go_to_statement_format_ii ::=
	"GO" ("TO" | ε) procedure_name+ "DEPENDING" ("ON" | ε) identifier
go_to_statement_format_iv ::=
	"GO" ("TO" | ε) "MORE-LABELS"
goback_statement ::=
	"GOBACK"
i_o_control_paragraph ::=
	"I-O-CONTROL" ";" ((qsam_or_sam_i_o_control_entries | vsam_i_o_control_entries)+ ";" | ε) (sort_merge_i_o_control_entries ";" | ε)
identifier_format_i ::=
	qualified_data_name ("(" subscript+ ")" | ε) ("(" leftmost_character_position ":" (mod_length | ε) ")" | ε)
identifier_format_ii ::=
	"LINAGE-COUNTER" (("IN" | "OF") file_name | ε)
idx_entry ::=
	"ALTERNATE" ("RECORD" | ε) ("KEY" | ε) ("IS" | ε) qualified_data_name ("PASSWORD" ("IS" | ε) qualified_data_name | ε) (("WITH" | ε) "DUPLICATES" | ε)
if_statement ::=
	"IF" condition ("THEN" | ε) (statement_verb | "NEXT" "SENTENCE") (statements | "NEXT" "SENTENCE") ("ELSE" (statements | "NEXT" "SENTENCE") | ε)
initialize_statement ::=
	"INITIALIZE" identifier+ ("REPLACING" (("ALPHABETIC" | "ALPHANUMERIC" | "NUMERIC" | "ALPHANUMERIC-EDITED" | "NUMERIC-EDITED" | "DBCS" | "EGCS") ("DATA" | ε) "BY" (identifier | literal))+ | ε)
input_output_section ::=
	"INPUT-OUTPUT" "SECTION" ";" (file_control_paragraph | ε) (i_o_control_paragraph | ε)
inspect_statement_format_i ::=
	"INSPECT" identifier inspect_tallying_phrase
inspect_statement_format_ii ::=
	"INSPECT" identifier inspect_replacing_phrase
inspect_statement_format_iii ::=
	"INSPECT" identifier inspect_tallying_phrase inspect_replacing_phrase
inspect_statement_format_iv ::=
	"INSPECT" identifier "CONVERTING" (identifier | literal) "TO" (identifier | literal) before_after_phrase*
justified_clause ::=
	("JUSTIFIED" | "JUST") ("RIGHT" | ε)
merge_statement ::=
	"MERGE" file_name (("ON" | ε) ("ASCENDING" | "DESCENDING") ("KEY" | ε) qualified_data_name+)+ (("COLLATING" | ε) "SEQUENCE" ("IS" | ε) alphabet_name | ε) "USING" file_name file_name+ ("OUTPUT" "PROCEDURE" ("IS" | ε) procedure_name (("THROUGH" | "THRU") procedure_name | ε) | "GIVING" file_name+)
move_statement_format_i ::=
	"MOVE" (identifier | literal) "TO" identifier+
move_statement_format_ii ::=
	"MOVE" ("CORRESPONDING" | "CORR") identifier "TO" identifier+
multiply_statement_format_i ::=
	"MULTIPLY" (identifier | literal) "BY" (identifier ("ROUNDED" | ε))+
multiply_statement_format_ii ::=
	"MULTIPLY" (identifier | literal) "BY" (identifier | literal) "GIVING" (identifier ("ROUNDED" | ε))+
negated_simple_condition ::=
	"NOT" condition
nested_source_program ::=
	("IDENTIFICATION" | "ID") "DIVISION" ";" "PROGRAM-ID" (";" | ε) program_name (("IS" | ε) ("COMMON" ("INITIAL" | ε) | "INITIAL" ("COMMON" | ε)) ("PROGRAM" | ε) | ε) (";" | ε) (identification_division_content | ε) ("ENVIRONMENT" "DIVISION" ";" environment_division_content | ε) ("DATA" "DIVISION" ";" data_division_content | ε) ("PROCEDURE" "DIVISION" ((using_phrase | ε) ";" | copy_directive | "USING" data_name* copy_directive) procedure_division_content | ε) nested_source_program* "END" "PROGRAM" program_name ";"
object_computer_paragraph ::=
	"OBJECT-COMPUTER" ";" (computer_name ("MEMORY" ("SIZE" | ε) integer ("WORDS" | "CHARACTERS" | "MODULES") | ε) ocp_entry ";" | ε)
occurs_clause_format_i ::=
	"OCCURS" integer ("TIMES" | ε) (("ASCENDING" | "DESCENDING") ("KEY" | ε) ("IS" | ε) data_name+)* ("INDEXED" ("BY" | ε) index_name+ | ε)
occurs_clause_format_ii ::=
	"OCCURS" (integer "TO" | ε) integer ("TIMES" | ε) "DEPENDING" ("ON" | ε) qualified_data_name (("ASCENDING" | "DESCENDING") ("KEY" | ε) ("IS" | ε) data_name+)* ("INDEXED" ("BY" | ε) index_name+ | ε)
ocp_entry ::=
	(("PROGRAM" | ε) ("COLLATING" | ε) "SEQUENCE" ("IS" | ε) alphabet_name | ε) ("SEGMENT-LIMIT" ("IS" | ε) priority_number | ε)
open_statement_format_i ::=
	"OPEN" ("INPUT" (file_name ("REVERSED" | ("WITH" | ε) "NO" "REWIND" | ε))+ | "OUTPUT" (file_name (("WITH" | ε) "NO" "REWIND" | ε))+ | "I-O" file_name+ | "EXTEND" file_name+)+
open_statement_format_ii ::=
	"OPEN" ("INPUT" file_name+ | "OUTPUT" file_name+ | "I-O" file_name+ | "EXTEND" file_name+)+
para ::=
	sentence* (paragraph_name ";" sentence*)*
	ε
perform_statement_format_i ::=
	"PERFORM" (procedure_name (("THROUGH" | "THRU") procedure_name | ε) | (series_of_imperative_statements | ε) "END-PERFORM")
perform_statement_format_ii ::=
	"PERFORM" (procedure_name (("THROUGH" | "THRU") procedure_name | ε) (identifier | integer) "TIMES" | (identifier | integer) "TIMES" (series_of_imperative_statements | ε) "END-PERFORM")
perform_statement_format_iii ::=
	"PERFORM" (procedure_name (("THROUGH" | "THRU") procedure_name | ε) test_phrase | test_phrase (series_of_imperative_statements | ε) "END-PERFORM")
perform_statement_format_iv ::=
	"PERFORM" (procedure_name (("THROUGH" | "THRU") procedure_name | ε) varying_phrase after_phrase | varying_phrase (series_of_imperative_statements | ε) "END-PERFORM")
picture_clause ::=
	("PICTURE" | "PIC") ("IS" | ε) character_string
qsam_or_sam_i_o_control_entries ::=
	"RERUN" ("ON" | ε) (assignment_name | file_name) ("EVERY" | ε) (integer "RECORDS" | "END" ("OF" | ε) ("REEL" | "UNIT")) ("OF" | ε) file_name
	"SAME" ("RECORD" | ε) ("AREA" | ε) ("FOR" | ε) file_name file_name*
	"MULTIPLE" "FILE" ("TAPE" | ε) ("CONTAINS" | ε) (file_name ("POSITION" integer | ε))+
	"APPLY" "WRITE-ONLY" ("ON" | ε) file_name+
read_statement_format_i ::=
	"READ" file_name ("NEXT" | ε) ("RECORD" | ε) ("INTO" identifier | ε)
read_statement_format_ii ::=
	"READ" file_name ("RECORD" | ε) ("INTO" identifier | ε) ("KEY" ("IS" | ε) qualified_data_name | ε)
redefines_clause ::=
	"REDEFINES" data_name
reference_to_procedure_division_name_format_i ::=
	paragraph_name (("IN" | "OF") section_name | ε)
reference_to_procedure_division_name_format_ii ::=
	section_name
relation_condition ::=
	operand relational_operator operand
release_statement ::=
	"RELEASE" record_name ("FROM" identifier | ε)
renames_clause ::=
	"RENAMES" qualified_data_name (("THROUGH" | "THRU") qualified_data_name | ε)
return_statement ::=
	"RETURN" file_name ("RECORD" | ε) ("INTO" identifier | ε) at_end (not_at_end | ε)
rewrite_statement ::=
	"REWRITE" record_name ("FROM" identifier | ε)
search_statement_format_i ::=
	"SEARCH" identifier ("VARYING" (identifier | index_name) | ε) (at_end | ε) ("WHEN" condition (series_of_imperative_statements | "NEXT" "SENTENCE"))+
search_statement_format_ii ::=
	"SEARCH" "ALL" identifier (at_end | ε) "WHEN" (identifier ("IS" | ε) ("EQUAL" ("TO" | ε) | "=") (identifier | literal | arithmetic_expression) | condition_name_reference) ("AND" (identifier ("IS" | ε) ("EQUAL" ("TO" | ε) | "=") (identifier | literal | arithmetic_expression) | condition_name_reference))* (series_of_imperative_statements | "NEXT" "SENTENCE" | ε)
sect ::=
	section_name "SECTION" (priority_number | ε)
set_statement_format_i ::=
	"SET" (index_name | identifier)+ "TO" (index_name | identifier | integer)
set_statement_format_ii ::=
	"SET" index_name+ ("UP" "BY" | "DOWN" "BY") (identifier | integer)
set_statement_format_iii ::=
	"SET" (mnemonic_name+ "TO" ("ON" | "OFF"))+
set_statement_format_iv ::=
	"SET" condition_name_reference+ "TO" "TRUE"
set_statement_format_v ::=
	"SET" (identifier | "ADDRESS" "OF" identifier)+ "TO" (identifier | "ADDRESS" "OF" identifier | "NULL" | "NULLS")
sign_clause ::=
	("SIGN" ("IS" | ε) | ε) ("LEADING" | "TRAILING") ("SEPARATE" ("CHARACTER" | ε) | ε)
sign_condition ::=
	operand ("IS" | "NOT" | "IS" "NOT" | "NOT" "IS" | ε) ("POSITIVE" | "NEGATIVE" | "ZERO")
snp_entry ::=
	"ON" ("STATUS" | ε) ("IS" | ε) condition ("OFF" ("STATUS" | ε) ("IS" | ε) condition | ε)
	"OFF" ("STATUS" | ε) ("IS" | ε) condition ("ON" ("STATUS" | ε) ("IS" | ε) condition | ε)
sort_merge_i_o_control_entries ::=
	("RERUN" "ON" assignment_name | ε) ("SAME" ("RECORD" | "SORT" | "SORT-MERGE") ("AREA" | ε) ("FOR" | ε) file_name file_name*)+
sort_statement ::=
	"SORT" file_name (("ON" | ε) ("ASCENDING" | "DESCENDING") ("KEY" | ε) qualified_data_name+)+ (("WITH" | ε) "DUPLICATES" ("IN" | ε) ("ORDER" | ε) | ε) (("COLLATING" | ε) "SEQUENCE" ("IS" | ε) alphabet_name | ε) ("USING" file_name+ | "INPUT" "PROCEDURE" ("IS" | ε) procedure_name (("THROUGH" | "THRU") procedure_name | ε)) ("GIVING" file_name+ | "OUTPUT" "PROCEDURE" ("IS" | ε) procedure_name (("THROUGH" | "THRU") procedure_name | ε))
source_computer_paragraph ::=
	"SOURCE-COMPUTER" ";" (computer_name (("WITH" | ε) "DEBUGGING" "MODE" | ε) ";" | ε)
special_names_paragraph ::=
	"SPECIAL-NAMES" ";" special_names_clauses (";" | ε)
start_statement ::=
	"START" file_name ("KEY" ("IS" | ε) ("EQUAL" ("TO" | ε) | "=" | "GREATER" ("THAN" | ε) | ">" | "NOT" "LESS" ("THAN" | ε) | "NOT" "<" | "GREATER" ("THAN" | ε) "OR" "EQUAL" ("TO" | ε) | ">=") qualified_data_name | ε)
stop_statement ::=
	"STOP" ("RUN" | literal)
string_statement ::=
	"STRING" ((identifier | literal)+ "DELIMITED" ("BY" | ε) (identifier | literal | "SIZE"))+ "INTO" identifier (("WITH" | ε) "POINTER" identifier | ε)
subtract_statement_format_i ::=
	"SUBTRACT" (identifier | literal)+ "FROM" (identifier ("ROUNDED" | ε))+
subtract_statement_format_ii ::=
	"SUBTRACT" (identifier | literal)+ "FROM" (identifier | literal) "GIVING" (identifier ("ROUNDED" | ε))+
subtract_statement_format_iii ::=
	"SUBTRACT" ("CORRESPONDING" | "CORR") identifier "FROM" identifier ("ROUNDED" | ε)
switch_status_condition ::=
	condition_name_reference
synchronized_clause ::=
	("SYNCHRONIZED" | "SYNC") ("LEFT" | "RIGHT" | ε)
test_phrase ::=
	(("WITH" | ε) "TEST" ("BEFORE" | "AFTER") | ε) "UNTIL" condition
unstring_statement ::=
	"UNSTRING" identifier ("DELIMITED" ("BY" | ε) ("ALL" | ε) (identifier | literal) ("OR" ("ALL" | ε) (identifier | literal))* | ε) "INTO" (identifier ("DELIMITER" ("IN" | ε) identifier | ε) ("COUNT" ("IN" | ε) identifier | ε))+ (("WITH" | ε) "POINTER" identifier | ε) ("TALLYING" ("IN" | ε) identifier | ε)
usage_clause ::=
	("USAGE" ("IS" | ε) | ε) ("BINARY" | "COMP" | "COMP-1" | "COMP-2" | "COMP-3" | "COMP-4" | "COMPUTATIONAL" | "COMPUTATIONAL-1" | "COMPUTATIONAL-2" | "COMPUTATIONAL-3" | "COMPUTATIONAL-4" | "DISPLAY" | "DISPLAY-1" | "INDEX" | "PACKED-DECIMAL" | "POINTER")
use_directive_format_i ::=
	"USE" ("GLOBAL" | ε) "AFTER" ("STANDARD" | ε) ("EXCEPTION" | "ERROR") "PROCEDURE" ("ON" | ε) (file_name+ | "INPUT" | "OUTPUT" | "I-O" | "EXTEND")
use_directive_format_ii ::=
	"USE" ("GLOBAL" | ε) "AFTER" ("STANDARD" | ε) ("BEGINNING" | "ENDING" | ε) ("FILE" | "REEL" | "UNIT" | ε) "LABEL" "PROCEDURE" ("ON" | ε) (file_name+ | "INPUT" | "OUTPUT" | "I-O" | "EXTEND")
use_directive_format_iii ::=
	"USE" ("FOR" | ε) "DEBUGGING" ("ON" | ε) (procedure_name+ | "ALL" "PROCEDURES")
value_clause_format_i ::=
	"VALUE" ("IS" | ε) literal
value_clause_format_ii ::=
	("VALUE" ("IS" | ε) | "VALUES" ("ARE" | ε)) (literal (("THROUGH" | "THRU") literal | ε))+
varying_phrase ::=
	(("WITH" | ε) "TEST" ("BEFORE" | "AFTER") | ε) "VARYING" (identifier | index_name) "FROM" (identifier | index_name | literal) "BY" (identifier | literal) "UNTIL" condition
vsam_i_o_control_entries ::=
	"RERUN" ("ON" | ε) (assignment_name | file_name) ("EVERY" | ε) integer "RECORDS" ("OF" | ε) file_name
	"SAME" ("RECORD" | ε) ("AREA" | ε) ("FOR" | ε) file_name file_name*
w_phrase ::=
	at_eop
	not_at_eop
	at_eop not_at_eop
write_statement_format_i ::=
	"WRITE" record_name ("FROM" identifier | ε)

GrammarLabMaintained by Dr. Vadim Zaytsev a.k.a. @grammarware. Last updated in September 2015. []