From 956883b0c72d62a29e1eefd4828a1eae1abbbf85 Mon Sep 17 00:00:00 2001
From: florian <florian@freepascal.org>
Date: Sat, 16 May 2015 20:27:09 +0000
Subject: [PATCH] * pass dyn. arrays in registers when i386 register calling
conventions are used
git-svn-id: trunk@30870 -
---
.gitattributes | 1 +
compiler/i386/cpupara.pas | 3 +-
tests/tbs/tb0610.pp | 75 +++++++++++++++++++++++++++++++++++++++
tests/webtbs/tw20075.pp | 4 +--
4 files changed, 80 insertions(+), 3 deletions(-)
create mode 100644 tests/tbs/tb0610.pp
diff --git a/.gitattributes b/.gitattributes
index 8992a68778..a8323b6143 100644
--- a/.gitattributes
+++ b/.gitattributes
@@ -10540,6 +10540,7 @@ tests/tbs/tb0606.pp svneol=native#text/pascal
tests/tbs/tb0607.pp svneol=native#text/plain
tests/tbs/tb0608.pp svneol=native#text/pascal
tests/tbs/tb0609.pp svneol=native#text/plain
+tests/tbs/tb0610.pp svneol=native#text/pascal
tests/tbs/tb205.pp svneol=native#text/plain
tests/tbs/tb610.pp svneol=native#text/pascal
tests/tbs/tbs0594.pp svneol=native#text/pascal
diff --git a/compiler/i386/cpupara.pas b/compiler/i386/cpupara.pas
index ab98a9d071..4cc20e08c7 100644
--- a/compiler/i386/cpupara.pas
+++ b/compiler/i386/cpupara.pas
@@ -601,7 +601,8 @@ unit cpupara;
if (parareg<=high(parasupregs)) and
(paralen<=sizeof(aint)) and
(not(hp.vardef.typ in [floatdef,recorddef,arraydef]) or
- pushaddr) and
+ pushaddr or
+ is_dynamic_array(hp.vardef)) and
(not(vo_is_parentfp in hp.varoptions) or
not(po_delphi_nested_cc in p.procoptions)) then
begin
diff --git a/tests/tbs/tb0610.pp b/tests/tbs/tb0610.pp
new file mode 100644
index 0000000000..6987bf5568
--- /dev/null
+++ b/tests/tbs/tb0610.pp
@@ -0,0 +1,75 @@
+program testarray;
+{$mode objfpc}
+{$h+}
+uses typinfo;
+
+Procedure SetPointerProp(Instance : TObject;PropInfo : PPropInfo;Value : Pointer);
+
+type
+ TObjectArray = Array of tobject;
+ TSetPointerProcIndex=procedure(index : longint;p:pointer) of object;
+ TSetPointerProc=procedure(P : Pointer) of object;
+
+var
+ DataSize: Integer;
+ AMethod : TMethod;
+begin
+ DataSize:=Length(TObjectArray(Value));
+ case (PropInfo^.PropProcs shr 2) and 3 of
+ ptfield:
+ PPointer(Pointer(Instance)+PtrUInt(PropInfo^.SetProc))^:=Value;
+ ptstatic,
+ ptvirtual :
+ begin
+ if ((PropInfo^.PropProcs shr 2) and 3)=ptStatic then
+ AMethod.Code:=PropInfo^.SetProc
+ else
+ AMethod.Code:=PPointer(Pointer(Instance.ClassType)+PtrUInt(PropInfo^.SetProc))^;
+ AMethod.Data:=Instance;
+ if ((PropInfo^.PropProcs shr 6) and 1)<>0 then
+ TSetPointerProcIndex(AMethod)(PropInfo^.Index,Value)
+ else
+ TSetPointerProc(AMethod)(Value);
+ end;
+ end;
+end;
+
+{$M+}
+Type
+ TMyArrayObject = Class(TObject);
+ TMyArrayObjectArray = Array of TMyArrayObject;
+
+ { TMyObject }
+
+ TMyObject = Class(TObject)
+ private
+ FMyArray : TMyArrayObjectArray;
+ procedure SetMyArray(AIndex: Integer; AValue: TMyArrayObjectArray);virtual;
+ Published
+ Property MyArray : TMyArrayObjectArray Index 8 Read FMyArray Write SetMyArray;
+ end;
+
+{ TMyObject }
+
+procedure TMyObject.SetMyArray(AIndex: Integer; AValue: TMyArrayObjectArray);
+Var
+ ALength : Integer;
+
+begin
+ ALength:=Length(AValue);
+ If FMyArray=AValue then exit;
+ FMyArray:=AValue;
+end;
+
+Var
+ O : TMyObject;
+ A : TMyArrayObjectArray;
+
+begin
+ SetLength(A,117);
+ O:=TMyObject.Create;
+ // SetObjProp(O,GetPropInfo(O,'MyArray'),TObject(A));
+ SetPointerProp(O,GetPropInfo(O,'MyArray'),Pointer(A));
+ If Length(O.MyArray)<>Length(A) then
+ Writeln('Wrong!!')
+end.
diff --git a/tests/webtbs/tw20075.pp b/tests/webtbs/tw20075.pp
index 82bf5ec86b..cc686ffea5 100644
--- a/tests/webtbs/tw20075.pp
+++ b/tests/webtbs/tw20075.pp
@@ -19,13 +19,13 @@ type
function TTest.GetCount(TheArray: TNodeArray; Count: Integer): Integer; assembler;
asm
- MOV EAX, EDX
+ MOV EAX, ECX
end;
{$IMPLICITEXCEPTIONS OFF}
function TTest.GetCountNoExceptions(TheArray: TNodeArray; Count: Integer): Integer; assembler;
asm
- MOV EAX, EDX
+ MOV EAX, ECX
end;
{$IMPLICITEXCEPTIONS ON}