I modified Jeff's modification :)
Working program follows.
BTW, http://www.allegro.com/papers/htpp.html explains some of the
changes I made.
Note that this is now completely Pascal I/O free, but the I/O isn't
encapsulated.
Stan.
--------------------------cut here-------------------------------------
program readgivenfile (parm);
{Run with PARM=1 (or any odd value) to get per-line information}
{For other PARM bits, see the outer block code. }
const
ccg = 0;
ccl = 1;
cce = 2;
type
io_str_type = string [256];
str32 = string [32];
var
old_plabel : integer;
parm : shortint; {set from RUN...;PARM=###}
want_strip_trailing_blanks : boolean; {PARM bit 14}
want_verbose : boolean; {PARM bit 15}
Function dascii : shortint; intrinsic;
Procedure fcheck; intrinsic;
Procedure fclose; intrinsic;
Function fopen : shortint; intrinsic;
Function fread : shortint; intrinsic;
Procedure print; intrinsic;
Function readx : shortint; intrinsic;
Procedure setjcw; intrinsic;
Procedure terminate; intrinsic;
Procedure xcontrap; intrinsic;
Procedure genmsgu (setnum : shortint; msgnum : shortint);
external;
{--------------------------forward routines--------------------}
Function fmti (n : integer; w : integer) : str32;
forward;
Function num (n : integer) : str32;
forward;
Procedure spout (s : io_str_type);
forward;
{***************************************************************}
procedure cy_handler;
begin
spout ('<control-Y>');
terminate;
end {cy_handler proc};
{***************************************************************}
function fmti (n : integer; w : integer) : str32;
{Returns string with ASCII representation of integer n}
{If n takes less than w characters to represent, the }
{string will be padded with blanks on the LEFT to a }
{total length of W. (I.e., this is like a FORTRAN I }
{format, although we don't truncate or do "***" on }
{overflow. }
var
len : integer;
s : str32;
begin
if w > strmax (s) then
w := strmax (s)
else if w < 1 then
w := 1;
$push, range off$
len := dascii (n, 10, s);
setstrlen (s, len);
if len < w then
s := strrpt (' ', w - len) + s;
fmti := s;
$pop$ {range}
end {fmti proc};
{***************************************************************}
function num (n : integer) : str32;
{Returns string with ASCII representation of integer n}
var
len : integer;
s : str32;
begin
$push, range off$
len := dascii (n, 10, s);
setstrlen (s, len);
num := s;
$pop$ {range}
end {num proc};
{***************************************************************}
procedure spout (s : io_str_type);
begin
print (s, - strlen (s), 0);
end {spout proc};
{***************************************************************}
procedure spoutstop (s : io_str_type);
begin
print (s, - strlen (s), octal ('320'));
end {spoutstop proc};
{***************************************************************}
procedure test;
label
999;
const
max_bytes_per_record = 512;
var
{Big variables first...}
{Note: if sum of all variables <= 8192 bytes,}
{then this doesn't matter. }
buffer : packed array [1..max_bytes_per_record] of char;
{small variables last...}
cc : integer;
err16 : shortint;
fid : shortint; {file# of input file}
infilename : packed array [1..81] of char; {80 + 1}
len : integer;
nextchar : char;
num_bytes : integer;
num_lines : integer; {line count}
total_byte_count : integer; {total # characters read}
begin
fid := 0; {in case we exit early}
num_lines := 0;
total_byte_count := 0;
spoutstop ('Enter the name of FILE to read: ');
len := readx (infilename, -80);
if len <= 0 then
goto 999; {no valid input}
{above check catches CCG/CCL as well as <cr>}
spout (' ');
infilename [len + 1] := ' '; {blank stopper}
fid := fopen (infilename,
1, {old}
octal ('300')); {SHR, in}
if ccode <> cce then
begin
fcheck (fid, err16);
spout ('Failed to open file, error # ' + num (err16));
genmsgu (8, err16);
goto 999;
end;
{ok, we have an open file...}
num_bytes := fread (fid, buffer, -sizeof (buffer));
cc := ccode; {get error/ok result of fread}
while cc = cce do {we have a record to handle...}
begin
if want_strip_trailing_blanks then
begin
while (num_bytes > 0) and (buffer [num_bytes] = ' ') do
num_bytes := num_bytes - 1;
end;
total_byte_count := total_byte_count + num_bytes;
num_lines := num_lines + 1; {total # of lines}
if want_verbose then
spout ('Number of characters in line ' +
fmti (num_lines, 5) +
' = ' +
fmti (num_bytes, 3) +
', total = ' +
fmti (total_byte_count, 6));
num_bytes := fread (fid, buffer, -sizeof (buffer));
cc := ccode; {get error/ok result of fread}
end;
{At this point, cc <> cce ... so it is either ccg or ccl}
if cc = ccg then
begin {hit EOF...that's ok}
end
else {not ccE, not ccG --> ccL}
begin {oops, error reading file...}
fcheck (fid, err16);
spout ('Error reading file, error # ' + num (err16));
genmsgu (8, err16);
goto 999;
end;
spout ('Read ' + num (num_lines) + ' records, ' +
num (total_byte_count) + ' bytes.');
999:
if fid <> 0 then
begin
fclose (fid, 0, 0);
{ignore any error}
fid := 0;
end;
end {test proc};
{***************************************************************}
begin
want_verbose := odd (parm); {PARM bit 15}
want_strip_trailing_blanks := odd (parm div 2); {PARM bit 14}
{arm control-Y}
xcontrap (baddress (cy_handler), old_plabel);
{do the main work...}
test;
end.
---------------------------------end cut-----------------------------------
Stan Sieler [log in to unmask]
http://www.allegro.com/sieler.html
|
