win_targ.pas 31 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844
  1. {
  2. $Id$
  3. Copyright (c) 1998 by Florian Klaempfl
  4. This unit implements some support routines for the win32 target like
  5. import/export handling
  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 win_targ;
  20. interface
  21. uses import,export;
  22. const
  23. winstackpagesize = 4096;
  24. type
  25. pimportlibwin32=^timportlibwin32;
  26. timportlibwin32=object(timportlib)
  27. procedure preparelib(const s:string);virtual;
  28. procedure importprocedure(const func,module:string;index:longint;const name:string);virtual;
  29. procedure importvariable(const varname,module:string;const name:string);virtual;
  30. procedure generatelib;virtual;
  31. procedure generatesmartlib;
  32. end;
  33. pexportlibwin32=^texportlibwin32;
  34. texportlibwin32=object(texportlib)
  35. st : string;
  36. last_index : longint;
  37. procedure preparelib(const s:string);virtual;
  38. procedure exportprocedure(hp : pexported_item);virtual;
  39. procedure exportvar(hp : pexported_item);virtual;
  40. procedure generatelib;virtual;
  41. end;
  42. { sets some flags of the executable }
  43. procedure postprocessexecutable(n : string);
  44. implementation
  45. uses
  46. aasm,files,strings,globtype,globals,cobjects,systems,verbose,
  47. cpubase,cpuasm
  48. {$ifdef GDB}
  49. ,gdb
  50. {$endif}
  51. ;
  52. type
  53. tdosheader = packed record
  54. e_magic : word;
  55. e_cblp : word;
  56. e_cp : word;
  57. e_crlc : word;
  58. e_cparhdr : word;
  59. e_minalloc : word;
  60. e_maxalloc : word;
  61. e_ss : word;
  62. e_sp : word;
  63. e_csum : word;
  64. e_ip : word;
  65. e_cs : word;
  66. e_lfarlc : word;
  67. e_ovno : word;
  68. e_res : array[0..3] of word;
  69. e_oemid : word;
  70. e_oeminfo : word;
  71. e_res2 : array[0..9] of word;
  72. e_lfanew : longint;
  73. end;
  74. tpeheader = packed record
  75. PEMagic : array[0..3] of char;
  76. Machine : word;
  77. NumberOfSections : word;
  78. TimeDateStamp : longint;
  79. PointerToSymbolTable : longint;
  80. NumberOfSymbols : longint;
  81. SizeOfOptionalHeader : word;
  82. Characteristics : word;
  83. Magic : word;
  84. MajorLinkerVersion : byte;
  85. MinorLinkerVersion : byte;
  86. SizeOfCode : longint;
  87. SizeOfInitializedData : longint;
  88. SizeOfUninitializedData : longint;
  89. AddressOfEntryPoint : longint;
  90. BaseOfCode : longint;
  91. BaseOfData : longint;
  92. ImageBase : longint;
  93. SectionAlignment : longint;
  94. FileAlignment : longint;
  95. MajorOperatingSystemVersion : word;
  96. MinorOperatingSystemVersion : word;
  97. MajorImageVersion : word;
  98. MinorImageVersion : word;
  99. MajorSubsystemVersion : word;
  100. MinorSubsystemVersion : word;
  101. Reserved1 : longint;
  102. SizeOfImage : longint;
  103. SizeOfHeaders : longint;
  104. CheckSum : longint;
  105. Subsystem : word;
  106. DllCharacteristics : word;
  107. SizeOfStackReserve : longint;
  108. SizeOfStackCommit : longint;
  109. SizeOfHeapReserve : longint;
  110. SizeOfHeapCommit : longint;
  111. LoaderFlags : longint;
  112. NumberOfRvaAndSizes : longint;
  113. { DataDirectory : array[0..(IMAGE_NUMBEROF_DIRECTORY_ENTRIES)-1] of IMAGE_DATA_DIRECTORY; }
  114. end;
  115. function DllName(Const Name : string) : string;
  116. var n : string;
  117. begin
  118. n:=Upper(SplitExtension(Name));
  119. if (n='.DLL') or (n='.DRV') or (n='.EXE') then
  120. DllName:=Name
  121. else
  122. DllName:=Name+target_os.sharedlibext;
  123. end;
  124. procedure timportlibwin32.preparelib(const s : string);
  125. begin
  126. if not(assigned(importssection)) then
  127. importssection:=new(paasmoutput,init);
  128. end;
  129. procedure timportlibwin32.importprocedure(const func,module : string;index : longint;const name : string);
  130. var
  131. hp1 : pimportlist;
  132. hp2 : pimported_item;
  133. hs : string;
  134. begin
  135. { that IS wrong for DRV files
  136. hs:=SplitName(module); }
  137. hs:=DllName(module);
  138. { search for the module }
  139. hp1:=pimportlist(current_module^.imports^.first);
  140. while assigned(hp1) do
  141. begin
  142. if hs=hp1^.dllname^ then
  143. break;
  144. hp1:=pimportlist(hp1^.next);
  145. end;
  146. { generate a new item ? }
  147. if not(assigned(hp1)) then
  148. begin
  149. hp1:=new(pimportlist,init(hs));
  150. current_module^.imports^.concat(hp1);
  151. end;
  152. { search for reuse of old import item }
  153. hp2:=pimported_item(hp1^.imported_items^.first);
  154. while assigned(hp2) do
  155. begin
  156. if hp2^.func^=func then
  157. break;
  158. hp2:=pimported_item(hp2^.next);
  159. end;
  160. if not assigned(hp2) then
  161. begin
  162. hp2:=new(pimported_item,init(func,name,index));
  163. hp1^.imported_items^.concat(hp2);
  164. end;
  165. end;
  166. procedure timportlibwin32.importvariable(const varname,module:string;const name:string);
  167. var
  168. hp1 : pimportlist;
  169. hp2 : pimported_item;
  170. hs : string;
  171. begin
  172. hs:=DllName(module);
  173. { search for the module }
  174. hp1:=pimportlist(current_module^.imports^.first);
  175. while assigned(hp1) do
  176. begin
  177. if hs=hp1^.dllname^ then
  178. break;
  179. hp1:=pimportlist(hp1^.next);
  180. end;
  181. { generate a new item ? }
  182. if not(assigned(hp1)) then
  183. begin
  184. hp1:=new(pimportlist,init(hs));
  185. current_module^.imports^.concat(hp1);
  186. end;
  187. hp2:=new(pimported_item,init_var(varname,name));
  188. hp1^.imported_items^.concat(hp2);
  189. end;
  190. procedure timportlibwin32.generatesmartlib;
  191. var
  192. hp1 : pimportlist;
  193. hp2 : pimported_item;
  194. lhead,lname,lcode,
  195. lidata4,lidata5 : pasmlabel;
  196. r : preference;
  197. begin
  198. hp1:=pimportlist(current_module^.imports^.first);
  199. while assigned(hp1) do
  200. begin
  201. importssection^.concat(new(pai_cut,init));
  202. codesegment^.concat(new(pai_cut,init));
  203. { create header for this importmodule }
  204. { Get labels for the sections }
  205. getdatalabel(lhead);
  206. getdatalabel(lname);
  207. getlabel(lidata4);
  208. getlabel(lidata5);
  209. importssection^.concat(new(pai_section,init(sec_idata2)));
  210. importssection^.concat(new(pai_label,init(lhead)));
  211. { pointer to procedure names }
  212. importssection^.concat(new(pai_const_symbol,init_rva(lidata4)));
  213. { two empty entries follow }
  214. importssection^.concat(new(pai_const,init_32bit(0)));
  215. importssection^.concat(new(pai_const,init_32bit(0)));
  216. { pointer to dll name }
  217. importssection^.concat(new(pai_const_symbol,init_rva(lname)));
  218. { pointer to fixups }
  219. importssection^.concat(new(pai_const_symbol,init_rva(lidata5)));
  220. { first write the name references }
  221. importssection^.concat(new(pai_section,init(sec_idata4)));
  222. importssection^.concat(new(pai_const,init_32bit(0)));
  223. importssection^.concat(new(pai_label,init(lidata4)));
  224. { then the addresses and create also the indirect jump }
  225. importssection^.concat(new(pai_section,init(sec_idata5)));
  226. importssection^.concat(new(pai_const,init_32bit(0)));
  227. importssection^.concat(new(pai_label,init(lidata5)));
  228. { write final section }
  229. importssection^.concat(new(pai_cut,init_end));
  230. { end of name references }
  231. importssection^.concat(new(pai_section,init(sec_idata4)));
  232. importssection^.concat(new(pai_const,init_32bit(0)));
  233. { end if addresses }
  234. importssection^.concat(new(pai_section,init(sec_idata5)));
  235. importssection^.concat(new(pai_const,init_32bit(0)));
  236. { dllname }
  237. importssection^.concat(new(pai_section,init(sec_idata7)));
  238. importssection^.concat(new(pai_label,init(lname)));
  239. importssection^.concat(new(pai_string,init(hp1^.dllname^+{target_os.sharedlibext+}#0)));
  240. { create procedures }
  241. hp2:=pimported_item(hp1^.imported_items^.first);
  242. while assigned(hp2) do
  243. begin
  244. { insert cuts }
  245. importssection^.concat(new(pai_cut,init));
  246. { create indirect jump }
  247. if not hp2^.is_var then
  248. begin
  249. getlabel(lcode);
  250. new(r);
  251. reset_reference(r^);
  252. r^.symbol:=lcode;
  253. { place jump in codesegment, insert a code section in the
  254. importsection to reduce the amount of .s files (PFV) }
  255. importssection^.concat(new(pai_section,init(sec_code)));
  256. {$IfDef GDB}
  257. if (cs_debuginfo in aktmoduleswitches) then
  258. importssection^.concat(new(pai_stab_function_name,init(nil)));
  259. {$EndIf GDB}
  260. importssection^.concat(new(pai_align,init_op(4,$90)));
  261. importssection^.concat(new(pai_symbol,initname_global(hp2^.func^,0)));
  262. importssection^.concat(new(pai386,op_ref(A_JMP,S_NO,r)));
  263. end;
  264. { create head link }
  265. importssection^.concat(new(pai_section,init(sec_idata7)));
  266. importssection^.concat(new(pai_const_symbol,init_rva(lhead)));
  267. { fixup }
  268. getlabel(pasmlabel(hp2^.lab));
  269. importssection^.concat(new(pai_section,init(sec_idata4)));
  270. importssection^.concat(new(pai_const_symbol,init_rva(hp2^.lab)));
  271. { add jump field to importsection }
  272. importssection^.concat(new(pai_section,init(sec_idata5)));
  273. if hp2^.is_var then
  274. importssection^.concat(new(pai_symbol,initname_global(hp2^.func^,0)))
  275. else
  276. importssection^.concat(new(pai_label,init(lcode)));
  277. if hp2^.name^<>'' then
  278. importssection^.concat(new(pai_const_symbol,init_rva(hp2^.lab)))
  279. else
  280. importssection^.concat(new(pai_const,init_32bit($80000000 or hp2^.ordnr)));
  281. { finally the import information }
  282. importssection^.concat(new(pai_section,init(sec_idata6)));
  283. importssection^.concat(new(pai_label,init(hp2^.lab)));
  284. importssection^.concat(new(pai_const,init_16bit(hp2^.ordnr)));
  285. importssection^.concat(new(pai_string,init(hp2^.name^+#0)));
  286. importssection^.concat(new(pai_align,init_op(2,0)));
  287. hp2:=pimported_item(hp2^.next);
  288. end;
  289. hp1:=pimportlist(hp1^.next);
  290. end;
  291. end;
  292. procedure timportlibwin32.generatelib;
  293. var
  294. hp1 : pimportlist;
  295. hp2 : pimported_item;
  296. l1,l2,l3,l4 : pasmlabel;
  297. r : preference;
  298. begin
  299. if (cs_smartlink in aktmoduleswitches) then
  300. begin
  301. generatesmartlib;
  302. exit;
  303. end;
  304. hp1:=pimportlist(current_module^.imports^.first);
  305. while assigned(hp1) do
  306. begin
  307. { Insert cuts for smartlinking }
  308. if (cs_smartlink in aktmoduleswitches) then
  309. begin
  310. importssection^.concat(new(pai_cut,init));
  311. codesegment^.concat(new(pai_cut,init));
  312. end;
  313. {$IfDef GDB}
  314. if (cs_debuginfo in aktmoduleswitches) then
  315. codesegment^.concat(new(pai_stab_function_name,init(nil)));
  316. {$EndIf GDB}
  317. { Get labels for the sections }
  318. getlabel(l1);
  319. getlabel(l2);
  320. getlabel(l3);
  321. importssection^.concat(new(pai_section,init(sec_idata2)));
  322. { pointer to procedure names }
  323. importssection^.concat(new(pai_const_symbol,init_rva(l2)));
  324. { two empty entries follow }
  325. importssection^.concat(new(pai_const,init_32bit(0)));
  326. importssection^.concat(new(pai_const,init_32bit(0)));
  327. { pointer to dll name }
  328. importssection^.concat(new(pai_const_symbol,init_rva(l1)));
  329. { pointer to fixups }
  330. importssection^.concat(new(pai_const_symbol,init_rva(l3)));
  331. { only create one section for each else it will
  332. create a lot of idata* }
  333. { first write the name references }
  334. importssection^.concat(new(pai_section,init(sec_idata4)));
  335. importssection^.concat(new(pai_label,init(l2)));
  336. hp2:=pimported_item(hp1^.imported_items^.first);
  337. while assigned(hp2) do
  338. begin
  339. getlabel(pasmlabel(hp2^.lab));
  340. if hp2^.name^<>'' then
  341. importssection^.concat(new(pai_const_symbol,init_rva(hp2^.lab)))
  342. else
  343. importssection^.concat(new(pai_const,init_32bit($80000000 or hp2^.ordnr)));
  344. hp2:=pimported_item(hp2^.next);
  345. end;
  346. { finalize the names ... }
  347. importssection^.concat(new(pai_const,init_32bit(0)));
  348. { then the addresses and create also the indirect jump }
  349. importssection^.concat(new(pai_section,init(sec_idata5)));
  350. importssection^.concat(new(pai_label,init(l3)));
  351. hp2:=pimported_item(hp1^.imported_items^.first);
  352. while assigned(hp2) do
  353. begin
  354. if not hp2^.is_var then
  355. begin
  356. getdatalabel(l4);
  357. { create indirect jump }
  358. new(r);
  359. reset_reference(r^);
  360. r^.symbol:=l4;
  361. { place jump in codesegment }
  362. codesegment^.concat(new(pai_align,init_op(4,$90)));
  363. codesegment^.concat(new(pai_symbol,initname_global(hp2^.func^,0)));
  364. codesegment^.concat(new(pai386,op_ref(A_JMP,S_NO,r)));
  365. { add jump field to importsection }
  366. importssection^.concat(new(pai_label,init(l4)));
  367. end
  368. else
  369. begin
  370. importssection^.concat(new(pai_symbol,initname_global(hp2^.func^,0)));
  371. end;
  372. importssection^.concat(new(pai_const_symbol,init_rva(hp2^.lab)));
  373. hp2:=pimported_item(hp2^.next);
  374. end;
  375. { finalize the addresses }
  376. importssection^.concat(new(pai_const,init_32bit(0)));
  377. { finally the import information }
  378. importssection^.concat(new(pai_section,init(sec_idata6)));
  379. hp2:=pimported_item(hp1^.imported_items^.first);
  380. while assigned(hp2) do
  381. begin
  382. importssection^.concat(new(pai_label,init(hp2^.lab)));
  383. { the ordinal number }
  384. importssection^.concat(new(pai_const,init_16bit(hp2^.ordnr)));
  385. importssection^.concat(new(pai_string,init(hp2^.name^+#0)));
  386. importssection^.concat(new(pai_align,init_op(2,0)));
  387. hp2:=pimported_item(hp2^.next);
  388. end;
  389. { create import dll name }
  390. importssection^.concat(new(pai_section,init(sec_idata7)));
  391. importssection^.concat(new(pai_label,init(l1)));
  392. importssection^.concat(new(pai_string,init(hp1^.dllname^+{target_os.sharedlibext+}#0)));
  393. hp1:=pimportlist(hp1^.next);
  394. end;
  395. end;
  396. procedure texportlibwin32.preparelib(const s:string);
  397. begin
  398. if not(assigned(exportssection)) then
  399. exportssection:=new(paasmoutput,init);
  400. last_index:=0;
  401. end;
  402. procedure texportlibwin32.exportvar(hp : pexported_item);
  403. begin
  404. { same code used !! PM }
  405. exportprocedure(hp);
  406. end;
  407. procedure texportlibwin32.exportprocedure(hp : pexported_item);
  408. { must be ordered at least for win32 !! }
  409. var hp2 : pexported_item;
  410. begin
  411. hp2:=pexported_item(current_module^._exports^.first);
  412. { first test the index value }
  413. if (hp^.options and eo_index)<>0 then
  414. begin
  415. if (hp^.index<=0) or (hp^.index>$ffff) then
  416. message1(parser_e_export_invalid_index,tostr(hp^.index))
  417. else while assigned(hp2) do
  418. begin
  419. if (hp^.index=hp2^.index) then
  420. if ((hp2^.options and eo_index)<>0) then
  421. message1(parser_e_export_ordinal_double,tostr(hp^.index))
  422. else
  423. begin
  424. inc(last_index);
  425. hp2^.index:=last_index;
  426. end;
  427. hp2:=pexported_item(hp2^.next);
  428. end;
  429. if hp^.index=last_index+1 then
  430. inc(last_index);
  431. end
  432. else
  433. begin
  434. inc(last_index);
  435. hp^.index:=last_index;
  436. end;
  437. { use pascal name is none specified }
  438. if (hp^.options and eo_name)=0 then
  439. begin
  440. hp^.name:=stringdup(hp^.sym^.name);
  441. hp^.options:=hp^.options or eo_name;
  442. end;
  443. { now place in correct order }
  444. hp2:=pexported_item(current_module^._exports^.first);
  445. while assigned(hp2) and
  446. (hp^.name^>hp2^.name^) do
  447. hp2:=pexported_item(hp2^.next);
  448. { insert hp there !! }
  449. if assigned(hp2) and (hp2^.name^=hp^.name^) then
  450. begin
  451. { this is not allowed !! }
  452. message1(parser_e_export_name_double,hp^.name^);
  453. end;
  454. if hp2=pexported_item(current_module^._exports^.first) then
  455. current_module^._exports^.insert(hp)
  456. else if assigned(hp2) then
  457. begin
  458. hp^.next:=hp2;
  459. hp^.previous:=hp2^.previous;
  460. if assigned(hp2^.previous) then
  461. hp2^.previous^.next:=hp;
  462. hp2^.previous:=hp;
  463. end
  464. else
  465. current_module^._exports^.concat(hp);
  466. end;
  467. procedure texportlibwin32.generatelib;
  468. var
  469. ordinal_base,ordinal_max,ordinal_min : longint;
  470. current_index : longint;
  471. entries,named_entries : longint;
  472. name_label,dll_name_label,export_address_table : pasmlabel;
  473. export_name_table_pointers,export_ordinal_table : pasmlabel;
  474. hp,hp2 : pexported_item;
  475. tempexport : plinkedlist;
  476. address_table,name_table_pointers,
  477. name_table,ordinal_table : paasmoutput;
  478. begin
  479. ordinal_max:=0;
  480. ordinal_min:=$7FFFFFFF;
  481. entries:=0;
  482. named_entries:=0;
  483. getlabel(dll_name_label);
  484. getlabel(export_address_table);
  485. getlabel(export_name_table_pointers);
  486. getlabel(export_ordinal_table);
  487. hp:=pexported_item(current_module^._exports^.first);
  488. { count entries }
  489. while assigned(hp) do
  490. begin
  491. inc(entries);
  492. if (hp^.index>ordinal_max) then
  493. ordinal_max:=hp^.index;
  494. if (hp^.index>0) and (hp^.index<ordinal_min) then
  495. ordinal_min:=hp^.index;
  496. if assigned(hp^.name) then
  497. inc(named_entries);
  498. hp:=pexported_item(hp^.next);
  499. end;
  500. { no support for higher ordinal base yet !! }
  501. ordinal_base:=1;
  502. current_index:=ordinal_base;
  503. { we must also count the holes !! }
  504. entries:=ordinal_max-ordinal_base+1;
  505. exportssection^.concat(new(pai_section,init(sec_edata)));
  506. { export flags }
  507. exportssection^.concat(new(pai_const,init_32bit(0)));
  508. { date/time stamp }
  509. exportssection^.concat(new(pai_const,init_32bit(0)));
  510. { major version }
  511. exportssection^.concat(new(pai_const,init_16bit(0)));
  512. { minor version }
  513. exportssection^.concat(new(pai_const,init_16bit(0)));
  514. { pointer to dll name }
  515. exportssection^.concat(new(pai_const_symbol,init_rva(dll_name_label)));
  516. { ordinal base normally set to 1 }
  517. exportssection^.concat(new(pai_const,init_32bit(ordinal_base)));
  518. { number of entries }
  519. exportssection^.concat(new(pai_const,init_32bit(entries)));
  520. { number of named entries }
  521. exportssection^.concat(new(pai_const,init_32bit(named_entries)));
  522. { address of export address table }
  523. exportssection^.concat(new(pai_const_symbol,init_rva(export_address_table)));
  524. { address of name pointer pointers }
  525. exportssection^.concat(new(pai_const_symbol,init_rva(export_name_table_pointers)));
  526. { address of ordinal number pointers }
  527. exportssection^.concat(new(pai_const_symbol,init_rva(export_ordinal_table)));
  528. { the name }
  529. exportssection^.concat(new(pai_label,init(dll_name_label)));
  530. if st='' then
  531. exportssection^.concat(new(pai_string,init(current_module^.modulename^+target_os.sharedlibext+#0)))
  532. else
  533. exportssection^.concat(new(pai_string,init(st+target_os.sharedlibext+#0)));
  534. { export address table }
  535. address_table:=new(paasmoutput,init);
  536. address_table^.concat(new(pai_align,init_op(4,0)));
  537. address_table^.concat(new(pai_label,init(export_address_table)));
  538. name_table_pointers:=new(paasmoutput,init);
  539. name_table_pointers^.concat(new(pai_align,init_op(4,0)));
  540. name_table_pointers^.concat(new(pai_label,init(export_name_table_pointers)));
  541. ordinal_table:=new(paasmoutput,init);
  542. ordinal_table^.concat(new(pai_align,init_op(4,0)));
  543. ordinal_table^.concat(new(pai_label,init(export_ordinal_table)));
  544. name_table:=new(paasmoutput,init);
  545. name_table^.concat(new(pai_align,init_op(4,0)));
  546. { write each address }
  547. hp:=pexported_item(current_module^._exports^.first);
  548. while assigned(hp) do
  549. begin
  550. if (hp^.options and eo_name)<>0 then
  551. begin
  552. getlabel(name_label);
  553. name_table_pointers^.concat(new(pai_const_symbol,init_rva(name_label)));
  554. ordinal_table^.concat(new(pai_const,init_16bit(hp^.index-ordinal_base)));
  555. name_table^.concat(new(pai_align,init_op(2,0)));
  556. name_table^.concat(new(pai_label,init(name_label)));
  557. name_table^.concat(new(pai_string,init(hp^.name^+#0)));
  558. end;
  559. hp:=pexported_item(hp^.next);
  560. end;
  561. { order in increasing ordinal values }
  562. { into tempexport list }
  563. tempexport:=new(plinkedlist,init);
  564. hp:=pexported_item(current_module^._exports^.first);
  565. while assigned(hp) do
  566. begin
  567. current_module^._exports^.remove(hp);
  568. hp2:=pexported_item(tempexport^.first);
  569. while assigned(hp2) and (hp^.index>hp2^.index) do
  570. begin
  571. hp2:=pexported_item(hp2^.next);
  572. end;
  573. if hp2=pexported_item(tempexport^.first) then
  574. tempexport^.insert(hp)
  575. else
  576. begin
  577. if assigned(hp2) then
  578. begin
  579. hp^.next:=hp2;
  580. hp^.previous:=hp2^.previous;
  581. hp2^.previous:=hp;
  582. if assigned(hp^.previous) then
  583. hp^.previous^.next:=hp;
  584. end
  585. else
  586. tempexport^.concat(hp);
  587. end;
  588. hp:=pexported_item(current_module^._exports^.first);;
  589. end;
  590. { write the export adress table }
  591. current_index:=ordinal_base;
  592. hp:=pexported_item(tempexport^.first);
  593. while assigned(hp) do
  594. begin
  595. { fill missing values }
  596. while current_index<hp^.index do
  597. begin
  598. address_table^.concat(new(pai_const,init_32bit(0)));
  599. inc(current_index);
  600. end;
  601. address_table^.concat(new(pai_const_symbol,initname_rva(hp^.sym^.mangledname)));
  602. inc(current_index);
  603. hp:=pexported_item(hp^.next);
  604. end;
  605. exportssection^.concatlist(address_table);
  606. exportssection^.concatlist(name_table_pointers);
  607. exportssection^.concatlist(ordinal_table);
  608. exportssection^.concatlist(name_table);
  609. dispose(address_table,done);
  610. dispose(name_table_pointers,done);
  611. dispose(ordinal_table,done);
  612. dispose(name_table,done);
  613. dispose(tempexport,done);
  614. end;
  615. procedure postprocessexecutable(n : string);
  616. var
  617. f : file;
  618. dosheader : tdosheader;
  619. peheader : tpeheader;
  620. peheaderpos : longint;
  621. begin
  622. { when -s is used quit, because there is no .exe }
  623. if cs_link_extern in aktglobalswitches then
  624. exit;
  625. { open file }
  626. assign(f,n);
  627. {$I-}
  628. reset(f,1);
  629. if ioresult<>0 then
  630. Message1(execinfo_f_cant_open_executable,n);
  631. { read headers }
  632. blockread(f,dosheader,sizeof(tdosheader));
  633. peheaderpos:=dosheader.e_lfanew;
  634. seek(f,peheaderpos);
  635. blockread(f,peheader,sizeof(tpeheader));
  636. { write info }
  637. Message1(execinfo_x_codesize,tostr(peheader.SizeOfCode));
  638. Message1(execinfo_x_initdatasize,tostr(peheader.SizeOfInitializedData));
  639. Message1(execinfo_x_uninitdatasize,tostr(peheader.SizeOfUninitializedData));
  640. { change stack size (PM) }
  641. { I am not sure that the default value is adequate !! }
  642. peheader.SizeOfStackReserve:=stacksize;
  643. { change the header }
  644. { sub system }
  645. { gui=2 }
  646. { cui=3 }
  647. if apptype=at_gui then
  648. peheader.Subsystem:=2
  649. else if apptype=at_cui then
  650. peheader.Subsystem:=3;
  651. seek(f,peheaderpos);
  652. blockwrite(f,peheader,sizeof(tpeheader));
  653. if ioresult<>0 then
  654. Message1(execinfo_f_cant_process_executable,n);
  655. seek(f,peheaderpos);
  656. blockread(f,peheader,sizeof(tpeheader));
  657. { write the value after the change }
  658. Message1(execinfo_x_stackreserve,tostr(peheader.SizeOfStackReserve));
  659. Message1(execinfo_x_stackcommit,tostr(peheader.SizeOfStackCommit));
  660. close(f);
  661. {$I+}
  662. end;
  663. end.
  664. {
  665. $Log$
  666. Revision 1.31 1999-08-04 00:23:50 florian
  667. * renamed i386asm and i386base to cpuasm and cpubase
  668. Revision 1.30 1999/07/29 20:54:11 peter
  669. * write .size also
  670. Revision 1.29 1999/07/22 16:12:28 peter
  671. * merged
  672. Revision 1.28 1999/07/18 10:20:03 florian
  673. * made it compilable with Dlephi 4 again
  674. + fixed problem with large stack allocations on win32
  675. Revision 1.27.2.1 1999/07/22 16:09:30 peter
  676. * reuse old import entries
  677. Revision 1.27 1999/05/27 19:45:30 peter
  678. * removed oldasm
  679. * plabel -> pasmlabel
  680. * -a switches to source writing automaticly
  681. * assembler readers OOPed
  682. * asmsymbol automaticly external
  683. * jumptables and other label fixes for asm readers
  684. Revision 1.26 1999/05/21 13:55:24 peter
  685. * NEWLAB for label as symbol
  686. Revision 1.25 1999/05/17 13:02:13 pierre
  687. * -Csmmm works for win32 but default is set to 32Mb
  688. Revision 1.24 1999/05/01 13:25:04 peter
  689. * merged nasm compiler
  690. * old asm moved to oldasm/
  691. Revision 1.23 1999/04/07 14:18:32 pierre
  692. * typo correction
  693. Revision 1.22 1999/04/07 14:04:40 pierre
  694. * adds .dll as library suffix only if
  695. the name does not end with .dll .drv or .exe !
  696. Revision 1.21 1999/02/25 21:02:59 peter
  697. * ag386bin updates
  698. + coff writer
  699. Revision 1.20 1999/02/22 02:44:14 peter
  700. * ag386bin doesn't use i386.pas anymore
  701. Revision 1.19 1998/12/11 00:04:06 peter
  702. + globtype,tokens,version unit splitted from globals
  703. Revision 1.18 1998/12/02 10:26:13 pierre
  704. * writing of .edata was wrong for indexes above number of exported items
  705. * importing by index only did not work !
  706. Revision 1.17 1998/12/01 23:35:43 pierre
  707. * alignment fixes
  708. Revision 1.16 1998/11/30 13:26:26 pierre
  709. * the code for ordering the exported procs/vars was buggy
  710. + added -WB to force binding (Ozerski way of creating DLL)
  711. this is off by default as direct writing of .edata section seems
  712. OK
  713. Revision 1.15 1998/11/30 09:43:25 pierre
  714. * some range check bugs fixed (still not working !)
  715. + added DLL writing support for win32 (also accepts variables)
  716. + TempAnsi for code that could be used for Temporary ansi strings
  717. handling
  718. Revision 1.14 1998/11/28 16:21:00 peter
  719. + support for dll variables
  720. Revision 1.13 1998/10/29 11:35:54 florian
  721. * some dll support for win32
  722. * fixed assembler writing for PalmOS
  723. Revision 1.12 1998/10/27 10:22:35 florian
  724. + First things for win32 export sections
  725. Revision 1.11 1998/10/22 17:54:09 florian
  726. + switch $APPTYPE for win32 added
  727. Revision 1.10 1998/10/22 15:18:51 florian
  728. + switch -vx for win32 added
  729. Revision 1.9 1998/10/19 15:41:03 peter
  730. * better splitname to support glib-1.1.dll alike names
  731. Revision 1.8 1998/09/07 18:33:35 peter
  732. + smartlinking for win95 imports
  733. Revision 1.7 1998/09/03 17:39:06 florian
  734. + better code for type conversation longint/dword to real type
  735. Revision 1.6 1998/08/10 14:50:38 peter
  736. + localswitches, moduleswitches, globalswitches splitting
  737. Revision 1.5 1998/06/10 10:43:18 peter
  738. * write also the .dll extension (needed for NT)
  739. Revision 1.4 1998/06/08 22:59:56 peter
  740. * smartlinking works for win32
  741. * some defines to exclude some compiler parts
  742. Revision 1.3 1998/06/04 23:52:06 peter
  743. * m68k compiles
  744. + .def file creation moved to gendef.pas so it could also be used
  745. for win32
  746. Revision 1.2 1998/05/06 18:36:55 peter
  747. * tai_section extended with code,data,bss sections and enumerated type
  748. * ident 'compiled by FPC' moved to pmodules
  749. * small fix for smartlink
  750. }