--- Merging r42809 into '.':

U    packages/rtl-objpas/tests/tests.rtti.util.pas
--- Recording mergeinfo for merge of r42809 into '.':
 U   .
--- Merging r42810 into '.':
U    packages/rtl-objpas/tests/tests.rtti.pas
G    packages/rtl-objpas/tests/tests.rtti.util.pas
--- Recording mergeinfo for merge of r42810 into '.':
 G   .
--- Recording mergeinfo for merge of r42810 into 'packages/rtl-objpas/tests/tests.rtti.pas':
 U   packages/rtl-objpas/tests/tests.rtti.pas
--- Merging r42988 into '.':
U    compiler/aarch64/racpugas.pas
--- Recording mergeinfo for merge of r42988 into '.':
 G   .
--- Recording mergeinfo for merge of r42988 into 'packages/rtl-objpas/tests/tests.rtti.pas':
 G   packages/rtl-objpas/tests/tests.rtti.pas
--- Merging r42989 into '.':
G    compiler/aarch64/racpugas.pas
--- Recording mergeinfo for merge of r42989 into '.':
 G   .
--- Recording mergeinfo for merge of r42989 into 'packages/rtl-objpas/tests/tests.rtti.pas':
 G   packages/rtl-objpas/tests/tests.rtti.pas
--- Merging r42990 into '.':
U    packages/rtl-objpas/src/inc/rtti.pp
--- Recording mergeinfo for merge of r42990 into '.':
 G   .
--- Recording mergeinfo for merge of r42990 into 'packages/rtl-objpas/tests/tests.rtti.pas':
 G   packages/rtl-objpas/tests/tests.rtti.pas
--- Merging r42991 into '.':
G    packages/rtl-objpas/src/inc/rtti.pp
--- Recording mergeinfo for merge of r42991 into '.':
 G   .
--- Recording mergeinfo for merge of r42991 into 'packages/rtl-objpas/tests/tests.rtti.pas':
 G   packages/rtl-objpas/tests/tests.rtti.pas
--- Merging r43016 into '.':
U    compiler/aarch64/aasmcpu.pas
U    compiler/aarch64/agcpugas.pas
G    compiler/aarch64/racpugas.pas
--- Recording mergeinfo for merge of r43016 into '.':
 G   .
--- Recording mergeinfo for merge of r43016 into 'packages/rtl-objpas/tests/tests.rtti.pas':
 G   packages/rtl-objpas/tests/tests.rtti.pas

# revisions: 42809,42810,42988,42989,42990,42991,43016

git-svn-id: branches/fixes_3_2@43424 -

compiler/aarch64/aasmcpu.pas

@@ -554,16 +554,17 @@ implementation
       begin
         result:=sr_complex;
         if not assigned(ref.symboldata) and
-           not(ref.refaddr in [addr_gotpageoffset,addr_gotpage,addr_pageoffset,addr_page]) then
+           not(ref.refaddr in [addr_pic,addr_gotpageoffset,addr_gotpage,addr_pageoffset,addr_page]) then
           exit;
         { can't use pre-/post-indexed mode here (makes no sense either) }
         if ref.addressmode<>AM_OFFSET then
           exit;
         { "ldr literal" must be a 32/64 bit LDR and have a symbol }
-        if assigned(ref.symboldata) and
+        if (ref.refaddr=addr_pic) and
            ((op<>A_LDR) or
             not(oppostfix in [PF_NONE,PF_W,PF_SW]) or
-            not assigned(ref.symbol)) then
+            (not assigned(ref.symbol) and
+             not assigned(ref.symboldata))) then
           exit;
         { if this is a (got) page offset load, we must have a base register and a
           symbol }

compiler/aarch64/agcpugas.pas

@@ -119,9 +119,11 @@ unit agcpugas;
                     result:=ref.symbol.name+darwin_addrpage2str[ref.refaddr]
                   else
                     result:=linux_addrpage2str[ref.refaddr]+ref.symbol.name
-                end
+                end;
+              addr_pic:
+                result:=ref.symbol.name;
               else
-                internalerror(2015022301);
+                internalerror(2015022302);
             end
           end
         else

compiler/aarch64/racpugas.pas

@@ -563,7 +563,8 @@ Unit racpugas;
                oper.opr.symbol:=hl;
              end
             else if (actopcode=A_ADR) or
-               (actopcode=A_ADRP) then
+               (actopcode=A_ADRP) or
+               (actopcode=A_LDR) then
               begin
                 oper.InitRef;
                 MaybeAddGotAddrMode;

packages/rtl-objpas/src/inc/rtti.pp

@@ -921,6 +921,26 @@ asm
   .long RawThunkPlaceholderContext
 RawThunkEnd:
 end;
