source: trunk/Disassembler.pas

unit Disassembler;

interface

uses
  Classes, SysUtils, CpuZ80, Instructions, StrUtils, Memory, Generics.Collections;

type

  { TDecodedInstruction }

  TDecodedInstruction = class
    Address: Word;
    Opcodes: array of Byte;
    Name: string;
    Parameters: string;
    constructor Create;
    procedure AddOpcode(Data: Byte);
    function GetOpcodesText: string;
  end;

  { TDecodedInstructions }

  TDecodedInstructions = class(TObjectList<TDecodedInstruction>)
    function SearchAddress(Address: Word): TDecodedInstruction;
  end;

  { TDisassembler }

  TDisassembler = class
    InstructionSet: TInstructionSet;
    Memory: TMemory;
    DecodedInstructions: TDecodedInstructions;
    procedure Disassemble;
    procedure SaveToFile(FileName: string);
    procedure ToLines(Lines: TStrings);
    constructor Create;
    destructor Destroy; override;
  end;


implementation

{ TDecodedInstructions }

function TDecodedInstructions.SearchAddress(Address: Word): TDecodedInstruction;
var
  I: Integer;
begin
  I := 0;
  while (I < Count) and (Items[I].Address <> Address) do Inc(I);
  if I < Count then Result := Items[I]
    else Result := nil;
end;

{ TDecodedInstruction }

constructor TDecodedInstruction.Create;
begin
  Parameters := '';
end;

procedure TDecodedInstruction.AddOpcode(Data: Byte);
begin
  SetLength(Opcodes, Length(Opcodes) + 1);
  Opcodes[Length(Opcodes) - 1] := Data;
end;

function TDecodedInstruction.GetOpcodesText: string;
var
  I: Integer;
begin
  Result := '';
  for I := 0 to Length(Opcodes) - 1 do
    Result := Result + IntToHex(Opcodes[I], 2) + ' ';
  Result := Trim(Result);
end;

procedure TDisassembler.Disassemble;
var
  J: Integer;
  Value: Integer;
  Instruction: TInstruction;
  InstructionInfo: TInstructionInfo;
  DecodedInstruction: TDecodedInstruction;
begin
  Memory.Position := 0;
  while Memory.Position < Memory.Size do begin
    DecodedInstruction := TDecodedInstruction.Create;
    DecodedInstruction.Address := Memory.Position;
    Value := Memory.ReadByte;
    DecodedInstruction.AddOpcode(Value);
    if Value = $cb then begin
      Value := Memory.ReadByte;
      DecodedInstruction.AddOpcode(Value);
      Value := $cb00 or Value;
    end else
    if Value = $dd then begin
      Value := Memory.ReadByte;
      DecodedInstruction.AddOpcode(Value);
      Value := $dd00 or Value;
    end else
    if Value = $ed then begin
      Value := Memory.ReadByte;
      DecodedInstruction.AddOpcode(Value);
      Value := $ed00 or Value;
    end else
    if Value = $fd then begin
      Value := Memory.ReadByte;
      DecodedInstruction.AddOpcode(Value);
      Value := $fd00 or Value;
    end;
    if (Value >= 0) and (Value <= Integer(High(TInstruction))) then begin
      Instruction := TInstruction(Value);
      InstructionInfo := InstructionSet.SearchInstruction(Instruction);
      if Assigned(InstructionInfo) then begin
        DecodedInstruction.Name := InstructionInfo.Name;
        for J := 0 to Length(InstructionInfo.Params) - 1 do begin
          if J > 0 then
            DecodedInstruction.Parameters := DecodedInstruction.Parameters + ', ';
          if InstructionInfo.Params[J] = ptNumberByte then begin
            Value := Memory.ReadByte;
            DecodedInstruction.AddOpcode(Value);
            DecodedInstruction.Parameters := DecodedInstruction.Parameters + IntToHex(Value, 2);
          end else
          if InstructionInfo.Params[J] = ptNumberWord then begin
            Value := Memory.ReadWord;
            DecodedInstruction.AddOpcode(Value shr 8);
            DecodedInstruction.AddOpcode(Value and $ff);
            DecodedInstruction.Parameters := DecodedInstruction.Parameters + IntToHex(Value, 4);
          end else
          if InstructionInfo.Params[J] = ptNumberByteIndir then begin
            Value := Memory.ReadByte;
            DecodedInstruction.AddOpcode(Value);
            DecodedInstruction.Parameters := DecodedInstruction.Parameters + '(' + IntToHex(Value, 2) + ')';
          end else
          if InstructionInfo.Params[J] = ptNumberWordIndir then begin
            Value := Memory.ReadWord;
            DecodedInstruction.AddOpcode(Value shr 8);
            DecodedInstruction.AddOpcode(Value and $ff);
            DecodedInstruction.Parameters := DecodedInstruction.Parameters + '(' + IntToHex(Value, 4) + ')';
          end else
          if InstructionInfo.Params[J] in [ptRegA, ptRegB, ptRegC, ptRegD,
            ptRegE, ptRegH, ptRegL, ptRegBC, ptRegDE, ptRegHL, ptRegSP,
            ptFlagZ, ptFlagNZ, ptFlagC, ptFlagNC,
            ptRegBCIndir, ptRegDEIndir, ptRegHLIndir,
            pt00, pt08, pt10, pt18, pt20, pt28, pt30, pt38, pt0, pt1, pt2] then begin
            DecodedInstruction.Parameters := DecodedInstruction.Parameters + ParamTypeText[InstructionInfo.Params[J]];
          end else
            raise Exception.Create('Unsupported instruction parameter type');
        end;
      end;
    end;
    DecodedInstructions.Add(DecodedInstruction);
  end;
end;

procedure TDisassembler.SaveToFile(FileName: string);
var
  Lines: TStringList;
begin
  Lines := TStringList.Create;
  Disassemble;
  ToLines(Lines);
  Lines.SaveToFile(FileName);
  FreeAndNil(Lines);
end;

procedure TDisassembler.ToLines(Lines: TStrings);
var
  I: Integer;
  OpcodesText: string;
begin
  Lines.Clear;
  for I := 0 to DecodedInstructions.Count - 1 do
  with TDecodedInstruction(DecodedInstructions[I]) do begin
    OpcodesText := GetOpcodesText;
    OpcodesText := OpcodesText + DupeString(' ', 13 - Length(OpcodesText));
    Lines.Add(IntToHex(Address, 4) + ' ' + OpcodesText + ' ' + Name + ' ' + Parameters);
  end;
end;

constructor TDisassembler.Create;
begin
  InstructionSet := TInstructionSet.Create;
  DecodedInstructions := TDecodedInstructions.Create;
end;

destructor TDisassembler.Destroy;
begin
  FreeAndNil(DecodedInstructions);
  FreeAndNil(InstructionSet);
  inherited;
end;

end.