unit optremovereload;

{$i fpcdefs.inc}

{$DEFINE DEBUG}
//{$DEFINE DEBUGVERBOSE}
{$DEFINE DEBUGPRINTREMOVED}

interface
uses
  aasmtai,
  aasmdata;

function RemoveReload(asml: TAsmList; first, last: tai; pass: longint): boolean;

implementation
uses
  {$IFDEF DEBUG}
  sysutils,
  globtype,
  fmodule,
  {$ENDIF}
  aasmcpu,
  cpubase,
  cgbase,
  cgutils,
  daopt386;

var
  List: array of taicpu;
  ListCount: Integer;

{$IFDEF DEBUG}
function DebugRegName(AReg: TSuperRegister): String;
begin
  case AReg of
    RS_EAX: Result := 'EAX';
    RS_EBX: Result := 'EBX';
    RS_ECX: Result := 'ECX';
    RS_EDX: Result := 'EDX';
    RS_ESI: Result := 'ESI';
    RS_EDI: Result := 'EDI';
    RS_ESP: Result := 'ESP';
    RS_EBP: Result := 'EBP';
    else Result := 'reg';
  end;
end;

{ return human readable source position for this instruction }
function DebugSourcePosInfo(p: taicpu): String;
var
  fi : tfileposinfo;
begin
  fi := p.fileinfo;
  Result := get_source_file(fi.moduleindex, fi.fileindex).name^ + ' ';
  Result := Result + IntToStr(fi.line) + ',' + IntToStr(fi.column);
end;

{ return human readable string representation (incomplete) for instruction }
function DebugInstString(p: taicpu): String;
var
  I : Integer;
  op: toper;
  ref: treference;
begin
  Result := std_op2str[p.opcode] + ' ';
  for I := 0 to p.ops-1 do begin
    op := p.oper[i]^;
    if op.typ = top_reg then begin
      Result := Result + std_regname(op.reg) + ' ';
    end
    else if op.typ = top_const then begin
      Result := Result + IntToHex(op.val, 8) + ' ';
    end
    else if op.typ = top_ref then begin
      Result := Result + '[';
      ref := op.ref^;
      if ref.offset < 0 then begin
        Result := Result + '-' + IntToHex(-ref.offset, 8);
      end
      else begin
        Result := Result + IntToHex(ref.offset, 8);
      end;
      if ref.base <> NR_NO then
        Result := Result + '+' + std_regname(ref.base);

      if ref.scalefactor > 0 then begin
        Result := Result + '+' + IntToHex(ref.scalefactor, 1) + '*';
        Result := Result + std_regname(ref.index) + ' ';
      end;
      Result := Result + '] ';
    end
    else begin
      Result := Result + '??? ';
    end;
  end;
end;
{$ENDIF}

{we only care about one kind of instruction.
 currently this is only: mov reg, [ofs+reg] }
function IsEligible(p: taicpu): Boolean;
var
  opin, opout: toper;
  regout: TSuperRegister;
begin
  Result := False;
  // mov
  if (p.opcode = A_MOV) and (p.ops = 2) then begin
    opin := p.oper[0]^;
    opout := p.oper[1]^;

    // only mem to register are of interest to us
    if opout.typ = top_reg then begin
      if opin.typ = top_ref then begin
        Result := True;

        if opin.ref^.base = NR_NO then
          exit(False);

        if opin.ref^.index <> NR_NO then
          exit(False);

        // instructions like mov edx, [something+edx]
        // cannot be repeated, they invalidate themselves.
        regout := getsupreg(opout.reg);
        if getsupreg(opin.ref^.base) = regout then
          exit(False);
        if getsupreg(opin.ref^.index) = regout then
          exit(False);

      end;
    end;
  end;
end;

function IsIdentical(p1, p2: taicpu): Boolean;
var
  I : Integer;
begin
  Result := True;
  if p1.opcode <> p2.opcode then exit(False);
  if p1.ops <> p2.ops then exit(False);
  for I := 0 to p1.ops-1 do
    if not OpsEqual(p1.oper[I]^, p2.oper[I]^) then exit(False);
