paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-12-04 03:37:35 +01:00
Code Issues Packages Projects Releases Wiki Activity

better handling of unhandled exceptions

Browse Source
This commit is contained in:
michael 1998-10-02 10:40:19 +00:00
parent 45f1890009
commit a99c5a00c7
1 changed files with 14 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

22
rtl/inc/except.inc
View File

@ -100,14 +100,24 @@ begin
ExceptObjectStack^.Addr:=AnAddr;
end;
Procedure DoUnHandledException (Var Obj : TObject; AnAddr : Pointer);
begin
If ExceptProc<>Nil then
If ExceptObjectStack<>Nil then
TExceptPRoc(ExceptProc)(Obj,AnAddr);
RunError(217);
end;
Function Raiseexcept (Obj : TObject; AnAddr : Pointer) : TObject;[Public, Alias : 'FPC_RAISEEXCEPTION'];
begin
{$ifdef excdebug}
writeln ('In RAiseException');
{$endif}
PushExceptObj(Obj,AnAddr);
If ExceptAddrStack=Nil then
DoUnhandledException (Obj,AnAddr);
longjmp(ExceptAddrStack^.Buf^,FPC_Exception);
end;
@ -141,6 +151,7 @@ begin
ExceptObjectStack:=ExceptObjectStack^.Next;
end;
Procedure ReRaise;[Public, Alias : 'FPC_RERAISE'];
begin
@ -149,13 +160,8 @@ begin
{$endif}
PopAddrStack;
If ExceptAddrStack=Nil then
begin
If ExceptProc<>Nil then
If ExceptObjectStack<>Nil then
TExceptPRoc(ExceptProc)(ExceptObjectStack^.FObject,
ExceptObjectStack^.Addr);
RunError(217);
end;
DoUnHandledException (ExceptObjectStack^.FObject,
ExceptObjectStack^.Addr);
longjmp(ExceptAddrStack^.Buf^,FPC_Exception);
end;