{ Copyright (c) 1998-2006 by Peter Vreman Contains the binary elf writer 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 ogelf; {$i fpcdefs.inc} interface uses { common } cclasses,globtype, { target } systems, { assembler } cpuinfo,cpubase,aasmbase,aasmtai,aasmdata,assemble, { output } ogbase, owbase; type TElfObjSection = class(TObjSection) public secshidx : longint; { index for the section in symtab } shstridx, shtype, shflags, shlink, shinfo, shentsize : longint; constructor create(AList:TFPHashObjectList;const Aname:string;Aalign:shortint;Aoptions:TObjSectionOptions);override; constructor create_ext(AList:TFPHashObjectList;const Aname:string;Ashtype,Ashflags,Ashlink,Ashinfo:longint;Aalign:shortint;Aentsize:longint); end; TElfObjData = class(TObjData) public constructor create(const n:string);override; function sectionname(atype:TAsmSectiontype;const aname:string;aorder:TAsmSectionOrder):string;override; procedure CreateDebugSections;override; procedure writereloc(data:aint;len:aword;p:TObjSymbol;reltype:TObjRelocationType);override; end; TElfObjectOutput = class(tObjOutput) private symtabsect, strtabsect, shstrtabsect: TElfObjSection; {gotpcsect, gotoffsect, goTSect, plTSect, symsect : TElfObjSection;} symidx, localsyms : longint; procedure createrelocsection(s:TElfObjSection;data:TObjData); procedure createshstrtab(data:TObjData); procedure createsymtab(data: TObjData); procedure writesectionheader(s:TElfObjSection); procedure write_internal_symbol(astridx:longint;ainfo:byte;ashndx:word); procedure section_write_symbol(p:TObject;arg:pointer); procedure section_write_sh_string(p:TObject;arg:pointer); procedure section_count_sections(p:TObject;arg:pointer); procedure section_create_relocsec(p:TObject;arg:pointer); procedure section_write_sechdr(p:TObject;arg:pointer); protected function writedata(data:TObjData):boolean;override; public constructor Create(AWriter:TObjectWriter);override; end; TElfAssembler = class(tinternalassembler) constructor create(smart:boolean);override; end; implementation uses SysUtils, verbose, cutils,globals,fmodule; const symbolresize = 200*18; const { Relocation types } {$ifdef i386} R_386_32 = 1; { ordinary absolute relocation } R_386_PC32 = 2; { PC-relative relocation } R_386_GOT32 = 3; { an offset into GOT } R_386_PLT32 = 4; { a PC-relative offset into PLT } R_386_GOTOFF = 9; { an offset from GOT base } R_386_GOTPC = 10; { a PC-relative offset _to_ GOT } R_386_GNU_VTINHERIT = 250; R_386_GNU_VTENTRY = 251; {$endif i386} {$ifdef sparc} R_SPARC_32 = 3; R_SPARC_WDISP30 = 7; R_SPARC_HI22 = 9; R_SPARC_LO10 = 12; R_SPARC_GNU_VTINHERIT = 250; R_SPARC_GNU_VTENTRY = 251; {$endif sparc} {$ifdef x86_64} R_X86_64_NONE = 0; { Direct 64 bit } R_X86_64_64 = 1; { PC relative 32 bit signed } R_X86_64_PC32 = 2; { 32 bit GOT entry } R_X86_64_GOT32 = 3; { 32 bit PLT address } R_X86_64_PLT32 = 4; { Copy symbol at runtime } R_X86_64_COPY = 5; { Create GOT entry } R_X86_64_GLOB_DAT = 6; { Create PLT entry } R_X86_64_JUMP_SLOT = 7; { Adjust by program base } R_X86_64_RELATIVE = 8; { 32 bit signed PC relative offset to GOT } R_X86_64_GOTPCREL = 9; { Direct 32 bit zero extended } R_X86_64_32 = 10; { Direct 32 bit sign extended } R_X86_64_32S = 11; { Direct 16 bit zero extended } R_X86_64_16 = 12; { 16 bit sign extended PC relative } R_X86_64_PC16 = 13; { Direct 8 bit sign extended } R_X86_64_8 = 14; { 8 bit sign extended PC relative } R_X86_64_PC8 = 15; { ID of module containing symbol } R_X86_64_DTPMOD64 = 16; { Offset in module's TLS block } R_X86_64_DTPOFF64 = 17; { Offset in initial TLS block } R_X86_64_TPOFF64 = 18; { 32 bit signed PC relative offset to two GOT entries for GD symbol } R_X86_64_TLSGD = 19; { 32 bit signed PC relative offset to two GOT entries for LD symbol } R_X86_64_TLSLD = 20; { Offset in TLS block } R_X86_64_DTPOFF32 = 21; { 32 bit signed PC relative offset to GOT entry for IE symbol } R_X86_64_GOTTPOFF = 22; { Offset in initial TLS block } R_X86_64_TPOFF32 = 23; { GNU extension to record C++ vtable hierarchy } R_X86_64_GNU_VTINHERIT = 24; { GNU extension to record C++ vtable member usage } R_X86_64_GNU_VTENTRY = 25; {$endif x86_64} { ELFHeader.file_class } ELFCLASSNONE = 0; ELFCLASS32 = 1; ELFCLASS64 = 2; { ELFHeader.e_type } ET_NONE = 0; ET_REL = 1; ET_EXEC = 2; ET_DYN = 3; ET_CORE = 4; { ELFHeader.e_machine } EM_SPARC = 2; EM_386 = 3; EM_M68K = 4; EM_PPC = 20; EM_ARM = 40; EM_X86_64 = 62; {$ifdef sparc} ELFMACHINE = EM_SPARC; {$endif sparc} {$ifdef i386} ELFMACHINE = EM_386; {$endif i386} {$ifdef m68k} ELFMACHINE = EM_M68K; {$endif m68k} {$ifdef powerpc} ELFMACHINE = EM_PPC; {$endif powerpc} {$ifdef arm} ELFMACHINE = EM_ARM; {$endif arm} {$ifdef x86_64} ELFMACHINE = EM_X86_64; {$endif x86_64} SHN_UNDEF = 0; SHN_ABS = $fff1; SHN_COMMON = $fff2; SHT_NULL = 0; SHT_PROGBITS = 1; SHT_SYMTAB = 2; SHT_STRTAB = 3; SHT_RELA = 4; SHT_HASH = 5; SHT_DYNAMIC = 6; SHT_NOTE = 7; SHT_NOBITS = 8; SHT_REL = 9; SHT_SHLIB = 10; SHT_DYNSYM = 11; SHF_WRITE = 1; SHF_ALLOC = 2; SHF_EXECINSTR = 4; STB_LOCAL = 0; STB_GLOBAL = 1; STB_WEAK = 2; STT_NOTYPE = 0; STT_OBJECT = 1; STT_FUNC = 2; STT_SECTION = 3; STT_FILE = 4; type { Structures which are written directly to the output file } TElf32header=packed record magic : array[0..3] of byte; file_class : byte; data_encoding : byte; file_version : byte; padding : array[$07..$0f] of byte; e_type : word; e_machine : word; e_version : longint; e_entry : longint; { entrypoint } e_phoff : longint; { program header offset } e_shoff : longint; { sections header offset } e_flags : longint; e_ehsize : word; { elf header size in bytes } e_phentsize : word; { size of an entry in the program header array } e_phnum : word; { 0..e_phnum-1 of entrys } e_shentsize : word; { size of an entry in sections header array } e_shnum : word; { 0..e_shnum-1 of entrys } e_shstrndx : word; { index of string section header } end; TElf32sechdr=packed record sh_name : longint; sh_type : longint; sh_flags : longint; sh_addr : longint; sh_offset : longint; sh_size : longint; sh_link : longint; sh_info : longint; sh_addralign : longint; sh_entsize : longint; end; TElf32proghdr=packed record p_type : longword; p_offset : longword; p_vaddr : longword; p_paddr : longword; p_filesz : longword; p_memsz : longword; p_flags : longword; p_align : longword; end; TElf32reloc=packed record address : longint; info : longint; { bit 0-7: type, 8-31: symbol } end; TElf32symbol=packed record st_name : longint; st_value : longint; st_size : longint; st_info : byte; { bit 0-3: type, 4-7: bind } st_other : byte; st_shndx : word; end; TElf32Dyn=packed record d_tag: longword; case integer of 0: (d_val: longword); 1: (d_ptr: longword); end; telf64header=packed record magic : array[0..3] of byte; file_class : byte; data_encoding : byte; file_version : byte; padding : array[$07..$0f] of byte; e_type : word; e_machine : word; e_version : longint; e_entry : qword; { entrypoint } e_phoff : qword; { program header offset } e_shoff : qword; { sections header offset } e_flags : longint; e_ehsize : word; { elf header size in bytes } e_phentsize : word; { size of an entry in the program header array } e_phnum : word; { 0..e_phnum-1 of entrys } e_shentsize : word; { size of an entry in sections header array } e_shnum : word; { 0..e_shnum-1 of entrys } e_shstrndx : word; { index of string section header } end; telf64sechdr=packed record sh_name : longint; sh_type : longint; sh_flags : qword; sh_addr : qword; sh_offset : qword; sh_size : qword; sh_link : longint; sh_info : longint; sh_addralign : qword; sh_entsize : qword; end; telf64proghdr=packed record p_type : longword; p_flags : longword; p_offset : qword; p_vaddr : qword; p_paddr : qword; p_filesz : qword; p_memsz : qword; p_align : qword; end; telf64reloc=packed record address : qword; info : qword; { bit 0-31: type, 32-63: symbol } addend : int64; { signed! } end; telf64symbol=packed record st_name : longint; st_info : byte; { bit 0-3: type, 4-7: bind } st_other : byte; st_shndx : word; st_value : qword; st_size : qword; end; TElf64Dyn=packed record d_tag: qword; case integer of 0: (d_val: qword); 1: (d_ptr: qword); end; {$ifdef cpu64bitaddr} const ELFCLASS = ELFCLASS64; type telfheader = telf64header; telfreloc = telf64reloc; telfsymbol = telf64symbol; telfsechdr = telf64sechdr; telfproghdr = telf64proghdr; telfdyn = telf64dyn; {$else cpu64bitaddr} const ELFCLASS = ELFCLASS32; type telfheader = telf32header; telfreloc = telf32reloc; telfsymbol = telf32symbol; telfsechdr = telf32sechdr; telfproghdr = telf32proghdr; telfdyn = telf32dyn; {$endif cpu64bitaddr} procedure MayBeSwapHeader(var h : telf32header); begin if source_info.endian<>target_info.endian then with h do begin e_type:=swapendian(e_type); e_machine:=swapendian(e_machine); e_version:=swapendian(e_version); e_entry:=swapendian(e_entry); e_phoff:=swapendian(e_phoff); e_shoff:=swapendian(e_shoff); e_flags:=swapendian(e_flags); e_ehsize:=swapendian(e_ehsize); e_phentsize:=swapendian(e_phentsize); e_phnum:=swapendian(e_phnum); e_shentsize:=swapendian(e_shentsize); e_shnum:=swapendian(e_shnum); e_shstrndx:=swapendian(e_shstrndx); end; end; procedure MayBeSwapHeader(var h : telf64header); begin if source_info.endian<>target_info.endian then with h do begin e_type:=swapendian(e_type); e_machine:=swapendian(e_machine); e_version:=swapendian(e_version); e_entry:=swapendian(e_entry); e_phoff:=swapendian(e_phoff); e_shoff:=swapendian(e_shoff); e_flags:=swapendian(e_flags); e_ehsize:=swapendian(e_ehsize); e_phentsize:=swapendian(e_phentsize); e_phnum:=swapendian(e_phnum); e_shentsize:=swapendian(e_shentsize); e_shnum:=swapendian(e_shnum); e_shstrndx:=swapendian(e_shstrndx); end; end; procedure MayBeSwapHeader(var h : telf32proghdr); begin if source_info.endian<>target_info.endian then with h do begin p_align:=swapendian(p_align); p_filesz:=swapendian(p_filesz); p_flags:=swapendian(p_flags); p_memsz:=swapendian(p_memsz); p_offset:=swapendian(p_offset); p_paddr:=swapendian(p_paddr); p_type:=swapendian(p_type); p_vaddr:=swapendian(p_vaddr); end; end; procedure MayBeSwapHeader(var h : telf64proghdr); begin if source_info.endian<>target_info.endian then with h do begin p_align:=swapendian(p_align); p_filesz:=swapendian(p_filesz); p_flags:=swapendian(p_flags); p_memsz:=swapendian(p_memsz); p_offset:=swapendian(p_offset); p_paddr:=swapendian(p_paddr); p_type:=swapendian(p_type); p_vaddr:=swapendian(p_vaddr); end; end; procedure MaybeSwapSecHeader(var h : telf32sechdr); begin if source_info.endian<>target_info.endian then with h do begin sh_name:=swapendian(sh_name); sh_type:=swapendian(sh_type); sh_flags:=swapendian(sh_flags); sh_addr:=swapendian(sh_addr); sh_offset:=swapendian(sh_offset); sh_size:=swapendian(sh_size); sh_link:=swapendian(sh_link); sh_info:=swapendian(sh_info); sh_addralign:=swapendian(sh_addralign); sh_entsize:=swapendian(sh_entsize); end; end; procedure MaybeSwapSecHeader(var h : telf64sechdr); begin if source_info.endian<>target_info.endian then with h do begin sh_name:=swapendian(sh_name); sh_type:=swapendian(sh_type); sh_flags:=swapendian(sh_flags); sh_addr:=swapendian(sh_addr); sh_offset:=swapendian(sh_offset); sh_size:=swapendian(sh_size); sh_link:=swapendian(sh_link); sh_info:=swapendian(sh_info); sh_addralign:=swapendian(sh_addralign); sh_entsize:=swapendian(sh_entsize); end; end; procedure MaybeSwapElfSymbol(var h : telf32symbol); begin if source_info.endian<>target_info.endian then with h do begin st_name:=swapendian(st_name); st_value:=swapendian(st_value); st_size:=swapendian(st_size); st_shndx:=swapendian(st_shndx); end; end; procedure MaybeSwapElfSymbol(var h : telf64symbol); begin if source_info.endian<>target_info.endian then with h do begin st_name:=swapendian(st_name); st_value:=swapendian(st_value); st_size:=swapendian(st_size); st_shndx:=swapendian(st_shndx); end; end; procedure MaybeSwapElfReloc(var h : telf32reloc); begin if source_info.endian<>target_info.endian then with h do begin address:=swapendian(address); info:=swapendian(info); end; end; procedure MaybeSwapElfReloc(var h : telf64reloc); begin if source_info.endian<>target_info.endian then with h do begin address:=swapendian(address); info:=swapendian(info); addend:=swapendian(addend); end; end; procedure MaybeSwapElfDyn(var h : telf32dyn); begin if source_info.endian<>target_info.endian then with h do begin d_tag:=swapendian(d_tag); d_val:=swapendian(d_val); end; end; procedure MaybeSwapElfDyn(var h : telf64dyn); begin if source_info.endian<>target_info.endian then with h do begin d_tag:=swapendian(d_tag); d_val:=swapendian(d_val); end; end; {**************************************************************************** Helpers ****************************************************************************} procedure encodesechdrflags(aoptions:TObjSectionOptions;out AshType:longint;out Ashflags:longint); begin { Section Type } AshType:=SHT_PROGBITS; if oso_strings in aoptions then AshType:=SHT_STRTAB else if not(oso_data in aoptions) then AshType:=SHT_NOBITS; { Section Flags } Ashflags:=0; if oso_load in aoptions then Ashflags:=Ashflags or SHF_ALLOC; if oso_executable in aoptions then Ashflags:=Ashflags or SHF_EXECINSTR; if oso_write in aoptions then Ashflags:=Ashflags or SHF_WRITE; end; procedure decodesechdrflags(AshType:longint;Ashflags:longint;out aoptions:TObjSectionOptions); begin aoptions:=[]; { Section Type } if AshType<>SHT_NOBITS then include(aoptions,oso_data); if AshType=SHT_STRTAB then include(aoptions,oso_strings); { Section Flags } if Ashflags and SHF_ALLOC<>0 then include(aoptions,oso_load) else include(aoptions,oso_noload); if Ashflags and SHF_WRITE<>0 then include(aoptions,oso_write) else include(aoptions,oso_readonly); if Ashflags and SHF_EXECINSTR<>0 then include(aoptions,oso_executable); end; {**************************************************************************** TElfObjSection ****************************************************************************} constructor TElfObjSection.create(AList:TFPHashObjectList;const Aname:string;Aalign:shortint;Aoptions:TObjSectionOptions); begin inherited create(AList,Aname,Aalign,aoptions); secshidx:=0; shstridx:=0; encodesechdrflags(aoptions,shtype,shflags); shlink:=0; shinfo:=0; if name='.stab' then shentsize:=sizeof(TObjStabEntry); end; constructor TElfObjSection.create_ext(AList:TFPHashObjectList;const Aname:string;Ashtype,Ashflags,Ashlink,Ashinfo:longint;Aalign:shortint;Aentsize:longint); var aoptions : TObjSectionOptions; begin decodesechdrflags(Ashtype,Ashflags,aoptions); inherited create(AList,Aname,Aalign,aoptions); secshidx:=0; shstridx:=0; shtype:=AshType; shflags:=AshFlags; shlink:=Ashlink; shinfo:=Ashinfo; shentsize:=Aentsize; end; {**************************************************************************** TElfObjData ****************************************************************************} constructor TElfObjData.create(const n:string); begin inherited create(n); CObjSection:=TElfObjSection; { we need at least the following sections } createsection(sec_code); { always a non-PIC data section (will remain empty if doing PIC) } createsection('.data',sizeof(pint),sectiontype2options(sec_data)); createsection(sec_bss); if (cs_create_pic in current_settings.moduleswitches) and not(target_info.system in systems_darwin) then createsection(sec_data); if tf_section_threadvars in target_info.flags then createsection(sec_threadvar); if (tf_needs_dwarf_cfi in target_info.flags) and (af_supports_dwarf in target_asm.flags) then createsection(sec_debug_frame); end; function TElfObjData.sectionname(atype:TAsmSectiontype;const aname:string;aorder:TAsmSectionOrder):string; const secnames : array[TAsmSectiontype] of string[length('__DATA, __datacoal_nt,coalesced')] = ('','', {$ifdef userodata} '.text','.data','.data','.rodata','.bss','.threadvar', {$else userodata} '.text','.data','.data','.data','.bss','.threadvar', {$endif userodata} '.pdata', '.text', { darwin stubs } '__DATA,__nl_symbol_ptr', '__DATA,__la_symbol_ptr', '__DATA,__mod_init_func', '__DATA,__mod_term_func', '.stab','.stabstr', '.idata$2','.idata$4','.idata$5','.idata$6','.idata$7','.edata', '.eh_frame', '.debug_frame','.debug_info','.debug_line','.debug_abbrev', '.fpc', '.toc', '.init', '.fini', '.objc_class', '.objc_meta_class', '.objc_cat_cls_meth', '.objc_cat_inst_meth', '.objc_protocol', '.objc_string_object', '.objc_cls_meth', '.objc_inst_meth', '.objc_cls_refs', '.objc_message_refs', '.objc_symbols', '.objc_category', '.objc_class_vars', '.objc_instance_vars', '.objc_module_info', '.objc_class_names', '.objc_meth_var_types', '.objc_meth_var_names', '.objc_selector_strs', '.objc_protocol_ext', '.objc_class_ext', '.objc_property', '.objc_image_info', '.objc_cstring_object', '.objc_sel_fixup', '__DATA,__objc_data', '__DATA,__objc_const', '.objc_superrefs', '__DATA, __datacoal_nt,coalesced', '.objc_classlist', '.objc_nlclasslist', '.objc_catlist', '.obcj_nlcatlist', '.objc_protolist' ); secnames_pic : array[TAsmSectiontype] of string[length('__DATA, __datacoal_nt,coalesced')] = ('','', '.text', '.data.rel', '.data.rel', '.data.rel', '.bss', '.threadvar', '.pdata', '', { stubs } '__DATA,__nl_symbol_ptr', '__DATA,__la_symbol_ptr', '__DATA,__mod_init_func', '__DATA,__mod_term_func', '.stab', '.stabstr', '.idata$2','.idata$4','.idata$5','.idata$6','.idata$7','.edata', '.eh_frame', '.debug_frame','.debug_info','.debug_line','.debug_abbrev', '.fpc', '.toc', '.init', '.fini', '.objc_class', '.objc_meta_class', '.objc_cat_cls_meth', '.objc_cat_inst_meth', '.objc_protocol', '.objc_string_object', '.objc_cls_meth', '.objc_inst_meth', '.objc_cls_refs', '.objc_message_refs', '.objc_symbols', '.objc_category', '.objc_class_vars', '.objc_instance_vars', '.objc_module_info', '.objc_class_names', '.objc_meth_var_types', '.objc_meth_var_names', '.objc_selector_strs', '.objc_protocol_ext', '.objc_class_ext', '.objc_property', '.objc_image_info', '.objc_cstring_object', '.objc_sel_fixup', '__DATA,__objc_data', '__DATA,__objc_const', '.objc_superrefs', '__DATA, __datacoal_nt,coalesced', '.objc_classlist', '.objc_nlclasslist', '.objc_catlist', '.obcj_nlcatlist', '.objc_protolist' ); var sep : string[3]; secname : string; begin { section type user gives the user full controll on the section name } if atype=sec_user then result:=aname else begin if (cs_create_pic in current_settings.moduleswitches) and not(target_info.system in systems_darwin) then secname:=secnames_pic[atype] else secname:=secnames[atype]; if (atype=sec_fpc) and (Copy(aname,1,3)='res') then begin result:=secname+'.'+aname; exit; end; if create_smartlink_sections and (aname<>'') then begin case aorder of secorder_begin : sep:='.b_'; secorder_end : sep:='.z_'; else sep:='.n_'; end; result:=secname+sep+aname end else result:=secname; end; end; procedure TElfObjData.CreateDebugSections; begin if target_dbg.id=dbg_stabs then begin stabssec:=createsection(sec_stab); stabstrsec:=createsection(sec_stabstr); end; end; procedure TElfObjData.writereloc(data:aint;len:aword;p:TObjSymbol;reltype:TObjRelocationType); var symaddr : aint; begin if CurrObjSec=nil then internalerror(200403292); {$ifdef userodata} if CurrObjSec.sectype in [sec_rodata,sec_bss,sec_threadvar] then internalerror(200408252); {$endif userodata} { Using RELOC_RVA to map 32-bit RELOC_ABSOLUTE to R_X86_64_32 (RELOC_ABSOLUTE maps to R_X86_64_32S) } if (reltype=RELOC_ABSOLUTE) and (len<>sizeof(pint)) then reltype:=RELOC_RVA; if assigned(p) then begin { real address of the symbol } symaddr:=p.address; { Local ObjSymbols can be resolved already or need a section reloc } if (p.bind=AB_LOCAL) and (reltype in [RELOC_RELATIVE,RELOC_ABSOLUTE{$ifdef x86_64},RELOC_ABSOLUTE32,RELOC_RVA{$endif x86_64}]) then begin { For a reltype relocation in the same section the value can be calculated } if (p.objsection=CurrObjSec) and (reltype=RELOC_RELATIVE) then inc(data,symaddr-len-CurrObjSec.Size) else begin CurrObjSec.addsectionreloc(CurrObjSec.Size,p.objsection,reltype); inc(data,symaddr); end; end else begin CurrObjSec.addsymreloc(CurrObjSec.Size,p,reltype); {$ifndef x86_64} if (reltype=RELOC_RELATIVE) or (reltype=RELOC_PLT32) then dec(data,len); {$endif x86_64} end; end; CurrObjSec.write(data,len); end; {**************************************************************************** TElfObjectOutput ****************************************************************************} constructor TElfObjectOutput.create(AWriter:TObjectWriter); begin inherited Create(AWriter); CObjData:=TElfObjData; end; procedure TElfObjectOutput.createrelocsection(s:TElfObjSection;data:TObjData); var i : longint; rel : telfreloc; objreloc : TObjRelocation; relsym, reltyp : longint; relocsect : TObjSection; {$ifdef x86_64} tmp: aint; asize: longint; {$endif x86_64} begin with data do begin {$ifdef userodata} { rodata can't have relocations } if s.sectype=sec_rodata then begin if assigned(s.relocations.first) then internalerror(200408251); exit; end; {$endif userodata} { create the reloc section } {$ifdef i386} relocsect:=TElfObjSection.create_ext(ObjSectionList,'.rel'+s.name,SHT_REL,0,symtabsect.secshidx,s.secshidx,4,sizeof(TElfReloc)); {$else i386} relocsect:=TElfObjSection.create_ext(ObjSectionList,'.rela'+s.name,SHT_RELA,0,symtabsect.secshidx,s.secshidx,4,sizeof(TElfReloc)); {$endif i386} { add the relocations } for i:=0 to s.Objrelocations.count-1 do begin objreloc:=TObjRelocation(s.Objrelocations[i]); fillchar(rel,sizeof(rel),0); rel.address:=objreloc.dataoffset; { when things settle down, we can create processor specific derived classes } case objreloc.typ of {$ifdef i386} RELOC_RELATIVE : reltyp:=R_386_PC32; RELOC_ABSOLUTE : reltyp:=R_386_32; RELOC_GOT32 : reltyp:=R_386_GOT32; RELOC_GOTPC : reltyp:=R_386_GOTPC; RELOC_PLT32 : begin reltyp:=R_386_PLT32; end; {$endif i386} {$ifdef sparc} RELOC_ABSOLUTE : reltyp:=R_SPARC_32; {$endif sparc} {$ifdef x86_64} RELOC_RELATIVE : begin reltyp:=R_X86_64_PC32; { length of the relocated location is handled here } rel.addend:=-4; end; RELOC_ABSOLUTE : reltyp:=R_X86_64_64; RELOC_ABSOLUTE32 : reltyp:=R_X86_64_32S; RELOC_RVA : reltyp:=R_X86_64_32; RELOC_GOTPCREL : begin reltyp:=R_X86_64_GOTPCREL; { length of the relocated location is handled here } rel.addend:=-4; end; RELOC_PLT32 : begin reltyp:=R_X86_64_PLT32; { length of the relocated location is handled here } rel.addend:=-4; end; {$endif x86_64} else internalerror(200602261); end; { This handles ELF 'rela'-styled relocations, which are currently used only for x86_64, but can be used other targets, too. } {$ifdef x86_64} s.Data.Seek(objreloc.dataoffset); if objreloc.typ=RELOC_ABSOLUTE then begin asize:=8; s.Data.Read(tmp,8); rel.addend:=rel.addend+tmp; end else begin asize:=4; s.Data.Read(tmp,4); rel.addend:=rel.addend+longint(tmp); end; { and zero the data member out } tmp:=0; s.Data.Seek(objreloc.dataoffset); s.Data.Write(tmp,asize); {$endif} { Symbol } if assigned(objreloc.symbol) then begin if objreloc.symbol.symidx=-1 then begin writeln(objreloc.symbol.Name); internalerror(200603012); end; relsym:=objreloc.symbol.symidx; end else begin if objreloc.objsection<>nil then relsym:=objreloc.objsection.secsymidx else relsym:=SHN_UNDEF; end; {$ifdef cpu64bitaddr} rel.info:=(qword(relsym) shl 32) or reltyp; {$else cpu64bitaddr} rel.info:=(relsym shl 8) or reltyp; {$endif cpu64bitaddr} { write reloc } MaybeSwapElfReloc(rel); relocsect.write(rel,sizeof(rel)); end; end; end; procedure TElfObjectOutput.write_internal_symbol(astridx:longint;ainfo:byte;ashndx:word); var elfsym : telfsymbol; begin fillchar(elfsym,sizeof(elfsym),0); elfsym.st_name:=astridx; elfsym.st_info:=ainfo; elfsym.st_shndx:=ashndx; inc(symidx); inc(localsyms); MaybeSwapElfSymbol(elfsym); symtabsect.write(elfsym,sizeof(elfsym)); end; procedure TElfObjectOutput.section_write_symbol(p:TObject;arg:pointer); begin TObjSection(p).secsymidx:=symidx; write_internal_symbol(0,STT_SECTION,TElfObjSection(p).secshidx); end; procedure TElfObjectOutput.createsymtab(data: TObjData); procedure WriteSym(objsym:TObjSymbol); var elfsym : telfsymbol; begin fillchar(elfsym,sizeof(elfsym),0); { symbolname, write the #0 separate to overcome 255+1 char not possible } elfsym.st_name:=strtabsect.Size; strtabsect.writestr(objsym.name); strtabsect.writestr(#0); elfsym.st_size:=objsym.size; case objsym.bind of AB_LOCAL : begin elfsym.st_value:=objsym.address; elfsym.st_info:=STB_LOCAL shl 4; inc(localsyms); end; AB_COMMON : begin elfsym.st_value:=$10; elfsym.st_info:=STB_GLOBAL shl 4; end; AB_EXTERNAL : elfsym.st_info:=STB_GLOBAL shl 4; AB_WEAK_EXTERNAL : elfsym.st_info:=STB_WEAK shl 4; AB_GLOBAL : begin elfsym.st_value:=objsym.address; elfsym.st_info:=STB_GLOBAL shl 4; end; end; if (objsym.bind<>AB_EXTERNAL) {and not(assigned(objsym.objsection) and not(oso_data in objsym.objsection.secoptions))} then begin case objsym.typ of AT_FUNCTION : elfsym.st_info:=elfsym.st_info or STT_FUNC; AT_DATA : elfsym.st_info:=elfsym.st_info or STT_OBJECT; end; end; if objsym.bind=AB_COMMON then elfsym.st_shndx:=SHN_COMMON else begin if assigned(objsym.objsection) then elfsym.st_shndx:=TElfObjSection(objsym.objsection).secshidx else elfsym.st_shndx:=SHN_UNDEF; end; objsym.symidx:=symidx; inc(symidx); MaybeSwapElfSymbol(elfsym); symtabsect.write(elfsym,sizeof(elfsym)); end; var i : longint; objsym : TObjSymbol; begin with data do begin symidx:=0; localsyms:=0; { empty entry } write_internal_symbol(0,0,0); { filename entry } write_internal_symbol(1,STT_FILE,SHN_ABS); { section } ObjSectionList.ForEachCall(@section_write_symbol,nil); { First the Local Symbols, this is required by ELF. The localsyms count stored in shinfo is used to skip the local symbols when traversing the symtab } for i:=0 to ObjSymbolList.Count-1 do begin objsym:=TObjSymbol(ObjSymbolList[i]); if (objsym.bind=AB_LOCAL) and (objsym.typ<>AT_LABEL) then WriteSym(objsym); end; { Global Symbols } for i:=0 to ObjSymbolList.Count-1 do begin objsym:=TObjSymbol(ObjSymbolList[i]); if (objsym.bind<>AB_LOCAL) then WriteSym(objsym); end; { update the .symtab section header } symtabsect.shlink:=strtabsect.secshidx; symtabsect.shinfo:=localsyms; end; end; procedure TElfObjectOutput.section_write_sh_string(p:TObject;arg:pointer); begin TElfObjSection(p).shstridx:=shstrtabsect.writestr(TObjSection(p).name+#0); end; procedure TElfObjectOutput.createshstrtab(data: TObjData); begin with data do begin shstrtabsect.writestr(#0); ObjSectionList.ForEachCall(@section_write_sh_string,nil); end; end; procedure TElfObjectOutput.writesectionheader(s:TElfObjSection); var sechdr : telfsechdr; begin fillchar(sechdr,sizeof(sechdr),0); sechdr.sh_name:=s.shstridx; sechdr.sh_type:=s.shtype; sechdr.sh_flags:=s.shflags; sechdr.sh_offset:=s.datapos; sechdr.sh_size:=s.Size; sechdr.sh_link:=s.shlink; sechdr.sh_info:=s.shinfo; sechdr.sh_addralign:=s.secalign; sechdr.sh_entsize:=s.shentsize; MaybeSwapSecHeader(sechdr); writer.write(sechdr,sizeof(sechdr)); end; procedure TElfObjectOutput.section_count_sections(p:TObject;arg:pointer); begin TElfObjSection(p).secshidx:=pword(arg)^; inc(pword(arg)^); end; procedure TElfObjectOutput.section_create_relocsec(p:TObject;arg:pointer); begin if (TElfObjSection(p).ObjRelocations.count>0) then createrelocsection(TElfObjSection(p),TObjData(arg)); end; procedure TElfObjectOutput.section_write_sechdr(p:TObject;arg:pointer); begin writesectionheader(TElfObjSection(p)); end; function TElfObjectOutput.writedata(data:TObjData):boolean; var header : telfheader; shoffset, datapos : aword; nsections : word; begin result:=false; with data do begin { default sections } symtabsect:=TElfObjSection.create_ext(ObjSectionList,'.symtab',SHT_SYMTAB,0,0,0,4,sizeof(telfsymbol)); strtabsect:=TElfObjSection.create_ext(ObjSectionList,'.strtab',SHT_STRTAB,0,0,0,1,0); shstrtabsect:=TElfObjSection.create_ext(ObjSectionList,'.shstrtab',SHT_STRTAB,0,0,0,1,0); { "no executable stack" marker for Linux } if (target_info.system in systems_linux) and not(cs_executable_stack in current_settings.moduleswitches) then TElfObjSection.create_ext(ObjSectionList,'.note.GNU-stack',SHT_PROGBITS,0,0,0,1,0); { insert the empty and filename as first in strtab } strtabsect.writestr(#0); strtabsect.writestr(ExtractFileName(current_module.mainsource)+#0); { calc amount of sections we have } nsections:=1; { also create the index in the section header table } ObjSectionList.ForEachCall(@section_count_sections,@nsections); { create .symtab and .strtab } createsymtab(data); { Create the relocation sections, this needs valid secidx and symidx } ObjSectionList.ForEachCall(@section_create_relocsec,data); { recalc nsections to incude the reloc sections } nsections:=1; ObjSectionList.ForEachCall(@section_count_sections,@nsections); { create .shstrtab } createshstrtab(data); { Calculate the filepositions } datapos:=$40; { elfheader + alignment } { section data } layoutsections(datapos); { section headers } shoffset:=datapos; inc(datapos,(nsections+1)*sizeof(telfsechdr)); { Write ELF Header } fillchar(header,sizeof(header),0); header.magic[0]:=$7f; { = #127'ELF' } header.magic[1]:=$45; header.magic[2]:=$4c; header.magic[3]:=$46; header.file_class:=ELFCLASS; if target_info.endian=endian_big then header.data_encoding:=2 else header.data_encoding:=1; header.file_version:=1; header.e_type:=ET_REL; header.e_machine:=ELFMACHINE; {$ifdef arm} if (current_settings.fputype=cpu_soft) then header.e_flags:=$600; {$endif arm} header.e_version:=1; header.e_shoff:=shoffset; header.e_shstrndx:=shstrtabsect.secshidx; header.e_shnum:=nsections; header.e_ehsize:=sizeof(telfheader); header.e_shentsize:=sizeof(telfsechdr); MaybeSwapHeader(header); writer.write(header,sizeof(header)); writer.writezeros($40-sizeof(header)); { align } { Sections } WriteSectionContent(data); { section headers, start with an empty header for sh_undef } writer.writezeros(sizeof(telfsechdr)); ObjSectionList.ForEachCall(@section_write_sechdr,nil); end; result:=true; end; {**************************************************************************** TELFAssembler ****************************************************************************} constructor TElfAssembler.Create(smart:boolean); begin inherited Create(smart); CObjOutput:=TElfObjectOutput; end; {***************************************************************************** Initialize *****************************************************************************} {$ifdef i386} const as_i386_elf32_info : tasminfo = ( id : as_i386_elf32; idtxt : 'ELF'; asmbin : ''; asmcmd : ''; supported_targets : [system_i386_linux,system_i386_beos, system_i386_freebsd,system_i386_haiku, system_i386_openbsd,system_i386_netbsd, system_i386_Netware,system_i386_netwlibc, system_i386_solaris,system_i386_embedded]; flags : [af_outputbinary,af_smartlink_sections,af_supports_dwarf]; labelprefix : '.L'; comment : ''; dollarsign: '$'; ); {$endif i386} {$ifdef x86_64} const as_x86_64_elf64_info : tasminfo = ( id : as_x86_64_elf64; idtxt : 'ELF'; asmbin : ''; asmcmd : ''; supported_targets : [system_x86_64_linux,system_x86_64_freebsd, system_x86_64_openbsd,system_x86_64_netbsd]; flags : [af_outputbinary,af_smartlink_sections,af_supports_dwarf]; labelprefix : '.L'; comment : ''; dollarsign: '$'; ); {$endif x86_64} {$ifdef sparc} const as_sparc_elf32_info : tasminfo = ( id : as_sparc_elf32; idtxt : 'ELF'; asmbin : ''; asmcmd : ''; supported_targets : []; // flags : [af_outputbinary,af_smartlink_sections]; flags : [af_outputbinary,af_supports_dwarf]; labelprefix : '.L'; comment : ''; dollarsign: '$'; ); {$endif sparc} initialization {$ifdef i386} RegisterAssembler(as_i386_elf32_info,TElfAssembler); {$endif i386} {$ifdef sparc} RegisterAssembler(as_sparc_elf32_info,TElfAssembler); {$endif sparc} {$ifdef x86_64} RegisterAssembler(as_x86_64_elf64_info,TElfAssembler); {$endif x86_64} end.