t_win32.pas 53 KB

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