mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-05-05 04:43:46 +02:00
600b460ecd
information in OMF LINNUM records, in addition to the DWARF debug information. This enables source level debugging on i8086-msdos, when using the Open Watcom Debugger, provided the source was compiled with this option and the external linker (wlink) was used for generating the executable (the internal linker does not yet support generating debug information). git-svn-id: trunk@39014 -
2819 lines
104 KiB
ObjectPascal
2819 lines
104 KiB
ObjectPascal
{
|
|
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;
|
|
function GetGroupIndex(const groupname: string): Integer;
|
|
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: string;
|
|
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: string 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: aword);
|
|
procedure AddGroup(const groupname: string; seglist: array of const);
|
|
procedure AddGroup(const groupname: string; seglist: TSegmentList);
|
|
procedure WriteSections(Data:TObjData);
|
|
procedure WriteSectionContentAndFixups(sec: TObjSection);
|
|
procedure WriteLinNumRecords(sec: TOmfObjSection);
|
|
|
|
procedure section_count_sections(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;
|
|
FRawRecord: TOmfRawRecord;
|
|
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 ReadLEDataAndFixups(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;
|
|
FHeader: TMZExeHeader;
|
|
function GetMZFlatContentSection: TMZExeSection;
|
|
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;
|
|
property ExeUnifiedLogicalSegments: TFPHashObjectList read FExeUnifiedLogicalSegments;
|
|
property ExeUnifiedLogicalGroups: TFPHashObjectList read FExeUnifiedLogicalGroups;
|
|
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_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,
|
|
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);
|
|
|
|
{****************************************************************************
|
|
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
|
|
****************************************************************************}
|
|
|
|
function TOmfRelocation.GetGroupIndex(const groupname: string): Integer;
|
|
begin
|
|
if groupname='DGROUP' then
|
|
Result:=1
|
|
else
|
|
internalerror(2014040703);
|
|
end;
|
|
|
|
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<>'' then
|
|
begin
|
|
FOmfFixup.FrameMethod:=ffmGroupIndex;
|
|
FOmfFixup.FrameDatum:=GetGroupIndex(TOmfObjSection(ObjSection).PrimaryGroup);
|
|
end
|
|
else
|
|
FOmfFixup.FrameMethod:=ffmTarget;
|
|
end
|
|
else
|
|
begin
|
|
FOmfFixup.FrameMethod:=ffmTarget;
|
|
if TOmfObjSection(ObjSection).PrimaryGroup<>'' then
|
|
begin
|
|
FOmfFixup.TargetMethod:=ftmGroupIndexNoDisp;
|
|
FOmfFixup.TargetDatum:=GetGroupIndex(TOmfObjSection(ObjSection).PrimaryGroup);
|
|
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:=GetGroupIndex(group.Name);
|
|
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;
|
|
begin
|
|
if (atype=sec_user) then
|
|
Result:=aname
|
|
else if omf_secnames[atype]=omf_secnames[sec_code] then
|
|
Result:=CodeSectionName(aname)
|
|
else if omf_segclass(atype)='FAR_DATA' then
|
|
Result:=current_module.modulename^ + '_DATA'
|
|
else
|
|
Result:=omf_secnames[atype];
|
|
end;
|
|
|
|
function TOmfObjData.createsection(atype: TAsmSectionType; const aname: string; aorder: TAsmSectionOrder): TObjSection;
|
|
begin
|
|
Result:=inherited createsection(atype, aname, aorder);
|
|
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
|
|
TOmfObjSection(Result).FUse:=suUse32;
|
|
if section_belongs_to_dgroup(atype) then
|
|
TOmfObjSection(Result).FPrimaryGroup:='DGROUP';
|
|
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: aword);
|
|
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(const groupname: string; seglist: array of const);
|
|
var
|
|
g: TOmfRecord_GRPDEF;
|
|
I: Integer;
|
|
SegListStr: TSegmentList;
|
|
begin
|
|
g:=TOmfRecord_GRPDEF.Create;
|
|
Groups.Add(groupname,g);
|
|
g.GroupNameIndex:=LNames.Add(groupname);
|
|
SetLength(SegListStr,Length(seglist));
|
|
for I:=0 to High(seglist) do
|
|
begin
|
|
case seglist[I].VType of
|
|
vtString:
|
|
SegListStr[I]:=Segments.FindIndexOf(seglist[I].VString^);
|
|
vtAnsiString:
|
|
SegListStr[I]:=Segments.FindIndexOf(AnsiString(seglist[I].VAnsiString));
|
|
vtWideString:
|
|
SegListStr[I]:=Segments.FindIndexOf(AnsiString(WideString(seglist[I].VWideString)));
|
|
vtUnicodeString:
|
|
SegListStr[I]:=Segments.FindIndexOf(AnsiString(UnicodeString(seglist[I].VUnicodeString)));
|
|
else
|
|
internalerror(2015040402);
|
|
end;
|
|
end;
|
|
g.SegmentList:=SegListStr;
|
|
end;
|
|
|
|
procedure TOmfObjOutput.AddGroup(const groupname: string; seglist: TSegmentList);
|
|
var
|
|
g: TOmfRecord_GRPDEF;
|
|
begin
|
|
g:=TOmfRecord_GRPDEF.Create;
|
|
Groups.Add(groupname,g);
|
|
g.GroupNameIndex:=LNames.Add(groupname);
|
|
g.SegmentList:=Copy(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;
|
|
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 }
|
|
RawRecord.RecordType:=RT_LEDATA;
|
|
NextOfs:=RawRecord.WriteIndexedRef(0,SegIndex);
|
|
RawRecord.RawData[NextOfs]:=Byte(ChunkStart);
|
|
RawRecord.RawData[NextOfs+1]:=Byte(ChunkStart shr 8);
|
|
Inc(NextOfs,2);
|
|
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.NextIndex<sec.LinNumEntries.Count do
|
|
begin
|
|
LinNumRec.EncodeTo(RawRecord);
|
|
RawRecord.WriteTo(FWriter);
|
|
end;
|
|
|
|
LinNumRec.Free;
|
|
RawRecord.Free;
|
|
end;
|
|
end;
|
|
|
|
procedure TOmfObjOutput.section_count_sections(p: TObject; arg: pointer);
|
|
begin
|
|
TOmfObjSection(p).index:=pinteger(arg)^;
|
|
inc(pinteger(arg)^);
|
|
end;
|
|
|
|
procedure TOmfObjOutput.WritePUBDEFs(Data: TObjData);
|
|
var
|
|
PubNamesForSection: array of TFPHashObjectList;
|
|
i: Integer;
|
|
objsym: TObjSymbol;
|
|
PublicNameElem: TOmfPublicNameElement;
|
|
RawRecord: TOmfRawRecord;
|
|
PubDefRec: TOmfRecord_PUBDEF;
|
|
PrimaryGroupName: string;
|
|
begin
|
|
RawRecord:=TOmfRawRecord.Create;
|
|
SetLength(PubNamesForSection,Data.ObjSectionList.Count);
|
|
for i:=0 to Data.ObjSectionList.Count-1 do
|
|
PubNamesForSection[i]:=TFPHashObjectList.Create;
|
|
|
|
for i:=0 to Data.ObjSymbolList.Count-1 do
|
|
begin
|
|
objsym:=TObjSymbol(Data.ObjSymbolList[i]);
|
|
if objsym.bind=AB_GLOBAL then
|
|
begin
|
|
PublicNameElem:=TOmfPublicNameElement.Create(PubNamesForSection[objsym.objsection.index-1],objsym.Name);
|
|
PublicNameElem.PublicOffset:=objsym.offset;
|
|
end;
|
|
end;
|
|
|
|
for i:=0 to Data.ObjSectionList.Count-1 do
|
|
if PubNamesForSection[i].Count>0 then
|
|
begin
|
|
PubDefRec:=TOmfRecord_PUBDEF.Create;
|
|
PubDefRec.BaseSegmentIndex:=i+1;
|
|
PrimaryGroupName:=TOmfObjSection(Data.ObjSectionList[i]).PrimaryGroup;
|
|
if PrimaryGroupName<>'' then
|
|
PubDefRec.BaseGroupIndex:=Groups.FindIndexOf(PrimaryGroupName)
|
|
else
|
|
PubDefRec.BaseGroupIndex:=0;
|
|
PubDefRec.PublicNames:=PubNamesForSection[i];
|
|
while PubDefRec.NextIndex<PubDefRec.PublicNames.Count do
|
|
begin
|
|
PubDefRec.EncodeTo(RawRecord);
|
|
RawRecord.WriteTo(FWriter);
|
|
end;
|
|
PubDefRec.Free;
|
|
end;
|
|
|
|
for i:=0 to Data.ObjSectionList.Count-1 do
|
|
FreeAndNil(PubNamesForSection[i]);
|
|
RawRecord.Free;
|
|
end;
|
|
|
|
procedure TOmfObjOutput.WriteEXTDEFs(Data: TObjData);
|
|
var
|
|
ExtNames: TFPHashObjectList;
|
|
RawRecord: TOmfRawRecord;
|
|
i,idx: Integer;
|
|
objsym: TObjSymbol;
|
|
ExternalNameElem: TOmfExternalNameElement;
|
|
ExtDefRec: TOmfRecord_EXTDEF;
|
|
begin
|
|
ExtNames:=TFPHashObjectList.Create;
|
|
RawRecord:=TOmfRawRecord.Create;
|
|
|
|
idx:=1;
|
|
for i:=0 to Data.ObjSymbolList.Count-1 do
|
|
begin
|
|
objsym:=TObjSymbol(Data.ObjSymbolList[i]);
|
|
if objsym.bind=AB_EXTERNAL then
|
|
begin
|
|
ExternalNameElem:=TOmfExternalNameElement.Create(ExtNames,objsym.Name);
|
|
objsym.symidx:=idx;
|
|
Inc(idx);
|
|
end;
|
|
end;
|
|
|
|
if ExtNames.Count>0 then
|
|
begin
|
|
ExtDefRec:=TOmfRecord_EXTDEF.Create;
|
|
ExtDefRec.ExternalNames:=ExtNames;
|
|
while ExtDefRec.NextIndex<ExtDefRec.ExternalNames.Count do
|
|
begin
|
|
ExtDefRec.EncodeTo(RawRecord);
|
|
RawRecord.WriteTo(FWriter);
|
|
end;
|
|
ExtDefRec.Free;
|
|
end;
|
|
|
|
ExtNames.Free;
|
|
RawRecord.Free;
|
|
end;
|
|
|
|
function TOmfObjOutput.writeData(Data:TObjData):boolean;
|
|
var
|
|
RawRecord: TOmfRawRecord;
|
|
Header: TOmfRecord_THEADR;
|
|
Translator_COMENT: TOmfRecord_COMENT;
|
|
DebugFormat_COMENT: TOmfRecord_COMENT;
|
|
LinkPassSeparator_COMENT: TOmfRecord_COMENT;
|
|
LNamesRec: TOmfRecord_LNAMES;
|
|
ModEnd: TOmfRecord_MODEND;
|
|
I: Integer;
|
|
SegDef: TOmfRecord_SEGDEF;
|
|
GrpDef: TOmfRecord_GRPDEF;
|
|
DGroupSegments: TSegmentList;
|
|
nsections: Integer;
|
|
begin
|
|
{ calc amount of sections we have and set their index, starting with 1 }
|
|
nsections:=1;
|
|
data.ObjSectionList.ForEachCall(@section_count_sections,@nsections);
|
|
{ maximum amount of sections supported in the omf format is $7fff }
|
|
if (nsections-1)>$7fff then
|
|
internalerror(2015040701);
|
|
|
|
{ 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.ObjSectionList.Count-1 do
|
|
with TOmfObjSection(Data.ObjSectionList[I]) do
|
|
AddSegment(Name,ClassName,OverlayName,OmfAlignment,Combination,Use,Size);
|
|
|
|
|
|
{ create group "DGROUP" }
|
|
SetLength(DGroupSegments,0);
|
|
for i:=0 to Data.ObjSectionList.Count-1 do
|
|
with TOmfObjSection(Data.ObjSectionList[I]) do
|
|
if PrimaryGroup='DGROUP' then
|
|
begin
|
|
SetLength(DGroupSegments,Length(DGroupSegments)+1);
|
|
DGroupSegments[High(DGroupSegments)]:=index;
|
|
end;
|
|
AddGroup('DGROUP',DGroupSegments);
|
|
|
|
{ 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='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);
|
|
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.ReadLEDataAndFixups(RawRec: TOmfRawRecord; objdata: TObjData): Boolean;
|
|
var
|
|
Is32Bit: Boolean;
|
|
NextOfs: Integer;
|
|
SegmentIndex: Integer;
|
|
EnumeratedDataOffset: DWord;
|
|
BlockLength: Integer;
|
|
objsec: TOmfObjSection;
|
|
FixupRawRec: TOmfRawRecord;
|
|
Fixup: TOmfSubRecord_FIXUP;
|
|
begin
|
|
Result:=False;
|
|
if not (RawRec.RecordType in [RT_LEDATA,RT_LEDATA32]) then
|
|
internalerror(2015040301);
|
|
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);
|
|
|
|
{ also read all the FIXUPP records that may follow }
|
|
while PeekNextRecordType in [RT_FIXUPP,RT_FIXUPP32] do
|
|
begin
|
|
FixupRawRec:=TOmfRawRecord.Create;
|
|
FixupRawRec.ReadFrom(FReader);
|
|
if not FRawRecord.VerifyChecksumByte then
|
|
begin
|
|
InputError('Invalid checksum in OMF record');
|
|
FixupRawRec.Free;
|
|
exit;
|
|
end;
|
|
NextOfs:=0;
|
|
Fixup:=TOmfSubRecord_FIXUP.Create;
|
|
Fixup.Is32Bit:=FixupRawRec.RecordType=RT_FIXUPP32;
|
|
Fixup.DataRecordStartOffset:=EnumeratedDataOffset;
|
|
while NextOfs<(FixupRawRec.RecordLength-1) do
|
|
begin
|
|
NextOfs:=Fixup.ReadAt(FixupRawRec,NextOfs);
|
|
if Fixup.FrameDeterminedByThread or Fixup.TargetDeterminedByThread then
|
|
begin
|
|
InputError('Fixups determined by thread not supported');
|
|
Fixup.Free;
|
|
FixupRawRec.Free;
|
|
exit;
|
|
end;
|
|
ImportOmfFixup(objdata,objsec,Fixup);
|
|
end;
|
|
Fixup.Free;
|
|
FixupRawRec.Free;
|
|
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(<segment name>),<displacement> 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(<segment name>) 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(<group name>),<displacement> 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(<group name>) 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(<symbol name>),<displacement> 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(<symbol name>) 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(<segment name>) 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(<group name>) 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(<symbol name>) 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))+' in external reference to '+sym.Name);
|
|
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))+' in external reference to '+sym.Name);
|
|
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;
|
|
FRawRecord:=TOmfRawRecord.Create;
|
|
CaseSensitiveSegments:=False;
|
|
CaseSensitiveSymbols:=True;
|
|
end;
|
|
|
|
destructor TOmfObjInput.destroy;
|
|
begin
|
|
FRawRecord.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;
|
|
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
|
|
{todo}
|
|
end;
|
|
RT_EXTDEF:
|
|
if not ReadExtDef(FRawRecord,objdata) then
|
|
exit;
|
|
RT_PUBDEF,RT_PUBDEF32:
|
|
if not ReadPubDef(FRawRecord,objdata) then
|
|
exit;
|
|
RT_LEDATA,RT_LEDATA32:
|
|
if not ReadLEDataAndFixups(FRawRecord,objdata) then
|
|
exit;
|
|
RT_LIDATA,RT_LIDATA32:
|
|
begin
|
|
InputError('LIDATA records are not supported');
|
|
exit;
|
|
end;
|
|
RT_FIXUPP,RT_FIXUPP32:
|
|
begin
|
|
InputError('FIXUPP record is invalid, because it does not follow a LEDATA or LIDATA record');
|
|
exit;
|
|
end;
|
|
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.MemPos<MinMemPos then
|
|
MinMemPos:=objsec.MemPos;
|
|
if (objsec.MemPos+objsec.Size)>MaxMemPos 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.MemPos<MinMemPos then
|
|
MinMemPos:=UniSeg.MemPos;
|
|
if (UniSeg.MemPos+UniSeg.Size)>MaxMemPos 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.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: Integer;
|
|
UniSeg: TMZExeUnifiedLogicalSegment;
|
|
UniGrp: TMZExeUnifiedLogicalGroup;
|
|
begin
|
|
exemap.AddHeader('Groups list');
|
|
exemap.Add('');
|
|
exemap.Add(PadSpace('Group',32)+PadSpace('Address',21)+'Size');
|
|
exemap.Add(PadSpace('=====',32)+PadSpace('=======',21)+'====');
|
|
exemap.Add('');
|
|
for i:=0 to ExeUnifiedLogicalGroups.Count-1 do
|
|
begin
|
|
UniGrp:=TMZExeUnifiedLogicalGroup(ExeUnifiedLogicalGroups[i]);
|
|
exemap.Add(PadSpace(UniGrp.Name,32)+PadSpace(UniGrp.MemPosStr,21)+HexStr(UniGrp.Size,8));
|
|
end;
|
|
exemap.Add('');
|
|
exemap.AddHeader('Segments list');
|
|
exemap.Add('');
|
|
exemap.Add(PadSpace('Segment',23)+PadSpace('Class',15)+PadSpace('Group',15)+PadSpace('Address',16)+'Size');
|
|
exemap.Add(PadSpace('=======',23)+PadSpace('=====',15)+PadSpace('=====',15)+PadSpace('=======',16)+'====');
|
|
exemap.Add('');
|
|
for i:=0 to ExeUnifiedLogicalSegments.Count-1 do
|
|
begin
|
|
UniSeg:=TMZExeUnifiedLogicalSegment(ExeUnifiedLogicalSegments[i]);
|
|
exemap.Add(PadSpace(UniSeg.SegName,23)+PadSpace(UniSeg.SegClass,15)+PadSpace(UniSeg.PrimaryGroup,15)+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.Size<stackseg_wannabe.Size)) then
|
|
Result:=stackseg_wannabe;
|
|
end;
|
|
end;
|
|
|
|
procedure TMZExeOutput.FillLoadableImageSize;
|
|
var
|
|
i: Integer;
|
|
ExeSec: TMZExeSection;
|
|
ObjSec: TOmfObjSection;
|
|
StartDataPos: LongWord;
|
|
buf: array [0..1023] of byte;
|
|
bytesread: LongWord;
|
|
begin
|
|
Header.LoadableImageSize:=0;
|
|
ExeSec:=MZFlatContentSection;
|
|
for i:=0 to ExeSec.ObjSectionList.Count-1 do
|
|
begin
|
|
ObjSec:=TOmfObjSection(ExeSec.ObjSectionList[i]);
|
|
if (ObjSec.Size>0) 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.MemPos<Header.LoadableImageSize then
|
|
begin
|
|
FWriter.WriteZeros(max(0,ObjSec.MemPos-FWriter.Size+ExeSec.DataPos));
|
|
if assigned(ObjSec.Data) then
|
|
FWriter.writearray(ObjSec.Data);
|
|
end;
|
|
end;
|
|
Result:=True;
|
|
end;
|
|
|
|
function TMZExeOutput.writeCom: boolean;
|
|
const
|
|
ComFileOffset=$100;
|
|
var
|
|
i: Integer;
|
|
ExeSec: TMZExeSection;
|
|
ObjSec: TOmfObjSection;
|
|
StartDataPos: LongWord;
|
|
buf: array [0..1023] of byte;
|
|
bytesread: LongWord;
|
|
begin
|
|
FillHeaderData;
|
|
if Length(Header.Relocations)>0 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.MemPos<Header.LoadableImageSize then
|
|
begin
|
|
FWriter.WriteZeros(max(0,ObjSec.MemPos-ComFileOffset-FWriter.Size));
|
|
if assigned(ObjSec.Data) then
|
|
begin
|
|
if ObjSec.MemPos<ComFileOffset then
|
|
begin
|
|
ObjSec.Data.seek(ComFileOffset-ObjSec.MemPos);
|
|
repeat
|
|
bytesread:=ObjSec.Data.read(buf,sizeof(buf));
|
|
if bytesread<>0 then
|
|
FWriter.write(buf,bytesread);
|
|
until bytesread=0;
|
|
end
|
|
else
|
|
FWriter.writearray(ObjSec.Data);
|
|
end;
|
|
end;
|
|
end;
|
|
Result:=True;
|
|
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
|
|
framebase:=TOmfObjSection(objreloc.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(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_EndExeSection;
|
|
var
|
|
SecName: TSymStr='';
|
|
begin
|
|
if assigned(CurrExeSec) then
|
|
SecName:=CurrExeSec.Name;
|
|
inherited MemPos_EndExeSection;
|
|
if SecName='.MZ_flat_content' then
|
|
begin
|
|
CalcExeUnifiedLogicalSegments;
|
|
CalcExeGroups;
|
|
CalcSegments_MemBasePos;
|
|
if assigned(exemap) then
|
|
WriteMap_SegmentsAndGroups;
|
|
end;
|
|
end;
|
|
|
|
function TMZExeOutput.writeData: boolean;
|
|
begin
|
|
if apptype=app_com then
|
|
Result:=WriteCom
|
|
else
|
|
Result:=WriteExe;
|
|
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;
|
|
FHeader:=TMZExeHeader.Create;
|
|
end;
|
|
|
|
destructor TMZExeOutput.destroy;
|
|
begin
|
|
FHeader.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_no_debug];
|
|
labelprefix : '..@';
|
|
comment : '; ';
|
|
dollarsign: '$';
|
|
);
|
|
{$endif i8086}
|
|
|
|
initialization
|
|
{$ifdef i8086}
|
|
RegisterAssembler(as_i8086_omf_info,TOmfAssembler);
|
|
{$endif i8086}
|
|
end.
|