{
    This file is part of the chelinfo library.

    Copyright (c) 2008 by Anton Rzheshevski
    Parts (c) 2006 Thomas Schatzl, member of the FreePascal
    Development team
    Parts (c) 2000 Peter Vreman (adapted from original stabs line
    reader)

    Dwarf LineInfo Extractor

    See the file COPYING.FPC, included in this distribution,
    for details about the copyright.

    This program is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.

 **********************************************************************}
{
    2008, Anton Rzheshevski aka Cheb:
    Like dr. Frankenshtein I sewn this library together
    from the dead meat of the the FPC RTL modules
    lineinfo.pp and lnfodwrf.pp.
    These (as of Jan. 2008 / FPC 2.2.0) both didn't work
    and had several limitations (e.g. inability to be used
    from a DLL)

    SUPPORTED TAGRETS: LINUX-32 AND WIN32 | FPC 2.2.0
    NOTE: Unlike the FPC RTL modules, this one does NOT
      have the "initialization" section: them buggers
      don't work in the Linux dlls.
      You must call the initialization function manually.

    }

{$mode delphi}
{$longstrings on}
{$codepage utf-8}
{$coperators on}
{$ifndef cpu32}
  {$fatal 64 bit formats not supported}
{$endif}
{$ifndef endian_little}
  {$fatal powerpc architecture not supported}
{$endif}
{
    You can, I presume, easily adapt this thing to 64-bits
    by borrowing from the same sources: lineinfo.pp
    and lnfodwrf.pp of the FreePascal RTL.
    I didn't, because there is no way for me to debug it.
    I use only the 32-bit OSes
}

unit chelinfo;

interface

uses
  SysUtils, Classes, zstream, md5, math;


  function ExplainLineInfo(addr: pointer): string;
  
  procedure GetLineInfo(addr: pointer; var exe, src: ansistring; var line, column: integer);
  {
    The format of returned information:
    "exe" *always* receives the full name of the executable file
      (the main exe or one of dlls it uses) the addr belongs to.
      In Linux, it returns the real file name, with all symlinks
      resolved.
    "line" can be negative, which means no line info has been found
      for this address. See LineInfoError (below) for details.
    "src" returns the source file name. It either doesn't or does
      contain a full path. If the source was in the same directory
      as the program itself, there will be no path. If the source
      was in the different directory, there will be a full path
      (for the moment when the program was compiled, NOT for the
      current location of that source).
    "column" is positive ONLY when there is more than one address
      stored for the same source line. FreePascal generates this
      on VERY rare occasions, mostly for the arithmetic formulas
      spanning several lines. So most of the time column will
      receive -1.
  }

  function InitLineInfo(someaddr: pointer): longbool;
  {
    This function is called by GetLineInfo() anyway if it doesnt't
      find a loaded line info for the executable to which the
      requested addres belongs.
    Also installs the custom BackTraceStr handler.

    Input:
    someaddr is adress of any function that belongs to the executable
      you want to pre-load the line info for. For example, a function
      exported from a particular dll.
    If you pass NIL, it will load the line info for the executable
      yhis module was compiled with.
      
    Output:
    Returns false if it failed to load the line info for the particular
      executable. In this case look LineInfoError for explanation
    Returns true if the line info for the particular executable is loaded ok.
    Returns true and does nothing if line info for that executable is
      already loaded.
  }
  
  procedure GetModuleByAddr(addr: pointer; var baseaddr: pointer; var filename: string);
  {
    This function allows you to know which executable (i.e. the main exe
      or one of the dlls loaded by it) owns this part of the virtual
      addres space.
    baseaddr receives the exe/dll base address
      (always NIL for the main exe in Linux).
    The mechnaism is made with possibility of a DLL relocation
      in mind, but that particular feature is untested.
    This function is used by GetLineInfo() to determine which executable
      to load line the info from.
  }
  
  var
    LineInfoError: WideString = '';
    LineInfoPaths: array of string = nil;
    {you can store the .zdli files in a different folder than the EXe itself.
      Just fill in this array.}
    ExtractDwarfLineInfoError: WideString = '';


  function ExtractDwarfLineInfo(
    ExeFileName: ansistring; var _dlnfo: pointer; var _dlnfoSize: integer;
    var Imagebase: cardinal): longbool;
  {
  Reads the dwarf line info from an executable.
    In case of error, see ExtractDwarfLineInfoError for details.
  ImageBase is nil for unix DLLs
    in all other cases the value it receives must be substracted
    from the addresses in the dwarf line info (and then the real
    base address added, to account for the possible relocation)
  NOTE: currently in unix it is also NIL for the main executable,
    corresponding the GetModuleByAddr() in un_lineinfo
    also returning NIL as the base address for the main executable.
  }


  procedure FinalizeExtractedDwarfLineInfo(ExeFileName: ansistring);
  {
   Used to add the exe's md5 control sum  to the zd2 file,
     as I had enough trouble with the debug info leftovers
     from the older exes. It have to be done *after* upx-ing
     the exe, which brings us to the need of another utility
     and another procedure.
  }


  procedure BrutalStripFPC(ein, eout, dlnout: TStream; UseWriteLn: longbool);
  {
  This function strips *all* unnecessary info from an EXE/DLL file.
  It is more effective than the standard "strip" utility,
    which leaves untouched any sections it doesn't understand.
  Unfortunately, "strip" doesn't understand the dwarf debugging info at all,
    so it doesn't strip it at all, leaving tons of junk behind it!
  This procedure is designed specifically for the executables generated by FPC,
    it would likely mutilate the files created by other compilers
    beyond any repair.
  The dlnout stream receives the dwarf line info.
    It can be NIL, in which case the dwarf line info is just discarded,
  }


  procedure InjectLineInfo(ein, dliin, eout: TStream; UseWriteLn: longbool);
  {
  This function injects the (compressed) line info
    back into the stripped exe.
    Usage:
    1. BrutalStrip it
    2. UPX it
    3. InjectLineInfo
    -- now you got a maximum-compressed release-quality exe}


  function DlnNameByExename(exename: string): string;
  {generates file names with .dwrlnfo extension.
     For unix, gives .elf.drwlnfo if the source name
     has no extension (as most executables do).
   Use in cases when both your windows and linux binaries are placed
     in the same folder }

implementation

   {$ifdef darwin}
  function ExplainLineInfo(addr: pointer): string;
  begin
    Result:='Line info is not supported for MacOS X'; 
  end;
  
  procedure GetLineInfo(addr: pointer; var exe, src: ansistring; var line, column: integer);
  begin
   exe:='<UNKNOWN>';
   line:= -1;
   src:='<UNKNOWN>';
   column:=-1;
  end;

  function InitLineInfo(someaddr: pointer): longbool;
  begin
    Result:= true;
	LineInfoError:= 'Not supported for MacOS X'
  end;
 
  procedure GetModuleByAddr(addr: pointer; var baseaddr: pointer; var filename: string);
  begin
    baseaddr:= nil;
	filename:= '<UNKNOWN>';  
  end;

  function ExtractDwarfLineInfo(
    ExeFileName: ansistring; var _dlnfo: pointer; var _dlnfoSize: integer;
    var Imagebase: cardinal): longbool;
   begin
     result:= false;
	 
   end;
   
  procedure FinalizeExtractedDwarfLineInfo(ExeFileName: ansistring); begin end;
  procedure BrutalStripFPC(ein, eout, dlnout: TStream; UseWriteLn: longbool); begin end;
  procedure InjectLineInfo(ein, dliin, eout: TStream; UseWriteLn: longbool); begin end;
  function DlnNameByExename(exename: string): string; begin result:='' end;
   
   {$else}
    uses
	{$ifdef unix}
      baseunix, dl
    {$else}
      windows
    {$endif}
    {$ifdef cge}
     ,{$ifdef cgemodule} mo_hub {$else} cge {$endif}
    {$endif}
