t_win32.pas 55 KB

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