win_targ.pas 20 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537
  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. procedure preparelib(const s:string);virtual;
  34. procedure generatelib;virtual;
  35. end;
  36. { sets some flags of the executable }
  37. procedure postprocessexecutable(n : string);
  38. implementation
  39. uses
  40. aasm,files,strings,globals,cobjects,systems,verbose
  41. {$ifdef GDB}
  42. ,gdb
  43. {$endif}
  44. {$ifdef i386}
  45. ,i386
  46. {$endif}
  47. ;
  48. type
  49. tdosheader = packed record
  50. e_magic : word;
  51. e_cblp : word;
  52. e_cp : word;
  53. e_crlc : word;
  54. e_cparhdr : word;
  55. e_minalloc : word;
  56. e_maxalloc : word;
  57. e_ss : word;
  58. e_sp : word;
  59. e_csum : word;
  60. e_ip : word;
  61. e_cs : word;
  62. e_lfarlc : word;
  63. e_ovno : word;
  64. e_res : array[0..3] of word;
  65. e_oemid : word;
  66. e_oeminfo : word;
  67. e_res2 : array[0..9] of word;
  68. e_lfanew : longint;
  69. end;
  70. tpeheader = packed record
  71. PEMagic : array[0..3] of char;
  72. Machine : word;
  73. NumberOfSections : word;
  74. TimeDateStamp : longint;
  75. PointerToSymbolTable : longint;
  76. NumberOfSymbols : longint;
  77. SizeOfOptionalHeader : word;
  78. Characteristics : word;
  79. Magic : word;
  80. MajorLinkerVersion : byte;
  81. MinorLinkerVersion : byte;
  82. SizeOfCode : longint;
  83. SizeOfInitializedData : longint;
  84. SizeOfUninitializedData : longint;
  85. AddressOfEntryPoint : longint;
  86. BaseOfCode : longint;
  87. BaseOfData : longint;
  88. ImageBase : longint;
  89. SectionAlignment : longint;
  90. FileAlignment : longint;
  91. MajorOperatingSystemVersion : word;
  92. MinorOperatingSystemVersion : word;
  93. MajorImageVersion : word;
  94. MinorImageVersion : word;
  95. MajorSubsystemVersion : word;
  96. MinorSubsystemVersion : word;
  97. Reserved1 : longint;
  98. SizeOfImage : longint;
  99. SizeOfHeaders : longint;
  100. CheckSum : longint;
  101. Subsystem : word;
  102. DllCharacteristics : word;
  103. SizeOfStackReserve : longint;
  104. SizeOfStackCommit : longint;
  105. SizeOfHeapReserve : longint;
  106. SizeOfHeapCommit : longint;
  107. LoaderFlags : longint;
  108. NumberOfRvaAndSizes : longint;
  109. { DataDirectory : array[0..(IMAGE_NUMBEROF_DIRECTORY_ENTRIES)-1] of IMAGE_DATA_DIRECTORY; }
  110. end;
  111. procedure timportlibwin32.preparelib(const s : string);
  112. begin
  113. if not(assigned(importssection)) then
  114. importssection:=new(paasmoutput,init);
  115. end;
  116. procedure timportlibwin32.importprocedure(const func,module : string;index : longint;const name : string);
  117. var
  118. hp1 : pimportlist;
  119. hp2 : pimported_item;
  120. hs : string;
  121. begin
  122. hs:=SplitName(module);
  123. { search for the module }
  124. hp1:=pimportlist(current_module^.imports^.first);
  125. while assigned(hp1) do
  126. begin
  127. if hs=hp1^.dllname^ then
  128. break;
  129. hp1:=pimportlist(hp1^.next);
  130. end;
  131. { generate a new item ? }
  132. if not(assigned(hp1)) then
  133. begin
  134. hp1:=new(pimportlist,init(hs));
  135. current_module^.imports^.concat(hp1);
  136. end;
  137. hp2:=new(pimported_item,init(func,name,index));
  138. hp1^.imported_items^.concat(hp2);
  139. end;
  140. procedure timportlibwin32.importvariable(const varname,module:string;const name:string);
  141. var
  142. hp1 : pimportlist;
  143. hp2 : pimported_item;
  144. hs : string;
  145. begin
  146. hs:=SplitName(module);
  147. { search for the module }
  148. hp1:=pimportlist(current_module^.imports^.first);
  149. while assigned(hp1) do
  150. begin
  151. if hs=hp1^.dllname^ then
  152. break;
  153. hp1:=pimportlist(hp1^.next);
  154. end;
  155. { generate a new item ? }
  156. if not(assigned(hp1)) then
  157. begin
  158. hp1:=new(pimportlist,init(hs));
  159. current_module^.imports^.concat(hp1);
  160. end;
  161. hp2:=new(pimported_item,init_var(varname,name));
  162. hp1^.imported_items^.concat(hp2);
  163. end;
  164. procedure timportlibwin32.generatesmartlib;
  165. var
  166. hp1 : pimportlist;
  167. hp2 : pimported_item;
  168. lhead,lname,lcode,
  169. lidata4,lidata5 : plabel;
  170. r : preference;
  171. begin
  172. hp1:=pimportlist(current_module^.imports^.first);
  173. while assigned(hp1) do
  174. begin
  175. importssection^.concat(new(pai_cut,init));
  176. codesegment^.concat(new(pai_cut,init));
  177. { create header for this importmodule }
  178. { Get labels for the sections }
  179. getdatalabel(lhead);
  180. getdatalabel(lname);
  181. getlabel(lidata4);
  182. getlabel(lidata5);
  183. importssection^.concat(new(pai_section,init_idata(2)));
  184. importssection^.concat(new(pai_label,init(lhead)));
  185. { pointer to procedure names }
  186. importssection^.concat(new(pai_const,init_rva(strpnew(lab2str(lidata4)))));
  187. { two empty entries follow }
  188. importssection^.concat(new(pai_const,init_32bit(0)));
  189. importssection^.concat(new(pai_const,init_32bit(0)));
  190. { pointer to dll name }
  191. importssection^.concat(new(pai_const,init_rva(strpnew(lab2str(lname)))));
  192. { pointer to fixups }
  193. importssection^.concat(new(pai_const,init_rva(strpnew(lab2str(lidata5)))));
  194. { first write the name references }
  195. importssection^.concat(new(pai_section,init_idata(4)));
  196. importssection^.concat(new(pai_const,init_32bit(0)));
  197. importssection^.concat(new(pai_label,init(lidata4)));
  198. { then the addresses and create also the indirect jump }
  199. importssection^.concat(new(pai_section,init_idata(5)));
  200. importssection^.concat(new(pai_const,init_32bit(0)));
  201. importssection^.concat(new(pai_label,init(lidata5)));
  202. { write final section }
  203. importssection^.concat(new(pai_cut,init_end));
  204. { end of name references }
  205. importssection^.concat(new(pai_section,init_idata(4)));
  206. importssection^.concat(new(pai_const,init_32bit(0)));
  207. { end if addresses }
  208. importssection^.concat(new(pai_section,init_idata(5)));
  209. importssection^.concat(new(pai_const,init_32bit(0)));
  210. { dllname }
  211. importssection^.concat(new(pai_section,init_idata(7)));
  212. importssection^.concat(new(pai_label,init(lname)));
  213. importssection^.concat(new(pai_string,init(hp1^.dllname^+target_os.sharedlibext+#0)));
  214. { create procedures }
  215. hp2:=pimported_item(hp1^.imported_items^.first);
  216. while assigned(hp2) do
  217. begin
  218. { insert cuts }
  219. importssection^.concat(new(pai_cut,init));
  220. { create indirect jump }
  221. if not hp2^.is_var then
  222. begin
  223. getlabel(lcode);
  224. new(r);
  225. reset_reference(r^);
  226. r^.symbol:=stringdup(lab2str(lcode));
  227. { place jump in codesegment, insert a code section in the
  228. importsection to reduce the amount of .s files (PFV) }
  229. importssection^.concat(new(pai_section,init(sec_code)));
  230. {$IfDef GDB}
  231. if (cs_debuginfo in aktmoduleswitches) then
  232. importssection^.concat(new(pai_stab_function_name,init(nil)));
  233. {$EndIf GDB}
  234. importssection^.concat(new(pai_align,init_op(4,$90)));
  235. importssection^.concat(new(pai_symbol,init_global(hp2^.func^)));
  236. importssection^.concat(new(pai386,op_ref(A_JMP,S_NO,r)));
  237. end;
  238. { create head link }
  239. importssection^.concat(new(pai_section,init_idata(7)));
  240. importssection^.concat(new(pai_const,init_rva(strpnew(lab2str(lhead)))));
  241. { fixup }
  242. getlabel(plabel(hp2^.lab));
  243. importssection^.concat(new(pai_section,init_idata(4)));
  244. importssection^.concat(new(pai_const,init_rva(strpnew(lab2str(hp2^.lab)))));
  245. { add jump field to importsection }
  246. importssection^.concat(new(pai_section,init_idata(5)));
  247. if hp2^.is_var then
  248. importssection^.concat(new(pai_symbol,init_global(hp2^.func^)))
  249. else
  250. importssection^.concat(new(pai_label,init(lcode)));
  251. importssection^.concat(new(pai_const,init_rva(strpnew(lab2str(hp2^.lab)))));
  252. { finally the import information }
  253. importssection^.concat(new(pai_section,init_idata(6)));
  254. importssection^.concat(new(pai_label,init(hp2^.lab)));
  255. importssection^.concat(new(pai_const,init_16bit(hp2^.ordnr)));
  256. importssection^.concat(new(pai_string,init(hp2^.name^+#0)));
  257. hp2:=pimported_item(hp2^.next);
  258. end;
  259. hp1:=pimportlist(hp1^.next);
  260. end;
  261. end;
  262. procedure timportlibwin32.generatelib;
  263. var
  264. hp1 : pimportlist;
  265. hp2 : pimported_item;
  266. l1,l2,l3,l4 : plabel;
  267. r : preference;
  268. begin
  269. if (cs_smartlink in aktmoduleswitches) then
  270. begin
  271. generatesmartlib;
  272. exit;
  273. end;
  274. hp1:=pimportlist(current_module^.imports^.first);
  275. while assigned(hp1) do
  276. begin
  277. { Insert cuts for smartlinking }
  278. if (cs_smartlink in aktmoduleswitches) then
  279. begin
  280. importssection^.concat(new(pai_cut,init));
  281. codesegment^.concat(new(pai_cut,init));
  282. end;
  283. {$IfDef GDB}
  284. if (cs_debuginfo in aktmoduleswitches) then
  285. codesegment^.concat(new(pai_stab_function_name,init(nil)));
  286. {$EndIf GDB}
  287. { Get labels for the sections }
  288. getlabel(l1);
  289. getlabel(l2);
  290. getlabel(l3);
  291. importssection^.concat(new(pai_section,init_idata(2)));
  292. { pointer to procedure names }
  293. importssection^.concat(new(pai_const,init_rva(strpnew(lab2str(l2)))));
  294. { two empty entries follow }
  295. importssection^.concat(new(pai_const,init_32bit(0)));
  296. importssection^.concat(new(pai_const,init_32bit(0)));
  297. { pointer to dll name }
  298. importssection^.concat(new(pai_const,init_rva(strpnew(lab2str(l1)))));
  299. { pointer to fixups }
  300. importssection^.concat(new(pai_const,init_rva(strpnew(lab2str(l3)))));
  301. { only create one section for each else it will
  302. create a lot of idata* }
  303. { first write the name references }
  304. importssection^.concat(new(pai_section,init_idata(4)));
  305. importssection^.concat(new(pai_label,init(l2)));
  306. hp2:=pimported_item(hp1^.imported_items^.first);
  307. while assigned(hp2) do
  308. begin
  309. getlabel(plabel(hp2^.lab));
  310. importssection^.concat(new(pai_const,init_rva(strpnew(lab2str(hp2^.lab)))));
  311. hp2:=pimported_item(hp2^.next);
  312. end;
  313. { finalize the names ... }
  314. importssection^.concat(new(pai_const,init_32bit(0)));
  315. { then the addresses and create also the indirect jump }
  316. importssection^.concat(new(pai_section,init_idata(5)));
  317. importssection^.concat(new(pai_label,init(l3)));
  318. hp2:=pimported_item(hp1^.imported_items^.first);
  319. while assigned(hp2) do
  320. begin
  321. if not hp2^.is_var then
  322. begin
  323. getdatalabel(l4);
  324. { create indirect jump }
  325. new(r);
  326. reset_reference(r^);
  327. r^.symbol:=stringdup(lab2str(l4));
  328. { place jump in codesegment }
  329. codesegment^.concat(new(pai_align,init_op(4,$90)));
  330. codesegment^.concat(new(pai_symbol,init_global(hp2^.func^)));
  331. codesegment^.concat(new(pai386,op_ref(A_JMP,S_NO,r)));
  332. { add jump field to importsection }
  333. importssection^.concat(new(pai_label,init(l4)));
  334. end
  335. else
  336. begin
  337. importssection^.concat(new(pai_symbol,init_global(hp2^.func^)));
  338. end;
  339. importssection^.concat(new(pai_const,init_rva(strpnew(lab2str(hp2^.lab)))));
  340. hp2:=pimported_item(hp2^.next);
  341. end;
  342. { finalize the addresses }
  343. importssection^.concat(new(pai_const,init_32bit(0)));
  344. { finally the import information }
  345. importssection^.concat(new(pai_section,init_idata(6)));
  346. hp2:=pimported_item(hp1^.imported_items^.first);
  347. while assigned(hp2) do
  348. begin
  349. importssection^.concat(new(pai_label,init(hp2^.lab)));
  350. { the ordinal number }
  351. importssection^.concat(new(pai_const,init_16bit(hp2^.ordnr)));
  352. importssection^.concat(new(pai_string,init(hp2^.name^+#0)));
  353. hp2:=pimported_item(hp2^.next);
  354. end;
  355. { create import dll name }
  356. importssection^.concat(new(pai_section,init_idata(7)));
  357. importssection^.concat(new(pai_label,init(l1)));
  358. importssection^.concat(new(pai_string,init(hp1^.dllname^+target_os.sharedlibext+#0)));
  359. hp1:=pimportlist(hp1^.next);
  360. end;
  361. end;
  362. procedure texportlibwin32.preparelib(const s:string);
  363. begin
  364. if not(assigned(exportssection)) then
  365. exportssection:=new(paasmoutput,init);
  366. end;
  367. procedure texportlibwin32.generatelib;
  368. var
  369. ordinal_base,entries,named_entries : longint;
  370. l1,l2,l3,l4 : plabel;
  371. begin
  372. ordinal_base:=0;
  373. getlabel(l1);
  374. getlabel(l2);
  375. getlabel(l3);
  376. getlabel(l4);
  377. { export flags }
  378. exportssection^.concat(new(pai_const,init_32bit(0)));
  379. { date/time stamp }
  380. exportssection^.concat(new(pai_const,init_32bit(0)));
  381. { major version }
  382. exportssection^.concat(new(pai_const,init_16bit(0)));
  383. { minor version }
  384. exportssection^.concat(new(pai_const,init_16bit(0)));
  385. { pointer to dll name }
  386. importssection^.concat(new(pai_const,init_rva(strpnew(lab2str(l1)))));
  387. { ordinal base }
  388. exportssection^.concat(new(pai_const,init_32bit(0)));
  389. { number of entries }
  390. exportssection^.concat(new(pai_const,init_32bit(entries)));
  391. { number of named entries }
  392. exportssection^.concat(new(pai_const,init_32bit(named_entries)));
  393. { address of export address table }
  394. importssection^.concat(new(pai_const,init_rva(strpnew(lab2str(l2)))));
  395. { address of name pointer pointers }
  396. importssection^.concat(new(pai_const,init_rva(strpnew(lab2str(l3)))));
  397. { address of ordinal number pointers }
  398. importssection^.concat(new(pai_const,init_rva(strpnew(lab2str(l4)))));
  399. { the name }
  400. importssection^.concat(new(pai_label,init(l1)));
  401. importssection^.concat(new(pai_string,init(current_module^.modulename^+target_os.sharedlibext+#0)));
  402. end;
  403. procedure postprocessexecutable(n : string);
  404. var
  405. f : file;
  406. dosheader : tdosheader;
  407. peheader : tpeheader;
  408. peheaderpos : longint;
  409. begin
  410. { when -s is used quit, because there is no .exe }
  411. if cs_link_extern in aktglobalswitches then
  412. exit;
  413. { open file }
  414. assign(f,n);
  415. {$I-}
  416. reset(f,1);
  417. if ioresult<>0 then
  418. Message1(execinfo_f_cant_open_executable,n);
  419. { read headers }
  420. blockread(f,dosheader,sizeof(tdosheader));
  421. peheaderpos:=dosheader.e_lfanew;
  422. seek(f,peheaderpos);
  423. blockread(f,peheader,sizeof(tpeheader));
  424. { write info }
  425. Message1(execinfo_x_codesize,tostr(peheader.SizeOfCode));
  426. Message1(execinfo_x_initdatasize,tostr(peheader.SizeOfInitializedData));
  427. Message1(execinfo_x_uninitdatasize,tostr(peheader.SizeOfUninitializedData));
  428. Message1(execinfo_x_stackreserve,tostr(peheader.SizeOfStackReserve));
  429. Message1(execinfo_x_stackcommit,tostr(peheader.SizeOfStackCommit));
  430. { change the header }
  431. { sub system }
  432. { gui=2 }
  433. { cui=3 }
  434. if apptype=at_gui then
  435. peheader.Subsystem:=2
  436. else if apptype=at_cui then
  437. peheader.Subsystem:=3;
  438. seek(f,peheaderpos);
  439. blockwrite(f,peheader,sizeof(tpeheader));
  440. close(f);
  441. if ioresult<>0 then
  442. Message1(execinfo_f_cant_process_executable,n);
  443. {$I+}
  444. end;
  445. end.
  446. {
  447. $Log$
  448. Revision 1.14 1998-11-28 16:21:00 peter
  449. + support for dll variables
  450. Revision 1.13 1998/10/29 11:35:54 florian
  451. * some dll support for win32
  452. * fixed assembler writing for PalmOS
  453. Revision 1.12 1998/10/27 10:22:35 florian
  454. + First things for win32 export sections
  455. Revision 1.11 1998/10/22 17:54:09 florian
  456. + switch $APPTYPE for win32 added
  457. Revision 1.10 1998/10/22 15:18:51 florian
  458. + switch -vx for win32 added
  459. Revision 1.9 1998/10/19 15:41:03 peter
  460. * better splitname to support glib-1.1.dll alike names
  461. Revision 1.8 1998/09/07 18:33:35 peter
  462. + smartlinking for win95 imports
  463. Revision 1.7 1998/09/03 17:39:06 florian
  464. + better code for type conversation longint/dword to real type
  465. Revision 1.6 1998/08/10 14:50:38 peter
  466. + localswitches, moduleswitches, globalswitches splitting
  467. Revision 1.5 1998/06/10 10:43:18 peter
  468. * write also the .dll extension (needed for NT)
  469. Revision 1.4 1998/06/08 22:59:56 peter
  470. * smartlinking works for win32
  471. * some defines to exclude some compiler parts
  472. Revision 1.3 1998/06/04 23:52:06 peter
  473. * m68k compiles
  474. + .def file creation moved to gendef.pas so it could also be used
  475. for win32
  476. Revision 1.2 1998/05/06 18:36:55 peter
  477. * tai_section extended with code,data,bss sections and enumerated type
  478. * ident 'compiled by FPC' moved to pmodules
  479. * small fix for smartlink
  480. }