dcinstr.pas

SrcDecompiler is about creating a Delphi program decompiler. The program is written for Delphi 4 or

unit dcInstr;

interface

uses
  Procs;

procedure GenerateInstr(Proc: TProc);

implementation

uses
  {$IFOPT D+}
    dcDebug, dialogs,
  {$ENDIF}
  PEFileClass, dcDecomps, Classes, SysUtils, dcUnits, Vars, DisAsm, procDecomp,
  TypeInfoUtils, dcThrVar;

type
  PPChar = ^PChar;
  PInteger = ^Integer;
  PInstrGenInfo = ^TInstrGenInfo;
  TInstrGenInfo = record
    Proc: TProc;
    Labels: TStringList;
    DDAddresses: TList;
    Asms: TStringList;
    Consts: TStringList;
    ImmediateData: Boolean;
  end;

procedure ReplaceJump(Param: Pointer; ValueAddress, JumpAddress: PChar; var Result: string);
var
  InstrGenInfo: PInstrGenInfo absolute Param;
  PEFile: TPEFileClass;
  DC: TDecompItem;
  I: Integer;
resourcestring
  SUndefinedDecompRefError = 'Undefined decomp ref %p %s, pointed at %p';
begin
  if JumpAddress = nil then Exit;
  PEFile := TPEFileClass(TProcs(InstrGenInfo.Proc.Collection).PEFileClass);
  if (JumpAddress >= InstrGenInfo.Proc.Address) and
     (JumpAddress < InstrGenInfo.Proc.Address + InstrGenInfo.Proc.Size) then
  begin
    // Jump or address ref inside the procedure.
    I := InstrGenInfo.Labels.IndexOfObject(TObject(JumpAddress));
    if I = -1 then
      I := InstrGenInfo.Labels.AddObject('@@' + IntToStr(InstrGenInfo.Labels.Count +1),
              TObject(JumpAddress));
    Result := '@@' + IntToStr(I +1);
    if InstrGenInfo.ImmediateData then
      Result := 'offset ' + Result;
  end
  else
  begin
    DC := PEFile.FindDecompItemByRef(JumpAddress);
    if DC = nil then
    begin
      DC := PEFile.FindDecompItemByBlock(JumpAddress);
      if DC = nil then
        exit;
    end;
    if DC is TProc then
    begin
      Result := TProc(DC).IncName;
      if InstrGenInfo.ImmediateData then
        Result := 'offset ' + Result;
    end
    else if DC is TVar then
      Result := 'offset ' + TVar(DC).Name
    else if DC is TClassInfo then
    begin
      Result := TClassInfo(DC).AClass.ClassName + 'ClassConst';
      Delete(Result, 22, Length(Result) - 32);
    end
    else if DC is TStringInfo then
    begin
      case TStringInfo(DC).StringType of
        stResourceString: Result := TStringInfo(DC).Name + 'Rec';
        else
        begin
          if not InstrGenInfo.ImmediateData then
          begin
            I := InstrGenInfo.Consts.IndexOfObject(TObject(JumpAddress));
            if I = -1 then
              I := InstrGenInfo.Consts.AddObject(Format('LConst%p', [Pointer(JumpAddress)]),
                TObject(JumpAddress));
            Result := InstrGenInfo.Consts[I];
          end
          else
            Result := TStringInfo(DC).Name;
        end;
      end;
    end
    else if DC is TTypeInfoInfo then
    begin
      Result := 'offset ' + TTypeInfoInfo(DC).TypeInfoVarName;
    end
    else
      {$IFOPT D+}
        SendDebugEx(Format(SUndefinedDecompRefError, [Pointer(JumpAddress), DC.ClassName, Pointer(ValueAddress)]), mtError);
      {$ELSE}
        raise EDecompilerError.CreateFmt(SUndefinedDecompRefError, [Pointer(JumpAddress), DC.ClassName, Pointer(ValueAddress)]);
      {$ENDIF D+}
    if DC.RefAddress <> JumpAddress then
      Result := Result + ' + ' + IntToStr(JumpAddress - DC.Address);
  end;
end;

procedure ImmidiateDataReplace(Param: Pointer; ValueAddress: PChar; OperandSize: Integer; Sigend: Boolean; var Result: string);
var
  InstrGenInfo: PInstrGenInfo absolute Param;
