Program filter;

type
  PosGroups=(GFirst,GInstr,GCo,GLoadStatus,GAffectFlags,
    GBy,GInc,GBef,GStack,GWrtBack,GRegDest,GRegis1,GRegis2,GShiftop,GRegis3,
    GConstant,GBranch,GRoutine,GLast);
  StatUnit=Record
    Name:String[10];
    Ocurrences:Real;
    end;

Const
  Title:array[Succ(GFirst)..Pred(GLast)] of String[20] =
    ('Instruc','Condits','LoadStatus','AffectFlags','ByteAcc',
    'Increm','Before','Stack','WrtBack','RegDest','Regis1','Regis2','ShiftOp','Regis3',
    'Constant','Branch','Routine');
  PosStack: array[False..True,False..True,False..True]
    of String[2]=((('ED','FD'),('EA','FA')),(('FA','EA'),('FD','ED')));
  MaxItems=50;

var
  Source,Destination:Text;
  InComment,InAsm:Boolean;
  Ch:Char;
  nuls,Fw,Condition,St,TStack,RegDest,Reg1,Reg2,ShiftOp,Reg3:String;
  List,Branch,Routine,Constant:String;
  Rest:String[32];
  J:PosGroups;
  TotalLines,I,H,LoadStatus,AffectFlags,By,Incrementing,PostIndexing,WrtBack:Integer;
  Stat: array[PosGroups,1..MaxItems] of StatUnit;
  TmpSU:StatUnit;


Procedure XSpaces;
begin
  While Rest[1]=' ' do delete(Rest,1,1);
  end;


Function Switch(S:Integer;S1,S2,S3:String):String;
begin
  Case S of
    -1:Switch:=S1;
    0:Switch:=S2;
    1:Switch:=S3;
    end;
  end;

Procedure Item(Group:PosGroups;Word:String);
var
  I:integer;
begin
  Write(Destination,Word,
    copy('              ',1,length(Title[Group])-length(Word)),' ');
  I:=1;
  While (Stat[Group,I].Name<>Word)
    AND (Stat[Group,I].Name<>'') do Inc(I);
  if Stat[Group,I].Name=Word then
    Stat[Group,I].Ocurrences:=Stat[Group,I].Ocurrences+1
  else begin
    if I=50 then Writeln('50',1/(I-I));
    Stat[Group,I].Name:=Word;
    Stat[Group,I].Ocurrences:=1;
    end;
  end;

Function XLit(S:String):Boolean;
var
  t:Boolean;
begin
  t:=(S=copy(Rest,1,length(S)));
  XLit:=t;
  if t then delete(Rest,1,length(S));
  end;


Function XString(Var Result:String;L:String):Boolean;
var
  Sinons,Current:String;
begin
  XString:=True;
  L:=L+' ';
  while L<>'' do begin
    Sinons:=copy(L,1,pos(' ',L)-1)+'<';
    delete(L,1,length(Sinons));
    Result:=copy(Sinons,1,pos('<',Sinons)-1);
    while Sinons<>'' do begin
      Current:=copy(Sinons,1,pos('<',Sinons)-1);
      delete(Sinons,1,length(Current)+1);
      if XLit(Current) then exit;
      end;
    end;
  XString:=False;
  end;

procedure XCondition;
begin
  if not XString(Condition,'EQ NE CS CC MI PL VS VC HI LS GE LT GT LE AL NV')
    then Condition:='AL';
  end;


function XNumber(Var N:LongInt):Boolean;
Const
  Dig: array[0..2] of String = ('01','0123456789','0123456789ABCDEF');
  BaseVal:array[0..2] of integer = (2,10,16);

var
  Negative:Boolean;
  Base:Integer;
begin
  Base:=1;{10}
  if XLit('&') then Base:=2  {16}
  else if XLit('%') then Base:=0; {2}
  Negative:=XLit('-');
  XNumber:=false;
  if pos(Rest[1],Dig[Base])=0 then exit;
  N:=0;
  while (Rest<>'') AND (N<40000000) AND (pos(Rest[1],Dig[Base])>0) do begin
    N:=N*BaseVal[Base]+pos(Rest[1],Dig[Base])-1;
    delete(Rest,1,1);
    end;
  if Negative then N:=-N;
  XNumber:=true;
  end;



