OS/2 Shareware BBS: 10 Tools/10-Tools.zip/ipo-101.zip/Samples.zip/imake.pas

Pascal/Delphi Source File | 1998-10-20 | 9KB | 334 lines

(*
** Irie Make utility
*)
program imake(makefile, target, out, output);
type
   TokenKind = (ProjectTok, ProgramTok, BeginTok, EndTok, DoTok,
                CommaTok, SemiColonTok, StringTok, IdTok,
                EmptyTok, EOFtok);
   Token = record
             lineno : integer;
             case kind : TokenKind of
                ProjectTok..SemiColonTok : ();
                StringTok : ( s : string);
                IdTok : (id : string);
                EOFtok, EmptyTok : ();
           end;
var
   makefile, out : text;
   target : string;
   line : string;
   lineno, linepos, linelen : integer;
   CurrToken : Token;
   whitespace : set of char;
   letter : set of char;
   MakeAll : boolean;
   NumMade : integer;

   procedure syntax;
   begin
      writeln('IMAKE - Irie Make');
      writeln('Usage:  imake makefile target');
      writeln('  where ''makefile'' is the name of the makefile');
      writeln('  and   ''target'' is the program/project to make');
      halt
   end;

   procedure error(s : string);
   begin
      writeln(out, 'ERROR: ', lineno:2, ':', s);
      halt
   end;

   procedure GetStringToken;
   var
      first, last : integer;
      c : char;
   begin
      c := line[linepos];
      first := linepos;
      last := pos(c, line, first+1);
      if last <= first then
         error('String not terminated');
      CurrToken.kind := StringTok;
      CurrToken.s := copy(line, first+1, last-first-1);
      CurrToken.lineno := lineno;
      linepos := last+1
   end;

   procedure GetIdToken;
   var
      first, last : integer;
      c : char;
      s : string;

      procedure identify(strg : string);
      (*
      ** Identify the following keywords
      ** project, program, begin, end, do
      *)
      var
         s : string;
      begin
         s := lowercase(strg);
         if s = 'project' then
            CurrToken.kind := ProjectTok
         else if s = 'program' then
            CurrToken.kind := ProgramTok
         else if s = 'begin' then
            CurrToken.kind := BeginTok
         else if s = 'end' then
            CurrToken.kind := EndTok
         else if s = 'do' then
            CurrToken.kind := DoTok
         else
            begin
               CurrToken.kind := IdTok;
               CurrToken.id := strg;
            end;
         CurrToken.lineno := lineno;
      end;

   begin
      c := line[linepos];
      first := linepos;
      last := first;
      while (last+1 <= linelen) and (line[last+1] in letter) do
          inc(last);
      s := copy(line, first, last-first+1);
      linepos := last+1;
      identify(s)
   end;

   procedure GetToken;

      function ProcessLine : boolean;
      var
         c : char;
      begin
         if CurrToken.kind = EOFtok then
            exit(true);
         while linepos <= linelen do
            begin
               c := line[linepos];
               case c of
               ',':
                  begin
                     inc(linepos);
                     CurrToken.kind := CommaTok;
                     CurrToken.lineno := lineno;
                     exit(true)
                  end;
               ';':
                  begin
                     inc(linepos);
                     CurrToken.kind := SemiColonTok;
                     CurrToken.lineno := lineno;
                     exit(true)
                  end;
               '{':
                  begin
                     inc(linepos);
                     CurrToken.kind := BeginTok;
                     CurrToken.lineno := lineno;
                     exit(true)
                  end;
               '}':
                  begin
                     inc(linepos);
                     CurrToken.kind := EndTok;
                     CurrToken.lineno := lineno;
                     exit(true)
                  end;
               '"', '''':
                  begin
                     GetStringToken;
                     exit(true)
                  end;
               '/':
                  if (linepos < linelen) and (line[linepos+1] = '/') then
                     linepos := linelen+1
                  else
                     error('Text not recognized');
               otherwise
                  if c in letter then
                     begin
                        GetIdToken;
                        exit(true)
                     end
                  else if c in whitespace then
                     inc(linepos)
                  else
                     error('Text not recognized')
               end (* case *)
         end; (* while *)
         exit(false)
      end; (* ProcessLine *)

      procedure NewLine;
      begin
         if eof(makefile) then
            begin
               CurrToken.kind := EOFtok;
               CurrToken.lineno := lineno;
               exit
            end;
         readln(makefile, line);
         linelen := length(line);
         inc(lineno);
         linepos := 1
      end;

(*
      procedure PrintToken;
      begin
         case CurrToken.kind of
         ProjectTok:
            write(out, '<PROJECT>');
         ProgramTok:
            write(out, '<PROGRAM>');
         BeginTok:
            writeln(out, '<BEGIN>');
         EndTok:
            begin
               writeln(out);
               writeln(out, '<END>')
            end;
         DoTok:
            writeln(out, '<DO>');
         CommaTok:
            write(out, ', ');
         SemiColonTok:
            write(out, '; ');
         StringTok:
            write(out, '''', CurrToken.s, '''');
         IdTok:
            write(out, CurrToken.id);
         EmptyTok:
            write(out, '<EMPTY>');
         EOFtok:
            write(out, '<EOF>')
         end
      end;
*)

   begin (* GetToken *)
      CurrToken.kind := EmptyTok;
      if lineno = 0 then
         NewLine;
      while not ProcessLine do
         NewLine;
      (* PrintToken *)
   end; (* GetToken *)

   procedure skip(k : TokenKind);
   begin
      if CurrToken.kind <> k then
         error('Invalid syntax');
      GetToken
   end;

   procedure run(command, name : string);
   var
      rc : integer;
      s : string;
   begin
      s := command+' '+name;
      writeln(out, 'Running ', s);
      rc := system(s);
      writeln(out, 'Exit code ', rc:3);
      if rc <> 0 then
         halt(rc);
      inc(NumMade)
   end;

   procedure parse;
   var
      ProjectName : string;

      function ParseName : string;
      begin
         case CurrToken.kind of
            Idtok: ParseName := CurrToken.id;
            StringTok: ParseName := CurrToken.s;
            otherwise error('Illegal syntax');
         end; (* case *)
         skip(CurrToken.kind);
      end;

      procedure ParseProjectGroup;

         procedure ParseProgramSpec;
         var
            ProgramName : string;
            MakeProgram : boolean;

            procedure ParseProgramGroup(b : boolean);

               procedure ParseAction(b : boolean);
               var
                  command, fn : string;
               begin (* ParseAction *)
                  skip(Dotok);
                  command := ParseName;
                  skip(BeginTok);
                  repeat
                     fn := ParseName;
                     if b then
                        run(command, fn);
                     if ((CurrToken.kind = CommaTok) or (CurrToken.kind = SemiColonTok)) then
                        skip(CurrToken.kind)
                  until ((CurrToken.kind <> IDtok) and (CurrToken.kind <> StringTok));
                  skip(EndTok)
               end; (* ParseAction *)

            begin (* ParseProgramGroup *)
               skip(BeginTok);
               repeat
                  ParseAction(b);
               until CurrToken.kind <> DoTok;
               skip(EndTok);
            end; (* ParseProgramGroup *)

         begin (* ParseProgramSpec *)
            skip(ProgramTok);
            ProgramName := ParseName;
            MakeProgram := MakeAll or (lowercase(ProgramName) = lowercase(target));
            if MakeProgram then
                writeln(out, 'Making ', ProgramName);
            ParseProgramGroup(MakeProgram)
         end; (* ParseProgramSpec *)

      begin (* ParsePojectGroup *)
         skip(BeginTok);
         while CurrToken.kind = ProgramTok do
            ParseProgramSpec;
         skip(EndTok);
      end; (* ParsePojectGroup *)

   begin (* parse *)
      skip(ProjectTok);
      ProjectName := ParseName;
      if lowercase(ProjectName) = lowercase(target) then
         MakeAll := true
      else
         MakeAll := false;
      NumMade := 0;
      ParseProjectGroup;
      if NumMade = 0 then
         writeln(out, 'WARNING: No targets were made')
   end; (* parse *)

begin
   if paramcount < 2 then
       syntax;
   reset(makefile);
   rewrite(out);
   writeln(out, 'Target = ', target);
   lineno := 0;
   whitespace := [chr(0)..' '];
   letter := ['@', 'a'..'z', 'A'..'Z', '0'..'9', '_', ':', '\', '.'];
   GetToken;
   parse
end.