Data update
This commit is contained in:
Ingy döt Net
parent
5150844a7d
commit
4bb20c9b71
7735 changed files with 38060 additions and 199180 deletions
|
|
@ -1,652 +0,0 @@
|
|||
>>SOURCE FORMAT IS FREE
|
||||
identification division.
|
||||
*> this code is dedicated to the public domain
|
||||
*> (GnuCOBOL) 2.3-dev.0
|
||||
program-id. generator.
|
||||
environment division.
|
||||
configuration section.
|
||||
repository. function all intrinsic.
|
||||
data division.
|
||||
working-storage section.
|
||||
01 program-name pic x(32) value spaces global.
|
||||
01 input-name pic x(32) value spaces global.
|
||||
01 input-status pic xx global.
|
||||
|
||||
01 ast-record global.
|
||||
03 ast-type pic x(14).
|
||||
03 ast-value pic x(48).
|
||||
03 filler redefines ast-value.
|
||||
05 asl-left pic 999.
|
||||
05 asl-right pic 999.
|
||||
|
||||
01 error-record pic x(64) value spaces global.
|
||||
|
||||
01 loadstack global.
|
||||
03 l pic 99 value 0.
|
||||
03 l-lim pic 99 value 64.
|
||||
03 load-entry occurs 64.
|
||||
05 l-node pic x(14).
|
||||
05 l-left pic 999.
|
||||
05 l-right pic 999.
|
||||
05 l-link pic 999.
|
||||
|
||||
01 abstract-syntax-tree global.
|
||||
03 t pic 999 value 0.
|
||||
03 t1 pic 999.
|
||||
03 t-lim pic 999 value 998.
|
||||
03 filler occurs 998.
|
||||
05 p1 pic 999.
|
||||
05 p2 pic 999.
|
||||
05 p3 pic 999.
|
||||
05 n1 pic 999.
|
||||
05 leaf.
|
||||
07 leaf-type pic x(14).
|
||||
07 leaf-value pic x(48).
|
||||
05 node redefines leaf.
|
||||
07 node-type pic x(14).
|
||||
07 node-left pic 999.
|
||||
07 node-right pic 999.
|
||||
|
||||
01 opcodes global.
|
||||
03 opFETCH pic x value x'00'.
|
||||
03 opSTORE pic x value x'01'.
|
||||
03 opPUSH pic x value x'02'.
|
||||
03 opADD pic x value x'03'.
|
||||
03 opSUB pic x value x'04'.
|
||||
03 opMUL pic x value x'05'.
|
||||
03 opDIV pic x value x'06'.
|
||||
03 opMOD pic x value x'07'.
|
||||
03 opLT pic x value x'08'.
|
||||
03 opGT pic x value x'09'.
|
||||
03 opLE pic x value x'0A'.
|
||||
03 opGE pic x value x'0B'.
|
||||
03 opEQ pic x value x'0C'.
|
||||
03 opNE pic x value x'0D'.
|
||||
03 opAND pic x value x'0E'.
|
||||
03 opOR pic x value x'0F'.
|
||||
03 opNEG pic x value x'10'.
|
||||
03 opNOT pic x value x'11'.
|
||||
03 opJMP pic x value x'13'.
|
||||
03 opJZ pic x value x'14'.
|
||||
03 opPRTC pic x value x'15'.
|
||||
03 opPRTS pic x value x'16'.
|
||||
03 opPRTI pic x value x'17'.
|
||||
03 opHALT pic x value x'18'.
|
||||
|
||||
01 variables global.
|
||||
03 v pic 99.
|
||||
03 v-max pic 99 value 0.
|
||||
03 v-lim pic 99 value 16.
|
||||
03 variable-entry occurs 16 pic x(48).
|
||||
|
||||
01 strings global.
|
||||
03 s pic 99.
|
||||
03 s-max pic 99 value 0.
|
||||
03 s-lim pic 99 value 16.
|
||||
03 string-entry occurs 16 pic x(48).
|
||||
|
||||
01 generated-code global.
|
||||
03 c pic 999 value 1.
|
||||
03 c1 pic 999.
|
||||
03 c-lim pic 999 value 512.
|
||||
03 kode pic x(512).
|
||||
|
||||
procedure division chaining program-name.
|
||||
start-generator.
|
||||
call 'loadast'
|
||||
if program-name <> spaces
|
||||
call 'readinput' *> close input-file
|
||||
end-if
|
||||
>>d perform print-ast
|
||||
call 'codegen' using t
|
||||
call 'emitbyte' using opHALT
|
||||
>>d call 'showhex' using kode c
|
||||
call 'listcode'
|
||||
stop run
|
||||
.
|
||||
print-ast.
|
||||
call 'printast' using t
|
||||
display 'ast:' upon syserr
|
||||
display 't=' t
|
||||
perform varying t1 from 1 by 1 until t1 > t
|
||||
if leaf-type(t1) = 'Identifier' or 'Integer' or 'String'
|
||||
display t1 space trim(leaf-type(t1)) space trim(leaf-value(t1)) upon syserr
|
||||
else
|
||||
display t1 space node-left(t1) space node-right(t1) space trim(node-type(t1))
|
||||
upon syserr
|
||||
end-if
|
||||
end-perform
|
||||
.
|
||||
identification division.
|
||||
program-id. codegen common recursive.
|
||||
data division.
|
||||
working-storage section.
|
||||
01 r pic ---9.
|
||||
linkage section.
|
||||
01 n pic 999.
|
||||
procedure division using n.
|
||||
start-codegen.
|
||||
if n = 0
|
||||
exit program
|
||||
end-if
|
||||
>>d display 'at 'c ' node=' space n space node-type(n) upon syserr
|
||||
evaluate node-type(n)
|
||||
when 'Identifier'
|
||||
call 'emitbyte' using opFetch
|
||||
call 'variableoffset' using leaf-value(n)
|
||||
call 'emitword' using v '0'
|
||||
when 'Integer'
|
||||
call 'emitbyte' using opPUSH
|
||||
call 'emitword' using leaf-value(n) '0'
|
||||
when 'String'
|
||||
call 'emitbyte' using opPUSH
|
||||
call 'stringoffset' using leaf-value(n)
|
||||
call 'emitword' using s '0'
|
||||
when 'Assign'
|
||||
call 'codegen' using node-right(n)
|
||||
call 'emitbyte' using opSTORE
|
||||
move node-left(n) to n1(n)
|
||||
call 'variableoffset' using leaf-value(n1(n))
|
||||
call 'emitword' using v '0'
|
||||
when 'If'
|
||||
call 'codegen' using node-left(n) *> conditional expr
|
||||
call 'emitbyte' using opJZ *> jump to false path or exit
|
||||
move c to p1(n)
|
||||
call 'emitword' using '0' '0'
|
||||
move node-right(n) to n1(n) *> true path
|
||||
call 'codegen' using node-left(n1(n))
|
||||
if node-right(n1(n)) <> 0 *> there is a false path
|
||||
call 'emitbyte' using opJMP *> jump past false path
|
||||
move c to p2(n)
|
||||
call 'emitword' using '0' '0'
|
||||
compute r = c - p1(n) *> fill in jump to false path
|
||||
call 'emitword' using r p1(n)
|
||||
call 'codegen' using node-right(n1(n)) *> false path
|
||||
compute r = c - p2(n) *> fill in jump to exit
|
||||
call 'emitword' using r p2(n)
|
||||
else
|
||||
compute r = c - p1(n)
|
||||
call 'emitword' using r p1(n) *> fill in jump to exit
|
||||
end-if
|
||||
when 'While'
|
||||
move c to p3(n) *> save address of while start
|
||||
call 'codegen' using node-left(n) *> conditional expr
|
||||
call 'emitbyte' using opJZ *> jump to exit
|
||||
move c to p2(n)
|
||||
call 'emitword' using '0' '0'
|
||||
call 'codegen' using node-right(n) *> while body
|
||||
call 'emitbyte' using opJMP *> jump to while start
|
||||
compute r = p3(n) - c
|
||||
call 'emitword' using r '0'
|
||||
compute r = c - p2(n) *> fill in jump to exit
|
||||
call 'emitword' using r p2(n)
|
||||
when 'Sequence'
|
||||
call 'codegen' using node-left(n)
|
||||
call 'codegen' using node-right(n)
|
||||
when 'Prtc'
|
||||
call 'codegen' using node-left(n)
|
||||
call 'emitbyte' using opPRTC
|
||||
when 'Prti'
|
||||
call 'codegen' using node-left(n)
|
||||
call 'emitbyte' using opPRTI
|
||||
when 'Prts'
|
||||
call 'codegen' using node-left(n)
|
||||
call 'emitbyte' using opPRTS
|
||||
when 'Less'
|
||||
call 'codegen' using node-left(n)
|
||||
call 'codegen' using node-right(n)
|
||||
call 'emitbyte' using opLT
|
||||
when 'Greater'
|
||||
call 'codegen' using node-left(n)
|
||||
call 'codegen' using node-right(n)
|
||||
call 'emitbyte' using opGT
|
||||
when 'LessEqual'
|
||||
call 'codegen' using node-left(n)
|
||||
call 'codegen' using node-right(n)
|
||||
call 'emitbyte' using opLE
|
||||
when 'GreaterEqual'
|
||||
call 'codegen' using node-left(n)
|
||||
call 'codegen' using node-right(n)
|
||||
call 'emitbyte' using opGE
|
||||
when 'Equal'
|
||||
call 'codegen' using node-left(n)
|
||||
call 'codegen' using node-right(n)
|
||||
call 'emitbyte' using opEQ
|
||||
when 'NotEqual'
|
||||
call 'codegen' using node-left(n)
|
||||
call 'codegen' using node-right(n)
|
||||
call 'emitbyte' using opNE
|
||||
when 'And'
|
||||
call 'codegen' using node-left(n)
|
||||
call 'codegen' using node-right(n)
|
||||
call 'emitbyte' using opAND
|
||||
when 'Or'
|
||||
call 'codegen' using node-left(n)
|
||||
call 'codegen' using node-right(n)
|
||||
call 'emitbyte' using opOR
|
||||
when 'Subtract'
|
||||
call 'codegen' using node-left(n)
|
||||
call 'codegen' using node-right(n)
|
||||
call 'emitbyte' using opSUB
|
||||
when 'Add'
|
||||
call 'codegen' using node-left(n)
|
||||
call 'codegen' using node-right(n)
|
||||
call 'emitbyte' using opADD
|
||||
when 'Divide'
|
||||
call 'codegen' using node-left(n)
|
||||
call 'codegen' using node-right(n)
|
||||
call 'emitbyte' using opDIV
|
||||
when 'Multiply'
|
||||
call 'codegen' using node-left(n)
|
||||
call 'codegen' using node-right(n)
|
||||
call 'emitbyte' using opMUL
|
||||
when 'Mod'
|
||||
call 'codegen' using node-left(n)
|
||||
call 'codegen' using node-right(n)
|
||||
call 'emitbyte' using opMOD
|
||||
when 'Negate'
|
||||
call 'codegen' using node-left(n)
|
||||
call 'emitbyte' using opNEG
|
||||
when 'Not'
|
||||
call 'codegen' using node-left(n)
|
||||
call 'emitbyte' using opNOT
|
||||
when other
|
||||
string 'in generator unknown node type: ' node-type(n) into error-record
|
||||
call 'reporterror'
|
||||
end-evaluate
|
||||
.
|
||||
end program codegen.
|
||||
|
||||
identification division.
|
||||
program-id. variableoffset common.
|
||||
data division.
|
||||
linkage section.
|
||||
01 variable-value pic x(48).
|
||||
procedure division using variable-value.
|
||||
start-variableoffset.
|
||||
perform varying v from 1 by 1
|
||||
until v > v-max
|
||||
or variable-entry(v) = variable-value
|
||||
continue
|
||||
end-perform
|
||||
if v > v-lim
|
||||
string 'in generator variable offset v exceeds ' v-lim into error-record
|
||||
call 'reporterror'
|
||||
end-if
|
||||
if v > v-max
|
||||
move v to v-max
|
||||
move variable-value to variable-entry(v)
|
||||
end-if
|
||||
.
|
||||
end program variableoffset.
|
||||
|
||||
identification division.
|
||||
program-id. stringoffset common.
|
||||
data division.
|
||||
linkage section.
|
||||
01 string-value pic x(48).
|
||||
procedure division using string-value.
|
||||
start-stringoffset.
|
||||
perform varying s from 1 by 1
|
||||
until s > s-max
|
||||
or string-entry(s) = string-value
|
||||
continue
|
||||
end-perform
|
||||
if s > s-lim
|
||||
string ' generator stringoffset s exceeds ' s-lim into error-record
|
||||
call 'reporterror'
|
||||
end-if
|
||||
if s > s-max
|
||||
move s to s-max
|
||||
move string-value to string-entry(s)
|
||||
end-if
|
||||
subtract 1 from s *> convert index to offset
|
||||
.
|
||||
end program stringoffset.
|
||||
|
||||
identification division.
|
||||
program-id. emitbyte common.
|
||||
data division.
|
||||
linkage section.
|
||||
01 opcode pic x.
|
||||
procedure division using opcode.
|
||||
start-emitbyte.
|
||||
if c >= c-lim
|
||||
string 'in generator emitbyte c exceeds ' c-lim into error-record
|
||||
call 'reporterror'
|
||||
end-if
|
||||
move opcode to kode(c:1)
|
||||
add 1 to c
|
||||
.
|
||||
end program emitbyte.
|
||||
|
||||
identification division.
|
||||
program-id. emitword common.
|
||||
data division.
|
||||
working-storage section.
|
||||
01 word-x.
|
||||
03 word usage binary-int.
|
||||
01 loc pic 999.
|
||||
linkage section.
|
||||
01 word-value any length.
|
||||
01 loc-value any length.
|
||||
procedure division using word-value loc-value.
|
||||
start-emitword.
|
||||
if c + length(word) > c-lim
|
||||
string 'in generator emitword exceeds ' c-lim into error-record
|
||||
call 'reporterror'
|
||||
end-if
|
||||
move numval(word-value) to word
|
||||
move numval(loc-value) to loc
|
||||
if loc = 0
|
||||
move word-x to kode(c:length(word))
|
||||
add length(word) to c
|
||||
else
|
||||
move word-x to kode(loc:length(word))
|
||||
end-if
|
||||
.
|
||||
end program emitword.
|
||||
|
||||
identification division.
|
||||
program-id. listcode common.
|
||||
data division.
|
||||
working-storage section.
|
||||
01 word-x.
|
||||
03 word usage binary-int.
|
||||
01 address-display pic ---9.
|
||||
01 address-absolute pic zzz9.
|
||||
01 data-display pic -(9)9.
|
||||
01 v-display pic z9.
|
||||
01 s-display pic z9.
|
||||
01 c-display pic zzz9.
|
||||
procedure division.
|
||||
start-listcode.
|
||||
move v-max to v-display
|
||||
move s-max to s-display
|
||||
display 'Datasize: ' trim(v-display) space 'Strings: ' trim(s-display)
|
||||
|
||||
perform varying s from 1 by 1
|
||||
until s > s-max
|
||||
display string-entry(s)
|
||||
end-perform
|
||||
|
||||
move 1 to c1
|
||||
perform until c1 >= c
|
||||
compute c-display = c1 - 1
|
||||
display c-display space with no advancing
|
||||
evaluate kode(c1:1)
|
||||
when opFETCH
|
||||
add 1 to c1
|
||||
move kode(c1:4) to word-x
|
||||
compute address-display = word - 1
|
||||
display 'fetch [' trim(address-display) ']'
|
||||
add 3 to c1
|
||||
when opSTORE
|
||||
add 1 to c1
|
||||
move kode(c1:4) to word-x
|
||||
compute address-display = word - 1
|
||||
display 'store [' trim(address-display) ']'
|
||||
add 3 to c1
|
||||
when opPUSH
|
||||
add 1 to c1
|
||||
move kode(c1:4) to word-x
|
||||
move word to data-display
|
||||
display 'push ' trim(data-display)
|
||||
add 3 to c1
|
||||
when opADD display 'add'
|
||||
when opSUB display 'sub'
|
||||
when opMUL display 'mul'
|
||||
when opDIV display 'div'
|
||||
when opMOD display 'mod'
|
||||
when opLT display 'lt'
|
||||
when opGT display 'gt'
|
||||
when opLE display 'le'
|
||||
when opGE display 'ge'
|
||||
when opEQ display 'eq'
|
||||
when opNE display 'ne'
|
||||
when opAND display 'and'
|
||||
when opOR display 'or'
|
||||
when opNEG display 'neg'
|
||||
when opNOT display 'not'
|
||||
when opJMP
|
||||
move kode(c1 + 1:length(word)) to word-x
|
||||
move word to address-display
|
||||
compute address-absolute = c1 + word
|
||||
display 'jmp (' trim(address-display) ') ' trim(address-absolute)
|
||||
add length(word) to c1
|
||||
when opJZ
|
||||
move kode(c1 + 1:length(word)) to word-x
|
||||
move word to address-display
|
||||
compute address-absolute = c1 + word
|
||||
display 'jz (' trim(address-display) ') ' trim(address-absolute)
|
||||
add length(word) to c1
|
||||
when opPRTC display 'prtc'
|
||||
when opPRTI display 'prti'
|
||||
when opPRTS display 'prts'
|
||||
when opHALT display 'halt'
|
||||
when other
|
||||
string 'in generator unknown opcode ' kode(c1:1) into error-record
|
||||
call 'reporterror'
|
||||
end-evaluate
|
||||
add 1 to c1
|
||||
end-perform
|
||||
.
|
||||
end program listcode.
|
||||
|
||||
identification division.
|
||||
program-id. loadast common recursive.
|
||||
procedure division.
|
||||
start-loadast.
|
||||
if l >= l-lim
|
||||
string 'in generator loadast l exceeds ' l-lim into error-record
|
||||
call 'reporterror'
|
||||
end-if
|
||||
add 1 to l
|
||||
call 'readinput'
|
||||
evaluate true
|
||||
when ast-record = ';'
|
||||
when input-status = '10'
|
||||
move 0 to return-code
|
||||
when ast-type = 'Identifier'
|
||||
when ast-type = 'Integer'
|
||||
when ast-type = 'String'
|
||||
call 'makeleaf' using ast-type ast-value
|
||||
move t to return-code
|
||||
when ast-type = 'Sequence'
|
||||
move ast-type to l-node(l)
|
||||
call 'loadast'
|
||||
move return-code to l-left(l)
|
||||
call 'loadast'
|
||||
move t to l-right(l)
|
||||
call 'makenode' using l-node(l) l-left(l) l-right(l)
|
||||
move t to return-code
|
||||
when other
|
||||
move ast-type to l-node(l)
|
||||
call 'loadast'
|
||||
move return-code to l-left(l)
|
||||
call 'loadast'
|
||||
move return-code to l-right(l)
|
||||
call 'makenode' using l-node(l) l-left(l) l-right(l)
|
||||
move t to return-code
|
||||
end-evaluate
|
||||
subtract 1 from l
|
||||
.
|
||||
end program loadast.
|
||||
|
||||
identification division.
|
||||
program-id. printast common recursive.
|
||||
data division.
|
||||
linkage section.
|
||||
01 n pic 999.
|
||||
procedure division using n.
|
||||
start-printast.
|
||||
if n = 0
|
||||
display ';' upon syserr
|
||||
exit program
|
||||
end-if
|
||||
display leaf-type(n) upon syserr
|
||||
evaluate leaf-type(n)
|
||||
when 'Identifier'
|
||||
when 'Integer'
|
||||
when 'String'
|
||||
display leaf-type(n) space trim(leaf-value(n)) upon syserr
|
||||
when other
|
||||
display node-type(n) upon syserr
|
||||
call 'printast' using node-left(n)
|
||||
call 'printast' using node-right(n)
|
||||
end-evaluate
|
||||
.
|
||||
end program printast.
|
||||
|
||||
identification division.
|
||||
program-id. makenode common.
|
||||
data division.
|
||||
linkage section.
|
||||
01 parm-type any length.
|
||||
01 parm-l-left pic 999.
|
||||
01 parm-l-right pic 999.
|
||||
procedure division using parm-type parm-l-left parm-l-right.
|
||||
start-makenode.
|
||||
if t >= t-lim
|
||||
string 'in generator makenode t exceeds ' t-lim into error-record
|
||||
call 'reporterror'
|
||||
end-if
|
||||
add 1 to t
|
||||
move parm-type to node-type(t)
|
||||
move parm-l-left to node-left(t)
|
||||
move parm-l-right to node-right(t)
|
||||
.
|
||||
end program makenode.
|
||||
|
||||
identification division.
|
||||
program-id. makeleaf common.
|
||||
data division.
|
||||
linkage section.
|
||||
01 parm-type any length.
|
||||
01 parm-value pic x(48).
|
||||
procedure division using parm-type parm-value.
|
||||
start-makeleaf.
|
||||
add 1 to t
|
||||
if t >= t-lim
|
||||
string 'in generator makeleaf t exceeds ' t-lim into error-record
|
||||
call 'reporterror'
|
||||
end-if
|
||||
move parm-type to leaf-type(t)
|
||||
move parm-value to leaf-value(t)
|
||||
.
|
||||
end program makeleaf.
|
||||
|
||||
identification division.
|
||||
program-id. readinput common.
|
||||
environment division.
|
||||
input-output section.
|
||||
file-control.
|
||||
select input-file assign using input-name
|
||||
status is input-status
|
||||
organization is line sequential.
|
||||
data division.
|
||||
file section.
|
||||
fd input-file.
|
||||
01 input-record pic x(64).
|
||||
procedure division.
|
||||
start-readinput.
|
||||
if program-name = spaces
|
||||
move '00' to input-status
|
||||
accept ast-record on exception move '10' to input-status end-accept
|
||||
exit program
|
||||
end-if
|
||||
if input-name = spaces
|
||||
string program-name delimited by space '.ast' into input-name
|
||||
open input input-file
|
||||
if input-status = '35'
|
||||
string 'in generator ' trim(input-name) ' not found' into error-record
|
||||
call 'reporterror'
|
||||
end-if
|
||||
end-if
|
||||
read input-file into ast-record
|
||||
evaluate input-status
|
||||
when '00'
|
||||
continue
|
||||
when '10'
|
||||
close input-file
|
||||
when other
|
||||
string 'in generator ' trim(input-name) ' unexpected input-status: ' input-status
|
||||
into error-record
|
||||
call 'reporterror'
|
||||
end-evaluate
|
||||
.
|
||||
end program readinput.
|
||||
|
||||
program-id. reporterror common.
|
||||
procedure division.
|
||||
start-reporterror.
|
||||
report-error.
|
||||
display error-record upon syserr
|
||||
stop run with error status -1
|
||||
.
|
||||
end program reporterror.
|
||||
|
||||
identification division.
|
||||
program-id. showhex common.
|
||||
|
||||
data division.
|
||||
working-storage section.
|
||||
01 hex.
|
||||
03 filler pic x(32) value '000102030405060708090A0B0C0D0E0F'.
|
||||
03 filler pic x(32) value '101112131415161718191A1B1C1D1E1F'.
|
||||
03 filler pic x(32) value '202122232425262728292A2B2C2D2E2F'.
|
||||
03 filler pic x(32) value '303132333435363738393A3B3C3D3E3F'.
|
||||
03 filler pic x(32) value '404142434445464748494A4B4C4D4E4F'.
|
||||
03 filler pic x(32) value '505152535455565758595A5B5C5D5E5F'.
|
||||
03 filler pic x(32) value '606162636465666768696A6B6C6D6E6F'.
|
||||
03 filler pic x(32) value '707172737475767778797A7B7C7D7E7F'.
|
||||
03 filler pic x(32) value '808182838485868788898A8B8C8D8E8F'.
|
||||
03 filler pic x(32) value '909192939495969798999A9B9C9D9E9F'.
|
||||
03 filler pic x(32) value 'A0A1A2A3A4A5A6A7A8A9AAABACADAEAF'.
|
||||
03 filler pic x(32) value 'B0B1B2B3B4B5B6B7B8B9BABBBCBDBEBF'.
|
||||
03 filler pic x(32) value 'C0C1C2C3C4C5C6C7C8C9CACBCCCDCECF'.
|
||||
03 filler pic x(32) value 'D0D1D2D3D4D5D6D7D8D9DADBDCDDDEDF'.
|
||||
03 filler pic x(32) value 'E0E1E2E3E4E5E6E7E8E9EAEBECEDEEEF'.
|
||||
03 filler pic x(32) value 'F0F1F2F3F4F5F6F7F8F9FAFBFCFDFEFF'.
|
||||
|
||||
01 cdx pic 9999.
|
||||
01 bdx pic 999.
|
||||
01 byte-count pic 9.
|
||||
01 bytes-per-word pic 9 value 4.
|
||||
01 word-count pic 9.
|
||||
01 words-per-line pic 9 value 8.
|
||||
|
||||
linkage section.
|
||||
01 data-field any length.
|
||||
01 length-data-field pic 999.
|
||||
|
||||
procedure division using
|
||||
by reference data-field
|
||||
by reference length-data-field.
|
||||
start-showhex.
|
||||
move 1 to byte-count
|
||||
move 1 to word-count
|
||||
perform varying cdx from 1 by 1
|
||||
until cdx > length-data-field
|
||||
compute bdx = 2 * ord(data-field(cdx:1)) - 1 end-compute
|
||||
display hex(bdx:2) with no advancing upon syserr
|
||||
add 1 to byte-count end-add
|
||||
if byte-count > bytes-per-word
|
||||
display ' ' with no advancing upon syserr
|
||||
move 1 to byte-count
|
||||
add 1 to word-count end-add
|
||||
end-if
|
||||
if word-count > words-per-line
|
||||
display ' ' upon syserr
|
||||
move 1 to word-count
|
||||
end-if
|
||||
end-perform
|
||||
if word-count <> 1
|
||||
or byte-count <> 1
|
||||
display ' ' upon syserr
|
||||
end-if
|
||||
display ' ' upon syserr
|
||||
goback
|
||||
.
|
||||
end program showhex.
|
||||
end program generator.
|
||||
Loading…
Add table
Add a link
Reference in a new issue