begin
  if (not Sigend) and (OperandSize = 4) and
     (TPEFileClass(InstrGenInfo.Proc.PEFileClass).Fixups.FindFixup(ValueAddress) <> -1) then
  begin
    InstrGenInfo.ImmediateData := True;
    ReplaceJump(Param, ValueAddress, PPChar(ValueAddress)^, Result);
    Result := Result;
  end;
end;

procedure RefReplace(Param: Pointer; Ref: TdaRef; OperandSize: Integer; var Result: string);
var
  InstrGenInfo: PInstrGenInfo absolute Param;
  DC: TDecompItem;
  I: Integer;
begin
  for I := 0 to OperandSize -1 do
    InstrGenInfo.DDAddresses.Add(Ref.Immidiate + I);
  if (OperandSize = 4) and (Ref.MultiplyReg1 = 0) then
  begin
    DC := TPEFileClass(InstrGenInfo.Proc.PEFileClass).FindDecompItemByRef(Ref.Immidiate);
    if (DC is TVar) and TVar(DC).RefVar then
    begin
      if TVar(DC).DecompCount <= 0 then
        raise EDecompilerError.Create('A Ref Count without a decomp ?!');
      if TVar(DC).DecompItems[0] is TVar then
        Result := '@' + TVar(TVar(DC).DecompItems[0]).Name
      else if TVar(DC).DecompItems[0] is TProc then
        Result := '@' + TProc(TVar(DC).DecompItems[0]).IncName
      else if TVar(DC).DecompItems[0] is TStringInfo then
      begin
        if TStringInfo(TVar(DC).DecompItems[0]).StringType = stResourceString then
          Result := TStringInfo(TVar(DC).DecompItems[0]).Name + 'Rec'
        else
          raise EDecompilerError.Create('Unsupported Ref var string type.');
      end
      else
        raise EDecompilerError.Create('Unsupported Ref var decomp. ' + TVar(DC).DecompItems[0].ClassName);
      Result := '^' + Chr(Length(Result))+ Result;
    end;
  end;
end;

function DisAsmInstr(Proc: TProc; DisAsm: TDisAsm; AAddress: PChar; Tabs: string;
   var InstrGenInfo: TInstrGenInfo): Integer;
var
  I: Integer;
  DC: TDecompItem;
  Size: Integer;
begin
  // If the AAddress is a fixup Include it is a reference.
  I := TPEFileClass(Proc.PEFileClass).Fixups.FindFixup(AAddress);
  if I <> -1 then
  begin
    if (PPChar(AAddress)^ >= Proc.Address) and (PPChar(AAddress)^ < Proc.Address + Proc.Size) then
    begin
      // Include it as a reference to a label in the Proc.
      I := InstrGenInfo.Labels.IndexOfObject(TObject(PPChar(AAddress)^));
      if I = -1 then
        // If the label doesn't exist create one.
        I := InstrGenInfo.Labels.AddObject('@@' + IntToStr(InstrGenInfo.Labels.Count +1),
              TObject(PPChar(AAddress)^));
      // Add the label to the code.
      InstrGenInfo.Asms.AddObject(Tabs + 'DD      @@' + IntToStr(I+1), TObject(AAddress));
    end
    else
    begin
      // Include it as a reference to a other decomp item.
      DC := TPEFileClass(Proc.PEFileClass).FindDecompItemByRef(PPChar(AAddress)^);
      if DC = nil then
      begin
      {$IFOPT D+}
        SendDebugEx(Format('Address not a ref address %p %p',
           [Pointer(AAddress), Pointer(PPChar(AAddress)^)]), mtError);
        DC:= Proc;
      {$ELSE}
        raise EDecompilerError.CreateFmt('Address not a ref address %p %p',
           [Pointer(AAddress), Pointer(PPChar(AAddress)^)]);
      {$ENDIF}
      end;
      if DC is TProc then
      begin
        if DC.Address <> PPChar(AAddress)^ then
          InstrGenInfo.Asms.AddObject(Format('%sDD      %s + %d',
             [Tabs, TProc(DC).IncName, PPChar(AAddress)^ - DC.Address]),
             TObject(AAddress))
        else
          InstrGenInfo.Asms.AddObject(Tabs + 'DD      '  + TProc(DC).IncName,
            TObject(AAddress));
      end
      else if DC is TClassInfo then
      begin
        if DC.Address <> PPChar(AAddress)^ then
          InstrGenInfo.Asms.AddObject(Format('%sDD      %s + %d',
             [Tabs, TClassInfo(DC).AClass.ClassName, PPChar(AAddress)^ - DC.Address]),
             TObject(AAddress))
        else
          InstrGenInfo.Asms.AddObject(Tabs + 'DD      '  + TClassInfo(DC).AClass.ClassName,
            TObject(AAddress));
      end
      else if DC is TVar then
      begin
        InstrGenInfo.Asms.AddObject(Tabs + 'DD      '  + TVar(DC).Name,
            TObject(AAddress));
      end
      else if DC is TStringInfo then
      begin
        InstrGenInfo.Asms.AddObject(Tabs + 'DD      '  + TStringInfo(DC).Name,
            TObject(AAddress));
      end
      else
        raise EDecompilerError.CreateFmt('Unsupported DD %s.', [DC.ClassName]);
    end;
    Result := 4;
  end
  else
  begin
    if InstrGenInfo.DDAddresses.IndexOf(AAddress) <> -1 then
    begin
      InstrGenInfo.Asms.AddObject(Tabs + 'DB      '  + IntToStr(Byte(Pointer(AAddress)^)),
         TObject(AAddress));
      Result := 1;
    end
    else
    begin
      // Assembler instruction.
      DisAsm.GetInstruction(AAddress, Size);
      I := 1;
      if Size > 4 then
        I := Size - 3;
      for I := I to Size -1 do
        if TPEFileClass(Proc.PEFileClass).Fixups.FindFixup(AAddress + I) <> -1 then
        begin
         InstrGenInfo.Asms.AddObject(Tabs + 'DB      '  + IntToStr(Byte(Pointer(AAddress)^)),
           TObject(AAddress));
         Result := 1;
         Exit;
        end;
      InstrGenInfo.ImmediateData := False;
      InstrGenInfo.Asms.AddObject(Tabs + DisAsm.GetInstruction(AAddress, Result), TObject(AAddress));
    end;
  end;