+{$elseif defined(cpuaarch64)}
+const
+  RawThunkPlaceholderProc = $8765876587658765;
+  RawThunkPlaceholderContext = $4321432143214321;
+
+type
+  TRawThunkProc = PtrUInt;
+  TRawThunkContext = PtrUInt;
+
+procedure RawThunk; assembler; nostackframe;
+asm
+  ldr x16, .LProc
+  ldr x0, .LContext
+  br x16
+.LProc:
+  .quad RawThunkPlaceholderProc
+.LContext:
+  .quad RawThunkPlaceholderContext
+RawThunkEnd:
+end;
 {$elseif defined(cpum68k)}
 const
   RawThunkPlaceholderProc = $87658765;
@@ -986,7 +1006,7 @@ begin
 {$if declared(TRawThunkBytesToPop)}
     if not btpdone and (i <= Size - SizeOf(TRawThunkBytesToPop)) then begin
       btp := PRawThunkBytesToPop(PByte(Result) + i);
-      if btp^ = RawThunkPlaceholderBytesToPop then begin
+      if btp^ = TRawThunkBytesToPop(RawThunkPlaceholderBytesToPop) then begin
         btp^ := TRawThunkBytesToPop(aBytesToPop);
         btpdone := True;
       end;
@@ -994,14 +1014,14 @@ begin
 {$endif}
     if not contextdone and (i <= Size - SizeOf(TRawThunkContext)) then begin
       context := PRawThunkContext(PByte(Result) + i);
-      if context^ = RawThunkPlaceholderContext then begin
+      if context^ = TRawThunkContext(RawThunkPlaceholderContext) then begin
         context^ := TRawThunkContext(aContext);
         contextdone := True;
       end;
     end;
     if not procdone and (i <= Size - SizeOf(TRawThunkProc)) then begin
       proc := PRawThunkProc(PByte(Result) + i);
-      if proc^ = RawThunkPlaceholderProc then begin
+      if proc^ = TRawThunkProc(RawThunkPlaceholderProc) then begin
         proc^ := TRawThunkProc(aProc);
         procdone := True;
       end;

packages/rtl-objpas/tests/tests.rtti.pas

@@ -94,6 +94,9 @@ type
 
 implementation
 
+uses
+  Tests.Rtti.Util;
+
 type
 
   {$M+}
@@ -1788,7 +1791,7 @@ begin
 
     method := methods[0];
     CheckEquals(method.Name, 'Test', 'Method name of Test does not match');
-    Check(method.CallingConvention = ccReg, 'Calling convention of Test does not match');
+    Check(method.CallingConvention = DefaultCC, 'Calling convention of Test does not match');
     Check(method.MethodKind = mkProcedure, 'Method kind of Test does not match');
     Check(method.DispatchKind = dkInterface, 'Dispatch kind of Test does not match');
     Check(not Assigned(method.CodeAddress), 'Code address of Test is not Nil');
@@ -1799,7 +1802,7 @@ begin
 
     method := methods[1];
     CheckEquals(method.Name, 'Test2', 'Method name of Test2 does not match');
-    Check(method.CallingConvention = ccReg, 'Calling convention of Test2 does not match');
+    Check(method.CallingConvention = DefaultCC, 'Calling convention of Test2 does not match');
     Check(method.MethodKind = mkFunction, 'Method kind of Test2 does not match');
     Check(method.DispatchKind = dkInterface, 'Dispatch kind of Test2 does not match');
     Check(not Assigned(method.CodeAddress), 'Code address of Test2 is not Nil');
@@ -1811,7 +1814,7 @@ begin
 
     method := methods[2];
     CheckEquals(method.Name, 'Test3', 'Method name of Test3 does not match');
-    Check(method.CallingConvention = ccReg, 'Calling convention of Test3 does not match');
+    Check(method.CallingConvention = DefaultCC, 'Calling convention of Test3 does not match');
     Check(method.MethodKind = mkProcedure, 'Method kind of Test3 does not match');
     Check(method.DispatchKind = dkInterface, 'Dispatch kind of Test3 does not match');
     Check(not Assigned(method.CodeAddress), 'Code address of Test3 is not Nil');
@@ -1847,7 +1850,7 @@ begin
 
     method := methods[3];
     CheckEquals(method.Name, 'Test4', 'Method name of Test4 does not match');
-    Check(method.CallingConvention = ccReg, 'Calling convention of Test4 does not match');
+    Check(method.CallingConvention = DefaultCC, 'Calling convention of Test4 does not match');
     Check(method.MethodKind = mkFunction, 'Method kind of Test4 does not match');
     Check(method.DispatchKind = dkInterface, 'Dispatch kind of Test4 does not match');
     Check(not Assigned(method.CodeAddress), 'Code address of Test4 is not Nil');
