t_win32.pas 56 KB

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