1 { 2 Copyright (c) 2015 by Nikolay Nikolov 3 4 Contains the binary Relocatable Object Module Format (OMF) reader and writer 5 This is the object format used on the i8086-msdos platform. 6 7 This program is free software; you can redistribute it and/or modify 8 it under the terms of the GNU General Public License as published by 9 the Free Software Foundation; either version 2 of the License, or 10 (at your option) any later version. 11 12 This program is distributed in the hope that it will be useful, 13 but WITHOUT ANY WARRANTY; without even the implied warranty of 14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 15 GNU General Public License for more details. 16 17 You should have received a copy of the GNU General Public License 18 along with this program; if not, write to the Free Software 19 Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. 20 21 **************************************************************************** 22 } 23 unit ogomf; 24 25 {$i fpcdefs.inc} 26 27 interface 28 29 uses 30 { common } 31 cclasses,globtype, 32 { target } 33 systems, 34 { assembler } 35 cpuinfo,cpubase,aasmbase,assemble,link, 36 { OMF definitions } 37 omfbase, 38 { output } 39 ogbase, 40 owbase; 41 42 type 43 44 { TOmfObjSymbol } 45 46 TOmfObjSymbol = class(TObjSymbol) 47 public 48 { string representation for the linker map file } AddressStrnull49 function AddressStr(AImageBase: qword): string;override; 50 end; 51 52 { TOmfRelocation } 53 54 TOmfRelocation = class(TObjRelocation) 55 private 56 FFrameGroup: string; 57 FOmfFixup: TOmfSubRecord_FIXUP; 58 public 59 destructor Destroy; override; 60 61 procedure BuildOmfFixup; 62 63 property FrameGroup: string read FFrameGroup write FFrameGroup; 64 property OmfFixup: TOmfSubRecord_FIXUP read FOmfFixup; 65 end; 66 67 TMZExeUnifiedLogicalSegment=class; 68 69 { TOmfObjSection } 70 71 TOmfObjSection = class(TObjSection) 72 private 73 FClassName: string; 74 FOverlayName: string; 75 FCombination: TOmfSegmentCombination; 76 FUse: TOmfSegmentUse; 77 FPrimaryGroup: TObjSectionGroup; 78 FSortOrder: Integer; 79 FMZExeUnifiedLogicalSegment: TMZExeUnifiedLogicalSegment; 80 FLinNumEntries: TOmfSubRecord_LINNUM_MsLink_LineNumberList; GetOmfAlignmentnull81 function GetOmfAlignment: TOmfSegmentAlignment; 82 public 83 constructor create(AList:TFPHashObjectList;const Aname:string;Aalign:longint;Aoptions:TObjSectionOptions);override; 84 destructor destroy;override; MemPosStrnull85 function MemPosStr(AImageBase: qword): string;override; 86 property ClassName: string read FClassName; 87 property OverlayName: string read FOverlayName; 88 property OmfAlignment: TOmfSegmentAlignment read GetOmfAlignment; 89 property Combination: TOmfSegmentCombination read FCombination; 90 property Use: TOmfSegmentUse read FUse; 91 property PrimaryGroup: TObjSectionGroup read FPrimaryGroup; 92 property SortOrder: Integer read FSortOrder write FSortOrder; 93 property MZExeUnifiedLogicalSegment: TMZExeUnifiedLogicalSegment read FMZExeUnifiedLogicalSegment write FMZExeUnifiedLogicalSegment; 94 property LinNumEntries: TOmfSubRecord_LINNUM_MsLink_LineNumberList read FLinNumEntries; 95 end; 96 97 { TOmfObjData } 98 99 TOmfObjData = class(TObjData) 100 private 101 FMainSource: TPathStr; CodeSectionNamenull102 class function CodeSectionName(const aname:string): string; 103 public 104 constructor create(const n:string);override; sectiontype2optionsnull105 function sectiontype2options(atype:TAsmSectiontype):TObjSectionOptions;override; sectiontype2alignnull106 function sectiontype2align(atype:TAsmSectiontype):longint;override; sectiontype2classnull107 function sectiontype2class(atype:TAsmSectiontype):string; sectionnamenull108 function sectionname(atype:TAsmSectiontype;const aname:string;aorder:TAsmSectionOrder):string;override; createsectionnull109 function createsection(atype:TAsmSectionType;const aname:string='';aorder:TAsmSectionOrder=secorder_default):TObjSection;override; reffardatasectionnull110 function reffardatasection:TObjSection; 111 procedure writeReloc(Data:TRelocDataInt;len:aword;p:TObjSymbol;Reloctype:TObjRelocationType);override; 112 property MainSource: TPathStr read FMainSource; 113 end; 114 115 { TOmfObjOutput } 116 117 TOmfObjOutput = class(tObjOutput) 118 private 119 FLNames: TOmfOrderedNameCollection; 120 FSegments: TFPHashObjectList; 121 FGroups: TFPHashObjectList; 122 procedure AddSegment(const name,segclass,ovlname: string; 123 Alignment: TOmfSegmentAlignment; Combination: TOmfSegmentCombination; 124 Use: TOmfSegmentUse; Size: TObjSectionOfs); 125 procedure AddGroup(group: TObjSectionGroup); 126 procedure WriteSections(Data:TObjData); 127 procedure WriteSectionContentAndFixups(sec: TObjSection); 128 procedure WriteLinNumRecords(sec: TOmfObjSection); 129 130 procedure section_count_sections(p:TObject;arg:pointer); 131 procedure group_count_groups(p:TObject;arg:pointer); 132 procedure WritePUBDEFs(Data: TObjData); 133 procedure WriteEXTDEFs(Data: TObjData); 134 135 property LNames: TOmfOrderedNameCollection read FLNames; 136 property Segments: TFPHashObjectList read FSegments; 137 property Groups: TFPHashObjectList read FGroups; 138 protected writeDatanull139 function writeData(Data:TObjData):boolean;override; 140 public 141 constructor create(AWriter:TObjectWriter);override; 142 destructor Destroy;override; 143 procedure WriteDllImport(const dllname,afuncname,mangledname:string;ordnr:longint;isvar:boolean); 144 end; 145 146 { TOmfObjInput } 147 148 TOmfObjInput = class(TObjInput) 149 private 150 FLNames: TOmfOrderedNameCollection; 151 FExtDefs: TFPHashObjectList; 152 FPubDefs: TFPHashObjectList; 153 FFixupThreads: TOmfThreads; 154 FRawRecord: TOmfRawRecord; 155 FCOMENTRecord: TOmfRecord_COMENT; 156 FCaseSensitiveSegments: Boolean; 157 FCaseSensitiveSymbols: Boolean; 158 PeekNextRecordTypenull159 function PeekNextRecordType: Byte; 160 ReadLNamesnull161 function ReadLNames(RawRec: TOmfRawRecord): Boolean; ReadSegDefnull162 function ReadSegDef(RawRec: TOmfRawRecord; objdata:TObjData): Boolean; ReadGrpDefnull163 function ReadGrpDef(RawRec: TOmfRawRecord; objdata:TObjData): Boolean; ReadExtDefnull164 function ReadExtDef(RawRec: TOmfRawRecord; objdata:TObjData): Boolean; ReadPubDefnull165 function ReadPubDef(RawRec: TOmfRawRecord; objdata:TObjData): Boolean; ReadModEndnull166 function ReadModEnd(RawRec: TOmfRawRecord; objdata:TObjData): Boolean; ReadLeOrLiDataAndFixupsnull167 function ReadLeOrLiDataAndFixups(RawRec: TOmfRawRecord; objdata:TObjData): Boolean; ImportOmfFixupnull168 function ImportOmfFixup(objdata: TObjData; objsec: TOmfObjSection; Fixup: TOmfSubRecord_FIXUP): Boolean; 169 170 property LNames: TOmfOrderedNameCollection read FLNames; 171 property ExtDefs: TFPHashObjectList read FExtDefs; 172 property PubDefs: TFPHashObjectList read FPubDefs; 173 174 { Specifies whether we're case sensitive in regards to segment, class, overlay and group names. } 175 property CaseSensitiveSegments: Boolean read FCaseSensitiveSegments write FCaseSensitiveSegments; 176 { Specifies whether symbol names (in EXTDEF and PUBDEF records) are case sensitive. } 177 property CaseSensitiveSymbols: Boolean read FCaseSensitiveSymbols write FCaseSensitiveSymbols; 178 public 179 constructor create;override; 180 destructor destroy;override; CanReadObjDatanull181 class function CanReadObjData(AReader:TObjectreader):boolean;override; ReadObjDatanull182 function ReadObjData(AReader:TObjectreader;out objdata:TObjData):boolean;override; 183 end; 184 185 { TMZExeRelocation } 186 187 TMZExeRelocation = record 188 offset: Word; 189 segment: Word; 190 end; 191 TMZExeRelocations = array of TMZExeRelocation; 192 TMZExeExtraHeaderData = array of Byte; 193 194 { TMZExeHeader } 195 196 TMZExeHeader = class 197 private 198 FChecksum: Word; 199 FExtraHeaderData: TMZExeExtraHeaderData; 200 FHeaderSizeAlignment: Integer; 201 FInitialCS: Word; 202 FInitialIP: Word; 203 FInitialSP: Word; 204 FInitialSS: Word; 205 FLoadableImageSize: DWord; 206 FMaxExtraParagraphs: Word; 207 FMinExtraParagraphs: Word; 208 FOverlayNumber: Word; 209 FRelocations: TMZExeRelocations; 210 procedure SetHeaderSizeAlignment(AValue: Integer); 211 public 212 constructor Create; 213 procedure WriteTo(aWriter: TObjectWriter); 214 procedure AddRelocation(aSegment,aOffset: Word); 215 property HeaderSizeAlignment: Integer read FHeaderSizeAlignment write SetHeaderSizeAlignment; {default=16, must be multiple of 16} 216 property Relocations: TMZExeRelocations read FRelocations write FRelocations; 217 property ExtraHeaderData: TMZExeExtraHeaderData read FExtraHeaderData write FExtraHeaderData; 218 property LoadableImageSize: DWord read FLoadableImageSize write FLoadableImageSize; 219 property MinExtraParagraphs: Word read FMinExtraParagraphs write FMinExtraParagraphs; 220 property MaxExtraParagraphs: Word read FMaxExtraParagraphs write FMaxExtraParagraphs; 221 property InitialSS: Word read FInitialSS write FInitialSS; 222 property InitialSP: Word read FInitialSP write FInitialSP; 223 property Checksum: Word read FChecksum write FChecksum; 224 property InitialIP: Word read FInitialIP write FInitialIP; 225 property InitialCS: Word read FInitialCS write FInitialCS; 226 property OverlayNumber: Word read FOverlayNumber write FOverlayNumber; 227 end; 228 229 { TMZExeSection } 230 231 TMZExeSection=class(TExeSection) 232 public 233 procedure AddObjSection(objsec:TObjSection;ignoreprops:boolean=false);override; 234 end; 235 236 { TMZExeUnifiedLogicalSegment } 237 238 TMZExeUnifiedLogicalSegment=class(TFPHashObject) 239 private 240 FObjSectionList: TFPObjectList; 241 FSegName: TSymStr; 242 FSegClass: TSymStr; 243 FPrimaryGroup: string; 244 public 245 Size, 246 MemPos, 247 MemBasePos: qword; 248 IsStack: Boolean; 249 constructor create(HashObjectList:TFPHashObjectList;const s:TSymStr); 250 destructor destroy;override; 251 procedure AddObjSection(ObjSec: TOmfObjSection); 252 procedure CalcMemPos; MemPosStrnull253 function MemPosStr:string; 254 property ObjSectionList: TFPObjectList read FObjSectionList; 255 property SegName: TSymStr read FSegName; 256 property SegClass: TSymStr read FSegClass; 257 property PrimaryGroup: string read FPrimaryGroup write FPrimaryGroup; 258 end; 259 260 { TMZExeUnifiedLogicalGroup } 261 262 TMZExeUnifiedLogicalGroup=class(TFPHashObject) 263 private 264 FSegmentList: TFPHashObjectList; 265 public 266 Size, 267 MemPos: qword; 268 constructor create(HashObjectList:TFPHashObjectList;const s:TSymStr); 269 destructor destroy;override; 270 procedure CalcMemPos; MemPosStrnull271 function MemPosStr:string; 272 procedure AddSegment(UniSeg: TMZExeUnifiedLogicalSegment); 273 property SegmentList: TFPHashObjectList read FSegmentList; 274 end; 275 276 { TMZExeOutput } 277 278 TMZExeOutput = class(TExeOutput) 279 private 280 FMZFlatContentSection: TMZExeSection; 281 FExeUnifiedLogicalSegments: TFPHashObjectList; 282 FExeUnifiedLogicalGroups: TFPHashObjectList; 283 FDwarfUnifiedLogicalSegments: TFPHashObjectList; 284 FHeader: TMZExeHeader; GetMZFlatContentSectionnull285 function GetMZFlatContentSection: TMZExeSection; 286 procedure CalcDwarfUnifiedLogicalSegmentsForSection(const SecName: TSymStr); 287 procedure CalcExeUnifiedLogicalSegments; 288 procedure CalcExeGroups; 289 procedure CalcSegments_MemBasePos; 290 procedure WriteMap_SegmentsAndGroups; 291 procedure WriteMap_HeaderData; FindStackSegmentnull292 function FindStackSegment: TMZExeUnifiedLogicalSegment; 293 procedure FillLoadableImageSize; 294 procedure FillMinExtraParagraphs; 295 procedure FillMaxExtraParagraphs; 296 procedure FillStartAddress; 297 procedure FillStackAddress; 298 procedure FillHeaderData; writeExenull299 function writeExe:boolean; writeComnull300 function writeCom:boolean; writeDebugElfnull301 function writeDebugElf:boolean; 302 property ExeUnifiedLogicalSegments: TFPHashObjectList read FExeUnifiedLogicalSegments; 303 property ExeUnifiedLogicalGroups: TFPHashObjectList read FExeUnifiedLogicalGroups; 304 property DwarfUnifiedLogicalSegments: TFPHashObjectList read FExeUnifiedLogicalSegments; 305 property Header: TMZExeHeader read FHeader; 306 protected 307 procedure Load_Symbol(const aname:string);override; 308 procedure DoRelocationFixup(objsec:TObjSection);override; 309 procedure Order_ObjSectionList(ObjSectionList : TFPObjectList;const aPattern:string);override; 310 procedure MemPos_ExeSection(const aname:string);override; 311 procedure MemPos_EndExeSection;override; writeDatanull312 function writeData:boolean;override; 313 public 314 constructor create;override; 315 destructor destroy;override; 316 property MZFlatContentSection: TMZExeSection read GetMZFlatContentSection; 317 end; 318 319 TOmfAssembler = class(tinternalassembler) 320 constructor create(info: pasminfo; smart:boolean);override; 321 end; 322 323 implementation 324 325 uses 326 SysUtils, 327 cutils,verbose,globals, 328 fmodule,aasmtai,aasmdata, 329 ogmap,owomflib,elfbase, 330 version 331 ; 332 333 const win16stub : array[0..255] of byte=( 334 $4d,$5a,$00,$01,$01,$00,$00,$00,$08,$00,$10,$00,$ff,$ff,$08,$00, 335 $00,$01,$00,$00,$00,$00,$00,$00,$40,$00,$00,$00,$00,$00,$00,$00, 336 $00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00, 337 $00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$01,$00,$00, 338 $00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00, 339 $00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00, 340 $00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00, 341 $00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00, 342 $ba,$10,$00,$0e,$1f,$b4,$09,$cd,$21,$b8,$01,$4c,$cd,$21,$90,$90, 343 $54,$68,$69,$73,$20,$70,$72,$6f,$67,$72,$61,$6d,$20,$72,$65,$71, 344 $75,$69,$72,$65,$73,$20,$4d,$69,$63,$72,$6f,$73,$6f,$66,$74,$20, 345 $57,$69,$6e,$64,$6f,$77,$73,$2e,$0d,$0a,$24,$20,$20,$20,$20,$20, 346 $20,$20,$20,$20,$20,$20,$20,$20,$20,$20,$20,$20,$20,$20,$20,$20, 347 $20,$20,$20,$20,$20,$20,$20,$20,$20,$20,$20,$20,$20,$20,$20,$20, 348 $20,$20,$20,$20,$20,$20,$20,$20,$20,$20,$20,$20,$20,$20,$20,$20, 349 $20,$20,$20,$20,$20,$20,$20,$20,$20,$20,$20,$20,$20,$20,$20,$20); 350 351 {**************************************************************************** 352 TTISTrailer 353 ****************************************************************************} 354 355 const 356 TIS_TRAILER_SIGNATURE: array[1..4] of char='TIS'#0; 357 TIS_TRAILER_VENDOR_TIS=0; 358 TIS_TRAILER_TYPE_TIS_DWARF=0; 359 360 type 361 TTISTrailer=record 362 tis_signature: array[1..4] of char; 363 tis_vendor, 364 tis_type, 365 tis_size: LongWord; 366 end; 367 368 procedure MayBeSwapTISTrailer(var h: TTISTrailer); 369 begin 370 if source_info.endian<>target_info.endian then 371 with h do 372 begin 373 tis_vendor:=swapendian(tis_vendor); 374 tis_type:=swapendian(tis_type); 375 tis_size:=swapendian(tis_size); 376 end; 377 end; 378 379 {**************************************************************************** 380 TOmfObjSymbol 381 ****************************************************************************} 382 TOmfObjSymbol.AddressStrnull383 function TOmfObjSymbol.AddressStr(AImageBase: qword): string; 384 var 385 base: qword; 386 begin 387 if assigned(TOmfObjSection(objsection).MZExeUnifiedLogicalSegment) then 388 base:=TOmfObjSection(objsection).MZExeUnifiedLogicalSegment.MemBasePos 389 else 390 base:=(address shr 4) shl 4; 391 Result:=HexStr(base shr 4,4)+':'+HexStr(address-base,4); 392 end; 393 394 {**************************************************************************** 395 TOmfRelocation 396 ****************************************************************************} 397 398 destructor TOmfRelocation.Destroy; 399 begin 400 FOmfFixup.Free; 401 inherited Destroy; 402 end; 403 404 procedure TOmfRelocation.BuildOmfFixup; 405 begin 406 FreeAndNil(FOmfFixup); 407 FOmfFixup:=TOmfSubRecord_FIXUP.Create; 408 if ObjSection<>nil then 409 begin 410 FOmfFixup.LocationOffset:=DataOffset; 411 if typ in [RELOC_ABSOLUTE16,RELOC_RELATIVE16] then 412 FOmfFixup.LocationType:=fltOffset 413 else if typ in [RELOC_ABSOLUTE32,RELOC_RELATIVE32] then 414 FOmfFixup.LocationType:=fltOffset32 415 else if typ in [RELOC_SEG,RELOC_SEGREL] then 416 FOmfFixup.LocationType:=fltBase 417 else 418 internalerror(2015041501); 419 FOmfFixup.FrameDeterminedByThread:=False; 420 FOmfFixup.TargetDeterminedByThread:=False; 421 if typ in [RELOC_ABSOLUTE16,RELOC_ABSOLUTE32,RELOC_SEG] then 422 FOmfFixup.Mode:=fmSegmentRelative 423 else if typ in [RELOC_RELATIVE16,RELOC_RELATIVE32,RELOC_SEGREL] then 424 FOmfFixup.Mode:=fmSelfRelative 425 else 426 internalerror(2015041401); 427 if typ in [RELOC_ABSOLUTE16,RELOC_ABSOLUTE32,RELOC_RELATIVE16,RELOC_RELATIVE32] then 428 begin 429 FOmfFixup.TargetMethod:=ftmSegmentIndexNoDisp; 430 FOmfFixup.TargetDatum:=ObjSection.Index; 431 if TOmfObjSection(ObjSection).PrimaryGroup<>nil then 432 begin 433 FOmfFixup.FrameMethod:=ffmGroupIndex; 434 FOmfFixup.FrameDatum:=TOmfObjSection(ObjSection).PrimaryGroup.index; 435 end 436 else 437 FOmfFixup.FrameMethod:=ffmTarget; 438 end 439 else 440 begin 441 FOmfFixup.FrameMethod:=ffmTarget; 442 if TOmfObjSection(ObjSection).PrimaryGroup<>nil then 443 begin 444 FOmfFixup.TargetMethod:=ftmGroupIndexNoDisp; 445 FOmfFixup.TargetDatum:=TOmfObjSection(ObjSection).PrimaryGroup.index; 446 end 447 else 448 begin 449 FOmfFixup.TargetMethod:=ftmSegmentIndexNoDisp; 450 FOmfFixup.TargetDatum:=ObjSection.Index; 451 end; 452 end; 453 end 454 else if symbol<>nil then 455 begin 456 FOmfFixup.LocationOffset:=DataOffset; 457 if typ in [RELOC_ABSOLUTE16,RELOC_RELATIVE16] then 458 FOmfFixup.LocationType:=fltOffset 459 else if typ in [RELOC_ABSOLUTE32,RELOC_RELATIVE32] then 460 FOmfFixup.LocationType:=fltOffset32 461 else if typ in [RELOC_SEG,RELOC_SEGREL] then 462 FOmfFixup.LocationType:=fltBase 463 else 464 internalerror(2015041501); 465 FOmfFixup.FrameDeterminedByThread:=False; 466 FOmfFixup.TargetDeterminedByThread:=False; 467 if typ in [RELOC_ABSOLUTE16,RELOC_ABSOLUTE32,RELOC_SEG] then 468 FOmfFixup.Mode:=fmSegmentRelative 469 else if typ in [RELOC_RELATIVE16,RELOC_RELATIVE32,RELOC_SEGREL] then 470 FOmfFixup.Mode:=fmSelfRelative 471 else 472 internalerror(2015041401); 473 FOmfFixup.TargetMethod:=ftmExternalIndexNoDisp; 474 FOmfFixup.TargetDatum:=symbol.symidx; 475 FOmfFixup.FrameMethod:=ffmTarget; 476 end 477 else if group<>nil then 478 begin 479 FOmfFixup.LocationOffset:=DataOffset; 480 if typ in [RELOC_ABSOLUTE16,RELOC_RELATIVE16] then 481 FOmfFixup.LocationType:=fltOffset 482 else if typ in [RELOC_ABSOLUTE32,RELOC_RELATIVE32] then 483 FOmfFixup.LocationType:=fltOffset32 484 else if typ in [RELOC_SEG,RELOC_SEGREL] then 485 FOmfFixup.LocationType:=fltBase 486 else 487 internalerror(2015041501); 488 FOmfFixup.FrameDeterminedByThread:=False; 489 FOmfFixup.TargetDeterminedByThread:=False; 490 if typ in [RELOC_ABSOLUTE16,RELOC_ABSOLUTE32,RELOC_SEG] then 491 FOmfFixup.Mode:=fmSegmentRelative 492 else if typ in [RELOC_RELATIVE16,RELOC_RELATIVE32,RELOC_SEGREL] then 493 FOmfFixup.Mode:=fmSelfRelative 494 else 495 internalerror(2015041401); 496 FOmfFixup.FrameMethod:=ffmTarget; 497 FOmfFixup.TargetMethod:=ftmGroupIndexNoDisp; 498 FOmfFixup.TargetDatum:=group.index; 499 end 500 else 501 internalerror(2015040702); 502 end; 503 504 {**************************************************************************** 505 TOmfObjSection 506 ****************************************************************************} 507 TOmfObjSection.GetOmfAlignmentnull508 function TOmfObjSection.GetOmfAlignment: TOmfSegmentAlignment; 509 begin 510 case SecAlign of 511 1: 512 result:=saRelocatableByteAligned; 513 2: 514 result:=saRelocatableWordAligned; 515 4: 516 result:=saRelocatableDWordAligned; 517 16: 518 result:=saRelocatableParaAligned; 519 256: 520 result:=saRelocatablePageAligned; 521 4096: 522 result:=saNotSupported; 523 else 524 internalerror(2015041504); 525 end; 526 end; 527 528 constructor TOmfObjSection.create(AList: TFPHashObjectList; 529 const Aname: string; Aalign: longint; Aoptions: TObjSectionOptions); 530 begin 531 inherited create(AList, Aname, Aalign, Aoptions); 532 FCombination:=scPublic; 533 FUse:=suUse16; 534 FLinNumEntries:=TOmfSubRecord_LINNUM_MsLink_LineNumberList.Create; 535 end; 536 537 destructor TOmfObjSection.destroy; 538 begin 539 FLinNumEntries.Free; 540 inherited destroy; 541 end; 542 TOmfObjSection.MemPosStrnull543 function TOmfObjSection.MemPosStr(AImageBase: qword): string; 544 begin 545 Result:=HexStr(MZExeUnifiedLogicalSegment.MemBasePos shr 4,4)+':'+ 546 HexStr(MemPos-MZExeUnifiedLogicalSegment.MemBasePos,4); 547 end; 548 549 {**************************************************************************** 550 TOmfObjData 551 ****************************************************************************} 552 TOmfObjData.CodeSectionNamenull553 class function TOmfObjData.CodeSectionName(const aname: string): string; 554 begin 555 {$ifdef i8086} 556 if current_settings.x86memorymodel in x86_far_code_models then 557 begin 558 if cs_huge_code in current_settings.moduleswitches then 559 result:=aname + '_TEXT' 560 else 561 result:=current_module.modulename^ + '_TEXT'; 562 end 563 else 564 {$endif} 565 result:='_TEXT'; 566 end; 567 568 constructor TOmfObjData.create(const n: string); 569 begin 570 inherited create(n); 571 CObjSymbol:=TOmfObjSymbol; 572 CObjSection:=TOmfObjSection; 573 createsectiongroup('DGROUP'); 574 FMainSource:=current_module.mainsource; 575 end; 576 TOmfObjData.sectiontype2optionsnull577 function TOmfObjData.sectiontype2options(atype: TAsmSectiontype): TObjSectionOptions; 578 begin 579 Result:=inherited sectiontype2options(atype); 580 { in the huge memory model, BSS data is actually written in the regular 581 FAR_DATA segment of the module } 582 if sectiontype2class(atype)='FAR_DATA' then 583 Result:=Result+[oso_data,oso_sparse_data]; 584 end; 585 TOmfObjData.sectiontype2alignnull586 function TOmfObjData.sectiontype2align(atype: TAsmSectiontype): longint; 587 begin 588 Result:=omf_sectiontype2align(atype); 589 end; 590 TOmfObjData.sectiontype2classnull591 function TOmfObjData.sectiontype2class(atype: TAsmSectiontype): string; 592 begin 593 Result:=omf_segclass(atype); 594 end; 595 TOmfObjData.sectionnamenull596 function TOmfObjData.sectionname(atype:TAsmSectiontype;const aname:string;aorder:TAsmSectionOrder):string; 597 var 598 sep : string[3]; 599 secname : string; 600 begin 601 if (atype=sec_user) then 602 Result:=aname 603 else 604 begin 605 if omf_secnames[atype]=omf_secnames[sec_code] then 606 secname:=CodeSectionName(aname) 607 else if omf_segclass(atype)='FAR_DATA' then 608 secname:=current_module.modulename^ + '_DATA' 609 else 610 secname:=omf_secnames[atype]; 611 if create_smartlink_sections and (aname<>'') then 612 begin 613 case aorder of 614 secorder_begin : 615 sep:='.b_'; 616 secorder_end : 617 sep:='.z_'; 618 else 619 sep:='.n_'; 620 end; 621 result:=UpCase(secname+sep+aname); 622 end 623 else 624 result:=secname; 625 end; 626 end; 627 TOmfObjData.createsectionnull628 function TOmfObjData.createsection(atype: TAsmSectionType; const aname: string; aorder: TAsmSectionOrder): TObjSection; 629 var 630 is_new: Boolean; 631 primary_group: String; 632 grp: TObjSectionGroup; 633 begin 634 is_new:=TObjSection(ObjSectionList.Find(sectionname(atype,aname,aorder)))=nil; 635 Result:=inherited createsection(atype, aname, aorder); 636 if is_new then 637 begin 638 TOmfObjSection(Result).FClassName:=sectiontype2class(atype); 639 if atype=sec_stack then 640 TOmfObjSection(Result).FCombination:=scStack 641 else if atype in [sec_debug_frame,sec_debug_info,sec_debug_line,sec_debug_abbrev,sec_debug_aranges,sec_debug_ranges] then 642 begin 643 TOmfObjSection(Result).FUse:=suUse32; 644 TOmfObjSection(Result).SizeLimit:=high(longword); 645 end; 646 primary_group:=omf_section_primary_group(atype,aname); 647 if primary_group<>'' then 648 begin 649 { find the primary group, if it already exists, else create it } 650 grp:=nil; 651 if GroupsList<>nil then 652 grp:=TObjSectionGroup(GroupsList.Find(primary_group)); 653 if grp=nil then 654 grp:=createsectiongroup(primary_group); 655 { add the current section to the group } 656 SetLength(grp.members,Length(grp.members)+1); 657 grp.members[High(grp.members)]:=Result; 658 TOmfObjSection(Result).FPrimaryGroup:=grp; 659 end; 660 end; 661 end; 662 TOmfObjData.reffardatasectionnull663 function TOmfObjData.reffardatasection: TObjSection; 664 var 665 secname: string; 666 begin 667 secname:=current_module.modulename^ + '_DATA'; 668 669 result:=TObjSection(ObjSectionList.Find(secname)); 670 if not assigned(result) then 671 begin 672 result:=CObjSection.create(ObjSectionList,secname,2,[oso_Data,oso_load,oso_write]); 673 result.ObjData:=self; 674 TOmfObjSection(Result).FClassName:='FAR_DATA'; 675 end; 676 end; 677 678 procedure TOmfObjData.writeReloc(Data:TRelocDataInt;len:aword;p:TObjSymbol;Reloctype:TObjRelocationType); 679 var 680 objreloc: TOmfRelocation; 681 symaddr: AWord; 682 begin 683 { RELOC_FARPTR = RELOC_ABSOLUTE16+RELOC_SEG } 684 if Reloctype=RELOC_FARPTR then 685 begin 686 if len<>4 then 687 internalerror(2015041502); 688 writeReloc(Data,2,p,RELOC_ABSOLUTE16); 689 writeReloc(0,2,p,RELOC_SEG); 690 exit; 691 end 692 { RELOC_FARPTR48 = RELOC_ABSOLUTE16+RELOC_SEG } 693 else if Reloctype=RELOC_FARPTR48 then 694 begin 695 if len<>6 then 696 internalerror(2015041502); 697 writeReloc(Data,4,p,RELOC_ABSOLUTE32); 698 writeReloc(0,2,p,RELOC_SEG); 699 exit; 700 end; 701 702 if CurrObjSec=nil then 703 internalerror(200403072); 704 objreloc:=nil; 705 if Reloctype in [RELOC_FARDATASEG,RELOC_FARDATASEGREL] then 706 begin 707 if Reloctype=RELOC_FARDATASEG then 708 objreloc:=TOmfRelocation.CreateSection(CurrObjSec.Size,reffardatasection,RELOC_SEG) 709 else 710 objreloc:=TOmfRelocation.CreateSection(CurrObjSec.Size,reffardatasection,RELOC_SEGREL); 711 CurrObjSec.ObjRelocations.Add(objreloc); 712 end 713 else if assigned(p) then 714 begin 715 { real address of the symbol } 716 symaddr:=p.address; 717 718 if p.bind=AB_EXTERNAL then 719 begin 720 objreloc:=TOmfRelocation.CreateSymbol(CurrObjSec.Size,p,Reloctype); 721 CurrObjSec.ObjRelocations.Add(objreloc); 722 end 723 { relative relocations within the same section can be calculated directly, 724 without the need to emit a relocation entry } 725 else if (p.objsection=CurrObjSec) and 726 (p.bind<>AB_COMMON) and 727 (Reloctype=RELOC_RELATIVE) then 728 begin 729 data:=data+symaddr-len-CurrObjSec.Size; 730 end 731 else 732 begin 733 objreloc:=TOmfRelocation.CreateSection(CurrObjSec.Size,p.objsection,Reloctype); 734 CurrObjSec.ObjRelocations.Add(objreloc); 735 if not (Reloctype in [RELOC_SEG,RELOC_SEGREL]) then 736 inc(data,symaddr); 737 end; 738 end 739 else if Reloctype in [RELOC_DGROUP,RELOC_DGROUPREL] then 740 begin 741 if Reloctype=RELOC_DGROUP then 742 objreloc:=TOmfRelocation.CreateGroup(CurrObjSec.Size,TObjSectionGroup(GroupsList.Find('DGROUP')),RELOC_SEG) 743 else 744 objreloc:=TOmfRelocation.CreateGroup(CurrObjSec.Size,TObjSectionGroup(GroupsList.Find('DGROUP')),RELOC_SEGREL); 745 CurrObjSec.ObjRelocations.Add(objreloc); 746 end; 747 CurrObjSec.write(data,len); 748 end; 749 750 {**************************************************************************** 751 TOmfObjOutput 752 ****************************************************************************} 753 754 procedure TOmfObjOutput.AddSegment(const name, segclass, ovlname: string; 755 Alignment: TOmfSegmentAlignment; Combination: TOmfSegmentCombination; 756 Use: TOmfSegmentUse; Size: TObjSectionOfs); 757 var 758 s: TOmfRecord_SEGDEF; 759 begin 760 s:=TOmfRecord_SEGDEF.Create; 761 Segments.Add(name,s); 762 s.SegmentNameIndex:=LNames.Add(name); 763 s.ClassNameIndex:=LNames.Add(segclass); 764 s.OverlayNameIndex:=LNames.Add(ovlname); 765 s.Alignment:=Alignment; 766 s.Combination:=Combination; 767 s.Use:=Use; 768 s.SegmentLength:=Size; 769 end; 770 771 procedure TOmfObjOutput.AddGroup(group: TObjSectionGroup); 772 var 773 g: TOmfRecord_GRPDEF; 774 seglist: TSegmentList; 775 I: Integer; 776 begin 777 seglist:=nil; 778 g:=TOmfRecord_GRPDEF.Create; 779 Groups.Add(group.Name,g); 780 g.GroupNameIndex:=LNames.Add(group.Name); 781 SetLength(seglist,Length(group.members)); 782 for I:=Low(group.members) to High(group.members) do 783 seglist[I]:=group.members[I].index; 784 g.SegmentList:=seglist; 785 end; 786 787 procedure TOmfObjOutput.WriteSections(Data: TObjData); 788 var 789 i:longint; 790 sec:TObjSection; 791 begin 792 for i:=0 to Data.ObjSectionList.Count-1 do 793 begin 794 sec:=TObjSection(Data.ObjSectionList[i]); 795 WriteSectionContentAndFixups(sec); 796 WriteLinNumRecords(TOmfObjSection(sec)); 797 end; 798 end; 799 800 procedure TOmfObjOutput.WriteSectionContentAndFixups(sec: TObjSection); 801 const 802 MaxChunkSize=$3fa; 803 var 804 RawRecord: TOmfRawRecord; 805 ChunkStart,ChunkLen: DWord; 806 ChunkFixupStart,ChunkFixupEnd: Integer; 807 SegIndex: Integer; 808 NextOfs: Integer; 809 Is32BitLEDATA: Boolean; 810 I: Integer; 811 begin 812 if (oso_data in sec.SecOptions) then 813 begin 814 if sec.Data=nil then 815 internalerror(200403073); 816 for I:=0 to sec.ObjRelocations.Count-1 do 817 TOmfRelocation(sec.ObjRelocations[I]).BuildOmfFixup; 818 SegIndex:=Segments.FindIndexOf(sec.Name); 819 RawRecord:=TOmfRawRecord.Create; 820 sec.data.seek(0); 821 ChunkFixupStart:=0; 822 ChunkFixupEnd:=-1; 823 ChunkStart:=0; 824 ChunkLen:=Min(MaxChunkSize, sec.Data.size-ChunkStart); 825 while ChunkLen>0 do 826 begin 827 { find last fixup in the chunk } 828 while (ChunkFixupEnd<(sec.ObjRelocations.Count-1)) and 829 (TOmfRelocation(sec.ObjRelocations[ChunkFixupEnd+1]).DataOffset<(ChunkStart+ChunkLen)) do 830 inc(ChunkFixupEnd); 831 { check if last chunk is crossing the chunk boundary, and trim ChunkLen if necessary } 832 if (ChunkFixupEnd>=ChunkFixupStart) and 833 ((TOmfRelocation(sec.ObjRelocations[ChunkFixupEnd]).DataOffset+ 834 TOmfRelocation(sec.ObjRelocations[ChunkFixupEnd]).OmfFixup.LocationSize)>(ChunkStart+ChunkLen)) then 835 begin 836 ChunkLen:=TOmfRelocation(sec.ObjRelocations[ChunkFixupEnd]).DataOffset-ChunkStart; 837 Dec(ChunkFixupEnd); 838 end; 839 { write LEDATA record } 840 Is32BitLEDATA:=TOmfObjSection(sec).Use=suUse32; 841 if Is32BitLEDATA then 842 RawRecord.RecordType:=RT_LEDATA32 843 else 844 RawRecord.RecordType:=RT_LEDATA; 845 NextOfs:=RawRecord.WriteIndexedRef(0,SegIndex); 846 if Is32BitLEDATA then 847 begin 848 RawRecord.RawData[NextOfs]:=Byte(ChunkStart); 849 RawRecord.RawData[NextOfs+1]:=Byte(ChunkStart shr 8); 850 RawRecord.RawData[NextOfs+2]:=Byte(ChunkStart shr 16); 851 RawRecord.RawData[NextOfs+3]:=Byte(ChunkStart shr 24); 852 Inc(NextOfs,4); 853 end 854 else 855 begin 856 if ChunkStart>$ffff then 857 internalerror(2018052201); 858 RawRecord.RawData[NextOfs]:=Byte(ChunkStart); 859 RawRecord.RawData[NextOfs+1]:=Byte(ChunkStart shr 8); 860 Inc(NextOfs,2); 861 end; 862 sec.data.read(RawRecord.RawData[NextOfs], ChunkLen); 863 Inc(NextOfs, ChunkLen); 864 RawRecord.RecordLength:=NextOfs+1; 865 RawRecord.CalculateChecksumByte; 866 RawRecord.WriteTo(FWriter); 867 { write FIXUPP record } 868 if ChunkFixupEnd>=ChunkFixupStart then 869 begin 870 RawRecord.RecordType:=RT_FIXUPP; 871 NextOfs:=0; 872 for I:=ChunkFixupStart to ChunkFixupEnd do 873 begin 874 TOmfRelocation(sec.ObjRelocations[I]).OmfFixup.DataRecordStartOffset:=ChunkStart; 875 NextOfs:=TOmfRelocation(sec.ObjRelocations[I]).OmfFixup.WriteAt(RawRecord,NextOfs); 876 end; 877 RawRecord.RecordLength:=NextOfs+1; 878 RawRecord.CalculateChecksumByte; 879 RawRecord.WriteTo(FWriter); 880 end; 881 { prepare next chunk } 882 Inc(ChunkStart, ChunkLen); 883 ChunkLen:=Min(MaxChunkSize, sec.Data.size-ChunkStart); 884 ChunkFixupStart:=ChunkFixupEnd+1; 885 end; 886 RawRecord.Free; 887 end; 888 end; 889 890 procedure TOmfObjOutput.WriteLinNumRecords(sec: TOmfObjSection); 891 var 892 SegIndex: Integer; 893 RawRecord: TOmfRawRecord; 894 LinNumRec: TOmfRecord_LINNUM_MsLink; 895 begin 896 if (oso_data in sec.SecOptions) then 897 begin 898 if sec.Data=nil then 899 internalerror(200403073); 900 if sec.LinNumEntries.Count=0 then 901 exit; 902 SegIndex:=Segments.FindIndexOf(sec.Name); 903 RawRecord:=TOmfRawRecord.Create; 904 LinNumRec:=TOmfRecord_LINNUM_MsLink.Create; 905 LinNumRec.BaseGroup:=0; 906 LinNumRec.BaseSegment:=SegIndex; 907 LinNumRec.LineNumberList:=sec.LinNumEntries; 908 909 while LinNumRec.NextIndex<sec.LinNumEntries.Count do 910 begin 911 LinNumRec.EncodeTo(RawRecord); 912 RawRecord.WriteTo(FWriter); 913 end; 914 915 LinNumRec.Free; 916 RawRecord.Free; 917 end; 918 end; 919 920 procedure TOmfObjOutput.section_count_sections(p: TObject; arg: pointer); 921 begin 922 TOmfObjSection(p).index:=pinteger(arg)^; 923 inc(pinteger(arg)^); 924 end; 925 926 procedure TOmfObjOutput.group_count_groups(p: TObject; arg: pointer); 927 begin 928 TObjSectionGroup(p).index:=pinteger(arg)^; 929 inc(pinteger(arg)^); 930 end; 931 932 procedure TOmfObjOutput.WritePUBDEFs(Data: TObjData); 933 var 934 PubNamesForSection: array of TFPHashObjectList; 935 i: Integer; 936 objsym: TObjSymbol; 937 PublicNameElem: TOmfPublicNameElement; 938 RawRecord: TOmfRawRecord; 939 PubDefRec: TOmfRecord_PUBDEF; 940 begin 941 PubNamesForSection:=nil; 942 RawRecord:=TOmfRawRecord.Create; 943 SetLength(PubNamesForSection,Data.ObjSectionList.Count); 944 for i:=0 to Data.ObjSectionList.Count-1 do 945 PubNamesForSection[i]:=TFPHashObjectList.Create; 946 947 for i:=0 to Data.ObjSymbolList.Count-1 do 948 begin 949 objsym:=TObjSymbol(Data.ObjSymbolList[i]); 950 if objsym.bind=AB_GLOBAL then 951 begin 952 PublicNameElem:=TOmfPublicNameElement.Create(PubNamesForSection[objsym.objsection.index-1],objsym.Name); 953 PublicNameElem.PublicOffset:=objsym.offset; 954 PublicNameElem.IsLocal:=False; 955 end 956 else if objsym.bind=AB_LOCAL then 957 begin 958 PublicNameElem:=TOmfPublicNameElement.Create(PubNamesForSection[objsym.objsection.index-1],objsym.Name); 959 PublicNameElem.PublicOffset:=objsym.offset; 960 PublicNameElem.IsLocal:=True; 961 end 962 end; 963 964 for i:=0 to Data.ObjSectionList.Count-1 do 965 if PubNamesForSection[i].Count>0 then 966 begin 967 PubDefRec:=TOmfRecord_PUBDEF.Create; 968 PubDefRec.BaseSegmentIndex:=i+1; 969 if TOmfObjSection(Data.ObjSectionList[i]).PrimaryGroup<>nil then 970 PubDefRec.BaseGroupIndex:=Groups.FindIndexOf(TOmfObjSection(Data.ObjSectionList[i]).PrimaryGroup.Name) 971 else 972 PubDefRec.BaseGroupIndex:=0; 973 PubDefRec.PublicNames:=PubNamesForSection[i]; 974 while PubDefRec.NextIndex<PubDefRec.PublicNames.Count do 975 begin 976 PubDefRec.EncodeTo(RawRecord); 977 RawRecord.WriteTo(FWriter); 978 end; 979 PubDefRec.Free; 980 end; 981 982 for i:=0 to Data.ObjSectionList.Count-1 do 983 FreeAndNil(PubNamesForSection[i]); 984 RawRecord.Free; 985 end; 986 987 procedure TOmfObjOutput.WriteEXTDEFs(Data: TObjData); 988 var 989 ExtNames: TFPHashObjectList; 990 RawRecord: TOmfRawRecord; 991 i,idx: Integer; 992 objsym: TObjSymbol; 993 ExternalNameElem: TOmfExternalNameElement; 994 ExtDefRec: TOmfRecord_EXTDEF; 995 begin 996 ExtNames:=TFPHashObjectList.Create; 997 RawRecord:=TOmfRawRecord.Create; 998 999 idx:=1; 1000 for i:=0 to Data.ObjSymbolList.Count-1 do 1001 begin 1002 objsym:=TObjSymbol(Data.ObjSymbolList[i]); 1003 if objsym.bind=AB_EXTERNAL then 1004 begin 1005 ExternalNameElem:=TOmfExternalNameElement.Create(ExtNames,objsym.Name); 1006 objsym.symidx:=idx; 1007 Inc(idx); 1008 end; 1009 end; 1010 1011 if ExtNames.Count>0 then 1012 begin 1013 ExtDefRec:=TOmfRecord_EXTDEF.Create; 1014 ExtDefRec.ExternalNames:=ExtNames; 1015 while ExtDefRec.NextIndex<ExtDefRec.ExternalNames.Count do 1016 begin 1017 ExtDefRec.EncodeTo(RawRecord); 1018 RawRecord.WriteTo(FWriter); 1019 end; 1020 ExtDefRec.Free; 1021 end; 1022 1023 ExtNames.Free; 1024 RawRecord.Free; 1025 end; 1026 TOmfObjOutput.writeDatanull1027 function TOmfObjOutput.writeData(Data:TObjData):boolean; 1028 var 1029 RawRecord: TOmfRawRecord; 1030 Header: TOmfRecord_THEADR; 1031 Translator_COMENT: TOmfRecord_COMENT; 1032 DebugFormat_COMENT: TOmfRecord_COMENT; 1033 LinkPassSeparator_COMENT: TOmfRecord_COMENT; 1034 LNamesRec: TOmfRecord_LNAMES; 1035 ModEnd: TOmfRecord_MODEND; 1036 I: Integer; 1037 SegDef: TOmfRecord_SEGDEF; 1038 GrpDef: TOmfRecord_GRPDEF; 1039 nsections,ngroups: Integer; 1040 objsym: TObjSymbol; 1041 begin 1042 { calc amount of sections we have and set their index, starting with 1 } 1043 nsections:=1; 1044 data.ObjSectionList.ForEachCall(@section_count_sections,@nsections); 1045 { calc amount of groups we have and set their index, starting with 1 } 1046 ngroups:=1; 1047 data.GroupsList.ForEachCall(@group_count_groups,@ngroups); 1048 { maximum amount of sections supported in the omf format is $7fff } 1049 if (nsections-1)>$7fff then 1050 internalerror(2015040701); 1051 { maximum amount of groups supported in the omf format is $7fff } 1052 if (ngroups-1)>$7fff then 1053 internalerror(2018062101); 1054 1055 { write header record } 1056 RawRecord:=TOmfRawRecord.Create; 1057 Header:=TOmfRecord_THEADR.Create; 1058 if cs_debuginfo in current_settings.moduleswitches then 1059 Header.ModuleName:=TOmfObjData(Data).MainSource 1060 else 1061 Header.ModuleName:=Data.Name; 1062 Header.EncodeTo(RawRecord); 1063 RawRecord.WriteTo(FWriter); 1064 Header.Free; 1065 1066 { write translator COMENT header } 1067 Translator_COMENT:=TOmfRecord_COMENT.Create; 1068 Translator_COMENT.CommentClass:=CC_Translator; 1069 Translator_COMENT.CommentString:='FPC '+full_version_string+ 1070 ' ['+date_string+'] for '+target_cpu_string+' - '+target_info.shortname; 1071 Translator_COMENT.EncodeTo(RawRecord); 1072 RawRecord.WriteTo(FWriter); 1073 Translator_COMENT.Free; 1074 1075 if (target_dbg.id=dbg_codeview) or 1076 ((ds_dwarf_omf_linnum in current_settings.debugswitches) and 1077 (target_dbg.id in [dbg_dwarf2,dbg_dwarf3,dbg_dwarf4])) then 1078 begin 1079 DebugFormat_COMENT:=TOmfRecord_COMENT.Create; 1080 DebugFormat_COMENT.CommentClass:=CC_NewOmfExtension; 1081 DebugFormat_COMENT.CommentString:=''; 1082 DebugFormat_COMENT.EncodeTo(RawRecord); 1083 RawRecord.WriteTo(FWriter); 1084 DebugFormat_COMENT.Free; 1085 end; 1086 1087 LNames.Clear; 1088 LNames.Add(''); { insert an empty string, which has index 1 } 1089 FSegments.Clear; 1090 FSegments.Add('',nil); 1091 FGroups.Clear; 1092 FGroups.Add('',nil); 1093 1094 for i:=0 to Data.GroupsList.Count-1 do 1095 AddGroup(TObjSectionGroup(Data.GroupsList[I])); 1096 for i:=0 to Data.ObjSectionList.Count-1 do 1097 with TOmfObjSection(Data.ObjSectionList[I]) do 1098 AddSegment(Name,ClassName,OverlayName,OmfAlignment,Combination,Use,Size); 1099 1100 { write LNAMES record(s) } 1101 LNamesRec:=TOmfRecord_LNAMES.Create; 1102 LNamesRec.Names:=LNames; 1103 while LNamesRec.NextIndex<=LNames.Count do 1104 begin 1105 LNamesRec.EncodeTo(RawRecord); 1106 RawRecord.WriteTo(FWriter); 1107 end; 1108 LNamesRec.Free; 1109 1110 { write SEGDEF record(s) } 1111 for I:=1 to Segments.Count-1 do 1112 begin 1113 SegDef:=TOmfRecord_SEGDEF(Segments[I]); 1114 SegDef.EncodeTo(RawRecord); 1115 RawRecord.WriteTo(FWriter); 1116 end; 1117 1118 { write GRPDEF record(s) } 1119 for I:=1 to Groups.Count-1 do 1120 begin 1121 GrpDef:=TOmfRecord_GRPDEF(Groups[I]); 1122 GrpDef.EncodeTo(RawRecord); 1123 RawRecord.WriteTo(FWriter); 1124 end; 1125 1126 { write PUBDEF record(s) } 1127 WritePUBDEFs(Data); 1128 1129 { write EXTDEF record(s) } 1130 WriteEXTDEFs(Data); 1131 1132 { write link pass separator } 1133 LinkPassSeparator_COMENT:=TOmfRecord_COMENT.Create; 1134 LinkPassSeparator_COMENT.CommentClass:=CC_LinkPassSeparator; 1135 LinkPassSeparator_COMENT.CommentString:=#1; 1136 LinkPassSeparator_COMENT.NoList:=True; 1137 LinkPassSeparator_COMENT.EncodeTo(RawRecord); 1138 RawRecord.WriteTo(FWriter); 1139 LinkPassSeparator_COMENT.Free; 1140 1141 { write section content, interleaved with fixups } 1142 WriteSections(Data); 1143 1144 { write MODEND record } 1145 ModEnd:=TOmfRecord_MODEND.Create; 1146 ModEnd.EncodeTo(RawRecord); 1147 RawRecord.WriteTo(FWriter); 1148 ModEnd.Free; 1149 1150 RawRecord.Free; 1151 result:=true; 1152 end; 1153 1154 constructor TOmfObjOutput.create(AWriter:TObjectWriter); 1155 begin 1156 inherited create(AWriter); 1157 cobjdata:=TOmfObjData; 1158 FLNames:=TOmfOrderedNameCollection.Create(False); 1159 FSegments:=TFPHashObjectList.Create; 1160 FSegments.Add('',nil); 1161 FGroups:=TFPHashObjectList.Create; 1162 FGroups.Add('',nil); 1163 end; 1164 1165 destructor TOmfObjOutput.Destroy; 1166 begin 1167 FGroups.Free; 1168 FSegments.Free; 1169 FLNames.Free; 1170 inherited Destroy; 1171 end; 1172 1173 procedure TOmfObjOutput.WriteDllImport(const dllname,afuncname,mangledname: string; ordnr: longint; isvar: boolean); 1174 var 1175 RawRecord: TOmfRawRecord; 1176 Header: TOmfRecord_THEADR; 1177 DllImport_COMENT: TOmfRecord_COMENT; 1178 ModEnd: TOmfRecord_MODEND; 1179 begin 1180 { write header record } 1181 RawRecord:=TOmfRawRecord.Create; 1182 Header:=TOmfRecord_THEADR.Create; 1183 Header.ModuleName:=mangledname; 1184 Header.EncodeTo(RawRecord); 1185 RawRecord.WriteTo(FWriter); 1186 Header.Free; 1187 1188 { write IMPDEF record } 1189 DllImport_COMENT:=TOmfRecord_COMENT.Create; 1190 DllImport_COMENT.CommentClass:=CC_OmfExtension; 1191 if ordnr <= 0 then 1192 begin 1193 if afuncname=mangledname then 1194 DllImport_COMENT.CommentString:=#1#0+Chr(Length(mangledname))+mangledname+Chr(Length(dllname))+dllname+#0 1195 else 1196 DllImport_COMENT.CommentString:=#1#0+Chr(Length(mangledname))+mangledname+Chr(Length(dllname))+dllname+Chr(Length(afuncname))+afuncname; 1197 end 1198 else 1199 DllImport_COMENT.CommentString:=#1#1+Chr(Length(mangledname))+mangledname+Chr(Length(dllname))+dllname+Chr(ordnr and $ff)+Chr((ordnr shr 8) and $ff); 1200 DllImport_COMENT.EncodeTo(RawRecord); 1201 RawRecord.WriteTo(FWriter); 1202 DllImport_COMENT.Free; 1203 1204 { write MODEND record } 1205 ModEnd:=TOmfRecord_MODEND.Create; 1206 ModEnd.EncodeTo(RawRecord); 1207 RawRecord.WriteTo(FWriter); 1208 ModEnd.Free; 1209 1210 RawRecord.Free; 1211 end; 1212 1213 {**************************************************************************** 1214 TOmfObjInput 1215 ****************************************************************************} 1216 TOmfObjInput.PeekNextRecordTypenull1217 function TOmfObjInput.PeekNextRecordType: Byte; 1218 var 1219 OldPos: LongInt; 1220 begin 1221 OldPos:=FReader.Pos; 1222 if not FReader.read(Result, 1) then 1223 begin 1224 InputError('Unexpected end of file'); 1225 Result:=0; 1226 exit; 1227 end; 1228 FReader.seek(OldPos); 1229 end; 1230 TOmfObjInput.ReadLNamesnull1231 function TOmfObjInput.ReadLNames(RawRec: TOmfRawRecord): Boolean; 1232 var 1233 LNamesRec: TOmfRecord_LNAMES; 1234 begin 1235 Result:=False; 1236 LNamesRec:=TOmfRecord_LNAMES.Create; 1237 LNamesRec.Names:=LNames; 1238 LNamesRec.DecodeFrom(RawRec); 1239 LNamesRec.Free; 1240 Result:=True; 1241 end; 1242 TOmfObjInput.ReadSegDefnull1243 function TOmfObjInput.ReadSegDef(RawRec: TOmfRawRecord; objdata: TObjData): Boolean; 1244 var 1245 SegDefRec: TOmfRecord_SEGDEF; 1246 SegmentName,SegClassName,OverlayName: string; 1247 SecAlign: LongInt; 1248 secoptions: TObjSectionOptions; 1249 objsec: TOmfObjSection; 1250 begin 1251 Result:=False; 1252 SegDefRec:=TOmfRecord_SEGDEF.Create; 1253 SegDefRec.DecodeFrom(RawRec); 1254 if (SegDefRec.SegmentNameIndex<1) or (SegDefRec.SegmentNameIndex>LNames.Count) then 1255 begin 1256 InputError('Segment name index out of range'); 1257 SegDefRec.Free; 1258 exit; 1259 end; 1260 SegmentName:=LNames[SegDefRec.SegmentNameIndex]; 1261 if (SegDefRec.ClassNameIndex<1) or (SegDefRec.ClassNameIndex>LNames.Count) then 1262 begin 1263 InputError('Segment class name index out of range'); 1264 SegDefRec.Free; 1265 exit; 1266 end; 1267 SegClassName:=LNames[SegDefRec.ClassNameIndex]; 1268 if (SegDefRec.OverlayNameIndex<1) or (SegDefRec.OverlayNameIndex>LNames.Count) then 1269 begin 1270 InputError('Segment overlay name index out of range'); 1271 SegDefRec.Free; 1272 exit; 1273 end; 1274 OverlayName:=LNames[SegDefRec.OverlayNameIndex]; 1275 SecAlign:=1; // otherwise warning prohibits compilation 1276 case SegDefRec.Alignment of 1277 saRelocatableByteAligned: 1278 SecAlign:=1; 1279 saRelocatableWordAligned: 1280 SecAlign:=2; 1281 saRelocatableParaAligned: 1282 SecAlign:=16; 1283 saRelocatableDWordAligned: 1284 SecAlign:=4; 1285 saRelocatablePageAligned: 1286 SecAlign:=256; 1287 saNotSupported: 1288 SecAlign:=4096; 1289 saAbsolute: 1290 begin 1291 InputError('Absolute segment alignment not supported'); 1292 SegDefRec.Free; 1293 exit; 1294 end; 1295 saNotDefined: 1296 begin 1297 InputError('Invalid (unsupported/undefined) OMF segment alignment'); 1298 SegDefRec.Free; 1299 exit; 1300 end; 1301 end; 1302 if not CaseSensitiveSegments then 1303 begin 1304 SegmentName:=UpCase(SegmentName); 1305 SegClassName:=UpCase(SegClassName); 1306 OverlayName:=UpCase(OverlayName); 1307 end; 1308 { hack for supporting object modules, generated by Borland's BINOBJ tool } 1309 if (SegClassName='') and (SegmentName='CODE') then 1310 begin 1311 SegmentName:=InputFileName; 1312 SegClassName:='CODE'; 1313 end; 1314 secoptions:=[]; 1315 objsec:=TOmfObjSection(objdata.createsection(SegmentName+'||'+SegClassName,SecAlign,secoptions,false)); 1316 objsec.FClassName:=SegClassName; 1317 objsec.FOverlayName:=OverlayName; 1318 objsec.FCombination:=SegDefRec.Combination; 1319 objsec.FUse:=SegDefRec.Use; 1320 if SegDefRec.SegmentLength>High(objsec.Size) then 1321 begin 1322 InputError('Segment too large'); 1323 SegDefRec.Free; 1324 exit; 1325 end; 1326 objsec.Size:=SegDefRec.SegmentLength; 1327 if SegClassName='DWARF' then 1328 objsec.SecOptions:=objsec.SecOptions+[oso_debug]; 1329 if (SegClassName='HEAP') or 1330 (SegClassName='STACK') or (SegDefRec.Combination=scStack) or 1331 (SegClassName='BEGDATA') or 1332 (SegmentName='FPC') then 1333 objsec.SecOptions:=objsec.SecOptions+[oso_keep]; 1334 SegDefRec.Free; 1335 Result:=True; 1336 end; 1337 TOmfObjInput.ReadGrpDefnull1338 function TOmfObjInput.ReadGrpDef(RawRec: TOmfRawRecord; objdata: TObjData): Boolean; 1339 var 1340 GrpDefRec: TOmfRecord_GRPDEF; 1341 GroupName: string; 1342 SecGroup: TObjSectionGroup; 1343 i,SegIndex: Integer; 1344 begin 1345 Result:=False; 1346 GrpDefRec:=TOmfRecord_GRPDEF.Create; 1347 GrpDefRec.DecodeFrom(RawRec); 1348 if (GrpDefRec.GroupNameIndex<1) or (GrpDefRec.GroupNameIndex>LNames.Count) then 1349 begin 1350 InputError('Group name index out of range'); 1351 GrpDefRec.Free; 1352 exit; 1353 end; 1354 GroupName:=LNames[GrpDefRec.GroupNameIndex]; 1355 if not CaseSensitiveSegments then 1356 GroupName:=UpCase(GroupName); 1357 SecGroup:=objdata.createsectiongroup(GroupName); 1358 SetLength(SecGroup.members,Length(GrpDefRec.SegmentList)); 1359 for i:=0 to Length(GrpDefRec.SegmentList)-1 do 1360 begin 1361 SegIndex:=GrpDefRec.SegmentList[i]; 1362 if (SegIndex<1) or (SegIndex>objdata.ObjSectionList.Count) then 1363 begin 1364 InputError('Segment name index out of range in group definition'); 1365 GrpDefRec.Free; 1366 exit; 1367 end; 1368 SecGroup.members[i]:=TOmfObjSection(objdata.ObjSectionList[SegIndex-1]); 1369 end; 1370 GrpDefRec.Free; 1371 Result:=True; 1372 end; 1373 TOmfObjInput.ReadExtDefnull1374 function TOmfObjInput.ReadExtDef(RawRec: TOmfRawRecord; objdata: TObjData): Boolean; 1375 var 1376 ExtDefRec: TOmfRecord_EXTDEF; 1377 ExtDefElem: TOmfExternalNameElement; 1378 OldCount,NewCount,i: Integer; 1379 objsym: TObjSymbol; 1380 symname: TSymStr; 1381 begin 1382 Result:=False; 1383 ExtDefRec:=TOmfRecord_EXTDEF.Create; 1384 ExtDefRec.ExternalNames:=ExtDefs; 1385 OldCount:=ExtDefs.Count; 1386 ExtDefRec.DecodeFrom(RawRec); 1387 NewCount:=ExtDefs.Count; 1388 for i:=OldCount to NewCount-1 do 1389 begin 1390 ExtDefElem:=TOmfExternalNameElement(ExtDefs[i]); 1391 symname:=ExtDefElem.Name; 1392 if not CaseSensitiveSymbols then 1393 symname:=UpCase(symname); 1394 objsym:=objdata.CreateSymbol(symname); 1395 objsym.bind:=AB_EXTERNAL; 1396 objsym.typ:=AT_FUNCTION; objsym.objsectionnull1397 objsym.objsection:=nil; 1398 objsym.offset:=0; 1399 objsym.size:=0; 1400 end; 1401 ExtDefRec.Free; 1402 Result:=True; 1403 end; 1404 TOmfObjInput.ReadPubDefnull1405 function TOmfObjInput.ReadPubDef(RawRec: TOmfRawRecord; objdata:TObjData): Boolean; 1406 var 1407 PubDefRec: TOmfRecord_PUBDEF; 1408 PubDefElem: TOmfPublicNameElement; 1409 OldCount,NewCount,i: Integer; 1410 basegroup: TObjSectionGroup; 1411 objsym: TObjSymbol; 1412 objsec: TOmfObjSection; 1413 symname: TSymStr; 1414 begin 1415 Result:=False; 1416 PubDefRec:=TOmfRecord_PUBDEF.Create; 1417 PubDefRec.PublicNames:=PubDefs; 1418 OldCount:=PubDefs.Count; 1419 PubDefRec.DecodeFrom(RawRec); 1420 NewCount:=PubDefs.Count; 1421 if (PubDefRec.BaseGroupIndex<0) or (PubDefRec.BaseGroupIndex>objdata.GroupsList.Count) then 1422 begin 1423 InputError('Public symbol''s group name index out of range'); 1424 PubDefRec.Free; 1425 exit; 1426 end; 1427 if PubDefRec.BaseGroupIndex<>0 then 1428 basegroup:=TObjSectionGroup(objdata.GroupsList[PubDefRec.BaseGroupIndex-1]) 1429 else 1430 basegroup:=nil; 1431 if (PubDefRec.BaseSegmentIndex<0) or (PubDefRec.BaseSegmentIndex>objdata.ObjSectionList.Count) then 1432 begin 1433 InputError('Public symbol''s segment name index out of range'); 1434 PubDefRec.Free; 1435 exit; 1436 end; 1437 if PubDefRec.BaseSegmentIndex=0 then 1438 begin 1439 InputError('Public symbol uses absolute addressing, which is not supported by this linker'); 1440 PubDefRec.Free; 1441 exit; 1442 end; 1443 objsec:=TOmfObjSection(objdata.ObjSectionList[PubDefRec.BaseSegmentIndex-1]); 1444 for i:=OldCount to NewCount-1 do 1445 begin 1446 PubDefElem:=TOmfPublicNameElement(PubDefs[i]); 1447 symname:=PubDefElem.Name; 1448 if not CaseSensitiveSymbols then 1449 symname:=UpCase(symname); 1450 objsym:=objdata.CreateSymbol(symname); 1451 if PubDefElem.IsLocal then 1452 objsym.bind:=AB_LOCAL 1453 else 1454 objsym.bind:=AB_GLOBAL; 1455 objsym.typ:=AT_FUNCTION; objsym.groupnull1456 objsym.group:=basegroup; 1457 objsym.objsection:=objsec; 1458 objsym.offset:=PubDefElem.PublicOffset; 1459 objsym.size:=0; 1460 end; 1461 PubDefRec.Free; 1462 Result:=True; 1463 end; 1464 TOmfObjInput.ReadModEndnull1465 function TOmfObjInput.ReadModEnd(RawRec: TOmfRawRecord; objdata:TObjData): Boolean; 1466 var 1467 ModEndRec: TOmfRecord_MODEND; 1468 objsym: TObjSymbol; 1469 objsec: TOmfObjSection; 1470 basegroup: TObjSectionGroup; 1471 begin 1472 Result:=False; 1473 ModEndRec:=TOmfRecord_MODEND.Create; 1474 ModEndRec.DecodeFrom(RawRec); 1475 if ModEndRec.HasStartAddress then 1476 begin 1477 if not ModEndRec.LogicalStartAddress then 1478 begin 1479 InputError('Physical start address not supported'); 1480 ModEndRec.Free; 1481 exit; 1482 end; 1483 if not (ModEndRec.TargetMethod in [ftmSegmentIndex,ftmSegmentIndexNoDisp]) then 1484 begin 1485 InputError('Target method for start address other than "Segment Index" is not supported'); 1486 ModEndRec.Free; 1487 exit; 1488 end; 1489 if (ModEndRec.TargetDatum<1) or (ModEndRec.TargetDatum>objdata.ObjSectionList.Count) then 1490 begin 1491 InputError('Segment name index for start address out of range'); 1492 ModEndRec.Free; 1493 exit; 1494 end; 1495 case ModEndRec.FrameMethod of 1496 ffmSegmentIndex: 1497 begin 1498 if (ModEndRec.FrameDatum<1) or (ModEndRec.FrameDatum>objdata.ObjSectionList.Count) then 1499 begin 1500 InputError('Frame segment name index for start address out of range'); 1501 ModEndRec.Free; 1502 exit; 1503 end; 1504 if ModEndRec.FrameDatum<>ModEndRec.TargetDatum then 1505 begin 1506 InputError('Frame segment different than target segment is not supported supported for start address'); 1507 ModEndRec.Free; 1508 exit; 1509 end; 1510 basegroup:=nil; 1511 end; 1512 ffmGroupIndex: 1513 begin 1514 if (ModEndRec.FrameDatum<1) or (ModEndRec.FrameDatum>objdata.GroupsList.Count) then 1515 begin 1516 InputError('Frame group name index for start address out of range'); 1517 ModEndRec.Free; 1518 exit; 1519 end; 1520 basegroup:=TObjSectionGroup(objdata.GroupsList[ModEndRec.FrameDatum-1]); 1521 end; 1522 else 1523 begin 1524 InputError('Frame method for start address other than "Segment Index" or "Group Index" is not supported'); 1525 ModEndRec.Free; 1526 exit; 1527 end; 1528 end; 1529 objsec:=TOmfObjSection(objdata.ObjSectionList[ModEndRec.TargetDatum-1]); 1530 1531 objsym:=objdata.CreateSymbol('..start'); 1532 objsym.bind:=AB_GLOBAL; 1533 objsym.typ:=AT_FUNCTION; objsym.groupnull1534 objsym.group:=basegroup; 1535 objsym.objsection:=objsec; 1536 objsym.offset:=ModEndRec.TargetDisplacement; 1537 objsym.size:=0; 1538 end; 1539 ModEndRec.Free; 1540 Result:=True; 1541 end; 1542 TOmfObjInput.ReadLeOrLiDataAndFixupsnull1543 function TOmfObjInput.ReadLeOrLiDataAndFixups(RawRec: TOmfRawRecord; objdata: TObjData): Boolean; 1544 var 1545 Is32Bit: Boolean; 1546 NextOfs: Integer; 1547 SegmentIndex: Integer; 1548 EnumeratedDataOffset: DWord; 1549 BlockLength: Integer; 1550 objsec: TOmfObjSection; 1551 FixupRawRec: TOmfRawRecord=nil; 1552 Fixup: TOmfSubRecord_FIXUP; 1553 Thread: TOmfSubRecord_THREAD; 1554 FixuppWithoutLeOrLiData: Boolean=False; 1555 begin 1556 Result:=False; 1557 case RawRec.RecordType of 1558 RT_LEDATA,RT_LEDATA32: 1559 begin 1560 Is32Bit:=RawRec.RecordType=RT_LEDATA32; 1561 NextOfs:=RawRec.ReadIndexedRef(0,SegmentIndex); 1562 if Is32Bit then 1563 begin 1564 if (NextOfs+3)>=RawRec.RecordLength then 1565 internalerror(2015040504); 1566 EnumeratedDataOffset := RawRec.RawData[NextOfs]+ 1567 (RawRec.RawData[NextOfs+1] shl 8)+ 1568 (RawRec.RawData[NextOfs+2] shl 16)+ 1569 (RawRec.RawData[NextOfs+3] shl 24); 1570 Inc(NextOfs,4); 1571 end 1572 else 1573 begin 1574 if (NextOfs+1)>=RawRec.RecordLength then 1575 internalerror(2015040504); 1576 EnumeratedDataOffset := RawRec.RawData[NextOfs]+ 1577 (RawRec.RawData[NextOfs+1] shl 8); 1578 Inc(NextOfs,2); 1579 end; 1580 BlockLength:=RawRec.RecordLength-NextOfs-1; 1581 if BlockLength<0 then 1582 internalerror(2015060501); 1583 if BlockLength>1024 then 1584 begin 1585 InputError('LEDATA contains more than 1024 bytes of data'); 1586 exit; 1587 end; 1588 1589 if (SegmentIndex<1) or (SegmentIndex>objdata.ObjSectionList.Count) then 1590 begin 1591 InputError('Segment index in LEDATA field is out of range'); 1592 exit; 1593 end; 1594 objsec:=TOmfObjSection(objdata.ObjSectionList[SegmentIndex-1]); 1595 1596 objsec.SecOptions:=objsec.SecOptions+[oso_Data]; 1597 if (objsec.Data.Size>EnumeratedDataOffset) then 1598 begin 1599 InputError('LEDATA enumerated data offset field out of sequence'); 1600 exit; 1601 end; 1602 if (EnumeratedDataOffset+BlockLength)>objsec.Size then 1603 begin 1604 InputError('LEDATA goes beyond the segment size declared in the SEGDEF record'); 1605 exit; 1606 end; 1607 objsec.Data.seek(EnumeratedDataOffset); 1608 objsec.Data.write(RawRec.RawData[NextOfs],BlockLength); 1609 end; 1610 RT_LIDATA,RT_LIDATA32: 1611 begin 1612 InputError('LIDATA records are not supported'); 1613 exit; 1614 end; 1615 RT_FIXUPP,RT_FIXUPP32: 1616 begin 1617 FixuppWithoutLeOrLiData:=True; 1618 { a hack, used to indicate, that we must process this record } 1619 { (RawRec) first in the FIXUPP record processing loop that follows } 1620 FixupRawRec:=RawRec; 1621 end; 1622 else 1623 internalerror(2015040301); 1624 end; 1625 1626 { also read all the FIXUPP records that may follow; } 1627 { (FixupRawRec=RawRec) indicates that we must process RawRec first, but } 1628 { without freeing it } 1629 while (FixupRawRec=RawRec) or (PeekNextRecordType in [RT_FIXUPP,RT_FIXUPP32]) do 1630 begin 1631 if FixupRawRec<>RawRec then 1632 begin 1633 FixupRawRec:=TOmfRawRecord.Create; 1634 FixupRawRec.ReadFrom(FReader); 1635 if not FRawRecord.VerifyChecksumByte then 1636 begin 1637 InputError('Invalid checksum in OMF record'); 1638 FixupRawRec.Free; 1639 exit; 1640 end; 1641 end; 1642 NextOfs:=0; 1643 Thread:=TOmfSubRecord_THREAD.Create; 1644 Fixup:=TOmfSubRecord_FIXUP.Create; 1645 Fixup.Is32Bit:=FixupRawRec.RecordType=RT_FIXUPP32; 1646 Fixup.DataRecordStartOffset:=EnumeratedDataOffset; 1647 while NextOfs<(FixupRawRec.RecordLength-1) do 1648 begin 1649 if (FixupRawRec.RawData[NextOfs] and $80)<>0 then 1650 begin 1651 { FIXUP subrecord } 1652 if FixuppWithoutLeOrLiData then 1653 begin 1654 InputError('FIXUP subrecord without previous LEDATA or LIDATA record'); 1655 Fixup.Free; 1656 Thread.Free; 1657 if FixupRawRec<>RawRec then 1658 FixupRawRec.Free; 1659 exit; 1660 end; 1661 NextOfs:=Fixup.ReadAt(FixupRawRec,NextOfs); 1662 Fixup.ResolveByThread(FFixupThreads); 1663 ImportOmfFixup(objdata,objsec,Fixup); 1664 end 1665 else 1666 begin 1667 { THREAD subrecord } 1668 NextOfs:=Thread.ReadAt(FixupRawRec,NextOfs); 1669 Thread.ApplyTo(FFixupThreads); 1670 end; 1671 end; 1672 Fixup.Free; 1673 Thread.Free; 1674 if FixupRawRec<>RawRec then 1675 FixupRawRec.Free; 1676 { always set it to null, so that we read the next record on the next } 1677 { loop iteration (this ensures that FixupRawRec<>RawRec, without } 1678 { freeing RawRec) } 1679 FixupRawRec:=nil; 1680 end; 1681 Result:=True; 1682 end; 1683 TOmfObjInput.ImportOmfFixupnull1684 function TOmfObjInput.ImportOmfFixup(objdata: TObjData; objsec: TOmfObjSection; Fixup: TOmfSubRecord_FIXUP): Boolean; 1685 var 1686 reloc: TOmfRelocation; 1687 sym: TObjSymbol; 1688 RelocType: TObjRelocationType; 1689 target_section: TOmfObjSection; 1690 target_group: TObjSectionGroup; 1691 begin 1692 Result:=False; 1693 1694 { range check location } 1695 if (Fixup.LocationOffset+Fixup.LocationSize)>objsec.Size then 1696 begin 1697 InputError('Fixup location exceeds the current segment boundary'); 1698 exit; 1699 end; 1700 1701 { range check target datum } 1702 case Fixup.TargetMethod of 1703 ftmSegmentIndex: 1704 if (Fixup.TargetDatum<1) or (Fixup.TargetDatum>objdata.ObjSectionList.Count) then 1705 begin 1706 InputError('Segment name index in SI(<segment name>),<displacement> fixup target is out of range'); 1707 exit; 1708 end; 1709 ftmSegmentIndexNoDisp: 1710 if (Fixup.TargetDatum<1) or (Fixup.TargetDatum>objdata.ObjSectionList.Count) then 1711 begin 1712 InputError('Segment name index in SI(<segment name>) fixup target is out of range'); 1713 exit; 1714 end; 1715 ftmGroupIndex: 1716 if (Fixup.TargetDatum<1) or (Fixup.TargetDatum>objdata.GroupsList.Count) then 1717 begin 1718 InputError('Group name index in GI(<group name>),<displacement> fixup target is out of range'); 1719 exit; 1720 end; 1721 ftmGroupIndexNoDisp: 1722 if (Fixup.TargetDatum<1) or (Fixup.TargetDatum>objdata.GroupsList.Count) then 1723 begin 1724 InputError('Group name index in GI(<group name>) fixup target is out of range'); 1725 exit; 1726 end; 1727 ftmExternalIndex: 1728 if (Fixup.TargetDatum<1) or (Fixup.TargetDatum>ExtDefs.Count) then 1729 begin 1730 InputError('External symbol name index in EI(<symbol name>),<displacement> fixup target is out of range'); 1731 exit; 1732 end; 1733 ftmExternalIndexNoDisp: 1734 if (Fixup.TargetDatum<1) or (Fixup.TargetDatum>ExtDefs.Count) then 1735 begin 1736 InputError('External symbol name index in EI(<symbol name>) fixup target is out of range'); 1737 exit; 1738 end; 1739 end; 1740 1741 { range check frame datum } 1742 case Fixup.FrameMethod of 1743 ffmSegmentIndex: 1744 if (Fixup.FrameDatum<1) or (Fixup.FrameDatum>objdata.ObjSectionList.Count) then 1745 begin 1746 InputError('Segment name index in SI(<segment name>) fixup frame is out of range'); 1747 exit; 1748 end; 1749 ffmGroupIndex: 1750 if (Fixup.FrameDatum<1) or (Fixup.FrameDatum>objdata.GroupsList.Count) then 1751 begin 1752 InputError('Group name index in GI(<group name>) fixup frame is out of range'); 1753 exit; 1754 end; 1755 ffmExternalIndex: 1756 if (Fixup.TargetDatum<1) or (Fixup.TargetDatum>ExtDefs.Count) then 1757 begin 1758 InputError('External symbol name index in EI(<symbol name>) fixup frame is out of range'); 1759 exit; 1760 end; 1761 end; 1762 1763 if Fixup.TargetMethod in [ftmExternalIndex,ftmExternalIndexNoDisp] then 1764 begin 1765 sym:=objdata.symbolref(TOmfExternalNameElement(ExtDefs[Fixup.TargetDatum-1]).Name); 1766 RelocType:=RELOC_NONE; 1767 case Fixup.LocationType of 1768 fltOffset: 1769 case Fixup.Mode of 1770 fmSegmentRelative: 1771 RelocType:=RELOC_ABSOLUTE16; 1772 fmSelfRelative: 1773 RelocType:=RELOC_RELATIVE16; 1774 end; 1775 fltOffset32: 1776 case Fixup.Mode of 1777 fmSegmentRelative: 1778 RelocType:=RELOC_ABSOLUTE32; 1779 fmSelfRelative: 1780 RelocType:=RELOC_RELATIVE32; 1781 end; 1782 fltBase: 1783 case Fixup.Mode of 1784 fmSegmentRelative: 1785 RelocType:=RELOC_SEG; 1786 fmSelfRelative: 1787 RelocType:=RELOC_SEGREL; 1788 end; 1789 fltFarPointer: 1790 case Fixup.Mode of 1791 fmSegmentRelative: 1792 RelocType:=RELOC_FARPTR; 1793 fmSelfRelative: 1794 RelocType:=RELOC_FARPTR_RELATIVEOFFSET; 1795 end; 1796 fltFarPointer48: 1797 case Fixup.Mode of 1798 fmSegmentRelative: 1799 RelocType:=RELOC_FARPTR48; 1800 fmSelfRelative: 1801 RelocType:=RELOC_FARPTR48_RELATIVEOFFSET; 1802 end; 1803 end; 1804 if RelocType=RELOC_NONE then 1805 begin 1806 InputError('Unsupported fixup location type '+tostr(Ord(Fixup.LocationType))+' with mode '+tostr(ord(Fixup.Mode))+' in external reference to '+sym.Name); 1807 exit; 1808 end; 1809 reloc:=TOmfRelocation.CreateSymbol(Fixup.LocationOffset,sym,RelocType); 1810 objsec.ObjRelocations.Add(reloc); 1811 case Fixup.FrameMethod of 1812 ffmTarget: 1813 {nothing}; 1814 ffmGroupIndex: 1815 reloc.FrameGroup:=TObjSectionGroup(objdata.GroupsList[Fixup.FrameDatum-1]).Name; 1816 else 1817 begin 1818 InputError('Unsupported frame method '+IntToStr(Ord(Fixup.FrameMethod))+' in external reference to '+sym.Name); 1819 exit; 1820 end; 1821 end; 1822 if Fixup.TargetDisplacement<>0 then 1823 begin 1824 InputError('Unsupported nonzero target displacement '+IntToStr(Fixup.TargetDisplacement)+' in external reference to '+sym.Name); 1825 exit; 1826 end; 1827 end 1828 else if Fixup.TargetMethod in [ftmSegmentIndex,ftmSegmentIndexNoDisp] then 1829 begin 1830 target_section:=TOmfObjSection(objdata.ObjSectionList[Fixup.TargetDatum-1]); 1831 RelocType:=RELOC_NONE; 1832 case Fixup.LocationType of 1833 fltOffset: 1834 case Fixup.Mode of 1835 fmSegmentRelative: 1836 RelocType:=RELOC_ABSOLUTE16; 1837 fmSelfRelative: 1838 RelocType:=RELOC_RELATIVE16; 1839 end; 1840 fltOffset32: 1841 case Fixup.Mode of 1842 fmSegmentRelative: 1843 RelocType:=RELOC_ABSOLUTE32; 1844 fmSelfRelative: 1845 RelocType:=RELOC_RELATIVE32; 1846 end; 1847 fltBase: 1848 case Fixup.Mode of 1849 fmSegmentRelative: 1850 RelocType:=RELOC_SEG; 1851 fmSelfRelative: 1852 RelocType:=RELOC_SEGREL; 1853 end; 1854 fltFarPointer: 1855 case Fixup.Mode of 1856 fmSegmentRelative: 1857 RelocType:=RELOC_FARPTR; 1858 fmSelfRelative: 1859 RelocType:=RELOC_FARPTR_RELATIVEOFFSET; 1860 end; 1861 fltFarPointer48: 1862 case Fixup.Mode of 1863 fmSegmentRelative: 1864 RelocType:=RELOC_FARPTR48; 1865 fmSelfRelative: 1866 RelocType:=RELOC_FARPTR48_RELATIVEOFFSET; 1867 end; 1868 end; 1869 if RelocType=RELOC_NONE then 1870 begin 1871 InputError('Unsupported fixup location type '+tostr(Ord(Fixup.LocationType))+' with mode '+tostr(ord(Fixup.Mode))); 1872 exit; 1873 end; 1874 reloc:=TOmfRelocation.CreateSection(Fixup.LocationOffset,target_section,RelocType); 1875 objsec.ObjRelocations.Add(reloc); 1876 case Fixup.FrameMethod of 1877 ffmTarget: 1878 {nothing}; 1879 ffmGroupIndex: 1880 reloc.FrameGroup:=TObjSectionGroup(objdata.GroupsList[Fixup.FrameDatum-1]).Name; 1881 else 1882 begin 1883 InputError('Unsupported frame method '+IntToStr(Ord(Fixup.FrameMethod))+' in reference to segment '+target_section.Name); 1884 exit; 1885 end; 1886 end; 1887 if Fixup.TargetDisplacement<>0 then 1888 begin 1889 InputError('Unsupported nonzero target displacement '+IntToStr(Fixup.TargetDisplacement)+' in reference to segment '+target_section.Name); 1890 exit; 1891 end; 1892 end 1893 else if Fixup.TargetMethod in [ftmGroupIndex,ftmGroupIndexNoDisp] then 1894 begin 1895 target_group:=TObjSectionGroup(objdata.GroupsList[Fixup.TargetDatum-1]); 1896 RelocType:=RELOC_NONE; 1897 case Fixup.LocationType of 1898 fltOffset: 1899 case Fixup.Mode of 1900 fmSegmentRelative: 1901 RelocType:=RELOC_ABSOLUTE16; 1902 fmSelfRelative: 1903 RelocType:=RELOC_RELATIVE16; 1904 end; 1905 fltOffset32: 1906 case Fixup.Mode of 1907 fmSegmentRelative: 1908 RelocType:=RELOC_ABSOLUTE32; 1909 fmSelfRelative: 1910 RelocType:=RELOC_RELATIVE32; 1911 end; 1912 fltBase: 1913 case Fixup.Mode of 1914 fmSegmentRelative: 1915 RelocType:=RELOC_SEG; 1916 fmSelfRelative: 1917 RelocType:=RELOC_SEGREL; 1918 end; 1919 fltFarPointer: 1920 case Fixup.Mode of 1921 fmSegmentRelative: 1922 RelocType:=RELOC_FARPTR; 1923 fmSelfRelative: 1924 RelocType:=RELOC_FARPTR_RELATIVEOFFSET; 1925 end; 1926 fltFarPointer48: 1927 case Fixup.Mode of 1928 fmSegmentRelative: 1929 RelocType:=RELOC_FARPTR48; 1930 fmSelfRelative: 1931 RelocType:=RELOC_FARPTR48_RELATIVEOFFSET; 1932 end; 1933 end; 1934 if RelocType=RELOC_NONE then 1935 begin 1936 InputError('Unsupported fixup location type '+tostr(Ord(Fixup.LocationType))+' with mode '+tostr(ord(Fixup.Mode))); 1937 exit; 1938 end; 1939 reloc:=TOmfRelocation.CreateGroup(Fixup.LocationOffset,target_group,RelocType); 1940 objsec.ObjRelocations.Add(reloc); 1941 case Fixup.FrameMethod of 1942 ffmTarget: 1943 {nothing}; 1944 else 1945 begin 1946 InputError('Unsupported frame method '+IntToStr(Ord(Fixup.FrameMethod))+' in reference to group '+target_group.Name); 1947 exit; 1948 end; 1949 end; 1950 if Fixup.TargetDisplacement<>0 then 1951 begin 1952 InputError('Unsupported nonzero target displacement '+IntToStr(Fixup.TargetDisplacement)+' in reference to group '+target_group.Name); 1953 exit; 1954 end; 1955 end 1956 else 1957 begin 1958 {todo: convert other fixup types as well } 1959 InputError('Unsupported fixup target method '+IntToStr(Ord(Fixup.TargetMethod))); 1960 exit; 1961 end; 1962 1963 Result:=True; 1964 end; 1965 1966 constructor TOmfObjInput.create; 1967 begin 1968 inherited create; 1969 cobjdata:=TOmfObjData; 1970 FLNames:=TOmfOrderedNameCollection.Create(True); 1971 FExtDefs:=TFPHashObjectList.Create; 1972 FPubDefs:=TFPHashObjectList.Create; 1973 FFixupThreads:=TOmfThreads.Create; 1974 FRawRecord:=TOmfRawRecord.Create; 1975 CaseSensitiveSegments:=False; 1976 CaseSensitiveSymbols:=True; 1977 end; 1978 1979 destructor TOmfObjInput.destroy; 1980 begin 1981 FCOMENTRecord.Free; 1982 FRawRecord.Free; 1983 FFixupThreads.Free; 1984 FPubDefs.Free; 1985 FExtDefs.Free; 1986 FLNames.Free; 1987 inherited destroy; 1988 end; 1989 TOmfObjInput.CanReadObjDatanull1990 class function TOmfObjInput.CanReadObjData(AReader: TObjectreader): boolean; 1991 var 1992 b: Byte; 1993 begin 1994 result:=false; 1995 if AReader.Read(b,sizeof(b)) then 1996 begin 1997 if b=RT_THEADR then 1998 { TODO: check additional fields } 1999 result:=true; 2000 end; 2001 AReader.Seek(0); 2002 end; 2003 TOmfObjInput.ReadObjDatanull2004 function TOmfObjInput.ReadObjData(AReader: TObjectreader; out objdata: TObjData): boolean; 2005 begin 2006 FReader:=AReader; 2007 InputFileName:=AReader.FileName; 2008 objdata:=CObjData.Create(InputFileName); 2009 result:=false; 2010 { the TOmfObjData constructor creates a group 'DGROUP', which is to be 2011 used by the code generator, when writing files. When reading object 2012 files, however, we need to start with an empty list of groups, so 2013 let's clear the group list now. } 2014 objdata.GroupsList.Clear; 2015 LNames.Clear; 2016 ExtDefs.Clear; 2017 FRawRecord.ReadFrom(FReader); 2018 if not FRawRecord.VerifyChecksumByte then 2019 begin 2020 InputError('Invalid checksum in OMF record'); 2021 exit; 2022 end; 2023 if FRawRecord.RecordType<>RT_THEADR then 2024 begin 2025 InputError('Can''t read OMF header'); 2026 exit; 2027 end; 2028 repeat 2029 FRawRecord.ReadFrom(FReader); 2030 if not FRawRecord.VerifyChecksumByte then 2031 begin 2032 InputError('Invalid checksum in OMF record'); 2033 exit; 2034 end; 2035 FreeAndNil(FCOMENTRecord); 2036 case FRawRecord.RecordType of 2037 RT_LNAMES: 2038 if not ReadLNames(FRawRecord) then 2039 exit; 2040 RT_SEGDEF,RT_SEGDEF32: 2041 if not ReadSegDef(FRawRecord,objdata) then 2042 exit; 2043 RT_GRPDEF: 2044 if not ReadGrpDef(FRawRecord,objdata) then 2045 exit; 2046 RT_COMENT: 2047 begin 2048 FCOMENTRecord:=TOmfRecord_COMENT.Create; 2049 FCOMENTRecord.DecodeFrom(FRawRecord); 2050 case FCOMENTRecord.CommentClass of 2051 CC_OmfExtension: 2052 begin 2053 {todo: handle these as well...} 2054 end; 2055 CC_LIBMOD: 2056 begin 2057 {todo: do we need to read the module name here?} 2058 end; 2059 CC_EXESTR: 2060 begin 2061 InputError('EXESTR record (Executable String Record) is not supported'); 2062 exit; 2063 end; 2064 CC_INCERR: 2065 begin 2066 InputError('Invalid object file (contains indication of error encountered during incremental compilation)'); 2067 exit; 2068 end; 2069 CC_NOPAD: 2070 begin 2071 InputError('NOPAD (No Segment Padding) record is not supported'); 2072 exit; 2073 end; 2074 CC_WKEXT: 2075 begin 2076 InputError('Weak externals are not supported'); 2077 exit; 2078 end; 2079 CC_LZEXT: 2080 begin 2081 InputError('Lazy externals are not supported'); 2082 exit; 2083 end; 2084 else 2085 begin 2086 {the rest are ignored for now...} 2087 end; 2088 end; 2089 end; 2090 RT_EXTDEF: 2091 if not ReadExtDef(FRawRecord,objdata) then 2092 exit; 2093 RT_LPUBDEF,RT_LPUBDEF32, 2094 RT_PUBDEF,RT_PUBDEF32: 2095 if not ReadPubDef(FRawRecord,objdata) then 2096 exit; 2097 RT_LEDATA,RT_LEDATA32, 2098 RT_LIDATA,RT_LIDATA32, 2099 RT_FIXUPP,RT_FIXUPP32: 2100 if not ReadLeOrLiDataAndFixups(FRawRecord,objdata) then 2101 exit; 2102 RT_MODEND,RT_MODEND32: 2103 if not ReadModEnd(FRawRecord,objdata) then 2104 exit; 2105 RT_LINNUM,RT_LINNUM32: 2106 ; 2107 else 2108 begin 2109 InputError('Unsupported OMF record type $'+HexStr(FRawRecord.RecordType,2)); 2110 exit; 2111 end; 2112 end; 2113 until FRawRecord.RecordType in [RT_MODEND,RT_MODEND32]; 2114 result:=true; 2115 end; 2116 2117 {**************************************************************************** 2118 TMZExeHeader 2119 ****************************************************************************} 2120 2121 procedure TMZExeHeader.SetHeaderSizeAlignment(AValue: Integer); 2122 begin 2123 if (AValue<16) or ((AValue mod 16) <> 0) then 2124 Internalerror(2015060601); 2125 FHeaderSizeAlignment:=AValue; 2126 end; 2127 2128 constructor TMZExeHeader.Create; 2129 begin 2130 FHeaderSizeAlignment:=16; 2131 end; 2132 2133 procedure TMZExeHeader.WriteTo(aWriter: TObjectWriter); 2134 var 2135 NumRelocs: Word; 2136 HeaderSizeInBytes: DWord; 2137 HeaderParagraphs: Word; 2138 RelocTableOffset: Word; 2139 BytesInLastBlock: Word; 2140 BlocksInFile: Word; 2141 HeaderBytes: array [0..$1B] of Byte; 2142 RelocBytes: array [0..3] of Byte; 2143 TotalExeSize: DWord; 2144 i: Integer; 2145 begin 2146 NumRelocs:=Length(Relocations); 2147 RelocTableOffset:=$1C+Length(ExtraHeaderData); 2148 HeaderSizeInBytes:=Align(RelocTableOffset+4*NumRelocs,16); 2149 HeaderParagraphs:=HeaderSizeInBytes div 16; 2150 TotalExeSize:=HeaderSizeInBytes+LoadableImageSize; 2151 BlocksInFile:=(TotalExeSize+511) div 512; 2152 BytesInLastBlock:=TotalExeSize mod 512; 2153 2154 HeaderBytes[$00]:=$4D; { 'M' } 2155 HeaderBytes[$01]:=$5A; { 'Z' } 2156 HeaderBytes[$02]:=Byte(BytesInLastBlock); 2157 HeaderBytes[$03]:=Byte(BytesInLastBlock shr 8); 2158 HeaderBytes[$04]:=Byte(BlocksInFile); 2159 HeaderBytes[$05]:=Byte(BlocksInFile shr 8); 2160 HeaderBytes[$06]:=Byte(NumRelocs); 2161 HeaderBytes[$07]:=Byte(NumRelocs shr 8); 2162 HeaderBytes[$08]:=Byte(HeaderParagraphs); 2163 HeaderBytes[$09]:=Byte(HeaderParagraphs shr 8); 2164 HeaderBytes[$0A]:=Byte(MinExtraParagraphs); 2165 HeaderBytes[$0B]:=Byte(MinExtraParagraphs shr 8); 2166 HeaderBytes[$0C]:=Byte(MaxExtraParagraphs); 2167 HeaderBytes[$0D]:=Byte(MaxExtraParagraphs shr 8); 2168 HeaderBytes[$0E]:=Byte(InitialSS); 2169 HeaderBytes[$0F]:=Byte(InitialSS shr 8); 2170 HeaderBytes[$10]:=Byte(InitialSP); 2171 HeaderBytes[$11]:=Byte(InitialSP shr 8); 2172 HeaderBytes[$12]:=Byte(Checksum); 2173 HeaderBytes[$13]:=Byte(Checksum shr 8); 2174 HeaderBytes[$14]:=Byte(InitialIP); 2175 HeaderBytes[$15]:=Byte(InitialIP shr 8); 2176 HeaderBytes[$16]:=Byte(InitialCS); 2177 HeaderBytes[$17]:=Byte(InitialCS shr 8); 2178 HeaderBytes[$18]:=Byte(RelocTableOffset); 2179 HeaderBytes[$19]:=Byte(RelocTableOffset shr 8); 2180 HeaderBytes[$1A]:=Byte(OverlayNumber); 2181 HeaderBytes[$1B]:=Byte(OverlayNumber shr 8); 2182 aWriter.write(HeaderBytes[0],$1C); 2183 aWriter.write(ExtraHeaderData[0],Length(ExtraHeaderData)); 2184 for i:=0 to NumRelocs-1 do 2185 with Relocations[i] do 2186 begin 2187 RelocBytes[0]:=Byte(offset); 2188 RelocBytes[1]:=Byte(offset shr 8); 2189 RelocBytes[2]:=Byte(segment); 2190 RelocBytes[3]:=Byte(segment shr 8); 2191 aWriter.write(RelocBytes[0],4); 2192 end; 2193 { pad with zeros until the end of header (paragraph aligned) } 2194 aWriter.WriteZeros(HeaderSizeInBytes-aWriter.Size); 2195 end; 2196 2197 procedure TMZExeHeader.AddRelocation(aSegment, aOffset: Word); 2198 begin 2199 SetLength(FRelocations,Length(FRelocations)+1); 2200 with FRelocations[High(FRelocations)] do 2201 begin 2202 segment:=aSegment; 2203 offset:=aOffset; 2204 end; 2205 end; 2206 2207 {**************************************************************************** 2208 TMZExeSection 2209 ****************************************************************************} 2210 2211 procedure TMZExeSection.AddObjSection(objsec: TObjSection; ignoreprops: boolean); 2212 begin 2213 { allow mixing initialized and uninitialized data in the same section 2214 => set ignoreprops=true } 2215 inherited AddObjSection(objsec,true); 2216 end; 2217 2218 {**************************************************************************** 2219 TMZExeUnifiedLogicalSegment 2220 ****************************************************************************} 2221 2222 constructor TMZExeUnifiedLogicalSegment.create(HashObjectList: TFPHashObjectList; const s: TSymStr); 2223 var 2224 Separator: SizeInt; 2225 begin 2226 inherited create(HashObjectList,s); 2227 FObjSectionList:=TFPObjectList.Create(false); 2228 { name format is 'SegName||ClassName' } 2229 Separator:=Pos('||',s); 2230 if Separator>0 then 2231 begin 2232 FSegName:=Copy(s,1,Separator-1); 2233 FSegClass:=Copy(s,Separator+2,Length(s)-Separator-1); 2234 end 2235 else 2236 begin 2237 FSegName:=Name; 2238 FSegClass:=''; 2239 end; 2240 { wlink recognizes the stack segment by the class name 'STACK' } 2241 { let's be compatible with wlink } 2242 IsStack:=FSegClass='STACK'; 2243 end; 2244 2245 destructor TMZExeUnifiedLogicalSegment.destroy; 2246 begin 2247 FObjSectionList.Free; 2248 inherited destroy; 2249 end; 2250 2251 procedure TMZExeUnifiedLogicalSegment.AddObjSection(ObjSec: TOmfObjSection); 2252 begin 2253 ObjSectionList.Add(ObjSec); 2254 ObjSec.MZExeUnifiedLogicalSegment:=self; 2255 { tlink (and ms link?) use the scStack segment combination to recognize 2256 the stack segment. 2257 let's be compatible with tlink as well } 2258 if ObjSec.Combination=scStack then 2259 IsStack:=True; 2260 end; 2261 2262 procedure TMZExeUnifiedLogicalSegment.CalcMemPos; 2263 var 2264 MinMemPos: qword=high(qword); 2265 MaxMemPos: qword=0; 2266 objsec: TOmfObjSection; 2267 i: Integer; 2268 begin 2269 if ObjSectionList.Count=0 then 2270 internalerror(2015082201); 2271 for i:=0 to ObjSectionList.Count-1 do 2272 begin 2273 objsec:=TOmfObjSection(ObjSectionList[i]); 2274 if objsec.MemPos<MinMemPos then 2275 MinMemPos:=objsec.MemPos; 2276 if (objsec.MemPos+objsec.Size)>MaxMemPos then 2277 MaxMemPos:=objsec.MemPos+objsec.Size; 2278 end; 2279 MemPos:=MinMemPos; 2280 Size:=MaxMemPos-MemPos; 2281 end; 2282 TMZExeUnifiedLogicalSegment.MemPosStrnull2283 function TMZExeUnifiedLogicalSegment.MemPosStr: string; 2284 begin 2285 Result:=HexStr(MemBasePos shr 4,4)+':'+HexStr((MemPos-MemBasePos),4); 2286 end; 2287 2288 {**************************************************************************** 2289 TMZExeUnifiedLogicalGroup 2290 ****************************************************************************} 2291 2292 constructor TMZExeUnifiedLogicalGroup.create(HashObjectList: TFPHashObjectList; const s: TSymStr); 2293 begin 2294 inherited create(HashObjectList,s); 2295 FSegmentList:=TFPHashObjectList.Create(false); 2296 end; 2297 2298 destructor TMZExeUnifiedLogicalGroup.destroy; 2299 begin 2300 FSegmentList.Free; 2301 inherited destroy; 2302 end; 2303 2304 procedure TMZExeUnifiedLogicalGroup.CalcMemPos; 2305 var 2306 MinMemPos: qword=high(qword); 2307 MaxMemPos: qword=0; 2308 UniSeg: TMZExeUnifiedLogicalSegment; 2309 i: Integer; 2310 begin 2311 if SegmentList.Count=0 then 2312 internalerror(2015082201); 2313 for i:=0 to SegmentList.Count-1 do 2314 begin 2315 UniSeg:=TMZExeUnifiedLogicalSegment(SegmentList[i]); 2316 if UniSeg.MemPos<MinMemPos then 2317 MinMemPos:=UniSeg.MemPos; 2318 if (UniSeg.MemPos+UniSeg.Size)>MaxMemPos then 2319 MaxMemPos:=UniSeg.MemPos+UniSeg.Size; 2320 end; 2321 { align *down* on a paragraph boundary } 2322 MemPos:=(MinMemPos shr 4) shl 4; 2323 Size:=MaxMemPos-MemPos; 2324 end; 2325 TMZExeUnifiedLogicalGroup.MemPosStrnull2326 function TMZExeUnifiedLogicalGroup.MemPosStr: string; 2327 begin 2328 Result:=HexStr(MemPos shr 4,4)+':'+HexStr(MemPos and $f,4); 2329 end; 2330 2331 procedure TMZExeUnifiedLogicalGroup.AddSegment(UniSeg: TMZExeUnifiedLogicalSegment); 2332 begin 2333 SegmentList.Add(UniSeg.Name,UniSeg); 2334 if UniSeg.PrimaryGroup='' then 2335 UniSeg.PrimaryGroup:=Name; 2336 end; 2337 2338 {**************************************************************************** 2339 TMZExeOutput 2340 ****************************************************************************} 2341 TMZExeOutput.GetMZFlatContentSectionnull2342 function TMZExeOutput.GetMZFlatContentSection: TMZExeSection; 2343 begin 2344 if not assigned(FMZFlatContentSection) then 2345 FMZFlatContentSection:=TMZExeSection(FindExeSection('.MZ_flat_content')); 2346 result:=FMZFlatContentSection; 2347 end; 2348 2349 procedure TMZExeOutput.CalcDwarfUnifiedLogicalSegmentsForSection(const SecName: TSymStr); 2350 var 2351 ExeSec: TMZExeSection; 2352 ObjSec: TOmfObjSection; 2353 UniSeg: TMZExeUnifiedLogicalSegment; 2354 i: Integer; 2355 begin 2356 ExeSec:=TMZExeSection(FindExeSection(SecName)); 2357 for i:=0 to ExeSec.ObjSectionList.Count-1 do 2358 begin 2359 ObjSec:=TOmfObjSection(ExeSec.ObjSectionList[i]); 2360 UniSeg:=TMZExeUnifiedLogicalSegment(DwarfUnifiedLogicalSegments.Find(ObjSec.Name)); 2361 if not assigned(UniSeg) then 2362 begin 2363 UniSeg:=TMZExeUnifiedLogicalSegment.Create(DwarfUnifiedLogicalSegments,ObjSec.Name); 2364 UniSeg.MemPos:=0; 2365 end; 2366 UniSeg.AddObjSection(ObjSec); 2367 end; 2368 for i:=0 to DwarfUnifiedLogicalSegments.Count-1 do 2369 begin 2370 UniSeg:=TMZExeUnifiedLogicalSegment(DwarfUnifiedLogicalSegments[i]); 2371 UniSeg.CalcMemPos; 2372 end; 2373 end; 2374 2375 procedure TMZExeOutput.CalcExeUnifiedLogicalSegments; 2376 var 2377 ExeSec: TMZExeSection; 2378 ObjSec: TOmfObjSection; 2379 UniSeg: TMZExeUnifiedLogicalSegment; 2380 i: Integer; 2381 begin 2382 ExeSec:=MZFlatContentSection; 2383 for i:=0 to ExeSec.ObjSectionList.Count-1 do 2384 begin 2385 ObjSec:=TOmfObjSection(ExeSec.ObjSectionList[i]); 2386 UniSeg:=TMZExeUnifiedLogicalSegment(ExeUnifiedLogicalSegments.Find(ObjSec.Name)); 2387 if not assigned(UniSeg) then 2388 UniSeg:=TMZExeUnifiedLogicalSegment.Create(ExeUnifiedLogicalSegments,ObjSec.Name); 2389 UniSeg.AddObjSection(ObjSec); 2390 end; 2391 for i:=0 to ExeUnifiedLogicalSegments.Count-1 do 2392 begin 2393 UniSeg:=TMZExeUnifiedLogicalSegment(ExeUnifiedLogicalSegments[i]); 2394 UniSeg.CalcMemPos; 2395 if UniSeg.Size>$10000 then 2396 begin 2397 if current_settings.x86memorymodel=mm_tiny then 2398 Message1(link_e_program_segment_too_large,IntToStr(UniSeg.Size-$10000)) 2399 else if UniSeg.SegClass='CODE' then 2400 Message2(link_e_code_segment_too_large,UniSeg.SegName,IntToStr(UniSeg.Size-$10000)) 2401 else if UniSeg.SegClass='DATA' then 2402 Message2(link_e_data_segment_too_large,UniSeg.SegName,IntToStr(UniSeg.Size-$10000)) 2403 else 2404 Message2(link_e_segment_too_large,UniSeg.SegName,IntToStr(UniSeg.Size-$10000)+' '+UniSeg.SegName); 2405 end; 2406 end; 2407 end; 2408 2409 procedure TMZExeOutput.CalcExeGroups; 2410 2411 procedure AddToGroup(UniSeg:TMZExeUnifiedLogicalSegment;GroupName:TSymStr); 2412 var 2413 Group: TMZExeUnifiedLogicalGroup; 2414 begin 2415 Group:=TMZExeUnifiedLogicalGroup(ExeUnifiedLogicalGroups.Find(GroupName)); 2416 if not assigned(Group) then 2417 Group:=TMZExeUnifiedLogicalGroup.Create(ExeUnifiedLogicalGroups,GroupName); 2418 Group.AddSegment(UniSeg); 2419 end; 2420 2421 var 2422 objdataidx,groupidx,secidx: Integer; 2423 ObjData: TObjData; 2424 ObjGroup: TObjSectionGroup; 2425 ObjSec: TOmfObjSection; 2426 UniGrp: TMZExeUnifiedLogicalGroup; 2427 begin 2428 for objdataidx:=0 to ObjDataList.Count-1 do 2429 begin 2430 ObjData:=TObjData(ObjDataList[objdataidx]); 2431 if assigned(ObjData.GroupsList) then 2432 for groupidx:=0 to ObjData.GroupsList.Count-1 do 2433 begin 2434 ObjGroup:=TObjSectionGroup(ObjData.GroupsList[groupidx]); 2435 for secidx:=low(ObjGroup.members) to high(ObjGroup.members) do 2436 begin 2437 ObjSec:=TOmfObjSection(ObjGroup.members[secidx]); 2438 if assigned(ObjSec.MZExeUnifiedLogicalSegment) then 2439 AddToGroup(ObjSec.MZExeUnifiedLogicalSegment,ObjGroup.Name); 2440 end; 2441 end; 2442 end; 2443 for groupidx:=0 to ExeUnifiedLogicalGroups.Count-1 do 2444 begin 2445 UniGrp:=TMZExeUnifiedLogicalGroup(ExeUnifiedLogicalGroups[groupidx]); 2446 UniGrp.CalcMemPos; 2447 if UniGrp.Size>$10000 then 2448 begin 2449 if current_settings.x86memorymodel=mm_tiny then 2450 Message1(link_e_program_segment_too_large,IntToStr(UniGrp.Size-$10000)) 2451 else if UniGrp.Name='DGROUP' then 2452 Message2(link_e_data_segment_too_large,UniGrp.Name,IntToStr(UniGrp.Size-$10000)) 2453 else 2454 Message2(link_e_group_too_large,UniGrp.Name,IntToStr(UniGrp.Size-$10000)); 2455 end; 2456 end; 2457 end; 2458 2459 procedure TMZExeOutput.CalcSegments_MemBasePos; 2460 var 2461 lastbase:qword=0; 2462 i: Integer; 2463 UniSeg: TMZExeUnifiedLogicalSegment; 2464 begin 2465 for i:=0 to ExeUnifiedLogicalSegments.Count-1 do 2466 begin 2467 UniSeg:=TMZExeUnifiedLogicalSegment(ExeUnifiedLogicalSegments[i]); 2468 if (UniSeg.PrimaryGroup<>'') or (UniSeg.IsStack) or 2469 (((UniSeg.MemPos+UniSeg.Size-1)-lastbase)>$ffff) then 2470 lastbase:=(UniSeg.MemPos shr 4) shl 4; 2471 UniSeg.MemBasePos:=lastbase; 2472 end; 2473 end; 2474 2475 procedure TMZExeOutput.WriteMap_SegmentsAndGroups; 2476 var 2477 i, LongestGroupName, LongestSegmentName, LongestClassName: Integer; 2478 UniSeg: TMZExeUnifiedLogicalSegment; 2479 UniGrp: TMZExeUnifiedLogicalGroup; 2480 GroupColumnSize, SegmentColumnSize, ClassColumnSize: LongInt; 2481 begin 2482 LongestGroupName:=0; 2483 for i:=0 to ExeUnifiedLogicalGroups.Count-1 do 2484 begin 2485 UniGrp:=TMZExeUnifiedLogicalGroup(ExeUnifiedLogicalGroups[i]); 2486 LongestGroupName:=max(LongestGroupName,Length(UniGrp.Name)); 2487 end; 2488 LongestSegmentName:=0; 2489 LongestClassName:=0; 2490 for i:=0 to ExeUnifiedLogicalSegments.Count-1 do 2491 begin 2492 UniSeg:=TMZExeUnifiedLogicalSegment(ExeUnifiedLogicalSegments[i]); 2493 LongestSegmentName:=max(LongestSegmentName,Length(UniSeg.SegName)); 2494 LongestClassName:=max(LongestClassName,Length(UniSeg.SegClass)); 2495 end; 2496 GroupColumnSize:=max(32,LongestGroupName+1); 2497 SegmentColumnSize:=max(23,LongestSegmentName+1); 2498 ClassColumnSize:=max(15,LongestClassName+1); 2499 exemap.AddHeader('Groups list'); 2500 exemap.Add(''); 2501 exemap.Add(PadSpace('Group',GroupColumnSize)+PadSpace('Address',21)+'Size'); 2502 exemap.Add(PadSpace('=====',GroupColumnSize)+PadSpace('=======',21)+'===='); 2503 exemap.Add(''); 2504 for i:=0 to ExeUnifiedLogicalGroups.Count-1 do 2505 begin 2506 UniGrp:=TMZExeUnifiedLogicalGroup(ExeUnifiedLogicalGroups[i]); 2507 exemap.Add(PadSpace(UniGrp.Name,GroupColumnSize)+PadSpace(UniGrp.MemPosStr,21)+HexStr(UniGrp.Size,8)); 2508 end; 2509 exemap.Add(''); 2510 GroupColumnSize:=max(15,LongestGroupName+1); 2511 exemap.AddHeader('Segments list'); 2512 exemap.Add(''); 2513 exemap.Add(PadSpace('Segment',SegmentColumnSize)+PadSpace('Class',ClassColumnSize)+PadSpace('Group',GroupColumnSize)+PadSpace('Address',16)+'Size'); 2514 exemap.Add(PadSpace('=======',SegmentColumnSize)+PadSpace('=====',ClassColumnSize)+PadSpace('=====',GroupColumnSize)+PadSpace('=======',16)+'===='); 2515 exemap.Add(''); 2516 for i:=0 to ExeUnifiedLogicalSegments.Count-1 do 2517 begin 2518 UniSeg:=TMZExeUnifiedLogicalSegment(ExeUnifiedLogicalSegments[i]); 2519 exemap.Add(PadSpace(UniSeg.SegName,SegmentColumnSize)+PadSpace(UniSeg.SegClass,ClassColumnSize)+PadSpace(UniSeg.PrimaryGroup,GroupColumnSize)+PadSpace(UniSeg.MemPosStr,16)+HexStr(UniSeg.Size,8)); 2520 end; 2521 exemap.Add(''); 2522 end; 2523 2524 procedure TMZExeOutput.WriteMap_HeaderData; 2525 begin 2526 exemap.AddHeader('Header data'); 2527 exemap.Add('Loadable image size: '+HexStr(Header.LoadableImageSize,8)); 2528 exemap.Add('Min extra paragraphs: '+HexStr(Header.MinExtraParagraphs,4)); 2529 exemap.Add('Max extra paragraphs: '+HexStr(Header.MaxExtraParagraphs,4)); 2530 exemap.Add('Initial stack pointer: '+HexStr(Header.InitialSS,4)+':'+HexStr(Header.InitialSP,4)); 2531 exemap.Add('Entry point address: '+HexStr(Header.InitialCS,4)+':'+HexStr(Header.InitialIP,4)); 2532 end; 2533 TMZExeOutput.FindStackSegmentnull2534 function TMZExeOutput.FindStackSegment: TMZExeUnifiedLogicalSegment; 2535 var 2536 i: Integer; 2537 stackseg_wannabe: TMZExeUnifiedLogicalSegment; 2538 begin 2539 Result:=nil; 2540 for i:=0 to ExeUnifiedLogicalSegments.Count-1 do 2541 begin 2542 stackseg_wannabe:=TMZExeUnifiedLogicalSegment(ExeUnifiedLogicalSegments[i]); 2543 { if there are multiple stack segments, choose the largest one. 2544 In theory, we're probably supposed to combine them all and put 2545 them in a contiguous location in memory, but we don't care } 2546 if stackseg_wannabe.IsStack and 2547 (not assigned(result) or (Result.Size<stackseg_wannabe.Size)) then 2548 Result:=stackseg_wannabe; 2549 end; 2550 end; 2551 2552 procedure TMZExeOutput.FillLoadableImageSize; 2553 var 2554 i: Integer; 2555 ExeSec: TMZExeSection; 2556 ObjSec: TOmfObjSection; 2557 StartDataPos: LongWord; 2558 buf: array [0..1023] of byte; 2559 bytesread: LongWord; 2560 begin 2561 Header.LoadableImageSize:=0; 2562 ExeSec:=MZFlatContentSection; 2563 for i:=0 to ExeSec.ObjSectionList.Count-1 do 2564 begin 2565 ObjSec:=TOmfObjSection(ExeSec.ObjSectionList[i]); 2566 if (ObjSec.Size>0) and assigned(ObjSec.Data) then 2567 if (ObjSec.MemPos+ObjSec.Size)>Header.LoadableImageSize then 2568 Header.LoadableImageSize:=ObjSec.MemPos+ObjSec.Size; 2569 end; 2570 end; 2571 2572 procedure TMZExeOutput.FillMinExtraParagraphs; 2573 var 2574 ExeSec: TMZExeSection; 2575 begin 2576 ExeSec:=MZFlatContentSection; 2577 Header.MinExtraParagraphs:=(align(ExeSec.Size,16)-align(Header.LoadableImageSize,16)) div 16; 2578 end; 2579 2580 procedure TMZExeOutput.FillMaxExtraParagraphs; 2581 var 2582 heapmin_paragraphs: Integer; 2583 heapmax_paragraphs: Integer; 2584 begin 2585 if current_settings.x86memorymodel in x86_far_data_models then 2586 begin 2587 { calculate the additional number of paragraphs needed } 2588 heapmin_paragraphs:=(heapsize + 15) div 16; 2589 heapmax_paragraphs:=(maxheapsize + 15) div 16; 2590 Header.MaxExtraParagraphs:=min(Header.MinExtraParagraphs-heapmin_paragraphs+heapmax_paragraphs,$FFFF); 2591 end 2592 else 2593 Header.MaxExtraParagraphs:=$FFFF; 2594 end; 2595 2596 procedure TMZExeOutput.FillStartAddress; 2597 var 2598 EntryMemPos: qword; 2599 EntryMemBasePos: qword; 2600 begin 2601 EntryMemPos:=EntrySym.address; 2602 if assigned(EntrySym.group) then 2603 EntryMemBasePos:=TMZExeUnifiedLogicalGroup(ExeUnifiedLogicalGroups.Find(EntrySym.group.Name)).MemPos 2604 else 2605 EntryMemBasePos:=TOmfObjSection(EntrySym.objsection).MZExeUnifiedLogicalSegment.MemBasePos; 2606 Header.InitialIP:=EntryMemPos-EntryMemBasePos; 2607 Header.InitialCS:=EntryMemBasePos shr 4; 2608 end; 2609 2610 procedure TMZExeOutput.FillStackAddress; 2611 var 2612 stackseg: TMZExeUnifiedLogicalSegment; 2613 begin 2614 stackseg:=FindStackSegment; 2615 if assigned(stackseg) then 2616 begin 2617 Header.InitialSS:=stackseg.MemBasePos shr 4; 2618 Header.InitialSP:=stackseg.MemPos+stackseg.Size-stackseg.MemBasePos; 2619 end 2620 else 2621 begin 2622 Header.InitialSS:=0; 2623 Header.InitialSP:=0; 2624 end; 2625 end; 2626 2627 procedure TMZExeOutput.FillHeaderData; 2628 begin 2629 Header.MaxExtraParagraphs:=$FFFF; 2630 FillLoadableImageSize; 2631 FillMinExtraParagraphs; 2632 FillMaxExtraParagraphs; 2633 FillStartAddress; 2634 FillStackAddress; 2635 if assigned(exemap) then 2636 WriteMap_HeaderData; 2637 end; 2638 TMZExeOutput.writeExenull2639 function TMZExeOutput.writeExe: boolean; 2640 var 2641 ExeSec: TMZExeSection; 2642 i: Integer; 2643 ObjSec: TOmfObjSection; 2644 begin 2645 Result:=False; 2646 FillHeaderData; 2647 Header.WriteTo(FWriter); 2648 2649 ExeSec:=MZFlatContentSection; 2650 ExeSec.DataPos:=FWriter.Size; 2651 for i:=0 to ExeSec.ObjSectionList.Count-1 do 2652 begin 2653 ObjSec:=TOmfObjSection(ExeSec.ObjSectionList[i]); 2654 if ObjSec.MemPos<Header.LoadableImageSize then 2655 begin 2656 FWriter.WriteZeros(max(0,ObjSec.MemPos-FWriter.Size+ExeSec.DataPos)); 2657 if assigned(ObjSec.Data) then 2658 FWriter.writearray(ObjSec.Data); 2659 end; 2660 end; 2661 Result:=True; 2662 end; 2663 TMZExeOutput.writeComnull2664 function TMZExeOutput.writeCom: boolean; 2665 const 2666 ComFileOffset=$100; 2667 var 2668 i: Integer; 2669 ExeSec: TMZExeSection; 2670 ObjSec: TOmfObjSection; 2671 StartDataPos: LongWord; 2672 buf: array [0..1023] of byte; 2673 bytesread: LongWord; 2674 begin 2675 FillHeaderData; 2676 if Length(Header.Relocations)>0 then 2677 begin 2678 Message(link_e_com_program_uses_segment_relocations); 2679 exit(False); 2680 end; 2681 ExeSec:=MZFlatContentSection; 2682 for i:=0 to ExeSec.ObjSectionList.Count-1 do 2683 begin 2684 ObjSec:=TOmfObjSection(ExeSec.ObjSectionList[i]); 2685 if ObjSec.MemPos<Header.LoadableImageSize then 2686 begin 2687 FWriter.WriteZeros(max(0,int64(ObjSec.MemPos)-ComFileOffset-int64(FWriter.Size))); 2688 if assigned(ObjSec.Data) then 2689 begin 2690 if ObjSec.MemPos<ComFileOffset then 2691 begin 2692 ObjSec.Data.seek(ComFileOffset-ObjSec.MemPos); 2693 repeat 2694 bytesread:=ObjSec.Data.read(buf,sizeof(buf)); 2695 if bytesread<>0 then 2696 FWriter.write(buf,bytesread); 2697 until bytesread=0; 2698 end 2699 else 2700 FWriter.writearray(ObjSec.Data); 2701 end; 2702 end; 2703 end; 2704 Result:=True; 2705 end; 2706 TMZExeOutput.writeDebugElfnull2707 function TMZExeOutput.writeDebugElf: boolean; 2708 label 2709 cleanup; 2710 var 2711 debugsections: array of TMZExeSection; 2712 debugsections_count: Word; 2713 elfsections_count: Word; 2714 elfsechdrs: array of TElf32sechdr; 2715 shstrndx: Word; 2716 next_section_ofs, elf_start_pos, elf_end_pos: LongWord; 2717 ElfHeader: TElf32header; 2718 shstrtabsect_data: TDynamicArray=Nil; 2719 I, elfsecidx, J: Integer; 2720 ObjSec: TOmfObjSection; 2721 tis_trailer: TTISTrailer; 2722 begin 2723 debugsections:=nil; 2724 elfsechdrs:=nil; 2725 2726 { mark the offset of the start of the ELF image } 2727 elf_start_pos:=Writer.Size; 2728 2729 { count the debug sections } 2730 debugsections_count:=0; 2731 for I:=0 to ExeSectionList.Count-1 do 2732 if oso_debug in TMZExeSection(ExeSectionList[I]).SecOptions then 2733 Inc(debugsections_count); 2734 2735 { extract them into the debugsections array } 2736 SetLength(debugsections,debugsections_count); 2737 debugsections_count:=0; 2738 for I:=0 to ExeSectionList.Count-1 do 2739 if oso_debug in TMZExeSection(ExeSectionList[I]).SecOptions then 2740 begin 2741 debugsections[debugsections_count]:=TMZExeSection(ExeSectionList[I]); 2742 Inc(debugsections_count); 2743 end; 2744 2745 { prepare/allocate elf section headers } 2746 elfsections_count:=debugsections_count+2; 2747 SetLength(elfsechdrs,elfsections_count); 2748 for I:=0 to elfsections_count-1 do 2749 FillChar(elfsechdrs[I],SizeOf(elfsechdrs[I]),0); 2750 shstrndx:=elfsections_count-1; 2751 shstrtabsect_data:=tdynamicarray.Create(SectionDataMaxGrow); 2752 shstrtabsect_data.writestr(#0); 2753 next_section_ofs:=SizeOf(ElfHeader)+elfsections_count*SizeOf(TElf32sechdr); 2754 for I:=0 to debugsections_count-1 do 2755 begin 2756 elfsecidx:=I+1; 2757 with elfsechdrs[elfsecidx] do 2758 begin 2759 sh_name:=shstrtabsect_data.Pos; 2760 sh_type:=SHT_PROGBITS; 2761 sh_flags:=0; 2762 sh_addr:=0; 2763 sh_offset:=next_section_ofs; 2764 sh_size:=debugsections[I].Size; 2765 sh_link:=0; 2766 sh_info:=0; 2767 sh_addralign:=0; 2768 sh_entsize:=0; 2769 end; 2770 Inc(next_section_ofs,debugsections[I].Size); 2771 shstrtabsect_data.writestr(debugsections[I].Name+#0); 2772 end; 2773 with elfsechdrs[shstrndx] do 2774 begin 2775 sh_name:=shstrtabsect_data.Pos; 2776 shstrtabsect_data.writestr('.shstrtab'#0); 2777 sh_type:=SHT_STRTAB; 2778 sh_flags:=0; 2779 sh_addr:=0; 2780 sh_offset:=next_section_ofs; 2781 sh_size:=shstrtabsect_data.Size; 2782 sh_link:=0; 2783 sh_info:=0; 2784 sh_addralign:=0; 2785 sh_entsize:=0; 2786 end; 2787 2788 { write header } 2789 FillChar(ElfHeader,SizeOf(ElfHeader),0); 2790 ElfHeader.e_ident[EI_MAG0]:=ELFMAG0; { = #127'ELF' } 2791 ElfHeader.e_ident[EI_MAG1]:=ELFMAG1; 2792 ElfHeader.e_ident[EI_MAG2]:=ELFMAG2; 2793 ElfHeader.e_ident[EI_MAG3]:=ELFMAG3; 2794 ElfHeader.e_ident[EI_CLASS]:=ELFCLASS32; 2795 ElfHeader.e_ident[EI_DATA]:=ELFDATA2LSB; 2796 ElfHeader.e_ident[EI_VERSION]:=1; 2797 ElfHeader.e_ident[EI_OSABI]:=ELFOSABI_NONE; 2798 ElfHeader.e_ident[EI_ABIVERSION]:=0; 2799 ElfHeader.e_type:=ET_EXEC; 2800 ElfHeader.e_machine:=EM_386; 2801 ElfHeader.e_version:=1; 2802 ElfHeader.e_entry:=0; 2803 ElfHeader.e_phoff:=0; 2804 ElfHeader.e_shoff:=SizeOf(ElfHeader); 2805 ElfHeader.e_flags:=0; 2806 ElfHeader.e_ehsize:=SizeOf(ElfHeader); 2807 ElfHeader.e_phentsize:=SizeOf(TElf32proghdr); 2808 ElfHeader.e_phnum:=0; 2809 ElfHeader.e_shentsize:=SizeOf(TElf32sechdr); 2810 ElfHeader.e_shnum:=elfsections_count; 2811 ElfHeader.e_shstrndx:=shstrndx; 2812 MaybeSwapHeader(ElfHeader); 2813 Writer.write(ElfHeader,sizeof(ElfHeader)); 2814 2815 { write section headers } 2816 for I:=0 to elfsections_count-1 do 2817 begin 2818 MaybeSwapSecHeader(elfsechdrs[I]); 2819 Writer.write(elfsechdrs[I],SizeOf(elfsechdrs[I])); 2820 end; 2821 2822 { write section data } 2823 for J:=0 to debugsections_count-1 do 2824 begin 2825 debugsections[J].DataPos:=Writer.Size; 2826 for i:=0 to debugsections[J].ObjSectionList.Count-1 do 2827 begin 2828 ObjSec:=TOmfObjSection(debugsections[J].ObjSectionList[i]); 2829 if assigned(ObjSec.Data) then 2830 FWriter.writearray(ObjSec.Data); 2831 end; 2832 end; 2833 { write .shstrtab section data } 2834 Writer.writearray(shstrtabsect_data); 2835 2836 { mark the offset past the end of the ELF image } 2837 elf_end_pos:=Writer.Size; 2838 2839 { write TIS trailer (not part of the ELF image) } 2840 FillChar(tis_trailer,sizeof(tis_trailer),0); 2841 with tis_trailer do 2842 begin 2843 tis_signature:=TIS_TRAILER_SIGNATURE; 2844 tis_vendor:=TIS_TRAILER_VENDOR_TIS; 2845 tis_type:=TIS_TRAILER_TYPE_TIS_DWARF; 2846 tis_size:=(elf_end_pos-elf_start_pos)+sizeof(tis_trailer); 2847 end; 2848 MayBeSwapTISTrailer(tis_trailer); 2849 Writer.write(tis_trailer,sizeof(tis_trailer)); 2850 2851 Result:=True; 2852 cleanup: 2853 shstrtabsect_data.Free; 2854 end; 2855 2856 procedure TMZExeOutput.Load_Symbol(const aname: string); 2857 var 2858 dgroup: TObjSectionGroup; 2859 sym: TObjSymbol; 2860 begin 2861 { special handling for the '_edata' and '_end' symbols, which are 2862 internally added by the linker } 2863 if (aname='_edata') or (aname='_end') then 2864 begin 2865 { create an internal segment with the 'BSS' class } 2866 internalObjData.createsection('*'+aname+'||BSS',0,[]); 2867 { add to group 'DGROUP' } 2868 dgroup:=nil; 2869 if assigned(internalObjData.GroupsList) then 2870 dgroup:=TObjSectionGroup(internalObjData.GroupsList.Find('DGROUP')); 2871 if dgroup=nil then 2872 dgroup:=internalObjData.createsectiongroup('DGROUP'); 2873 SetLength(dgroup.members,Length(dgroup.members)+1); 2874 dgroup.members[Length(dgroup.members)-1]:=internalObjData.CurrObjSec; 2875 { define the symbol itself } 2876 sym:=internalObjData.SymbolDefine(aname,AB_GLOBAL,AT_DATA); 2877 sym.group:=dgroup; 2878 end 2879 else 2880 inherited; 2881 end; 2882 2883 procedure TMZExeOutput.DoRelocationFixup(objsec: TObjSection); 2884 var 2885 i: Integer; 2886 omfsec: TOmfObjSection absolute objsec; 2887 objreloc: TOmfRelocation; 2888 target: DWord; 2889 framebase: DWord; 2890 fixupamount: Integer; 2891 target_group: TMZExeUnifiedLogicalGroup; 2892 2893 procedure FixupOffset; 2894 var 2895 w: Word; 2896 begin 2897 omfsec.Data.seek(objreloc.DataOffset); 2898 omfsec.Data.read(w,2); 2899 w:=LEtoN(w); 2900 Inc(w,fixupamount); 2901 w:=LEtoN(w); 2902 omfsec.Data.seek(objreloc.DataOffset); 2903 omfsec.Data.write(w,2); 2904 end; 2905 2906 procedure FixupOffset32; 2907 var 2908 lw: LongWord; 2909 begin 2910 omfsec.Data.seek(objreloc.DataOffset); 2911 omfsec.Data.read(lw,4); 2912 lw:=LEtoN(lw); 2913 Inc(lw,fixupamount); 2914 lw:=LEtoN(lw); 2915 omfsec.Data.seek(objreloc.DataOffset); 2916 omfsec.Data.write(lw,4); 2917 end; 2918 2919 procedure FixupBase(DataOffset: LongWord); 2920 var 2921 w: Word; 2922 begin 2923 omfsec.Data.seek(DataOffset); 2924 omfsec.Data.read(w,2); 2925 w:=LEtoN(w); 2926 Inc(w,framebase shr 4); 2927 w:=LEtoN(w); 2928 omfsec.Data.seek(DataOffset); 2929 omfsec.Data.write(w,2); 2930 Header.AddRelocation(omfsec.MZExeUnifiedLogicalSegment.MemBasePos shr 4, 2931 omfsec.MemPos+DataOffset-omfsec.MZExeUnifiedLogicalSegment.MemBasePos); 2932 end; 2933 2934 begin 2935 for i:=0 to objsec.ObjRelocations.Count-1 do 2936 begin 2937 objreloc:=TOmfRelocation(objsec.ObjRelocations[i]); 2938 if assigned(objreloc.symbol) then 2939 begin 2940 target:=objreloc.symbol.address; 2941 if objreloc.FrameGroup<>'' then 2942 framebase:=TMZExeUnifiedLogicalGroup(ExeUnifiedLogicalGroups.Find(objreloc.FrameGroup)).MemPos 2943 else if assigned(objreloc.symbol.group) then 2944 framebase:=TMZExeUnifiedLogicalGroup(ExeUnifiedLogicalGroups.Find(objreloc.symbol.group.Name)).MemPos 2945 else 2946 framebase:=TOmfObjSection(objreloc.symbol.objsection).MZExeUnifiedLogicalSegment.MemBasePos; 2947 case objreloc.typ of 2948 RELOC_ABSOLUTE16,RELOC_ABSOLUTE32,RELOC_SEG,RELOC_FARPTR,RELOC_FARPTR48: 2949 fixupamount:=target-framebase; 2950 RELOC_RELATIVE16,RELOC_SEGREL,RELOC_FARPTR_RELATIVEOFFSET: 2951 fixupamount:=target-(omfsec.MemPos+objreloc.DataOffset)-2; 2952 RELOC_RELATIVE32,RELOC_FARPTR48_RELATIVEOFFSET: 2953 fixupamount:=target-(omfsec.MemPos+objreloc.DataOffset)-4; 2954 else 2955 internalerror(2015082402); 2956 end; 2957 case objreloc.typ of 2958 RELOC_ABSOLUTE16, 2959 RELOC_RELATIVE16: 2960 FixupOffset; 2961 RELOC_ABSOLUTE32, 2962 RELOC_RELATIVE32: 2963 FixupOffset32; 2964 RELOC_SEG, 2965 RELOC_SEGREL: 2966 FixupBase(objreloc.DataOffset); 2967 RELOC_FARPTR, 2968 RELOC_FARPTR_RELATIVEOFFSET: 2969 begin 2970 FixupOffset; 2971 FixupBase(objreloc.DataOffset+2); 2972 end; 2973 RELOC_FARPTR48, 2974 RELOC_FARPTR48_RELATIVEOFFSET: 2975 begin 2976 FixupOffset32; 2977 FixupBase(objreloc.DataOffset+4); 2978 end; 2979 else 2980 internalerror(2015082403); 2981 end; 2982 end 2983 else if assigned(objreloc.objsection) then 2984 begin 2985 target:=objreloc.objsection.MemPos; 2986 if objreloc.FrameGroup<>'' then 2987 framebase:=TMZExeUnifiedLogicalGroup(ExeUnifiedLogicalGroups.Find(objreloc.FrameGroup)).MemPos 2988 else 2989 begin 2990 if assigned(TOmfObjSection(objreloc.objsection).MZExeUnifiedLogicalSegment) then 2991 framebase:=TOmfObjSection(objreloc.objsection).MZExeUnifiedLogicalSegment.MemBasePos 2992 else 2993 begin 2994 framebase:=0; 2995 Comment(V_Warning,'Encountered an OMF reference to a section, that has been removed by smartlinking: '+TOmfObjSection(objreloc.objsection).Name); 2996 end; 2997 end; 2998 case objreloc.typ of 2999 RELOC_ABSOLUTE16,RELOC_ABSOLUTE32,RELOC_SEG,RELOC_FARPTR,RELOC_FARPTR48: 3000 fixupamount:=target-framebase; 3001 RELOC_RELATIVE16,RELOC_SEGREL,RELOC_FARPTR_RELATIVEOFFSET: 3002 fixupamount:=target-(omfsec.MemPos+objreloc.DataOffset)-2; 3003 RELOC_RELATIVE32,RELOC_FARPTR48_RELATIVEOFFSET: 3004 fixupamount:=target-(omfsec.MemPos+objreloc.DataOffset)-4; 3005 else 3006 internalerror(2015082405); 3007 end; 3008 case objreloc.typ of 3009 RELOC_ABSOLUTE16, 3010 RELOC_RELATIVE16: 3011 FixupOffset; 3012 RELOC_ABSOLUTE32, 3013 RELOC_RELATIVE32: 3014 FixupOffset32; 3015 RELOC_SEG, 3016 RELOC_SEGREL: 3017 FixupBase(objreloc.DataOffset); 3018 RELOC_FARPTR, 3019 RELOC_FARPTR_RELATIVEOFFSET: 3020 begin 3021 FixupOffset; 3022 FixupBase(objreloc.DataOffset+2); 3023 end; 3024 RELOC_FARPTR48, 3025 RELOC_FARPTR48_RELATIVEOFFSET: 3026 begin 3027 FixupOffset32; 3028 FixupBase(objreloc.DataOffset+4); 3029 end; 3030 else 3031 internalerror(2015082406); 3032 end; 3033 end 3034 else if assigned(objreloc.group) then 3035 begin 3036 target_group:=TMZExeUnifiedLogicalGroup(ExeUnifiedLogicalGroups.Find(objreloc.group.Name)); 3037 target:=target_group.MemPos; 3038 if objreloc.FrameGroup<>'' then 3039 framebase:=TMZExeUnifiedLogicalGroup(ExeUnifiedLogicalGroups.Find(objreloc.FrameGroup)).MemPos 3040 else 3041 framebase:=target_group.MemPos; 3042 case objreloc.typ of 3043 RELOC_ABSOLUTE16,RELOC_ABSOLUTE32,RELOC_SEG,RELOC_FARPTR,RELOC_FARPTR48: 3044 fixupamount:=target-framebase; 3045 RELOC_RELATIVE16,RELOC_SEGREL,RELOC_FARPTR_RELATIVEOFFSET: 3046 fixupamount:=target-(omfsec.MemPos+objreloc.DataOffset)-2; 3047 RELOC_RELATIVE32,RELOC_FARPTR48_RELATIVEOFFSET: 3048 fixupamount:=target-(omfsec.MemPos+objreloc.DataOffset)-4; 3049 else 3050 internalerror(2015111202); 3051 end; 3052 case objreloc.typ of 3053 RELOC_ABSOLUTE16, 3054 RELOC_RELATIVE16: 3055 FixupOffset; 3056 RELOC_ABSOLUTE32, 3057 RELOC_RELATIVE32: 3058 FixupOffset32; 3059 RELOC_SEG, 3060 RELOC_SEGREL: 3061 FixupBase(objreloc.DataOffset); 3062 RELOC_FARPTR, 3063 RELOC_FARPTR_RELATIVEOFFSET: 3064 begin 3065 FixupOffset; 3066 FixupBase(objreloc.DataOffset+2); 3067 end; 3068 RELOC_FARPTR48, 3069 RELOC_FARPTR48_RELATIVEOFFSET: 3070 begin 3071 FixupOffset32; 3072 FixupBase(objreloc.DataOffset+4); 3073 end; 3074 else 3075 internalerror(2015111203); 3076 end; 3077 end 3078 else 3079 internalerror(2015082407); 3080 end; 3081 end; 3082 IOmfObjSectionClassNameComparenull3083 function IOmfObjSectionClassNameCompare(Item1, Item2: Pointer): Integer; 3084 var 3085 I1 : TOmfObjSection absolute Item1; 3086 I2 : TOmfObjSection absolute Item2; 3087 begin 3088 Result:=CompareStr(I1.ClassName,I2.ClassName); 3089 if Result=0 then 3090 Result:=CompareStr(I1.Name,I2.Name); 3091 if Result=0 then 3092 Result:=I1.SortOrder-I2.SortOrder; 3093 end; 3094 3095 procedure TMZExeOutput.Order_ObjSectionList(ObjSectionList: TFPObjectList; const aPattern: string); 3096 var 3097 i: Integer; 3098 begin 3099 for i:=0 to ObjSectionList.Count-1 do 3100 TOmfObjSection(ObjSectionList[i]).SortOrder:=i; 3101 ObjSectionList.Sort(@IOmfObjSectionClassNameCompare); 3102 end; 3103 3104 procedure TMZExeOutput.MemPos_ExeSection(const aname: string); 3105 begin 3106 { overlay all .exe sections on top of each other. In practice, the MZ 3107 formats doesn't have sections, so really, everything goes to a single 3108 section, called .MZ_flat_content. All the remaining sections, that we 3109 use are the debug sections, which go to a separate ELF file, appended 3110 after the end of the .exe. They live in a separate address space, with 3111 each section starting at virtual offset 0. So, that's why we always 3112 set CurrMemPos to 0 before each section here. } 3113 CurrMemPos:=0; 3114 inherited MemPos_ExeSection(aname); 3115 end; 3116 3117 procedure TMZExeOutput.MemPos_EndExeSection; 3118 var 3119 SecName: TSymStr=''; 3120 begin 3121 if assigned(CurrExeSec) then 3122 SecName:=CurrExeSec.Name; 3123 inherited MemPos_EndExeSection; 3124 case SecName of 3125 '.MZ_flat_content': 3126 begin 3127 CalcExeUnifiedLogicalSegments; 3128 CalcExeGroups; 3129 CalcSegments_MemBasePos; 3130 if assigned(exemap) then 3131 WriteMap_SegmentsAndGroups; 3132 end; 3133 '.debug_info', 3134 '.debug_abbrev', 3135 '.debug_line', 3136 '.debug_aranges': 3137 begin 3138 CalcDwarfUnifiedLogicalSegmentsForSection(SecName); 3139 with TMZExeSection(FindExeSection(SecName)) do 3140 SecOptions:=SecOptions+[oso_debug]; 3141 end; 3142 '': 3143 {nothing to do}; 3144 else 3145 internalerror(2018061401); 3146 end; 3147 end; 3148 TMZExeOutput.writeDatanull3149 function TMZExeOutput.writeData: boolean; 3150 begin 3151 Result:=False; 3152 if ExeWriteMode in [ewm_exefull,ewm_exeonly] then 3153 begin 3154 if apptype=app_com then 3155 Result:=WriteCom 3156 else 3157 Result:=WriteExe; 3158 if not Result then 3159 exit; 3160 end; 3161 if ((cs_debuginfo in current_settings.moduleswitches) and 3162 (target_dbg.id in [dbg_dwarf2,dbg_dwarf3,dbg_dwarf4])) and 3163 ((ExeWriteMode=ewm_dbgonly) or 3164 ((ExeWriteMode=ewm_exefull) and 3165 not(cs_link_strip in current_settings.globalswitches))) then 3166 Result:=writeDebugElf; 3167 end; 3168 3169 constructor TMZExeOutput.create; 3170 begin 3171 inherited create; 3172 CExeSection:=TMZExeSection; 3173 CObjData:=TOmfObjData; 3174 CObjSymbol:=TOmfObjSymbol; 3175 { "640K ought to be enough for anybody" :) } 3176 MaxMemPos:=$9FFFF; 3177 FExeUnifiedLogicalSegments:=TFPHashObjectList.Create; 3178 FExeUnifiedLogicalGroups:=TFPHashObjectList.Create; 3179 FDwarfUnifiedLogicalSegments:=TFPHashObjectList.Create; 3180 FHeader:=TMZExeHeader.Create; 3181 end; 3182 3183 destructor TMZExeOutput.destroy; 3184 begin 3185 FHeader.Free; 3186 FDwarfUnifiedLogicalSegments.Free; 3187 FExeUnifiedLogicalGroups.Free; 3188 FExeUnifiedLogicalSegments.Free; 3189 inherited destroy; 3190 end; 3191 3192 {**************************************************************************** 3193 TOmfAssembler 3194 ****************************************************************************} 3195 3196 constructor TOmfAssembler.Create(info: pasminfo; smart:boolean); 3197 begin 3198 inherited; 3199 CObjOutput:=TOmfObjOutput; 3200 CInternalAr:=TOmfLibObjectWriter; 3201 end; 3202 3203 {***************************************************************************** 3204 Initialize 3205 *****************************************************************************} 3206 {$ifdef i8086} 3207 const 3208 as_i8086_omf_info : tasminfo = 3209 ( 3210 id : as_i8086_omf; 3211 idtxt : 'OMF'; 3212 asmbin : ''; 3213 asmcmd : ''; 3214 supported_targets : [system_i8086_msdos,system_i8086_embedded]; 3215 flags : [af_outputbinary,af_smartlink_sections]; 3216 labelprefix : '..@'; 3217 comment : '; '; 3218 dollarsign: '$'; 3219 ); 3220 {$endif i8086} 3221 3222 initialization 3223 {$ifdef i8086} 3224 RegisterAssembler(as_i8086_omf_info,TOmfAssembler); 3225 {$endif i8086} 3226 end. 3227