@@ -1929,7 +1932,7 @@ begin
     Check(t is TRttiProcedureType, 'Rtti Type is not a procedure type');
 
     p := t as TRttiProcedureType;
-    Check(p.CallingConvention = ccReg, 'Calling convention does not match');
+    Check(p.CallingConvention = DefaultCC, 'Calling convention does not match');
     Check(not Assigned(p.ReturnType), 'Return type is assigned');
     CheckEquals(0, Length(p.GetParameters), 'Procedure variable has parameters');
 
@@ -1939,7 +1942,7 @@ begin
     Check(t is TRttiProcedureType, 'Rtti Type is not a procedure type');
 
     p := t as TRttiProcedureType;
-    Check(p.CallingConvention = ccReg, 'Calling convention does not match');
+    Check(p.CallingConvention = DefaultCC, 'Calling convention does not match');
     Check(Assigned(p.ReturnType), 'Return type is not assigned');
     //Check(p.ReturnType is TRttiOrdinalType, 'Return type is not an ordinal type');
     CheckEquals(0, Length(p.GetParameters), 'Procedure variable has parameters');
@@ -1950,7 +1953,7 @@ begin
     Check(t is TRttiProcedureType, 'Rtti Type is not a procedure type');
 
     p := t as TRttiProcedureType;
-    Check(p.CallingConvention = ccReg, 'Calling convention does not match');
+    Check(p.CallingConvention = DefaultCC, 'Calling convention does not match');
     Check(Assigned(p.ReturnType), 'Return type is not assigned');
     Check(p.ReturnType is TRttiStringType, 'Return type is not a string type');
 
@@ -1981,7 +1984,7 @@ begin
     Check(t is TRttiMethodType, 'Rtti Type is not a method type');
 
     m := t as TRttiMethodType;
-    Check(m.CallingConvention = ccReg, 'Calling convention does not match');
+    Check(m.CallingConvention = DefaultCC, 'Calling convention does not match');
     Check(not Assigned(m.ReturnType), 'Return type is assigned');
     CheckEquals(0, Length(m.GetParameters), 'Method variable has parameters');
 
@@ -1991,7 +1994,7 @@ begin
     Check(t is TRttiMethodType, 'Rtti Type is not a method type');
 
     m := t as TRttiMethodType;
-    Check(m.CallingConvention = ccReg, 'Calling convention does not match');
+    Check(m.CallingConvention = DefaultCC, 'Calling convention does not match');
     Check(Assigned(m.ReturnType), 'Return type is not assigned');
     //Check(p.ReturnType is TRttiOrdinalType, 'Return type is not an ordinal type');
     CheckEquals(0, Length(m.GetParameters), 'Method variable has parameters');
@@ -2002,7 +2005,7 @@ begin
     Check(t is TRttiMethodType, 'Rtti Type is not a method type');
 
     m := t as TRttiMethodType;
-    Check(m.CallingConvention = ccReg, 'Calling convention does not match');
+    Check(m.CallingConvention = DefaultCC, 'Calling convention does not match');
     Check(Assigned(m.ReturnType), 'Return type is not assigned');
     Check(m.ReturnType is TRttiStringType, 'Return type is not a string type');
 

packages/rtl-objpas/tests/tests.rtti.util.pas

@@ -5,7 +5,7 @@ unit Tests.Rtti.Util;
 interface
 
 uses
-  Rtti;
+  TypInfo, Rtti;
 
 {$ifndef fpc}
 type
@@ -17,6 +17,13 @@ type
   end;
 {$endif}
 
+const
+{$if defined(cpui386) or defined(cpux86_64) or defined(cpum68k)}
+  DefaultCC = ccReg;
+{$else}
+  DefaultCC = ccStdCall;
+{$endif}
+
 function CopyValue({$ifdef fpc}constref{$else}const [ref]{$endif} aValue: TValue): TValue;
 function EqualValues({$ifdef fpc}constref{$else}const [ref]{$endif} aValue1, aValue2: TValue): Boolean;
 
@@ -37,7 +44,7 @@ function GetArray(const aArg: array of SizeInt): TValue;
 implementation
 
 uses
-  TypInfo, SysUtils, Math;
+  SysUtils, Math;
 
 {$ifndef fpc}
 function TValueHelper.AsUnicodeString: UnicodeString;
@@ -90,7 +97,9 @@ begin
       Result := True;
       for i := 0 to aValue1.GetArrayLength - 1 do
         if not EqualValues(aValue1.GetArrayElement(i), aValue2.GetArrayElement(i)) then begin
+{$ifdef debug}
           Writeln('Element ', i, ' differs: ', HexStr(aValue1.GetArrayElement(i).AsOrdinal, 4), ' ', HexStr(aValue2.GetArrayElement(i).AsOrdinal, 4));
+{$endif}
           Result := False;
           Break;
         end;