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.
Files changed (199) hide show
  1. checksums.yaml +7 -0
  2. data/.gitignore +1 -0
  3. data/CHANGELOG.md +71 -0
  4. data/Gemfile +1 -1
  5. data/LICENSE +17 -0
  6. data/README.md +28 -1
  7. data/Rakefile +2 -5
  8. data/lexers +0 -0
  9. data/lib/pygments/mentos.py +19 -12
  10. data/lib/pygments/popen.rb +21 -4
  11. data/lib/pygments/version.rb +1 -1
  12. data/pygments.rb.gemspec +2 -0
  13. data/test/test_pygments.rb +13 -2
  14. data/vendor/custom_lexers/github.py +206 -3
  15. data/vendor/pygments-main/AUTHORS +41 -3
  16. data/vendor/pygments-main/CHANGES +132 -5
  17. data/vendor/pygments-main/LICENSE +1 -1
  18. data/vendor/pygments-main/Makefile +1 -1
  19. data/vendor/pygments-main/REVISION +1 -1
  20. data/vendor/pygments-main/docs/generate.py +1 -1
  21. data/vendor/pygments-main/docs/src/api.txt +1 -1
  22. data/vendor/pygments-main/docs/src/index.txt +1 -1
  23. data/vendor/pygments-main/docs/src/integrate.txt +5 -0
  24. data/vendor/pygments-main/docs/src/java.txt +70 -0
  25. data/vendor/pygments-main/docs/src/lexerdevelopment.txt +52 -0
  26. data/vendor/pygments-main/external/autopygmentize +64 -0
  27. data/vendor/pygments-main/external/lasso-builtins-generator-9.lasso +144 -0
  28. data/vendor/pygments-main/external/markdown-processor.py +2 -2
  29. data/vendor/pygments-main/external/moin-parser.py +1 -1
  30. data/vendor/pygments-main/external/rst-directive-old.py +1 -1
  31. data/vendor/pygments-main/external/rst-directive.py +1 -1
  32. data/vendor/pygments-main/pygmentize +1 -1
  33. data/vendor/pygments-main/pygments/__init__.py +2 -2
  34. data/vendor/pygments-main/pygments/cmdline.py +14 -6
  35. data/vendor/pygments-main/pygments/console.py +1 -1
  36. data/vendor/pygments-main/pygments/filter.py +1 -1
  37. data/vendor/pygments-main/pygments/filters/__init__.py +3 -4
  38. data/vendor/pygments-main/pygments/formatter.py +4 -1
  39. data/vendor/pygments-main/pygments/formatters/__init__.py +1 -1
  40. data/vendor/pygments-main/pygments/formatters/_mapping.py +3 -3
  41. data/vendor/pygments-main/pygments/formatters/bbcode.py +1 -1
  42. data/vendor/pygments-main/pygments/formatters/html.py +73 -2
  43. data/vendor/pygments-main/pygments/formatters/img.py +2 -2
  44. data/vendor/pygments-main/pygments/formatters/latex.py +9 -9
  45. data/vendor/pygments-main/pygments/formatters/other.py +1 -3
  46. data/vendor/pygments-main/pygments/formatters/rtf.py +1 -1
  47. data/vendor/pygments-main/pygments/formatters/svg.py +1 -1
  48. data/vendor/pygments-main/pygments/formatters/terminal.py +1 -1
  49. data/vendor/pygments-main/pygments/formatters/terminal256.py +1 -1
  50. data/vendor/pygments-main/pygments/lexer.py +78 -10
  51. data/vendor/pygments-main/pygments/lexers/__init__.py +13 -2
  52. data/vendor/pygments-main/pygments/lexers/_asybuiltins.py +1 -1
  53. data/vendor/pygments-main/pygments/lexers/_clbuiltins.py +1 -1
  54. data/vendor/pygments-main/pygments/lexers/_lassobuiltins.py +5172 -0
  55. data/vendor/pygments-main/pygments/lexers/_luabuiltins.py +1 -1
  56. data/vendor/pygments-main/pygments/lexers/_mapping.py +92 -36
  57. data/vendor/pygments-main/pygments/lexers/_openedgebuiltins.py +562 -0
  58. data/vendor/pygments-main/pygments/lexers/_phpbuiltins.py +2 -2
  59. data/vendor/pygments-main/pygments/lexers/_postgres_builtins.py +4 -3
  60. data/vendor/pygments-main/pygments/lexers/_robotframeworklexer.py +557 -0
  61. data/vendor/pygments-main/pygments/lexers/_scilab_builtins.py +11 -0
  62. data/vendor/pygments-main/pygments/lexers/_sourcemodbuiltins.py +1072 -0
  63. data/vendor/pygments-main/pygments/lexers/_stan_builtins.py +360 -0
  64. data/vendor/pygments-main/pygments/lexers/_vimbuiltins.py +13 -3
  65. data/vendor/pygments-main/pygments/lexers/agile.py +525 -38
  66. data/vendor/pygments-main/pygments/lexers/asm.py +45 -7
  67. data/vendor/pygments-main/pygments/lexers/compiled.py +1257 -425
  68. data/vendor/pygments-main/pygments/lexers/dalvik.py +104 -0
  69. data/vendor/pygments-main/pygments/lexers/dotnet.py +97 -62
  70. data/vendor/pygments-main/pygments/lexers/foxpro.py +428 -0
  71. data/vendor/pygments-main/pygments/lexers/functional.py +931 -32
  72. data/vendor/pygments-main/pygments/lexers/github.py +206 -3
  73. data/vendor/pygments-main/pygments/lexers/hdl.py +3 -3
  74. data/vendor/pygments-main/pygments/lexers/jvm.py +309 -44
  75. data/vendor/pygments-main/pygments/lexers/math.py +876 -30
  76. data/vendor/pygments-main/pygments/lexers/other.py +956 -517
  77. data/vendor/pygments-main/pygments/lexers/parsers.py +85 -2
  78. data/vendor/pygments-main/pygments/lexers/shell.py +81 -18
  79. data/vendor/pygments-main/pygments/lexers/special.py +1 -1
  80. data/vendor/pygments-main/pygments/lexers/sql.py +2 -2
  81. data/vendor/pygments-main/pygments/lexers/templates.py +119 -8
  82. data/vendor/pygments-main/pygments/lexers/text.py +155 -15
  83. data/vendor/pygments-main/pygments/lexers/web.py +1578 -397
  84. data/vendor/pygments-main/pygments/modeline.py +40 -0
  85. data/vendor/pygments-main/pygments/plugin.py +1 -1
  86. data/vendor/pygments-main/pygments/scanner.py +1 -1
  87. data/vendor/pygments-main/pygments/style.py +1 -1
  88. data/vendor/pygments-main/pygments/styles/__init__.py +1 -1
  89. data/vendor/pygments-main/pygments/styles/autumn.py +1 -1
  90. data/vendor/pygments-main/pygments/styles/borland.py +1 -1
  91. data/vendor/pygments-main/pygments/styles/bw.py +1 -1
  92. data/vendor/pygments-main/pygments/styles/colorful.py +1 -1
  93. data/vendor/pygments-main/pygments/styles/default.py +1 -1
  94. data/vendor/pygments-main/pygments/styles/emacs.py +1 -1
  95. data/vendor/pygments-main/pygments/styles/friendly.py +1 -1
  96. data/vendor/pygments-main/pygments/styles/fruity.py +1 -1
  97. data/vendor/pygments-main/pygments/styles/manni.py +1 -1
  98. data/vendor/pygments-main/pygments/styles/monokai.py +1 -1
  99. data/vendor/pygments-main/pygments/styles/murphy.py +1 -1
  100. data/vendor/pygments-main/pygments/styles/native.py +1 -1
  101. data/vendor/pygments-main/pygments/styles/pastie.py +1 -1
  102. data/vendor/pygments-main/pygments/styles/perldoc.py +1 -1
  103. data/vendor/pygments-main/pygments/styles/rrt.py +1 -1
  104. data/vendor/pygments-main/pygments/styles/tango.py +1 -1
  105. data/vendor/pygments-main/pygments/styles/trac.py +1 -1
  106. data/vendor/pygments-main/pygments/styles/vim.py +1 -1
  107. data/vendor/pygments-main/pygments/styles/vs.py +1 -1
  108. data/vendor/pygments-main/pygments/token.py +1 -1
  109. data/vendor/pygments-main/pygments/unistring.py +36 -26
  110. data/vendor/pygments-main/pygments/util.py +46 -1
  111. data/vendor/pygments-main/scripts/check_sources.py +2 -2
  112. data/vendor/pygments-main/scripts/detect_missing_analyse_text.py +2 -0
  113. data/vendor/pygments-main/scripts/find_codetags.py +1 -1
  114. data/vendor/pygments-main/scripts/find_error.py +5 -6
  115. data/vendor/pygments-main/setup.cfg +1 -0
  116. data/vendor/pygments-main/setup.py +6 -4
  117. data/vendor/pygments-main/tests/examplefiles/BOM.js +1 -0
  118. data/vendor/pygments-main/tests/examplefiles/Config.in.cache +1973 -0
  119. data/vendor/pygments-main/tests/examplefiles/Deflate.fs +578 -0
  120. data/vendor/pygments-main/tests/examplefiles/Get-CommandDefinitionHtml.ps1 +66 -0
  121. data/vendor/pygments-main/tests/examplefiles/IPDispatchC.nc +104 -0
  122. data/vendor/pygments-main/tests/examplefiles/IPDispatchP.nc +671 -0
  123. data/vendor/pygments-main/tests/examplefiles/RoleQ.pm6 +23 -0
  124. data/vendor/pygments-main/tests/examplefiles/autoit_submit.au3 +25 -0
  125. data/vendor/pygments-main/tests/examplefiles/bigtest.nsi +308 -0
  126. data/vendor/pygments-main/tests/examplefiles/ca65_example +284 -0
  127. data/vendor/pygments-main/tests/examplefiles/cbmbas_example +9 -0
  128. data/vendor/pygments-main/tests/examplefiles/classes.dylan +89 -4
  129. data/vendor/pygments-main/tests/examplefiles/example.Rd +78 -0
  130. data/vendor/pygments-main/tests/examplefiles/example.bug +54 -0
  131. data/vendor/pygments-main/tests/examplefiles/example.ceylon +52 -0
  132. data/vendor/pygments-main/tests/examplefiles/example.clay +33 -0
  133. data/vendor/pygments-main/tests/examplefiles/example.cob +3556 -0
  134. data/vendor/pygments-main/tests/examplefiles/example.hx +142 -0
  135. data/vendor/pygments-main/tests/examplefiles/example.jag +48 -0
  136. data/vendor/pygments-main/tests/examplefiles/example.lagda +19 -0
  137. data/vendor/pygments-main/tests/examplefiles/example.monkey +152 -0
  138. data/vendor/pygments-main/tests/examplefiles/example.msc +43 -0
  139. data/vendor/pygments-main/tests/examplefiles/example.prg +161 -0
  140. data/vendor/pygments-main/tests/examplefiles/example.reg +19 -0
  141. data/vendor/pygments-main/tests/examplefiles/example.rexx +50 -0
  142. data/vendor/pygments-main/tests/examplefiles/example.rkt +95 -0
  143. data/vendor/pygments-main/tests/examplefiles/example.rpf +4 -0
  144. data/vendor/pygments-main/tests/examplefiles/example.shell-session +45 -0
  145. data/vendor/pygments-main/tests/examplefiles/example.stan +108 -0
  146. data/vendor/pygments-main/tests/examplefiles/example.ts +28 -0
  147. data/vendor/pygments-main/tests/examplefiles/example.xtend +34 -0
  148. data/vendor/pygments-main/tests/examplefiles/example2.msc +79 -0
  149. data/vendor/pygments-main/tests/examplefiles/garcia-wachs.kk +133 -0
  150. data/vendor/pygments-main/tests/examplefiles/grammar-test.p6 +22 -0
  151. data/vendor/pygments-main/tests/examplefiles/hello.smali +40 -0
  152. data/vendor/pygments-main/tests/examplefiles/hello.sp +9 -0
  153. data/vendor/pygments-main/tests/examplefiles/http_request_example +2 -1
  154. data/vendor/pygments-main/tests/examplefiles/http_response_example +4 -2
  155. data/vendor/pygments-main/tests/examplefiles/inet_pton6.dg +71 -0
  156. data/vendor/pygments-main/tests/examplefiles/json.lasso +301 -0
  157. data/vendor/pygments-main/tests/examplefiles/json.lasso9 +213 -0
  158. data/vendor/pygments-main/tests/examplefiles/livescript-demo.ls +41 -0
  159. data/vendor/pygments-main/tests/examplefiles/logos_example.xm +28 -0
  160. data/vendor/pygments-main/tests/examplefiles/matlab_sample +5 -2
  161. data/vendor/pygments-main/tests/examplefiles/metagrammar.treetop +455 -0
  162. data/vendor/pygments-main/tests/examplefiles/mg_sample.pro +73 -0
  163. data/vendor/pygments-main/tests/examplefiles/minehunt.qml +112 -0
  164. data/vendor/pygments-main/tests/examplefiles/nanomsg.intr +95 -0
  165. data/vendor/pygments-main/tests/examplefiles/objc_example.m +7 -0
  166. data/vendor/pygments-main/tests/examplefiles/phpMyAdmin.spec +163 -0
  167. data/vendor/pygments-main/tests/examplefiles/py3tb_test.py3tb +4 -0
  168. data/vendor/pygments-main/tests/examplefiles/pytb_test3.pytb +4 -0
  169. data/vendor/pygments-main/tests/examplefiles/robotframework.txt +39 -0
  170. data/vendor/pygments-main/tests/examplefiles/rust_example.rs +233 -0
  171. data/vendor/pygments-main/tests/examplefiles/session.dylan-console +9 -0
  172. data/vendor/pygments-main/tests/examplefiles/swig_java.swg +1329 -0
  173. data/vendor/pygments-main/tests/examplefiles/swig_std_vector.i +225 -0
  174. data/vendor/pygments-main/tests/examplefiles/test.R +149 -115
  175. data/vendor/pygments-main/tests/examplefiles/test.agda +102 -0
  176. data/vendor/pygments-main/tests/examplefiles/test.bb +95 -0
  177. data/vendor/pygments-main/tests/examplefiles/test.cu +36 -0
  178. data/vendor/pygments-main/tests/examplefiles/test.ebnf +31 -0
  179. data/vendor/pygments-main/tests/examplefiles/test.opa +10 -0
  180. data/vendor/pygments-main/tests/examplefiles/test.p6 +252 -0
  181. data/vendor/pygments-main/tests/examplefiles/test2.pypylog +120 -0
  182. data/vendor/pygments-main/tests/examplefiles/type.lisp +16 -0
  183. data/vendor/pygments-main/tests/examplefiles/unix-io.lid +37 -0
  184. data/vendor/pygments-main/tests/old_run.py +1 -1
  185. data/vendor/pygments-main/tests/run.py +3 -2
  186. data/vendor/pygments-main/tests/support/tags +36 -0
  187. data/vendor/pygments-main/tests/test_basic_api.py +4 -3
  188. data/vendor/pygments-main/tests/test_clexer.py +1 -1
  189. data/vendor/pygments-main/tests/test_cmdline.py +1 -1
  190. data/vendor/pygments-main/tests/test_examplefiles.py +3 -1
  191. data/vendor/pygments-main/tests/test_html_formatter.py +17 -1
  192. data/vendor/pygments-main/tests/test_latex_formatter.py +1 -1
  193. data/vendor/pygments-main/tests/test_lexers_other.py +68 -0
  194. data/vendor/pygments-main/tests/test_perllexer.py +1 -1
  195. data/vendor/pygments-main/tests/test_regexlexer.py +1 -1
  196. data/vendor/pygments-main/tests/test_token.py +1 -1
  197. data/vendor/pygments-main/tests/test_using_api.py +1 -1
  198. data/vendor/pygments-main/tests/test_util.py +22 -3
  199. 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
- end;
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;}}{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.