end;

procedure GenerateInstr(Proc: TProc);
const
  ProcDef: array[TProcType, Boolean] of string =
    (('procedure  %s(%s);', 'function %s(%s): %s;'), ('class procedure %s.%s(%s);', 'class function %s.%s(%s): %s;'),
     ('procedure %s.%s(%s);', 'function %s.%s(%s): %s;'), ('constructor %s.%s(%s);', 'constructor %s.%s(%s);'),
     ('destructor %s.%s(%s);', 'destructor %s.%s(%s);'), ('', ''), ('', ''), ('', ''));
var
  AAddress: PChar;
  DisAsm: TDisAsm;
  Tabs: string;
  InstrGenInfo: TInstrGenInfo;
  I: Integer;
begin
  // There are no instruction
  // if the size is 0 or the proc is imported or
  // it is a system procedure or
  // this is a package and this proc is in the program unit
  if (Proc.Size = 0) or Proc.ImportInfo.Imported or (Proc.InstrSrc.Count <> 0) or
     (TUnit(Proc.AUnit).UnitType = utSystem) or
     ((TUnit(Proc.AUnit).UnitType = utProgram) and (TPEFileClass(Proc.PEFileClass).ProjectType = ptPackage)) then
    Exit;
  // Fill the instrGenInfo sturcture
  FillChar(InstrGenInfo, SizeOf(InstrGenInfo), 0);
  InstrGenInfo.Proc := Proc;
  try
    InstrGenInfo.Labels := TStringList.Create;
    InstrGenInfo.Asms := TStringList.Create;
    InstrGenInfo.DDAddresses := TList.Create;
    InstrGenInfo.Consts := TStringList.Create;
    DisAsm := TDisAsm.Create;
    try
      // Start with the procedure declaration and the asm block.
      if Proc.ProcType in [ptInitialization, ptFinalization] then
      begin
        if Proc.ProcType = ptInitialization then
          Proc.InstrSrc.Add('Initialization')
        else
          Proc.InstrSrc.Add('Finalization');
        Tabs := '  ';
      end
      else
      begin
        if Proc.ProcType in ptMethods then
          Proc.InstrSrc.Add(Format(ProcDef[Proc.ProcType, Proc.Parameters.FuncResult <> ''],
             [Proc.AClass.AClass.ClassName, Proc.Name, Proc.Parameters.Parameters, Proc.Parameters.FuncResult]))
        else
          Proc.InstrSrc.Add(Format(ProcDef[Proc.ProcType, Proc.Parameters.FuncResult <> ''], [Proc.Name, Proc.Parameters.Parameters, Proc.Parameters.FuncResult]));
        Tabs := '';
      end;

      DisAsm.OnJumpInstr := ReplaceJump;
      DisAsm.OnCallInstr := ReplaceJump;
      DisAsm.OnAddressRef := ReplaceJump;
      DisAsm.OnImmidiateData := ImmidiateDataReplace;
      DisAsm.OnRef := RefReplace;
      DisAsm.Param := @InstrGenInfo;

      // Disassemble the code before Init
      AAddress := Proc.Address;
      while AAddress < Proc.Address + Proc.BeforeInitSize do
      begin
        // Assembler instruction.
        Inc(AAddress, DisAsmInstr(Proc, DisAsm, AAddress, Tabs, InstrGenInfo));
      end;

      // Add every code.
      AAddress := Proc.Address + Proc.BeforeInitSize + Proc.InitSize;
      while AAddress < Proc.Address + Proc.ProcSize - Proc.FinaSize - Proc.AfterFinaSize do
      begin
        // Disassemble the instruction.
        Inc(AAddress, DisAsmInstr(Proc, DisAsm, AAddress, Tabs, InstrGenInfo));
      end;

      // Disassemble the code at end of proc.
      AAddress := Proc.Address + Proc.ProcSize - Proc.AfterFinaSize;
      while AAddress < Proc.Address + Proc.ProcSize do
      begin
        // Disassemble the instruction.
        Inc(AAddress, DisAsmInstr(Proc, DisAsm, AAddress, Tabs, InstrGenInfo));
      end;

    finally
      DisAsm.Free;
    end;
    // Add the Consts to the code
    if InstrGenInfo.Consts.Count <> 0 then
    begin
      Proc.InstrSrc.Add(Tabs + 'const');
      for I := 0 to InstrGenInfo.Consts.Count -1 do
        Proc.InstrSrc.Add(Format('%s  %s: Integer = %d;',
           [Tabs, InstrGenInfo.Consts[I], PInteger(InstrGenInfo.Consts.Objects[I])^]));
    end;
    // Add the asm and labels to the code.
    Proc.InstrSrc.Add(Tabs + 'asm');
    Tabs := Tabs + '  ';
    AAddress := Proc.Address;
    while InstrGenInfo.Asms.Count <> 0 do
    begin
      while InstrGenInfo.Asms.IndexOfObject(TObject(AAddress)) = -1 do
        Inc(AAddress);
      I := InstrGenInfo.Labels.IndexOfObject(TObject(AAddress));
      if I <> -1 then
      begin
        Proc.InstrSrc.Add(Format('%s%s:', [Tabs, InstrGenInfo.Labels[I]]));
        InstrGenInfo.Labels.Delete(I);
      end;
      I := InstrGenInfo.Asms.IndexOfObject(TObject(AAddress));
      Proc.InstrSrc.Add(Tabs + InstrGenInfo.Asms[I]);
      InstrGenInfo.Asms.Delete(I);
    end;
    if InstrGenInfo.Labels.Count = 1 then
      Proc.InstrSrc.Add(Format('%s%s:', [Tabs, InstrGenInfo.Labels[0]]))
    else
      if InstrGenInfo.Labels.Count <> 0 then
        raise EDecompilerError.Create('Jump to the middle of an instruction');

    // Add dummy code which acces the treadvars to prevent optimalization.
    if Proc.ProcType = ptEntryPointProc then
      with TPEFileClass(Proc.PEFileClass).Miscs do
        for I := 0 to Count -1 do
          if Items[I] is TThreadVar then
          begin
            Proc.InstrSrc.Add(Tabs + '// Dummy code to prevent optimalization of TThreadVar');
            Proc.InstrSrc.Add(Tabs + 'jmp @@DummyTLS');
            Proc.InstrSrc.Add(Tabs + 'mov al, ThreadVar1');
            Proc.InstrSrc.Add(Tabs + '@@DummyTLS:');
            Break;
          end;

    // End the proc.
    SetLength(Tabs, Length(Tabs) -2);
    if Proc.ProcType = ptEntryPointProc then
      Proc.InstrSrc.Add(Tabs + 'end.')
    else
      Proc.InstrSrc.Add(Tabs + 'end;');
  finally
    InstrGenInfo.DDAddresses.Free;
    InstrGenInfo.Labels.Free;
    InstrGenInfo.Asms.Free;
    InstrGenInfo.Consts.Free;
  end;
end;

end.