+ implemented reading of T and R records

git-svn-id: trunk@45564 -

compiler/ogrel.pas

@@ -658,9 +658,230 @@ implementation
 
     function TRelObjInput.ReadObjData(AReader: TObjectreader; out Data: TObjData): boolean;
 
+      function DecodeRelFlags(n1: Word): TRelRelocationFlags;
+        begin
+          result:=[];
+          if (n1 and (1 shl 0))<>0 then
+            include(result,rrfByte);
+          if (n1 and (1 shl 1))<>0 then
+            include(result,rrfSymbol);
+          if (n1 and (1 shl 2))<>0 then
+            include(result,rrfPcRelative);
+          if (n1 and (1 shl 3))<>0 then
+            include(result,rrfTwoByteObjectFormatForByteData);
+          if (n1 and (1 shl 4))<>0 then
+            include(result,rrfUnsignedByteData);
+          if (n1 and (1 shl 5))<>0 then
+            include(result,rrfPage0Reference);
+          if (n1 and (1 shl 6))<>0 then
+            include(result,rrfPageNNNReference);
+          if (n1 and (1 shl 7))<>0 then
+            include(result,rrfMSBWith2ByteMode);
+          if (n1 and (1 shl 8))<>0 then
+            include(result,rrfThreeByteObjectFormatForByteData);
+          if (n1 and (1 shl 9))<>0 then
+            include(result,rrfRealMSBForThreeByteMode);
+          if (n1 and (1 shl 10))<>0 then
+            include(result,rrfReserved10);
+          if (n1 and (1 shl 11))<>0 then
+            include(result,rrfReserved11);
+        end;
+
       function HandleTR(const T,R: string): boolean;
+        const
+          GenericTErrMsg='Invalid T record';
+          GenericRErrMsg='Invalid R record';
+          UnsupportedRelocationFlags=[rrfPcRelative,rrfUnsignedByteData,
+            rrfPage0Reference,rrfPageNNNReference,rrfThreeByteObjectFormatForByteData,
+            rrfRealMSBForThreeByteMode,rrfReserved10,rrfReserved11];
+        var
+          ArrT, ArrR: array of byte;
+          ArrTIsRelocHiByte: array of boolean;
+          tmpint: Longint;
+          i: Integer;
+          AreaIndex, AreaOffset: Word;
+          LastDataOfsIndex: Integer;
+          LastDataOfsValue: TObjSectionOfs;
+          ObjSec: TObjSection;
+          n1, xx_xx: Word;
+          n1x, n2, RelHiByte: Byte;
+          RelFlags: TRelRelocationFlags;
+          reloc:TRelRelocation;
+          RelocDataOffset: TObjSectionOfs;
+          RelocTyp: TObjRelocationType;
         begin
