paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-05 20:48:06 +02:00
Code Issues Packages Projects Releases Wiki Activity
59e307ec2e
fpc/compiler/machoutils.pas
pierre 828a248287 Systematically include fpcdefs.inc at sart of all units used by compiler 
git-svn-id: trunk@42322 -
2019-07-03 13:35:05 +00:00

1469 lines
43 KiB
ObjectPascal
Raw Blame History

{
Copyright (c) 2009-2010 by Dmitry Boyarintsev
Contains utility routines and types for handling mach-o structure and types.
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
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. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
****************************************************************************
}
unit machoutils;
{$i fpcdefs.inc}
{$h+}
interface
uses
macho;
type
TRawWriter=class(TObject)
public
procedure WriteRaw(const data; datasize: Integer); virtual; abstract;
end;
TRawReader=class(TObject)
public
function ReadRaw(var data; datasize: Integer): Integer; virtual; abstract;
function Seek(pos: qword): Boolean; virtual; abstract;
function ReadPos: qword; virtual; abstract;
end;
TMachHeader=record
cputype : cpu_type_t;
cpusubtype : cpu_subtype_t;
filetype : longword;
ncmds : longword;
sizeofcmds : longword;
flags : longword;
end;
TSegmentName=string[16];
TSectionName=TSegmentName;
TMachoSegment=record
segname : TSegmentName;
vmaddr : qword;
vmsize : qword;
fileoff : qword;
filesize : qword;
maxprot : vm_prot_t;
initprot : vm_prot_t;
nsects : longword;
flags : longword;
end;
TMachoSection=record
sectname : TSectionName;
segname : TSegmentName;
addr : uint64_t;
size : uint64_t;
offset : uint32_t;
align : uint32_t;
reloff : uint32_t;
nreloc : uint32_t;
flags : uint32_t;
indirectIndex : Integer; // reserved1 for LAZY and NON_LAZY pointers
stubSize : Integer; // reserved2 for S_SYMBOL_STUBS
end;
TMachoRoutine=record
init_address : uint64_t; { address of initialization routine }
init_module : uint64_t; { index into the module table that }
end;
{ TMachoWriter }
TMachoWriter=class(TObject)
private
fwriter : TRawWriter;
fown : Boolean;
protected
public
constructor Create(ARawWriter: TRawWriter; AllowFreeWriter: Boolean);
destructor Destroy; override;
{ non platform specific writer }
procedure WriteData(const data; dataSize: Integer);
procedure WriteUint8(i: uint8_t);
{ endian specific writer }
procedure WriteUint16(i: uint16_t); virtual; abstract;
procedure WriteUint32(i: uint32_t); virtual; abstract;
procedure WriteUint64(i: uint64_t); virtual; abstract;
{ endian and ptr-size specific writer }
procedure WritePtr(ofs: QWord); virtual; abstract; // ptr is 32 bit for 32-bit platforms
{ macro utility methods }
procedure WriteHeader(const hdr: TMachHeader); virtual; abstract;
procedure WriteSegmentCmd(const seg: TMachoSegment; cmdSize: LongWord); virtual; abstract;
procedure WriteSection(const sec: TMachoSection); virtual; abstract;
procedure WriteRoutineCmd(const rt: TMachoRoutine); virtual; abstract;
procedure WriteLoadCommand(const cmd: load_command); virtual; abstract; overload;
procedure WriteLoadCommand(cmd, cmdsize: Integer); overload;
procedure WriteRelocation(const ri: relocation_info); virtual; abstract;
procedure WriteScatterReloc(const ri: scattered_relocation_info); virtual; abstract;
procedure WriteNList(const list: nlist_64); virtual; abstract;
end;
{ TLE32MachoWriter }
TLE32MachoWriter=class(TMachoWriter)
public
procedure WriteUint16(i: uint16_t); override;
procedure WriteUint32(i: uint32_t); override;
procedure WriteUint64(i: uint64_t); override;
procedure WritePtr(ofs: QWord); override;
procedure WriteHeader(const hdr: TMachHeader); override;
procedure WriteSegmentCmd(const seg: TMachoSegment; ACmdSize: LongWord); override;
procedure WriteSection(const sec: TMachoSection); override;
procedure WriteRoutineCmd(const rt: TMachoRoutine); override;
procedure WriteLoadCommand(const cmd: load_command); override;
procedure WriteRelocation(const ri: relocation_info); override;
procedure WriteScatterReloc(const ri: scattered_relocation_info); override;
procedure WriteNList(const list: nlist_64); override;
end;
{ TLE64MachoWriter }
TLE64MachoWriter=class(TLE32MachoWriter)
public
procedure WritePtr(ofs: QWord); override;
procedure WriteHeader(const hdr: TMachHeader); override;
procedure WriteSegmentCmd(const seg: TMachoSegment; acmdSize: LongWord); override;
procedure WriteSection(const sec: TMachoSection); override;
procedure WriteRoutineCmd(const rt: TMachoRoutine); override;
procedure WriteNList(const list: nlist_64); override;
end;
{ TBE32MachoWriter }
TBE32MachoWriter=class(TMachoWriter)
public
procedure WriteUint16(i: uint16_t); override;
procedure WriteUint32(i: uint32_t); override;
procedure WriteUint64(i: uint64_t); override;
procedure WritePtr(ofs: QWord); override;
procedure WriteHeader(const hdr: TMachHeader); override;
procedure WriteSegmentCmd(const seg: TMachoSegment; acmdSize: LongWord); override;
procedure WriteSection(const sec: TMachoSection); override;
procedure WriteRoutineCmd(const rt: TMachoRoutine); override;
procedure WriteLoadCommand(const cmd: load_command); override;
procedure WriteRelocation(const ri: relocation_info); override;
procedure WriteScatterReloc(const ri: scattered_relocation_info); override;
procedure WriteNList(const list: nlist_64); override;
end;
{ TBE64MachoWriter }
TBE64MachoWriter=class(TBE32MachoWriter)
public
procedure WritePtr(ofs: QWord); override;
procedure WriteHeader(const hdr: TMachHeader); override;
procedure WriteSegmentCmd(const seg: TMachoSegment; acmdSize: LongWord); override;
procedure WriteSection(const sec: TMachoSection); override;
procedure WriteRoutineCmd(const rt: TMachoRoutine); override;
procedure WriteNList(const list: nlist_64); override;
end;
{ TLEMachoStructConverter }
{ converter for Little-endian structures to Host }
TLEMachoStructConverter = class(TObject)
public
procedure ConvertMachoHeader(const mh: mach_header; var hdr: TMachHeader); virtual;
procedure ConvertMachoHeader64(const mh: mach_header_64; var hdr: TMachHeader); virtual;
procedure ConvertLoadCommand(var cmd: load_command); virtual;
procedure ConvertSegment(const segcmd: segment_command; var segment: TMachoSegment); virtual;
procedure ConvertSegment64(const segcmd: segment_command_64; var segment: TMachoSegment); virtual;
procedure ConvertSection(const sec: section; var section: TMachoSection); virtual;
procedure ConvertSection64(const sec: section_64; var section: TMachoSection); virtual;
procedure ConvertUInt16(var v: Word); virtual;
procedure ConvertUInt32(var v: LongWord); virtual;
procedure ConvertUInt64(var v: qWord); virtual;
end;
{ converter for Big-endian structures to Host }
TBEMachoStructConverter = class(TLEMachoStructConverter);
{common}
TMachoStructConverter = TLEMachoStructConverter;
{ TMachoReader }
TMachoReader=class(TObject)
private
fReader : TRawReader;
HdrOfs : qword;
fCnv : TMachoStructConverter;
fHdr : TMachHeader;
is64 : Boolean;
cmdofs : array of qword;
cmds : array of load_command;
protected
function IntReadStruct: Boolean;
public
constructor Create(ARawReader: TRawReader; StartOfs: QWord=0);
function ReadHeader(var hdr: TMachHeader): Boolean;
function ReadCommandID(index: LongWord; var cmd: load_command): Boolean;
function GetCmdOfs(index: LongWord): qword;
function ReadSegmentCommand(cmdindex: LongWord; var segment: TMachoSegment): Boolean;
function ReadSection(segindex, secindex: LongWord; var machsection: TMachoSection): Boolean;
function ReadSymTabCmd(var symcmd: symtab_command): Boolean;
function ReadUInt32(var v: LongWord): Boolean;
function ReadData(var data; dataSize: Integer): Integer;
{todo: ReadNList - using index of symbol, instead of file offset?}
function GetNListSize: Integer;
function ReadNList(fileofs: qword; var nsym: nlist_64): Boolean;
procedure Seek(apos: qword);
end;
const
seg_TEXT : TSegmentName = '__TEXT';
seg_DATA : TSegmentName = '__DATA';
seg_OBJC : TSegmentName = '__OBJC';
seg_IMPORT : TSegmentName = '__IMPORT';
seg_DWARF : TSegmentName = '__DWARF';
function AllocMachoWriter(cputarget: cpu_type_t; ARawWriter: TRawWriter; AllowFreeWriter: Boolean): TMachoWriter;
function sizeMachHeader(cputarget: cpu_type_t): integer;
function sizeSegment(cputarget: cpu_type_t): integer;
function sizeSection(cputarget: cpu_type_t): integer;
function sizeNList(cputarget: cpu_type_t): integer;
function AlignAddr(cputarget: cpu_type_t; addr: qword): qword;
procedure InitSegment(var seg: TMachoSegment);
function MakeSectionName(const segName, secName: shortstring): shortstring;
function GetSegmentSectionName(const objSecName: shortstring; var segName, secName: shortstring): shortstring;
function GetSectionFlags(const segName, secName: shortstring): LongWord;
type
TRelocInfoLength = (ril_byte = 0, ril_word = 1, ril_long = 2, ril_quad = 3);
procedure RelocInfo(addr, symnum, reltype: integer; len: TRelocInfoLength; pcrel, extern: Boolean; var info: relocation_info);
procedure ScatterRelocInfo(value, addr, reltype: integer; len: TRelocInfoLength; pcrel: Boolean; var info: scattered_relocation_info);
function GetReserved1(const macho: TMachoSection): integer;
function GetReserved2(const macho: TMachoSection): integer;
function GetStubSize(cputarget: Integer; Pic: Boolean): Integer;
function MachoAlign(al: integer): integer;
implementation
function MachoAlign(al: integer): integer;
begin
Result:=0;
al:=al shr 1;
while al>0 do
begin
inc(Result);
al:=al shr 1;
end;
end;
function AllocConverter(magic: LongWord): TMachoStructConverter;
begin
{$ifdef ENDIAN_BIG}
if magic=MH_MAGIC then
Result:=TBEMachoStructConverter.Create
else
Result:=TLEMachoStructConverter.Create;
{$else}
if magic=MH_MAGIC then
Result:=TLEMachoStructConverter.Create
else
Result:=TBEMachoStructConverter.Create;
{$endif}
end;
{result values are used from aggas.pas, see TGNUAssembler.WriteSection }
function GetStubSize(cputarget: Integer; Pic: Boolean): Integer;
begin
case cputarget of
CPU_TYPE_I386, CPU_TYPE_X86_64:
Result:=5;
CPU_TYPE_POWERPC, CPU_TYPE_POWERPC64:
if Pic then
Result:=32
else
Result:=16;
CPU_TYPE_ARM:
if Pic then
Result:=16
else
Result:=12;
else
Result:=-1;
end;
end;
function GetReserved1(const macho: TMachoSection): integer;
begin
case macho.flags and SECTION_TYPE of
S_NON_LAZY_SYMBOL_POINTERS, S_LAZY_SYMBOL_POINTERS:
Result:=macho.indirectIndex;
else
Result:=0;
end;
end;
function GetReserved2(const macho: TMachoSection): integer;
begin
case macho.flags and SECTION_TYPE of
S_SYMBOL_STUBS:
Result:=macho.stubSize
else
Result:=0;
end;
end;
procedure RelocInfo(addr, symnum, reltype: integer; len: TRelocInfoLength; pcrel, extern: Boolean; var info: relocation_info);
{$ifdef ENDIAN_BIG}
const
relbit : array [Boolean] of Integer = (0, 1 shl 7);
extbit : array [Boolean] of Integer = (0, 1 shl 4);
ri_len_mask : array [TRelocInfoLength] of Integer = (0 shl 5, 1 shl 5, 2 shl 5, 3 shl 5);
begin
info.r_address:=addr;
info.r_info:=((symnum and $FFFFFF) shl 8) or // r_symbolnum:24
relbit[pcrel] or // r_pcrel:1;
ri_len_mask[len] or // r_length:2;
extbit[extern] or // r_extern:1;
(reltype and $F); // r_type:4;
end;
{$else}
const
relbit : array [Boolean] of Integer = (0, 1 shl 24);
extbit : array [Boolean] of Integer = (0, 1 shl 27);
ri_len_mask : array [TRelocInfoLength] of Integer = (0 shl 25, 1 shl 25, 2 shl 25, 3 shl 25);
begin
info.r_address:=addr;
info.r_info:=(symnum and $FFFFFF) or // r_symbolnum:24
relbit[pcrel] or // r_pcrel:1;
extbit[extern] or // r_length:2;
ri_len_mask[len] or // r_extern:1;
(reltype shl 28); // r_type:4;
end;
{$endif}
const
si_len_mask: array [TRelocInfoLength] of Integer = (0 shl 28, 1 shl 28, 2 shl 28, 3 shl 28);
si_type_ofs = 24;
si_pcrel_bit = 1 shl 30;
si_scatter_bit = 1 shl 31;
si_addr_ofs = 0;
procedure ScatterRelocInfo(value, addr, reltype: integer; len: TRelocInfoLength; pcrel: Boolean; var info: scattered_relocation_info);
const
relbit : array [Boolean] of Integer = (0, si_pcrel_bit);
begin
// big endian
info.r_info:=si_scatter_bit or // r_scattered:1, /* 1=scattered, 0=non-scattered (see above) */
relbit[pcrel] or // r_pcrel:1, /* was relocated pc relative already */
si_len_mask[len] or // r_length:2, /* 0=byte, 1=word, 2=long, 3=quad */
((reltype and $F) shl si_type_ofs) or // r_type:4, /* if not 0, machine specific relocation type */
((addr and $FFFFFF) shl si_addr_ofs); // r_address:24; /* offset in the section to what is being relocated */}
info.r_value:=value;
// little endian
// r_address:24, /* offset in the section to what is being relocated */
// r_type:4, /* if not 0, machine specific relocation type */
// r_length:2, /* 0=byte, 1=word, 2=long, 3=quad */
// r_pcrel:1, /* was relocated pc relative already */
// r_scattered:1; /* 1=scattered, 0=non-scattered (see above) */ *}
end;
function GetSectionFlags(const segName, secName: shortstring): LongWord;
begin
Result:=0;
if segName = seg_DATA then
begin
if secName = '__nl_symbol_ptr' then
Result:=Result or S_NON_LAZY_SYMBOL_POINTERS
else if secName = '__la_symbol_ptr' then
Result:=Result or S_LAZY_SYMBOL_POINTERS
else if secName = '__common' then
Result:=Result or S_ZEROFILL
end
else if segName = seg_TEXT then
begin
if (secName = '__text') then
Result:=Result or S_ATTR_PURE_INSTRUCTIONS or S_ATTR_SOME_INSTRUCTIONS
else if secName = '__textcoal_nt' then
Result:=Result or S_ATTR_PURE_INSTRUCTIONS or S_ATTR_SOME_INSTRUCTIONS or S_COALESCED
else if secName = '.fpc' then
Result:=Result or S_ATTR_NO_DEAD_STRIP
else if secName = '__cstring' then
Result:=Result or S_CSTRING_LITERALS;
end
else if (segName = seg_IMPORT) then
begin
if (secName = '__jump_table') then
Result:=Result or S_SYMBOL_STUBS or S_ATTR_SELF_MODIFYING_CODE or S_ATTR_SOME_INSTRUCTIONS
end
else if (segName=seg_OBJC) then
begin
Result:=S_ATTR_NO_DEAD_STRIP;
if secName='__message_refs' then
Result:=Result or S_ATTR_NO_DEAD_STRIP or S_LITERAL_POINTERS
else if secName='__cls_refs' then
Result:=Result or S_ATTR_NO_DEAD_STRIP or S_LITERAL_POINTERS;
end;
end;
function MakeSectionName(const segName, secName: shortstring): shortstring;
begin
if segName = '' then
Result:=secName
else
Result:=segName+' '+secName;
end;
function GetSegmentSectionName(const objSecName: shortstring; var segName, secName: shortstring): shortstring;
var
i : integer;
begin
i:=Pos(' ', objSecName);
if i>0 then
begin
segName:=copy(objsecName, 1, i-1);
secName:=copy(objsecName, i+1, length(objsecName)-i);
end
else
begin
segName:='';
secName:=objSecName;
end;
Result:=objSecName;
end;
procedure InitSegment(var seg: TMachoSegment);
begin
FillChar(seg, sizeof(seg), 0);
seg.initprot:=VM_PROT_ALL;
seg.maxprot:=VM_PROT_ALL;
end;
const
is64MachHeaderSize : array [Boolean] of Integer = ( sizeof(mach_header), sizeof(mach_header_64));
is64SectionSize : array [Boolean] of Integer = ( sizeof(section), sizeof(section_64));
is64SegmentSize : array [Boolean] of Integer = ( sizeof(segment_command), sizeof(segment_command_64));
is64NListSize : array [Boolean] of Integer = (sizeof(nlist), sizeof(nlist_64));
function AlignAddr(cputarget: cpu_type_t; addr: qword): qword;
var
md : array [Boolean] of integer = (4, 8);
p : PtrUInt;
begin
p:=addr;
p:=align(p, md[cputarget and CPU_ARCH_ABI64 > 0]);
Result:=qword(p);
end;
function sizeMachHeader(cputarget: cpu_type_t): integer;
begin
Result:=is64MachHeaderSize[ cputarget and CPU_ARCH_ABI64 > 0];
end;
function sizeSegment(cputarget: cpu_type_t): integer;
begin
Result:=is64SegmentSize[ cputarget and CPU_ARCH_ABI64 > 0];
end;
function sizeSection(cputarget: cpu_type_t): integer;
begin
Result:=is64SectionSize[ cputarget and CPU_ARCH_ABI64 > 0];
end;
function sizeNList(cputarget: cpu_type_t): integer;
begin
Result:=is64NlistSize[ cputarget and CPU_ARCH_ABI64 > 0];
end;
function AllocMachoWriter(cputarget: cpu_type_t; ARawWriter: TRawWriter; AllowFreeWriter: Boolean): TMachoWriter;
begin
case cputarget of
CPU_TYPE_I386,
CPU_TYPE_ARM: Result:=TLE32MachoWriter.Create(ARawWriter, AllowFreeWriter);
CPU_TYPE_X86_64: Result:=TLE64MachoWriter.Create(ARawWriter, AllowFreeWriter);
CPU_TYPE_POWERPC: Result:=TBE32MachoWriter.Create(ARawWriter, AllowFreeWriter);
CPU_TYPE_POWERPC64: Result:=TBE64MachoWriter.Create(ARawWriter, AllowFreeWriter);
else
begin
if AllowFreeWriter then
ARawWriter.Free;
Result:=nil;
end;
end;
end;
{ TMachoWriter }
procedure TMachoWriter.WriteData(const data; dataSize: Integer);
begin
if not assigned(fwriter) then
Exit;
fwriter.WriteRaw(data, dataSize);
end;
procedure TMachoWriter.WriteUint8(i: uint8_t);
begin
WriteData(i, sizeof(i));
end;
procedure TMachoWriter.WriteLoadCommand(cmd, cmdsize: Integer);
var
m : load_command;
begin
m.cmd:=cmd;
m.cmdsize:=cmdsize;
WriteLoadCommand(m);
end;
constructor TMachoWriter.Create(ARawWriter: TRawWriter; AllowFreeWriter: Boolean);
begin
inherited Create;
fwriter:=ARawWriter;
fown:=AllowFreeWriter;
end;
destructor TMachoWriter.Destroy;
begin
if fown then
fwriter.Free;
inherited Destroy;
end;
{ TLE32MachoWriter }
procedure TLE32MachoWriter.WriteHeader(const hdr: TMachHeader);
var
m : mach_header;
begin
with m do
begin
magic:=NtoLE(MH_MAGIC);
cputype:=NtoLE(hdr.cputype);
cpusubtype:=NtoLE(hdr.cpusubtype);
filetype:=NtoLE(hdr.filetype);
ncmds:=NtoLE(hdr.ncmds);
sizeofcmds:=NtoLE(hdr.sizeofcmds);
flags:=NtoLE(hdr.flags);
end;
WriteData(m, sizeof(m));
end;
procedure TLE32MachoWriter.WriteSegmentCmd(const seg: TMachoSegment; ACmdSize: LongWord);
var
m : segment_command;
begin
with m do
begin
cmd:=NtoLE(LC_SEGMENT);
cmdsize:=NtoLE(ACmdSize);
segname:=seg.segname;
vmaddr:=NtoLE(uint32_t(seg.vmaddr));
vmsize:=NtoLE(uint32_t(seg.vmsize));
fileoff:=NtoLE(uint32_t(seg.fileoff));
filesize:=NtoLE(uint32_t(seg.filesize));
maxprot:=NtoLE(seg.maxprot);
initprot:=NtoLE(seg.initprot);
nsects:=NtoLE(seg.nsects);
flags:=NtoLE(seg.flags);
end;
WriteData(m, sizeof(m));
end;
procedure TLE32MachoWriter.WriteSection(const sec: TMachoSection);
var
m : section;
begin
FillChar(m, sizeof(m), 0);
with m do
begin
sectname:=sec.sectname;
segname:=sec.segname;
addr:=NtoLE(sec.addr);
size:=NtoLE(sec.size);
offset:=NtoLE(sec.offset);
align:=NtoLE(sec.align);
reloff:=NtoLE(sec.reloff);
nreloc:=NtoLE(sec.nreloc);
flags:=NtoLE(sec.flags);
reserved1:=NtoLE( GetReserved1(sec));
reserved2:=NtoLE( GetReserved2(sec));
end;
WriteData(m, sizeof(m));
end;
procedure TLE32MachoWriter.WriteRoutineCmd(const rt: TMachoRoutine);
var
m : routines_command;
begin
FillChar(m, sizeof(m), 0);
with m do
begin
cmd:=NtoLE(LC_ROUTINES);
cmdsize:=NtoLE(sizeof(m));
init_address:=NtoLE(rt.init_address);
init_module:=NtoLE(rt.init_module);
end;
WriteData(m, sizeof(m));
end;
procedure TLE32MachoWriter.WriteLoadCommand(const cmd: load_command);
var
m : load_command;
begin
m.cmd:=NtoLE(cmd.cmd);
m.cmdsize:=NtoLE(cmd.cmdsize);
WriteData(m, sizeof(m));
end;
procedure TLE32MachoWriter.WriteRelocation(const ri: relocation_info);
var
m : relocation_info;
begin
m.r_address:=NtoLE(ri.r_address);
m.r_info:=NtoLE(ri.r_info);
WriteData(m, sizeof(m));
end;
procedure TLE32MachoWriter.WriteScatterReloc(const ri: scattered_relocation_info);
var
m : LongWord;
begin
m:=LongWord(ri.r_info);
WriteUint32(NtoLE(m));
m:=LongWord(ri.r_value);
WriteUint32(NtoLE(m));
end;
procedure TLE32MachoWriter.WriteNList(const list: nlist_64);
var
m : nlist;
begin
m.n_un.n_strx:=NtoLe(list.n_un.n_strx);
m.n_type:=NtoLe(list.n_type);
m.n_sect:=NtoLe(list.n_sect);
m.n_desc:=NtoLe(list.n_desc);
m.n_value:=NtoLe(list.n_value);
WriteData(m, sizeof(m));
end;
procedure TLE32MachoWriter.WriteUint16(i: uint16_t);
var
m: uint16_t;
begin
m:=NtoLE(i);
WriteData(m, sizeof(m));
end;
procedure TLE32MachoWriter.WriteUint32(i: uint32_t);
var
m: uint32_t;
begin
m:=NtoLE(i);
WriteData(m, sizeof(m));
end;
procedure TLE32MachoWriter.WriteUint64(i: uint64_t);
var
m: uint64_t;
begin
m:=NtoLE(i);
WriteData(m, sizeof(m));
end;
procedure TLE32MachoWriter.WritePtr(ofs: QWord);
var
m: uint32_t;
begin
m:=NtoLE(ofs);
WriteData(m, sizeof(m));
end;
{ TLE64MachoWriter }
procedure TLE64MachoWriter.WritePtr(ofs: QWord);
var
m : uint64_t;
begin
m:=NtoLE(ofs);
Writedata(m, sizeof(m));
end;
procedure TLE64MachoWriter.WriteHeader(const hdr: TMachHeader);
var
m : mach_header_64;
begin
with m do
begin
magic:=NtoLE(MH_MAGIC_64);
cputype:=NtoLE(hdr.cputype);
cpusubtype:=NtoLE(hdr.cpusubtype);
filetype:=NtoLE(hdr.filetype);
ncmds:=NtoLE(hdr.ncmds);
sizeofcmds:=NtoLE(hdr.sizeofcmds);
flags:=NtoLE(hdr.flags);
reserved:=0;
end;
WriteData(m, sizeof(m));
end;
procedure TLE64MachoWriter.WriteSegmentCmd(const seg: TMachoSegment; acmdSize: LongWord);
var
m : segment_command_64;
begin
with m do
begin
cmd:=NtoLE(LC_SEGMENT_64);
cmdsize:=NtoLE(acmdSize);
segname:=seg.segname;
vmaddr:=NtoLE(seg.vmaddr);
vmsize:=NtoLE(seg.vmsize);
fileoff:=NtoLE(seg.fileoff);
filesize:=NtoLE(seg.filesize);
maxprot:=NtoLE(seg.maxprot);
initprot:=NtoLE(seg.initprot);
nsects:=NtoLE(seg.nsects);
flags:=NtoLE(seg.flags);
end;
WriteData(m, sizeof(m));
end;
procedure TLE64MachoWriter.WriteSection(const sec: TMachoSection);
var
m : section_64;
begin
FillChar(m, sizeof(m), 0);
with m do
begin
sectname:=sec.sectname;
segname:=sec.segname;
addr:=NtoLE(sec.addr);
size:=NtoLE(sec.size);
offset:=NtoLE(sec.offset);
align:=NtoLE(sec.align);
reloff:=NtoLE(sec.reloff);
nreloc:=NtoLE(sec.nreloc);
flags:=NtoLE(sec.flags);
reserved1:=NtoLE( GetReserved1(sec));
reserved2:=NtoLE( GetReserved2(sec));
end;
WriteData(m, sizeof(m));
end;
procedure TLE64MachoWriter.WriteRoutineCmd(const rt: TMachoRoutine);
var
m : routines_command_64;
begin
FillChar(m, sizeof(m), 0);
with m do
begin
cmd:=NtoLE(LC_ROUTINES);
cmdsize:=NtoLE(sizeof(m));
init_address:=NtoLE(rt.init_address);
init_module:=NtoLE(rt.init_module);
end;
WriteData(m, sizeof(m));
end;
procedure TLE64MachoWriter.WriteNList(const list: nlist_64);
var
m : nlist_64;
begin
m.n_un.n_strx:=NtoLe(list.n_un.n_strx);
m.n_type:=NtoLe(list.n_type);
m.n_sect:=NtoLe(list.n_sect);
m.n_desc:=NtoLe(list.n_desc);
m.n_value:=NtoLe(list.n_value);
WriteData(m, sizeof(m));
end;
{ TBE32MachoWriter }
procedure TBE32MachoWriter.WriteHeader(const hdr: TMachHeader);
var
m : mach_header;
begin
with m do
begin
magic:=NtoBE(MH_MAGIC);
cputype:=NtoBE(hdr.cputype);
cpusubtype:=NtoBE(hdr.cpusubtype);
filetype:=NtoBE(hdr.filetype);
ncmds:=NtoBE(hdr.ncmds);
sizeofcmds:=NtoBE(hdr.sizeofcmds);
flags:=NtoBE(hdr.flags);
end;
WriteData(m, sizeof(m));
end;
procedure TBE32MachoWriter.WriteSegmentCmd(const seg: TMachoSegment; acmdSize: LongWord);
var
m : segment_command;
begin
with m do
begin
cmd:=NtoBE(LC_SEGMENT);
cmdsize:=NtoBE(acmdSize);
segname:=seg.segname;
vmaddr:=NtoBE(uint32_t(seg.vmaddr));
vmsize:=NtoBE(uint32_t(seg.vmsize));
fileoff:=NtoBE(uint32_t(seg.fileoff));
filesize:=NtoBE(uint32_t(seg.filesize));
maxprot:=NtoBE(seg.maxprot);
initprot:=NtoBE(seg.initprot);
nsects:=NtoBE(seg.nsects);
flags:=NtoBE(seg.flags);
end;
WriteData(m, sizeof(m));
end;
procedure TBE32MachoWriter.WriteSection(const sec: TMachoSection);
var
m : section;
begin
FillChar(m, sizeof(m), 0);
with m do
begin
sectname:=sec.sectname;
segname:=sec.segname;
addr:=NtoBE(sec.addr);
size:=NtoBE(sec.size);
offset:=NtoBE(sec.offset);
align:=NtoBE(sec.align);
reloff:=NtoBE(sec.reloff);
nreloc:=NtoBE(sec.nreloc);
flags:=NtoBE(sec.flags);
reserved1:=NtoBE( GetReserved1(sec));
reserved2:=NtoBE( GetReserved2(sec));
end;
WriteData(m, sizeof(m));
end;
procedure TBE32MachoWriter.WriteRoutineCmd(const rt: TMachoRoutine);
var
m : routines_command;
begin
FillChar(m, sizeof(m), 0);
with m do
begin
cmd:=NtoBE(LC_ROUTINES);
cmdsize:=NtoBE(sizeof(m));
init_address:=NtoBE(rt.init_address);
init_module:=NtoBE(rt.init_module);
end;
WriteData(m, sizeof(m));
end;
procedure TBE32MachoWriter.WriteLoadCommand(const cmd: load_command);
var
m : load_command;
begin
m.cmd:=NtoBE(cmd.cmd);
m.cmdsize:=NtoBE(cmd.cmdsize);
WriteData(m, sizeof(m));
end;
procedure TBE32MachoWriter.WriteRelocation(const ri: relocation_info);
var
m : relocation_info;
begin
m.r_address:=NtoBE(ri.r_address);
m.r_info:=NtoBE(ri.r_info);
WriteData(m, sizeof(m));
end;
procedure TBE32MachoWriter.WriteScatterReloc(const ri: scattered_relocation_info);
var
m : LongWord;
begin
m:=LongWord(ri.r_info);
WriteUint32(NtoBE(m));
m:=LongWord(ri.r_value);
WriteUint32(NtoBE(m));
end;
procedure TBE32MachoWriter.WriteNList(const list: nlist_64);
var
m : nlist;
begin
m.n_un.n_strx:=NtoBe(list.n_un.n_strx);
m.n_type:=NtoBe(list.n_type);
m.n_sect:=NtoBe(list.n_sect);
m.n_desc:=NtoBe(list.n_desc);
m.n_value:=NtoBe(list.n_value);
WriteData(m, sizeof(m));
end;
procedure TBE32MachoWriter.WriteUint16(i: uint16_t);
var
m: uint16_t;
begin
m:=NtoBE(i);
WriteData(m, sizeof(m));
end;
procedure TBE32MachoWriter.WriteUint32(i: uint32_t);
var
m: uint32_t;
begin
m:=NtoBE(i);
WriteData(m, sizeof(m));
end;
procedure TBE32MachoWriter.WriteUint64(i: uint64_t);
var
m: uint64_t;
begin
m:=NtoBE(i);
WriteData(m, sizeof(m));
end;
procedure TBE32MachoWriter.WritePtr(ofs: QWord);
var
m: uint32_t;
begin
m:=NtoBE(ofs);
WriteData(m, sizeof(m));
end;
{ TBE64MachoWriter }
procedure TBE64MachoWriter.WritePtr(ofs: QWord);
var
m : uint64_t;
begin
m:=NtoBE(ofs);
Writedata(m, sizeof(m));
end;
procedure TBE64MachoWriter.WriteHeader(const hdr: TMachHeader);
var
m : mach_header_64;
begin
with m do
begin
magic:=NtoBE(MH_MAGIC_64);
cputype:=NtoBE(hdr.cputype);
cpusubtype:=NtoBE(hdr.cpusubtype);
filetype:=NtoBE(hdr.filetype);
ncmds:=NtoBE(hdr.ncmds);
sizeofcmds:=NtoBE(hdr.sizeofcmds);
flags:=NtoBE(hdr.flags);
reserved:=0;
end;
WriteData(m, sizeof(m));
end;
procedure TBE64MachoWriter.WriteSegmentCmd(const seg: TMachoSegment; acmdSize: LongWord);
var
m : segment_command_64;
begin
with m do
begin
cmd:=NtoBE(LC_SEGMENT_64);
cmdsize:=NtoBE(acmdSize);
segname:=seg.segname;
vmaddr:=NtoBE(seg.vmaddr);
vmsize:=NtoBE(seg.vmsize);
fileoff:=NtoBE(seg.fileoff);
filesize:=NtoBE(seg.filesize);
maxprot:=NtoBE(seg.maxprot);
initprot:=NtoBE(seg.initprot);
nsects:=NtoBE(seg.nsects);
flags:=NtoBE(seg.flags);
end;
WriteData(m, sizeof(m));
end;
procedure TBE64MachoWriter.WriteSection(const sec: TMachoSection);
var
m : section_64;
begin
FillChar(m, sizeof(m), 0);
with m do
begin
sectname:=sec.sectname;
segname:=sec.segname;
addr:=NtoBE(sec.addr);
size:=NtoBE(sec.size);
offset:=NtoBE(sec.offset);
align:=NtoBE(sec.align);
reloff:=NtoBE(sec.reloff);
nreloc:=NtoBE(sec.nreloc);
flags:=NtoBE(sec.flags);
reserved1:=NtoBE( GetReserved1(sec));
reserved2:=NtoBE( GetReserved2(sec));
end;
WriteData(m, sizeof(m));
end;
procedure TBE64MachoWriter.WriteRoutineCmd(const rt: TMachoRoutine);
var
m : routines_command_64;
begin
FillChar(m, sizeof(m), 0);
with m do
begin
cmd:=NtoBE(LC_ROUTINES);
cmdsize:=NtoBE(sizeof(m));
init_address:=NtoBE(rt.init_address);
init_module:=NtoBE(rt.init_module);
end;
WriteData(m, sizeof(m));
end;
procedure TBE64MachoWriter.WriteNList(const list: nlist_64);
var
m : nlist_64;
begin
m.n_un.n_strx:=NtoBe(list.n_un.n_strx);
m.n_type:=NtoBe(list.n_type);
m.n_sect:=NtoBe(list.n_sect);
m.n_desc:=NtoBe(list.n_desc);
m.n_value:=NtoBe(list.n_value);
WriteData(m, sizeof(m));
end;
{ TMachoReader }
constructor TMachoReader.Create(ARawReader: TRawReader; StartOfs: QWord=0);
begin
inherited Create;
fReader:=ARawReader;
hdrofs:=StartOfs;
end;
function TMachoReader.IntReadStruct: Boolean;
var
m : mach_header_64;
i : Integer;
p : qword;
begin
Result:=false;
if not fReader.Seek(hdrofs) then
Exit;
//todo:
fReader.ReadRaw(m, sizeof(mach_header_64));
fCnv:=AllocConverter(m.magic);
fCnv.ConvertMachoHeader(pmach_header(@m)^, fhdr);
is64:=fhdr.cputype and CPU_ARCH_ABI64>0;
Result:=true;
SetLength(cmds, fHdr.ncmds);
if fHdr.ncmds>0 then
begin
if is64 then
p:=sizeof(mach_header_64)
else
p:=sizeof(mach_header);
SetLength(cmdofs, fHdr.ncmds);
for i:=0 to fHdr.ncmds - 1 do
begin
cmdofs[i]:=p;
fReader.Seek(p);
fReader.ReadRaw(cmds[i], sizeof(cmds[i]));
fCnv.ConvertLoadCommand(cmds[i]);
inc(p, cmds[i].cmdsize);
end;
end;
end;
function TMachoReader.ReadHeader(var hdr: TMachHeader): Boolean;
begin
if not Assigned(fCnv) then
Result:=IntReadStruct
else
Result:=true;
hdr:=fhdr;
end;
function TMachoReader.ReadCommandID(index: LongWord; var cmd: load_command): Boolean;
begin
if not Assigned(fCnv) then
IntReadStruct;
Result:={(index>=0) and }(index<fHdr.ncmds);
if not Result then
Exit;
Result:=true;
cmd:=cmds[index];
end;
function TMachoReader.ReadSegmentCommand(cmdindex: LongWord; var segment: TMachoSegment): Boolean;
var
seg64 : segment_command_64;
seg32 : segment_command;
begin
if not Assigned(fCnv) then
IntReadStruct;
Result:={(cmdindex>=0) and }
(cmdindex<fHdr.ncmds) and
(cmds[cmdindex].cmd in [LC_SEGMENT, LC_SEGMENT_64]);
if Result then
begin
fReader.Seek(cmdofs[cmdindex]);
if is64 then
begin
Result:=fReader.ReadRaw(seg64, sizeof(seg64))=sizeof(seg64);
if Result then
fCnv.ConvertSegment64(seg64, segment);
end
else
begin
Result:=fReader.ReadRaw(seg32, sizeof(seg32))=sizeof(seg32);
if Result then
fCnv.ConvertSegment(seg32, segment);
end;
end;
end;
function TMachoReader.GetCmdOfs(index: LongWord): qword;
begin
if not Assigned(fCnv) then
IntReadStruct;
if {(index<0) or}
(index>=longword(length(cmdofs))) then
Result:=0
else
Result:=cmdofs[index];
end;
function TMachoReader.ReadSection(segindex, secindex: LongWord; var machsection: TMachoSection): Boolean;
var
ofs : qword;
is64bit : Boolean;
buf : array [0..sizeof(section_64)-1] of byte;
const
sectsize : array[Boolean] of LongWord = ( sizeof(macho.section), sizeof(macho.section_64));
segsize : array[Boolean] of LongWord = ( sizeof(macho.segment_command), sizeof(macho.segment_command_64));
begin
if not Assigned(fCnv) then
IntReadStruct;
Result:={(secindex>=0) and (segindex>=0) and }(segindex<fHdr.ncmds) and (cmds[segindex].cmd in [LC_SEGMENT, LC_SEGMENT_64]);
if not Result then
Exit;
is64bit:=cmds[segindex].cmd=LC_SEGMENT_64;
Result:=secindex<(cmds[segindex].cmdsize-segsize[is64bit]) div sectsize[is64bit];
if not Result then
Exit;
ofs:=cmdofs[segindex]+segsize[is64bit]+sectsize[is64]*secindex;
fReader.Seek(ofs);
fReader.ReadRaw(buf, segsize[is64bit]);
if is64bit then
fCnv.ConvertSection64( psection_64(@buf)^, machsection)
else
fCnv.ConvertSection( psection(@buf)^, machsection);
end;
function TMachoReader.ReadUInt32(var v: LongWord): Boolean;
begin
if not Assigned(fCnv) then
IntReadStruct;
Result:=Assigned(fCnv) and (fReader.ReadRaw(v, sizeof(v))=sizeof(v));
if Result then
fCnv.ConvertUint32(v);
end;
function TMachoReader.ReadData(var data; dataSize: Integer): Integer;
begin
Result:=fReader.ReadRaw(data, dataSize);
end;
function TMachoReader.GetNListSize: Integer;
begin
if is64 then
Result:=sizeof(nlist_64)
else
Result:=sizeof(nlist);
end;
function TMachoReader.ReadNList(fileofs: qword; var nsym: nlist_64): Boolean;
var
n32 : nlist;
begin
fReader.Seek(fileofs);
if is64 then
Result:=fReader.ReadRaw(nsym, sizeof(nlist_64))=sizeof(nlist_64)
else
begin
Result:=fReader.ReadRaw(n32, sizeof(nlist))=sizeof(nlist);
nsym.n_un.n_strx:=n32.n_un.n_strx;
nsym.n_desc:=n32.n_desc;
nsym.n_sect:=n32.n_sect;
nsym.n_type:=n32.n_type;
nsym.n_value:=n32.n_value;
end;
fCnv.ConvertUInt32(nsym.n_un.n_strx);
fCnv.ConvertUInt16(nsym.n_desc);
fCnv.ConvertUInt64(nsym.n_value);
end;
function TMachoReader.ReadSymTabCmd(var symcmd: symtab_command): Boolean;
var
i : Integer;
p : qword;
begin
if not Assigned(fCnv) then
IntReadStruct;
for i:=0 to length(cmds)-1 do
if cmds[i].cmd=LC_SYMTAB then
begin
p:=fReader.ReadPos;
fReader.Seek(cmdofs[i]);
fReader.ReadRaw(symcmd, sizeof(symcmd));
fCnv.ConvertUInt32(symcmd.cmd);
fCnv.ConvertUInt32(symcmd.cmdsize);
fCnv.ConvertUInt32(symcmd.symoff);
fCnv.ConvertUInt32(symcmd.nsyms);
fCnv.ConvertUInt32(symcmd.stroff);
fCnv.ConvertUInt32(symcmd.strsize);
fReader.Seek(p);
Result:=true;
Exit;
end;
Result:=false;
end;
procedure TMachoReader.Seek(apos: qword);
begin
fReader.Seek(apos);
end;
{ TLEMachoStructConverter }
procedure TLEMachoStructConverter.ConvertMachoHeader(const mh: mach_header; var hdr: TMachHeader);
begin
hdr.cputype:=LEToN(mh.cputype);
hdr.cpusubtype:=LEtoN(mh.cpusubtype);
hdr.filetype:=LEToN(mh.filetype);
hdr.ncmds:=LEToN(mh.ncmds);
hdr.sizeofcmds:=LEToN(mh.ncmds);
hdr.flags:=LEToN(mh.flags);
end;
procedure TLEMachoStructConverter.ConvertMachoHeader64(const mh: mach_header_64; var hdr: TMachHeader);
begin
hdr.cputype:=LEToN(mh.cputype);
hdr.cpusubtype:=LEtoN(mh.cpusubtype);
hdr.filetype:=LEToN(mh.filetype);
hdr.ncmds:=LEToN(mh.ncmds);
hdr.sizeofcmds:=LEToN(mh.ncmds);
hdr.flags:=LEToN(mh.flags);
end;
procedure TLEMachoStructConverter.ConvertLoadCommand(var cmd: load_command);
begin
cmd.cmd:=LEToN(cmd.cmd);
cmd.cmdsize:=LEToN(cmd.cmdsize);
end;
procedure TLEMachoStructConverter.ConvertSegment(const segcmd: segment_command; var segment: TMachoSegment);
begin
FillChar(segment, sizeof(segment), 0);
segment.segname:=segcmd.segname;
segment.vmaddr:=LEToN(segcmd.vmaddr);
segment.vmsize:=LEToN(segcmd.vmsize);
segment.fileoff:=LEToN(segcmd.fileoff);
segment.filesize:=LEToN(segcmd.filesize);
segment.maxprot:=LEToN(segcmd.maxprot);
segment.initprot:=LEToN(segcmd.initprot);
writelN('segcmd.nsects = ', segcmd.nsects);
segment.nsects:=LEToN(segcmd.nsects);
segment.flags:=LEToN(segcmd.flags);
//todo: reserved!?
end;
procedure TMachoStructConverter.ConvertSegment64(const segcmd: segment_command_64; var segment: TMachoSegment);
begin
FillChar(segment, sizeof(segment), 0);
segment.segname:=segcmd.segname;
segment.vmaddr:=LEToN(segcmd.vmaddr);
segment.vmsize:=LEToN(segcmd.vmsize);
segment.fileoff:=LEToN(segcmd.fileoff);
segment.filesize:=LEToN(segcmd.filesize);
segment.maxprot:=LEToN(segcmd.maxprot);
segment.initprot:=LEToN(segcmd.initprot);
segment.nsects:=LEToN(segcmd.nsects);
segment.flags:=LEToN(segcmd.flags);
//todo: reserved!?
end;
procedure TMachoStructConverter.ConvertSection(const sec: section; var section: TMachoSection);
begin
FillChar(section, sizeof(section), 0);
section.sectname:=sec.sectname;
section.segname:=sec.segname;
section.addr:=LEToN(sec.addr);
section.size:=LEToN(sec.size);
section.offset:=LEToN(sec.offset);
section.align:=LEToN(sec.align);
section.reloff:=LEToN(sec.reloff);
section.nreloc:=LEToN(sec.nreloc);
section.flags:=LEToN(sec.flags);
//todo:
//section.indirectIndex : Integer; // reserved1 for LAZY and NON_LAZY pointers
//section.stubSize : Integer; // reserved2 for S_SYMBOL_STUBS
end;
procedure TMachoStructConverter.ConvertSection64(const sec: section_64; var section: TMachoSection);
begin
FillChar(section, sizeof(section), 0);
section.sectname:=sec.sectname;
section.segname:=sec.segname;
section.addr:=LEToN(sec.addr);
section.size:=LEToN(sec.size);
section.offset:=LEToN(sec.offset);
section.align:=LEToN(sec.align);
section.reloff:=LEToN(sec.reloff);
section.nreloc:=LEToN(sec.nreloc);
section.flags:=LEToN(sec.flags);
//todo:
//section.indirectIndex : Integer; // reserved1 for LAZY and NON_LAZY pointers
//section.stubSize : Integer; // reserved2 for S_SYMBOL_STUBS
end;
procedure TMachoStructConverter.ConvertUInt32(var v: LongWord);
begin
v:=LEtoN(v);
end;
procedure TMachoStructConverter.ConvertUInt64(var v: qword);
begin
v:=LEtoN(v);
end;
procedure TMachoStructConverter.ConvertUInt16(var v: Word);
begin
v:=LEToN(v);
end;
end.
Reference in New Issue View Git Blame Copy Permalink