dwarfutils.pas

一个不出名的GBA模拟器

function Pop: uint32;
begin
  Result := stack[stackIndex];
  stackIndex := (stackIndex+1) and 63;
end;

function Peek(offset: integer): uint32;
begin
  Result := stack[(stackIndex+offset) and 63];
end;

var
  u1, u2, u3: uint32;
  s1, s2: integer;
  opcode: byte;
  data: TReadableResource;
begin
  // Position the reader
  data := TReadableResource.Create;
  data.data := block.data;
  data.Seek(0);

  stackIndex := 63;
  stack[stackIndex] := 0;
  inRegister := false;

  with data do begin

  notOptimized := false;
  while integer(dataPointer) - integer(block.data) < block.size do begin
    notOptimized := true;
    opcode := ReadUint8;
    case opcode of
      DW_OP_addr: Push(ReadAddress);
      DW_OP_deref: Push(ReadTSAddress(Pop));
      DW_OP_const1u: Push(ReadUint8);
      DW_OP_const1s: Push(ReadInt8);
      DW_OP_const2u: Push(ReadUint16);
      DW_OP_const2s: Push(ReadInt16);
      DW_OP_const4u: Push(ReadUint32);
      DW_OP_const4s: Push(ReadInt32);
      DW_OP_const8u: Push(ReadUint64);
      DW_OP_const8s: Push(ReadInt64);
      DW_OP_constu: Push(ReadLEB128);
      DW_OP_consts: Push(ReadSLEB128);
      DW_OP_dup: Push(Peek(stackIndex));
      DW_OP_drop: Pop;
      DW_OP_over: Push(Peek(1));
      DW_OP_pick: Push(Peek(ReadUint8));
      DW_OP_swap: begin
        u1 := Pop;
        u2 := Pop;
        Push(u1);
        Push(u2);
      end;
      DW_OP_rot: begin
        u1 := Pop;
        u2 := Pop;
        u3 := Pop;
        Push(u1);
        Push(u2);
        Push(u3);
      end;
      DW_OP_xderef: begin
        // fixme, todo, error
        Push(ReadTSAddress(Pop + Pop));  // todo: incorrect hack}
      end;
      DW_OP_abs: Push(Abs(integer(Pop)));
      DW_OP_and: Push(Pop and Pop);
      DW_OP_div: begin
        s1 := Pop;
        s2 := Pop;
        if s1 = 0 then s1 := 1;
        Push(s2 div s1);
      end;
      DW_OP_minus: begin
        u1 := Pop;
        Push(Pop - u1);
      end;
      DW_OP_mod: begin
        u1 := Pop;
        u2 := Pop;
        if u1 = 0 then u1 := 1;
        Push(u2 mod u1);
      end;
      DW_OP_mul: Push(Pop * Pop);
      DW_OP_neg: begin
        s1 := Pop;
        Push(-s1);
      end;
      DW_OP_not: Push(not Pop);
      DW_OP_or: Push(Pop or Pop);
      DW_OP_plus: Push(Pop + Pop);
      DW_OP_plus_uconst: Push(Pop + ReadLEB128);
      DW_OP_shl: begin
        u1 := Pop;
        Push(Pop shl u1);
      end;
      DW_OP_shr: begin
        u1 := Pop;
        Push(Pop shr u1);
      end;
      DW_OP_shra: begin
        u1 := Pop;
        u2 := Pop;
        u3 := u2 shr u1;
        if u2 shr 31 <> 0 then u3 := u3 or ($FFFFFFFF shl u1);
        Push(u3);
      end;
      DW_OP_xor: Push(Pop xor Pop);
      DW_OP_skip: SeekRelAddress(ReadInt16);
      DW_OP_bra: begin
        s1 := ReadInt16;
        if Pop = 0 then SeekRelAddress(s1);
      end;
      // todo: are these in the correct order (i.e. is GE s2 >= s1 or s1 >= s2)?
      DW_OP_eq: begin
        s1 := Pop;
        s2 := Pop;
        if s1 = s2 then Push(1) else Push(0);
      end;
      DW_OP_ge: begin
        s1 := Pop;
        s2 := Pop;
        if s1 >= s2 then Push(1) else Push(0);
      end;
      DW_OP_gt: begin
        s1 := Pop;
        s2 := Pop;
        if s1 > s2 then Push(1) else Push(0);
      end;
      DW_OP_le: begin
        s1 := Pop;
        s2 := Pop;
        if s1 <= s2 then Push(1) else Push(0);
      end;
      DW_OP_lt: begin
        s1 := Pop;
        s2 := Pop;
        if s1 < s2 then Push(1) else Push(0);
      end;
      DW_OP_ne: begin
        s1 := Pop;
        s2 := Pop;
        if s1 <> s2 then Push(1) else Push(0);
      end;
      DW_OP_lit0..DW_OP_lit31: Push(opcode and $1F);
      DW_OP_reg0..DW_OP_reg31: begin
        inRegister := true;
        Result := opcode and $1F;
        Exit;
      end;
      DW_OP_breg0: Push(ReadTSRegister(opcode and $1F) + ReadSLEB128);
      DW_OP_regx: begin
        inRegister := true;
        Result := ReadLEB128;
        Exit;
      end;
      DW_OP_fbreg: begin
        // fixme!
        s1 := ReadTSRegister(0);
        Push(s1 + ReadSLEB128);
      end;
      DW_OP_bregx: begin
        s1 := ReadTSRegister(ReadLEB128);
        Push(s1 + ReadSLEB128);
      end;
      DW_OP_piece: begin
        // todo: not supported yet
        ReadLEB128; // size of piece addressed
        // error, fixme, todo
      end;
      DW_OP_deref_size: begin
        // fixme, todo, error
        u1 := Pop;
        u2 := 0;
        u3 := Min(ReadUint8, 4)-1;
        for s1 := 0 to u3 do begin
          u2 := u2 shl 8 + ReadTSUint8(u1);
          Inc(u1);
        end;
        Push(u2);
      end;
      DW_OP_xderef_size: begin
        // todo: incorrect hack
        u1 := Pop + Pop;
        u2 := 0;
        u3 := Min(ReadUint8, 4)-1;
        for s1 := 0 to u3 do begin
          u2 := u2 shl 8 + ReadTSUint8(u1);
          Inc(u1);
        end;
        Push(u2);
      end;
      DW_OP_nop: ;
    else
      // balls, unsuported opcode
      logWriteLn('Error: Unsupported location state machine opcode $' + IntToHex(opcode, 2));
    end;
  end;
  Result := Pop;
  end;

  data.Free;
