mirror of
				https://gitlab.com/freepascal.org/fpc/source.git
				synced 2025-10-31 16:31:36 +01:00 
			
		
		
		
	* tkclass removed from finalize()
* cleanupinstance now parses the tkclass rtti entry itself and
    calls finalize() for the rtti members
			
			
This commit is contained in:
		
							parent
							
								
									356b3378e8
								
							
						
					
					
						commit
						72324a4283
					
				| @ -510,15 +510,42 @@ | |||||||
| 
 | 
 | ||||||
|       procedure TObject.CleanupInstance; |       procedure TObject.CleanupInstance; | ||||||
| 
 | 
 | ||||||
|  |         Type | ||||||
|  |           TRecElem = Record | ||||||
|  |             Info : Pointer; | ||||||
|  |             Offset : Longint; | ||||||
|  |           end; | ||||||
|  | 
 | ||||||
|  |           TRecElemArray = Array[1..Maxint] of TRecElem; | ||||||
|  | 
 | ||||||
|  |           PRecRec = ^TRecRec; | ||||||
|  |           TRecRec = record | ||||||
|  |             Size,Count : Longint; | ||||||
|  |             Elements : TRecElemArray; | ||||||
|  |           end; | ||||||
|  | 	   | ||||||
|         var |         var | ||||||
|            vmt  : tclass; |            vmt  : tclass; | ||||||
| 
 | 	   temp : pbyte; | ||||||
|  | 	   count, | ||||||
|  | 	   i    : longint; | ||||||
|         begin |         begin | ||||||
|            vmt:=ClassType; |            vmt:=ClassType; | ||||||
|            while vmt<>nil do |            while vmt<>nil do | ||||||
|              begin |              begin | ||||||
|                 if Assigned(Pointer((Pointer(vmt)+vmtInitTable)^)) then | 	       { This need to be included here, because Finalize() | ||||||
|                   int_finalize(Pointer(Self),Pointer((Pointer(vmt)+vmtInitTable)^)); | 	         has should support for tkClass } | ||||||
|  | 	       Temp:=Pointer((Pointer(vmt)+vmtInitTable)^); | ||||||
|  |                if Assigned(Temp) then | ||||||
|  |  	         begin | ||||||
|  |                    inc(Temp); | ||||||
|  |                    I:=Temp^; | ||||||
|  |                    inc(temp,I+1);                // skip name string;
 | ||||||
|  |                    Count:=PRecRec(Temp)^.Count;  // get element Count
 | ||||||
|  |                    For I:=1 to count do | ||||||
|  |                      With PRecRec(Temp)^.elements[I] do | ||||||
|  |                        int_Finalize (pointer(self)+Offset,Info); | ||||||
|  | 		 end;        | ||||||
|                vmt:=pclass(pointer(vmt)+vmtParent)^; |                vmt:=pclass(pointer(vmt)+vmtParent)^; | ||||||
|              end; |              end; | ||||||
|         end; |         end; | ||||||
| @ -695,7 +722,12 @@ | |||||||
| 
 | 
 | ||||||
| { | { | ||||||
|   $Log$ |   $Log$ | ||||||
|   Revision 1.33  2003-07-19 11:19:07  michael |   Revision 1.34  2004-02-26 16:19:01  peter | ||||||
|  |     * tkclass removed from finalize() | ||||||
|  |     * cleanupinstance now parses the tkclass rtti entry itself and | ||||||
|  |       calls finalize() for the rtti members | ||||||
|  | 
 | ||||||
|  |   Revision 1.33  2003/07/19 11:19:07  michael | ||||||
|   + fix from Ivan Shikhalev for QueryInterface to return ancestor methods |   + fix from Ivan Shikhalev for QueryInterface to return ancestor methods | ||||||
| 
 | 
 | ||||||
|   Revision 1.32  2003/05/01 08:05:23  florian |   Revision 1.32  2003/05/01 08:05:23  florian | ||||||
|  | |||||||
| @ -53,7 +53,6 @@ Const | |||||||
| } | } | ||||||
| 
 | 
 | ||||||
| Type | Type | ||||||
| 
 |  | ||||||