function XIdentifier(Var S:String):Boolean;
begin
  while (Rest<>'') and (pos(Rest[1],'ABCDEFGHIJKLMNOPQRSTUVWXYZ')>0) do begin
    S:=S+Rest[1];
    delete(Rest,1,1);
    end;
  XIdentifier:=(S<>'');
  if S<>'' then S:='ident';
  if XLit('%') then S:=S+'%';
  end;


function XIdOrNum(Var S:String):Boolean;
var
  t:LongInt;
begin
  if XNumber(t) then
    Str(t,S)
  else
    if not XIdentifier(S) then exit;
  XIdOrNum:=True;
  end;


function XRegister(Var Reg:String):Boolean;
var
  t:LongInt;
begin
  XRegister:=False;
  if XLit('(') then begin
    if not XIdentifier(Reg) then exit;
    Reg:='R??';
    if not XLit(')') then exit;
    end
  else begin
    if not XLit('R') then exit;
    if not XNumber(t) then exit;
    if (t<0) or (t>15) then exit;
    Str(t,Reg);
    Reg:='R'+Reg;
    end;
  XRegister:=True;
  end;

function XRegOrId(Var Reg:String):Boolean;
begin
  XSpaces;
  XRegOrId:=False;
  if not XRegister(Reg) then begin
    if not XIdentifier(Reg) then exit;
    Reg:='R??';
    end;
  XRegOrId:=True;
  end;



function XImmConst(var S:String):Boolean;
var
  ts:String;
begin
  XImmConst:=True;
  if pos(']',Rest)>0 then begin
    S:=copy(Rest,1,pos(']',Rest)-1);
    delete(Rest,1,pos(']',Rest)-1);
    end
  else if pos(',',Rest)>0 then begin
    S:=copy(Rest,1,pos(',',Rest)-1);
    delete(Rest,1,pos(',',Rest));
    end
  else begin
    S:='rest';
    Rest:='';
    end
  end;


function XOperand2:Boolean;
var
  t:LongInt;
begin
  XOperand2:=false;
  if XRegister(Reg2) then begin
    if XLit(',') then
      if XString(ShiftOp,'LSL<ASL LSR ASR ROR') then begin
        if not XLit(' ') then exit;
        if not XRegister(Reg3) then begin
          if not XLit('#') then exit;
          if not XNumber(t) then exit;
          if (t<0) or (t>31) then exit;
          Str(t,Constant);
          end;
        end
      else
        if not XString(ShiftOp,'RRX') then exit
    end
  else
    if not XImmConst(Constant) then exit;
  XOperand2:=true;
  end;

function XBranch:Boolean;
begin
  XBranch:=XIdentifier(Branch);
  end;

function XRoutine:Boolean;
begin
  XRoutine:=False;
  if not XLit('"') then exit;
  if pos('"',Rest)=0 then exit;
  Routine:=copy(Rest,1,pos('"',Rest)-1);
  delete(Rest,1,length(Routine)+1);
  XRoutine:=true;
  end;

function XRegList:Boolean;
begin
  XRegList:=False;
  if not XLit('{') then exit;
  if pos('}',Rest)=0 then exit;
  List:=copy(Rest,1,pos('}',Rest)-1);
  delete(Rest,1,length(List)+1);
  XRegList:=true;
  end;

Function XDetails:Boolean;
var
  t:LongInt;