end;

//////////////////////////////////////////////////////////////////////

function FindLineInP(target: uint32; var hit: TLineHit): boolean;
var
  cunit: TCompilationUnit;
begin
  Result := false;
  if Assigned(dwarf) then begin
    cunit := Dwarf.FindContainingUnit(target);
    if cunit <> nil then Result := DoLineProgram(false, cunit, target, hit);
  end;
end;

//////////////////////////////////////////////////////////////////////

function DoLineProgram(building: boolean; cunit: TCompilationUnit; target: uint32; var hit: TLineHit): boolean;
var
  line, sourceFile: int32;
  address, column: uint32;
  isStatement, basicBlock, endSequence: boolean;
  header: TDwarfStatementPrologue;
  sizes: PByteArray;

procedure ResetRegs;
begin
  // Set up the registers of the state machine
  address := 0;
  sourceFile := 1;
  line := 1;
  column := 0;
  isStatement := header.defaultIsStatement <> 0;
  basicBlock := false;
end;

procedure LoadFile(st: string);
var
  dirIndex: integer;
  st2: string;
begin
  dirIndex := debugLine.ReadLEB128;
  if (dirIndex > -1) and (dirIndex < cunit.dirs.Count) then begin
    st2 := cunit.dirs.Strings[dirIndex];
    if st2 <> '' then st2 := st2 + '\' + st else st2 := st;
    if building then cunit.files.AddObject(st2, loadSourceFile(st2));
  end;
  debugLine.ReadLEB128; // skip the time
  debugLine.ReadLEB128; // skip the length
