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