{$R- No runtime checks }
 
program select (tty);
 
{ This program can extract selected modules from a packed
  source file.  Each module must start with one line giving
  the module's file name and end with one line containing '****'.
  Such packing is performed by the program PACK.
}
 
label	99;
 
 
var
    inp, outp: text;
    filnam, searched, packfile:  packed array [1..22] of char;
    i, nstar:  integer;
    c:  char;
    eom:  boolean;
 

procedure exitst ( x: integer );  extern;  { Exit with status }

 
begin  { select }
write ('Name of packed file: ');   break;
readln;
read (packfile);
loop
    reset (inp, packfile);
    if eof(inp) then
	begin
	writeln (packfile, 'not found');
	exitst (2)
	end;
    write ('Searched file: ');  break;
    readln;
    exit if eoln(tty);
    read (searched);
    for i := 1 to 22 do  { Convert searched to uppercase }
	if (searched[i] >= 'a') and (searched[i] <= 'z') then
	    searched[i] := chr(ord(searched[i]) - 32);
    loop
	if not eof(inp) then read (inp, filnam);
	exit if (filnam = searched) or eof(inp);
	while not eof(inp) and (inp^ <> '*') do readln (inp);
	if not eof(inp) then readln (inp);  { Skip eom line }
	end;
    if eof(inp) then
	begin
	writeln (searched, 'not found');
	goto 99
	end;
    writeln (filnam);
    readln (inp);  { Advance to first data line of module }
    rewrite (outp, filnam);
    if ioresult(outp) < 0 then
	begin
	writeln ('Error creating ', filnam, ioresult(outp));
	exitst (2)
	end;
    eom := false;
    while not eom do
	begin
	nstar := 0;
	for i := 1 to 4 do
	    if inp^ = '*' then
		begin
		nstar := nstar + 1 ;
		get (inp)
		end;
	if nstar = 4 then
	    eom := true
	else
	    begin
	    for i := 1 to nstar do write (outp, '*');
	    while not eoln(inp) do
		begin  { Copy line to output file }
		read (inp, c);
		write (outp, c)
		end;
	    writeln (outp);
	    if ioresult(outp) < 0 then
		begin
		writeln ('Error writing to ', filnam, ioresult(outp));
		exitst (2)
		end;
	    end;
	readln (inp);
	if eof(inp) then
	    eom := true
	else
	    if ioresult(inp) < 0 then
		begin
		writeln ('Error reading ', filnam, ioresult(inp));
		exitst (2)
		end
	end;  { while not eom }
99:
    end  { loop }
end.