program macro;
  { Mike Parr    m.parr@shu.ac.uk
     1/july.03  -  v1.1

  usage:   macro defFile   callFile  outFile
    the definition file only holds defs.
    here is an e.g of one def:
    define
    $swap
    temp=param1
    param1=param2
    param2=temp
    enddefine

    i.e starts with define, eds with  enddefine, the macro name
       starts with $
       no inenting allowed


    You refer to formal params as param1   ,   param2,  etc ...  param9
    where param is a formal param  - 1 to 9 only.
    If there are not enough actuals - then param is left as it is.
    if there are 2 many act params, they are ignored. 

    the calls file has calls, processed as follows:

   expand all lines of form :
  $fred
  =aaa                      the
  =bbb                     2
                          params (cannot be indented)
  ended by a line not starting with equals
  - the above is a call of macro fred, with 2 parameters
  aaa,bbb

  - undefined macro calls are copied as is.
  - other lines are copied as is.
  The result from the above call is the text:

  temp=aaa
  aaa=bbb
  bbb=temp

        where param1 has been replaced by aaa, etc

}

 {$apptype console}
uses
  Sysutils;


{usage:  macro  defFile, callFile  outFile

{globals }
const MAXDEFS=500;

var
line,
     defFileString, callFileString, outFileString:String;
crlf:String;
defWord, enddefWord:String;

place:integer;
bodies,names:array[1..MAXDEFS] of String;
inFile, outFile:textfile;
myEOF, lastline:boolean;


{---------------}
function eofJSP :boolean;  // do jackson-style eof, for read-ahead
begin
   eofJSP:=myEOF;
end;
{---------------}


 { The function searches for a substring 'SearchFor' in a string
  'Str' and replaces all found substrings by 'ReplaceStr' }

function ReplaceIn(SearchFor, ReplaceStr, Str : String): String;
var
  Dummy, st : String;
  i : integer;
begin
  { make a temp. copy of the Str }
  st := Str;
  { first position of the substring }
  i := Pos(SearchFor, St);
  Dummy := '';

  { search lasts while the specified substring is found }
  while i <> 0 do
  begin
    Dummy := Dummy + Copy(St, 0, i - 1) + ReplaceStr;
    st := copy(st, i + length(SearchFor), length(st)+1);
    i := Pos(SearchFor, St);
  end;

  { result: the substrings replaced by 'ReplaceStr' }
  result := Dummy + st;
end;

{-------------------------}


procedure error(message:String);
var dummy:String;
Begin
    writeln('***** Error: '+message);  writeln;
    writeln('...Press  Enter to end the program.');
    readln(dummy);
    Halt;
end;
{----------------------------}


procedure readLine;
begin
if lastLine then begin
    line:='';
    myEOF:=true;
    end
else Begin
     myEOF:=false;
     readln(inFile, line);
     if eof(inFile) then
         lastLine:=true;
end;
end;
{--------------------------------}

procedure storeDef;

begin
 crlf:=chr(13)+chr(10);
 if copy(line,1,1)<> '$' then
     error('Missing $ before mac name in a define.')
 else begin


    place:=place+1;
    names[place]:=line;
    bodies[place]:='';

    {loop to store body... }
    readLine;
    while (line<>enddefWord) and (not eofJSP ) do begin
        bodies[place]:=bodies[place]+line+crlf;
        readLine;
    end;
    end;{if}
    readLine; {read ahead}
end;
{--------------------------}



procedure processDefs;
begin
while not eofJSP do begin
    if line=defWord then   begin
        readLine;
        storeDef;
    end
    else
        readLine;

    { ignore any enddef (done elsewhere) or embedded $calls
    and ignore any rubbish between enddef and next define}
end;{while}
closeFile(inFile);
end;
{--------------------------------}

procedure processCall(macName:string);
var
params:array[1..100] of string;  { but only the first 1..9 allowed }
param:integer;
n:integer;
body, actualParam:string;
found:boolean;
doneParams:boolean;

begin
n:=1;
found:=false;
{find where macName stored...}
while(n<=place) and not found do begin
    if macName=names[n] then
        found:=true
     else
        n:=n+1;
end{while};

if not found then begin
    { macro undefined: copy line  unaltered }
    writeln(outFile, line);
    readLine;
    end
else begin
   {expand }
    body:=bodies[n];
    param:=1;
    doneParams:=false;
    {any params ?  }
    if copy(line,1,1) <> '=' then
         doneparams:=true;

    while (param<= 9) and(doneParams=false) do begin
        actualparam:=copy(line,2, length(line)-1);
        body:=replaceIn('param'+chr(ord('0')+param), actualParam, body);
        param:=param+1;
        readLine;   {any more params? }
        if copy(line,1,1)<>'=' then
             doneparams:=true;

    end;{ while param loop }
    write(outFile, body);
    end;{if}
end;{proc}

{-----------------------------}


procedure processAllCalls;
var
macName:  String;
begin
while not eofJSP do begin

    if copy(line,1,1)='$' then  begin
           macName:=line;
           readLine;
           processCall(macname) {does a read-ahead}
    end
    else   begin
          writeln(outFile,line);
          readline;
    end;

end;{while}
end;
{------------------------}



Begin {main}
place:=0;
defWord:='define';
enddefWord:='enddefine';

if paramCount<>3 then
    error('- macro needs 3 parameters');

defFileString:=ParamStr(1);
callFileString:=ParamStr(2);
outFileString:=ParamStr(3);
assignFile(inFile, defFileString);
reset(inFile);

lastLine:=false;
readLine;
processDefs;

assignFile(inFile, callFileString);
reset(inFile);
assignFile(outFile, outFileString);
rewrite(outFile);

lastLine:=false;
readLine;
processAllCalls;

closeFile(inFile);
closeFile(outFile);
writeln('Processing complete.');
end.