Skip to content

Instantly share code, notes, and snippets.

@blippy

blippy/naps.cob

Created May 16, 2016 13:48
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save blippy/9919d8db7e0776ef9b59b2360855a4ba to your computer and use it in GitHub Desktop.
Save blippy/9919d8db7e0776ef9b59b2360855a4ba to your computer and use it in GitHub Desktop.
Download ZIP
An implementation of naps in COBOL
Raw
naps.cob
000100 identification division.
000200 program-id. naps.
000300 environment division.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT EPICS-FILE ASSIGN TO
"/home/mcarter/.mca/work/s3/epics.rep"
ORGANIZATION IS LINE SEQUENTIAL.
select sectors-file assign to
"sectors.txt"
organization is line sequential.
000400 data division.
file section.
fd EPICS-FILE
record contains 80 characters
data record is epics-file-line.
01 epics-file-line.
02 efl-ticker pic x(6).
02 filler pic x(14).
02 efl-pounds pic 9(10).
02 filler pic x.
02 efl-pennies pic 99.
fd sectors-file
record contains 80 characters
data record is sector-rec.
01 sector-rec.
02 sr-ticker pic x(6).
02 filler pic x.
02 sr-cat pic x(5).
02 filler pic x.
02 sr-percent pic 9v99.
000500 working-storage section.
78 num-cats value 11.
78 long-width value 20.
01 cat-table.
02 cat-grand pic 9(6)v99 value 0.
02 cat-grand-out pic ZZZ,ZZ9.99.
02 out-values.
03 filler pic x(5) value "UNKNO".
03 filler pic x(long-width) value "Uknown".
03 filler pic x(5) value "BAMAT".
03 filler pic x(long-width) value
"Basic Materials".
03 filler pic x(5) value "CONCY".
03 filler pic x(long-width) value
"Consumer cyclicals".
03 filler pic x(5) value "CONDE".
03 filler pic x(long-width) value
"Consumer defensives".
03 filler pic x(5) value "ENERG".
03 filler pic x(long-width) value
"Energy".
03 filler pic x(5) value "FINAN".
03 filler pic x(long-width) value
"Finance".
03 filler pic x(5) value "HEALT".
03 filler pic x(long-width) value
"Health".
03 filler pic x(5) value "INDUS".
03 filler pic x(long-width) value
"Industrials".
03 filler pic x(5) value "TECHN".
03 filler pic x(long-width) value
"Technology".
03 filler pic x(5) value "TELEC".
03 filler pic x(long-width) value
"Telecoms".
03 filler pic x(5) value "UTILS".
03 filler pic x(long-width) value
"Utilities".
02 filler redefines out-values.
03 cat-1 occurs num-cats times
indexed by cat-index.
05 cat pic x(5).
05 long pic x(long-width).
02 cat-total pic 9(6)v99 occurs num-cats times
value is 0.
02 cat-total-out pic ZZZ,ZZ9.99.
02 cat-percent pic 999v99 value is 0.
02 cat-percent-out pic ZZ9.99.
01 sector-table-len pic 999 value is 0.
01 sector-table occurs 100 times
indexed by sector-table-index.
02 st-ticker pic x(6).
02 filler pic x.
02 st-cat pic x(5).
02 filler pic x.
02 st-percent pic 9v99 value is 0.
* derived values
02 st-cat-index pic 999.
01 ws-idx pic 99.
01 eof pic x value 'N'.
01 epics-rec.
02 epics-ticker pic x(6) value spaces.
02 filler pic x value space.
02 epics-hit pic x value 'N'.
02 filler pic x value space.
02 epics-value pic 9(10)v99 value is 0.
02 filler pic x value space.
02 epics-cat-index pic 999 value is 0.
02 filler pic x value space.
02 epics-cat pic x(5) value is spaces.
02 filler pic x value space.
02 epics-cum-value pic 9(10)v99 value is 0.
000600
000700 procedure division.
000800 program-begin.
perform load-sector-table.
perform read-epic-rep.
perform print-cat-table.
.
000900
001000 program-done.
001100 stop run.
print-cat-table section.
display "cat-table"
perform show-cat
varying ws-idx from 1 by 1 until ws-idx>num-cats.
display " "
move cat-grand to cat-grand-out
display "TOTAL " cat-grand-out
.
show-cat section.
move cat-total(ws-idx) to cat-total-out
compute cat-percent = 100 * cat-total(ws-idx)/cat-grand
move cat-percent to cat-percent-out
display cat(ws-idx) " "
cat-total-out " "
cat-percent-out "% "
long(ws-idx)
.
read-epic-rep section.
display "reading epic file"
open input epics-file
move 'N' to eof
perform until eof = 'Y'
read epics-file next record into epics-file-line
at end move 'Y' to eof
not at end perform process-efl
end-read
end-perform
close epics-file
.
process-efl section.
if epics-file-line(1:4) = "mine" then
* read next line for processing. "mine" is not useful
read epics-file next record into epics-file-line
move 'Y' to epics-hit
end-if
if epics-file-line(1:5) = "Grand" then
move 'N' to epics-hit
end-if
if 'Y' = epics-hit and
epics-file-line(1:4) not = "TICK" then
perform process-mine-epic
end-if
.
process-mine-epic section.
* check constraint
set sector-table-index to 1
search sector-table
at end perform epic-constraint-violation
when st-ticker(sector-table-index) = efl-ticker
perform accumulate-cat
end-search
.
epic-constraint-violation section.
display "ERR: epic-constraint-violation section"
display epics-file-line.
stop run
.
accumulate-cat section.
move efl-ticker to epics-ticker.
compute epics-value = (efl-pounds + efl-pennies/100) *
st-percent(sector-table-index)
move st-cat-index(sector-table-index) to epics-cat-index
add epics-value to cat-total(epics-cat-index)
add epics-value to cat-grand
move st-cat(sector-table-index) to epics-cat
move cat-grand to epics-cum-value
display epics-rec
.
load-sector-table section.
display "loading sector file"
open input sectors-file
move 'N' to eof
move 0 to sector-table-len
perform until eof = 'Y'
read sectors-file next record into sector-rec
at end move 'Y' to eof
not at end perform process-sector-file-line
end-read
end-perform
close sectors-file
.
process-sector-file-line section.
add 1 to sector-table-len
move sector-rec to sector-table(sector-table-len)
set cat-index to 1
search cat-1
at end perform no-cat-found
when sr-cat = cat(cat-index)
move cat-index to
st-cat-index(sector-table-len)
end-search
.
no-cat-found section.
display "ERR: no category:" sr-cat " in " sector-rec
stop run
.
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment