{                         P32 - 32bit Pascal Compiler                        }
{ -------------------------------------------------------------------------- }
{                       Johan Prins - jprins@knoware.nl                      }
{ ========================================================================== }
{ Lowlevel optimizer                                                         }
{                                                                            }
{                                                   (c) Copyright 1996-1998  }
{                                                                            }
{ -------------------------------------------------------------------------- }

{ optimize options:

  Implemented:
  ----------------
  mov   reg, [var]
  mov   reg, [var]
  ----------------
  mov   [var], reg
  mov   reg, [var]
  ----------------
  mov   reg, [var]
  add   reg, x | sub  reg, x
  mov   [var], reg
  ----------------

  Not implemented (yet):
  ----------------
  pop   reg
  push  reg
  ----------------
  jmp   label
  label:
}

{
  IDEA!
  What also needs to be done, some kind of 'virtual machine' which traces all
  register loads and stores...we can then eliminate all duplicate load and
  stores, maybe this is also useful for keeping variables in register (which
  it is, actually)
}
{$DEFINE debug}
unit P32_lopt;

interface

uses P32_tree, P32_asm, P32_asml, P32_prep, P32_scan, P32_err;

procedure LowLevelOptimize(var a: tAsmList);

implementation

type
   contents = record
                changed: boolean;
                size   : byte;
                loc    : location;
              end;

    varlist    = ^varrecord;
    varrecord  = record
                   next    : varlist;
                   priority: integer;
                   size    : byte;
                   loc     : location;
                 end;


var
   inreg : array[eax..edi] of contents;
   unused: set of eax..edi;

function equal_loc(var loc1, loc2: location): boolean;
begin
  equal_loc:=false;
  case loc1.l of
  undef        : exit;
  register     : if loc1.reg=loc2.reg then equal_loc:=true;
  port,
  directmem,
  memref       : if (loc1.base   = loc2.base) and
                    (loc1.index  = loc2.index) and
                    (loc1.factor = loc2.factor) and
                    (loc1.offset = loc2.offset) and
                    (loc1.name   = loc2.name) then equal_loc:=true;
  ordconst     : if loc1.value=loc2.value then equal_loc:=true;
  fpu          : if loc1.nr=loc2.nr then equal_loc:=true;
  end;
end;

procedure CreateVarList(var p: varlist);
begin
   new(p);
   fillchar(p^, sizeof(p^), 0);
end;

procedure DestroyVarList(var p: varlist);
var start: varlist;

begin
  start:=p;
  while start<>NIL do
    begin
      {$IFDEF debug}
      writeln(CreateName(p^.loc),', priority: ', start^.priority);
      {$ENDIF}
      p:=start^.next;
      dispose(start);
      start:=p;
    end;
  p:=NIL;
end;

procedure AddVarName(p: varlist; size: integer; var l:location);

begin
  while (p^.next<>NIL) and not equal_loc(p^.loc, l) do
    p:=p^.next;

  if not equal_loc(p^.loc, l) then
    begin
      new(p^.next);  {create new one}
      p:=p^.next;
      p^.next:=NIL;  {only one entry added}
      p^.priority:=1;
      p^.size:=size;
      p^.loc:=l;
    end
  else
    inc(p^.priority);
end;

function FindHighest(p:varlist): varlist; {pointer to highest entry}
var pr: integer;
     t: varlist;
begin
  pr:=0;
  t:=NIL;
  while (p<>NIL) do
    begin
      if pr<p^.priority then
        begin
          pr:=p^.priority;
          t:=p;
        end;
      p:=p^.next;
    end;
  t^.priority:=0; {set to zero, so it isn't found again...}
  FindHighest:=t;
end;

procedure ReplaceVarWithRegister(var a: tAsmList;{size: byte;}var l:location; i: regs);
var p: pAsmRecord;

begin
  p:=a.first;
  while p<>NIL do
    begin
      if (p^.o1.o=_mem) and equal_loc(p^.o1.loc, l) then
        begin
          p^.o1.o:=_reg;
          p^.o1.reg:=i;
        end;
      if (p^.o2.o=_mem) and equal_loc(p^.o2.loc, l) then
        begin
          p^.o2.o:=_reg;
          p^.o2.reg:=i;
        end;
      p:=p^.next;
    end;
end;


function FindRegister(var l:location): regs;
var i:regs;
begin
  FindRegister:=none;
  for i:=eax to edi do
     if equal_loc(inreg[i].loc, l) then
       begin
         FindRegister:=i;
         {$IFDEF debug}
         writeln('Found: ', r[i]);
         {$ENDIF}
         break;
       end;
end;

procedure ReplaceVariables(var a:tAsmList; v: varlist);

label
   l1;
var
   entry: varlist;

begin
  repeat
    entry:=FindHighest(v);
    if entry^.size=_dword then
      begin
        if edi in unused then
          begin
            ReplaceVarWithRegister(a, entry^.loc, edi);
            unused:=unused - [edi]
          end
        else
        if esi in unused then
          begin
            ReplaceVarWithRegister(a, entry^.loc, esi);
            unused:=unused - [esi]
          end;
        goto l1;
      end
    else
l1:
      begin
        if eax in unused then
          begin
            ReplaceVarWithRegister(a, entry^.loc, eax);
            unused:=unused - [eax]
          end
        else
        if edx in unused then
          begin
            ReplaceVarWithRegister(a, entry^.loc, edx);
            unused:=unused - [edx]
          end
        else
        if ecx in unused then
          begin
            ReplaceVarWithRegister(a, entry^.loc, ecx);
            unused:=unused - [ecx]
          end
        else
        if ebx in unused then
          begin
            ReplaceVarWithRegister(a, entry^.loc, ebx);
            unused:=unused - [ebx]
          end;
      end;
  until (entry=NIL) or (unused=[]);
end;

procedure AnalyzeRegisterUsage(var a: tAsmList);

var p: pAsmRecord;
    i: regs;
    v: varlist;
begin
  fillchar(inreg, sizeof(inreg), 0);
  unused:=[]; {clear the unused registers set}
  CreateVarList(v);

  p:=a.first;
  while p<>NIL do
    begin
      if (p^.o1.o=_mem) and (p^.o1.loc.name='') and (p^.o1.loc.offset<0) then AddVarName(v, p^.o1.size, p^.o1.loc);
      if (p^.o2.o=_mem) and (p^.o2.loc.name='') and (p^.o2.loc.offset<0) then AddVarName(v, p^.o2.size, p^.o2.loc);
      case p^.op of
      _add_   : begin
                  if (p^.o1.o=_reg) and (p^.o2.o=_reg) then {mov reg, reg}
                    begin
                      inreg[p^.o1.reg].changed:=TRUE;
                    end;
                end;
      _mov_,
      _movsx_,
      _movzx_ : begin
                  if (p^.o1.o=_reg) and (p^.o2.o=_mem) then {mov reg, [var]}
                    begin
                      inreg[p^.o1.reg].changed:=FALSE;
                      inreg[p^.o1.reg].size   :=p^.o2.size;
                      i:=FindRegister(p^.o2.loc);
                      if (i<>none) and
                         (inreg[i].size=p^.o2.size) and
                         not inreg[i].changed and
                         (p^.o2.loc.base=none) and
                         (p^.o2.loc.index=none) then
                        begin
                          p^.o2.o:=_reg;
                          p^.o2.reg:=i;
                        end
                      else
                        inreg[p^.o1.reg].loc:=p^.o2.loc;
                      {$IFDEF debug}
                      writeln(r[p^.o1.reg],': ', CreateName(p^.o2.loc));
                      {$ENDIF}
                    end;
                  if (p^.o1.o=_reg) and (p^.o2.o=_reg) then {mov reg, reg}
                    begin
                      if (p^.o1.reg=p^.o2.reg) and
                         (p^.o1.size=p^.o2.size) then
                        begin
                          DeleteAsmEntry(p);
                          continue;
                        end;
                      inreg[p^.o1.reg].changed:=TRUE;
                      {$IFDEF debug}
                      writeln(r[p^.o1.reg],': ', r[p^.o2.reg]);
                      {$ENDIF}
                    end;
                end;
      else      if (p^.o1.o=_reg) then
                  begin
                    inreg[p^.o1.reg].changed:=TRUE;
                  end;
      end;
      p:=p^.next;
    end;

  {set unused registers}
  for i:=eax to edi do
    if inreg[i].loc.l=undef then
      unused:=unused + [i];

  if OptimizeLevel>=4 then ReplaceVariables(a, v);

  DestroyVarList(v);
end;


procedure LowLevelOptimize2(var a: tAsmList);
var p1, p2: pAsmRecord;

begin
  p1:=a.first;
  while p1<>NIL do
    begin
      p2:=p1^.next;
      if p2=NIL then break;
      if p1^.a=_opcode then
        case p1^.op of
        _mov_,
        _movsx_,
        _movzx_: begin {duplicate load}
                   if (p1^.o1.o=_mem) and (p1^.o2.o=_reg) and
                      (p2^.o1.o=_mem) and (p2^.o2.o=_reg) then
                     begin
                       if equal_loc(p1^.o1.loc, p2^.o1.loc) then
                         begin
                           if p1^.o2.reg=p2^.o1.reg then
                             {completely remove the load}
                             DeleteAsmEntry(p2)
                           else
                             begin
                               {change the load into a 'mov'}
                               p2^.o2.o:=_reg;
                               p2^.o2.reg:=p1^.o2.reg
                             end;
                         end;
                     end;
                   if (p1^.o1.o=_reg) and (p1^.o2.o=_mem) and
                      (p2^.o1.o=_reg) and (p2^.o2.o=_mem) then
                     begin
                       if equal_loc(p1^.o2.loc, p2^.o2.loc) then
                         begin
                           if p1^.o1.reg=p2^.o1.reg then
                             {completely remove the load/store}
                             DeleteAsmEntry(p2)
                           else
                             begin
                               {change the load into a 'mov'}
                               p2^.op:=_mov_;
                               p2^.o2.o:=_reg;
                               p2^.o2.reg:=p1^.o1.reg;
                               p2^.o2.size:=p1^.o1.size;
                             end;
                         end;
                     end;
                 end;
        _jmp_  : begin
                   if (p1^.o1.o=_lab) and (p2^.a=_label) then
                     begin
                       if p1^.o1.lab=p2^.lab then
                         begin
                           DeleteAsmEntry(p1);
                           DeleteAsmEntry(p2);
                           continue;
                         end;
                     end;
                 end;
        end;
      p1:=p1^.next;
    end;
end;

procedure LowLevelOptimize3(var a: tAsmList);
var p1, p2, p3: pAsmRecord;

begin
  p1:=a.first;
  while p1<>NIL do
    begin
      p2:=p1^.next;
      if p2=NIL then break;
      p3:=p2^.next;
      if p3=NIL then break;

      if p1^.a=_opcode then
        begin
          if (p1^.op=_mov_) and
             ((p2^.op=_add_) or (p2^.op=_sub_) or
              (p2^.op=_inc_) or (p2^.op=_dec_)) and
             (p3^.op=_mov_) then
            begin
              if (p1^.o1.o=_reg) and (p1^.o2.o=_mem) and
                 (p2^.o1.o=_reg) and (p2^.o2.o=_ord) and
                 (p3^.o1.o=_mem) and (p3^.o2.o=_reg) then
                begin
                  if equal_loc(p1^.o2.loc, p3^.o1.loc) and
                     (p1^.o1.reg=p2^.o1.reg) and
                     (p2^.o1.reg=p3^.o2.reg) then
                    begin
                      {replace with direct add/sub}
                      p1^.op:=p2^.op;
                      p1^.o1.o:=_mem;
                      p1^.o1.loc:=p1^.o2.loc;
                      p1^.o2.o:=_ord;
                      p1^.o2.n:=p2^.o2.n;
                      DeleteAsmEntry(p2);
                      DeleteAsmEntry(p3);
                      continue; {jump to evaluation}
                    end;
                end;
              if ((p2^.op=_inc_) or (p2^.op=_dec_)) and
                 (p1^.o1.o=_reg) and (p1^.o2.o=_mem) and
                 (p2^.o1.o=_reg) and
                 (p3^.o1.o=_mem) and (p3^.o2.o=_reg) then
                begin
                  if equal_loc(p1^.o2.loc, p3^.o1.loc) and
                     (p1^.o1.reg=p2^.o1.reg) and
                     (p2^.o1.reg=p3^.o2.reg) then
                    begin
                      p1^.op:=p2^.op;
                      p1^.o1.o:=_mem;
                      p1^.o1.loc:=p1^.o2.loc;
                      p1^.o2.o:=_non;
                      DeleteAsmEntry(p2);
                      DeleteAsmEntry(p3);
                      continue; {jump to evaluation}
                    end;
                end;
             end;
        end;
      p1:=p1^.next;
    end;
end;

procedure LowLevelOptimize(var a: tAsmList);
begin
  if OptimizeLevel >= 1 then LowLevelOptimize2(a); {optimisations constiting of _two_ lines}
  if OptimizeLevel >= 2 then LowLevelOptimize3(a); {optimisations constiting of _three_ lines}
  if OptimizeLevel >= 3 then AnalyzeRegisterUsage(a);
end;

begin
end.
