t_win.pas 69 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402140314041405140614071408140914101411141214131414141514161417141814191420142114221423142414251426142714281429143014311432143314341435143614371438143914401441144214431444144514461447144814491450145114521453145414551456145714581459146014611462146314641465146614671468146914701471147214731474147514761477147814791480148114821483148414851486148714881489149014911492149314941495149614971498149915001501150215031504150515061507150815091510151115121513151415151516151715181519152015211522152315241525152615271528152915301531153215331534153515361537153815391540154115421543154415451546154715481549155015511552155315541555155615571558155915601561156215631564156515661567156815691570157115721573157415751576157715781579158015811582158315841585158615871588158915901591159215931594159515961597159815991600160116021603160416051606160716081609161016111612161316141615161616171618161916201621162216231624162516261627162816291630163116321633163416351636163716381639164016411642164316441645164616471648164916501651165216531654165516561657165816591660166116621663166416651666166716681669167016711672167316741675167616771678167916801681168216831684168516861687168816891690169116921693169416951696169716981699170017011702170317041705170617071708170917101711171217131714171517161717171817191720172117221723172417251726172717281729173017311732173317341735173617371738173917401741174217431744174517461747174817491750175117521753175417551756175717581759176017611762176317641765176617671768176917701771177217731774177517761777177817791780178117821783
  1. {
  2. Copyright (c) 1998-2008 by Peter Vreman
  3. This unit implements support import,export,link routines
  4. for the (i386) Win32 target
  5. This program is free software; you can redistribute it and/or modify
  6. it under the terms of the GNU General Public License as published by
  7. the Free Software Foundation; either version 2 of the License, or
  8. (at your option) any later version.
  9. This program is distributed in the hope that it will be useful,
  10. but WITHOUT ANY WARRANTY; without even the implied warranty of
  11. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  12. GNU General Public License for more details.
  13. You should have received a copy of the GNU General Public License
  14. along with this program; if not, write to the Free Software
  15. Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  16. ****************************************************************************
  17. }
  18. unit t_win;
  19. {$i fpcdefs.inc}
  20. interface
  21. uses
  22. cutils,cclasses,
  23. aasmbase,aasmtai,aasmdata,aasmcpu,fmodule,globtype,globals,systems,verbose,
  24. symconst,symdef,symsym,
  25. script,gendef,
  26. cpubase,
  27. import,export,link,comprsrc,cgobj,i_win;
  28. const
  29. MAX_DEFAULT_EXTENSIONS = 3;
  30. type
  31. tStr4=array[1..MAX_DEFAULT_EXTENSIONS] of string[4];
  32. pStr4=^tStr4;
  33. TImportLibWin=class(timportlib)
  34. private
  35. procedure generateimportlib;
  36. procedure generateidatasection;
  37. public
  38. procedure generatelib;override;
  39. end;
  40. TExportLibWin=class(texportlib)
  41. private
  42. st : string;
  43. EList_indexed:TFPList;
  44. EList_nonindexed:TFPList;
  45. public
  46. destructor Destroy;override;
  47. procedure preparelib(const s:string);override;
  48. procedure exportprocedure(hp : texported_item);override;
  49. procedure exportvar(hp : texported_item);override;
  50. procedure exportfromlist(hp : texported_item);
  51. procedure generatelib;override;
  52. procedure generatenasmlib;virtual;
  53. end;
  54. TInternalLinkerWin = class(tinternallinker)
  55. constructor create;override;
  56. procedure DefaultLinkScript;override;
  57. procedure InitSysInitUnitName;override;
  58. end;
  59. TExternalLinkerWin=class(texternallinker)
  60. private
  61. Function WriteResponseFile(isdll:boolean) : Boolean;
  62. Function PostProcessExecutable(const fn:string;isdll:boolean) : Boolean;
  63. public
  64. Constructor Create;override;
  65. Procedure SetDefaultInfo;override;
  66. function MakeExecutable:boolean;override;
  67. function MakeSharedLibrary:boolean;override;
  68. procedure InitSysInitUnitName;override;
  69. end;
  70. TDLLScannerWin=class(tDLLScanner)
  71. private
  72. importfound : boolean;
  73. procedure CheckDLLFunc(const dllname,funcname:string);
  74. public
  75. function Scan(const binname:string):boolean;override;
  76. end;
  77. implementation
  78. uses
  79. SysUtils,
  80. cfileutl,
  81. cpuinfo,cgutils,dbgbase,
  82. owar,ogbase,ogcoff;
  83. const
  84. res_gnu_windres_info : tresinfo =
  85. (
  86. id : res_gnu_windres;
  87. resbin : 'fpcres';
  88. rescmd : '-o $OBJ -a $ARCH -of coff $DBG';
  89. rcbin : 'windres';
  90. rccmd : '--include $INC -O res -o $RES $RC';
  91. resourcefileclass : nil;
  92. resflags : [];
  93. );
  94. {$ifdef x86_64}
  95. res_win64_gorc_info : tresinfo =
  96. (
  97. id : res_win64_gorc;
  98. resbin : 'fpcres';
  99. rescmd : '-o $OBJ -a $ARCH -of coff $DBG';
  100. rcbin : 'gorc';
  101. rccmd : '/machine x64 /nw /ni /r /fo $RES $RC';
  102. resourcefileclass : nil;
  103. resflags : [];
  104. );
  105. {$endif x86_64}
  106. Procedure GlobalInitSysInitUnitName(Linker : TLinker);
  107. var
  108. hp : tmodule;
  109. linkcygwin : boolean;
  110. begin
  111. hp:=tmodule(loaded_units.first);
  112. while assigned(hp) do
  113. begin
  114. linkcygwin := hp.linkothersharedlibs.find('cygwin') or hp.linkotherstaticlibs.find('cygwin');
  115. if linkcygwin then
  116. break;
  117. hp:=tmodule(hp.next);
  118. end;
  119. if cs_profile in current_settings.moduleswitches then
  120. linker.sysinitunit:='sysinitgprof'
  121. else if linkcygwin or (Linker.SharedLibFiles.Find('cygwin')<>nil) or (Linker.StaticLibFiles.Find('cygwin')<>nil) then
  122. linker.sysinitunit:='sysinitcyg'
  123. else
  124. linker.sysinitunit:='sysinitpas';
  125. end;
  126. {*****************************************************************************
  127. TImportLibWin
  128. *****************************************************************************}
  129. procedure TImportLibWin.generateimportlib;
  130. var
  131. ObjWriter : tarobjectwriter;
  132. ObjOutput : TPECoffObjOutput;
  133. basedllname : string;
  134. AsmPrefix : string;
  135. idatalabnr,
  136. SmartFilesCount,
  137. SmartHeaderCount : longint;
  138. function CreateObjData(place:tcutplace):TObjData;
  139. var
  140. s : string;
  141. begin
  142. s:='';
  143. case place of
  144. cut_begin :
  145. begin
  146. inc(SmartHeaderCount);
  147. s:=asmprefix+tostr(SmartHeaderCount)+'h';
  148. end;
  149. cut_normal :
  150. s:=asmprefix+tostr(SmartHeaderCount)+'s';
  151. cut_end :
  152. s:=asmprefix+tostr(SmartHeaderCount)+'t';
  153. end;
  154. inc(SmartFilesCount);
  155. result:=ObjOutput.NewObjData(FixFileName(s+tostr(SmartFilesCount)+target_info.objext));
  156. ObjOutput.startobjectfile(Result.Name);
  157. end;
  158. procedure WriteObjData(objdata:TObjData);
  159. begin
  160. ObjOutput.writeobjectfile(ObjData);
  161. end;
  162. procedure StartImport(const dllname:string);
  163. var
  164. headlabel,
  165. idata4label,
  166. idata5label,
  167. idata7label : TObjSymbol;
  168. emptyint : longint;
  169. objdata : TObjData;
  170. idata2objsection,
  171. idata4objsection,
  172. idata5objsection : TObjSection;
  173. begin
  174. objdata:=CreateObjData(cut_begin);
  175. idata2objsection:=objdata.createsection(sec_idata2,'');
  176. idata4objsection:=objdata.createsection(sec_idata4,'');
  177. idata5objsection:=objdata.createsection(sec_idata5,'');
  178. emptyint:=0;
  179. basedllname:=ExtractFileName(dllname);
  180. { idata4 }
  181. objdata.SetSection(idata4objsection);
  182. idata4label:=objdata.SymbolDefine(asmprefix+'_names_'+basedllname,AB_GLOBAL,AT_DATA);
  183. { idata5 }
  184. objdata.SetSection(idata5objsection);
  185. idata5label:=objdata.SymbolDefine(asmprefix+'_fixup_'+basedllname,AB_GLOBAL,AT_DATA);
  186. { idata2 }
  187. objdata.SetSection(idata2objsection);
  188. headlabel:=objdata.SymbolDefine(asmprefix+'_head_'+basedllname,AB_GLOBAL,AT_DATA);
  189. ObjOutput.exportsymbol(headlabel);
  190. objdata.writereloc(0,sizeof(longint),idata4label,RELOC_RVA);
  191. objdata.writebytes(emptyint,sizeof(emptyint));
  192. objdata.writebytes(emptyint,sizeof(emptyint));
  193. idata7label:=objdata.SymbolRef(asmprefix+'_dll_'+basedllname);
  194. objdata.writereloc(0,sizeof(longint),idata7label,RELOC_RVA);
  195. objdata.writereloc(0,sizeof(longint),idata5label,RELOC_RVA);
  196. WriteObjData(objdata);
  197. objdata.free;
  198. end;
  199. procedure EndImport;
  200. var
  201. idata7label : TObjSymbol;
  202. emptyint : longint;
  203. objdata : TObjData;
  204. idata4objsection,
  205. idata5objsection,
  206. idata7objsection : TObjSection;
  207. begin
  208. objdata:=CreateObjData(cut_end);
  209. idata4objsection:=objdata.createsection(sec_idata4,'');
  210. idata5objsection:=objdata.createsection(sec_idata5,'');
  211. idata7objsection:=objdata.createsection(sec_idata7,'');
  212. emptyint:=0;
  213. { idata4 }
  214. objdata.SetSection(idata4objsection);
  215. objdata.writebytes(emptyint,sizeof(emptyint));
  216. if target_info.system=system_x86_64_win64 then
  217. objdata.writebytes(emptyint,sizeof(emptyint));
  218. { idata5 }
  219. objdata.SetSection(idata5objsection);
  220. objdata.writebytes(emptyint,sizeof(emptyint));
  221. if target_info.system=system_x86_64_win64 then
  222. objdata.writebytes(emptyint,sizeof(emptyint));
  223. { idata7 }
  224. objdata.SetSection(idata7objsection);
  225. idata7label:=objdata.SymbolDefine(asmprefix+'_dll_'+basedllname,AB_GLOBAL,AT_DATA);
  226. objoutput.exportsymbol(idata7label);
  227. objdata.writebytes(basedllname[1],length(basedllname));
  228. objdata.writebytes(emptyint,1);
  229. WriteObjData(objdata);
  230. objdata.free;
  231. end;
  232. procedure AddImport(const afuncname,mangledname:string;ordnr:longint;isvar:boolean);
  233. const
  234. {$ifdef x86_64}
  235. jmpopcode : array[0..2] of byte = (
  236. $ff,$24,$25
  237. );
  238. {$else x86_64}
  239. {$ifdef arm}
  240. jmpopcode : array[0..7] of byte = (
  241. $00,$c0,$9f,$e5, // ldr ip, [pc, #0]
  242. $00,$f0,$9c,$e5 // ldr pc, [ip]
  243. );
  244. {$else arm}
  245. jmpopcode : array[0..1] of byte = (
  246. $ff,$25
  247. );
  248. {$endif arm}
  249. {$endif x86_64}
  250. nopopcodes : array[0..1] of byte = (
  251. $90,$90
  252. );
  253. var
  254. implabel,
  255. idata2label,
  256. idata5label,
  257. idata6label : TObjSymbol;
  258. emptyint : longint;
  259. objdata : TObjData;
  260. textobjsection,
  261. idata4objsection,
  262. idata5objsection,
  263. idata6objsection,
  264. idata7objsection : TObjSection;
  265. absordnr: word;
  266. procedure WriteTableEntry;
  267. var
  268. ordint: dword;
  269. begin
  270. if ordnr <= 0 then
  271. begin
  272. { import by name }
  273. objdata.writereloc(0,sizeof(longint),idata6label,RELOC_RVA);
  274. if target_info.system=system_x86_64_win64 then
  275. objdata.writebytes(emptyint,sizeof(emptyint));
  276. end
  277. else
  278. begin
  279. { import by ordinal }
  280. ordint:=ordnr;
  281. if target_info.system=system_x86_64_win64 then
  282. begin
  283. objdata.writebytes(ordint,sizeof(ordint));
  284. ordint:=$80000000;
  285. objdata.writebytes(ordint,sizeof(ordint));
  286. end
  287. else
  288. begin
  289. ordint:=ordint or $80000000;
  290. objdata.writebytes(ordint,sizeof(ordint));
  291. end;
  292. end;
  293. end;
  294. begin
  295. objdata:=CreateObjData(cut_normal);
  296. if not isvar then
  297. textobjsection:=objdata.createsection(sec_code,'');
  298. idata4objsection:=objdata.createsection(sec_idata4,'');
  299. idata5objsection:=objdata.createsection(sec_idata5,'');
  300. idata6objsection:=objdata.createsection(sec_idata6,'');
  301. idata7objsection:=objdata.createsection(sec_idata7,'');
  302. emptyint:=0;
  303. { idata7, link to head }
  304. objdata.SetSection(idata7objsection);
  305. idata2label:=objdata.SymbolRef(asmprefix+'_head_'+basedllname);
  306. objdata.writereloc(0,sizeof(longint),idata2label,RELOC_RVA);
  307. { idata6, import data (ordnr+name) }
  308. objdata.SetSection(idata6objsection);
  309. inc(idatalabnr);
  310. idata6label:=objdata.SymbolDefine(asmprefix+'_'+tostr(idatalabnr),AB_LOCAL,AT_DATA);
  311. absordnr:=Abs(ordnr);
  312. { write index hint }
  313. objdata.writebytes(absordnr,2);
  314. if ordnr <= 0 then
  315. objdata.writebytes(afuncname[1],length(afuncname));
  316. objdata.writebytes(emptyint,1);
  317. objdata.writebytes(emptyint,align(objdata.CurrObjSec.size,2)-objdata.CurrObjSec.size);
  318. { idata4, import lookup table }
  319. objdata.SetSection(idata4objsection);
  320. WriteTableEntry;
  321. { idata5, import address table }
  322. objdata.SetSection(idata5objsection);
  323. if isvar then
  324. implabel:=objdata.SymbolDefine(mangledname,AB_GLOBAL,AT_DATA)
  325. else
  326. idata5label:=objdata.SymbolDefine(asmprefix+'_'+mangledname,AB_LOCAL,AT_DATA);
  327. WriteTableEntry;
  328. { text, jmp }
  329. if not isvar then
  330. begin
  331. objdata.SetSection(textobjsection);
  332. if mangledname <> '' then
  333. implabel:=objdata.SymbolDefine(mangledname,AB_GLOBAL,AT_FUNCTION)
  334. else
  335. implabel:=objdata.SymbolDefine(basedllname+'_index_'+tostr(ordnr),AB_GLOBAL,AT_FUNCTION);
  336. objdata.writebytes(jmpopcode,sizeof(jmpopcode));
  337. objdata.writereloc(0,sizeof(longint),idata5label,RELOC_ABSOLUTE32);
  338. objdata.writebytes(nopopcodes,align(objdata.CurrObjSec.size,sizeof(nopopcodes))-objdata.CurrObjSec.size);
  339. end;
  340. ObjOutput.exportsymbol(implabel);
  341. WriteObjData(objdata);
  342. objdata.free;
  343. end;
  344. var
  345. i,j : longint;
  346. ImportLibrary : TImportLibrary;
  347. ImportSymbol : TImportSymbol;
  348. begin
  349. AsmPrefix:='imp'+Lower(current_module.modulename^);
  350. idatalabnr:=0;
  351. SmartFilesCount:=0;
  352. SmartHeaderCount:=0;
  353. current_module.linkotherstaticlibs.add(current_module.importlibfilename^,link_always);
  354. ObjWriter:=TARObjectWriter.create(current_module.importlibfilename^);
  355. ObjOutput:=TPECoffObjOutput.Create(ObjWriter);
  356. for i:=0 to current_module.ImportLibraryList.Count-1 do
  357. begin
  358. ImportLibrary:=TImportLibrary(current_module.ImportLibraryList[i]);
  359. StartImport(ImportLibrary.Name);
  360. for j:=0 to ImportLibrary.ImportSymbolList.Count-1 do
  361. begin
  362. ImportSymbol:=TImportSymbol(ImportLibrary.ImportSymbolList[j]);
  363. AddImport(ImportSymbol.Name,ImportSymbol.MangledName,ImportSymbol.OrdNr,ImportSymbol.IsVar);
  364. end;
  365. EndImport;
  366. end;
  367. ObjOutput.Free;
  368. ObjWriter.Free;
  369. end;
  370. procedure TImportLibWin.generateidatasection;
  371. var
  372. templab,
  373. l1,l2,l3,l4 {$ifdef ARM} ,l5 {$endif ARM} : tasmlabel;
  374. importname : string;
  375. suffix : integer;
  376. href : treference;
  377. i,j : longint;
  378. ImportLibrary : TImportLibrary;
  379. ImportSymbol : TImportSymbol;
  380. ImportLabels : TFPList;
  381. begin
  382. if current_asmdata.asmlists[al_imports]=nil then
  383. current_asmdata.asmlists[al_imports]:=TAsmList.create;
  384. if (target_asm.id in [as_i386_masm,as_i386_tasm,as_i386_nasmwin32]) then
  385. begin
  386. new_section(current_asmdata.asmlists[al_imports],sec_code,'',0);
  387. for i:=0 to current_module.ImportLibraryList.Count-1 do
  388. begin
  389. ImportLibrary:=TImportLibrary(current_module.ImportLibraryList[i]);
  390. for j:=0 to ImportLibrary.ImportSymbolList.Count-1 do
  391. begin
  392. ImportSymbol:=TImportSymbol(ImportLibrary.ImportSymbolList[j]);
  393. current_asmdata.asmlists[al_imports].concat(tai_directive.create(asd_extern,ImportSymbol.Name));
  394. current_asmdata.asmlists[al_imports].concat(tai_directive.create(asd_nasm_import,ImportSymbol.Name+' '+ImportLibrary.Name+' '+ImportSymbol.Name));
  395. end;
  396. end;
  397. exit;
  398. end;
  399. for i:=0 to current_module.ImportLibraryList.Count-1 do
  400. begin
  401. ImportLibrary:=TImportLibrary(current_module.ImportLibraryList[i]);
  402. { align al_procedures for the jumps }
  403. new_section(current_asmdata.asmlists[al_imports],sec_code,'',sizeof(aint));
  404. { Get labels for the sections }
  405. current_asmdata.getjumplabel(l1);
  406. current_asmdata.getjumplabel(l2);
  407. current_asmdata.getjumplabel(l3);
  408. new_section(current_asmdata.asmlists[al_imports],sec_idata2,'',0);
  409. { pointer to procedure names }
  410. current_asmdata.asmlists[al_imports].concat(Tai_const.Create_rva_sym(l2));
  411. { two empty entries follow }
  412. current_asmdata.asmlists[al_imports].concat(Tai_const.Create_32bit(0));
  413. current_asmdata.asmlists[al_imports].concat(Tai_const.Create_32bit(0));
  414. { pointer to dll name }
  415. current_asmdata.asmlists[al_imports].concat(Tai_const.Create_rva_sym(l1));
  416. { pointer to fixups }
  417. current_asmdata.asmlists[al_imports].concat(Tai_const.Create_rva_sym(l3));
  418. { only create one section for each else it will
  419. create a lot of idata* }
  420. { first write the name references }
  421. new_section(current_asmdata.asmlists[al_imports],sec_idata4,'',0);
  422. current_asmdata.asmlists[al_imports].concat(Tai_label.Create(l2));
  423. ImportLabels:=TFPList.Create;
  424. ImportLabels.Count:=ImportLibrary.ImportSymbolList.Count;
  425. for j:=0 to ImportLibrary.ImportSymbolList.Count-1 do
  426. begin
  427. ImportSymbol:=TImportSymbol(ImportLibrary.ImportSymbolList[j]);
  428. current_asmdata.getjumplabel(templab);
  429. ImportLabels[j]:=templab;
  430. if ImportSymbol.Name<>'' then
  431. begin
  432. current_asmdata.asmlists[al_imports].concat(Tai_const.Create_rva_sym(TAsmLabel(ImportLabels[j])));
  433. if target_info.system=system_x86_64_win64 then
  434. current_asmdata.asmlists[al_imports].concat(Tai_const.Create_32bit(0));
  435. end
  436. else
  437. begin
  438. if target_info.system=system_x86_64_win64 then
  439. current_asmdata.asmlists[al_imports].concat(Tai_const.Create_64bit(int64($8000000000000000) or ImportSymbol.ordnr))
  440. else
  441. current_asmdata.asmlists[al_imports].concat(Tai_const.Create_32bit(longint($80000000) or ImportSymbol.ordnr));
  442. end;
  443. end;
  444. { finalize the names ... }
  445. current_asmdata.asmlists[al_imports].concat(Tai_const.Create_32bit(0));
  446. if target_info.system=system_x86_64_win64 then
  447. current_asmdata.asmlists[al_imports].concat(Tai_const.Create_32bit(0));
  448. { then the addresses and create also the indirect jump }
  449. new_section(current_asmdata.asmlists[al_imports],sec_idata5,'',0);
  450. current_asmdata.asmlists[al_imports].concat(Tai_label.Create(l3));
  451. for j:=0 to ImportLibrary.ImportSymbolList.Count-1 do
  452. begin
  453. ImportSymbol:=TImportSymbol(ImportLibrary.ImportSymbolList[j]);
  454. if not ImportSymbol.IsVar then
  455. begin
  456. current_asmdata.getjumplabel(l4);
  457. {$ifdef ARM}
  458. current_asmdata.getjumplabel(l5);
  459. {$endif ARM}
  460. { create indirect jump and }
  461. { place jump in al_procedures }
  462. new_section(current_asmdata.asmlists[al_imports],sec_code,'',0);
  463. if ImportSymbol.Name <> '' then
  464. current_asmdata.asmlists[al_imports].concat(Tai_symbol.Createname_global(ImportSymbol.MangledName,AT_FUNCTION,0))
  465. else
  466. current_asmdata.asmlists[al_imports].concat(Tai_symbol.Createname_global(ExtractFileName(ImportLibrary.Name)+'_index_'+tostr(ImportSymbol.ordnr),AT_FUNCTION,0));
  467. current_asmdata.asmlists[al_imports].concat(tai_function_name.create(''));
  468. {$ifdef ARM}
  469. reference_reset_symbol(href,l5,0);
  470. current_asmdata.asmlists[al_imports].concat(Taicpu.op_reg_ref(A_LDR,NR_R12,href));
  471. reference_reset_base(href,NR_R12,0);
  472. current_asmdata.asmlists[al_imports].concat(Taicpu.op_reg_ref(A_LDR,NR_R15,href));
  473. current_asmdata.asmlists[al_imports].concat(Tai_label.Create(l5));
  474. reference_reset_symbol(href,l4,0);
  475. current_asmdata.asmlists[al_imports].concat(tai_const.create_sym_offset(href.symbol,href.offset));
  476. {$else ARM}
  477. reference_reset_symbol(href,l4,0);
  478. current_asmdata.asmlists[al_imports].concat(Taicpu.Op_ref(A_JMP,S_NO,href));
  479. current_asmdata.asmlists[al_imports].concat(Tai_align.Create_op(4,$90));
  480. {$endif ARM}
  481. { add jump field to al_imports }
  482. new_section(current_asmdata.asmlists[al_imports],sec_idata5,'',0);
  483. if (cs_debuginfo in current_settings.moduleswitches) then
  484. begin
  485. if ImportSymbol.MangledName<>'' then
  486. begin
  487. importname:='__imp_'+ImportSymbol.MangledName;
  488. suffix:=0;
  489. while assigned(current_asmdata.getasmsymbol(importname)) do
  490. begin
  491. inc(suffix);
  492. importname:='__imp_'+ImportSymbol.MangledName+'_'+tostr(suffix);
  493. end;
  494. current_asmdata.asmlists[al_imports].concat(tai_symbol.createname(importname,AT_FUNCTION,4));
  495. end
  496. else
  497. begin
  498. importname:='__imp_by_ordinal'+tostr(ImportSymbol.ordnr);
  499. suffix:=0;
  500. while assigned(current_asmdata.getasmsymbol(importname)) do
  501. begin
  502. inc(suffix);
  503. importname:='__imp_by_ordinal'+tostr(ImportSymbol.ordnr)+'_'+tostr(suffix);
  504. end;
  505. current_asmdata.asmlists[al_imports].concat(tai_symbol.createname(importname,AT_FUNCTION,4));
  506. end;
  507. end;
  508. current_asmdata.asmlists[al_imports].concat(Tai_label.Create(l4));
  509. end
  510. else
  511. current_asmdata.asmlists[al_imports].concat(Tai_symbol.Createname_global(ImportSymbol.MangledName,AT_DATA,0));
  512. current_asmdata.asmlists[al_imports].concat(Tai_const.Create_rva_sym(TAsmLabel(Importlabels[j])));
  513. if target_info.system=system_x86_64_win64 then
  514. current_asmdata.asmlists[al_imports].concat(Tai_const.Create_32bit(0));
  515. end;
  516. { finalize the addresses }
  517. current_asmdata.asmlists[al_imports].concat(Tai_const.Create_32bit(0));
  518. if target_info.system=system_x86_64_win64 then
  519. current_asmdata.asmlists[al_imports].concat(Tai_const.Create_32bit(0));
  520. { finally the import information }
  521. new_section(current_asmdata.asmlists[al_imports],sec_idata6,'',0);
  522. for j:=0 to ImportLibrary.ImportSymbolList.Count-1 do
  523. begin
  524. ImportSymbol:=TImportSymbol(ImportLibrary.ImportSymbolList[j]);
  525. current_asmdata.asmlists[al_imports].concat(Tai_label.Create(TAsmLabel(ImportLabels[j])));
  526. { the ordinal number }
  527. current_asmdata.asmlists[al_imports].concat(Tai_const.Create_16bit(ImportSymbol.ordnr));
  528. current_asmdata.asmlists[al_imports].concat(Tai_string.Create(ImportSymbol.Name+#0));
  529. current_asmdata.asmlists[al_imports].concat(Tai_align.Create_op(2,0));
  530. end;
  531. { create import dll name }
  532. new_section(current_asmdata.asmlists[al_imports],sec_idata7,'',0);
  533. current_asmdata.asmlists[al_imports].concat(Tai_label.Create(l1));
  534. current_asmdata.asmlists[al_imports].concat(Tai_string.Create(ImportLibrary.Name+#0));
  535. ImportLabels.Free;
  536. ImportLabels:=nil;
  537. end;
  538. end;
  539. procedure TImportLibWin.generatelib;
  540. begin
  541. if GenerateImportSection then
  542. generateidatasection
  543. else
  544. generateimportlib;
  545. end;
  546. {*****************************************************************************
  547. TExportLibWin
  548. *****************************************************************************}
  549. destructor TExportLibWin.Destroy;
  550. begin
  551. EList_indexed.Free;
  552. EList_nonindexed.Free;
  553. inherited;
  554. end;
  555. procedure TExportLibWin.preparelib(const s:string);
  556. begin
  557. if current_asmdata.asmlists[al_exports]=nil then
  558. current_asmdata.asmlists[al_exports]:=TAsmList.create;
  559. if EList_indexed=nil then
  560. EList_indexed:=tFPList.Create;
  561. if EList_nonindexed=nil then
  562. EList_nonindexed:=tFPList.Create;
  563. end;
  564. procedure TExportLibWin.exportvar(hp : texported_item);
  565. begin
  566. { same code used !! PM }
  567. exportprocedure(hp);
  568. end;
  569. var
  570. Gl_DoubleIndex:boolean;
  571. Gl_DoubleIndexValue:longint;
  572. function IdxCompare(Item1, Item2: Pointer): Integer;
  573. var
  574. I1:texported_item absolute Item1;
  575. I2:texported_item absolute Item2;
  576. begin
  577. Result:=I1.index-I2.index;
  578. if(Result=0)and(Item1<>Item2)then
  579. begin
  580. Gl_DoubleIndex:=true;
  581. Gl_DoubleIndexValue:=I1.index;
  582. end;
  583. end;
  584. procedure TExportLibWin.exportprocedure(hp : texported_item);
  585. begin
  586. if ((hp.options and eo_index)<>0) and ((hp.index<=0) or (hp.index>$ffff)) then
  587. begin
  588. message1(parser_e_export_invalid_index,tostr(hp.index));
  589. exit;
  590. end;
  591. if hp.options and eo_index=eo_index then
  592. EList_indexed.Add(hp)
  593. else
  594. EList_nonindexed.Add(hp);
  595. end;
  596. procedure TExportLibWin.exportfromlist(hp : texported_item);
  597. //formerly TExportLibWin.exportprocedure
  598. { must be ordered at least for win32 !! }
  599. var
  600. hp2 : texported_item;
  601. begin
  602. hp2:=texported_item(current_module._exports.first);
  603. while assigned(hp2) and
  604. (hp.name^>hp2.name^) do
  605. hp2:=texported_item(hp2.next);
  606. { insert hp there !! }
  607. if hp2=nil then
  608. current_module._exports.concat(hp)
  609. else
  610. begin
  611. if hp2.name^=hp.name^ then
  612. begin
  613. { this is not allowed !! }
  614. message1(parser_e_export_name_double,hp.name^);
  615. exit;
  616. end;
  617. current_module._exports.insertbefore(hp,hp2);
  618. end;
  619. end;
  620. procedure TExportLibWin.generatelib;
  621. var
  622. ordinal_base,ordinal_max,ordinal_min : longint;
  623. current_index : longint;
  624. entries,named_entries : longint;
  625. name_label,dll_name_label,export_address_table : tasmlabel;
  626. export_name_table_pointers,export_ordinal_table : tasmlabel;
  627. hp,hp2 : texported_item;
  628. temtexport : TLinkedList;
  629. address_table,name_table_pointers,
  630. name_table,ordinal_table : TAsmList;
  631. i,autoindex,ni_high : longint;
  632. hole : boolean;
  633. asmsym : TAsmSymbol;
  634. begin
  635. Gl_DoubleIndex:=false;
  636. ELIst_indexed.Sort(@IdxCompare);
  637. if Gl_DoubleIndex then
  638. begin
  639. message1(parser_e_export_ordinal_double,tostr(Gl_DoubleIndexValue));
  640. FreeAndNil(EList_indexed);
  641. FreeAndNil(EList_nonindexed);
  642. exit;
  643. end;
  644. autoindex:=1;
  645. while EList_nonindexed.Count>0 do
  646. begin
  647. hole:=(EList_indexed.Count>0) and (texported_item(EList_indexed.Items[0]).index>1);
  648. if not hole then
  649. for i:=autoindex to pred(EList_indexed.Count) do
  650. if texported_item(EList_indexed.Items[i]).index-texported_item(EList_indexed.Items[pred(i)]).index>1 then
  651. begin
  652. autoindex:=succ(texported_item(EList_indexed.Items[pred(i)]).index);
  653. hole:=true;
  654. break;
  655. end;
  656. ni_high:=pred(EList_nonindexed.Count);
  657. if not hole then
  658. begin
  659. autoindex:=succ(EList_indexed.Count);
  660. EList_indexed.Add(EList_nonindexed.Items[ni_high]);
  661. end
  662. else
  663. EList_indexed.Insert(pred(AutoIndex),EList_nonindexed.Items[ni_high]);
  664. EList_nonindexed.Delete(ni_high);
  665. texported_item(EList_indexed.Items[pred(AutoIndex)]).index:=autoindex;
  666. end;
  667. FreeAndNil(EList_nonindexed);
  668. for i:=0 to pred(EList_indexed.Count) do
  669. exportfromlist(texported_item(EList_indexed.Items[i]));
  670. FreeAndNil(EList_indexed);
  671. if (target_asm.id in [as_i386_masm,as_i386_tasm,as_i386_nasmwin32]) then
  672. begin
  673. generatenasmlib;
  674. exit;
  675. end;
  676. hp:=texported_item(current_module._exports.first);
  677. if not assigned(hp) then
  678. exit;
  679. ordinal_max:=0;
  680. ordinal_min:=$7FFFFFFF;
  681. entries:=0;
  682. named_entries:=0;
  683. current_asmdata.getjumplabel(dll_name_label);
  684. current_asmdata.getjumplabel(export_address_table);
  685. current_asmdata.getjumplabel(export_name_table_pointers);
  686. current_asmdata.getjumplabel(export_ordinal_table);
  687. { count entries }
  688. while assigned(hp) do
  689. begin
  690. inc(entries);
  691. if (hp.index>ordinal_max) then
  692. ordinal_max:=hp.index;
  693. if (hp.index>0) and (hp.index<ordinal_min) then
  694. ordinal_min:=hp.index;
  695. if assigned(hp.name) then
  696. inc(named_entries);
  697. hp:=texported_item(hp.next);
  698. end;
  699. { no support for higher ordinal base yet !! }
  700. ordinal_base:=1;
  701. current_index:=ordinal_base;
  702. { we must also count the holes !! }
  703. entries:=ordinal_max-ordinal_base+1;
  704. new_section(current_asmdata.asmlists[al_exports],sec_edata,'',0);
  705. { create label to reference from main so smartlink will include
  706. the .edata section }
  707. current_asmdata.asmlists[al_exports].concat(Tai_symbol.Createname_global(make_mangledname('EDATA',current_module.localsymtable,''),AT_DATA,0));
  708. { export flags }
  709. current_asmdata.asmlists[al_exports].concat(Tai_const.Create_32bit(0));
  710. { date/time stamp }
  711. current_asmdata.asmlists[al_exports].concat(Tai_const.Create_32bit(0));
  712. { major version }
  713. current_asmdata.asmlists[al_exports].concat(Tai_const.Create_16bit(0));
  714. { minor version }
  715. current_asmdata.asmlists[al_exports].concat(Tai_const.Create_16bit(0));
  716. { pointer to dll name }
  717. current_asmdata.asmlists[al_exports].concat(Tai_const.Create_rva_sym(dll_name_label));
  718. { ordinal base normally set to 1 }
  719. current_asmdata.asmlists[al_exports].concat(Tai_const.Create_32bit(ordinal_base));
  720. { number of entries }
  721. current_asmdata.asmlists[al_exports].concat(Tai_const.Create_32bit(entries));
  722. { number of named entries }
  723. current_asmdata.asmlists[al_exports].concat(Tai_const.Create_32bit(named_entries));
  724. { address of export address table }
  725. current_asmdata.asmlists[al_exports].concat(Tai_const.Create_rva_sym(export_address_table));
  726. { address of name pointer pointers }
  727. current_asmdata.asmlists[al_exports].concat(Tai_const.Create_rva_sym(export_name_table_pointers));
  728. { address of ordinal number pointers }
  729. current_asmdata.asmlists[al_exports].concat(Tai_const.Create_rva_sym(export_ordinal_table));
  730. { the name }
  731. current_asmdata.asmlists[al_exports].concat(Tai_label.Create(dll_name_label));
  732. if st='' then
  733. current_asmdata.asmlists[al_exports].concat(Tai_string.Create(current_module.modulename^+target_info.sharedlibext+#0))
  734. else
  735. current_asmdata.asmlists[al_exports].concat(Tai_string.Create(st+target_info.sharedlibext+#0));
  736. { export address table }
  737. address_table:=TAsmList.create;
  738. address_table.concat(Tai_align.Create_op(4,0));
  739. address_table.concat(Tai_label.Create(export_address_table));
  740. name_table_pointers:=TAsmList.create;
  741. name_table_pointers.concat(Tai_align.Create_op(4,0));
  742. name_table_pointers.concat(Tai_label.Create(export_name_table_pointers));
  743. ordinal_table:=TAsmList.create;
  744. ordinal_table.concat(Tai_align.Create_op(4,0));
  745. ordinal_table.concat(Tai_label.Create(export_ordinal_table));
  746. name_table:=TAsmList.Create;
  747. name_table.concat(Tai_align.Create_op(4,0));
  748. { write each address }
  749. hp:=texported_item(current_module._exports.first);
  750. while assigned(hp) do
  751. begin
  752. if (hp.options and eo_name)<>0 then
  753. begin
  754. current_asmdata.getjumplabel(name_label);
  755. name_table_pointers.concat(Tai_const.Create_rva_sym(name_label));
  756. ordinal_table.concat(Tai_const.Create_16bit(hp.index-ordinal_base));
  757. name_table.concat(Tai_align.Create_op(2,0));
  758. name_table.concat(Tai_label.Create(name_label));
  759. name_table.concat(Tai_string.Create(hp.name^+#0));
  760. end;
  761. hp:=texported_item(hp.next);
  762. end;
  763. { order in increasing ordinal values }
  764. { into temtexport list }
  765. temtexport:=TLinkedList.Create;
  766. hp:=texported_item(current_module._exports.first);
  767. while assigned(hp) do
  768. begin
  769. current_module._exports.remove(hp);
  770. hp2:=texported_item(temtexport.first);
  771. while assigned(hp2) and (hp.index>hp2.index) do
  772. hp2:=texported_item(hp2.next);
  773. if hp2=nil then
  774. temtexport.concat(hp)
  775. else
  776. temtexport.insertbefore(hp,hp2);
  777. hp:=texported_item(current_module._exports.first);
  778. end;
  779. { write the export adress table }
  780. current_index:=ordinal_base;
  781. hp:=texported_item(temtexport.first);
  782. while assigned(hp) do
  783. begin
  784. { fill missing values }
  785. while current_index<hp.index do
  786. begin
  787. address_table.concat(Tai_const.Create_32bit(0));
  788. inc(current_index);
  789. end;
  790. { symbol known? then get a new name }
  791. if assigned(hp.sym) then
  792. case hp.sym.typ of
  793. staticvarsym :
  794. asmsym:=current_asmdata.RefAsmSymbol(tstaticvarsym(hp.sym).mangledname);
  795. procsym :
  796. asmsym:=current_asmdata.RefAsmSymbol(tprocdef(tprocsym(hp.sym).ProcdefList[0]).mangledname)
  797. else
  798. internalerror(200709272);
  799. end
  800. else
  801. asmsym:=current_asmdata.RefAsmSymbol(hp.name^);
  802. address_table.concat(Tai_const.Create_rva_sym(asmsym));
  803. inc(current_index);
  804. hp:=texported_item(hp.next);
  805. end;
  806. current_asmdata.asmlists[al_exports].concatlist(address_table);
  807. current_asmdata.asmlists[al_exports].concatlist(name_table_pointers);
  808. current_asmdata.asmlists[al_exports].concatlist(ordinal_table);
  809. current_asmdata.asmlists[al_exports].concatlist(name_table);
  810. address_table.Free;
  811. name_table_pointers.free;
  812. ordinal_table.free;
  813. name_table.free;
  814. { the package support needs this data later on
  815. to create the import library }
  816. current_module._exports.concatlist(temtexport);
  817. temtexport.free;
  818. end;
  819. procedure TExportLibWin.generatenasmlib;
  820. var
  821. hp : texported_item;
  822. p : pchar;
  823. s : string;
  824. begin
  825. new_section(current_asmdata.asmlists[al_exports],sec_code,'',0);
  826. hp:=texported_item(current_module._exports.first);
  827. while assigned(hp) do
  828. begin
  829. case hp.sym.typ of
  830. staticvarsym :
  831. s:=tstaticvarsym(hp.sym).mangledname;
  832. procsym :
  833. s:=tprocdef(tprocsym(hp.sym).ProcdefList[0]).mangledname;
  834. else
  835. s:='';
  836. end;
  837. p:=strpnew(#9+'export '+s+' '+hp.Name^+' '+tostr(hp.index));
  838. {current_asmdata.asmlists[al_exports].concat(tai_direct.create(p));}
  839. hp:=texported_item(hp.next);
  840. end;
  841. end;
  842. {****************************************************************************
  843. TInternalLinkerWin
  844. ****************************************************************************}
  845. constructor TInternalLinkerWin.Create;
  846. begin
  847. inherited Create;
  848. CExeoutput:=TPECoffexeoutput;
  849. CObjInput:=TPECoffObjInput;
  850. end;
  851. procedure TInternalLinkerWin.DefaultLinkScript;
  852. var
  853. s,s2,
  854. ibase : TCmdStr;
  855. secname,
  856. secnames : string;
  857. begin
  858. with LinkScript do
  859. begin
  860. while not ObjectFiles.Empty do
  861. begin
  862. s:=ObjectFiles.GetFirst;
  863. if s<>'' then
  864. Concat('READOBJECT '+MaybeQuoted(s));
  865. end;
  866. while not StaticLibFiles.Empty do
  867. begin
  868. s:=StaticLibFiles.GetFirst;
  869. if s<>'' then
  870. Concat('READSTATICLIBRARY '+MaybeQuoted(s));
  871. end;
  872. While not SharedLibFiles.Empty do
  873. begin
  874. S:=SharedLibFiles.GetFirst;
  875. if FindLibraryFile(s,target_info.staticClibprefix,target_info.staticClibext,s2) then
  876. Concat('READSTATICLIBRARY '+MaybeQuoted(s2))
  877. else
  878. Comment(V_Error,'Import library not found for '+S);
  879. end;
  880. if IsSharedLibrary then
  881. begin
  882. Concat('ISSHAREDLIBRARY');
  883. if apptype=app_gui then
  884. Concat('ENTRYNAME _DLLWinMainCRTStartup')
  885. else
  886. Concat('ENTRYNAME _DLLMainCRTStartup');
  887. end
  888. else
  889. begin
  890. if apptype=app_gui then
  891. Concat('ENTRYNAME _WinMainCRTStartup')
  892. else
  893. Concat('ENTRYNAME _mainCRTStartup');
  894. end;
  895. ibase:='';
  896. if assigned(DLLImageBase) then
  897. ibase:=DLLImageBase^
  898. else
  899. begin
  900. if IsSharedLibrary then
  901. ibase:='10000000'
  902. else
  903. if target_info.system in [system_arm_wince] then
  904. ibase:='10000'
  905. else
  906. ibase:='400000';
  907. end;
  908. Concat('IMAGEBASE $' + ibase);
  909. Concat('HEADER');
  910. Concat('EXESECTION .text');
  911. Concat(' SYMBOL __text_start__');
  912. Concat(' OBJSECTION .text*');
  913. Concat(' SYMBOL ___CTOR_LIST__');
  914. Concat(' SYMBOL __CTOR_LIST__');
  915. Concat(' LONG -1');
  916. Concat(' OBJSECTION .ctor*');
  917. Concat(' LONG 0');
  918. Concat(' SYMBOL ___DTOR_LIST__');
  919. Concat(' SYMBOL __DTOR_LIST__');
  920. Concat(' LONG -1');
  921. Concat(' OBJSECTION .dtor*');
  922. Concat(' LONG 0');
  923. Concat(' SYMBOL etext');
  924. Concat('ENDEXESECTION');
  925. Concat('EXESECTION .data');
  926. Concat(' SYMBOL __data_start__');
  927. Concat(' OBJSECTION .data*');
  928. Concat(' OBJSECTION .fpc*');
  929. Concat(' SYMBOL edata');
  930. Concat(' SYMBOL __data_end__');
  931. Concat('ENDEXESECTION');
  932. Concat('EXESECTION .rdata');
  933. Concat(' SYMBOL ___RUNTIME_PSEUDO_RELOC_LIST__');
  934. Concat(' SYMBOL __RUNTIME_PSEUDO_RELOC_LIST__');
  935. Concat(' OBJSECTION .rdata_runtime_pseudo_reloc');
  936. Concat(' SYMBOL ___RUNTIME_PSEUDO_RELOC_LIST_END__');
  937. Concat(' SYMBOL __RUNTIME_PSEUDO_RELOC_LIST_END__');
  938. Concat(' OBJSECTION .rdata*');
  939. Concat(' OBJSECTION .rodata*');
  940. Concat('ENDEXESECTION');
  941. Concat('EXESECTION .pdata');
  942. Concat(' OBJSECTION .pdata');
  943. Concat('ENDEXESECTION');
  944. Concat('EXESECTION .bss');
  945. Concat(' SYMBOL __bss_start__');
  946. Concat(' OBJSECTION .bss*');
  947. Concat(' SYMBOL __bss_end__');
  948. Concat('ENDEXESECTION');
  949. Concat('EXESECTION .idata');
  950. Concat(' OBJSECTION .idata$2*');
  951. Concat(' OBJSECTION .idata$3*');
  952. Concat(' ZEROS 20');
  953. Concat(' OBJSECTION .idata$4*');
  954. Concat(' OBJSECTION .idata$5*');
  955. Concat(' OBJSECTION .idata$6*');
  956. Concat(' OBJSECTION .idata$7*');
  957. Concat('ENDEXESECTION');
  958. secnames:='.edata,.rsrc,.reloc,.gnu_debuglink,'+
  959. '.debug_aranges,.debug_pubnames,.debug_info,.debug_abbrev,.debug_line,.debug_frame,.debug_str,.debug_loc,'+
  960. '.debug_macinfo,.debug_weaknames,.debug_funcnames,.debug_typenames,.debug_varnames,.debug_ranges';
  961. repeat
  962. secname:=gettoken(secnames,',');
  963. if secname='' then
  964. break;
  965. Concat('EXESECTION '+secname);
  966. Concat(' OBJSECTION '+secname+'*');
  967. Concat('ENDEXESECTION');
  968. until false;
  969. { Can't use the generic rules, because that will add also .stabstr to .stab }
  970. Concat('EXESECTION .stab');
  971. Concat(' OBJSECTION .stab');
  972. Concat('ENDEXESECTION');
  973. Concat('EXESECTION .stabstr');
  974. Concat(' OBJSECTION .stabstr');
  975. Concat('ENDEXESECTION');
  976. Concat('STABS');
  977. Concat('SYMBOLS');
  978. end;
  979. end;
  980. procedure TInternalLinkerWin.InitSysInitUnitName;
  981. begin
  982. if target_info.system=system_i386_win32 then
  983. GlobalInitSysInitUnitName(self);
  984. end;
  985. {****************************************************************************
  986. TExternalLinkerWin
  987. ****************************************************************************}
  988. Constructor TExternalLinkerWin.Create;
  989. begin
  990. Inherited Create;
  991. { allow duplicated libs (PM) }
  992. SharedLibFiles.doubles:=true;
  993. StaticLibFiles.doubles:=true;
  994. end;
  995. Procedure TExternalLinkerWin.SetDefaultInfo;
  996. var
  997. targetopts: string;
  998. begin
  999. with Info do
  1000. begin
  1001. if target_info.system=system_arm_wince then
  1002. targetopts:='-m armpe'
  1003. else
  1004. targetopts:='-b pe-i386 -m i386pe';
  1005. ExeCmd[1]:='ld '+targetopts+' $OPT $GCSECTIONS $MAP $STRIP $APPTYPE $ENTRY $IMAGEBASE $RELOC -o $EXE $RES';
  1006. DllCmd[1]:='ld '+targetopts+' $OPT $GCSECTIONS $MAP $STRIP --dll $APPTYPE $ENTRY $IMAGEBASE $RELOC -o $EXE $RES';
  1007. { ExeCmd[2]:='dlltool --as $ASBIN --dllname $EXE --output-exp exp.$$$ $RELOC $DEF';
  1008. use short forms to avoid 128 char limitation problem }
  1009. ExeCmd[2]:='dlltool -S $ASBIN -D $EXE -e exp.$$$ $RELOC $DEF';
  1010. ExeCmd[3]:='ld '+targetopts+' $OPT $STRIP $APPTYPE $ENTRY $IMAGEBASE -o $EXE $RES exp.$$$';
  1011. { DllCmd[2]:='dlltool --as $ASBIN --dllname $EXE --output-exp exp.$$$ $RELOC $DEF'; }
  1012. DllCmd[2]:='dlltool -S $ASBIN -D $EXE -e exp.$$$ $RELOC $DEF';
  1013. DllCmd[3]:='ld '+targetopts+' $OPT $STRIP --dll $APPTYPE $ENTRY $IMAGEBASE -o $EXE $RES exp.$$$';
  1014. end;
  1015. end;
  1016. Function TExternalLinkerWin.WriteResponseFile(isdll:boolean) : Boolean;
  1017. Var
  1018. linkres : TLinkRes;
  1019. HPath : TCmdStrListItem;
  1020. s,s2 : TCmdStr;
  1021. i : integer;
  1022. begin
  1023. WriteResponseFile:=False;
  1024. if (cs_profile in current_settings.moduleswitches) then
  1025. begin
  1026. SharedLibFiles.Concat('gmon');
  1027. SharedLibFiles.Concat('c');
  1028. SharedLibFiles.Concat('gcc');
  1029. SharedLibFiles.Concat('kernel32');
  1030. end;
  1031. { Open link.res file }
  1032. LinkRes:=TLinkres.Create(outputexedir+Info.ResName);
  1033. with linkres do
  1034. begin
  1035. { Write path to search libraries }
  1036. HPath:=TCmdStrListItem(current_module.locallibrarysearchpath.First);
  1037. while assigned(HPath) do
  1038. begin
  1039. Add('SEARCH_DIR('+MaybeQuoted(HPath.Str)+')');
  1040. HPath:=TCmdStrListItem(HPath.Next);
  1041. end;
  1042. HPath:=TCmdStrListItem(LibrarySearchPath.First);
  1043. while assigned(HPath) do
  1044. begin
  1045. Add('SEARCH_DIR('+MaybeQuoted(HPath.Str)+')');
  1046. HPath:=TCmdStrListItem(HPath.Next);
  1047. end;
  1048. { add objectfiles, start with prt0 always }
  1049. { profiling of shared libraries is currently not supported }
  1050. if not ObjectFiles.Empty then
  1051. begin
  1052. Add('INPUT(');
  1053. while not ObjectFiles.Empty do
  1054. begin
  1055. s:=ObjectFiles.GetFirst;
  1056. if s<>'' then
  1057. AddFileName(MaybeQuoted(s));
  1058. end;
  1059. Add(')');
  1060. end;
  1061. { Write staticlibraries }
  1062. if (not StaticLibFiles.Empty) then
  1063. begin
  1064. Add('GROUP(');
  1065. While not StaticLibFiles.Empty do
  1066. begin
  1067. S:=StaticLibFiles.GetFirst;
  1068. AddFileName(MaybeQuoted(s));
  1069. end;
  1070. Add(')');
  1071. end;
  1072. { Write sharedlibraries (=import libraries) }
  1073. if not SharedLibFiles.Empty then
  1074. begin
  1075. Add('INPUT(') ;
  1076. While not SharedLibFiles.Empty do
  1077. begin
  1078. S:=SharedLibFiles.GetFirst;
  1079. if FindLibraryFile(s,target_info.staticClibprefix,target_info.staticClibext,s2) then
  1080. begin
  1081. Add(MaybeQuoted(s2));
  1082. continue;
  1083. end;
  1084. if pos(target_info.sharedlibprefix,s)=1 then
  1085. s:=copy(s,length(target_info.sharedlibprefix)+1,255);
  1086. i:=Pos(target_info.sharedlibext,S);
  1087. if i>0 then
  1088. Delete(S,i,255);
  1089. Add('-l'+s);
  1090. end;
  1091. Add(')');
  1092. end;
  1093. Add('SEARCH_DIR("/usr/i686-pc-cygwin/lib"); SEARCH_DIR("/usr/lib"); SEARCH_DIR("/usr/lib/w32api");');
  1094. Add('OUTPUT_FORMAT(pei-i386)');
  1095. Add('ENTRY(_mainCRTStartup)');
  1096. Add('SECTIONS');
  1097. Add('{');
  1098. Add(' . = SIZEOF_HEADERS;');
  1099. Add(' . = ALIGN(__section_alignment__);');
  1100. Add(' .text __image_base__ + ( __section_alignment__ < 0x1000 ? . : __section_alignment__ ) :');
  1101. Add(' {');
  1102. Add(' *(.init)');
  1103. add(' *(.text .stub .text.* .gnu.linkonce.t.*)');
  1104. Add(' *(SORT(.text$*))');
  1105. Add(' ___CTOR_LIST__ = .; __CTOR_LIST__ = . ;');
  1106. Add(' LONG (-1);*(.ctors); *(.ctor); *(SORT(.ctors.*)); LONG (0);');
  1107. Add(' ___DTOR_LIST__ = .; __DTOR_LIST__ = . ;');
  1108. Add(' LONG (-1); *(.dtors); *(.dtor); *(SORT(.dtors.*)); LONG (0);');
  1109. Add(' *(.fini)');
  1110. Add(' PROVIDE (etext = .);');
  1111. Add(' *(.gcc_except_table)');
  1112. Add(' }');
  1113. Add(' .data BLOCK(__section_alignment__) :');
  1114. Add(' {');
  1115. Add(' __data_start__ = . ;');
  1116. add(' *(.data .data.* .gnu.linkonce.d.* .fpc*)');
  1117. Add(' *(.data2)');
  1118. Add(' *(SORT(.data$*))');
  1119. Add(' __data_end__ = . ;');
  1120. Add(' *(.data_cygwin_nocopy)');
  1121. Add(' }');
  1122. Add(' .rdata BLOCK(__section_alignment__) :');
  1123. Add(' {');
  1124. Add(' *(.rdata)');
  1125. add(' *(.rodata .rodata.* .gnu.linkonce.r.*)');
  1126. Add(' *(SORT(.rdata$*))');
  1127. Add(' *(.eh_frame)');
  1128. Add(' ___RUNTIME_PSEUDO_RELOC_LIST__ = .;');
  1129. Add(' __RUNTIME_PSEUDO_RELOC_LIST__ = .;');
  1130. Add(' *(.rdata_runtime_pseudo_reloc)');
  1131. Add(' ___RUNTIME_PSEUDO_RELOC_LIST_END__ = .;');
  1132. Add(' __RUNTIME_PSEUDO_RELOC_LIST_END__ = .;');
  1133. Add(' }');
  1134. Add(' .pdata BLOCK(__section_alignment__) : { *(.pdata) }');
  1135. Add(' .bss BLOCK(__section_alignment__) :');
  1136. Add(' {');
  1137. Add(' __bss_start__ = . ;');
  1138. Add(' *(.bss .bss.* .gnu.linkonce.b.*)');
  1139. Add(' *(SORT(.bss$*))');
  1140. Add(' *(COMMON)');
  1141. Add(' __bss_end__ = . ;');
  1142. Add(' }');
  1143. Add(' .edata BLOCK(__section_alignment__) : { *(.edata) }');
  1144. Add(' .idata BLOCK(__section_alignment__) :');
  1145. Add(' {');
  1146. Add(' SORT(*)(.idata$2)');
  1147. Add(' SORT(*)(.idata$3)');
  1148. Add(' /* These zeroes mark the end of the import list. */');
  1149. Add(' LONG (0); LONG (0); LONG (0); LONG (0); LONG (0);');
  1150. Add(' SORT(*)(.idata$4)');
  1151. Add(' SORT(*)(.idata$5)');
  1152. Add(' SORT(*)(.idata$6)');
  1153. Add(' SORT(*)(.idata$7)');
  1154. Add(' }');
  1155. Add(' .CRT BLOCK(__section_alignment__) :');
  1156. Add(' {');
  1157. Add(' ___crt_xc_start__ = . ;');
  1158. Add(' *(SORT(.CRT$XC*)) /* C initialization */');
  1159. Add(' ___crt_xc_end__ = . ;');
  1160. Add(' ___crt_xi_start__ = . ;');
  1161. Add(' *(SORT(.CRT$XI*)) /* C++ initialization */');
  1162. Add(' ___crt_xi_end__ = . ;');
  1163. Add(' ___crt_xl_start__ = . ;');
  1164. Add(' *(SORT(.CRT$XL*)) /* TLS callbacks */');
  1165. Add(' /* ___crt_xl_end__ is defined in the TLS Directory support code */');
  1166. Add(' ___crt_xp_start__ = . ;');
  1167. Add(' *(SORT(.CRT$XP*)) /* Pre-termination */');
  1168. Add(' ___crt_xp_end__ = . ;');
  1169. Add(' ___crt_xt_start__ = . ;');
  1170. Add(' *(SORT(.CRT$XT*)) /* Termination */');
  1171. Add(' ___crt_xt_end__ = . ;');
  1172. Add(' }');
  1173. Add(' .tls BLOCK(__section_alignment__) :');
  1174. Add(' {');
  1175. Add(' ___tls_start__ = . ;');
  1176. Add(' *(.tls .tls.*)');
  1177. Add(' *(.tls$)');
  1178. Add(' *(SORT(.tls$*))');
  1179. Add(' ___tls_end__ = . ;');
  1180. Add(' }');
  1181. Add(' .rsrc BLOCK(__section_alignment__) :');
  1182. Add(' {');
  1183. Add(' *(.rsrc)');
  1184. Add(' *(SORT(.rsrc$*))');
  1185. Add(' }');
  1186. Add(' .reloc BLOCK(__section_alignment__) : { *(.reloc) }');
  1187. Add(' .stab BLOCK(__section_alignment__) (NOLOAD) : { *(.stab) }');
  1188. Add(' .stabstr BLOCK(__section_alignment__) (NOLOAD) : { *(.stabstr) }');
  1189. Add(' .debug_aranges BLOCK(__section_alignment__) (NOLOAD) : { *(.debug_aranges) }');
  1190. Add(' .debug_pubnames BLOCK(__section_alignment__) (NOLOAD) : { *(.debug_pubnames) }');
  1191. Add(' .debug_info BLOCK(__section_alignment__) (NOLOAD) : { *(.debug_info) *(.gnu.linkonce.wi.*) }');
  1192. Add(' .debug_abbrev BLOCK(__section_alignment__) (NOLOAD) : { *(.debug_abbrev) }');
  1193. Add(' .debug_line BLOCK(__section_alignment__) (NOLOAD) : { *(.debug_line) }');
  1194. Add(' .debug_frame BLOCK(__section_alignment__) (NOLOAD) : { *(.debug_frame) }');
  1195. Add(' .debug_str BLOCK(__section_alignment__) (NOLOAD) : { *(.debug_str) }');
  1196. Add(' .debug_loc BLOCK(__section_alignment__) (NOLOAD) : { *(.debug_loc) }');
  1197. Add(' .debug_macinfo BLOCK(__section_alignment__) (NOLOAD) : { *(.debug_macinfo) }');
  1198. Add(' .debug_weaknames BLOCK(__section_alignment__) (NOLOAD) : { *(.debug_weaknames) }');
  1199. Add(' .debug_funcnames BLOCK(__section_alignment__) (NOLOAD) : { *(.debug_funcnames) }');
  1200. Add(' .debug_typenames BLOCK(__section_alignment__) (NOLOAD) : { *(.debug_typenames) }');
  1201. Add(' .debug_varnames BLOCK(__section_alignment__) (NOLOAD) : { *(.debug_varnames) }');
  1202. Add(' .debug_ranges BLOCK(__section_alignment__) (NOLOAD) : { *(.debug_ranges) }');
  1203. Add('}');
  1204. { Write and Close response }
  1205. writetodisk;
  1206. Free;
  1207. end;
  1208. WriteResponseFile:=True;
  1209. end;
  1210. function TExternalLinkerWin.MakeExecutable:boolean;
  1211. var
  1212. MapStr,
  1213. binstr,
  1214. cmdstr : TCmdStr;
  1215. success : boolean;
  1216. cmds,i : longint;
  1217. AsBinStr : string[80];
  1218. GCSectionsStr,
  1219. StripStr,
  1220. RelocStr,
  1221. AppTypeStr,
  1222. EntryStr,
  1223. ImageBaseStr : string[40];
  1224. begin
  1225. if not(cs_link_nolink in current_settings.globalswitches) then
  1226. Message1(exec_i_linking,current_module.exefilename^);
  1227. { Create some replacements }
  1228. RelocStr:='';
  1229. AppTypeStr:='';
  1230. EntryStr:='';
  1231. ImageBaseStr:='';
  1232. StripStr:='';
  1233. MapStr:='';
  1234. GCSectionsStr:='';
  1235. AsBinStr:=FindUtil(utilsprefix+'as');
  1236. if RelocSection then
  1237. RelocStr:='--base-file base.$$$';
  1238. if create_smartlink_sections then
  1239. GCSectionsStr:='--gc-sections';
  1240. if target_info.system in [system_arm_wince,system_i386_wince] then
  1241. AppTypeStr:='--subsystem wince'
  1242. else
  1243. begin
  1244. if apptype=app_gui then
  1245. AppTypeStr:='--subsystem windows';
  1246. end;
  1247. if apptype=app_gui then
  1248. EntryStr:='--entry=_WinMainCRTStartup'
  1249. else
  1250. EntryStr:='--entry=_mainCRTStartup';
  1251. if assigned(DLLImageBase) then
  1252. ImageBaseStr:='--image-base=0x'+DLLImageBase^;
  1253. if (cs_link_strip in current_settings.globalswitches) then
  1254. StripStr:='-s';
  1255. if (cs_link_map in current_settings.globalswitches) then
  1256. MapStr:='-Map '+maybequoted(ChangeFileExt(current_module.exefilename^,'.map'));
  1257. { Write used files and libraries }
  1258. WriteResponseFile(false);
  1259. { Call linker }
  1260. success:=false;
  1261. if RelocSection or (not Deffile.empty) then
  1262. cmds:=3
  1263. else
  1264. cmds:=1;
  1265. for i:=1 to cmds do
  1266. begin
  1267. SplitBinCmd(Info.ExeCmd[i],binstr,cmdstr);
  1268. if binstr<>'' then
  1269. begin
  1270. Replace(cmdstr,'$EXE',maybequoted(current_module.exefilename^));
  1271. Replace(cmdstr,'$OPT',Info.ExtraOptions);
  1272. Replace(cmdstr,'$RES',maybequoted(outputexedir+Info.ResName));
  1273. Replace(cmdstr,'$APPTYPE',AppTypeStr);
  1274. Replace(cmdstr,'$ENTRY',EntryStr);
  1275. Replace(cmdstr,'$ASBIN',AsbinStr);
  1276. Replace(cmdstr,'$RELOC',RelocStr);
  1277. Replace(cmdstr,'$IMAGEBASE',ImageBaseStr);
  1278. Replace(cmdstr,'$GCSECTIONS',GCSectionsStr);
  1279. Replace(cmdstr,'$STRIP',StripStr);
  1280. Replace(cmdstr,'$MAP',MapStr);
  1281. if not DefFile.Empty then
  1282. begin
  1283. DefFile.WriteFile;
  1284. Replace(cmdstr,'$DEF','-d '+maybequoted(deffile.fname));
  1285. end
  1286. else
  1287. Replace(cmdstr,'$DEF','');
  1288. success:=DoExec(FindUtil(utilsprefix+binstr),cmdstr,(i=1),false);
  1289. if not success then
  1290. break;
  1291. end;
  1292. end;
  1293. { Post process }
  1294. if success then
  1295. success:=PostProcessExecutable(current_module.exefilename^,false);
  1296. { Remove ReponseFile }
  1297. if (success) and not(cs_link_nolink in current_settings.globalswitches) then
  1298. begin
  1299. DeleteFile(outputexedir+Info.ResName);
  1300. DeleteFile('base.$$$');
  1301. DeleteFile('exp.$$$');
  1302. DeleteFile('deffile.$$$');
  1303. end;
  1304. MakeExecutable:=success; { otherwise a recursive call to link method }
  1305. end;
  1306. Function TExternalLinkerWin.MakeSharedLibrary:boolean;
  1307. var
  1308. MapStr,
  1309. binstr,
  1310. cmdstr : TCmdStr;
  1311. success : boolean;
  1312. cmds,
  1313. i : longint;
  1314. AsBinStr : string[80];
  1315. StripStr,
  1316. GCSectionsStr,
  1317. RelocStr,
  1318. AppTypeStr,
  1319. EntryStr,
  1320. ImageBaseStr : string[40];
  1321. begin
  1322. MakeSharedLibrary:=false;
  1323. if not(cs_link_nolink in current_settings.globalswitches) then
  1324. Message1(exec_i_linking,current_module.sharedlibfilename^);
  1325. { Create some replacements }
  1326. RelocStr:='';
  1327. AppTypeStr:='';
  1328. EntryStr:='';
  1329. ImageBaseStr:='';
  1330. StripStr:='';
  1331. MapStr:='';
  1332. GCSectionsStr:='';
  1333. AsBinStr:=FindUtil(utilsprefix+'as');
  1334. if RelocSection then
  1335. RelocStr:='--base-file base.$$$';
  1336. if create_smartlink_sections then
  1337. GCSectionsStr:='--gc-sections';
  1338. if apptype=app_gui then
  1339. begin
  1340. AppTypeStr:='--subsystem windows';
  1341. EntryStr:='--entry _DLLWinMainCRTStartup'
  1342. end
  1343. else
  1344. EntryStr:='--entry _DLLMainCRTStartup';
  1345. if assigned(DLLImageBase) then
  1346. ImageBaseStr:='--image-base=0x'+DLLImageBase^;
  1347. if (cs_link_strip in current_settings.globalswitches) then
  1348. StripStr:='-s';
  1349. if (cs_link_map in current_settings.globalswitches) then
  1350. MapStr:='-Map '+maybequoted(ChangeFileExt(current_module.exefilename^,'.map'));
  1351. { Write used files and libraries }
  1352. WriteResponseFile(true);
  1353. { Call linker }
  1354. success:=false;
  1355. if RelocSection or (not Deffile.empty) then
  1356. cmds:=3
  1357. else
  1358. cmds:=1;
  1359. for i:=1 to cmds do
  1360. begin
  1361. SplitBinCmd(Info.DllCmd[i],binstr,cmdstr);
  1362. if binstr<>'' then
  1363. begin
  1364. Replace(cmdstr,'$EXE',maybequoted(current_module.sharedlibfilename^));
  1365. Replace(cmdstr,'$OPT',Info.ExtraOptions);
  1366. Replace(cmdstr,'$RES',maybequoted(outputexedir+Info.ResName));
  1367. Replace(cmdstr,'$APPTYPE',AppTypeStr);
  1368. Replace(cmdstr,'$ENTRY',EntryStr);
  1369. Replace(cmdstr,'$ASBIN',AsbinStr);
  1370. Replace(cmdstr,'$RELOC',RelocStr);
  1371. Replace(cmdstr,'$IMAGEBASE',ImageBaseStr);
  1372. Replace(cmdstr,'$STRIP',StripStr);
  1373. Replace(cmdstr,'$GCSECTIONS',GCSectionsStr);
  1374. Replace(cmdstr,'$MAP',MapStr);
  1375. if not DefFile.Empty then
  1376. begin
  1377. DefFile.WriteFile;
  1378. Replace(cmdstr,'$DEF','-d '+maybequoted(deffile.fname));
  1379. end
  1380. else
  1381. Replace(cmdstr,'$DEF','');
  1382. success:=DoExec(FindUtil(utilsprefix+binstr),cmdstr,(i=1),false);
  1383. if not success then
  1384. break;
  1385. end;
  1386. end;
  1387. { Post process }
  1388. if success then
  1389. success:=PostProcessExecutable(current_module.sharedlibfilename^,true);
  1390. { Remove ReponseFile }
  1391. if (success) and not(cs_link_nolink in current_settings.globalswitches) then
  1392. begin
  1393. DeleteFile(outputexedir+Info.ResName);
  1394. DeleteFile('base.$$$');
  1395. DeleteFile('exp.$$$');
  1396. DeleteFile('deffile.$$$');
  1397. end;
  1398. MakeSharedLibrary:=success; { otherwise a recursive call to link method }
  1399. end;
  1400. function TExternalLinkerWin.postprocessexecutable(const fn : string;isdll:boolean):boolean;
  1401. type
  1402. tdosheader = packed record
  1403. e_magic : word;
  1404. e_cblp : word;
  1405. e_cp : word;
  1406. e_crlc : word;
  1407. e_cparhdr : word;
  1408. e_minalloc : word;
  1409. e_maxalloc : word;
  1410. e_ss : word;
  1411. e_sp : word;
  1412. e_csum : word;
  1413. e_ip : word;
  1414. e_cs : word;
  1415. e_lfarlc : word;
  1416. e_ovno : word;
  1417. e_res : array[0..3] of word;
  1418. e_oemid : word;
  1419. e_oeminfo : word;
  1420. e_res2 : array[0..9] of word;
  1421. e_lfanew : longint;
  1422. end;
  1423. psecfill=^TSecfill;
  1424. TSecfill=record
  1425. fillpos,
  1426. fillsize : longint;
  1427. next : psecfill;
  1428. end;
  1429. var
  1430. f : file;
  1431. cmdstr : string;
  1432. dosheader : tdosheader;
  1433. peheader : tcoffheader;
  1434. peoptheader : tcoffpeoptheader;
  1435. firstsecpos,
  1436. maxfillsize,
  1437. l,peheaderpos : longint;
  1438. coffsec : tcoffsechdr;
  1439. secroot,hsecroot : psecfill;
  1440. zerobuf : pointer;
  1441. begin
  1442. postprocessexecutable:=false;
  1443. { when -s is used or it's a dll then quit }
  1444. if (cs_link_nolink in current_settings.globalswitches) then
  1445. begin
  1446. case apptype of
  1447. app_native :
  1448. cmdstr:='--subsystem native';
  1449. app_gui :
  1450. cmdstr:='--subsystem gui';
  1451. app_cui :
  1452. cmdstr:='--subsystem console';
  1453. end;
  1454. if dllversion<>'' then
  1455. cmdstr:=cmdstr+' --version '+dllversion;
  1456. cmdstr:=cmdstr+' --input '+maybequoted(fn);
  1457. cmdstr:=cmdstr+' --stack '+tostr(stacksize);
  1458. DoExec(FindUtil(utilsprefix+'postw32'),cmdstr,false,false);
  1459. postprocessexecutable:=true;
  1460. exit;
  1461. end;
  1462. { open file }
  1463. assign(f,fn);
  1464. {$I-}
  1465. reset(f,1);
  1466. if ioresult<>0 then
  1467. Message1(execinfo_f_cant_open_executable,fn);
  1468. { read headers }
  1469. blockread(f,dosheader,sizeof(tdosheader));
  1470. peheaderpos:=dosheader.e_lfanew;
  1471. { skip to headerpos and skip pe magic }
  1472. seek(f,peheaderpos+4);
  1473. blockread(f,peheader,sizeof(tcoffheader));
  1474. blockread(f,peoptheader,sizeof(tcoffpeoptheader));
  1475. { write info }
  1476. Message1(execinfo_x_codesize,tostr(peoptheader.tsize));
  1477. Message1(execinfo_x_initdatasize,tostr(peoptheader.dsize));
  1478. Message1(execinfo_x_uninitdatasize,tostr(peoptheader.bsize));
  1479. { change stack size (PM) }
  1480. { I am not sure that the default value is adequate !! }
  1481. peoptheader.SizeOfStackReserve:=stacksize;
  1482. if SetPEFlagsSetExplicity then
  1483. peoptheader.LoaderFlags:=peflags;
  1484. if ImageBaseSetExplicity then
  1485. peoptheader.ImageBase:=imagebase;
  1486. if MinStackSizeSetExplicity then
  1487. peoptheader.SizeOfStackCommit:=minstacksize;
  1488. if MaxStackSizeSetExplicity then
  1489. peoptheader.SizeOfStackReserve:=maxstacksize;
  1490. { change the header }
  1491. { sub system }
  1492. { gui=2 }
  1493. { cui=3 }
  1494. { wincegui=9 }
  1495. if target_info.system in [system_arm_wince,system_i386_wince] then
  1496. peoptheader.Subsystem:=9
  1497. else
  1498. case apptype of
  1499. app_native :
  1500. peoptheader.Subsystem:=1;
  1501. app_gui :
  1502. peoptheader.Subsystem:=2;
  1503. app_cui :
  1504. peoptheader.Subsystem:=3;
  1505. end;
  1506. if dllversion<>'' then
  1507. begin
  1508. peoptheader.MajorImageVersion:=dllmajor;
  1509. peoptheader.MinorImageVersion:=dllminor;
  1510. end;
  1511. { reset timestamp }
  1512. peheader.time:=0;
  1513. { write header back, skip pe magic }
  1514. seek(f,peheaderpos+4);
  1515. blockwrite(f,peheader,sizeof(tcoffheader));
  1516. if ioresult<>0 then
  1517. Message1(execinfo_f_cant_process_executable,fn);
  1518. blockwrite(f,peoptheader,sizeof(tcoffpeoptheader));
  1519. if ioresult<>0 then
  1520. Message1(execinfo_f_cant_process_executable,fn);
  1521. { skip to headerpos and skip pe magic }
  1522. seek(f,peheaderpos+4);
  1523. blockread(f,peheader,sizeof(tcoffheader));
  1524. blockread(f,peoptheader,sizeof(tcoffpeoptheader));
  1525. { write the value after the change }
  1526. Message1(execinfo_x_stackreserve,tostr(peoptheader.SizeOfStackReserve));
  1527. Message1(execinfo_x_stackcommit,tostr(peoptheader.SizeOfStackCommit));
  1528. { read section info }
  1529. maxfillsize:=0;
  1530. firstsecpos:=0;
  1531. secroot:=nil;
  1532. for l:=1 to peheader.nsects do
  1533. begin
  1534. blockread(f,coffsec,sizeof(tcoffsechdr));
  1535. if coffsec.datapos>0 then
  1536. begin
  1537. if secroot=nil then
  1538. firstsecpos:=coffsec.datapos;
  1539. new(hsecroot);
  1540. hsecroot^.fillpos:=coffsec.datapos+coffsec.vsize;
  1541. hsecroot^.fillsize:=coffsec.datasize-coffsec.vsize;
  1542. hsecroot^.next:=secroot;
  1543. secroot:=hsecroot;
  1544. if secroot^.fillsize>maxfillsize then
  1545. maxfillsize:=secroot^.fillsize;
  1546. end;
  1547. end;
  1548. if firstsecpos>0 then
  1549. begin
  1550. l:=firstsecpos-filepos(f);
  1551. if l>maxfillsize then
  1552. maxfillsize:=l;
  1553. end
  1554. else
  1555. l:=0;
  1556. { get zero buffer }
  1557. getmem(zerobuf,maxfillsize);
  1558. fillchar(zerobuf^,maxfillsize,0);
  1559. { zero from sectioninfo until first section }
  1560. blockwrite(f,zerobuf^,l);
  1561. { zero section alignments }
  1562. while assigned(secroot) do
  1563. begin
  1564. seek(f,secroot^.fillpos);
  1565. blockwrite(f,zerobuf^,secroot^.fillsize);
  1566. hsecroot:=secroot;
  1567. secroot:=secroot^.next;
  1568. dispose(hsecroot);
  1569. end;
  1570. freemem(zerobuf,maxfillsize);
  1571. close(f);
  1572. {$I+}
  1573. if ioresult<>0 then;
  1574. postprocessexecutable:=true;
  1575. end;
  1576. procedure TExternalLinkerWin.InitSysInitUnitName;
  1577. begin
  1578. if target_info.system=system_i386_win32 then
  1579. GlobalInitSysInitUnitName(self);
  1580. end;
  1581. {****************************************************************************
  1582. TDLLScannerWin
  1583. ****************************************************************************}
  1584. procedure TDLLScannerWin.CheckDLLFunc(const dllname,funcname:string);
  1585. var
  1586. i : longint;
  1587. ExtName : string;
  1588. begin
  1589. for i:=0 to current_module.dllscannerinputlist.count-1 do
  1590. begin
  1591. ExtName:=current_module.dllscannerinputlist.NameOfIndex(i);
  1592. if (ExtName=funcname) then
  1593. begin
  1594. current_module.AddExternalImport(dllname,funcname,0,false,false);
  1595. importfound:=true;
  1596. current_module.dllscannerinputlist.Delete(i);
  1597. exit;
  1598. end;
  1599. end;
  1600. end;
  1601. function TDLLScannerWin.scan(const binname:string):boolean;
  1602. var
  1603. hs,
  1604. dllname : TCmdStr;
  1605. begin
  1606. result:=false;
  1607. { is there already an import library the we will use that one }
  1608. if FindLibraryFile(binname,target_info.staticClibprefix,target_info.staticClibext,hs) then
  1609. exit;
  1610. { check if we can find the dll }
  1611. hs:=binname;
  1612. if ExtractFileExt(hs)='' then
  1613. hs:=ChangeFileExt(hs,target_info.sharedlibext);
  1614. if not FindDll(hs,dllname) then
  1615. exit;
  1616. importfound:=false;
  1617. ReadDLLImports(dllname,@CheckDLLFunc);
  1618. if importfound then
  1619. current_module.dllscannerinputlist.Pack;
  1620. result:=importfound;
  1621. end;
  1622. {*****************************************************************************
  1623. Initialize
  1624. *****************************************************************************}
  1625. initialization
  1626. {$ifdef i386}
  1627. { Win32 }
  1628. RegisterExternalLinker(system_i386_win32_info,TExternalLinkerWin);
  1629. RegisterInternalLinker(system_i386_win32_info,TInternalLinkerWin);
  1630. RegisterImport(system_i386_win32,TImportLibWin);
  1631. RegisterExport(system_i386_win32,TExportLibWin);
  1632. RegisterDLLScanner(system_i386_win32,TDLLScannerWin);
  1633. RegisterRes(res_gnu_windres_info,TWinLikeResourceFile);
  1634. RegisterTarget(system_i386_win32_info);
  1635. { WinCE }
  1636. RegisterExternalLinker(system_i386_wince_info,TExternalLinkerWin);
  1637. RegisterInternalLinker(system_i386_wince_info,TInternalLinkerWin);
  1638. RegisterImport(system_i386_wince,TImportLibWin);
  1639. RegisterExport(system_i386_wince,TExportLibWin);
  1640. RegisterDLLScanner(system_i386_wince,TDLLScannerWin);
  1641. RegisterTarget(system_i386_wince_info);
  1642. {$endif i386}
  1643. {$ifdef x86_64}
  1644. RegisterInternalLinker(system_x64_win64_info,TInternalLinkerWin);
  1645. RegisterImport(system_x86_64_win64,TImportLibWin);
  1646. RegisterExport(system_x86_64_win64,TExportLibWin);
  1647. RegisterDLLScanner(system_x86_64_win64,TDLLScannerWin);
  1648. RegisterRes(res_win64_gorc_info,TWinLikeResourceFile);
  1649. RegisterTarget(system_x64_win64_info);
  1650. {$endif x86_64}
  1651. {$ifdef arm}
  1652. RegisterExternalLinker(system_arm_wince_info,TExternalLinkerWin);
  1653. RegisterInternalLinker(system_arm_wince_info,TInternalLinkerWin);
  1654. RegisterImport(system_arm_wince,TImportLibWin);
  1655. RegisterExport(system_arm_wince,TExportLibWin);
  1656. RegisterRes(res_gnu_windres_info,TWinLikeResourceFile);
  1657. RegisterTarget(system_arm_wince_info);
  1658. {$endif arm}
  1659. end.