% This is MAKEPROG.CF.IO.TURBO as of 02 May 89
%--------------------------------------------------------
% (c) 1989 by J.Schrod.
%
% Changefile for I/O handling with Turbo-Pascal (V5.0)
% text_char is extended ASCII (up to chr(255))
% text_file must be named text
% tab marks should be recognized
% binding of external files to internal file variables is not done by the
% run time system, therefor reset and rewrite must be done with own
% procedures
% file name is taken from command line
% files are buffered for higher performance
% file access is done with a read/write in a string (no get/put available)
% files must be closed (???)
%
@x S 2
@t\4@>@<Error handling procedures@>@;
@y
@t\4@>@<Turbo Pascal specific procedures@>@;
@t\4@>@<Error handling procedures@>@;
@z
@x S 12
@d last_text_char=127 {ordinal number of the largest element of |text_char|}
@y
@d last_text_char=255 {ordinal number of the largest element of |text_char|}
@z
@x S 12
@!text_file=packed file of text_char;
@y
@!text_file=text;
@z
@x S 17
for i:=1 to " "-1 do xchr[i]:=' ';
@y
for i:=1 to " "-1 do xchr[i]:=' ';
xchr[tab_mark] := chr(tab_mark);
@z
@x S 24
reset(doc_file); reset(change_file);
@y
@< Initialize the Turbo Pascal specific input/output related variables @>;
tp_reset(doc_file, 'DOC', doc_buffer);
tp_reset(change_file, 'CHF', chf_buffer);
@z
@x S 26
rewrite(prog_file);
@y
tp_rewrite(prog_file, prog_ext, prog_buffer);
@z
@x S 28 [ERROR]
function input_ln(var f:text_file):boolean; {inputs a line or returns |false|}
var final_limit:0..buf_size; {|limit| without trailing blanks}
begin limit:=0; final_limit:=0;
if eof(f) then input_ln:=false
else begin
while not eoln(f) do
begin buffer[limit]:=xord[f^]; get(f);
incr(limit);
if (buffer[limit-1]<>" ") and (buffer[limit-1]<>tab_mark) then
final_limit:=limit;
if limit=buf_size then
begin while not eoln(f) do get(f);
decr(limit); {keep |buffer[buf_size]| empty}
print_nl('! Input line too long'); error; mark_error;
@.Input line too long@>
end;
end;
read_ln(f); limit:=final_limit; input_ln:=true;
end;
end;
@y
function input_ln(var f:text_file):boolean; {inputs a line or returns |false|}
var s: string; {temporary line storage}
final_limit: 0..buf_size+1; {index into |s|}
i: 0..buf_size; {index into |buffer|}
begin
if eof(f) then
begin limit := 0; input_ln := false;
end
else begin read_ln(f,s);
final_limit := ord(s[0]);
while (final_limit > 0) and
((s[final_limit] = ' ') or (s[final_limit] = xchr[tab_mark])) do
decr(final_limit);
if final_limit > buf_size+1 then final_limit := buf_size + 1;
for i:=0 to final_limit-1 do buffer[i] := xord[s[i+1]];
if final_limit >= buf_size then
begin final_limit := buf_size - 1; {keep |buffer[buf_size]| empty}
print_nl('! Input line too long'); error; mark_error;
@.Input line too long@>
end;
limit := final_limit; input_ln := true ;
end;
end;
@z
@x S 31
{here files should be closed if the operating system requires it}
@y
close(prog_file); close(doc_file); close(change_file);
@z
@x
procedure put_line;
var i: 0..buf_size;
begin
for i:=0 to limit-1 do write(prog_file, xchr[buffer[i]]);
write_ln(prog_file);
end;
@y
procedure put_line;
var i: 0..buf_size;
s: string; {temporary line storage}
begin
for i:=0 to limit-1 do s[i+1] := xchr[buffer[i]];
s[0] := chr(limit); write_ln(prog_file, s);
end;
@z
@x S 188
\noindent This module should be replaced, if necessary, by
changes to the program that are necessary to make
\MAKEPROG{} work at a particular installation. It is
usually best to design your change file so that all changes
to previous modules preserve the module numbering; then
everybody's version will be consistent with the printed
program. More extensive changes, which introduce new
modules, can be inserted here; then only the index itself
will get a new module number.
@^system dependencies@>
@y
\noindent This module should be replaced, if necessary, by
changes to the program that are necessary to make
\MAKEPROG{} work at a particular installation. It is
usually best to design your change file so that all changes
to previous modules preserve the module numbering; then
everybody's version will be consistent with the printed
program. More extensive changes, which introduce new
modules, can be inserted here; then only the index itself
will get a new module number.
@^system dependencies@>
@* Resetting and rewriting files.
\noindent Turbo Pascal allows the usage of command line
parameters but does not connect external files with the
internal file variables automatically. Therefore we demand
the file name (without extension) in the command line---with
this name we can open resp.\ create the files. The real
opening of input files is done via |tp_reset| and the
creating of output files is done via |tp_rewrite|. Both
procedures have two parameters, the file variable and the
extension which should be used together with the file name.
The extension is passed without a dot.
@ But first we have to look at the command line. If there is
no parameter present we print a usage message and finish the
program afterwards. Here |jump_out| cannot be used because
files would be closed that would be not open.
@< Initialize the Turbo... @>=
if param_count < 1 then
begin print('! usage: makeprog [-ext] file_name'); halt;
end
else begin
file_name := param_str(1);
if (param_count = 2) and (file_name[1] = '-') then
begin prog_ext := copy(file_name, 2, 3); file_name := param_str(2);
end
else prog_ext := 'PRG';
end;
@ @< Type... @>=
@!file_buffer=packed array[1..4096] of byte;
@ @< Glob... @>=
@!doc_buffer:file_buffer; {file buffer for primary input}
@!chf_buffer:file_buffer; {file buffer for updates}
@!prog_buffer:file_buffer; {file buffer for output}
@ If an input file can't be opened we handle it just like a
file that is not there. I.e., we use \.{NUL:} as the input
file---|eof| will then always return true as presumed by the
program.
@< Turbo Pascal specific procedures @>=
procedure tp_reset( var f: text_file; ext: string; var buf: file_buffer );
begin assign(f, file_name+'.'+ext); @/
@{@=$I-@>@} reset(f); @{@=$I+@>@}
if io_result = 0 then settextbuf(f, buf)
else begin assign(f, 'NUL'); reset(f); { |eof(f) = true| }
end;
end;
@#
procedure tp_rewrite( var f: text_file; ext: string; var buf: file_buffer );
begin assign(f, file_name+'.'+ext); rewrite(f); settextbuf(f, buf);
end;
@z
