mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-14 10:49:09 +02:00
* pass dyn. arrays in registers when i386 register calling conventions are used
git-svn-id: trunk@30870 -
This commit is contained in:
parent
f8fda7ed65
commit
956883b0c7
1
.gitattributes
vendored
1
.gitattributes
vendored
@ -10540,6 +10540,7 @@ tests/tbs/tb0606.pp svneol=native#text/pascal
|
|||||||
tests/tbs/tb0607.pp svneol=native#text/plain
|
tests/tbs/tb0607.pp svneol=native#text/plain
|
||||||
tests/tbs/tb0608.pp svneol=native#text/pascal
|
tests/tbs/tb0608.pp svneol=native#text/pascal
|
||||||
tests/tbs/tb0609.pp svneol=native#text/plain
|
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/tb205.pp svneol=native#text/plain
|
||||||
tests/tbs/tb610.pp svneol=native#text/pascal
|
tests/tbs/tb610.pp svneol=native#text/pascal
|
||||||
tests/tbs/tbs0594.pp svneol=native#text/pascal
|
tests/tbs/tbs0594.pp svneol=native#text/pascal
|
||||||
|
@ -601,7 +601,8 @@ unit cpupara;
|
|||||||
if (parareg<=high(parasupregs)) and
|
if (parareg<=high(parasupregs)) and
|
||||||
(paralen<=sizeof(aint)) and
|
(paralen<=sizeof(aint)) and
|
||||||
(not(hp.vardef.typ in [floatdef,recorddef,arraydef]) or
|
(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(vo_is_parentfp in hp.varoptions) or
|
||||||
not(po_delphi_nested_cc in p.procoptions)) then
|
not(po_delphi_nested_cc in p.procoptions)) then
|
||||||
begin
|
begin
|
||||||
|
75
tests/tbs/tb0610.pp
Normal file
75
tests/tbs/tb0610.pp
Normal 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.
|
@ -19,13 +19,13 @@ type
|
|||||||
|
|
||||||
function TTest.GetCount(TheArray: TNodeArray; Count: Integer): Integer; assembler;
|
function TTest.GetCount(TheArray: TNodeArray; Count: Integer): Integer; assembler;
|
||||||
asm
|
asm
|
||||||
MOV EAX, EDX
|
MOV EAX, ECX
|
||||||
end;
|
end;
|
||||||
|
|
||||||
{$IMPLICITEXCEPTIONS OFF}
|
{$IMPLICITEXCEPTIONS OFF}
|
||||||
function TTest.GetCountNoExceptions(TheArray: TNodeArray; Count: Integer): Integer; assembler;
|
function TTest.GetCountNoExceptions(TheArray: TNodeArray; Count: Integer): Integer; assembler;
|
||||||
asm
|
asm
|
||||||
MOV EAX, EDX
|
MOV EAX, ECX
|
||||||
end;
|
end;
|
||||||
{$IMPLICITEXCEPTIONS ON}
|
{$IMPLICITEXCEPTIONS ON}
|
||||||
|
|
||||||
|
Loading…
Reference in New Issue
Block a user