Browse Source

+ added and implemented the TNewExeRelocationList class

git-svn-id: trunk@42744 -
nickysn 6 years ago
parent
commit
e7d590724a
1 changed files with 100 additions and 0 deletions
  1. 100 0
      compiler/ogomf.pas

+ 100 - 0
compiler/ogomf.pas

@@ -692,6 +692,26 @@ interface
         property InternalRefMovableSegmentEntryTableIndex: Word read FInternalRefMovableSegmentEntryTableIndex write FInternalRefMovableSegmentEntryTableIndex;
         property InternalRefMovableSegmentEntryTableIndex: Word read FInternalRefMovableSegmentEntryTableIndex write FInternalRefMovableSegmentEntryTableIndex;
       end;
       end;
 
 
+      { TNewExeRelocationList }
+
+      TNewExeRelocationList=class
+      private
+        FInternalList: TFPObjectList;
+        function GetCount: Integer;
+        function GetItem(Index: Integer): TNewExeRelocation;
+        function GetSize: QWord;
+        procedure SetCount(AValue: Integer);
+        procedure SetItem(Index: Integer; AValue: TNewExeRelocation);
+      public
+        constructor Create;
+        destructor Destroy; override;
+        procedure WriteTo(aWriter: TObjectWriter);
+        function Add(AObject: TNewExeRelocation): Integer;
+        property Size: QWord read GetSize;
+        property Count: Integer read GetCount write SetCount;
+        property Items[Index: Integer]: TNewExeRelocation read GetItem write SetItem; default;
+      end;
+
       { TNewExeSection }
       { TNewExeSection }
 
 
       TNewExeSection=class(TExeSection)
       TNewExeSection=class(TExeSection)
@@ -703,8 +723,12 @@ interface
         FDataPosSectors: Word;
         FDataPosSectors: Word;
         FNewExeSegmentFlags: TNewExeSegmentFlags;
         FNewExeSegmentFlags: TNewExeSegmentFlags;
         FSizeInFile: QWord;
         FSizeInFile: QWord;
+        FRelocations: TNewExeRelocationList;
         function GetMinAllocSize: QWord;
         function GetMinAllocSize: QWord;
       public
       public
+        constructor create(AList:TFPHashObjectList;const AName:string);override;
+        destructor destroy;override;
+
         procedure WriteHeaderTo(aWriter: TObjectWriter);
         procedure WriteHeaderTo(aWriter: TObjectWriter);
         function MemPosStr(AImageBase: qword): string;override;
         function MemPosStr(AImageBase: qword): string;override;
         procedure AddObjSection(objsec:TObjSection;ignoreprops:boolean=false);override;
         procedure AddObjSection(objsec:TObjSection;ignoreprops:boolean=false);override;
@@ -717,6 +741,7 @@ interface
         property MinAllocSize: QWord read GetMinAllocSize;
         property MinAllocSize: QWord read GetMinAllocSize;
         property SizeInFile: QWord read FSizeInFile write FSizeInFile;
         property SizeInFile: QWord read FSizeInFile write FSizeInFile;
         property NewExeSegmentFlags: TNewExeSegmentFlags read FNewExeSegmentFlags write FNewExeSegmentFlags;
         property NewExeSegmentFlags: TNewExeSegmentFlags read FNewExeSegmentFlags write FNewExeSegmentFlags;
+        property Relocations: TNewExeRelocationList read FRelocations;
       end;
       end;
 
 
       { TNewExeOutput }
       { TNewExeOutput }
@@ -4264,6 +4289,69 @@ cleanup:
         end;
         end;
       end;
       end;
 
 
+{****************************************************************************
+                           TNewExeRelocationList
+****************************************************************************}
+
+    function TNewExeRelocationList.GetCount: Integer;
+      begin
+        Result:=FInternalList.Count;
+      end;
+
+    function TNewExeRelocationList.GetItem(Index: Integer): TNewExeRelocation;
+      begin
+        Result:=TNewExeRelocation(FInternalList[Index]);
+      end;
+
+    function TNewExeRelocationList.GetSize: QWord;
+      begin
+        Result:=2+Count*NewExeRelocationRecordSize;
+      end;
+
+    procedure TNewExeRelocationList.SetCount(AValue: Integer);
+      begin
+        FInternalList.Count:=AValue;
+      end;
+
+    procedure TNewExeRelocationList.SetItem(Index:Integer;AValue:TNewExeRelocation);
+      begin
+        FInternalList[Index]:=AValue;
+      end;
+
+    constructor TNewExeRelocationList.Create;
+      begin
+        FInternalList:=TFPObjectList.Create;
+      end;
+
+    destructor TNewExeRelocationList.Destroy;
+      begin
+        FInternalList.Free;
+        inherited Destroy;
+      end;
+
+    procedure TNewExeRelocationList.WriteTo(aWriter: TObjectWriter);
+      var
+        buf: array of Byte;
+        p: PByte;
+        i: Integer;
+      begin
+        SetLength(buf,Size);
+        buf[0]:=Byte(Count);
+        buf[1]:=Byte(Count shr 8);
+        p:=@(buf[2]);
+        for i:=0 to Count-1 do
+          begin
+            Items[i].EncodeTo(p);
+            Inc(p,NewExeRelocationRecordSize);
+          end;
+        aWriter.write(buf[0],Size);
+      end;
+
+    function TNewExeRelocationList.Add(AObject: TNewExeRelocation): Integer;
+      begin
+        Result:=FInternalList.Add(AObject);
+      end;
+
 {****************************************************************************
 {****************************************************************************
                               TNewExeSection
                               TNewExeSection
 ****************************************************************************}
 ****************************************************************************}
@@ -4273,6 +4361,18 @@ cleanup:
         Result:=Size-StackSize;
         Result:=Size-StackSize;
       end;
       end;
 
 
+    constructor TNewExeSection.create(AList:TFPHashObjectList;const AName:string);
+      begin
+        inherited create(AList, AName);
+        FRelocations:=TNewExeRelocationList.Create;
+      end;
+
+    destructor TNewExeSection.destroy;
+      begin
+        FRelocations.Free;
+        inherited destroy;
+      end;
+
     procedure TNewExeSection.WriteHeaderTo(aWriter: TObjectWriter);
     procedure TNewExeSection.WriteHeaderTo(aWriter: TObjectWriter);
       var
       var
         SegmentHeaderBytes: array [0..7] of Byte;
         SegmentHeaderBytes: array [0..7] of Byte;