Category : Miscellaneous Language Source Code
Archive   : MPREP11.ZIP
Filename : MPREP.PAS

program MPREP;
{ Macro Preprocessor and version control program to give C-like preprocessing
to programs written in any language (or general text).
The following commands can be embedded in any ASCII file
(They must start with a '#' as the first character of a new line):
#define identifier [string]
#ifdef identifier
#ifndef identifier
#endif
In addition, using the identifier in any text following its definition
results in replacement of the identifier by the string that followed
it in the #define statement. (Macros can contain references to previously-
defined macros.) MPREP is invoked as:
MPREP [-E ext] [-D identifier] filename [filename2] [filename3] ...
where ext is an optional filename extension, which is used to name the
output file (the default is PAS). For example, the command:
MPREP MAIN.PRE
would result in the creation of an output file named MAIN.PAS.
Identifiers specified with the -D flag will define the identifier.
Note that all identifiers that are defined on the command line and
in the files are defined for all files listed. Also, it should be noted
that all commands in MPREP are case-sensitive. Thus, an identifier specified
in capital letters will not be confused with the same identifier in lower
case. The only exception is the letters '-D' and '-E' on the command line,
which may be specified in either upper or lower case.
I won't bother going into specifics on how to use the #define, #ifdef,
#ifndef, and #endif commands. Any book on the C language can tell you how
they work. (The only differences between my version and standard C are
(1) In mine, macro definitions that contain previously-defined macros are
expanded; and (2) I have not bothered to implement the optional designation
of an identifier after #endif. It always goes with the last open #ifdef or
#ifndef.)
Ken Van Camp
P.O. Box 784
Stroudsburg, PA 18360
MPREP may be freely distributed, or distributed at nominal copying/mailing
fee, but may not be otherwise charged for. It may not be incorporated into
commercial software without express written permission of the author.
}

