* Instead of three individual try..except blocks in fpc_pushexceptobject, guard the entire procedure at the caller side (it is called only from fpc_raiseexception). This additionally guards against possible crashes in getmem() due to corrupted heap. Furthermore, try..except block is not necessary at all for such one-time purposes.

git-svn-id: trunk@26843 -

rtl/inc/except.inc

@@ -102,16 +102,9 @@ begin
 end;
 
 
-{$ifdef FPC_HAS_FEATURE_EXCEPTIONS}
-  { get_caller_XX funxctions can generate exceptions on their own
-    for instance ifd the stack got corrupted
-    Here we protect calls to those function by a
-    try/except bloc, with a global indicator TryExceptLevel
-    to avoid calling get_caller_XXX functions again if
-    any exception appears while calling them }
-  {$define FPC_CHECK_GET_CALLER_EXCEPTIONS}
-{$endif}
-
+{ This routine is called only from fpc_raiseexception, which uses ExceptTryLevel
+  flag to guard against repeated exceptions which can occur due to corrupted stack
+  or heap. }
 Procedure PushExceptObject(Obj : TObject; AnAddr : CodePointer; AFrame : Pointer);
 var
   Newobj : PExceptObject;
@@ -143,52 +136,26 @@ begin
   frames:=nil;
   framebufsize:=0;
   framecount:=0;
-  if ExceptTryLevel = 0 then
-    begin
-      Inc(ExceptTrylevel);
-{$ifdef FPC_CHECK_GET_CALLER_EXCEPTIONS}
-      try
-{$endif FPC_CHECK_GET_CALLER_EXCEPTIONS}
-      prev_frame:=get_caller_frame(curr_frame, curr_addr);
-{$ifdef FPC_CHECK_GET_CALLER_EXCEPTIONS}
-      except
-        halt(217);
-      end;
-{$endif FPC_CHECK_GET_CALLER_EXCEPTIONS}
-      while (framecount<RaiseMaxFrameCount) and (curr_frame > prev_frame) and
-            (curr_frame<(StackBottom + StackLength)) do
-        Begin
-{$ifdef FPC_CHECK_GET_CALLER_EXCEPTIONS}
-          try
-            caller_addr := get_caller_addr(curr_frame, curr_addr);
-          except
-            halt(217);
-          end;
-          try
-            caller_frame := get_caller_frame(curr_frame, curr_addr);
-          except
-            halt(217);
-          end;
-{$else not FPC_CHECK_GET_CALLER_EXCEPTIONS}
-          caller_addr := get_caller_addr(curr_frame, curr_addr);
-          caller_frame := get_caller_frame(curr_frame, curr_addr);
-{$endif FPC_CHECK_GET_CALLER_EXCEPTIONS}
-          if (caller_addr=nil) or
-             (caller_frame=nil) then
-            break;
-          if (framecount>=framebufsize) then
-            begin
-              inc(framebufsize,16);
-              reallocmem(frames,framebufsize*sizeof(codepointer));
-            end;
-          frames[framecount]:=caller_addr;
-          inc(framecount);
-          prev_frame:=curr_frame;
-          curr_addr:=caller_addr;
-          curr_frame:=caller_frame;
-        End;
-      Dec(ExceptTryLevel);
-    end;
+  prev_frame:=get_caller_frame(curr_frame, curr_addr);
+  while (framecount<RaiseMaxFrameCount) and (curr_frame > prev_frame) and
+        (curr_frame<(StackBottom + StackLength)) do
+    Begin
+      caller_addr := get_caller_addr(curr_frame, curr_addr);
+      caller_frame := get_caller_frame(curr_frame, curr_addr);
+      if (caller_addr=nil) or
+         (caller_frame=nil) then
+        break;
+      if (framecount>=framebufsize) then
+        begin
+          inc(framebufsize,16);
+          reallocmem(frames,framebufsize*sizeof(codepointer));
+        end;
+      frames[framecount]:=caller_addr;
+      inc(framecount);
+      prev_frame:=curr_frame;
+      curr_addr:=caller_addr;
+      curr_frame:=caller_frame;
+    End;
   NewObj^.framecount:=framecount;
   NewObj^.frames:=frames;
 end;
@@ -219,7 +186,13 @@ begin
 {$ifdef excdebug}
   writeln ('In RaiseException');
 {$endif}
+  if ExceptTryLevel<>0 then
+    Halt(217);
+  ExceptTryLevel:=1;
   PushExceptObject(Obj,AnAddr,AFrame);
+  { if PushExceptObject causes another exception, the following won't be executed,
+    causing halt upon entering this routine recursively. }
+  ExceptTryLevel:=0;
   _ExceptAddrstack:=ExceptAddrStack;
   If _ExceptAddrStack=Nil then
     DoUnhandledException;