aparler/RosettaCodeData
1
0
Fork 0
Code Issues 12 Pull requests 3 Projects Releases Packages Wiki Activity Actions

Data update

Browse source
This commit is contained in:
Ingy döt Net 2026-02-01 16:33:20 -08:00
parent 5150844a7d
commit 4bb20c9b71
7735 changed files with 38060 additions and 199180 deletions
Download patch file Download diff file Expand all files Collapse all files

89
Task/Fixed-length-records/COBOL/fixed-length-records-1.cobol
View file

@ -1,89 +0,0 @@
*> Rosetta Code, fixed length records
*> Tectonics:
*> cobc -xj lrecl80.cob
identification division.
program-id. lrecl80.
environment division.
configuration section.
repository.
function all intrinsic.
input-output section.
file-control.
select infile
assign to infile-name
organization is sequential
file status is infile-status
.
select outfile
assign to outfile-name
organization is sequential
file status is outfile-status
.
data division.
file section.
fd infile.
01 input-text pic x(80).
fd outfile.
01 output-text pic x(80).
working-storage section.
01 infile-name.
05 value "infile.dat".
01 infile-status pic xx.
88 ok-input value '00'.
88 eof-input value '10'.
01 outfile-name.
05 value "outfile.dat".
01 outfile-status pic xx.
88 ok-output value '00'.
procedure division.
open input infile
if not ok-input then
display "error opening input " infile-name upon syserr
goback
end-if
open output outfile
if not ok-output
display "error opening output " outfile-name upon syserr
goback
end-if
*> read lrecl 80 and write the reverse as lrecl 80
read infile
perform until not ok-input
move function reverse(input-text) to output-text
write output-text
if not ok-output then
display "error writing: " output-text upon syserr
end-if
read infile
end-perform
close infile outfile
*> from fixed length to normal text, outfile is now the input file
open input outfile
if not ok-output then
display "error opening input " outfile-name upon syserr
goback
end-if
read outfile
perform until not ok-output
display function trim(output-text trailing)
read outfile
end-perform
close outfile
goback.
end program lrecl80.

90
Task/Fixed-length-records/COBOL/fixed-length-records-2.cobol
View file

@ -1,90 +0,0 @@
*> Rosetta Code fixed length records, text to Forth block
identification division.
program-id. blocking.
environment division.
configuration section.
repository.
function all intrinsic.
input-output section.
file-control.
select infile
assign to infile-name
organization is line sequential
file status is infile-status
.
select outfile
assign to outfile-name
organization is sequential
file status is outfile-status
.
data division.
file section.
fd infile.
01 input-text pic x(64).
fd outfile.
01 output-text pic x(64).
working-storage section.
01 infile-name.
05 value "forth.txt".
01 infile-status pic xx.
88 ok-input value '00'.
88 eof-input value '10'.
01 outfile-name.
05 value "forth.blk".
01 outfile-status pic xx.
88 ok-output value '00'.
procedure division.
*> read a line, padded to or truncated at 64 as defined in FD
open input infile
if not ok-input then
display "error opening input " infile-name upon syserr
goback
end-if
open output outfile
if not ok-output
display "error opening output " outfile-name upon syserr
goback
end-if
move 0 to tally
read infile
perform until not ok-input
move input-text to output-text
write output-text
if not ok-output then
display "error writing: " output-text upon syserr
end-if
add 1 to tally
if tally > 15 then move 0 to tally end-if
read infile
end-perform
*> Output up to next 1024 byte boundary
if tally > 0 then
compute tally = 16 - tally
move spaces to output-text
perform tally times
write output-text
if not ok-output then
display "error writing: " output-text upon syserr
end-if
end-perform
end-if
close infile outfile
goback.
end program blocking.

72
Task/Fixed-length-records/COBOL/fixed-length-records-3.cobol
View file

@ -1,72 +0,0 @@
*> Rosetta Code fixed length records, Forth blocks to text.
identification division.
program-id. unblocking.
environment division.
configuration section.
repository.
function all intrinsic.
input-output section.
file-control.
select infile
assign to infile-name
organization is sequential
file status is infile-status
.
select outfile
assign to outfile-name
organization is line sequential
file status is outfile-status
.
data division.
file section.
fd infile.
01 input-text pic x(64).
fd outfile.
01 output-text pic x(64).
working-storage section.
01 infile-name.
05 value "forth.blk".
01 infile-status pic xx.
88 ok-input value '00'.
88 eof-input value '10'.
01 outfile-name.
05 value "forth.txt".
01 outfile-status pic xx.
88 ok-output value '00'.
procedure division.
open input infile
if not ok-input then
display "error opening input " trim(infile-name) upon syserr
goback
end-if
open output outfile
if not ok-output
display "error opening write " trim(outfile-name) upon syserr
goback
end-if
*> read a fixed length line, 64 characters
read infile
perform until not ok-input
move trim(input-text) to output-text
write output-text
if not ok-output then
display "error writing: " output-text upon syserr
end-if
read infile
end-perform
close infile outfile
goback.
end program unblocking.