|   TRecElem = Record |   TRecElem = Record | ||||||
|     Info : Pointer; |     Info : Pointer; | ||||||
|     Offset : Longint; |     Offset : Longint; | ||||||
| @ -88,14 +87,10 @@ Procedure fpc_Initialize (Data,TypeInfo : pointer);saveregisters;[Public,Alias : | |||||||
| 
 | 
 | ||||||
| { this definition is sometimes (depending on switches) | { this definition is sometimes (depending on switches) | ||||||
|   already defined or not so define it locally to avoid problems PM } |   already defined or not so define it locally to avoid problems PM } | ||||||
| Type |  | ||||||
|     Pbyte = ^Byte; |  | ||||||
| 
 |  | ||||||
| Var Temp       : PByte; | Var Temp       : PByte; | ||||||
|     I          : longint; |     I          : longint; | ||||||
|     Size,Count : longint; |     Size,Count : longint; | ||||||
|     TInfo : Pointer; |     TInfo : Pointer; | ||||||
| 
 |  | ||||||
| begin | begin | ||||||
|   Temp:=PByte(TypeInfo); |   Temp:=PByte(TypeInfo); | ||||||
|   case temp^ of |   case temp^ of | ||||||
| @ -112,14 +107,12 @@ begin | |||||||
|          For I:=0 to Count-1 do |          For I:=0 to Count-1 do | ||||||
|            int_Initialize (Data+(I*size),TInfo); |            int_Initialize (Data+(I*size),TInfo); | ||||||
|       end; |       end; | ||||||
|     tkRecord,tkClass,tkObject: |     tkObject, | ||||||
|  |     tkRecord: | ||||||
|       begin |       begin | ||||||
|          inc(Temp); |          inc(Temp); | ||||||
|          I:=Temp^; |          I:=Temp^; | ||||||
|          inc(temp,I+1);             // skip name string;
 |          inc(temp,I+1);             // skip name string;
 | ||||||
|          { if it isn't necessary, why should we load it ? FK |  | ||||||
|            Size:=PRecRec(Temp)^.Size;    // get record size; not needed.
 |  | ||||||
|          } |  | ||||||
|          Count:=PRecRec(Temp)^.Count;  // get element Count
 |          Count:=PRecRec(Temp)^.Count;  // get element Count
 | ||||||
|          For I:=1 to count Do |          For I:=1 to count Do | ||||||
|            With PRecRec(Temp)^.elements[I] do |            With PRecRec(Temp)^.elements[I] do | ||||||
| @ -134,17 +127,12 @@ end; | |||||||
| 
 | 
 | ||||||
| 
 | 
 | ||||||
| Procedure fpc_finalize (Data,TypeInfo: Pointer);saveregisters;[Public,Alias : 'FPC_FINALIZE'];  {$ifdef hascompilerproc} compilerproc; {$endif} | Procedure fpc_finalize (Data,TypeInfo: Pointer);saveregisters;[Public,Alias : 'FPC_FINALIZE'];  {$ifdef hascompilerproc} compilerproc; {$endif} | ||||||
| 
 |  | ||||||
| { this definition is sometimes (depending on switches) | { this definition is sometimes (depending on switches) | ||||||
|   already defined or not so define it locally to avoid problems PM } |   already defined or not so define it locally to avoid problems PM } | ||||||
| Type |  | ||||||
|     Pbyte = ^Byte; |  | ||||||
|     PPointer = ^Pointer; |  | ||||||
| Var Temp       : PByte; | Var Temp       : PByte; | ||||||
|     I          : longint; |     I          : longint; | ||||||
|     Size,Count : longint; |     Size,Count : longint; | ||||||
|     TInfo : Pointer; |     TInfo : Pointer; | ||||||
| 
 |  | ||||||
| begin | begin | ||||||
|   Temp:=PByte(TypeInfo); |   Temp:=PByte(TypeInfo); | ||||||
|   case temp^ of |   case temp^ of | ||||||
| @ -165,14 +153,12 @@ begin | |||||||
|         For I:=0 to Count-1 do |         For I:=0 to Count-1 do | ||||||
|           int_Finalize (Data+(I*size),TInfo); |           int_Finalize (Data+(I*size),TInfo); | ||||||
|       end; |       end; | ||||||
|     tkRecord,tkObject,tkClass: |     tkObject, | ||||||
|  |     tkRecord: | ||||||
|       begin |       begin | ||||||
|         inc(Temp); |         inc(Temp); | ||||||
|         I:=Temp^; |         I:=Temp^; | ||||||
|         inc(temp,I+1);                // skip name string;
 |         inc(temp,I+1);                // skip name string;
 | ||||||
|          { if it isn't necessary, why should we load it? FK |  | ||||||
|            Size:=PRecRec(Temp)^.Size;    // get record size; not needed.
 |  | ||||||
|          } |  | ||||||
|         Count:=PRecRec(Temp)^.Count;  // get element Count
 |         Count:=PRecRec(Temp)^.Count;  // get element Count
 | ||||||
|         For I:=1 to count do |         For I:=1 to count do | ||||||
|           With PRecRec(Temp)^.elements[I] do |           With PRecRec(Temp)^.elements[I] do | ||||||
| @ -196,9 +182,6 @@ Procedure fpc_Addref (Data,TypeInfo : Pointer);saveregisters; [Public,alias : 'F | |||||||
| 
 | 
 | ||||||
| { this definition is sometimes (depending on switches) | { this definition is sometimes (depending on switches) | ||||||
|   already defined or not so define it locally to avoid problems PM } |   already defined or not so define it locally to avoid problems PM } | ||||||
| Type |  | ||||||
|     Pbyte = ^Byte; |  | ||||||
|     PPointer = ^Pointer; |  | ||||||
| Var Temp       : PByte; | Var Temp       : PByte; | ||||||
|     I          : longint; |     I          : longint; | ||||||
|     Size,Count : longint; |     Size,Count : longint; | ||||||
| @ -223,12 +206,12 @@ begin | |||||||
|         For I:=0 to Count-1 do |         For I:=0 to Count-1 do | ||||||
|           int_AddRef (Data+(I*size),TInfo); |           int_AddRef (Data+(I*size),TInfo); | ||||||
|       end; |       end; | ||||||
|  |     tkobject, | ||||||
|     tkrecord : |     tkrecord : | ||||||
|       begin |       begin | ||||||
|         Inc(Temp); |         Inc(Temp); | ||||||
|         I:=Temp^; |         I:=Temp^; | ||||||
|         temp:=temp+(I+1);             // skip name string;
 |         temp:=temp+(I+1);             // skip name string;
 | ||||||
|         Size:=PRecRec(Temp)^.Size;    // get record size; not needed.
 |  | ||||||
|         Count:=PRecRec(Temp)^.Count;  // get element Count
 |         Count:=PRecRec(Temp)^.Count;  // get element Count
 | ||||||
|         For I:=1 to count do |         For I:=1 to count do | ||||||
|           With PRecRec(Temp)^.elements[I] do |           With PRecRec(Temp)^.elements[I] do | ||||||
| @ -251,14 +234,10 @@ procedure fpc_systemDecRef (Data, TypeInfo : Pointer);saveregisters;[external na | |||||||
| Procedure fpc_DecRef (Data, TypeInfo : Pointer);saveregisters;[Public,alias : 'FPC_DECREF'];  {$ifdef hascompilerproc} compilerproc; {$endif} | Procedure fpc_DecRef (Data, TypeInfo : Pointer);saveregisters;[Public,alias : 'FPC_DECREF'];  {$ifdef hascompilerproc} compilerproc; {$endif} | ||||||
| { this definition is sometimes (depending on switches) | { this definition is sometimes (depending on switches) | ||||||
|   already defined or not so define it locally to avoid problems PM } |   already defined or not so define it locally to avoid problems PM } | ||||||
| Type |  | ||||||
|     Pbyte = ^Byte; |  | ||||||
|     PPointer = ^Pointer; |  | ||||||
| Var Temp       : PByte; | Var Temp       : PByte; | ||||||
|     I          : longint; |     I          : longint; | ||||||
|     Size,Count : longint; |     Size,Count : longint; | ||||||
|     TInfo : Pointer; |     TInfo : Pointer; | ||||||
| 
 |  | ||||||
| begin | begin | ||||||
|   Temp:=PByte(TypeInfo); |   Temp:=PByte(TypeInfo); | ||||||
|   case temp^ of |   case temp^ of | ||||||
| @ -280,12 +259,12 @@ begin | |||||||
|          For I:=0 to Count-1 do |          For I:=0 to Count-1 do | ||||||
|            fpc_systemDecRef (Data+(I*size),TInfo); |            fpc_systemDecRef (Data+(I*size),TInfo); | ||||||
|       end; |       end; | ||||||
|  |     tkobject, | ||||||
|     tkrecord: |     tkrecord: | ||||||
|       begin |       begin | ||||||
|       Temp:=Temp+1; |          inc(Temp); | ||||||
|       I:=Temp^; |          I:=temp^; | ||||||
|       temp:=temp+(I+1);             // skip name string;
 |          inc(temp,I+1);               // skip name string;
 | ||||||
|       Size:=PRecRec(Temp)^.Size;    // get record size; not needed.
 |  | ||||||
|          Count:=PRecRec(Temp)^.Count;  // get element Count
 |          Count:=PRecRec(Temp)^.Count;  // get element Count
 | ||||||
|          For I:=1 to count do |          For I:=1 to count do | ||||||
|            With PRecRec(Temp)^.elements[I] do |            With PRecRec(Temp)^.elements[I] do | ||||||
| @ -313,7 +292,12 @@ procedure fpc_finalize_array(data,typeinfo : pointer;count,size : longint); [Pub | |||||||
| 
 | 
 | ||||||
| { | { | ||||||
|   $Log$ |   $Log$ | ||||||
|   Revision 1.9  2004-02-26 12:42:34  michael |   Revision 1.10  2004-02-26 16:19:01  peter | ||||||
|  |     * tkclass removed from finalize() | ||||||
|  |     * cleanupinstance now parses the tkclass rtti entry itself and | ||||||
|  |       calls finalize() for the rtti members | ||||||
|  | 
 | ||||||
|  |   Revision 1.9  2004/02/26 12:42:34  michael | ||||||
|   + Patch from peter to fix finalize (bug 2975) |   + Patch from peter to fix finalize (bug 2975) | ||||||
| 
 | 
 | ||||||
|   Revision 1.8  2004/01/22 22:09:05  peter |   Revision 1.8  2004/01/22 22:09:05  peter | ||||||
|  | |||||||
		Loading…
	
		Reference in New Issue
	
	Block a user
	 peter
						peter