begin
  Write('*');
  XDetails:=False;
  while Rest[length(Rest)]=' ' do delete(Rest,length(Rest),1);
  LoadStatus:=-1;
  AffectFlags:=-1;
  By:=-1;
  Incrementing:=-1;
  PostIndexing:=-1;
  TStack:='--';
  RegDest:='---';
  WrtBack:=-1;
  Reg1:='---';
  Reg2:='---';
  Reg3:='---';
  ShiftOp:='---';
  Branch:='-';
  Routine:='-';
  Constant:='-';

  if XString(Fw,'CMP CMN TEQ TST') then begin
    XCondition;
    LoadStatus:=Ord(XLit('P'));
    if not XLit(' ') then exit;
    if not XRegOrId(Reg1) then exit;
    if not XLit(',') then exit;
    if not XOperand2 then exit;
    if Rest<>'' then exit;
    end

  else if XString(Fw,'AND EOR SUB RSB ADD ADC SBC RSC ORR BIC MUL') then begin
    XCondition;
    AffectFlags:=Ord(XLit('S'));
    if not XLit(' ') then exit;
    if not XRegOrId(RegDest) then exit;
    if not XLit(',') then exit;
    if not XRegOrId(Reg1) then exit;
    if not XLit(',') then exit;
    if not XOperand2 then exit;
    if Rest<>'' then exit;
    end

  else if XString(Fw,'MOV MVN') then begin
    XCondition;
    AffectFlags:=Ord(XLit('S'));
    if not XLit(' ') then exit;
    if not XRegOrId(RegDest) then exit;
    if not XLit(',') then exit;
    if not XOperand2 then exit;
    if Rest<>'' then exit;
    end

  else if XString(Fw,'LDR STR') then begin
    XCondition;
    By:=Ord(XLit('B'));
    if not XLit(' ') then exit;
    if not XRegOrId(RegDest) then exit;
    if not XLit(',') then exit;
    if XLit('[') then begin
      if not XRegOrId(Reg1) then exit;
      if XLit(']') then begin
        PostIndexing:=1;
        Wrtback:=1;
        if XLit(',') then begin
          if not XOperand2 then exit;
          if Rest<>''then exit;
          end
        else
          Constant:='0';
        end
      else begin
        if not XLit(',') then exit;
        PostIndexing:=0;
        if not XOperand2 then exit;
        if not XLit(']') then exit;
        WrtBack:=Ord(XLit('!'));
        if Rest<>'' then exit;
        end;
      end
    else begin
      if XNumber(t) then begin
        Constant:='absol add';
        Reg1:='PC';
        PostIndexing:=0;
        WrtBack:=0;
        end
      else
        if not XImmConst(Constant) then exit;
      if Rest<>'' then exit;
      end;
    end

  else if XString(Fw,'BL B') then begin
    XCondition;
    if not XLit(' ') then exit;
    if not XBranch then exit;
    if Rest<>'' then exit;
    end

  else if XString(Fw,'SWI') then begin
    XCondition;
    if not XLit(' ') then exit;
    if not XRoutine then exit;
    if Rest<>'' then exit;
    end

  else if XString(Fw,'MLA') then begin
    XCondition;
    AffectFlags:=Ord(XLit('S'));
    if not XLit(' ') then exit;
    if not XRegOrId(RegDest) then exit;
    if not XLit(',') then exit;
    if not XRegOrId(Reg1) then exit;
    if not XLit(',') then exit;
    if not XRegOrId(Reg2) then exit;
    if not XLit(',') then exit;
    if not XRegOrId(Reg3) then exit;
    if Rest<>'' then exit;
    end

  else if XString(Fw,'ADR') then begin
    XCondition;
    AffectFlags:=Ord(XLit('S'));
    if not XLit(' ') then exit;
    if not XRegOrId(RegDest) then exit;
    if not XLit(',') then exit;
    Reg1:='PC';
    if not XIdentifier(Constant) then exit;
    if Rest<>'' then exit;
    end

  else if XString(Fw,'LDM') then begin
    XCondition;
    LoadStatus:=Ord(XLit('P'));
    if not XString(TStack,'FD<IA FA<DA ED<IB EA<DB') then exit;
    PostIndexing:=Ord(TStack[1]='F');
    Incrementing:=Ord(TStack[2]='D');
    if not XLit(' ') then exit;
    if not XRegOrId(Reg1) then exit;
    WrtBack:=Ord(XLit('!'));
    if not XLit(',') then exit;
    if not XRegList then exit;
    if Rest<>'' then exit
    end

  else if XString(Fw,'STM') then begin
    XCondition;
    LoadStatus:=Ord(XLit('P'));
    if not XString(TStack,'EA<IA ED<DA FA<IB FD<DB') then exit;
    PostIndexing:=Ord(TStack[1]<>'F');
    Incrementing:=Ord(TStack[2]<>'D');
    if not XLit(' ') then exit;
    if not XRegOrId(Reg1) then exit;
    WrtBack:=Ord(XLit('!'));
    if not XLit(',') then exit;
    if not XRegList then exit;
    if Rest<>'' then exit;
    end;



  Item(GInstr,Fw);
  Item(GCo,Condition);
  Item(GLoadStatus,Switch(LoadStatus,'-','N','Y'));
  Item(GAffectFlags,Switch(AffectFlags,'-','N','Y'));
  Item(GBy,Switch(By,'----','Word','Byte'));
  Item(GInc,Switch(Incrementing,'---','Dec','Inc'));
  Item(GBef,Switch(PostIndexing,'----','Post','Pre'));
  Item(GStack,Tstack);
  Item(GWrtBack,Switch(WrtBack,'-','N','Y'));
  Item(GRegDest,RegDest);
  Item(GRegis1,Reg1);
  Item(GRegis2,Reg2);
  Item(GShiftOp,ShiftOp);
  Item(GRegis3,Reg3);
  Item(GConstant,Constant);
  Item(GBranch,Branch);
  Item(GRoutine,Routine);
  WriteLn(Destination,St);
  Inc(TotalLines);
  XDetails:=True;
  end;





