ogomf.pas 54 KB

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