{From:	29543::graham "David Graham" 29-OCT-1991 15:25:53.65
On another topic, I made a little change in ProcInt to read
in procedure file once and for all and then to work from
an array. Here it is:}

{----------this goes up at front in variables of darfs.pas---------------}
    oldprocfile:string; kch,nch:integer;
    buf:array[1..4096] of Char;
    proctext:array [1..16384] of char;
{-----------extra procedure and modified ProcInterp--------------}
function xeadln:string;
var m:integer;line:string;
begin
  m:=1;   line:='';
  while not (Ord(proctext[kch]) =13) do
  begin
    line:=line+proctext[kch] ;m:=m+1;kch:=kch+1;
  end;
  kch:=kch+2;
  xeadln:=line;
end;
{-------------------------}

procedure ProcInterp;
var fi: text; var line:string;parm:string[6];
    ch,Fch: char; n:word; procname:string[10];
begin
  if stk<=1 then if procfile <> oldprocfile then begin
    s:=fsearch(procfile+'.prc',drive);
    if s='' then procfile:='PROCXXXX';
    s:=fsearch(procfile+'.prc',drive);  
      if s='' then begin
        writeln('Procedure File ',procfile,'.PRC Not Found');
        exit;
      end else
    assign (fi,drive+procfile+'.prc');
    SetTextBuf(fi,buf);
    reset(fi);nch:=1;
    while not Eof(fi) do
     begin
      read(fi,ch);proctext[nch]:=ch;
      nch:=nch+1;
     end;
    close(fi);
    nch:=nch-1;
    writeln(' no of characters in file=',nch);
    oldprocfile:=procfile;
  end;
  kch:=1;
  textattr:=yellow; 
  repeat
    n:=6;procname:='';
    repeat
      if  kch>nch then begin
        if procname=''then
         writeln('Procedure not found: ',opcommand);
         normvideo; exit;end;
      line:=xeadln;
      parm := copy(line,1,n);
    until parm ='DEFINE';
    repeat
      n:=n+1; fch:=line[n];
    until fch<>' ';
    repeat
      procname:=procname+fch;
      n:=n+1; fch:=line[n];
    until fch=' ';
  until procname=opcommand;
  stk:=stk+1;if stk>5 then begin
    writeln('Proc. stack overflow');
    exit;end;
  procparm1[stk]:=getparm(opinline);
  procparm2[stk]:=getparm(opinline);
  {writeln('PROC P1:',procparm1[stk],' P2: ',procparm2[stk],' s=',stk)};
  {readln;}
  repeat {Parse and pass to SnapInterpret};
    while waitflag do begin
      if checkflag then Chekr;
    end;
      line:=xeadln;
      parm:= copy(line,1,3);
      if parm<>'END' then begin
        if xdispflag then writeln(procname,'/',line);
        opinline:=line;
        textattr:=yellow; 
        SnapInterpret(opinline);
      end;
  until parm='END';
  comflag:=true;normvideo;  
  stk:=stk-1;
  {Writeln('End of Procedure: ',procname);}
end;
{-------------------------}