{ Build -- very crude version of MAKE

  John Fritz 
  MCV Academic Computing
  Medical College of Virignia
  Box 16, MCV Station
  Richmond, VA   23298
  (804) 786-9843
  }

[inherit('mcv:rtl')] program build;
type
   string = varying[256] of char;
const
   flag = ']';
   maxLine = 1024;
var
   inp: text; line: varying[maxLine+1] of char;
   p: integer;

procedure getLine;
begin
   p := 2;
   if eof(inp) then line := ' '
   else begin
      readln(inp,line);
      if line.length = 0 then line := ' '
      end;
   end;

function getToken(var t: string): boolean;
var
   q: integer;
begin
   line.length := line.length+1;
   line[line.length] := flag;
   while line[p] <= ' ' do p := p+1;
   if p = line.length then getToken := false
   else begin
      getToken := true;
      line[line.length] := ' ';
      q := p; repeat q := q+1 until line[q] <= ' ';
      t := substr(line,p,q-p);
      if find_member(t,['.',';','[',']','-',':']) > 0 then
         t := 'f$cvtime(f$file("'+t+'","RDT"))';
      p := q;
      end;
   line.length := line.length-1;
   end;

var
   outp: text;

procedure skipLines;
begin
   p := 2;
   while line[1] <> flag do begin
      writeln(outp,line);
      if eof(inp) then line := flag
      else begin
         readln(inp,line);
         if line.length = 0 then line := ' ';
         end;
      end;
   end;

var
   name,tag,result,check: string;
   setSymbol: varying[512] of char;
   labl: integer;
const
   prefix = 'BUILD___';
   endLabel = prefix+'ENDIT';
   oldMessage = prefix+'OldMessage';
begin
   lib$get_foreign(%descr name);
   open(inp, name, history:=readonly, record_length:=maxLine, default:='.BLD');
   open(outp, '.COM', history:=new, record_length:=maxLine, default:=name);
   reset(inp); rewrite(outp);
   getLine;
   skipLines;
   labl := 0;
   while not eof(inp) do begin
      labl := labl+1;
      if not getToken(tag) then begin getLine; skipLines end
      else if not getToken(result) then begin getLine; skipLines end
      else begin
         writeln(outp,'$ on warning then continue');
         setSymbol := '$ '+tag+' = '+result;
         writeln(outp,setSymbol);
         getLine;
         if line[1] = flag then begin
            getToken(check);
            write(outp,'$ if '+check+' .les. '+tag);
            repeat
               while getToken(check) do begin
                  writeln(outp,' .and. -'); 
                  write(outp,'     '+check+' .les. '+tag);
                  end;
               getLine;
               until line[1] <> flag;
            writeln(outp,' then goto '+prefix,labl:1);
            writeln(outp,'$ write sys$output "'+tag+'"');
            end;
         writeln(outp,'$ on warning then goto '+endLabel);
         skipLines;
         writeln(outp,setSymbol);
         end;
      writeln(outp,'$'+prefix,labl:1,':');
      end;
   writeln(outp,'$'+endLabel+':');
   writeln(outp,'$ status = $status');
{   writeln(outp,'$ set message '''+oldMessage+'''');}
   writeln(outp,'$ exit status'); 
   end.
