t_win.pas 69 KB

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