ogomf.pas 48 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399
  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. SecAlign:=1; // otherwise warning prohibits compilation
  909. case SegDefRec.Alignment of
  910. saRelocatableByteAligned:
  911. SecAlign:=1;
  912. saRelocatableWordAligned:
  913. SecAlign:=2;
  914. saRelocatableParaAligned:
  915. SecAlign:=16;
  916. saRelocatableDWordAligned:
  917. SecAlign:=4;
  918. saRelocatablePageAligned:
  919. begin
  920. InputError('Page segment alignment not supported');
  921. SegDefRec.Free;
  922. exit;
  923. end;
  924. saAbsolute:
  925. begin
  926. InputError('Absolute segment alignment not supported');
  927. SegDefRec.Free;
  928. exit;
  929. end;
  930. saNotSupported,
  931. saNotDefined:
  932. begin
  933. InputError('Invalid (unsupported/undefined) OMF segment alignment');
  934. SegDefRec.Free;
  935. exit;
  936. end;
  937. end;
  938. secoptions:=[];
  939. objsec:=TOmfObjSection(objdata.createsection(SegmentName,SecAlign,secoptions,false));
  940. objsec.FClassName:=SegClassName;
  941. objsec.FOverlayName:=OverlayName;
  942. objsec.FCombination:=SegDefRec.Combination;
  943. objsec.FUse:=SegDefRec.Use;
  944. if SegDefRec.SegmentLength>High(objsec.Size) then
  945. begin
  946. InputError('Segment too large');
  947. SegDefRec.Free;
  948. exit;
  949. end;
  950. objsec.Size:=SegDefRec.SegmentLength;
  951. SegDefRec.Free;
  952. Result:=True;
  953. end;
  954. function TOmfObjInput.ReadGrpDef(RawRec: TOmfRawRecord; objdata: TObjData): Boolean;
  955. var
  956. GrpDefRec: TOmfRecord_GRPDEF;
  957. GroupName: string;
  958. SecGroup: TObjSectionGroup;
  959. i,SegIndex: Integer;
  960. begin
  961. Result:=False;
  962. GrpDefRec:=TOmfRecord_GRPDEF.Create;
  963. GrpDefRec.DecodeFrom(RawRec);
  964. if (GrpDefRec.GroupNameIndex<1) or (GrpDefRec.GroupNameIndex>LNames.Count) then
  965. begin
  966. InputError('Group name index out of range');
  967. GrpDefRec.Free;
  968. exit;
  969. end;
  970. GroupName:=LNames[GrpDefRec.GroupNameIndex];
  971. SecGroup:=objdata.createsectiongroup(GroupName);
  972. SetLength(SecGroup.members,Length(GrpDefRec.SegmentList));
  973. for i:=0 to Length(GrpDefRec.SegmentList)-1 do
  974. begin
  975. SegIndex:=GrpDefRec.SegmentList[i];
  976. if (SegIndex<1) or (SegIndex>objdata.ObjSectionList.Count) then
  977. begin
  978. InputError('Segment name index out of range in group definition');
  979. GrpDefRec.Free;
  980. exit;
  981. end;
  982. SecGroup.members[i]:=TOmfObjSection(objdata.ObjSectionList[SegIndex-1]);
  983. end;
  984. GrpDefRec.Free;
  985. Result:=True;
  986. end;
  987. function TOmfObjInput.ReadExtDef(RawRec: TOmfRawRecord; objdata: TObjData): Boolean;
  988. var
  989. ExtDefRec: TOmfRecord_EXTDEF;
  990. ExtDefElem: TOmfExternalNameElement;
  991. OldCount,NewCount,i: Integer;
  992. objsym: TObjSymbol;
  993. begin
  994. Result:=False;
  995. ExtDefRec:=TOmfRecord_EXTDEF.Create;
  996. ExtDefRec.ExternalNames:=ExtDefs;
  997. OldCount:=ExtDefs.Count;
  998. ExtDefRec.DecodeFrom(RawRec);
  999. NewCount:=ExtDefs.Count;
  1000. for i:=OldCount to NewCount-1 do
  1001. begin
  1002. ExtDefElem:=TOmfExternalNameElement(ExtDefs[i]);
  1003. objsym:=objdata.CreateSymbol(ExtDefElem.Name);
  1004. objsym.bind:=AB_EXTERNAL;
  1005. objsym.typ:=AT_FUNCTION;
  1006. objsym.objsection:=nil;
  1007. objsym.offset:=0;
  1008. objsym.size:=0;
  1009. end;
  1010. Result:=True;
  1011. end;
  1012. function TOmfObjInput.ReadLEDataAndFixups(RawRec: TOmfRawRecord; objdata: TObjData): Boolean;
  1013. var
  1014. Is32Bit: Boolean;
  1015. NextOfs: Integer;
  1016. SegmentIndex: Integer;
  1017. EnumeratedDataOffset: DWord;
  1018. BlockLength: Integer;
  1019. objsec: TOmfObjSection;
  1020. begin
  1021. Result:=False;
  1022. if not (RawRec.RecordType in [RT_LEDATA,RT_LEDATA32]) then
  1023. internalerror(2015040301);
  1024. Is32Bit:=RawRec.RecordType=RT_LEDATA32;
  1025. NextOfs:=RawRec.ReadIndexedRef(0,SegmentIndex);
  1026. if Is32Bit then
  1027. begin
  1028. if (NextOfs+3)>=RawRec.RecordLength then
  1029. internalerror(2015040504);
  1030. EnumeratedDataOffset := RawRec.RawData[NextOfs]+
  1031. (RawRec.RawData[NextOfs+1] shl 8)+
  1032. (RawRec.RawData[NextOfs+2] shl 16)+
  1033. (RawRec.RawData[NextOfs+3] shl 24);
  1034. Inc(NextOfs,4);
  1035. end
  1036. else
  1037. begin
  1038. if (NextOfs+1)>=RawRec.RecordLength then
  1039. internalerror(2015040504);
  1040. EnumeratedDataOffset := RawRec.RawData[NextOfs]+
  1041. (RawRec.RawData[NextOfs+1] shl 8);
  1042. Inc(NextOfs,2);
  1043. end;
  1044. BlockLength:=RawRec.RecordLength-NextOfs-1;
  1045. if BlockLength<0 then
  1046. internalerror(2015060501);
  1047. if BlockLength>1024 then
  1048. begin
  1049. InputError('LEDATA contains more than 1024 bytes of data');
  1050. exit;
  1051. end;
  1052. if (SegmentIndex<1) or (SegmentIndex>objdata.ObjSectionList.Count) then
  1053. begin
  1054. InputError('Segment index in LEDATA field is out of range');
  1055. exit;
  1056. end;
  1057. objsec:=TOmfObjSection(objdata.ObjSectionList[SegmentIndex-1]);
  1058. objsec.SecOptions:=objsec.SecOptions+[oso_Data];
  1059. if (objsec.Data.Size<>EnumeratedDataOffset) then
  1060. begin
  1061. InputError('LEDATA enumerated data offset field out of sequence');
  1062. exit;
  1063. end;
  1064. if (EnumeratedDataOffset+BlockLength)>objsec.Size then
  1065. begin
  1066. InputError('LEDATA goes beyond the segment size declared in the SEGDEF record');
  1067. exit;
  1068. end;
  1069. objsec.Data.write(RawRec.RawData[NextOfs],BlockLength);
  1070. {todo: read also the FIXUPP record that may follow}
  1071. Result:=True;
  1072. end;
  1073. constructor TOmfObjInput.create;
  1074. begin
  1075. inherited create;
  1076. cobjdata:=TOmfObjData;
  1077. FLNames:=TOmfOrderedNameCollection.Create;
  1078. FExtDefs:=TFPHashObjectList.Create;
  1079. FRawRecord:=TOmfRawRecord.Create;
  1080. end;
  1081. destructor TOmfObjInput.destroy;
  1082. begin
  1083. FRawRecord.Free;
  1084. FExtDefs.Free;
  1085. FLNames.Free;
  1086. inherited destroy;
  1087. end;
  1088. class function TOmfObjInput.CanReadObjData(AReader: TObjectreader): boolean;
  1089. var
  1090. b: Byte;
  1091. begin
  1092. result:=false;
  1093. if AReader.Read(b,sizeof(b)) then
  1094. begin
  1095. if b=RT_THEADR then
  1096. { TODO: check additional fields }
  1097. result:=true;
  1098. end;
  1099. AReader.Seek(0);
  1100. end;
  1101. function TOmfObjInput.ReadObjData(AReader: TObjectreader; out objdata: TObjData): boolean;
  1102. begin
  1103. FReader:=AReader;
  1104. InputFileName:=AReader.FileName;
  1105. objdata:=CObjData.Create(InputFileName);
  1106. result:=false;
  1107. LNames.Clear;
  1108. ExtDefs.Clear;
  1109. FRawRecord.ReadFrom(FReader);
  1110. if not FRawRecord.VerifyChecksumByte then
  1111. begin
  1112. InputError('Invalid checksum in OMF record');
  1113. exit;
  1114. end;
  1115. if FRawRecord.RecordType<>RT_THEADR then
  1116. begin
  1117. InputError('Can''t read OMF header');
  1118. exit;
  1119. end;
  1120. repeat
  1121. FRawRecord.ReadFrom(FReader);
  1122. if not FRawRecord.VerifyChecksumByte then
  1123. begin
  1124. InputError('Invalid checksum in OMF record');
  1125. exit;
  1126. end;
  1127. case FRawRecord.RecordType of
  1128. RT_LNAMES:
  1129. if not ReadLNames(FRawRecord) then
  1130. exit;
  1131. RT_SEGDEF,RT_SEGDEF32:
  1132. if not ReadSegDef(FRawRecord,objdata) then
  1133. exit;
  1134. RT_GRPDEF:
  1135. if not ReadGrpDef(FRawRecord,objdata) then
  1136. exit;
  1137. RT_COMENT:
  1138. begin
  1139. {todo}
  1140. end;
  1141. RT_EXTDEF:
  1142. if not ReadExtDef(FRawRecord,objdata) then
  1143. exit;
  1144. RT_PUBDEF,RT_PUBDEF32:
  1145. begin
  1146. {todo}
  1147. end;
  1148. RT_LEDATA,RT_LEDATA32:
  1149. if not ReadLEDataAndFixups(FRawRecord,objdata) then
  1150. exit;
  1151. RT_FIXUPP,RT_FIXUPP32:
  1152. begin
  1153. {todo}
  1154. end;
  1155. RT_MODEND,RT_MODEND32:
  1156. begin
  1157. {todo}
  1158. end;
  1159. else
  1160. begin
  1161. InputError('Unsupported OMF record type $'+HexStr(FRawRecord.RecordType,2));
  1162. exit;
  1163. end;
  1164. end;
  1165. until FRawRecord.RecordType in [RT_MODEND,RT_MODEND32];
  1166. end;
  1167. {****************************************************************************
  1168. TMZExeHeader
  1169. ****************************************************************************}
  1170. procedure TMZExeHeader.SetHeaderSizeAlignment(AValue: Integer);
  1171. begin
  1172. if (AValue<16) or ((AValue mod 16) <> 0) then
  1173. Internalerror(2015060601);
  1174. FHeaderSizeAlignment:=AValue;
  1175. end;
  1176. constructor TMZExeHeader.Create;
  1177. begin
  1178. FHeaderSizeAlignment:=16;
  1179. end;
  1180. procedure TMZExeHeader.WriteTo(aWriter: TObjectWriter);
  1181. var
  1182. NumRelocs: Word;
  1183. HeaderSizeInBytes: DWord;
  1184. HeaderParagraphs: Word;
  1185. RelocTableOffset: Word;
  1186. BytesInLastBlock: Word;
  1187. BlocksInFile: Word;
  1188. HeaderBytes: array [0..$1B] of Byte;
  1189. RelocBytes: array [0..3] of Byte;
  1190. TotalExeSize: DWord;
  1191. i: Integer;
  1192. begin
  1193. NumRelocs:=Length(Relocations);
  1194. RelocTableOffset:=$1C+Length(ExtraHeaderData);
  1195. HeaderSizeInBytes:=Align(RelocTableOffset+4*NumRelocs,16);
  1196. HeaderParagraphs:=HeaderSizeInBytes div 16;
  1197. TotalExeSize:=HeaderSizeInBytes+LoadableImageSize;
  1198. BlocksInFile:=(TotalExeSize+511) div 512;
  1199. BytesInLastBlock:=TotalExeSize mod 512;
  1200. HeaderBytes[$00]:=$4D; { 'M' }
  1201. HeaderBytes[$01]:=$5A; { 'Z' }
  1202. HeaderBytes[$02]:=Byte(BytesInLastBlock);
  1203. HeaderBytes[$03]:=Byte(BytesInLastBlock shr 8);
  1204. HeaderBytes[$04]:=Byte(BlocksInFile);
  1205. HeaderBytes[$05]:=Byte(BlocksInFile shr 8);
  1206. HeaderBytes[$06]:=Byte(NumRelocs);
  1207. HeaderBytes[$07]:=Byte(NumRelocs shr 8);
  1208. HeaderBytes[$08]:=Byte(HeaderParagraphs);
  1209. HeaderBytes[$09]:=Byte(HeaderParagraphs shr 8);
  1210. HeaderBytes[$0A]:=Byte(MinExtraParagraphs);
  1211. HeaderBytes[$0B]:=Byte(MinExtraParagraphs shr 8);
  1212. HeaderBytes[$0C]:=Byte(MaxExtraParagraphs);
  1213. HeaderBytes[$0D]:=Byte(MaxExtraParagraphs shr 8);
  1214. HeaderBytes[$0E]:=Byte(InitialSS);
  1215. HeaderBytes[$0F]:=Byte(InitialSS shr 8);
  1216. HeaderBytes[$10]:=Byte(InitialSP);
  1217. HeaderBytes[$11]:=Byte(InitialSP shr 8);
  1218. HeaderBytes[$12]:=Byte(Checksum);
  1219. HeaderBytes[$13]:=Byte(Checksum shr 8);
  1220. HeaderBytes[$14]:=Byte(InitialIP);
  1221. HeaderBytes[$15]:=Byte(InitialIP shr 8);
  1222. HeaderBytes[$16]:=Byte(InitialCS);
  1223. HeaderBytes[$17]:=Byte(InitialCS shr 8);
  1224. HeaderBytes[$18]:=Byte(RelocTableOffset);
  1225. HeaderBytes[$19]:=Byte(RelocTableOffset shr 8);
  1226. HeaderBytes[$1A]:=Byte(OverlayNumber);
  1227. HeaderBytes[$1B]:=Byte(OverlayNumber shr 8);
  1228. aWriter.write(HeaderBytes[0],$1C);
  1229. aWriter.write(ExtraHeaderData[0],Length(ExtraHeaderData));
  1230. for i:=0 to NumRelocs-1 do
  1231. with Relocations[i] do
  1232. begin
  1233. RelocBytes[0]:=Byte(offset);
  1234. RelocBytes[1]:=Byte(offset shr 8);
  1235. RelocBytes[2]:=Byte(segment);
  1236. RelocBytes[3]:=Byte(segment shr 8);
  1237. aWriter.write(RelocBytes[0],4);
  1238. end;
  1239. { pad with zeros until the end of header (paragraph aligned) }
  1240. aWriter.WriteZeros(HeaderSizeInBytes-aWriter.Size);
  1241. end;
  1242. {****************************************************************************
  1243. TMZExeOutput
  1244. ****************************************************************************}
  1245. function TMZExeOutput.writeData: boolean;
  1246. var
  1247. Header: TMZExeHeader;
  1248. begin
  1249. Result:=False;
  1250. Header:=TMZExeHeader.Create;
  1251. {todo: fill header data}
  1252. Header.WriteTo(FWriter);
  1253. Header.Free;
  1254. Result:=True;
  1255. end;
  1256. constructor TMZExeOutput.create;
  1257. begin
  1258. inherited create;
  1259. CObjData:=TOmfObjData;
  1260. end;
  1261. {****************************************************************************
  1262. TOmfAssembler
  1263. ****************************************************************************}
  1264. constructor TOmfAssembler.Create(smart:boolean);
  1265. begin
  1266. inherited Create(smart);
  1267. CObjOutput:=TOmfObjOutput;
  1268. CInternalAr:=TOmfLibObjectWriter;
  1269. end;
  1270. {*****************************************************************************
  1271. Initialize
  1272. *****************************************************************************}
  1273. {$ifdef i8086}
  1274. const
  1275. as_i8086_omf_info : tasminfo =
  1276. (
  1277. id : as_i8086_omf;
  1278. idtxt : 'OMF';
  1279. asmbin : '';
  1280. asmcmd : '';
  1281. supported_targets : [system_i8086_msdos];
  1282. flags : [af_outputbinary,af_no_debug];
  1283. labelprefix : '..@';
  1284. comment : '; ';
  1285. dollarsign: '$';
  1286. );
  1287. {$endif i8086}
  1288. initialization
  1289. {$ifdef i8086}
  1290. RegisterAssembler(as_i8086_omf_info,TOmfAssembler);
  1291. {$endif i8086}
  1292. end.