end;

function IsInvalidating(pnew, pold: taicpu): Boolean;
var
  R : TSuperRegister;
  opnew_out, opold_in, opold_out: toper;
  I : Integer;
begin
  Result := False;

  // in this function we rely on a certain structure of pold
  // because we know it has passed the IsEligible() function,
  // it can only ever be a certain kind of mov instruction.

  opold_in := pold.oper[0]^;  // is always top_ref
  opold_out := pold.oper[1]^; // is always top_reg

  // but pnew can be anything
  for I := 0 to pnew.ops-1 do begin
    if pnew.spilling_get_operation_type(I) in [operand_write, operand_readwrite] then
    begin
      opnew_out := pnew.oper[I]^;

      if opnew_out.typ = top_reg then begin
        // if it writes to any of the 2 old registers then it is invalidating
        if  getsupreg(opnew_out.reg) = getsupreg(opold_out.reg) then
          exit(True);
        if  getsupreg(opnew_out.reg) = getsupreg(opold_in.ref^.base) then
          exit(True);
      end;

      if opnew_out.typ = top_ref then begin
        if opnew_out.ref^.offset = opold_in.ref^.offset then
          // writing to something with the same offset is suspicious,
          // better risk a false positive, better save than sorry
          exit(True);
      end;
    end;
  end;
end;

procedure ListAdd(p: taicpu);
begin
  if Length(List) = ListCount then
    SetLength(List, Length(List)*2 + 1);
  List[ListCount] := p;
  Inc(ListCount);
end;

procedure ListRemove(i: Integer);
begin
  if i < ListCount-1 then
    List[i] := List[ListCount-1];
  Dec(ListCount);
end;

procedure ListEmpty;
begin
  ListCount := 0;
end;

function ListContains(p: taicpu): Boolean;
var
  I : Integer;
begin
  Result := False;
  for I := 0 to ListCount-1 do begin
    if IsIdentical(p, List[i]) then
      exit(True);
  end;
end;

procedure ListRemoveInvalidated(p: taicpu);
var
  I : Integer;
begin
  for I := ListCount-1 downto 0 do begin
    if IsInvalidating(p, List[I]) then
      ListRemove(I);
  end;
end;

{ remove certain redundant mov instructions from asml }
function RemoveReload(asml: TAsmList; first, last: tai; pass: longint): boolean;
var
  p, pnext : taicpu;
  was_removed: Boolean;
  is_eligible: Boolean;
begin
  Result := False;
  if pass < 3 then exit; // peephole would crash in earlier passes. why?

  p := taicpu(first);
  repeat
    was_removed := False;
    is_eligible := False;
    pnext := taicpu(p.Next);

    case p.typ of
      ait_label:
      begin
        {$IFDEF DEBUGVERBOSE}
        writeln('label');
        {$ENDIF}
        ListEmpty;
      end;

      ait_instruction:
      begin
        {$IFDEF DEBUGVERBOSE}
        write('  ', DebugInstString(p));
        {$ENDIF}
        if IsEligible(p) then // only care about certain kind of mov
        begin
          if taicpu(p).oper[1]^.typ = top_reg then
          begin
            is_eligible := True;
            if ListContains(p) then begin
              {$IFDEF DEBUG}
              write(IntToStr(ListCount), ' ');
              {$ENDIF}
              {$IFDEF DEBUGPRINTREMOVED}
              write(DebugInstString(p), '   in ');
              writeln(DebugSourcePosInfo(p));
              {$ENDIF}
              asml.Remove(p);
              p.Free;
              Result := True;
              was_removed := true;
            end;
          end;
        end

        else if p.opcode = A_CALL then
        begin
          ListEmpty;
        end;

        // all instructions

        if not was_removed then begin
          ListRemoveInvalidated(p);

          if is_eligible then begin
            ListAdd(p);
          end;
        end;

        {$IFDEF DEBUGVERBOSE}
        writeln;
        {$ENDIF}
      end;
    end;
    p := pnext;
  until p = last;
  ListEmpty;
end;


end.