paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-12 23:09:40 +02:00
Code Issues Packages Projects Releases Wiki Activity

* Reuse RecordRTTI to finalize class instances. This is possible because RTTI for classes is the same as for records (except different value of tkKind field), and RecordRTTI ignores tkKind (assuming that required checks are done by its caller).

Browse Source 
git-svn-id: trunk@23213 -
This commit is contained in:
sergei 2012-12-23 12:10:11 +00:00
parent 4dbe24d375
commit 27c626245b
3 changed files with 10 additions and 53 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
rtl/inc/aliases.inc
View File

@ -29,3 +29,9 @@ Procedure int_Addref (Data,TypeInfo : Pointer); [external name 'FPC_ADDREF'];
Procedure int_Initialize (Data,TypeInfo: Pointer); [external name 'FPC_INITIALIZE'];
procedure int_FinalizeArray(data,typeinfo : pointer;count : longint); [external name 'FPC_FINALIZE_ARRAY'];
{$ifdef FPC_HAS_FEATURE_RTTI}
type
TRTTIProc=procedure(Data,TypeInfo:Pointer);
procedure RecordRTTI(Data,TypeInfo:Pointer;rttiproc:TRTTIProc); forward;
{$endif FPC_HAS_FEATURE_RTTI}

55
rtl/inc/objpas.inc
View File

@ -610,9 +610,6 @@
procedure TObject.DispatchStr(var message);
type
PSizeUInt = ^SizeUInt;
var
name : shortstring;
count,i : longint;
@ -662,62 +659,18 @@
procedure TObject.CleanupInstance;
Type
TRecElem = packed Record
Info : Pointer;
Offset : Longint;
end;
{$ifdef CPU16}
TRecElemArray = packed array[1..Maxint div sizeof(TRecElem)-1] of TRecElem;
{$else CPU16}
TRecElemArray = packed array[1..Maxint] of TRecElem;
{$endif CPU16}
PRecRec = ^TRecRec;
TRecRec = record
Size,Count : Longint;
Elements : TRecElemArray;
end;
var
vmt : PVmt;
temp : pbyte;
count,
i : longint;
{$ifdef FPC_REQUIRES_PROPER_ALIGNMENT}
recelem : TRecElem;
{$endif FPC_REQUIRES_PROPER_ALIGNMENT}
temp : pointer;
begin
vmt := PVmt(ClassType);
while vmt<>nil do
begin
{ This need to be included here, because Finalize()
has should support for tkClass }
Temp:= vmt^.vInitTable;
{ The RTTI format matches one for records, except the type is tkClass.
Since RecordRTTI does not check the type, calling it yields the desired result. }
if Assigned(Temp) then
begin
inc(Temp);
I:=Temp^;
inc(temp,I+1); // skip name string;
temp:=aligntoptr(temp);
{$ifdef FPC_REQUIRES_PROPER_ALIGNMENT}
move(PRecRec(Temp)^.Count,Count,sizeof(Count));
{$else FPC_REQUIRES_PROPER_ALIGNMENT}
Count:=PRecRec(Temp)^.Count; // get element Count
{$endif FPC_REQUIRES_PROPER_ALIGNMENT}
For I:=1 to count do
{$ifdef FPC_REQUIRES_PROPER_ALIGNMENT}
begin
move(PRecRec(Temp)^.elements[I],RecElem,sizeof(RecElem));
With RecElem do
int_Finalize (pointer(self)+Offset,Info);
end;
{$else FPC_REQUIRES_PROPER_ALIGNMENT}
With PRecRec(Temp)^.elements[I] do
int_Finalize (pointer(self)+Offset,Info);
{$endif FPC_REQUIRES_PROPER_ALIGNMENT}
end;
RecordRTTI(Self,Temp,@int_finalize);
vmt:= vmt^.vParent;
end;
end;

2
rtl/inc/rtti.inc
View File

@ -17,8 +17,6 @@
{ the tk* constants are now declared in system.inc }
type
TRTTIProc=procedure(Data,TypeInfo:Pointer);
PRecordElement=^TRecordElement;
TRecordElement=packed record
TypeInfo: Pointer;