Begin
  Assign(Source,'e:\arm.txt');
  Assign(Destination,'e:\arm.res');
  Reset(Source);
  Rewrite(Destination);
  Incomment:=False;
  InAsm:=False;
  For J:=Succ(GFirst) to Pred(Glast) do
    for I:=1 to MaxItems do begin
      Stat[J,I].Name:='';
      Stat[J,I].Ocurrences:=0;
      end;

  TotalLines:=0;
  While not Eof(Source) do begin
    ReadLn(Source,Ch,Ch,Ch,Ch,Ch,St);
    While St[1]=' ' do delete(St,1,1);
    if InAsm and (St[1]=']') then InAsm:=False;
    if not InAsm and (St[1]='[') then begin
      delete(St,1,1);
      InAsm:=True;
      end;

    if InAsm then begin
      if St[1]='.' then
        delete(St,1,pos(' ',St));
      if St[Length(St)]=':' then delete(St,Length(St),1);
      Rest:=St;
      if pos(';',Rest)>0 then
        Rest:=copy(Rest,1,pos(';',Rest)-1);
      for i:=1 to length(Rest) do Rest[I]:=upcase(Rest[I]);
      if (Rest[1]<>'.')
        AND (copy(Rest,1,2)<>'FN')
        AND (pos(copy(Rest,1,3),'OPT DCB DCW DCD')=0)
        AND (pos(copy(Rest,1,4),'EQUB EQUW EQUD EQUS')=0)
        AND (copy(Rest,1,5)<>'ALIGN') then
        if not XDetails then begin
          WriteLn('ERROR: ',St,'   >>>>',Rest);
          exit;
          end;
      end;{InAsm}

    end;{While}
  Close(Source);
  WriteLn(Destination,'Total instructions: ',TotalLines);

  for J:=Succ(GFirst) to Pred(Glast) do Write(Destination,Title[J],' ');
  WriteLn(Destination,'Original');

  for J:=Succ(GFirst) to Pred(GLast) do
    for H:=1 to 24 do
      for I:=24 downto H do
        if Stat[J,I].Ocurrences<Stat[J,I+1].Ocurrences then begin
          TmpSU:=Stat[J,I];
          Stat[J,I]:=Stat[J,I+1];
          Stat[J,I+1]:=TmpSU;
          end;

  for I:=1 to MaxItems do begin
    for J:=Succ(GFirst) to Pred(GLast) do
      Write(Destination,Stat[J,I].Name,
        copy('               ',1,length(Title[J])-length(Stat[J,I].Name)),' ');
    WriteLn(Destination);
    for J:=Succ(GFirst) to Pred(GLast) do
      if Stat[J,I].Ocurrences>0 then
        Write(Destination,Stat[J,I].Ocurrences*100/TotalLines:length(Title[J]):2,' ')
      else
        Write(Destination,' ':length(Title[J])+1);
    WriteLn(Destination);
    end;

  Close(Destination);
  end.