win_targ.pas 28 KB

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