* Introduced a new function CaptureBacktrace, using it to handle most of back-tracing in heaptrc unit.

* Use StackTop instead of StackBottom+StackLength in a few remaining locations.

git-svn-id: trunk@27141 -

rtl/inc/except.inc

@@ -137,7 +137,7 @@ begin
   { The frame pointer of this procedure is used as initial stack bottom value. }
   prev_frame:=get_frame;
   while (framecount<RaiseMaxFrameCount) and (curr_frame > prev_frame) and
-        (curr_frame<(StackBottom + StackLength)) do
+        (curr_frame<StackTop) do
     Begin
       prev_frame:=curr_frame;
       get_caller_stackinfo(curr_frame,curr_addr);

rtl/inc/heaptrc.pp

@@ -464,10 +464,7 @@ end;
 
 Function TraceGetMem(size:ptruint):pointer;
 var
-  allocsize,i : ptruint;
-  oldbp,
-  bp : pointer;
-  pcaddr : codepointer;
+  allocsize : ptruint;
   pl : pdword;
   p  : pointer;
   pp : pheap_mem_info;
@@ -531,19 +528,7 @@ begin
   { clear the memory }
   fillchar(p^,size,#255);
   { retrieve backtrace info }
-  bp:=get_frame;
-  pcaddr:=get_pc_addr;
-  oldbp:=bp;
-  get_caller_stackinfo(bp,pcaddr);
-
-  for i:=1 to tracesize do
-    begin
-      if (bp<oldbp) or (bp>(StackBottom + StackLength)) then
-        break;
-      oldbp:=bp;
-      get_caller_stackinfo(bp,pcaddr);
-      pp^.calls[i]:=pcaddr;
-    end;
+  CaptureBacktrace(1,tracesize-1,@pp^.calls[1]);
 
   { insert in the linked list }
   if loc_info^.heap_mem_root<>nil then
@@ -575,10 +560,6 @@ end;
 function CheckFreeMemSize(loc_info: pheap_info; pp: pheap_mem_info;
   size, ppsize: ptruint): boolean; inline;
 var
-  i: ptruint;
-  oldbp,
-  bp : pointer;
-  pcaddr : codepointer;
   ptext : ^text;
 {$ifdef EXTRA}
   pp2 : pheap_mem_info;
@@ -636,21 +617,8 @@ begin
          loc_info^.heap_mem_root:=loc_info^.heap_mem_root^.previous;
     end
   else
-    begin
-       bp:=get_frame;
-       pcaddr:=get_pc_addr;
-       oldbp:=bp;
-       get_caller_stackinfo(bp,pcaddr);
+    CaptureBacktrace(1,(tracesize div 2)-1,@pp^.calls[(tracesize div 2)+1]);
 
-       for i:=(tracesize div 2)+1 to tracesize do
-         begin
-           if (bp<oldbp) or (bp>(StackBottom + StackLength)) then
-              break;
-           oldbp:=bp;
-           get_caller_stackinfo(bp,pcaddr);
-           pp^.calls[i]:=pcaddr;
-         end;
-    end;
   inc(loc_info^.freemem_cnt);
   { clear the memory, $F0 will lead to GFP if used as pointer ! }
   fillchar((pointer(pp)+sizeof(theap_mem_info))^,size,#240);
@@ -801,11 +769,7 @@ function TraceReAllocMem(var p:pointer;size:ptruint):Pointer;
 var
   newP: pointer;
   allocsize,
-  movesize,
-  i  : ptruint;
-  oldbp,
-  bp : pointer;
-  pcaddr : codepointer;
+  movesize  : ptruint;
   pl : pdword;
   pp : pheap_mem_info;
   oldsize,
@@ -920,18 +884,7 @@ begin
   inc(loc_info^.getmem_size,size);
   inc(loc_info^.getmem8_size,(size+7) and not 7);
   { generate new backtrace }
-  bp:=get_frame;
-  pcaddr:=get_pc_addr;
-  oldbp:=bp;
-  get_caller_stackinfo(bp,pcaddr);
-  for i:=1 to tracesize do
-    begin
-      if (bp<oldbp) or (bp>(StackBottom + StackLength)) then
-        break;
-      oldbp:=bp;
-      get_caller_stackinfo(bp,pcaddr);
-      pp^.calls[i]:=pcaddr;
-    end;
+  CaptureBacktrace(1,tracesize-1,@pp^.calls[1]);
   { regenerate signature }
   if usecrc then
     pp^.sig:=calculate_sig(pp);
@@ -1008,9 +961,6 @@ var
 {$ifdef windows}
   datap : pointer;
 {$endif windows}
-{$ifdef morphos}
-  stack_top: longword;
-{$endif morphos}
   bp : pointer;
   pcaddr : codepointer;
   ptext : ^text;
@@ -1088,8 +1038,7 @@ begin
 
 {$ifdef morphos}
   { inside stack ? }
-  stack_top:=ptruint(StackBottom)+StackLength;
-  if (ptruint(p)<stack_top) and (ptruint(p)>ptruint(StackBottom)) then
+  if (ptruint(p)<ptruint(StackTop)) and (ptruint(p)>ptruint(StackBottom)) then
     exit;
   { inside data or bss ? }
   {$WARNING data and bss checking missing }

rtl/inc/system.inc

@@ -1065,6 +1065,36 @@ begin
 end;
 
 
+function CaptureBacktrace(skipframes,count:sizeint;frames:PCodePointer):sizeint;
+var
+  curr_frame,prev_frame: pointer;
+  curr_addr: codepointer;
+  i: sizeint;
+begin
+  curr_frame:=get_frame;
+  curr_addr:=get_pc_addr;
+  prev_frame:=curr_frame;
+  get_caller_stackinfo(curr_frame,curr_addr);
+  i:=-skipframes;
+  while (i<count) and (curr_frame>prev_frame) and
+     (curr_frame<StackTop) do
+    begin
+      prev_frame:=curr_frame;
+      get_caller_stackinfo(curr_frame,curr_addr);
+      if (curr_addr=nil) or
+         (curr_frame=nil) then
+        break;
+      if (i>=0) then
+        frames[i]:=curr_addr;
+      inc(i);
+    end;
+  if i<0 then
+    result:=0
+  else
+    result:=i;
+end;
+
+
 Procedure HandleErrorAddrFrame (Errno : longint;addr : CodePointer; frame : Pointer);[public,alias:'FPC_BREAK_ERROR']; {$ifdef CPUI386} register; {$endif}
 begin
   If pointer(ErrorProc)<>Nil then

rtl/inc/systemh.inc

@@ -1270,6 +1270,10 @@ function get_frame:pointer;{$ifdef SYSTEMINLINE}inline;{$endif}
 
 Function Get_pc_addr : CodePointer;
 
+{ Writes at most 'count' caller stack frames to pre-allocated buffer pointed to
+  by 'frames', skipping 'skipframes' initial frames. Returns number of frames written. }
+function CaptureBacktrace(skipframes,count:sizeint;frames:PCodePointer):sizeint;
+
 function get_caller_addr(framebp:pointer;addr:codepointer=nil):codepointer;
 function get_caller_frame(framebp:pointer;addr:codepointer=nil):pointer;
 procedure get_caller_stackinfo(var framebp : pointer; var addr : codepointer);