end;

// Appends a row to the matrix
procedure AppendRow;
var
  st: TStringList;
  i: integer;
begin
  if isStatement and building and (cunit.files <> nil) then begin
    if (sourceFile > 0) and (sourceFile <= cunit.files.Count) then begin
      if findFile(cunit.files.Strings[sourceFile-1]) <> nil then
        vmAddBreakpoint(address, true);

      st := TStringList(cunit.files.Objects[sourceFile-1]);
      if st <> nil then begin
        i := line-1;
        if (i >= 0) and (i < st.Count) then
          st.Objects[i] := TObject(address);
      end;
    end;
  end;
end;

var
  st: string;
  temp: pointer;
  i: uint32;
  opcode: byte;
begin
  // Initialization
  Result := false;

  if cunit = nil then Exit;

  if (cunit.statementOffset >= debugLine.size) then Exit;
  debugLine.Seek(cunit.statementOffset);

  // Read in the fixed portion of the prologue
  debugLine.ReadBlock(header, SizeOf(TDwarfStatementPrologue));
  if header.lineRange = 0 then header.lineRange := 1;

  // Read in the standard opcode sizes
  if header.opcodeBase > 0 then begin
    GetMem(sizes, header.opcodeBase-1);
    for i := 0 to header.opcodeBase - 2 do
      sizes^[i] := debugLine.ReadUint8;
  end else begin
    logWriteLn('Error: Line program state machine opcode base cannot be 0');
    Exit;
  end;

  if building then begin
    // Read in the include directories
    cunit.dirs.Clear;
    cunit.dirs.Add(dwarf.baseDir);
    st := debugLine.ReadString;
    while st <> '' do begin
      cunit.dirs.Add(st);
      st := debugLine.ReadString;
    end;

    // Read in the contributing files
    cunit.files.Clear;
    repeat
      st := debugLine.ReadString;
      if st <> '' then LoadFile(st);
    until st = '';

    cunit.rStatementOffset := uint32(debugLine.dataPointer) - uint32(debugLine.data) - uint32(cunit.statementOffset);
  end else
    debugLine.Seek(cunit.rStatementOffset);

  // Set up the registers of the state machine
  ResetRegs;
  endSequence := false;

  // Run the program
  temp := pointer(header.totalLength + 4 + uint32(debugLine.data) + cunit.statementOffset);
  if uint32(temp) > debugLine.size + uint32(debugLine.data) then begin
    // Clean up
    logWriteLn('Dwarf Processor: Invalid state machine segment');
    FreeMem(sizes, header.opcodeBase-1);
    Exit;
  end;

//  logWriteLn(Format('tl = %d  temp = %8.8x   dp = %8.8x', [header.totalLength, uint32(temp), uint32(datapointer)]));
  while integer(debugLine.dataPointer) < integer(temp) do begin
//    logwrite('.');
    // Check for the target address and leave
    if (address = target) and not building then begin
      if (sourceFile <= cunit.files.Count) and (sourceFile > 0) then begin
        hit.line := line;
        hit.column := column;
        hit.isStatement := isStatement;
        hit.basicBlock := basicBlock;
        hit.endSequence := endSequence;
        hit.filename := cunit.files.Strings[sourceFile-1];
        Result := true;
      end;
      Break;
    end;

    // Process the opcode
    opcode := debugLine.ReadUint8;
    if opcode < header.opcodeBase then
      case opcode of
        DW_LNS_extended_opcode: begin
          debugLine.ReadUint8;
          opcode := debugLine.ReadUint8;
          case opcode of
            DW_LNE_end_sequence: begin
              endSequence := true;
              AppendRow;
              ResetRegs;
            end;
            DW_LNE_set_address: address := debugLine.ReadAddress;
            DW_LNE_define_file: begin
              st := debugLine.ReadString;
              if st <> '' then LoadFile(st);
            end;
          end;
        end;
        DW_LNS_copy: begin
          AppendRow;
          basicBlock := false;
        end;
        DW_LNS_advance_pc: address := address + debugLine.ReadLEB128 * header.minInstructionLength;
        DW_LNS_advance_line: line := line + debugLine.ReadSLEB128;
        DW_LNS_set_file: sourceFile := debugLine.ReadLEB128;
        DW_LNS_set_column: column := debugLine.ReadLEB128;
        DW_LNS_negate_stmt: isStatement := not isStatement;
        DW_LNS_set_basic_block: basicBlock := true;
        DW_LNS_const_add_pc: address := address + uint32(((255-header.opcodeBase) div header.lineRange) * header.minInstructionLength);
        DW_LNS_fixed_advance_pc: address := address + debugLine.ReadUint16;
      else
        // Parse an unknown standard opcode by skipping its operands
        for i := 1 to sizes[opcode] do debugLine.ReadLEB128;
      end
    else begin
      // Parse a special opcode
      opcode := opcode - header.opcodeBase;
      line := line + header.lineBase + opcode mod header.lineRange;
      address := address + (opcode div header.lineRange) * header.minInstructionLength;
      AppendRow;
      basicBlock := false;
    end;
  end;

  // Clean up
  if header.opcodeBase > 0 then FreeMem(sizes, header.opcodeBase-1);
