From d40a2dbb1271ca1964fdfd8b34efb55c580724b9 Mon Sep 17 00:00:00 2001
From: Sven/Sarah Barth <pascaldragon@gmail.com>
Date: Mon, 6 Mar 2023 23:03:06 +0100
Subject: [PATCH] + add generic utility function ConstParamIsRef<> to determine
 whether a specific type is passed by-value or by-reference as a const
 parameter

---
 rtl/objpas/rtlconst.inc |  1 +
 rtl/objpas/typinfo.pp   | 77 +++++++++++++++++++++++++++++++++++++++++
 2 files changed, 78 insertions(+)

diff --git a/rtl/objpas/rtlconst.inc b/rtl/objpas/rtlconst.inc
index 955a69337e..6946ad6ff5 100644
--- a/rtl/objpas/rtlconst.inc
+++ b/rtl/objpas/rtlconst.inc
@@ -287,6 +287,7 @@ ResourceString
   SUnknownGroup                 = '%s not in a class registration group';
   SUnknownProperty              = 'Unknown property: "%s"';
   SUnknownPropertyType          = 'Unknown property type %d';
+  SUnsupportedCallConv          = 'Unsupported calling convention: %s';
   SUnsupportedPropertyVariantType = 'Unsupported property variant type %d';
   SUntitled                     = '(Untitled)';
   SVBitmaps                     = 'Bitmaps';
diff --git a/rtl/objpas/typinfo.pp b/rtl/objpas/typinfo.pp
index 3bd890426a..da6a889b08 100644
--- a/rtl/objpas/typinfo.pp
+++ b/rtl/objpas/typinfo.pp
@@ -849,6 +849,7 @@ Function GetTypeData(TypeInfo : PTypeInfo) : PTypeData;
 Function AlignTypeData(p : Pointer) : Pointer; inline;
 Function AlignTParamFlags(p : Pointer) : Pointer; inline;
 Function AlignPTypeInfo(p : Pointer) : Pointer; inline;
+Generic Function ConstParamIsRef<T>(aCallConv: TCallConv = ccReg): Boolean; inline;
 
 Function GetPropInfo(TypeInfo: PTypeInfo;const PropName: string): PPropInfo;
 Function GetPropInfo(TypeInfo: PTypeInfo;const PropName: string; AKinds: TTypeKinds): PPropInfo;
@@ -1497,6 +1498,82 @@ begin
 end;
 
 
+Generic Function ConstParamIsRef<T>(aCallConv: TCallConv): Boolean;
+
+  Function SameAddrRegister(const aArg1: T; constref aArg2: T): Boolean; register;
+  begin
+    Result := @aArg1 = @aArg2;
+  end;
+
+  Function SameAddrCDecl(const aArg1: T; constref aArg2: T): Boolean; cdecl;
+  begin
+    Result := @aArg1 = @aArg2;
+  end;
+
+{$if defined(cpui8086) or defined(cpui386)}
+  Function SameAddrPascal(const aArg1: T; constref aArg2: T): Boolean; pascal;
+  begin
+    Result := @aArg1 = @aArg2;
+  end;
+{$endif}
+
+  Function SameAddrStdCall(const aArg1: T; constref aArg2: T): Boolean; stdcall;
+  begin
+    Result := @aArg1 = @aArg2;
+  end;
+
+  Function SameAddrCppDecl(const aArg1: T; constref aArg2: T): Boolean; cppdecl;
+  begin
+    Result := @aArg1 = @aArg2;
+  end;
+
+{$if defined(cpui386)}
+  Function SameAddrOldFPCCall(const aArg1: T; constref aArg2: T): Boolean; oldfpccall;
+  begin
+    Result := @aArg1 = @aArg2;
+  end;
+{$endif}
+
+  Function SameAddrMWPascal(const aArg1: T; constref aArg2: T): Boolean; mwpascal;
+  begin
+    Result := @aArg1 = @aArg2;
+  end;
+
+var
+  v: T;
+begin
+  v := Default(T);
+  case aCallConv of
+    ccReg:
+      Result := SameAddrRegister(v, v);
+    ccCdecl:
+      Result := SameAddrCDecl(v, v);
+{$if defined(cpui386) or defined(cpui8086)}
+    ccPascal:
+      Result := SameAddrPascal(v, v);
+{$endif}
+{$if not defined(cpui386)}
+    ccOldFPCCall,
+{$endif}
+{$if not defined(cpui386) and not defined(cpui8086)}
+    ccPascal,
+{$endif}
+    ccStdCall:
+      Result := SameAddrStdCall(v, v);
+    ccCppdecl:
+      Result := SameAddrCppDecl(v, v);
+{$if defined(cpui386)}
+    ccOldFPCCall:
+      Result := SameAddrOldFPCCall(v, v);
+{$endif}
+    ccMWPascal:
+      Result := SameAddrMWPascal(v, v);
+    else
+      raise EArgumentException.CreateFmt(SUnsupportedCallConv, [GetEnumName(PTypeInfo(TypeInfo(TCallConv)), Ord(aCallConv))]);
+  end;
+end;
+
+
 Function GetTypeData(TypeInfo : PTypeInfo) : PTypeData;
 begin
   GetTypeData:=AlignTypeData(pointer(TypeInfo)+2+PByte(pointer(TypeInfo)+1)^);