PageRenderTime 62ms CodeModel.GetById 17ms RepoModel.GetById 1ms app.codeStats 0ms

/compiler/ogcoff.pas

https://github.com/slibre/freepascal
Pascal | 3018 lines | 2517 code | 215 blank | 286 comment | 230 complexity | e284ea8302d6d609ad1851ec3ea6d850 MD5 | raw file
Possible License(s): LGPL-2.0, LGPL-2.1, LGPL-3.0
  1. {
  2. Copyright (c) 1998-2006 by Peter Vreman
  3. Contains the binary coff/PE reader and writer
  4. This program is free software; you can redistribute it and/or modify
  5. it under the terms of the GNU General Public License as published by
  6. the Free Software Foundation; either version 2 of the License, or
  7. (at your option) any later version.
  8. This program is distributed in the hope that it will be useful,
  9. but WITHOUT ANY WARRANTY; without even the implied warranty of
  10. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  11. GNU General Public License for more details.
  12. You should have received a copy of the GNU General Public License
  13. along with this program; if not, write to the Free Software
  14. Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  15. ****************************************************************************
  16. }
  17. unit ogcoff;
  18. {$i fpcdefs.inc}
  19. interface
  20. uses
  21. { common }
  22. cclasses,globtype,
  23. { target }
  24. systems,
  25. { assembler }
  26. cpuinfo,cpubase,aasmbase,assemble,link,
  27. { output }
  28. ogbase,
  29. owbase;
  30. const
  31. PE_DATADIR_ENTRIES = 16;
  32. type
  33. tcoffpedatadir = packed record
  34. vaddr : longword;
  35. size : longword;
  36. end;
  37. tcoffheader = packed record
  38. mach : word;
  39. nsects : word;
  40. time : longword;
  41. sympos : longword;
  42. syms : longword;
  43. opthdr : word;
  44. flag : word;
  45. end;
  46. tcoffpeoptheader = packed record
  47. Magic : word;
  48. MajorLinkerVersion : byte;
  49. MinorLinkerVersion : byte;
  50. tsize : longword;
  51. dsize : longword;
  52. bsize : longword;
  53. entry : longword;
  54. text_start : longword;
  55. {$ifndef cpu64bitaddr}
  56. data_start : longword;
  57. {$endif cpu64bitaddr}
  58. ImageBase : aword;
  59. SectionAlignment : longword;
  60. FileAlignment : longword;
  61. MajorOperatingSystemVersion : word;
  62. MinorOperatingSystemVersion : word;
  63. MajorImageVersion : word;
  64. MinorImageVersion : word;
  65. MajorSubsystemVersion : word;
  66. MinorSubsystemVersion : word;
  67. Win32Version : longword;
  68. SizeOfImage : longword;
  69. SizeOfHeaders : longword;
  70. CheckSum : longword;
  71. Subsystem : word;
  72. DllCharacteristics : word;
  73. SizeOfStackReserve : aword;
  74. SizeOfStackCommit : aword;
  75. SizeOfHeapReserve : aword;
  76. SizeOfHeapCommit : aword;
  77. LoaderFlags : longword; { This field is obsolete }
  78. NumberOfRvaAndSizes : longword;
  79. DataDirectory : array[0..PE_DATADIR_ENTRIES-1] of tcoffpedatadir;
  80. end;
  81. tcoffsechdr = packed record
  82. name : array[0..7] of char;
  83. vsize : longword;
  84. rvaofs : longword;
  85. datasize : longword;
  86. datapos : longword;
  87. relocpos : longword;
  88. lineno1 : longword;
  89. nrelocs : word;
  90. lineno2 : word;
  91. flags : longword;
  92. end;
  93. TCoffObjSection = class(TObjSection)
  94. private
  95. orgmempos,
  96. coffrelocs,
  97. coffrelocpos : aword;
  98. public
  99. constructor create(AList:TFPHashObjectList;const Aname:string;Aalign:shortint;Aoptions:TObjSectionOptions);override;
  100. procedure writereloc_internal(aTarget:TObjSection;offset:aword;len:byte;reltype:TObjRelocationType);override;
  101. end;
  102. TCoffObjData = class(TObjData)
  103. private
  104. win32 : boolean;
  105. {$ifdef arm}
  106. eVCobj : boolean;
  107. {$endif arm}
  108. public
  109. constructor createcoff(const n:string;awin32:boolean;acObjSection:TObjSectionClass);
  110. procedure CreateDebugSections;override;
  111. function sectionname(atype:TAsmSectiontype;const aname:string;aorder:TAsmSectionOrder):string;override;
  112. function sectiontype2options(atype:TAsmSectiontype):TObjSectionOptions;override;
  113. procedure writereloc(data:aint;len:aword;p:TObjSymbol;reloctype:TObjRelocationType);override;
  114. end;
  115. TDJCoffObjData = class(TCoffObjData)
  116. constructor create(const n:string);override;
  117. end;
  118. TPECoffObjData = class(TCoffObjData)
  119. constructor create(const n:string);override;
  120. end;
  121. TCoffObjOutput = class(tObjOutput)
  122. private
  123. win32 : boolean;
  124. symidx : longint;
  125. FCoffSyms,
  126. FCoffStrs : tdynamicarray;
  127. procedure write_symbol(const name:string;value:aword;section:smallint;typ,aux:byte);
  128. procedure section_write_symbol(p:TObject;arg:pointer);
  129. procedure section_write_relocs(p:TObject;arg:pointer);
  130. procedure create_symbols(data:TObjData);
  131. procedure section_set_reloc_datapos(p:TCoffObjSection;var datapos:aword);
  132. procedure section_write_header(p:TObject;arg:pointer);
  133. protected
  134. function writedata(data:TObjData):boolean;override;
  135. public
  136. constructor createcoff(AWriter:TObjectWriter;awin32:boolean);
  137. destructor destroy;override;
  138. end;
  139. TDJCoffObjOutput = class(TCoffObjOutput)
  140. constructor create(AWriter:TObjectWriter);override;
  141. end;
  142. TPECoffObjOutput = class(TCoffObjOutput)
  143. constructor create(AWriter:TObjectWriter);override;
  144. end;
  145. TCoffObjInput = class(tObjInput)
  146. private
  147. FCoffsyms : tdynamicarray;
  148. FCoffStrs : PChar;
  149. FCoffStrSize: longword;
  150. { Convert symidx -> TObjSymbol }
  151. FSymTbl : ^TObjSymbolArray;
  152. { Convert secidx -> TObjSection }
  153. FSecCount : smallint;
  154. FSecTbl : ^TObjSectionArray;
  155. win32 : boolean;
  156. function GetSection(secidx:longint):TObjSection;
  157. function Read_str(strpos:longword):string;
  158. procedure read_relocs(s:TCoffObjSection);
  159. procedure read_symbols(objdata:TObjData);
  160. procedure ObjSections_read_relocs(p:TObject;arg:pointer);
  161. public
  162. constructor createcoff(awin32:boolean);
  163. destructor destroy;override;
  164. function ReadObjData(AReader:TObjectreader;out objdata:TObjData):boolean;override;
  165. end;
  166. TDJCoffObjInput = class(TCoffObjInput)
  167. constructor create;override;
  168. end;
  169. TPECoffObjInput = class(TCoffObjInput)
  170. constructor create;override;
  171. end;
  172. TCoffexeoutput = class(texeoutput)
  173. private
  174. FCoffStrs : tdynamicarray;
  175. win32 : boolean;
  176. nsects : word;
  177. nsyms,
  178. sympos : aword;
  179. datapos_offset: longword;
  180. function totalheadersize:longword;
  181. procedure ExeSectionList_pass2_header(p:TObject;arg:pointer);
  182. procedure write_symbol(const name:string;value:aword;section:smallint;typ,aux:byte);
  183. procedure globalsyms_write_symbol(p:TObject;arg:pointer);
  184. procedure ExeSectionList_write_header(p:TObject;arg:pointer);
  185. protected
  186. function writedata:boolean;override;
  187. procedure Order_ObjSectionList(ObjSectionList : TFPObjectList;const aPattern:string);override;
  188. procedure DoRelocationFixup(objsec:TObjSection);override;
  189. public
  190. constructor createcoff(awin32:boolean);
  191. procedure MemPos_Header;override;
  192. procedure DataPos_Header;override;
  193. procedure DataPos_Symbols;override;
  194. end;
  195. TDJCoffexeoutput = class(TCoffexeoutput)
  196. constructor create;override;
  197. procedure MemPos_Header;override;
  198. end;
  199. TPECoffexeoutput = class(TCoffexeoutput)
  200. private
  201. FRelocsGenerated : boolean;
  202. procedure GenerateRelocs;
  203. public
  204. constructor create;override;
  205. procedure GenerateLibraryImports(ImportLibraryList:TFPHashObjectList);override;
  206. procedure MemPos_Start;override;
  207. procedure MemPos_ExeSection(const aname:string);override;
  208. end;
  209. TObjSymbolArray = array[0..high(word)] of TObjSymbol;
  210. TObjSectionArray = array[0..high(smallint)] of TObjSection;
  211. TDJCoffAssembler = class(tinternalassembler)
  212. constructor create(smart:boolean);override;
  213. end;
  214. TPECoffassembler = class(tinternalassembler)
  215. constructor create(smart:boolean);override;
  216. end;
  217. type
  218. Treaddllproc = procedure(const dllname,funcname:string) of object;
  219. const
  220. {$ifdef i386}
  221. COFF_MAGIC = $14c;
  222. COFF_OPT_MAGIC = $10b;
  223. TLSDIR_SIZE = $18;
  224. {$endif i386}
  225. {$ifdef arm}
  226. COFF_MAGIC = $1c0;
  227. COFF_OPT_MAGIC = $10b;
  228. TLSDIR_SIZE = $18;
  229. {$endif arm}
  230. {$ifdef x86_64}
  231. COFF_MAGIC = $8664;
  232. COFF_OPT_MAGIC = $20b;
  233. TLSDIR_SIZE = $28;
  234. {$endif x86_64}
  235. function ReadDLLImports(const dllname:string;readdllproc:Treaddllproc):boolean;
  236. implementation
  237. uses
  238. {$ifdef win32}
  239. Windows,
  240. {$endif win32}
  241. SysUtils,
  242. cutils,verbose,globals,
  243. fmodule,aasmtai,aasmdata,
  244. ogmap,
  245. version
  246. ;
  247. const
  248. COFF_FLAG_NORELOCS = $0001;
  249. COFF_FLAG_EXE = $0002;
  250. COFF_FLAG_NOLINES = $0004;
  251. COFF_FLAG_NOLSYMS = $0008;
  252. COFF_FLAG_AR16WR = $0080; { 16bit little endian }
  253. COFF_FLAG_AR32WR = $0100; { 32bit little endian }
  254. COFF_FLAG_AR32W = $0200; { 32bit big endian }
  255. COFF_FLAG_DLL = $2000;
  256. COFF_SYM_GLOBAL = 2;
  257. COFF_SYM_LOCAL = 3;
  258. COFF_SYM_LABEL = 6;
  259. COFF_SYM_FUNCTION = 101;
  260. COFF_SYM_FILE = 103;
  261. COFF_SYM_SECTION = 104;
  262. COFF_STYP_REG = $0000; { "regular": allocated, relocated, loaded }
  263. COFF_STYP_DSECT = $0001; { "dummy": relocated only }
  264. COFF_STYP_NOLOAD = $0002; { "noload": allocated, relocated, not loaded }
  265. COFF_STYP_GROUP = $0004; { "grouped": formed of input sections }
  266. COFF_STYP_PAD = $0008;
  267. COFF_STYP_COPY = $0010;
  268. COFF_STYP_TEXT = $0020;
  269. COFF_STYP_DATA = $0040;
  270. COFF_STYP_BSS = $0080;
  271. COFF_STYP_INFO = $0200;
  272. COFF_STYP_OVER = $0400;
  273. COFF_STYP_LIB = $0800;
  274. PE_SUBSYSTEM_NATIVE = 1;
  275. PE_SUBSYSTEM_WINDOWS_GUI = 2;
  276. PE_SUBSYSTEM_WINDOWS_CUI = 3;
  277. PE_SUBSYSTEM_WINDOWS_CE_GUI = 9;
  278. PE_FILE_RELOCS_STRIPPED = $0001;
  279. PE_FILE_EXECUTABLE_IMAGE = $0002;
  280. PE_FILE_LINE_NUMS_STRIPPED = $0004;
  281. PE_FILE_LOCAL_SYMS_STRIPPED = $0008;
  282. PE_FILE_AGGRESSIVE_WS_TRIM = $0010;
  283. PE_FILE_LARGE_ADDRESS_AWARE = $0020;
  284. PE_FILE_16BIT_MACHINE = $0040;
  285. PE_FILE_BYTES_REVERSED_LO = $0080;
  286. PE_FILE_32BIT_MACHINE = $0100;
  287. PE_FILE_DEBUG_STRIPPED = $0200;
  288. PE_FILE_REMOVABLE_RUN_FROM_SWAP = $0400;
  289. PE_FILE_NET_RUN_FROM_SWAP = $0800;
  290. PE_FILE_SYSTEM = $1000;
  291. PE_FILE_DLL = $2000;
  292. PE_FILE_UP_SYSTEM_ONLY = $4000;
  293. PE_FILE_BYTES_REVERSED_HI = $8000;
  294. PE_SCN_CNT_CODE = $00000020; { Section contains code. }
  295. PE_SCN_CNT_INITIALIZED_DATA = $00000040; { Section contains initialized data. }
  296. PE_SCN_CNT_UNINITIALIZED_DATA = $00000080; { Section contains uninitialized data. }
  297. PE_SCN_LNK_OTHER = $00000100; { Reserved. }
  298. PE_SCN_LNK_INFO = $00000200; { Section contains comments or some other type of information. }
  299. PE_SCN_LNK_REMOVE = $00000800; { Section contents will not become part of image. }
  300. PE_SCN_LNK_COMDAT = $00001000; { Section contents comdat. }
  301. PE_SCN_MEM_FARDATA = $00008000;
  302. PE_SCN_MEM_PURGEABLE = $00020000;
  303. PE_SCN_MEM_16BIT = $00020000;
  304. PE_SCN_MEM_LOCKED = $00040000;
  305. PE_SCN_MEM_PRELOAD = $00080000;
  306. PE_SCN_ALIGN_MASK = $00f00000;
  307. PE_SCN_ALIGN_1BYTES = $00100000;
  308. PE_SCN_ALIGN_2BYTES = $00200000;
  309. PE_SCN_ALIGN_4BYTES = $00300000;
  310. PE_SCN_ALIGN_8BYTES = $00400000;
  311. PE_SCN_ALIGN_16BYTES = $00500000; { Default alignment if no others are specified. }
  312. PE_SCN_ALIGN_32BYTES = $00600000;
  313. PE_SCN_ALIGN_64BYTES = $00700000;
  314. PE_SCN_LNK_NRELOC_OVFL = $01000000; { Section contains extended relocations. }
  315. PE_SCN_MEM_NOT_CACHED = $04000000; { Section is not cachable. }
  316. PE_SCN_MEM_NOT_PAGED = $08000000; { Section is not pageable. }
  317. PE_SCN_MEM_SHARED = $10000000; { Section is shareable. }
  318. PE_SCN_MEM_DISCARDABLE = $02000000;
  319. PE_SCN_MEM_EXECUTE = $20000000;
  320. PE_SCN_MEM_READ = $40000000;
  321. PE_SCN_MEM_WRITE = $80000000;
  322. PE_DATADIR_EDATA = 0;
  323. PE_DATADIR_IDATA = 1;
  324. PE_DATADIR_RSRC = 2;
  325. PE_DATADIR_PDATA = 3;
  326. PE_DATADIR_SECURITY = 4;
  327. PE_DATADIR_RELOC = 5;
  328. PE_DATADIR_DEBUG = 6;
  329. PE_DATADIR_DESCRIPTION = 7;
  330. PE_DATADIR_SPECIAL = 8;
  331. PE_DATADIR_TLS = 9;
  332. PE_DATADIR_LOADCFG = 10;
  333. PE_DATADIR_BOUNDIMPORT = 11;
  334. PE_DATADIR_IMPORTADDRESSTABLE = 12;
  335. PE_DATADIR_DELAYIMPORT = 13;
  336. {$ifdef x86_64}
  337. IMAGE_REL_AMD64_ABSOLUTE = $0000; { Reference is absolute, no relocation is necessary }
  338. IMAGE_REL_AMD64_ADDR64 = $0001; { 64-bit address (VA). }
  339. IMAGE_REL_AMD64_ADDR32 = $0002; { 32-bit address (VA). }
  340. IMAGE_REL_AMD64_ADDR32NB = $0003; { 32-bit address w/o image base (RVA). }
  341. IMAGE_REL_AMD64_REL32 = $0004; { 32-bit relative address from byte following reloc }
  342. IMAGE_REL_AMD64_REL32_1 = $0005; { 32-bit relative address from byte distance 1 from reloc }
  343. IMAGE_REL_AMD64_REL32_2 = $0006; { 32-bit relative address from byte distance 2 from reloc }
  344. IMAGE_REL_AMD64_REL32_3 = $0007; { 32-bit relative address from byte distance 3 from reloc }
  345. IMAGE_REL_AMD64_REL32_4 = $0008; { 32-bit relative address from byte distance 4 from reloc }
  346. IMAGE_REL_AMD64_REL32_5 = $0009; { 32-bit relative address from byte distance 5 from reloc }
  347. IMAGE_REL_AMD64_SECTION = $000A; { Section index }
  348. IMAGE_REL_AMD64_SECREL = $000B; { 32 bit offset from base of section containing target }
  349. IMAGE_REL_AMD64_SECREL7 = $000C; { 7 bit unsigned offset from base of section containing target }
  350. IMAGE_REL_AMD64_TOKEN = $000D; { 32 bit metadata token }
  351. IMAGE_REL_AMD64_SREL32 = $000E; { 32 bit signed span-dependent value emitted into object }
  352. IMAGE_REL_AMD64_PAIR = $000F;
  353. IMAGE_REL_AMD64_SSPAN32 = $0010; { 32 bit signed span-dependent value applied at link time }
  354. { Direct 32 bit sign extended,
  355. win64 mingw GNU compiler
  356. also generates this type
  357. inside coff objects
  358. We assume they are equivalent to
  359. IMAGE_REL_AMD64_ADDR32 PM 2010-11-27 }
  360. R_X86_64_32S = $11;
  361. {$endif x86_64}
  362. {$ifdef arm}
  363. IMAGE_REL_ARM_ABSOLUTE = $0000; { No relocation required }
  364. IMAGE_REL_ARM_ADDR32 = $0001; { 32 bit address }
  365. IMAGE_REL_ARM_ADDR32NB = $0002; { 32 bit address w/o image base }
  366. IMAGE_REL_ARM_BRANCH24 = $0003; { 24 bit offset << 2 & sign ext. }
  367. IMAGE_REL_ARM_BRANCH11 = $0004; { Thumb: 2 11 bit offsets }
  368. IMAGE_REL_ARM_TOKEN = $0005; { clr token }
  369. IMAGE_REL_ARM_GPREL12 = $0006; { GP-relative addressing (ARM) }
  370. IMAGE_REL_ARM_GPREL7 = $0007; { GP-relative addressing (Thumb) }
  371. IMAGE_REL_ARM_BLX24 = $0008;
  372. IMAGE_REL_ARM_BLX11 = $0009;
  373. IMAGE_REL_ARM_SECTION = $000E; { Section table index }
  374. IMAGE_REL_ARM_SECREL = $000F; { Offset within section }
  375. {$endif arm}
  376. {$ifdef i386}
  377. IMAGE_REL_I386_DIR32 = 6;
  378. IMAGE_REL_I386_IMAGEBASE = 7;
  379. IMAGE_REL_I386_SECREL32 = 11;
  380. IMAGE_REL_I386_PCRLONG = 20;
  381. {$endif i386}
  382. { .reloc section fixup types }
  383. IMAGE_REL_BASED_HIGHLOW = 3; { Applies the delta to the 32-bit field at Offset. }
  384. IMAGE_REL_BASED_DIR64 = 10; { Applies the delta to the 64-bit field at Offset. }
  385. { values for coffsectionrec.select }
  386. IMAGE_COMDAT_SELECT_NODUPLICATES = 1;
  387. IMAGE_COMDAT_SELECT_ANY = 2;
  388. IMAGE_COMDAT_SELECT_SAME_SIZE = 3;
  389. IMAGE_COMDAT_SELECT_EXACT_MATCH = 4;
  390. IMAGE_COMDAT_SELECT_ASSOCIATIVE = 5;
  391. IMAGE_COMDAT_SELECT_LARGEST = 6;
  392. type
  393. coffdjoptheader=packed record
  394. magic : word;
  395. vstamp : word;
  396. tsize : longint;
  397. dsize : longint;
  398. bsize : longint;
  399. entry : longint;
  400. text_start : longint;
  401. data_start : longint;
  402. end;
  403. coffsectionrec=packed record
  404. len : longword;
  405. nrelocs : word;
  406. nlines : word;
  407. checksum: longword;
  408. assoc : word;
  409. select : byte;
  410. empty : array[0..2] of char;
  411. end;
  412. coffreloc=packed record
  413. address : longword;
  414. sym : longword;
  415. reloctype : word;
  416. end;
  417. coffsymbol=packed record
  418. name : array[0..3] of char; { real is [0..7], which overlaps the strpos ! }
  419. strpos : longword;
  420. value : longword;
  421. section : smallint;
  422. empty : word; { actually type, $20: function, 0: not a function }
  423. typ : byte;
  424. aux : byte;
  425. end;
  426. { This is defined in rtl/win/sysos.inc source }
  427. tlsdirectory=packed record
  428. data_start, data_end : PUInt;
  429. index_pointer, callbacks_pointer : PUInt;
  430. zero_fill_size : dword;
  431. flags : dword;
  432. end;
  433. const
  434. SymbolMaxGrow = 200*sizeof(coffsymbol);
  435. StrsMaxGrow = 8192;
  436. coffsecnames : array[TAsmSectiontype] of string[length('__DATA, __datacoal_nt,coalesced')] = ('','',
  437. '.text','.data','.rdata','.rdata','.bss','.tls',
  438. '.pdata',{pdata}
  439. '.text', {stub}
  440. '.data',
  441. '.data',
  442. '.data',
  443. '.data',
  444. '.stab','.stabstr',
  445. '.idata$2','.idata$4','.idata$5','.idata$6','.idata$7','.edata',
  446. '.eh_frame',
  447. '.debug_frame','.debug_info','.debug_line','.debug_abbrev',
  448. '.fpc',
  449. '',
  450. '.init',
  451. '.fini',
  452. '.objc_class',
  453. '.objc_meta_class',
  454. '.objc_cat_cls_meth',
  455. '.objc_cat_inst_meth',
  456. '.objc_protocol',
  457. '.objc_string_object',
  458. '.objc_cls_meth',
  459. '.objc_inst_meth',
  460. '.objc_cls_refs',
  461. '.objc_message_refs',
  462. '.objc_symbols',
  463. '.objc_category',
  464. '.objc_class_vars',
  465. '.objc_instance_vars',
  466. '.objc_module_info',
  467. '.objc_class_names',
  468. '.objc_meth_var_types',
  469. '.objc_meth_var_names',
  470. '.objc_selector_strs',
  471. '.objc_protocol_ext',
  472. '.objc_class_ext',
  473. '.objc_property',
  474. '.objc_image_info',
  475. '.objc_cstring_object',
  476. '.objc_sel_fixup',
  477. '__DATA,__objc_data',
  478. '__DATA,__objc_const',
  479. '.objc_superrefs',
  480. '__DATA, __datacoal_nt,coalesced',
  481. '.objc_classlist',
  482. '.objc_nlclasslist',
  483. '.objc_catlist',
  484. '.obcj_nlcatlist',
  485. '.objc_protolist'
  486. );
  487. const go32v2stub : array[0..2047] of byte=(
  488. $4D,$5A,$00,$00,$04,$00,$00,$00,$20,$00,$27,$00,$FF,$FF,$00,
  489. $00,$60,$07,$00,$00,$54,$00,$00,$00,$00,$00,$00,$00,$0D,$0A,
  490. $73,$74,$75,$62,$2E,$68,$20,$67,$65,$6E,$65,$72,$61,$74,$65,
  491. $64,$20,$66,$72,$6F,$6D,$20,$73,$74,$75,$62,$2E,$61,$73,$6D,
  492. $20,$62,$79,$20,$64,$6A,$61,$73,$6D,$2C,$20,$6F,$6E,$20,$54,
  493. $68,$75,$20,$44,$65,$63,$20,$20,$39,$20,$31,$30,$3A,$35,$39,
  494. $3A,$33,$31,$20,$31,$39,$39,$39,$0D,$0A,$54,$68,$65,$20,$53,
  495. $54,$55,$42,$2E,$45,$58,$45,$20,$73,$74,$75,$62,$20,$6C,$6F,
  496. $61,$64,$65,$72,$20,$69,$73,$20,$43,$6F,$70,$79,$72,$69,$67,
  497. $68,$74,$20,$28,$43,$29,$20,$31,$39,$39,$33,$2D,$31,$39,$39,
  498. $35,$20,$44,$4A,$20,$44,$65,$6C,$6F,$72,$69,$65,$2E,$20,$0D,
  499. $0A,$50,$65,$72,$6D,$69,$73,$73,$69,$6F,$6E,$20,$67,$72,$61,
  500. $6E,$74,$65,$64,$20,$74,$6F,$20,$75,$73,$65,$20,$66,$6F,$72,
  501. $20,$61,$6E,$79,$20,$70,$75,$72,$70,$6F,$73,$65,$20,$70,$72,
  502. $6F,$76,$69,$64,$65,$64,$20,$74,$68,$69,$73,$20,$63,$6F,$70,
  503. $79,$72,$69,$67,$68,$74,$20,$0D,$0A,$72,$65,$6D,$61,$69,$6E,
  504. $73,$20,$70,$72,$65,$73,$65,$6E,$74,$20,$61,$6E,$64,$20,$75,
  505. $6E,$6D,$6F,$64,$69,$66,$69,$65,$64,$2E,$20,$0D,$0A,$54,$68,
  506. $69,$73,$20,$6F,$6E,$6C,$79,$20,$61,$70,$70,$6C,$69,$65,$73,
  507. $20,$74,$6F,$20,$74,$68,$65,$20,$73,$74,$75,$62,$2C,$20,$61,
  508. $6E,$64,$20,$6E,$6F,$74,$20,$6E,$65,$63,$65,$73,$73,$61,$72,
  509. $69,$6C,$79,$20,$74,$68,$65,$20,$77,$68,$6F,$6C,$65,$20,$70,
  510. $72,$6F,$67,$72,$61,$6D,$2E,$0A,$0D,$0A,$24,$49,$64,$3A,$20,
  511. $73,$74,$75,$62,$2E,$61,$73,$6D,$20,$62,$75,$69,$6C,$74,$20,
  512. $31,$32,$2F,$30,$39,$2F,$39,$39,$20,$31,$30,$3A,$35,$39,$3A,
  513. $33,$31,$20,$62,$79,$20,$64,$6A,$61,$73,$6D,$20,$24,$0A,$0D,
  514. $0A,$40,$28,$23,$29,$20,$73,$74,$75,$62,$2E,$61,$73,$6D,$20,
  515. $62,$75,$69,$6C,$74,$20,$31,$32,$2F,$30,$39,$2F,$39,$39,$20,
  516. $31,$30,$3A,$35,$39,$3A,$33,$31,$20,$62,$79,$20,$64,$6A,$61,
  517. $73,$6D,$0A,$0D,$0A,$1A,$00,$00,$00,$00,$00,$00,$00,$00,$00,
  518. $00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,
  519. $00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,
  520. $00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,
  521. $00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,
  522. $00,$00,$67,$6F,$33,$32,$73,$74,$75,$62,$2C,$20,$76,$20,$32,
  523. $2E,$30,$32,$54,$00,$00,$00,$00,$00,$08,$00,$00,$00,$00,$00,
  524. $00,$00,$00,$00,$00,$40,$00,$00,$00,$00,$00,$00,$00,$00,$00,
  525. $00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,
  526. $00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$43,$57,$53,$44,$50,
  527. $4D,$49,$2E,$45,$58,$45,$00,$00,$00,$00,$00,$0E,$1F,$8C,$1E,
  528. $24,$00,$8C,$06,$60,$07,$FC,$B4,$30,$CD,$21,$3C,$03,$73,$08,
  529. $B0,$6D,$BA,$A7,$05,$E9,$D4,$03,$A2,$69,$08,$BE,$20,$00,$8B,
  530. $04,$09,$C0,$75,$02,$B4,$FE,$BB,$70,$08,$39,$C3,$73,$02,$89,
  531. $C3,$89,$1C,$FE,$C7,$B9,$04,$FF,$D3,$EB,$B4,$4A,$CD,$21,$73,
  532. $08,$D3,$E3,$FE,$CF,$89,$1C,$EB,$D8,$26,$8E,$06,$2C,$00,$31,
  533. $FF,$30,$C0,$A9,$F2,$AE,$26,$81,$3D,$50,$41,$75,$15,$AF,$26,
  534. $81,$3D,$54,$48,$75,$0D,$AF,$26,$80,$3D,$3D,$75,$06,$47,$89,
  535. $3E,$8C,$04,$4F,$AE,$75,$DF,$AF,$B4,$3E,$BB,$13,$00,$CD,$21,
  536. $B4,$3E,$BB,$12,$00,$CD,$21,$06,$57,$31,$C9,$74,$12,$B0,$6E,
  537. $BA,$7E,$05,$E9,$5E,$03,$09,$C9,$75,$F4,$41,$E8,$A1,$03,$72,
  538. $EE,$B8,$87,$16,$CD,$2F,$09,$C0,$75,$ED,$80,$E3,$01,$74,$E8,
  539. $89,$3E,$00,$06,$8C,$06,$02,$06,$89,$36,$04,$06,$5F,$07,$E8,
  540. $D3,$02,$89,$3E,$2A,$00,$89,$36,$62,$07,$80,$3E,$2C,$00,$00,
  541. $74,$23,$B9,$08,$00,$BF,$2C,$00,$8A,$05,$47,$08,$C0,$74,$05,
  542. $88,$07,$43,$E2,$F4,$66,$C7,$07,$2E,$45,$58,$45,$83,$C3,$04,
  543. $C6,$07,$00,$89,$1E,$62,$07,$B8,$00,$3D,$BA,$64,$07,$CD,$21,
  544. $0F,$82,$B3,$02,$A3,$06,$06,$89,$C3,$B9,$06,$00,$BA,$B5,$07,
  545. $B4,$3F,$CD,$21,$31,$D2,$31,$C9,$A1,$B5,$07,$3D,$4C,$01,$74,
  546. $1B,$3D,$4D,$5A,$0F,$85,$98,$02,$8B,$16,$B9,$07,$C1,$E2,$09,
  547. $8B,$1E,$B7,$07,$09,$DB,$74,$05,$80,$EE,$02,$01,$DA,$89,$16,
  548. $BB,$07,$89,$0E,$BD,$07,$B8,$00,$42,$8B,$1E,$06,$06,$CD,$21,
  549. $B9,$A8,$00,$BA,$BF,$07,$B4,$3F,$CD,$21,$3D,$A8,$00,$75,$06,
  550. $81,$3E,$BF,$07,$4C,$01,$0F,$85,$61,$02,$66,$A1,$E3,$07,$66,
  551. $A3,$10,$06,$66,$8B,$0E,$BB,$07,$66,$A1,$03,$08,$66,$01,$C8,
  552. $66,$A3,$08,$06,$66,$A1,$2B,$08,$66,$01,$C8,$66,$A3,$0C,$06,
  553. $66,$8B,$1E,$4B,$08,$66,$A1,$4F,$08,$66,$01,$C3,$66,$B8,$01,
  554. $00,$01,$00,$66,$39,$C3,$73,$03,$66,$89,$C3,$66,$81,$C3,$FF,
  555. $FF,$00,$00,$31,$DB,$66,$89,$1E,$1C,$00,$E8,$F5,$02,$8B,$1E,
  556. $04,$06,$09,$DB,$74,$0A,$B4,$48,$CD,$21,$0F,$82,$15,$02,$8E,
  557. $C0,$E8,$08,$03,$B8,$01,$00,$FF,$1E,$00,$06,$0F,$82,$0F,$02,
  558. $8C,$06,$26,$00,$8C,$0E,$28,$00,$8C,$D8,$A3,$22,$00,$8E,$C0,
  559. $31,$C0,$B9,$01,$00,$CD,$31,$72,$07,$A3,$14,$06,$31,$C0,$CD,
  560. $31,$0F,$82,$F3,$01,$A3,$16,$06,$66,$8B,$0E,$1C,$00,$B8,$01,
  561. $05,$8B,$1E,$1E,$00,$CD,$31,$0F,$82,$E5,$01,$89,$1E,$1A,$06,
  562. $89,$0E,$18,$06,$89,$36,$1A,$00,$89,$3E,$18,$00,$B8,$07,$00,
  563. $8B,$1E,$14,$06,$8B,$0E,$1A,$06,$8B,$16,$18,$06,$CD,$31,$B8,
  564. $09,$00,$8C,$C9,$83,$E1,$03,$C1,$E1,$05,$51,$81,$C9,$9B,$C0,
  565. $CD,$31,$B8,$08,$00,$8B,$0E,$1E,$00,$49,$BA,$FF,$FF,$CD,$31,
  566. $B8,$07,$00,$8B,$1E,$16,$06,$8B,$0E,$1A,$06,$8B,$16,$18,$06,
  567. $CD,$31,$B8,$09,$00,$59,$81,$C9,$93,$C0,$CD,$31,$B8,$08,$00,
  568. $8B,$0E,$1E,$00,$49,$BA,$FF,$FF,$CD,$31,$B8,$00,$01,$BB,$00,
  569. $0F,$CD,$31,$73,$10,$3D,$08,$00,$0F,$85,$73,$01,$B8,$00,$01,
  570. $CD,$31,$0F,$82,$6A,$01,$A3,$1C,$06,$89,$16,$1E,$06,$C1,$E3,
  571. $04,$89,$1E,$20,$06,$66,$8B,$36,$08,$06,$66,$8B,$3E,$FB,$07,
  572. $66,$8B,$0E,$FF,$07,$E8,$49,$00,$66,$8B,$36,$0C,$06,$66,$8B,
  573. $3E,$23,$08,$66,$8B,$0E,$27,$08,$E8,$37,$00,$8E,$06,$16,$06,
  574. $66,$8B,$3E,$4B,$08,$66,$8B,$0E,$4F,$08,$66,$31,$C0,$66,$C1,
  575. $E9,$02,$67,$F3,$66,$AB,$B4,$3E,$8B,$1E,$06,$06,$CD,$21,$B8,
  576. $01,$01,$8B,$16,$1E,$06,$CD,$31,$1E,$0F,$A1,$8E,$1E,$16,$06,
  577. $66,$64,$FF,$2E,$10,$06,$66,$89,$F0,$66,$25,$FF,$01,$00,$00,
  578. $66,$01,$C1,$29,$C6,$66,$29,$C7,$66,$89,$0E,$26,$06,$66,$89,
  579. $3E,$22,$06,$E8,$0F,$01,$89,$36,$3E,$06,$66,$C1,$EE,$10,$89,
  580. $36,$42,$06,$8B,$1E,$06,$06,$89,$1E,$3A,$06,$C7,$06,$46,$06,
  581. $00,$42,$E8,$03,$01,$A1,$1C,$06,$A3,$4E,$06,$C7,$06,$3E,$06,
  582. $00,$00,$C6,$06,$47,$06,$3F,$A1,$28,$06,$09,$C0,$75,$09,$A1,
  583. $26,$06,$3B,$06,$20,$06,$76,$03,$A1,$20,$06,$A3,$42,$06,$E8,
  584. $D9,$00,$66,$31,$C9,$8B,$0E,$46,$06,$66,$8B,$3E,$22,$06,$66,
  585. $01,$0E,$22,$06,$66,$29,$0E,$26,$06,$66,$31,$F6,$C1,$E9,$02,
  586. $1E,$06,$8E,$06,$16,$06,$8E,$1E,$1E,$06,$67,$F3,$66,$A5,$07,
  587. $1F,$66,$03,$0E,$26,$06,$75,$AF,$C3,$3C,$3A,$74,$06,$3C,$2F,
  588. $74,$02,$3C,$5C,$C3,$BE,$64,$07,$89,$F3,$26,$8A,$05,$47,$88,
  589. $04,$38,$E0,$74,$0E,$08,$C0,$74,$0A,$46,$E8,$DE,$FF,$75,$EC,
  590. $89,$F3,$74,$E8,$C3,$B0,$66,$BA,$48,$05,$EB,$0C,$B0,$67,$BA,
  591. $55,$05,$EB,$05,$B0,$68,$BA,$5F,$05,$52,$8B,$1E,$62,$07,$C6,
  592. $07,$24,$BB,$64,$07,$EB,$28,$E8,$F5,$00,$B0,$69,$BA,$99,$05,
  593. $EB,$1A,$B0,$6A,$BA,$B2,$05,$EB,$13,$B0,$6B,$BA,$C4,$05,$EB,
  594. $0C,$B0,$6C,$BA,$D6,$05,$EB,$05,$B0,$69,$BA,$99,$05,$52,$BB,
  595. $3B,$05,$E8,$15,$00,$5B,$E8,$11,$00,$BB,$67,$04,$E8,$0B,$00,
  596. $B4,$4C,$CD,$21,$43,$50,$B4,$02,$CD,$21,$58,$8A,$17,$80,$FA,
  597. $24,$75,$F2,$C3,$0D,$0A,$24,$50,$51,$57,$31,$C0,$BF,$2A,$06,
  598. $B9,$19,$00,$F3,$AB,$5F,$59,$58,$C3,$B8,$00,$03,$BB,$21,$00,
  599. $31,$C9,$66,$BF,$2A,$06,$00,$00,$CD,$31,$C3,$00,$00,$30,$E4,
  600. $E8,$4E,$FF,$89,$DE,$8B,$3E,$8C,$04,$EB,$17,$B4,$3B,$E8,$41,
  601. $FF,$81,$FE,$64,$07,$74,$12,$8A,$44,$FF,$E8,$2A,$FF,$74,$04,
  602. $C6,$04,$5C,$46,$E8,$03,$00,$72,$E4,$C3,$E8,$34,$00,$BB,$44,
  603. $00,$8A,$07,$88,$04,$43,$46,$08,$C0,$75,$F6,$06,$57,$1E,$07,
  604. $E8,$9B,$FF,$BB,$2A,$06,$8C,$5F,$04,$89,$5F,$02,$BA,$64,$07,
  605. $B8,$00,$4B,$CD,$21,$5F,$07,$72,$09,$B4,$4D,$CD,$21,$2D,$00,
  606. $03,$F7,$D8,$EB,$28,$80,$3E,$69,$08,$05,$72,$20,$B8,$00,$58,
  607. $CD,$21,$A2,$67,$08,$B8,$02,$58,$CD,$21,$A2,$68,$08,$B8,$01,
  608. $58,$BB,$80,$00,$CD,$21,$B8,$03,$58,$BB,$01,$00,$CD,$21,$C3,
  609. $9C,$80,$3E,$69,$08,$05,$72,$1A,$50,$53,$B8,$03,$58,$8A,$1E,
  610. $68,$08,$30,$FF,$CD,$21,$B8,$01,$58,$8A,$1E,$67,$08,$30,$FF,
  611. $CD,$21,$5B,$58,$9D,$C3,$4C,$6F,$61,$64,$20,$65,$72,$72,$6F,
  612. $72,$3A,$20,$24,$3A,$20,$63,$61,$6E,$27,$74,$20,$6F,$70,$65,
  613. $6E,$24,$3A,$20,$6E,$6F,$74,$20,$45,$58,$45,$24,$3A,$20,$6E,
  614. $6F,$74,$20,$43,$4F,$46,$46,$20,$28,$43,$68,$65,$63,$6B,$20,
  615. $66,$6F,$72,$20,$76,$69,$72,$75,$73,$65,$73,$29,$24,$6E,$6F,
  616. $20,$44,$50,$4D,$49,$20,$2D,$20,$47,$65,$74,$20,$63,$73,$64,
  617. $70,$6D,$69,$2A,$62,$2E,$7A,$69,$70,$24,$6E,$6F,$20,$44,$4F,
  618. $53,$20,$6D,$65,$6D,$6F,$72,$79,$24,$6E,$65,$65,$64,$20,$44,
  619. $4F,$53,$20,$33,$24,$63,$61,$6E,$27,$74,$20,$73,$77,$69,$74,
  620. $63,$68,$20,$6D,$6F,$64,$65,$24,$6E,$6F,$20,$44,$50,$4D,$49,
  621. $20,$73,$65,$6C,$65,$63,$74,$6F,$72,$73,$24,$6E,$6F,$20,$44,
  622. $50,$4D,$49,$20,$6D,$65,$6D,$6F,$72,$79,$24,$90,$90,$90,$90,
  623. $90,$90,$90,$90,$90,$90,$90,$90,$90,$90,$90,$90,$90,$90,$90,
  624. $90,$90,$90,$90,$90,$90,$90,$90);
  625. const win32stub : array[0..127] of byte=(
  626. $4D,$5A,$90,$00,$03,$00,$00,$00,$04,$00,$00,$00,$FF,$FF,$00,$00,
  627. $B8,$00,$00,$00,$00,$00,$00,$00,$40,$00,$00,$00,$00,$00,$00,$00,
  628. $00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,
  629. $00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$80,$00,$00,$00,
  630. $0E,$1F,$BA,$0E,$00,$B4,$09,$CD,$21,$B8,$01,$4C,$CD,$21,$54,$68,
  631. $69,$73,$20,$70,$72,$6F,$67,$72,$61,$6D,$20,$63,$61,$6E,$6E,$6F,
  632. $74,$20,$62,$65,$20,$72,$75,$6E,$20,$69,$6E,$20,$44,$4F,$53,$20,
  633. $6D,$6F,$64,$65,$2E,$0D,$0D,$0A,$24,$00,$00,$00,$00,$00,$00,$00);
  634. const pemagic : array[0..3] of byte = (
  635. $50,$45,$00,$00);
  636. {****************************************************************************
  637. Helpers
  638. ****************************************************************************}
  639. function djencodesechdrflags(aoptions:TObjSectionOptions):longword;
  640. begin
  641. if (oso_load in aoptions) then
  642. begin
  643. if oso_executable in aoptions then
  644. result:=COFF_STYP_TEXT
  645. else if not(oso_data in aoptions) then
  646. result:=COFF_STYP_BSS
  647. else
  648. result:=COFF_STYP_DATA;
  649. end
  650. else if oso_debug in aoptions then
  651. result:=COFF_STYP_INFO
  652. else
  653. result:=COFF_STYP_REG;
  654. end;
  655. function djdecodesechdrflags(const aname:string;flags:longword):TObjSectionOptions;
  656. begin
  657. result:=[];
  658. if flags and COFF_STYP_TEXT<>0 then
  659. result:=[oso_data,oso_load,oso_executable]
  660. else if flags and COFF_STYP_BSS<>0 then
  661. result:=[oso_load]
  662. else if flags and COFF_STYP_DATA<>0 then
  663. result:=[oso_data,oso_load]
  664. else if flags and COFF_STYP_INFO<>0 then
  665. result:=[oso_data,oso_debug]
  666. else
  667. result:=[oso_data]
  668. end;
  669. function peencodesechdrflags(aoptions:TObjSectionOptions;aalign:shortint):longword;
  670. begin
  671. result:=0;
  672. if (oso_load in aoptions) then
  673. begin
  674. if oso_executable in aoptions then
  675. result:=result or PE_SCN_CNT_CODE or PE_SCN_MEM_EXECUTE
  676. else
  677. begin
  678. if (oso_data in aoptions) then
  679. result:=result or PE_SCN_CNT_INITIALIZED_DATA
  680. else
  681. result:=result or PE_SCN_CNT_UNINITIALIZED_DATA;
  682. end;
  683. if oso_write in aoptions then
  684. result:=result or PE_SCN_MEM_WRITE or PE_SCN_MEM_READ
  685. else
  686. result:=result or PE_SCN_MEM_READ;
  687. end
  688. else
  689. result:=result or PE_SCN_MEM_DISCARDABLE;
  690. case aalign of
  691. 1 : result:=result or PE_SCN_ALIGN_1BYTES;
  692. 2 : result:=result or PE_SCN_ALIGN_2BYTES;
  693. 4 : result:=result or PE_SCN_ALIGN_4BYTES;
  694. 8 : result:=result or PE_SCN_ALIGN_8BYTES;
  695. 16 : result:=result or PE_SCN_ALIGN_16BYTES;
  696. 32 : result:=result or PE_SCN_ALIGN_32BYTES;
  697. 64 : result:=result or PE_SCN_ALIGN_64BYTES;
  698. else result:=result or PE_SCN_ALIGN_16BYTES;
  699. end;
  700. end;
  701. procedure pedecodesechdrflags(const aname:string;flags:longword;out aoptions:TObjSectionOptions;out aalign:shortint);
  702. var
  703. alignflag : longword;
  704. begin
  705. aoptions:=[];
  706. if flags and PE_SCN_CNT_CODE<>0 then
  707. include(aoptions,oso_executable);
  708. if flags and PE_SCN_MEM_DISCARDABLE<>0 then
  709. include(aoptions,oso_debug);
  710. if flags and PE_SCN_CNT_UNINITIALIZED_DATA=0 then
  711. include(aoptions,oso_data);
  712. if (flags and (PE_SCN_LNK_REMOVE or PE_SCN_MEM_DISCARDABLE)=0) then
  713. include(aoptions,oso_load);
  714. { read/write }
  715. if flags and PE_SCN_MEM_WRITE<>0 then
  716. include(aoptions,oso_write);
  717. { alignment }
  718. alignflag:=flags and PE_SCN_ALIGN_MASK;
  719. if alignflag=PE_SCN_ALIGN_64BYTES then
  720. aalign:=64
  721. else if alignflag=PE_SCN_ALIGN_32BYTES then
  722. aalign:=32
  723. else if alignflag=PE_SCN_ALIGN_16BYTES then
  724. aalign:=16
  725. else if alignflag=PE_SCN_ALIGN_8BYTES then
  726. aalign:=8
  727. else if alignflag=PE_SCN_ALIGN_4BYTES then
  728. aalign:=4
  729. else if alignflag=PE_SCN_ALIGN_2BYTES then
  730. aalign:=2
  731. else if alignflag=PE_SCN_ALIGN_1BYTES then
  732. aalign:=1
  733. else if alignflag=0 then
  734. aalign:=0
  735. else
  736. Internalerror(2009050401);
  737. end;
  738. {****************************************************************************
  739. TCoffObjSection
  740. ****************************************************************************}
  741. constructor TCoffObjSection.create(AList:TFPHashObjectList;const aname:string;aalign:shortint;aoptions:TObjSectionOptions);
  742. begin
  743. inherited create(AList,aname,aalign,aoptions);
  744. end;
  745. procedure TCoffObjSection.writereloc_internal(aTarget:TObjSection;offset:aword;len:byte;reltype:TObjRelocationType);
  746. begin
  747. AddSectionReloc(size,aTarget,reltype);
  748. write(offset,len);
  749. end;
  750. { We don't want overflow nor range checks here,
  751. wrapping is accepted in the address computation below }
  752. {$r-}
  753. {$q-}
  754. procedure TCoffExeOutput.DoRelocationFixup(objsec:TObjSection);
  755. var
  756. i,zero,address_size : longint;
  757. objreloc : TObjRelocation;
  758. address,
  759. relocval : aint;
  760. relocsec : TObjSection;
  761. {$ifdef cpu64bitaddr}
  762. s : string;
  763. {$endif cpu64bitaddr}
  764. data : TDynamicArray;
  765. begin
  766. data:=objsec.data;
  767. for i:=0 to objsec.ObjRelocations.Count-1 do
  768. begin
  769. objreloc:=TObjRelocation(objsec.ObjRelocations[i]);
  770. address_size:=4;
  771. case objreloc.typ of
  772. RELOC_NONE:
  773. continue;
  774. RELOC_ZERO:
  775. begin
  776. data.Seek(objreloc.dataoffset);
  777. zero:=0;
  778. data.Write(zero,4);
  779. continue;
  780. end;
  781. {$ifdef cpu64bitaddr}
  782. RELOC_ABSOLUTE:
  783. address_size:=8;
  784. {$endif cpu64bitaddr}
  785. end;
  786. address:=0;
  787. data.Seek(objreloc.dataoffset);
  788. data.Read(address,address_size);
  789. if assigned(objreloc.symbol) then
  790. begin
  791. relocsec:=objreloc.symbol.objsection;
  792. relocval:=objreloc.symbol.address;
  793. end
  794. else
  795. if assigned(objreloc.objsection) then
  796. begin
  797. relocsec:=objreloc.objsection;
  798. relocval:=objreloc.objsection.mempos
  799. end
  800. else
  801. internalerror(200205183);
  802. { Only debug sections are allowed to have relocs pointing to unused sections }
  803. if not relocsec.used and not (oso_debug in objsec.secoptions) then
  804. internalerror(200603061);
  805. if relocsec.used then
  806. case objreloc.typ of
  807. RELOC_RELATIVE :
  808. begin
  809. address:=address-objsec.mempos+relocval;
  810. if win32 then
  811. dec(address,objreloc.dataoffset+4);
  812. end;
  813. RELOC_RVA:
  814. begin
  815. { fixup address when the symbol was known in defined object }
  816. if (relocsec.objdata=objsec.objdata) then
  817. dec(address,TCoffObjSection(relocsec).orgmempos);
  818. {$ifdef arm}
  819. if (relocsec.objdata=objsec.objdata) and not TCoffObjData(objsec.objdata).eVCobj then
  820. inc(address, relocsec.MemPos)
  821. else
  822. {$endif arm}
  823. inc(address,relocval);
  824. end;
  825. RELOC_SECREL32 :
  826. begin
  827. { fixup address when the symbol was known in defined object }
  828. if (relocsec.objdata=objsec.objdata) then
  829. dec(address,relocsec.ExeSection.MemPos);
  830. inc(address,relocval);
  831. end;
  832. {$ifdef arm}
  833. RELOC_RELATIVE_24:
  834. begin
  835. relocval:=longint(relocval - objsec.mempos - objreloc.dataoffset) shr 2 - 2;
  836. address:=address or (relocval and $ffffff);
  837. relocval:=relocval shr 24;
  838. if (relocval<>$3f) and (relocval<>0) then
  839. internalerror(200606085); { offset overflow }
  840. end;
  841. {$endif arm}
  842. {$ifdef x86_64}
  843. { 64 bit coff only }
  844. RELOC_RELATIVE_1:
  845. begin
  846. address:=address-objsec.mempos+relocval;
  847. dec(address,objreloc.dataoffset+1);
  848. end;
  849. RELOC_RELATIVE_2:
  850. begin
  851. address:=address-objsec.mempos+relocval;
  852. dec(address,objreloc.dataoffset+2);
  853. end;
  854. RELOC_RELATIVE_3:
  855. begin
  856. address:=address-objsec.mempos+relocval;
  857. dec(address,objreloc.dataoffset+3);
  858. end;
  859. RELOC_RELATIVE_4:
  860. begin
  861. address:=address-objsec.mempos+relocval;
  862. dec(address,objreloc.dataoffset+4);
  863. end;
  864. RELOC_RELATIVE_5:
  865. begin
  866. address:=address-objsec.mempos+relocval;
  867. dec(address,objreloc.dataoffset+5);
  868. end;
  869. RELOC_ABSOLUTE32,
  870. {$endif x86_64}
  871. RELOC_ABSOLUTE :
  872. begin
  873. if (not win32) and assigned(objreloc.symbol) and
  874. (objreloc.symbol.bind=AB_COMMON) then
  875. begin
  876. dec(address,objreloc.symbol.size);
  877. end
  878. else
  879. begin
  880. { fixup address when the symbol was known in defined object }
  881. if (relocsec.objdata=objsec.objdata) then
  882. dec(address,TCoffObjSection(relocsec).orgmempos);
  883. end;
  884. {$ifdef arm}
  885. if (relocsec.objdata=objsec.objdata) and not TCoffObjData(objsec.objdata).eVCobj then
  886. inc(address, relocsec.MemPos)
  887. else
  888. {$endif arm}
  889. inc(address,relocval);
  890. inc(address,imagebase);
  891. end;
  892. else
  893. internalerror(200604014);
  894. end
  895. else
  896. address:=0; { Relocation in debug section points to unused section, which is eliminated by linker }
  897. data.Seek(objreloc.dataoffset);
  898. data.Write(address,address_size);
  899. {$ifdef cpu64bitaddr}
  900. if (objreloc.typ = RELOC_ABSOLUTE32) and (objsec.name <> '.stab') then
  901. begin
  902. if assigned(objreloc.symbol) then
  903. s:=objreloc.symbol.Name
  904. else
  905. s:=objreloc.objsection.Name;
  906. Message2(link_w_32bit_absolute_reloc, objsec.ObjData.Name, s);
  907. end;
  908. {$endif cpu64bitaddr}
  909. end;
  910. end;
  911. {****************************************************************************
  912. TCoffObjData
  913. ****************************************************************************}
  914. constructor TCoffObjData.createcoff(const n:string;awin32:boolean;acObjSection:TObjSectionClass);
  915. begin
  916. inherited create(n);
  917. CObjSection:=ACObjSection;
  918. win32:=awin32;
  919. end;
  920. function TCoffObjData.sectionname(atype:TAsmSectiontype;const aname:string;aorder:TAsmSectionOrder):string;
  921. var
  922. sep : string[3];
  923. secname : string;
  924. begin
  925. { section type user gives the user full controll on the section name }
  926. if atype=sec_user then
  927. result:=aname
  928. else
  929. begin
  930. { non-PECOFF targets lack rodata support.
  931. TODO: WinCE likely supports it, but needs testing. }
  932. if (atype in [sec_rodata,sec_rodata_norel]) and
  933. not (target_info.system in systems_windows) then
  934. atype:=sec_data;
  935. secname:=coffsecnames[atype];
  936. if create_smartlink_sections and
  937. (aname<>'') then
  938. begin
  939. case aorder of
  940. secorder_begin :
  941. sep:='.b_';
  942. secorder_end :
  943. sep:='.z_';
  944. else
  945. sep:='.n_';
  946. end;
  947. result:=secname+sep+aname
  948. end
  949. else
  950. result:=secname;
  951. end;
  952. end;
  953. function TCoffObjData.sectiontype2options(aType:TAsmSectionType): TObjSectionOptions;
  954. begin
  955. if (aType in [sec_rodata,sec_rodata_norel]) then
  956. begin
  957. { TODO: WinCE needs testing }
  958. if (target_info.system in systems_windows) then
  959. aType:=sec_rodata_norel
  960. else
  961. aType:=sec_data;
  962. end;
  963. result:=inherited sectiontype2options(aType);
  964. end;
  965. procedure TCoffObjData.CreateDebugSections;
  966. begin
  967. if target_dbg.id=dbg_stabs then
  968. begin
  969. stabssec:=createsection(sec_stab);
  970. stabstrsec:=createsection(sec_stabstr);
  971. end;
  972. end;
  973. procedure TCoffObjData.writereloc(data:aint;len:aword;p:TObjSymbol;reloctype:TObjRelocationType);
  974. var
  975. curraddr,
  976. symaddr : aword;
  977. begin
  978. if CurrObjSec=nil then
  979. internalerror(200403072);
  980. if assigned(p) then
  981. begin
  982. { current address }
  983. curraddr:=CurrObjSec.mempos+CurrObjSec.Size;
  984. { external/common symbols don't have a fixed memory position yet }
  985. if (p.bind=AB_COMMON) then
  986. begin
  987. { For go32v2 we need to use the size as address }
  988. if not win32 then
  989. symaddr:=p.size
  990. else
  991. symaddr:=0;
  992. end
  993. else
  994. symaddr:=p.address;
  995. { no symbol relocation need inside a section }
  996. if (p.objsection=CurrObjSec) and
  997. (p.bind<>AB_COMMON) then
  998. begin
  999. case reloctype of
  1000. RELOC_ABSOLUTE :
  1001. begin
  1002. CurrObjSec.addsectionreloc(curraddr,CurrObjSec,RELOC_ABSOLUTE);
  1003. inc(data,symaddr);
  1004. end;
  1005. {$ifdef cpu64bitaddr}
  1006. RELOC_ABSOLUTE32 :
  1007. begin
  1008. CurrObjSec.addsectionreloc(curraddr,CurrObjSec,RELOC_ABSOLUTE32);
  1009. inc(data,symaddr);
  1010. end;
  1011. {$endif cpu64bitaddr}
  1012. RELOC_RELATIVE :
  1013. begin
  1014. //inc(data,symaddr-len-CurrObjSec.Size);
  1015. data:=data+symaddr-len-CurrObjSec.Size;
  1016. end;
  1017. RELOC_RVA,
  1018. RELOC_SECREL32 :
  1019. begin
  1020. CurrObjSec.addsectionreloc(curraddr,CurrObjSec,reloctype);
  1021. inc(data,symaddr);
  1022. end;
  1023. else
  1024. internalerror(200604013);
  1025. end;
  1026. end
  1027. else
  1028. begin
  1029. if (p.objsection<>nil) and
  1030. (p.bind<>AB_COMMON) then
  1031. CurrObjSec.addsectionreloc(curraddr,p.objsection,reloctype)
  1032. else
  1033. CurrObjSec.addsymreloc(curraddr,p,reloctype);
  1034. if (not win32) or
  1035. (p.objsection<>nil) then
  1036. inc(data,symaddr);
  1037. if reloctype=RELOC_RELATIVE then
  1038. begin
  1039. if win32 then
  1040. dec(data,len-4)
  1041. else
  1042. dec(data,len+CurrObjSec.Size);
  1043. end;
  1044. end;
  1045. end
  1046. else
  1047. begin
  1048. if reloctype=RELOC_RVA then
  1049. internalerror(200603033);
  1050. end;
  1051. CurrObjSec.write(data,len);
  1052. end;
  1053. {****************************************************************************
  1054. TDJCoffObjData
  1055. ****************************************************************************}
  1056. constructor TDJCoffObjData.create(const n:string);
  1057. begin
  1058. inherited createcoff(n,false,TCoffObjSection);
  1059. end;
  1060. {****************************************************************************
  1061. TPECoffObjData
  1062. ****************************************************************************}
  1063. constructor TPECoffObjData.create(const n:string);
  1064. begin
  1065. inherited createcoff(n,true,TCoffObjSection);
  1066. end;
  1067. {****************************************************************************
  1068. TCoffObjOutput
  1069. ****************************************************************************}
  1070. constructor TCoffObjOutput.createcoff(AWriter:TObjectWriter;awin32:boolean);
  1071. begin
  1072. inherited create(AWriter);
  1073. win32:=awin32;
  1074. end;
  1075. destructor TCoffObjOutput.destroy;
  1076. begin
  1077. FCoffSyms.free;
  1078. FCoffStrs.free;
  1079. inherited destroy;
  1080. end;
  1081. procedure TCoffObjOutput.write_symbol(const name:string;value:aword;section:smallint;typ,aux:byte);
  1082. var
  1083. sym : coffsymbol;
  1084. begin
  1085. FillChar(sym,sizeof(sym),0);
  1086. { symbolname }
  1087. if length(name)>8 then
  1088. begin
  1089. sym.strpos:=FCoffStrs.size+4;
  1090. FCoffStrs.writestr(name);
  1091. FCoffStrs.writestr(#0);
  1092. end
  1093. else
  1094. move(name[1],sym.name,length(name));
  1095. sym.value:=value;
  1096. sym.section:=section;
  1097. sym.typ:=typ;
  1098. sym.aux:=aux;
  1099. inc(symidx);
  1100. FCoffSyms.write(sym,sizeof(sym));
  1101. end;
  1102. procedure TCoffObjOutput.section_write_symbol(p:TObject;arg:pointer);
  1103. var
  1104. secrec : coffsectionrec;
  1105. begin
  1106. with TCoffObjSection(p) do
  1107. begin
  1108. Inc(plongword(arg)^);
  1109. index:=plongword(arg)^;
  1110. secsymidx:=symidx;
  1111. { Both GNU and Microsoft toolchains write section symbols using
  1112. storage class 3 (STATIC).
  1113. No reason to use COFF_SYM_SECTION, it is silently converted to 3 by
  1114. PE binutils and causes warnings with DJGPP binutils. }
  1115. write_symbol(name,mempos,index,COFF_SYM_LOCAL,1);
  1116. { AUX }
  1117. fillchar(secrec,sizeof(secrec),0);
  1118. secrec.len:=Size;
  1119. if ObjRelocations.count<65535 then
  1120. secrec.nrelocs:=ObjRelocations.count
  1121. else
  1122. secrec.nrelocs:=65535;
  1123. inc(symidx);
  1124. FCoffSyms.write(secrec,sizeof(secrec));
  1125. end;
  1126. end;
  1127. procedure TCoffObjOutput.section_write_relocs(p:TObject;arg:pointer);
  1128. var
  1129. i : longint;
  1130. rel : coffreloc;
  1131. objreloc : TObjRelocation;
  1132. begin
  1133. if (TObjSection(p).ObjRelocations.Count>65535) then
  1134. begin
  1135. rel.address:=TObjSection(p).ObjRelocations.Count+1;
  1136. rel.sym:=0;
  1137. rel.reloctype:=0;
  1138. FWriter.Write(rel,sizeof(rel));
  1139. end;
  1140. for i:=0 to TObjSection(p).ObjRelocations.Count-1 do
  1141. begin
  1142. objreloc:=TObjRelocation(TObjSection(p).ObjRelocations[i]);
  1143. rel.address:=objreloc.dataoffset;
  1144. if assigned(objreloc.symbol) then
  1145. begin
  1146. if (objreloc.symbol.bind=AB_LOCAL) then
  1147. rel.sym:=objreloc.symbol.objsection.secsymidx
  1148. else
  1149. begin
  1150. if objreloc.symbol.symidx=-1 then
  1151. internalerror(200602233);
  1152. rel.sym:=objreloc.symbol.symidx;
  1153. end;
  1154. end
  1155. else
  1156. begin
  1157. if objreloc.objsection<>nil then
  1158. rel.sym:=objreloc.objsection.secsymidx
  1159. else
  1160. rel.sym:=0;
  1161. end;
  1162. case objreloc.typ of
  1163. {$ifdef arm}
  1164. RELOC_ABSOLUTE :
  1165. rel.reloctype:=IMAGE_REL_ARM_ADDR32;
  1166. { I've no idea if this is correct (FK):
  1167. RELOC_RELATIVE :
  1168. rel.reloctype:=IMAGE_REL_ARM_GPREL12;
  1169. }
  1170. RELOC_RVA :
  1171. rel.reloctype:=IMAGE_REL_ARM_ADDR32NB;
  1172. RELOC_SECREL32 :
  1173. rel.reloctype:=IMAGE_REL_ARM_SECREL;
  1174. {$endif arm}
  1175. {$ifdef i386}
  1176. RELOC_RELATIVE :
  1177. rel.reloctype:=IMAGE_REL_I386_PCRLONG;
  1178. RELOC_ABSOLUTE :
  1179. rel.reloctype:=IMAGE_REL_I386_DIR32;
  1180. RELOC_RVA :
  1181. rel.reloctype:=IMAGE_REL_I386_IMAGEBASE;
  1182. RELOC_SECREL32 :
  1183. rel.reloctype:=IMAGE_REL_I386_SECREL32;
  1184. {$endif i386}
  1185. {$ifdef x86_64}
  1186. RELOC_NONE :
  1187. rel.reloctype:=IMAGE_REL_AMD64_ABSOLUTE;
  1188. RELOC_RELATIVE :
  1189. rel.reloctype:=IMAGE_REL_AMD64_REL32;
  1190. RELOC_ABSOLUTE32 :
  1191. rel.reloctype:=IMAGE_REL_AMD64_ADDR32;
  1192. RELOC_ABSOLUTE :
  1193. rel.reloctype:=IMAGE_REL_AMD64_ADDR64;
  1194. RELOC_RVA :
  1195. rel.reloctype:=IMAGE_REL_AMD64_ADDR32NB;
  1196. RELOC_RELATIVE_1 :
  1197. rel.reloctype:=IMAGE_REL_AMD64_REL32_1;
  1198. RELOC_RELATIVE_2 :
  1199. rel.reloctype:=IMAGE_REL_AMD64_REL32_2;
  1200. RELOC_RELATIVE_3 :
  1201. rel.reloctype:=IMAGE_REL_AMD64_REL32_3;
  1202. RELOC_RELATIVE_4 :
  1203. rel.reloctype:=IMAGE_REL_AMD64_REL32_4;
  1204. RELOC_RELATIVE_5 :
  1205. rel.reloctype:=IMAGE_REL_AMD64_REL32_5;
  1206. RELOC_SECREL32 :
  1207. rel.reloctype:=IMAGE_REL_AMD64_SECREL;
  1208. {$endif x86_64}
  1209. else
  1210. internalerror(200905071);
  1211. end;
  1212. FWriter.write(rel,sizeof(rel));
  1213. end;
  1214. end;
  1215. procedure TCoffObjOutput.create_symbols(data:TObjData);
  1216. var
  1217. filename : string[18];
  1218. sectionval : word;
  1219. globalval : byte;
  1220. i : longint;
  1221. value : aword;
  1222. objsym : TObjSymbol;
  1223. secidx : longword;
  1224. begin
  1225. with TCoffObjData(data) do
  1226. begin
  1227. symidx:=0;
  1228. { The `.file' record, and the file name auxiliary record }
  1229. write_symbol('.file', 0, -2, COFF_SYM_FILE, 1);
  1230. fillchar(filename,sizeof(filename),0);
  1231. filename:=ExtractFileName(current_module.mainsource);
  1232. inc(symidx);
  1233. FCoffSyms.write(filename[1],sizeof(filename)-1);
  1234. { Sections }
  1235. secidx:=0;
  1236. ObjSectionList.ForEachCall(@section_write_symbol,@secidx);
  1237. { ObjSymbols }
  1238. for i:=0 to ObjSymbolList.Count-1 do
  1239. begin
  1240. objsym:=TObjSymbol(ObjSymbolList[i]);
  1241. if (objsym.bind=AB_LOCAL) then
  1242. continue;
  1243. case objsym.bind of
  1244. AB_GLOBAL :
  1245. begin
  1246. globalval:=COFF_SYM_GLOBAL;
  1247. sectionval:=objsym.objsection.index;
  1248. value:=objsym.address;
  1249. end;
  1250. AB_LOCAL :
  1251. begin
  1252. globalval:=COFF_SYM_LOCAL;
  1253. sectionval:=objsym.objsection.index;
  1254. value:=objsym.address;
  1255. end;
  1256. else
  1257. begin
  1258. globalval:=COFF_SYM_GLOBAL;
  1259. sectionval:=0;
  1260. value:=objsym.size;
  1261. end;
  1262. end;
  1263. { symbolname }
  1264. objsym.symidx:=symidx;
  1265. write_symbol(objsym.name,value,sectionval,globalval,0);
  1266. end;
  1267. end;
  1268. end;
  1269. procedure TCoffObjOutput.section_set_reloc_datapos(p:TCoffObjSection;var datapos:aword);
  1270. begin
  1271. p.coffrelocpos:=datapos;
  1272. inc(datapos,sizeof(coffreloc)*p.ObjRelocations.count);
  1273. if p.ObjRelocations.count>65535 then
  1274. begin
  1275. if win32 then
  1276. inc(datapos,sizeof(coffreloc))
  1277. else
  1278. Message1(asmw_f_too_many_relocations,p.fullname);
  1279. end;
  1280. end;
  1281. procedure TCoffObjOutput.section_write_header(p:TObject;arg:pointer);
  1282. var
  1283. sechdr : tcoffsechdr;
  1284. s : string;
  1285. strpos : aword;
  1286. begin
  1287. with TCoffObjSection(p) do
  1288. begin
  1289. fillchar(sechdr,sizeof(sechdr),0);
  1290. s:=name;
  1291. if length(s)>8 then
  1292. begin
  1293. strpos:=FCoffStrs.size+4;
  1294. FCoffStrs.writestr(s);
  1295. FCoffStrs.writestr(#0);
  1296. s:='/'+ToStr(strpos);
  1297. end;
  1298. move(s[1],sechdr.name,length(s));
  1299. if not win32 then
  1300. begin
  1301. sechdr.rvaofs:=mempos;
  1302. sechdr.vsize:=mempos;
  1303. end
  1304. else
  1305. begin
  1306. if not(oso_data in secoptions) then
  1307. sechdr.vsize:=Size;
  1308. end;
  1309. sechdr.DataSize:=size;
  1310. if (Size>0) and
  1311. (oso_data in secoptions) then
  1312. sechdr.datapos:=datapos;
  1313. if ObjRelocations.count<65535 then
  1314. sechdr.nrelocs:=ObjRelocations.count
  1315. else
  1316. sechdr.nrelocs:=65535;
  1317. sechdr.relocpos:=coffrelocpos;
  1318. if win32 then
  1319. begin
  1320. sechdr.flags:=peencodesechdrflags(secoptions,secalign);
  1321. if ObjRelocations.count>65535 then
  1322. sechdr.flags:=sechdr.flags or PE_SCN_LNK_NRELOC_OVFL;
  1323. end
  1324. else
  1325. sechdr.flags:=djencodesechdrflags(secoptions);
  1326. FWriter.write(sechdr,sizeof(sechdr));
  1327. end;
  1328. end;
  1329. function TCoffObjOutput.writedata(data:TObjData):boolean;
  1330. var
  1331. datapos,
  1332. sympos : aword;
  1333. i : longint;
  1334. header : tcoffheader;
  1335. begin
  1336. result:=false;
  1337. FCoffSyms:=TDynamicArray.Create(SymbolMaxGrow);
  1338. FCoffStrs:=TDynamicArray.Create(StrsMaxGrow);
  1339. with TCoffObjData(data) do
  1340. begin
  1341. { Create Symbol Table }
  1342. create_symbols(data);
  1343. { Calculate the filepositions }
  1344. datapos:=sizeof(tcoffheader)+sizeof(tcoffsechdr)*ObjSectionList.Count;
  1345. { Sections first }
  1346. layoutsections(datapos);
  1347. { relocs }
  1348. for i:=0 to ObjSectionList.Count-1 do
  1349. section_set_reloc_datapos(TCoffObjSection(ObjSectionList[i]),datapos);
  1350. { Symbols }
  1351. sympos:=datapos;
  1352. { Generate COFF header }
  1353. fillchar(header,sizeof(tcoffheader),0);
  1354. header.mach:=COFF_MAGIC;
  1355. header.nsects:=ObjSectionList.Count;
  1356. header.sympos:=sympos;
  1357. header.syms:=symidx;
  1358. if win32 then
  1359. begin
  1360. {$ifndef x86_64}
  1361. header.flag:=PE_FILE_32BIT_MACHINE or
  1362. PE_FILE_LINE_NUMS_STRIPPED or PE_FILE_LOCAL_SYMS_STRIPPED;
  1363. {$else x86_64}
  1364. header.flag:=PE_FILE_LINE_NUMS_STRIPPED or PE_FILE_LOCAL_SYMS_STRIPPED;
  1365. {$endif x86_64}
  1366. end
  1367. else
  1368. header.flag:=COFF_FLAG_AR32WR or COFF_FLAG_NOLINES or COFF_FLAG_NOLSYMS;
  1369. FWriter.write(header,sizeof(header));
  1370. { Section headers }
  1371. ObjSectionList.ForEachCall(@section_write_header,nil);
  1372. { ObjSections }
  1373. WriteSectionContent(data);
  1374. { Relocs }
  1375. ObjSectionList.ForEachCall(@section_write_relocs,nil);
  1376. { ObjSymbols }
  1377. if Sympos<>FWriter.ObjSize then
  1378. internalerror(200603051);
  1379. FWriter.writearray(FCoffSyms);
  1380. { Strings }
  1381. i:=FCoffStrs.size+4;
  1382. FWriter.write(i,4);
  1383. FWriter.writearray(FCoffStrs);
  1384. end;
  1385. FCoffStrs.Free;
  1386. FCoffStrs:=nil;
  1387. FCoffSyms.Free;
  1388. FCoffSyms:=nil;
  1389. end;
  1390. constructor TDJCoffObjOutput.create(AWriter:TObjectWriter);
  1391. begin
  1392. inherited createcoff(AWriter,false);
  1393. cobjdata:=TDJCoffObjData;
  1394. end;
  1395. constructor TPECoffObjOutput.create(AWriter:TObjectWriter);
  1396. begin
  1397. inherited createcoff(AWriter,true);
  1398. cobjdata:=TPECoffObjData;
  1399. end;
  1400. {****************************************************************************
  1401. TCoffObjInput
  1402. ****************************************************************************}
  1403. constructor TCoffObjInput.createcoff(awin32:boolean);
  1404. begin
  1405. inherited create;
  1406. win32:=awin32;
  1407. FSymTbl:=nil;
  1408. end;
  1409. destructor TCoffObjInput.destroy;
  1410. begin
  1411. FCoffSyms.free;
  1412. if assigned(FCoffStrs) then
  1413. freemem(FCoffStrs);
  1414. if assigned(FSymTbl) then
  1415. freemem(FSymTbl);
  1416. if assigned(FSecTbl) then
  1417. freemem(FSecTbl);
  1418. inherited destroy;
  1419. end;
  1420. function TCoffObjInput.GetSection(secidx:longint):TObjSection;
  1421. begin
  1422. result:=nil;
  1423. if (secidx<1) or (secidx>FSecCount) then
  1424. begin
  1425. InputError('Failed reading coff file, invalid section index');
  1426. exit;
  1427. end;
  1428. result:=FSecTbl^[secidx];
  1429. end;
  1430. function TCoffObjInput.Read_str(strpos:longword):string;
  1431. begin
  1432. if (FCoffStrs=nil) or (strpos>=FCoffStrSize) or (FCoffStrs[strpos]=#0) then
  1433. Internalerror(200205172);
  1434. result:=string(PChar(@FCoffStrs[strpos]));
  1435. end;
  1436. procedure TCoffObjInput.read_relocs(s:TCoffObjSection);
  1437. var
  1438. rel : coffreloc;
  1439. rel_type : TObjRelocationType;
  1440. i : longint;
  1441. p : TObjSymbol;
  1442. begin
  1443. if s.coffrelocs=high(aword) then
  1444. begin
  1445. { If number of relocations exceeds 65535, it is stored in address field
  1446. of the first record, and includes this first fake relocation. }
  1447. FReader.read(rel,sizeof(rel));
  1448. s.coffrelocs:=rel.address-1;
  1449. if s.coffrelocs<=65535 then
  1450. InternalError(2013012503);
  1451. end;
  1452. for i:=1 to s.coffrelocs do
  1453. begin
  1454. FReader.read(rel,sizeof(rel));
  1455. case rel.reloctype of
  1456. {$ifdef arm}
  1457. IMAGE_REL_ARM_ABSOLUTE:
  1458. rel_type:=RELOC_NONE;
  1459. IMAGE_REL_ARM_ADDR32:
  1460. rel_type:=RELOC_ABSOLUTE;
  1461. IMAGE_REL_ARM_ADDR32NB:
  1462. rel_type:=RELOC_RVA;
  1463. IMAGE_REL_ARM_BRANCH24:
  1464. rel_type:=RELOC_RELATIVE_24;
  1465. IMAGE_REL_ARM_SECREL:
  1466. rel_type:=RELOC_SECREL32;
  1467. {$endif arm}
  1468. {$ifdef i386}
  1469. IMAGE_REL_I386_PCRLONG :
  1470. rel_type:=RELOC_RELATIVE;
  1471. IMAGE_REL_I386_DIR32 :
  1472. rel_type:=RELOC_ABSOLUTE;
  1473. IMAGE_REL_I386_IMAGEBASE :
  1474. rel_type:=RELOC_RVA;
  1475. IMAGE_REL_I386_SECREL32 :
  1476. rel_type:=RELOC_SECREL32;
  1477. {$endif i386}
  1478. {$ifdef x86_64}
  1479. IMAGE_REL_AMD64_ABSOLUTE:
  1480. rel_type:=RELOC_NONE;
  1481. IMAGE_REL_AMD64_REL32:
  1482. rel_type:=RELOC_RELATIVE;
  1483. IMAGE_REL_AMD64_ADDR32,
  1484. R_X86_64_32S:
  1485. rel_type:=RELOC_ABSOLUTE32;
  1486. IMAGE_REL_AMD64_ADDR64:
  1487. rel_type:=RELOC_ABSOLUTE;
  1488. IMAGE_REL_AMD64_ADDR32NB:
  1489. rel_type:=RELOC_RVA;
  1490. IMAGE_REL_AMD64_REL32_1:
  1491. rel_type:=RELOC_RELATIVE_1;
  1492. IMAGE_REL_AMD64_REL32_2:
  1493. rel_type:=RELOC_RELATIVE_2;
  1494. IMAGE_REL_AMD64_REL32_3:
  1495. rel_type:=RELOC_RELATIVE_3;
  1496. IMAGE_REL_AMD64_REL32_4:
  1497. rel_type:=RELOC_RELATIVE_4;
  1498. IMAGE_REL_AMD64_REL32_5:
  1499. rel_type:=RELOC_RELATIVE_5;
  1500. IMAGE_REL_AMD64_SECREL:
  1501. rel_type:=RELOC_SECREL32;
  1502. {$endif x86_64}
  1503. else
  1504. begin
  1505. InputError('Failed reading coff file, illegal reloctype $'+system.hexstr(rel.reloctype,4));
  1506. exit;
  1507. end;
  1508. end;
  1509. p:=FSymTbl^[rel.sym];
  1510. if assigned(p) then
  1511. s.addsymreloc(rel.address-s.mempos,p,rel_type)
  1512. else
  1513. begin
  1514. InputError('Failed reading coff file, can''t resolve symbol of relocation');
  1515. exit;
  1516. end;
  1517. end;
  1518. end;
  1519. procedure TCoffObjInput.read_symbols(objdata:TObjData);
  1520. var
  1521. size,
  1522. address,
  1523. nsyms,
  1524. symidx : aint;
  1525. i : longint;
  1526. sym : coffsymbol;
  1527. objsym : TObjSymbol;
  1528. bind : Tasmsymbind;
  1529. strname : string;
  1530. auxrec : array[0..17] of byte;
  1531. objsec : TObjSection;
  1532. begin
  1533. with TCoffObjData(objdata) do
  1534. begin
  1535. nsyms:=FCoffSyms.Size div sizeof(CoffSymbol);
  1536. { Allocate memory for symidx -> TObjSymbol table }
  1537. FSymTbl:=AllocMem(nsyms*sizeof(TObjSymbol));
  1538. { Load the Symbols }
  1539. FCoffSyms.Seek(0);
  1540. symidx:=0;
  1541. while (symidx<nsyms) do
  1542. begin
  1543. FCoffSyms.Read(sym,sizeof(sym));
  1544. if plongint(@sym.name)^<>0 then
  1545. begin
  1546. move(sym.name,strname[1],8);
  1547. strname[9]:=#0;
  1548. strname[0]:=chr(strlen(@strname[1]));
  1549. if strname='' then
  1550. Internalerror(200205171);
  1551. end
  1552. else
  1553. strname:=Read_str(sym.strpos);
  1554. bind:=AB_EXTERNAL;
  1555. size:=0;
  1556. address:=0;
  1557. objsym:=nil;
  1558. objsec:=nil;
  1559. case sym.typ of
  1560. COFF_SYM_GLOBAL :
  1561. begin
  1562. if sym.section=0 then
  1563. begin
  1564. if sym.value=0 then
  1565. bind:=AB_EXTERNAL
  1566. else
  1567. begin
  1568. bind:=AB_COMMON;
  1569. size:=sym.value;
  1570. end;
  1571. end
  1572. else
  1573. begin
  1574. bind:=AB_GLOBAL;
  1575. objsec:=GetSection(sym.section);
  1576. if sym.value>=objsec.mempos then
  1577. address:=sym.value-objsec.mempos;
  1578. end;
  1579. objsym:=CreateSymbol(strname);
  1580. objsym.bind:=bind;
  1581. objsym.typ:=AT_FUNCTION;
  1582. objsym.objsection:=objsec;
  1583. objsym.offset:=address;
  1584. objsym.size:=size;
  1585. end;
  1586. COFF_SYM_LABEL,
  1587. COFF_SYM_LOCAL :
  1588. begin
  1589. { do not add constants (section=-1) }
  1590. if sym.section<>-1 then
  1591. begin
  1592. objsec:=GetSection(sym.section);
  1593. if sym.value>=objsec.mempos then
  1594. address:=sym.value-objsec.mempos;
  1595. objsym:=CreateSymbol(strname);
  1596. objsym.bind:=AB_LOCAL;
  1597. objsym.typ:=AT_FUNCTION;
  1598. objsym.objsection:=objsec;
  1599. objsym.offset:=address;
  1600. objsym.size:=size;
  1601. end;
  1602. end;
  1603. COFF_SYM_SECTION :
  1604. begin
  1605. if sym.section=0 then
  1606. InputError('Failed reading coff file, illegal section');
  1607. objsec:=GetSection(sym.section);
  1608. if assigned(objsec) then
  1609. begin
  1610. if sym.value>=objsec.mempos then
  1611. address:=sym.value-objsec.mempos;
  1612. objsym:=CreateSymbol(strname);
  1613. objsym.bind:=AB_LOCAL;
  1614. objsym.typ:=AT_FUNCTION;
  1615. objsym.objsection:=objsec;
  1616. objsym.offset:=address;
  1617. objsym.size:=size;
  1618. end;
  1619. end;
  1620. COFF_SYM_FUNCTION,
  1621. COFF_SYM_FILE :
  1622. ;
  1623. else
  1624. internalerror(200602232);
  1625. end;
  1626. FSymTbl^[symidx]:=objsym;
  1627. { read aux records }
  1628. for i:=1 to sym.aux do
  1629. begin
  1630. FCoffSyms.Read(auxrec,sizeof(auxrec));
  1631. inc(symidx);
  1632. end;
  1633. inc(symidx);
  1634. end;
  1635. end;
  1636. end;
  1637. procedure TCoffObjInput.ObjSections_read_relocs(p:TObject;arg:pointer);
  1638. begin
  1639. with TCoffObjSection(p) do
  1640. begin
  1641. { Skip debug sections }
  1642. if (oso_debug in secoptions) and
  1643. (cs_link_strip in current_settings.globalswitches) and
  1644. not(cs_link_separate_dbg_file in current_settings.globalswitches) then
  1645. exit;
  1646. if coffrelocs>0 then
  1647. begin
  1648. FReader.Seek(coffrelocpos);
  1649. read_relocs(TCoffObjSection(p));
  1650. end;
  1651. end;
  1652. end;
  1653. function TCoffObjInput.ReadObjData(AReader:TObjectreader;out objdata:TObjData):boolean;
  1654. var
  1655. secalign : shortint;
  1656. strpos,
  1657. i : longint;
  1658. code : longint;
  1659. objsec : TCoffObjSection;
  1660. secoptions : TObjSectionOptions;
  1661. header : tcoffheader;
  1662. sechdr : tcoffsechdr;
  1663. secname : string;
  1664. secnamebuf : array[0..15] of char;
  1665. begin
  1666. FReader:=AReader;
  1667. InputFileName:=AReader.FileName;
  1668. objdata:=CObjData.Create(InputFileName);
  1669. result:=false;
  1670. FCoffSyms:=TDynamicArray.Create(SymbolMaxGrow);
  1671. with TCoffObjData(objdata) do
  1672. begin
  1673. { Read COFF header }
  1674. if not AReader.read(header,sizeof(tcoffheader)) then
  1675. begin
  1676. InputError('Can''t read COFF Header');
  1677. exit;
  1678. end;
  1679. if header.mach<>COFF_MAGIC then
  1680. begin
  1681. InputError('Illegal COFF Magic');
  1682. exit;
  1683. end;
  1684. {$ifdef arm}
  1685. eVCobj:=header.flag=$100;
  1686. {$endif arm}
  1687. { ObjSymbols }
  1688. AReader.Seek(header.sympos);
  1689. if not AReader.ReadArray(FCoffSyms,header.syms*sizeof(CoffSymbol)) then
  1690. begin
  1691. InputError('Error reading coff symbol table');
  1692. exit;
  1693. end;
  1694. { Strings }
  1695. if not AReader.Read(FCoffStrSize,4) then
  1696. begin
  1697. InputError('Error reading COFF string table');
  1698. exit;
  1699. end;
  1700. if (FCoffStrSize>4) then
  1701. begin
  1702. { allocate an extra byte and null-terminate }
  1703. GetMem(FCoffStrs,FCoffStrSize+1);
  1704. FCoffStrs[FCoffStrSize]:=#0;
  1705. for i:=0 to 3 do
  1706. FCoffStrs[i]:=#0;
  1707. if not AReader.Read(FCoffStrs[4],FCoffStrSize-4) then
  1708. begin
  1709. InputError('Error reading COFF string table');
  1710. exit;
  1711. end;
  1712. end;
  1713. { Section headers }
  1714. { Allocate SecIdx -> TObjSection table, secidx is 1-based }
  1715. FSecCount:=header.nsects;
  1716. FSecTbl:=AllocMem((header.nsects+1)*sizeof(TObjSection));
  1717. AReader.Seek(sizeof(tcoffheader)+header.opthdr);
  1718. for i:=1 to header.nsects do
  1719. begin
  1720. if not AReader.read(sechdr,sizeof(sechdr)) then
  1721. begin
  1722. InputError('Error reading COFF Section Headers');
  1723. exit;
  1724. end;
  1725. move(sechdr.name,secnamebuf,8);
  1726. secnamebuf[8]:=#0;
  1727. secname:=strpas(secnamebuf);
  1728. if secname[1]='/' then
  1729. begin
  1730. Val(Copy(secname,2,8),strpos,code);
  1731. if code=0 then
  1732. secname:=Read_str(strpos)
  1733. else
  1734. begin
  1735. InputError('Error reading COFF Section Headers');
  1736. secname:='error';
  1737. end;
  1738. end;
  1739. if win32 then
  1740. pedecodesechdrflags(secname,sechdr.flags,secoptions,secalign)
  1741. else
  1742. begin
  1743. secoptions:=djdecodesechdrflags(secname,sechdr.flags);
  1744. secalign:=sizeof(pint);
  1745. end;
  1746. if (Length(secname)>3) and (secname[2] in ['e','f','i','p','r']) then
  1747. begin
  1748. if (Pos('.edata',secname)=1) or
  1749. (Pos('.rsrc',secname)=1) or
  1750. {$ifndef x86_64}
  1751. (Pos('.pdata',secname)=1) or
  1752. {$endif}
  1753. (Pos('.fpc',secname)=1) then
  1754. include(secoptions,oso_keep);
  1755. if (Pos('.idata',secname)=1) then
  1756. begin
  1757. { TODO: idata keep can maybe replaced with grouping of text and idata}
  1758. include(secoptions,oso_keep);
  1759. secname:=secname + '.' + ExtractFileName(InputFileName);
  1760. end;
  1761. end;
  1762. objsec:=TCoffObjSection(createsection(secname,secalign,secoptions,false));
  1763. FSecTbl^[i]:=objsec;
  1764. if not win32 then
  1765. objsec.mempos:=sechdr.rvaofs;
  1766. objsec.orgmempos:=sechdr.rvaofs;
  1767. objsec.coffrelocs:=sechdr.nrelocs;
  1768. if win32 then
  1769. begin
  1770. if (sechdr.flags and PE_SCN_LNK_NRELOC_OVFL)<>0 then
  1771. objsec.coffrelocs:=high(aword);
  1772. end;
  1773. objsec.coffrelocpos:=sechdr.relocpos;
  1774. objsec.datapos:=sechdr.datapos;
  1775. objsec.Size:=sechdr.dataSize;
  1776. end;
  1777. { Insert all ObjSymbols }
  1778. read_symbols(objdata);
  1779. { Section Data }
  1780. ReadSectionContent(objdata);
  1781. { Relocs }
  1782. ObjSectionList.ForEachCall(@objsections_read_relocs,nil);
  1783. end;
  1784. if assigned(FCoffStrs) then
  1785. freemem(FCoffStrs);
  1786. FCoffStrs:=nil;
  1787. FCoffSyms.Free;
  1788. FCoffSyms:=nil;
  1789. result:=true;
  1790. end;
  1791. constructor TDJCoffObjInput.create;
  1792. begin
  1793. inherited createcoff(false);
  1794. cobjdata:=TDJCoffObjData;
  1795. end;
  1796. constructor TPECoffObjInput.create;
  1797. begin
  1798. inherited createcoff(true);
  1799. cobjdata:=TPECoffObjData;
  1800. end;
  1801. {****************************************************************************
  1802. TCoffexeoutput
  1803. ****************************************************************************}
  1804. constructor TCoffexeoutput.createcoff(awin32:boolean);
  1805. begin
  1806. inherited create;
  1807. win32:=awin32;
  1808. if target_info.system in [system_x86_64_win64] then
  1809. MaxMemPos:=$FFFFFFFF
  1810. else
  1811. if target_info.system in systems_wince then
  1812. MaxMemPos:=$1FFFFFF
  1813. else
  1814. MaxMemPos:=$7FFFFFFF;
  1815. end;
  1816. procedure TCoffexeoutput.write_symbol(const name:string;value:aword;section:smallint;typ,aux:byte);
  1817. var
  1818. sym : coffsymbol;
  1819. begin
  1820. FillChar(sym,sizeof(sym),0);
  1821. if length(name)>8 then
  1822. begin
  1823. sym.strpos:=FCoffStrs.size+4;
  1824. FCoffStrs.writestr(name);
  1825. FCoffStrs.writestr(#0);
  1826. end
  1827. else
  1828. move(name[1],sym.name,length(name));
  1829. sym.value:=value;
  1830. sym.section:=section;
  1831. sym.typ:=typ;
  1832. sym.aux:=aux;
  1833. FWriter.write(sym,sizeof(sym));
  1834. end;
  1835. procedure TCoffexeoutput.globalsyms_write_symbol(p:TObject;arg:pointer);
  1836. var
  1837. secval,
  1838. value : aint;
  1839. globalval : byte;
  1840. exesec : TExeSection;
  1841. begin
  1842. if not assigned(texesymbol(p).objsymbol) then
  1843. internalerror(200603053);
  1844. with texesymbol(p).objsymbol do
  1845. begin
  1846. exesec:=TExeSection(objsection.exesection);
  1847. { There is no exesection defined for special internal symbols
  1848. like __image_base__ }
  1849. if assigned(exesec) then
  1850. begin
  1851. secval:=exesec.secsymidx;
  1852. if win32 then
  1853. value:=address-exesec.mempos
  1854. else
  1855. value:=address;
  1856. end
  1857. else
  1858. begin
  1859. secval:=-1;
  1860. value:=address;
  1861. end;
  1862. if bind=AB_LOCAL then
  1863. globalval:=COFF_SYM_LOCAL
  1864. else
  1865. globalval:=COFF_SYM_GLOBAL;
  1866. { reloctype address to the section in the executable }
  1867. write_symbol(name,value,secval,globalval,0);
  1868. end;
  1869. end;
  1870. procedure TCoffexeoutput.ExeSectionList_write_header(p:TObject;arg:pointer);
  1871. var
  1872. sechdr : tcoffsechdr;
  1873. s : string;
  1874. strpos : aword;
  1875. begin
  1876. with tExeSection(p) do
  1877. begin
  1878. fillchar(sechdr,sizeof(sechdr),0);
  1879. s:=name;
  1880. if length(s)>8 then
  1881. begin
  1882. strpos:=FCoffStrs.size+4;
  1883. FCoffStrs.writestr(s);
  1884. FCoffStrs.writestr(#0);
  1885. s:='/'+ToStr(strpos);
  1886. end;
  1887. move(s[1],sechdr.name,length(s));
  1888. if win32 then
  1889. begin
  1890. sechdr.rvaofs:=mempos;
  1891. sechdr.vsize:=Size;
  1892. { sechdr.dataSize is size of initialized data, rounded up to FileAlignment
  1893. (so it can be greater than VirtualSize). Must be zero for sections that
  1894. do not contain initialized data. }
  1895. if (oso_data in SecOptions) then
  1896. sechdr.datasize:=Align(Size,SectionDataAlign);
  1897. end
  1898. else
  1899. begin
  1900. if not (oso_debug in SecOptions) then
  1901. begin
  1902. sechdr.rvaofs:=mempos;
  1903. sechdr.vsize:=mempos;
  1904. end;
  1905. sechdr.datasize:=Size;
  1906. end;
  1907. if (Size>0) then
  1908. sechdr.datapos:=datapos-datapos_offset;
  1909. sechdr.nrelocs:=0;
  1910. sechdr.relocpos:=0;
  1911. if win32 then
  1912. begin
  1913. if (target_info.system in systems_nativent) and
  1914. (apptype = app_native) then
  1915. sechdr.flags:=peencodesechdrflags(SecOptions,SecAlign) or PE_SCN_MEM_NOT_PAGED
  1916. else
  1917. sechdr.flags:=peencodesechdrflags(SecOptions,SecAlign);
  1918. { some flags are invalid in executables, reset them }
  1919. sechdr.flags:=sechdr.flags and
  1920. not(PE_SCN_LNK_INFO or PE_SCN_LNK_REMOVE or
  1921. PE_SCN_LNK_COMDAT or PE_SCN_ALIGN_MASK);
  1922. end
  1923. else
  1924. sechdr.flags:=djencodesechdrflags(SecOptions);
  1925. FWriter.write(sechdr,sizeof(sechdr));
  1926. end;
  1927. end;
  1928. procedure TCoffexeoutput.ExeSectionList_pass2_header(p:TObject;arg:pointer);
  1929. begin
  1930. with TExeSection(p) do
  1931. begin
  1932. { The debuginfo sections should already be stripped }
  1933. { if (ExeWriteMode=ewm_exeonly) and
  1934. (oso_debug in SecOptions) then
  1935. internalerror(200801161); }
  1936. inc(plongint(arg)^);
  1937. secsymidx:=plongint(arg)^;
  1938. end;
  1939. end;
  1940. function tcoffexeoutput.totalheadersize:longword;
  1941. var
  1942. stubsize,
  1943. optheadersize : longword;
  1944. begin
  1945. if win32 then
  1946. begin
  1947. stubsize:=sizeof(win32stub)+sizeof(pemagic);
  1948. optheadersize:=sizeof(tcoffpeoptheader);
  1949. end
  1950. else
  1951. begin
  1952. stubsize:=sizeof(go32v2stub);
  1953. optheadersize:=sizeof(coffdjoptheader);
  1954. end;
  1955. result:=stubsize+sizeof(tcoffheader)+optheadersize;
  1956. end;
  1957. procedure tcoffexeoutput.MemPos_Header;
  1958. begin
  1959. { calculate start positions after the headers }
  1960. currmempos:=totalheadersize+sizeof(tcoffsechdr)*longword(ExeSectionList.Count-2);
  1961. end;
  1962. procedure tcoffexeoutput.DataPos_Header;
  1963. begin
  1964. { retrieve amount of sections }
  1965. nsects:=0;
  1966. ExeSectionList.ForEachCall(@ExeSectionList_pass2_header,@nsects);
  1967. { calculate start positions after the headers }
  1968. currdatapos:=totalheadersize+longword(nsects)*sizeof(tcoffsechdr);
  1969. end;
  1970. procedure tcoffexeoutput.DataPos_Symbols;
  1971. begin
  1972. inherited DataPos_Symbols;
  1973. { Calculating symbols position and size }
  1974. nsyms:=ExeSymbolList.Count;
  1975. sympos:=Align(CurrDataPos,SectionDataAlign);
  1976. inc(CurrDataPos,sizeof(coffsymbol)*nsyms);
  1977. end;
  1978. function TCoffexeoutput.writedata:boolean;
  1979. var
  1980. i : longword;
  1981. header : tcoffheader;
  1982. djoptheader : coffdjoptheader;
  1983. peoptheader : tcoffpeoptheader;
  1984. textExeSec,
  1985. dataExeSec,
  1986. bssExeSec,
  1987. idataExeSec,
  1988. tlsExeSec : TExeSection;
  1989. tlsdir : TlsDirectory;
  1990. hassymbols,
  1991. writeDbgStrings : boolean;
  1992. procedure UpdateDataDir(const secname:string;idx:longint);
  1993. var
  1994. exesec : TExeSection;
  1995. begin
  1996. exesec:=FindExeSection(secname);
  1997. if assigned(exesec) then
  1998. begin
  1999. peoptheader.DataDirectory[idx].vaddr:=exesec.mempos;
  2000. peoptheader.DataDirectory[idx].size:=exesec.Size;
  2001. end;
  2002. end;
  2003. procedure UpdateImports;
  2004. var
  2005. exesec: TExeSection;
  2006. objsec, iat_start, iat_end, ilt_start: TObjSection;
  2007. i: longint;
  2008. begin
  2009. exesec:=FindExeSection('.idata');
  2010. if exesec=nil then
  2011. exit;
  2012. iat_start:=nil;
  2013. iat_end:=nil;
  2014. ilt_start:=nil;
  2015. for i:=0 to exesec.ObjSectionList.Count-1 do
  2016. begin
  2017. objsec:=TObjSection(exesec.ObjSectionList[i]);
  2018. if (ilt_start=nil) and (Pos('.idata$4',objsec.Name)=1) then
  2019. ilt_start:=objsec;
  2020. if Pos('.idata$5',objsec.Name)=1 then
  2021. begin
  2022. if iat_start=nil then
  2023. iat_start:=objsec;
  2024. end
  2025. else
  2026. if Assigned(iat_start) then
  2027. begin
  2028. iat_end:=objsec;
  2029. Break;
  2030. end;
  2031. end;
  2032. peoptheader.DataDirectory[PE_DATADIR_IDATA].vaddr:=exesec.mempos;
  2033. if Assigned(ilt_start) then
  2034. peoptheader.DataDirectory[PE_DATADIR_IDATA].size:=ilt_start.mempos-exesec.mempos
  2035. else { should not happen }
  2036. peoptheader.DataDirectory[PE_DATADIR_IDATA].size:=exesec.Size;
  2037. if Assigned(iat_start) and Assigned(iat_end) then
  2038. begin
  2039. peoptheader.DataDirectory[PE_DATADIR_IMPORTADDRESSTABLE].vaddr:=iat_start.mempos;
  2040. peoptheader.DataDirectory[PE_DATADIR_IMPORTADDRESSTABLE].size:=iat_end.mempos-iat_start.mempos;
  2041. end;
  2042. end;
  2043. procedure UpdateTlsDataDir;
  2044. var
  2045. {callbacksection : TExeSection;}
  2046. tlsexesymbol: TExeSymbol;
  2047. tlssymbol: TObjSymbol;
  2048. callbackexesymbol: TExeSymbol;
  2049. callbacksymbol: TObjSymbol;
  2050. begin
  2051. { according to GNU ld,
  2052. the callback routines should be placed into .CRT$XL*
  2053. sections, and the thread local variables in .tls
  2054. __tls_start__ and __tls_end__ symbols
  2055. should be used for the initialized part,
  2056. which we do not support yet. }
  2057. { For now, we only pass the address of the __tls_used
  2058. asm symbol into PE_DATADIR_TLS with the correct
  2059. size of this table (different for win32/win64 }
  2060. tlsexesymbol:=texesymbol(ExeSymbolList.Find(
  2061. target_info.Cprefix+'_tls_used'));
  2062. if assigned(tlsexesymbol) then
  2063. begin
  2064. tlssymbol:=tlsexesymbol.ObjSymbol;
  2065. peoptheader.DataDirectory[PE_DATADIR_TLS].vaddr:=tlssymbol.address;
  2066. { sizeof(TlsDirectory) is different on host and target when cross-compiling }
  2067. peoptheader.DataDirectory[PE_DATADIR_TLS].size:=TLSDIR_SIZE;
  2068. if IsSharedLibrary then
  2069. begin
  2070. { Here we should reset __FPC_tls_callbacks value to nil }
  2071. callbackexesymbol:=texesymbol(ExeSymbolList.Find(
  2072. '__FPC_tls_callbacks'));
  2073. if assigned (callbackexesymbol) then
  2074. begin
  2075. callbacksymbol:=callbackexesymbol.ObjSymbol;
  2076. end;
  2077. end;
  2078. end;
  2079. end;
  2080. begin
  2081. result:=false;
  2082. FCoffStrs:=TDynamicArray.Create(StrsMaxGrow);
  2083. textExeSec:=FindExeSection('.text');
  2084. dataExeSec:=FindExeSection('.data');
  2085. bssExeSec:=FindExeSection('.bss');
  2086. tlsExeSec:=FindExeSection('.tls');
  2087. if not assigned(TextExeSec) or
  2088. not assigned(DataExeSec) then
  2089. internalerror(200602231);
  2090. { do we need to write symbols? }
  2091. hassymbols:=(ExeWriteMode=ewm_dbgonly) or
  2092. (
  2093. (ExeWriteMode=ewm_exefull) and
  2094. not(cs_link_strip in current_settings.globalswitches)
  2095. );
  2096. writeDbgStrings:=hassymbols or ((ExeWriteMode=ewm_exeonly) and (cs_link_separate_dbg_file in current_settings.globalswitches));
  2097. { Stub }
  2098. if win32 then
  2099. begin
  2100. FWriter.write(win32stub,sizeof(win32stub));
  2101. FWriter.write(pemagic,sizeof(pemagic));
  2102. end
  2103. else
  2104. FWriter.write(go32v2stub,sizeof(go32v2stub));
  2105. { Initial header, will be updated later }
  2106. fillchar(header,sizeof(header),0);
  2107. header.mach:=COFF_MAGIC;
  2108. header.nsects:=nsects;
  2109. if writeDbgStrings then
  2110. header.sympos:=sympos-datapos_offset;
  2111. if hassymbols then
  2112. header.syms:=nsyms;
  2113. if win32 then
  2114. header.opthdr:=sizeof(tcoffpeoptheader)
  2115. else
  2116. header.opthdr:=sizeof(coffdjoptheader);
  2117. if win32 then
  2118. begin
  2119. header.flag:=PE_FILE_EXECUTABLE_IMAGE or PE_FILE_LINE_NUMS_STRIPPED;
  2120. if target_info.system in [system_x86_64_win64] then
  2121. header.flag:=header.flag or PE_FILE_LARGE_ADDRESS_AWARE
  2122. else
  2123. header.flag:=header.flag or PE_FILE_32BIT_MACHINE;
  2124. if IsSharedLibrary then
  2125. header.flag:=header.flag or PE_FILE_DLL;
  2126. if FindExeSection('.reloc')=nil then
  2127. header.flag:=header.flag or PE_FILE_RELOCS_STRIPPED;
  2128. if (FindExeSection('.stab')=nil) and
  2129. (FindExeSection('.debug_info')=nil) and
  2130. (FindExeSection('.gnu_debuglink')=nil) then
  2131. header.flag:=header.flag or PE_FILE_DEBUG_STRIPPED;
  2132. if not hassymbols then
  2133. header.flag:=header.flag or PE_FILE_LOCAL_SYMS_STRIPPED;
  2134. if SetPEFlagsSetExplicity then
  2135. header.flag:=header.flag or peflags;
  2136. end
  2137. else
  2138. header.flag:=COFF_FLAG_AR32WR or COFF_FLAG_EXE or COFF_FLAG_NORELOCS or COFF_FLAG_NOLINES;
  2139. FWriter.write(header,sizeof(header));
  2140. { Optional COFF Header }
  2141. if win32 then
  2142. begin
  2143. fillchar(peoptheader,sizeof(peoptheader),0);
  2144. peoptheader.magic:=COFF_OPT_MAGIC;
  2145. peoptheader.MajorLinkerVersion:=ord(version_nr)-ord('0');
  2146. peoptheader.MinorLinkerVersion:=(ord(release_nr)-ord('0'))*10 + (ord(patch_nr)-ord('0'));
  2147. peoptheader.tsize:=TextExeSec.Size;
  2148. peoptheader.dsize:=DataExeSec.Size;
  2149. if assigned(BSSExeSec) then
  2150. peoptheader.bsize:=BSSExeSec.Size;
  2151. peoptheader.text_start:=TextExeSec.mempos;
  2152. {$ifndef cpu64bitaddr}
  2153. peoptheader.data_start:=DataExeSec.mempos;
  2154. {$endif cpu64bitaddr}
  2155. peoptheader.entry:=EntrySym.Address;
  2156. peoptheader.ImageBase:=ImageBase;
  2157. peoptheader.SectionAlignment:=SectionMemAlign;
  2158. peoptheader.FileAlignment:=SectionDataAlign;
  2159. peoptheader.MajorOperatingSystemVersion:=4;
  2160. peoptheader.MinorOperatingSystemVersion:=0;
  2161. peoptheader.MajorImageVersion:=dllmajor;
  2162. peoptheader.MinorImageVersion:=dllminor;
  2163. if target_info.system in systems_wince then
  2164. peoptheader.MajorSubsystemVersion:=3
  2165. else
  2166. peoptheader.MajorSubsystemVersion:=4;
  2167. peoptheader.MinorSubsystemVersion:=0;
  2168. peoptheader.Win32Version:=0;
  2169. peoptheader.SizeOfImage:=Align(CurrMemPos,SectionMemAlign);
  2170. peoptheader.SizeOfHeaders:=textExeSec.DataPos;
  2171. peoptheader.CheckSum:=0;
  2172. if (target_info.system in systems_nativent) and (not IsSharedLibrary or (apptype = app_native)) then
  2173. { Although I did not really test this, it seems that Subsystem is
  2174. not checked in DLLs except for maybe drivers}
  2175. peoptheader.Subsystem:=PE_SUBSYSTEM_NATIVE
  2176. else
  2177. if target_info.system in systems_wince then
  2178. peoptheader.Subsystem:=PE_SUBSYSTEM_WINDOWS_CE_GUI
  2179. else
  2180. if apptype=app_gui then
  2181. peoptheader.Subsystem:=PE_SUBSYSTEM_WINDOWS_GUI
  2182. else
  2183. peoptheader.Subsystem:=PE_SUBSYSTEM_WINDOWS_CUI;
  2184. if SetPEOptFlagsSetExplicity then
  2185. peoptheader.DllCharacteristics:=peoptflags
  2186. else
  2187. peoptheader.DllCharacteristics:=0;
  2188. peoptheader.SizeOfStackReserve:=stacksize;
  2189. peoptheader.SizeOfStackCommit:=$1000;
  2190. if MinStackSizeSetExplicity then
  2191. peoptheader.SizeOfStackCommit:=minstacksize;
  2192. if MaxStackSizeSetExplicity then
  2193. peoptheader.SizeOfStackReserve:=maxstacksize;
  2194. peoptheader.SizeOfHeapReserve:=$100000;
  2195. peoptheader.SizeOfHeapCommit:=$1000;
  2196. peoptheader.NumberOfRvaAndSizes:=PE_DATADIR_ENTRIES;
  2197. UpdateImports;
  2198. UpdateTlsDataDir;
  2199. UpdateDataDir('.edata',PE_DATADIR_EDATA);
  2200. UpdateDataDir('.rsrc',PE_DATADIR_RSRC);
  2201. UpdateDataDir('.pdata',PE_DATADIR_PDATA);
  2202. UpdateDataDir('.reloc',PE_DATADIR_RELOC);
  2203. FWriter.write(peoptheader,sizeof(peoptheader));
  2204. end
  2205. else
  2206. begin
  2207. fillchar(djoptheader,sizeof(djoptheader),0);
  2208. djoptheader.magic:=COFF_OPT_MAGIC;
  2209. djoptheader.tsize:=TextExeSec.Size;
  2210. djoptheader.dsize:=DataExeSec.Size;
  2211. if assigned(BSSExeSec) then
  2212. djoptheader.bsize:=BSSExeSec.Size;
  2213. djoptheader.text_start:=TextExeSec.mempos;
  2214. djoptheader.data_start:=DataExeSec.mempos;
  2215. djoptheader.entry:=EntrySym.Address;
  2216. FWriter.write(djoptheader,sizeof(djoptheader));
  2217. end;
  2218. { For some unknown reason WM 6.1 requires .idata section to be read only.
  2219. Otherwise it refuses to load DLLs greater than 64KB.
  2220. Earlier versions of WinCE load DLLs regardless of .idata flags. }
  2221. if target_info.system in systems_wince then
  2222. begin
  2223. idataExeSec:=FindExeSection('.idata');
  2224. if idataExeSec<>nil then
  2225. idataExeSec.SecOptions:=idataExeSec.SecOptions - [oso_write];
  2226. end;
  2227. { Section headers }
  2228. ExeSectionList.ForEachCall(@ExeSectionList_write_header,nil);
  2229. { Section data }
  2230. WriteExeSectionContent;
  2231. { Align after the last section }
  2232. FWriter.Writezeros(Align(FWriter.Size,SectionDataAlign)-FWriter.Size);
  2233. { Optional Symbols }
  2234. if SymPos<>FWriter.Size then
  2235. internalerror(200602252);
  2236. if hassymbols then
  2237. ExeSymbolList.ForEachCall(@globalsyms_write_symbol,nil);
  2238. if writeDbgStrings then
  2239. begin
  2240. { Strings }
  2241. i:=FCoffStrs.size+4;
  2242. FWriter.write(i,4);
  2243. FWriter.writearray(FCoffStrs);
  2244. end;
  2245. { Release }
  2246. FCoffStrs.Free;
  2247. result:=true;
  2248. end;
  2249. function IdataObjSectionCompare(Item1, Item2: Pointer): Integer;
  2250. var
  2251. I1 : TObjSection absolute Item1;
  2252. I2 : TObjSection absolute Item2;
  2253. begin
  2254. Result:=CompareStr(I1.Name,I2.Name);
  2255. end;
  2256. procedure TCoffexeoutput.Order_ObjSectionList(ObjSectionList: TFPObjectList;const aPattern:string);
  2257. begin
  2258. { Sort sections having '$' in the name, that's how PECOFF documentation
  2259. tells to handle them. However, look for '$' in the pattern, not in section
  2260. names, because the latter often get superfluous '$' due to mangling. }
  2261. if Pos('$',aPattern)>0 then
  2262. ObjSectionList.Sort(@IdataObjSectionCompare);
  2263. end;
  2264. constructor TDJCoffexeoutput.create;
  2265. begin
  2266. inherited createcoff(false);
  2267. datapos_offset:=sizeof(go32v2stub);
  2268. CExeSection:=TExeSection;
  2269. CObjData:=TDJCoffObjData;
  2270. end;
  2271. procedure TDJCoffexeoutput.MemPos_Header;
  2272. begin
  2273. { Headers are not loaded, first 4K page is reserved }
  2274. CurrMemPos:=$1000;
  2275. end;
  2276. constructor TPECoffexeoutput.create;
  2277. begin
  2278. inherited createcoff(true);
  2279. CExeSection:=TExeSection;
  2280. CObjData:=TPECoffObjData;
  2281. end;
  2282. procedure TPECoffexeoutput.GenerateLibraryImports(ImportLibraryList:TFPHashObjectList);
  2283. var
  2284. textobjsection,
  2285. idata2objsection,
  2286. idata4objsection,
  2287. idata5objsection,
  2288. idata6objsection,
  2289. idata7objsection : TObjSection;
  2290. basedllname : string;
  2291. procedure StartImport(const dllname:string);
  2292. begin
  2293. if assigned(exemap) then
  2294. begin
  2295. exemap.Add('');
  2296. exemap.Add('Importing from DLL '+dllname);
  2297. end;
  2298. basedllname:=ExtractFileName(dllname);
  2299. idata2objsection:=internalobjdata.createsection(sec_idata2,basedllname);
  2300. idata4objsection:=internalobjdata.createsection(sec_idata4,basedllname);
  2301. idata5objsection:=internalobjdata.createsection(sec_idata5,basedllname);
  2302. idata7objsection:=internalobjdata.createsection(sec_idata7,basedllname);
  2303. { idata2 }
  2304. idata2objsection.writereloc_internal(idata4objsection,0,sizeof(longint),RELOC_RVA);
  2305. idata2objsection.writezeros(2*sizeof(longint));
  2306. idata2objsection.writereloc_internal(idata7objsection,0,sizeof(longint),RELOC_RVA);
  2307. idata2objsection.writereloc_internal(idata5objsection,0,sizeof(longint),RELOC_RVA);
  2308. { idata7 }
  2309. idata7objsection.writestr(basedllname);
  2310. end;
  2311. procedure EndImport;
  2312. begin
  2313. { These are referenced from idata2, oso_keep is not necessary. }
  2314. idata4objsection:=internalobjdata.createsection(sec_idata4, basedllname+'_z_');
  2315. idata5objsection:=internalobjdata.createsection(sec_idata5, basedllname+'_z_');
  2316. idata2objsection.writereloc_internal(idata4objsection,0,0,RELOC_NONE);
  2317. idata2objsection.writereloc_internal(idata5objsection,0,0,RELOC_NONE);
  2318. { idata4 }
  2319. idata4objsection.writezeros(sizeof(longint));
  2320. if target_info.system=system_x86_64_win64 then
  2321. idata4objsection.writezeros(sizeof(longint));
  2322. { idata5 }
  2323. idata5objsection.writezeros(sizeof(longint));
  2324. if target_info.system=system_x86_64_win64 then
  2325. idata5objsection.writezeros(sizeof(longint));
  2326. end;
  2327. function AddImport(const afuncname,amangledname:string; AOrdNr:longint;isvar:boolean):TObjSymbol;
  2328. const
  2329. {$ifdef arm}
  2330. jmpopcode : array[0..7] of byte = (
  2331. $00,$c0,$9f,$e5, // ldr ip, [pc, #0]
  2332. $00,$f0,$9c,$e5 // ldr pc, [ip]
  2333. );
  2334. {$else arm}
  2335. jmpopcode : array[0..1] of byte = (
  2336. $ff,$25
  2337. );
  2338. {$endif arm}
  2339. nopopcodes : array[0..1] of byte = (
  2340. $90,$90
  2341. );
  2342. var
  2343. secname: string;
  2344. procedure WriteTableEntry(objsec:TObjSection);
  2345. var
  2346. ordint: dword;
  2347. begin
  2348. if AOrdNr <= 0 then
  2349. begin
  2350. { import by name }
  2351. if idata6objsection=nil then
  2352. begin
  2353. idata6objsection:=internalobjdata.createsection(sec_idata6,secname);
  2354. ordint:=Abs(AOrdNr);
  2355. { index hint, function name, null terminator and align }
  2356. idata6objsection.write(ordint,2);
  2357. idata6objsection.writestr(afuncname);
  2358. idata6objsection.writezeros(align(idata6objsection.size,2)-idata6objsection.size);
  2359. end;
  2360. objsec.writereloc_internal(idata6objsection,0,sizeof(longint),RELOC_RVA);
  2361. if target_info.system=system_x86_64_win64 then
  2362. objsec.writezeros(sizeof(longint));
  2363. end
  2364. else
  2365. begin
  2366. { import by ordinal }
  2367. ordint:=AOrdNr;
  2368. if target_info.system=system_x86_64_win64 then
  2369. begin
  2370. objsec.write(ordint,sizeof(ordint));
  2371. ordint:=$80000000;
  2372. objsec.write(ordint,sizeof(ordint));
  2373. end
  2374. else
  2375. begin
  2376. ordint:=ordint or $80000000;
  2377. objsec.write(ordint,sizeof(ordint));
  2378. end;
  2379. end;
  2380. end;
  2381. begin
  2382. result:=nil;
  2383. textobjsection:=nil;
  2384. idata6objsection:=nil;
  2385. if assigned(exemap) then
  2386. begin
  2387. if AOrdNr <= 0 then
  2388. exemap.Add(' Importing Function '+afuncname)
  2389. else
  2390. exemap.Add(' Importing Function '+afuncname+' (OrdNr='+tostr(AOrdNr)+')');
  2391. end;
  2392. secname:=basedllname+'_i_'+amangledname;
  2393. idata4objsection:=internalobjdata.createsection(sec_idata4, secname);
  2394. idata5objsection:=internalobjdata.createsection(sec_idata5, secname);
  2395. { idata4, import lookup table }
  2396. WriteTableEntry(idata4objsection);
  2397. { idata5, import address table }
  2398. internalobjdata.SetSection(idata5objsection);
  2399. { dummy back links }
  2400. idata5objsection.writereloc_internal(idata4objsection,0,0,RELOC_NONE);
  2401. idata5objsection.writereloc_internal(idata2objsection,0,0,RELOC_NONE);
  2402. if isvar then
  2403. result:=internalobjdata.SymbolDefine(amangledname,AB_GLOBAL,AT_DATA)
  2404. else
  2405. begin
  2406. textobjsection:=internalobjdata.createsection(internalobjdata.sectionname(sec_code,secname,secorder_default),current_settings.alignment.procalign,
  2407. internalobjdata.sectiontype2options(sec_code) - [oso_keep]);
  2408. result:=internalobjdata.SymbolDefine('_'+amangledname,AB_GLOBAL,AT_FUNCTION);
  2409. textobjsection.write(jmpopcode,sizeof(jmpopcode));
  2410. {$ifdef x86_64}
  2411. textobjsection.writereloc_internal(idata5objsection,0,4,RELOC_RELATIVE);
  2412. {$else}
  2413. textobjsection.writereloc_internal(idata5objsection,0,4,RELOC_ABSOLUTE32);
  2414. {$endif x86_64}
  2415. textobjsection.write(nopopcodes,align(textobjsection.size,sizeof(nopopcodes))-textobjsection.size);
  2416. end;
  2417. { idata5 section data }
  2418. WriteTableEntry(idata5objsection);
  2419. end;
  2420. var
  2421. i,j : longint;
  2422. ImportLibrary : TImportLibrary;
  2423. ImportSymbol : TImportSymbol;
  2424. exesym : TExeSymbol;
  2425. begin
  2426. for i:=0 to ImportLibraryList.Count-1 do
  2427. begin
  2428. ImportLibrary:=TImportLibrary(ImportLibraryList[i]);
  2429. idata2objsection:=nil;
  2430. idata4objsection:=nil;
  2431. idata5objsection:=nil;
  2432. idata6objsection:=nil;
  2433. idata7objsection:=nil;
  2434. for j:=0 to ImportLibrary.ImportSymbolList.Count-1 do
  2435. begin
  2436. ImportSymbol:=TImportSymbol(ImportLibrary.ImportSymbolList[j]);
  2437. exesym:=TExeSymbol(ExeSymbolList.Find(ImportSymbol.MangledName));
  2438. if assigned(exesym) and
  2439. (exesym.State<>symstate_defined) then
  2440. begin
  2441. if not assigned(idata2objsection) then
  2442. StartImport(ImportLibrary.Name);
  2443. exesym.objsymbol:=AddImport(ImportSymbol.Name,ImportSymbol.MangledName,ImportSymbol.OrdNr,ImportSymbol.IsVar);
  2444. exesym.State:=symstate_defined;
  2445. end;
  2446. end;
  2447. if assigned(idata2objsection) then
  2448. EndImport;
  2449. end;
  2450. PackUnresolvedExeSymbols('after DLL imports');
  2451. end;
  2452. procedure TPECoffexeoutput.GenerateRelocs;
  2453. var
  2454. pgaddr, hdrpos : longword;
  2455. procedure FinishBlock;
  2456. var
  2457. p,len : longint;
  2458. begin
  2459. if hdrpos = longword(-1) then
  2460. exit;
  2461. p:=0;
  2462. internalobjdata.writebytes(p,align(internalobjdata.CurrObjSec.size,4)-internalobjdata.CurrObjSec.size);
  2463. p:=internalObjData.CurrObjSec.Data.Pos;
  2464. internalObjData.CurrObjSec.Data.seek(hdrpos+4);
  2465. len:=p-hdrpos;
  2466. internalObjData.CurrObjSec.Data.write(len,4);
  2467. internalObjData.CurrObjSec.Data.seek(p);
  2468. hdrpos:=longword(-1);
  2469. end;
  2470. var
  2471. exesec : TExeSection;
  2472. objsec : TObjSection;
  2473. objreloc : TObjRelocation;
  2474. i,j,k : longint;
  2475. offset : longword;
  2476. w: word;
  2477. begin
  2478. if not RelocSection or FRelocsGenerated then
  2479. exit;
  2480. exesec:=FindExeSection('.reloc');
  2481. if exesec=nil then
  2482. exit;
  2483. objsec:=internalObjData.createsection('.reloc',0,[oso_data,oso_load,oso_keep]);
  2484. exesec.AddObjSection(objsec);
  2485. pgaddr:=longword(-1);
  2486. hdrpos:=longword(-1);
  2487. for i:=0 to ExeSectionList.Count-1 do
  2488. begin
  2489. exesec:=TExeSection(ExeSectionList[i]);
  2490. for j:=0 to exesec.ObjSectionList.count-1 do
  2491. begin
  2492. objsec:=TObjSection(exesec.ObjSectionList[j]);
  2493. { create relocs only for sections which are loaded in memory }
  2494. if not (oso_load in objsec.SecOptions) then
  2495. continue;
  2496. for k:=0 to objsec.ObjRelocations.Count-1 do
  2497. begin
  2498. objreloc:=TObjRelocation(objsec.ObjRelocations[k]);
  2499. if not (objreloc.typ in [{$ifdef cpu64bitaddr}RELOC_ABSOLUTE32,{$endif cpu64bitaddr}RELOC_ABSOLUTE]) then
  2500. continue;
  2501. offset:=objsec.MemPos+objreloc.dataoffset;
  2502. if (offset<pgaddr) and (pgaddr<>longword(-1)) then
  2503. Internalerror(2007062701);
  2504. if (offset-pgaddr>=4096) or (pgaddr=longword(-1)) then
  2505. begin
  2506. FinishBlock;
  2507. pgaddr:=(offset div 4096)*4096;
  2508. hdrpos:=internalObjData.CurrObjSec.Data.Pos;
  2509. internalObjData.writebytes(pgaddr,4);
  2510. { Reserving space for block size. The size will be written later in FinishBlock }
  2511. internalObjData.writebytes(k,4);
  2512. end;
  2513. {$ifdef cpu64bitaddr}
  2514. if objreloc.typ = RELOC_ABSOLUTE then
  2515. w:=IMAGE_REL_BASED_DIR64
  2516. else
  2517. {$endif cpu64bitaddr}
  2518. w:=IMAGE_REL_BASED_HIGHLOW;
  2519. w:=(w shl 12) or (offset-pgaddr);
  2520. internalObjData.writebytes(w,2);
  2521. end;
  2522. end;
  2523. end;
  2524. FinishBlock;
  2525. FRelocsGenerated:=true;
  2526. end;
  2527. procedure TPECoffexeoutput.MemPos_Start;
  2528. var
  2529. exesec : TExeSection;
  2530. begin
  2531. if RelocSection then
  2532. begin
  2533. exesec:=FindExeSection('.reloc');
  2534. if exesec=nil then
  2535. InternalError(2012072401);
  2536. exesec.SecOptions:=exesec.SecOptions-[oso_disabled];
  2537. end;
  2538. inherited;
  2539. end;
  2540. procedure TPECoffexeoutput.MemPos_ExeSection(const aname:string);
  2541. begin
  2542. if aname='.reloc' then
  2543. GenerateRelocs;
  2544. inherited;
  2545. end;
  2546. {****************************************************************************
  2547. TDJCoffAssembler
  2548. ****************************************************************************}
  2549. constructor TDJCoffAssembler.Create(smart:boolean);
  2550. begin
  2551. inherited Create(smart);
  2552. CObjOutput:=TDJCoffObjOutput;
  2553. end;
  2554. {****************************************************************************
  2555. TPECoffAssembler
  2556. ****************************************************************************}
  2557. constructor TPECoffAssembler.Create(smart:boolean);
  2558. begin
  2559. inherited Create(smart);
  2560. CObjOutput:=TPECoffObjOutput;
  2561. end;
  2562. {*****************************************************************************
  2563. DLLReader
  2564. *****************************************************************************}
  2565. {$ifdef win32}
  2566. var
  2567. Wow64DisableWow64FsRedirection : function (var OldValue : pointer) : boolean;stdcall;
  2568. Wow64RevertWow64FsRedirection : function (OldValue : pointer) : boolean;stdcall;
  2569. {$endif win32}
  2570. function ReadDLLImports(const dllname:string;readdllproc:Treaddllproc):boolean;
  2571. type
  2572. TPECoffExpDir=packed record
  2573. flag,
  2574. stamp : cardinal;
  2575. Major,
  2576. Minor : word;
  2577. Name,
  2578. Base,
  2579. NumFuncs,
  2580. NumNames,
  2581. AddrFuncs,
  2582. AddrNames,
  2583. AddrOrds : cardinal;
  2584. end;
  2585. var
  2586. DLLReader : TObjectReader;
  2587. DosHeader : array[0..$7f] of byte;
  2588. PEMagic : array[0..3] of byte;
  2589. Header : TCoffHeader;
  2590. peheader : tcoffpeoptheader;
  2591. NameOfs,
  2592. newheaderofs : longword;
  2593. FuncName : string;
  2594. expdir : TPECoffExpDir;
  2595. i : longint;
  2596. found : boolean;
  2597. sechdr : tCoffSecHdr;
  2598. {$ifdef win32}
  2599. p : pointer;
  2600. {$endif win32}
  2601. begin
  2602. result:=false;
  2603. {$ifdef win32}
  2604. if (target_info.system=system_x86_64_win64) and
  2605. assigned(Wow64DisableWow64FsRedirection) then
  2606. Wow64DisableWow64FsRedirection(p);
  2607. {$endif win32}
  2608. DLLReader:=TObjectReader.Create;
  2609. DLLReader.OpenFile(dllname);
  2610. {$ifdef win32}
  2611. if (target_info.system=system_x86_64_win64) and
  2612. assigned(Wow64RevertWow64FsRedirection) then
  2613. Wow64RevertWow64FsRedirection(p);
  2614. {$endif win32}
  2615. if not DLLReader.Read(DosHeader,sizeof(DosHeader)) or
  2616. (DosHeader[0]<>$4d) or (DosHeader[1]<>$5a) then
  2617. begin
  2618. Comment(V_Error,'Invalid DLL '+dllname+', Dos Header invalid');
  2619. exit;
  2620. end;
  2621. newheaderofs:=cardinal(DosHeader[$3c]) or (DosHeader[$3d] shl 8) or (DosHeader[$3e] shl 16) or (DosHeader[$3f] shl 24);
  2622. DLLReader.Seek(newheaderofs);
  2623. if not DLLReader.Read(PEMagic,sizeof(PEMagic)) or
  2624. (PEMagic[0]<>$50) or (PEMagic[1]<>$45) or (PEMagic[2]<>$00) or (PEMagic[3]<>$00) then
  2625. begin
  2626. Comment(V_Error,'Invalid DLL '+dllname+': invalid magic code');
  2627. exit;
  2628. end;
  2629. if not DLLReader.Read(Header,sizeof(TCoffHeader)) or
  2630. (Header.mach<>COFF_MAGIC) or
  2631. (Header.opthdr<>sizeof(tcoffpeoptheader)) then
  2632. begin
  2633. Comment(V_Error,'Invalid DLL '+dllname+', invalid header size');
  2634. exit;
  2635. end;
  2636. { Read optheader }
  2637. DLLreader.Read(peheader,sizeof(tcoffpeoptheader));
  2638. { Section headers }
  2639. found:=false;
  2640. for i:=1 to header.nsects do
  2641. begin
  2642. if not DLLreader.read(sechdr,sizeof(sechdr)) then
  2643. begin
  2644. Comment(V_Error,'Error reading coff file '+DLLName);
  2645. exit;
  2646. end;
  2647. if (sechdr.rvaofs<=peheader.DataDirectory[PE_DATADIR_EDATA].vaddr) and
  2648. (peheader.DataDirectory[PE_DATADIR_EDATA].vaddr<sechdr.rvaofs+sechdr.vsize) then
  2649. begin
  2650. found:=true;
  2651. break;
  2652. end;
  2653. end;
  2654. if not found then
  2655. begin
  2656. Comment(V_Warning,'DLL '+DLLName+' does not contain any exports');
  2657. exit;
  2658. end;
  2659. { Process edata }
  2660. DLLReader.Seek(sechdr.datapos+peheader.DataDirectory[PE_DATADIR_EDATA].vaddr-sechdr.rvaofs);
  2661. DLLReader.Read(expdir,sizeof(expdir));
  2662. for i:=0 to expdir.NumNames-1 do
  2663. begin
  2664. DLLReader.Seek(sechdr.datapos+expdir.AddrNames-sechdr.rvaofs+i*4);
  2665. DLLReader.Read(NameOfs,4);
  2666. Dec(NameOfs,sechdr.rvaofs);
  2667. if {(NameOfs<0) or}
  2668. (NameOfs>sechdr.vsize) then
  2669. begin
  2670. Comment(V_Error,'DLL does contains invalid exports');
  2671. break;
  2672. end;
  2673. { Read Function name from DLL, prepend _ and terminate with #0 }
  2674. DLLReader.Seek(sechdr.datapos+NameOfs);
  2675. DLLReader.Read((@FuncName[1])^,sizeof(FuncName)-3);
  2676. FuncName[sizeof(FuncName)-1]:=#0;
  2677. FuncName[0]:=chr(Strlen(@FuncName[1]));
  2678. readdllproc(DLLName,FuncName);
  2679. end;
  2680. DLLReader.Free;
  2681. end;
  2682. {*****************************************************************************
  2683. Initialize
  2684. *****************************************************************************}
  2685. {$ifdef i386}
  2686. const
  2687. as_i386_coff_info : tasminfo =
  2688. (
  2689. id : as_i386_coff;
  2690. idtxt : 'COFF';
  2691. asmbin : '';
  2692. asmcmd : '';
  2693. supported_targets : [system_i386_go32v2];
  2694. flags : [af_outputbinary,af_smartlink_sections];
  2695. labelprefix : '.L';
  2696. comment : '';
  2697. dollarsign: '$';
  2698. );
  2699. as_i386_pecoff_info : tasminfo =
  2700. (
  2701. id : as_i386_pecoff;
  2702. idtxt : 'PECOFF';
  2703. asmbin : '';
  2704. asmcmd : '';
  2705. supported_targets : [system_i386_win32,system_i386_nativent];
  2706. flags : [af_outputbinary,af_smartlink_sections];
  2707. labelprefix : '.L';
  2708. comment : '';
  2709. dollarsign: '$';
  2710. );
  2711. as_i386_pecoffwdosx_info : tasminfo =
  2712. (
  2713. id : as_i386_pecoffwdosx;
  2714. idtxt : 'PEWDOSX';
  2715. asmbin : '';
  2716. asmcmd : '';
  2717. supported_targets : [system_i386_wdosx];
  2718. flags : [af_outputbinary];
  2719. labelprefix : '.L';
  2720. comment : '';
  2721. dollarsign: '$';
  2722. );
  2723. as_i386_pecoffwince_info : tasminfo =
  2724. (
  2725. id : as_i386_pecoffwince;
  2726. idtxt : 'PECOFFWINCE';
  2727. asmbin : '';
  2728. asmcmd : '';
  2729. supported_targets : [system_i386_wince];
  2730. flags : [af_outputbinary,af_smartlink_sections];
  2731. labelprefix : '.L';
  2732. comment : '';
  2733. dollarsign: '$';
  2734. );
  2735. {$endif i386}
  2736. {$ifdef x86_64}
  2737. const
  2738. as_x86_64_pecoff_info : tasminfo =
  2739. (
  2740. id : as_x86_64_pecoff;
  2741. idtxt : 'PECOFF';
  2742. asmbin : '';
  2743. asmcmd : '';
  2744. supported_targets : [system_x86_64_win64];
  2745. flags : [af_outputbinary,af_smartlink_sections];
  2746. labelprefix : '.L';
  2747. comment : '';
  2748. dollarsign: '$';
  2749. );
  2750. {$endif x86_64}
  2751. {$ifdef arm}
  2752. const
  2753. as_arm_pecoffwince_info : tasminfo =
  2754. (
  2755. id : as_arm_pecoffwince;
  2756. idtxt : 'PECOFFWINCE';
  2757. asmbin : '';
  2758. asmcmd : '';
  2759. supported_targets : [system_arm_wince];
  2760. flags : [af_outputbinary];
  2761. labelprefix : '.L';
  2762. comment : '';
  2763. dollarsign: '$';
  2764. );
  2765. {$endif arm}
  2766. {$ifdef win32}
  2767. procedure SetupProcVars;
  2768. var
  2769. hinstLib : THandle;
  2770. begin
  2771. Wow64DisableWow64FsRedirection:=nil;
  2772. Wow64RevertWow64FsRedirection:=nil;
  2773. hinstLib:=LoadLibrary('kernel32.dll');
  2774. if hinstLib<>0 then
  2775. begin
  2776. pointer(Wow64DisableWow64FsRedirection):=GetProcAddress(hinstLib,'Wow64DisableWow64FsRedirection');
  2777. pointer(Wow64RevertWow64FsRedirection):=GetProcAddress(hinstLib,'Wow64RevertWow64FsRedirection');
  2778. FreeLibrary(hinstLib);
  2779. end;
  2780. end;
  2781. {$endif win32}
  2782. initialization
  2783. {$ifdef i386}
  2784. RegisterAssembler(as_i386_coff_info,TDJCoffAssembler);
  2785. RegisterAssembler(as_i386_pecoff_info,TPECoffAssembler);
  2786. RegisterAssembler(as_i386_pecoffwdosx_info,TPECoffAssembler);
  2787. RegisterAssembler(as_i386_pecoffwince_info,TPECoffAssembler);
  2788. {$endif i386}
  2789. {$ifdef x86_64}
  2790. RegisterAssembler(as_x86_64_pecoff_info,TPECoffAssembler);
  2791. {$endif x86_64}
  2792. {$ifdef arm}
  2793. RegisterAssembler(as_arm_pecoffwince_info,TPECoffAssembler);
  2794. {$endif arm}
  2795. {$ifdef win32}
  2796. SetupProcVars;
  2797. {$endif win32}
  2798. end.