ogomf.pas 48 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398
  1. {
  2. Copyright (c) 2015 by Nikolay Nikolov
  3. Contains the binary Relocatable Object Module Format (OMF) reader and writer
  4. This is the object format used on the i8086-msdos platform.
  5. This program is free software; you can redistribute it and/or modify
  6. it under the terms of the GNU General Public License as published by
  7. the Free Software Foundation; either version 2 of the License, or
  8. (at your option) any later version.
  9. This program is distributed in the hope that it will be useful,
  10. but WITHOUT ANY WARRANTY; without even the implied warranty of
  11. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  12. GNU General Public License for more details.
  13. You should have received a copy of the GNU General Public License
  14. along with this program; if not, write to the Free Software
  15. Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  16. ****************************************************************************
  17. }
  18. unit ogomf;
  19. {$i fpcdefs.inc}
  20. interface
  21. uses
  22. { common }
  23. cclasses,globtype,
  24. { target }
  25. systems,
  26. { assembler }
  27. cpuinfo,cpubase,aasmbase,assemble,link,
  28. { OMF definitions }
  29. omfbase,
  30. { output }
  31. ogbase,
  32. owbase;
  33. type
  34. { TOmfRelocation }
  35. TOmfRelocation = class(TObjRelocation)
  36. private
  37. FOmfFixup: TOmfSubRecord_FIXUP;
  38. function GetGroupIndex(const groupname: string): Integer;
  39. public
  40. constructor CreateSection(ADataOffset:aword;aobjsec:TObjSection;Atyp:TObjRelocationType);
  41. destructor Destroy; override;
  42. procedure BuildOmfFixup;
  43. property OmfFixup: TOmfSubRecord_FIXUP read FOmfFixup;
  44. end;
  45. { TOmfObjSection }
  46. TOmfObjSection = class(TObjSection)
  47. private
  48. FClassName: string;
  49. FOverlayName: string;
  50. FCombination: TOmfSegmentCombination;
  51. FUse: TOmfSegmentUse;
  52. FPrimaryGroup: string;
  53. function GetOmfAlignment: TOmfSegmentAlignment;
  54. public
  55. constructor create(AList:TFPHashObjectList;const Aname:string;Aalign:shortint;Aoptions:TObjSectionOptions);override;
  56. property ClassName: string read FClassName;
  57. property OverlayName: string read FOverlayName;
  58. property OmfAlignment: TOmfSegmentAlignment read GetOmfAlignment;
  59. property Combination: TOmfSegmentCombination read FCombination;
  60. property Use: TOmfSegmentUse read FUse;
  61. property PrimaryGroup: string read FPrimaryGroup;
  62. end;
  63. { TOmfObjData }
  64. TOmfObjData = class(TObjData)
  65. private
  66. class function CodeSectionName(const aname:string): string;
  67. public
  68. constructor create(const n:string);override;
  69. function sectiontype2align(atype:TAsmSectiontype):shortint;override;
  70. function sectionname(atype:TAsmSectiontype;const aname:string;aorder:TAsmSectionOrder):string;override;
  71. procedure writeReloc(Data:aint;len:aword;p:TObjSymbol;Reloctype:TObjRelocationType);override;
  72. end;
  73. { TOmfObjOutput }
  74. TOmfObjOutput = class(tObjOutput)
  75. private
  76. FLNames: TOmfOrderedNameCollection;
  77. FSegments: TFPHashObjectList;
  78. FGroups: TFPHashObjectList;
  79. procedure AddSegment(const name,segclass,ovlname: string;
  80. Alignment: TOmfSegmentAlignment; Combination: TOmfSegmentCombination;
  81. Use: TOmfSegmentUse; Size: aword);
  82. procedure AddGroup(const groupname: string; seglist: array of const);
  83. procedure AddGroup(const groupname: string; seglist: TSegmentList);
  84. procedure WriteSections(Data:TObjData);
  85. procedure WriteSectionContentAndFixups(sec: TObjSection);
  86. procedure section_count_sections(p:TObject;arg:pointer);
  87. procedure WritePUBDEFs(Data: TObjData);
  88. procedure WriteEXTDEFs(Data: TObjData);
  89. property LNames: TOmfOrderedNameCollection read FLNames;
  90. property Segments: TFPHashObjectList read FSegments;
  91. property Groups: TFPHashObjectList read FGroups;
  92. protected
  93. function writeData(Data:TObjData):boolean;override;
  94. public
  95. constructor create(AWriter:TObjectWriter);override;
  96. destructor Destroy;override;
  97. end;
  98. { TOmfObjInput }
  99. TOmfObjInput = class(TObjInput)
  100. private
  101. FLNames: TOmfOrderedNameCollection;
  102. FExtDefs: TFPHashObjectList;
  103. FRawRecord: TOmfRawRecord;
  104. function ReadLNames(RawRec: TOmfRawRecord): Boolean;
  105. function ReadSegDef(RawRec: TOmfRawRecord; objdata:TObjData): Boolean;
  106. function ReadGrpDef(RawRec: TOmfRawRecord; objdata:TObjData): Boolean;
  107. function ReadExtDef(RawRec: TOmfRawRecord; objdata:TObjData): Boolean;
  108. function ReadLEDataAndFixups(RawRec: TOmfRawRecord; objdata:TObjData): Boolean;
  109. property LNames: TOmfOrderedNameCollection read FLNames;
  110. property ExtDefs: TFPHashObjectList read FExtDefs;
  111. public
  112. constructor create;override;
  113. destructor destroy;override;
  114. class function CanReadObjData(AReader:TObjectreader):boolean;override;
  115. function ReadObjData(AReader:TObjectreader;out objdata:TObjData):boolean;override;
  116. end;
  117. { TMZExeRelocation }
  118. TMZExeRelocation = record
  119. offset: Word;
  120. segment: Word;
  121. end;
  122. TMZExeRelocations = array of TMZExeRelocation;
  123. TMZExeExtraHeaderData = array of Byte;
  124. { TMZExeHeader }
  125. TMZExeHeader = class
  126. private
  127. FChecksum: Word;
  128. FExtraHeaderData: TMZExeExtraHeaderData;
  129. FHeaderSizeAlignment: Integer;
  130. FInitialCS: Word;
  131. FInitialIP: Word;
  132. FInitialSP: Word;
  133. FInitialSS: Word;
  134. FLoadableImageSize: DWord;
  135. FMaxExtraParagraphs: Word;
  136. FMinExtraParagraphs: Word;
  137. FOverlayNumber: Word;
  138. FRelocations: TMZExeRelocations;
  139. procedure SetHeaderSizeAlignment(AValue: Integer);
  140. public
  141. constructor Create;
  142. procedure WriteTo(aWriter: TObjectWriter);
  143. property HeaderSizeAlignment: Integer read FHeaderSizeAlignment write SetHeaderSizeAlignment; {default=16, must be multiple of 16}
  144. property Relocations: TMZExeRelocations read FRelocations write FRelocations;
  145. property ExtraHeaderData: TMZExeExtraHeaderData read FExtraHeaderData write FExtraHeaderData;
  146. property LoadableImageSize: DWord read FLoadableImageSize write FLoadableImageSize;
  147. property MinExtraParagraphs: Word read FMinExtraParagraphs write FMinExtraParagraphs;
  148. property MaxExtraParagraphs: Word read FMaxExtraParagraphs write FMaxExtraParagraphs;
  149. property InitialSS: Word read FInitialSS write FInitialSS;
  150. property InitialSP: Word read FInitialSP write FInitialSP;
  151. property Checksum: Word read FChecksum write FChecksum;
  152. property InitialIP: Word read FInitialIP write FInitialIP;
  153. property InitialCS: Word read FInitialCS write FInitialCS;
  154. property OverlayNumber: Word read FOverlayNumber write FOverlayNumber;
  155. end;
  156. { TMZExeOutput }
  157. TMZExeOutput = class(TExeOutput)
  158. protected
  159. function writeData:boolean;override;
  160. public
  161. constructor create;override;
  162. end;
  163. TOmfAssembler = class(tinternalassembler)
  164. constructor create(smart:boolean);override;
  165. end;
  166. implementation
  167. uses
  168. SysUtils,
  169. cutils,verbose,globals,
  170. fmodule,aasmtai,aasmdata,
  171. ogmap,owomflib,
  172. version
  173. ;
  174. {****************************************************************************
  175. TOmfRelocation
  176. ****************************************************************************}
  177. function TOmfRelocation.GetGroupIndex(const groupname: string): Integer;
  178. begin
  179. if groupname='dgroup' then
  180. Result:=1
  181. else
  182. internalerror(2014040703);
  183. end;
  184. constructor TOmfRelocation.CreateSection(ADataOffset: aword; aobjsec: TObjSection; Atyp: TObjRelocationType);
  185. begin
  186. if not (Atyp in [RELOC_DGROUP,RELOC_DGROUPREL]) and not assigned(aobjsec) then
  187. internalerror(200603036);
  188. DataOffset:=ADataOffset;
  189. Symbol:=nil;
  190. OrgSize:=0;
  191. ObjSection:=aobjsec;
  192. ftype:=ord(Atyp);
  193. end;
  194. destructor TOmfRelocation.Destroy;
  195. begin
  196. FOmfFixup.Free;
  197. inherited Destroy;
  198. end;
  199. procedure TOmfRelocation.BuildOmfFixup;
  200. begin
  201. FreeAndNil(FOmfFixup);
  202. FOmfFixup:=TOmfSubRecord_FIXUP.Create;
  203. if ObjSection<>nil then
  204. begin
  205. FOmfFixup.LocationOffset:=DataOffset;
  206. if typ in [RELOC_ABSOLUTE,RELOC_RELATIVE] then
  207. FOmfFixup.LocationType:=fltOffset
  208. else if typ in [RELOC_SEG,RELOC_SEGREL] then
  209. FOmfFixup.LocationType:=fltBase
  210. else
  211. internalerror(2015041501);
  212. FOmfFixup.FrameDeterminedByThread:=False;
  213. FOmfFixup.TargetDeterminedByThread:=False;
  214. if typ in [RELOC_ABSOLUTE,RELOC_SEG] then
  215. FOmfFixup.Mode:=fmSegmentRelative
  216. else if typ in [RELOC_RELATIVE,RELOC_SEGREL] then
  217. FOmfFixup.Mode:=fmSelfRelative
  218. else
  219. internalerror(2015041401);
  220. if typ in [RELOC_ABSOLUTE,RELOC_RELATIVE] then
  221. begin
  222. FOmfFixup.TargetMethod:=ftmSegmentIndexNoDisp;
  223. FOmfFixup.TargetDatum:=ObjSection.Index;
  224. if TOmfObjSection(ObjSection).PrimaryGroup<>'' then
  225. begin
  226. FOmfFixup.FrameMethod:=ffmGroupIndex;
  227. FOmfFixup.FrameDatum:=GetGroupIndex(TOmfObjSection(ObjSection).PrimaryGroup);
  228. end
  229. else
  230. FOmfFixup.FrameMethod:=ffmTarget;
  231. end
  232. else
  233. begin
  234. FOmfFixup.FrameMethod:=ffmTarget;
  235. if TOmfObjSection(ObjSection).PrimaryGroup<>'' then
  236. begin
  237. FOmfFixup.TargetMethod:=ftmGroupIndexNoDisp;
  238. FOmfFixup.TargetDatum:=GetGroupIndex(TOmfObjSection(ObjSection).PrimaryGroup);
  239. end
  240. else
  241. begin
  242. FOmfFixup.TargetMethod:=ftmSegmentIndexNoDisp;
  243. FOmfFixup.TargetDatum:=ObjSection.Index;
  244. end;
  245. end;
  246. end
  247. else if symbol<>nil then
  248. begin
  249. FOmfFixup.LocationOffset:=DataOffset;
  250. if typ in [RELOC_ABSOLUTE,RELOC_RELATIVE] then
  251. FOmfFixup.LocationType:=fltOffset
  252. else if typ in [RELOC_SEG,RELOC_SEGREL] then
  253. FOmfFixup.LocationType:=fltBase
  254. else
  255. internalerror(2015041501);
  256. FOmfFixup.FrameDeterminedByThread:=False;
  257. FOmfFixup.TargetDeterminedByThread:=False;
  258. if typ in [RELOC_ABSOLUTE,RELOC_SEG] then
  259. FOmfFixup.Mode:=fmSegmentRelative
  260. else if typ in [RELOC_RELATIVE,RELOC_SEGREL] then
  261. FOmfFixup.Mode:=fmSelfRelative
  262. else
  263. internalerror(2015041401);
  264. FOmfFixup.TargetMethod:=ftmExternalIndexNoDisp;
  265. FOmfFixup.TargetDatum:=symbol.symidx;
  266. FOmfFixup.FrameMethod:=ffmTarget;
  267. end
  268. else if typ in [RELOC_DGROUP,RELOC_DGROUPREL] then
  269. begin
  270. FOmfFixup.LocationOffset:=DataOffset;
  271. FOmfFixup.LocationType:=fltBase;
  272. FOmfFixup.FrameDeterminedByThread:=False;
  273. FOmfFixup.TargetDeterminedByThread:=False;
  274. if typ=RELOC_DGROUP then
  275. FOmfFixup.Mode:=fmSegmentRelative
  276. else if typ=RELOC_DGROUPREL then
  277. FOmfFixup.Mode:=fmSelfRelative
  278. else
  279. internalerror(2015041401);
  280. FOmfFixup.FrameMethod:=ffmTarget;
  281. FOmfFixup.TargetMethod:=ftmGroupIndexNoDisp;
  282. FOmfFixup.TargetDatum:=GetGroupIndex('dgroup');
  283. end
  284. else
  285. internalerror(2015040702);
  286. end;
  287. {****************************************************************************
  288. TOmfObjSection
  289. ****************************************************************************}
  290. function TOmfObjSection.GetOmfAlignment: TOmfSegmentAlignment;
  291. begin
  292. case SecAlign of
  293. 1:
  294. result:=saRelocatableByteAligned;
  295. 2:
  296. result:=saRelocatableWordAligned;
  297. 4:
  298. result:=saRelocatableDWordAligned;
  299. 16:
  300. result:=saRelocatableParaAligned;
  301. else
  302. internalerror(2015041504);
  303. end;
  304. end;
  305. constructor TOmfObjSection.create(AList: TFPHashObjectList;
  306. const Aname: string; Aalign: shortint; Aoptions: TObjSectionOptions);
  307. var
  308. dgroup: Boolean;
  309. begin
  310. inherited create(AList, Aname, Aalign, Aoptions);
  311. FCombination:=scPublic;
  312. FUse:=suUse16;
  313. if oso_executable in Aoptions then
  314. begin
  315. FClassName:='code';
  316. dgroup:=(current_settings.x86memorymodel=mm_tiny);
  317. end
  318. else if Aname='stack' then
  319. begin
  320. FClassName:='stack';
  321. FCombination:=scStack;
  322. dgroup:=current_settings.x86memorymodel in (x86_near_data_models-[mm_tiny]);
  323. end
  324. else if Aname='heap' then
  325. begin
  326. FClassName:='heap';
  327. dgroup:=current_settings.x86memorymodel in x86_near_data_models;
  328. end
  329. else if Aname='bss' then
  330. begin
  331. FClassName:='bss';
  332. dgroup:=true;
  333. end
  334. else if Aname='data' then
  335. begin
  336. FClassName:='data';
  337. dgroup:=true;
  338. end
  339. else if (Aname='debug_frame') or
  340. (Aname='debug_info') or
  341. (Aname='debug_line') or
  342. (Aname='debug_abbrev') then
  343. begin
  344. FClassName:='DWARF';
  345. FUse:=suUse32;
  346. dgroup:=false;
  347. end
  348. else
  349. begin
  350. FClassName:='data';
  351. dgroup:=true;
  352. end;
  353. if dgroup then
  354. FPrimaryGroup:='dgroup'
  355. else
  356. FPrimaryGroup:='';
  357. end;
  358. {****************************************************************************
  359. TOmfObjData
  360. ****************************************************************************}
  361. class function TOmfObjData.CodeSectionName(const aname: string): string;
  362. begin
  363. {$ifdef i8086}
  364. if current_settings.x86memorymodel in x86_far_code_models then
  365. begin
  366. if cs_huge_code in current_settings.moduleswitches then
  367. result:=aname + '_TEXT'
  368. else
  369. result:=current_module.modulename^ + '_TEXT';
  370. end
  371. else
  372. {$endif}
  373. result:='text';
  374. end;
  375. constructor TOmfObjData.create(const n: string);
  376. begin
  377. inherited create(n);
  378. CObjSection:=TOmfObjSection;
  379. end;
  380. function TOmfObjData.sectiontype2align(atype: TAsmSectiontype): shortint;
  381. begin
  382. case atype of
  383. sec_stabstr:
  384. result:=1;
  385. sec_code:
  386. result:=1;
  387. sec_data,
  388. sec_rodata,
  389. sec_rodata_norel,
  390. sec_bss:
  391. result:=2;
  392. { For idata (at least idata2) it must be 4 bytes, because
  393. an entry is always (also in win64) 20 bytes and aligning
  394. on 8 bytes will insert 4 bytes between the entries resulting
  395. in a corrupt idata section.
  396. Same story with .pdata, it has 4-byte elements which should
  397. be packed without gaps. }
  398. sec_idata2,sec_idata4,sec_idata5,sec_idata6,sec_idata7,sec_pdata:
  399. result:=4;
  400. sec_debug_frame,sec_debug_info,sec_debug_line,sec_debug_abbrev:
  401. result:=4;
  402. sec_stack,
  403. sec_heap:
  404. result:=16;
  405. else
  406. result:=1;
  407. end;
  408. end;
  409. function TOmfObjData.sectionname(atype:TAsmSectiontype;const aname:string;aorder:TAsmSectionOrder):string;
  410. const
  411. secnames : array[TAsmSectiontype] of string[length('__DATA, __datacoal_nt,coalesced')] = ('','',
  412. 'text',
  413. 'data',
  414. 'data',
  415. 'rodata',
  416. 'bss',
  417. 'tbss',
  418. 'pdata',
  419. 'text','data','data','data','data',
  420. 'stab',
  421. 'stabstr',
  422. 'idata2','idata4','idata5','idata6','idata7','edata',
  423. 'eh_frame',
  424. 'debug_frame','debug_info','debug_line','debug_abbrev',
  425. 'fpc',
  426. '',
  427. 'init',
  428. 'fini',
  429. 'objc_class',
  430. 'objc_meta_class',
  431. 'objc_cat_cls_meth',
  432. 'objc_cat_inst_meth',
  433. 'objc_protocol',
  434. 'objc_string_object',
  435. 'objc_cls_meth',
  436. 'objc_inst_meth',
  437. 'objc_cls_refs',
  438. 'objc_message_refs',
  439. 'objc_symbols',
  440. 'objc_category',
  441. 'objc_class_vars',
  442. 'objc_instance_vars',
  443. 'objc_module_info',
  444. 'objc_class_names',
  445. 'objc_meth_var_types',
  446. 'objc_meth_var_names',
  447. 'objc_selector_strs',
  448. 'objc_protocol_ext',
  449. 'objc_class_ext',
  450. 'objc_property',
  451. 'objc_image_info',
  452. 'objc_cstring_object',
  453. 'objc_sel_fixup',
  454. '__DATA,__objc_data',
  455. '__DATA,__objc_const',
  456. 'objc_superrefs',
  457. '__DATA, __datacoal_nt,coalesced',
  458. 'objc_classlist',
  459. 'objc_nlclasslist',
  460. 'objc_catlist',
  461. 'obcj_nlcatlist',
  462. 'objc_protolist',
  463. 'stack',
  464. 'heap'
  465. );
  466. begin
  467. if (atype=sec_user) then
  468. Result:=aname
  469. else if secnames[atype]='text' then
  470. Result:=CodeSectionName(aname)
  471. else
  472. Result:=secnames[atype];
  473. end;
  474. procedure TOmfObjData.writeReloc(Data:aint;len:aword;p:TObjSymbol;Reloctype:TObjRelocationType);
  475. var
  476. objreloc: TOmfRelocation;
  477. symaddr: AWord;
  478. begin
  479. { RELOC_FARPTR = RELOC_ABSOLUTE+RELOC_SEG }
  480. if Reloctype=RELOC_FARPTR then
  481. begin
  482. if len<>4 then
  483. internalerror(2015041502);
  484. writeReloc(Data,2,p,RELOC_ABSOLUTE);
  485. writeReloc(0,2,p,RELOC_SEG);
  486. exit;
  487. end;
  488. if CurrObjSec=nil then
  489. internalerror(200403072);
  490. objreloc:=nil;
  491. if assigned(p) then
  492. begin
  493. { real address of the symbol }
  494. symaddr:=p.address;
  495. if p.bind=AB_EXTERNAL then
  496. begin
  497. objreloc:=TOmfRelocation.CreateSymbol(CurrObjSec.Size,p,Reloctype);
  498. CurrObjSec.ObjRelocations.Add(objreloc);
  499. end
  500. { relative relocations within the same section can be calculated directly,
  501. without the need to emit a relocation entry }
  502. else if (p.objsection=CurrObjSec) and
  503. (p.bind<>AB_COMMON) and
  504. (Reloctype=RELOC_RELATIVE) then
  505. begin
  506. data:=data+symaddr-len-CurrObjSec.Size;
  507. end
  508. else
  509. begin
  510. objreloc:=TOmfRelocation.CreateSection(CurrObjSec.Size,p.objsection,Reloctype);
  511. CurrObjSec.ObjRelocations.Add(objreloc);
  512. if not (Reloctype in [RELOC_SEG,RELOC_SEGREL]) then
  513. inc(data,symaddr);
  514. end;
  515. end
  516. else if Reloctype in [RELOC_DGROUP,RELOC_DGROUPREL] then
  517. begin
  518. objreloc:=TOmfRelocation.CreateSection(CurrObjSec.Size,nil,Reloctype);
  519. CurrObjSec.ObjRelocations.Add(objreloc);
  520. end;
  521. CurrObjSec.write(data,len);
  522. end;
  523. {****************************************************************************
  524. TOmfObjOutput
  525. ****************************************************************************}
  526. procedure TOmfObjOutput.AddSegment(const name, segclass, ovlname: string;
  527. Alignment: TOmfSegmentAlignment; Combination: TOmfSegmentCombination;
  528. Use: TOmfSegmentUse; Size: aword);
  529. var
  530. s: TOmfRecord_SEGDEF;
  531. begin
  532. s:=TOmfRecord_SEGDEF.Create;
  533. Segments.Add(name,s);
  534. s.SegmentNameIndex:=LNames.Add(name);
  535. s.ClassNameIndex:=LNames.Add(segclass);
  536. s.OverlayNameIndex:=LNames.Add(ovlname);
  537. s.Alignment:=Alignment;
  538. s.Combination:=Combination;
  539. s.Use:=Use;
  540. s.SegmentLength:=Size;
  541. end;
  542. procedure TOmfObjOutput.AddGroup(const groupname: string; seglist: array of const);
  543. var
  544. g: TOmfRecord_GRPDEF;
  545. I: Integer;
  546. SegListStr: TSegmentList;
  547. begin
  548. g:=TOmfRecord_GRPDEF.Create;
  549. Groups.Add(groupname,g);
  550. g.GroupNameIndex:=LNames.Add(groupname);
  551. SetLength(SegListStr,Length(seglist));
  552. for I:=0 to High(seglist) do
  553. begin
  554. case seglist[I].VType of
  555. vtString:
  556. SegListStr[I]:=Segments.FindIndexOf(seglist[I].VString^);
  557. vtAnsiString:
  558. SegListStr[I]:=Segments.FindIndexOf(AnsiString(seglist[I].VAnsiString));
  559. vtWideString:
  560. SegListStr[I]:=Segments.FindIndexOf(AnsiString(WideString(seglist[I].VWideString)));
  561. vtUnicodeString:
  562. SegListStr[I]:=Segments.FindIndexOf(AnsiString(UnicodeString(seglist[I].VUnicodeString)));
  563. else
  564. internalerror(2015040402);
  565. end;
  566. end;
  567. g.SegmentList:=SegListStr;
  568. end;
  569. procedure TOmfObjOutput.AddGroup(const groupname: string; seglist: TSegmentList);
  570. var
  571. g: TOmfRecord_GRPDEF;
  572. begin
  573. g:=TOmfRecord_GRPDEF.Create;
  574. Groups.Add(groupname,g);
  575. g.GroupNameIndex:=LNames.Add(groupname);
  576. g.SegmentList:=Copy(seglist);
  577. end;
  578. procedure TOmfObjOutput.WriteSections(Data: TObjData);
  579. var
  580. i:longint;
  581. sec:TObjSection;
  582. begin
  583. for i:=0 to Data.ObjSectionList.Count-1 do
  584. begin
  585. sec:=TObjSection(Data.ObjSectionList[i]);
  586. WriteSectionContentAndFixups(sec);
  587. end;
  588. end;
  589. procedure TOmfObjOutput.WriteSectionContentAndFixups(sec: TObjSection);
  590. const
  591. MaxChunkSize=$3fa;
  592. var
  593. RawRecord: TOmfRawRecord;
  594. ChunkStart,ChunkLen: DWord;
  595. ChunkFixupStart,ChunkFixupEnd: Integer;
  596. SegIndex: Integer;
  597. NextOfs: Integer;
  598. I: Integer;
  599. begin
  600. if (oso_data in sec.SecOptions) then
  601. begin
  602. if sec.Data=nil then
  603. internalerror(200403073);
  604. for I:=0 to sec.ObjRelocations.Count-1 do
  605. TOmfRelocation(sec.ObjRelocations[I]).BuildOmfFixup;
  606. SegIndex:=Segments.FindIndexOf(sec.Name);
  607. RawRecord:=TOmfRawRecord.Create;
  608. sec.data.seek(0);
  609. ChunkFixupStart:=0;
  610. ChunkFixupEnd:=-1;
  611. ChunkStart:=0;
  612. ChunkLen:=Min(MaxChunkSize, sec.Data.size-ChunkStart);
  613. while ChunkLen>0 do
  614. begin
  615. { find last fixup in the chunk }
  616. while (ChunkFixupEnd<(sec.ObjRelocations.Count-1)) and
  617. (TOmfRelocation(sec.ObjRelocations[ChunkFixupEnd+1]).DataOffset<(ChunkStart+ChunkLen)) do
  618. inc(ChunkFixupEnd);
  619. { check if last chunk is crossing the chunk boundary, and trim ChunkLen if necessary }
  620. if (ChunkFixupEnd>=ChunkFixupStart) and
  621. ((TOmfRelocation(sec.ObjRelocations[ChunkFixupEnd]).DataOffset+
  622. TOmfRelocation(sec.ObjRelocations[ChunkFixupEnd]).OmfFixup.LocationSize)>(ChunkStart+ChunkLen)) then
  623. begin
  624. ChunkLen:=TOmfRelocation(sec.ObjRelocations[ChunkFixupEnd]).DataOffset-ChunkStart;
  625. Dec(ChunkFixupEnd);
  626. end;
  627. { write LEDATA record }
  628. RawRecord.RecordType:=RT_LEDATA;
  629. NextOfs:=RawRecord.WriteIndexedRef(0,SegIndex);
  630. RawRecord.RawData[NextOfs]:=Byte(ChunkStart);
  631. RawRecord.RawData[NextOfs+1]:=Byte(ChunkStart shr 8);
  632. Inc(NextOfs,2);
  633. sec.data.read(RawRecord.RawData[NextOfs], ChunkLen);
  634. Inc(NextOfs, ChunkLen);
  635. RawRecord.RecordLength:=NextOfs+1;
  636. RawRecord.CalculateChecksumByte;
  637. RawRecord.WriteTo(FWriter);
  638. { write FIXUPP record }
  639. if ChunkFixupEnd>=ChunkFixupStart then
  640. begin
  641. RawRecord.RecordType:=RT_FIXUPP;
  642. NextOfs:=0;
  643. for I:=ChunkFixupStart to ChunkFixupEnd do
  644. begin
  645. TOmfRelocation(sec.ObjRelocations[I]).OmfFixup.DataRecordStartOffset:=ChunkStart;
  646. NextOfs:=TOmfRelocation(sec.ObjRelocations[I]).OmfFixup.WriteAt(RawRecord,NextOfs);
  647. end;
  648. RawRecord.RecordLength:=NextOfs+1;
  649. RawRecord.CalculateChecksumByte;
  650. RawRecord.WriteTo(FWriter);
  651. end;
  652. { prepare next chunk }
  653. Inc(ChunkStart, ChunkLen);
  654. ChunkLen:=Min(MaxChunkSize, sec.Data.size-ChunkStart);
  655. ChunkFixupStart:=ChunkFixupEnd+1;
  656. end;
  657. RawRecord.Free;
  658. end;
  659. end;
  660. procedure TOmfObjOutput.section_count_sections(p: TObject; arg: pointer);
  661. begin
  662. TOmfObjSection(p).index:=pinteger(arg)^;
  663. inc(pinteger(arg)^);
  664. end;
  665. procedure TOmfObjOutput.WritePUBDEFs(Data: TObjData);
  666. var
  667. PubNamesForSection: array of TFPHashObjectList;
  668. i: Integer;
  669. objsym: TObjSymbol;
  670. PublicNameElem: TOmfPublicNameElement;
  671. RawRecord: TOmfRawRecord;
  672. PubDefRec: TOmfRecord_PUBDEF;
  673. PrimaryGroupName: string;
  674. begin
  675. RawRecord:=TOmfRawRecord.Create;
  676. SetLength(PubNamesForSection,Data.ObjSectionList.Count);
  677. for i:=0 to Data.ObjSectionList.Count-1 do
  678. PubNamesForSection[i]:=TFPHashObjectList.Create;
  679. for i:=0 to Data.ObjSymbolList.Count-1 do
  680. begin
  681. objsym:=TObjSymbol(Data.ObjSymbolList[i]);
  682. if objsym.bind=AB_GLOBAL then
  683. begin
  684. PublicNameElem:=TOmfPublicNameElement.Create(PubNamesForSection[objsym.objsection.index-1],objsym.Name);
  685. PublicNameElem.PublicOffset:=objsym.offset;
  686. end;
  687. end;
  688. for i:=0 to Data.ObjSectionList.Count-1 do
  689. if PubNamesForSection[i].Count>0 then
  690. begin
  691. PubDefRec:=TOmfRecord_PUBDEF.Create;
  692. PubDefRec.BaseSegmentIndex:=i+1;
  693. PrimaryGroupName:=TOmfObjSection(Data.ObjSectionList[i]).PrimaryGroup;
  694. if PrimaryGroupName<>'' then
  695. PubDefRec.BaseGroupIndex:=Groups.FindIndexOf(PrimaryGroupName)
  696. else
  697. PubDefRec.BaseGroupIndex:=0;
  698. PubDefRec.PublicNames:=PubNamesForSection[i];
  699. while PubDefRec.NextIndex<PubDefRec.PublicNames.Count do
  700. begin
  701. PubDefRec.EncodeTo(RawRecord);
  702. RawRecord.WriteTo(FWriter);
  703. end;
  704. PubDefRec.Free;
  705. end;
  706. for i:=0 to Data.ObjSectionList.Count-1 do
  707. FreeAndNil(PubNamesForSection[i]);
  708. RawRecord.Free;
  709. end;
  710. procedure TOmfObjOutput.WriteEXTDEFs(Data: TObjData);
  711. var
  712. ExtNames: TFPHashObjectList;
  713. RawRecord: TOmfRawRecord;
  714. i,idx: Integer;
  715. objsym: TObjSymbol;
  716. ExternalNameElem: TOmfExternalNameElement;
  717. ExtDefRec: TOmfRecord_EXTDEF;
  718. begin
  719. ExtNames:=TFPHashObjectList.Create;
  720. RawRecord:=TOmfRawRecord.Create;
  721. idx:=1;
  722. for i:=0 to Data.ObjSymbolList.Count-1 do
  723. begin
  724. objsym:=TObjSymbol(Data.ObjSymbolList[i]);
  725. if objsym.bind=AB_EXTERNAL then
  726. begin
  727. ExternalNameElem:=TOmfExternalNameElement.Create(ExtNames,objsym.Name);
  728. objsym.symidx:=idx;
  729. Inc(idx);
  730. end;
  731. end;
  732. if ExtNames.Count>0 then
  733. begin
  734. ExtDefRec:=TOmfRecord_EXTDEF.Create;
  735. ExtDefRec.ExternalNames:=ExtNames;
  736. while ExtDefRec.NextIndex<ExtDefRec.ExternalNames.Count do
  737. begin
  738. ExtDefRec.EncodeTo(RawRecord);
  739. RawRecord.WriteTo(FWriter);
  740. end;
  741. ExtDefRec.Free;
  742. end;
  743. ExtNames.Free;
  744. RawRecord.Free;
  745. end;
  746. function TOmfObjOutput.writeData(Data:TObjData):boolean;
  747. var
  748. RawRecord: TOmfRawRecord;
  749. Header: TOmfRecord_THEADR;
  750. Translator_COMENT: TOmfRecord_COMENT;
  751. LinkPassSeparator_COMENT: TOmfRecord_COMENT;
  752. LNamesRec: TOmfRecord_LNAMES;
  753. ModEnd: TOmfRecord_MODEND;
  754. I: Integer;
  755. SegDef: TOmfRecord_SEGDEF;
  756. GrpDef: TOmfRecord_GRPDEF;
  757. DGroupSegments: TSegmentList;
  758. nsections: Integer;
  759. begin
  760. { calc amount of sections we have and set their index, starting with 1 }
  761. nsections:=1;
  762. data.ObjSectionList.ForEachCall(@section_count_sections,@nsections);
  763. { maximum amount of sections supported in the omf format is $7fff }
  764. if (nsections-1)>$7fff then
  765. internalerror(2015040701);
  766. { write header record }
  767. RawRecord:=TOmfRawRecord.Create;
  768. Header:=TOmfRecord_THEADR.Create;
  769. Header.ModuleName:=Data.Name;
  770. Header.EncodeTo(RawRecord);
  771. RawRecord.WriteTo(FWriter);
  772. Header.Free;
  773. { write translator COMENT header }
  774. Translator_COMENT:=TOmfRecord_COMENT.Create;
  775. Translator_COMENT.CommentClass:=CC_Translator;
  776. Translator_COMENT.CommentString:='FPC '+full_version_string+
  777. ' ['+date_string+'] for '+target_cpu_string+' - '+target_info.shortname;
  778. Translator_COMENT.EncodeTo(RawRecord);
  779. RawRecord.WriteTo(FWriter);
  780. Translator_COMENT.Free;
  781. LNames.Clear;
  782. LNames.Add(''); { insert an empty string, which has index 1 }
  783. FSegments.Clear;
  784. FSegments.Add('',nil);
  785. FGroups.Clear;
  786. FGroups.Add('',nil);
  787. for i:=0 to Data.ObjSectionList.Count-1 do
  788. with TOmfObjSection(Data.ObjSectionList[I]) do
  789. AddSegment(Name,ClassName,OverlayName,OmfAlignment,Combination,Use,Size);
  790. { create group "dgroup" }
  791. SetLength(DGroupSegments,0);
  792. for i:=0 to Data.ObjSectionList.Count-1 do
  793. with TOmfObjSection(Data.ObjSectionList[I]) do
  794. if PrimaryGroup='dgroup' then
  795. begin
  796. SetLength(DGroupSegments,Length(DGroupSegments)+1);
  797. DGroupSegments[High(DGroupSegments)]:=index;
  798. end;
  799. AddGroup('dgroup',DGroupSegments);
  800. { write LNAMES record(s) }
  801. LNamesRec:=TOmfRecord_LNAMES.Create;
  802. LNamesRec.Names:=LNames;
  803. while LNamesRec.NextIndex<=LNames.Count do
  804. begin
  805. LNamesRec.EncodeTo(RawRecord);
  806. RawRecord.WriteTo(FWriter);
  807. end;
  808. LNamesRec.Free;
  809. { write SEGDEF record(s) }
  810. for I:=1 to Segments.Count-1 do
  811. begin
  812. SegDef:=TOmfRecord_SEGDEF(Segments[I]);
  813. SegDef.EncodeTo(RawRecord);
  814. RawRecord.WriteTo(FWriter);
  815. end;
  816. { write GRPDEF record(s) }
  817. for I:=1 to Groups.Count-1 do
  818. begin
  819. GrpDef:=TOmfRecord_GRPDEF(Groups[I]);
  820. GrpDef.EncodeTo(RawRecord);
  821. RawRecord.WriteTo(FWriter);
  822. end;
  823. { write PUBDEF record(s) }
  824. WritePUBDEFs(Data);
  825. { write EXTDEF record(s) }
  826. WriteEXTDEFs(Data);
  827. { write link pass separator }
  828. LinkPassSeparator_COMENT:=TOmfRecord_COMENT.Create;
  829. LinkPassSeparator_COMENT.CommentClass:=CC_LinkPassSeparator;
  830. LinkPassSeparator_COMENT.CommentString:=#1;
  831. LinkPassSeparator_COMENT.NoList:=True;
  832. LinkPassSeparator_COMENT.EncodeTo(RawRecord);
  833. RawRecord.WriteTo(FWriter);
  834. LinkPassSeparator_COMENT.Free;
  835. { write section content, interleaved with fixups }
  836. WriteSections(Data);
  837. { write MODEND record }
  838. ModEnd:=TOmfRecord_MODEND.Create;
  839. ModEnd.EncodeTo(RawRecord);
  840. RawRecord.WriteTo(FWriter);
  841. ModEnd.Free;
  842. RawRecord.Free;
  843. result:=true;
  844. end;
  845. constructor TOmfObjOutput.create(AWriter:TObjectWriter);
  846. begin
  847. inherited create(AWriter);
  848. cobjdata:=TOmfObjData;
  849. FLNames:=TOmfOrderedNameCollection.Create;
  850. FSegments:=TFPHashObjectList.Create;
  851. FSegments.Add('',nil);
  852. FGroups:=TFPHashObjectList.Create;
  853. FGroups.Add('',nil);
  854. end;
  855. destructor TOmfObjOutput.Destroy;
  856. begin
  857. FGroups.Free;
  858. FSegments.Free;
  859. FLNames.Free;
  860. inherited Destroy;
  861. end;
  862. {****************************************************************************
  863. TOmfObjInput
  864. ****************************************************************************}
  865. function TOmfObjInput.ReadLNames(RawRec: TOmfRawRecord): Boolean;
  866. var
  867. LNamesRec: TOmfRecord_LNAMES;
  868. begin
  869. Result:=False;
  870. LNamesRec:=TOmfRecord_LNAMES.Create;
  871. LNamesRec.Names:=LNames;
  872. LNamesRec.DecodeFrom(RawRec);
  873. LNamesRec.Free;
  874. Result:=True;
  875. end;
  876. function TOmfObjInput.ReadSegDef(RawRec: TOmfRawRecord; objdata: TObjData): Boolean;
  877. var
  878. SegDefRec: TOmfRecord_SEGDEF;
  879. SegmentName,SegClassName,OverlayName: string;
  880. SecAlign: ShortInt;
  881. secoptions: TObjSectionOptions;
  882. objsec: TOmfObjSection;
  883. begin
  884. Result:=False;
  885. SegDefRec:=TOmfRecord_SEGDEF.Create;
  886. SegDefRec.DecodeFrom(RawRec);
  887. if (SegDefRec.SegmentNameIndex<1) or (SegDefRec.SegmentNameIndex>LNames.Count) then
  888. begin
  889. InputError('Segment name index out of range');
  890. SegDefRec.Free;
  891. exit;
  892. end;
  893. SegmentName:=LNames[SegDefRec.SegmentNameIndex];
  894. if (SegDefRec.ClassNameIndex<1) or (SegDefRec.ClassNameIndex>LNames.Count) then
  895. begin
  896. InputError('Segment class name index out of range');
  897. SegDefRec.Free;
  898. exit;
  899. end;
  900. SegClassName:=LNames[SegDefRec.ClassNameIndex];
  901. if (SegDefRec.OverlayNameIndex<1) or (SegDefRec.OverlayNameIndex>LNames.Count) then
  902. begin
  903. InputError('Segment overlay name index out of range');
  904. SegDefRec.Free;
  905. exit;
  906. end;
  907. OverlayName:=LNames[SegDefRec.OverlayNameIndex];
  908. case SegDefRec.Alignment of
  909. saRelocatableByteAligned:
  910. SecAlign:=1;
  911. saRelocatableWordAligned:
  912. SecAlign:=2;
  913. saRelocatableParaAligned:
  914. SecAlign:=16;
  915. saRelocatableDWordAligned:
  916. SecAlign:=4;
  917. saRelocatablePageAligned:
  918. begin
  919. InputError('Page segment alignment not supported');
  920. SegDefRec.Free;
  921. exit;
  922. end;
  923. saAbsolute:
  924. begin
  925. InputError('Absolute segment alignment not supported');
  926. SegDefRec.Free;
  927. exit;
  928. end;
  929. saNotSupported,
  930. saNotDefined:
  931. begin
  932. InputError('Invalid (unsupported/undefined) OMF segment alignment');
  933. SegDefRec.Free;
  934. exit;
  935. end;
  936. end;
  937. secoptions:=[];
  938. objsec:=TOmfObjSection(objdata.createsection(SegmentName,SecAlign,secoptions,false));
  939. objsec.FClassName:=SegClassName;
  940. objsec.FOverlayName:=OverlayName;
  941. objsec.FCombination:=SegDefRec.Combination;
  942. objsec.FUse:=SegDefRec.Use;
  943. if SegDefRec.SegmentLength>High(objsec.Size) then
  944. begin
  945. InputError('Segment too large');
  946. SegDefRec.Free;
  947. exit;
  948. end;
  949. objsec.Size:=SegDefRec.SegmentLength;
  950. SegDefRec.Free;
  951. Result:=True;
  952. end;
  953. function TOmfObjInput.ReadGrpDef(RawRec: TOmfRawRecord; objdata: TObjData): Boolean;
  954. var
  955. GrpDefRec: TOmfRecord_GRPDEF;
  956. GroupName: string;
  957. SecGroup: TObjSectionGroup;
  958. i,SegIndex: Integer;
  959. begin
  960. Result:=False;
  961. GrpDefRec:=TOmfRecord_GRPDEF.Create;
  962. GrpDefRec.DecodeFrom(RawRec);
  963. if (GrpDefRec.GroupNameIndex<1) or (GrpDefRec.GroupNameIndex>LNames.Count) then
  964. begin
  965. InputError('Group name index out of range');
  966. GrpDefRec.Free;
  967. exit;
  968. end;
  969. GroupName:=LNames[GrpDefRec.GroupNameIndex];
  970. SecGroup:=objdata.createsectiongroup(GroupName);
  971. SetLength(SecGroup.members,Length(GrpDefRec.SegmentList));
  972. for i:=0 to Length(GrpDefRec.SegmentList)-1 do
  973. begin
  974. SegIndex:=GrpDefRec.SegmentList[i];
  975. if (SegIndex<1) or (SegIndex>objdata.ObjSectionList.Count) then
  976. begin
  977. InputError('Segment name index out of range in group definition');
  978. GrpDefRec.Free;
  979. exit;
  980. end;
  981. SecGroup.members[i]:=TOmfObjSection(objdata.ObjSectionList[SegIndex-1]);
  982. end;
  983. GrpDefRec.Free;
  984. Result:=True;
  985. end;
  986. function TOmfObjInput.ReadExtDef(RawRec: TOmfRawRecord; objdata: TObjData): Boolean;
  987. var
  988. ExtDefRec: TOmfRecord_EXTDEF;
  989. ExtDefElem: TOmfExternalNameElement;
  990. OldCount,NewCount,i: Integer;
  991. objsym: TObjSymbol;
  992. begin
  993. Result:=False;
  994. ExtDefRec:=TOmfRecord_EXTDEF.Create;
  995. ExtDefRec.ExternalNames:=ExtDefs;
  996. OldCount:=ExtDefs.Count;
  997. ExtDefRec.DecodeFrom(RawRec);
  998. NewCount:=ExtDefs.Count;
  999. for i:=OldCount to NewCount-1 do
  1000. begin
  1001. ExtDefElem:=TOmfExternalNameElement(ExtDefs[i]);
  1002. objsym:=objdata.CreateSymbol(ExtDefElem.Name);
  1003. objsym.bind:=AB_EXTERNAL;
  1004. objsym.typ:=AT_FUNCTION;
  1005. objsym.objsection:=nil;
  1006. objsym.offset:=0;
  1007. objsym.size:=0;
  1008. end;
  1009. Result:=True;
  1010. end;
  1011. function TOmfObjInput.ReadLEDataAndFixups(RawRec: TOmfRawRecord; objdata: TObjData): Boolean;
  1012. var
  1013. Is32Bit: Boolean;
  1014. NextOfs: Integer;
  1015. SegmentIndex: Integer;
  1016. EnumeratedDataOffset: DWord;
  1017. BlockLength: Integer;
  1018. objsec: TOmfObjSection;
  1019. begin
  1020. Result:=False;
  1021. if not (RawRec.RecordType in [RT_LEDATA,RT_LEDATA32]) then
  1022. internalerror(2015040301);
  1023. Is32Bit:=RawRec.RecordType=RT_LEDATA32;
  1024. NextOfs:=RawRec.ReadIndexedRef(0,SegmentIndex);
  1025. if Is32Bit then
  1026. begin
  1027. if (NextOfs+3)>=RawRec.RecordLength then
  1028. internalerror(2015040504);
  1029. EnumeratedDataOffset := RawRec.RawData[NextOfs]+
  1030. (RawRec.RawData[NextOfs+1] shl 8)+
  1031. (RawRec.RawData[NextOfs+2] shl 16)+
  1032. (RawRec.RawData[NextOfs+3] shl 24);
  1033. Inc(NextOfs,4);
  1034. end
  1035. else
  1036. begin
  1037. if (NextOfs+1)>=RawRec.RecordLength then
  1038. internalerror(2015040504);
  1039. EnumeratedDataOffset := RawRec.RawData[NextOfs]+
  1040. (RawRec.RawData[NextOfs+1] shl 8);
  1041. Inc(NextOfs,2);
  1042. end;
  1043. BlockLength:=RawRec.RecordLength-NextOfs-1;
  1044. if BlockLength<0 then
  1045. internalerror(2015060501);
  1046. if BlockLength>1024 then
  1047. begin
  1048. InputError('LEDATA contains more than 1024 bytes of data');
  1049. exit;
  1050. end;
  1051. if (SegmentIndex<1) or (SegmentIndex>objdata.ObjSectionList.Count) then
  1052. begin
  1053. InputError('Segment index in LEDATA field is out of range');
  1054. exit;
  1055. end;
  1056. objsec:=TOmfObjSection(objdata.ObjSectionList[SegmentIndex-1]);
  1057. objsec.SecOptions:=objsec.SecOptions+[oso_Data];
  1058. if (objsec.Data.Size<>EnumeratedDataOffset) then
  1059. begin
  1060. InputError('LEDATA enumerated data offset field out of sequence');
  1061. exit;
  1062. end;
  1063. if (EnumeratedDataOffset+BlockLength)>objsec.Size then
  1064. begin
  1065. InputError('LEDATA goes beyond the segment size declared in the SEGDEF record');
  1066. exit;
  1067. end;
  1068. objsec.Data.write(RawRec.RawData[NextOfs],BlockLength);
  1069. {todo: read also the FIXUPP record that may follow}
  1070. Result:=True;
  1071. end;
  1072. constructor TOmfObjInput.create;
  1073. begin
  1074. inherited create;
  1075. cobjdata:=TOmfObjData;
  1076. FLNames:=TOmfOrderedNameCollection.Create;
  1077. FExtDefs:=TFPHashObjectList.Create;
  1078. FRawRecord:=TOmfRawRecord.Create;
  1079. end;
  1080. destructor TOmfObjInput.destroy;
  1081. begin
  1082. FRawRecord.Free;
  1083. FExtDefs.Free;
  1084. FLNames.Free;
  1085. inherited destroy;
  1086. end;
  1087. class function TOmfObjInput.CanReadObjData(AReader: TObjectreader): boolean;
  1088. var
  1089. b: Byte;
  1090. begin
  1091. result:=false;
  1092. if AReader.Read(b,sizeof(b)) then
  1093. begin
  1094. if b=RT_THEADR then
  1095. { TODO: check additional fields }
  1096. result:=true;
  1097. end;
  1098. AReader.Seek(0);
  1099. end;
  1100. function TOmfObjInput.ReadObjData(AReader: TObjectreader; out objdata: TObjData): boolean;
  1101. begin
  1102. FReader:=AReader;
  1103. InputFileName:=AReader.FileName;
  1104. objdata:=CObjData.Create(InputFileName);
  1105. result:=false;
  1106. LNames.Clear;
  1107. ExtDefs.Clear;
  1108. FRawRecord.ReadFrom(FReader);
  1109. if not FRawRecord.VerifyChecksumByte then
  1110. begin
  1111. InputError('Invalid checksum in OMF record');
  1112. exit;
  1113. end;
  1114. if FRawRecord.RecordType<>RT_THEADR then
  1115. begin
  1116. InputError('Can''t read OMF header');
  1117. exit;
  1118. end;
  1119. repeat
  1120. FRawRecord.ReadFrom(FReader);
  1121. if not FRawRecord.VerifyChecksumByte then
  1122. begin
  1123. InputError('Invalid checksum in OMF record');
  1124. exit;
  1125. end;
  1126. case FRawRecord.RecordType of
  1127. RT_LNAMES:
  1128. if not ReadLNames(FRawRecord) then
  1129. exit;
  1130. RT_SEGDEF,RT_SEGDEF32:
  1131. if not ReadSegDef(FRawRecord,objdata) then
  1132. exit;
  1133. RT_GRPDEF:
  1134. if not ReadGrpDef(FRawRecord,objdata) then
  1135. exit;
  1136. RT_COMENT:
  1137. begin
  1138. {todo}
  1139. end;
  1140. RT_EXTDEF:
  1141. if not ReadExtDef(FRawRecord,objdata) then
  1142. exit;
  1143. RT_PUBDEF,RT_PUBDEF32:
  1144. begin
  1145. {todo}
  1146. end;
  1147. RT_LEDATA,RT_LEDATA32:
  1148. if not ReadLEDataAndFixups(FRawRecord,objdata) then
  1149. exit;
  1150. RT_FIXUPP,RT_FIXUPP32:
  1151. begin
  1152. {todo}
  1153. end;
  1154. RT_MODEND,RT_MODEND32:
  1155. begin
  1156. {todo}
  1157. end;
  1158. else
  1159. begin
  1160. InputError('Unsupported OMF record type $'+HexStr(FRawRecord.RecordType,2));
  1161. exit;
  1162. end;
  1163. end;
  1164. until FRawRecord.RecordType in [RT_MODEND,RT_MODEND32];
  1165. end;
  1166. {****************************************************************************
  1167. TMZExeHeader
  1168. ****************************************************************************}
  1169. procedure TMZExeHeader.SetHeaderSizeAlignment(AValue: Integer);
  1170. begin
  1171. if (AValue<16) or ((AValue mod 16) <> 0) then
  1172. Internalerror(2015060601);
  1173. FHeaderSizeAlignment:=AValue;
  1174. end;
  1175. constructor TMZExeHeader.Create;
  1176. begin
  1177. FHeaderSizeAlignment:=16;
  1178. end;
  1179. procedure TMZExeHeader.WriteTo(aWriter: TObjectWriter);
  1180. var
  1181. NumRelocs: Word;
  1182. HeaderSizeInBytes: DWord;
  1183. HeaderParagraphs: Word;
  1184. RelocTableOffset: Word;
  1185. BytesInLastBlock: Word;
  1186. BlocksInFile: Word;
  1187. HeaderBytes: array [0..$1B] of Byte;
  1188. RelocBytes: array [0..3] of Byte;
  1189. TotalExeSize: DWord;
  1190. i: Integer;
  1191. begin
  1192. NumRelocs:=Length(Relocations);
  1193. RelocTableOffset:=$1C+Length(ExtraHeaderData);
  1194. HeaderSizeInBytes:=Align(RelocTableOffset+4*NumRelocs,16);
  1195. HeaderParagraphs:=HeaderSizeInBytes div 16;
  1196. TotalExeSize:=HeaderSizeInBytes+LoadableImageSize;
  1197. BlocksInFile:=(TotalExeSize+511) div 512;
  1198. BytesInLastBlock:=TotalExeSize mod 512;
  1199. HeaderBytes[$00]:=$4D; { 'M' }
  1200. HeaderBytes[$01]:=$5A; { 'Z' }
  1201. HeaderBytes[$02]:=Byte(BytesInLastBlock);
  1202. HeaderBytes[$03]:=Byte(BytesInLastBlock shr 8);
  1203. HeaderBytes[$04]:=Byte(BlocksInFile);
  1204. HeaderBytes[$05]:=Byte(BlocksInFile shr 8);
  1205. HeaderBytes[$06]:=Byte(NumRelocs);
  1206. HeaderBytes[$07]:=Byte(NumRelocs shr 8);
  1207. HeaderBytes[$08]:=Byte(HeaderParagraphs);
  1208. HeaderBytes[$09]:=Byte(HeaderParagraphs shr 8);
  1209. HeaderBytes[$0A]:=Byte(MinExtraParagraphs);
  1210. HeaderBytes[$0B]:=Byte(MinExtraParagraphs shr 8);
  1211. HeaderBytes[$0C]:=Byte(MaxExtraParagraphs);
  1212. HeaderBytes[$0D]:=Byte(MaxExtraParagraphs shr 8);
  1213. HeaderBytes[$0E]:=Byte(InitialSS);
  1214. HeaderBytes[$0F]:=Byte(InitialSS shr 8);
  1215. HeaderBytes[$10]:=Byte(InitialSP);
  1216. HeaderBytes[$11]:=Byte(InitialSP shr 8);
  1217. HeaderBytes[$12]:=Byte(Checksum);
  1218. HeaderBytes[$13]:=Byte(Checksum shr 8);
  1219. HeaderBytes[$14]:=Byte(InitialIP);
  1220. HeaderBytes[$15]:=Byte(InitialIP shr 8);
  1221. HeaderBytes[$16]:=Byte(InitialCS);
  1222. HeaderBytes[$17]:=Byte(InitialCS shr 8);
  1223. HeaderBytes[$18]:=Byte(RelocTableOffset);
  1224. HeaderBytes[$19]:=Byte(RelocTableOffset shr 8);
  1225. HeaderBytes[$1A]:=Byte(OverlayNumber);
  1226. HeaderBytes[$1B]:=Byte(OverlayNumber shr 8);
  1227. aWriter.write(HeaderBytes[0],$1C);
  1228. aWriter.write(ExtraHeaderData[0],Length(ExtraHeaderData));
  1229. for i:=0 to NumRelocs-1 do
  1230. with Relocations[i] do
  1231. begin
  1232. RelocBytes[0]:=Byte(offset);
  1233. RelocBytes[1]:=Byte(offset shr 8);
  1234. RelocBytes[2]:=Byte(segment);
  1235. RelocBytes[3]:=Byte(segment shr 8);
  1236. aWriter.write(RelocBytes[0],4);
  1237. end;
  1238. { pad with zeros until the end of header (paragraph aligned) }
  1239. aWriter.WriteZeros(HeaderSizeInBytes-aWriter.Size);
  1240. end;
  1241. {****************************************************************************
  1242. TMZExeOutput
  1243. ****************************************************************************}
  1244. function TMZExeOutput.writeData: boolean;
  1245. var
  1246. Header: TMZExeHeader;
  1247. begin
  1248. Result:=False;
  1249. Header:=TMZExeHeader.Create;
  1250. {todo: fill header data}
  1251. Header.WriteTo(FWriter);
  1252. Header.Free;
  1253. Result:=True;
  1254. end;
  1255. constructor TMZExeOutput.create;
  1256. begin
  1257. inherited create;
  1258. CObjData:=TOmfObjData;
  1259. end;
  1260. {****************************************************************************
  1261. TOmfAssembler
  1262. ****************************************************************************}
  1263. constructor TOmfAssembler.Create(smart:boolean);
  1264. begin
  1265. inherited Create(smart);
  1266. CObjOutput:=TOmfObjOutput;
  1267. CInternalAr:=TOmfLibObjectWriter;
  1268. end;
  1269. {*****************************************************************************
  1270. Initialize
  1271. *****************************************************************************}
  1272. {$ifdef i8086}
  1273. const
  1274. as_i8086_omf_info : tasminfo =
  1275. (
  1276. id : as_i8086_omf;
  1277. idtxt : 'OMF';
  1278. asmbin : '';
  1279. asmcmd : '';
  1280. supported_targets : [system_i8086_msdos];
  1281. flags : [af_outputbinary,af_no_debug];
  1282. labelprefix : '..@';
  1283. comment : '; ';
  1284. dollarsign: '$';
  1285. );
  1286. {$endif i8086}
  1287. initialization
  1288. {$ifdef i8086}
  1289. RegisterAssembler(as_i8086_omf_info,TOmfAssembler);
  1290. {$endif i8086}
  1291. end.