1167 lines
45 KiB
COBOL
1167 lines
45 KiB
COBOL
$set ans85 noosvs comp mf
|
|
************************************************************
|
|
* *
|
|
* (C) Micro Focus Ltd. 1989 *
|
|
* *
|
|
* CASE.CBL *
|
|
* *
|
|
* This program converts the case of COBOL source code *
|
|
* files in several ways, producing, for example, uppercase *
|
|
* reserved words and lower case data names. *
|
|
* *
|
|
* Instructions for use are presented when it is first *
|
|
* executed. *
|
|
* *
|
|
* This source file actually contains two separate *
|
|
* programs, one called from the other. This type of source *
|
|
* file is known as a multi-program source. Compiling this *
|
|
* source file will result in the creation of two separate *
|
|
* OBJs, as if two separate programs had been compiled, one *
|
|
* after the other. The two OBJs will be called CASE and *
|
|
* CASECONV, CASECONV taking its name from the PROGRAM-ID *
|
|
* line in the second program. *
|
|
* *
|
|
* Compile the program and link the two OBJs created in the *
|
|
* usual way. *
|
|
* *
|
|
************************************************************
|
|
identification division.
|
|
program-id. case.
|
|
environment division.
|
|
file-control.
|
|
select input-file assign input-file-name
|
|
organization is line sequential
|
|
file status is file-status.
|
|
|
|
select output-file assign output-file-name
|
|
organization is line sequential
|
|
file status is file-status.
|
|
|
|
data division.
|
|
|
|
file section.
|
|
|
|
fd input-file.
|
|
01 input-record pic x(80).
|
|
|
|
fd output-file.
|
|
01 output-record pic x(80).
|
|
|
|
working-storage section.
|
|
01 temp-00 .
|
|
03 temp-00-0101 pic x(0078) value "Instructions for using
|
|
- " the CASE utility for altering the case of COBOL source:".
|
|
03 filler pic x(0082).
|
|
03 temp-00-0301 pic x(0077) value "CASE <srce-file-spec>
|
|
- "<target-file-spec> <resvd-word> <data-name> <procedure>".
|
|
03 filler pic x(0086).
|
|
03 temp-00-0504 pic x(0062) value "src-file-spec: full pa
|
|
- "thname and file name for the source file".
|
|
03 filler pic x(0015).
|
|
03 temp-00-0601 pic x(0065) value "target-file-spec: full
|
|
- " pathname and file name for the target file".
|
|
03 filler pic x(0021).
|
|
03 temp-00-0707 pic x(0060) value "resvd-word: U means co
|
|
- "nvert all reserved words to UPPER case".
|
|
03 filler pic x(0032).
|
|
03 temp-00-0819 pic x(0029) value "L means convert to LOW
|
|
- "ER case".
|
|
03 filler pic x(0051).
|
|
03 temp-00-0919 pic x(0062) value "F means convert first
|
|
- "character to UPPER, all others to LOWER ".
|
|
03 temp-00-1001 pic x(0062) value " data-name: U me
|
|
- "ans convert all data names to UPPER case".
|
|
03 filler pic x(0036).
|
|
03 temp-00-1119 pic x(0029) value "L means convert to LOW
|
|
- "ER case".
|
|
03 filler pic x(0051).
|
|
03 temp-00-1219 pic x(0062) value "F means convert first
|
|
- "character to UPPER, all others to LOWER ".
|
|
03 temp-00-1301 pic x(0079) value " procedure: U me
|
|
- "ans convert all procedure and section names to UPPER case".
|
|
03 filler pic x(0019).
|
|
03 temp-00-1419 pic x(0029) value "L means convert to LOW
|
|
- "ER case".
|
|
03 filler pic x(0051).
|
|
03 temp-00-1519 pic x(0061) value "F means convert first
|
|
- "character to UPPER, all others to LOWER".
|
|
03 filler pic x(0081).
|
|
03 temp-00-1701 pic x(0054) value "eg. CASE C:\WORK\MYPRO
|
|
- "G.CBL D:\MYDIR\NEWPROG.CBL U F L".
|
|
03 filler pic x(0106).
|
|
03 temp-00-1901 pic x(0080) value "The other use of this
|
|
- "utility is to convert a COBOL source file to ""SENTENCE"".
|
|
- "".
|
|
03 temp-00-2001 pic x(0080) value "ie. the first characte
|
|
- "r found after a period is UPPER case, all others are LOWER".
|
|
03 filler pic x(0080).
|
|
03 temp-00-2201 pic x(0050) value "eg. CASE C:\WORK\MYPRO
|
|
- "G.CBL D:\MYDIR\NEWPROG.CBL S".
|
|
03 filler pic x(0030).
|
|
77 prog-line-no pic 9(6) comp.
|
|
77 prog-line-no-disp pic z(6).
|
|
77 start-ind pic 99 comp.
|
|
77 char-ind pic 99 comp.
|
|
77 buffer-char-ind pic 99 comp.
|
|
|
|
77 file-flag pic x.
|
|
88 end-of-file value "Y".
|
|
|
|
77 error-flag pic x.
|
|
88 error-found value "Y".
|
|
|
|
77 file-status pic xx.
|
|
|
|
77 input-file-name pic x(80).
|
|
|
|
77 output-file-name pic x(80).
|
|
|
|
77 q-answer pic x.
|
|
|
|
77 no-list pic x(6).
|
|
88 no-list-true value "Nolist" "NOLIST" "nolist" "NoList".
|
|
77 syntax-error pic x(80)
|
|
value "Syntax error in parameters - Program Terminated".
|
|
01 out-err.
|
|
03 oe1 pic x(20)
|
|
value "Target file exists:".
|
|
03 oe2 pic x(15) value "Are you sure?".
|
|
01 in-err.
|
|
03 ie1 pic x(27)
|
|
value "Source file not found for:".
|
|
03 in-err-fname pic x(53).
|
|
01 dup-err.
|
|
03 de1 pic x(37)
|
|
value "Source and target file are the same:".
|
|
03 dup-err-fname pic x(43).
|
|
|
|
78 upper-case value "UPPER-CASE".
|
|
78 lower-case value "lower-case".
|
|
78 first-char value "First-Character-Upper".
|
|
78 sentence-case value "Sentence-type-case".
|
|
|
|
01 final-message-1.
|
|
03 fm1 pic x(31) value " About to convert:".
|
|
03 disp-inp pic x(49).
|
|
03 fm2 pic x(31) value " to:".
|
|
03 disp-out pic x(49).
|
|
01 final-message-2-1.
|
|
03 fm3 pic x(31) value " Converting Reserved words to:".
|
|
03 res-inp pic x(49).
|
|
03 fm4 pic x(31) value " Data names to:".
|
|
03 dat-inp pic x(49).
|
|
03 fm5 pic x(31) value " Procedure names to:".
|
|
03 pro-inp pic x(49).
|
|
01 final-message-2-2.
|
|
03 fm6 pic x(31) value " Converting entire file to:".
|
|
03 fm7 pic x(49) value "Sentence case".
|
|
01 final-message-3.
|
|
03 fm8 pic x(31) value "--- No screen listing ---".
|
|
01 final-message-4.
|
|
03 fm9 pic x(31) value " Do you wish to continue ? ".
|
|
|
|
01 command-tail.
|
|
03 command-tail-char pic x occurs 81.
|
|
|
|
01 buffer-string.
|
|
03 buffer-char pic x occurs 80.
|
|
|
|
01 case-linkage.
|
|
03 case-flags.
|
|
05 lnk-reserved-case pic x.
|
|
88 lnk-reserved-case-ok
|
|
value "u" "l" "f" "U" "L" "F" "S" "s".
|
|
* note that the resreved case flag is also used to determine if
|
|
* the conversion is to be a "sentence" type conversion.
|
|
05 lnk-data-name-case pic x.
|
|
88 lnk-data-name-case-ok
|
|
value "u" "l" "f" "U" "L" "F".
|
|
05 lnk-proc-case pic x.
|
|
88 lnk-proc-case-ok
|
|
value "u" "l" "f" "U" "L" "F".
|
|
03 record-area pic x(80).
|
|
|
|
procedure division.
|
|
runstart section.
|
|
display spaces upon crt
|
|
perform get-command-line
|
|
if not error-found
|
|
perform test-case-flags
|
|
if error-found
|
|
perform command-line-error
|
|
else
|
|
perform open-input-file
|
|
if error-found
|
|
perform input-file-error
|
|
else
|
|
display spaces upon crt
|
|
perform check-output-file
|
|
if not error-found
|
|
open output output-file
|
|
perform convert-file
|
|
close input-file
|
|
close output-file
|
|
end-if
|
|
end-if
|
|
end-if
|
|
end-if
|
|
exit program
|
|
stop run.
|
|
|
|
get-command-line section.
|
|
accept command-tail from command-line
|
|
if command-tail = spaces
|
|
perform command-line-prompt
|
|
display "Enter Parameters"
|
|
accept command-tail
|
|
if command-tail = spaces
|
|
set error-found to true
|
|
display syntax-error
|
|
end-if
|
|
end-if
|
|
if not error-found
|
|
perform split-off-names
|
|
if input-file-name = spaces
|
|
or output-file-name = spaces
|
|
or lnk-reserved-case = spaces
|
|
or lnk-data-name-case = spaces
|
|
or lnk-proc-case = spaces
|
|
perform command-line-error
|
|
else
|
|
if input-file-name = output-file-name
|
|
perform duplicate-file-name-error
|
|
end-if
|
|
end-if
|
|
end-if.
|
|
|
|
open-input-file section.
|
|
open input input-file
|
|
if file-status not = "00"
|
|
set error-found to true
|
|
close input-file
|
|
end-if.
|
|
|
|
check-output-file section.
|
|
open input output-file
|
|
if file-status = "00"
|
|
close output-file
|
|
perform check-for-overwrite
|
|
end-if.
|
|
|
|
convert-file section.
|
|
move input-file-name to disp-inp
|
|
move output-file-name to disp-out
|
|
evaluate lnk-reserved-case
|
|
when "U"
|
|
when "u"
|
|
move upper-case to res-inp
|
|
when "L"
|
|
when "l"
|
|
move lower-case to res-inp
|
|
when "F"
|
|
when "f"
|
|
move first-char to res-inp
|
|
when "S"
|
|
when "s"
|
|
move sentence-case to res-inp
|
|
end-evaluate
|
|
evaluate lnk-data-name-case
|
|
when "U"
|
|
when "u"
|
|
move upper-case to dat-inp
|
|
when "L"
|
|
when "l"
|
|
move lower-case to dat-inp
|
|
when "F"
|
|
when "f"
|
|
move first-char to dat-inp
|
|
end-evaluate
|
|
evaluate lnk-proc-case
|
|
when "U"
|
|
when "u"
|
|
move upper-case to pro-inp
|
|
when "L"
|
|
when "l"
|
|
move lower-case to pro-inp
|
|
when "F"
|
|
when "f"
|
|
move first-char to pro-inp
|
|
end-evaluate
|
|
display final-message-1 at 0301
|
|
if lnk-reserved-case = "S" or "s"
|
|
display final-message-2-2 at 0601
|
|
else
|
|
display final-message-2-1 at 0601
|
|
end-if
|
|
if no-list-true
|
|
display final-message-3 at 1001
|
|
end-if
|
|
display final-message-4 at 1201
|
|
move "Y" to q-answer
|
|
accept q-answer at 1233
|
|
|
|
if q-answer = "y" or "Y"
|
|
display "Converting - Please Wait" at 1401
|
|
perform read-input-file
|
|
move 1 to prog-line-no
|
|
perform until end-of-file
|
|
move prog-line-no to prog-line-no-disp
|
|
move input-record to record-area
|
|
call "CASECONV" using case-linkage
|
|
move record-area to output-record
|
|
write output-record
|
|
if not no-list-true
|
|
move prog-line-no-disp to output-record(1:6)
|
|
display output-record
|
|
else
|
|
display prog-line-no-disp at 1425
|
|
end-if
|
|
add 1 to prog-line-no
|
|
perform read-input-file
|
|
end-perform
|
|
display " "
|
|
display " "
|
|
display "Conversion complete"
|
|
else
|
|
set error-found to true
|
|
end-if.
|
|
|
|
split-off-names section.
|
|
move 1 to start-ind
|
|
perform find-leading-spaces
|
|
perform get-input-file-name
|
|
perform find-leading-spaces
|
|
perform get-output-file-name
|
|
perform find-leading-spaces
|
|
perform get-reserved-flag
|
|
if lnk-reserved-case = "S" or "s"
|
|
move "S" to lnk-data-name-case
|
|
move "S" to lnk-proc-case
|
|
else
|
|
perform find-leading-spaces
|
|
perform get-data-name-flag
|
|
perform find-leading-spaces
|
|
perform get-proc-name-flag
|
|
end-if
|
|
perform find-leading-spaces
|
|
perform get-nolist-flag.
|
|
|
|
find-leading-spaces section.
|
|
perform varying char-ind from start-ind by 1 until
|
|
(char-ind > 80)
|
|
or not (command-tail-char(char-ind) = (spaces or ","))
|
|
end-perform
|
|
move char-ind to start-ind.
|
|
|
|
get-input-file-name section.
|
|
move spaces to buffer-string
|
|
move 1 to buffer-char-ind
|
|
perform varying char-ind from start-ind by 1 until
|
|
char-ind > 80 or command-tail-char(char-ind) = spaces
|
|
move command-tail-char(char-ind) to
|
|
buffer-char(buffer-char-ind)
|
|
add 1 to buffer-char-ind
|
|
end-perform
|
|
move buffer-string to input-file-name
|
|
move char-ind to start-ind.
|
|
|
|
get-output-file-name section.
|
|
move spaces to buffer-string
|
|
move 1 to buffer-char-ind
|
|
perform varying char-ind from start-ind by 1 until
|
|
char-ind > 80 or command-tail-char(char-ind) = spaces
|
|
move command-tail-char(char-ind) to
|
|
buffer-char(buffer-char-ind)
|
|
add 1 to buffer-char-ind
|
|
end-perform
|
|
move buffer-string to output-file-name
|
|
move char-ind to start-ind.
|
|
|
|
get-reserved-flag section.
|
|
if start-ind < 80
|
|
move command-tail-char(start-ind) to lnk-reserved-case
|
|
add 1 to start-ind
|
|
end-if.
|
|
|
|
get-data-name-flag section.
|
|
if start-ind < 80
|
|
move command-tail-char(start-ind) to lnk-data-name-case
|
|
add 1 to start-ind
|
|
end-if.
|
|
|
|
get-proc-name-flag section.
|
|
if start-ind < 80
|
|
move command-tail-char(start-ind) to lnk-proc-case
|
|
add 1 to start-ind
|
|
end-if.
|
|
|
|
get-nolist-flag section.
|
|
move spaces to buffer-string
|
|
move 1 to buffer-char-ind
|
|
perform varying char-ind from start-ind by 1 until
|
|
char-ind > 80 or command-tail-char(char-ind) = spaces
|
|
move command-tail-char(char-ind) to
|
|
buffer-char(buffer-char-ind)
|
|
add 1 to buffer-char-ind
|
|
end-perform
|
|
move buffer-string to no-list.
|
|
|
|
check-for-overwrite section.
|
|
display out-err at 0101
|
|
move "Y" to q-answer
|
|
accept q-answer at 0137
|
|
if q-answer = "y" or "Y"
|
|
next sentence
|
|
else
|
|
set error-found to true
|
|
end-if.
|
|
|
|
input-file-error section.
|
|
set error-found to true
|
|
move input-file-name to in-err-fname
|
|
display in-err.
|
|
|
|
command-line-error section.
|
|
perform command-line-prompt
|
|
display syntax-error
|
|
set error-found to true.
|
|
|
|
command-line-prompt section.
|
|
display temp-00.
|
|
|
|
duplicate-file-name-error section.
|
|
move input-file-name to dup-err-fname
|
|
set error-found to true
|
|
display dup-err.
|
|
|
|
read-input-file section.
|
|
read input-file
|
|
at end
|
|
set end-of-file to true
|
|
end-read.
|
|
|
|
test-case-flags section.
|
|
if lnk-reserved-case = "S" or "s"
|
|
next sentence
|
|
else
|
|
if lnk-reserved-case-ok and
|
|
lnk-data-name-case-ok and lnk-proc-case-ok
|
|
next sentence
|
|
else
|
|
set error-found to true
|
|
end-if
|
|
end-if.
|
|
|
|
end program case.
|
|
|
|
|
|
identification division.
|
|
program-id. caseconv.
|
|
***************************************************************
|
|
* This program accepts one 80 character line of COBOL code in its
|
|
* linkage section. This line of code is returned to the calling
|
|
* program with the line of code changed according to the
|
|
* following rules:
|
|
*
|
|
* There are 3 parameters passed in linkage section:
|
|
*
|
|
* lnk-reserved-case can have values U, L and F
|
|
* lnk-data-name-case can have values U, L and F
|
|
* lnk-proc-case can have values U, L and F
|
|
*
|
|
* the first parameter controls the case of reserved words
|
|
* the second parameter controls the case of data names
|
|
* the third parameter controls the procedure and section names
|
|
*
|
|
* All the above can be independantly changed so that they are
|
|
* in:
|
|
*
|
|
* UPPER-CASE
|
|
* lower-case or
|
|
* First-Character-Upper-Case
|
|
*
|
|
* according to the respective value of the parameter
|
|
*
|
|
* One additional function of this program is controlled by
|
|
* passing the value "S" in lnk-reserved-case. In this case, the
|
|
* other parameters are ignored and the entire line is converted
|
|
* so that the case is made "Sentence like". ie. the first
|
|
* alphabetic character found after a period is capitalised.
|
|
***************************************************************
|
|
working-storage section.
|
|
01 temp-char pic x.
|
|
01 temp-char-9 redefines temp-char pic 99 comp.
|
|
* This next variable, and its associated 88 is used to determine
|
|
* whether to capitalize the next character in the case of "F"
|
|
* type conversion. The setting in the 88 is to capitalize after
|
|
* a space, a hyphen etc. This can be changed to suit your
|
|
* requirements.
|
|
|
|
01 prev-char pic x.
|
|
88 prev-char-separator
|
|
value "(" ":" "-" space "0" thru "9".
|
|
77 ind-1 pic 9(4) comp.
|
|
77 ind-2 pic 9(4) comp.
|
|
78 editfun value x"bb".
|
|
78 spacebreak value x"c5".
|
|
78 yes value 1.
|
|
78 nay value 0.
|
|
01 literal pic 99 comp value zero.
|
|
01 reserved pic 99 comp value zero.
|
|
01 new-sentence-expected pic 99 comp value 1.
|
|
01 start-of-sentence pic 99 comp value 1.
|
|
01 perf-name-expected pic 99 comp value zero.
|
|
01 alt1-name-expected pic 99 comp value zero.
|
|
01 alt2-name-expected pic 99 comp value zero.
|
|
01 go-name-expected pic 99 comp value zero.
|
|
01 pic-name-expected pic 99 comp value zero.
|
|
01 sub pic 99 comp value zero.
|
|
01 start-sub pic 99 comp value zero.
|
|
01 end-sub pic 99 comp value zero.
|
|
01 res-sub pic 99 comp value zero.
|
|
01 res-len pic 99 comp value zero.
|
|
01 res-word-buffer.
|
|
02 res-word-buffer-char pic x occurs 65.
|
|
01 filler redefines res-word-buffer.
|
|
02 res19.
|
|
03 res18.
|
|
04 res17.
|
|
05 res16.
|
|
06 res15.
|
|
07 res14.
|
|
08 res13.
|
|
09 res12.
|
|
10 res11.
|
|
11 res10.
|
|
12 res09.
|
|
13 res08.
|
|
14 res07.
|
|
15 res06.
|
|
16 res05.
|
|
17 res04.
|
|
18 res03.
|
|
19 res02 pic xx.
|
|
19 filler pic x.
|
|
18 filler pic x.
|
|
17 filler pic x.
|
|
16 filler pic x.
|
|
15 filler pic x.
|
|
14 filler pic x.
|
|
13 filler pic x.
|
|
12 filler pic x.
|
|
11 filler pic x.
|
|
10 filler pic x.
|
|
09 filler pic x.
|
|
08 filler pic x.
|
|
07 filler pic x.
|
|
06 filler pic x.
|
|
05 filler pic x.
|
|
04 filler pic x.
|
|
03 filler pic x.
|
|
02 filler pic x(46).
|
|
01 char-to-bin.
|
|
02 char pic x.
|
|
01 char9 redefines char-to-bin pic 99 comp.
|
|
01 ulcase pic 99 comp value 0.
|
|
01 locase pic 99 comp value 1.
|
|
01 editstart pic 9(4) comp value zero.
|
|
01 templen pic 9(4) comp value zero.
|
|
01 editlen pic 9(4) comp value zero.
|
|
01 editfunction pic 9(4) comp value 0.
|
|
|
|
*list of no of reserved words for ANS85
|
|
78 res-word-count-2 value 24.
|
|
78 res-word-count-3 value 24.
|
|
78 res-word-count-4 value 51.
|
|
78 res-word-count-5 value 43.
|
|
78 res-word-count-6 value 48.
|
|
78 res-word-count-7 value 41.
|
|
78 res-word-count-8 value 40.
|
|
78 res-word-count-9 value 23.
|
|
78 res-word-count-10 value 23.
|
|
78 res-word-count-11 value 17.
|
|
78 res-word-count-12 value 15.
|
|
78 res-word-count-13 value 9.
|
|
78 res-word-count-14 value 6.
|
|
78 res-word-count-15 value 4.
|
|
78 res-word-count-16 value 2.
|
|
78 res-word-count-19 value 1.
|
|
|
|
01 r2tab pic x(48) value "ATBYCDFDGOIDIFINISNOOFONORRDSDTOUPCF
|
|
-"CHDEPFPHRFRH".
|
|
01 filler redefines r2tab.
|
|
02 r2entry pic xx occurs res-word-count-2.
|
|
01 r3tab pic x(72) value "ADDALLANDARECRTDAYEGIEMIENDEOPESIFOR
|
|
-"KEYNOTOFFPICRUNSETTABTOPUSEI-OSUMANY".
|
|
01 filler redefines r3tab.
|
|
02 r3entry pic xxx occurs res-word-count-3.
|
|
01 r4tab.
|
|
02 filler pic x(128) value "ALSOAREACALLCOMPCOPYCORRDATADATEDOWN
|
|
-"ELSEEXITFILEFROMINTOJUSTKEPTLEFTLESSLINEMODEMOVENEXTOPENPAGEREAD
|
|
-"REELSAMESENDSIGNSIZESORTSTOP".
|
|
02 filler pic x(76) value
|
|
-"TAPETEXTTHANTHENTHRUTIMETYPEUNITUPONWHENWITHZEROSYNCCODELASTPLUS
|
|
-"TESTTHENTRUE".
|
|
01 filler redefines r4tab.
|
|
02 r4entry pic x(4) occurs res-word-count-4.
|
|
01 r5tab.
|
|
02 filler pic x(128) value "AFTERALTERAREASBLANKBLOCKCLOSECOBOLC
|
|
-"OMMACOUNTEQUALERROREVERYFIRSTINDEXINPUTLABELLIMITLINESMERGEQUEUE
|
|
-"QUOTERERUNSPACESTARTSYSINTAB".
|
|
02 filler pic x(87) value
|
|
-"LETIMESUNTILUSAGEUSINGVALUEWORDSWRITEZEROSENTERRIGHTFINALGROUPRE
|
|
-"SETCLASSORDEROTHERPURGE".
|
|
01 filler redefines r5tab.
|
|
02 r5entry pic x(5) occurs res-word-count-5.
|
|
01 r6tab.
|
|
02 filler pic x(128) value "ACCEPTACCESSASSIGNAUTHORBEFOREBOTTOM
|
|
-"CANCELCOMMITCOMP-3CURSORDELETEDIVIDEENABLEEXTENDFILLERGIVINGLENG
|
|
-"THLIMITSLINAGEMANUALMEMORYNA".
|
|
02 filler pic x(124) value
|
|
-"TIVEOCCURSOUTPUTQUOTESRANDOMRECORDRETURNREWINDSEARCHSELECTSOURCE
|
|
-"SPACESSTATUSSTRINGSWITCHSYSOUTUNLOCKVALUESZEROESCOMP-3COLUMN".
|
|
02 filler pic x(42) value
|
|
-"DETAILREPORTNUMBERBINARYCOMMONEND-IFGLOBAL".
|
|
01 filler redefines r6tab.
|
|
02 r6entry pic x(6) occurs res-word-count-6.
|
|
01 r7tab.
|
|
02 filler pic x(128) value "COMPUTECONSOLEDISABLEDISPLAYDYNAMICF
|
|
-"OOTINGGREATERINDEXEDINSPECTINVALIDLEADINGLINKAGEMESSAGEMODULESNU
|
|
-"MERICOMITTEDPERFORMPICTUREPO".
|
|
02 filler pic x(124) value
|
|
-"INTERPROCEEDPROGRAMRECEIVERECORDSRELEASEREMOVALRENAMESRESERVEREW
|
|
-"RITEROUNDEDSECTIONSEGMENTTHROUGHVARYINGINITIALCONTROLHEADING".
|
|
02 filler pic x(35) value
|
|
-"REPORTSCONTENTEND-ADDPADDINGREPLACE".
|
|
01 filler redefines r7tab.
|
|
02 r7entry pic x(7) occurs res-word-count-7.
|
|
01 r8tab.
|
|
02 filler pic x(128) value "CODE-SETCONTAINSCURRENCYDIVISIONEXCE
|
|
-"SS-3FORMFEEDJAPANESEMULTIPLEMULTIPLYNEGATIVEOPTIONALOVERFLOWPOSI
|
|
-"TIONPOSITIVEREVERSEDROLLBACK".
|
|
02 filler pic x(128) value
|
|
-"SENTENCESEPARATESEQUENCESTANDARDSUBTRACTSYMBOLICTALLYINGTERMINAL
|
|
-"TRAILINGUNSTRINGCONTROLSGENERATEINDICATEINITIATEPRINTINGSUPPRESS
|
|
-"".
|
|
02 filler pic x(64) value
|
|
-"RELATIVESECURITYALPHABETCONTINUEEND-READEVALUATEEXTERNALEND-CALL
|
|
-"".
|
|
01 filler redefines r8tab.
|
|
02 r8entry pic x(8) occurs res-word-count-8.
|
|
01 r9tab.
|
|
02 filler pic x(126) value "ADVANCINGAUTOMATICCHARACTERCRT-UNDER
|
|
-"DEBUGGINGDELIMITEDDELIMITERDEPENDINGEXCEPTIONEXCLUSIVEJUSTIFIEDP
|
|
-"ROCEDUREREDEFINESREMAINDER".
|
|
02 filler pic x(81) value
|
|
-"REPLACINGREPORTINGTERMINATEASCENDINGALTERNATECOLLATINGEND-STARTE
|
|
-"ND-WRITEREFERENCE".
|
|
01 filler redefines r9tab.
|
|
02 r9entry pic x(9) occurs res-word-count-9.
|
|
01 r10tab.
|
|
02 filler pic x(090) value "ALPHABETICAREA-VALUECHARACTERSDUPLIC
|
|
-"ATESPROCEDURESREFERENCESSEQUENTIALSORT-MERGESTANDARD-1".
|
|
02 filler pic x(060) value "DEBUG-ITEMDEBUG-LINEDEBUG-NAMEHIGH-V
|
|
-"ALUEPROGRAM-IDDESCENDING".
|
|
02 filler pic x(080) value "CONVERTINGEND-DELETEEND-RETURNEND-SE
|
|
-"ARCHEND-STRINGINITIALIZESTANDARD-2END-DIVIDE".
|
|
01 filler redefines r10tab.
|
|
02 r10entry pic x(10) occurs res-word-count-10.
|
|
01 r11tab.
|
|
02 filler pic x(088) value "CLOCK-UNITSDEBUG-SUB-1DEBUG-SUB-2DEB
|
|
-"UG-SUB-3DESTINATIONEND-OF-PAGEENVIRONMENTHIGH-VALUES".
|
|
02 filler pic x(033) value "SUB-QUEUE-1SUB-QUEUE-2SUB-QUEUE-3".
|
|
02 filler pic x(011) value "I-O-CONTROL".
|
|
02 filler pic x(055) value
|
|
"DAY-OF-WEEKEND-COMPUTEEND-PERFORMEND-RECEIVEEND-REWRITE".
|
|
01 filler redefines r11tab.
|
|
02 r11entry pic x(11) occurs res-word-count-11.
|
|
01 r12tab.
|
|
02 filler pic x(084) value "COMMAND-LINEDATE-WRITTENDECLARATIVES
|
|
-"FILE-CONTROLINPUT-OUTPUTINSTALLATIONORGANIZATION".
|
|
02 filler pic x(096) value "SYNCHRONIZEDLINE-COUNTERPAGE-COUNTER
|
|
-"ALPHANUMERICEND-EVALUATEEND-MULTIPLYEND-SUBTRACTEND-UNSTRING".
|
|
01 filler redefines r12tab.
|
|
02 r12entry pic x(12) occurs res-word-count-12.
|
|
01 r13tab.
|
|
02 filler pic x(078) value "COMMUNICATIONCOMPUTATIONALCONFIGURAT
|
|
-"IONCORRESPONDINGDATE-COMPILEDDECIMAL-POINT".
|
|
02 filler pic x(039) value "LOCKLOW-VALUESEGMENT-LIMITSPECIAL-NA
|
|
-"MES".
|
|
01 filler redefines r13tab.
|
|
02 r13entry pic x(13) occurs res-word-count-13.
|
|
01 r14tab.
|
|
02 filler pic x(084) value "DEBUG-CONTENTSIDENTIFICATIONLINAGE-C
|
|
-"OUNTERLOCKLOW-VALUESNUMERIC-EDITEDPACKED-DECIMAL".
|
|
01 filler redefines r14tab.
|
|
02 r14entry pic x(14) occurs res-word-count-14.
|
|
01 r15tab.
|
|
02 filler pic x(060) value "COMPUTATIONAL-3OBJECT-COMPUTERSOURCE
|
|
-"-COMPUTERWORKING-STORAGE".
|
|
01 filler redefines r15tab.
|
|
02 r15entry pic x(15) occurs res-word-count-15.
|
|
01 r16tab.
|
|
02 filler pic x(032) value "ALPHABETIC-LOWERALPHABETIC-UPPER".
|
|
01 filler redefines r16tab.
|
|
02 r16entry pic x(16) occurs res-word-count-16.
|
|
01 r19tab.
|
|
02 filler pic x(019) value "ALPHANUMERIC-EDITED".
|
|
01 filler redefines r19tab.
|
|
02 r19entry pic x(19) occurs res-word-count-19.
|
|
|
|
01 ws-case-linkage.
|
|
03 ws-case-flags.
|
|
05 def-reserved-case pic x.
|
|
05 def-sentence-case redefines def-reserved-case pic x.
|
|
05 def-data-name-case pic x.
|
|
05 def-proc-case pic x.
|
|
03 so-rec.
|
|
05 so-rec-chr pic x occurs 80.
|
|
|
|
linkage section.
|
|
01 case-linkage.
|
|
03 case-flags.
|
|
05 lnk-reserved-case pic x.
|
|
05 lnk-data-name-case pic x.
|
|
05 lnk-proc-case pic x.
|
|
03 record-area pic x(80).
|
|
|
|
procedure division using case-linkage.
|
|
main-prog section.
|
|
move case-linkage to ws-case-linkage.
|
|
if ws-case-flags = spaces or so-rec = spaces
|
|
next sentence
|
|
else
|
|
perform case
|
|
move ws-case-linkage to case-linkage.
|
|
exit program.
|
|
stop run.
|
|
|
|
case section.
|
|
move nay to perf-name-expected.
|
|
move nay to alt1-name-expected.
|
|
move nay to alt2-name-expected.
|
|
move nay to go-name-expected.
|
|
move nay to pic-name-expected.
|
|
move nay to literal.
|
|
case1.
|
|
move 8 to start-sub.
|
|
if so-rec-chr(7) = "*"
|
|
go to case-end.
|
|
case2.
|
|
if new-sentence-expected = 1
|
|
move 1 to start-of-sentence
|
|
else
|
|
move 0 to start-of-sentence.
|
|
perform next-word.
|
|
if start-sub > 72
|
|
go to case-end.
|
|
if literal = yes
|
|
move end-sub to start-sub
|
|
go to case2.
|
|
move start-sub to sub.
|
|
if reserved = yes
|
|
if def-reserved-case = "N"
|
|
move end-sub to start-sub
|
|
go to case2.
|
|
if pic-name-expected = yes
|
|
go to case3.
|
|
if reserved = nay
|
|
go to case4.
|
|
case3.
|
|
move res-len to editlen.
|
|
move sub to editstart.
|
|
if def-sentence-case = "S" or "s"
|
|
perform convert-to-sentence
|
|
else
|
|
if def-reserved-case = "F" or "f"
|
|
perform convert-to-first
|
|
else
|
|
if def-reserved-case = "U" or "u"
|
|
perform convert-to-upper
|
|
else
|
|
if def-reserved-case = "L" or "l"
|
|
perform convert-to-lower.
|
|
move end-sub to start-sub.
|
|
go to case2.
|
|
case4.
|
|
if start-sub = 8
|
|
go to case6.
|
|
if perf-name-expected = yes
|
|
go to case6.
|
|
if alt1-name-expected = yes
|
|
go to case6.
|
|
if alt2-name-expected = yes
|
|
go to case6.
|
|
if go-name-expected = yes
|
|
go to case6.
|
|
if def-data-name-case= "N"
|
|
move end-sub to start-sub
|
|
go to case2.
|
|
case5.
|
|
move res-len to editlen.
|
|
move sub to editstart.
|
|
if def-sentence-case = "S" or "s"
|
|
perform convert-to-sentence
|
|
else
|
|
if def-data-name-case = "F" or "f"
|
|
perform convert-to-first
|
|
else
|
|
if def-data-name-case= "U" or "u"
|
|
perform convert-to-upper
|
|
else
|
|
if def-data-name-case = "L" or "l"
|
|
perform convert-to-lower.
|
|
move end-sub to start-sub.
|
|
go to case2.
|
|
case6.
|
|
move nay to perf-name-expected.
|
|
move alt1-name-expected to alt2-name-expected.
|
|
move nay to alt1-name-expected.
|
|
if def-proc-case = "N"
|
|
move end-sub to start-sub
|
|
go to case2.
|
|
case7.
|
|
move res-len to editlen.
|
|
move sub to editstart.
|
|
if def-sentence-case = "S" or "s"
|
|
perform convert-to-sentence
|
|
else
|
|
if def-proc-case = "F" or "f"
|
|
perform convert-to-first
|
|
else
|
|
if def-proc-case = "U" or "u"
|
|
perform convert-to-upper
|
|
else
|
|
if def-proc-case = "L" or "l"
|
|
perform convert-to-lower.
|
|
move end-sub to start-sub.
|
|
go to case2.
|
|
case-end.
|
|
exit.
|
|
next-word section.
|
|
next-w1.
|
|
perform find-char.
|
|
if start-sub > 72
|
|
go to next-wend.
|
|
if char = quote
|
|
if literal = yes
|
|
move nay to literal
|
|
add 1 to start-sub
|
|
go to next-w1
|
|
else
|
|
move yes to literal
|
|
add 1 to start-sub
|
|
go to next-w1.
|
|
if char = "."
|
|
move 1 to new-sentence-expected
|
|
if literal = nay
|
|
move nay to perf-name-expected
|
|
alt1-name-expected
|
|
alt2-name-expected
|
|
go-name-expected
|
|
pic-name-expected
|
|
add 1 to start-sub
|
|
go to next-w1
|
|
else
|
|
add 1 to start-sub
|
|
go to next-w1.
|
|
if literal = yes
|
|
add 1 to start-sub
|
|
go to next-w1.
|
|
move start-sub to end-sub.
|
|
move 1 to res-sub.
|
|
move spaces to res-word-buffer.
|
|
next-w2.
|
|
move char to res-word-buffer-char(res-sub).
|
|
add 1 to end-sub.
|
|
add 1 to res-sub.
|
|
if end-sub > 72
|
|
go to next-w3.
|
|
move so-rec-chr(end-sub) to char.
|
|
if char = space
|
|
go to next-w3
|
|
else if char = "."
|
|
move 1 to new-sentence-expected
|
|
go to next-w3.
|
|
go to next-w2.
|
|
next-w3.
|
|
perform reserved-or-not.
|
|
next-wend.
|
|
exit.
|
|
reserved-or-not section.
|
|
reserv1.
|
|
move 65 to editlen.
|
|
move 1 to editstart.
|
|
perform convert-resv-to-upper.
|
|
move nay to reserved.
|
|
move res-sub to res-len.
|
|
subtract 1 from res-len.
|
|
if res-sub < 3 or res-sub > 20
|
|
go to r20.
|
|
subtract 2 from res-sub.
|
|
go to r2 r3 r4 r5 r6 r7 r8 r9 r10 r11 r12 r13 r14 r15
|
|
r16 r20 r20 r19
|
|
depending on res-sub.
|
|
r2.
|
|
move 0 to res-sub.
|
|
r2a.
|
|
add 1 to res-sub.
|
|
if res-sub > res-word-count-2 go to r20.
|
|
if res02 = r2entry(res-sub)
|
|
move yes to reserved
|
|
go to r20.
|
|
go to r2a.
|
|
r3.
|
|
move 0 to res-sub.
|
|
r3a.
|
|
add 1 to res-sub.
|
|
if res-sub > res-word-count-3 go to r20.
|
|
if res03 = r3entry(res-sub)
|
|
move yes to reserved
|
|
go to r20.
|
|
go to r3a.
|
|
r4.
|
|
move 0 to res-sub.
|
|
r4a.
|
|
add 1 to res-sub.
|
|
if res-sub > res-word-count-4 go to r20.
|
|
if res04 = r4entry(res-sub)
|
|
move yes to reserved
|
|
go to r20.
|
|
go to r4a.
|
|
r5.
|
|
move 0 to res-sub.
|
|
r5a.
|
|
add 1 to res-sub.
|
|
if res-sub > res-word-count-5 go to r20.
|
|
if res05 = r5entry(res-sub)
|
|
move yes to reserved
|
|
go to r20.
|
|
go to r5a.
|
|
r6.
|
|
move 0 to res-sub.
|
|
r6a.
|
|
add 1 to res-sub.
|
|
if res-sub > res-word-count-6 go to r20.
|
|
if res06 = r6entry(res-sub)
|
|
move yes to reserved
|
|
go to r20.
|
|
go to r6a.
|
|
r7.
|
|
move 0 to res-sub.
|
|
r7a.
|
|
add 1 to res-sub.
|
|
if res-sub > res-word-count-7 go to r20.
|
|
if res07 = r7entry(res-sub)
|
|
move yes to reserved
|
|
go to r20.
|
|
go to r7a.
|
|
r8.
|
|
move 0 to res-sub.
|
|
r8a.
|
|
add 1 to res-sub.
|
|
if res-sub > res-word-count-8 go to r20.
|
|
if res08 = r8entry(res-sub)
|
|
move yes to reserved
|
|
go to r20.
|
|
go to r8a.
|
|
r9.
|
|
move 0 to res-sub.
|
|
r9a.
|
|
add 1 to res-sub.
|
|
if res-sub > res-word-count-9 go to r20.
|
|
if res09 = r9entry(res-sub)
|
|
move yes to reserved
|
|
go to r20.
|
|
go to r9a.
|
|
r10.
|
|
move 0 to res-sub.
|
|
r10a.
|
|
add 1 to res-sub.
|
|
if res-sub > res-word-count-10 go to r20.
|
|
if res10 = r10entry(res-sub)
|
|
move yes to reserved
|
|
go to r20.
|
|
go to r10a.
|
|
r11.
|
|
move 0 to res-sub.
|
|
r11a.
|
|
add 1 to res-sub.
|
|
if res-sub > res-word-count-11 go to r20.
|
|
if res11 = r11entry(res-sub)
|
|
move yes to reserved
|
|
go to r20.
|
|
go to r11a.
|
|
r12.
|
|
move 0 to res-sub.
|
|
r12a.
|
|
add 1 to res-sub.
|
|
if res-sub > res-word-count-12 go to r20.
|
|
if res12 = r12entry(res-sub)
|
|
move yes to reserved
|
|
go to r20.
|
|
go to r12a.
|
|
r13.
|
|
move 0 to res-sub.
|
|
r13a.
|
|
add 1 to res-sub.
|
|
if res-sub > res-word-count-13 go to r20.
|
|
if res13 = r13entry(res-sub)
|
|
move yes to reserved
|
|
go to r20.
|
|
go to r13a.
|
|
r14.
|
|
move 0 to res-sub.
|
|
r14a.
|
|
add 1 to res-sub.
|
|
if res-sub > res-word-count-14 go to r20.
|
|
if res14 = r14entry(res-sub)
|
|
move yes to reserved
|
|
go to r20.
|
|
go to r14a.
|
|
r15.
|
|
move 0 to res-sub.
|
|
r15a.
|
|
add 1 to res-sub.
|
|
if res-sub > res-word-count-15 go to r20.
|
|
if res15 = r15entry(res-sub)
|
|
move yes to reserved
|
|
go to r20.
|
|
go to r15a.
|
|
r16.
|
|
move 0 to res-sub.
|
|
r16a.
|
|
add 1 to res-sub.
|
|
if res-sub > res-word-count-16 go to r20.
|
|
if res16 = r16entry(res-sub)
|
|
move yes to reserved
|
|
go to r20.
|
|
go to r16a.
|
|
r19.
|
|
move 0 to res-sub.
|
|
r19a.
|
|
add 1 to res-sub.
|
|
if res-sub > res-word-count-19 go to r20.
|
|
if res19 = r19entry(res-sub)
|
|
move yes to reserved
|
|
go to r20.
|
|
go to r19a.
|
|
r20.
|
|
if reserved = nay go to reserv-end.
|
|
if res-word-buffer not = "TO"
|
|
move nay to go-name-expected.
|
|
if res-word-buffer = "PIC" or "PICTURE" or "VALUE"
|
|
move yes to pic-name-expected
|
|
go to reserv-end
|
|
else
|
|
move nay to pic-name-expected.
|
|
if res-word-buffer = "PERFORM" or "THRU" or "THROUGH"
|
|
move yes to perf-name-expected
|
|
go to reserv-end.
|
|
if res-word-buffer = "ALTER"
|
|
move yes to alt1-name-expected
|
|
go to reserv-end.
|
|
if res-word-buffer = "GO"
|
|
move yes to go-name-expected
|
|
go to reserv-end.
|
|
reserv-end.
|
|
exit.
|
|
convert-to-upper section.
|
|
move editstart to ind-1.
|
|
move 1 to ind-2.
|
|
convert-to-upper-loop.
|
|
move so-rec-chr(ind-1) to temp-char
|
|
if temp-char-9 < 123 and temp-char-9 > 96
|
|
subtract 32 from temp-char-9
|
|
move temp-char to so-rec-chr(ind-1).
|
|
add 1 to ind-1
|
|
add 1 to ind-2.
|
|
if ind-2 not > editlen
|
|
go to convert-to-upper-loop.
|
|
|
|
convert-to-sentence section.
|
|
move editstart to ind-1.
|
|
move 1 to ind-2.
|
|
convert-to-sentence-loop.
|
|
move so-rec-chr(ind-1) to temp-char.
|
|
if start-of-sentence = 1
|
|
if temp-char-9 < 123 and temp-char-9 > 96
|
|
subtract 32 from temp-char-9
|
|
move temp-char to so-rec-chr(ind-1)
|
|
move 0 to new-sentence-expected
|
|
move 0 to start-of-sentence
|
|
else
|
|
if temp-char-9 < 91 and temp-char-9 > 64
|
|
move 0 to new-sentence-expected
|
|
move 0 to start-of-sentence
|
|
else
|
|
next sentence
|
|
else
|
|
if temp-char-9 < 91 and temp-char-9 > 64
|
|
add 32 to temp-char-9
|
|
move temp-char to so-rec-chr(ind-1).
|
|
add 1 to ind-1
|
|
add 1 to ind-2.
|
|
if ind-2 not > editlen
|
|
go to convert-to-sentence-loop.
|
|
|
|
|
|
convert-to-first section.
|
|
move editstart to ind-1.
|
|
move 1 to ind-2.
|
|
convert-to-first-loop.
|
|
move so-rec-chr(ind-1) to temp-char.
|
|
move so-rec-chr(ind-1 - 1) to prev-char
|
|
if prev-char-separator
|
|
if temp-char-9 < 123 and temp-char-9 > 96
|
|
subtract 32 from temp-char-9
|
|
move temp-char to so-rec-chr(ind-1)
|
|
else
|
|
next sentence
|
|
else
|
|
if temp-char-9 < 91 and temp-char-9 > 64
|
|
add 32 to temp-char-9
|
|
move temp-char to so-rec-chr(ind-1).
|
|
add 1 to ind-1
|
|
add 1 to ind-2.
|
|
if ind-2 not > editlen
|
|
go to convert-to-first-loop.
|
|
|
|
convert-to-lower section.
|
|
move editstart to ind-1.
|
|
move 1 to ind-2.
|
|
convert-to-lower-loop.
|
|
move so-rec-chr(ind-1) to temp-char
|
|
if temp-char-9 < 91 and temp-char-9 > 64
|
|
add 32 to temp-char-9
|
|
move temp-char to so-rec-chr(ind-1).
|
|
add 1 to ind-1
|
|
add 1 to ind-2.
|
|
if ind-2 not > editlen
|
|
go to convert-to-lower-loop.
|
|
|
|
convert-resv-to-upper section.
|
|
move editstart to ind-1.
|
|
move 1 to ind-2.
|
|
convert-resv-to-upper-loop.
|
|
move res-word-buffer-char(ind-1) to temp-char
|
|
if temp-char-9 < 123 and temp-char-9 > 96
|
|
subtract 32 from temp-char-9
|
|
move temp-char to res-word-buffer-char(ind-1).
|
|
add 1 to ind-1
|
|
add 1 to ind-2.
|
|
if ind-2 not > editlen
|
|
go to convert-resv-to-upper-loop.
|
|
|
|
find-char section.
|
|
if start-sub < 73
|
|
if so-rec-chr(start-sub) = space
|
|
add 1 to start-sub
|
|
go to find-char
|
|
else
|
|
move so-rec-chr(start-sub) to char
|
|
else
|
|
move space to char.
|
|
|
|
end program caseconv.
|