-          { todo: implement }
+          result:=false;
+          if (length(T)<5) or (((length(T)-2) mod 3)<>0) then
+            begin
+              InputError(GenericTErrMsg);
+              exit;
+            end;
+          if (length(R)<11) or (((length(R)-2) mod 3)<>0) then
+            begin
+              InputError(GenericRErrMsg);
+              exit;
+            end;
+          SetLength(ArrT,((length(T)-2) div 3)+1);
+          for i:=0 to length(ArrT)-1 do
+            begin
+              if (i>0) and (T[i*3]<>' ') then
+                begin
+                  InputError(GenericTErrMsg);
+                  exit;
+                end;
+              if not TryStrToInt('$'+copy(T,1+i*3,2),tmpint) then
+                begin
+                  InputError(GenericTErrMsg);
+                  exit;
+                end;
+              if (tmpint<0) or (tmpint>255) then
+                begin
+                  InputError(GenericTErrMsg);
+                  exit;
+                end;
+              ArrT[i]:=tmpint;
+            end;
+          SetLength(ArrR,((length(R)-2) div 3)+1);
+          for i:=0 to length(ArrR)-1 do
+            begin
+              if (i>0) and (R[i*3]<>' ') then
+                begin
+                  InputError(GenericRErrMsg);
+                  exit;
+                end;
+              if not TryStrToInt('$'+copy(R,1+i*3,2),tmpint) then
+                begin
+                  InputError(GenericRErrMsg);
+                  exit;
+                end;
+              if (tmpint<0) or (tmpint>255) then
+                begin
+                  InputError(GenericRErrMsg);
+                  exit;
+                end;
+              ArrR[i]:=tmpint;
+            end;
+          if (length(ArrT)<2) or (length(ArrR)<4) then
+            internalerror(2020060201);
+          if (ArrR[0]<>0) or (ArrR[1]<>0) then
+            begin
+              InputError(GenericRErrMsg);
+              exit;
+            end;
+          AreaIndex:=(ArrR[3] shl 8) or ArrR[2];
+          AreaOffset:=(ArrT[1] shl 8) or ArrT[0];
+          if AreaIndex>=Data.ObjSectionList.Count then
+            begin
+              InputError('Area index in R record out of bounds');
+              exit;
+            end;
+          ObjSec:=TObjSection(Data.ObjSectionList[AreaIndex]);
+          if AreaOffset>ObjSec.Size then
+            begin
+              InputError('Area offset in T exceeds area size');
+              exit;
+            end;
+          { parse relocations }
+          SetLength(ArrTIsRelocHiByte,Length(ArrT));
+          LastDataOfsIndex:=2;
+          LastDataOfsValue:=AreaOffset;
+          i:=4;
+          while i<length(ArrR) do
+            begin
+              n1:=ArrR[i];
+              Inc(i);
+              if (n1 and $F0)=$F0 then
+                begin
+                  if i>=length(ArrR) then
+                    begin
+                      InputError(GenericRErrMsg);
+                      exit;
+                    end;
+                  n1x:=ArrR[i];
+                  Inc(i);
+                  n1:=((n1 and $0F) shl 8) or n1x;
+                end;
+              if (i+2)>=length(ArrR) then
+                begin
+                  InputError(GenericRErrMsg);
+                  exit;
+                end;
+              n2:=ArrR[i];
+              xx_xx:=ArrR[i+1] or (ArrR[i+2] shl 8);
+              Inc(i,3);
+              RelFlags:=DecodeRelFlags(n1);
+              if ((RelFlags*UnsupportedRelocationFlags)<>[]) or
+                 ((rrfByte in RelFlags) xor (rrfTwoByteObjectFormatForByteData in RelFlags)) then
+                begin
+                  InputError('Unsupported relocation flags ($'+HexStr(n1,3)+')');
+                  exit;
+                end;
+
+              if n2<=1 then
+                begin
+                  InputError('Invalid relocation data offset');
+                  exit;
+                end;
+              if rrfByte in RelFlags then
+                begin
+                  if rrfMSBWith2ByteMode in RelFlags then
+                    RelocTyp:=RELOC_ABSOLUTE_HI8
+                  else
+                    RelocTyp:=RELOC_ABSOLUTE_LO8;
+                  if (n2+1)>=length(ArrT) then
+                    begin
+                      InputError('Invalid relocation data offset');
+                      exit;
+                    end;
+                  ArrTIsRelocHiByte[n2+1]:=true;
+                  RelHiByte:=ArrT[n2+1];
+                end
+              else
+                begin
+                  RelocTyp:=RELOC_ABSOLUTE;
+                  if n2>=length(ArrT) then
+                    begin
+                      InputError('Invalid relocation data offset');
+                      exit;
+                    end;
+                  RelHiByte:=0;
+                end;
+              while LastDataOfsIndex<n2 do
+                begin
+                  if not ArrTIsRelocHiByte[LastDataOfsIndex] then
+                    Inc(LastDataOfsValue);
+                  Inc(LastDataOfsIndex);
+                end;
+              RelocDataOffset:=LastDataOfsValue;
+
+              if rrfSymbol in RelFlags then
+                begin
+                  if xx_xx>=Data.ObjSymbolList.Count then
+                    begin
+                      InputError('Relocation to symbol with invalid index');
+                      exit;
+                    end;
+                  reloc:=TRelRelocation.CreateSymbol(RelocDataOffset,TObjSymbol(Data.ObjSymbolList[xx_xx]),RelocTyp);
+                end
+              else
+                begin
+                  if xx_xx>=Data.ObjSectionlist.Count then
+                    begin
+                      InputError('Relocation to area with invalid index');
+                      exit;
+                    end;
+                  reloc:=TRelRelocation.CreateSection(RelocDataOffset,TObjSection(Data.ObjSectionlist[xx_xx]),RelocTyp);
+                end;
+              reloc.RelFlags:=RelFlags;
+              reloc.HiByte:=RelHiByte;
+              objsec.ObjRelocations.Add(reloc);
+            end;
+          { read the data }
+          objsec.SecOptions:=objsec.SecOptions+[oso_Data];
+          objsec.Data.seek(AreaOffset);
+          for i:=2 to length(ArrT)-1 do
+            if not ArrTIsRelocHiByte[i] then
+              objsec.Data.write(ArrT[i],1);
           result:=true;
         end;