paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-11-02 07:49:32 +01:00
Code Issues Packages Projects Releases Wiki Activity

* RTL: clean up exception handling code (functionality is not changed).

Browse Source 
* changed fpc_pushexceptobj to normal procedure, it does not need to be a compilerproc.

git-svn-id: trunk@19596 -
This commit is contained in:
sergei 2011-11-05 16:28:37 +00:00
parent 84c23f6b42
commit 56900b4754
2 changed files with 15 additions and 34 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
rtl/inc/compproc.inc
View File

@ -653,7 +653,6 @@ procedure fpc_dispatch_by_id(Result: Pointer; const Dispatch: pointer;DispDesc:
{$ifdef FPC_HAS_FEATURE_EXCEPTIONS}
Function fpc_PushExceptAddr (Ft: Longint;_buf,_newaddr : pointer): PJmp_buf ; compilerproc;
Procedure fpc_PushExceptObj (Obj : TObject; AnAddr,AFrame : Pointer); compilerproc;
Function fpc_Raiseexception (Obj : TObject; AnAddr,AFrame : Pointer) : TObject; compilerproc;
Procedure fpc_PopAddrStack; compilerproc;
function fpc_PopObjectStack : TObject; compilerproc;

48
rtl/inc/except.inc
View File

@ -33,10 +33,8 @@ Type
frametype : Longint;
end;
TExceptObjectClass = Class of TObject;
Const
CatchAllExceptions : PtrInt = -1;
CatchAllExceptions = PtrInt(-1);
ThreadVar
ExceptAddrStack : PExceptAddr;
@ -95,8 +93,7 @@ begin
end;
Procedure fpc_PushExceptObj (Obj : TObject; AnAddr,AFrame : Pointer);
[Public, Alias : 'FPC_PUSHEXCEPTOBJECT']; compilerproc;
Procedure PushExceptObject(Obj : TObject; AnAddr,AFrame : Pointer);
var
Newobj : PExceptObject;
_ExceptObjectStack : ^PExceptObject;
@ -112,23 +109,14 @@ begin
writeln ('In PushExceptObject');
{$endif}
_ExceptObjectStack:=@ExceptObjectStack;
If _ExceptObjectStack^=Nil then
begin
New(_ExceptObjectStack^);
_ExceptObjectStack^^.Next:=Nil;
end
else
begin
New(NewObj);
NewObj^.Next:=_ExceptObjectStack^;
_ExceptObjectStack^:=NewObj;
end;
with _ExceptObjectStack^^ do
begin
FObject:=Obj;
Addr:=AnAddr;
refcount:=0;
end;
New(NewObj);
NewObj^.Next:=_ExceptObjectStack^;
_ExceptObjectStack^:=NewObj;
NewObj^.FObject:=Obj;
NewObj^.Addr:=AnAddr;
NewObj^.refcount:=0;
{ Backtrace }
curr_frame:=AFrame;
prev_frame:=get_frame;
@ -153,14 +141,10 @@ begin
prev_frame:=curr_frame;
curr_frame:=caller_frame;
End;
_ExceptObjectStack^^.framecount:=framecount;
_ExceptObjectStack^^.frames:=frames;
NewObj^.framecount:=framecount;
NewObj^.frames:=frames;
end;
{ make it avalable for local use }
Procedure fpc_PushExceptObj (Obj : TObject; AnAddr,AFrame : Pointer); [external name 'FPC_PUSHEXCEPTOBJECT'];
Procedure DoUnHandledException;
var
_ExceptObjectStack : PExceptObject;
@ -193,7 +177,7 @@ begin
writeln ('In RaiseException');
{$endif}
fpc_Raiseexception:=nil;
fpc_PushExceptObj(Obj,AnAddr,AFrame);
PushExceptObject(Obj,AnAddr,AFrame);
_ExceptAddrstack:=ExceptAddrStack;
If _ExceptAddrStack=Nil then
DoUnhandledException;
@ -313,7 +297,6 @@ procedure Internal_Reraise; external name 'FPC_RERAISE';
Function fpc_Catches(Objtype : TClass) : TObject;[Public, Alias : 'FPC_CATCHES']; compilerproc;
var
_Objtype : TExceptObjectClass;
_ExceptObjectStack : PExceptObject;
begin
_ExceptObjectStack:=ExceptObjectStack;
@ -324,9 +307,8 @@ begin
{$endif}
halt (255);
end;
_Objtype := TExceptObjectClass(Objtype);
if Not ((_Objtype = TExceptObjectClass(CatchAllExceptions)) or
(_ExceptObjectStack^.FObject is _ObjType)) then
if Not ((Objtype = TClass(CatchAllExceptions)) or
(_ExceptObjectStack^.FObject is ObjType)) then
fpc_Catches:=Nil
else
begin