paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-14 07:59:27 +02:00
Code Issues Packages Projects Releases Wiki Activity

* pass dyn. arrays in registers when i386 register calling conventions are used

Browse Source 
git-svn-id: trunk@30870 -
This commit is contained in:
florian 2015-05-16 20:27:09 +00:00
parent f8fda7ed65
commit 956883b0c7
4 changed files with 80 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitattributes vendored
View File

@ -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

3
compiler/i386/cpupara.pas
View File

@ -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

75
tests/tbs/tb0610.pp Normal file
View File

@ -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.

4
tests/webtbs/tw20075.pp
View File

@ -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}