paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-05-03 14:44:11 +02:00
Code Issues Packages Projects Releases Wiki Activity

* remvoe objectsize loading from help_destructor

Browse Source 
* implement fpc_check_object
  * saveregistrers for check_object
This commit is contained in:
peter 2003-04-23 13:10:09 +00:00
parent 86c4522697
commit f272c18e94
1 changed files with 13 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

24
rtl/inc/generic.inc
View File

@ -369,8 +369,6 @@ type
size,msize : longint; size,msize : longint;
parent : pointer; parent : pointer;
end; end;
var
objectsize : longint;
begin begin
if (_self=nil) then if (_self=nil) then
exit; exit;
@ -379,10 +377,9 @@ begin
RunError(210); RunError(210);
if (_vmt = nil) then if (_vmt = nil) then
exit; exit;
objectsize:=pvmt(_vmt)^.size;
{ reset vmt to nil for protection } { reset vmt to nil for protection }
ppointer(_self+vmt_pos)^:=nil; ppointer(_self+vmt_pos)^:=nil;
freemem(_self,objectsize); freemem(_self);
end; end;
{$endif FPC_SYSTEM_HAS_FPC_HELP_DESTRUCTOR} {$endif FPC_SYSTEM_HAS_FPC_HELP_DESTRUCTOR}
@ -447,7 +444,7 @@ end;
{$ifndef FPC_SYSTEM_HAS_FPC_CHECK_OBJECT} {$ifndef FPC_SYSTEM_HAS_FPC_CHECK_OBJECT}
procedure fpc_check_object(obj : pointer);[public,alias:'FPC_CHECK_OBJECT']; {$ifdef hascompilerproc} compilerproc; {$endif} procedure fpc_check_object(_vmt : pointer);saveregisters;[public,alias:'FPC_CHECK_OBJECT']; {$ifdef hascompilerproc} compilerproc; {$endif}
type type
pvmt = ^tvmt; pvmt = ^tvmt;
tvmt = packed record tvmt = packed record
@ -455,10 +452,10 @@ type
parent : pointer; parent : pointer;
end; end;
begin begin
(* if (vmt=nil) or if (_vmt=nil) or
(pvmt(vmt)^.size=0) or (pvmt(_vmt)^.size=0) or
(pvmt(vmt)^.size+pvmt(vmt)^.msize<>0) then (pvmt(_vmt)^.size+pvmt(_vmt)^.msize<>0) then
RunError(210);*) RunError(210);
end; end;
{$endif ndef FPC_SYSTEM_HAS_FPC_CHECK_OBJECT} {$endif ndef FPC_SYSTEM_HAS_FPC_CHECK_OBJECT}
@ -468,7 +465,7 @@ end;
{ checks for a correct vmt pointer } { checks for a correct vmt pointer }
{ deeper check to see if the current object is } { deeper check to see if the current object is }
{ really related to the true } { really related to the true }
procedure fpc_check_object_ext(vmt, expvmt : pointer);[public,alias:'FPC_CHECK_OBJECT_EXT']; {$ifdef hascompilerproc} compilerproc; {$endif} procedure fpc_check_object_ext(vmt, expvmt : pointer);saveregisters;[public,alias:'FPC_CHECK_OBJECT_EXT']; {$ifdef hascompilerproc} compilerproc; {$endif}
type type
pvmt = ^tvmt; pvmt = ^tvmt;
tvmt = packed record tvmt = packed record
@ -962,7 +959,12 @@ end;
{ {
$Log$ $Log$
Revision 1.53 2003-04-02 14:05:45 peter Revision 1.54 2003-04-23 13:10:09 peter
* remvoe objectsize loading from help_destructor
* implement fpc_check_object
* saveregistrers for check_object
Revision 1.53 2003/04/02 14:05:45 peter
* undo previous commit * undo previous commit
Revision 1.51 2003/03/26 00:17:34 peter Revision 1.51 2003/03/26 00:17:34 peter