win_targ.pas 30 KB

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