{$R- No runtime checks }
 
program PACK (input, tty);
 
{ This program compresses arbitrary source files 
  into one file with unpacking information in it.
  The names of the source files are given from the terminal.
  The resulting file contains for each file:
   - one line with the file name
   - the source module lines
   - one line containing '****'
 
  An indirect file specification can also be specified as
  input.   eg.  If @XYZ is entered in response to file name,
  then the names of the files to be packed will be taken from
  file XYZ.
 
  Unpacking can be performed by the program UNPACK.
}
 
type
    nametype = packed array [1..22] of char;
 
var
    i, j, k:  integer;
    c:  char;
    filnam:  nametype;
    using_ind_file:  boolean;
    indfile:  text;
    outf:  text;
    none:  boolean;


procedure exitst ( x:  integer );   extern;  { Exit with status }

procedure  getname ( var name: nametype;  var none: boolean ) ;

var
    i:  integer;
 

    procedure  getind  ( var name: nametype;
			 var none: boolean );
    begin
    none := eof(indfile);
    if none then
	using_ind_file := false
    else
	begin
	using_ind_file := true;
	name[1] := ' ';
	read (indfile, name);
	readln (indfile);
	end
    end;  { getind }
 
 
begin  { getnam }
none := true ;
if using_ind_file then  getind (name, none) ;
    
if none then
    begin
    name[1] := ' ';
    write (tty, 'Source file: ');   break;
    readln (tty);
    if not eof(tty) then read (tty, name);
 
    if name[1] = '@' then
	begin
	reset (indfile, name[2..22]) ;
	if ioresult(indfile) < 0 then
	    writeln ('Error opening ', name[2..22], ioresult(indfile));
	getind (name, none)
	end ;
 
    none := name[1] = ' ';
    end;

if not none then
    for i := 1 to 22 do  { Convert name to uppercase }
	if (name[i] >= 'a') and (name[i] <= 'z') then
	    name[i] := chr(ord(name[i]) - 32);
end;  { getnam }

begin
 
write (tty, 'Output file name: ');   break;
readln (tty);
read (tty, filnam);
rewrite (outf, filnam);
if ioresult(outf) < 0 then
    begin
    writeln (tty, 'Error creating output file: ',ioresult(outf):1);
    exitst (2)
    end;
 
using_ind_file := false;
loop
    getname (filnam, none);
    exit if none;
    if using_ind_file then writeln (tty, filnam);

    reset (input, filnam);
    if eof(input) then
	writeln (tty, filnam, ' not found')
    else
	begin
	writeln (outf, filnam);
	while not eof(input) do
	    begin  { copy a line }
	    while not eoln(input) do
		begin
		read (c);
		write (outf, c);
		end;
	    readln;
	    writeln (outf);
	    if ioresult(outf) < 0 then
		begin
		writeln (tty, 'I/O error on output: ', ioresult(outf):1);
		exitst (2)
		end
	    end;
	writeln (outf, '****');  { End of module marker }
	end;
    end;  { loop }
writeln (tty, 'finished')
end.