oglx.pas 13 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422
  1. {
  2. $Id$
  3. Copyright (c) 2002 by Daniel Mantione, Peter Vreman
  4. Contains the binary reader and writer for the linear executable
  5. format used by OS/2
  6. * This code was inspired by the NASM sources
  7. The Netwide Assembler is copyright (C) 1996 Simon Tatham and
  8. Julian Hall. All rights reserved.
  9. This program is free software; you can redistribute it and/or modify
  10. it under the terms of the GNU General Public License as published by
  11. the Free Software Foundation; either version 2 of the License, or
  12. (at your option) any later version.
  13. This program is distributed in the hope that it will be useful,
  14. but WITHOUT ANY WARRANTY; without even the implied warranty of
  15. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  16. GNU General Public License for more details.
  17. You should have received a copy of the GNU General Public License
  18. along with this program; if not, write to the Free Software
  19. Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  20. ****************************************************************************
  21. }
  22. unit oglx;
  23. {$i fpcdefs.inc}
  24. interface
  25. uses
  26. { common }
  27. cclasses,
  28. { target }
  29. systems,
  30. { assembler }
  31. cpubase,aasmbase,assemble,link,
  32. { output }
  33. ogbase,ogmap,ogcoff;
  34. { An LX executable is called a module; it can be either an executable
  35. or a DLL.
  36. A module consists of objects. In other executable formats, these
  37. are usually called sections.
  38. Objects consist of pages.
  39. The objects are numbered, numbers do not have any special meaning. The
  40. pages of the object are loaded into memory with the access rights specified
  41. the object table entry. (DM)}
  42. { For the operating system the object numbers have no special meaning.
  43. However, for Free Pascal generated executables, I define: (DM)}
  44. const code_object = 0;
  45. data_object = 1;
  46. bss_object = 2;
  47. stack_object = 3;
  48. heap_object = 4;
  49. type Tlxheader = packed record
  50. magic:word; {'LX'}
  51. byteorder:byte; {0 = little 1 = big endian.}
  52. wordorder:byte; {0 = little 1 = big endian.}
  53. format_level:cardinal; {Nothing else than LX level
  54. 0 has ever been defined.}
  55. cpu_type:word; {1 = 286, 2 = 386, 3 = 486,
  56. 4 = pentium.}
  57. os_type:word; {1 = OS/2, 2 = Windows,
  58. 3 = Siemens MS-Dos 4.0,
  59. 4 = Windows 386.}
  60. module_version:cardinal; {Version of executable,
  61. defined by user.}
  62. module_flags:cardinal; {Flags.}
  63. module_page_count:cardinal; {Amount of pages in module.}
  64. eip_object,eip:cardinal; {Initial EIP, object nr and
  65. offset within object.}
  66. esp_object,esp:cardinal; {Initial ESP, object nr and
  67. offset within object.}
  68. page_size,page_shift:cardinal; {Page size, in bytes and
  69. 1 << pageshift.}
  70. fixup_sect_size:cardinal;
  71. fixup_sect_checksum:cardinal;
  72. loader_sect_size:cardinal;
  73. loader_sect_chksum:cardinal;
  74. object_table_offset:cardinal; {Location of object table.}
  75. object_count:cardinal; {Amount of objects in module.}
  76. object_pagetable_ofs:cardinal; {Location of object page
  77. table.}
  78. object_iterpages_ofs:cardinal;
  79. resource_table_ofs:cardinal; {Location of resource table.}
  80. resource_count:cardinal; {Amount of resources in
  81. resource table.}
  82. resid_name_tbl_ofs:cardinal;
  83. entry_table_offset:cardinal;
  84. module_dir_offset:cardinal;
  85. module_dir_count:cardinal;
  86. fixup_pagetab_ofs:cardinal;
  87. fixup_recrab_ofs:cardinal;
  88. import_modtab_ofs:cardinal;
  89. import_modtab_count:cardinal;
  90. data_pages_offset:cardinal;
  91. preload_page_count:cardinal;
  92. nonresid_table_ofs:cardinal;
  93. nonresid_table_len:cardinal;
  94. nonresid_tbl_chksum:cardinal;
  95. auto_ds_object_no:cardinal; {Not used by OS/2.}
  96. debug_info_offset:cardinal;
  97. inst_preload_count:cardinal;
  98. inst_demand_count:cardinal;
  99. heapsize:cardinal; {Only used for 16-bit programs.}
  100. end;
  101. Tlxobject_flags = (ofreadable,ofwriteable,ofexecutable,ofresource,
  102. ofdiscardable,ofshared,ofpreload,ofinvalid,
  103. ofzerofilled);
  104. Tlxobject_flag_set = set of Tlxobject_flags;
  105. Tlxobject_table_entry = packed record
  106. virtual_size:cardinal;
  107. reloc_base_addr:cardinal;
  108. object_flags:Tlxobject_flag_set;
  109. page_table_index:cardinal;
  110. page_count:cardinal;
  111. reserved:cardinal;
  112. end;
  113. Tlxexeoutput = class(texeoutput)
  114. private
  115. { FCoffsyms,
  116. FCoffStrs : tdynamicarray;
  117. win32 : boolean;}
  118. nsects,
  119. nsyms,
  120. sympos : longint;
  121. procedure write_symbol(const name:string;strpos,value,section,typ,aux:longint);
  122. procedure write_symbols;
  123. protected
  124. function writedata:boolean;override;
  125. public
  126. constructor createos2;
  127. function newobjectinput:tobjectinput;override;
  128. procedure CalculateMemoryMap;override;
  129. procedure GenerateExecutable(const fn:string);override;
  130. end;
  131. Tlxlinker = class(tinternallinker)
  132. constructor create;override;
  133. end;
  134. implementation
  135. uses
  136. {$ifdef delphi}
  137. sysutils,
  138. {$else}
  139. strings,
  140. {$endif}
  141. cutils,verbose,
  142. globtype,globals,fmodule;
  143. {****************************************************************************
  144. tcoffexeoutput
  145. ****************************************************************************}
  146. constructor Tlxexeoutput.createos2;
  147. begin
  148. inherited create;
  149. end;
  150. function Tlxexeoutput.newobjectinput:tobjectinput;
  151. begin
  152. result:=tcoffobjectinput.createdjgpp;
  153. end;
  154. procedure Tlxexeoutput.write_symbol(const name:string;strpos,value,section,typ,aux:longint);
  155. { var
  156. sym : coffsymbol;}
  157. begin
  158. { FillChar(sym,sizeof(sym),0);
  159. if strpos=-1 then
  160. move(name[1],sym.name,length(name))
  161. else
  162. sym.strpos:=strpos;
  163. sym.value:=value;
  164. sym.section:=section;
  165. sym.typ:=typ;
  166. sym.aux:=aux;
  167. FWriter.write(sym,sizeof(sym));}
  168. end;
  169. procedure Tlxexeoutput.write_symbols;
  170. { var
  171. filename : string[18];
  172. sec : TSection;
  173. namestr : string[8];
  174. nameidx,
  175. value,
  176. sectionval,
  177. i : longint;
  178. globalval : byte;
  179. secrec : coffsectionrec;
  180. objdata : TAsmObjectData;
  181. p : tasmsymbol;
  182. s : string;}
  183. begin
  184. (* objdata:=TAsmObjectData(objdatalist.first);
  185. while assigned(objdata) do
  186. begin
  187. with tcoffobjectdata(objdata) do
  188. begin
  189. { The symbols used }
  190. p:=Tasmsymbol(symbols.First);
  191. while assigned(p) do
  192. begin
  193. if p.section=sec_common then
  194. sectionval:=sections[sec_bss].secsymidx
  195. else
  196. sectionval:=sections[p.section].secsymidx;
  197. if p.currbind=AB_LOCAL then
  198. globalval:=3
  199. else
  200. globalval:=2;
  201. { if local of global then set the section value to the address
  202. of the symbol }
  203. if p.currbind in [AB_LOCAL,AB_GLOBAL] then
  204. value:=p.address
  205. else
  206. value:=p.size;
  207. { symbolname }
  208. s:=p.name;
  209. if length(s)>8 then
  210. begin
  211. nameidx:=FCoffStrs.size+4;
  212. FCoffStrs.writestr(s);
  213. FCoffStrs.writestr(#0);
  214. end
  215. else
  216. begin
  217. nameidx:=-1;
  218. namestr:=s;
  219. end;
  220. write_symbol(namestr,nameidx,value,sectionval,globalval,0);
  221. p:=tasmsymbol(p.indexnext);
  222. end;
  223. end;
  224. objdata:=TAsmObjectData(objdata.next);
  225. end;*)
  226. end;
  227. procedure Tlxexeoutput.CalculateMemoryMap;
  228. { var
  229. objdata : TAsmObjectData;
  230. secsymidx,
  231. mempos,
  232. datapos : longint;
  233. sec : TSection;
  234. sym : tasmsymbol;
  235. s : TAsmSection;}
  236. begin
  237. (* { retrieve amount of sections }
  238. nsects:=0;
  239. secsymidx:=0;
  240. for sec:=low(TSection) to high(TSection) do
  241. begin
  242. if sections[sec].available then
  243. begin
  244. inc(nsects);
  245. inc(secsymidx);
  246. sections[sec].secsymidx:=secsymidx;
  247. end;
  248. end;
  249. { calculate start positions after the headers }
  250. datapos:=sizeof(coffheader)+sizeof(coffoptheader)+sizeof(coffsechdr)*nsects;
  251. mempos:=sizeof(coffheader)+sizeof(coffoptheader)+sizeof(coffsechdr)*nsects;
  252. if not win32 then
  253. inc(mempos,sizeof(go32v2stub)+$1000);
  254. { add sections }
  255. MapObjectdata(datapos,mempos);
  256. { end symbol }
  257. AddGlobalSym('_etext',sections[sec_code].mempos+sections[sec_code].memsize);
  258. AddGlobalSym('_edata',sections[sec_data].mempos+sections[sec_data].memsize);
  259. AddGlobalSym('end',mempos);
  260. { symbols }
  261. nsyms:=0;
  262. sympos:=0;
  263. if not(cs_link_strip in aktglobalswitches) then
  264. begin
  265. sympos:=datapos;
  266. objdata:=TAsmObjectData(objdatalist.first);
  267. while assigned(objdata) do
  268. begin
  269. inc(nsyms,objdata.symbols.count);
  270. objdata:=TAsmObjectData(objdata.next);
  271. end;
  272. end;*)
  273. end;
  274. function gen_section_header(sec:Tsection;obj:cardinal):Tlxobject_table_entry;
  275. virtual_size:cardinal;
  276. reloc_base_addr:cardinal;
  277. object_flags:Tlxobject_flag_set;
  278. page_table_index:cardinal;
  279. page_count:cardinal;
  280. reserved:cardinal;
  281. begin
  282. gen_section_header.virtual_size:=sections[sec.memsize];
  283. end;
  284. function Tlxexeoutput.writedata:boolean;
  285. var header:Tlxheader;
  286. hsym:Tasmsymbol;
  287. code_object_header,data_object_header,bss_object_header,stack_object_header,
  288. heap_object_header:Tlxobject_table_entry;
  289. begin
  290. result:=false;
  291. fillchar(header,sizeof(header),0);
  292. header.magic:=$584c; {'LX'}
  293. header.cpu_type:=2; {Intel 386}
  294. header.os_type:=1; {OS/2}
  295. {Set the initial EIP.}
  296. header.eip_object:=code_object;
  297. hsym:=tasmsymbol(globalsyms.search('start'));
  298. if not assigned(hsym) then
  299. begin
  300. comment(V_Error,'Entrypoint "start" not defined');
  301. exit;
  302. end;
  303. header.eip:=hsym.address-sections[sec_code].mempos;
  304. {Set the initial ESP.}
  305. header.esp_object:=stack_object;
  306. header.esp:=stacksize;
  307. Fwriter.write(header,sizeof(header));
  308. for sec:=low(Tsection) to high(Tsection) do
  309. if sections[sec].available then
  310. if not(sec in [sec_code,sec_data,sec_bss,sec_stab,sec_stabstr]) then
  311. begin
  312. result:=false;
  313. exit;
  314. end;
  315. code_object_header:=gen_section_header(sec_code,code_object);
  316. data_object_header:=gen_section_header(sec_data,data_object);
  317. bss_object_header:=gen_section_header(sec_bss,bss_object);
  318. result:=true;
  319. end;
  320. procedure Tlxexeoutput.GenerateExecutable(const fn:string);
  321. begin
  322. { AddGlobalSym('_etext',0);
  323. AddGlobalSym('_edata',0);
  324. AddGlobalSym('end',0);
  325. if not CalculateSymbols then
  326. exit;
  327. CalculateMemoryMap;
  328. FixupSymbols;
  329. FixupRelocations;
  330. writeexefile(fn);}
  331. end;
  332. {****************************************************************************
  333. TCoffLinker
  334. ****************************************************************************}
  335. constructor Tlxlinker.Create;
  336. begin
  337. inherited Create;
  338. exeoutput:=Tlxexeoutput.createos2;
  339. end;
  340. {*****************************************************************************
  341. Initialize
  342. *****************************************************************************}
  343. begin
  344. { RegisterAssembler(as_i386_coff_info,TCoffAssembler);
  345. RegisterAssembler(as_i386_pecoff_info,TPECoffAssembler);
  346. RegisterAssembler(as_i386_pecoffwdosx_info,TPECoffAssembler);
  347. RegisterLinker(ld_i386_coff,Tlxlinker);}
  348. end.
  349. {
  350. $Log$
  351. Revision 1.5 2002-09-07 15:25:05 peter
  352. * old logs removed and tabs fixed
  353. Revision 1.4 2002/08/12 15:08:40 carl
  354. + stab register indexes for powerpc (moved from gdb to cpubase)
  355. + tprocessor enumeration moved to cpuinfo
  356. + linker in target_info is now a class
  357. * many many updates for m68k (will soon start to compile)
  358. - removed some ifdef or correct them for correct cpu
  359. Revision 1.3 2002/07/14 18:00:44 daniel
  360. + Added the beginning of a state tracker. This will track the values of
  361. variables through procedures and optimize things away.
  362. Revision 1.2 2002/07/11 15:23:25 daniel
  363. * Continued work on LX header
  364. Revision 1.1 2002/07/08 19:22:22 daniel
  365. + OS/2 lx format support: Copied ogcoff and started to modify it
  366. }