t_win32.pas 52 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631
  1. {
  2. $Id$
  3. Copyright (c) 1998-2000 by Peter Vreman
  4. This unit implements support import,export,link routines
  5. for the (i386) Win32 target
  6. This program is free software; you can redistribute it and/or modify
  7. it under the terms of the GNU General Public License as published by
  8. the Free Software Foundation; either version 2 of the License, or
  9. (at your option) any later version.
  10. This program is distributed in the hope that it will be useful,
  11. but WITHOUT ANY WARRANTY; without even the implied warranty of
  12. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  13. GNU General Public License for more details.
  14. You should have received a copy of the GNU General Public License
  15. along with this program; if not, write to the Free Software
  16. Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  17. ****************************************************************************
  18. }
  19. unit t_win32;
  20. {$i defines.inc}
  21. interface
  22. implementation
  23. uses
  24. {$ifdef Delphi}
  25. dmisc,
  26. {$else Delphi}
  27. dos,
  28. {$endif Delphi}
  29. cutils,cclasses,
  30. aasm,fmodule,globtype,globals,systems,verbose,
  31. script,gendef,
  32. cpubase,cpuasm,
  33. {$ifdef GDB}
  34. gdb,
  35. {$endif}
  36. import,export,link;
  37. type
  38. timportlibwin32=class(timportlib)
  39. procedure preparelib(const s:string);override;
  40. procedure importprocedure(const func,module:string;index:longint;const name:string);override;
  41. procedure importvariable(const varname,module:string;const name:string);override;
  42. procedure generatelib;override;
  43. procedure generatenasmlib;virtual;
  44. procedure generatesmartlib;override;
  45. end;
  46. texportlibwin32=class(texportlib)
  47. st : string;
  48. last_index : longint;
  49. procedure preparelib(const s:string);override;
  50. procedure exportprocedure(hp : texported_item);override;
  51. procedure exportvar(hp : texported_item);override;
  52. procedure generatelib;override;
  53. procedure generatenasmlib;virtual;
  54. end;
  55. tlinkerwin32=class(tlinker)
  56. private
  57. Function WriteResponseFile(isdll:boolean) : Boolean;
  58. Function PostProcessExecutable(const fn:string;isdll:boolean) : Boolean;
  59. public
  60. Constructor Create;override;
  61. Procedure SetDefaultInfo;override;
  62. function MakeExecutable:boolean;override;
  63. function MakeSharedLibrary:boolean;override;
  64. end;
  65. tDLLScannerWin32=class(tDLLScanner)
  66. private
  67. cstring : array[0..127]of char;
  68. function DOSstubOK(var x:cardinal):boolean;
  69. function FindDLL(const s:string;var founddll:string):boolean;
  70. function DllName(Const Name : string) : string;
  71. public
  72. function isSuitableFileType(x:cardinal):longbool;override;
  73. function GetEdata(HeaderEntry:cardinal):longbool;override;
  74. function Scan(const binname:string):longbool;override;
  75. end;
  76. function DllName(Const Name : string) : string;
  77. var n : string;
  78. begin
  79. n:=Upper(SplitExtension(Name));
  80. if (n='.DLL') or (n='.DRV') or (n='.EXE') then
  81. DllName:=Name
  82. else
  83. DllName:=Name+target_info.sharedlibext;
  84. end;
  85. {*****************************************************************************
  86. TIMPORTLIBWIN32
  87. *****************************************************************************}
  88. procedure timportlibwin32.preparelib(const s : string);
  89. begin
  90. if not(assigned(importssection)) then
  91. importssection:=TAAsmoutput.create;
  92. end;
  93. procedure timportlibwin32.importprocedure(const func,module : string;index : longint;const name : string);
  94. var
  95. hp1 : timportlist;
  96. hp2 : timported_item;
  97. hs : string;
  98. begin
  99. hs:=DllName(module);
  100. { search for the module }
  101. hp1:=timportlist(current_module.imports.first);
  102. while assigned(hp1) do
  103. begin
  104. if hs=hp1.dllname^ then
  105. break;
  106. hp1:=timportlist(hp1.next);
  107. end;
  108. { generate a new item ? }
  109. if not(assigned(hp1)) then
  110. begin
  111. hp1:=timportlist.create(hs);
  112. current_module.imports.concat(hp1);
  113. end;
  114. { search for reuse of old import item }
  115. hp2:=timported_item(hp1.imported_items.first);
  116. while assigned(hp2) do
  117. begin
  118. if hp2.func^=func then
  119. break;
  120. hp2:=timported_item(hp2.next);
  121. end;
  122. if not assigned(hp2) then
  123. begin
  124. hp2:=timported_item.create(func,name,index);
  125. hp1.imported_items.concat(hp2);
  126. end;
  127. end;
  128. procedure timportlibwin32.importvariable(const varname,module:string;const name:string);
  129. var
  130. hp1 : timportlist;
  131. hp2 : timported_item;
  132. hs : string;
  133. begin
  134. hs:=DllName(module);
  135. { search for the module }
  136. hp1:=timportlist(current_module.imports.first);
  137. while assigned(hp1) do
  138. begin
  139. if hs=hp1.dllname^ then
  140. break;
  141. hp1:=timportlist(hp1.next);
  142. end;
  143. { generate a new item ? }
  144. if not(assigned(hp1)) then
  145. begin
  146. hp1:=timportlist.create(hs);
  147. current_module.imports.concat(hp1);
  148. end;
  149. hp2:=timported_item.create_var(varname,name);
  150. hp1.imported_items.concat(hp2);
  151. end;
  152. procedure timportlibwin32.generatenasmlib;
  153. var
  154. hp1 : timportlist;
  155. hp2 : timported_item;
  156. p : pchar;
  157. begin
  158. importssection.concat(tai_section.create(sec_code));
  159. hp1:=timportlist(current_module.imports.first);
  160. while assigned(hp1) do
  161. begin
  162. hp2:=timported_item(hp1.imported_items.first);
  163. while assigned(hp2) do
  164. begin
  165. if (aktoutputformat=as_i386_tasm) or
  166. (aktoutputformat=as_i386_masm) then
  167. p:=strpnew(#9+'EXTRN '+hp2.func^)
  168. else
  169. p:=strpnew(#9+'EXTERN '+hp2.func^);
  170. importssection.concat(tai_direct.create(p));
  171. p:=strpnew(#9+'import '+hp2.func^+' '+hp1.dllname^+' '+hp2.name^);
  172. importssection.concat(tai_direct.create(p));
  173. hp2:=timported_item(hp2.next);
  174. end;
  175. hp1:=timportlist(hp1.next);
  176. end;
  177. end;
  178. procedure timportlibwin32.generatesmartlib;
  179. var
  180. hp1 : timportlist;
  181. hp2 : timported_item;
  182. lhead,lname,lcode,
  183. lidata4,lidata5 : tasmlabel;
  184. r : preference;
  185. begin
  186. if (aktoutputformat<>as_i386_asw) and
  187. (aktoutputformat<>as_i386_pecoff) then
  188. begin
  189. generatenasmlib;
  190. exit;
  191. end;
  192. hp1:=timportlist(current_module.imports.first);
  193. while assigned(hp1) do
  194. begin
  195. { Get labels for the sections }
  196. getdatalabel(lhead);
  197. getdatalabel(lname);
  198. getaddrlabel(lidata4);
  199. getaddrlabel(lidata5);
  200. { create header for this importmodule }
  201. importsSection.concat(Tai_cut.Create_begin);
  202. importsSection.concat(Tai_section.Create(sec_idata2));
  203. importsSection.concat(Tai_label.Create(lhead));
  204. { pointer to procedure names }
  205. importsSection.concat(Tai_const_symbol.Create_rva(lidata4));
  206. { two empty entries follow }
  207. importsSection.concat(Tai_const.Create_32bit(0));
  208. importsSection.concat(Tai_const.Create_32bit(0));
  209. { pointer to dll name }
  210. importsSection.concat(Tai_const_symbol.Create_rva(lname));
  211. { pointer to fixups }
  212. importsSection.concat(Tai_const_symbol.Create_rva(lidata5));
  213. { first write the name references }
  214. importsSection.concat(Tai_section.Create(sec_idata4));
  215. importsSection.concat(Tai_const.Create_32bit(0));
  216. importsSection.concat(Tai_label.Create(lidata4));
  217. { then the addresses and create also the indirect jump }
  218. importsSection.concat(Tai_section.Create(sec_idata5));
  219. importsSection.concat(Tai_const.Create_32bit(0));
  220. importsSection.concat(Tai_label.Create(lidata5));
  221. { create procedures }
  222. hp2:=timported_item(hp1.imported_items.first);
  223. while assigned(hp2) do
  224. begin
  225. { insert cuts }
  226. importsSection.concat(Tai_cut.Create);
  227. { create indirect jump }
  228. if not hp2.is_var then
  229. begin
  230. getlabel(lcode);
  231. new(r);
  232. reset_reference(r^);
  233. r^.symbol:=lcode;
  234. { place jump in codesegment, insert a code section in the
  235. importsection to reduce the amount of .s files (PFV) }
  236. importsSection.concat(Tai_section.Create(sec_code));
  237. {$IfDef GDB}
  238. if (cs_debuginfo in aktmoduleswitches) then
  239. importsSection.concat(Tai_stab_function_name.Create(nil));
  240. {$EndIf GDB}
  241. importsSection.concat(Tai_symbol.Createname_global(hp2.func^,0));
  242. importsSection.concat(Taicpu.Op_ref(A_JMP,S_NO,r));
  243. importsSection.concat(Tai_align.Create_op(4,$90));
  244. end;
  245. { create head link }
  246. importsSection.concat(Tai_section.Create(sec_idata7));
  247. importsSection.concat(Tai_const_symbol.Create_rva(lhead));
  248. { fixup }
  249. getlabel(tasmlabel(hp2.lab));
  250. importsSection.concat(Tai_section.Create(sec_idata4));
  251. importsSection.concat(Tai_const_symbol.Create_rva(hp2.lab));
  252. { add jump field to importsection }
  253. importsSection.concat(Tai_section.Create(sec_idata5));
  254. if hp2.is_var then
  255. importsSection.concat(Tai_symbol.Createname_global(hp2.func^,0))
  256. else
  257. importsSection.concat(Tai_label.Create(lcode));
  258. if hp2.name^<>'' then
  259. importsSection.concat(Tai_const_symbol.Create_rva(hp2.lab))
  260. else
  261. importsSection.concat(Tai_const.Create_32bit($80000000 or hp2.ordnr));
  262. { finally the import information }
  263. importsSection.concat(Tai_section.Create(sec_idata6));
  264. importsSection.concat(Tai_label.Create(hp2.lab));
  265. importsSection.concat(Tai_const.Create_16bit(hp2.ordnr));
  266. importsSection.concat(Tai_string.Create(hp2.name^+#0));
  267. importsSection.concat(Tai_align.Create_op(2,0));
  268. hp2:=timported_item(hp2.next);
  269. end;
  270. { write final section }
  271. importsSection.concat(Tai_cut.Create_end);
  272. { end of name references }
  273. importsSection.concat(Tai_section.Create(sec_idata4));
  274. importsSection.concat(Tai_const.Create_32bit(0));
  275. { end if addresses }
  276. importsSection.concat(Tai_section.Create(sec_idata5));
  277. importsSection.concat(Tai_const.Create_32bit(0));
  278. { dllname }
  279. importsSection.concat(Tai_section.Create(sec_idata7));
  280. importsSection.concat(Tai_label.Create(lname));
  281. importsSection.concat(Tai_string.Create(hp1.dllname^+#0));
  282. hp1:=timportlist(hp1.next);
  283. end;
  284. end;
  285. procedure timportlibwin32.generatelib;
  286. var
  287. hp1 : timportlist;
  288. hp2 : timported_item;
  289. l1,l2,l3,l4 : tasmlabel;
  290. r : preference;
  291. begin
  292. if (aktoutputformat<>as_i386_asw) and
  293. (aktoutputformat<>as_i386_pecoff) then
  294. begin
  295. generatenasmlib;
  296. exit;
  297. end;
  298. hp1:=timportlist(current_module.imports.first);
  299. while assigned(hp1) do
  300. begin
  301. { align codesegment for the jumps }
  302. importsSection.concat(Tai_section.Create(sec_code));
  303. importsSection.concat(Tai_align.Create_op(4,$90));
  304. { Get labels for the sections }
  305. getlabel(l1);
  306. getlabel(l2);
  307. getlabel(l3);
  308. importsSection.concat(Tai_section.Create(sec_idata2));
  309. { pointer to procedure names }
  310. importsSection.concat(Tai_const_symbol.Create_rva(l2));
  311. { two empty entries follow }
  312. importsSection.concat(Tai_const.Create_32bit(0));
  313. importsSection.concat(Tai_const.Create_32bit(0));
  314. { pointer to dll name }
  315. importsSection.concat(Tai_const_symbol.Create_rva(l1));
  316. { pointer to fixups }
  317. importsSection.concat(Tai_const_symbol.Create_rva(l3));
  318. { only create one section for each else it will
  319. create a lot of idata* }
  320. { first write the name references }
  321. importsSection.concat(Tai_section.Create(sec_idata4));
  322. importsSection.concat(Tai_label.Create(l2));
  323. hp2:=timported_item(hp1.imported_items.first);
  324. while assigned(hp2) do
  325. begin
  326. getlabel(tasmlabel(hp2.lab));
  327. if hp2.name^<>'' then
  328. importsSection.concat(Tai_const_symbol.Create_rva(hp2.lab))
  329. else
  330. importsSection.concat(Tai_const.Create_32bit($80000000 or hp2.ordnr));
  331. hp2:=timported_item(hp2.next);
  332. end;
  333. { finalize the names ... }
  334. importsSection.concat(Tai_const.Create_32bit(0));
  335. { then the addresses and create also the indirect jump }
  336. importsSection.concat(Tai_section.Create(sec_idata5));
  337. importsSection.concat(Tai_label.Create(l3));
  338. hp2:=timported_item(hp1.imported_items.first);
  339. while assigned(hp2) do
  340. begin
  341. if not hp2.is_var then
  342. begin
  343. getlabel(l4);
  344. { create indirect jump }
  345. new(r);
  346. reset_reference(r^);
  347. r^.symbol:=l4;
  348. { place jump in codesegment }
  349. importsSection.concat(Tai_section.Create(sec_code));
  350. importsSection.concat(Tai_symbol.Createname_global(hp2.func^,0));
  351. importsSection.concat(Taicpu.Op_ref(A_JMP,S_NO,r));
  352. importsSection.concat(Tai_align.Create_op(4,$90));
  353. { add jump field to importsection }
  354. importsSection.concat(Tai_section.Create(sec_idata5));
  355. importsSection.concat(Tai_label.Create(l4));
  356. end
  357. else
  358. begin
  359. importsSection.concat(Tai_symbol.Createname_global(hp2.func^,0));
  360. end;
  361. importsSection.concat(Tai_const_symbol.Create_rva(hp2.lab));
  362. hp2:=timported_item(hp2.next);
  363. end;
  364. { finalize the addresses }
  365. importsSection.concat(Tai_const.Create_32bit(0));
  366. { finally the import information }
  367. importsSection.concat(Tai_section.Create(sec_idata6));
  368. hp2:=timported_item(hp1.imported_items.first);
  369. while assigned(hp2) do
  370. begin
  371. importsSection.concat(Tai_label.Create(hp2.lab));
  372. { the ordinal number }
  373. importsSection.concat(Tai_const.Create_16bit(hp2.ordnr));
  374. importsSection.concat(Tai_string.Create(hp2.name^+#0));
  375. importsSection.concat(Tai_align.Create_op(2,0));
  376. hp2:=timported_item(hp2.next);
  377. end;
  378. { create import dll name }
  379. importsSection.concat(Tai_section.Create(sec_idata7));
  380. importsSection.concat(Tai_label.Create(l1));
  381. importsSection.concat(Tai_string.Create(hp1.dllname^+#0));
  382. hp1:=timportlist(hp1.next);
  383. end;
  384. end;
  385. {*****************************************************************************
  386. TEXPORTLIBWIN32
  387. *****************************************************************************}
  388. procedure texportlibwin32.preparelib(const s:string);
  389. begin
  390. if not(assigned(exportssection)) then
  391. exportssection:=TAAsmoutput.create;
  392. last_index:=0;
  393. getdatalabel(edatalabel);
  394. end;
  395. procedure texportlibwin32.exportvar(hp : texported_item);
  396. begin
  397. { same code used !! PM }
  398. exportprocedure(hp);
  399. end;
  400. procedure texportlibwin32.exportprocedure(hp : texported_item);
  401. { must be ordered at least for win32 !! }
  402. var
  403. hp2 : texported_item;
  404. begin
  405. { first test the index value }
  406. if (hp.options and eo_index)<>0 then
  407. begin
  408. if (hp.index<=0) or (hp.index>$ffff) then
  409. begin
  410. message1(parser_e_export_invalid_index,tostr(hp.index));
  411. exit;
  412. end;
  413. if (hp.index<=last_index) then
  414. begin
  415. message1(parser_e_export_ordinal_double,tostr(hp.index));
  416. { disregard index value }
  417. inc(last_index);
  418. hp.index:=last_index;
  419. exit;
  420. end
  421. else
  422. begin
  423. last_index:=hp.index;
  424. end;
  425. end
  426. else
  427. begin
  428. inc(last_index);
  429. hp.index:=last_index;
  430. end;
  431. { now place in correct order }
  432. hp2:=texported_item(current_module._exports.first);
  433. while assigned(hp2) and
  434. (hp.name^>hp2.name^) do
  435. hp2:=texported_item(hp2.next);
  436. { insert hp there !! }
  437. if assigned(hp2) and (hp2.name^=hp.name^) then
  438. begin
  439. { this is not allowed !! }
  440. message1(parser_e_export_name_double,hp.name^);
  441. exit;
  442. end;
  443. if hp2=texported_item(current_module._exports.first) then
  444. current_module._exports.concat(hp)
  445. else if assigned(hp2) then
  446. begin
  447. hp.next:=hp2;
  448. hp.previous:=hp2.previous;
  449. if assigned(hp2.previous) then
  450. hp2.previous.next:=hp;
  451. hp2.previous:=hp;
  452. end
  453. else
  454. current_module._exports.concat(hp);
  455. end;
  456. procedure texportlibwin32.generatelib;
  457. var
  458. ordinal_base,ordinal_max,ordinal_min : longint;
  459. current_index : longint;
  460. entries,named_entries : longint;
  461. name_label,dll_name_label,export_address_table : tasmlabel;
  462. export_name_table_pointers,export_ordinal_table : tasmlabel;
  463. hp,hp2 : texported_item;
  464. temtexport : TLinkedList;
  465. address_table,name_table_pointers,
  466. name_table,ordinal_table : TAAsmoutput;
  467. begin
  468. if (aktoutputformat<>as_i386_asw) and
  469. (aktoutputformat<>as_i386_pecoff) then
  470. begin
  471. generatenasmlib;
  472. exit;
  473. end;
  474. hp:=texported_item(current_module._exports.first);
  475. if not assigned(hp) then
  476. exit;
  477. ordinal_max:=0;
  478. ordinal_min:=$7FFFFFFF;
  479. entries:=0;
  480. named_entries:=0;
  481. getlabel(dll_name_label);
  482. getlabel(export_address_table);
  483. getlabel(export_name_table_pointers);
  484. getlabel(export_ordinal_table);
  485. { count entries }
  486. while assigned(hp) do
  487. begin
  488. inc(entries);
  489. if (hp.index>ordinal_max) then
  490. ordinal_max:=hp.index;
  491. if (hp.index>0) and (hp.index<ordinal_min) then
  492. ordinal_min:=hp.index;
  493. if assigned(hp.name) then
  494. inc(named_entries);
  495. hp:=texported_item(hp.next);
  496. end;
  497. { no support for higher ordinal base yet !! }
  498. ordinal_base:=1;
  499. current_index:=ordinal_base;
  500. { we must also count the holes !! }
  501. entries:=ordinal_max-ordinal_base+1;
  502. exportsSection.concat(Tai_section.Create(sec_edata));
  503. { create label to reference from main so smartlink will include
  504. the .edata section }
  505. exportsSection.concat(Tai_symbol.Create(edatalabel,0));
  506. { export flags }
  507. exportsSection.concat(Tai_const.Create_32bit(0));
  508. { date/time stamp }
  509. exportsSection.concat(Tai_const.Create_32bit(0));
  510. { major version }
  511. exportsSection.concat(Tai_const.Create_16bit(0));
  512. { minor version }
  513. exportsSection.concat(Tai_const.Create_16bit(0));
  514. { pointer to dll name }
  515. exportsSection.concat(Tai_const_symbol.Create_rva(dll_name_label));
  516. { ordinal base normally set to 1 }
  517. exportsSection.concat(Tai_const.Create_32bit(ordinal_base));
  518. { number of entries }
  519. exportsSection.concat(Tai_const.Create_32bit(entries));
  520. { number of named entries }
  521. exportsSection.concat(Tai_const.Create_32bit(named_entries));
  522. { address of export address table }
  523. exportsSection.concat(Tai_const_symbol.Create_rva(export_address_table));
  524. { address of name pointer pointers }
  525. exportsSection.concat(Tai_const_symbol.Create_rva(export_name_table_pointers));
  526. { address of ordinal number pointers }
  527. exportsSection.concat(Tai_const_symbol.Create_rva(export_ordinal_table));
  528. { the name }
  529. exportsSection.concat(Tai_label.Create(dll_name_label));
  530. if st='' then
  531. exportsSection.concat(Tai_string.Create(current_module.modulename^+target_info.sharedlibext+#0))
  532. else
  533. exportsSection.concat(Tai_string.Create(st+target_info.sharedlibext+#0));
  534. { export address table }
  535. address_table:=TAAsmoutput.create;
  536. address_table.concat(Tai_align.Create_op(4,0));
  537. address_table.concat(Tai_label.Create(export_address_table));
  538. name_table_pointers:=TAAsmoutput.create;
  539. name_table_pointers.concat(Tai_align.Create_op(4,0));
  540. name_table_pointers.concat(Tai_label.Create(export_name_table_pointers));
  541. ordinal_table:=TAAsmoutput.create;
  542. ordinal_table.concat(Tai_align.Create_op(4,0));
  543. ordinal_table.concat(Tai_label.Create(export_ordinal_table));
  544. name_table:=TAAsmoutput.Create;
  545. name_table.concat(Tai_align.Create_op(4,0));
  546. { write each address }
  547. hp:=texported_item(current_module._exports.first);
  548. while assigned(hp) do
  549. begin
  550. if (hp.options and eo_name)<>0 then
  551. begin
  552. getlabel(name_label);
  553. name_table_pointers.concat(Tai_const_symbol.Create_rva(name_label));
  554. ordinal_table.concat(Tai_const.Create_16bit(hp.index-ordinal_base));
  555. name_table.concat(Tai_align.Create_op(2,0));
  556. name_table.concat(Tai_label.Create(name_label));
  557. name_table.concat(Tai_string.Create(hp.name^+#0));
  558. end;
  559. hp:=texported_item(hp.next);
  560. end;
  561. { order in increasing ordinal values }
  562. { into temtexport list }
  563. temtexport:=TLinkedList.Create;
  564. hp:=texported_item(current_module._exports.first);
  565. while assigned(hp) do
  566. begin
  567. current_module._exports.remove(hp);
  568. hp2:=texported_item(temtexport.first);
  569. while assigned(hp2) and (hp.index>hp2.index) do
  570. begin
  571. hp2:=texported_item(hp2.next);
  572. end;
  573. if hp2=texported_item(temtexport.first) then
  574. temtexport.insert(hp)
  575. else
  576. begin
  577. if assigned(hp2) then
  578. begin
  579. hp.next:=hp2;
  580. hp.previous:=hp2.previous;
  581. hp2.previous:=hp;
  582. if assigned(hp.previous) then
  583. hp.previous.next:=hp;
  584. end
  585. else
  586. temtexport.concat(hp);
  587. end;
  588. hp:=texported_item(current_module._exports.first);;
  589. end;
  590. { write the export adress table }
  591. current_index:=ordinal_base;
  592. hp:=texported_item(temtexport.first);
  593. while assigned(hp) do
  594. begin
  595. { fill missing values }
  596. while current_index<hp.index do
  597. begin
  598. address_table.concat(Tai_const.Create_32bit(0));
  599. inc(current_index);
  600. end;
  601. address_table.concat(Tai_const_symbol.Createname_rva(hp.sym.mangledname));
  602. inc(current_index);
  603. hp:=texported_item(hp.next);
  604. end;
  605. exportsSection.concatlist(address_table);
  606. exportsSection.concatlist(name_table_pointers);
  607. exportsSection.concatlist(ordinal_table);
  608. exportsSection.concatlist(name_table);
  609. address_table.Free;
  610. name_table_pointers.free;
  611. ordinal_table.free;
  612. name_table.free;
  613. temtexport.free;
  614. end;
  615. procedure texportlibwin32.generatenasmlib;
  616. var
  617. hp : texported_item;
  618. p : pchar;
  619. begin
  620. exportssection.concat(tai_section.create(sec_code));
  621. hp:=texported_item(current_module._exports.first);
  622. while assigned(hp) do
  623. begin
  624. p:=strpnew(#9+'export '+hp.sym.mangledname+' '+hp.name^+' '+tostr(hp.index));
  625. exportssection.concat(tai_direct.create(p));
  626. hp:=texported_item(hp.next);
  627. end;
  628. end;
  629. {****************************************************************************
  630. TLINKERWIN32
  631. ****************************************************************************}
  632. Constructor TLinkerWin32.Create;
  633. begin
  634. Inherited Create;
  635. { allow duplicated libs (PM) }
  636. SharedLibFiles.doubles:=true;
  637. StaticLibFiles.doubles:=true;
  638. If not ForceDeffileForExport then
  639. UseDeffileForExport:=false;
  640. end;
  641. Procedure TLinkerWin32.SetDefaultInfo;
  642. begin
  643. with Info do
  644. begin
  645. ExeCmd[1]:='ldw $OPT $STRIP $APPTYPE $IMAGEBASE $RELOC -o $EXE $RES';
  646. DllCmd[1]:='ldw $OPT $STRIP --dll $APPTYPE $IMAGEBASE $RELOC -o $EXE $RES';
  647. if RelocSection or UseDeffileForExport then
  648. begin
  649. { ExeCmd[2]:='dlltool --as $ASBIN --dllname $EXE --output-exp exp.$$$ $RELOC $DEF';
  650. use short forms to avoid 128 char limitation problem }
  651. ExeCmd[2]:='dlltool -S $ASBIN -D $EXE -e exp.$$$ $RELOC $DEF';
  652. ExeCmd[3]:='ldw $OPT $STRIP $APPTYPE $IMAGEBASE -o $EXE $RES exp.$$$';
  653. { DllCmd[2]:='dlltool --as $ASBIN --dllname $EXE --output-exp exp.$$$ $RELOC $DEF'; }
  654. DllCmd[2]:='dlltool -S $ASBIN -D $EXE -e exp.$$$ $RELOC $DEF';
  655. DllCmd[3]:='ldw $OPT $STRIP --dll $APPTYPE $IMAGEBASE -o $EXE $RES exp.$$$';
  656. end;
  657. end;
  658. end;
  659. Function TLinkerWin32.WriteResponseFile(isdll:boolean) : Boolean;
  660. Var
  661. linkres : TLinkRes;
  662. HPath : TStringListItem;
  663. s,s2 : string;
  664. i : integer;
  665. linklibc,
  666. found : boolean;
  667. begin
  668. WriteResponseFile:=False;
  669. linklibc:=false;
  670. { Open link.res file }
  671. LinkRes:=TLinkRes.Create(outputexedir+Info.ResName);
  672. { Write path to search libraries }
  673. HPath:=TStringListItem(current_module.locallibrarysearchpath.First);
  674. while assigned(HPath) do
  675. begin
  676. LinkRes.Add('SEARCH_DIR('+GetShortName(HPath.Str)+')');
  677. HPath:=TStringListItem(HPath.Next);
  678. end;
  679. HPath:=TStringListItem(LibrarySearchPath.First);
  680. while assigned(HPath) do
  681. begin
  682. LinkRes.Add('SEARCH_DIR('+GetShortName(HPath.Str)+')');
  683. HPath:=TStringListItem(HPath.Next);
  684. end;
  685. { add objectfiles, start with prt0 always }
  686. LinkRes.Add('INPUT(');
  687. if isdll then
  688. LinkRes.AddFileName(GetShortName(FindObjectFile('wdllprt0','')))
  689. else
  690. LinkRes.AddFileName(GetShortName(FindObjectFile('wprt0','')));
  691. while not ObjectFiles.Empty do
  692. begin
  693. s:=ObjectFiles.GetFirst;
  694. if s<>'' then
  695. LinkRes.AddFileName(GetShortName(s));
  696. end;
  697. { add libaries required for profiling }
  698. if cs_profile in aktmoduleswitches then
  699. begin
  700. LinkRes.Add('-lgmon');
  701. LinkRes.Add('-lc');
  702. end;
  703. LinkRes.Add(')');
  704. { Write staticlibraries }
  705. if not StaticLibFiles.Empty then
  706. begin
  707. LinkRes.Add('GROUP(');
  708. While not StaticLibFiles.Empty do
  709. begin
  710. S:=StaticLibFiles.GetFirst;
  711. LinkRes.AddFileName(GetShortName(s));
  712. end;
  713. LinkRes.Add(')');
  714. end;
  715. { Write sharedlibraries }
  716. if not SharedLibFiles.Empty then
  717. begin
  718. LinkRes.Add('INPUT(') ;
  719. While not SharedLibFiles.Empty do
  720. begin
  721. S:=SharedLibFiles.GetFirst;
  722. if FindLibraryFile(s,target_info.staticClibprefix,target_info.staticClibext,s2) then
  723. begin
  724. LinkRes.Add(GetShortName(s2));
  725. continue;
  726. end;
  727. if pos(target_info.sharedlibprefix,s)=1 then
  728. s:=copy(s,length(target_info.sharedlibprefix)+1,255);
  729. if s<>'c' then
  730. begin
  731. i:=Pos(target_info.sharedlibext,S);
  732. if i>0 then
  733. Delete(S,i,255);
  734. LinkRes.Add('-l'+s);
  735. end
  736. else
  737. begin
  738. LinkRes.Add('-l'+s);
  739. linklibc:=true;
  740. end;
  741. end;
  742. { be sure that libc is the last lib }
  743. if linklibc then
  744. LinkRes.Add('-lc');
  745. LinkRes.Add(')');
  746. end;
  747. { Write and Close response }
  748. linkres.writetodisk;
  749. LinkRes.Free;
  750. WriteResponseFile:=True;
  751. end;
  752. function TLinkerWin32.MakeExecutable:boolean;
  753. var
  754. binstr,
  755. cmdstr : string;
  756. success : boolean;
  757. i : longint;
  758. AsBinStr : string[80];
  759. StripStr,
  760. RelocStr,
  761. AppTypeStr,
  762. ImageBaseStr : string[40];
  763. begin
  764. if not(cs_link_extern in aktglobalswitches) then
  765. Message1(exec_i_linking,current_module.exefilename^);
  766. { Create some replacements }
  767. RelocStr:='';
  768. AppTypeStr:='';
  769. ImageBaseStr:='';
  770. StripStr:='';
  771. FindExe('asw',AsBinStr);
  772. if RelocSection then
  773. { Using short form to avoid problems with 128 char limitation under Dos. }
  774. RelocStr:='-b base.$$$';
  775. if apptype=app_gui then
  776. AppTypeStr:='--subsystem windows';
  777. if assigned(DLLImageBase) then
  778. ImageBaseStr:='--image-base=0x'+DLLImageBase^;
  779. if (cs_link_strip in aktglobalswitches) then
  780. StripStr:='-s';
  781. { Write used files and libraries }
  782. WriteResponseFile(false);
  783. { Call linker }
  784. success:=false;
  785. for i:=1 to 3 do
  786. begin
  787. SplitBinCmd(Info.ExeCmd[i],binstr,cmdstr);
  788. if binstr<>'' then
  789. begin
  790. Replace(cmdstr,'$EXE',maybequoted(current_module.exefilename^));
  791. Replace(cmdstr,'$OPT',Info.ExtraOptions);
  792. Replace(cmdstr,'$RES',maybequoted(outputexedir+Info.ResName));
  793. Replace(cmdstr,'$APPTYPE',AppTypeStr);
  794. Replace(cmdstr,'$ASBIN',AsbinStr);
  795. Replace(cmdstr,'$RELOC',RelocStr);
  796. Replace(cmdstr,'$IMAGEBASE',ImageBaseStr);
  797. Replace(cmdstr,'$STRIP',StripStr);
  798. if not DefFile.Empty {and UseDefFileForExport} then
  799. begin
  800. DefFile.WriteFile;
  801. Replace(cmdstr,'$DEF','-d '+maybequoted(deffile.fname));
  802. end
  803. else
  804. Replace(cmdstr,'$DEF','');
  805. success:=DoExec(FindUtil(binstr),cmdstr,(i=1),false);
  806. if not success then
  807. break;
  808. end;
  809. end;
  810. { Post process }
  811. if success then
  812. success:=PostProcessExecutable(current_module.exefilename^,false);
  813. { Remove ReponseFile }
  814. if (success) and not(cs_link_extern in aktglobalswitches) then
  815. begin
  816. RemoveFile(outputexedir+Info.ResName);
  817. RemoveFile('base.$$$');
  818. RemoveFile('exp.$$$');
  819. RemoveFile('deffile.$$$');
  820. end;
  821. MakeExecutable:=success; { otherwise a recursive call to link method }
  822. end;
  823. Function TLinkerWin32.MakeSharedLibrary:boolean;
  824. var
  825. binstr,
  826. cmdstr : string;
  827. success : boolean;
  828. i : longint;
  829. AsBinStr : string[80];
  830. StripStr,
  831. RelocStr,
  832. AppTypeStr,
  833. ImageBaseStr : string[40];
  834. begin
  835. MakeSharedLibrary:=false;
  836. if not(cs_link_extern in aktglobalswitches) then
  837. Message1(exec_i_linking,current_module.sharedlibfilename^);
  838. { Create some replacements }
  839. RelocStr:='';
  840. AppTypeStr:='';
  841. ImageBaseStr:='';
  842. StripStr:='';
  843. FindExe('asw',AsBinStr);
  844. if RelocSection then
  845. { Using short form to avoid problems with 128 char limitation under Dos. }
  846. RelocStr:='-b base.$$$';
  847. if apptype=app_gui then
  848. AppTypeStr:='--subsystem windows';
  849. if assigned(DLLImageBase) then
  850. ImageBaseStr:='--image-base=0x'+DLLImageBase^;
  851. if (cs_link_strip in aktglobalswitches) then
  852. StripStr:='-s';
  853. { Write used files and libraries }
  854. WriteResponseFile(true);
  855. { Call linker }
  856. success:=false;
  857. for i:=1 to 3 do
  858. begin
  859. SplitBinCmd(Info.DllCmd[i],binstr,cmdstr);
  860. if binstr<>'' then
  861. begin
  862. Replace(cmdstr,'$EXE',maybequoted(current_module.sharedlibfilename^));
  863. Replace(cmdstr,'$OPT',Info.ExtraOptions);
  864. Replace(cmdstr,'$RES',maybequoted(outputexedir+Info.ResName));
  865. Replace(cmdstr,'$APPTYPE',AppTypeStr);
  866. Replace(cmdstr,'$ASBIN',AsbinStr);
  867. Replace(cmdstr,'$RELOC',RelocStr);
  868. Replace(cmdstr,'$IMAGEBASE',ImageBaseStr);
  869. Replace(cmdstr,'$STRIP',StripStr);
  870. if not DefFile.Empty {and UseDefFileForExport} then
  871. begin
  872. DefFile.WriteFile;
  873. Replace(cmdstr,'$DEF','-d '+maybequoted(deffile.fname));
  874. end
  875. else
  876. Replace(cmdstr,'$DEF','');
  877. success:=DoExec(FindUtil(binstr),cmdstr,(i=1),false);
  878. if not success then
  879. break;
  880. end;
  881. end;
  882. { Post process }
  883. if success then
  884. success:=PostProcessExecutable(current_module.sharedlibfilename^,true);
  885. { Remove ReponseFile }
  886. if (success) and not(cs_link_extern in aktglobalswitches) then
  887. begin
  888. RemoveFile(outputexedir+Info.ResName);
  889. RemoveFile('base.$$$');
  890. RemoveFile('exp.$$$');
  891. end;
  892. MakeSharedLibrary:=success; { otherwise a recursive call to link method }
  893. end;
  894. function tlinkerwin32.postprocessexecutable(const fn : string;isdll:boolean):boolean;
  895. type
  896. tdosheader = packed record
  897. e_magic : word;
  898. e_cblp : word;
  899. e_cp : word;
  900. e_crlc : word;
  901. e_cparhdr : word;
  902. e_minalloc : word;
  903. e_maxalloc : word;
  904. e_ss : word;
  905. e_sp : word;
  906. e_csum : word;
  907. e_ip : word;
  908. e_cs : word;
  909. e_lfarlc : word;
  910. e_ovno : word;
  911. e_res : array[0..3] of word;
  912. e_oemid : word;
  913. e_oeminfo : word;
  914. e_res2 : array[0..9] of word;
  915. e_lfanew : longint;
  916. end;
  917. tpeheader = packed record
  918. PEMagic : array[0..3] of char;
  919. Machine : word;
  920. NumberOfSections : word;
  921. TimeDateStamp : longint;
  922. PointerToSymbolTable : longint;
  923. NumberOfSymbols : longint;
  924. SizeOfOptionalHeader : word;
  925. Characteristics : word;
  926. Magic : word;
  927. MajorLinkerVersion : byte;
  928. MinorLinkerVersion : byte;
  929. SizeOfCode : longint;
  930. SizeOfInitializedData : longint;
  931. SizeOfUninitializedData : longint;
  932. AddressOfEntryPoint : longint;
  933. BaseOfCode : longint;
  934. BaseOfData : longint;
  935. ImageBase : longint;
  936. SectionAlignment : longint;
  937. FileAlignment : longint;
  938. MajorOperatingSystemVersion : word;
  939. MinorOperatingSystemVersion : word;
  940. MajorImageVersion : word;
  941. MinorImageVersion : word;
  942. MajorSubsystemVersion : word;
  943. MinorSubsystemVersion : word;
  944. Reserved1 : longint;
  945. SizeOfImage : longint;
  946. SizeOfHeaders : longint;
  947. CheckSum : longint;
  948. Subsystem : word;
  949. DllCharacteristics : word;
  950. SizeOfStackReserve : longint;
  951. SizeOfStackCommit : longint;
  952. SizeOfHeapReserve : longint;
  953. SizeOfHeapCommit : longint;
  954. LoaderFlags : longint;
  955. NumberOfRvaAndSizes : longint;
  956. DataDirectory : array[1..$80] of byte;
  957. end;
  958. tcoffsechdr=packed record
  959. name : array[0..7] of char;
  960. vsize : longint;
  961. rvaofs : longint;
  962. datalen : longint;
  963. datapos : longint;
  964. relocpos : longint;
  965. lineno1 : longint;
  966. nrelocs : word;
  967. lineno2 : word;
  968. flags : longint;
  969. end;
  970. psecfill=^tsecfill;
  971. tsecfill=record
  972. fillpos,
  973. fillsize : longint;
  974. next : psecfill;
  975. end;
  976. var
  977. f : file;
  978. cmdstr : string;
  979. dosheader : tdosheader;
  980. peheader : tpeheader;
  981. firstsecpos,
  982. maxfillsize,
  983. l,peheaderpos : longint;
  984. coffsec : tcoffsechdr;
  985. secroot,hsecroot : psecfill;
  986. zerobuf : pointer;
  987. begin
  988. postprocessexecutable:=false;
  989. { when -s is used or it's a dll then quit }
  990. if (cs_link_extern in aktglobalswitches) then
  991. begin
  992. case apptype of
  993. app_gui :
  994. cmdstr:='--subsystem gui';
  995. app_cui :
  996. cmdstr:='--subsystem console';
  997. end;
  998. if dllversion<>'' then
  999. cmdstr:=cmdstr+' --version '+dllversion;
  1000. cmdstr:=cmdstr+' --input '+fn;
  1001. cmdstr:=cmdstr+' --stack '+tostr(stacksize);
  1002. DoExec(FindUtil('postw32'),cmdstr,false,false);
  1003. postprocessexecutable:=true;
  1004. exit;
  1005. end;
  1006. { open file }
  1007. assign(f,fn);
  1008. {$I-}
  1009. reset(f,1);
  1010. if ioresult<>0 then
  1011. Message1(execinfo_f_cant_open_executable,fn);
  1012. { read headers }
  1013. blockread(f,dosheader,sizeof(tdosheader));
  1014. peheaderpos:=dosheader.e_lfanew;
  1015. seek(f,peheaderpos);
  1016. blockread(f,peheader,sizeof(tpeheader));
  1017. { write info }
  1018. Message1(execinfo_x_codesize,tostr(peheader.SizeOfCode));
  1019. Message1(execinfo_x_initdatasize,tostr(peheader.SizeOfInitializedData));
  1020. Message1(execinfo_x_uninitdatasize,tostr(peheader.SizeOfUninitializedData));
  1021. { change stack size (PM) }
  1022. { I am not sure that the default value is adequate !! }
  1023. peheader.SizeOfStackReserve:=stacksize;
  1024. { change the header }
  1025. { sub system }
  1026. { gui=2 }
  1027. { cui=3 }
  1028. case apptype of
  1029. app_gui :
  1030. peheader.Subsystem:=2;
  1031. app_cui :
  1032. peheader.Subsystem:=3;
  1033. end;
  1034. if dllversion<>'' then
  1035. begin
  1036. peheader.MajorImageVersion:=dllmajor;
  1037. peheader.MinorImageVersion:=dllminor;
  1038. end;
  1039. { reset timestamp }
  1040. peheader.TimeDateStamp:=0;
  1041. { write header back }
  1042. seek(f,peheaderpos);
  1043. blockwrite(f,peheader,sizeof(tpeheader));
  1044. if ioresult<>0 then
  1045. Message1(execinfo_f_cant_process_executable,fn);
  1046. seek(f,peheaderpos);
  1047. blockread(f,peheader,sizeof(tpeheader));
  1048. { write the value after the change }
  1049. Message1(execinfo_x_stackreserve,tostr(peheader.SizeOfStackReserve));
  1050. Message1(execinfo_x_stackcommit,tostr(peheader.SizeOfStackCommit));
  1051. { read section info }
  1052. maxfillsize:=0;
  1053. firstsecpos:=0;
  1054. secroot:=nil;
  1055. for l:=1 to peheader.NumberOfSections do
  1056. begin
  1057. blockread(f,coffsec,sizeof(tcoffsechdr));
  1058. if coffsec.datapos>0 then
  1059. begin
  1060. if secroot=nil then
  1061. firstsecpos:=coffsec.datapos;
  1062. new(hsecroot);
  1063. hsecroot^.fillpos:=coffsec.datapos+coffsec.vsize;
  1064. hsecroot^.fillsize:=coffsec.datalen-coffsec.vsize;
  1065. hsecroot^.next:=secroot;
  1066. secroot:=hsecroot;
  1067. if secroot^.fillsize>maxfillsize then
  1068. maxfillsize:=secroot^.fillsize;
  1069. end;
  1070. end;
  1071. if firstsecpos>0 then
  1072. begin
  1073. l:=firstsecpos-filepos(f);
  1074. if l>maxfillsize then
  1075. maxfillsize:=l;
  1076. end
  1077. else
  1078. l:=0;
  1079. { get zero buffer }
  1080. getmem(zerobuf,maxfillsize);
  1081. fillchar(zerobuf^,maxfillsize,0);
  1082. { zero from sectioninfo until first section }
  1083. blockwrite(f,zerobuf^,l);
  1084. { zero section alignments }
  1085. while assigned(secroot) do
  1086. begin
  1087. seek(f,secroot^.fillpos);
  1088. blockwrite(f,zerobuf^,secroot^.fillsize);
  1089. hsecroot:=secroot;
  1090. secroot:=secroot^.next;
  1091. dispose(hsecroot);
  1092. end;
  1093. freemem(zerobuf,maxfillsize);
  1094. close(f);
  1095. {$I+}
  1096. if ioresult<>0 then;
  1097. postprocessexecutable:=true;
  1098. end;
  1099. {****************************************************************************
  1100. TDLLScannerWin32
  1101. ****************************************************************************}
  1102. function tDLLScannerWin32.DOSstubOK(var x:cardinal):boolean;
  1103. begin
  1104. blockread(f,TheWord,2,loaded);
  1105. if loaded<>2 then
  1106. DOSstubOK:=false
  1107. else
  1108. begin
  1109. DOSstubOK:=(TheWord='MZ');
  1110. seek(f,$3C);
  1111. blockread(f,x,4,loaded);
  1112. if(loaded<>4)or(longint(x)>filesize(f))then
  1113. DOSstubOK:=false;
  1114. end;
  1115. end;
  1116. function TDLLScannerWin32.FindDLL(const s:string;var founddll:string):boolean;
  1117. var
  1118. sysdir : string;
  1119. Found : boolean;
  1120. begin
  1121. Found:=false;
  1122. { Look for DLL in:
  1123. 1. Current dir
  1124. 2. Library Path
  1125. 3. windir,windir/system,windir/system32 }
  1126. Found:=FindFile(s,'.'+source_info.DirSep,founddll);
  1127. if (not found) then
  1128. Found:=librarysearchpath.FindFile(s,founddll);
  1129. if (not found) then
  1130. begin
  1131. sysdir:=FixPath(GetEnv('windir'),false);
  1132. Found:=FindFile(s,sysdir+';'+sysdir+'system'+source_info.DirSep+';'+sysdir+'system32'+source_info.DirSep,founddll);
  1133. end;
  1134. if (not found) then
  1135. begin
  1136. message1(exec_w_libfile_not_found,s);
  1137. FoundDll:=s;
  1138. end;
  1139. FindDll:=Found;
  1140. end;
  1141. function tDLLScannerWin32.DllName(Const Name : string) : string;
  1142. var n : string;
  1143. begin
  1144. n:=Upper(SplitExtension(Name));
  1145. if (n='.DLL') or (n='.DRV') or (n='.EXE') then
  1146. DllName:=Name
  1147. else
  1148. DllName:=Name+target_info.sharedlibext;
  1149. end;
  1150. function tDLLScannerWin32.isSuitableFileType(x:cardinal):longbool;
  1151. begin
  1152. seek(f,x);
  1153. blockread(f,TheWord,2,loaded);
  1154. isSuitableFileType:=(loaded=2)and(TheWord='PE');
  1155. end;
  1156. function tDLLScannerWin32.GetEdata(HeaderEntry:cardinal):longbool;
  1157. type
  1158. TObjInfo=packed record
  1159. ObjName:array[0..7]of char;
  1160. VirtSize,
  1161. VirtAddr,
  1162. RawSize,
  1163. RawOffset,
  1164. Reloc,
  1165. LineNum:cardinal;
  1166. RelCount,
  1167. LineCount:word;
  1168. flags:cardinal;
  1169. end;
  1170. var
  1171. i:cardinal;
  1172. ObjOfs:cardinal;
  1173. Obj:TObjInfo;
  1174. APE_obj,APE_Optsize:word;
  1175. ExportRVA:cardinal;
  1176. delta:cardinal;
  1177. const
  1178. IMAGE_SCN_CNT_CODE=$00000020;
  1179. var
  1180. _d:dirstr;
  1181. _n:namestr;
  1182. _e:extstr;
  1183. function isUsedFunction(name:pchar):longbool;
  1184. var
  1185. hp:tExternalsItem;
  1186. begin
  1187. isUsedFunction:=false;
  1188. hp:=tExternalsItem(current_module.Externals.first);
  1189. while assigned(hp)do
  1190. begin
  1191. if(assigned(hp.data))and(not hp.found)then
  1192. if hp.data^=StrPas(name)then
  1193. begin
  1194. isUsedFunction:=true;
  1195. hp.found:=true;
  1196. exit;
  1197. end;
  1198. hp:=tExternalsItem(hp.next);
  1199. end;
  1200. end;
  1201. procedure Store(index:cardinal;name:pchar;isData:longbool);
  1202. begin
  1203. if not isUsedFunction(name)then
  1204. exit;
  1205. if not(current_module.uses_imports) then
  1206. begin
  1207. current_module.uses_imports:=true;
  1208. importlib.preparelib(current_module.modulename^);
  1209. end;
  1210. if IsData then
  1211. importlib.importvariable(name,_n,name)
  1212. else
  1213. importlib.importprocedure(name,_n,index,name);
  1214. end;
  1215. procedure ProcessEdata;
  1216. type
  1217. a8=array[0..7]of char;
  1218. function GetSectionName(rva:cardinal;var Flags:cardinal):a8;
  1219. var
  1220. i:cardinal;
  1221. LocObjOfs:cardinal;
  1222. LocObj:TObjInfo;
  1223. begin
  1224. GetSectionName:='';
  1225. Flags:=0;
  1226. LocObjOfs:=APE_OptSize+HeaderOffset+24;
  1227. for i:=1 to APE_obj do
  1228. begin
  1229. seek(f,LocObjOfs);
  1230. blockread(f,LocObj,sizeof(LocObj));
  1231. if(rva>=LocObj.VirtAddr)and(rva<=LocObj.VirtAddr+LocObj.RawSize)then
  1232. begin
  1233. GetSectionName:=a8(LocObj.ObjName);
  1234. Flags:=LocObj.flags;
  1235. end;
  1236. end;
  1237. end;
  1238. var
  1239. j,Fl:cardinal;
  1240. ulongval,procEntry:cardinal;
  1241. Ordinal:word;
  1242. isData:longbool;
  1243. ExpDir:packed record
  1244. flag,
  1245. stamp:cardinal;
  1246. Major,
  1247. Minor:word;
  1248. Name,
  1249. Base,
  1250. NumFuncs,
  1251. NumNames,
  1252. AddrFuncs,
  1253. AddrNames,
  1254. AddrOrds:cardinal;
  1255. end;
  1256. begin
  1257. with Obj do
  1258. begin
  1259. seek(f,RawOffset+delta);
  1260. blockread(f,ExpDir,sizeof(ExpDir));
  1261. fsplit(impname,_d,_n,_e);
  1262. for j:=0 to pred(ExpDir.NumNames)do
  1263. begin
  1264. seek(f,RawOffset-VirtAddr+ExpDir.AddrOrds+j*2);
  1265. blockread(f,Ordinal,2);
  1266. seek(f,RawOffset-VirtAddr+ExpDir.AddrFuncs+cardinal(Ordinal)*4);
  1267. blockread(f,ProcEntry,4);
  1268. seek(f,RawOffset-VirtAddr+ExpDir.AddrNames+j*4);
  1269. blockread(f,ulongval,4);
  1270. seek(f,RawOffset-VirtAddr+ulongval);
  1271. blockread(f,cstring,sizeof(cstring));
  1272. isData:=GetSectionName(procentry,Fl)='';
  1273. if not isData then
  1274. isData:=Fl and IMAGE_SCN_CNT_CODE<>IMAGE_SCN_CNT_CODE;
  1275. Store(succ(Ordinal),cstring,isData);
  1276. end;
  1277. end;
  1278. end;
  1279. begin
  1280. GetEdata:=false;
  1281. seek(f,HeaderEntry+120);
  1282. blockread(f,ExportRVA,4);
  1283. seek(f,HeaderEntry+6);
  1284. blockread(f,APE_Obj,2);
  1285. seek(f,HeaderEntry+20);
  1286. blockread(f,APE_OptSize,2);
  1287. ObjOfs:=APE_OptSize+HeaderOffset+24;
  1288. for i:=1 to APE_obj do
  1289. begin
  1290. seek(f,ObjOfs);
  1291. blockread(f,Obj,sizeof(Obj));
  1292. inc(ObjOfs,sizeof(Obj));
  1293. with Obj do
  1294. if(VirtAddr<=ExportRva)and(ExportRva<VirtAddr+VirtSize)then
  1295. begin
  1296. delta:=ExportRva-VirtAddr;
  1297. ProcessEdata;
  1298. GetEdata:=true;
  1299. end;
  1300. end;
  1301. end;
  1302. function tDLLScannerWin32.scan(const binname:string):longbool;
  1303. var
  1304. OldFileMode:longint;
  1305. foundimp : string;
  1306. begin
  1307. Scan:=false;
  1308. { is there already an import library the we will use that one }
  1309. if FindLibraryFile(binname,target_info.staticClibprefix,target_info.staticClibext,foundimp) then
  1310. exit;
  1311. { check if we can find the dll }
  1312. if not FindDll(DLLName(binname),impname) then
  1313. exit;
  1314. { read the dll file }
  1315. assign(f,impname);
  1316. OldFileMode:=filemode;
  1317. filemode:=0;
  1318. reset(f,1);
  1319. filemode:=OldFileMode;
  1320. if not DOSstubOK(HeaderOffset)then
  1321. scan:=false
  1322. else if not isSuitableFileType(HeaderOffset)then
  1323. scan:=false
  1324. else
  1325. scan:=GetEdata(HeaderOffset);
  1326. close(f);
  1327. end;
  1328. {*****************************************************************************
  1329. Initialize
  1330. *****************************************************************************}
  1331. const
  1332. ar_gnu_arw_info : tarinfo =
  1333. (
  1334. id : ar_gnu_arw;
  1335. arcmd : 'arw rs $LIB $FILES'
  1336. );
  1337. const
  1338. res_gnu_windres_info : tresinfo =
  1339. (
  1340. id : res_gnu_windres;
  1341. resbin : 'windres';
  1342. rescmd : '--include $INC -O coff -o $OBJ $RES'
  1343. );
  1344. const
  1345. target_i386_win32_info : ttargetinfo =
  1346. (
  1347. target : target_i386_WIN32;
  1348. name : 'Win32 for i386';
  1349. shortname : 'Win32';
  1350. flags : [];
  1351. cpu : i386;
  1352. unit_env : 'WIN32UNITS';
  1353. extradefines : 'MSWINDOWS';
  1354. sourceext : '.pp';
  1355. pasext : '.pas';
  1356. exeext : '.exe';
  1357. defext : '.def';
  1358. scriptext : '.bat';
  1359. smartext : '.slw';
  1360. unitext : '.ppw';
  1361. unitlibext : '.ppl';
  1362. asmext : '.sw';
  1363. objext : '.ow';
  1364. resext : '.rc';
  1365. resobjext : '.owr';
  1366. sharedlibext : '.dll';
  1367. staticlibext : '.aw';
  1368. staticlibprefix : 'libp';
  1369. sharedlibprefix : '';
  1370. sharedClibext : '.dll';
  1371. staticClibext : '.a';
  1372. staticClibprefix : 'lib';
  1373. sharedClibprefix : '';
  1374. Cprefix : '_';
  1375. newline : #13#10;
  1376. dirsep : '\';
  1377. files_case_relevent : false;
  1378. assem : as_i386_pecoff;
  1379. assemextern : as_i386_asw;
  1380. link : ld_i386_win32;
  1381. linkextern : ld_i386_win32;
  1382. ar : ar_gnu_arw;
  1383. res : res_gnu_windres;
  1384. script : script_dos;
  1385. endian : endian_little;
  1386. alignment :
  1387. (
  1388. procalign : 4;
  1389. loopalign : 4;
  1390. jumpalign : 0;
  1391. constalignmin : 0;
  1392. constalignmax : 1;
  1393. varalignmin : 0;
  1394. varalignmax : 1;
  1395. localalignmin : 0;
  1396. localalignmax : 1;
  1397. paraalign : 4;
  1398. recordalignmin : 0;
  1399. recordalignmax : 2;
  1400. maxCrecordalign : 16
  1401. );
  1402. size_of_pointer : 4;
  1403. size_of_longint : 4;
  1404. heapsize : 256*1024;
  1405. maxheapsize : 32*1024*1024;
  1406. stacksize : 32*1024*1024;
  1407. DllScanSupported:true;
  1408. use_bound_instruction : false;
  1409. use_function_relative_addresses : true
  1410. );
  1411. initialization
  1412. RegisterLinker(ld_i386_win32,TLinkerWin32);
  1413. RegisterImport(target_i386_win32,TImportLibWin32);
  1414. RegisterExport(target_i386_win32,TExportLibWin32);
  1415. RegisterDLLScanner(target_i386_win32,TDLLScannerWin32);
  1416. RegisterAr(ar_gnu_arw_info);
  1417. RegisterRes(res_gnu_windres_info);
  1418. RegisterTarget(target_i386_win32_info);
  1419. end.
  1420. {
  1421. $Log$
  1422. Revision 1.18 2001-09-18 11:32:00 michael
  1423. * Fixes win32 linking problems with import libraries
  1424. * LINKLIB Libraries are now looked for using C file extensions
  1425. * get_exepath fix
  1426. Revision 1.17 2001/09/17 21:29:16 peter
  1427. * merged netbsd, fpu-overflow from fixes branch
  1428. Revision 1.16 2001/09/13 14:47:19 michael
  1429. + Committed patch from peter
  1430. Revision 1.15 2001/08/07 18:47:15 peter
  1431. * merged netbsd start
  1432. * profile for win32
  1433. Revision 1.14 2001/07/01 20:16:21 peter
  1434. * alignmentinfo record added
  1435. * -Oa argument supports more alignment settings that can be specified
  1436. per type: PROC,LOOP,VARMIN,VARMAX,CONSTMIN,CONSTMAX,RECORDMIN
  1437. RECORDMAX,LOCALMIN,LOCALMAX. It is possible to set the mimimum
  1438. required alignment and the maximum usefull alignment. The final
  1439. alignment will be choosen per variable size dependent on these
  1440. settings
  1441. Revision 1.13 2001/06/28 19:46:25 peter
  1442. * added override and virtual for constructors
  1443. Revision 1.12 2001/06/18 20:36:26 peter
  1444. * -Ur switch (merged)
  1445. * masm fixes (merged)
  1446. * quoted filenames for go32v2 and win32
  1447. Revision 1.11 2001/06/06 21:58:16 peter
  1448. * Win32 fixes for Makefile so it doesn't require sh.exe
  1449. Revision 1.10 2001/06/03 20:18:13 peter
  1450. * define also MSWINDOWS
  1451. Revision 1.9 2001/06/03 15:15:32 peter
  1452. * dllprt0 stub for linux shared libs
  1453. * pass -init and -fini for linux shared libs
  1454. * libprefix splitted into staticlibprefix and sharedlibprefix
  1455. Revision 1.8 2001/06/02 19:22:44 peter
  1456. * extradefines field added
  1457. Revision 1.7 2001/04/21 13:33:16 peter
  1458. * move winstackpagesize const to cgai386 to remove uses t_win32
  1459. Revision 1.6 2001/04/18 22:02:04 peter
  1460. * registration of targets and assemblers
  1461. Revision 1.5 2001/04/13 23:51:02 peter
  1462. * fix for the stricter compilemode
  1463. Revision 1.4 2001/04/13 01:22:22 peter
  1464. * symtable change to classes
  1465. * range check generation and errors fixed, make cycle DEBUG=1 works
  1466. * memory leaks fixed
  1467. Revision 1.3 2001/04/02 21:20:40 peter
  1468. * resulttype rewrite
  1469. Revision 1.2 2001/03/06 18:28:02 peter
  1470. * patch from Pavel with a new and much faster DLL Scanner for
  1471. automatic importing so $linklib works for DLLs. Thanks Pavel!
  1472. Revision 1.1 2001/02/26 19:43:11 peter
  1473. * moved target units to subdir
  1474. Revision 1.10 2001/02/20 21:41:16 peter
  1475. * new fixfilename, findfile for unix. Look first for lowercase, then
  1476. NormalCase and last for UPPERCASE names.
  1477. Revision 1.9 2001/01/13 00:09:22 peter
  1478. * made Pavel O. happy ;)
  1479. Revision 1.8 2000/12/30 22:53:25 peter
  1480. * export with the case provided in the exports section
  1481. Revision 1.7 2000/12/25 00:07:30 peter
  1482. + new tlinkedlist class (merge of old tstringqueue,tcontainer and
  1483. tlinkedlist objects)
  1484. Revision 1.6 2000/11/12 22:20:37 peter
  1485. * create generic toutputsection for binary writers
  1486. Revision 1.5 2000/09/24 15:06:31 peter
  1487. * use defines.inc
  1488. Revision 1.4 2000/08/27 16:11:54 peter
  1489. * moved some util functions from globals,cobjects to cutils
  1490. * splitted files into finput,fmodule
  1491. Revision 1.3 2000/07/21 15:14:02 jonas
  1492. + added is_addr field for labels, if they are only used for getting the address
  1493. (e.g. for io checks) and corresponding getaddrlabel() procedure
  1494. Revision 1.2 2000/07/13 11:32:50 michael
  1495. + removed logs
  1496. }