home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
OS/2 Shareware BBS: 10 Tools
/
10-Tools.zip
/
ipo-101.zip
/
Samples.zip
/
imake.pas
< prev
next >
Wrap
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.