end;

//////////////////////////////////////////////////////////////////////

// Needs to be pointed towards the .debug_pubnames section for a compilation unit
procedure ProcessNameLookups(var list: TStringList);
var
  header: TPubnamesUnitHeader;
  offset: uint32;
begin
  if assigned(debugPubNames) then begin
    debugPubNames.Seek(0);

    debugPubNames.ReadBlock(header, SizeOf(TPubnamesUnitHeader));
    repeat
      offset := debugPubNames.ReadUint32;
      if offset > 0 then list.AddObject(debugPubNames.ReadString, TObject(header.offset+offset)) else Break
    until false;
  end;
end;

//////////////////////////////////////////////////////////////////////

(*
procedure ProcessAddressLookups(var rangeData: TARangeData);
var
  header: TARangesUnitHeader;
  i: integer;
begin
  ReadBlock(header, SizeOf(TARangesUnitHeader));
  for i := 1 to SizeOf(TARangesUnitHeader) mod (SizeOf(uint32)*2) do ReadUint8;
  rangeData.data := dataPointer;
  rangeData.count := 0;
  while not ((rangeData.data^[rangeData.count].start = 0) and
             (rangeData.data^[rangeData.count].size = 0)) do Inc(rangeData.count);
end;

*)
//////////////////////////////////////////////////////////////////////

function ProcessDWARF(elf: TELFFile; dir: string): TDwarfFile;
var
  offset: uint32;
  compUnit: TCompilationUnit;
begin
  logWriteLn('Processing DWARF file');

  Result := TDwarfFile.Create;
  Dwarf := Result;
  Result.baseDir := Copy(dir, 1, Length(dir)-1);

  // Find sections
  debugAbbrev := elf.FindSectionByName('.debug_abbrev');
  debugAranges := elf.FindSectionByName('.debug_aranges');
  debugFrame := elf.FindSectionByName('.debug_frame');
  debugInfo := elf.FindSectionByName('.debug_info');
  debugLine := elf.FindSectionByName('.debug_line');
  debugLoc := elf.FindSectionByName('.debug_loc');
  debugMacInfo := elf.FindSectionByName('.debug_macinfo');
  debugPubNames := elf.FindSectionByName('.debug_pubnames');
  debugStr := elf.FindSectionByName('.debug_str');

  // Fixme: verify that we have all the sections we need
  if (debugInfo = nil) or (debugAbbrev = nil) then Exit;

  offset := 0;
  while offset < debugInfo.size do begin
    debugInfo.Seek(offset);
    compUnit := TCompilationUnit.Create;
    dwarf.compUnits.Add(compUnit);
    offset := offset + compUnit.unitLength + 4;
  end;

{  ProcessNameLookups(dwarf.varList);
  if dwarf.varList.Count > 0 then begin
    logWrite(dwarf.varList.Strings[0]);
    for i := 1 to dwarf.varList.count-1 do
      logWrite(', ' + dwarf.varList.Strings[i]);