;


{$MACRO ON}

{define DEBUG_WRITE := WriteLn}
{$define DEBUG_WRITE := //}
{$ifdef cge}
  {define DEBUG_ADDLOG := AddLog}
  {$define DEBUG_ADDLOG := //}
{$else}
  {$define DEBUG_ADDLOG := //}
{$endif}

const
  //sections to leave in the PE executable
  PeNecessary: array [0..9] of string =
    ('.text','.data','.bss','.idata','.edata', '.rdata', '.rsrc', '.reloc', 'CODE', 'DATA');
  PEDlin: string = '/30';
  ZPEDlin: string = 'Zdblinfo';
  ELFDlin: string = '.debug_line';
  ZELFDlin: string = '.z_debug_line';


  function ChelinfoBackTraceStr(addr : Pointer) : ShortString;
  var
    exe, src: ansistring;
    line, column: integer;
    Store  : TBackTraceStrFunc;
  begin
    { reset to prevent infinite recursion if problems inside the code }
    Store := BackTraceStrFunc;
    BackTraceStrFunc := @SysBackTraceStr;
    GetLineInfo(addr, exe, src, line, column);
    { create string }
    Result:=' $' + HexStr(ptrint(addr), sizeof(ptrint) * 2);
    if line < 0 then Result+= ' (no debug info: ' + LineInfoError + ')'
    else begin
      Result+= ', line ' + IntToStr(line);
      if column >=0 then Result+= ', column ' + IntToStr(column);
      Result += ' of ' + src;
    end;
    Result+= ' in ' + exe;
    BackTraceStrFunc := Store;
  end;
  
  
  function ExplainLineInfo(addr: pointer): string;
  var
    exe, src: ansistring;
    line, column: integer;
  begin
    GetLineInfo(addr, exe, src, line, column);
    Result:= '';
    if line < 0 then Result+= ' (no debug info: ' + LineInfoError + ')'
    else begin
      Result+= ', line ' + IntToStr(line);
      if column >=0 then Result+= ', column ' + IntToStr(column);
      Result += ' of ' + ExtractFileName(src);
    end;
    Result+= ' in ' + ExtractFileName(exe);
  end;



{$packrecords default}
  const
    MAX_RANDOM_OFFSET_TO_TRY = 1000;
  
  var
    initialized: boolean = false;

  { DWARF 2 default opcodes}
  const
    { Extended opcodes }
    DW_LNE_END_SEQUENCE = 1;
    DW_LNE_SET_ADDRESS = 2;
    DW_LNE_DEFINE_FILE = 3;
    { Standard opcodes }
    DW_LNS_COPY = 1;
    DW_LNS_ADVANCE_PC = 2;
    DW_LNS_ADVANCE_LINE = 3;
    DW_LNS_SET_FILE = 4;
    DW_LNS_SET_COLUMN = 5;
    DW_LNS_NEGATE_STMT = 6;
    DW_LNS_SET_BASIC_BLOCK = 7;
    DW_LNS_CONST_ADD_PC = 8;
    DW_LNS_FIXED_ADVANCE_PC = 9;
    DW_LNS_SET_PROLOGUE_END = 10;
    DW_LNS_SET_EPILOGUE_BEGIN = 11;
    DW_LNS_SET_ISA = 12;

  type
    { state record for the line info state machine }
    TMachineState = record
      address : cardinal;
      file_id : DWord;
      line : QWord;
      column : DWord;
      is_stmt : Boolean;
      basic_block : Boolean;
      end_sequence : Boolean;
      prolouge_end : Boolean;
      epilouge_begin : Boolean;
      isa : DWord;
      append_row : Boolean;
    end;


  { DWARF line number program header preceding the line number program, 32 bit version }
    TLineNumberProgramHeader32 = packed record
      unit_length : DWord;
      version : Word;
      length : DWord;
      minimum_instruction_length : Byte;
      default_is_stmt : byte;//Bool8;
      line_base : ShortInt;
      line_range : Byte;
      opcode_base : Byte;
    end;

    TDwarfChunk = packed record
      addr: pointer;
      line: integer;
      end_sequence: Boolean;
      column, fileind: smallint; // it is sooo unlikely for them
    end;                         // to go beyond the 32767 limit...
    TFileInfo = packed record
      name: ansistring;
      dirind: integer;
    end;
    TDwarftable = array of TDwarfChunk;
    TCompilationUnit = record
      dTable: TDwarftable;
      Files: array of TFileInfo;
      Dirs: array of ansistring;
    end;
    TExecutableUnit = record
      name: string;
      CompilationUnit: array of TCompilationUnit;
    end;
  var
    base_addr: pointer = nil;
    ExecutableUnit: array of TExecutableUnit;
    

  procedure GetModuleByAddr(addr: pointer; var baseaddr: pointer; var filename: string);
  {$ifdef unix}
  var
    dlinfo: dl_info;
  begin
    FillChar(dlinfo, sizeof(dlinfo), 0);
    dladdr(addr, @dlinfo);
    baseaddr:= dlinfo.dli_fbase;
    filename:= String(dlinfo.dli_fname);
    if ExtractFileName(filename) = ExtractFileName(ParamStr(0))
      then baseaddr:= nil;
//    if filename = BacktrackSymlink(ParamStr(0)) then baseaddr:= nil; //doesn't work!
//addlog ('----------'#10#13'  %0'#10#13'  %1',[BacktrackSymlink(ParamStr(0)), filename]);
  end;
  {$else}
  var
    Tmm: TMemoryBasicInformation;
    TST: array[0..Max_Path] of Char;
  begin
    if VirtualQuery(addr, @Tmm, SizeOf(Tmm)) <> sizeof(Tmm)
      then raise Exception.Create('The VirualQuery() call failed.');
    baseaddr:=Tmm.AllocationBase;
    TST[0]:= #0;
    GetModuleFileName(THandle(Tmm.AllocationBase), TST, SizeOf(TST));
    filename:= String(PChar(@TST));
  end;
  {$endif}

  function CheckMd5Sums(d2stream: TStream; Exename: ansistring): boolean;
  var
    buf: array[0..2047] of byte;
    d1r, d2r, d1c, d2c: TMD5Digest;
    fs: TFileStream;
    procedure CalcMd5Sum(i: TStream; len: integer; var d: TMD5Digest);
    var
      a: integer;
      c: TMd5Context;
    begin
      MD5Init(c);
      repeat
        a:= min(2048, len);
        i.Read(buf[0], a);
        MD5Update(c, buf[0], a);
        dec(len, a);
      until len = 0;
      Md5Final(c, d);
     end;
     function HashesMatch(var d1, d2: TMd5Digest): boolean;
     var j: integer;
     begin
       Result:= true;
       for j:=0 to sizeof(TMd5Digest)  - 1 do
         if d1[j] <> d2[j] then Exit(false);
     end;
  begin
    d2stream.Position:= 0;
    CalcMd5Sum(d2stream, d2stream.Size - 2 * sizeof(TMD5Digest), d2c);
    d2stream.Read(d1r, sizeof(d1r));
    d2stream.Read(d2r, sizeof(d2r));
    fs:= TFileStream.Create(exename, fmOpenRead or fmShareDenyNone);
    CalcMd5Sum(fs, fs.Size, d1c);
    fs.Free;
    Result:= HashesMatch(d1r, d1c) and HashesMatch(d2r, d2c)
  end;



  function InitLineInfo(someaddr: pointer): longbool;
  var
    dwarfsize: integer;
    dli, dc, ts: TStream;
    unit_length, unit_base, next_base: dword;
    header_length: SizeInt;
    header : TLineNumberProgramHeader32;
    state : TMachineState;
    numoptable : array[1..255] of Byte;
    i, din: integer;
    s: ansistring;

    opcode, extended_opcode : Byte;
    extended_opcode_length : Integer;
    adjusted_opcode : Int64;
    addrIncrement, lineIncrement: Integer;
    _dwarf: pointer;
    ExeImageBase: cardinal;

    filename, exname: ansistring;

    { Reads an unsigned LEB encoded number from the input stream }
    function ReadULEB128() : QWord;
    var
      shift : Byte;
      data : Integer;
      val : QWord;
    begin
      shift := 0;
      result := 0;
      dli.Read (data, 1);
      while (data <> -1) do begin
        val := data and $7f;
        result := result or (val shl shift);
        inc(shift, 7);
        if ((data and $80) = 0) then
          break;
        dli.Read (data, 1);
      end;
    end;


    { Reads a signed LEB encoded number from the input stream }
    function ReadLEB128() : Int64;
    var
      shift : Byte;
      data : Integer;
      val : Int64;
    begin
      shift := 0;
      result := 0;
      dli.Read (data, 1);
      while (data <> -1) do begin
        val := data and $7f;
        result := result or (val shl shift);
        inc(shift, 7);
        if ((data and $80) = 0) then
          break;
        dli.Read (data, 1);
      end;
      { extend sign. Note that we can not use shl/shr since the latter does not
        translate to arithmetic shifting for signed types }
      result := (not ((result and (1 shl (shift-1)))-1)) or result;
    end;

    procedure SkipLEB128();
    var temp : int64;
    begin
      temp := ReadLEB128();
      DEBUG_ADDLOG('Skipping LEB128 : %0',[temp]);
    end;
    
    function CalculateAddressIncrement(_opcode : Byte) : Int64;
    begin
      result := (Int64(_opcode) - header.opcode_base) div header.line_range * header.minimum_instruction_length;
    end;

    
    function ReadString(): ansistring;
    var a: ansichar;
    begin
      Result:= '';
      while (true) do begin
        dli.Read(a, 1);
        if a = #0 then Exit;
        Result+= a;
      end;
    end;

    { initializes the line info state to the default values }
    procedure InitStateRegisters();
    begin
      with state do begin
        address := 0;
        file_id := 1;
        line := 1;
        column := 0;
        is_stmt := (header.default_is_stmt <> 0);
        basic_block := false;
        end_sequence := false;
        prolouge_end := false;
        epilouge_begin := false;
        isa := 0;
        append_row := false;
      end;
    end;
    
    function ParseCompilationUnit(var CompilationUnit: array of TCompilationUnit): boolean;
    var j: integer;
      procedure AddChunk;
      begin
        With CompilationUnit[high(CompilationUnit)] do begin
          SetLength(dtable, length(dtable) + 1);
          with dtable[high(dtable)] do begin
            //account for thepossible relocation (in 99% cases ExeImagebase = base_addr)
            addr:= pointer(cardinal(state.address) - ExeImagebase + cardinal(base_addr));
            line:= state.line; // should we add 1 here ?
            column:= state.column;
            fileind:= state.file_id - 1;
            end_sequence:= state.end_sequence;
//            {$ifdef cge}
//              if {$ifdef cgemodule}MotherState.VerboseLog {$else}MotherState.DebugMode {$endif}//  or true
//                then
//                  if (fileind < 0) or (fileind > high(files))
//                    then AddLog('dwrflnfo: %0 %1:%2, INVALID fileind %3!', [addr, line, column, fileind])
//                    else AddLog('dwrflnfo: %0 %1:%2 %3', [addr, line, column, files[fileind].name]);
//            {$else}
              DEBUG_WRITE('dwrflnfo: ', IntToHex(cardinal(addr),8), ' ', line,' ', column, ' ',files[fileind].name);
//            {$endif}
          end;
        end;
      end;


    begin
      Result:= true;
      fillchar(CompilationUnit[high(CompilationUnit)], sizeof(TCompilationUnit), 0);

     // a hack: the next compilation unit can have an unpredictable ofset,
     // so we try to find it by checking the most common values of the header
      j:= 0;
      repeat
        if unit_base + j + sizeof(header) + 2 > dli.Size then begin
          DEBUG_ADDLOG('The stream end reached, no more units.');
          Exit(false);
        end;
        dli.position:= unit_base + j;
        dli.Read(header, sizeof(header));
        with header do begin
          if (version = 2) and (line_range = 255) and (opcode_base = 13) then begin
            unit_base+= j;
            DEBUG_ADDLOG('rand_offset=%8, p=%9, unit_length %0 version %1  length %2  min_instr_leng %3 def_is_stmt %4 line_base %5 line_range %6 opcode_base %7',        [unit_length, version, length, minimum_instruction_length, default_is_stmt, line_base, line_range, opcode_base, j, pointer(unit_base)]);
            header_length := sizeof(header.length) + sizeof(header.version)
                          + sizeof(header.unit_length)
                          + header.length;
            Break;
          end;
        end;
        inc(j);
      until false;

      next_base:= unit_base + header.unit_length + sizeof(header.unit_length);

      fillchar(numoptable, sizeof(numoptable), #0);
      dli.Read(numoptable, header.opcode_base - 1);
      DEBUG_ADDLOG('Opcode parameter count table');
      for j := 1 to header.opcode_base - 1 do begin
        DEBUG_ADDLOG('Opcode[%0] - %1 parameters', [j, numoptable[j]]);
      end;

      With CompilationUnit[high(CompilationUnit)] do begin
        SetLength(dirs, 1);
        dirs[0]:=''; //the project directory
        while (true) do begin
          s:= ReadString();
          if (s = '') then break;
          SetLength(dirs, length(dirs) + 1);
          dirs[high(dirs)]:= s;
          DEBUG_ADDLOG('Dir %0: %1',[high(dirs), AnsiToWide(s)]);
        end;


        while (true) do begin
          s:= ReadString;
          if (s = '') then break;
          SetLength(files, length(files) + 1);
          with files[high(files)] do begin
            name:= s;
            dirind:= ReadLEB128(); { the directory index for the file }
            DEBUG_ADDLOG('File %0 (dir %2): %1',[high(files), AnsiToWide(name), dirind]);
          end;
          SkipLEB128(); { skip last modification time for file }
          SkipLEB128(); { skip length of file }
        end;


        dli.Position:= header_length + unit_base;
        unit_length:= header.unit_length;
        
        InitStateRegisters();

        while (dli.Position - unit_base) < unit_length - 2{ dli.Size - 1} do begin
          dli.Read(opcode, 1);
          DEBUG_ADDLOG('Next opcode: %0  (stream pos. %1 ( %2 / %3 )',[opcode, dli.position, dli.position - unit_base, unit_length]);

          case (opcode) of
            { extended opcode }
            0 : begin
              extended_opcode_length := ReadULEB128();
              dli.Read(extended_opcode, 1);
              case (extended_opcode) of
                DW_LNE_END_SEQUENCE : begin
                  state.end_sequence := true;
                  state.append_row := true;
                  AddChunk;
                  DEBUG_ADDLOG('DW_LNE_END_SEQUENCE');
                  InitStateRegisters();
                end;
                DW_LNE_SET_ADDRESS : begin
                  dli.Read(state.address, 4);
                  DEBUG_ADDLOG('DW_LNE_SET_ADDRESS (%0)', [pointer(state.address)]);
                end;
                DW_LNE_DEFINE_FILE : begin
                  {$ifdef DEBUG_DWARF_PARSER}s := {$endif}ReadString();
                  SkipLEB128();
                  SkipLEB128();
                  SkipLEB128();
                  DEBUG_ADDLOG('DW_LNE_DEFINE_FILE (' + s + ')');
                end;
                else begin
                  DEBUG_ADDLOG('Unknown extended opcode (opcode %0 length %1)', [extended_opcode, extended_opcode_length]);
                  dli.Position:= dli.Position + extended_opcode_length - 1;
                end;
              end;
            end;
            DW_LNS_COPY : begin
              state.basic_block := false;
              state.prolouge_end := false;
              state.epilouge_begin := false;
              state.append_row := true;
              DEBUG_ADDLOG('DW_LNS_COPY');
              AddChunk;
            end;
            DW_LNS_ADVANCE_PC : begin
              inc(state.address, ReadULEB128() * header.minimum_instruction_length);
              DEBUG_ADDLOG('DW_LNS_ADVANCE_PC (' + hexstr(state.address, sizeof(state.address)*2) + ')');
            end;
            DW_LNS_ADVANCE_LINE : begin
              inc(state.line, ReadLEB128());
              DEBUG_ADDLOG('DW_LNS_ADVANCE_LINE (%0)', [state.line]);
             // AddChunk;
            end;
            DW_LNS_SET_FILE : begin
              state.file_id := ReadULEB128();
              DEBUG_ADDLOG('DW_LNS_SET_FILE (%0)', [state.file_id]);
            end;
            DW_LNS_SET_COLUMN : begin
              state.column := ReadULEB128();
              DEBUG_ADDLOG('DW_LNS_SET_COLUMN (%0)', [state.column]);
            end;
            DW_LNS_NEGATE_STMT : begin
              state.is_stmt := not state.is_stmt;
              DEBUG_ADDLOG('DW_LNS_NEGATE_STMT (%0)',[state.is_stmt]);
            end;
            DW_LNS_SET_BASIC_BLOCK : begin
              state.basic_block := true;
              DEBUG_ADDLOG('DW_LNS_SET_BASIC_BLOCK');
            end;
            DW_LNS_CONST_ADD_PC : begin
              inc(state.address, CalculateAddressIncrement(255));
              DEBUG_ADDLOG('DW_LNS_CONST_ADD_PC (' + hexstr(state.address, sizeof(state.address)*2) + ')');
            end;
            DW_LNS_FIXED_ADVANCE_PC : begin
              dli.Read(state.address, sizeof(state.address));
              DEBUG_ADDLOG('DW_LNS_FIXED_ADVANCE_PC (' + hexstr(state.address, sizeof(state.address)*2) + ')');
            end;
            DW_LNS_SET_PROLOGUE_END : begin
              state.prolouge_end := true;
              DEBUG_ADDLOG('DW_LNS_SET_PROLOGUE_END');
            end;
            DW_LNS_SET_EPILOGUE_BEGIN : begin
              state.epilouge_begin := true;
              DEBUG_ADDLOG('DW_LNS_SET_EPILOGUE_BEGIN');
            end;
            DW_LNS_SET_ISA : begin
              state.isa := ReadULEB128();
              DEBUG_ADDLOG('DW_LNS_SET_ISA (%0)', [state.isa]);
            end;
            else begin { special opcode }
              if (opcode < header.opcode_base) then begin
                DEBUG_ADDLOG('Unknown standard opcode $' + hexstr(opcode, 2) + '; skipping');
                for j := 1 to numoptable[opcode] do
                  SkipLEB128();
              end else begin
                adjusted_opcode := integer(opcode) - header.opcode_base;
                addrIncrement := CalculateAddressIncrement(opcode);
                inc(state.address, addrIncrement);
                lineIncrement := header.line_base + (adjusted_opcode mod header.line_range);
                inc(state.line, lineIncrement);
                DEBUG_ADDLOG('Special opcode $' + hexstr(opcode, 2) + ' address increment: %0 new line: %1', [addrIncrement, lineIncrement]);
                state.basic_block := false;
                state.prolouge_end := false;
                state.epilouge_begin := false;
                state.append_row := true;
                AddChunk;
              end;
            end;
          end; //case
        end; //while
      end; //with
      Result:= true;
    end;
    
    
  begin
    if someaddr = nil then someaddr:=@InitLineInfo;
    GetModuleByAddr(someaddr, base_addr, filename);
    din:= -1;
    for i:=0 to high(ExecutableUnit) do
      if ExecutableUnit[i].name = filename then din:=i;
    if din < 0 then begin
      SetLength(ExecutableUnit, length(ExecutableUnit) + 1);
      din:= high(ExecutableUnit); // it gets added at the end, of course
      ExecutableUnit[din].name:= filename;
      ExecutableUnit[din].CompilationUnit:= nil;
    end
    else
      Exit(true); //already initialized for this exe/dll

    BackTraceStrFunc := @ChelinfoBacktraceStr;

    {$ifdef cge}
      if MotherState.VerboseLog then begin
        AddLog(RuEn('Загрузка отладочной информации...', 'Loading the self-debugging info...'));
        AddLog('  %2 is %1, base %0', [base_addr, filename, someaddr]);
      end;
    {$else}
//writeln('-- ',IntToHex(cardinal(base_addr), 8), '  ',filename);
    {$endif}

    try
      Result:= false;
     {  First, try the external file with line information.
        Failing that, try to parse the executable itself }

      exname:= DlnNameByExename(filename);
      i:= -1;
      repeat
{$ifdef cge}if MotherState.VerboseLog then addlog('  ..file "%0", exists=%1..', [exname, FileExists(exname)]);{$endif}
        if FileExists(exname)
          then break
          else exname:='';
        inc(i);
        if i > high(LineInfoPaths) then break;
        exname:= LineInfopaths[i] + DlnNameByExename(ExtractFileName(filename));
      until false;
      
      if exname <> ''
        //and (FileAge(filename) <= FileAge(DlnNameByExename(filename)))
      then begin
        //the compression streams are unable to seek,
        //so we decompress to a memory stream first.
        ts:=TFileStream.Create(exname, fmOpenRead);
        dc:=TDecompressionStream.Create(ts);
        dli:= TMemoryStream.Create;
        dc.Read(DwarfSize, 4);
        dc.Read(ExeImageBase, 4);
        dli.CopyFrom(dc, DwarfSize);
        dc.Free;
        if not CheckMd5Sums(ts, filename) then begin
          {$ifdef cge}
            LineInfoError:=
              {$ifndef cgemodule}
                PervertedFormat(MessageContainer[MI_DEBUG_INFO_MISMATCH], [ExtractFileName(filename)]);
              {$else}
                MsgFormat(MI_DEBUG_INFO_MISMATCH, [ExtractFileName(filename)]);
              {$endif}
          {$else}
            LineInfoError:= 'debug info checksum doesn''t match this exe.';
          {$endif}
          ts.Free;
          Exit(false);
        end;
        ts.Free;
      end
      else begin
        {$ifdef cge}if MotherState.VerboseLog then addlog('  External file not found, trying to parse self: "%0"..', [filename]);{$endif}
        DEBUG_WRITE('  External file not found, trying to parse self.');
        if not ExtractDwarfLineInfo(filename, _dwarf, DwarfSize, ExeImageBase) then begin
          LineInfoError:= ExtractDwarfLineInfoError;
          Exit(false);
        end;
        dli:= TMemoryStream.Create;
        dli.Write(_dwarf^, DwarfSize);
        FreeMem(_dwarf);
      end;

      dli.Position:= 0;
      next_base:= 0;

      {$ifdef cge}if MotherState.VerboseLog then addlog('  dwarf2 line info: %0 bytes..', [dli.size]);{$endif}
      DEBUG_WRITE('dwarf2 line info: ',dli.size,' bytes.');
      
      With ExecutableUnit[din] do
        while true {next_base < dli.Size - sizeof(header) - 5} do begin
          SetLength(CompilationUnit, length(CompilationUnit) + 1);
          unit_base:= next_base;
          if not ParseCompilationUnit(CompilationUnit) then begin
            SetLength(CompilationUnit, length(CompilationUnit) - 1);
            Break;
          end;
        end;
    except
      {$ifdef cge}
        Die(RuEn('Крах при парсинге отладочной информации.','Crashed while parsing the self-debugging info.'))
      {$else}
      LineInfoError:= 'Crashed parsing the dwarf line info: ' + (ExceptObject as Exception).Message;
      dli.Free;
      Result:=false;
      {$endif}
    end;
    if {Result and} (length(ExecutableUnit[din].CompilationUnit) > 0)
      then begin
        initialized:= true;
        {$ifdef cge}
          if MotherState.VerboseLog then
            AddLog(RuEn('  найдено %0 блоков.','  found %0 units.'), [length(ExecutableUnit[din].CompilationUnit)])
        {$else}
        DEBUG_WRITE('  found ', length(ExecutableUnit[din].CompilationUnit), ' compilation units.');
        {$endif}
      end
      else begin
        {$ifdef cge}
//        AddLog(RuEn(
//          'Не найдена отладочная информация для'#10#13'  %0.',
//          'No debug info found for'#10#13'  %0.'),
//            [ExecutableUnit[din].name]);
        {$endif}
        LineInfoError:= 'no compilation units found.';
        Result:=false;
      end;
    dli.Free;
    Result:= True;
  end;
  



  procedure GetLineInfo(addr: pointer; var exe, src: ansistring; var line, column: integer);
  var
    i,j,k, ei: integer;
    ubase: pointer;
    b: boolean;
  begin
    src:='';
    exe:='';
    line:= -1;
    column:= -1;
    //LineInfoError:= '';

    if not initialized then
      if not InitLineInfo(addr) then exit;
    try
      GetModuleByAddr(addr, ubase, exe);
      ei:= -1;
      for i:=0 to high(ExecutableUnit) do
        if ExecutableUnit[i].name = exe then ei:=i;
      if ei < 0 then begin
        if not InitLineInfo(addr) then exit;
        ei:= high(ExecutableUnit); // it gets added at the end, of course
      end;
      with ExecutableUnit[ei] do
        for j:=0 to high(CompilationUnit) do
          with ExecutableUnit[ei].CompilationUnit[j] do
            for i:=0 to high(dtable) do
              if (addr = dtable[i].addr)
                or ((i < high(dtable))
                  and (addr >= dtable[i].addr) and (addr < dtable[i + 1].addr)
                  and not dtable[i].end_sequence //(cardinal(addr) - cardinal(dtable[i].addr) < 1000)//
                )
              then begin
                src:= IncludeTrailingPathDelimiter(Dirs[Files[dtable[i].fileind].dirind])
                      + Files[dtable[i].fileind].name;
                line:= dtable[i].line;
                column:= dtable[i].column;
                //now check if the same line appears twice with different columns.
                // if not, then reset column to -1.
                b:= false;
                for k:=0 to high(dtable) do
                  b:= b or
                      (     (dtable[k].line = line)
                        and (dtable[k].column <> column)
                        and (dtable[k].fileind = dtable[i].fileind));
                if not b then column:= -1;

                LineInfoError:= '';
                Exit;
              end;
      LineInfoError:='doesn''t include this address range';
    except
      LineInfoError:= (ExceptObject as Exception).Message;
    end;
  end;


{$ioerrors on}

  function DlnNameByExename(exename: string): string;
  begin
    {$ifdef unix}
     if ExtractFileExt(exename) = ''
       then Result:= ChangeFileExt(exename, '.elf.zd2')
       else
    {$endif}
            Result:= ChangeFileExt(exename, '.zd2');
  end;


  procedure FinalizeExtractedDwarfLineInfo(ExeFileName: ansistring);
  {
   Used to add the exe's md5 control sum  to the zd2 file,
     as I had enough trouble with the debug info leftovers
     from the older exes. It have to be done *after* upx-ing
     the exe, which brings us to the need of another utility
     and another procedure.
  }
  var
    c: TMD5Context;
    d1, d2: TMD5Digest;
    s: TStream;
    b: array of byte;
  begin
    s:= TFileStream.Create(ExeFilename, fmOpenRead);
    SetLength(b, s.Size);
    s.Read(b[0], s.Size);
    s.Free;
    MD5Init(c);
    MD5Update(c, b[0], Length(b));
    Md5Final(c, d1);
    SetLength(b, 0);
    s:= TFileStream.Create(DlnNameByExeName(ExeFilename), fmOpenReadWrite);
    SetLength(b, s.Size);
    s.Read(b[0], s.Size);
    MD5Init(c);
    MD5Update(c, b[0], Length(b));
    Md5Final(c, d2);
    s.Write(d1, sizeof(d1));
    s.Write(d2, sizeof(d2));
    s.Free;
  end;
{$packrecords c}

{ ELF Header structures types}
type
  Elf32_Half = Word;
  Elf64_Half = Word;
  { Types for signed and unsigned 32-bit quantities.   }
  Elf32_Word = DWord;
  Elf32_Sword = Longint;
  Elf64_Word = DWord;
  Elf64_Sword = Longint;
  { Types for signed and unsigned 64-bit quantities.   }
  Elf32_Xword = QWord;
  Elf32_Sxword = Int64;
  Elf64_Xword = QWord;
  Elf64_Sxword = Int64;
  { Type of addresses.   }
  Elf32_Addr = DWord;
  Elf64_Addr = QWord;
  { Type of file offsets.   }
  Elf32_Off = DWord;
  Elf64_Off = QWord;
  { Type for section indices, which are 16-bit quantities.   }
  Elf32_Section = Word;
  Elf64_Section = Word;
  { Type for version symbol information.   }
  Elf32_Versym = Elf32_Half;
  Elf64_Versym = Elf64_Half;
{ some constants from the corresponding header files }
const
  El_NIDENT = 16;
  { some important indices into the e_ident signature of an ELF file }
  EI_MAG0 = 0;
  EI_MAG1 = 1;
  EI_MAG2 = 2;
  EI_MAG3 = 3;
  EI_CLASS = 4;
  { the first byte of the e_ident array must be of this value }
  ELFMAG0 = $7f;
  { the second byte of the e_ident array must be of this value }
  ELFMAG1 = Byte('E');
  { the third byte of the e_ident array must be of this value }
  ELFMAG2 = Byte('L');
  { the fourth byte of the e_ident array must be of this value }
  ELFMAG3 = Byte('F');

  { the fifth byte specifies the bitness of the header; all other values are invalid }
  ELFCLASS32 = 1;
  ELFCLASS64 = 2;

  ELFCLASS = {$IFDEF CPU32}ELFCLASS32{$ENDIF}{$IFDEF CPU64}ELFCLASS64{$ENDIF};

type
   { The ELF file header.  This appears at the start of every ELF file, 32 bit version }
  TElf32_Ehdr = record
    e_ident : array[0..El_NIDENT-1] of Byte; { file identification }
    e_type : Elf32_Half; { file type }
    e_machine : Elf32_Half; { machine architecture }
    e_version : Elf32_Word; { ELF format version }
    e_entry : Elf32_Addr; { entry point }
    e_phoff : Elf32_Off; { program header file offset }
    e_shoff : Elf32_Off; { section header file offset }
    e_flags : Elf32_Word; { architecture specific flags }
    e_ehsize : Elf32_Half; { size of ELF header in bytes }
    e_phentsize : Elf32_Half; { size of program header entry }
    e_phnum : Elf32_Half; { number of program header entries }
    e_shentsize : Elf32_Half; { size of section header entry }
    e_shnum : Elf32_Half; { number of section header entry }
    e_shstrndx : Elf32_Half; { section name strings section index }
  end;

  { ELF32 Section header }
  TElf32_Shdr = record
    sh_name : Elf32_Word; { section name }
    sh_type : Elf32_Word; { section type }
    sh_flags : Elf32_Word; { section flags }
    sh_addr : Elf32_Addr; { virtual address }
    sh_offset : Elf32_Off; { file offset }
    sh_size : Elf32_Word; { section size }
    sh_link : Elf32_Word; { misc info }
    sh_info : Elf32_Word; { misc info }
    sh_addralign : Elf32_Word; { memory alignment }
    sh_entsize : Elf32_Word; { entry size if table }
  end;

  { The ELF file header.  This appears at the start of every ELF file, 64 bit version }
  TElf64_Ehdr = record
    e_ident : array[0..El_NIDENT-1] of Byte;
    e_type : Elf64_Half;
    e_machine : Elf64_Half;
    e_version : Elf64_Word;
    e_entry : Elf64_Addr;
    e_phoff : Elf64_Off;
    e_shoff : Elf64_Off;
    e_flags : Elf64_Word;
    e_ehsize : Elf64_Half;
    e_phentsize : Elf64_Half;
    e_phnum : Elf64_Half;
    e_shentsize : Elf64_Half;
    e_shnum : Elf64_Half;
    e_shstrndx : Elf64_Half;
  end;

  { ELF64 Section header }
  TElf64_Shdr = record
    sh_name : Elf64_Word;
    sh_type : Elf64_Word;
    sh_flags : Elf64_Xword;
    sh_addr : Elf64_Addr;
    sh_offset : Elf64_Off;
    sh_size : Elf64_Xword;
    sh_link : Elf64_Word;
    sh_info : Elf64_Word;
    sh_addralign : Elf64_Xword;
    sh_entsize : Elf64_Xword;
  end;

  TElf_Shdr = {$ifdef cpu32}TElf32_Shdr{$endif}{$ifdef cpu64}TElf64_Shdr{$endif};
  TElf_Ehdr = {$ifdef cpu32}TElf32_Ehdr{$endif}{$ifdef cpu64}TElf64_Ehdr{$endif};


  {$packrecords default}

var
  ExeFileName: ansistring;
  header : TElf_Ehdr;
  strtab_header : TElf_Shdr;
  cursec_header : TElf_Shdr;

  buf : array[0..20] of char;


type
  tdosheader = packed record
     e_magic : word;
     e_cblp : word;
     e_cp : word;
     e_crlc : word;
     e_cparhdr : word;
     e_minalloc : word;
     e_maxalloc : word;
     e_ss : word;
     e_sp : word;
     e_csum : word;
     e_ip : word;
     e_cs : word;
     e_lfarlc : word;
     e_ovno : word;
     e_res : array[0..3] of word;
     e_oemid : word;
     e_oeminfo : word;
     e_res2 : array[0..9] of word;
     e_lfanew : longint;
  end;
  tpeheader = packed record
     PEMagic : longint;
     Machine : word;
     NumberOfSections : word;
     TimeDateStamp : longint;
     PointerToSymbolTable : longint;
     NumberOfSymbols : longint;
     SizeOfOptionalHeader : word;
     Characteristics : word;
     Magic : word;
     MajorLinkerVersion : byte;
     MinorLinkerVersion : byte;
     SizeOfCode : longint;
     SizeOfInitializedData : longint;
     SizeOfUninitializedData : longint;
     AddressOfEntryPoint : longint;
     BaseOfCode : longint;
     BaseOfData : longint;
     ImageBase : longint;
     SectionAlignment : longint;
     FileAlignment : longint;
     MajorOperatingSystemVersion : word;
     MinorOperatingSystemVersion : word;
     MajorImageVersion : word;
     MinorImageVersion : word;
     MajorSubsystemVersion : word;
     MinorSubsystemVersion : word;
     Reserved1 : longint;
     SizeOfImage : longint;
     SizeOfHeaders : longint;
     CheckSum : longint;
     Subsystem : word;
     DllCharacteristics : word;
     SizeOfStackReserve : longint;
     SizeOfStackCommit : longint;
     SizeOfHeapReserve : longint;
     SizeOfHeapCommit : longint;
     LoaderFlags : longint;
     NumberOfRvaAndSizes : longint;
     DataDirectory : array[1..$80] of byte;
  end;
  tcoffsechdr=packed record
    name     : array[0..7] of char;
    vsize    : longint;
    rvaofs   : longint;
    datalen  : longint;
    datapos  : longint;
    relocpos : longint;
    lineno1  : longint;
    nrelocs  : word;
    lineno2  : word;
    flags    : longint;
  end;

var
  dosheader  : tdosheader;
  peheader   : tpeheader;
  coffsec    : tcoffsechdr;



  function cntostr(cn: pchar): string;
  var
    i: integer = 0;
  begin
    Result:='';
    repeat
      if cn^ = #0 then break;
      Result+= cn^;
      inc(i);
      inc(cn);
    until i = 8;
  end;



function ExtractDwarfLineInfo(
  ExeFileName: ansistring; var _dlnfo: pointer; var _dlnfoSize: integer;
  var Imagebase: cardinal): longbool;

var
  DwarfOffset : int64;
  DwarfSize : SizeInt;
  i : Integer;
  f : TFileStream;
  IsCompressed: boolean = false;
  DC: TDecompressionStream;

begin
  DEBUG_ADDLOG('Reading dwarf line info from %0', [ExeFileName]);
  Result := false;

  if (ExeFileName = '') or not fileexists(ExeFileName) then begin
      ExtractDwarfLineInfoError:='Invalid executable file name!';
      Exit(false);
  end;

  f:= TFileStream.Create(ExeFileName, fmOpenRead or fmShareDenyNone);
  DwarfOffset:= -1;
  DwarfSize:= -1;

  {$ifdef unix}

    if (f.read(header, sizeof(header)) <> sizeof(header)) then begin
      ExtractDwarfLineInfoError:='Could not read the ELF header!';
      f.Free;
      Exit(false);
    end;

    { more paranoia checks }
    if ((header.e_ident[EI_MAG0] <> ELFMAG0) or (header.e_ident[EI_MAG1] <> ELFMAG1) or
      (header.e_ident[EI_MAG2] <> ELFMAG2) or (header.e_ident[EI_MAG3] <> ELFMAG3)) then begin
      ExtractDwarfLineInfoError:='Invalid ELF magic header.';
      f.Free;
      Exit(false);
    end;

    if (header.e_ident[EI_CLASS] <> ELFCLASS) then begin
      ExtractDwarfLineInfoError:='Invalid ELF header bitness.';
      f.Free;
      Exit(false);
    end;

    { seek to the start of section headers }

    { first get string section header }
    f.Position:= header.e_shoff + (header.e_shstrndx * header.e_shentsize);
    if (f.read(strtab_header, sizeof(strtab_header)) <> sizeof(strtab_header)) then begin
      ExtractDwarfLineInfoError:='Could not read string section header';
      f.Free;
      Exit(false);
    end;

    for i := 0 to (header.e_shnum-1) do begin
      f.Position:= header.e_shoff + (i * header.e_shentsize);
      if (f.Read(cursec_header, sizeof(cursec_header)) <> sizeof(cursec_header)) then begin
        ExtractDwarfLineInfoError:='Could not read next section header';
        f.Free;
        Exit(false);
      end;
      { paranoia TODO: check cursec_header.e_shentsize }

      f.Position:= strtab_header.sh_offset + cursec_header.sh_name;
      if (f.Read(buf, sizeof(buf)) <> sizeof(buf)) then begin
        ExtractDwarfLineInfoError:='Could not read section name';
        Exit(false);
      end;
      buf[sizeof(buf)-1] := #0;

      DEBUG_ADDLOG('This section is "%0", offset %1 size %2', [pchar(@buf[0]), cursec_header.sh_offset, cursec_header.sh_size]);
      if (pchar(@buf[0]) = ELFDlin) then begin
        DEBUG_ADDLOG(ELFDlin + ' section found');
        DwarfOffset := cursec_header.sh_offset;
        DwarfSize := cursec_header.sh_size;
        { more checks }
        DEBUG_ADDLOG(' offset %0,  size %1', [DwarfOffset, DwarfSize]);
        Result := (DwarfOffset >= 0) and (DwarfSize > 0);
        break;
      end;
      if (pchar(@buf[0]) = ZELFDlin) then begin
        DEBUG_ADDLOG(ZELFDlin + ' section found');
        DwarfOffset := cursec_header.sh_offset;
        DEBUG_ADDLOG(' offset %0', [DwarfOffset]);
        IsCompressed:= true;
        Result := (DwarfOffset >= 0);
        break;
      end;

    end;

    Imagebase:= 0;

 {$else}

    { read and check header }
    if f.Size < sizeof(dosheader) then begin
        ExtractDwarfLineInfoError:= 'Could not read the PE header';
        f.Free;
        Exit(false);
      end;
    f.Read(dosheader, sizeof(tdosheader));
    f.Position:= dosheader.e_lfanew;
    f.Read(peheader, sizeof(tpeheader));
    if peheader.pemagic<>$4550 then begin
        ExtractDwarfLineInfoError:= 'Not a valid Portable Executable';
        f.Free;
        Exit(false);
      end;
//writeln('--base, ', IntToHex(peheader.Imagebase,8));

    { read section info }
    for i:=1 to peheader.NumberOfSections do
     begin
       f.Read(coffsec, sizeof(tcoffsechdr));
       DEBUG_ADDLOG(coffsec.name);
//writeln(coffsec.name, '  ', coffsec.datalen);

       if cntostr(@coffsec.name) = PEDlin then begin
         DwarfOffset:= coffsec.datapos;
         DwarfSize:= coffsec.datalen;
         break;
       end;
       if cntostr(@coffsec.name) = ZPEDlin then begin
         DwarfOffset:= coffsec.datapos;
         IsCompressed:= true;
         break;
       end;


     end;
    Result:= (DwarfOffset > 0);
    ImageBase:= peheader.Imagebase;

 {$endif}

  if Result then begin
    if IsCompressed then begin
      f.Position:= DwarfOffset;
      DC:= TDecompressionStream.Create(f);
      DC.Read(DwarfSize, sizeof(DwarfSize));
      DC.Read(ImageBase, sizeof(ImageBase));
      _dlnfoSize:= DwarfSize;
      GetMem(_dlnfo, DwarfSize);
      DC.Read(_dlnfo^, DwarfSize);
      DC.Free;
    end
    else begin
      GetMem(_dlnfo, DwarfSize);
      _dlnfoSize:= DwarfSize;
      f.Position:= DwarfOffset;
      f.Read(_dlnfo^, DwarfSize);
    end;
  end
  else
    ExtractDwarfLineInfoError:=
    {$ifdef unix}
      'The line info section not found in the ELF file.'
    {$else}
      'The line info section not found in the PE file.'
    {$endif}
    ;
  f.Free;
end;

  function align(addr, alignment: cardinal): cardinal;
  begin
    if addr = 0
      then result:=0
      else result:=(((addr - 1) div alignment) + 1) * alignment;
  end;

  function strpaddr(a: string; l: integer): string;
  begin
    result:=a;
    if l <= length(a) then exit;
    setlength(result, l);
    fillchar(result[length(a) + 1], l - length(a), 32);
  end;

  function strpaddl(a: string; l: integer): string;
  begin
    if l <= length(a) then exit(a);
    SetLength(result, l - length(a));
    fillchar(result[1], length(result), 32);
    result+= a;
  end;



  procedure BrutalStripFPC(ein, eout, dlnout: TStream; UseWriteLn: longbool);
  var
    elfid: string[4];
    zero: byte = 0;
    ct, cofftable: array of tcoffsechdr;
    necessary: array of boolean;
    i, j, n, sectpos, rmv: integer;
    dlil: integer = 0;
    p: pointer;
    ib: cardinal;
    CS: TCompressionStream;
    procedure advanceOut(pos: integer);
    begin
      if eout.size >= pos then eout.position:=pos
      else begin
        eout.position:= eout.size;
        repeat eout.write(zero, 1) until eout.size = pos;
      end;
    end;
  begin
    ExtractDwarfLineInfoError:= '';
    ein.position:=0;
    eout.position:=0;
    ein.read(elfid[1], 4);
    if elfid = #$7f'ELF' then begin
      ExtractDwarfLineInfoError:=('ELF format isn''t supported yet!');
      eout.CopyFrom(ein, ein.size);
//************************************** ДОДЕЛАТЬ!!!!!!!!!!!!!!!!!!!!!!!!
    end
    else begin
      ein.position:= 0;
      ein.Read(dosheader, sizeof(tdosheader));
      //removing the DOS crap:
      dosheader.e_lfarlc:=0;
      ein.position:= dosheader.e_lfanew;
      ein.Read(peheader, sizeof(peheader));
      if peheader.pemagic<>$4550 then begin
        ExtractDwarfLineInfoError:= 'Not a valid Portable Executable';
        Exit;
      end;

      SetLength(ct, peheader.NumberOfSections);
      SetLength(necessary, peheader.NumberOfSections);
      ein.read(ct[0], length(ct) * sizeof(tcoffsechdr));

      peheader.NumberOfSections:= 0;
      rmv:=0;

      for i:=0 to high(ct) do begin
        Necessary[i]:=false;
        for n:=0 to high(PENecessary)
          do Necessary[i]:= Necessary[i] or (cntostr(@ct[i].name[0]) = PENecessary[n]);
        if UseWriteLn then write('   ',
          strpaddr(cntostr(@ct[i].name[0]), 8), ' ',
          strpaddl(inttostr(ct[i].datalen div 1024), 4), 'K'
//,' flags', inttohex(ct[i].flags,8),' vsize:', ct[i].vsize,' rvaofs:',ct[i].rvaofs

          );
        if necessary[i] then inc(peheader.NumberOfSections)
        else begin
          if Assigned(dlnout) and (cntostr(@ct[i].name[0]) = pedlin)
          then begin
            dlil:= ct[i].datalen;
            if UseWriteLn then write(' - EXTRACTED');
            dlnout.position:= 0;
            ein.position:= ct[i].datapos;
            CS:= TCompressionStream.Create(clMax, dlnout);
            CS.write(ct[i].datalen, 4);
            CS.write(peheader.ImageBase, 4);
            CS.CopyFrom(ein, ct[i].datalen);
            CS.Free;
          end
          else
            if UseWriteLn then write(' - removed');
          inc(rmv, ct[i].datalen);
        end;
        writeln;
      end;

      // copying everything up to the PE header;
      ein.Position:=0;
      eout.position:=0;
      eout.CopyFrom(ein, dosheader.e_lfanew);


      eout.write(peheader, sizeof(peheader)); //solely to update the number of sections.

      sectpos:= eout.position;

      advanceOut(eout.position + (peheader.NumberOfSections * sizeof(tcoffsechdr)));

      for i:=0 to high(ct) do begin
        if not Necessary[i] then continue; //skip this unfortunate section
        SetLength(cofftable, length(cofftable) + 1);

        //add this section to the output file
        cofftable[high(cofftable)]:= ct[i];
        ein.position:= ct[i].datapos;

       if ct[i].datalen > 0 then begin
          advanceOut(align(eout.position, peheader.FileAlignment));
          cofftable[high(cofftable)].datapos:= eout.position;
          eout.CopyFrom(ein, ct[i].datalen);
        end;
//with cofftable[high(cofftable)] do writeln(' --> ', cntostr(@name[0]), '  len= ', datalen, '  pos=',datapos);

      end;

      //with all the politically reliable sections written
      // we can write the section table.
      eout.position:= sectpos;
      eout.write(cofftable[0], length(cofftable) * sizeof(tcoffsechdr));
      if UseWriteLn then begin
        WriteLn('  total crap count: ', rmv div 1024,'K');
        WriteLn('  line info: ', dlil div 1024,'K, compressed to ',dlnout.size div 1024,'K');
      end;
    end;
  end;


  procedure InjectLineInfo(ein, dliin, eout: TStream; UseWriteLn: longbool);
  var
    elfid: string[4];
    zero: byte = 0;
    ct: array of tcoffsechdr;
    i, j, n, sectpos, rmv: integer;
    dlil: integer = 0;
    p: pointer;
    ib, maxrva, maxrvl : cardinal;
    procedure advanceOut(pos: integer);
    begin
      if eout.size >= pos then eout.position:=pos
      else begin
        eout.position:= eout.size;
        repeat eout.write(zero, 1) until eout.size = pos;
      end;
    end;
  begin
    ExtractDwarfLineInfoError:= '';
    ein.position:=0;
    eout.position:=0;
    ein.read(elfid[1], 4);
    if elfid = #$7f'ELF' then begin
      ExtractDwarfLineInfoError:=('ELF format isn''t supported yet!');
      eout.CopyFrom(ein, ein.size);
//************************************** ДОДЕЛАТЬ!!!!!!!!!!!!!!!!!!!!!!!!
    end
    else begin
      ein.position:= 0;
      ein.Read(dosheader, sizeof(tdosheader));
      //removing the DOS crap:
      dosheader.e_lfarlc:=0;
      ein.position:= dosheader.e_lfanew;
      ein.Read(peheader, sizeof(peheader));
      if peheader.pemagic<>$4550 then begin
        ExtractDwarfLineInfoError:= 'Not a valid Portable Executable';
        Exit;
      end;

      SetLength(ct, peheader.NumberOfSections);
      ein.read(ct[0], length(ct) * sizeof(tcoffsechdr));
      SetLength(ct, length(ct) + 1);

      peheader.NumberOfSections:= length(ct);

      // copying everything up to the PE header;
      ein.Position:=0;
      eout.position:=0;
      eout.CopyFrom(ein, dosheader.e_lfanew);

      eout.write(peheader, sizeof(peheader)); //solely to update the number of sections.

      sectpos:= eout.position;

      advanceOut(eout.position + (peheader.NumberOfSections * sizeof(tcoffsechdr)));

      maxrva:=0;
      for i:=0 to high(ct) - 1 do begin
        ein.position:= ct[i].datapos;
        if ct[i].datalen > 0 then begin
          advanceOut(align(eout.position, peheader.FileAlignment));
          ct[i].datapos:= eout.position;
          eout.CopyFrom(ein, ct[i].datalen);
          if ct[i].rvaofs > maxrva then maxrva:= ct[i].rvaofs + ct[i].vsize;
        end;
      end;
      FillChar(ct[high(ct)], sizeof(tcoffsechdr), 0);
      with ct[high(ct)] do begin
        datalen:= dliin.Size;
        advanceOut(align(eout.position, peheader.FileAlignment));
        datapos:= eout.position;
        dliin.position:=0;
        eout.CopyFrom(dliin, datalen);
        move(ZPEDlin[1], name[0], 8);
        flags:= $02100800; //do not load
        rvaofs:=align(maxrva, peheader.SectionAlignment);
//        peheader.
      end;

      if UseWriteln then
        for i:=0 to high(ct) do
          WriteLn('   ',
            strpaddr(cntostr(@ct[i].name[0]), 8), ' ',
            strpaddl(inttostr(ct[i].datalen div 1024), 4), 'K'
            //,' pos', strpaddl(inttostr(ct[i].datapos), 7)
            );


      // write the section table.
      eout.position:= sectpos;
      eout.write(ct[0], length(ct) * sizeof(tcoffsechdr));
    end;
  end;
{$endif}
end.