const MAXDEF = 200; { max # defines }

type nametype = string[40];
stringtype = string[70];
filetype = string[40];

var Defname: array[1..MAXDEF] of nametype; { defined names }
Defstring: array[1..MAXDEF] of stringtype; { strings defined by Defname}
Extension: string[4]; { filename extension for output files }
Param: integer; { cmmd-line parameter # }
Filin: text; { input files }
Filout: text; { output files }
Numdef: integer; { # defined names }
Nextext: boolean; { flag that next param is an extension }
Nextdef: boolean; { flag that next param is a definition }
Line: string[255]; { line inputted from file }
Lenline: integer; { length of line }
Startstr: integer; { start pos of define string }
Endstr: integer; { end pos of define string }
Defined: boolean; { flag OK to echo lines to file }
Name: nametype; { name of define macro }
Def: integer; { define # }
Found: boolean; { flag found define name }
Nif: integer; { # open ifdef's or ifndef's }
Ifdef: integer; { flag the ifdef that stopped echoing }
Fdpos: integer; { position where macro name was found }
Fileread: boolean; { flag that a file was read }
Nextc: integer; { next character after macro names }

procedure USAGE;
begin
writeln ('usage: PREP [-E ext] [-D defname] flnm [flnm2] [flnm3] ...');
halt;
end; { procedure USAGE }

procedure MAXEXCEED;
begin
writeln ('PREP: Maximum # of defines (',MAXDEF,') exceeded.');
halt;
end; { procedure MAXEXCEED }

function ISALPHANUM (c: char): boolean;
{ Returns TRUE if c is alphanumeric }
begin
if ((c>='0') and (c<='9')) or ((c>='A') and (c<='Z')) or
((c>='a') and (c<='z')) then
ISALPHANUM := TRUE
else
ISALPHANUM := FALSE;
end; { function ISALPHANUM }

procedure OPENFILIN (Filename: filetype; var Filin: text);
{ Open the input file, with error checking }

var Flnm: filetype;
Fileopen: boolean;

begin
Fileopen := FALSE;
Flnm := Filename;
while (NOT Fileopen) do begin
assign (Filin, Flnm);
{$I-}
reset (Filin);
{$I+}
if (ioresult <> 0) then begin
write ('Input file ',Flnm,' cannot be opened. Enter new filename: ');
readln (Flnm);
if (Flnm = '') then
halt;
end else
Fileopen := TRUE;
end; { while }
end; { procedure OPENFILIN }

procedure OPENFILOUT (Filename: filetype; var Filout: text);
{ Open the output file, with error checking}

var Flnm: filetype;
Fileopen: boolean;
Period: integer; { location of period in file name }

begin
Fileopen := FALSE;
Flnm := Filename;
while (NOT Fileopen) do begin
Period := pos ('.', Flnm);
if (Period > 0) then
Flnm := copy (Flnm, 1, Period-1);
{ Check to see if the user put a period in the filename extension }
if (Extension[1] = '.') then
Flnm := Flnm + Extension
else
Flnm := Flnm + '.' + Extension;
if (Flnm = Filename) then begin
writeln ('MPREP: Input and output filenames (',Flnm,') are same.');
halt;
end;
assign (Filout, Flnm);
{$I-}
rewrite (Filout);
{$I+}
if (ioresult <> 0) then begin
write ('Output file ',Flnm,' cannot be opened. Enter new file name: ');
readln (Flnm);
if (Flnm = '') then
halt;
end else
Fileopen := TRUE;
end; { while }
end; { procedure OPENFILOUT }

begin { program PREP }
{ Initializations }
Fileread := FALSE;
Extension := 'PAS'; { default is for Pascal file extension }
Nextext := FALSE;
Nextdef := FALSE;
Numdef := 0;
Defined := TRUE;
Nif := 0;
Ifdef := 0;

for Param := 1 to paramcount do begin
if (Nextext) then begin
{ Last parameter was -E, so this parameter is the filename extension. }
if (length (paramstr (Param)) > 3) then
usage;
Extension := paramstr (Param);
Nextext := FALSE;
end else if (Nextdef) then begin
{ Last parameter was -D, so this parameter is a definition. }
Numdef := Numdef + 1;
if (Numdef > MAXDEF) then
maxexceed;
Defname[Numdef] := paramstr (Param);
Defstring[Numdef] := '';
Nextdef := FALSE;
end else if (copy (paramstr(Param),1,2) = '-e') or
(copy (paramstr(Param),1,2) = '-E') then begin
{ -E flag found; next parameter should contain filename extension }
Nextext := TRUE;
end else if (copy (paramstr(Param),1,2) = '-d') or
(copy (paramstr(Param),1,2) = '-D') then begin
{ -D flag found; next parameter should contain definition }
Nextdef := TRUE;
end else begin
{ Just a normal file name }
openfilin (paramstr (Param), Filin);
openfilout(paramstr (Param), Filout);
Fileread := TRUE;

{ Now read the file & process the define's }
repeat
readln (Filin, Line);
Lenline := length (Line);
if (copy (Line,1,8) = '#define ') then begin
{ Find the #define name }
{ (Starts at first non-blank & non-tab.) }
Startstr := 9;
while (Startstr <= Lenline) and ((Line[Startstr] = ' ') or
(Line[Startstr] = ^I)) do
Startstr := Startstr + 1;
if (Startstr <= Lenline) then begin
{ Name was found; define it }
Numdef := Numdef + 1;
if (Numdef > MAXDEF) then
maxexceed;
Endstr := Startstr + 1;
while (Endstr <= Lenline) and (Line[Endstr] <> ' ') and
(Line[Endstr] <> ^I) do
Endstr := Endstr + 1;
if (Endstr > Lenline) then
Endstr := Lenline;
Defname[Numdef] := copy (Line, Startstr, Endstr-Startstr);

{ Now find the string defined, if it exists }
Startstr := Endstr + 1;
while (Startstr <= Lenline) and ((Line[Startstr] = ' ') or
(Line[Startstr] = ^I)) do
Startstr := Startstr + 1;
if (Startstr <= Lenline) then begin
{ Definition was found }
Defstring[Numdef] := copy (Line, Startstr, Lenline);
{ Check for any other macros within the definition }
for Def := 1 to Numdef-1 do
if (Defstring[Def] <> '') then begin
Fdpos := pos (Defname[Def], Defstring[Numdef]);
if (Fdpos > 0) then begin
Found := TRUE;
if (Fdpos > 1) then
if isalphanum (Defstring[Numdef][Fdpos-1]) then
Found := FALSE;
Nextc := Fdpos + length (Defname[Def]);
if (Found) and (Nextc <= length(Defstring[Numdef])) then
if isalphanum (Defstring[Numdef][Nextc]) then
Found := FALSE;
if (Found) then
Defstring[Numdef] := copy (Defstring[Numdef],1,Fdpos-1)
+ Defstring[Def] +
copy (Defstring[Numdef],Fdpos+length(Defname[Def]),
length(Defstring[Numdef]));
end; { if Fdpos }
end; { if Defstring[Def] }
{ for Def }
end else
{ No definition }
Defstring[Numdef] := '';
end; { if Startstr }
end else if (copy (Line,1,7) = '#ifdef ') then begin
Nif := Nif + 1;
if (Defined) then begin
Startstr := 8;
while (Startstr <= Lenline) and ((Line[Startstr] = ' ') or
(Line[Startstr] = ^I)) do
Startstr := Startstr + 1;
if (Startstr <= Lenline) then begin
{ Name was found; find the end of it }
Endstr := Startstr + 1;
while (Endstr <= Lenline) and (Line[Endstr] <> ' ') and
(Line[Endstr] <> ^I) do
Endstr := Endstr + 1;
if (Endstr > Lenline) then
Endstr := Lenline;
Name := copy (Line, Startstr, Endstr-Startstr+1);
{ Now see if the name was defined }
Found := FALSE;
for Def := 1 to Numdef do
if (Defname[Def] = Name) then
Found := TRUE;
if (Found) then
Defined := TRUE
else begin
Defined := FALSE;
Ifdef := Nif;
end; { if Found }
end; { if Startstr }
end; { if Defined }
end else if (copy (Line,1,8) = '#ifndef ') then begin
Nif := Nif + 1;
if (Defined) then begin
Startstr := 9;
while (Startstr <= Lenline) and ((Line[Startstr] = ' ') or
(Line[Startstr] = ^I)) do
Startstr := Startstr + 1;
if (Startstr <= Lenline) then begin
{ Name was found; find the end of it }
Endstr := Startstr + 1;
while (Endstr <= Lenline) and (Line[Endstr] <> ' ') and
(Line[Endstr] <> ^I) do
Endstr := Endstr + 1;
if (Endstr > Lenline) then
Endstr := Lenline;
Name := copy (Line, Startstr, Endstr-Startstr+1);
{ Now see if the name was defined }
Found := FALSE;
for Def := 1 to Numdef do
if (Defname[Def] = Name) then
Found := TRUE;
if (Found) then begin
Defined := FALSE;

Ifdef := Nif;
end else
Defined := TRUE;
end; { if Startstr }
end; { if Defined }
end else if (copy (Line,1,6) = '#endif') then begin
if (Ifdef = Nif) then begin
Defined := TRUE;
Ifdef := 0;
end;
Nif := Nif - 1;
end else if (Defined) then begin
{ No preprocessor directives; just a normal line }
{ Check for any defined macros }
Def := 1;
Found := FALSE;
while (Def <= Numdef) and (NOT Found) do begin
if (Defstring[Def] <> '') then begin
Fdpos := pos (Defname[Def], Line);
if (Fdpos > 0) then begin
Found := TRUE;
if (Fdpos > 1) then
if (isalphanum (Line[Fdpos-1])) then
Found := FALSE;
Nextc := Fdpos + length(Defname[Def]);
if (Found) and (Nextc <= Lenline) then
if (isalphanum (Line[Nextc])) then
Found := FALSE;
Line := copy (Line,1,Fdpos-1) + Defstring[Def] +
copy (Line,Fdpos+length(Defname[Def]),Lenline);
end; { if Fdpos > 0 }
end; { if Defstring[Def] }
Def := Def + 1;
end; { while Def... }
writeln (Filout, Line);
end; { if copy(Line,1,8)... }

until eof (Filin);
close (Filin);
close (Filout);
end; { if Nextext... }
end; { for Param }
if (NOT Fileread) then
usage;
end. { program PREP }