t_win32.pas 55 KB

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