{ Copyright (c) 2015 by Nikolay Nikolov Contains the binary Relocatable Object Module Format (OMF) reader and writer This is the object format used on the i8086-msdos platform. This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. **************************************************************************** } unit ogomf; {$i fpcdefs.inc} interface uses { common } cclasses,globtype, { target } systems, { assembler } cpuinfo,cpubase,aasmbase,assemble,link, { OMF definitions } omfbase, { output } ogbase, owbase; type { TOmfObjSymbol } TOmfObjSymbol = class(TObjSymbol) public { string representation for the linker map file } function AddressStr(AImageBase: qword): string;override; end; { TOmfRelocation } TOmfRelocation = class(TObjRelocation) private FFrameGroup: string; FOmfFixup: TOmfSubRecord_FIXUP; public destructor Destroy; override; procedure BuildOmfFixup; property FrameGroup: string read FFrameGroup write FFrameGroup; property OmfFixup: TOmfSubRecord_FIXUP read FOmfFixup; end; TMZExeUnifiedLogicalSegment=class; { TOmfObjSection } TOmfObjSection = class(TObjSection) private FClassName: string; FOverlayName: string; FCombination: TOmfSegmentCombination; FUse: TOmfSegmentUse; FPrimaryGroup: TObjSectionGroup; FSortOrder: Integer; FMZExeUnifiedLogicalSegment: TMZExeUnifiedLogicalSegment; FLinNumEntries: TOmfSubRecord_LINNUM_MsLink_LineNumberList; function GetOmfAlignment: TOmfSegmentAlignment; public constructor create(AList:TFPHashObjectList;const Aname:string;Aalign:longint;Aoptions:TObjSectionOptions);override; destructor destroy;override; function MemPosStr(AImageBase: qword): string;override; property ClassName: string read FClassName; property OverlayName: string read FOverlayName; property OmfAlignment: TOmfSegmentAlignment read GetOmfAlignment; property Combination: TOmfSegmentCombination read FCombination; property Use: TOmfSegmentUse read FUse; property PrimaryGroup: TObjSectionGroup read FPrimaryGroup; property SortOrder: Integer read FSortOrder write FSortOrder; property MZExeUnifiedLogicalSegment: TMZExeUnifiedLogicalSegment read FMZExeUnifiedLogicalSegment write FMZExeUnifiedLogicalSegment; property LinNumEntries: TOmfSubRecord_LINNUM_MsLink_LineNumberList read FLinNumEntries; end; { TOmfObjData } TOmfObjData = class(TObjData) private FMainSource: TPathStr; class function CodeSectionName(const aname:string): string; public constructor create(const n:string);override; function sectiontype2options(atype:TAsmSectiontype):TObjSectionOptions;override; function sectiontype2align(atype:TAsmSectiontype):longint;override; function sectiontype2class(atype:TAsmSectiontype):string; function sectionname(atype:TAsmSectiontype;const aname:string;aorder:TAsmSectionOrder):string;override; function createsection(atype:TAsmSectionType;const aname:string='';aorder:TAsmSectionOrder=secorder_default):TObjSection;override; function reffardatasection:TObjSection; procedure writeReloc(Data:TRelocDataInt;len:aword;p:TObjSymbol;Reloctype:TObjRelocationType);override; property MainSource: TPathStr read FMainSource; end; { TOmfObjOutput } TOmfObjOutput = class(tObjOutput) private FLNames: TOmfOrderedNameCollection; FSegments: TFPHashObjectList; FGroups: TFPHashObjectList; procedure AddSegment(const name,segclass,ovlname: string; Alignment: TOmfSegmentAlignment; Combination: TOmfSegmentCombination; Use: TOmfSegmentUse; Size: TObjSectionOfs); procedure AddGroup(group: TObjSectionGroup); procedure WriteSections(Data:TObjData); procedure WriteSectionContentAndFixups(sec: TObjSection); procedure WriteLinNumRecords(sec: TOmfObjSection); procedure section_count_sections(p:TObject;arg:pointer); procedure group_count_groups(p:TObject;arg:pointer); procedure WritePUBDEFs(Data: TObjData); procedure WriteEXTDEFs(Data: TObjData); property LNames: TOmfOrderedNameCollection read FLNames; property Segments: TFPHashObjectList read FSegments; property Groups: TFPHashObjectList read FGroups; protected function writeData(Data:TObjData):boolean;override; public constructor create(AWriter:TObjectWriter);override; destructor Destroy;override; procedure WriteDllImport(const dllname,afuncname,mangledname:string;ordnr:longint;isvar:boolean); end; { TOmfObjInput } TOmfObjInput = class(TObjInput) private FLNames: TOmfOrderedNameCollection; FExtDefs: TFPHashObjectList; FPubDefs: TFPHashObjectList; FFixupThreads: TOmfThreads; FRawRecord: TOmfRawRecord; FCOMENTRecord: TOmfRecord_COMENT; FCaseSensitiveSegments: Boolean; FCaseSensitiveSymbols: Boolean; function PeekNextRecordType: Byte; function ReadLNames(RawRec: TOmfRawRecord): Boolean; function ReadSegDef(RawRec: TOmfRawRecord; objdata:TObjData): Boolean; function ReadGrpDef(RawRec: TOmfRawRecord; objdata:TObjData): Boolean; function ReadExtDef(RawRec: TOmfRawRecord; objdata:TObjData): Boolean; function ReadPubDef(RawRec: TOmfRawRecord; objdata:TObjData): Boolean; function ReadModEnd(RawRec: TOmfRawRecord; objdata:TObjData): Boolean; function ReadLeOrLiDataAndFixups(RawRec: TOmfRawRecord; objdata:TObjData): Boolean; function ImportOmfFixup(objdata: TObjData; objsec: TOmfObjSection; Fixup: TOmfSubRecord_FIXUP): Boolean; property LNames: TOmfOrderedNameCollection read FLNames; property ExtDefs: TFPHashObjectList read FExtDefs; property PubDefs: TFPHashObjectList read FPubDefs; { Specifies whether we're case sensitive in regards to segment, class, overlay and group names. } property CaseSensitiveSegments: Boolean read FCaseSensitiveSegments write FCaseSensitiveSegments; { Specifies whether symbol names (in EXTDEF and PUBDEF records) are case sensitive. } property CaseSensitiveSymbols: Boolean read FCaseSensitiveSymbols write FCaseSensitiveSymbols; public constructor create;override; destructor destroy;override; class function CanReadObjData(AReader:TObjectreader):boolean;override; function ReadObjData(AReader:TObjectreader;out objdata:TObjData):boolean;override; end; { TMZExeRelocation } TMZExeRelocation = record offset: Word; segment: Word; end; TMZExeRelocations = array of TMZExeRelocation; TMZExeExtraHeaderData = array of Byte; { TMZExeHeader } TMZExeHeader = class private FChecksum: Word; FExtraHeaderData: TMZExeExtraHeaderData; FHeaderSizeAlignment: Integer; FInitialCS: Word; FInitialIP: Word; FInitialSP: Word; FInitialSS: Word; FLoadableImageSize: DWord; FMaxExtraParagraphs: Word; FMinExtraParagraphs: Word; FOverlayNumber: Word; FRelocations: TMZExeRelocations; procedure SetHeaderSizeAlignment(AValue: Integer); public constructor Create; procedure WriteTo(aWriter: TObjectWriter); procedure AddRelocation(aSegment,aOffset: Word); property HeaderSizeAlignment: Integer read FHeaderSizeAlignment write SetHeaderSizeAlignment; {default=16, must be multiple of 16} property Relocations: TMZExeRelocations read FRelocations write FRelocations; property ExtraHeaderData: TMZExeExtraHeaderData read FExtraHeaderData write FExtraHeaderData; property LoadableImageSize: DWord read FLoadableImageSize write FLoadableImageSize; property MinExtraParagraphs: Word read FMinExtraParagraphs write FMinExtraParagraphs; property MaxExtraParagraphs: Word read FMaxExtraParagraphs write FMaxExtraParagraphs; property InitialSS: Word read FInitialSS write FInitialSS; property InitialSP: Word read FInitialSP write FInitialSP; property Checksum: Word read FChecksum write FChecksum; property InitialIP: Word read FInitialIP write FInitialIP; property InitialCS: Word read FInitialCS write FInitialCS; property OverlayNumber: Word read FOverlayNumber write FOverlayNumber; end; { TMZExeSection } TMZExeSection=class(TExeSection) public procedure AddObjSection(objsec:TObjSection;ignoreprops:boolean=false);override; end; { TMZExeUnifiedLogicalSegment } TMZExeUnifiedLogicalSegment=class(TFPHashObject) private FObjSectionList: TFPObjectList; FSegName: TSymStr; FSegClass: TSymStr; FPrimaryGroup: string; public Size, MemPos, MemBasePos: qword; IsStack: Boolean; constructor create(HashObjectList:TFPHashObjectList;const s:TSymStr); destructor destroy;override; procedure AddObjSection(ObjSec: TOmfObjSection); procedure CalcMemPos; function MemPosStr:string; property ObjSectionList: TFPObjectList read FObjSectionList; property SegName: TSymStr read FSegName; property SegClass: TSymStr read FSegClass; property PrimaryGroup: string read FPrimaryGroup write FPrimaryGroup; end; { TMZExeUnifiedLogicalGroup } TMZExeUnifiedLogicalGroup=class(TFPHashObject) private FSegmentList: TFPHashObjectList; public Size, MemPos: qword; constructor create(HashObjectList:TFPHashObjectList;const s:TSymStr); destructor destroy;override; procedure CalcMemPos; function MemPosStr:string; procedure AddSegment(UniSeg: TMZExeUnifiedLogicalSegment); property SegmentList: TFPHashObjectList read FSegmentList; end; { TMZExeOutput } TMZExeOutput = class(TExeOutput) private FMZFlatContentSection: TMZExeSection; FExeUnifiedLogicalSegments: TFPHashObjectList; FExeUnifiedLogicalGroups: TFPHashObjectList; FDwarfUnifiedLogicalSegments: TFPHashObjectList; FHeader: TMZExeHeader; function GetMZFlatContentSection: TMZExeSection; procedure CalcDwarfUnifiedLogicalSegmentsForSection(const SecName: TSymStr); procedure CalcExeUnifiedLogicalSegments; procedure CalcExeGroups; procedure CalcSegments_MemBasePos; procedure WriteMap_SegmentsAndGroups; procedure WriteMap_HeaderData; function FindStackSegment: TMZExeUnifiedLogicalSegment; procedure FillLoadableImageSize; procedure FillMinExtraParagraphs; procedure FillMaxExtraParagraphs; procedure FillStartAddress; procedure FillStackAddress; procedure FillHeaderData; function writeExe:boolean; function writeCom:boolean; function writeDebugElf:boolean; property ExeUnifiedLogicalSegments: TFPHashObjectList read FExeUnifiedLogicalSegments; property ExeUnifiedLogicalGroups: TFPHashObjectList read FExeUnifiedLogicalGroups; property DwarfUnifiedLogicalSegments: TFPHashObjectList read FExeUnifiedLogicalSegments; property Header: TMZExeHeader read FHeader; protected procedure Load_Symbol(const aname:string);override; procedure DoRelocationFixup(objsec:TObjSection);override; procedure Order_ObjSectionList(ObjSectionList : TFPObjectList;const aPattern:string);override; procedure MemPos_ExeSection(const aname:string);override; procedure MemPos_EndExeSection;override; function writeData:boolean;override; public constructor create;override; destructor destroy;override; property MZFlatContentSection: TMZExeSection read GetMZFlatContentSection; end; TOmfAssembler = class(tinternalassembler) constructor create(info: pasminfo; smart:boolean);override; end; implementation uses SysUtils, cutils,verbose,globals, fmodule,aasmtai,aasmdata, ogmap,owomflib,elfbase, version ; const win16stub : array[0..255] of byte=( $4d,$5a,$00,$01,$01,$00,$00,$00,$08,$00,$10,$00,$ff,$ff,$08,$00, $00,$01,$00,$00,$00,$00,$00,$00,$40,$00,$00,$00,$00,$00,$00,$00, $00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00, $00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$01,$00,$00, $00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00, $00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00, $00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00, $00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00, $ba,$10,$00,$0e,$1f,$b4,$09,$cd,$21,$b8,$01,$4c,$cd,$21,$90,$90, $54,$68,$69,$73,$20,$70,$72,$6f,$67,$72,$61,$6d,$20,$72,$65,$71, $75,$69,$72,$65,$73,$20,$4d,$69,$63,$72,$6f,$73,$6f,$66,$74,$20, $57,$69,$6e,$64,$6f,$77,$73,$2e,$0d,$0a,$24,$20,$20,$20,$20,$20, $20,$20,$20,$20,$20,$20,$20,$20,$20,$20,$20,$20,$20,$20,$20,$20, $20,$20,$20,$20,$20,$20,$20,$20,$20,$20,$20,$20,$20,$20,$20,$20, $20,$20,$20,$20,$20,$20,$20,$20,$20,$20,$20,$20,$20,$20,$20,$20, $20,$20,$20,$20,$20,$20,$20,$20,$20,$20,$20,$20,$20,$20,$20,$20); {**************************************************************************** TTISTrailer ****************************************************************************} const TIS_TRAILER_SIGNATURE: array[1..4] of char='TIS'#0; TIS_TRAILER_VENDOR_TIS=0; TIS_TRAILER_TYPE_TIS_DWARF=0; type TTISTrailer=record tis_signature: array[1..4] of char; tis_vendor, tis_type, tis_size: LongWord; end; procedure MayBeSwapTISTrailer(var h: TTISTrailer); begin if source_info.endian<>target_info.endian then with h do begin tis_vendor:=swapendian(tis_vendor); tis_type:=swapendian(tis_type); tis_size:=swapendian(tis_size); end; end; {**************************************************************************** TOmfObjSymbol ****************************************************************************} function TOmfObjSymbol.AddressStr(AImageBase: qword): string; var base: qword; begin if assigned(TOmfObjSection(objsection).MZExeUnifiedLogicalSegment) then base:=TOmfObjSection(objsection).MZExeUnifiedLogicalSegment.MemBasePos else base:=(address shr 4) shl 4; Result:=HexStr(base shr 4,4)+':'+HexStr(address-base,4); end; {**************************************************************************** TOmfRelocation ****************************************************************************} destructor TOmfRelocation.Destroy; begin FOmfFixup.Free; inherited Destroy; end; procedure TOmfRelocation.BuildOmfFixup; begin FreeAndNil(FOmfFixup); FOmfFixup:=TOmfSubRecord_FIXUP.Create; if ObjSection<>nil then begin FOmfFixup.LocationOffset:=DataOffset; if typ in [RELOC_ABSOLUTE16,RELOC_RELATIVE16] then FOmfFixup.LocationType:=fltOffset else if typ in [RELOC_ABSOLUTE32,RELOC_RELATIVE32] then FOmfFixup.LocationType:=fltOffset32 else if typ in [RELOC_SEG,RELOC_SEGREL] then FOmfFixup.LocationType:=fltBase else internalerror(2015041501); FOmfFixup.FrameDeterminedByThread:=False; FOmfFixup.TargetDeterminedByThread:=False; if typ in [RELOC_ABSOLUTE16,RELOC_ABSOLUTE32,RELOC_SEG] then FOmfFixup.Mode:=fmSegmentRelative else if typ in [RELOC_RELATIVE16,RELOC_RELATIVE32,RELOC_SEGREL] then FOmfFixup.Mode:=fmSelfRelative else internalerror(2015041401); if typ in [RELOC_ABSOLUTE16,RELOC_ABSOLUTE32,RELOC_RELATIVE16,RELOC_RELATIVE32] then begin FOmfFixup.TargetMethod:=ftmSegmentIndexNoDisp; FOmfFixup.TargetDatum:=ObjSection.Index; if TOmfObjSection(ObjSection).PrimaryGroup<>nil then begin FOmfFixup.FrameMethod:=ffmGroupIndex; FOmfFixup.FrameDatum:=TOmfObjSection(ObjSection).PrimaryGroup.index; end else FOmfFixup.FrameMethod:=ffmTarget; end else begin FOmfFixup.FrameMethod:=ffmTarget; if TOmfObjSection(ObjSection).PrimaryGroup<>nil then begin FOmfFixup.TargetMethod:=ftmGroupIndexNoDisp; FOmfFixup.TargetDatum:=TOmfObjSection(ObjSection).PrimaryGroup.index; end else begin FOmfFixup.TargetMethod:=ftmSegmentIndexNoDisp; FOmfFixup.TargetDatum:=ObjSection.Index; end; end; end else if symbol<>nil then begin FOmfFixup.LocationOffset:=DataOffset; if typ in [RELOC_ABSOLUTE16,RELOC_RELATIVE16] then FOmfFixup.LocationType:=fltOffset else if typ in [RELOC_ABSOLUTE32,RELOC_RELATIVE32] then FOmfFixup.LocationType:=fltOffset32 else if typ in [RELOC_SEG,RELOC_SEGREL] then FOmfFixup.LocationType:=fltBase else internalerror(2015041501); FOmfFixup.FrameDeterminedByThread:=False; FOmfFixup.TargetDeterminedByThread:=False; if typ in [RELOC_ABSOLUTE16,RELOC_ABSOLUTE32,RELOC_SEG] then FOmfFixup.Mode:=fmSegmentRelative else if typ in [RELOC_RELATIVE16,RELOC_RELATIVE32,RELOC_SEGREL] then FOmfFixup.Mode:=fmSelfRelative else internalerror(2015041401); FOmfFixup.TargetMethod:=ftmExternalIndexNoDisp; FOmfFixup.TargetDatum:=symbol.symidx; FOmfFixup.FrameMethod:=ffmTarget; end else if group<>nil then begin FOmfFixup.LocationOffset:=DataOffset; if typ in [RELOC_ABSOLUTE16,RELOC_RELATIVE16] then FOmfFixup.LocationType:=fltOffset else if typ in [RELOC_ABSOLUTE32,RELOC_RELATIVE32] then FOmfFixup.LocationType:=fltOffset32 else if typ in [RELOC_SEG,RELOC_SEGREL] then FOmfFixup.LocationType:=fltBase else internalerror(2015041501); FOmfFixup.FrameDeterminedByThread:=False; FOmfFixup.TargetDeterminedByThread:=False; if typ in [RELOC_ABSOLUTE16,RELOC_ABSOLUTE32,RELOC_SEG] then FOmfFixup.Mode:=fmSegmentRelative else if typ in [RELOC_RELATIVE16,RELOC_RELATIVE32,RELOC_SEGREL] then FOmfFixup.Mode:=fmSelfRelative else internalerror(2015041401); FOmfFixup.FrameMethod:=ffmTarget; FOmfFixup.TargetMethod:=ftmGroupIndexNoDisp; FOmfFixup.TargetDatum:=group.index; end else internalerror(2015040702); end; {**************************************************************************** TOmfObjSection ****************************************************************************} function TOmfObjSection.GetOmfAlignment: TOmfSegmentAlignment; begin case SecAlign of 1: result:=saRelocatableByteAligned; 2: result:=saRelocatableWordAligned; 4: result:=saRelocatableDWordAligned; 16: result:=saRelocatableParaAligned; 256: result:=saRelocatablePageAligned; 4096: result:=saNotSupported; else internalerror(2015041504); end; end; constructor TOmfObjSection.create(AList: TFPHashObjectList; const Aname: string; Aalign: longint; Aoptions: TObjSectionOptions); begin inherited create(AList, Aname, Aalign, Aoptions); FCombination:=scPublic; FUse:=suUse16; FLinNumEntries:=TOmfSubRecord_LINNUM_MsLink_LineNumberList.Create; end; destructor TOmfObjSection.destroy; begin FLinNumEntries.Free; inherited destroy; end; function TOmfObjSection.MemPosStr(AImageBase: qword): string; begin Result:=HexStr(MZExeUnifiedLogicalSegment.MemBasePos shr 4,4)+':'+ HexStr(MemPos-MZExeUnifiedLogicalSegment.MemBasePos,4); end; {**************************************************************************** TOmfObjData ****************************************************************************} class function TOmfObjData.CodeSectionName(const aname: string): string; begin {$ifdef i8086} if current_settings.x86memorymodel in x86_far_code_models then begin if cs_huge_code in current_settings.moduleswitches then result:=aname + '_TEXT' else result:=current_module.modulename^ + '_TEXT'; end else {$endif} result:='_TEXT'; end; constructor TOmfObjData.create(const n: string); begin inherited create(n); CObjSymbol:=TOmfObjSymbol; CObjSection:=TOmfObjSection; createsectiongroup('DGROUP'); FMainSource:=current_module.mainsource; end; function TOmfObjData.sectiontype2options(atype: TAsmSectiontype): TObjSectionOptions; begin Result:=inherited sectiontype2options(atype); { in the huge memory model, BSS data is actually written in the regular FAR_DATA segment of the module } if sectiontype2class(atype)='FAR_DATA' then Result:=Result+[oso_data,oso_sparse_data]; end; function TOmfObjData.sectiontype2align(atype: TAsmSectiontype): longint; begin Result:=omf_sectiontype2align(atype); end; function TOmfObjData.sectiontype2class(atype: TAsmSectiontype): string; begin Result:=omf_segclass(atype); end; function TOmfObjData.sectionname(atype:TAsmSectiontype;const aname:string;aorder:TAsmSectionOrder):string; var sep : string[3]; secname : string; begin if (atype=sec_user) then Result:=aname else begin if omf_secnames[atype]=omf_secnames[sec_code] then secname:=CodeSectionName(aname) else if omf_segclass(atype)='FAR_DATA' then secname:=current_module.modulename^ + '_DATA' else secname:=omf_secnames[atype]; if create_smartlink_sections and (aname<>'') then begin case aorder of secorder_begin : sep:='.b_'; secorder_end : sep:='.z_'; else sep:='.n_'; end; result:=UpCase(secname+sep+aname); end else result:=secname; end; end; function TOmfObjData.createsection(atype: TAsmSectionType; const aname: string; aorder: TAsmSectionOrder): TObjSection; var is_new: Boolean; primary_group: String; grp: TObjSectionGroup; begin is_new:=TObjSection(ObjSectionList.Find(sectionname(atype,aname,aorder)))=nil; Result:=inherited createsection(atype, aname, aorder); if is_new then begin TOmfObjSection(Result).FClassName:=sectiontype2class(atype); if atype=sec_stack then TOmfObjSection(Result).FCombination:=scStack else if atype in [sec_debug_frame,sec_debug_info,sec_debug_line,sec_debug_abbrev,sec_debug_aranges,sec_debug_ranges] then begin TOmfObjSection(Result).FUse:=suUse32; TOmfObjSection(Result).SizeLimit:=high(longword); end; primary_group:=omf_section_primary_group(atype,aname); if primary_group<>'' then begin { find the primary group, if it already exists, else create it } grp:=nil; if GroupsList<>nil then grp:=TObjSectionGroup(GroupsList.Find(primary_group)); if grp=nil then grp:=createsectiongroup(primary_group); { add the current section to the group } SetLength(grp.members,Length(grp.members)+1); grp.members[High(grp.members)]:=Result; TOmfObjSection(Result).FPrimaryGroup:=grp; end; end; end; function TOmfObjData.reffardatasection: TObjSection; var secname: string; begin secname:=current_module.modulename^ + '_DATA'; result:=TObjSection(ObjSectionList.Find(secname)); if not assigned(result) then begin result:=CObjSection.create(ObjSectionList,secname,2,[oso_Data,oso_load,oso_write]); result.ObjData:=self; TOmfObjSection(Result).FClassName:='FAR_DATA'; end; end; procedure TOmfObjData.writeReloc(Data:TRelocDataInt;len:aword;p:TObjSymbol;Reloctype:TObjRelocationType); var objreloc: TOmfRelocation; symaddr: AWord; begin { RELOC_FARPTR = RELOC_ABSOLUTE16+RELOC_SEG } if Reloctype=RELOC_FARPTR then begin if len<>4 then internalerror(2015041502); writeReloc(Data,2,p,RELOC_ABSOLUTE16); writeReloc(0,2,p,RELOC_SEG); exit; end { RELOC_FARPTR48 = RELOC_ABSOLUTE16+RELOC_SEG } else if Reloctype=RELOC_FARPTR48 then begin if len<>6 then internalerror(2015041502); writeReloc(Data,4,p,RELOC_ABSOLUTE32); writeReloc(0,2,p,RELOC_SEG); exit; end; if CurrObjSec=nil then internalerror(200403072); objreloc:=nil; if Reloctype in [RELOC_FARDATASEG,RELOC_FARDATASEGREL] then begin if Reloctype=RELOC_FARDATASEG then objreloc:=TOmfRelocation.CreateSection(CurrObjSec.Size,reffardatasection,RELOC_SEG) else objreloc:=TOmfRelocation.CreateSection(CurrObjSec.Size,reffardatasection,RELOC_SEGREL); CurrObjSec.ObjRelocations.Add(objreloc); end else if assigned(p) then begin { real address of the symbol } symaddr:=p.address; if p.bind=AB_EXTERNAL then begin objreloc:=TOmfRelocation.CreateSymbol(CurrObjSec.Size,p,Reloctype); CurrObjSec.ObjRelocations.Add(objreloc); end { relative relocations within the same section can be calculated directly, without the need to emit a relocation entry } else if (p.objsection=CurrObjSec) and (p.bind<>AB_COMMON) and (Reloctype=RELOC_RELATIVE) then begin data:=data+symaddr-len-CurrObjSec.Size; end else begin objreloc:=TOmfRelocation.CreateSection(CurrObjSec.Size,p.objsection,Reloctype); CurrObjSec.ObjRelocations.Add(objreloc); if not (Reloctype in [RELOC_SEG,RELOC_SEGREL]) then inc(data,symaddr); end; end else if Reloctype in [RELOC_DGROUP,RELOC_DGROUPREL] then begin if Reloctype=RELOC_DGROUP then objreloc:=TOmfRelocation.CreateGroup(CurrObjSec.Size,TObjSectionGroup(GroupsList.Find('DGROUP')),RELOC_SEG) else objreloc:=TOmfRelocation.CreateGroup(CurrObjSec.Size,TObjSectionGroup(GroupsList.Find('DGROUP')),RELOC_SEGREL); CurrObjSec.ObjRelocations.Add(objreloc); end; CurrObjSec.write(data,len); end; {**************************************************************************** TOmfObjOutput ****************************************************************************} procedure TOmfObjOutput.AddSegment(const name, segclass, ovlname: string; Alignment: TOmfSegmentAlignment; Combination: TOmfSegmentCombination; Use: TOmfSegmentUse; Size: TObjSectionOfs); var s: TOmfRecord_SEGDEF; begin s:=TOmfRecord_SEGDEF.Create; Segments.Add(name,s); s.SegmentNameIndex:=LNames.Add(name); s.ClassNameIndex:=LNames.Add(segclass); s.OverlayNameIndex:=LNames.Add(ovlname); s.Alignment:=Alignment; s.Combination:=Combination; s.Use:=Use; s.SegmentLength:=Size; end; procedure TOmfObjOutput.AddGroup(group: TObjSectionGroup); var g: TOmfRecord_GRPDEF; seglist: TSegmentList; I: Integer; begin g:=TOmfRecord_GRPDEF.Create; Groups.Add(group.Name,g); g.GroupNameIndex:=LNames.Add(group.Name); SetLength(seglist,Length(group.members)); for I:=Low(group.members) to High(group.members) do seglist[I]:=group.members[I].index; g.SegmentList:=seglist; end; procedure TOmfObjOutput.WriteSections(Data: TObjData); var i:longint; sec:TObjSection; begin for i:=0 to Data.ObjSectionList.Count-1 do begin sec:=TObjSection(Data.ObjSectionList[i]); WriteSectionContentAndFixups(sec); WriteLinNumRecords(TOmfObjSection(sec)); end; end; procedure TOmfObjOutput.WriteSectionContentAndFixups(sec: TObjSection); const MaxChunkSize=$3fa; var RawRecord: TOmfRawRecord; ChunkStart,ChunkLen: DWord; ChunkFixupStart,ChunkFixupEnd: Integer; SegIndex: Integer; NextOfs: Integer; Is32BitLEDATA: Boolean; I: Integer; begin if (oso_data in sec.SecOptions) then begin if sec.Data=nil then internalerror(200403073); for I:=0 to sec.ObjRelocations.Count-1 do TOmfRelocation(sec.ObjRelocations[I]).BuildOmfFixup; SegIndex:=Segments.FindIndexOf(sec.Name); RawRecord:=TOmfRawRecord.Create; sec.data.seek(0); ChunkFixupStart:=0; ChunkFixupEnd:=-1; ChunkStart:=0; ChunkLen:=Min(MaxChunkSize, sec.Data.size-ChunkStart); while ChunkLen>0 do begin { find last fixup in the chunk } while (ChunkFixupEnd<(sec.ObjRelocations.Count-1)) and (TOmfRelocation(sec.ObjRelocations[ChunkFixupEnd+1]).DataOffset<(ChunkStart+ChunkLen)) do inc(ChunkFixupEnd); { check if last chunk is crossing the chunk boundary, and trim ChunkLen if necessary } if (ChunkFixupEnd>=ChunkFixupStart) and ((TOmfRelocation(sec.ObjRelocations[ChunkFixupEnd]).DataOffset+ TOmfRelocation(sec.ObjRelocations[ChunkFixupEnd]).OmfFixup.LocationSize)>(ChunkStart+ChunkLen)) then begin ChunkLen:=TOmfRelocation(sec.ObjRelocations[ChunkFixupEnd]).DataOffset-ChunkStart; Dec(ChunkFixupEnd); end; { write LEDATA record } Is32BitLEDATA:=TOmfObjSection(sec).Use=suUse32; if Is32BitLEDATA then RawRecord.RecordType:=RT_LEDATA32 else RawRecord.RecordType:=RT_LEDATA; NextOfs:=RawRecord.WriteIndexedRef(0,SegIndex); if Is32BitLEDATA then begin RawRecord.RawData[NextOfs]:=Byte(ChunkStart); RawRecord.RawData[NextOfs+1]:=Byte(ChunkStart shr 8); RawRecord.RawData[NextOfs+2]:=Byte(ChunkStart shr 16); RawRecord.RawData[NextOfs+3]:=Byte(ChunkStart shr 24); Inc(NextOfs,4); end else begin if ChunkStart>$ffff then internalerror(2018052201); RawRecord.RawData[NextOfs]:=Byte(ChunkStart); RawRecord.RawData[NextOfs+1]:=Byte(ChunkStart shr 8); Inc(NextOfs,2); end; sec.data.read(RawRecord.RawData[NextOfs], ChunkLen); Inc(NextOfs, ChunkLen); RawRecord.RecordLength:=NextOfs+1; RawRecord.CalculateChecksumByte; RawRecord.WriteTo(FWriter); { write FIXUPP record } if ChunkFixupEnd>=ChunkFixupStart then begin RawRecord.RecordType:=RT_FIXUPP; NextOfs:=0; for I:=ChunkFixupStart to ChunkFixupEnd do begin TOmfRelocation(sec.ObjRelocations[I]).OmfFixup.DataRecordStartOffset:=ChunkStart; NextOfs:=TOmfRelocation(sec.ObjRelocations[I]).OmfFixup.WriteAt(RawRecord,NextOfs); end; RawRecord.RecordLength:=NextOfs+1; RawRecord.CalculateChecksumByte; RawRecord.WriteTo(FWriter); end; { prepare next chunk } Inc(ChunkStart, ChunkLen); ChunkLen:=Min(MaxChunkSize, sec.Data.size-ChunkStart); ChunkFixupStart:=ChunkFixupEnd+1; end; RawRecord.Free; end; end; procedure TOmfObjOutput.WriteLinNumRecords(sec: TOmfObjSection); var SegIndex: Integer; RawRecord: TOmfRawRecord; LinNumRec: TOmfRecord_LINNUM_MsLink; begin if (oso_data in sec.SecOptions) then begin if sec.Data=nil then internalerror(200403073); if sec.LinNumEntries.Count=0 then exit; SegIndex:=Segments.FindIndexOf(sec.Name); RawRecord:=TOmfRawRecord.Create; LinNumRec:=TOmfRecord_LINNUM_MsLink.Create; LinNumRec.BaseGroup:=0; LinNumRec.BaseSegment:=SegIndex; LinNumRec.LineNumberList:=sec.LinNumEntries; while LinNumRec.NextIndex0 then begin PubDefRec:=TOmfRecord_PUBDEF.Create; PubDefRec.BaseSegmentIndex:=i+1; if TOmfObjSection(Data.ObjSectionList[i]).PrimaryGroup<>nil then PubDefRec.BaseGroupIndex:=Groups.FindIndexOf(TOmfObjSection(Data.ObjSectionList[i]).PrimaryGroup.Name) else PubDefRec.BaseGroupIndex:=0; PubDefRec.PublicNames:=PubNamesForSection[i]; while PubDefRec.NextIndex0 then begin ExtDefRec:=TOmfRecord_EXTDEF.Create; ExtDefRec.ExternalNames:=ExtNames; while ExtDefRec.NextIndex$7fff then internalerror(2015040701); { maximum amount of groups supported in the omf format is $7fff } if (ngroups-1)>$7fff then internalerror(2018062101); { write header record } RawRecord:=TOmfRawRecord.Create; Header:=TOmfRecord_THEADR.Create; if cs_debuginfo in current_settings.moduleswitches then Header.ModuleName:=TOmfObjData(Data).MainSource else Header.ModuleName:=Data.Name; Header.EncodeTo(RawRecord); RawRecord.WriteTo(FWriter); Header.Free; { write translator COMENT header } Translator_COMENT:=TOmfRecord_COMENT.Create; Translator_COMENT.CommentClass:=CC_Translator; Translator_COMENT.CommentString:='FPC '+full_version_string+ ' ['+date_string+'] for '+target_cpu_string+' - '+target_info.shortname; Translator_COMENT.EncodeTo(RawRecord); RawRecord.WriteTo(FWriter); Translator_COMENT.Free; if (target_dbg.id=dbg_codeview) or ((ds_dwarf_omf_linnum in current_settings.debugswitches) and (target_dbg.id in [dbg_dwarf2,dbg_dwarf3,dbg_dwarf4])) then begin DebugFormat_COMENT:=TOmfRecord_COMENT.Create; DebugFormat_COMENT.CommentClass:=CC_NewOmfExtension; DebugFormat_COMENT.CommentString:=''; DebugFormat_COMENT.EncodeTo(RawRecord); RawRecord.WriteTo(FWriter); DebugFormat_COMENT.Free; end; LNames.Clear; LNames.Add(''); { insert an empty string, which has index 1 } FSegments.Clear; FSegments.Add('',nil); FGroups.Clear; FGroups.Add('',nil); for i:=0 to Data.GroupsList.Count-1 do AddGroup(TObjSectionGroup(Data.GroupsList[I])); for i:=0 to Data.ObjSectionList.Count-1 do with TOmfObjSection(Data.ObjSectionList[I]) do AddSegment(Name,ClassName,OverlayName,OmfAlignment,Combination,Use,Size); { write LNAMES record(s) } LNamesRec:=TOmfRecord_LNAMES.Create; LNamesRec.Names:=LNames; while LNamesRec.NextIndex<=LNames.Count do begin LNamesRec.EncodeTo(RawRecord); RawRecord.WriteTo(FWriter); end; LNamesRec.Free; { write SEGDEF record(s) } for I:=1 to Segments.Count-1 do begin SegDef:=TOmfRecord_SEGDEF(Segments[I]); SegDef.EncodeTo(RawRecord); RawRecord.WriteTo(FWriter); end; { write GRPDEF record(s) } for I:=1 to Groups.Count-1 do begin GrpDef:=TOmfRecord_GRPDEF(Groups[I]); GrpDef.EncodeTo(RawRecord); RawRecord.WriteTo(FWriter); end; { write PUBDEF record(s) } WritePUBDEFs(Data); { write EXTDEF record(s) } WriteEXTDEFs(Data); { write link pass separator } LinkPassSeparator_COMENT:=TOmfRecord_COMENT.Create; LinkPassSeparator_COMENT.CommentClass:=CC_LinkPassSeparator; LinkPassSeparator_COMENT.CommentString:=#1; LinkPassSeparator_COMENT.NoList:=True; LinkPassSeparator_COMENT.EncodeTo(RawRecord); RawRecord.WriteTo(FWriter); LinkPassSeparator_COMENT.Free; { write section content, interleaved with fixups } WriteSections(Data); { write MODEND record } ModEnd:=TOmfRecord_MODEND.Create; ModEnd.EncodeTo(RawRecord); RawRecord.WriteTo(FWriter); ModEnd.Free; RawRecord.Free; result:=true; end; constructor TOmfObjOutput.create(AWriter:TObjectWriter); begin inherited create(AWriter); cobjdata:=TOmfObjData; FLNames:=TOmfOrderedNameCollection.Create(False); FSegments:=TFPHashObjectList.Create; FSegments.Add('',nil); FGroups:=TFPHashObjectList.Create; FGroups.Add('',nil); end; destructor TOmfObjOutput.Destroy; begin FGroups.Free; FSegments.Free; FLNames.Free; inherited Destroy; end; procedure TOmfObjOutput.WriteDllImport(const dllname,afuncname,mangledname: string; ordnr: longint; isvar: boolean); var RawRecord: TOmfRawRecord; Header: TOmfRecord_THEADR; DllImport_COMENT: TOmfRecord_COMENT; ModEnd: TOmfRecord_MODEND; begin { write header record } RawRecord:=TOmfRawRecord.Create; Header:=TOmfRecord_THEADR.Create; Header.ModuleName:=mangledname; Header.EncodeTo(RawRecord); RawRecord.WriteTo(FWriter); Header.Free; { write IMPDEF record } DllImport_COMENT:=TOmfRecord_COMENT.Create; DllImport_COMENT.CommentClass:=CC_OmfExtension; if ordnr <= 0 then begin if afuncname=mangledname then DllImport_COMENT.CommentString:=#1#0+Chr(Length(mangledname))+mangledname+Chr(Length(dllname))+dllname+#0 else DllImport_COMENT.CommentString:=#1#0+Chr(Length(mangledname))+mangledname+Chr(Length(dllname))+dllname+Chr(Length(afuncname))+afuncname; end else DllImport_COMENT.CommentString:=#1#1+Chr(Length(mangledname))+mangledname+Chr(Length(dllname))+dllname+Chr(ordnr and $ff)+Chr((ordnr shr 8) and $ff); DllImport_COMENT.EncodeTo(RawRecord); RawRecord.WriteTo(FWriter); DllImport_COMENT.Free; { write MODEND record } ModEnd:=TOmfRecord_MODEND.Create; ModEnd.EncodeTo(RawRecord); RawRecord.WriteTo(FWriter); ModEnd.Free; RawRecord.Free; end; {**************************************************************************** TOmfObjInput ****************************************************************************} function TOmfObjInput.PeekNextRecordType: Byte; var OldPos: LongInt; begin OldPos:=FReader.Pos; if not FReader.read(Result, 1) then begin InputError('Unexpected end of file'); Result:=0; exit; end; FReader.seek(OldPos); end; function TOmfObjInput.ReadLNames(RawRec: TOmfRawRecord): Boolean; var LNamesRec: TOmfRecord_LNAMES; begin Result:=False; LNamesRec:=TOmfRecord_LNAMES.Create; LNamesRec.Names:=LNames; LNamesRec.DecodeFrom(RawRec); LNamesRec.Free; Result:=True; end; function TOmfObjInput.ReadSegDef(RawRec: TOmfRawRecord; objdata: TObjData): Boolean; var SegDefRec: TOmfRecord_SEGDEF; SegmentName,SegClassName,OverlayName: string; SecAlign: LongInt; secoptions: TObjSectionOptions; objsec: TOmfObjSection; begin Result:=False; SegDefRec:=TOmfRecord_SEGDEF.Create; SegDefRec.DecodeFrom(RawRec); if (SegDefRec.SegmentNameIndex<1) or (SegDefRec.SegmentNameIndex>LNames.Count) then begin InputError('Segment name index out of range'); SegDefRec.Free; exit; end; SegmentName:=LNames[SegDefRec.SegmentNameIndex]; if (SegDefRec.ClassNameIndex<1) or (SegDefRec.ClassNameIndex>LNames.Count) then begin InputError('Segment class name index out of range'); SegDefRec.Free; exit; end; SegClassName:=LNames[SegDefRec.ClassNameIndex]; if (SegDefRec.OverlayNameIndex<1) or (SegDefRec.OverlayNameIndex>LNames.Count) then begin InputError('Segment overlay name index out of range'); SegDefRec.Free; exit; end; OverlayName:=LNames[SegDefRec.OverlayNameIndex]; SecAlign:=1; // otherwise warning prohibits compilation case SegDefRec.Alignment of saRelocatableByteAligned: SecAlign:=1; saRelocatableWordAligned: SecAlign:=2; saRelocatableParaAligned: SecAlign:=16; saRelocatableDWordAligned: SecAlign:=4; saRelocatablePageAligned: SecAlign:=256; saNotSupported: SecAlign:=4096; saAbsolute: begin InputError('Absolute segment alignment not supported'); SegDefRec.Free; exit; end; saNotDefined: begin InputError('Invalid (unsupported/undefined) OMF segment alignment'); SegDefRec.Free; exit; end; end; if not CaseSensitiveSegments then begin SegmentName:=UpCase(SegmentName); SegClassName:=UpCase(SegClassName); OverlayName:=UpCase(OverlayName); end; { hack for supporting object modules, generated by Borland's BINOBJ tool } if (SegClassName='') and (SegmentName='CODE') then begin SegmentName:=InputFileName; SegClassName:='CODE'; end; secoptions:=[]; objsec:=TOmfObjSection(objdata.createsection(SegmentName+'||'+SegClassName,SecAlign,secoptions,false)); objsec.FClassName:=SegClassName; objsec.FOverlayName:=OverlayName; objsec.FCombination:=SegDefRec.Combination; objsec.FUse:=SegDefRec.Use; if SegDefRec.SegmentLength>High(objsec.Size) then begin InputError('Segment too large'); SegDefRec.Free; exit; end; objsec.Size:=SegDefRec.SegmentLength; if SegClassName='DWARF' then objsec.SecOptions:=objsec.SecOptions+[oso_debug]; if (SegClassName='HEAP') or (SegClassName='STACK') or (SegDefRec.Combination=scStack) or (SegClassName='BEGDATA') or (SegmentName='FPC') then objsec.SecOptions:=objsec.SecOptions+[oso_keep]; SegDefRec.Free; Result:=True; end; function TOmfObjInput.ReadGrpDef(RawRec: TOmfRawRecord; objdata: TObjData): Boolean; var GrpDefRec: TOmfRecord_GRPDEF; GroupName: string; SecGroup: TObjSectionGroup; i,SegIndex: Integer; begin Result:=False; GrpDefRec:=TOmfRecord_GRPDEF.Create; GrpDefRec.DecodeFrom(RawRec); if (GrpDefRec.GroupNameIndex<1) or (GrpDefRec.GroupNameIndex>LNames.Count) then begin InputError('Group name index out of range'); GrpDefRec.Free; exit; end; GroupName:=LNames[GrpDefRec.GroupNameIndex]; if not CaseSensitiveSegments then GroupName:=UpCase(GroupName); SecGroup:=objdata.createsectiongroup(GroupName); SetLength(SecGroup.members,Length(GrpDefRec.SegmentList)); for i:=0 to Length(GrpDefRec.SegmentList)-1 do begin SegIndex:=GrpDefRec.SegmentList[i]; if (SegIndex<1) or (SegIndex>objdata.ObjSectionList.Count) then begin InputError('Segment name index out of range in group definition'); GrpDefRec.Free; exit; end; SecGroup.members[i]:=TOmfObjSection(objdata.ObjSectionList[SegIndex-1]); end; GrpDefRec.Free; Result:=True; end; function TOmfObjInput.ReadExtDef(RawRec: TOmfRawRecord; objdata: TObjData): Boolean; var ExtDefRec: TOmfRecord_EXTDEF; ExtDefElem: TOmfExternalNameElement; OldCount,NewCount,i: Integer; objsym: TObjSymbol; symname: TSymStr; begin Result:=False; ExtDefRec:=TOmfRecord_EXTDEF.Create; ExtDefRec.ExternalNames:=ExtDefs; OldCount:=ExtDefs.Count; ExtDefRec.DecodeFrom(RawRec); NewCount:=ExtDefs.Count; for i:=OldCount to NewCount-1 do begin ExtDefElem:=TOmfExternalNameElement(ExtDefs[i]); symname:=ExtDefElem.Name; if not CaseSensitiveSymbols then symname:=UpCase(symname); objsym:=objdata.CreateSymbol(symname); objsym.bind:=AB_EXTERNAL; objsym.typ:=AT_FUNCTION; objsym.objsection:=nil; objsym.offset:=0; objsym.size:=0; end; ExtDefRec.Free; Result:=True; end; function TOmfObjInput.ReadPubDef(RawRec: TOmfRawRecord; objdata:TObjData): Boolean; var PubDefRec: TOmfRecord_PUBDEF; PubDefElem: TOmfPublicNameElement; OldCount,NewCount,i: Integer; basegroup: TObjSectionGroup; objsym: TObjSymbol; objsec: TOmfObjSection; symname: TSymStr; begin Result:=False; PubDefRec:=TOmfRecord_PUBDEF.Create; PubDefRec.PublicNames:=PubDefs; OldCount:=PubDefs.Count; PubDefRec.DecodeFrom(RawRec); NewCount:=PubDefs.Count; if (PubDefRec.BaseGroupIndex<0) or (PubDefRec.BaseGroupIndex>objdata.GroupsList.Count) then begin InputError('Public symbol''s group name index out of range'); PubDefRec.Free; exit; end; if PubDefRec.BaseGroupIndex<>0 then basegroup:=TObjSectionGroup(objdata.GroupsList[PubDefRec.BaseGroupIndex-1]) else basegroup:=nil; if (PubDefRec.BaseSegmentIndex<0) or (PubDefRec.BaseSegmentIndex>objdata.ObjSectionList.Count) then begin InputError('Public symbol''s segment name index out of range'); PubDefRec.Free; exit; end; if PubDefRec.BaseSegmentIndex=0 then begin InputError('Public symbol uses absolute addressing, which is not supported by this linker'); PubDefRec.Free; exit; end; objsec:=TOmfObjSection(objdata.ObjSectionList[PubDefRec.BaseSegmentIndex-1]); for i:=OldCount to NewCount-1 do begin PubDefElem:=TOmfPublicNameElement(PubDefs[i]); symname:=PubDefElem.Name; if not CaseSensitiveSymbols then symname:=UpCase(symname); objsym:=objdata.CreateSymbol(symname); if PubDefElem.IsLocal then objsym.bind:=AB_LOCAL else objsym.bind:=AB_GLOBAL; objsym.typ:=AT_FUNCTION; objsym.group:=basegroup; objsym.objsection:=objsec; objsym.offset:=PubDefElem.PublicOffset; objsym.size:=0; end; PubDefRec.Free; Result:=True; end; function TOmfObjInput.ReadModEnd(RawRec: TOmfRawRecord; objdata:TObjData): Boolean; var ModEndRec: TOmfRecord_MODEND; objsym: TObjSymbol; objsec: TOmfObjSection; basegroup: TObjSectionGroup; begin Result:=False; ModEndRec:=TOmfRecord_MODEND.Create; ModEndRec.DecodeFrom(RawRec); if ModEndRec.HasStartAddress then begin if not ModEndRec.LogicalStartAddress then begin InputError('Physical start address not supported'); ModEndRec.Free; exit; end; if not (ModEndRec.TargetMethod in [ftmSegmentIndex,ftmSegmentIndexNoDisp]) then begin InputError('Target method for start address other than "Segment Index" is not supported'); ModEndRec.Free; exit; end; if (ModEndRec.TargetDatum<1) or (ModEndRec.TargetDatum>objdata.ObjSectionList.Count) then begin InputError('Segment name index for start address out of range'); ModEndRec.Free; exit; end; case ModEndRec.FrameMethod of ffmSegmentIndex: begin if (ModEndRec.FrameDatum<1) or (ModEndRec.FrameDatum>objdata.ObjSectionList.Count) then begin InputError('Frame segment name index for start address out of range'); ModEndRec.Free; exit; end; if ModEndRec.FrameDatum<>ModEndRec.TargetDatum then begin InputError('Frame segment different than target segment is not supported supported for start address'); ModEndRec.Free; exit; end; basegroup:=nil; end; ffmGroupIndex: begin if (ModEndRec.FrameDatum<1) or (ModEndRec.FrameDatum>objdata.GroupsList.Count) then begin InputError('Frame group name index for start address out of range'); ModEndRec.Free; exit; end; basegroup:=TObjSectionGroup(objdata.GroupsList[ModEndRec.FrameDatum-1]); end; else begin InputError('Frame method for start address other than "Segment Index" or "Group Index" is not supported'); ModEndRec.Free; exit; end; end; objsec:=TOmfObjSection(objdata.ObjSectionList[ModEndRec.TargetDatum-1]); objsym:=objdata.CreateSymbol('..start'); objsym.bind:=AB_GLOBAL; objsym.typ:=AT_FUNCTION; objsym.group:=basegroup; objsym.objsection:=objsec; objsym.offset:=ModEndRec.TargetDisplacement; objsym.size:=0; end; ModEndRec.Free; Result:=True; end; function TOmfObjInput.ReadLeOrLiDataAndFixups(RawRec: TOmfRawRecord; objdata: TObjData): Boolean; var Is32Bit: Boolean; NextOfs: Integer; SegmentIndex: Integer; EnumeratedDataOffset: DWord; BlockLength: Integer; objsec: TOmfObjSection; FixupRawRec: TOmfRawRecord=nil; Fixup: TOmfSubRecord_FIXUP; Thread: TOmfSubRecord_THREAD; FixuppWithoutLeOrLiData: Boolean=False; begin Result:=False; case RawRec.RecordType of RT_LEDATA,RT_LEDATA32: begin Is32Bit:=RawRec.RecordType=RT_LEDATA32; NextOfs:=RawRec.ReadIndexedRef(0,SegmentIndex); if Is32Bit then begin if (NextOfs+3)>=RawRec.RecordLength then internalerror(2015040504); EnumeratedDataOffset := RawRec.RawData[NextOfs]+ (RawRec.RawData[NextOfs+1] shl 8)+ (RawRec.RawData[NextOfs+2] shl 16)+ (RawRec.RawData[NextOfs+3] shl 24); Inc(NextOfs,4); end else begin if (NextOfs+1)>=RawRec.RecordLength then internalerror(2015040504); EnumeratedDataOffset := RawRec.RawData[NextOfs]+ (RawRec.RawData[NextOfs+1] shl 8); Inc(NextOfs,2); end; BlockLength:=RawRec.RecordLength-NextOfs-1; if BlockLength<0 then internalerror(2015060501); if BlockLength>1024 then begin InputError('LEDATA contains more than 1024 bytes of data'); exit; end; if (SegmentIndex<1) or (SegmentIndex>objdata.ObjSectionList.Count) then begin InputError('Segment index in LEDATA field is out of range'); exit; end; objsec:=TOmfObjSection(objdata.ObjSectionList[SegmentIndex-1]); objsec.SecOptions:=objsec.SecOptions+[oso_Data]; if (objsec.Data.Size>EnumeratedDataOffset) then begin InputError('LEDATA enumerated data offset field out of sequence'); exit; end; if (EnumeratedDataOffset+BlockLength)>objsec.Size then begin InputError('LEDATA goes beyond the segment size declared in the SEGDEF record'); exit; end; objsec.Data.seek(EnumeratedDataOffset); objsec.Data.write(RawRec.RawData[NextOfs],BlockLength); end; RT_LIDATA,RT_LIDATA32: begin InputError('LIDATA records are not supported'); exit; end; RT_FIXUPP,RT_FIXUPP32: begin FixuppWithoutLeOrLiData:=True; { a hack, used to indicate, that we must process this record } { (RawRec) first in the FIXUPP record processing loop that follows } FixupRawRec:=RawRec; end; else internalerror(2015040301); end; { also read all the FIXUPP records that may follow; } { (FixupRawRec=RawRec) indicates that we must process RawRec first, but } { without freeing it } while (FixupRawRec=RawRec) or (PeekNextRecordType in [RT_FIXUPP,RT_FIXUPP32]) do begin if FixupRawRec<>RawRec then begin FixupRawRec:=TOmfRawRecord.Create; FixupRawRec.ReadFrom(FReader); if not FRawRecord.VerifyChecksumByte then begin InputError('Invalid checksum in OMF record'); FixupRawRec.Free; exit; end; end; NextOfs:=0; Thread:=TOmfSubRecord_THREAD.Create; Fixup:=TOmfSubRecord_FIXUP.Create; Fixup.Is32Bit:=FixupRawRec.RecordType=RT_FIXUPP32; Fixup.DataRecordStartOffset:=EnumeratedDataOffset; while NextOfs<(FixupRawRec.RecordLength-1) do begin if (FixupRawRec.RawData[NextOfs] and $80)<>0 then begin { FIXUP subrecord } if FixuppWithoutLeOrLiData then begin InputError('FIXUP subrecord without previous LEDATA or LIDATA record'); Fixup.Free; Thread.Free; if FixupRawRec<>RawRec then FixupRawRec.Free; exit; end; NextOfs:=Fixup.ReadAt(FixupRawRec,NextOfs); Fixup.ResolveByThread(FFixupThreads); ImportOmfFixup(objdata,objsec,Fixup); end else begin { THREAD subrecord } NextOfs:=Thread.ReadAt(FixupRawRec,NextOfs); Thread.ApplyTo(FFixupThreads); end; end; Fixup.Free; Thread.Free; if FixupRawRec<>RawRec then FixupRawRec.Free; { always set it to null, so that we read the next record on the next } { loop iteration (this ensures that FixupRawRec<>RawRec, without } { freeing RawRec) } FixupRawRec:=nil; end; Result:=True; end; function TOmfObjInput.ImportOmfFixup(objdata: TObjData; objsec: TOmfObjSection; Fixup: TOmfSubRecord_FIXUP): Boolean; var reloc: TOmfRelocation; sym: TObjSymbol; RelocType: TObjRelocationType; target_section: TOmfObjSection; target_group: TObjSectionGroup; begin Result:=False; { range check location } if (Fixup.LocationOffset+Fixup.LocationSize)>objsec.Size then begin InputError('Fixup location exceeds the current segment boundary'); exit; end; { range check target datum } case Fixup.TargetMethod of ftmSegmentIndex: if (Fixup.TargetDatum<1) or (Fixup.TargetDatum>objdata.ObjSectionList.Count) then begin InputError('Segment name index in SI(), fixup target is out of range'); exit; end; ftmSegmentIndexNoDisp: if (Fixup.TargetDatum<1) or (Fixup.TargetDatum>objdata.ObjSectionList.Count) then begin InputError('Segment name index in SI() fixup target is out of range'); exit; end; ftmGroupIndex: if (Fixup.TargetDatum<1) or (Fixup.TargetDatum>objdata.GroupsList.Count) then begin InputError('Group name index in GI(), fixup target is out of range'); exit; end; ftmGroupIndexNoDisp: if (Fixup.TargetDatum<1) or (Fixup.TargetDatum>objdata.GroupsList.Count) then begin InputError('Group name index in GI() fixup target is out of range'); exit; end; ftmExternalIndex: if (Fixup.TargetDatum<1) or (Fixup.TargetDatum>ExtDefs.Count) then begin InputError('External symbol name index in EI(), fixup target is out of range'); exit; end; ftmExternalIndexNoDisp: if (Fixup.TargetDatum<1) or (Fixup.TargetDatum>ExtDefs.Count) then begin InputError('External symbol name index in EI() fixup target is out of range'); exit; end; end; { range check frame datum } case Fixup.FrameMethod of ffmSegmentIndex: if (Fixup.FrameDatum<1) or (Fixup.FrameDatum>objdata.ObjSectionList.Count) then begin InputError('Segment name index in SI() fixup frame is out of range'); exit; end; ffmGroupIndex: if (Fixup.FrameDatum<1) or (Fixup.FrameDatum>objdata.GroupsList.Count) then begin InputError('Group name index in GI() fixup frame is out of range'); exit; end; ffmExternalIndex: if (Fixup.TargetDatum<1) or (Fixup.TargetDatum>ExtDefs.Count) then begin InputError('External symbol name index in EI() fixup frame is out of range'); exit; end; end; if Fixup.TargetMethod in [ftmExternalIndex,ftmExternalIndexNoDisp] then begin sym:=objdata.symbolref(TOmfExternalNameElement(ExtDefs[Fixup.TargetDatum-1]).Name); RelocType:=RELOC_NONE; case Fixup.LocationType of fltOffset: case Fixup.Mode of fmSegmentRelative: RelocType:=RELOC_ABSOLUTE16; fmSelfRelative: RelocType:=RELOC_RELATIVE16; end; fltOffset32: case Fixup.Mode of fmSegmentRelative: RelocType:=RELOC_ABSOLUTE32; fmSelfRelative: RelocType:=RELOC_RELATIVE32; end; fltBase: case Fixup.Mode of fmSegmentRelative: RelocType:=RELOC_SEG; fmSelfRelative: RelocType:=RELOC_SEGREL; end; fltFarPointer: case Fixup.Mode of fmSegmentRelative: RelocType:=RELOC_FARPTR; fmSelfRelative: RelocType:=RELOC_FARPTR_RELATIVEOFFSET; end; fltFarPointer48: case Fixup.Mode of fmSegmentRelative: RelocType:=RELOC_FARPTR48; fmSelfRelative: RelocType:=RELOC_FARPTR48_RELATIVEOFFSET; end; end; if RelocType=RELOC_NONE then begin InputError('Unsupported fixup location type '+tostr(Ord(Fixup.LocationType))+' with mode '+tostr(ord(Fixup.Mode))+' in external reference to '+sym.Name); exit; end; reloc:=TOmfRelocation.CreateSymbol(Fixup.LocationOffset,sym,RelocType); objsec.ObjRelocations.Add(reloc); case Fixup.FrameMethod of ffmTarget: {nothing}; ffmGroupIndex: reloc.FrameGroup:=TObjSectionGroup(objdata.GroupsList[Fixup.FrameDatum-1]).Name; else begin InputError('Unsupported frame method '+IntToStr(Ord(Fixup.FrameMethod))+' in external reference to '+sym.Name); exit; end; end; if Fixup.TargetDisplacement<>0 then begin InputError('Unsupported nonzero target displacement '+IntToStr(Fixup.TargetDisplacement)+' in external reference to '+sym.Name); exit; end; end else if Fixup.TargetMethod in [ftmSegmentIndex,ftmSegmentIndexNoDisp] then begin target_section:=TOmfObjSection(objdata.ObjSectionList[Fixup.TargetDatum-1]); RelocType:=RELOC_NONE; case Fixup.LocationType of fltOffset: case Fixup.Mode of fmSegmentRelative: RelocType:=RELOC_ABSOLUTE16; fmSelfRelative: RelocType:=RELOC_RELATIVE16; end; fltOffset32: case Fixup.Mode of fmSegmentRelative: RelocType:=RELOC_ABSOLUTE32; fmSelfRelative: RelocType:=RELOC_RELATIVE32; end; fltBase: case Fixup.Mode of fmSegmentRelative: RelocType:=RELOC_SEG; fmSelfRelative: RelocType:=RELOC_SEGREL; end; fltFarPointer: case Fixup.Mode of fmSegmentRelative: RelocType:=RELOC_FARPTR; fmSelfRelative: RelocType:=RELOC_FARPTR_RELATIVEOFFSET; end; fltFarPointer48: case Fixup.Mode of fmSegmentRelative: RelocType:=RELOC_FARPTR48; fmSelfRelative: RelocType:=RELOC_FARPTR48_RELATIVEOFFSET; end; end; if RelocType=RELOC_NONE then begin InputError('Unsupported fixup location type '+tostr(Ord(Fixup.LocationType))+' with mode '+tostr(ord(Fixup.Mode))); exit; end; reloc:=TOmfRelocation.CreateSection(Fixup.LocationOffset,target_section,RelocType); objsec.ObjRelocations.Add(reloc); case Fixup.FrameMethod of ffmTarget: {nothing}; ffmGroupIndex: reloc.FrameGroup:=TObjSectionGroup(objdata.GroupsList[Fixup.FrameDatum-1]).Name; else begin InputError('Unsupported frame method '+IntToStr(Ord(Fixup.FrameMethod))+' in reference to segment '+target_section.Name); exit; end; end; if Fixup.TargetDisplacement<>0 then begin InputError('Unsupported nonzero target displacement '+IntToStr(Fixup.TargetDisplacement)+' in reference to segment '+target_section.Name); exit; end; end else if Fixup.TargetMethod in [ftmGroupIndex,ftmGroupIndexNoDisp] then begin target_group:=TObjSectionGroup(objdata.GroupsList[Fixup.TargetDatum-1]); RelocType:=RELOC_NONE; case Fixup.LocationType of fltOffset: case Fixup.Mode of fmSegmentRelative: RelocType:=RELOC_ABSOLUTE16; fmSelfRelative: RelocType:=RELOC_RELATIVE16; end; fltOffset32: case Fixup.Mode of fmSegmentRelative: RelocType:=RELOC_ABSOLUTE32; fmSelfRelative: RelocType:=RELOC_RELATIVE32; end; fltBase: case Fixup.Mode of fmSegmentRelative: RelocType:=RELOC_SEG; fmSelfRelative: RelocType:=RELOC_SEGREL; end; fltFarPointer: case Fixup.Mode of fmSegmentRelative: RelocType:=RELOC_FARPTR; fmSelfRelative: RelocType:=RELOC_FARPTR_RELATIVEOFFSET; end; fltFarPointer48: case Fixup.Mode of fmSegmentRelative: RelocType:=RELOC_FARPTR48; fmSelfRelative: RelocType:=RELOC_FARPTR48_RELATIVEOFFSET; end; end; if RelocType=RELOC_NONE then begin InputError('Unsupported fixup location type '+tostr(Ord(Fixup.LocationType))+' with mode '+tostr(ord(Fixup.Mode))); exit; end; reloc:=TOmfRelocation.CreateGroup(Fixup.LocationOffset,target_group,RelocType); objsec.ObjRelocations.Add(reloc); case Fixup.FrameMethod of ffmTarget: {nothing}; else begin InputError('Unsupported frame method '+IntToStr(Ord(Fixup.FrameMethod))+' in reference to group '+target_group.Name); exit; end; end; if Fixup.TargetDisplacement<>0 then begin InputError('Unsupported nonzero target displacement '+IntToStr(Fixup.TargetDisplacement)+' in reference to group '+target_group.Name); exit; end; end else begin {todo: convert other fixup types as well } InputError('Unsupported fixup target method '+IntToStr(Ord(Fixup.TargetMethod))); exit; end; Result:=True; end; constructor TOmfObjInput.create; begin inherited create; cobjdata:=TOmfObjData; FLNames:=TOmfOrderedNameCollection.Create(True); FExtDefs:=TFPHashObjectList.Create; FPubDefs:=TFPHashObjectList.Create; FFixupThreads:=TOmfThreads.Create; FRawRecord:=TOmfRawRecord.Create; CaseSensitiveSegments:=False; CaseSensitiveSymbols:=True; end; destructor TOmfObjInput.destroy; begin FCOMENTRecord.Free; FRawRecord.Free; FFixupThreads.Free; FPubDefs.Free; FExtDefs.Free; FLNames.Free; inherited destroy; end; class function TOmfObjInput.CanReadObjData(AReader: TObjectreader): boolean; var b: Byte; begin result:=false; if AReader.Read(b,sizeof(b)) then begin if b=RT_THEADR then { TODO: check additional fields } result:=true; end; AReader.Seek(0); end; function TOmfObjInput.ReadObjData(AReader: TObjectreader; out objdata: TObjData): boolean; begin FReader:=AReader; InputFileName:=AReader.FileName; objdata:=CObjData.Create(InputFileName); result:=false; LNames.Clear; ExtDefs.Clear; FRawRecord.ReadFrom(FReader); if not FRawRecord.VerifyChecksumByte then begin InputError('Invalid checksum in OMF record'); exit; end; if FRawRecord.RecordType<>RT_THEADR then begin InputError('Can''t read OMF header'); exit; end; repeat FRawRecord.ReadFrom(FReader); if not FRawRecord.VerifyChecksumByte then begin InputError('Invalid checksum in OMF record'); exit; end; FreeAndNil(FCOMENTRecord); case FRawRecord.RecordType of RT_LNAMES: if not ReadLNames(FRawRecord) then exit; RT_SEGDEF,RT_SEGDEF32: if not ReadSegDef(FRawRecord,objdata) then exit; RT_GRPDEF: if not ReadGrpDef(FRawRecord,objdata) then exit; RT_COMENT: begin FCOMENTRecord:=TOmfRecord_COMENT.Create; FCOMENTRecord.DecodeFrom(FRawRecord); case FCOMENTRecord.CommentClass of CC_OmfExtension: begin {todo: handle these as well...} end; CC_LIBMOD: begin {todo: do we need to read the module name here?} end; CC_EXESTR: begin InputError('EXESTR record (Executable String Record) is not supported'); exit; end; CC_INCERR: begin InputError('Invalid object file (contains indication of error encountered during incremental compilation)'); exit; end; CC_NOPAD: begin InputError('NOPAD (No Segment Padding) record is not supported'); exit; end; CC_WKEXT: begin InputError('Weak externals are not supported'); exit; end; CC_LZEXT: begin InputError('Lazy externals are not supported'); exit; end; else begin {the rest are ignored for now...} end; end; end; RT_EXTDEF: if not ReadExtDef(FRawRecord,objdata) then exit; RT_LPUBDEF,RT_LPUBDEF32, RT_PUBDEF,RT_PUBDEF32: if not ReadPubDef(FRawRecord,objdata) then exit; RT_LEDATA,RT_LEDATA32, RT_LIDATA,RT_LIDATA32, RT_FIXUPP,RT_FIXUPP32: if not ReadLeOrLiDataAndFixups(FRawRecord,objdata) then exit; RT_MODEND,RT_MODEND32: if not ReadModEnd(FRawRecord,objdata) then exit; RT_LINNUM,RT_LINNUM32: ; else begin InputError('Unsupported OMF record type $'+HexStr(FRawRecord.RecordType,2)); exit; end; end; until FRawRecord.RecordType in [RT_MODEND,RT_MODEND32]; result:=true; end; {**************************************************************************** TMZExeHeader ****************************************************************************} procedure TMZExeHeader.SetHeaderSizeAlignment(AValue: Integer); begin if (AValue<16) or ((AValue mod 16) <> 0) then Internalerror(2015060601); FHeaderSizeAlignment:=AValue; end; constructor TMZExeHeader.Create; begin FHeaderSizeAlignment:=16; end; procedure TMZExeHeader.WriteTo(aWriter: TObjectWriter); var NumRelocs: Word; HeaderSizeInBytes: DWord; HeaderParagraphs: Word; RelocTableOffset: Word; BytesInLastBlock: Word; BlocksInFile: Word; HeaderBytes: array [0..$1B] of Byte; RelocBytes: array [0..3] of Byte; TotalExeSize: DWord; i: Integer; begin NumRelocs:=Length(Relocations); RelocTableOffset:=$1C+Length(ExtraHeaderData); HeaderSizeInBytes:=Align(RelocTableOffset+4*NumRelocs,16); HeaderParagraphs:=HeaderSizeInBytes div 16; TotalExeSize:=HeaderSizeInBytes+LoadableImageSize; BlocksInFile:=(TotalExeSize+511) div 512; BytesInLastBlock:=TotalExeSize mod 512; HeaderBytes[$00]:=$4D; { 'M' } HeaderBytes[$01]:=$5A; { 'Z' } HeaderBytes[$02]:=Byte(BytesInLastBlock); HeaderBytes[$03]:=Byte(BytesInLastBlock shr 8); HeaderBytes[$04]:=Byte(BlocksInFile); HeaderBytes[$05]:=Byte(BlocksInFile shr 8); HeaderBytes[$06]:=Byte(NumRelocs); HeaderBytes[$07]:=Byte(NumRelocs shr 8); HeaderBytes[$08]:=Byte(HeaderParagraphs); HeaderBytes[$09]:=Byte(HeaderParagraphs shr 8); HeaderBytes[$0A]:=Byte(MinExtraParagraphs); HeaderBytes[$0B]:=Byte(MinExtraParagraphs shr 8); HeaderBytes[$0C]:=Byte(MaxExtraParagraphs); HeaderBytes[$0D]:=Byte(MaxExtraParagraphs shr 8); HeaderBytes[$0E]:=Byte(InitialSS); HeaderBytes[$0F]:=Byte(InitialSS shr 8); HeaderBytes[$10]:=Byte(InitialSP); HeaderBytes[$11]:=Byte(InitialSP shr 8); HeaderBytes[$12]:=Byte(Checksum); HeaderBytes[$13]:=Byte(Checksum shr 8); HeaderBytes[$14]:=Byte(InitialIP); HeaderBytes[$15]:=Byte(InitialIP shr 8); HeaderBytes[$16]:=Byte(InitialCS); HeaderBytes[$17]:=Byte(InitialCS shr 8); HeaderBytes[$18]:=Byte(RelocTableOffset); HeaderBytes[$19]:=Byte(RelocTableOffset shr 8); HeaderBytes[$1A]:=Byte(OverlayNumber); HeaderBytes[$1B]:=Byte(OverlayNumber shr 8); aWriter.write(HeaderBytes[0],$1C); aWriter.write(ExtraHeaderData[0],Length(ExtraHeaderData)); for i:=0 to NumRelocs-1 do with Relocations[i] do begin RelocBytes[0]:=Byte(offset); RelocBytes[1]:=Byte(offset shr 8); RelocBytes[2]:=Byte(segment); RelocBytes[3]:=Byte(segment shr 8); aWriter.write(RelocBytes[0],4); end; { pad with zeros until the end of header (paragraph aligned) } aWriter.WriteZeros(HeaderSizeInBytes-aWriter.Size); end; procedure TMZExeHeader.AddRelocation(aSegment, aOffset: Word); begin SetLength(FRelocations,Length(FRelocations)+1); with FRelocations[High(FRelocations)] do begin segment:=aSegment; offset:=aOffset; end; end; {**************************************************************************** TMZExeSection ****************************************************************************} procedure TMZExeSection.AddObjSection(objsec: TObjSection; ignoreprops: boolean); begin { allow mixing initialized and uninitialized data in the same section => set ignoreprops=true } inherited AddObjSection(objsec,true); end; {**************************************************************************** TMZExeUnifiedLogicalSegment ****************************************************************************} constructor TMZExeUnifiedLogicalSegment.create(HashObjectList: TFPHashObjectList; const s: TSymStr); var Separator: SizeInt; begin inherited create(HashObjectList,s); FObjSectionList:=TFPObjectList.Create(false); { name format is 'SegName||ClassName' } Separator:=Pos('||',s); if Separator>0 then begin FSegName:=Copy(s,1,Separator-1); FSegClass:=Copy(s,Separator+2,Length(s)-Separator-1); end else begin FSegName:=Name; FSegClass:=''; end; { wlink recognizes the stack segment by the class name 'STACK' } { let's be compatible with wlink } IsStack:=FSegClass='STACK'; end; destructor TMZExeUnifiedLogicalSegment.destroy; begin FObjSectionList.Free; inherited destroy; end; procedure TMZExeUnifiedLogicalSegment.AddObjSection(ObjSec: TOmfObjSection); begin ObjSectionList.Add(ObjSec); ObjSec.MZExeUnifiedLogicalSegment:=self; { tlink (and ms link?) use the scStack segment combination to recognize the stack segment. let's be compatible with tlink as well } if ObjSec.Combination=scStack then IsStack:=True; end; procedure TMZExeUnifiedLogicalSegment.CalcMemPos; var MinMemPos: qword=high(qword); MaxMemPos: qword=0; objsec: TOmfObjSection; i: Integer; begin if ObjSectionList.Count=0 then internalerror(2015082201); for i:=0 to ObjSectionList.Count-1 do begin objsec:=TOmfObjSection(ObjSectionList[i]); if objsec.MemPosMaxMemPos then MaxMemPos:=objsec.MemPos+objsec.Size; end; MemPos:=MinMemPos; Size:=MaxMemPos-MemPos; end; function TMZExeUnifiedLogicalSegment.MemPosStr: string; begin Result:=HexStr(MemBasePos shr 4,4)+':'+HexStr((MemPos-MemBasePos),4); end; {**************************************************************************** TMZExeUnifiedLogicalGroup ****************************************************************************} constructor TMZExeUnifiedLogicalGroup.create(HashObjectList: TFPHashObjectList; const s: TSymStr); begin inherited create(HashObjectList,s); FSegmentList:=TFPHashObjectList.Create(false); end; destructor TMZExeUnifiedLogicalGroup.destroy; begin FSegmentList.Free; inherited destroy; end; procedure TMZExeUnifiedLogicalGroup.CalcMemPos; var MinMemPos: qword=high(qword); MaxMemPos: qword=0; UniSeg: TMZExeUnifiedLogicalSegment; i: Integer; begin if SegmentList.Count=0 then internalerror(2015082201); for i:=0 to SegmentList.Count-1 do begin UniSeg:=TMZExeUnifiedLogicalSegment(SegmentList[i]); if UniSeg.MemPosMaxMemPos then MaxMemPos:=UniSeg.MemPos+UniSeg.Size; end; { align *down* on a paragraph boundary } MemPos:=(MinMemPos shr 4) shl 4; Size:=MaxMemPos-MemPos; end; function TMZExeUnifiedLogicalGroup.MemPosStr: string; begin Result:=HexStr(MemPos shr 4,4)+':'+HexStr(MemPos and $f,4); end; procedure TMZExeUnifiedLogicalGroup.AddSegment(UniSeg: TMZExeUnifiedLogicalSegment); begin SegmentList.Add(UniSeg.Name,UniSeg); if UniSeg.PrimaryGroup='' then UniSeg.PrimaryGroup:=Name; end; {**************************************************************************** TMZExeOutput ****************************************************************************} function TMZExeOutput.GetMZFlatContentSection: TMZExeSection; begin if not assigned(FMZFlatContentSection) then FMZFlatContentSection:=TMZExeSection(FindExeSection('.MZ_flat_content')); result:=FMZFlatContentSection; end; procedure TMZExeOutput.CalcDwarfUnifiedLogicalSegmentsForSection(const SecName: TSymStr); var ExeSec: TMZExeSection; ObjSec: TOmfObjSection; UniSeg: TMZExeUnifiedLogicalSegment; i: Integer; begin ExeSec:=TMZExeSection(FindExeSection(SecName)); for i:=0 to ExeSec.ObjSectionList.Count-1 do begin ObjSec:=TOmfObjSection(ExeSec.ObjSectionList[i]); UniSeg:=TMZExeUnifiedLogicalSegment(DwarfUnifiedLogicalSegments.Find(ObjSec.Name)); if not assigned(UniSeg) then begin UniSeg:=TMZExeUnifiedLogicalSegment.Create(DwarfUnifiedLogicalSegments,ObjSec.Name); UniSeg.MemPos:=0; end; UniSeg.AddObjSection(ObjSec); end; for i:=0 to DwarfUnifiedLogicalSegments.Count-1 do begin UniSeg:=TMZExeUnifiedLogicalSegment(DwarfUnifiedLogicalSegments[i]); UniSeg.CalcMemPos; end; end; procedure TMZExeOutput.CalcExeUnifiedLogicalSegments; var ExeSec: TMZExeSection; ObjSec: TOmfObjSection; UniSeg: TMZExeUnifiedLogicalSegment; i: Integer; begin ExeSec:=MZFlatContentSection; for i:=0 to ExeSec.ObjSectionList.Count-1 do begin ObjSec:=TOmfObjSection(ExeSec.ObjSectionList[i]); UniSeg:=TMZExeUnifiedLogicalSegment(ExeUnifiedLogicalSegments.Find(ObjSec.Name)); if not assigned(UniSeg) then UniSeg:=TMZExeUnifiedLogicalSegment.Create(ExeUnifiedLogicalSegments,ObjSec.Name); UniSeg.AddObjSection(ObjSec); end; for i:=0 to ExeUnifiedLogicalSegments.Count-1 do begin UniSeg:=TMZExeUnifiedLogicalSegment(ExeUnifiedLogicalSegments[i]); UniSeg.CalcMemPos; if UniSeg.Size>$10000 then begin if current_settings.x86memorymodel=mm_tiny then Message1(link_e_program_segment_too_large,IntToStr(UniSeg.Size-$10000)) else if UniSeg.SegClass='CODE' then Message2(link_e_code_segment_too_large,UniSeg.SegName,IntToStr(UniSeg.Size-$10000)) else if UniSeg.SegClass='DATA' then Message2(link_e_data_segment_too_large,UniSeg.SegName,IntToStr(UniSeg.Size-$10000)) else Message2(link_e_segment_too_large,UniSeg.SegName,IntToStr(UniSeg.Size-$10000)+' '+UniSeg.SegName); end; end; end; procedure TMZExeOutput.CalcExeGroups; procedure AddToGroup(UniSeg:TMZExeUnifiedLogicalSegment;GroupName:TSymStr); var Group: TMZExeUnifiedLogicalGroup; begin Group:=TMZExeUnifiedLogicalGroup(ExeUnifiedLogicalGroups.Find(GroupName)); if not assigned(Group) then Group:=TMZExeUnifiedLogicalGroup.Create(ExeUnifiedLogicalGroups,GroupName); Group.AddSegment(UniSeg); end; var objdataidx,groupidx,secidx: Integer; ObjData: TObjData; ObjGroup: TObjSectionGroup; ObjSec: TOmfObjSection; UniGrp: TMZExeUnifiedLogicalGroup; begin for objdataidx:=0 to ObjDataList.Count-1 do begin ObjData:=TObjData(ObjDataList[objdataidx]); if assigned(ObjData.GroupsList) then for groupidx:=0 to ObjData.GroupsList.Count-1 do begin ObjGroup:=TObjSectionGroup(ObjData.GroupsList[groupidx]); for secidx:=low(ObjGroup.members) to high(ObjGroup.members) do begin ObjSec:=TOmfObjSection(ObjGroup.members[secidx]); if assigned(ObjSec.MZExeUnifiedLogicalSegment) then AddToGroup(ObjSec.MZExeUnifiedLogicalSegment,ObjGroup.Name); end; end; end; for groupidx:=0 to ExeUnifiedLogicalGroups.Count-1 do begin UniGrp:=TMZExeUnifiedLogicalGroup(ExeUnifiedLogicalGroups[groupidx]); UniGrp.CalcMemPos; if UniGrp.Size>$10000 then begin if current_settings.x86memorymodel=mm_tiny then Message1(link_e_program_segment_too_large,IntToStr(UniGrp.Size-$10000)) else if UniGrp.Name='DGROUP' then Message2(link_e_data_segment_too_large,UniGrp.Name,IntToStr(UniGrp.Size-$10000)) else Message2(link_e_group_too_large,UniGrp.Name,IntToStr(UniGrp.Size-$10000)); end; end; end; procedure TMZExeOutput.CalcSegments_MemBasePos; var lastbase:qword=0; i: Integer; UniSeg: TMZExeUnifiedLogicalSegment; begin for i:=0 to ExeUnifiedLogicalSegments.Count-1 do begin UniSeg:=TMZExeUnifiedLogicalSegment(ExeUnifiedLogicalSegments[i]); if (UniSeg.PrimaryGroup<>'') or (UniSeg.IsStack) or (((UniSeg.MemPos+UniSeg.Size-1)-lastbase)>$ffff) then lastbase:=(UniSeg.MemPos shr 4) shl 4; UniSeg.MemBasePos:=lastbase; end; end; procedure TMZExeOutput.WriteMap_SegmentsAndGroups; var i, LongestGroupName, LongestSegmentName, LongestClassName: Integer; UniSeg: TMZExeUnifiedLogicalSegment; UniGrp: TMZExeUnifiedLogicalGroup; GroupColumnSize, SegmentColumnSize, ClassColumnSize: LongInt; begin LongestGroupName:=0; for i:=0 to ExeUnifiedLogicalGroups.Count-1 do begin UniGrp:=TMZExeUnifiedLogicalGroup(ExeUnifiedLogicalGroups[i]); LongestGroupName:=max(LongestGroupName,Length(UniGrp.Name)); end; LongestSegmentName:=0; LongestClassName:=0; for i:=0 to ExeUnifiedLogicalSegments.Count-1 do begin UniSeg:=TMZExeUnifiedLogicalSegment(ExeUnifiedLogicalSegments[i]); LongestSegmentName:=max(LongestSegmentName,Length(UniSeg.SegName)); LongestClassName:=max(LongestClassName,Length(UniSeg.SegClass)); end; GroupColumnSize:=max(32,LongestGroupName+1); SegmentColumnSize:=max(23,LongestSegmentName+1); ClassColumnSize:=max(15,LongestClassName+1); exemap.AddHeader('Groups list'); exemap.Add(''); exemap.Add(PadSpace('Group',GroupColumnSize)+PadSpace('Address',21)+'Size'); exemap.Add(PadSpace('=====',GroupColumnSize)+PadSpace('=======',21)+'===='); exemap.Add(''); for i:=0 to ExeUnifiedLogicalGroups.Count-1 do begin UniGrp:=TMZExeUnifiedLogicalGroup(ExeUnifiedLogicalGroups[i]); exemap.Add(PadSpace(UniGrp.Name,GroupColumnSize)+PadSpace(UniGrp.MemPosStr,21)+HexStr(UniGrp.Size,8)); end; exemap.Add(''); GroupColumnSize:=max(15,LongestGroupName+1); exemap.AddHeader('Segments list'); exemap.Add(''); exemap.Add(PadSpace('Segment',SegmentColumnSize)+PadSpace('Class',ClassColumnSize)+PadSpace('Group',GroupColumnSize)+PadSpace('Address',16)+'Size'); exemap.Add(PadSpace('=======',SegmentColumnSize)+PadSpace('=====',ClassColumnSize)+PadSpace('=====',GroupColumnSize)+PadSpace('=======',16)+'===='); exemap.Add(''); for i:=0 to ExeUnifiedLogicalSegments.Count-1 do begin UniSeg:=TMZExeUnifiedLogicalSegment(ExeUnifiedLogicalSegments[i]); exemap.Add(PadSpace(UniSeg.SegName,SegmentColumnSize)+PadSpace(UniSeg.SegClass,ClassColumnSize)+PadSpace(UniSeg.PrimaryGroup,GroupColumnSize)+PadSpace(UniSeg.MemPosStr,16)+HexStr(UniSeg.Size,8)); end; exemap.Add(''); end; procedure TMZExeOutput.WriteMap_HeaderData; begin exemap.AddHeader('Header data'); exemap.Add('Loadable image size: '+HexStr(Header.LoadableImageSize,8)); exemap.Add('Min extra paragraphs: '+HexStr(Header.MinExtraParagraphs,4)); exemap.Add('Max extra paragraphs: '+HexStr(Header.MaxExtraParagraphs,4)); exemap.Add('Initial stack pointer: '+HexStr(Header.InitialSS,4)+':'+HexStr(Header.InitialSP,4)); exemap.Add('Entry point address: '+HexStr(Header.InitialCS,4)+':'+HexStr(Header.InitialIP,4)); end; function TMZExeOutput.FindStackSegment: TMZExeUnifiedLogicalSegment; var i: Integer; stackseg_wannabe: TMZExeUnifiedLogicalSegment; begin Result:=nil; for i:=0 to ExeUnifiedLogicalSegments.Count-1 do begin stackseg_wannabe:=TMZExeUnifiedLogicalSegment(ExeUnifiedLogicalSegments[i]); { if there are multiple stack segments, choose the largest one. In theory, we're probably supposed to combine them all and put them in a contiguous location in memory, but we don't care } if stackseg_wannabe.IsStack and (not assigned(result) or (Result.Size0) and assigned(ObjSec.Data) then if (ObjSec.MemPos+ObjSec.Size)>Header.LoadableImageSize then Header.LoadableImageSize:=ObjSec.MemPos+ObjSec.Size; end; end; procedure TMZExeOutput.FillMinExtraParagraphs; var ExeSec: TMZExeSection; begin ExeSec:=MZFlatContentSection; Header.MinExtraParagraphs:=(align(ExeSec.Size,16)-align(Header.LoadableImageSize,16)) div 16; end; procedure TMZExeOutput.FillMaxExtraParagraphs; var heapmin_paragraphs: Integer; heapmax_paragraphs: Integer; begin if current_settings.x86memorymodel in x86_far_data_models then begin { calculate the additional number of paragraphs needed } heapmin_paragraphs:=(heapsize + 15) div 16; heapmax_paragraphs:=(maxheapsize + 15) div 16; Header.MaxExtraParagraphs:=min(Header.MinExtraParagraphs-heapmin_paragraphs+heapmax_paragraphs,$FFFF); end else Header.MaxExtraParagraphs:=$FFFF; end; procedure TMZExeOutput.FillStartAddress; var EntryMemPos: qword; EntryMemBasePos: qword; begin EntryMemPos:=EntrySym.address; if assigned(EntrySym.group) then EntryMemBasePos:=TMZExeUnifiedLogicalGroup(ExeUnifiedLogicalGroups.Find(EntrySym.group.Name)).MemPos else EntryMemBasePos:=TOmfObjSection(EntrySym.objsection).MZExeUnifiedLogicalSegment.MemBasePos; Header.InitialIP:=EntryMemPos-EntryMemBasePos; Header.InitialCS:=EntryMemBasePos shr 4; end; procedure TMZExeOutput.FillStackAddress; var stackseg: TMZExeUnifiedLogicalSegment; begin stackseg:=FindStackSegment; if assigned(stackseg) then begin Header.InitialSS:=stackseg.MemBasePos shr 4; Header.InitialSP:=stackseg.MemPos+stackseg.Size-stackseg.MemBasePos; end else begin Header.InitialSS:=0; Header.InitialSP:=0; end; end; procedure TMZExeOutput.FillHeaderData; begin Header.MaxExtraParagraphs:=$FFFF; FillLoadableImageSize; FillMinExtraParagraphs; FillMaxExtraParagraphs; FillStartAddress; FillStackAddress; if assigned(exemap) then WriteMap_HeaderData; end; function TMZExeOutput.writeExe: boolean; var ExeSec: TMZExeSection; i: Integer; ObjSec: TOmfObjSection; begin Result:=False; FillHeaderData; Header.WriteTo(FWriter); ExeSec:=MZFlatContentSection; ExeSec.DataPos:=FWriter.Size; for i:=0 to ExeSec.ObjSectionList.Count-1 do begin ObjSec:=TOmfObjSection(ExeSec.ObjSectionList[i]); if ObjSec.MemPos0 then begin Message(link_e_com_program_uses_segment_relocations); exit(False); end; ExeSec:=MZFlatContentSection; for i:=0 to ExeSec.ObjSectionList.Count-1 do begin ObjSec:=TOmfObjSection(ExeSec.ObjSectionList[i]); if ObjSec.MemPos0 then FWriter.write(buf,bytesread); until bytesread=0; end else FWriter.writearray(ObjSec.Data); end; end; end; Result:=True; end; function TMZExeOutput.writeDebugElf: boolean; label cleanup; var debugsections: array of TMZExeSection; debugsections_count: Word; elfsections_count: Word; elfsechdrs: array of TElf32sechdr; shstrndx: Word; next_section_ofs, elf_start_pos, elf_end_pos: LongWord; ElfHeader: TElf32header; shstrtabsect_data: TDynamicArray=Nil; I, elfsecidx, J: Integer; ObjSec: TOmfObjSection; tis_trailer: TTISTrailer; begin { mark the offset of the start of the ELF image } elf_start_pos:=Writer.Size; { count the debug sections } debugsections_count:=0; for I:=0 to ExeSectionList.Count-1 do if oso_debug in TMZExeSection(ExeSectionList[I]).SecOptions then Inc(debugsections_count); { extract them into the debugsections array } SetLength(debugsections,debugsections_count); debugsections_count:=0; for I:=0 to ExeSectionList.Count-1 do if oso_debug in TMZExeSection(ExeSectionList[I]).SecOptions then begin debugsections[debugsections_count]:=TMZExeSection(ExeSectionList[I]); Inc(debugsections_count); end; { prepare/allocate elf section headers } elfsections_count:=debugsections_count+2; SetLength(elfsechdrs,elfsections_count); for I:=0 to elfsections_count-1 do FillChar(elfsechdrs[I],SizeOf(elfsechdrs[I]),0); shstrndx:=elfsections_count-1; shstrtabsect_data:=tdynamicarray.Create(SectionDataMaxGrow); shstrtabsect_data.writestr(#0); next_section_ofs:=SizeOf(ElfHeader)+elfsections_count*SizeOf(TElf32sechdr); for I:=0 to debugsections_count-1 do begin elfsecidx:=I+1; with elfsechdrs[elfsecidx] do begin sh_name:=shstrtabsect_data.Pos; sh_type:=SHT_PROGBITS; sh_flags:=0; sh_addr:=0; sh_offset:=next_section_ofs; sh_size:=debugsections[I].Size; sh_link:=0; sh_info:=0; sh_addralign:=0; sh_entsize:=0; end; Inc(next_section_ofs,debugsections[I].Size); shstrtabsect_data.writestr(debugsections[I].Name+#0); end; with elfsechdrs[shstrndx] do begin sh_name:=shstrtabsect_data.Pos; shstrtabsect_data.writestr('.shstrtab'#0); sh_type:=SHT_STRTAB; sh_flags:=0; sh_addr:=0; sh_offset:=next_section_ofs; sh_size:=shstrtabsect_data.Size; sh_link:=0; sh_info:=0; sh_addralign:=0; sh_entsize:=0; end; { write header } FillChar(ElfHeader,SizeOf(ElfHeader),0); ElfHeader.e_ident[EI_MAG0]:=ELFMAG0; { = #127'ELF' } ElfHeader.e_ident[EI_MAG1]:=ELFMAG1; ElfHeader.e_ident[EI_MAG2]:=ELFMAG2; ElfHeader.e_ident[EI_MAG3]:=ELFMAG3; ElfHeader.e_ident[EI_CLASS]:=ELFCLASS32; ElfHeader.e_ident[EI_DATA]:=ELFDATA2LSB; ElfHeader.e_ident[EI_VERSION]:=1; ElfHeader.e_ident[EI_OSABI]:=ELFOSABI_NONE; ElfHeader.e_ident[EI_ABIVERSION]:=0; ElfHeader.e_type:=ET_EXEC; ElfHeader.e_machine:=EM_386; ElfHeader.e_version:=1; ElfHeader.e_entry:=0; ElfHeader.e_phoff:=0; ElfHeader.e_shoff:=SizeOf(ElfHeader); ElfHeader.e_flags:=0; ElfHeader.e_ehsize:=SizeOf(ElfHeader); ElfHeader.e_phentsize:=SizeOf(TElf32proghdr); ElfHeader.e_phnum:=0; ElfHeader.e_shentsize:=SizeOf(TElf32sechdr); ElfHeader.e_shnum:=elfsections_count; ElfHeader.e_shstrndx:=shstrndx; MaybeSwapHeader(ElfHeader); Writer.write(ElfHeader,sizeof(ElfHeader)); { write section headers } for I:=0 to elfsections_count-1 do begin MaybeSwapSecHeader(elfsechdrs[I]); Writer.write(elfsechdrs[I],SizeOf(elfsechdrs[I])); end; { write section data } for J:=0 to debugsections_count-1 do begin debugsections[J].DataPos:=Writer.Size; for i:=0 to debugsections[J].ObjSectionList.Count-1 do begin ObjSec:=TOmfObjSection(debugsections[J].ObjSectionList[i]); if assigned(ObjSec.Data) then FWriter.writearray(ObjSec.Data); end; end; { write .shstrtab section data } Writer.writearray(shstrtabsect_data); { mark the offset past the end of the ELF image } elf_end_pos:=Writer.Size; { write TIS trailer (not part of the ELF image) } FillChar(tis_trailer,sizeof(tis_trailer),0); with tis_trailer do begin tis_signature:=TIS_TRAILER_SIGNATURE; tis_vendor:=TIS_TRAILER_VENDOR_TIS; tis_type:=TIS_TRAILER_TYPE_TIS_DWARF; tis_size:=(elf_end_pos-elf_start_pos)+sizeof(tis_trailer); end; MayBeSwapTISTrailer(tis_trailer); Writer.write(tis_trailer,sizeof(tis_trailer)); Result:=True; cleanup: shstrtabsect_data.Free; end; procedure TMZExeOutput.Load_Symbol(const aname: string); var dgroup: TObjSectionGroup; sym: TObjSymbol; begin { special handling for the '_edata' and '_end' symbols, which are internally added by the linker } if (aname='_edata') or (aname='_end') then begin { create an internal segment with the 'BSS' class } internalObjData.createsection('*'+aname+'||BSS',0,[]); { add to group 'DGROUP' } dgroup:=nil; if assigned(internalObjData.GroupsList) then dgroup:=TObjSectionGroup(internalObjData.GroupsList.Find('DGROUP')); if dgroup=nil then dgroup:=internalObjData.createsectiongroup('DGROUP'); SetLength(dgroup.members,Length(dgroup.members)+1); dgroup.members[Length(dgroup.members)-1]:=internalObjData.CurrObjSec; { define the symbol itself } sym:=internalObjData.SymbolDefine(aname,AB_GLOBAL,AT_DATA); sym.group:=dgroup; end else inherited; end; procedure TMZExeOutput.DoRelocationFixup(objsec: TObjSection); var i: Integer; omfsec: TOmfObjSection absolute objsec; objreloc: TOmfRelocation; target: DWord; framebase: DWord; fixupamount: Integer; target_group: TMZExeUnifiedLogicalGroup; procedure FixupOffset; var w: Word; begin omfsec.Data.seek(objreloc.DataOffset); omfsec.Data.read(w,2); w:=LEtoN(w); Inc(w,fixupamount); w:=LEtoN(w); omfsec.Data.seek(objreloc.DataOffset); omfsec.Data.write(w,2); end; procedure FixupOffset32; var lw: LongWord; begin omfsec.Data.seek(objreloc.DataOffset); omfsec.Data.read(lw,4); lw:=LEtoN(lw); Inc(lw,fixupamount); lw:=LEtoN(lw); omfsec.Data.seek(objreloc.DataOffset); omfsec.Data.write(lw,4); end; procedure FixupBase(DataOffset: LongWord); var w: Word; begin omfsec.Data.seek(DataOffset); omfsec.Data.read(w,2); w:=LEtoN(w); Inc(w,framebase shr 4); w:=LEtoN(w); omfsec.Data.seek(DataOffset); omfsec.Data.write(w,2); Header.AddRelocation(omfsec.MZExeUnifiedLogicalSegment.MemBasePos shr 4, omfsec.MemPos+DataOffset-omfsec.MZExeUnifiedLogicalSegment.MemBasePos); end; begin for i:=0 to objsec.ObjRelocations.Count-1 do begin objreloc:=TOmfRelocation(objsec.ObjRelocations[i]); if assigned(objreloc.symbol) then begin target:=objreloc.symbol.address; if objreloc.FrameGroup<>'' then framebase:=TMZExeUnifiedLogicalGroup(ExeUnifiedLogicalGroups.Find(objreloc.FrameGroup)).MemPos else if assigned(objreloc.symbol.group) then framebase:=TMZExeUnifiedLogicalGroup(ExeUnifiedLogicalGroups.Find(objreloc.symbol.group.Name)).MemPos else framebase:=TOmfObjSection(objreloc.symbol.objsection).MZExeUnifiedLogicalSegment.MemBasePos; case objreloc.typ of RELOC_ABSOLUTE16,RELOC_ABSOLUTE32,RELOC_SEG,RELOC_FARPTR,RELOC_FARPTR48: fixupamount:=target-framebase; RELOC_RELATIVE16,RELOC_SEGREL,RELOC_FARPTR_RELATIVEOFFSET: fixupamount:=target-(omfsec.MemPos+objreloc.DataOffset)-2; RELOC_RELATIVE32,RELOC_FARPTR48_RELATIVEOFFSET: fixupamount:=target-(omfsec.MemPos+objreloc.DataOffset)-4; else internalerror(2015082402); end; case objreloc.typ of RELOC_ABSOLUTE16, RELOC_RELATIVE16: FixupOffset; RELOC_ABSOLUTE32, RELOC_RELATIVE32: FixupOffset32; RELOC_SEG, RELOC_SEGREL: FixupBase(objreloc.DataOffset); RELOC_FARPTR, RELOC_FARPTR_RELATIVEOFFSET: begin FixupOffset; FixupBase(objreloc.DataOffset+2); end; RELOC_FARPTR48, RELOC_FARPTR48_RELATIVEOFFSET: begin FixupOffset32; FixupBase(objreloc.DataOffset+4); end; else internalerror(2015082403); end; end else if assigned(objreloc.objsection) then begin target:=objreloc.objsection.MemPos; if objreloc.FrameGroup<>'' then framebase:=TMZExeUnifiedLogicalGroup(ExeUnifiedLogicalGroups.Find(objreloc.FrameGroup)).MemPos else begin if assigned(TOmfObjSection(objreloc.objsection).MZExeUnifiedLogicalSegment) then framebase:=TOmfObjSection(objreloc.objsection).MZExeUnifiedLogicalSegment.MemBasePos else begin framebase:=0; Comment(V_Warning,'Encountered an OMF reference to a section, that has been removed by smartlinking: '+TOmfObjSection(objreloc.objsection).Name); end; end; case objreloc.typ of RELOC_ABSOLUTE16,RELOC_ABSOLUTE32,RELOC_SEG,RELOC_FARPTR,RELOC_FARPTR48: fixupamount:=target-framebase; RELOC_RELATIVE16,RELOC_SEGREL,RELOC_FARPTR_RELATIVEOFFSET: fixupamount:=target-(omfsec.MemPos+objreloc.DataOffset)-2; RELOC_RELATIVE32,RELOC_FARPTR48_RELATIVEOFFSET: fixupamount:=target-(omfsec.MemPos+objreloc.DataOffset)-4; else internalerror(2015082405); end; case objreloc.typ of RELOC_ABSOLUTE16, RELOC_RELATIVE16: FixupOffset; RELOC_ABSOLUTE32, RELOC_RELATIVE32: FixupOffset32; RELOC_SEG, RELOC_SEGREL: FixupBase(objreloc.DataOffset); RELOC_FARPTR, RELOC_FARPTR_RELATIVEOFFSET: begin FixupOffset; FixupBase(objreloc.DataOffset+2); end; RELOC_FARPTR48, RELOC_FARPTR48_RELATIVEOFFSET: begin FixupOffset32; FixupBase(objreloc.DataOffset+4); end; else internalerror(2015082406); end; end else if assigned(objreloc.group) then begin target_group:=TMZExeUnifiedLogicalGroup(ExeUnifiedLogicalGroups.Find(objreloc.group.Name)); target:=target_group.MemPos; if objreloc.FrameGroup<>'' then framebase:=TMZExeUnifiedLogicalGroup(ExeUnifiedLogicalGroups.Find(objreloc.FrameGroup)).MemPos else framebase:=target_group.MemPos; case objreloc.typ of RELOC_ABSOLUTE16,RELOC_ABSOLUTE32,RELOC_SEG,RELOC_FARPTR,RELOC_FARPTR48: fixupamount:=target-framebase; RELOC_RELATIVE16,RELOC_SEGREL,RELOC_FARPTR_RELATIVEOFFSET: fixupamount:=target-(omfsec.MemPos+objreloc.DataOffset)-2; RELOC_RELATIVE32,RELOC_FARPTR48_RELATIVEOFFSET: fixupamount:=target-(omfsec.MemPos+objreloc.DataOffset)-4; else internalerror(2015111202); end; case objreloc.typ of RELOC_ABSOLUTE16, RELOC_RELATIVE16: FixupOffset; RELOC_ABSOLUTE32, RELOC_RELATIVE32: FixupOffset32; RELOC_SEG, RELOC_SEGREL: FixupBase(objreloc.DataOffset); RELOC_FARPTR, RELOC_FARPTR_RELATIVEOFFSET: begin FixupOffset; FixupBase(objreloc.DataOffset+2); end; RELOC_FARPTR48, RELOC_FARPTR48_RELATIVEOFFSET: begin FixupOffset32; FixupBase(objreloc.DataOffset+4); end; else internalerror(2015111203); end; end else internalerror(2015082407); end; end; function IOmfObjSectionClassNameCompare(Item1, Item2: Pointer): Integer; var I1 : TOmfObjSection absolute Item1; I2 : TOmfObjSection absolute Item2; begin Result:=CompareStr(I1.ClassName,I2.ClassName); if Result=0 then Result:=CompareStr(I1.Name,I2.Name); if Result=0 then Result:=I1.SortOrder-I2.SortOrder; end; procedure TMZExeOutput.Order_ObjSectionList(ObjSectionList: TFPObjectList; const aPattern: string); var i: Integer; begin for i:=0 to ObjSectionList.Count-1 do TOmfObjSection(ObjSectionList[i]).SortOrder:=i; ObjSectionList.Sort(@IOmfObjSectionClassNameCompare); end; procedure TMZExeOutput.MemPos_ExeSection(const aname: string); begin { overlay all .exe sections on top of each other. In practice, the MZ formats doesn't have sections, so really, everything goes to a single section, called .MZ_flat_content. All the remaining sections, that we use are the debug sections, which go to a separate ELF file, appended after the end of the .exe. They live in a separate address space, with each section starting at virtual offset 0. So, that's why we always set CurrMemPos to 0 before each section here. } CurrMemPos:=0; inherited MemPos_ExeSection(aname); end; procedure TMZExeOutput.MemPos_EndExeSection; var SecName: TSymStr=''; begin if assigned(CurrExeSec) then SecName:=CurrExeSec.Name; inherited MemPos_EndExeSection; case SecName of '.MZ_flat_content': begin CalcExeUnifiedLogicalSegments; CalcExeGroups; CalcSegments_MemBasePos; if assigned(exemap) then WriteMap_SegmentsAndGroups; end; '.debug_info', '.debug_abbrev', '.debug_line', '.debug_aranges': begin CalcDwarfUnifiedLogicalSegmentsForSection(SecName); with TMZExeSection(FindExeSection(SecName)) do SecOptions:=SecOptions+[oso_debug]; end; '': {nothing to do}; else internalerror(2018061401); end; end; function TMZExeOutput.writeData: boolean; begin Result:=False; if ExeWriteMode in [ewm_exefull,ewm_exeonly] then begin if apptype=app_com then Result:=WriteCom else Result:=WriteExe; if not Result then exit; end; if ((cs_debuginfo in current_settings.moduleswitches) and (target_dbg.id in [dbg_dwarf2,dbg_dwarf3,dbg_dwarf4])) and ((ExeWriteMode=ewm_dbgonly) or ((ExeWriteMode=ewm_exefull) and not(cs_link_strip in current_settings.globalswitches))) then Result:=writeDebugElf; end; constructor TMZExeOutput.create; begin inherited create; CExeSection:=TMZExeSection; CObjData:=TOmfObjData; CObjSymbol:=TOmfObjSymbol; { "640K ought to be enough for anybody" :) } MaxMemPos:=$9FFFF; FExeUnifiedLogicalSegments:=TFPHashObjectList.Create; FExeUnifiedLogicalGroups:=TFPHashObjectList.Create; FDwarfUnifiedLogicalSegments:=TFPHashObjectList.Create; FHeader:=TMZExeHeader.Create; end; destructor TMZExeOutput.destroy; begin FHeader.Free; FDwarfUnifiedLogicalSegments.Free; FExeUnifiedLogicalGroups.Free; FExeUnifiedLogicalSegments.Free; inherited destroy; end; {**************************************************************************** TOmfAssembler ****************************************************************************} constructor TOmfAssembler.Create(info: pasminfo; smart:boolean); begin inherited; CObjOutput:=TOmfObjOutput; CInternalAr:=TOmfLibObjectWriter; end; {***************************************************************************** Initialize *****************************************************************************} {$ifdef i8086} const as_i8086_omf_info : tasminfo = ( id : as_i8086_omf; idtxt : 'OMF'; asmbin : ''; asmcmd : ''; supported_targets : [system_i8086_msdos,system_i8086_embedded]; flags : [af_outputbinary,af_smartlink_sections]; labelprefix : '..@'; comment : '; '; dollarsign: '$'; ); {$endif i8086} initialization {$ifdef i8086} RegisterAssembler(as_i8086_omf_info,TOmfAssembler); {$endif i8086} end.