CP/M/CPM_CDROM.iso/beehive/program/chkif.arc/CHKIF.PAS

Pascal/Delphi Source File | 1990-07-22 | 5.6 KB | 248 lines

program chkif(ifil,output);
{
CHKIF v0.1 by J.Loke 87Sep06
Checks an ASM or PRN program for correct conditional assembly
and macro balance.

Vers Date    Name       Notes
0.10 87Sep06 J.Loke     Original version in TURBO Pascal
     Known bug: Will not process statements with non-comment ';'
     Known bug: Will not process COMMENT <flg> properly
}
type
  str=string[255];
var
  cmd: string[127] absolute $80;
  ifil: text;
  p,v: boolean;
  i,m,n: byte;
  l: integer;
  lif,lelse,lmacro,nmacro: array [1..16] of integer;
  a,b,c: str;
function kwd(wrd: str): boolean;
{
  KWD uses global variable b: str
  KWD returns true if WRD is a keyword in string B
  WRD must be delimited by chars belonging to the set PUNC,
  else KWD returns false
}
  const
    punc: set of char = [#0..'?','['..'`','{'..'~'];
  var
    i: byte;
    f: boolean;
  begin
    i:=pos(wrd,b);
    if (i=0) then
{
WRD not in string B
}
      f:=false
    else
    begin
      f:=true;
{
Test if a PUNCtuation char precedes WRD
}
      if (i>1) then
        f:=(b[i-1] in punc);
{
Test if a PUNCtuation char follows WRD
}
      if (f) then
        if (i<length(b)-length(wrd)) then
          f:=(b[i+length(wrd)] in punc);
    end; {if (i=0) else}
    kwd:=f;
  end; {function kwd}
begin
  writeln('CHKIF v0.1 by J.Loke 87Sep06');
{
Check quiet option specifier
}
  while (copy(cmd,1,1)=' ') do
    delete(cmd,1,1);
  if (copy(cmd,1,2)='-Q') then
  begin
    v:=false;
    delete(cmd,1,2);
    while (copy(cmd,1,1)=' ') do
      delete(cmd,1,1);
  end
  else
    v:=true;
{
No parameter invokes USAGE display
}
  if (length(cmd)=0) then
    writeln('Usage:  CHKIF [-Q] <file>     -Q=quiet')
  else
  begin
{
Open file for sequential read
}
    assign(ifil,cmd);
    reset(ifil);
{
Set P flag if PRN output truncation needed
}
    p:=(pos('.PRN',cmd)>0);
{
Initialize line counter, IF/ELSE and MACRO level pointers
}
    l:=0;
    n:=0;
    m:=0;
{
Process each line of the file
}
    while not(eof(ifil)) do
    begin
      readln(ifil,c);
      l:=l+1;
{
If .PRN file, strip address and HEX display
}
      if (p) then begin
        i:=16;
        if (copy(c,1,1)=#12) then
          i:=i+1;
        delete(c,1,i);
      end; {if (p)}
{
Process each statement of the file
}
      while (length(c)>0) do
      begin
{
Strip statement from multi-statement line
}
        i:=pos('!',c+'!')-1;
        a:=copy(c,1,i);
        delete(c,1,i+1);
{
Ignore assembly directives or comment lines
}
        if (copy(a,1,1)='$') or (copy(a,1,1)='*') then
          i:=0
        else begin
{
Strip leading spaces and tabs
}
          while (copy(a,1,1)=' ') or (copy(a,1,1)=#9) do
            delete(a,1,1);
          i:=pos(';',a+';')-1
        end;
        if (i>0) then
        begin
{
Process non-empty statements, convert to upper case
}
          b:=copy(a,1,i);
          for i:=1 to length(b) do
            b[i]:=upcase(b[i]);
{
ENDIF keyword
}
          if kwd('ENDIF') then
          begin
            if v then
              writeln(l:5+n+m,' ',a);
            if (n=0) then
              writeln(l:5+n+m,'*ENDIF: No matching IF')
            else
              n:=n-1;
          end {if kwd('ENDIF') then }
{
IF keyword
}
          else if kwd('IF') then
          begin
            if v then
              writeln(l:6+n+m,' ',a);
            if (n=8) then
              writeln(l:6+n+m,'*IF: Too many IF''s');
            n:=n+1;
            lif[n]:=l;
            lelse[n]:=0;
          end {else if kwd('IF')}
{
ELSE keyword
}
          else if kwd('ELSE') then
          begin
            if v then
              writeln(l:5+n+m,' ',a);
            if (n=0) then
              writeln(l:5+n+m,'*ELSE: Missing IF')
            else begin
              if (lelse[n]<>0) then
                writeln(l:5+n+m,'*ELSE: Missing ENDIF');
              lelse[n]:=l;
            end
          end {else if kwd('ELSE')}
{
MACRO keywords
}
          else if kwd('MACRO')or kwd('IRP')or kwd('IRPC')or kwd('REPT') then
          begin
            if v then
              writeln(l:6+n+m,' ',a);
            if (m=8) then
              writeln(l:6+n+m,'*MACRO: Too many MACRO''s');
            m:=m+1;
            lmacro[m]:=l;
            nmacro[m]:=n;
          end {else if kwd('MACRO')or kwd('IRP')or kwd('IRPC')or kwd('REPT')}
{
EXITM keyword
}
          else if kwd('EXITM') then
          begin
            if v then
              writeln(l:5+n+m,' ',a);
            if (m=0) then
              writeln(l:5+n+m,'*EXITM: Missing MACRO')
          end {else if kwd('EXITM')}
{
ENDM keyword
}
          else if kwd('ENDM') then
          begin
            if v then
              writeln(l:5+n+m,' ',a);
            if (m=0) then
              writeln(l:5+n+m,'*ENDM: Missing MACRO')
            else
              m:=m-1
          end {else if kwd('ENDM')}
{
Process next statement on this line
}
        end {if (i>0)}
      end {length(c)=0}
    end; {while not(eof(ifil))}
    writeln;
{
IF/ELSE/ENDIF balance error
}
    if (n>0) then
      for i:=n downto 1 do begin
        write('CHKIF: Missing ENDIF.  Unmatched IF at line',lif[i]:6);
        if (lelse[i]<>0) then
          write(' Unmatched ELSE at line',lelse[i]:6);
        writeln
      end; {for i:=n downto 1}
{
MACRO/ENDM balance error
}
    if (m>0) then
      for i:=m downto 1 do
        writeln('CHKIF: Missing ENDM.  Unmatched MACRO at line',lmacro[i]:6);
  end; {if (length(cmd)=0)}
{
End of Program
}
  writeln('CHKIF: Done');
end.