From 4fbb2d9cf06ac87f0c7da541c7b122b2a0957b78 Mon Sep 17 00:00:00 2001 From: marco Date: Sat, 9 Nov 2019 13:28:55 +0000 Subject: [PATCH] --- 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 | 7 ++--- compiler/aarch64/agcpugas.pas | 6 +++-- compiler/aarch64/racpugas.pas | 3 ++- packages/rtl-objpas/src/inc/rtti.pp | 26 ++++++++++++++++--- packages/rtl-objpas/tests/tests.rtti.pas | 23 +++++++++------- packages/rtl-objpas/tests/tests.rtti.util.pas | 13 ++++++++-- 6 files changed, 57 insertions(+), 21 deletions(-) diff --git a/compiler/aarch64/aasmcpu.pas b/compiler/aarch64/aasmcpu.pas index c5f03b7d8b..67e6413651 100644 --- a/compiler/aarch64/aasmcpu.pas +++ b/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 } diff --git a/compiler/aarch64/agcpugas.pas b/compiler/aarch64/agcpugas.pas index 2d1665ebbc..da9f4ce983 100644 --- a/compiler/aarch64/agcpugas.pas +++ b/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 diff --git a/compiler/aarch64/racpugas.pas b/compiler/aarch64/racpugas.pas index 0c84dc79af..685edc67f2 100644 --- a/compiler/aarch64/racpugas.pas +++ b/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; diff --git a/packages/rtl-objpas/src/inc/rtti.pp b/packages/rtl-objpas/src/inc/rtti.pp index e77c6d84d4..4c8665bebe 100644 --- a/packages/rtl-objpas/src/inc/rtti.pp +++ b/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; diff --git a/packages/rtl-objpas/tests/tests.rtti.pas b/packages/rtl-objpas/tests/tests.rtti.pas index bae0877f4a..2993eb7ac3 100644 --- a/packages/rtl-objpas/tests/tests.rtti.pas +++ b/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'); diff --git a/packages/rtl-objpas/tests/tests.rtti.util.pas b/packages/rtl-objpas/tests/tests.rtti.util.pas index da780e8e56..f939f936ef 100644 --- a/packages/rtl-objpas/tests/tests.rtti.util.pas +++ b/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;