Programmer 7500/MAX_PROGRAMMERS.iso/PASCAL/MPREP.ZIP/MPREP.PAS

Pascal/Delphi Source File | 1987-01-12 | 13.6 KB | 347 lines

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 }