t_win32.pas 49 KB

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