paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-12-11 06:20:47 +01:00
Code Issues Packages Projects Releases Wiki Activity

* making sparc compiling again by adapting compilerproc declarations after the

Browse Source 
last change of compilerproc by i386 team.
This commit is contained in:
mazen 2003-04-01 21:12:40 +00:00
parent d7d14b0eca
commit 9f66d3bc05
1 changed files with 18 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

31
rtl/inc/generic.inc
View File

@ -324,7 +324,7 @@ end;
{$ifndef FPC_SYSTEM_HAS_FPC_HELP_CONSTRUCTOR} {$ifndef FPC_SYSTEM_HAS_FPC_HELP_CONSTRUCTOR}
{ Note: _vmt will be reset to -1 when memory is allocated, { Note: _vmt will be reset to -1 when memory is allocated,
this is needed for fpc_help_fail } this is needed for fpc_help_fail }
function fpc_help_constructor(_self:pointer;var _vmt:pointer;_vmt_pos:cardinal):pointer;[public,alias:'FPC_HELP_CONSTRUCTOR'];{$ifdef hascompilerproc}compilerproc;{$endif} procedure fpc_help_constructor;[public,alias:'FPC_HELP_CONSTRUCTOR'];{$ifdef hascompilerproc}compilerproc;{$endif}
type type
ppointer = ^pointer; ppointer = ^pointer;
pvmt = ^tvmt; pvmt = ^tvmt;
@ -334,11 +334,12 @@ type
end; end;
var var
vmtcopy : pointer; vmtcopy : pointer;
_self:pointer;var _vmt:pointer;_vmt_pos:cardinal;result:pointer;
begin begin
{ Inherited call? } { Inherited call? }
if _vmt=nil then if _vmt=nil then
begin begin
fpc_help_constructor:=_self; result:=_self;
exit; exit;
end; end;
vmtcopy:=_vmt; vmtcopy:=_vmt;
@ -354,14 +355,14 @@ begin
fillchar(_self^,pvmt(vmtcopy)^.size,#0); fillchar(_self^,pvmt(vmtcopy)^.size,#0);
ppointer(_self+_vmt_pos)^:=vmtcopy; ppointer(_self+_vmt_pos)^:=vmtcopy;
end; end;
fpc_help_constructor:=_self; result:=_self;
end; end;
{$endif FPC_SYSTEM_HAS_FPC_HELP_CONSTRUCTOR} {$endif FPC_SYSTEM_HAS_FPC_HELP_CONSTRUCTOR}
{$ifndef FPC_SYSTEM_HAS_FPC_HELP_DESTRUCTOR} {$ifndef FPC_SYSTEM_HAS_FPC_HELP_DESTRUCTOR}
{ Note: _self will not be reset, the compiler has to generate the reset } { Note: _self will not be reset, the compiler has to generate the reset }
procedure fpc_help_destructor(_self,_vmt:pointer;vmt_pos:cardinal);[public,alias:'FPC_HELP_DESTRUCTOR']; {$ifdef hascompilerproc} compilerproc; {$endif} procedure fpc_help_destructor(var _self : pointer; vmt : pointer; vmt_pos : cardinal);[public,alias:'FPC_HELP_DESTRUCTOR']; {$ifdef hascompilerproc} compilerproc; {$endif}
type type
ppointer = ^pointer; ppointer = ^pointer;
pvmt = ^tvmt; pvmt = ^tvmt;
@ -377,9 +378,9 @@ begin
if (pvmt(ppointer(_self+vmt_pos)^)^.size=0) or if (pvmt(ppointer(_self+vmt_pos)^)^.size=0) or
(pvmt(ppointer(_self+vmt_pos)^)^.size+pvmt(ppointer(_self+vmt_pos)^)^.msize<>0) then (pvmt(ppointer(_self+vmt_pos)^)^.size+pvmt(ppointer(_self+vmt_pos)^)^.msize<>0) then
RunError(210); RunError(210);
if (_vmt = nil) then if (vmt = nil) then
exit; exit;
objectsize:=pvmt(_vmt)^.size; 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,objectsize);
@ -389,7 +390,7 @@ end;
{$ifndef FPC_SYSTEM_HAS_FPC_HELP_FAIL} {$ifndef FPC_SYSTEM_HAS_FPC_HELP_FAIL}
{ Note: _self will not be reset, the compiler has to generate the reset } { Note: _self will not be reset, the compiler has to generate the reset }
procedure fpc_help_fail(_self:pointer;var _vmt:pointer;vmt_pos:cardinal);[public,alias:'FPC_HELP_FAIL'];compilerproc; procedure fpc_help_fail(var _self:pointer;var vmt:pointer;vmt_pos:cardinal);[public,alias:'FPC_HELP_FAIL'];compilerproc;
type type
ppointer = ^pointer; ppointer = ^pointer;
pvmt = ^tvmt; pvmt = ^tvmt;
@ -398,10 +399,10 @@ type
parent : pointer; parent : pointer;
end; end;
begin begin
if _vmt=nil then if vmt=nil then
exit; exit;
{ vmt=-1 when memory was allocated } { vmt=-1 when memory was allocated }
if longint(_vmt)=-1 then if longint(vmt)=-1 then
begin begin
if (_self=nil) or (ppointer(_self+vmt_pos)^=nil) then if (_self=nil) or (ppointer(_self+vmt_pos)^=nil) then
HandleError(210) HandleError(210)
@ -411,7 +412,7 @@ begin
freemem(_self); freemem(_self);
{ reset _vmt to 0 so it will not be freed a { reset _vmt to 0 so it will not be freed a
second time } second time }
_vmt:=0; vmt:=0;
end; end;
end end
else else
@ -421,7 +422,7 @@ end;
{$ifndef FPC_SYSTEM_HAS_FPC_NEW_CLASS} {$ifndef FPC_SYSTEM_HAS_FPC_NEW_CLASS}
function fpc_new_class(_self,_vmt:pointer):pointer;[public,alias:'FPC_NEW_CLASS']; {$ifdef hascompilerproc} compilerproc; {$endif} function fpc_new_class(_vmt:pointer;_self:pointer):pointer;[public,alias:'FPC_NEW_CLASS']; {$ifdef hascompilerproc} compilerproc; {$endif}
begin begin
{ Inherited call? } { Inherited call? }
if _vmt=nil then if _vmt=nil then
@ -436,7 +437,7 @@ end;
{$ifndef FPC_SYSTEM_HAS_FPC_DISPOSE_CLASS} {$ifndef FPC_SYSTEM_HAS_FPC_DISPOSE_CLASS}
procedure fpc_dispose_class(_self: pointer; flag : longint);[public,alias:'FPC_DISPOSE_CLASS'];compilerproc; procedure fpc_dispose_class(_self: tobject; flag : longint);[public,alias:'FPC_DISPOSE_CLASS'];compilerproc;
begin begin
{ inherited -> flag = 0 -> no destroy } { inherited -> flag = 0 -> no destroy }
{ normal -> flag = 1 -> destroy } { normal -> flag = 1 -> destroy }
@ -962,7 +963,11 @@ end;
{ {
$Log$ $Log$
Revision 1.51 2003-03-26 00:17:34 peter Revision 1.52 2003-04-01 21:12:40 mazen
* making sparc compiling again by adapting compilerproc declarations after the
last change of compilerproc by i386 team.
Revision 1.51 2003/03/26 00:17:34 peter
* generic constructor/destructor fixes * generic constructor/destructor fixes
Revision 1.50 2003/02/18 17:56:06 jonas Revision 1.50 2003/02/18 17:56:06 jonas