gitlab-pygments.rb 0.3.2 → 0.5.4
Sign up to get free protection for your applications and to get access to all the features.
- checksums.yaml +7 -0
- data/.gitignore +1 -0
- data/CHANGELOG.md +71 -0
- data/Gemfile +1 -1
- data/LICENSE +17 -0
- data/README.md +28 -1
- data/Rakefile +2 -5
- data/lexers +0 -0
- data/lib/pygments/mentos.py +19 -12
- data/lib/pygments/popen.rb +21 -4
- data/lib/pygments/version.rb +1 -1
- data/pygments.rb.gemspec +2 -0
- data/test/test_pygments.rb +13 -2
- data/vendor/custom_lexers/github.py +206 -3
- data/vendor/pygments-main/AUTHORS +41 -3
- data/vendor/pygments-main/CHANGES +132 -5
- data/vendor/pygments-main/LICENSE +1 -1
- data/vendor/pygments-main/Makefile +1 -1
- data/vendor/pygments-main/REVISION +1 -1
- data/vendor/pygments-main/docs/generate.py +1 -1
- data/vendor/pygments-main/docs/src/api.txt +1 -1
- data/vendor/pygments-main/docs/src/index.txt +1 -1
- data/vendor/pygments-main/docs/src/integrate.txt +5 -0
- data/vendor/pygments-main/docs/src/java.txt +70 -0
- data/vendor/pygments-main/docs/src/lexerdevelopment.txt +52 -0
- data/vendor/pygments-main/external/autopygmentize +64 -0
- data/vendor/pygments-main/external/lasso-builtins-generator-9.lasso +144 -0
- data/vendor/pygments-main/external/markdown-processor.py +2 -2
- data/vendor/pygments-main/external/moin-parser.py +1 -1
- data/vendor/pygments-main/external/rst-directive-old.py +1 -1
- data/vendor/pygments-main/external/rst-directive.py +1 -1
- data/vendor/pygments-main/pygmentize +1 -1
- data/vendor/pygments-main/pygments/__init__.py +2 -2
- data/vendor/pygments-main/pygments/cmdline.py +14 -6
- data/vendor/pygments-main/pygments/console.py +1 -1
- data/vendor/pygments-main/pygments/filter.py +1 -1
- data/vendor/pygments-main/pygments/filters/__init__.py +3 -4
- data/vendor/pygments-main/pygments/formatter.py +4 -1
- data/vendor/pygments-main/pygments/formatters/__init__.py +1 -1
- data/vendor/pygments-main/pygments/formatters/_mapping.py +3 -3
- data/vendor/pygments-main/pygments/formatters/bbcode.py +1 -1
- data/vendor/pygments-main/pygments/formatters/html.py +73 -2
- data/vendor/pygments-main/pygments/formatters/img.py +2 -2
- data/vendor/pygments-main/pygments/formatters/latex.py +9 -9
- data/vendor/pygments-main/pygments/formatters/other.py +1 -3
- data/vendor/pygments-main/pygments/formatters/rtf.py +1 -1
- data/vendor/pygments-main/pygments/formatters/svg.py +1 -1
- data/vendor/pygments-main/pygments/formatters/terminal.py +1 -1
- data/vendor/pygments-main/pygments/formatters/terminal256.py +1 -1
- data/vendor/pygments-main/pygments/lexer.py +78 -10
- data/vendor/pygments-main/pygments/lexers/__init__.py +13 -2
- data/vendor/pygments-main/pygments/lexers/_asybuiltins.py +1 -1
- data/vendor/pygments-main/pygments/lexers/_clbuiltins.py +1 -1
- data/vendor/pygments-main/pygments/lexers/_lassobuiltins.py +5172 -0
- data/vendor/pygments-main/pygments/lexers/_luabuiltins.py +1 -1
- data/vendor/pygments-main/pygments/lexers/_mapping.py +92 -36
- data/vendor/pygments-main/pygments/lexers/_openedgebuiltins.py +562 -0
- data/vendor/pygments-main/pygments/lexers/_phpbuiltins.py +2 -2
- data/vendor/pygments-main/pygments/lexers/_postgres_builtins.py +4 -3
- data/vendor/pygments-main/pygments/lexers/_robotframeworklexer.py +557 -0
- data/vendor/pygments-main/pygments/lexers/_scilab_builtins.py +11 -0
- data/vendor/pygments-main/pygments/lexers/_sourcemodbuiltins.py +1072 -0
- data/vendor/pygments-main/pygments/lexers/_stan_builtins.py +360 -0
- data/vendor/pygments-main/pygments/lexers/_vimbuiltins.py +13 -3
- data/vendor/pygments-main/pygments/lexers/agile.py +525 -38
- data/vendor/pygments-main/pygments/lexers/asm.py +45 -7
- data/vendor/pygments-main/pygments/lexers/compiled.py +1257 -425
- data/vendor/pygments-main/pygments/lexers/dalvik.py +104 -0
- data/vendor/pygments-main/pygments/lexers/dotnet.py +97 -62
- data/vendor/pygments-main/pygments/lexers/foxpro.py +428 -0
- data/vendor/pygments-main/pygments/lexers/functional.py +931 -32
- data/vendor/pygments-main/pygments/lexers/github.py +206 -3
- data/vendor/pygments-main/pygments/lexers/hdl.py +3 -3
- data/vendor/pygments-main/pygments/lexers/jvm.py +309 -44
- data/vendor/pygments-main/pygments/lexers/math.py +876 -30
- data/vendor/pygments-main/pygments/lexers/other.py +956 -517
- data/vendor/pygments-main/pygments/lexers/parsers.py +85 -2
- data/vendor/pygments-main/pygments/lexers/shell.py +81 -18
- data/vendor/pygments-main/pygments/lexers/special.py +1 -1
- data/vendor/pygments-main/pygments/lexers/sql.py +2 -2
- data/vendor/pygments-main/pygments/lexers/templates.py +119 -8
- data/vendor/pygments-main/pygments/lexers/text.py +155 -15
- data/vendor/pygments-main/pygments/lexers/web.py +1578 -397
- data/vendor/pygments-main/pygments/modeline.py +40 -0
- data/vendor/pygments-main/pygments/plugin.py +1 -1
- data/vendor/pygments-main/pygments/scanner.py +1 -1
- data/vendor/pygments-main/pygments/style.py +1 -1
- data/vendor/pygments-main/pygments/styles/__init__.py +1 -1
- data/vendor/pygments-main/pygments/styles/autumn.py +1 -1
- data/vendor/pygments-main/pygments/styles/borland.py +1 -1
- data/vendor/pygments-main/pygments/styles/bw.py +1 -1
- data/vendor/pygments-main/pygments/styles/colorful.py +1 -1
- data/vendor/pygments-main/pygments/styles/default.py +1 -1
- data/vendor/pygments-main/pygments/styles/emacs.py +1 -1
- data/vendor/pygments-main/pygments/styles/friendly.py +1 -1
- data/vendor/pygments-main/pygments/styles/fruity.py +1 -1
- data/vendor/pygments-main/pygments/styles/manni.py +1 -1
- data/vendor/pygments-main/pygments/styles/monokai.py +1 -1
- data/vendor/pygments-main/pygments/styles/murphy.py +1 -1
- data/vendor/pygments-main/pygments/styles/native.py +1 -1
- data/vendor/pygments-main/pygments/styles/pastie.py +1 -1
- data/vendor/pygments-main/pygments/styles/perldoc.py +1 -1
- data/vendor/pygments-main/pygments/styles/rrt.py +1 -1
- data/vendor/pygments-main/pygments/styles/tango.py +1 -1
- data/vendor/pygments-main/pygments/styles/trac.py +1 -1
- data/vendor/pygments-main/pygments/styles/vim.py +1 -1
- data/vendor/pygments-main/pygments/styles/vs.py +1 -1
- data/vendor/pygments-main/pygments/token.py +1 -1
- data/vendor/pygments-main/pygments/unistring.py +36 -26
- data/vendor/pygments-main/pygments/util.py +46 -1
- data/vendor/pygments-main/scripts/check_sources.py +2 -2
- data/vendor/pygments-main/scripts/detect_missing_analyse_text.py +2 -0
- data/vendor/pygments-main/scripts/find_codetags.py +1 -1
- data/vendor/pygments-main/scripts/find_error.py +5 -6
- data/vendor/pygments-main/setup.cfg +1 -0
- data/vendor/pygments-main/setup.py +6 -4
- data/vendor/pygments-main/tests/examplefiles/BOM.js +1 -0
- data/vendor/pygments-main/tests/examplefiles/Config.in.cache +1973 -0
- data/vendor/pygments-main/tests/examplefiles/Deflate.fs +578 -0
- data/vendor/pygments-main/tests/examplefiles/Get-CommandDefinitionHtml.ps1 +66 -0
- data/vendor/pygments-main/tests/examplefiles/IPDispatchC.nc +104 -0
- data/vendor/pygments-main/tests/examplefiles/IPDispatchP.nc +671 -0
- data/vendor/pygments-main/tests/examplefiles/RoleQ.pm6 +23 -0
- data/vendor/pygments-main/tests/examplefiles/autoit_submit.au3 +25 -0
- data/vendor/pygments-main/tests/examplefiles/bigtest.nsi +308 -0
- data/vendor/pygments-main/tests/examplefiles/ca65_example +284 -0
- data/vendor/pygments-main/tests/examplefiles/cbmbas_example +9 -0
- data/vendor/pygments-main/tests/examplefiles/classes.dylan +89 -4
- data/vendor/pygments-main/tests/examplefiles/example.Rd +78 -0
- data/vendor/pygments-main/tests/examplefiles/example.bug +54 -0
- data/vendor/pygments-main/tests/examplefiles/example.ceylon +52 -0
- data/vendor/pygments-main/tests/examplefiles/example.clay +33 -0
- data/vendor/pygments-main/tests/examplefiles/example.cob +3556 -0
- data/vendor/pygments-main/tests/examplefiles/example.hx +142 -0
- data/vendor/pygments-main/tests/examplefiles/example.jag +48 -0
- data/vendor/pygments-main/tests/examplefiles/example.lagda +19 -0
- data/vendor/pygments-main/tests/examplefiles/example.monkey +152 -0
- data/vendor/pygments-main/tests/examplefiles/example.msc +43 -0
- data/vendor/pygments-main/tests/examplefiles/example.prg +161 -0
- data/vendor/pygments-main/tests/examplefiles/example.reg +19 -0
- data/vendor/pygments-main/tests/examplefiles/example.rexx +50 -0
- data/vendor/pygments-main/tests/examplefiles/example.rkt +95 -0
- data/vendor/pygments-main/tests/examplefiles/example.rpf +4 -0
- data/vendor/pygments-main/tests/examplefiles/example.shell-session +45 -0
- data/vendor/pygments-main/tests/examplefiles/example.stan +108 -0
- data/vendor/pygments-main/tests/examplefiles/example.ts +28 -0
- data/vendor/pygments-main/tests/examplefiles/example.xtend +34 -0
- data/vendor/pygments-main/tests/examplefiles/example2.msc +79 -0
- data/vendor/pygments-main/tests/examplefiles/garcia-wachs.kk +133 -0
- data/vendor/pygments-main/tests/examplefiles/grammar-test.p6 +22 -0
- data/vendor/pygments-main/tests/examplefiles/hello.smali +40 -0
- data/vendor/pygments-main/tests/examplefiles/hello.sp +9 -0
- data/vendor/pygments-main/tests/examplefiles/http_request_example +2 -1
- data/vendor/pygments-main/tests/examplefiles/http_response_example +4 -2
- data/vendor/pygments-main/tests/examplefiles/inet_pton6.dg +71 -0
- data/vendor/pygments-main/tests/examplefiles/json.lasso +301 -0
- data/vendor/pygments-main/tests/examplefiles/json.lasso9 +213 -0
- data/vendor/pygments-main/tests/examplefiles/livescript-demo.ls +41 -0
- data/vendor/pygments-main/tests/examplefiles/logos_example.xm +28 -0
- data/vendor/pygments-main/tests/examplefiles/matlab_sample +5 -2
- data/vendor/pygments-main/tests/examplefiles/metagrammar.treetop +455 -0
- data/vendor/pygments-main/tests/examplefiles/mg_sample.pro +73 -0
- data/vendor/pygments-main/tests/examplefiles/minehunt.qml +112 -0
- data/vendor/pygments-main/tests/examplefiles/nanomsg.intr +95 -0
- data/vendor/pygments-main/tests/examplefiles/objc_example.m +7 -0
- data/vendor/pygments-main/tests/examplefiles/phpMyAdmin.spec +163 -0
- data/vendor/pygments-main/tests/examplefiles/py3tb_test.py3tb +4 -0
- data/vendor/pygments-main/tests/examplefiles/pytb_test3.pytb +4 -0
- data/vendor/pygments-main/tests/examplefiles/robotframework.txt +39 -0
- data/vendor/pygments-main/tests/examplefiles/rust_example.rs +233 -0
- data/vendor/pygments-main/tests/examplefiles/session.dylan-console +9 -0
- data/vendor/pygments-main/tests/examplefiles/swig_java.swg +1329 -0
- data/vendor/pygments-main/tests/examplefiles/swig_std_vector.i +225 -0
- data/vendor/pygments-main/tests/examplefiles/test.R +149 -115
- data/vendor/pygments-main/tests/examplefiles/test.agda +102 -0
- data/vendor/pygments-main/tests/examplefiles/test.bb +95 -0
- data/vendor/pygments-main/tests/examplefiles/test.cu +36 -0
- data/vendor/pygments-main/tests/examplefiles/test.ebnf +31 -0
- data/vendor/pygments-main/tests/examplefiles/test.opa +10 -0
- data/vendor/pygments-main/tests/examplefiles/test.p6 +252 -0
- data/vendor/pygments-main/tests/examplefiles/test2.pypylog +120 -0
- data/vendor/pygments-main/tests/examplefiles/type.lisp +16 -0
- data/vendor/pygments-main/tests/examplefiles/unix-io.lid +37 -0
- data/vendor/pygments-main/tests/old_run.py +1 -1
- data/vendor/pygments-main/tests/run.py +3 -2
- data/vendor/pygments-main/tests/support/tags +36 -0
- data/vendor/pygments-main/tests/test_basic_api.py +4 -3
- data/vendor/pygments-main/tests/test_clexer.py +1 -1
- data/vendor/pygments-main/tests/test_cmdline.py +1 -1
- data/vendor/pygments-main/tests/test_examplefiles.py +3 -1
- data/vendor/pygments-main/tests/test_html_formatter.py +17 -1
- data/vendor/pygments-main/tests/test_latex_formatter.py +1 -1
- data/vendor/pygments-main/tests/test_lexers_other.py +68 -0
- data/vendor/pygments-main/tests/test_perllexer.py +1 -1
- data/vendor/pygments-main/tests/test_regexlexer.py +1 -1
- data/vendor/pygments-main/tests/test_token.py +1 -1
- data/vendor/pygments-main/tests/test_using_api.py +1 -1
- data/vendor/pygments-main/tests/test_util.py +22 -3
- metadata +84 -16
@@ -0,0 +1,9 @@
|
|
1
|
+
10 rem cbm basic v2 example
|
2
|
+
20 rem comment with keywords: for, data
|
3
|
+
30 dim a$(20)
|
4
|
+
35 rem the typical space efficient form of leaving spaces out:
|
5
|
+
40 fort=0to15:poke646,t:print"{revers on} ";:next
|
6
|
+
50 geta$:ifa$=chr$(0):goto40
|
7
|
+
55 rem it is legal to omit the closing " on line end
|
8
|
+
60 print"{white}":print"bye...
|
9
|
+
70 end
|
@@ -1,12 +1,26 @@
|
|
1
|
+
module: sample
|
2
|
+
comment: for make sure that does not highlight per word.
|
3
|
+
and it continues on to the next line.
|
4
|
+
|
1
5
|
define class <car> (<object>)
|
2
6
|
slot serial-number :: <integer> = unique-serial-number();
|
3
|
-
slot model-name :: <string>,
|
7
|
+
constant slot model-name :: <string>,
|
4
8
|
required-init-keyword: model:;
|
5
|
-
slot has-sunroof? :: <boolean>,
|
9
|
+
each-subclass slot has-sunroof? :: <boolean>,
|
6
10
|
init-keyword: sunroof?:,
|
7
11
|
init-value: #f;
|
12
|
+
keyword foo:;
|
13
|
+
required keyword bar:;
|
8
14
|
end class <car>;
|
9
15
|
|
16
|
+
define class <flying-car> (<car>)
|
17
|
+
end class <flying-car>;
|
18
|
+
|
19
|
+
let flying-car = make(<flying-car>);
|
20
|
+
let car? :: <car?> = #f;
|
21
|
+
let prefixed-car :: <vehicles/car> = #f;
|
22
|
+
let model :: <car-911> = #f;
|
23
|
+
|
10
24
|
define constant $empty-string = "";
|
11
25
|
define constant $escaped-backslash = '\\';
|
12
26
|
define constant $escaped-single-quote = '\'';
|
@@ -31,10 +45,81 @@ define method foo() => _ :: <boolean>;
|
|
31
45
|
#t
|
32
46
|
end method;
|
33
47
|
|
34
|
-
define method \+
|
35
|
-
|
48
|
+
define method \+
|
49
|
+
(offset1 :: <time-offset>, offset2 :: <time-offset>)
|
50
|
+
=> (sum :: <time-offset>)
|
51
|
+
let sum = offset1.total-seconds + offset2.total-seconds;
|
52
|
+
make(<time-offset>, total-seconds: sum);
|
53
|
+
end method \+;
|
54
|
+
|
55
|
+
define method bar ()
|
56
|
+
1 | 2 & 3
|
57
|
+
end
|
58
|
+
|
59
|
+
if (bar)
|
60
|
+
1
|
61
|
+
elseif (foo)
|
62
|
+
2
|
63
|
+
else
|
64
|
+
3
|
65
|
+
end if;
|
66
|
+
|
67
|
+
select (foo by instance?)
|
68
|
+
<integer> => 1
|
69
|
+
otherwise => 3
|
70
|
+
end select;
|
71
|
+
|
72
|
+
/* multi
|
73
|
+
line
|
74
|
+
comment
|
75
|
+
*/
|
76
|
+
|
77
|
+
/* multi line comments
|
78
|
+
/* can be */
|
79
|
+
nested */
|
36
80
|
|
37
81
|
define constant $symbol = #"hello";
|
38
82
|
define variable *vector* = #[3.5, 5]
|
39
83
|
define constant $list = #(1, 2);
|
40
84
|
define constant $pair = #(1 . "foo")
|
85
|
+
|
86
|
+
let octal-number = #o238;
|
87
|
+
let hex-number = #x3890ADEF;
|
88
|
+
let binary-number = #b1010;
|
89
|
+
let float-exponent = 3.5e10;
|
90
|
+
|
91
|
+
block (return)
|
92
|
+
with-lock (lock)
|
93
|
+
return();
|
94
|
+
end;
|
95
|
+
exception (e :: <error>)
|
96
|
+
format-out("Oh no");
|
97
|
+
cleanup
|
98
|
+
return();
|
99
|
+
afterwards
|
100
|
+
format-out("Hello");
|
101
|
+
end;
|
102
|
+
|
103
|
+
define macro repeat
|
104
|
+
{ repeat ?:body end }
|
105
|
+
=> { block (?=stop!)
|
106
|
+
local method again() ?body; again() end;
|
107
|
+
again();
|
108
|
+
end }
|
109
|
+
end macro repeat;
|
110
|
+
|
111
|
+
define macro with-decoded-seconds
|
112
|
+
{
|
113
|
+
with-decoded-seconds
|
114
|
+
(?max:variable, ?min:variable, ?sec:variable = ?time:expression)
|
115
|
+
?:body
|
116
|
+
end
|
117
|
+
}
|
118
|
+
=> {
|
119
|
+
let (?max, ?min, ?sec) = decode-total-seconds(?time);
|
120
|
+
?body
|
121
|
+
}
|
122
|
+
end macro;
|
123
|
+
|
124
|
+
let x = "This size call should be seen as a builtin despite the odd case.".siZe;
|
125
|
+
|
@@ -0,0 +1,78 @@
|
|
1
|
+
\name{foo}
|
2
|
+
\alias{foo}
|
3
|
+
% I'm a comment
|
4
|
+
\title{The foo function}
|
5
|
+
|
6
|
+
\description{It doesn't do much}
|
7
|
+
|
8
|
+
\usage{
|
9
|
+
foo(x, y)
|
10
|
+
}
|
11
|
+
|
12
|
+
\arguments{
|
13
|
+
\item{x}{A number}
|
14
|
+
\item{y}{Another number}
|
15
|
+
}
|
16
|
+
\details{
|
17
|
+
I just adds \code{x} and \code{y},
|
18
|
+
}
|
19
|
+
\value{\code{numeric}. The sum of \code{x} and \code{y}.}
|
20
|
+
\references{
|
21
|
+
\href{http://en.wikipedia.org/wiki/Sum}{Sum}
|
22
|
+
}
|
23
|
+
\author{
|
24
|
+
Anonymous
|
25
|
+
}
|
26
|
+
\note{
|
27
|
+
Lorem ipsum \dots \R \emph{emp}, \strong{strong}, \bold{bold},
|
28
|
+
\sQuote{single quotes}, \dQuote{double quotes}, \code{code},
|
29
|
+
\preformatted{x <- 2 + 2}, \kbd{type this}, \samp{literal seq},
|
30
|
+
\pkg{base}, \file{foo.txt}, \email{email@hostname},
|
31
|
+
\url{http://cran.r-project.org/}, \var{foo}, \env{HOME},
|
32
|
+
\option{-d}, \dfn{something new}, \acronym{GNU}.
|
33
|
+
|
34
|
+
Escaped symbols: \\ \{ \} \% not comment. \\NotAMacro.
|
35
|
+
|
36
|
+
\tabular{rlll}{
|
37
|
+
[,1] \tab alpha \tab numeric \tab A (ppb)\cr
|
38
|
+
[,2] \tab bravo \tab integer \tab B \cr
|
39
|
+
[,3] \tab charlie \tab character \tab C \cr
|
40
|
+
}
|
41
|
+
\enumerate{
|
42
|
+
\item delta
|
43
|
+
\item echo
|
44
|
+
}
|
45
|
+
\itemize{
|
46
|
+
\item foxtrot
|
47
|
+
\item golf
|
48
|
+
}
|
49
|
+
|
50
|
+
\deqn{p(x; \mu, \sigma^2) = \frac{1}{\sigma \sqrt{2 \pi}} \exp \frac{-(x - \mu)^2}{2 \sigma}{%
|
51
|
+
p(\mu; x) = 1/\sigma (2 \pi)^(-1/2) exp( -(x - \mu)^2 / (2 \sigma)) }
|
52
|
+
for \eqn{x = 0, 1, 2, \ldots}.
|
53
|
+
|
54
|
+
\if{latex}{\out{\beta}}\ifelse{html}{\out{β}}{beta}
|
55
|
+
|
56
|
+
#ifdef unix
|
57
|
+
Now windows
|
58
|
+
#endif
|
59
|
+
#ifndef windows
|
60
|
+
Using windows
|
61
|
+
#endif
|
62
|
+
|
63
|
+
}
|
64
|
+
\section{Misc}{
|
65
|
+
Stuff.
|
66
|
+
}
|
67
|
+
|
68
|
+
\seealso{
|
69
|
+
\code{\link{sum}}
|
70
|
+
}
|
71
|
+
\examples{
|
72
|
+
x <- 1
|
73
|
+
y <- 2
|
74
|
+
z <- foo(x, y)
|
75
|
+
\dontrun{plot(z)}
|
76
|
+
\dontshow{log(x)}
|
77
|
+
}
|
78
|
+
\keyword{arith}
|
@@ -0,0 +1,54 @@
|
|
1
|
+
# Alligators: multinomial - logistic regression
|
2
|
+
# http://www.openbugs.info/Examples/Aligators.html
|
3
|
+
model {
|
4
|
+
# PRIORS
|
5
|
+
alpha[1] <- 0; # zero contrast for baseline food
|
6
|
+
for (k in 2 : K) {
|
7
|
+
alpha[k] ~ dnorm(0, 0.00001) # vague priors
|
8
|
+
}
|
9
|
+
# Loop around lakes:
|
10
|
+
for (k in 1 : K){
|
11
|
+
beta[1, k] <- 0
|
12
|
+
} # corner-point contrast with first lake
|
13
|
+
for (i in 2 : I) {
|
14
|
+
beta[i, 1] <- 0 ; # zero contrast for baseline food
|
15
|
+
for (k in 2 : K){
|
16
|
+
beta[i, k] ~ dnorm(0, 0.00001) # vague priors
|
17
|
+
}
|
18
|
+
}
|
19
|
+
# Loop around sizes:
|
20
|
+
for (k in 1 : K){
|
21
|
+
gamma[1, k] <- 0 # corner-point contrast with first size
|
22
|
+
}
|
23
|
+
for (j in 2 : J) {
|
24
|
+
gamma[j, 1] <- 0 ; # zero contrast for baseline food
|
25
|
+
for ( k in 2 : K){
|
26
|
+
gamma[j, k] ~ dnorm(0, 0.00001) # vague priors
|
27
|
+
}
|
28
|
+
}
|
29
|
+
|
30
|
+
# LIKELIHOOD
|
31
|
+
for (i in 1 : I) { # loop around lakes
|
32
|
+
for (j in 1 : J) { # loop around sizes
|
33
|
+
|
34
|
+
# Fit standard Poisson regressions relative to baseline
|
35
|
+
lambda[i, j] ~ dflat() # vague priors
|
36
|
+
for (k in 1 : K) { # loop around foods
|
37
|
+
X[i, j, k] ~ dpois(mu[i, j, k])
|
38
|
+
log(mu[i, j, k]) <- lambda[i, j] + alpha[k] + beta[i, k] + gamma[j, k]
|
39
|
+
culmative.X[i, j, k] <- culmative(X[i, j, k], X[i, j, k])
|
40
|
+
}
|
41
|
+
}
|
42
|
+
}
|
43
|
+
|
44
|
+
# TRANSFORM OUTPUT TO ENABLE COMPARISON
|
45
|
+
# WITH AGRESTI'S RESULTS
|
46
|
+
for (k in 1 : K) { # loop around foods
|
47
|
+
for (i in 1 : I) { # loop around lakes
|
48
|
+
b[i, k] <- beta[i, k] - mean(beta[, k]); # sum to zero constraint
|
49
|
+
}
|
50
|
+
for (j in 1 : J) { # loop around sizes
|
51
|
+
g[j, k] <- gamma[j, k] - mean(gamma[, k]); # sum to zero constraint
|
52
|
+
}
|
53
|
+
}
|
54
|
+
}
|
@@ -0,0 +1,52 @@
|
|
1
|
+
import ceylon.language { parseInteger }
|
2
|
+
|
3
|
+
doc "A top-level function,
|
4
|
+
with multi-line documentation."
|
5
|
+
void topLevel(String? a, Integer b=5, String* seqs) {
|
6
|
+
function nested(String s) {
|
7
|
+
print(s[1..2]);
|
8
|
+
return true;
|
9
|
+
}
|
10
|
+
for (s in seqs.filter((String x) => x.size > 2)) {
|
11
|
+
nested(s);
|
12
|
+
}
|
13
|
+
value uppers = seqs.map((String x) {
|
14
|
+
return x.uppercased;
|
15
|
+
});
|
16
|
+
String|Null z = a;
|
17
|
+
{Integer+} ints = { 1, 2, 3, 4, 5 };
|
18
|
+
value numbers = [ 1, #ffff, #ffff_ffff, $10101010, $1010_1010_1010_1010,
|
19
|
+
123_456_789 ];
|
20
|
+
value chars = ['a', '\{#ffff}' ];
|
21
|
+
}
|
22
|
+
|
23
|
+
shared class Example_1<Element>(name, element) satisfies Comparable<Example_1<Element>>
|
24
|
+
given Element satisfies Comparable<Element> {
|
25
|
+
shared String name;
|
26
|
+
shared Element element;
|
27
|
+
shared [Integer,String] tuple = [1, "2"];
|
28
|
+
shared late String lastName;
|
29
|
+
variable Integer cnt = 0;
|
30
|
+
|
31
|
+
shared Integer count => cnt;
|
32
|
+
assign count {
|
33
|
+
assert(count >= cnt);
|
34
|
+
cnt = count;
|
35
|
+
}
|
36
|
+
|
37
|
+
shared actual Comparison compare(Example_1<Element> other) {
|
38
|
+
return element <=> other.element;
|
39
|
+
}
|
40
|
+
|
41
|
+
shared actual String string {
|
42
|
+
return "Example with ``element.string``";
|
43
|
+
}
|
44
|
+
}
|
45
|
+
|
46
|
+
Example_1<Integer> instance = Example_1 {
|
47
|
+
element = 5;
|
48
|
+
name = "Named args call \{#0060}";
|
49
|
+
};
|
50
|
+
|
51
|
+
object example1 extends Example_1<Integer>("object", 5) {
|
52
|
+
}
|
@@ -0,0 +1,33 @@
|
|
1
|
+
|
2
|
+
/// @section StringLiteralRef
|
3
|
+
|
4
|
+
record StringLiteralRef (
|
5
|
+
sizep : Pointer[SizeT],
|
6
|
+
);
|
7
|
+
|
8
|
+
|
9
|
+
/// @section predicates
|
10
|
+
|
11
|
+
overload ContiguousSequence?(#StringLiteralRef) : Bool = true;
|
12
|
+
[s when StringLiteral?(s)]
|
13
|
+
overload ContiguousSequence?(#Static[s]) : Bool = true;
|
14
|
+
|
15
|
+
|
16
|
+
|
17
|
+
/// @section size, begin, end, index
|
18
|
+
|
19
|
+
forceinline overload size(a:StringLiteralRef) = a.sizep^;
|
20
|
+
|
21
|
+
forceinline overload begin(a:StringLiteralRef) : Pointer[Char] = Pointer[Char](a.sizep + 1);
|
22
|
+
forceinline overload end(a:StringLiteralRef) = begin(a) + size(a);
|
23
|
+
|
24
|
+
[I when Integer?(I)]
|
25
|
+
forceinline overload index(a:StringLiteralRef, i:I) : ByRef[Char] {
|
26
|
+
assert["boundsChecks"](i >= 0 and i < size(a), "StringLiteralRef index out of bounds");
|
27
|
+
return ref (begin(a) + i)^;
|
28
|
+
}
|
29
|
+
|
30
|
+
foo() = """
|
31
|
+
long\tlong
|
32
|
+
story
|
33
|
+
"""
|
@@ -0,0 +1,3556 @@
|
|
1
|
+
IDENTIFICATION DIVISION.
|
2
|
+
PROGRAM-ID. OCic.
|
3
|
+
*****************************************************************
|
4
|
+
** This program provides a Textual User Interface (TUI) to the **
|
5
|
+
** process of compiling and (optionally) executing an OpenCOBOL**
|
6
|
+
** program. **
|
7
|
+
** **
|
8
|
+
** This programs execution syntax is as follows: **
|
9
|
+
** **
|
10
|
+
** ocic <program-path-and-filename> [ <switch>... ] **
|
11
|
+
** **
|
12
|
+
** Once executed, a display screen will be presented showing **
|
13
|
+
** the compilation options that will be used. The user will **
|
14
|
+
** have the opportunity to change options, specify new ones **
|
15
|
+
** and specify any program execution arguments to be used if **
|
16
|
+
** you select the "Execute" option. When you press the Enter **
|
17
|
+
** key the program will be compiled. **
|
18
|
+
** **
|
19
|
+
** The SCREEN SECTION contains an image of the screen. **
|
20
|
+
** **
|
21
|
+
** The "010-Parse-Args" section in the PROCEDURE DIVISION has **
|
22
|
+
** documentation on switches and their function. **
|
23
|
+
*****************************************************************
|
24
|
+
** **
|
25
|
+
** AUTHOR: GARY L. CUTLER **
|
26
|
+
** CutlerGL@gmail.com **
|
27
|
+
** Copyright (C) 2009-2010, Gary L. Cutler, GPL **
|
28
|
+
** **
|
29
|
+
** DATE-WRITTEN: June 14, 2009 **
|
30
|
+
** **
|
31
|
+
*****************************************************************
|
32
|
+
** Note: Depending on which extended DISPLAY handler you're **
|
33
|
+
** using (PDCurses, Curses, ...), you may need to un- **
|
34
|
+
** comment any source lines tagged with "SCROLL" in cols **
|
35
|
+
** 1-6 in order to have error messages scroll properly **
|
36
|
+
** in the OCic shell window. **
|
37
|
+
*****************************************************************
|
38
|
+
** DATE CHANGE DESCRIPTION **
|
39
|
+
** ====== ==================================================== **
|
40
|
+
** GC0609 Don't display compiler messages file if compilation **
|
41
|
+
** Is successful. Also don't display messages if the **
|
42
|
+
** output file is busy (just put a message on the **
|
43
|
+
** screen, leave the OC screen up & let the user fix **
|
44
|
+
** the problem & resubmit. **
|
45
|
+
** GC0709 When 'EXECUTE' is selected, a 'FILE BUSY' error will **
|
46
|
+
** still cause the (old) executable to be launched. **
|
47
|
+
** Also, the 'EXTRA SWITCHES' field is being ignored. **
|
48
|
+
** Changed the title bar to lowlighted reverse video & **
|
49
|
+
** the message area to highlighted reverse-video. **
|
50
|
+
** GC0809 Add a SPACE in from of command-line args when **
|
51
|
+
** executing users program. Add a SPACE after the **
|
52
|
+
** -ftraceall switch when building cobc command. **
|
53
|
+
** GC0909 Convert to work on Cygwin/Linux as well as MinGW **
|
54
|
+
** GC0310 Virtualized the key codes for S-F1 thru S-F7 as they **
|
55
|
+
** differ depending upon whether PDCurses or NCurses is **
|
56
|
+
** being used. **
|
57
|
+
** GC0410 Introduced the cross-reference and source listing **
|
58
|
+
** features. Also fixed a bug in @EXTRA switch proces- **
|
59
|
+
** sing where garbage will result if more than the **
|
60
|
+
** @EXTRA switch is specified. **
|
61
|
+
*****************************************************************
|
62
|
+
ENVIRONMENT DIVISION.
|
63
|
+
CONFIGURATION SECTION.
|
64
|
+
REPOSITORY.
|
65
|
+
FUNCTION ALL INTRINSIC.
|
66
|
+
INPUT-OUTPUT SECTION.
|
67
|
+
FILE-CONTROL.
|
68
|
+
SELECT Bat-File ASSIGN TO Bat-File-Name
|
69
|
+
ORGANIZATION IS LINE SEQUENTIAL.
|
70
|
+
|
71
|
+
SELECT Cobc-Output ASSIGN TO Cobc-Output-File
|
72
|
+
ORGANIZATION IS LINE SEQUENTIAL.
|
73
|
+
|
74
|
+
SELECT Source-Code ASSIGN TO File-Name
|
75
|
+
ORGANIZATION IS LINE SEQUENTIAL
|
76
|
+
FILE STATUS IS FSM-Status.
|
77
|
+
DATA DIVISION.
|
78
|
+
FILE SECTION.
|
79
|
+
FD Bat-File.
|
80
|
+
01 Bat-File-Rec PIC X(2048).
|
81
|
+
|
82
|
+
FD Cobc-Output.
|
83
|
+
01 Cobc-Output-Rec PIC X(256).
|
84
|
+
|
85
|
+
FD Source-Code.
|
86
|
+
01 Source-Code-Record PIC X(80).
|
87
|
+
|
88
|
+
WORKING-STORAGE SECTION.
|
89
|
+
COPY screenio.
|
90
|
+
|
91
|
+
01 Bat-File-Name PIC X(256).
|
92
|
+
|
93
|
+
GC0909 01 Cmd PIC X(512).
|
94
|
+
|
95
|
+
01 Cobc-Cmd PIC X(256).
|
96
|
+
|
97
|
+
01 Cobc-Output-File PIC X(256).
|
98
|
+
|
99
|
+
01 Command-Line-Args PIC X(256).
|
100
|
+
|
101
|
+
01 Config-File PIC X(12).
|
102
|
+
|
103
|
+
GC0310 01 Config-Keys.
|
104
|
+
GC0310 05 CK-S-F1 PIC 9(4).
|
105
|
+
GC0310 05 CK-S-F2 PIC 9(4).
|
106
|
+
GC0310 05 CK-S-F3 PIC 9(4).
|
107
|
+
GC0310 05 CK-S-F4 PIC 9(4).
|
108
|
+
GC0310 05 CK-S-F5 PIC 9(4).
|
109
|
+
GC0310 05 CK-S-F6 PIC 9(4).
|
110
|
+
GC0310 05 CK-S-F7 PIC 9(4).
|
111
|
+
|
112
|
+
GC0909 01 Dir-Char PIC X(1).
|
113
|
+
|
114
|
+
01 Dummy PIC X(1).
|
115
|
+
|
116
|
+
01 Env-TEMP PIC X(256).
|
117
|
+
|
118
|
+
01 File-Name.
|
119
|
+
05 FN-Char OCCURS 256 TIMES PIC X(1).
|
120
|
+
|
121
|
+
01 File-Status-Message.
|
122
|
+
05 FILLER PIC X(13) VALUE 'Status Code: '.
|
123
|
+
05 FSM-Status PIC 9(2).
|
124
|
+
05 FILLER PIC X(11) VALUE ', Meaning: '.
|
125
|
+
05 FSM-Msg PIC X(25).
|
126
|
+
|
127
|
+
01 Flags.
|
128
|
+
05 F-Compilation-Succeeded PIC X(1).
|
129
|
+
88 88-Compile-OK VALUE 'Y'.
|
130
|
+
GC0909 88 88-Compile-OK-Warn VALUE 'W'.
|
131
|
+
88 88-Compile-Failed VALUE 'N'.
|
132
|
+
GC0609 05 F-Complete PIC X(1).
|
133
|
+
GC0609 88 88-Complete VALUE 'Y'.
|
134
|
+
GC0609 88 88-Not-Complete VALUE 'N'.
|
135
|
+
GC0809 05 F-IDENT-DIVISION PIC X(1).
|
136
|
+
GC0809 88 88-1st-Prog-Complete VALUE 'Y'.
|
137
|
+
GC0809 88 88-More-To-1st-Prog VALUE 'N'.
|
138
|
+
05 F-LINKAGE-SECTION PIC X(1).
|
139
|
+
88 88-Compile-As-Subpgm VALUE 'Y'.
|
140
|
+
88 88-Compile-As-Mainpgm VALUE 'N'.
|
141
|
+
05 F-No-Switch-Changes PIC X(1).
|
142
|
+
88 88-No-Switch-Changes VALUE 'Y'.
|
143
|
+
88 88-Switch-Changes VALUE 'N'.
|
144
|
+
GC0709 05 F-Output-File-Busy PIC X(1).
|
145
|
+
GC0709 88 88-Output-File-Busy VALUE 'Y'.
|
146
|
+
GC0709 88 88-Output-File-Avail VALUE 'N'.
|
147
|
+
GC0809 05 F-Source-Record-Type PIC X(1).
|
148
|
+
GC0809 88 88-Source-Rec-Linkage VALUE 'L'.
|
149
|
+
GC0809 88 88-Source-Rec-Ident VALUE 'I'.
|
150
|
+
GC0809 88 88-Source-Rec-IgnoCOB-COLOR-RED VALUE ' '.
|
151
|
+
05 F-Switch-Error PIC X(1).
|
152
|
+
88 88-Switch-Is-Bad VALUE 'Y'.
|
153
|
+
88 88-Switch-Is-Good VALUE 'N'.
|
154
|
+
|
155
|
+
GC0909 01 Horizontal-Line PIC X(80).
|
156
|
+
GC0909
|
157
|
+
01 I USAGE BINARY-LONG.
|
158
|
+
|
159
|
+
01 J USAGE BINARY-LONG.
|
160
|
+
|
161
|
+
GC0909 01 MS USAGE BINARY-LONG.
|
162
|
+
|
163
|
+
GC0909 01 ML USAGE BINARY-LONG.
|
164
|
+
|
165
|
+
01 OC-Compiled PIC XXXX/XX/XXBXX/XX.
|
166
|
+
|
167
|
+
GC0909 01 OS-Type USAGE BINARY-LONG.
|
168
|
+
GC0909 88 OS-Unknown VALUE 0.
|
169
|
+
GC0909 88 OS-Windows VALUE 1.
|
170
|
+
GC0909 88 OS-Cygwin VALUE 2.
|
171
|
+
GC0909 88 OS-UNIX VALUE 3.
|
172
|
+
|
173
|
+
GC0909 01 OS-Type-Literal PIC X(7).
|
174
|
+
|
175
|
+
01 Output-Message PIC X(80).
|
176
|
+
|
177
|
+
01 Path-Delimiter PIC X(1).
|
178
|
+
|
179
|
+
01 Prog-Folder PIC X(256).
|
180
|
+
|
181
|
+
01 Prog-Extension PIC X(30).
|
182
|
+
|
183
|
+
01 Prog-File-Name PIC X(40).
|
184
|
+
|
185
|
+
01 Prog-Name PIC X(31).
|
186
|
+
|
187
|
+
78 Selection-Char VALUE '>'.
|
188
|
+
|
189
|
+
01 Switch-Display.
|
190
|
+
05 SD-Switch-And-Value PIC X(19).
|
191
|
+
05 FILLER PIC X(1).
|
192
|
+
05 SD-Description PIC X(60).
|
193
|
+
|
194
|
+
01 Switch-Keyword PIC X(12).
|
195
|
+
GC0410 88 Switch-Is-CONFIG VALUE '@CONFIG', '@C'.
|
196
|
+
GC0410 88 Switch-Is-DEBUG VALUE '@DEBUG', '@D'.
|
197
|
+
GC0410 88 Switch-Is-DLL VALUE '@DLL'.
|
198
|
+
GC0410 88 Switch-Is-EXECUTE VALUE '@EXECUTE', '@E'.
|
199
|
+
GC0410 88 Switch-Is-EXTRA VALUE '@EXTRA', '@EX'.
|
200
|
+
GC0410 88 Switch-Is-NOTRUNC VALUE '@NOTRUNC', '@N'.
|
201
|
+
GC0410 88 Switch-Is-TRACE VALUE '@TRACE', '@T'.
|
202
|
+
GC0410 88 Switch-Is-SOURCE VALUE '@SOURCE', '@S'.
|
203
|
+
GC0410 88 Switch-Is-XREF VALUE '@XREF', '@X'.
|
204
|
+
|
205
|
+
01 Switch-Keyword-And-Value PIC X(256).
|
206
|
+
|
207
|
+
01 Switch-Value.
|
208
|
+
05 SV-1 PIC X(1).
|
209
|
+
05 FILLER PIC X(255).
|
210
|
+
01 Switch-Value-Alt REDEFINES Switch-Value
|
211
|
+
PIC X(256).
|
212
|
+
88 Valid-Config-Filename
|
213
|
+
VALUE 'BS2000', 'COBOL85', 'COBOL2002', 'DEFAULT',
|
214
|
+
'IBM', 'MF', 'MVS'.
|
215
|
+
|
216
|
+
01 Switches.
|
217
|
+
05 S-ARGS PIC X(75) VALUE SPACES.
|
218
|
+
05 S-CfgS.
|
219
|
+
10 S-Cfg-BS2000 PIC X(1) VALUE ' '.
|
220
|
+
10 S-Cfg-COBOL85 PIC X(1) VALUE ' '.
|
221
|
+
10 S-Cfg-COBOL2002 PIC X(1) VALUE ' '.
|
222
|
+
10 S-Cfg-DEFAULT PIC X(1) VALUE Selection-Char.
|
223
|
+
10 S-Cfg-IBM PIC X(1) VALUE ' '.
|
224
|
+
10 S-Cfg-MF PIC X(1) VALUE ' '.
|
225
|
+
10 S-Cfg-MVS PIC X(1) VALUE ' '.
|
226
|
+
05 S-EXTRA PIC X(75) VALUE SPACES.
|
227
|
+
05 S-Yes-No-Switches.
|
228
|
+
10 S-DEBUG PIC X(1) VALUE 'N'.
|
229
|
+
10 S-DLL PIC X(1) VALUE 'N'.
|
230
|
+
GC0410 10 S-XREF PIC X(1) VALUE 'N'.
|
231
|
+
GC0410 10 S-SOURCE PIC X(1) VALUE 'N'.
|
232
|
+
10 S-EXECUTE PIC X(1) VALUE 'N'.
|
233
|
+
10 S-NOTRUNC PIC X(1) VALUE 'Y'.
|
234
|
+
10 S-SUBROUTINE PIC X(1) VALUE 'A'.
|
235
|
+
10 S-TRACE PIC X(1) VALUE 'N'.
|
236
|
+
10 S-TRACEALL PIC X(1) VALUE 'N'.
|
237
|
+
|
238
|
+
01 Tally USAGE BINARY-LONG.
|
239
|
+
|
240
|
+
SCREEN SECTION.
|
241
|
+
*>
|
242
|
+
*> Here is the layout of the OCic screen.
|
243
|
+
*>
|
244
|
+
*> Note that this program can utilize the traditional PC line-drawing characters,
|
245
|
+
*> if they are available.
|
246
|
+
*>
|
247
|
+
*> If this program is run on Windows, it must run with codepage 437 activated to
|
248
|
+
*> display the line-drawing characters. With a native Windows build or a
|
249
|
+
*> Windows/MinGW build, one could use the command "chcp 437" to set that codepage
|
250
|
+
*> for display within a Windows console window (that should be the default, though).
|
251
|
+
*> With a Windows/Cygwin build, set the environment variable CYGWIN to a value of
|
252
|
+
*> "codepage:oem" (this cannot be done from within the program though - you will
|
253
|
+
*> have to use the "Computer/Advanced System Settings/Environment Variables" (Vista or
|
254
|
+
*> Windows 7) function to define the variable. XP Users: use "My Computer/Properties/
|
255
|
+
*> Advanced/Environment Variables".
|
256
|
+
*>
|
257
|
+
*> To use OCic without the line-drawing characters, comment-out the first set of
|
258
|
+
*> 78 "LD" items and uncomment the second.
|
259
|
+
*>
|
260
|
+
*> The following sample screen layout shows how the screen looks with line-drawing
|
261
|
+
*> characters disabled.
|
262
|
+
*>
|
263
|
+
*>===================================================================================
|
264
|
+
*> OCic (2010/04/02 11:36) - OpenCOBOL V1.1 Interactive Compilation Windows 01
|
265
|
+
*> +-----------------------------------------------------------------------------+ 02
|
266
|
+
*> | Program: OCic F-Key: Select Opt | 03
|
267
|
+
*> | Folder: E:\OpenCOBOL\Samples Enter: Compile | 04
|
268
|
+
*> | Filename: OCic.cbl Esc: Quit | 05
|
269
|
+
*> +-----------------------------------------------------------------------------+ 06
|
270
|
+
*> On/Off Switches: Configuration: 07
|
271
|
+
*> +---------------------------------------------------------+-------------------+ 08
|
272
|
+
*> | F1 Compile debug lines F8 Produce source listing | S-F1 BS2000 | 09
|
273
|
+
*> | F2 Always make DLLs F9 Produce xref listing | S-F2 COBOL85 | 10
|
274
|
+
*> | F3 Pgm is a SUBROUTINE | S-F3 COBOL2002 | 11
|
275
|
+
*> | F4 Execute if compile OK | S-F4 > Default | 12
|
276
|
+
*> | F5 > No COMP/BINARY trunc | S-F5 IBM | 13
|
277
|
+
*> | F6 Trace procedures | S-F6 MicroFocus | 14
|
278
|
+
*> | F7 Trace proc + stmnts | S-F7 MVS | 15
|
279
|
+
*> +---------------------------------------------------------+-------------------+ 16
|
280
|
+
*> Additional "cobc" Switches (if any): 17
|
281
|
+
*> +-----------------------------------------------------------------------------+ 18
|
282
|
+
*> | -O2________________________________________________________________________ | 19
|
283
|
+
*> +-----------------------------------------------------------------------------+ 20
|
284
|
+
*> Program Execution Arguments (if any): 21
|
285
|
+
*> +-----------------------------------------------------------------------------+ 22
|
286
|
+
*> | ___________________________________________________________________________ | 23
|
287
|
+
*> +-----------------------------------------------------------------------------+ 24
|
288
|
+
*> OCic Copyright (C) 2009-2010, Gary L. Cutler, GPL 25
|
289
|
+
*>===================================================================================
|
290
|
+
*>12345678901234567890123456789012345678901234567890123456789012345678901234567890
|
291
|
+
*> 1 2 3 4 5 6 7 8
|
292
|
+
*>
|
293
|
+
*> USE THESE CHARS FOR LINE-DRAWING IF YOU HAVE ACCESS TO PC-DOS CODEPAGE 437:
|
294
|
+
*>
|
295
|
+
78 LD-UL-Corner VALUE X"DA".
|
296
|
+
78 LD-LL-Corner VALUE X"C0".
|
297
|
+
78 LD-UR-Corner VALUE X"BF".
|
298
|
+
78 LD-LR-Corner VALUE X"D9".
|
299
|
+
78 LD-Upper-T VALUE X"C2".
|
300
|
+
78 LD-Lower-T VALUE X"C1".
|
301
|
+
78 LD-Horiz-Line VALUE X"C4".
|
302
|
+
78 LD-Vert-Line VALUE X"B3".
|
303
|
+
*>
|
304
|
+
*> USE THESE CHARS FOR LINE-DRAWING IF YOU DO NOT HAVE ACCESS TO PC-DOS CODEPAGE 437:
|
305
|
+
*>
|
306
|
+
*> 78 LD-UL-Corner VALUE '+'.
|
307
|
+
*> 78 LD-LL-Corner VALUE '+'.
|
308
|
+
*> 78 LD-UR-Corner VALUE '+'.
|
309
|
+
*> 78 LD-LR-Corner VALUE '+'.
|
310
|
+
*> 78 LD-Upper-T VALUE '+'.
|
311
|
+
*> 78 LD-Lower-T VALUE '+'.
|
312
|
+
*> 78 LD-Horiz-Line VALUE '-'.
|
313
|
+
*> 78 LD-Vert-Line VALUE '|'.
|
314
|
+
*>
|
315
|
+
01 Blank-Screen LINE 1 COLUMN 1 BLANK SCREEN.
|
316
|
+
|
317
|
+
01 Switches-Screen BACKGROUND-COLOR COB-COLOR-BLACK
|
318
|
+
FOREGROUND-COLOR COB-COLOR-WHITE AUTO.
|
319
|
+
*>
|
320
|
+
*> GENERAL SCREEN FRAMEWORK
|
321
|
+
*>
|
322
|
+
03 BACKGROUND-COLOR COB-COLOR-BLACK
|
323
|
+
FOREGROUND-COLOR COB-COLOR-BLUE HIGHLIGHT.
|
324
|
+
05 LINE 02 COL 02 VALUE LD-UL-Corner.
|
325
|
+
05 PIC X(77) FROM Horizontal-Line.
|
326
|
+
05 COL 80 VALUE LD-UR-Corner.
|
327
|
+
|
328
|
+
05 LINE 03 COL 02 VALUE LD-Vert-Line.
|
329
|
+
05 COL 80 VALUE LD-Vert-Line.
|
330
|
+
|
331
|
+
05 LINE 04 COL 02 VALUE LD-Vert-Line.
|
332
|
+
05 COL 80 VALUE LD-Vert-Line.
|
333
|
+
|
334
|
+
05 LINE 05 COL 02 VALUE LD-Vert-Line.
|
335
|
+
05 COL 80 VALUE LD-Vert-Line.
|
336
|
+
|
337
|
+
05 LINE 06 COL 02 VALUE LD-LL-Corner.
|
338
|
+
05 PIC X(77) FROM Horizontal-Line.
|
339
|
+
05 COL 80 VALUE LD-LR-Corner.
|
340
|
+
|
341
|
+
05 LINE 08 COL 02 VALUE LD-UL-Corner.
|
342
|
+
05 PIC X(57) FROM Horizontal-Line.
|
343
|
+
05 COL 60 VALUE LD-Upper-T.
|
344
|
+
05 PIC X(19) FROM Horizontal-Line.
|
345
|
+
05 COL 80 VALUE LD-UR-Corner.
|
346
|
+
|
347
|
+
05 LINE 09 COL 02 VALUE LD-Vert-Line.
|
348
|
+
05 COL 60 VALUE LD-Vert-Line.
|
349
|
+
05 COL 80 VALUE LD-Vert-Line.
|
350
|
+
|
351
|
+
05 LINE 10 COL 02 VALUE LD-Vert-Line.
|
352
|
+
05 COL 60 VALUE LD-Vert-Line.
|
353
|
+
05 COL 80 VALUE LD-Vert-Line.
|
354
|
+
|
355
|
+
05 LINE 11 COL 02 VALUE LD-Vert-Line.
|
356
|
+
05 COL 60 VALUE LD-Vert-Line.
|
357
|
+
05 COL 80 VALUE LD-Vert-Line.
|
358
|
+
|
359
|
+
05 LINE 12 COL 02 VALUE LD-Vert-Line.
|
360
|
+
05 COL 60 VALUE LD-Vert-Line.
|
361
|
+
05 COL 80 VALUE LD-Vert-Line.
|
362
|
+
|
363
|
+
05 LINE 13 COL 02 VALUE LD-Vert-Line.
|
364
|
+
05 COL 60 VALUE LD-Vert-Line.
|
365
|
+
05 COL 80 VALUE LD-Vert-Line.
|
366
|
+
|
367
|
+
05 LINE 14 COL 02 VALUE LD-Vert-Line.
|
368
|
+
05 COL 60 VALUE LD-Vert-Line.
|
369
|
+
05 COL 80 VALUE LD-Vert-Line.
|
370
|
+
|
371
|
+
05 LINE 15 COL 02 VALUE LD-Vert-Line.
|
372
|
+
05 COL 60 VALUE LD-Vert-Line.
|
373
|
+
05 COL 80 VALUE LD-Vert-Line.
|
374
|
+
|
375
|
+
05 LINE 16 COL 02 VALUE LD-LL-Corner.
|
376
|
+
05 PIC X(57) FROM Horizontal-Line.
|
377
|
+
05 COL 60 VALUE LD-Lower-T.
|
378
|
+
05 PIC X(19) FROM Horizontal-Line.
|
379
|
+
05 COL 80 VALUE LD-LR-Corner.
|
380
|
+
|
381
|
+
05 LINE 18 COL 02 VALUE LD-UL-Corner.
|
382
|
+
05 PIC X(77) FROM Horizontal-Line.
|
383
|
+
05 COL 80 VALUE LD-UR-Corner.
|
384
|
+
|
385
|
+
05 LINE 19 COL 02 VALUE LD-Vert-Line.
|
386
|
+
05 COL 80 VALUE LD-Vert-Line.
|
387
|
+
|
388
|
+
05 LINE 20 COL 02 VALUE LD-LL-Corner.
|
389
|
+
05 PIC X(77) FROM Horizontal-Line.
|
390
|
+
05 COL 80 VALUE LD-LR-Corner.
|
391
|
+
|
392
|
+
05 LINE 22 COL 02 VALUE LD-UL-Corner.
|
393
|
+
05 PIC X(77) FROM Horizontal-Line.
|
394
|
+
05 COL 80 VALUE LD-UR-Corner.
|
395
|
+
|
396
|
+
05 LINE 23 COL 02 VALUE LD-Vert-Line.
|
397
|
+
05 COL 80 VALUE LD-Vert-Line.
|
398
|
+
|
399
|
+
05 LINE 24 COL 02 VALUE LD-LL-Corner.
|
400
|
+
05 PIC X(77) FROM Horizontal-Line.
|
401
|
+
05 COL 80 VALUE LD-LR-Corner.
|
402
|
+
*>
|
403
|
+
*> TOP AND BOTTOM LINES
|
404
|
+
*>
|
405
|
+
03 BACKGROUND-COLOR COB-COLOR-BLUE BLINK
|
406
|
+
FOREGROUND-COLOR COB-COLOR-WHITE HIGHLIGHT.
|
407
|
+
GC0410 05 LINE 01 COL 01 VALUE ' OCic ('.
|
408
|
+
GC0410 05 PIC X(16) FROM OC-Compiled.
|
409
|
+
GC0410 05 VALUE ') OpenCOBOL V1.1 06FEB2009 ' &
|
410
|
+
GC0410 'Interactive Compilation '.
|
411
|
+
GC0410 05 LINE 25 COL 01 PIC X(81) FROM Output-Message.
|
412
|
+
*>
|
413
|
+
*> LABELS
|
414
|
+
*>
|
415
|
+
03 BACKGROUND-COLOR COB-COLOR-BLACK
|
416
|
+
FOREGROUND-COLOR COB-COLOR-CYAN HIGHLIGHT.
|
417
|
+
05 LINE 07 COL 04 VALUE 'On/Off Switches:'.
|
418
|
+
05 COL 62 VALUE 'Configuration:'.
|
419
|
+
05 LINE 17 COL 04 VALUE 'Additional "cobc" Switches (if any
|
420
|
+
- '):'.
|
421
|
+
05 LINE 21 COL 04 VALUE 'Program Execution Arguments (if an
|
422
|
+
- 'y):'.
|
423
|
+
*>
|
424
|
+
*> TOP SECTION BACKGROUND
|
425
|
+
*>
|
426
|
+
03 BACKGROUND-COLOR COB-COLOR-BLACK
|
427
|
+
FOREGROUND-COLOR COB-COLOR-CYAN LOWLIGHT.
|
428
|
+
05 LINE 03 COL 04 VALUE 'Program: '.
|
429
|
+
05 LINE 04 COL 04 VALUE 'Folder: '.
|
430
|
+
05 LINE 05 COL 04 VALUE 'Filename: '.
|
431
|
+
|
432
|
+
05 LINE 03 COL 62 VALUE 'F-Key: Select Opt'.
|
433
|
+
05 LINE 04 COL 62 VALUE 'Enter: Compile '.
|
434
|
+
05 LINE 05 COL 62 VALUE 'Esc: Quit '.
|
435
|
+
*>
|
436
|
+
*> TOP SECTION PROGRAM INFO
|
437
|
+
*>
|
438
|
+
03 BACKGROUND-COLOR COB-COLOR-BLACK
|
439
|
+
FOREGROUND-COLOR COB-COLOR-WHITE HIGHLIGHT.
|
440
|
+
05 LINE 03 COL 14 PIC X(47) FROM Prog-Name.
|
441
|
+
05 LINE 04 COL 14 PIC X(47) FROM Prog-Folder.
|
442
|
+
05 LINE 05 COL 14 PIC X(47) FROM Prog-File-Name.
|
443
|
+
*>
|
444
|
+
*> MIDDLE LEFT SECTION F-KEYS
|
445
|
+
*>
|
446
|
+
03 BACKGROUND-COLOR COB-COLOR-BLACK
|
447
|
+
FOREGROUND-COLOR COB-COLOR-WHITE HIGHLIGHT.
|
448
|
+
05 LINE 09 COL 04 VALUE 'F1'.
|
449
|
+
05 LINE 10 COL 04 VALUE 'F2'.
|
450
|
+
05 LINE 11 COL 04 VALUE 'F3'.
|
451
|
+
05 LINE 12 COL 04 VALUE 'F4'.
|
452
|
+
05 LINE 13 COL 04 VALUE 'F5'.
|
453
|
+
05 LINE 14 COL 04 VALUE 'F6'.
|
454
|
+
05 LINE 15 COL 04 VALUE 'F7'.
|
455
|
+
05 LINE 09 COL 32 VALUE 'F8'.
|
456
|
+
05 LINE 10 COL 32 VALUE 'F9'.
|
457
|
+
*>
|
458
|
+
*> MIDDLE LEFT SECTION SWITCHES
|
459
|
+
*>
|
460
|
+
03 BACKGROUND-COLOR COB-COLOR-BLACK
|
461
|
+
FOREGROUND-COLOR COB-COLOR-RED HIGHLIGHT.
|
462
|
+
05 LINE 09 COL 07 PIC X(1) FROM S-DEBUG.
|
463
|
+
05 LINE 10 COL 07 PIC X(1) FROM S-DLL.
|
464
|
+
05 LINE 11 COL 07 PIC X(1) FROM S-SUBROUTINE.
|
465
|
+
05 LINE 12 COL 07 PIC X(1) FROM S-EXECUTE.
|
466
|
+
05 LINE 13 COL 07 PIC X(1) FROM S-NOTRUNC.
|
467
|
+
05 LINE 14 COL 07 PIC X(1) FROM S-TRACE.
|
468
|
+
05 LINE 15 COL 07 PIC X(1) FROM S-TRACEALL.
|
469
|
+
05 LINE 09 COL 35 PIC X(1) FROM S-SOURCE.
|
470
|
+
05 LINE 10 COL 35 PIC X(1) FROM S-XREF.
|
471
|
+
*>
|
472
|
+
*> MIDDLE LEFT SECTION BACKGROUND
|
473
|
+
*>
|
474
|
+
03 BACKGROUND-COLOR COB-COLOR-BLACK
|
475
|
+
FOREGROUND-COLOR COB-COLOR-CYAN LOWLIGHT.
|
476
|
+
05 LINE 09 COL 09 VALUE 'Compile debug lines '.
|
477
|
+
05 LINE 10 COL 09 VALUE 'Always make DLLs '.
|
478
|
+
05 LINE 11 COL 09 VALUE 'Pgm is a SUBROUTINE '.
|
479
|
+
05 LINE 12 COL 09 VALUE 'Execute if compile OK '.
|
480
|
+
05 LINE 13 COL 09 VALUE 'No COMP/BINARY trunc '.
|
481
|
+
05 LINE 14 COL 09 VALUE 'Trace procedures '.
|
482
|
+
05 LINE 15 COL 09 VALUE 'Trace proc + stmnts '.
|
483
|
+
05 LINE 09 COL 37 VALUE 'Produce source listing'.
|
484
|
+
05 LINE 10 COL 37 VALUE 'Produce xref listing '.
|
485
|
+
*>
|
486
|
+
*> MIDDLE RIGHT SECTION F-KEYS
|
487
|
+
*>
|
488
|
+
03 BACKGROUND-COLOR COB-COLOR-BLACK
|
489
|
+
FOREGROUND-COLOR COB-COLOR-WHITE HIGHLIGHT.
|
490
|
+
05 LINE 09 COL 62 VALUE 'S-F1'.
|
491
|
+
05 LINE 10 COL 62 VALUE 'S-F2'.
|
492
|
+
05 LINE 11 COL 62 VALUE 'S-F3'.
|
493
|
+
05 LINE 12 COL 62 VALUE 'S-F4'.
|
494
|
+
05 LINE 13 COL 62 VALUE 'S-F5'.
|
495
|
+
05 LINE 14 COL 62 VALUE 'S-F6'.
|
496
|
+
05 LINE 15 COL 62 VALUE 'S-F7'.
|
497
|
+
*>
|
498
|
+
*> MIDDLE RIGHT SECTION SWITCHES
|
499
|
+
*>
|
500
|
+
03 BACKGROUND-COLOR COB-COLOR-BLACK
|
501
|
+
FOREGROUND-COLOR COB-COLOR-RED HIGHLIGHT.
|
502
|
+
05 LINE 09 COL 67 PIC X(1) FROM S-Cfg-BS2000.
|
503
|
+
05 LINE 10 COL 67 PIC X(1) FROM S-Cfg-COBOL85.
|
504
|
+
05 LINE 11 COL 67 PIC X(1) FROM S-Cfg-COBOL2002.
|
505
|
+
05 LINE 12 COL 67 PIC X(1) FROM S-Cfg-DEFAULT.
|
506
|
+
05 LINE 13 COL 67 PIC X(1) FROM S-Cfg-IBM.
|
507
|
+
05 LINE 14 COL 67 PIC X(1) FROM S-Cfg-MF.
|
508
|
+
05 LINE 15 COL 67 PIC X(1) FROM S-Cfg-MVS.
|
509
|
+
*>
|
510
|
+
*> MIDDLE RIGHT SECTION BACKGROUND
|
511
|
+
*>
|
512
|
+
03 BACKGROUND-COLOR COB-COLOR-BLACK
|
513
|
+
FOREGROUND-COLOR COB-COLOR-CYAN LOWLIGHT.
|
514
|
+
05 LINE 09 COL 69 VALUE 'BS2000 '.
|
515
|
+
05 LINE 10 COL 69 VALUE 'COBOL85 '.
|
516
|
+
05 LINE 11 COL 69 VALUE 'COBOL2002 '.
|
517
|
+
05 LINE 12 COL 69 VALUE 'Default '.
|
518
|
+
05 LINE 13 COL 69 VALUE 'IBM '.
|
519
|
+
05 LINE 14 COL 69 VALUE 'MicroFocus'.
|
520
|
+
05 LINE 15 COL 69 VALUE 'MVS '.
|
521
|
+
*>
|
522
|
+
*> FREE-FORM OPTIONS FIELDS
|
523
|
+
*>
|
524
|
+
03 BACKGROUND-COLOR COB-COLOR-BLACK
|
525
|
+
FOREGROUND-COLOR COB-COLOR-WHITE HIGHLIGHT.
|
526
|
+
05 LINE 19 COL 04 PIC X(75) USING S-EXTRA.
|
527
|
+
05 LINE 23 COL 04 PIC X(75) USING S-ARGS.
|
528
|
+
/
|
529
|
+
PROCEDURE DIVISION.
|
530
|
+
*****************************************************************
|
531
|
+
** Legend to procedure names: **
|
532
|
+
** **
|
533
|
+
** 00x-xxx All MAIN driver procedures **
|
534
|
+
** 0xx-xxx All GLOBAL UTILITY procedures **
|
535
|
+
** 1xx-xxx All INITIALIZATION procedures **
|
536
|
+
** 2xx-xxx All CORE PROCESSING procedures **
|
537
|
+
** 9xx-xxx All TERMINATION procedures **
|
538
|
+
*****************************************************************
|
539
|
+
DECLARATIVES.
|
540
|
+
000-File-Error SECTION.
|
541
|
+
USE AFTER STANDARD ERROR PROCEDURE ON Source-Code.
|
542
|
+
000-Handle-Error.
|
543
|
+
COPY FileStat-Msgs
|
544
|
+
REPLACING STATUS BY FSM-Status
|
545
|
+
MSG BY FSM-Msg.
|
546
|
+
MOVE SPACES TO Output-Message
|
547
|
+
IF FSM-Status = 35
|
548
|
+
DISPLAY
|
549
|
+
'File not found: "'
|
550
|
+
TRIM(File-Name,TRAILING)
|
551
|
+
'"'
|
552
|
+
END-DISPLAY
|
553
|
+
ELSE
|
554
|
+
DISPLAY
|
555
|
+
'Error accessing file: "'
|
556
|
+
TRIM(File-Name,TRAILING)
|
557
|
+
'"'
|
558
|
+
END-DISPLAY
|
559
|
+
END-IF
|
560
|
+
GOBACK
|
561
|
+
.
|
562
|
+
END DECLARATIVES.
|
563
|
+
/
|
564
|
+
000-Main SECTION.
|
565
|
+
|
566
|
+
PERFORM 100-Initialization
|
567
|
+
GC0609 SET 88-Not-Complete TO TRUE
|
568
|
+
GC0609 PERFORM UNTIL 88-Complete
|
569
|
+
GC0609 PERFORM 200-Let-User-Set-Switches
|
570
|
+
GC0609 PERFORM 210-Run-Compiler
|
571
|
+
GC0410 IF (88-Compile-OK OR 88-Compile-OK-Warn)
|
572
|
+
GC0410 AND (S-XREF NOT = SPACE OR S-SOURCE NOT = SPACE)
|
573
|
+
GC0410 PERFORM 220-Make-Listing
|
574
|
+
GC0410 END-IF
|
575
|
+
GC0709 IF (S-EXECUTE NOT = SPACES)
|
576
|
+
GC0709 AND (88-Output-File-Avail)
|
577
|
+
GC0609 PERFORM 230-Run-Program
|
578
|
+
GC0609 END-IF
|
579
|
+
GC0609 END-PERFORM
|
580
|
+
.
|
581
|
+
|
582
|
+
009-Done.
|
583
|
+
PERFORM 900-Terminate
|
584
|
+
.
|
585
|
+
* -- Control will NOT return
|
586
|
+
/
|
587
|
+
010-Parse-Args SECTION.
|
588
|
+
*****************************************************************
|
589
|
+
** Process a sequence of KEYWORD=VALUE items. These are items **
|
590
|
+
** specified on the command-line to provide the initial **
|
591
|
+
** options shown selected on the screen. When integrating **
|
592
|
+
** OCic into an edirot or framework, include these switches on **
|
593
|
+
** the ocic.exe command the editor/framework executes. Any **
|
594
|
+
** underlined choice is the default value for that switch. **
|
595
|
+
** **
|
596
|
+
** @CONFIG=BS2000|COBOL85|COBOL2002|DEFAULT|IBM|MF|MVS **
|
597
|
+
** ======= **
|
598
|
+
** This switch specifies the default cobc compiler configura- **
|
599
|
+
** tion file to be used **
|
600
|
+
** **
|
601
|
+
** @DEBUG=YES|NO **
|
602
|
+
** == **
|
603
|
+
** This switch specifies whether (YES) or not (NO) debugging **
|
604
|
+
** lines (those with a "D" in column 7) will be compiled. **
|
605
|
+
** **
|
606
|
+
** @DLL=YES|NO **
|
607
|
+
** == **
|
608
|
+
** Use this switch to force ALL compiled programs to be built **
|
609
|
+
** as DLLs ("@DLL=YES"). When main programs are built as DLLs **
|
610
|
+
** they must be executed using the cobcrun utility. When **
|
611
|
+
** "@DLL=NO" is in effect, main programs are generated as **
|
612
|
+
** actual "exe" files and only subprograms will be generated **
|
613
|
+
** as DLLs. **
|
614
|
+
** **
|
615
|
+
** @EXECUTE=YES|NO **
|
616
|
+
** == **
|
617
|
+
** This switch specifies whether ("@EXECUTE=YES") or not **
|
618
|
+
** ("@EXECUTE=NO") the program will be executed after it is **
|
619
|
+
** successfully compiled. **
|
620
|
+
** **
|
621
|
+
** @EXTRA=extra cobc argument(s) **
|
622
|
+
** **
|
623
|
+
** This switch allows you to specify additional cobc arguments **
|
624
|
+
** that aren't managed by the other OC switches. If used, **
|
625
|
+
** this must be the last switch specified on the command line, **
|
626
|
+
** as everything that follows the "=" will be placed on the **
|
627
|
+
** cobc command generated by OC. **
|
628
|
+
** **
|
629
|
+
** @NOTRUNC=YES|NO **
|
630
|
+
** === **
|
631
|
+
** This switch specifies whether (YES) or not (NO) the sup- **
|
632
|
+
** pression of binary field truncation will occur. If a PIC **
|
633
|
+
** 99 COMP field (one byte of storage), for example, is given **
|
634
|
+
** the value 123, it may have its value truncated to 23 when **
|
635
|
+
** DISPLAYed. Regardless of the NOTRUNC setting, internally **
|
636
|
+
** the full precision of the field (allowing a maximum value **
|
637
|
+
** of 255) will be preserved. Even though truncation - if it **
|
638
|
+
** does occur - would appear to have a minimal disruption on **
|
639
|
+
** program operation, it has a significant effect on program **
|
640
|
+
** run-time speed. **
|
641
|
+
** **
|
642
|
+
** @TRACE=YES|NO|ALL **
|
643
|
+
** == **
|
644
|
+
** This switch controls whether or not code will be added to **
|
645
|
+
** the object program to produce execution-time logic traces. **
|
646
|
+
** A specification of "@TRACE=NO" means no such code will be **
|
647
|
+
** produced. By specifying "@TRACE=YES", code will be genera- **
|
648
|
+
** ted to display procedure names as they are entered. A **
|
649
|
+
** "@TRACE=ALL" specification will generate not only procedure **
|
650
|
+
** traces (as "@TRACE=YES" would) but also statement-level **
|
651
|
+
** traces too! All trace output is written to STDERR, so **
|
652
|
+
** adding a "2>file" to the execution of the program will pipe **
|
653
|
+
** the trace output to a file. You may find it valuable to **
|
654
|
+
** add your own DISPLAY statements to the debugging output via **
|
655
|
+
** "DISPLAY xx UPON SYSERR" The SYSERR device corresponds to **
|
656
|
+
** the Windows or UNIX STDERR device and will therefore honor **
|
657
|
+
** any "2>file" placed at the end of your program's execution. **
|
658
|
+
** Add a "D" in column 7 and you can control the generation or **
|
659
|
+
** ignoring of these DISPLAY statements via the "@DEBUG" **
|
660
|
+
** switch. **
|
661
|
+
** **
|
662
|
+
GC0410** @SOURCE=YES|NO **
|
663
|
+
GC0410** == **
|
664
|
+
GC0410** Use this switch to produce a source listing of the program, **
|
665
|
+
GC0410** PROVIDED it compiles without errors. **
|
666
|
+
** **
|
667
|
+
GC0410** @XREF=YES|NO **
|
668
|
+
GC0410** == **
|
669
|
+
GC0410** Use this switch to produce a cross-reference listing of the **
|
670
|
+
GC0410** program, PROVIDED it compiles without errors. **
|
671
|
+
*****************************************************************
|
672
|
+
|
673
|
+
011-Init.
|
674
|
+
MOVE 1 TO I
|
675
|
+
.
|
676
|
+
|
677
|
+
012-Extract-Kwd-And-Value.
|
678
|
+
PERFORM UNTIL I NOT < LENGTH(Command-Line-Args)
|
679
|
+
MOVE I TO J
|
680
|
+
UNSTRING Command-Line-Args
|
681
|
+
DELIMITED BY ALL SPACES
|
682
|
+
INTO Switch-Keyword-And-Value
|
683
|
+
WITH POINTER I
|
684
|
+
END-UNSTRING
|
685
|
+
IF Switch-Keyword-And-Value NOT = SPACES
|
686
|
+
UNSTRING Switch-Keyword-And-Value
|
687
|
+
DELIMITED BY '='
|
688
|
+
INTO Switch-Keyword, Switch-Value
|
689
|
+
END-UNSTRING
|
690
|
+
PERFORM 030-Process-Keyword
|
691
|
+
END-IF
|
692
|
+
END-PERFORM
|
693
|
+
.
|
694
|
+
|
695
|
+
019-Done.
|
696
|
+
EXIT.
|
697
|
+
|
698
|
+
*****************************************************************
|
699
|
+
** Since this program uses the SCREEN SECTION, it cannot do **
|
700
|
+
** conventional console DISPLAY operations. This routine **
|
701
|
+
** (which, I admit, is like using an H-bomb to hunt rabbits) **
|
702
|
+
** will submit an "ECHO" command to the system to simulate a **
|
703
|
+
** DISPLAY. **
|
704
|
+
*****************************************************************
|
705
|
+
021-Build-And-Issue-Command.
|
706
|
+
DISPLAY
|
707
|
+
Output-Message
|
708
|
+
END-DISPLAY
|
709
|
+
.
|
710
|
+
|
711
|
+
029-Done.
|
712
|
+
EXIT.
|
713
|
+
/
|
714
|
+
030-Process-Keyword SECTION.
|
715
|
+
*****************************************************************
|
716
|
+
** Process a single KEYWORD=VALUE item. **
|
717
|
+
*****************************************************************
|
718
|
+
|
719
|
+
031-Init.
|
720
|
+
MOVE UPPER-CASE(Switch-Keyword) TO Switch-Keyword
|
721
|
+
SET 88-Switch-Is-Good TO TRUE
|
722
|
+
.
|
723
|
+
|
724
|
+
032-Process.
|
725
|
+
EVALUATE TRUE
|
726
|
+
WHEN Switch-Is-EXTRA
|
727
|
+
GC0410 MOVE J TO I
|
728
|
+
UNSTRING Command-Line-Args DELIMITED BY '='
|
729
|
+
INTO Dummy, S-EXTRA
|
730
|
+
GC0410 WITH POINTER I
|
731
|
+
GC0410 END-UNSTRING
|
732
|
+
MOVE LENGTH(Command-Line-Args) TO I
|
733
|
+
WHEN Switch-Is-CONFIG
|
734
|
+
MOVE 'CONFIG' TO Switch-Keyword
|
735
|
+
MOVE UPPER-CASE(Switch-Value)
|
736
|
+
TO Switch-Value
|
737
|
+
EVALUATE Switch-Value
|
738
|
+
WHEN 'BS2000'
|
739
|
+
MOVE SPACES TO S-CfgS
|
740
|
+
MOVE Selection-Char TO S-Cfg-BS2000
|
741
|
+
WHEN 'COBOL85'
|
742
|
+
MOVE SPACES TO S-CfgS
|
743
|
+
MOVE Selection-Char TO S-Cfg-COBOL85
|
744
|
+
WHEN 'COBOL2002'
|
745
|
+
MOVE SPACES TO S-CfgS
|
746
|
+
MOVE Selection-Char TO S-Cfg-COBOL2002
|
747
|
+
WHEN 'DEFAULT'
|
748
|
+
MOVE SPACES TO S-CfgS
|
749
|
+
MOVE Selection-Char TO S-Cfg-DEFAULT
|
750
|
+
WHEN 'IBM'
|
751
|
+
MOVE SPACES TO S-CfgS
|
752
|
+
MOVE Selection-Char TO S-Cfg-IBM
|
753
|
+
WHEN 'MF'
|
754
|
+
MOVE SPACES TO S-CfgS
|
755
|
+
MOVE Selection-Char TO S-Cfg-MF
|
756
|
+
WHEN 'MVS'
|
757
|
+
MOVE SPACES TO S-CfgS
|
758
|
+
MOVE Selection-Char TO S-Cfg-MVS
|
759
|
+
WHEN OTHER
|
760
|
+
MOVE 'An invalid /CONFIG switch value ' &
|
761
|
+
'was specified on the command line ' &
|
762
|
+
'- ignored'
|
763
|
+
TO Output-Message
|
764
|
+
END-EVALUATE
|
765
|
+
WHEN Switch-Is-DEBUG
|
766
|
+
MOVE 'DEBUG' TO Switch-Keyword
|
767
|
+
MOVE UPPER-CASE(Switch-Value)
|
768
|
+
TO Switch-Value
|
769
|
+
PERFORM 040-Process-Yes-No-Value
|
770
|
+
IF 88-Switch-Is-Good
|
771
|
+
MOVE SV-1 TO S-DEBUG
|
772
|
+
END-IF
|
773
|
+
GC0410 WHEN Switch-Is-DLL
|
774
|
+
GC0410 MOVE 'DLL' TO Switch-Keyword
|
775
|
+
GC0410 MOVE UPPER-CASE(Switch-Value)
|
776
|
+
GC0410 TO Switch-Value
|
777
|
+
GC0410 PERFORM 040-Process-Yes-No-Value
|
778
|
+
GC0410 IF 88-Switch-Is-Good
|
779
|
+
GC0410 MOVE SV-1 TO S-DLL
|
780
|
+
GC0410 END-IF
|
781
|
+
WHEN Switch-Is-EXECUTE
|
782
|
+
MOVE 'EXECUTE' TO Switch-Keyword
|
783
|
+
MOVE UPPER-CASE(Switch-Value)
|
784
|
+
TO Switch-Value
|
785
|
+
PERFORM 040-Process-Yes-No-Value
|
786
|
+
IF 88-Switch-Is-Good
|
787
|
+
MOVE SV-1 TO S-EXECUTE
|
788
|
+
END-IF
|
789
|
+
WHEN Switch-Is-NOTRUNC
|
790
|
+
MOVE 'NOTRUNC' TO Switch-Keyword
|
791
|
+
MOVE UPPER-CASE(Switch-Value)
|
792
|
+
TO Switch-Value
|
793
|
+
PERFORM 040-Process-Yes-No-Value
|
794
|
+
IF 88-Switch-Is-Good
|
795
|
+
MOVE SV-1 TO S-NOTRUNC
|
796
|
+
END-IF
|
797
|
+
GC0410 WHEN Switch-Is-SOURCE
|
798
|
+
GC0410 MOVE 'SOURCE' TO Switch-Keyword
|
799
|
+
GC0410 MOVE UPPER-CASE(Switch-Value)
|
800
|
+
GC0410 TO Switch-Value
|
801
|
+
GC0410 PERFORM 050-Process-Yes-No-All
|
802
|
+
GC0410 IF 88-Switch-Is-Good
|
803
|
+
GC0410 MOVE SV-1 TO S-SOURCE
|
804
|
+
GC0410 END-IF
|
805
|
+
WHEN Switch-Is-TRACE
|
806
|
+
MOVE 'TRACE' TO Switch-Keyword
|
807
|
+
MOVE UPPER-CASE(Switch-Value)
|
808
|
+
TO Switch-Value
|
809
|
+
PERFORM 050-Process-Yes-No-All
|
810
|
+
IF 88-Switch-Is-Good
|
811
|
+
MOVE SV-1 TO S-TRACE
|
812
|
+
END-IF
|
813
|
+
GC0410 WHEN Switch-Is-XREF
|
814
|
+
GC0410 MOVE 'XREF' TO Switch-Keyword
|
815
|
+
GC0410 MOVE UPPER-CASE(Switch-Value)
|
816
|
+
GC0410 TO Switch-Value
|
817
|
+
GC0410 PERFORM 050-Process-Yes-No-All
|
818
|
+
GC0410 IF 88-Switch-Is-Good
|
819
|
+
GC0410 MOVE SV-1 TO S-XREF
|
820
|
+
GC0410 END-IF
|
821
|
+
WHEN OTHER
|
822
|
+
MOVE SPACES TO Output-Message
|
823
|
+
STRING '"'
|
824
|
+
TRIM(Switch-Keyword)
|
825
|
+
'" is not a valid switch ' &
|
826
|
+
'- ignored'
|
827
|
+
DELIMITED SIZE
|
828
|
+
INTO Output-Message
|
829
|
+
END-STRING
|
830
|
+
SET 88-Switch-Is-Bad TO TRUE
|
831
|
+
END-EVALUATE
|
832
|
+
.
|
833
|
+
|
834
|
+
039-Done.
|
835
|
+
EXIT.
|
836
|
+
/
|
837
|
+
040-Process-Yes-No-Value SECTION.
|
838
|
+
*****************************************************************
|
839
|
+
** Process a switch value of YES or NO **
|
840
|
+
*****************************************************************
|
841
|
+
|
842
|
+
042-Process.
|
843
|
+
EVALUATE SV-1
|
844
|
+
WHEN 'Y'
|
845
|
+
MOVE 'YES' TO Switch-Value
|
846
|
+
WHEN 'N'
|
847
|
+
MOVE 'NO' To Switch-Value
|
848
|
+
WHEN OTHER
|
849
|
+
MOVE SPACES TO Output-Message
|
850
|
+
STRING '*ERROR: "' TRIM(Switch-Value)
|
851
|
+
'" is not a valid value for the "'
|
852
|
+
TRIM(Switch-Keyword) '" switch'
|
853
|
+
DELIMITED SPACES
|
854
|
+
INTO Output-Message
|
855
|
+
END-STRING
|
856
|
+
SET 88-Switch-Is-Bad TO TRUE
|
857
|
+
END-EVALUATE
|
858
|
+
.
|
859
|
+
|
860
|
+
049-Done.
|
861
|
+
EXIT.
|
862
|
+
/
|
863
|
+
050-Process-Yes-No-All SECTION.
|
864
|
+
*****************************************************************
|
865
|
+
** Process a switch value of YES, NO or ALL **
|
866
|
+
*****************************************************************
|
867
|
+
|
868
|
+
052-Process.
|
869
|
+
IF SV-1 = 'A'
|
870
|
+
MOVE 'ALL' TO Switch-Value
|
871
|
+
ELSE
|
872
|
+
PERFORM 040-Process-Yes-No-Value
|
873
|
+
END-IF
|
874
|
+
.
|
875
|
+
|
876
|
+
059-Done.
|
877
|
+
EXIT.
|
878
|
+
/
|
879
|
+
060-Process-Yes-No-Auto SECTION.
|
880
|
+
*****************************************************************
|
881
|
+
** Process a switch value of YES, NO or AUTO **
|
882
|
+
*****************************************************************
|
883
|
+
|
884
|
+
061-Init.
|
885
|
+
IF SV-1 = 'A'
|
886
|
+
PERFORM 070-Find-LINKAGE-SECTION
|
887
|
+
IF 88-Compile-As-Subpgm
|
888
|
+
MOVE 'Y' TO Switch-Value
|
889
|
+
ELSE
|
890
|
+
MOVE 'N' TO Switch-Value
|
891
|
+
END-IF
|
892
|
+
ELSE
|
893
|
+
PERFORM 040-Process-Yes-No-Value
|
894
|
+
END-IF
|
895
|
+
.
|
896
|
+
/
|
897
|
+
070-Find-LINKAGE-SECTION SECTION.
|
898
|
+
*****************************************************************
|
899
|
+
** Determine if the program being compiled is a MAIN program **
|
900
|
+
*****************************************************************
|
901
|
+
|
902
|
+
071-Init.
|
903
|
+
OPEN INPUT Source-Code
|
904
|
+
SET 88-Compile-As-Mainpgm TO TRUE
|
905
|
+
SET 88-More-To-1st-Prog TO TRUE
|
906
|
+
PERFORM UNTIL 88-1st-Prog-Complete
|
907
|
+
READ Source-Code AT END
|
908
|
+
CLOSE Source-Code
|
909
|
+
EXIT SECTION
|
910
|
+
END-READ
|
911
|
+
CALL 'CHECKSOURCE' USING Source-Code-Record
|
912
|
+
F-Source-Record-Type
|
913
|
+
END-CALL
|
914
|
+
IF 88-Source-Rec-Ident
|
915
|
+
SET 88-1st-Prog-Complete TO TRUE
|
916
|
+
END-IF
|
917
|
+
END-PERFORM
|
918
|
+
.
|
919
|
+
|
920
|
+
072-Process-Source.
|
921
|
+
SET 88-Source-Rec-IgnoCOB-COLOR-RED TO TRUE
|
922
|
+
PERFORM UNTIL 88-Source-Rec-Linkage
|
923
|
+
OR 88-Source-Rec-Ident
|
924
|
+
READ Source-Code AT END
|
925
|
+
CLOSE Source-Code
|
926
|
+
EXIT SECTION
|
927
|
+
END-READ
|
928
|
+
CALL 'CHECKSOURCE' USING Source-Code-Record
|
929
|
+
F-Source-Record-Type
|
930
|
+
END-CALL
|
931
|
+
END-PERFORM
|
932
|
+
CLOSE Source-Code
|
933
|
+
IF 88-Source-Rec-Linkage
|
934
|
+
SET 88-Compile-As-Subpgm TO TRUE
|
935
|
+
END-IF
|
936
|
+
.
|
937
|
+
|
938
|
+
079-Done.
|
939
|
+
EXIT.
|
940
|
+
/
|
941
|
+
100-Initialization SECTION.
|
942
|
+
*****************************************************************
|
943
|
+
** Perform all program-wide initialization operations **
|
944
|
+
*****************************************************************
|
945
|
+
|
946
|
+
|
947
|
+
GC0909 101-Determine-OS-Type.
|
948
|
+
GC0909 CALL 'GETOSTYPE'
|
949
|
+
GC0909 END-CALL
|
950
|
+
GC0909 MOVE RETURN-CODE TO OS-Type
|
951
|
+
GC0909 EVALUATE TRUE
|
952
|
+
GC0909 WHEN OS-Unknown
|
953
|
+
GC0909 MOVE '\' TO Dir-Char
|
954
|
+
GC0909 MOVE 'Unknown' TO OS-Type-Literal
|
955
|
+
GC0310 MOVE COB-SCR-F11 TO CK-S-F1
|
956
|
+
GC0310 MOVE COB-SCR-F12 TO CK-S-F2
|
957
|
+
GC0310 MOVE COB-SCR-F13 TO CK-S-F3
|
958
|
+
GC0310 MOVE COB-SCR-F14 TO CK-S-F4
|
959
|
+
GC0310 MOVE COB-SCR-F15 TO CK-S-F5
|
960
|
+
GC0310 MOVE COB-SCR-F16 TO CK-S-F6
|
961
|
+
GC0310 MOVE COB-SCR-F17 TO CK-S-F7
|
962
|
+
GC0909 WHEN OS-Windows
|
963
|
+
GC0909 MOVE '\' TO Dir-Char
|
964
|
+
GC0909 MOVE 'Windows' TO OS-Type-Literal
|
965
|
+
GC0310 MOVE COB-SCR-F13 TO CK-S-F1
|
966
|
+
GC0310 MOVE COB-SCR-F14 TO CK-S-F2
|
967
|
+
GC0310 MOVE COB-SCR-F15 TO CK-S-F3
|
968
|
+
GC0310 MOVE COB-SCR-F16 TO CK-S-F4
|
969
|
+
GC0310 MOVE COB-SCR-F17 TO CK-S-F5
|
970
|
+
GC0310 MOVE COB-SCR-F18 TO CK-S-F6
|
971
|
+
GC0310 MOVE COB-SCR-F19 TO CK-S-F7
|
972
|
+
GC0909 WHEN OS-Cygwin
|
973
|
+
GC0909 MOVE '/' TO Dir-Char
|
974
|
+
GC0410 MOVE 'Cygwin' TO OS-Type-Literal
|
975
|
+
GC0310 MOVE COB-SCR-F11 TO CK-S-F1
|
976
|
+
GC0310 MOVE COB-SCR-F12 TO CK-S-F2
|
977
|
+
GC0310 MOVE COB-SCR-F13 TO CK-S-F3
|
978
|
+
GC0310 MOVE COB-SCR-F14 TO CK-S-F4
|
979
|
+
GC0310 MOVE COB-SCR-F15 TO CK-S-F5
|
980
|
+
GC0310 MOVE COB-SCR-F16 TO CK-S-F6
|
981
|
+
GC0310 MOVE COB-SCR-F17 TO CK-S-F7
|
982
|
+
GC0909 WHEN OS-UNIX
|
983
|
+
GC0909 MOVE '/' TO Dir-Char
|
984
|
+
GC0410 MOVE 'UNIX ' TO OS-Type-Literal
|
985
|
+
GC0310 MOVE COB-SCR-F11 TO CK-S-F1
|
986
|
+
GC0310 MOVE COB-SCR-F12 TO CK-S-F2
|
987
|
+
GC0310 MOVE COB-SCR-F13 TO CK-S-F3
|
988
|
+
GC0310 MOVE COB-SCR-F14 TO CK-S-F4
|
989
|
+
GC0310 MOVE COB-SCR-F15 TO CK-S-F5
|
990
|
+
GC0310 MOVE COB-SCR-F16 TO CK-S-F6
|
991
|
+
GC0310 MOVE COB-SCR-F17 TO CK-S-F7
|
992
|
+
GC0909 END-EVALUATE
|
993
|
+
GC0909 .
|
994
|
+
|
995
|
+
102-Set-Environment-Vars.
|
996
|
+
SET ENVIRONMENT 'COB_SCREEN_EXCEPTIONS' TO 'Y'
|
997
|
+
SET ENVIRONMENT 'COB_SCREEN_ESC' TO 'Y'
|
998
|
+
.
|
999
|
+
|
1000
|
+
103-Generate-Cobc-Output-Fn.
|
1001
|
+
ACCEPT Env-TEMP
|
1002
|
+
FROM ENVIRONMENT "TEMP"
|
1003
|
+
END-ACCEPT
|
1004
|
+
MOVE SPACES TO Cobc-Output-File
|
1005
|
+
STRING TRIM(Env-TEMP,TRAILING)
|
1006
|
+
GC0909 Dir-Char
|
1007
|
+
GC0909 'OC-Messages.TXT'
|
1008
|
+
DELIMITED SIZE
|
1009
|
+
INTO Cobc-Output-File
|
1010
|
+
END-STRING
|
1011
|
+
.
|
1012
|
+
|
1013
|
+
104-Generate-Banner-Line-Info.
|
1014
|
+
MOVE WHEN-COMPILED (1:12) TO OC-Compiled
|
1015
|
+
INSPECT OC-Compiled
|
1016
|
+
REPLACING ALL '/' BY ':'
|
1017
|
+
AFTER INITIAL SPACE
|
1018
|
+
.
|
1019
|
+
|
1020
|
+
105-Establish-Switch-Settings.
|
1021
|
+
ACCEPT Command-Line-Args
|
1022
|
+
FROM COMMAND-LINE
|
1023
|
+
END-ACCEPT
|
1024
|
+
MOVE TRIM(Command-Line-Args, Leading)
|
1025
|
+
TO Command-Line-Args
|
1026
|
+
MOVE 0 TO Tally
|
1027
|
+
GC0410 INSPECT Command-Line-Args TALLYING Tally FOR ALL '@'
|
1028
|
+
IF Tally = 0
|
1029
|
+
MOVE Command-Line-Args TO File-Name
|
1030
|
+
MOVE SPACES TO Command-Line-Args
|
1031
|
+
ELSE
|
1032
|
+
GC0410 UNSTRING Command-Line-Args DELIMITED BY '@'
|
1033
|
+
INTO File-Name, Dummy
|
1034
|
+
END-UNSTRING
|
1035
|
+
INSPECT Command-Line-Args
|
1036
|
+
GC0410 REPLACING FIRST '@' BY LOW-VALUES
|
1037
|
+
UNSTRING Command-Line-Args
|
1038
|
+
DELIMITED BY LOW-VALUES
|
1039
|
+
INTO Dummy, Cmd
|
1040
|
+
END-UNSTRING
|
1041
|
+
MOVE SPACES TO Command-Line-Args
|
1042
|
+
GC0410 STRING '@' Cmd DELIMITED SIZE
|
1043
|
+
INTO Command-Line-Args
|
1044
|
+
END-STRING
|
1045
|
+
END-IF
|
1046
|
+
IF File-Name = SPACES
|
1047
|
+
DISPLAY
|
1048
|
+
'No program filename was specified'
|
1049
|
+
END-DISPLAY
|
1050
|
+
PERFORM 900-Terminate
|
1051
|
+
END-IF
|
1052
|
+
PERFORM 010-Parse-Args
|
1053
|
+
IF S-SUBROUTINE = 'A'
|
1054
|
+
MOVE 'S' TO Switch-Keyword
|
1055
|
+
MOVE 'A' TO Switch-Value
|
1056
|
+
PERFORM 070-Find-LINKAGE-SECTION
|
1057
|
+
IF 88-Compile-As-Subpgm
|
1058
|
+
MOVE 'Y' TO S-SUBROUTINE
|
1059
|
+
ELSE
|
1060
|
+
MOVE 'N' TO S-SUBROUTINE
|
1061
|
+
END-IF
|
1062
|
+
END-IF
|
1063
|
+
INSPECT S-Yes-No-Switches REPLACING ALL 'Y' BY Selection-Char
|
1064
|
+
INSPECT S-Yes-No-Switches REPLACING ALL 'N' BY ' '
|
1065
|
+
.
|
1066
|
+
|
1067
|
+
106-Determine-Folder-Path.
|
1068
|
+
Move 256 TO I
|
1069
|
+
GC0909 IF OS-Cygwin AND File-Name (2:1) = ':'
|
1070
|
+
GC0909 MOVE '\' TO Dir-Char
|
1071
|
+
GC0909 END-IF
|
1072
|
+
PERFORM UNTIL I = 0 OR FN-Char (I) = Dir-Char
|
1073
|
+
SUBTRACT 1 FROM I
|
1074
|
+
END-PERFORM
|
1075
|
+
IF I = 0
|
1076
|
+
MOVE SPACES TO Prog-Folder
|
1077
|
+
MOVE File-Name TO Prog-File-Name
|
1078
|
+
ELSE
|
1079
|
+
MOVE '*' TO FN-Char (I)
|
1080
|
+
UNSTRING File-Name DELIMITED BY '*'
|
1081
|
+
INTO Prog-Folder
|
1082
|
+
Prog-File-Name
|
1083
|
+
END-UNSTRING
|
1084
|
+
MOVE Dir-Char TO FN-Char (I)
|
1085
|
+
END-IF
|
1086
|
+
UNSTRING Prog-File-Name DELIMITED BY '.'
|
1087
|
+
INTO Prog-Name, Prog-Extension
|
1088
|
+
END-UNSTRING
|
1089
|
+
IF Prog-Folder = SPACES
|
1090
|
+
ACCEPT Prog-Folder
|
1091
|
+
FROM ENVIRONMENT 'CD'
|
1092
|
+
END-ACCEPT
|
1093
|
+
GC0909 ELSE
|
1094
|
+
GC0909 CALL "CBL_CHANGE_DIR"
|
1095
|
+
GC0909 USING TRIM(Prog-Folder,TRAILING)
|
1096
|
+
GC0909 END-CALL
|
1097
|
+
END-IF
|
1098
|
+
GC0909 IF OS-Cygwin AND File-Name (2:1) = ':'
|
1099
|
+
GC0909 MOVE '/' TO Dir-Char
|
1100
|
+
GC0909 END-IF
|
1101
|
+
.
|
1102
|
+
|
1103
|
+
GC0909 107-Other.
|
1104
|
+
GC0909 MOVE ALL LD-Horiz-Line TO Horizontal-Line.
|
1105
|
+
GC0410 MOVE CONCATENATE(' OCic for ',
|
1106
|
+
GC0410 TRIM(OS-Type-Literal,Trailing),
|
1107
|
+
GC0410 ' Copyright (C) 2009-2010, Gary L. Cutler,',
|
1108
|
+
GC0410 ' GPL')
|
1109
|
+
GC0410 TO Output-Message.
|
1110
|
+
GC0909 .
|
1111
|
+
GC0909
|
1112
|
+
109-Done.
|
1113
|
+
EXIT.
|
1114
|
+
/
|
1115
|
+
200-Let-User-Set-Switches SECTION.
|
1116
|
+
*****************************************************************
|
1117
|
+
** Show the user the current switch settings and allow them to **
|
1118
|
+
** be changed. **
|
1119
|
+
*****************************************************************
|
1120
|
+
|
1121
|
+
201-Init.
|
1122
|
+
SET 88-Switch-Changes TO TRUE
|
1123
|
+
.
|
1124
|
+
|
1125
|
+
202-Show-And-Change-Switches.
|
1126
|
+
PERFORM UNTIL 88-No-Switch-Changes
|
1127
|
+
ACCEPT
|
1128
|
+
Switches-Screen
|
1129
|
+
END-ACCEPT
|
1130
|
+
IF COB-CRT-STATUS > 0
|
1131
|
+
EVALUATE COB-CRT-STATUS
|
1132
|
+
WHEN COB-SCR-F1
|
1133
|
+
IF S-DEBUG = SPACE
|
1134
|
+
MOVE Selection-Char TO S-DEBUG
|
1135
|
+
ELSE
|
1136
|
+
MOVE ' ' TO S-DEBUG
|
1137
|
+
END-IF
|
1138
|
+
WHEN COB-SCR-F2
|
1139
|
+
IF S-DLL = SPACE
|
1140
|
+
MOVE Selection-Char TO S-DLL
|
1141
|
+
ELSE
|
1142
|
+
MOVE ' ' TO S-DLL
|
1143
|
+
END-IF
|
1144
|
+
WHEN COB-SCR-F3
|
1145
|
+
IF S-SUBROUTINE = SPACE
|
1146
|
+
MOVE Selection-Char TO S-SUBROUTINE
|
1147
|
+
MOVE ' ' TO S-EXECUTE
|
1148
|
+
ELSE
|
1149
|
+
MOVE ' ' TO S-SUBROUTINE
|
1150
|
+
END-IF
|
1151
|
+
WHEN COB-SCR-F4
|
1152
|
+
IF S-EXECUTE = SPACE
|
1153
|
+
AND S-SUBROUTINE = SPACE
|
1154
|
+
MOVE Selection-Char TO S-EXECUTE
|
1155
|
+
ELSE
|
1156
|
+
MOVE ' ' TO S-EXECUTE
|
1157
|
+
END-IF
|
1158
|
+
WHEN COB-SCR-F5
|
1159
|
+
IF S-NOTRUNC = SPACE
|
1160
|
+
MOVE Selection-Char TO S-NOTRUNC
|
1161
|
+
ELSE
|
1162
|
+
MOVE ' ' TO S-NOTRUNC
|
1163
|
+
END-IF
|
1164
|
+
WHEN COB-SCR-F6
|
1165
|
+
IF S-TRACE = SPACE
|
1166
|
+
MOVE Selection-Char TO S-TRACE
|
1167
|
+
MOVE ' ' TO S-TRACEALL
|
1168
|
+
ELSE
|
1169
|
+
MOVE ' ' TO S-TRACE
|
1170
|
+
END-IF
|
1171
|
+
WHEN COB-SCR-F7
|
1172
|
+
IF S-TRACEALL = SPACE
|
1173
|
+
MOVE Selection-Char TO S-TRACEALL
|
1174
|
+
MOVE ' ' TO S-TRACE
|
1175
|
+
ELSE
|
1176
|
+
MOVE ' ' TO S-TRACEALL
|
1177
|
+
END-IF
|
1178
|
+
GC0410 WHEN COB-SCR-F8
|
1179
|
+
GC0410 IF S-SOURCE = SPACE
|
1180
|
+
GC0410 MOVE Selection-Char TO S-SOURCE
|
1181
|
+
GC0410 ELSE
|
1182
|
+
GC0410 MOVE ' ' TO S-SOURCE
|
1183
|
+
GC0410 END-IF
|
1184
|
+
GC0410 WHEN COB-SCR-F9
|
1185
|
+
GC0410 IF S-XREF = SPACE
|
1186
|
+
GC0410 MOVE Selection-Char TO S-XREF
|
1187
|
+
GC0410 ELSE
|
1188
|
+
GC0410 MOVE ' ' TO S-XREF
|
1189
|
+
GC0410 END-IF
|
1190
|
+
WHEN COB-SCR-ESC
|
1191
|
+
PERFORM 900-Terminate
|
1192
|
+
GC0310 WHEN CK-S-F1
|
1193
|
+
MOVE SPACES TO S-CfgS
|
1194
|
+
MOVE Selection-Char TO S-Cfg-BS2000
|
1195
|
+
GC0310 WHEN CK-S-F2
|
1196
|
+
MOVE SPACES TO S-CfgS
|
1197
|
+
MOVE Selection-Char TO S-Cfg-COBOL85
|
1198
|
+
GC0310 WHEN CK-S-F3
|
1199
|
+
MOVE SPACES TO S-CfgS
|
1200
|
+
MOVE Selection-Char TO S-Cfg-COBOL2002
|
1201
|
+
GC0310 WHEN CK-S-F4
|
1202
|
+
MOVE SPACES TO S-CfgS
|
1203
|
+
MOVE Selection-Char TO S-Cfg-DEFAULT
|
1204
|
+
GC0310 WHEN CK-S-F5
|
1205
|
+
MOVE SPACES TO S-CfgS
|
1206
|
+
MOVE Selection-Char TO S-Cfg-IBM
|
1207
|
+
GC0310 WHEN CK-S-F6
|
1208
|
+
MOVE SPACES TO S-CfgS
|
1209
|
+
MOVE Selection-Char TO S-Cfg-MF
|
1210
|
+
GC0310 WHEN CK-S-F7
|
1211
|
+
MOVE SPACES TO S-CfgS
|
1212
|
+
MOVE Selection-Char TO S-Cfg-MVS
|
1213
|
+
WHEN OTHER
|
1214
|
+
MOVE 'An unsupported key was pressed'
|
1215
|
+
TO Output-Message
|
1216
|
+
END-EVALUATE
|
1217
|
+
ELSE
|
1218
|
+
SET 88-No-Switch-Changes TO TRUE
|
1219
|
+
END-IF
|
1220
|
+
END-PERFORM
|
1221
|
+
.
|
1222
|
+
|
1223
|
+
209-Done.
|
1224
|
+
EXIT.
|
1225
|
+
/
|
1226
|
+
210-Run-Compiler SECTION.
|
1227
|
+
*****************************************************************
|
1228
|
+
** Run the compiler using the switch settings we've prepared. **
|
1229
|
+
*****************************************************************
|
1230
|
+
|
1231
|
+
211-Init.
|
1232
|
+
MOVE SPACES TO Cmd
|
1233
|
+
Cobc-Cmd
|
1234
|
+
Output-Message
|
1235
|
+
DISPLAY
|
1236
|
+
Switches-Screen
|
1237
|
+
END-DISPLAY
|
1238
|
+
MOVE 1 TO I
|
1239
|
+
EVALUATE TRUE
|
1240
|
+
WHEN S-Cfg-BS2000 NOT = SPACES
|
1241
|
+
MOVE 'bs2000' TO Config-File
|
1242
|
+
WHEN S-Cfg-COBOL85 NOT = SPACES
|
1243
|
+
MOVE 'cobol85' TO Config-File
|
1244
|
+
WHEN S-Cfg-COBOL2002 NOT = SPACES
|
1245
|
+
MOVE 'cobol2002' TO Config-File
|
1246
|
+
WHEN S-Cfg-IBM NOT = SPACES
|
1247
|
+
MOVE 'ibm' TO Config-File
|
1248
|
+
WHEN S-Cfg-MF NOT = SPACES
|
1249
|
+
MOVE 'mf' TO Config-File
|
1250
|
+
WHEN S-Cfg-MVS NOT = SPACES
|
1251
|
+
MOVE 'mvs' TO Config-File
|
1252
|
+
WHEN OTHER
|
1253
|
+
MOVE 'default' TO Config-File
|
1254
|
+
END-EVALUATE
|
1255
|
+
.
|
1256
|
+
|
1257
|
+
212-Build-Compile-Command.
|
1258
|
+
GC0909 MOVE SPACES TO Cobc-Cmd
|
1259
|
+
GC0909 STRING 'cobc -std='
|
1260
|
+
GC0909 TRIM(Config-File,TRAILING)
|
1261
|
+
GC0909 ' '
|
1262
|
+
GC0909 INTO Cobc-Cmd
|
1263
|
+
GC0909 WITH POINTER I
|
1264
|
+
GC0909 END-STRING
|
1265
|
+
IF S-SUBROUTINE NOT = ' '
|
1266
|
+
STRING '-m '
|
1267
|
+
DELIMITED SIZE INTO Cobc-Cmd
|
1268
|
+
WITH POINTER I
|
1269
|
+
END-STRING
|
1270
|
+
ELSE
|
1271
|
+
STRING '-x '
|
1272
|
+
DELIMITED SIZE INTO Cobc-Cmd
|
1273
|
+
WITH POINTER I
|
1274
|
+
END-STRING
|
1275
|
+
END-IF
|
1276
|
+
IF S-DEBUG NOT = ' '
|
1277
|
+
STRING '-fdebugging-line '
|
1278
|
+
DELIMITED SIZE INTO Cobc-Cmd
|
1279
|
+
WITH POINTER I
|
1280
|
+
END-STRING
|
1281
|
+
END-IF
|
1282
|
+
IF S-NOTRUNC NOT = ' '
|
1283
|
+
STRING '-fnotrunc '
|
1284
|
+
DELIMITED SIZE INTO Cobc-Cmd
|
1285
|
+
WITH POINTER I
|
1286
|
+
END-STRING
|
1287
|
+
END-IF
|
1288
|
+
IF S-TRACEALL NOT = ' '
|
1289
|
+
GC0809 STRING '-ftraceall '
|
1290
|
+
DELIMITED SIZE INTO Cobc-Cmd
|
1291
|
+
WITH POINTER I
|
1292
|
+
END-STRING
|
1293
|
+
END-IF
|
1294
|
+
IF S-TRACE NOT = ' '
|
1295
|
+
STRING '-ftrace '
|
1296
|
+
DELIMITED SIZE INTO Cobc-Cmd
|
1297
|
+
WITH POINTER I
|
1298
|
+
END-STRING
|
1299
|
+
END-IF
|
1300
|
+
|
1301
|
+
GC0709 IF S-EXTRA > SPACES
|
1302
|
+
GC0709 STRING ' '
|
1303
|
+
GC0709 TRIM(S-Extra,TRAILING)
|
1304
|
+
GC0709 ' '
|
1305
|
+
GC0709 DELIMITED SIZE INTO Cobc-Cmd
|
1306
|
+
GC0709 WITH POINTER I
|
1307
|
+
GC0709 END-STRING
|
1308
|
+
GC0709 END-IF
|
1309
|
+
GC0909 STRING TRIM(Prog-File-Name,TRAILING)
|
1310
|
+
GC0909 DELIMITED SIZE INTO Cobc-Cmd
|
1311
|
+
GC0909 WITH POINTER I
|
1312
|
+
GC0909 END-STRING
|
1313
|
+
.
|
1314
|
+
|
1315
|
+
213-Run-Compiler.
|
1316
|
+
GC0410 MOVE ' Compiling...' TO Output-Message
|
1317
|
+
GC0410 DISPLAY
|
1318
|
+
GC0410 Switches-Screen
|
1319
|
+
GC0410 END-DISPLAY
|
1320
|
+
GC0609 SET 88-Output-File-Avail TO TRUE
|
1321
|
+
MOVE SPACES TO Cmd
|
1322
|
+
STRING TRIM(Cobc-Cmd,TRAILING)
|
1323
|
+
' 2>'
|
1324
|
+
TRIM(Cobc-Output-File,TRAILING)
|
1325
|
+
DELIMITED SIZE
|
1326
|
+
INTO Cmd
|
1327
|
+
END-STRING
|
1328
|
+
CALL 'SYSTEM'
|
1329
|
+
USING TRIM(Cmd,TRAILING)
|
1330
|
+
END-CALL
|
1331
|
+
GC0909 IF RETURN-CODE = 0
|
1332
|
+
GC0909 SET 88-Compile-OK TO TRUE
|
1333
|
+
GC0909 ELSE
|
1334
|
+
GC0909 SET 88-Compile-Failed TO TRUE
|
1335
|
+
GC0909 END-IF
|
1336
|
+
GC0909 IF 88-Compile-OK
|
1337
|
+
GC0909 OPEN INPUT Cobc-Output
|
1338
|
+
GC0909 READ Cobc-Output
|
1339
|
+
GC0909 AT END
|
1340
|
+
GC0909 CONTINUE
|
1341
|
+
GC0909 NOT AT END
|
1342
|
+
GC0909 SET 88-Compile-OK-Warn TO TRUE
|
1343
|
+
GC0909 END-READ
|
1344
|
+
GC0909 CLOSE Cobc-Output
|
1345
|
+
GC0909 END-IF
|
1346
|
+
GC0909 MOVE SPACES TO Output-Message
|
1347
|
+
IF 88-Compile-OK
|
1348
|
+
GC0909 MOVE ' Compilation Was Successful' TO Output-Message
|
1349
|
+
GC0909 DISPLAY
|
1350
|
+
GC0909 Switches-Screen
|
1351
|
+
GC0909 END-DISPLAY
|
1352
|
+
GC0909 CALL 'C$SLEEP'
|
1353
|
+
GC0909 USING 2
|
1354
|
+
GC0909 END-CALL
|
1355
|
+
GC0909 MOVE SPACES TO Output-Message
|
1356
|
+
GC0609 SET 88-Complete TO TRUE
|
1357
|
+
ELSE
|
1358
|
+
GC0909 DISPLAY
|
1359
|
+
GC0909 Blank-Screen
|
1360
|
+
GC0909 END-DISPLAY
|
1361
|
+
GC0909 IF 88-Compile-OK-Warn
|
1362
|
+
GC0909 DISPLAY ' Compilation was successful, but ' &
|
1363
|
+
GC0909 'warnings were generated:'
|
1364
|
+
SCROLL* AT LINE 24 COLUMN 1
|
1365
|
+
SCROLL* WITH SCROLL UP 1 LINE
|
1366
|
+
GC0909 END-DISPLAY
|
1367
|
+
GC0909 ELSE
|
1368
|
+
GC0909 DISPLAY 'Compilation Failed:'
|
1369
|
+
SCROLL* AT LINE 24 COLUMN 1
|
1370
|
+
SCROLL* WITH SCROLL UP 1 LINE
|
1371
|
+
GC0909 END-DISPLAY
|
1372
|
+
GC0909 END-IF
|
1373
|
+
GC0609 SET 88-Compile-Failed TO TRUE
|
1374
|
+
GC0609 SET 88-Complete TO TRUE
|
1375
|
+
GC0909 DISPLAY ' '
|
1376
|
+
SCROLL* AT LINE 24 COLUMN 1
|
1377
|
+
SCROLL* WITH SCROLL UP 1 LINE
|
1378
|
+
GC0909 END-DISPLAY
|
1379
|
+
GC0909 OPEN INPUT Cobc-Output
|
1380
|
+
GC0909 PERFORM FOREVER
|
1381
|
+
GC0909 READ Cobc-Output AT END
|
1382
|
+
GC0909 EXIT PERFORM
|
1383
|
+
GC0909 END-READ
|
1384
|
+
GC0909 DISPLAY TRIM(Cobc-Output-Rec,TRAILING)
|
1385
|
+
SCROLL* AT LINE 24 COLUMN 1
|
1386
|
+
SCROLL* WITH SCROLL UP 1 LINE
|
1387
|
+
GC0909 END-DISPLAY
|
1388
|
+
GC0909 END-PERFORM
|
1389
|
+
GC0909 CLOSE Cobc-Output
|
1390
|
+
GC0909 DISPLAY ' '
|
1391
|
+
SCROLL* AT LINE 24 COLUMN 1
|
1392
|
+
SCROLL* WITH SCROLL UP 2 LINES
|
1393
|
+
GC0909 END-DISPLAY
|
1394
|
+
GC0909 DISPLAY 'Press ENTER to close:'
|
1395
|
+
SCROLL* AT LINE 24 COLUMN 1
|
1396
|
+
SCROLL* WITH SCROLL UP 1 LINE
|
1397
|
+
GC0909 END-DISPLAY
|
1398
|
+
GC0909 ACCEPT Dummy
|
1399
|
+
GC0909 FROM CONSOLE
|
1400
|
+
GC0909 END-ACCEPT
|
1401
|
+
GC0909 DISPLAY
|
1402
|
+
GC0909 Blank-Screen
|
1403
|
+
GC0909 END-DISPLAY
|
1404
|
+
END-IF
|
1405
|
+
.
|
1406
|
+
|
1407
|
+
219-Done.
|
1408
|
+
IF 88-Compile-Failed
|
1409
|
+
PERFORM 900-Terminate
|
1410
|
+
END-IF
|
1411
|
+
.
|
1412
|
+
/
|
1413
|
+
GC0410 220-Make-Listing SECTION.
|
1414
|
+
GC0410*****************************************************************
|
1415
|
+
GC0410** Generate a source and/or xref listing using XREF **
|
1416
|
+
GC0410*****************************************************************
|
1417
|
+
GC0410
|
1418
|
+
GC0410 221-Init.
|
1419
|
+
GC0410 MOVE ' Generating cross-reference listing...'
|
1420
|
+
GC0410 TO Output-Message
|
1421
|
+
GC0410 DISPLAY
|
1422
|
+
GC0410 Switches-Screen
|
1423
|
+
GC0410 END-DISPLAY
|
1424
|
+
GC0410 CALL "CBL_DELETE_FILE"
|
1425
|
+
GC0410 USING CONCATENATE(TRIM(Prog-Name,Trailing),".lst")
|
1426
|
+
GC0410 END-CALL
|
1427
|
+
GC0410 MOVE 0 TO RETURN-CODE
|
1428
|
+
GC0410 .
|
1429
|
+
GC0410
|
1430
|
+
GC0410 213-Run-OCXref.
|
1431
|
+
GC0410 MOVE SPACES TO Output-Message
|
1432
|
+
GC0410 CALL 'LISTING'
|
1433
|
+
GC0410 USING S-SOURCE
|
1434
|
+
GC0410 S-XREF
|
1435
|
+
GC0410 File-Name
|
1436
|
+
GC0410 ON EXCEPTION
|
1437
|
+
GC0410 MOVE ' LISTING module is not available'
|
1438
|
+
GC0410 TO Output-Message
|
1439
|
+
GC0410 MOVE 1 TO RETURN-CODE
|
1440
|
+
GC0410 END-CALL
|
1441
|
+
GC0410 IF RETURN-CODE = 0
|
1442
|
+
GC0410 MOVE ' Listing generated'
|
1443
|
+
GC0410 TO Output-Message
|
1444
|
+
GC0410 IF OS-Windows OR OS-Cygwin
|
1445
|
+
GC0410 MOVE SPACES TO Cmd
|
1446
|
+
GC0410 STRING
|
1447
|
+
GC0410 'cmd /c '
|
1448
|
+
GC0410 TRIM(Prog-Name,TRAILING)
|
1449
|
+
GC0410 '.lst'
|
1450
|
+
GC0410 DELIMITED SIZE INTO Cmd
|
1451
|
+
GC0410 END-STRING
|
1452
|
+
GC0410 CALL 'SYSTEM'
|
1453
|
+
GC0410 USING TRIM(Cmd,TRAILING)
|
1454
|
+
GC0410 END-CALL
|
1455
|
+
GC0410 END-IF
|
1456
|
+
GC0410 ELSE
|
1457
|
+
GC0410 IF Output-Message = SPACES
|
1458
|
+
GC0410 MOVE ' Listing generation failed'
|
1459
|
+
GC0410 TO Output-Message
|
1460
|
+
GC0410 END-IF
|
1461
|
+
GC0410 END-IF
|
1462
|
+
GC0410 DISPLAY
|
1463
|
+
GC0410 Switches-Screen
|
1464
|
+
GC0410 END-DISPLAY
|
1465
|
+
GC0410 CALL 'C$SLEEP'
|
1466
|
+
GC0410 USING 2
|
1467
|
+
GC0410 END-CALL
|
1468
|
+
GC0410 .
|
1469
|
+
/
|
1470
|
+
230-Run-Program SECTION.
|
1471
|
+
*****************************************************************
|
1472
|
+
** Run the compiled program **
|
1473
|
+
*****************************************************************
|
1474
|
+
|
1475
|
+
232-Build-Command.
|
1476
|
+
GC0909 MOVE SPACES TO Cmd
|
1477
|
+
GC0909 MOVE 1 TO I
|
1478
|
+
IF S-SUBROUTINE NOT = ' '
|
1479
|
+
OR S-DLL NOT = ' '
|
1480
|
+
STRING 'cobcrun ' DELIMITED SIZE
|
1481
|
+
INTO Cmd
|
1482
|
+
WITH POINTER I
|
1483
|
+
END-STRING
|
1484
|
+
END-IF
|
1485
|
+
IF Prog-Folder NOT = SPACES
|
1486
|
+
GC0909 IF OS-Cygwin AND Prog-Folder (2:1) = ':'
|
1487
|
+
GC0909 STRING '/cygdrive/'
|
1488
|
+
GC0909 INTO Cmd
|
1489
|
+
GC0909 WITH POINTER I
|
1490
|
+
GC0909 END-STRING
|
1491
|
+
GC0909 STRING LOWER-CASE(Prog-Folder (1:1))
|
1492
|
+
GC0909 INTO Cmd
|
1493
|
+
GC0909 WITH POINTER I
|
1494
|
+
GC0909 END-STRING
|
1495
|
+
GC0909 PERFORM VARYING J FROM 3 BY 1
|
1496
|
+
GC0909 UNTIL J > LENGTH(TRIM(Prog-Folder))
|
1497
|
+
GC0909 IF Prog-Folder (J:1) = '\'
|
1498
|
+
GC0909 STRING '/'
|
1499
|
+
GC0909 INTO Cmd
|
1500
|
+
GC0909 WITH POINTER I
|
1501
|
+
GC0909 END-STRING
|
1502
|
+
GC0909 ELSE
|
1503
|
+
GC0909 STRING Prog-Folder (J:1)
|
1504
|
+
GC0909 INTO Cmd
|
1505
|
+
GC0909 WITH POINTER I
|
1506
|
+
GC0909 END-STRING
|
1507
|
+
GC0909 END-IF
|
1508
|
+
GC0909 END-PERFORM
|
1509
|
+
GC0909 ELSE
|
1510
|
+
GC0410 STRING '"' TRIM(Prog-Folder,TRAILING)
|
1511
|
+
GC0909 INTO Cmd
|
1512
|
+
GC0909 WITH POINTER I
|
1513
|
+
GC0909 END-STRING
|
1514
|
+
GC0909 END-IF
|
1515
|
+
GC0909 STRING Dir-Char
|
1516
|
+
GC0909 INTO Cmd
|
1517
|
+
GC0909 WITH POINTER I
|
1518
|
+
GC0909 END-STRING
|
1519
|
+
GC0909 ELSE
|
1520
|
+
GC0909 IF OS-Cygwin OR OS-UNIX
|
1521
|
+
GC0909 STRING './'
|
1522
|
+
GC0909 INTO Cmd
|
1523
|
+
GC0909 WITH POINTER I
|
1524
|
+
GC0909 END-STRING
|
1525
|
+
GC0909 END-IF
|
1526
|
+
END-IF
|
1527
|
+
GC0909 STRING TRIM(Prog-Name,TRAILING)
|
1528
|
+
GC0909 INTO Cmd
|
1529
|
+
GC0909 WITH POINTER I
|
1530
|
+
GC0909 END-STRING
|
1531
|
+
GC0909 IF S-SUBROUTINE = ' '
|
1532
|
+
GC0909 AND S-DLL NOT = ' '
|
1533
|
+
GC0909 STRING '.exe' DELIMITED SIZE
|
1534
|
+
INTO Cmd
|
1535
|
+
WITH POINTER I
|
1536
|
+
END-STRING
|
1537
|
+
END-IF
|
1538
|
+
IF S-ARGS NOT = SPACES
|
1539
|
+
GC0809 STRING ' ' TRIM(S-ARGS,TRAILING)
|
1540
|
+
INTO Cmd
|
1541
|
+
WITH POINTER I
|
1542
|
+
END-STRING
|
1543
|
+
END-IF
|
1544
|
+
IF OS-Unknown OR OS-Windows
|
1545
|
+
GC0410 STRING '"&&pause'
|
1546
|
+
INTO Cmd
|
1547
|
+
WITH POINTER I
|
1548
|
+
END-STRING
|
1549
|
+
ELSE
|
1550
|
+
STRING ';echo "Press ENTER to close...";read'
|
1551
|
+
INTO Cmd
|
1552
|
+
WITH POINTER I
|
1553
|
+
END-STRING
|
1554
|
+
END-IF
|
1555
|
+
.
|
1556
|
+
|
1557
|
+
233-Run-Program.
|
1558
|
+
GC0909 DISPLAY
|
1559
|
+
GC0909 Blank-Screen
|
1560
|
+
GC0909 END-DISPLAY
|
1561
|
+
|
1562
|
+
CALL 'SYSTEM'
|
1563
|
+
USING TRIM(Cmd,TRAILING)
|
1564
|
+
END-CALL
|
1565
|
+
PERFORM 900-Terminate
|
1566
|
+
.
|
1567
|
+
|
1568
|
+
239-Done.
|
1569
|
+
EXIT.
|
1570
|
+
/
|
1571
|
+
900-Terminate SECTION.
|
1572
|
+
*****************************************************************
|
1573
|
+
** Display a message and halt the program **
|
1574
|
+
*****************************************************************
|
1575
|
+
|
1576
|
+
901-Display-Message.
|
1577
|
+
GC0909 IF Output-Message > SPACES
|
1578
|
+
GC0909 DISPLAY
|
1579
|
+
GC0909 Switches-Screen
|
1580
|
+
GC0909 END-DISPLAY
|
1581
|
+
GC0909 CALL 'C$SLEEP'
|
1582
|
+
GC0909 USING 2
|
1583
|
+
GC0909 END-CALL
|
1584
|
+
GC0909 END-IF
|
1585
|
+
DISPLAY
|
1586
|
+
Blank-Screen
|
1587
|
+
END-DISPLAY
|
1588
|
+
.
|
1589
|
+
|
1590
|
+
909-Done.
|
1591
|
+
GOBACK
|
1592
|
+
.
|
1593
|
+
|
1594
|
+
END PROGRAM OCic.
|
1595
|
+
|
1596
|
+
IDENTIFICATION DIVISION.
|
1597
|
+
PROGRAM-ID. GETOSTYPE.
|
1598
|
+
*****************************************************************
|
1599
|
+
** This subprogram determine the OS type the program is run- **
|
1600
|
+
** ning under, passing that result back in RETURN-CODE as fol- **
|
1601
|
+
** lows: **
|
1602
|
+
** **
|
1603
|
+
** 0: Cannot be determined **
|
1604
|
+
** 1: Native Windows or Windows/MinGW **
|
1605
|
+
** 2: Cygwin **
|
1606
|
+
** 3: UNIX/Linux/MacOS **
|
1607
|
+
*****************************************************************
|
1608
|
+
** DATE CHANGE DESCRIPTION **
|
1609
|
+
** ====== ==================================================== **
|
1610
|
+
** GC0909 Initial coding. **
|
1611
|
+
*****************************************************************
|
1612
|
+
ENVIRONMENT DIVISION.
|
1613
|
+
CONFIGURATION SECTION.
|
1614
|
+
REPOSITORY.
|
1615
|
+
FUNCTION ALL INTRINSIC.
|
1616
|
+
DATA DIVISION.
|
1617
|
+
WORKING-STORAGE SECTION.
|
1618
|
+
01 Env-Path PIC X(1024).
|
1619
|
+
01 Tally USAGE BINARY-LONG.
|
1620
|
+
PROCEDURE DIVISION.
|
1621
|
+
000-Main SECTION.
|
1622
|
+
010-Get-TEMP-Var.
|
1623
|
+
MOVE SPACES TO Env-Path
|
1624
|
+
ACCEPT Env-Path
|
1625
|
+
FROM ENVIRONMENT "PATH"
|
1626
|
+
ON EXCEPTION
|
1627
|
+
MOVE 0 TO RETURN-CODE
|
1628
|
+
GOBACK
|
1629
|
+
END-ACCEPT
|
1630
|
+
IF Env-Path = SPACES
|
1631
|
+
MOVE 0 TO RETURN-CODE
|
1632
|
+
ELSE
|
1633
|
+
MOVE 0 TO Tally
|
1634
|
+
INSPECT Env-Path
|
1635
|
+
TALLYING Tally FOR ALL ";"
|
1636
|
+
IF Tally = 0 *> Must be some form of UNIX
|
1637
|
+
MOVE 0 TO Tally
|
1638
|
+
INSPECT Env-Path
|
1639
|
+
TALLYING TALLY FOR ALL "/cygdrive/"
|
1640
|
+
IF Tally = 0 *> UNIX/MacOS
|
1641
|
+
MOVE 3 TO RETURN-CODE
|
1642
|
+
ELSE *> Cygwin
|
1643
|
+
MOVE 2 TO RETURN-CODE
|
1644
|
+
END-IF
|
1645
|
+
ELSE *> Assume Windows[/MinGW]
|
1646
|
+
MOVE 1 TO RETURN-CODE
|
1647
|
+
END-IF
|
1648
|
+
END-IF
|
1649
|
+
GOBACK
|
1650
|
+
.
|
1651
|
+
END PROGRAM GETOSTYPE.
|
1652
|
+
|
1653
|
+
IDENTIFICATION DIVISION.
|
1654
|
+
PROGRAM-ID. CHECKSOURCE.
|
1655
|
+
*****************************************************************
|
1656
|
+
** This subprogram will scan a line of source code it is given **
|
1657
|
+
** looking for "LINKAGE SECTION" or "IDENTIFICATION DIVISION". **
|
1658
|
+
** **
|
1659
|
+
** ****NOTE**** ****NOTE**** ****NOTE**** ****NOTE*** **
|
1660
|
+
** **
|
1661
|
+
** These two strings must be found IN THEIR ENTIRETY within **
|
1662
|
+
** the 1st 80 columns of program source records, and cannot **
|
1663
|
+
** follow either a "*>" sequence OR a "*" in col 7. **
|
1664
|
+
*****************************************************************
|
1665
|
+
** DATE CHANGE DESCRIPTION **
|
1666
|
+
** ====== ==================================================== **
|
1667
|
+
** GC0809 Initial coding. **
|
1668
|
+
*****************************************************************
|
1669
|
+
ENVIRONMENT DIVISION.
|
1670
|
+
CONFIGURATION SECTION.
|
1671
|
+
REPOSITORY.
|
1672
|
+
FUNCTION ALL INTRINSIC.
|
1673
|
+
DATA DIVISION.
|
1674
|
+
WORKING-STORAGE SECTION.
|
1675
|
+
01 Compressed-Src.
|
1676
|
+
05 CS-Char OCCURS 80 TIMES PIC X(1).
|
1677
|
+
|
1678
|
+
01 Flags.
|
1679
|
+
05 F-Found-SPACE PIC X(1).
|
1680
|
+
88 88-Skipping-SPACE VALUE 'Y'.
|
1681
|
+
88 88-Not-Skipping-SPACE VALUE 'N'.
|
1682
|
+
|
1683
|
+
01 I USAGE BINARY-CHAR.
|
1684
|
+
|
1685
|
+
01 J USAGE BINARY-CHAR.
|
1686
|
+
LINKAGE SECTION.
|
1687
|
+
01 Argument-1.
|
1688
|
+
02 A1-Char OCCURS 80 TIMES PIC X(1).
|
1689
|
+
|
1690
|
+
01 Argument-2 PIC X(1).
|
1691
|
+
88 88-A2-LINKAGE-SECTION VALUE 'L'.
|
1692
|
+
88 88-A2-IDENTIFICATION-DIVISION VALUE 'I'.
|
1693
|
+
88 88-A2-Nothing-Special VALUE ' '.
|
1694
|
+
PROCEDURE DIVISION USING Argument-1, Argument-2.
|
1695
|
+
000-Main SECTION.
|
1696
|
+
|
1697
|
+
010-Initialize.
|
1698
|
+
SET 88-A2-Nothing-Special TO TRUE
|
1699
|
+
IF A1-Char (7) = '*'
|
1700
|
+
GOBACK
|
1701
|
+
END-IF
|
1702
|
+
.
|
1703
|
+
|
1704
|
+
020-Compress-Multiple-SPACES.
|
1705
|
+
SET 88-Not-Skipping-SPACE TO TRUE
|
1706
|
+
MOVE 0 TO J
|
1707
|
+
MOVE SPACES TO Compressed-Src
|
1708
|
+
PERFORM VARYING I FROM 1 BY 1
|
1709
|
+
UNTIL I > 80
|
1710
|
+
IF A1-Char (I) = SPACE
|
1711
|
+
IF 88-Not-Skipping-SPACE
|
1712
|
+
ADD 1 TO J
|
1713
|
+
MOVE UPPER-CASE(A1-Char (I)) TO CS-Char (J)
|
1714
|
+
SET 88-Skipping-SPACE TO TRUE
|
1715
|
+
END-IF
|
1716
|
+
ELSE
|
1717
|
+
SET 88-Not-Skipping-SPACE TO TRUE
|
1718
|
+
ADD 1 TO J
|
1719
|
+
MOVE A1-Char (I) TO CS-Char (J)
|
1720
|
+
END-IF
|
1721
|
+
END-PERFORM
|
1722
|
+
.
|
1723
|
+
|
1724
|
+
030-Scan-Compressed-Src.
|
1725
|
+
PERFORM VARYING I FROM 1 BY 1
|
1726
|
+
UNTIL I > 66
|
1727
|
+
EVALUATE TRUE
|
1728
|
+
WHEN CS-Char (I) = '*'
|
1729
|
+
IF Compressed-Src (I : 2) = '*>'
|
1730
|
+
GOBACK
|
1731
|
+
END-IF
|
1732
|
+
WHEN (CS-Char (I) = 'L') AND (I < 66)
|
1733
|
+
IF Compressed-Src (I : 15) = 'LINKAGE SECTION'
|
1734
|
+
SET 88-A2-LINKAGE-SECTION TO TRUE
|
1735
|
+
GOBACK
|
1736
|
+
END-IF
|
1737
|
+
WHEN (CS-Char (I) = 'I') AND (I < 58)
|
1738
|
+
IF Compressed-Src (I : 23) = 'IDENTIFICATION ' &
|
1739
|
+
'DIVISION'
|
1740
|
+
SET 88-A2-IDENTIFICATION-DIVISION TO TRUE
|
1741
|
+
GOBACK
|
1742
|
+
END-IF
|
1743
|
+
END-EVALUATE
|
1744
|
+
END-PERFORM
|
1745
|
+
.
|
1746
|
+
|
1747
|
+
099-Never-Found-Either-One.
|
1748
|
+
GOBACK
|
1749
|
+
.
|
1750
|
+
END PROGRAM CHECKSOURCE.
|
1751
|
+
|
1752
|
+
IDENTIFICATION DIVISION.
|
1753
|
+
PROGRAM-ID. LISTING.
|
1754
|
+
*****************************************************************
|
1755
|
+
** This subprogram generates a cross-reference listing of an **
|
1756
|
+
** OpenCOBOL program. **
|
1757
|
+
** **
|
1758
|
+
** Linkage: CALL "LISTING" USING <source> **
|
1759
|
+
** <xref> **
|
1760
|
+
** <filename> **
|
1761
|
+
** **
|
1762
|
+
** Where: **
|
1763
|
+
** <source> is a PIC X(1) flag indicating **
|
1764
|
+
** whether or not a source listing **
|
1765
|
+
** should be produced (space=NO, **
|
1766
|
+
** non-space=yes) **
|
1767
|
+
** <xref> is a PIC X(1) flag indicating **
|
1768
|
+
** whether or not an xref listing **
|
1769
|
+
** should be produced (space=NO, **
|
1770
|
+
** non-space=yes) **
|
1771
|
+
** <filename> is the [path]filename of the **
|
1772
|
+
** program being listed and/or **
|
1773
|
+
** xreffed in a PIC X(256) form. **
|
1774
|
+
*****************************************************************
|
1775
|
+
** **
|
1776
|
+
** AUTHOR: GARY L. CUTLER **
|
1777
|
+
** CutlerGL@gmail.com **
|
1778
|
+
** Copyright (C) 2010, Gary L. Cutler, GPL **
|
1779
|
+
** **
|
1780
|
+
** DATE-WRITTEN: April 1, 2010 **
|
1781
|
+
** **
|
1782
|
+
*****************************************************************
|
1783
|
+
** DATE CHANGE DESCRIPTION **
|
1784
|
+
** ====== ==================================================== **
|
1785
|
+
** GC0410 Initial coding **
|
1786
|
+
** GC0710 Handle duplicate data names (i.e. "CORRESPONDING" or **
|
1787
|
+
** qualified items) better; ignore "END PROGRAM" recs **
|
1788
|
+
** so program name doesn't appear in listing. **
|
1789
|
+
*****************************************************************
|
1790
|
+
ENVIRONMENT DIVISION.
|
1791
|
+
CONFIGURATION SECTION.
|
1792
|
+
REPOSITORY.
|
1793
|
+
FUNCTION ALL INTRINSIC.
|
1794
|
+
INPUT-OUTPUT SECTION.
|
1795
|
+
FILE-CONTROL.
|
1796
|
+
SELECT Expand-Code ASSIGN TO Expanded-Src-Filename
|
1797
|
+
ORGANIZATION IS LINE SEQUENTIAL.
|
1798
|
+
SELECT Report-File ASSIGN TO Report-Filename
|
1799
|
+
ORGANIZATION IS LINE SEQUENTIAL.
|
1800
|
+
SELECT Sort-File ASSIGN TO DISK.
|
1801
|
+
SELECT Source-Code ASSIGN TO Src-Filename
|
1802
|
+
ORGANIZATION IS LINE SEQUENTIAL.
|
1803
|
+
DATA DIVISION.
|
1804
|
+
FILE SECTION.
|
1805
|
+
FD Expand-Code.
|
1806
|
+
01 Expand-Code-Rec.
|
1807
|
+
05 ECR-1 PIC X.
|
1808
|
+
05 ECR-2-256 PIC X(256).
|
1809
|
+
01 Expand-Code-Rec-Alt.
|
1810
|
+
05 ECR-1-128 PIC X(128).
|
1811
|
+
05 ECR-129-256 PIC X(128).
|
1812
|
+
|
1813
|
+
FD Report-File.
|
1814
|
+
01 Report-Rec PIC X(135).
|
1815
|
+
|
1816
|
+
SD Sort-File.
|
1817
|
+
01 Sort-Rec.
|
1818
|
+
05 SR-Prog-ID PIC X(15).
|
1819
|
+
05 SR-Token-UC PIC X(32).
|
1820
|
+
05 SR-Token PIC X(32).
|
1821
|
+
05 SR-Section PIC X(15).
|
1822
|
+
05 SR-Line-No-Def PIC 9(6).
|
1823
|
+
05 SR-Reference.
|
1824
|
+
10 SR-Line-No-Ref PIC 9(6).
|
1825
|
+
10 SR-Ref-Flag PIC X(1).
|
1826
|
+
|
1827
|
+
FD Source-Code.
|
1828
|
+
01 Source-Code-Rec.
|
1829
|
+
GC0410 05 SCR-1-128.
|
1830
|
+
GC0410 10 FILLER PIC X(6).
|
1831
|
+
GC0410 10 SCR-7 PIC X(1).
|
1832
|
+
GC0410 10 FILLER PIC X(121).
|
1833
|
+
05 SCR-129-256 PIC X(128).
|
1834
|
+
|
1835
|
+
WORKING-STORAGE SECTION.
|
1836
|
+
78 Line-Nos-Per-Rec VALUE 8.
|
1837
|
+
|
1838
|
+
01 Cmd PIC X(256).
|
1839
|
+
|
1840
|
+
01 Delim PIC X(2).
|
1841
|
+
|
1842
|
+
01 Detail-Line-S.
|
1843
|
+
05 DLS-Line-No PIC ZZZZZ9.
|
1844
|
+
05 FILLER PIC X(1).
|
1845
|
+
05 DLS-Statement PIC X(128).
|
1846
|
+
|
1847
|
+
01 Detail-Line-X.
|
1848
|
+
05 DLX-Prog-ID PIC X(15).
|
1849
|
+
05 FILLER PIC X(1).
|
1850
|
+
05 DLX-Token PIC X(32).
|
1851
|
+
05 FILLER PIC X(1).
|
1852
|
+
05 DLX-Line-No-Def PIC ZZZZZ9.
|
1853
|
+
05 FILLER PIC X(1).
|
1854
|
+
05 DLX-Section PIC X(15).
|
1855
|
+
05 FILLER PIC X(1).
|
1856
|
+
05 DLX-Reference OCCURS Line-Nos-Per-Rec TIMES.
|
1857
|
+
10 DLX-Line-No-Ref PIC ZZZZZ9.
|
1858
|
+
10 DLX-Ref-Flag PIC X(1).
|
1859
|
+
10 FILLER PIC X(1).
|
1860
|
+
|
1861
|
+
01 Dummy PIC X(1).
|
1862
|
+
|
1863
|
+
01 Env-TEMP PIC X(256).
|
1864
|
+
|
1865
|
+
01 Expanded-Src-Filename PIC X(256).
|
1866
|
+
|
1867
|
+
01 Filename PIC X(256).
|
1868
|
+
|
1869
|
+
01 Flags.
|
1870
|
+
GC0710 05 F-Duplicate PIC X(1).
|
1871
|
+
05 F-First-Record PIC X(1).
|
1872
|
+
05 F-In-Which-Pgm PIC X(1).
|
1873
|
+
88 In-Main-Module VALUE 'M'.
|
1874
|
+
88 In-Copybook VALUE 'C'.
|
1875
|
+
05 F-Last-Token-Ended-Sent PIC X(1).
|
1876
|
+
05 F-Processing-PICTURE PIC X(1).
|
1877
|
+
05 F-Token-Ended-Sentence PIC X(1).
|
1878
|
+
GC0710 05 F-Verb-Has-Been-Found PIC X(1).
|
1879
|
+
|
1880
|
+
01 Group-Indicators.
|
1881
|
+
05 GI-Prog-ID PIC X(15).
|
1882
|
+
05 GI-Token PIC X(32).
|
1883
|
+
|
1884
|
+
01 Heading-1S.
|
1885
|
+
05 FILLER PIC X(125) VALUE
|
1886
|
+
"OpenCOBOL 1.1 06FEB2009 Source Listing - " &
|
1887
|
+
"OCic Copyright (C) 2009-2010, Gary L. Cutler, GPL".
|
1888
|
+
05 H1S-Date PIC 9999/99/99.
|
1889
|
+
|
1890
|
+
01 Heading-1X.
|
1891
|
+
05 FILLER PIC X(125) VALUE
|
1892
|
+
"OpenCOBOL 1.1 06FEB2009 Cross-Reference Listing - " &
|
1893
|
+
"OCic Copyright (C) 2009-2010, Gary L. Cutler, GPL".
|
1894
|
+
05 H1X-Date PIC 9999/99/99.
|
1895
|
+
|
1896
|
+
01 Heading-2 PIC X(135).
|
1897
|
+
|
1898
|
+
01 Heading-4S PIC X(16) VALUE
|
1899
|
+
"Line Statement".
|
1900
|
+
|
1901
|
+
01 Heading-4X PIC X(96) VALUE
|
1902
|
+
"PROGRAM-ID Identifier/Register/Function Defn Wher
|
1903
|
+
- "e Defined References (* = Updated)".
|
1904
|
+
|
1905
|
+
01 Heading-5S PIC X(135) VALUE
|
1906
|
+
"====== =====================================================
|
1907
|
+
- "============================================================
|
1908
|
+
- "===============".
|
1909
|
+
|
1910
|
+
01 Heading-5X PIC X(135) VALUE
|
1911
|
+
"=============== ================================ ====== ====
|
1912
|
+
- "=========== ================================================
|
1913
|
+
- "===============".
|
1914
|
+
|
1915
|
+
01 Held-Reference PIC X(100).
|
1916
|
+
|
1917
|
+
01 I USAGE BINARY-LONG.
|
1918
|
+
|
1919
|
+
01 J USAGE BINARY-LONG.
|
1920
|
+
|
1921
|
+
01 Lines-Left USAGE BINARY-LONG.
|
1922
|
+
|
1923
|
+
01 Lines-Per-Page USAGE BINARY-LONG.
|
1924
|
+
|
1925
|
+
01 Lines-Per-Page-ENV PIC X(256).
|
1926
|
+
|
1927
|
+
01 Num-UserNames USAGE BINARY-LONG.
|
1928
|
+
|
1929
|
+
01 PIC-X10 PIC X(10).
|
1930
|
+
|
1931
|
+
01 PIC-X32 PIC X(32).
|
1932
|
+
|
1933
|
+
01 PIC-X256 PIC X(256).
|
1934
|
+
|
1935
|
+
01 Program-Path PIC X(256).
|
1936
|
+
|
1937
|
+
01 Report-Filename PIC X(256).
|
1938
|
+
|
1939
|
+
01 Reserved-Words.
|
1940
|
+
05 FILLER PIC X(33) VALUE "IABS".
|
1941
|
+
05 FILLER PIC X(33) VALUE "VACCEPT".
|
1942
|
+
05 FILLER PIC X(33) VALUE " ACCESS".
|
1943
|
+
05 FILLER PIC X(33) VALUE "IACOS".
|
1944
|
+
05 FILLER PIC X(33) VALUE " ACTIVE-CLASS".
|
1945
|
+
05 FILLER PIC X(33) VALUE "VADD".
|
1946
|
+
05 FILLER PIC X(33) VALUE " ADDRESS".
|
1947
|
+
05 FILLER PIC X(33) VALUE " ADVANCING".
|
1948
|
+
05 FILLER PIC X(33) VALUE "KAFTER".
|
1949
|
+
05 FILLER PIC X(33) VALUE " ALIGNED".
|
1950
|
+
05 FILLER PIC X(33) VALUE " ALL".
|
1951
|
+
05 FILLER PIC X(33) VALUE "VALLOCATE".
|
1952
|
+
05 FILLER PIC X(33) VALUE " ALPHABET".
|
1953
|
+
05 FILLER PIC X(33) VALUE " ALPHABETIC".
|
1954
|
+
05 FILLER PIC X(33) VALUE " ALPHABETIC-LOWER".
|
1955
|
+
05 FILLER PIC X(33) VALUE " ALPHABETIC-UPPER".
|
1956
|
+
05 FILLER PIC X(33) VALUE " ALPHANUMERIC".
|
1957
|
+
05 FILLER PIC X(33) VALUE " ALPHANUMERIC-EDITED".
|
1958
|
+
05 FILLER PIC X(33) VALUE " ALSO".
|
1959
|
+
05 FILLER PIC X(33) VALUE "VALTER".
|
1960
|
+
05 FILLER PIC X(33) VALUE " ALTERNATE".
|
1961
|
+
05 FILLER PIC X(33) VALUE " AND".
|
1962
|
+
05 FILLER PIC X(33) VALUE "IANNUITY".
|
1963
|
+
05 FILLER PIC X(33) VALUE " ANY".
|
1964
|
+
05 FILLER PIC X(33) VALUE " ANYCASE".
|
1965
|
+
05 FILLER PIC X(33) VALUE " ARE".
|
1966
|
+
05 FILLER PIC X(33) VALUE " AREA".
|
1967
|
+
05 FILLER PIC X(33) VALUE " AREAS".
|
1968
|
+
05 FILLER PIC X(33) VALUE " ARGUMENT-NUMBER".
|
1969
|
+
05 FILLER PIC X(33) VALUE " ARGUMENT-VALUE".
|
1970
|
+
05 FILLER PIC X(33) VALUE " AS".
|
1971
|
+
05 FILLER PIC X(33) VALUE " ASCENDING".
|
1972
|
+
05 FILLER PIC X(33) VALUE "IASIN".
|
1973
|
+
05 FILLER PIC X(33) VALUE " ASSIGN".
|
1974
|
+
05 FILLER PIC X(33) VALUE " AT".
|
1975
|
+
05 FILLER PIC X(33) VALUE "IATAN".
|
1976
|
+
05 FILLER PIC X(33) VALUE " AUTHOR".
|
1977
|
+
05 FILLER PIC X(33) VALUE " AUTO".
|
1978
|
+
05 FILLER PIC X(33) VALUE " AUTO-SKIP".
|
1979
|
+
05 FILLER PIC X(33) VALUE " AUTOMATIC".
|
1980
|
+
05 FILLER PIC X(33) VALUE " AUTOTERMINATE".
|
1981
|
+
05 FILLER PIC X(33) VALUE " BACKGROUND-COLOR".
|
1982
|
+
05 FILLER PIC X(33) VALUE " BASED".
|
1983
|
+
05 FILLER PIC X(33) VALUE " BEEP".
|
1984
|
+
05 FILLER PIC X(33) VALUE " BEFORE".
|
1985
|
+
05 FILLER PIC X(33) VALUE " BELL".
|
1986
|
+
05 FILLER PIC X(33) VALUE " BINARY".
|
1987
|
+
05 FILLER PIC X(33) VALUE " BINARY-C-LONG".
|
1988
|
+
05 FILLER PIC X(33) VALUE " BINARY-CHAR".
|
1989
|
+
05 FILLER PIC X(33) VALUE " BINARY-DOUBLE".
|
1990
|
+
05 FILLER PIC X(33) VALUE " BINARY-LONG".
|
1991
|
+
05 FILLER PIC X(33) VALUE " BINARY-SHORT".
|
1992
|
+
05 FILLER PIC X(33) VALUE " BIT".
|
1993
|
+
05 FILLER PIC X(33) VALUE " BLANK".
|
1994
|
+
05 FILLER PIC X(33) VALUE " BLINK".
|
1995
|
+
05 FILLER PIC X(33) VALUE " BLOCK".
|
1996
|
+
05 FILLER PIC X(33) VALUE " BOOLEAN".
|
1997
|
+
05 FILLER PIC X(33) VALUE " BOTTOM".
|
1998
|
+
05 FILLER PIC X(33) VALUE "YBY".
|
1999
|
+
05 FILLER PIC X(33) VALUE "IBYTE-LENGTH".
|
2000
|
+
05 FILLER PIC X(33) VALUE "MC01".
|
2001
|
+
05 FILLER PIC X(33) VALUE "MC02".
|
2002
|
+
05 FILLER PIC X(33) VALUE "MC03".
|
2003
|
+
05 FILLER PIC X(33) VALUE "MC04".
|
2004
|
+
05 FILLER PIC X(33) VALUE "MC05".
|
2005
|
+
05 FILLER PIC X(33) VALUE "MC06".
|
2006
|
+
05 FILLER PIC X(33) VALUE "MC07".
|
2007
|
+
05 FILLER PIC X(33) VALUE "MC08".
|
2008
|
+
05 FILLER PIC X(33) VALUE "MC09".
|
2009
|
+
05 FILLER PIC X(33) VALUE "MC10".
|
2010
|
+
05 FILLER PIC X(33) VALUE "MC11".
|
2011
|
+
05 FILLER PIC X(33) VALUE "MC12".
|
2012
|
+
05 FILLER PIC X(33) VALUE "VCALL".
|
2013
|
+
05 FILLER PIC X(33) VALUE "VCANCEL".
|
2014
|
+
05 FILLER PIC X(33) VALUE " CF".
|
2015
|
+
05 FILLER PIC X(33) VALUE " CH".
|
2016
|
+
05 FILLER PIC X(33) VALUE " CHAINING".
|
2017
|
+
05 FILLER PIC X(33) VALUE "ICHAR".
|
2018
|
+
05 FILLER PIC X(33) VALUE " CHARACTER".
|
2019
|
+
05 FILLER PIC X(33) VALUE " CHARACTERS".
|
2020
|
+
05 FILLER PIC X(33) VALUE " CLASS".
|
2021
|
+
05 FILLER PIC X(33) VALUE " CLASS-ID".
|
2022
|
+
05 FILLER PIC X(33) VALUE "VCLOSE".
|
2023
|
+
05 FILLER PIC X(33) VALUE "ICOB-CRT-STATUS".
|
2024
|
+
05 FILLER PIC X(33) VALUE " CODE".
|
2025
|
+
05 FILLER PIC X(33) VALUE " CODE-SET".
|
2026
|
+
05 FILLER PIC X(33) VALUE " COL".
|
2027
|
+
05 FILLER PIC X(33) VALUE " COLLATING".
|
2028
|
+
05 FILLER PIC X(33) VALUE " COLS".
|
2029
|
+
05 FILLER PIC X(33) VALUE " COLUMN".
|
2030
|
+
05 FILLER PIC X(33) VALUE " COLUMNS".
|
2031
|
+
05 FILLER PIC X(33) VALUE "ICOMBINED-DATETIME".
|
2032
|
+
05 FILLER PIC X(33) VALUE " COMMA".
|
2033
|
+
05 FILLER PIC X(33) VALUE " COMMAND-LINE".
|
2034
|
+
05 FILLER PIC X(33) VALUE "VCOMMIT".
|
2035
|
+
05 FILLER PIC X(33) VALUE " COMMON".
|
2036
|
+
05 FILLER PIC X(33) VALUE " COMP".
|
2037
|
+
05 FILLER PIC X(33) VALUE " COMP-1".
|
2038
|
+
05 FILLER PIC X(33) VALUE " COMP-2".
|
2039
|
+
05 FILLER PIC X(33) VALUE " COMP-3".
|
2040
|
+
05 FILLER PIC X(33) VALUE " COMP-4".
|
2041
|
+
05 FILLER PIC X(33) VALUE " COMP-5".
|
2042
|
+
05 FILLER PIC X(33) VALUE " COMP-X".
|
2043
|
+
05 FILLER PIC X(33) VALUE " COMPUTATIONAL".
|
2044
|
+
05 FILLER PIC X(33) VALUE " COMPUTATIONAL-1".
|
2045
|
+
05 FILLER PIC X(33) VALUE " COMPUTATIONAL-2".
|
2046
|
+
05 FILLER PIC X(33) VALUE " COMPUTATIONAL-3".
|
2047
|
+
05 FILLER PIC X(33) VALUE " COMPUTATIONAL-4".
|
2048
|
+
05 FILLER PIC X(33) VALUE " COMPUTATIONAL-5".
|
2049
|
+
05 FILLER PIC X(33) VALUE " COMPUTATIONAL-X".
|
2050
|
+
05 FILLER PIC X(33) VALUE "VCOMPUTE".
|
2051
|
+
05 FILLER PIC X(33) VALUE "ICONCATENATE".
|
2052
|
+
05 FILLER PIC X(33) VALUE " CONDITION".
|
2053
|
+
05 FILLER PIC X(33) VALUE "KCONFIGURATION".
|
2054
|
+
05 FILLER PIC X(33) VALUE "MCONSOLE".
|
2055
|
+
05 FILLER PIC X(33) VALUE " CONSTANT".
|
2056
|
+
05 FILLER PIC X(33) VALUE " CONTAINS".
|
2057
|
+
05 FILLER PIC X(33) VALUE " CONTENT".
|
2058
|
+
05 FILLER PIC X(33) VALUE "VCONTINUE".
|
2059
|
+
05 FILLER PIC X(33) VALUE " CONTROL".
|
2060
|
+
05 FILLER PIC X(33) VALUE " CONTROLS".
|
2061
|
+
05 FILLER PIC X(33) VALUE "KCONVERTING".
|
2062
|
+
05 FILLER PIC X(33) VALUE " COPY".
|
2063
|
+
05 FILLER PIC X(33) VALUE " CORR".
|
2064
|
+
05 FILLER PIC X(33) VALUE " CORRESPONDING".
|
2065
|
+
05 FILLER PIC X(33) VALUE "ICOS".
|
2066
|
+
05 FILLER PIC X(33) VALUE "KCOUNT".
|
2067
|
+
05 FILLER PIC X(33) VALUE " CRT".
|
2068
|
+
05 FILLER PIC X(33) VALUE " CURRENCY".
|
2069
|
+
05 FILLER PIC X(33) VALUE "ICURRENT-DATE".
|
2070
|
+
05 FILLER PIC X(33) VALUE " CURSOR".
|
2071
|
+
05 FILLER PIC X(33) VALUE " CYCLE".
|
2072
|
+
05 FILLER PIC X(33) VALUE "KDATA".
|
2073
|
+
05 FILLER PIC X(33) VALUE " DATA-POINTER".
|
2074
|
+
05 FILLER PIC X(33) VALUE " DATE".
|
2075
|
+
05 FILLER PIC X(33) VALUE " DATE-COMPILED".
|
2076
|
+
05 FILLER PIC X(33) VALUE " DATE-MODIFIED".
|
2077
|
+
05 FILLER PIC X(33) VALUE "IDATE-OF-INTEGER".
|
2078
|
+
05 FILLER PIC X(33) VALUE "IDATE-TO-YYYYMMDD".
|
2079
|
+
05 FILLER PIC X(33) VALUE " DATE-WRITTEN".
|
2080
|
+
05 FILLER PIC X(33) VALUE " DAY".
|
2081
|
+
05 FILLER PIC X(33) VALUE "IDAY-OF-INTEGER".
|
2082
|
+
05 FILLER PIC X(33) VALUE " DAY-OF-WEEK".
|
2083
|
+
05 FILLER PIC X(33) VALUE "IDAY-TO-YYYYDDD".
|
2084
|
+
05 FILLER PIC X(33) VALUE " DE".
|
2085
|
+
05 FILLER PIC X(33) VALUE " DEBUGGING".
|
2086
|
+
05 FILLER PIC X(33) VALUE " DECIMAL-POINT".
|
2087
|
+
05 FILLER PIC X(33) VALUE " DECLARATIVES".
|
2088
|
+
05 FILLER PIC X(33) VALUE " DEFAULT".
|
2089
|
+
05 FILLER PIC X(33) VALUE "VDELETE".
|
2090
|
+
05 FILLER PIC X(33) VALUE " DELIMITED".
|
2091
|
+
05 FILLER PIC X(33) VALUE "KDELIMITER".
|
2092
|
+
05 FILLER PIC X(33) VALUE " DEPENDING".
|
2093
|
+
05 FILLER PIC X(33) VALUE " DESCENDING".
|
2094
|
+
05 FILLER PIC X(33) VALUE " DESTINATION".
|
2095
|
+
05 FILLER PIC X(33) VALUE " DETAIL".
|
2096
|
+
05 FILLER PIC X(33) VALUE " DISABLE".
|
2097
|
+
05 FILLER PIC X(33) VALUE " DISK".
|
2098
|
+
05 FILLER PIC X(33) VALUE "VDISPLAY".
|
2099
|
+
05 FILLER PIC X(33) VALUE "VDIVIDE".
|
2100
|
+
05 FILLER PIC X(33) VALUE "KDIVISION".
|
2101
|
+
05 FILLER PIC X(33) VALUE "KDOWN".
|
2102
|
+
05 FILLER PIC X(33) VALUE " DUPLICATES".
|
2103
|
+
05 FILLER PIC X(33) VALUE " DYNAMIC".
|
2104
|
+
05 FILLER PIC X(33) VALUE "IE".
|
2105
|
+
05 FILLER PIC X(33) VALUE " EBCDIC".
|
2106
|
+
05 FILLER PIC X(33) VALUE " EC".
|
2107
|
+
05 FILLER PIC X(33) VALUE "VELSE".
|
2108
|
+
GC0710 05 FILLER PIC X(33) VALUE "KEND".
|
2109
|
+
05 FILLER PIC X(33) VALUE " END-ACCEPT".
|
2110
|
+
05 FILLER PIC X(33) VALUE " END-ADD".
|
2111
|
+
05 FILLER PIC X(33) VALUE " END-CALL".
|
2112
|
+
05 FILLER PIC X(33) VALUE " END-COMPUTE".
|
2113
|
+
05 FILLER PIC X(33) VALUE " END-DELETE".
|
2114
|
+
05 FILLER PIC X(33) VALUE " END-DISPLAY".
|
2115
|
+
05 FILLER PIC X(33) VALUE " END-DIVIDE".
|
2116
|
+
05 FILLER PIC X(33) VALUE " END-EVALUATE".
|
2117
|
+
05 FILLER PIC X(33) VALUE " END-IF".
|
2118
|
+
05 FILLER PIC X(33) VALUE " END-MULTIPLY".
|
2119
|
+
05 FILLER PIC X(33) VALUE " END-OF-PAGE".
|
2120
|
+
05 FILLER PIC X(33) VALUE " END-PERFORM".
|
2121
|
+
05 FILLER PIC X(33) VALUE " END-READ".
|
2122
|
+
05 FILLER PIC X(33) VALUE " END-RETURN".
|
2123
|
+
05 FILLER PIC X(33) VALUE " END-REWRITE".
|
2124
|
+
05 FILLER PIC X(33) VALUE " END-SEARCH".
|
2125
|
+
05 FILLER PIC X(33) VALUE " END-START".
|
2126
|
+
05 FILLER PIC X(33) VALUE " END-STRING".
|
2127
|
+
05 FILLER PIC X(33) VALUE " END-SUBTRACT".
|
2128
|
+
05 FILLER PIC X(33) VALUE " END-UNSTRING".
|
2129
|
+
05 FILLER PIC X(33) VALUE " END-WRITE".
|
2130
|
+
05 FILLER PIC X(33) VALUE "VENTRY".
|
2131
|
+
05 FILLER PIC X(33) VALUE "KENVIRONMENT".
|
2132
|
+
05 FILLER PIC X(33) VALUE " ENVIRONMENT-NAME".
|
2133
|
+
05 FILLER PIC X(33) VALUE " ENVIRONMENT-VALUE".
|
2134
|
+
05 FILLER PIC X(33) VALUE " EO".
|
2135
|
+
05 FILLER PIC X(33) VALUE " EOL".
|
2136
|
+
05 FILLER PIC X(33) VALUE " EOP".
|
2137
|
+
05 FILLER PIC X(33) VALUE " EOS".
|
2138
|
+
05 FILLER PIC X(33) VALUE " EQUAL".
|
2139
|
+
05 FILLER PIC X(33) VALUE "KEQUALS".
|
2140
|
+
05 FILLER PIC X(33) VALUE " ERASE".
|
2141
|
+
05 FILLER PIC X(33) VALUE " ERROR".
|
2142
|
+
05 FILLER PIC X(33) VALUE " ESCAPE".
|
2143
|
+
05 FILLER PIC X(33) VALUE "VEVALUATE".
|
2144
|
+
05 FILLER PIC X(33) VALUE " EXCEPTION".
|
2145
|
+
05 FILLER PIC X(33) VALUE "IEXCEPTION-FILE".
|
2146
|
+
05 FILLER PIC X(33) VALUE "IEXCEPTION-LOCATION".
|
2147
|
+
05 FILLER PIC X(33) VALUE " EXCEPTION-OBJECT".
|
2148
|
+
05 FILLER PIC X(33) VALUE "IEXCEPTION-STATEMENT".
|
2149
|
+
05 FILLER PIC X(33) VALUE "IEXCEPTION-STATUS".
|
2150
|
+
05 FILLER PIC X(33) VALUE " EXCLUSIVE".
|
2151
|
+
05 FILLER PIC X(33) VALUE "VEXIT".
|
2152
|
+
05 FILLER PIC X(33) VALUE "IEXP".
|
2153
|
+
05 FILLER PIC X(33) VALUE "IEXP10".
|
2154
|
+
05 FILLER PIC X(33) VALUE " EXTEND".
|
2155
|
+
05 FILLER PIC X(33) VALUE " EXTERNAL".
|
2156
|
+
05 FILLER PIC X(33) VALUE "IFACTORIAL".
|
2157
|
+
05 FILLER PIC X(33) VALUE " FACTORY".
|
2158
|
+
05 FILLER PIC X(33) VALUE " FALSE".
|
2159
|
+
05 FILLER PIC X(33) VALUE "KFD".
|
2160
|
+
05 FILLER PIC X(33) VALUE "KFILE".
|
2161
|
+
05 FILLER PIC X(33) VALUE " FILE-CONTROL".
|
2162
|
+
05 FILLER PIC X(33) VALUE " FILE-ID".
|
2163
|
+
05 FILLER PIC X(33) VALUE " FILLER".
|
2164
|
+
05 FILLER PIC X(33) VALUE " FINAL".
|
2165
|
+
05 FILLER PIC X(33) VALUE " FIRST".
|
2166
|
+
05 FILLER PIC X(33) VALUE " FLOAT-BINARY-16".
|
2167
|
+
05 FILLER PIC X(33) VALUE " FLOAT-BINARY-34".
|
2168
|
+
05 FILLER PIC X(33) VALUE " FLOAT-BINARY-7".
|
2169
|
+
05 FILLER PIC X(33) VALUE " FLOAT-DECIMAL-16".
|
2170
|
+
05 FILLER PIC X(33) VALUE " FLOAT-DECIMAL-34".
|
2171
|
+
05 FILLER PIC X(33) VALUE " FLOAT-EXTENDED".
|
2172
|
+
05 FILLER PIC X(33) VALUE " FLOAT-LONG".
|
2173
|
+
05 FILLER PIC X(33) VALUE " FLOAT-SHORT".
|
2174
|
+
05 FILLER PIC X(33) VALUE " FOOTING".
|
2175
|
+
05 FILLER PIC X(33) VALUE " FOR".
|
2176
|
+
05 FILLER PIC X(33) VALUE " FOREGROUND-COLOR".
|
2177
|
+
05 FILLER PIC X(33) VALUE " FOREVER".
|
2178
|
+
05 FILLER PIC X(33) VALUE " FORMAT".
|
2179
|
+
05 FILLER PIC X(33) VALUE "MFORMFEED".
|
2180
|
+
05 FILLER PIC X(33) VALUE "IFRACTION-PART".
|
2181
|
+
05 FILLER PIC X(33) VALUE "VFREE".
|
2182
|
+
05 FILLER PIC X(33) VALUE " FROM".
|
2183
|
+
05 FILLER PIC X(33) VALUE " FULL".
|
2184
|
+
05 FILLER PIC X(33) VALUE " FUNCTION".
|
2185
|
+
05 FILLER PIC X(33) VALUE " FUNCTION-ID".
|
2186
|
+
05 FILLER PIC X(33) VALUE " FUNCTION-POINTER".
|
2187
|
+
05 FILLER PIC X(33) VALUE "VGENERATE".
|
2188
|
+
05 FILLER PIC X(33) VALUE " GET".
|
2189
|
+
05 FILLER PIC X(33) VALUE "KGIVING".
|
2190
|
+
05 FILLER PIC X(33) VALUE " GLOBAL".
|
2191
|
+
05 FILLER PIC X(33) VALUE "VGO".
|
2192
|
+
05 FILLER PIC X(33) VALUE "VGOBACK".
|
2193
|
+
05 FILLER PIC X(33) VALUE " GREATER".
|
2194
|
+
05 FILLER PIC X(33) VALUE " GROUP".
|
2195
|
+
05 FILLER PIC X(33) VALUE " GROUP-USAGE".
|
2196
|
+
05 FILLER PIC X(33) VALUE " HEADING".
|
2197
|
+
05 FILLER PIC X(33) VALUE " HIGH-VALUE".
|
2198
|
+
05 FILLER PIC X(33) VALUE " HIGH-VALUES".
|
2199
|
+
05 FILLER PIC X(33) VALUE " HIGHLIGHT".
|
2200
|
+
05 FILLER PIC X(33) VALUE " I-O".
|
2201
|
+
05 FILLER PIC X(33) VALUE " I-O-CONTROL".
|
2202
|
+
05 FILLER PIC X(33) VALUE "KID".
|
2203
|
+
05 FILLER PIC X(33) VALUE "KIDENTIFICATION".
|
2204
|
+
05 FILLER PIC X(33) VALUE "VIF".
|
2205
|
+
05 FILLER PIC X(33) VALUE " IGNORE".
|
2206
|
+
05 FILLER PIC X(33) VALUE " IGNORING".
|
2207
|
+
05 FILLER PIC X(33) VALUE " IN".
|
2208
|
+
05 FILLER PIC X(33) VALUE " INDEX".
|
2209
|
+
05 FILLER PIC X(33) VALUE "KINDEXED".
|
2210
|
+
05 FILLER PIC X(33) VALUE " INDICATE".
|
2211
|
+
05 FILLER PIC X(33) VALUE " INFINITY".
|
2212
|
+
05 FILLER PIC X(33) VALUE " INHERITS".
|
2213
|
+
05 FILLER PIC X(33) VALUE " INITIAL".
|
2214
|
+
05 FILLER PIC X(33) VALUE " INITIALISED".
|
2215
|
+
05 FILLER PIC X(33) VALUE "VINITIALIZE".
|
2216
|
+
05 FILLER PIC X(33) VALUE " INITIALIZED".
|
2217
|
+
05 FILLER PIC X(33) VALUE "VINITIATE".
|
2218
|
+
05 FILLER PIC X(33) VALUE " INPUT".
|
2219
|
+
05 FILLER PIC X(33) VALUE "KINPUT-OUTPUT".
|
2220
|
+
05 FILLER PIC X(33) VALUE "VINSPECT".
|
2221
|
+
05 FILLER PIC X(33) VALUE " INSTALLATION".
|
2222
|
+
05 FILLER PIC X(33) VALUE "IINTEGER".
|
2223
|
+
05 FILLER PIC X(33) VALUE "IINTEGER-OF-DATE".
|
2224
|
+
05 FILLER PIC X(33) VALUE "IINTEGER-OF-DAY".
|
2225
|
+
05 FILLER PIC X(33) VALUE "IINTEGER-PART".
|
2226
|
+
05 FILLER PIC X(33) VALUE " INTERFACE".
|
2227
|
+
05 FILLER PIC X(33) VALUE " INTERFACE-ID".
|
2228
|
+
05 FILLER PIC X(33) VALUE "KINTO".
|
2229
|
+
05 FILLER PIC X(33) VALUE " INTRINSIC".
|
2230
|
+
05 FILLER PIC X(33) VALUE " INVALID".
|
2231
|
+
05 FILLER PIC X(33) VALUE " INVOKE".
|
2232
|
+
05 FILLER PIC X(33) VALUE " IS".
|
2233
|
+
05 FILLER PIC X(33) VALUE " JUST".
|
2234
|
+
05 FILLER PIC X(33) VALUE " JUSTIFIED".
|
2235
|
+
05 FILLER PIC X(33) VALUE " KEY".
|
2236
|
+
05 FILLER PIC X(33) VALUE " LABEL".
|
2237
|
+
05 FILLER PIC X(33) VALUE " LAST".
|
2238
|
+
05 FILLER PIC X(33) VALUE " LEADING".
|
2239
|
+
05 FILLER PIC X(33) VALUE " LEFT".
|
2240
|
+
05 FILLER PIC X(33) VALUE " LEFT-JUSTIFY".
|
2241
|
+
05 FILLER PIC X(33) VALUE "ILENGTH".
|
2242
|
+
05 FILLER PIC X(33) VALUE " LESS".
|
2243
|
+
05 FILLER PIC X(33) VALUE " LIMIT".
|
2244
|
+
05 FILLER PIC X(33) VALUE " LIMITS".
|
2245
|
+
05 FILLER PIC X(33) VALUE " LINAGE".
|
2246
|
+
05 FILLER PIC X(33) VALUE "ILINAGE-COUNTER".
|
2247
|
+
05 FILLER PIC X(33) VALUE " LINE".
|
2248
|
+
05 FILLER PIC X(33) VALUE " LINE-COUNTER".
|
2249
|
+
05 FILLER PIC X(33) VALUE " LINES".
|
2250
|
+
05 FILLER PIC X(33) VALUE "KLINKAGE".
|
2251
|
+
05 FILLER PIC X(33) VALUE "KLOCAL-STORAGE".
|
2252
|
+
05 FILLER PIC X(33) VALUE " LOCALE".
|
2253
|
+
05 FILLER PIC X(33) VALUE "ILOCALE-DATE".
|
2254
|
+
05 FILLER PIC X(33) VALUE "ILOCALE-TIME".
|
2255
|
+
05 FILLER PIC X(33) VALUE "ILOCALE-TIME-FROM-SECONDS".
|
2256
|
+
05 FILLER PIC X(33) VALUE " LOCK".
|
2257
|
+
05 FILLER PIC X(33) VALUE "ILOG".
|
2258
|
+
05 FILLER PIC X(33) VALUE "ILOG10".
|
2259
|
+
05 FILLER PIC X(33) VALUE " LOW-VALUE".
|
2260
|
+
05 FILLER PIC X(33) VALUE " LOW-VALUES".
|
2261
|
+
05 FILLER PIC X(33) VALUE " LOWER".
|
2262
|
+
05 FILLER PIC X(33) VALUE "ILOWER-CASE".
|
2263
|
+
05 FILLER PIC X(33) VALUE " LOWLIGHT".
|
2264
|
+
05 FILLER PIC X(33) VALUE " MANUAL".
|
2265
|
+
05 FILLER PIC X(33) VALUE "IMAX".
|
2266
|
+
05 FILLER PIC X(33) VALUE "IMEAN".
|
2267
|
+
05 FILLER PIC X(33) VALUE "IMEDIAN".
|
2268
|
+
05 FILLER PIC X(33) VALUE " MEMORY".
|
2269
|
+
05 FILLER PIC X(33) VALUE "VMERGE".
|
2270
|
+
05 FILLER PIC X(33) VALUE " METHOD".
|
2271
|
+
05 FILLER PIC X(33) VALUE " METHOD-ID".
|
2272
|
+
05 FILLER PIC X(33) VALUE "IMIDRANGE".
|
2273
|
+
05 FILLER PIC X(33) VALUE "IMIN".
|
2274
|
+
05 FILLER PIC X(33) VALUE " MINUS".
|
2275
|
+
05 FILLER PIC X(33) VALUE "IMOD".
|
2276
|
+
05 FILLER PIC X(33) VALUE " MODE".
|
2277
|
+
05 FILLER PIC X(33) VALUE "VMOVE".
|
2278
|
+
05 FILLER PIC X(33) VALUE " MULTIPLE".
|
2279
|
+
05 FILLER PIC X(33) VALUE "VMULTIPLY".
|
2280
|
+
05 FILLER PIC X(33) VALUE " NATIONAL".
|
2281
|
+
05 FILLER PIC X(33) VALUE " NATIONAL-EDITED".
|
2282
|
+
05 FILLER PIC X(33) VALUE " NATIVE".
|
2283
|
+
05 FILLER PIC X(33) VALUE " NEGATIVE".
|
2284
|
+
05 FILLER PIC X(33) VALUE " NESTED".
|
2285
|
+
05 FILLER PIC X(33) VALUE "VNEXT".
|
2286
|
+
05 FILLER PIC X(33) VALUE " NO".
|
2287
|
+
05 FILLER PIC X(33) VALUE " NOT".
|
2288
|
+
05 FILLER PIC X(33) VALUE " NULL".
|
2289
|
+
05 FILLER PIC X(33) VALUE " NULLS".
|
2290
|
+
05 FILLER PIC X(33) VALUE " NUMBER".
|
2291
|
+
05 FILLER PIC X(33) VALUE "INUMBER-OF-CALL-PARAMETERS".
|
2292
|
+
05 FILLER PIC X(33) VALUE " NUMBERS".
|
2293
|
+
05 FILLER PIC X(33) VALUE " NUMERIC".
|
2294
|
+
05 FILLER PIC X(33) VALUE " NUMERIC-EDITED".
|
2295
|
+
05 FILLER PIC X(33) VALUE "INUMVAL".
|
2296
|
+
05 FILLER PIC X(33) VALUE "INUMVAL-C".
|
2297
|
+
05 FILLER PIC X(33) VALUE " OBJECT".
|
2298
|
+
05 FILLER PIC X(33) VALUE " OBJECT-COMPUTER".
|
2299
|
+
05 FILLER PIC X(33) VALUE " OBJECT-REFERENCE".
|
2300
|
+
05 FILLER PIC X(33) VALUE " OCCURS".
|
2301
|
+
05 FILLER PIC X(33) VALUE " OF".
|
2302
|
+
05 FILLER PIC X(33) VALUE " OFF".
|
2303
|
+
05 FILLER PIC X(33) VALUE " OMITTED".
|
2304
|
+
05 FILLER PIC X(33) VALUE " ON".
|
2305
|
+
05 FILLER PIC X(33) VALUE " ONLY".
|
2306
|
+
05 FILLER PIC X(33) VALUE "VOPEN".
|
2307
|
+
05 FILLER PIC X(33) VALUE " OPTIONAL".
|
2308
|
+
05 FILLER PIC X(33) VALUE " OPTIONS".
|
2309
|
+
05 FILLER PIC X(33) VALUE " OR".
|
2310
|
+
05 FILLER PIC X(33) VALUE "IORD".
|
2311
|
+
05 FILLER PIC X(33) VALUE "IORD-MAX".
|
2312
|
+
05 FILLER PIC X(33) VALUE "IORD-MIN".
|
2313
|
+
05 FILLER PIC X(33) VALUE " ORDER".
|
2314
|
+
05 FILLER PIC X(33) VALUE " ORGANIZATION".
|
2315
|
+
05 FILLER PIC X(33) VALUE " OTHER".
|
2316
|
+
05 FILLER PIC X(33) VALUE " OUTPUT".
|
2317
|
+
05 FILLER PIC X(33) VALUE " OVERFLOW".
|
2318
|
+
05 FILLER PIC X(33) VALUE " OVERLINE".
|
2319
|
+
05 FILLER PIC X(33) VALUE " OVERRIDE".
|
2320
|
+
05 FILLER PIC X(33) VALUE " PACKED-DECIMAL".
|
2321
|
+
05 FILLER PIC X(33) VALUE " PADDING".
|
2322
|
+
05 FILLER PIC X(33) VALUE " PAGE".
|
2323
|
+
05 FILLER PIC X(33) VALUE " PAGE-COUNTER".
|
2324
|
+
05 FILLER PIC X(33) VALUE " PARAGRAPH".
|
2325
|
+
05 FILLER PIC X(33) VALUE "VPERFORM".
|
2326
|
+
05 FILLER PIC X(33) VALUE " PF".
|
2327
|
+
05 FILLER PIC X(33) VALUE " PH".
|
2328
|
+
05 FILLER PIC X(33) VALUE "IPI".
|
2329
|
+
05 FILLER PIC X(33) VALUE "KPIC".
|
2330
|
+
05 FILLER PIC X(33) VALUE "KPICTURE".
|
2331
|
+
05 FILLER PIC X(33) VALUE " PLUS".
|
2332
|
+
05 FILLER PIC X(33) VALUE "KPOINTER".
|
2333
|
+
05 FILLER PIC X(33) VALUE " POSITION".
|
2334
|
+
05 FILLER PIC X(33) VALUE " POSITIVE".
|
2335
|
+
05 FILLER PIC X(33) VALUE " PRESENT".
|
2336
|
+
05 FILLER PIC X(33) VALUE "IPRESENT-VALUE".
|
2337
|
+
05 FILLER PIC X(33) VALUE " PREVIOUS".
|
2338
|
+
05 FILLER PIC X(33) VALUE "MPRINTER".
|
2339
|
+
05 FILLER PIC X(33) VALUE " PRINTING".
|
2340
|
+
05 FILLER PIC X(33) VALUE "KPROCEDURE".
|
2341
|
+
05 FILLER PIC X(33) VALUE " PROCEDURE-POINTER".
|
2342
|
+
05 FILLER PIC X(33) VALUE " PROCEDURES".
|
2343
|
+
05 FILLER PIC X(33) VALUE " PROCEED".
|
2344
|
+
05 FILLER PIC X(33) VALUE " PROGRAM".
|
2345
|
+
05 FILLER PIC X(33) VALUE "KPROGRAM-ID".
|
2346
|
+
05 FILLER PIC X(33) VALUE " PROGRAM-POINTER".
|
2347
|
+
05 FILLER PIC X(33) VALUE " PROMPT".
|
2348
|
+
05 FILLER PIC X(33) VALUE " PROPERTY".
|
2349
|
+
05 FILLER PIC X(33) VALUE " PROTOTYPE".
|
2350
|
+
05 FILLER PIC X(33) VALUE " QUOTE".
|
2351
|
+
05 FILLER PIC X(33) VALUE " QUOTES".
|
2352
|
+
05 FILLER PIC X(33) VALUE " RAISE".
|
2353
|
+
05 FILLER PIC X(33) VALUE " RAISING".
|
2354
|
+
05 FILLER PIC X(33) VALUE "IRANDOM".
|
2355
|
+
05 FILLER PIC X(33) VALUE "IRANGE".
|
2356
|
+
05 FILLER PIC X(33) VALUE " RD".
|
2357
|
+
05 FILLER PIC X(33) VALUE "VREAD".
|
2358
|
+
05 FILLER PIC X(33) VALUE "VREADY".
|
2359
|
+
05 FILLER PIC X(33) VALUE " RECORD".
|
2360
|
+
05 FILLER PIC X(33) VALUE " RECORDING".
|
2361
|
+
05 FILLER PIC X(33) VALUE " RECORDS".
|
2362
|
+
05 FILLER PIC X(33) VALUE " RECURSIVE".
|
2363
|
+
05 FILLER PIC X(33) VALUE "KREDEFINES".
|
2364
|
+
05 FILLER PIC X(33) VALUE " REEL".
|
2365
|
+
05 FILLER PIC X(33) VALUE " REFERENCE".
|
2366
|
+
05 FILLER PIC X(33) VALUE " RELATIVE".
|
2367
|
+
05 FILLER PIC X(33) VALUE "VRELEASE".
|
2368
|
+
05 FILLER PIC X(33) VALUE "IREM".
|
2369
|
+
05 FILLER PIC X(33) VALUE " REMAINDER".
|
2370
|
+
05 FILLER PIC X(33) VALUE " REMARKS".
|
2371
|
+
05 FILLER PIC X(33) VALUE " REMOVAL".
|
2372
|
+
05 FILLER PIC X(33) VALUE "KRENAMES".
|
2373
|
+
05 FILLER PIC X(33) VALUE "KREPLACING".
|
2374
|
+
05 FILLER PIC X(33) VALUE "KREPORT".
|
2375
|
+
05 FILLER PIC X(33) VALUE " REPORTING".
|
2376
|
+
05 FILLER PIC X(33) VALUE " REPORTS".
|
2377
|
+
05 FILLER PIC X(33) VALUE " REPOSITORY".
|
2378
|
+
05 FILLER PIC X(33) VALUE " REPRESENTS-NOT-A-NUMBER".
|
2379
|
+
05 FILLER PIC X(33) VALUE " REQUIRED".
|
2380
|
+
05 FILLER PIC X(33) VALUE " RESERVE".
|
2381
|
+
05 FILLER PIC X(33) VALUE " RESUME".
|
2382
|
+
05 FILLER PIC X(33) VALUE " RETRY".
|
2383
|
+
05 FILLER PIC X(33) VALUE "VRETURN".
|
2384
|
+
05 FILLER PIC X(33) VALUE "IRETURN-CODE".
|
2385
|
+
05 FILLER PIC X(33) VALUE "KRETURNING".
|
2386
|
+
05 FILLER PIC X(33) VALUE "IREVERSE".
|
2387
|
+
05 FILLER PIC X(33) VALUE " REVERSE-VIDEO".
|
2388
|
+
05 FILLER PIC X(33) VALUE " REWIND".
|
2389
|
+
05 FILLER PIC X(33) VALUE "VREWRITE".
|
2390
|
+
05 FILLER PIC X(33) VALUE " RF".
|
2391
|
+
05 FILLER PIC X(33) VALUE " RH".
|
2392
|
+
05 FILLER PIC X(33) VALUE " RIGHT".
|
2393
|
+
05 FILLER PIC X(33) VALUE " RIGHT-JUSTIFY".
|
2394
|
+
05 FILLER PIC X(33) VALUE "VROLLBACK".
|
2395
|
+
05 FILLER PIC X(33) VALUE " ROUNDED".
|
2396
|
+
05 FILLER PIC X(33) VALUE " RUN".
|
2397
|
+
05 FILLER PIC X(33) VALUE " SAME".
|
2398
|
+
05 FILLER PIC X(33) VALUE "KSCREEN".
|
2399
|
+
05 FILLER PIC X(33) VALUE " SCROLL".
|
2400
|
+
05 FILLER PIC X(33) VALUE "KSD".
|
2401
|
+
05 FILLER PIC X(33) VALUE "VSEARCH".
|
2402
|
+
05 FILLER PIC X(33) VALUE "ISECONDS-FROM-FORMATTED-TIME".
|
2403
|
+
05 FILLER PIC X(33) VALUE "ISECONDS-PAST-MIDNIGHT".
|
2404
|
+
05 FILLER PIC X(33) VALUE "KSECTION".
|
2405
|
+
05 FILLER PIC X(33) VALUE " SECURE".
|
2406
|
+
05 FILLER PIC X(33) VALUE " SECURITY".
|
2407
|
+
05 FILLER PIC X(33) VALUE " SEGMENT-LIMIT".
|
2408
|
+
05 FILLER PIC X(33) VALUE " SELECT".
|
2409
|
+
05 FILLER PIC X(33) VALUE " SELF".
|
2410
|
+
05 FILLER PIC X(33) VALUE " SENTENCE".
|
2411
|
+
05 FILLER PIC X(33) VALUE " SEPARATE".
|
2412
|
+
05 FILLER PIC X(33) VALUE " SEQUENCE".
|
2413
|
+
05 FILLER PIC X(33) VALUE " SEQUENTIAL".
|
2414
|
+
05 FILLER PIC X(33) VALUE "VSET".
|
2415
|
+
05 FILLER PIC X(33) VALUE " SHARING".
|
2416
|
+
05 FILLER PIC X(33) VALUE "ISIGN".
|
2417
|
+
05 FILLER PIC X(33) VALUE " SIGNED".
|
2418
|
+
05 FILLER PIC X(33) VALUE " SIGNED-INT".
|
2419
|
+
05 FILLER PIC X(33) VALUE " SIGNED-LONG".
|
2420
|
+
05 FILLER PIC X(33) VALUE " SIGNED-SHORT".
|
2421
|
+
05 FILLER PIC X(33) VALUE "ISIN".
|
2422
|
+
05 FILLER PIC X(33) VALUE " SIZE".
|
2423
|
+
05 FILLER PIC X(33) VALUE "VSORT".
|
2424
|
+
05 FILLER PIC X(33) VALUE " SORT-MERGE".
|
2425
|
+
05 FILLER PIC X(33) VALUE "ISORT-RETURN".
|
2426
|
+
05 FILLER PIC X(33) VALUE " SOURCE".
|
2427
|
+
05 FILLER PIC X(33) VALUE " SOURCE-COMPUTER".
|
2428
|
+
05 FILLER PIC X(33) VALUE " SOURCES".
|
2429
|
+
05 FILLER PIC X(33) VALUE " SPACE".
|
2430
|
+
05 FILLER PIC X(33) VALUE " SPACE-FILL".
|
2431
|
+
05 FILLER PIC X(33) VALUE " SPACES".
|
2432
|
+
05 FILLER PIC X(33) VALUE " SPECIAL-NAMES".
|
2433
|
+
05 FILLER PIC X(33) VALUE "ISQRT".
|
2434
|
+
05 FILLER PIC X(33) VALUE " STANDARD".
|
2435
|
+
05 FILLER PIC X(33) VALUE " STANDARD-1".
|
2436
|
+
05 FILLER PIC X(33) VALUE " STANDARD-2".
|
2437
|
+
05 FILLER PIC X(33) VALUE "ISTANDARD-DEVIATION".
|
2438
|
+
05 FILLER PIC X(33) VALUE "VSTART".
|
2439
|
+
05 FILLER PIC X(33) VALUE " STATUS".
|
2440
|
+
05 FILLER PIC X(33) VALUE "VSTOP".
|
2441
|
+
05 FILLER PIC X(33) VALUE "ISTORED-CHAR-LENGTH".
|
2442
|
+
05 FILLER PIC X(33) VALUE "VSTRING".
|
2443
|
+
05 FILLER PIC X(33) VALUE "ISUBSTITUTE".
|
2444
|
+
05 FILLER PIC X(33) VALUE "ISUBSTITUTE-CASE".
|
2445
|
+
05 FILLER PIC X(33) VALUE "VSUBTRACT".
|
2446
|
+
05 FILLER PIC X(33) VALUE "ISUM".
|
2447
|
+
05 FILLER PIC X(33) VALUE " SUPER".
|
2448
|
+
05 FILLER PIC X(33) VALUE "VSUPPRESS".
|
2449
|
+
05 FILLER PIC X(33) VALUE "MSWITCH-1".
|
2450
|
+
05 FILLER PIC X(33) VALUE "MSWITCH-2".
|
2451
|
+
05 FILLER PIC X(33) VALUE "MSWITCH-3".
|
2452
|
+
05 FILLER PIC X(33) VALUE "MSWITCH-4".
|
2453
|
+
05 FILLER PIC X(33) VALUE "MSWITCH-5".
|
2454
|
+
05 FILLER PIC X(33) VALUE "MSWITCH-6".
|
2455
|
+
05 FILLER PIC X(33) VALUE "MSWITCH-7".
|
2456
|
+
05 FILLER PIC X(33) VALUE "MSWITCH-8".
|
2457
|
+
05 FILLER PIC X(33) VALUE " SYMBOLIC".
|
2458
|
+
05 FILLER PIC X(33) VALUE " SYNC".
|
2459
|
+
05 FILLER PIC X(33) VALUE " SYNCHRONIZED".
|
2460
|
+
05 FILLER PIC X(33) VALUE "MSYSERR".
|
2461
|
+
05 FILLER PIC X(33) VALUE "MSYSIN".
|
2462
|
+
05 FILLER PIC X(33) VALUE "MSYSIPT".
|
2463
|
+
05 FILLER PIC X(33) VALUE "MSYSLIST".
|
2464
|
+
05 FILLER PIC X(33) VALUE "MSYSLST".
|
2465
|
+
05 FILLER PIC X(33) VALUE "MSYSOUT".
|
2466
|
+
05 FILLER PIC X(33) VALUE " SYSTEM-DEFAULT".
|
2467
|
+
05 FILLER PIC X(33) VALUE " TABLE".
|
2468
|
+
05 FILLER PIC X(33) VALUE "KTALLYING".
|
2469
|
+
05 FILLER PIC X(33) VALUE "ITAN".
|
2470
|
+
05 FILLER PIC X(33) VALUE " TAPE".
|
2471
|
+
05 FILLER PIC X(33) VALUE "VTERMINATE".
|
2472
|
+
05 FILLER PIC X(33) VALUE " TEST".
|
2473
|
+
05 FILLER PIC X(33) VALUE "ITEST-DATE-YYYYMMDD".
|
2474
|
+
05 FILLER PIC X(33) VALUE "ITEST-DAY-YYYYDDD".
|
2475
|
+
05 FILLER PIC X(33) VALUE " THAN".
|
2476
|
+
05 FILLER PIC X(33) VALUE " THEN".
|
2477
|
+
05 FILLER PIC X(33) VALUE " THROUGH".
|
2478
|
+
05 FILLER PIC X(33) VALUE " THRU".
|
2479
|
+
05 FILLER PIC X(33) VALUE " TIME".
|
2480
|
+
05 FILLER PIC X(33) VALUE " TIMES".
|
2481
|
+
05 FILLER PIC X(33) VALUE "KTO".
|
2482
|
+
05 FILLER PIC X(33) VALUE " TOP".
|
2483
|
+
05 FILLER PIC X(33) VALUE " TRAILING".
|
2484
|
+
05 FILLER PIC X(33) VALUE " TRAILING-SIGN".
|
2485
|
+
05 FILLER PIC X(33) VALUE "VTRANSFORM".
|
2486
|
+
05 FILLER PIC X(33) VALUE "ITRIM".
|
2487
|
+
05 FILLER PIC X(33) VALUE " TRUE".
|
2488
|
+
05 FILLER PIC X(33) VALUE " TYPE".
|
2489
|
+
05 FILLER PIC X(33) VALUE " TYPEDEF".
|
2490
|
+
05 FILLER PIC X(33) VALUE " UNDERLINE".
|
2491
|
+
05 FILLER PIC X(33) VALUE " UNIT".
|
2492
|
+
05 FILLER PIC X(33) VALUE " UNIVERSAL".
|
2493
|
+
05 FILLER PIC X(33) VALUE "VUNLOCK".
|
2494
|
+
05 FILLER PIC X(33) VALUE " UNSIGNED".
|
2495
|
+
05 FILLER PIC X(33) VALUE " UNSIGNED-INT".
|
2496
|
+
05 FILLER PIC X(33) VALUE " UNSIGNED-LONG".
|
2497
|
+
05 FILLER PIC X(33) VALUE " UNSIGNED-SHORT".
|
2498
|
+
05 FILLER PIC X(33) VALUE "VUNSTRING".
|
2499
|
+
05 FILLER PIC X(33) VALUE " UNTIL".
|
2500
|
+
05 FILLER PIC X(33) VALUE "KUP".
|
2501
|
+
05 FILLER PIC X(33) VALUE " UPDATE".
|
2502
|
+
05 FILLER PIC X(33) VALUE " UPON".
|
2503
|
+
05 FILLER PIC X(33) VALUE " UPPER".
|
2504
|
+
05 FILLER PIC X(33) VALUE "IUPPER-CASE".
|
2505
|
+
05 FILLER PIC X(33) VALUE " USAGE".
|
2506
|
+
05 FILLER PIC X(33) VALUE "VUSE".
|
2507
|
+
05 FILLER PIC X(33) VALUE " USER-DEFAULT".
|
2508
|
+
05 FILLER PIC X(33) VALUE "KUSING".
|
2509
|
+
05 FILLER PIC X(33) VALUE " VAL-STATUS".
|
2510
|
+
05 FILLER PIC X(33) VALUE " VALID".
|
2511
|
+
05 FILLER PIC X(33) VALUE " VALIDATE".
|
2512
|
+
05 FILLER PIC X(33) VALUE " VALIDATE-STATUS".
|
2513
|
+
05 FILLER PIC X(33) VALUE " VALUE".
|
2514
|
+
05 FILLER PIC X(33) VALUE " VALUES".
|
2515
|
+
05 FILLER PIC X(33) VALUE "IVARIANCE".
|
2516
|
+
05 FILLER PIC X(33) VALUE "KVARYING".
|
2517
|
+
05 FILLER PIC X(33) VALUE " WAIT".
|
2518
|
+
05 FILLER PIC X(33) VALUE "VWHEN".
|
2519
|
+
05 FILLER PIC X(33) VALUE "IWHEN-COMPILED".
|
2520
|
+
05 FILLER PIC X(33) VALUE " WITH".
|
2521
|
+
05 FILLER PIC X(33) VALUE " WORDS".
|
2522
|
+
05 FILLER PIC X(33) VALUE "KWORKING-STORAGE".
|
2523
|
+
05 FILLER PIC X(33) VALUE "VWRITE".
|
2524
|
+
05 FILLER PIC X(33) VALUE "IYEAR-TO-YYYY".
|
2525
|
+
05 FILLER PIC X(33) VALUE " YYYYDDD".
|
2526
|
+
05 FILLER PIC X(33) VALUE " YYYYMMDD".
|
2527
|
+
05 FILLER PIC X(33) VALUE " ZERO".
|
2528
|
+
05 FILLER PIC X(33) VALUE " ZERO-FILL".
|
2529
|
+
05 FILLER PIC X(33) VALUE " ZEROES".
|
2530
|
+
05 FILLER PIC X(33) VALUE " ZEROS".
|
2531
|
+
01 Reserved-Word-Table REDEFINES Reserved-Words.
|
2532
|
+
05 Reserved-Word OCCURS 591 TIMES
|
2533
|
+
ASCENDING KEY RW-Word
|
2534
|
+
INDEXED RW-Idx.
|
2535
|
+
10 RW-Type PIC X(1).
|
2536
|
+
10 RW-Word PIC X(32).
|
2537
|
+
|
2538
|
+
01 Saved-Section PIC X(15).
|
2539
|
+
|
2540
|
+
01 Search-Token PIC X(32).
|
2541
|
+
|
2542
|
+
01 Source-Line-No PIC 9(6).
|
2543
|
+
|
2544
|
+
01 Src-Ptr USAGE BINARY-LONG.
|
2545
|
+
|
2546
|
+
01 Syntax-Parsing-Items.
|
2547
|
+
05 SPI-Current-Char PIC X(1).
|
2548
|
+
88 Current-Char-Is-Punct VALUE "=", "(", ")", "*", "/",
|
2549
|
+
"&", ";", ",", "<", ">",
|
2550
|
+
":".
|
2551
|
+
88 Current-Char-Is-Quote VALUE '"', "'".
|
2552
|
+
88 Current-Char-Is-X VALUE "x", "X".
|
2553
|
+
88 Current-Char-Is-Z VALUE "z", "Z".
|
2554
|
+
05 SPI-Current-Division PIC X(1).
|
2555
|
+
88 In-IDENTIFICATION-DIVISION VALUE "I", "?".
|
2556
|
+
88 In-ENVIRONMENT-DIVISION VALUE "E".
|
2557
|
+
88 In-DATA-DIVISION VALUE "D".
|
2558
|
+
88 In-PROCEDURE-DIVISION VALUE "P".
|
2559
|
+
05 SPI-Current-Line-No PIC 9(6).
|
2560
|
+
05 SPI-Current-Program-ID.
|
2561
|
+
10 FILLER PIC X(12).
|
2562
|
+
10 SPI-CP-13-15 PIC X(3).
|
2563
|
+
05 SPI-Current-Section.
|
2564
|
+
10 SPI-CS-1 PIC X(1).
|
2565
|
+
10 SPI-CS-2-14.
|
2566
|
+
15 FILLER PIC X(10).
|
2567
|
+
15 SPI-CS-11-14 PIC X(3).
|
2568
|
+
10 SPI-CS-15 PIC X(1).
|
2569
|
+
05 SPI-Current-Token PIC X(32).
|
2570
|
+
05 SPI-Current-Token-UC PIC X(32).
|
2571
|
+
05 SPI-Current-Verb PIC X(12).
|
2572
|
+
05 SPI-Next-Char PIC X(1).
|
2573
|
+
88 Next-Char-Is-Quote VALUE '"', "'".
|
2574
|
+
05 SPI-Prior-Token PIC X(32).
|
2575
|
+
05 SPI-Token-Type PIC X(1).
|
2576
|
+
88 Token-Is-EOF VALUE HIGH-VALUES.
|
2577
|
+
88 Token-Is-Identifier VALUE "I".
|
2578
|
+
88 Token-Is-Key-Word VALUE "K", "V".
|
2579
|
+
88 Token-Is-Literal-Alpha VALUE "L".
|
2580
|
+
88 Token-Is-Literal-Number VALUE "N".
|
2581
|
+
88 Token-Is-Verb VALUE "V".
|
2582
|
+
GC0710 88 Token-Is-Reserved-Word VALUE " ".
|
2583
|
+
|
2584
|
+
01 Tally USAGE BINARY-LONG.
|
2585
|
+
|
2586
|
+
01 Todays-Date PIC 9(8).
|
2587
|
+
|
2588
|
+
LINKAGE SECTION.
|
2589
|
+
01 Produce-Source-Listing PIC X(1).
|
2590
|
+
01 Produce-Xref-Listing PIC X(1).
|
2591
|
+
01 Src-Filename PIC X(256).
|
2592
|
+
/
|
2593
|
+
PROCEDURE DIVISION USING Produce-Source-Listing
|
2594
|
+
Produce-Xref-Listing
|
2595
|
+
Src-Filename.
|
2596
|
+
000-Main SECTION.
|
2597
|
+
001-Init.
|
2598
|
+
PERFORM 100-Initialization
|
2599
|
+
PERFORM 200-Execute-cobc
|
2600
|
+
OPEN OUTPUT Report-File
|
2601
|
+
IF Produce-Source-Listing NOT = SPACE
|
2602
|
+
PERFORM 500-Produce-Source-Listing
|
2603
|
+
END-IF
|
2604
|
+
IF Produce-Xref-Listing NOT = SPACE
|
2605
|
+
SORT Sort-File
|
2606
|
+
ASCENDING KEY SR-Prog-ID
|
2607
|
+
SR-Token-UC
|
2608
|
+
SR-Line-No-Ref
|
2609
|
+
INPUT PROCEDURE 300-Tokenize-Source
|
2610
|
+
OUTPUT PROCEDURE 400-Produce-Xref-Listing
|
2611
|
+
END-IF
|
2612
|
+
CLOSE Report-File
|
2613
|
+
GOBACK
|
2614
|
+
.
|
2615
|
+
/
|
2616
|
+
100-Initialization SECTION.
|
2617
|
+
*****************************************************************
|
2618
|
+
** Perform all program-wide initialization operations **
|
2619
|
+
*****************************************************************
|
2620
|
+
101-Establish-Working-Env.
|
2621
|
+
MOVE TRIM(Src-Filename,Leading) TO Src-Filename
|
2622
|
+
ACCEPT Env-TEMP
|
2623
|
+
FROM ENVIRONMENT "TEMP"
|
2624
|
+
END-ACCEPT
|
2625
|
+
ACCEPT Lines-Per-Page-ENV
|
2626
|
+
FROM ENVIRONMENT "OCXREF_LINES"
|
2627
|
+
END-ACCEPT
|
2628
|
+
INSPECT Src-Filename REPLACING ALL "\" BY "/"
|
2629
|
+
INSPECT Env-TEMP REPLACING ALL "\" BY "/"
|
2630
|
+
MOVE Src-Filename TO Program-Path
|
2631
|
+
MOVE Program-Path TO Heading-2
|
2632
|
+
CALL "C$JUSTIFY"
|
2633
|
+
USING Heading-2, "Right"
|
2634
|
+
END-CALL
|
2635
|
+
MOVE LENGTH(TRIM(Src-Filename,Trailing)) TO I
|
2636
|
+
MOVE 0 TO J
|
2637
|
+
PERFORM UNTIL Src-Filename(I:1) = '/'
|
2638
|
+
OR I = 0
|
2639
|
+
SUBTRACT 1 FROM I
|
2640
|
+
ADD 1 TO J
|
2641
|
+
END-PERFORM
|
2642
|
+
UNSTRING Src-Filename((I + 1):J) DELIMITED BY "."
|
2643
|
+
INTO Filename, Dummy
|
2644
|
+
END-UNSTRING
|
2645
|
+
STRING TRIM(Env-TEMP,Trailing)
|
2646
|
+
"/"
|
2647
|
+
TRIM(Filename,Trailing)
|
2648
|
+
".i"
|
2649
|
+
DELIMITED SIZE
|
2650
|
+
INTO Expanded-Src-Filename
|
2651
|
+
END-STRING
|
2652
|
+
STRING Program-Path(1:I)
|
2653
|
+
TRIM(Filename,Trailing)
|
2654
|
+
".lst"
|
2655
|
+
DELIMITED SIZE
|
2656
|
+
INTO Report-Filename
|
2657
|
+
END-STRING
|
2658
|
+
IF Lines-Per-Page-ENV NOT = SPACES
|
2659
|
+
MOVE NUMVAL(Lines-Per-Page-ENV) TO Lines-Per-Page
|
2660
|
+
ELSE
|
2661
|
+
MOVE 60 TO Lines-Per-Page
|
2662
|
+
END-IF
|
2663
|
+
ACCEPT Todays-Date
|
2664
|
+
FROM DATE YYYYMMDD
|
2665
|
+
END-ACCEPT
|
2666
|
+
MOVE Todays-Date TO H1X-Date
|
2667
|
+
H1S-Date
|
2668
|
+
MOVE "????????????..." TO SPI-Current-Program-ID
|
2669
|
+
MOVE SPACES TO SPI-Current-Verb
|
2670
|
+
Held-Reference
|
2671
|
+
MOVE "Y" TO F-First-Record
|
2672
|
+
.
|
2673
|
+
/
|
2674
|
+
200-Execute-cobc SECTION.
|
2675
|
+
201-Build-Cmd.
|
2676
|
+
STRING "cobc -E "
|
2677
|
+
TRIM(Program-Path, Trailing)
|
2678
|
+
" > "
|
2679
|
+
TRIM(Expanded-Src-Filename,Trailing)
|
2680
|
+
DELIMITED SIZE
|
2681
|
+
INTO Cmd
|
2682
|
+
END-STRING
|
2683
|
+
CALL "SYSTEM"
|
2684
|
+
USING Cmd
|
2685
|
+
END-CALL
|
2686
|
+
IF RETURN-CODE NOT = 0
|
2687
|
+
DISPLAY
|
2688
|
+
"Cross-reference terminated by previous errors"
|
2689
|
+
UPON SYSERR
|
2690
|
+
END-DISPLAY
|
2691
|
+
GOBACK
|
2692
|
+
END-IF
|
2693
|
+
.
|
2694
|
+
|
2695
|
+
209-Exit.
|
2696
|
+
EXIT
|
2697
|
+
.
|
2698
|
+
/
|
2699
|
+
300-Tokenize-Source SECTION.
|
2700
|
+
301-Driver.
|
2701
|
+
OPEN INPUT Expand-Code
|
2702
|
+
MOVE SPACES TO Expand-Code-Rec
|
2703
|
+
MOVE 256 TO Src-Ptr
|
2704
|
+
MOVE 0 TO Num-UserNames
|
2705
|
+
SPI-Current-Line-No
|
2706
|
+
MOVE "?" TO SPI-Current-Division
|
2707
|
+
GC0710 MOVE "N" TO F-Verb-Has-Been-Found.
|
2708
|
+
PERFORM FOREVER
|
2709
|
+
PERFORM 310-Get-Token
|
2710
|
+
IF Token-Is-EOF
|
2711
|
+
EXIT PERFORM
|
2712
|
+
END-IF
|
2713
|
+
MOVE UPPER-CASE(SPI-Current-Token)
|
2714
|
+
TO SPI-Current-Token-UC
|
2715
|
+
IF Token-Is-Verb
|
2716
|
+
MOVE SPI-Current-Token-UC TO SPI-Current-Verb
|
2717
|
+
SPI-Prior-Token
|
2718
|
+
IF Held-Reference NOT = SPACES
|
2719
|
+
MOVE Held-Reference TO Sort-Rec
|
2720
|
+
MOVE SPACES TO Held-Reference
|
2721
|
+
RELEASE Sort-Rec
|
2722
|
+
END-IF
|
2723
|
+
END-IF
|
2724
|
+
EVALUATE TRUE
|
2725
|
+
WHEN In-IDENTIFICATION-DIVISION
|
2726
|
+
PERFORM 320-IDENTIFICATION-DIVISION
|
2727
|
+
WHEN In-ENVIRONMENT-DIVISION
|
2728
|
+
PERFORM 330-ENVIRONMENT-DIVISION
|
2729
|
+
WHEN In-DATA-DIVISION
|
2730
|
+
PERFORM 340-DATA-DIVISION
|
2731
|
+
WHEN In-PROCEDURE-DIVISION
|
2732
|
+
PERFORM 350-PROCEDURE-DIVISION
|
2733
|
+
END-EVALUATE
|
2734
|
+
IF Token-Is-Key-Word
|
2735
|
+
MOVE SPI-Current-Token-UC TO SPI-Prior-Token
|
2736
|
+
END-IF
|
2737
|
+
IF F-Token-Ended-Sentence = "Y"
|
2738
|
+
AND SPI-Current-Division NOT = "I"
|
2739
|
+
MOVE SPACES TO SPI-Prior-Token
|
2740
|
+
SPI-Current-Verb
|
2741
|
+
END-IF
|
2742
|
+
|
2743
|
+
END-PERFORM
|
2744
|
+
CLOSE Expand-Code
|
2745
|
+
EXIT SECTION
|
2746
|
+
.
|
2747
|
+
*>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
|
2748
|
+
310-Get-Token.
|
2749
|
+
*>-- Position to 1st non-blank character
|
2750
|
+
MOVE F-Token-Ended-Sentence TO F-Last-Token-Ended-Sent
|
2751
|
+
MOVE "N" TO F-Token-Ended-Sentence
|
2752
|
+
PERFORM UNTIL Expand-Code-Rec(Src-Ptr : 1) NOT = SPACE
|
2753
|
+
IF Src-Ptr > 255
|
2754
|
+
READ Expand-Code AT END
|
2755
|
+
IF Held-Reference NOT = SPACES
|
2756
|
+
MOVE Held-Reference TO Sort-Rec
|
2757
|
+
MOVE SPACES TO Held-Reference
|
2758
|
+
RELEASE Sort-Rec
|
2759
|
+
END-IF
|
2760
|
+
SET Token-Is-EOF TO TRUE
|
2761
|
+
MOVE 0 TO SPI-Current-Line-No
|
2762
|
+
EXIT PARAGRAPH
|
2763
|
+
END-READ
|
2764
|
+
IF ECR-1 = "#"
|
2765
|
+
PERFORM 311-Control-Record
|
2766
|
+
ELSE
|
2767
|
+
PERFORM 312-Expand-Code-Record
|
2768
|
+
END-IF
|
2769
|
+
ELSE
|
2770
|
+
ADD 1 TO Src-Ptr
|
2771
|
+
END-IF
|
2772
|
+
END-PERFORM
|
2773
|
+
*>-- Extract token string
|
2774
|
+
MOVE Expand-Code-Rec(Src-Ptr : 1) TO SPI-Current-Char
|
2775
|
+
MOVE Expand-Code-Rec(Src-Ptr + 1: 1) TO SPI-Next-Char
|
2776
|
+
IF SPI-Current-Char = "."
|
2777
|
+
ADD 1 TO Src-Ptr
|
2778
|
+
MOVE SPI-Current-Char TO SPI-Current-Token
|
2779
|
+
MOVE SPACE TO SPI-Token-Type
|
2780
|
+
MOVE "Y" TO F-Token-Ended-Sentence
|
2781
|
+
EXIT PARAGRAPH
|
2782
|
+
END-IF
|
2783
|
+
IF Current-Char-Is-Punct
|
2784
|
+
AND SPI-Current-Char = "="
|
2785
|
+
AND SPI-Current-Division = "P"
|
2786
|
+
ADD 1 TO Src-Ptr
|
2787
|
+
MOVE "EQUALS" TO SPI-Current-Token
|
2788
|
+
MOVE "K" TO SPI-Token-Type
|
2789
|
+
EXIT PARAGRAPH
|
2790
|
+
END-IF
|
2791
|
+
IF Current-Char-Is-Punct *> So subscripts don't get flagged w/ "*"
|
2792
|
+
AND SPI-Current-Char = "("
|
2793
|
+
AND SPI-Current-Division = "P"
|
2794
|
+
MOVE SPACES TO SPI-Prior-Token
|
2795
|
+
END-IF
|
2796
|
+
IF Current-Char-Is-Punct
|
2797
|
+
ADD 1 TO Src-Ptr
|
2798
|
+
MOVE SPI-Current-Char TO SPI-Current-Token
|
2799
|
+
MOVE SPACE TO SPI-Token-Type
|
2800
|
+
EXIT PARAGRAPH
|
2801
|
+
END-IF
|
2802
|
+
IF Current-Char-Is-Quote
|
2803
|
+
ADD 1 TO Src-Ptr
|
2804
|
+
UNSTRING Expand-Code-Rec
|
2805
|
+
DELIMITED BY SPI-Current-Char
|
2806
|
+
INTO SPI-Current-Token
|
2807
|
+
WITH POINTER Src-Ptr
|
2808
|
+
END-UNSTRING
|
2809
|
+
IF Expand-Code-Rec(Src-Ptr : 1) = "."
|
2810
|
+
MOVE "Y" TO F-Token-Ended-Sentence
|
2811
|
+
ADD 1 TO Src-Ptr
|
2812
|
+
END-IF
|
2813
|
+
SET Token-Is-Literal-Alpha TO TRUE
|
2814
|
+
EXIT PARAGRAPH
|
2815
|
+
END-IF
|
2816
|
+
IF Current-Char-Is-X AND Next-Char-Is-Quote
|
2817
|
+
ADD 2 TO Src-Ptr
|
2818
|
+
UNSTRING Expand-Code-Rec
|
2819
|
+
DELIMITED BY SPI-Next-Char
|
2820
|
+
INTO SPI-Current-Token
|
2821
|
+
WITH POINTER Src-Ptr
|
2822
|
+
END-UNSTRING
|
2823
|
+
IF Expand-Code-Rec(Src-Ptr : 1) = "."
|
2824
|
+
MOVE "Y" TO F-Token-Ended-Sentence
|
2825
|
+
ADD 1 TO Src-Ptr
|
2826
|
+
END-IF
|
2827
|
+
SET Token-Is-Literal-Number TO TRUE
|
2828
|
+
EXIT PARAGRAPH
|
2829
|
+
END-IF
|
2830
|
+
IF Current-Char-Is-Z AND Next-Char-Is-Quote
|
2831
|
+
ADD 2 TO Src-Ptr
|
2832
|
+
UNSTRING Expand-Code-Rec
|
2833
|
+
DELIMITED BY SPI-Next-Char
|
2834
|
+
INTO SPI-Current-Token
|
2835
|
+
WITH POINTER Src-Ptr
|
2836
|
+
END-UNSTRING
|
2837
|
+
IF Expand-Code-Rec(Src-Ptr : 1) = "."
|
2838
|
+
MOVE "Y" TO F-Token-Ended-Sentence
|
2839
|
+
ADD 1 TO Src-Ptr
|
2840
|
+
END-IF
|
2841
|
+
SET Token-Is-Literal-Alpha TO TRUE
|
2842
|
+
EXIT PARAGRAPH
|
2843
|
+
END-IF
|
2844
|
+
IF F-Processing-PICTURE = "Y"
|
2845
|
+
UNSTRING Expand-Code-Rec
|
2846
|
+
DELIMITED BY ". " OR " "
|
2847
|
+
INTO SPI-Current-Token
|
2848
|
+
DELIMITER IN Delim
|
2849
|
+
WITH POINTER Src-Ptr
|
2850
|
+
END-UNSTRING
|
2851
|
+
IF Delim = ". "
|
2852
|
+
MOVE "Y" TO F-Token-Ended-Sentence
|
2853
|
+
ADD 1 TO Src-Ptr
|
2854
|
+
END-IF
|
2855
|
+
IF UPPER-CASE(SPI-Current-Token) = "IS"
|
2856
|
+
MOVE SPACE TO SPI-Token-Type
|
2857
|
+
EXIT PARAGRAPH
|
2858
|
+
ELSE
|
2859
|
+
MOVE "N" TO F-Processing-PICTURE
|
2860
|
+
MOVE SPACE TO SPI-Token-Type
|
2861
|
+
EXIT PARAGRAPH
|
2862
|
+
END-IF
|
2863
|
+
END-IF
|
2864
|
+
UNSTRING Expand-Code-Rec
|
2865
|
+
DELIMITED BY ". " OR " " OR "=" OR "(" OR ")" OR "*"
|
2866
|
+
OR "/" OR "&" OR ";" OR "," OR "<"
|
2867
|
+
OR ">" OR ":"
|
2868
|
+
INTO SPI-Current-Token
|
2869
|
+
DELIMITER IN Delim
|
2870
|
+
WITH POINTER Src-Ptr
|
2871
|
+
END-UNSTRING
|
2872
|
+
IF Delim = ". "
|
2873
|
+
MOVE "Y" TO F-Token-Ended-Sentence
|
2874
|
+
END-IF
|
2875
|
+
IF Delim NOT = ". " AND " "
|
2876
|
+
SUBTRACT 1 FROM Src-Ptr
|
2877
|
+
END-IF
|
2878
|
+
*>-- Classify Token
|
2879
|
+
MOVE UPPER-CASE(SPI-Current-Token) TO Search-Token
|
2880
|
+
IF Search-Token = "EQUAL" OR "EQUALS"
|
2881
|
+
MOVE "EQUALS" TO SPI-Current-Token
|
2882
|
+
MOVE "K" TO SPI-Token-Type
|
2883
|
+
EXIT PARAGRAPH
|
2884
|
+
END-IF
|
2885
|
+
SEARCH ALL Reserved-Word
|
2886
|
+
WHEN RW-Word (RW-Idx) = Search-Token
|
2887
|
+
MOVE RW-Type (RW-Idx) TO SPI-Token-Type
|
2888
|
+
GC0710 IF Token-Is-Verb
|
2889
|
+
GC0710 MOVE "Y" TO F-Verb-Has-Been-Found
|
2890
|
+
GC0710 END-IF
|
2891
|
+
EXIT PARAGRAPH
|
2892
|
+
END-SEARCH
|
2893
|
+
*>-- Not a reserved word, must be a user name
|
2894
|
+
SET Token-Is-Identifier TO TRUE *> NEEDS EXPANSION!!!!
|
2895
|
+
PERFORM 313-Check-For-Numeric-Token
|
2896
|
+
IF Token-Is-Literal-Number
|
2897
|
+
IF (F-Last-Token-Ended-Sent = "Y")
|
2898
|
+
AND (SPI-Current-Division = "D")
|
2899
|
+
MOVE "LEVEL #" TO SPI-Current-Token
|
2900
|
+
MOVE "K" TO SPI-Token-Type
|
2901
|
+
EXIT PARAGRAPH
|
2902
|
+
ELSE
|
2903
|
+
EXIT PARAGRAPH
|
2904
|
+
END-IF
|
2905
|
+
END-IF
|
2906
|
+
EXIT PARAGRAPH
|
2907
|
+
.
|
2908
|
+
*>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
|
2909
|
+
311-Control-Record.
|
2910
|
+
UNSTRING ECR-2-256
|
2911
|
+
DELIMITED BY '"'
|
2912
|
+
INTO PIC-X10, PIC-X256, Dummy
|
2913
|
+
END-UNSTRING
|
2914
|
+
INSPECT PIC-X10 REPLACING ALL '"' BY SPACE
|
2915
|
+
COMPUTE I = NUMVAL(PIC-X10) - 1
|
2916
|
+
IF TRIM(PIC-X256,Trailing) = TRIM(Program-Path,Trailing)
|
2917
|
+
MOVE I TO SPI-Current-Line-No
|
2918
|
+
SET In-Main-Module TO TRUE
|
2919
|
+
IF Saved-Section NOT = SPACES
|
2920
|
+
MOVE Saved-Section TO SPI-Current-Section
|
2921
|
+
END-IF
|
2922
|
+
ELSE
|
2923
|
+
SET In-Copybook TO TRUE
|
2924
|
+
IF Saved-Section = SPACES
|
2925
|
+
MOVE SPI-Current-Section TO Saved-Section
|
2926
|
+
END-IF
|
2927
|
+
MOVE LENGTH(TRIM(PIC-X256,Trailing)) TO I
|
2928
|
+
MOVE 0 TO J
|
2929
|
+
PERFORM UNTIL PIC-X256(I:1) = '/'
|
2930
|
+
OR I = 0
|
2931
|
+
SUBTRACT 1 FROM I
|
2932
|
+
ADD 1 TO J
|
2933
|
+
END-PERFORM
|
2934
|
+
UNSTRING PIC-X256((I + 1):J) DELIMITED BY "."
|
2935
|
+
INTO Filename, Dummy
|
2936
|
+
END-UNSTRING
|
2937
|
+
MOVE "[" TO SPI-CS-1
|
2938
|
+
MOVE Filename TO SPI-CS-2-14
|
2939
|
+
IF SPI-CS-11-14 NOT = SPACES
|
2940
|
+
MOVE "..." TO SPI-CS-11-14
|
2941
|
+
END-IF
|
2942
|
+
MOVE "]" TO SPI-CS-15
|
2943
|
+
END-IF
|
2944
|
+
MOVE SPACES TO Expand-Code-Rec *> Force another READ
|
2945
|
+
MOVE 256 TO Src-Ptr
|
2946
|
+
.
|
2947
|
+
*>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
|
2948
|
+
312-Expand-Code-Record.
|
2949
|
+
MOVE 1 TO Src-Ptr
|
2950
|
+
IF In-Main-Module
|
2951
|
+
ADD 1 To SPI-Current-Line-No
|
2952
|
+
END-IF
|
2953
|
+
.
|
2954
|
+
*>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
|
2955
|
+
313-Check-For-Numeric-Token.
|
2956
|
+
MOVE SPI-Current-Token TO PIC-X32
|
2957
|
+
INSPECT PIC-X32
|
2958
|
+
REPLACING TRAILING SPACES BY "0"
|
2959
|
+
IF PIC-X32 IS NUMERIC *> Simple Unsigned Integer
|
2960
|
+
SET Token-Is-Literal-Number TO TRUE
|
2961
|
+
EXIT PARAGRAPH
|
2962
|
+
END-IF
|
2963
|
+
IF PIC-X32(1:1) = "+" OR "-"
|
2964
|
+
MOVE "0" TO PIC-X32(1:1)
|
2965
|
+
END-IF
|
2966
|
+
MOVE 0 TO Tally
|
2967
|
+
INSPECT PIC-X32
|
2968
|
+
TALLYING Tally FOR ALL "."
|
2969
|
+
IF Tally = 1
|
2970
|
+
INSPECT PIC-X32 REPLACING ALL "." BY "0"
|
2971
|
+
END-IF
|
2972
|
+
IF PIC-X32 IS NUMERIC
|
2973
|
+
SET Token-Is-Literal-Number TO TRUE
|
2974
|
+
EXIT PARAGRAPH
|
2975
|
+
END-IF
|
2976
|
+
.
|
2977
|
+
*>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
|
2978
|
+
320-IDENTIFICATION-DIVISION.
|
2979
|
+
GC0710 MOVE "N" TO F-Verb-Has-Been-Found
|
2980
|
+
IF Token-Is-Key-Word AND SPI-Current-Token = "DIVISION"
|
2981
|
+
MOVE SPI-Prior-Token TO SPI-Current-Division
|
2982
|
+
EXIT PARAGRAPH
|
2983
|
+
END-IF
|
2984
|
+
IF SPI-Prior-Token = "PROGRAM-ID"
|
2985
|
+
MOVE SPACES TO SPI-Prior-Token
|
2986
|
+
MOVE SPI-Current-Token TO SPI-Current-Program-ID
|
2987
|
+
IF SPI-CP-13-15 NOT = SPACES
|
2988
|
+
MOVE "..." TO SPI-CP-13-15
|
2989
|
+
END-IF
|
2990
|
+
EXIT PARAGRAPH
|
2991
|
+
END-IF
|
2992
|
+
.
|
2993
|
+
*>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
|
2994
|
+
330-ENVIRONMENT-DIVISION.
|
2995
|
+
IF Token-Is-Key-Word AND SPI-Current-Token = "DIVISION"
|
2996
|
+
MOVE SPI-Prior-Token TO SPI-Current-Division
|
2997
|
+
EXIT PARAGRAPH
|
2998
|
+
END-IF
|
2999
|
+
IF Token-Is-Key-Word AND SPI-Current-Token = "SECTION"
|
3000
|
+
MOVE SPI-Prior-Token TO SPI-Current-Section
|
3001
|
+
EXIT PARAGRAPH
|
3002
|
+
END-IF
|
3003
|
+
IF Token-Is-Identifier
|
3004
|
+
PERFORM 361-Release-Ref
|
3005
|
+
END-IF
|
3006
|
+
.
|
3007
|
+
*>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
|
3008
|
+
340-DATA-DIVISION.
|
3009
|
+
IF Token-Is-Key-Word AND SPI-Current-Token = "DIVISION"
|
3010
|
+
MOVE SPI-Prior-Token TO SPI-Current-Division
|
3011
|
+
EXIT PARAGRAPH
|
3012
|
+
END-IF
|
3013
|
+
IF Token-Is-Key-Word AND SPI-Current-Token = "SECTION"
|
3014
|
+
MOVE SPI-Prior-Token TO SPI-Current-Section
|
3015
|
+
EXIT PARAGRAPH
|
3016
|
+
END-IF
|
3017
|
+
IF (SPI-Current-Token = "PIC" OR "PICTURE")
|
3018
|
+
AND (Token-Is-Key-Word)
|
3019
|
+
MOVE "Y" TO F-Processing-PICTURE
|
3020
|
+
EXIT PARAGRAPH
|
3021
|
+
END-IF
|
3022
|
+
GC0710 IF Token-Is-Reserved-Word
|
3023
|
+
GC0710 AND SPI-Prior-Token = "LEVEL #"
|
3024
|
+
GC0710 MOVE SPACES TO SPI-Prior-Token
|
3025
|
+
GC0710 EXIT PARAGRAPH
|
3026
|
+
GC0710 END-IF
|
3027
|
+
IF Token-Is-Identifier
|
3028
|
+
EVALUATE SPI-Prior-Token
|
3029
|
+
WHEN "FD"
|
3030
|
+
PERFORM 360-Release-Def
|
3031
|
+
MOVE SPACES TO SPI-Prior-Token
|
3032
|
+
WHEN "SD"
|
3033
|
+
PERFORM 360-Release-Def
|
3034
|
+
MOVE SPACES TO SPI-Prior-Token
|
3035
|
+
WHEN "LEVEL #"
|
3036
|
+
PERFORM 360-Release-Def
|
3037
|
+
MOVE SPACES TO SPI-Prior-Token
|
3038
|
+
WHEN "INDEXED"
|
3039
|
+
PERFORM 360-Release-Def
|
3040
|
+
MOVE SPACES TO SPI-Prior-Token
|
3041
|
+
WHEN "USING"
|
3042
|
+
PERFORM 362-Release-Upd
|
3043
|
+
MOVE SPACES TO SPI-Prior-Token
|
3044
|
+
WHEN "INTO"
|
3045
|
+
PERFORM 362-Release-Upd
|
3046
|
+
MOVE SPACES TO SPI-Prior-Token
|
3047
|
+
WHEN OTHER
|
3048
|
+
PERFORM 361-Release-Ref
|
3049
|
+
END-EVALUATE
|
3050
|
+
EXIT PARAGRAPH
|
3051
|
+
END-IF
|
3052
|
+
.
|
3053
|
+
*>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
|
3054
|
+
350-PROCEDURE-DIVISION.
|
3055
|
+
IF SPI-Current-Section NOT = "PROCEDURE"
|
3056
|
+
MOVE "PROCEDURE" TO SPI-Current-Section
|
3057
|
+
END-IF
|
3058
|
+
GC0710 IF SPI-Current-Token-UC = "PROGRAM"
|
3059
|
+
GC0710 AND SPI-Prior-Token = "END"
|
3060
|
+
GC0710 MOVE "?" TO SPI-Current-Division
|
3061
|
+
GC0710 EXIT PARAGRAPH
|
3062
|
+
GC0710 END-IF
|
3063
|
+
IF Token-Is-Key-Word AND SPI-Current-Token = "DIVISION"
|
3064
|
+
MOVE SPI-Prior-Token TO SPI-Current-Division
|
3065
|
+
EXIT PARAGRAPH
|
3066
|
+
END-IF
|
3067
|
+
IF SPI-Current-Verb = SPACES
|
3068
|
+
GC0710 AND F-Verb-Has-Been-Found = "Y"
|
3069
|
+
IF Token-Is-Identifier
|
3070
|
+
PERFORM 360-Release-Def
|
3071
|
+
MOVE SPACES TO SPI-Prior-Token
|
3072
|
+
END-IF
|
3073
|
+
EXIT PARAGRAPH
|
3074
|
+
END-IF
|
3075
|
+
IF NOT Token-Is-Identifier
|
3076
|
+
EXIT PARAGRAPH
|
3077
|
+
END-IF
|
3078
|
+
EVALUATE SPI-Current-Verb
|
3079
|
+
WHEN "ACCEPT"
|
3080
|
+
PERFORM 351-ACCEPT
|
3081
|
+
WHEN "ADD"
|
3082
|
+
PERFORM 351-ADD
|
3083
|
+
WHEN "ALLOCATE"
|
3084
|
+
PERFORM 351-ALLOCATE
|
3085
|
+
WHEN "CALL"
|
3086
|
+
PERFORM 351-CALL
|
3087
|
+
WHEN "COMPUTE"
|
3088
|
+
PERFORM 351-COMPUTE
|
3089
|
+
WHEN "DIVIDE"
|
3090
|
+
PERFORM 351-DIVIDE
|
3091
|
+
WHEN "FREE"
|
3092
|
+
PERFORM 351-FREE
|
3093
|
+
WHEN "INITIALIZE"
|
3094
|
+
PERFORM 351-INITIALIZE
|
3095
|
+
WHEN "INSPECT"
|
3096
|
+
PERFORM 351-INSPECT
|
3097
|
+
WHEN "MOVE"
|
3098
|
+
PERFORM 351-MOVE
|
3099
|
+
WHEN "MULTIPLY"
|
3100
|
+
PERFORM 351-MULTIPLY
|
3101
|
+
WHEN "PERFORM"
|
3102
|
+
PERFORM 351-PERFORM
|
3103
|
+
WHEN "SET"
|
3104
|
+
PERFORM 351-SET
|
3105
|
+
WHEN "STRING"
|
3106
|
+
PERFORM 351-STRING
|
3107
|
+
WHEN "SUBTRACT"
|
3108
|
+
PERFORM 351-SUBTRACT
|
3109
|
+
WHEN "TRANSFORM"
|
3110
|
+
PERFORM 351-TRANSFORM
|
3111
|
+
WHEN "UNSTRING"
|
3112
|
+
PERFORM 351-UNSTRING
|
3113
|
+
WHEN OTHER
|
3114
|
+
PERFORM 361-Release-Ref
|
3115
|
+
END-EVALUATE
|
3116
|
+
.
|
3117
|
+
*>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
|
3118
|
+
351-ACCEPT.
|
3119
|
+
EVALUATE SPI-Prior-Token
|
3120
|
+
WHEN "ACCEPT"
|
3121
|
+
PERFORM 362-Release-Upd
|
3122
|
+
MOVE SPACES TO SPI-Prior-Token
|
3123
|
+
WHEN OTHER
|
3124
|
+
PERFORM 361-Release-Ref
|
3125
|
+
END-EVALUATE
|
3126
|
+
.
|
3127
|
+
*>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
|
3128
|
+
351-ADD.
|
3129
|
+
EVALUATE SPI-Prior-Token
|
3130
|
+
WHEN "GIVING"
|
3131
|
+
PERFORM 362-Release-Upd
|
3132
|
+
WHEN "TO"
|
3133
|
+
PERFORM 362-Release-Upd
|
3134
|
+
WHEN OTHER
|
3135
|
+
PERFORM 361-Release-Ref
|
3136
|
+
END-EVALUATE
|
3137
|
+
.
|
3138
|
+
*>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
|
3139
|
+
351-ALLOCATE.
|
3140
|
+
EVALUATE SPI-Prior-Token
|
3141
|
+
WHEN "ALLOCATE"
|
3142
|
+
PERFORM 362-Release-Upd
|
3143
|
+
MOVE SPACES TO SPI-Prior-Token
|
3144
|
+
WHEN "RETURNING"
|
3145
|
+
PERFORM 362-Release-Upd
|
3146
|
+
WHEN OTHER
|
3147
|
+
PERFORM 361-Release-Ref
|
3148
|
+
END-EVALUATE
|
3149
|
+
.
|
3150
|
+
*>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
|
3151
|
+
351-CALL.
|
3152
|
+
EVALUATE SPI-Prior-Token
|
3153
|
+
WHEN "RETURNING"
|
3154
|
+
PERFORM 362-Release-Upd
|
3155
|
+
WHEN "GIVING"
|
3156
|
+
PERFORM 362-Release-Upd
|
3157
|
+
WHEN OTHER
|
3158
|
+
PERFORM 361-Release-Ref
|
3159
|
+
END-EVALUATE
|
3160
|
+
.
|
3161
|
+
*>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
|
3162
|
+
351-COMPUTE.
|
3163
|
+
EVALUATE SPI-Prior-Token
|
3164
|
+
WHEN "COMPUTE"
|
3165
|
+
PERFORM 362-Release-Upd
|
3166
|
+
WHEN OTHER
|
3167
|
+
PERFORM 361-Release-Ref
|
3168
|
+
END-EVALUATE
|
3169
|
+
.
|
3170
|
+
*>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
|
3171
|
+
351-DIVIDE.
|
3172
|
+
EVALUATE SPI-Prior-Token
|
3173
|
+
WHEN "INTO"
|
3174
|
+
PERFORM 363-Set-Upd
|
3175
|
+
MOVE Sort-Rec TO Held-Reference
|
3176
|
+
WHEN "GIVING"
|
3177
|
+
IF Held-Reference NOT = SPACES
|
3178
|
+
MOVE Held-Reference To Sort-Rec
|
3179
|
+
MOVE SPACES To Held-Reference
|
3180
|
+
SR-Ref-Flag
|
3181
|
+
RELEASE Sort-Rec
|
3182
|
+
END-IF
|
3183
|
+
PERFORM 362-Release-Upd
|
3184
|
+
WHEN "REMAINDER"
|
3185
|
+
PERFORM 362-Release-Upd
|
3186
|
+
WHEN OTHER
|
3187
|
+
PERFORM 361-Release-Ref
|
3188
|
+
END-EVALUATE
|
3189
|
+
.
|
3190
|
+
*>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
|
3191
|
+
351-FREE.
|
3192
|
+
PERFORM 362-Release-Upd
|
3193
|
+
.
|
3194
|
+
*>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
|
3195
|
+
351-INITIALIZE.
|
3196
|
+
EVALUATE SPI-Prior-Token
|
3197
|
+
WHEN "INITIALIZE"
|
3198
|
+
PERFORM 362-Release-Upd
|
3199
|
+
WHEN "REPLACING"
|
3200
|
+
PERFORM 361-Release-Ref
|
3201
|
+
END-EVALUATE
|
3202
|
+
.
|
3203
|
+
*>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
|
3204
|
+
351-INSPECT.
|
3205
|
+
EVALUATE SPI-Prior-Token
|
3206
|
+
WHEN "INSPECT"
|
3207
|
+
PERFORM 364-Set-Ref
|
3208
|
+
MOVE SPACES TO Held-Reference
|
3209
|
+
MOVE SPACES TO SPI-Prior-Token
|
3210
|
+
WHEN "TALLYING"
|
3211
|
+
PERFORM 362-Release-Upd
|
3212
|
+
MOVE SPACES TO SPI-Prior-Token
|
3213
|
+
WHEN "REPLACING"
|
3214
|
+
IF Held-Reference NOT = SPACES
|
3215
|
+
MOVE Held-Reference TO Sort-Rec
|
3216
|
+
MOVE SPACES TO Held-Reference
|
3217
|
+
MOVE "*" TO SR-Ref-Flag
|
3218
|
+
RELEASE Sort-Rec
|
3219
|
+
END-IF
|
3220
|
+
MOVE SPACES TO SPI-Prior-Token
|
3221
|
+
WHEN "CONVERTING"
|
3222
|
+
IF Held-Reference NOT = SPACES
|
3223
|
+
MOVE Held-Reference TO Sort-Rec
|
3224
|
+
MOVE SPACES TO Held-Reference
|
3225
|
+
MOVE "*" TO SR-Ref-Flag
|
3226
|
+
RELEASE Sort-Rec
|
3227
|
+
END-IF
|
3228
|
+
MOVE SPACES TO SPI-Prior-Token
|
3229
|
+
WHEN OTHER
|
3230
|
+
PERFORM 361-Release-Ref
|
3231
|
+
END-EVALUATE
|
3232
|
+
.
|
3233
|
+
*>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
|
3234
|
+
351-MOVE.
|
3235
|
+
EVALUATE SPI-Prior-Token
|
3236
|
+
WHEN "TO"
|
3237
|
+
PERFORM 362-Release-Upd
|
3238
|
+
WHEN OTHER
|
3239
|
+
PERFORM 361-Release-Ref
|
3240
|
+
END-EVALUATE
|
3241
|
+
.
|
3242
|
+
*>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
|
3243
|
+
351-MULTIPLY.
|
3244
|
+
EVALUATE SPI-Prior-Token
|
3245
|
+
WHEN "BY"
|
3246
|
+
PERFORM 363-Set-Upd
|
3247
|
+
MOVE Sort-Rec TO Held-Reference
|
3248
|
+
WHEN "GIVING"
|
3249
|
+
MOVE Held-Reference TO Sort-Rec
|
3250
|
+
MOVE SPACES TO Held-Reference
|
3251
|
+
SR-Ref-Flag
|
3252
|
+
RELEASE Sort-Rec
|
3253
|
+
PERFORM 362-Release-Upd
|
3254
|
+
WHEN OTHER
|
3255
|
+
PERFORM 361-Release-Ref
|
3256
|
+
END-EVALUATE
|
3257
|
+
.
|
3258
|
+
*>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
|
3259
|
+
351-PERFORM.
|
3260
|
+
EVALUATE SPI-Prior-Token
|
3261
|
+
WHEN "VARYING"
|
3262
|
+
PERFORM 362-Release-Upd
|
3263
|
+
MOVE SPACES TO SPI-Prior-Token
|
3264
|
+
WHEN "AFTER"
|
3265
|
+
PERFORM 362-Release-Upd
|
3266
|
+
MOVE SPACES TO SPI-Prior-Token
|
3267
|
+
WHEN OTHER
|
3268
|
+
PERFORM 361-Release-Ref
|
3269
|
+
END-EVALUATE
|
3270
|
+
.
|
3271
|
+
*>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
|
3272
|
+
351-SET.
|
3273
|
+
EVALUATE SPI-Prior-Token
|
3274
|
+
WHEN "SET"
|
3275
|
+
PERFORM 362-Release-Upd
|
3276
|
+
WHEN OTHER
|
3277
|
+
PERFORM 361-Release-Ref
|
3278
|
+
END-EVALUATE
|
3279
|
+
.
|
3280
|
+
*>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
|
3281
|
+
351-STRING.
|
3282
|
+
EVALUATE SPI-Prior-Token
|
3283
|
+
WHEN "INTO"
|
3284
|
+
PERFORM 362-Release-Upd
|
3285
|
+
WHEN "POINTER"
|
3286
|
+
PERFORM 362-Release-Upd
|
3287
|
+
WHEN OTHER
|
3288
|
+
PERFORM 361-Release-Ref
|
3289
|
+
END-EVALUATE
|
3290
|
+
.
|
3291
|
+
*>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
|
3292
|
+
351-SUBTRACT.
|
3293
|
+
EVALUATE SPI-Prior-Token
|
3294
|
+
WHEN "GIVING"
|
3295
|
+
PERFORM 362-Release-Upd
|
3296
|
+
WHEN "FROM"
|
3297
|
+
PERFORM 362-Release-Upd
|
3298
|
+
WHEN OTHER
|
3299
|
+
PERFORM 361-Release-Ref
|
3300
|
+
END-EVALUATE
|
3301
|
+
.
|
3302
|
+
*>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
|
3303
|
+
351-TRANSFORM.
|
3304
|
+
EVALUATE SPI-Prior-Token
|
3305
|
+
WHEN "TRANSFORM"
|
3306
|
+
PERFORM 362-Release-Upd
|
3307
|
+
MOVE SPACES TO SPI-Prior-Token
|
3308
|
+
WHEN OTHER
|
3309
|
+
PERFORM 361-Release-Ref
|
3310
|
+
END-EVALUATE
|
3311
|
+
.
|
3312
|
+
*>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
|
3313
|
+
351-UNSTRING.
|
3314
|
+
EVALUATE SPI-Prior-Token
|
3315
|
+
WHEN "INTO"
|
3316
|
+
PERFORM 362-Release-Upd
|
3317
|
+
WHEN "DELIMITER"
|
3318
|
+
PERFORM 362-Release-Upd
|
3319
|
+
WHEN "COUNT"
|
3320
|
+
PERFORM 362-Release-Upd
|
3321
|
+
WHEN "POINTER"
|
3322
|
+
PERFORM 362-Release-Upd
|
3323
|
+
WHEN "TALLYING"
|
3324
|
+
PERFORM 362-Release-Upd
|
3325
|
+
WHEN OTHER
|
3326
|
+
PERFORM 361-Release-Ref
|
3327
|
+
END-EVALUATE
|
3328
|
+
.
|
3329
|
+
*>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
|
3330
|
+
360-Release-Def.
|
3331
|
+
MOVE SPACES TO Sort-Rec
|
3332
|
+
MOVE SPI-Current-Program-ID TO SR-Prog-ID
|
3333
|
+
MOVE SPI-Current-Token-UC TO SR-Token-UC
|
3334
|
+
MOVE SPI-Current-Token TO SR-Token
|
3335
|
+
MOVE SPI-Current-Section TO SR-Section
|
3336
|
+
MOVE SPI-Current-Line-No TO SR-Line-No-Def
|
3337
|
+
MOVE 0 TO SR-Line-No-Ref
|
3338
|
+
RELEASE Sort-Rec
|
3339
|
+
.
|
3340
|
+
*>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
|
3341
|
+
361-Release-Ref.
|
3342
|
+
PERFORM 364-Set-Ref
|
3343
|
+
RELEASE Sort-Rec
|
3344
|
+
.
|
3345
|
+
*>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
|
3346
|
+
362-Release-Upd.
|
3347
|
+
PERFORM 363-Set-Upd
|
3348
|
+
RELEASE Sort-Rec
|
3349
|
+
.
|
3350
|
+
*>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
|
3351
|
+
363-Set-Upd.
|
3352
|
+
MOVE SPACES TO Sort-Rec
|
3353
|
+
MOVE SPI-Current-Program-ID TO SR-Prog-ID
|
3354
|
+
MOVE SPI-Current-Token-UC TO SR-Token-UC
|
3355
|
+
MOVE SPI-Current-Token TO SR-Token
|
3356
|
+
MOVE SPI-Current-Section TO SR-Section
|
3357
|
+
MOVE SPI-Current-Line-No TO SR-Line-No-Ref
|
3358
|
+
MOVE "*" TO SR-Ref-Flag
|
3359
|
+
.
|
3360
|
+
*>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
|
3361
|
+
364-Set-Ref.
|
3362
|
+
MOVE SPACES TO Sort-Rec
|
3363
|
+
MOVE SPI-Current-Program-ID TO SR-Prog-ID
|
3364
|
+
MOVE SPI-Current-Token-UC TO SR-Token-UC
|
3365
|
+
MOVE SPI-Current-Token TO SR-Token
|
3366
|
+
MOVE SPI-Current-Section TO SR-Section
|
3367
|
+
MOVE SPI-Current-Line-No TO SR-Line-No-Ref
|
3368
|
+
.
|
3369
|
+
/
|
3370
|
+
400-Produce-Xref-Listing SECTION.
|
3371
|
+
401-Init.
|
3372
|
+
MOVE SPACES TO Detail-Line-X
|
3373
|
+
Group-Indicators
|
3374
|
+
MOVE 0 TO I
|
3375
|
+
Lines-Left
|
3376
|
+
GC0710 MOVE 'N' TO F-Duplicate
|
3377
|
+
.
|
3378
|
+
|
3379
|
+
402-Process-Sorted-Recs.
|
3380
|
+
PERFORM FOREVER
|
3381
|
+
RETURN Sort-File AT END
|
3382
|
+
EXIT PERFORM
|
3383
|
+
END-RETURN
|
3384
|
+
IF SR-Prog-ID NOT = GI-Prog-ID
|
3385
|
+
OR SR-Token-UC NOT = GI-Token
|
3386
|
+
GC0710 MOVE 'N' TO F-Duplicate
|
3387
|
+
IF Detail-Line-X NOT = SPACES
|
3388
|
+
PERFORM 410-Generate-Report-Line
|
3389
|
+
END-IF
|
3390
|
+
IF SR-Prog-ID NOT = GI-Prog-ID
|
3391
|
+
MOVE 0 TO Lines-Left
|
3392
|
+
END-IF
|
3393
|
+
MOVE SR-Prog-ID TO GI-Prog-ID
|
3394
|
+
MOVE SR-Token-UC TO GI-Token
|
3395
|
+
END-IF
|
3396
|
+
GC0710 IF SR-Token-UC = GI-Token
|
3397
|
+
GC0710 AND SR-Line-No-Def NOT = SPACES
|
3398
|
+
GC0710 AND Detail-Line-X NOT = SPACES
|
3399
|
+
GC0710 MOVE 'Y' TO F-Duplicate
|
3400
|
+
GC0710 PERFORM 410-Generate-Report-Line
|
3401
|
+
GC0710 MOVE 0 TO I
|
3402
|
+
GC0710 MOVE SR-Prog-ID TO DLX-Prog-ID
|
3403
|
+
GC0710 MOVE ' (Duplicate Definition)' TO DLX-Token
|
3404
|
+
GC0710 MOVE SR-Section TO DLX-Section
|
3405
|
+
GC0710 MOVE SR-Line-No-Def TO DLX-Line-No-Def
|
3406
|
+
GC0710 EXIT PERFORM CYCLE
|
3407
|
+
GC0710 END-IF
|
3408
|
+
GC0710 IF SR-Token-UC = GI-Token
|
3409
|
+
GC0710 AND SR-Line-No-Def = SPACES
|
3410
|
+
GC0710 AND F-Duplicate = 'Y'
|
3411
|
+
GC0710 MOVE 'N' TO F-Duplicate
|
3412
|
+
GC0710 PERFORM 410-Generate-Report-Line
|
3413
|
+
GC0710 MOVE 0 TO I
|
3414
|
+
GC0710 MOVE SR-Prog-ID TO DLX-Prog-ID
|
3415
|
+
GC0710 MOVE ' (Duplicate References)' TO DLX-Token
|
3416
|
+
GC0710 END-IF
|
3417
|
+
IF Detail-Line-X = SPACES
|
3418
|
+
MOVE SR-Prog-ID TO DLX-Prog-ID
|
3419
|
+
MOVE SR-Token TO DLX-Token
|
3420
|
+
MOVE SR-Section TO DLX-Section
|
3421
|
+
IF SR-Line-No-Def NOT = SPACES
|
3422
|
+
MOVE SR-Line-No-Def TO DLX-Line-No-Def
|
3423
|
+
END-IF
|
3424
|
+
END-IF
|
3425
|
+
IF SR-Reference > '000000'
|
3426
|
+
ADD 1 TO I
|
3427
|
+
IF I > Line-Nos-Per-Rec
|
3428
|
+
PERFORM 410-Generate-Report-Line
|
3429
|
+
MOVE 1 TO I
|
3430
|
+
END-IF
|
3431
|
+
MOVE SR-Line-No-Ref TO DLX-Line-No-Ref (I)
|
3432
|
+
MOVE SR-Ref-Flag TO DLX-Ref-Flag (I)
|
3433
|
+
END-IF
|
3434
|
+
END-PERFORM
|
3435
|
+
IF Detail-Line-X NOT = SPACES
|
3436
|
+
PERFORM 410-Generate-Report-Line
|
3437
|
+
END-IF
|
3438
|
+
EXIT SECTION
|
3439
|
+
.
|
3440
|
+
*>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
|
3441
|
+
410-Generate-Report-Line.
|
3442
|
+
IF Lines-Left < 1
|
3443
|
+
IF F-First-Record = "Y"
|
3444
|
+
MOVE "N" TO F-First-Record
|
3445
|
+
WRITE Report-Rec FROM Heading-1X BEFORE 1
|
3446
|
+
ELSE
|
3447
|
+
MOVE SPACES TO Report-Rec
|
3448
|
+
WRITE Report-Rec BEFORE PAGE
|
3449
|
+
MOVE SPACES TO Report-Rec
|
3450
|
+
WRITE Report-Rec BEFORE 1
|
3451
|
+
WRITE Report-Rec FROM Heading-1X BEFORE 1
|
3452
|
+
END-IF
|
3453
|
+
WRITE Report-Rec FROM Heading-2 BEFORE 1
|
3454
|
+
WRITE Report-Rec FROM Heading-4X BEFORE 1
|
3455
|
+
WRITE Report-Rec FROM Heading-5X BEFORE 1
|
3456
|
+
COMPUTE
|
3457
|
+
Lines-Left = Lines-Per-Page - 4
|
3458
|
+
END-COMPUTE
|
3459
|
+
END-IF
|
3460
|
+
WRITE Report-Rec FROM Detail-Line-X BEFORE 1
|
3461
|
+
MOVE SPACES TO Detail-Line-X
|
3462
|
+
MOVE 0 TO I
|
3463
|
+
SUBTRACT 1 FROM Lines-Left
|
3464
|
+
.
|
3465
|
+
/
|
3466
|
+
500-Produce-Source-Listing SECTION.
|
3467
|
+
501-Generate-Source-Listing.
|
3468
|
+
OPEN INPUT Source-Code
|
3469
|
+
Expand-Code
|
3470
|
+
MOVE 0 TO Source-Line-No
|
3471
|
+
PERFORM FOREVER
|
3472
|
+
READ Expand-Code AT END
|
3473
|
+
EXIT PERFORM
|
3474
|
+
END-READ
|
3475
|
+
IF ECR-1 = "#"
|
3476
|
+
PERFORM 510-Control-Record
|
3477
|
+
ELSE
|
3478
|
+
PERFORM 520-Expand-Code-Record
|
3479
|
+
END-IF
|
3480
|
+
END-PERFORM
|
3481
|
+
CLOSE Source-Code
|
3482
|
+
Expand-Code
|
3483
|
+
EXIT SECTION
|
3484
|
+
.
|
3485
|
+
*>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
|
3486
|
+
510-Control-Record.
|
3487
|
+
UNSTRING ECR-2-256
|
3488
|
+
DELIMITED BY '"'
|
3489
|
+
INTO PIC-X10, PIC-X256, Dummy
|
3490
|
+
END-UNSTRING
|
3491
|
+
IF TRIM(PIC-X256,Trailing) = TRIM(Program-Path,Trailing) *> Main Pgm
|
3492
|
+
SET In-Main-Module TO TRUE
|
3493
|
+
IF Source-Line-No > 0
|
3494
|
+
READ Expand-Code END-READ
|
3495
|
+
END-IF
|
3496
|
+
ELSE *> COPY
|
3497
|
+
SET In-Copybook TO TRUE
|
3498
|
+
END-IF
|
3499
|
+
.
|
3500
|
+
*>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
|
3501
|
+
520-Expand-Code-Record.
|
3502
|
+
IF In-Main-Module
|
3503
|
+
ADD 1 To SPI-Current-Line-No
|
3504
|
+
READ Source-Code AT END NEXT SENTENCE END-READ
|
3505
|
+
ADD 1 TO Source-Line-No
|
3506
|
+
MOVE SPACES TO Detail-Line-S
|
3507
|
+
MOVE Source-Line-No TO DLS-Line-No
|
3508
|
+
MOVE SCR-1-128 TO DLS-Statement
|
3509
|
+
GC0410 IF SCR-7 = "/"
|
3510
|
+
GC0410 MOVE 0 TO Lines-Left
|
3511
|
+
GC0410 END-IF
|
3512
|
+
PERFORM 530-Generate-Source-Line
|
3513
|
+
IF SCR-129-256 NOT = SPACES
|
3514
|
+
MOVE SPACES TO Detail-Line-S
|
3515
|
+
MOVE SCR-129-256 TO DLS-Statement
|
3516
|
+
PERFORM 530-Generate-Source-Line
|
3517
|
+
END-IF
|
3518
|
+
ELSE
|
3519
|
+
IF Expand-Code-Rec NOT = SPACES
|
3520
|
+
MOVE SPACES TO Detail-Line-S
|
3521
|
+
MOVE ECR-1-128 TO DLS-Statement
|
3522
|
+
PERFORM 530-Generate-Source-Line
|
3523
|
+
IF ECR-129-256 NOT = SPACES
|
3524
|
+
MOVE SPACES TO Detail-Line-S
|
3525
|
+
MOVE ECR-129-256 TO DLS-Statement
|
3526
|
+
PERFORM 530-Generate-Source-Line
|
3527
|
+
END-IF
|
3528
|
+
END-IF
|
3529
|
+
END-IF
|
3530
|
+
.
|
3531
|
+
*>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
|
3532
|
+
530-Generate-Source-Line.
|
3533
|
+
IF Lines-Left < 1
|
3534
|
+
IF F-First-Record = "Y"
|
3535
|
+
MOVE "N" TO F-First-Record
|
3536
|
+
WRITE Report-Rec FROM Heading-1S BEFORE 1
|
3537
|
+
ELSE
|
3538
|
+
MOVE SPACES TO Report-Rec
|
3539
|
+
WRITE Report-Rec BEFORE PAGE
|
3540
|
+
MOVE SPACES TO Report-Rec
|
3541
|
+
WRITE Report-Rec BEFORE 1
|
3542
|
+
WRITE Report-Rec FROM Heading-1S BEFORE 1
|
3543
|
+
END-IF
|
3544
|
+
WRITE Report-Rec FROM Heading-2 BEFORE 1
|
3545
|
+
WRITE Report-Rec FROM Heading-4S BEFORE 1
|
3546
|
+
WRITE Report-Rec FROM Heading-5S BEFORE 1
|
3547
|
+
COMPUTE
|
3548
|
+
Lines-Left = Lines-Per-Page - 4
|
3549
|
+
END-COMPUTE
|
3550
|
+
END-IF
|
3551
|
+
WRITE Report-Rec FROM Detail-Line-S BEFORE 1
|
3552
|
+
MOVE SPACES TO Detail-Line-S
|
3553
|
+
SUBTRACT 1 FROM Lines-Left
|
3554
|
+
.
|
3555
|
+
|
3556
|
+
END PROGRAM LISTING.
|