View Issue Details

IDProjectCategoryView StatusLast Update
0028288FPCRTLpublic2016-09-19 10:19
ReporterAndrey ZubarevAssigned ToMichael Van Canneyt 
PrioritynormalSeverityminorReproducibilityalways
Status closedResolutionfixed 
Product VersionProduct Build 
Target Version3.0.2Fixed in Version3.1.1 
Summary0028288: GetLineInfo works only if first сall was made with valid address
DescriptionSample program:
program Project1;
uses sysutils;
procedure dotest(addr:pointer);
var
   func,source:shortstring;
   line:longint;
begin
     lineinfo.GetLineInfo(ptruint(addr),func,source,line);
     if (func<>'')or(source<>'')then writeln(format('func:%s source:%s line:%d',[func,source,line]))
                                else writeln('wrong addres')
end;
begin
  dotest(pointer(100));//comment this line and everything is working well
  dotest(@dotest);
  dotest(pointer(100));
  dotest(@dotest);
end.

if first line not commented, output:
D:\temp>project1.exe
wrong addres
wrong addres
wrong addres
wrong addres

if first line commented, output:
D:\temp>project1.exe
func:DOTEST source:d:/temp/project1.lpr line:0
wrong addres
func:DOTEST source:d:/temp/project1.lpr line:0
Tagspatch
Fixed in Revision32918
FPCOldBugId
FPCTarget
Attached Files
  • lineinfo.pp.patch (454 bytes)
    Index: lineinfo.pp
    ===================================================================
    --- lineinfo.pp	(revision 31027)
    +++ lineinfo.pp	(working copy)
    @@ -104,11 +104,11 @@
         exit;
     
       // If target filename same as previous, then re-use previous result
    -  if filename = lastfilename then
    +  {if filename = lastfilename then
       begin
         OpenStabs:=lastopenstabs;
         exit;
    -  end;
    +  end;}
     
       // Close previously opened stabs
       CloseStabs;
    
    lineinfo.pp.patch (454 bytes)
  • lineinfo.pp_reuse_if_last_founded.patch (3,600 bytes)
    Index: rtl/inc/lineinfo.pp
    ===================================================================
    --- rtl/inc/lineinfo.pp	(revision 31027)
    +++ rtl/inc/lineinfo.pp	(working copy)
    @@ -81,6 +81,7 @@
       lastfilename,         { store last processed file }
       dbgfn : string;
       lastopenstabs: Boolean; { store last result of processing a file }
    +  canreusestab:  Boolean; { last result GetLineInfo}
     
     
     function OpenStabs(addr : pointer) : boolean;
    @@ -104,7 +105,7 @@
         exit;
     
       // If target filename same as previous, then re-use previous result
    -  if filename = lastfilename then
    +  if (filename = lastfilename) and canreusestab then
       begin
         OpenStabs:=lastopenstabs;
         exit;
    @@ -169,10 +170,8 @@
       res,
       stabsleft,
       stabscnt,i : longint;
    -  found : boolean;
       lastfunc : tstab;
     begin
    -  GetLineInfo:=false;
     {$ifdef DEBUG_LINEINFO}
       writeln(stderr,'GetLineInfo called');
     {$endif DEBUG_LINEINFO}
    @@ -182,6 +181,7 @@
     
       if not OpenStabs(pointer(addr)) then
         exit;
    +  canreusestab:=false;
     
       { correct the value to the correct address in the file }
       { processaddress is set in OpenStabs                   }
    @@ -196,7 +196,6 @@
       fillchar(dirstab,sizeof(tstab),0);
       fillchar(linestab,sizeof(tstab),0);
       fillchar(lastfunc,sizeof(tstab),0);
    -  found:=false;
       seek(e.f,stabofs);
       stabsleft:=stabcnt;
       repeat
    @@ -220,7 +219,7 @@
                   begin
                     { if it's equal we can stop and take the last info }
                     if stabs[i].nvalue=addr then
    -                 found:=true
    +                 canreusestab:=true
                     else
                      linestab:=stabs[i];
                   end;
    @@ -261,36 +260,38 @@
            end;
          end;
         dec(stabsleft,stabscnt);
    -  until found or (stabsleft=0);
    +  until canreusestab or (stabsleft=0);
    +  GetLineInfo:=canreusestab;
     
     { get the line,source,function info }
    -  line:=linestab.ndesc;
    -  if dirstab.ntype<>0 then
    -   begin
    -     seek(e.f,stabstrofs+dirstab.strpos);
    -     blockread(e.f,source[1],high(source)-1,res);
    -     dirlength:=strlen(@source[1]);
    -     source[0]:=chr(dirlength);
    -   end
    -  else
    -   dirlength:=0;
    -  if filestab.ntype<>0 then
    -   begin
    -     seek(e.f,stabstrofs+filestab.strpos);
    -     blockread(e.f,source[dirlength+1],high(source)-(dirlength+1),res);
    -     source[0]:=chr(strlen(@source[1]));
    -   end;
    -  if funcstab.ntype<>0 then
    -   begin
    -     seek(e.f,stabstrofs+funcstab.strpos);
    -     blockread(e.f,func[1],high(func)-1,res);
    -     func[0]:=chr(strlen(@func[1]));
    -     i:=pos(':',func);
    -     if i>0 then
    -      Delete(func,i,255);
    -   end;
    -
    -  GetLineInfo:=true;
    +  if canreusestab then
    +  begin
    +    line:=linestab.ndesc;
    +    if dirstab.ntype<>0 then
    +     begin
    +       seek(e.f,stabstrofs+dirstab.strpos);
    +       blockread(e.f,source[1],high(source)-1,res);
    +       dirlength:=strlen(@source[1]);
    +       source[0]:=chr(dirlength);
    +     end
    +    else
    +     dirlength:=0;
    +    if filestab.ntype<>0 then
    +     begin
    +       seek(e.f,stabstrofs+filestab.strpos);
    +       blockread(e.f,source[dirlength+1],high(source)-(dirlength+1),res);
    +       source[0]:=chr(strlen(@source[1]));
    +     end;
    +    if funcstab.ntype<>0 then
    +     begin
    +       seek(e.f,stabstrofs+funcstab.strpos);
    +       blockread(e.f,func[1],high(func)-1,res);
    +       func[0]:=chr(strlen(@func[1]));
    +       i:=pos(':',func);
    +       if i>0 then
    +        Delete(func,i,255);
    +     end;
    +  end;
     end;
     
     
    @@ -339,6 +340,7 @@
     initialization
       lastfilename := '';
       lastopenstabs := false;
    +  canreusestab := false;
       BackTraceStrFunc:=@StabBackTraceStr;
     
     finalization
    
  • lineinfo.pp_reuse_if_last_founded2.patch (2,206 bytes)
    Index: rtl/inc/lineinfo.pp
    ===================================================================
    --- rtl/inc/lineinfo.pp	(revision 31027)
    +++ rtl/inc/lineinfo.pp	(working copy)
    @@ -81,6 +81,7 @@
       lastfilename,         { store last processed file }
       dbgfn : string;
       lastopenstabs: Boolean; { store last result of processing a file }
    +  canreusestab:  Boolean; { last result GetLineInfo}
     
     
     function OpenStabs(addr : pointer) : boolean;
    @@ -104,7 +105,7 @@
         exit;
     
       // If target filename same as previous, then re-use previous result
    -  if filename = lastfilename then
    +  if (filename = lastfilename) and canreusestab then
       begin
         OpenStabs:=lastopenstabs;
         exit;
    @@ -169,10 +170,8 @@
       res,
       stabsleft,
       stabscnt,i : longint;
    -  found : boolean;
       lastfunc : tstab;
     begin
    -  GetLineInfo:=false;
     {$ifdef DEBUG_LINEINFO}
       writeln(stderr,'GetLineInfo called');
     {$endif DEBUG_LINEINFO}
    @@ -182,6 +181,7 @@
     
       if not OpenStabs(pointer(addr)) then
         exit;
    +  canreusestab:=false;
     
       { correct the value to the correct address in the file }
       { processaddress is set in OpenStabs                   }
    @@ -196,7 +196,6 @@
       fillchar(dirstab,sizeof(tstab),0);
       fillchar(linestab,sizeof(tstab),0);
       fillchar(lastfunc,sizeof(tstab),0);
    -  found:=false;
       seek(e.f,stabofs);
       stabsleft:=stabcnt;
       repeat
    @@ -220,7 +219,7 @@
                   begin
                     { if it's equal we can stop and take the last info }
                     if stabs[i].nvalue=addr then
    -                 found:=true
    +                 canreusestab:=true
                     else
                      linestab:=stabs[i];
                   end;
    @@ -261,7 +260,7 @@
            end;
          end;
         dec(stabsleft,stabscnt);
    -  until found or (stabsleft=0);
    +  until canreusestab or (stabsleft=0);
     
     { get the line,source,function info }
       line:=linestab.ndesc;
    @@ -289,8 +288,8 @@
          if i>0 then
           Delete(func,i,255);
        end;
    -
       GetLineInfo:=true;
    +  if (func='') or (source='') then canreusestab:=false;
     end;
     
     
    @@ -339,6 +338,7 @@
     initialization
       lastfilename := '';
       lastopenstabs := false;
    +  canreusestab := false;
       BackTraceStrFunc:=@StabBackTraceStr;
     
     finalization
    
  • 20160109-lineinfo.pp.patch (3,427 bytes)
    Index: rtl/inc/lineinfo.pp
    ===================================================================
    --- rtl/inc/lineinfo.pp	(revision 32893)
    +++ rtl/inc/lineinfo.pp	(working copy)
    @@ -17,6 +17,7 @@
       dependent on objpas unit.
     }
     unit lineinfo;
    +
     interface
     
     {$S-}
    @@ -23,7 +24,7 @@
     {$Q-}
     
     {$IF FPC_VERSION<3}
    -Type 
    +type
       CodePointer = Pointer;
     {$ENDIF}
     
    @@ -31,6 +32,14 @@
     function StabBackTraceStr(addr:CodePointer):string;
     procedure CloseStabs;
     
    +var
    +  // Allows more efficient operation by reusing previously loaded debug data
    +  // when the target module filename is the same. However, if an invalid memory
    +  // address is supplied then further calls may result in an undefined behaviour.
    +  // In summary: enable for speed, disable for resilience.
    +  AllowReuseOfLineInfoData: Boolean = True;
    +
    +
     implementation
     
     uses
    @@ -88,7 +97,7 @@
         baseaddr : pointer;
     begin
       // False by default
    -  OpenStabs:=false;
    +  Result:=false;
     
       // Empty so can test if GetModuleByAddr has worked
       filename := '';
    @@ -104,9 +113,12 @@
         exit;
     
       // If target filename same as previous, then re-use previous result
    -  if filename = lastfilename then
    +  if AllowReuseOfLineInfoData and (filename = lastfilename) then
       begin
    -    OpenStabs:=lastopenstabs;
    +    {$ifdef DEBUG_LINEINFO}
    +    writeln(stderr,'Reusing debug data');
    +    {$endif DEBUG_LINEINFO}
    +    Result:=lastopenstabs;
         exit;
       end;
     
    @@ -142,13 +154,10 @@
         begin
           stabcnt:=stablen div sizeof(tstab);
           lastopenstabs:=true;
    -      OpenStabs:=true;
    +      Result:=true;
         end
       else
    -    begin
    -      CloseExeFile(e);
    -      exit;
    -    end;
    +    CloseExeFile(e);
     end;
     
     
    @@ -155,12 +164,10 @@
     procedure CloseStabs;
     begin
       if e.isopen then
    -  begin
         CloseExeFile(e);
     
    -    // Reset last processed filename
    -    lastfilename := '';
    -  end;
    +  // Reset last processed filename
    +  lastfilename := '';
     end;
     
     
    @@ -172,7 +179,7 @@
       found : boolean;
       lastfunc : tstab;
     begin
    -  GetLineInfo:=false;
    +  Result:=false;
     {$ifdef DEBUG_LINEINFO}
       writeln(stderr,'GetLineInfo called');
     {$endif DEBUG_LINEINFO}
    @@ -290,7 +297,10 @@
           Delete(func,i,255);
        end;
     
    -  GetLineInfo:=true;
    +  if not AllowReuseOfLineInfoData then
    +    CloseStabs;
    +
    +  Result:=true;
     end;
     
     
    @@ -315,23 +325,26 @@
     {$ifdef netware}
       { we need addr relative to code start on netware }
       dec(addr,ptruint(system.NWGetCodeStart));
    -  StabBackTraceStr:='  CodeStart + $'+HexStr(ptruint(addr),sizeof(ptruint)*2);
    +  Result:='  CodeStart + $'+HexStr(ptruint(addr),sizeof(ptruint)*2);
     {$else}
    -  StabBackTraceStr:='  $'+HexStr(ptruint(addr),sizeof(ptruint)*2);
    +  Result:='  $'+HexStr(ptruint(addr),sizeof(ptruint)*2);
     {$endif}
    -  if func<>'' then
    -    StabBackTraceStr:=StabBackTraceStr+'  '+func;
    -  if source<>'' then
    -   begin
    -     if func<>'' then
    -      StabBackTraceStr:=StabBackTraceStr+', ';
    -     if line<>0 then
    +  if Success then
    +  begin
    +    if func<>'' then
    +      Result:=Result+'  '+func;
    +    if source<>'' then
    +    begin
    +      if func<>'' then
    +        Result:=Result+', ';
    +      if line<>0 then
           begin
             str(line,hs);
    -        StabBackTraceStr:=StabBackTraceStr+' line '+hs;
    +        Result:=Result+' line '+hs;
           end;
    -     StabBackTraceStr:=StabBackTraceStr+' of '+source;
    -   end;
    +      Result:=Result+' of '+source;
    +    end;
    +  end;
       BackTraceStrFunc:=Store;
     end;
     
    
  • 20160109-2-lineinfo.pp.patch (2,582 bytes)
    Index: rtl/inc/lineinfo.pp
    ===================================================================
    --- rtl/inc/lineinfo.pp	(revision 32893)
    +++ rtl/inc/lineinfo.pp	(working copy)
    @@ -17,6 +17,7 @@
       dependent on objpas unit.
     }
     unit lineinfo;
    +
     interface
     
     {$S-}
    @@ -23,7 +24,7 @@
     {$Q-}
     
     {$IF FPC_VERSION<3}
    -Type 
    +type
       CodePointer = Pointer;
     {$ENDIF}
     
    @@ -31,6 +32,14 @@
     function StabBackTraceStr(addr:CodePointer):string;
     procedure CloseStabs;
     
    +var
    +  // Allows more efficient operation by reusing previously loaded debug data
    +  // when the target module filename is the same. However, if an invalid memory
    +  // address is supplied then further calls may result in an undefined behaviour.
    +  // In summary: enable for speed, disable for resilience.
    +  AllowReuseOfLineInfoData: Boolean = True;
    +
    +
     implementation
     
     uses
    @@ -104,8 +113,11 @@
         exit;
     
       // If target filename same as previous, then re-use previous result
    -  if filename = lastfilename then
    +  if AllowReuseOfLineInfoData and (filename = lastfilename) then
       begin
    +    {$ifdef DEBUG_LINEINFO}
    +    writeln(stderr,'Reusing debug data');
    +    {$endif DEBUG_LINEINFO}
         OpenStabs:=lastopenstabs;
         exit;
       end;
    @@ -145,10 +157,7 @@
           OpenStabs:=true;
         end
       else
    -    begin
    -      CloseExeFile(e);
    -      exit;
    -    end;
    +    CloseExeFile(e);
     end;
     
     
    @@ -155,12 +164,10 @@
     procedure CloseStabs;
     begin
       if e.isopen then
    -  begin
         CloseExeFile(e);
     
    -    // Reset last processed filename
    -    lastfilename := '';
    -  end;
    +  // Reset last processed filename
    +  lastfilename := '';
     end;
     
     
    @@ -290,6 +297,9 @@
           Delete(func,i,255);
        end;
     
    +  if not AllowReuseOfLineInfoData then
    +    CloseStabs;
    +
       GetLineInfo:=true;
     end;
     
    @@ -319,19 +329,22 @@
     {$else}
       StabBackTraceStr:='  $'+HexStr(ptruint(addr),sizeof(ptruint)*2);
     {$endif}
    -  if func<>'' then
    -    StabBackTraceStr:=StabBackTraceStr+'  '+func;
    -  if source<>'' then
    -   begin
    -     if func<>'' then
    -      StabBackTraceStr:=StabBackTraceStr+', ';
    -     if line<>0 then
    +  if Success then
    +  begin
    +    if func<>'' then
    +      StabBackTraceStr:=StabBackTraceStr+'  '+func;
    +    if source<>'' then
    +    begin
    +      if func<>'' then
    +        StabBackTraceStr:=StabBackTraceStr+', ';
    +      if line<>0 then
           begin
             str(line,hs);
             StabBackTraceStr:=StabBackTraceStr+' line '+hs;
           end;
    -     StabBackTraceStr:=StabBackTraceStr+' of '+source;
    -   end;
    +      StabBackTraceStr:=StabBackTraceStr+' of '+source;
    +    end;
    +  end;
       BackTraceStrFunc:=Store;
     end;
     
    

Relationships

has duplicate 0028907 resolvedJonas Maebe LineInfo unit can stop displaying backtrace if invalid pointer is passed 

Activities

Andrey Zubarev

2015-06-13 08:59

reporter   ~0084430

Testet with last trunk fpc. After rev 31026 (http://bugs.freepascal.org/view.php?id=13518)

Andrey Zubarev

2015-06-13 14:24

reporter  

lineinfo.pp.patch (454 bytes)
Index: lineinfo.pp
===================================================================
--- lineinfo.pp	(revision 31027)
+++ lineinfo.pp	(working copy)
@@ -104,11 +104,11 @@
     exit;
 
   // If target filename same as previous, then re-use previous result
-  if filename = lastfilename then
+  {if filename = lastfilename then
   begin
     OpenStabs:=lastopenstabs;
     exit;
-  end;
+  end;}
 
   // Close previously opened stabs
   CloseStabs;
lineinfo.pp.patch (454 bytes)

Andrey Zubarev

2015-06-13 14:29

reporter   ~0084434

If remove reuse last opened stabs (see uploaded patch) - everything working well.

Denis Kozlov

2015-06-14 00:29

reporter   ~0084439

Last edited: 2015-06-14 00:30

View 2 revisions

OpenStabs function (after the recent fix) caches the result of the previous attempt to open the same file, for obvious efficiency reasons.

You have tried to get line info for an invalid memory address, so OpenStabs failed and that result was cached. Following attempts to get line info from the same file will return the cached failure result.

Your patch simply disables caching, so the failure to get line info for invalid memory address no longer propagates into the consequent calls.

Apart from a possibility of making caching optional, is there a real need to address such cases, i.e. trying to get line info of invalid memory addresses?

Andrey Zubarev

2015-06-14 00:54

reporter   ~0084441

>> i.e. trying to get line info of invalid memory addresses?
Program crashed... For example, I manually calculated the address of a procedure, made a mistake and do a "call 100". In error handler I have an address, and it can be wrong. GetLineInfo procedure must always operate reliably and not return cached incorrect results.

Perhaps it makes sense to re-use only if the previous search was true?

Andrey Zubarev

2015-06-14 12:27

reporter   ~0084442

I add new path, please review.

Changes:
 1) Removed use of "found" variable in GetLineInfo, instead use "canreusestab" global variable.
 2) GetLineInfo return true\false if lineinfo founded\notfounded
 3) Reuse last opened file in OpenStabs if last GetLineInfo result is true.

Andrey Zubarev

2015-06-14 12:27

reporter  

lineinfo.pp_reuse_if_last_founded.patch (3,600 bytes)
Index: rtl/inc/lineinfo.pp
===================================================================
--- rtl/inc/lineinfo.pp	(revision 31027)
+++ rtl/inc/lineinfo.pp	(working copy)
@@ -81,6 +81,7 @@
   lastfilename,         { store last processed file }
   dbgfn : string;
   lastopenstabs: Boolean; { store last result of processing a file }
+  canreusestab:  Boolean; { last result GetLineInfo}
 
 
 function OpenStabs(addr : pointer) : boolean;
@@ -104,7 +105,7 @@
     exit;
 
   // If target filename same as previous, then re-use previous result
-  if filename = lastfilename then
+  if (filename = lastfilename) and canreusestab then
   begin
     OpenStabs:=lastopenstabs;
     exit;
@@ -169,10 +170,8 @@
   res,
   stabsleft,
   stabscnt,i : longint;
-  found : boolean;
   lastfunc : tstab;
 begin
-  GetLineInfo:=false;
 {$ifdef DEBUG_LINEINFO}
   writeln(stderr,'GetLineInfo called');
 {$endif DEBUG_LINEINFO}
@@ -182,6 +181,7 @@
 
   if not OpenStabs(pointer(addr)) then
     exit;
+  canreusestab:=false;
 
   { correct the value to the correct address in the file }
   { processaddress is set in OpenStabs                   }
@@ -196,7 +196,6 @@
   fillchar(dirstab,sizeof(tstab),0);
   fillchar(linestab,sizeof(tstab),0);
   fillchar(lastfunc,sizeof(tstab),0);
-  found:=false;
   seek(e.f,stabofs);
   stabsleft:=stabcnt;
   repeat
@@ -220,7 +219,7 @@
               begin
                 { if it's equal we can stop and take the last info }
                 if stabs[i].nvalue=addr then
-                 found:=true
+                 canreusestab:=true
                 else
                  linestab:=stabs[i];
               end;
@@ -261,36 +260,38 @@
        end;
      end;
     dec(stabsleft,stabscnt);
-  until found or (stabsleft=0);
+  until canreusestab or (stabsleft=0);
+  GetLineInfo:=canreusestab;
 
 { get the line,source,function info }
-  line:=linestab.ndesc;
-  if dirstab.ntype<>0 then
-   begin
-     seek(e.f,stabstrofs+dirstab.strpos);
-     blockread(e.f,source[1],high(source)-1,res);
-     dirlength:=strlen(@source[1]);
-     source[0]:=chr(dirlength);
-   end
-  else
-   dirlength:=0;
-  if filestab.ntype<>0 then
-   begin
-     seek(e.f,stabstrofs+filestab.strpos);
-     blockread(e.f,source[dirlength+1],high(source)-(dirlength+1),res);
-     source[0]:=chr(strlen(@source[1]));
-   end;
-  if funcstab.ntype<>0 then
-   begin
-     seek(e.f,stabstrofs+funcstab.strpos);
-     blockread(e.f,func[1],high(func)-1,res);
-     func[0]:=chr(strlen(@func[1]));
-     i:=pos(':',func);
-     if i>0 then
-      Delete(func,i,255);
-   end;
-
-  GetLineInfo:=true;
+  if canreusestab then
+  begin
+    line:=linestab.ndesc;
+    if dirstab.ntype<>0 then
+     begin
+       seek(e.f,stabstrofs+dirstab.strpos);
+       blockread(e.f,source[1],high(source)-1,res);
+       dirlength:=strlen(@source[1]);
+       source[0]:=chr(dirlength);
+     end
+    else
+     dirlength:=0;
+    if filestab.ntype<>0 then
+     begin
+       seek(e.f,stabstrofs+filestab.strpos);
+       blockread(e.f,source[dirlength+1],high(source)-(dirlength+1),res);
+       source[0]:=chr(strlen(@source[1]));
+     end;
+    if funcstab.ntype<>0 then
+     begin
+       seek(e.f,stabstrofs+funcstab.strpos);
+       blockread(e.f,func[1],high(func)-1,res);
+       func[0]:=chr(strlen(@func[1]));
+       i:=pos(':',func);
+       if i>0 then
+        Delete(func,i,255);
+     end;
+  end;
 end;
 
 
@@ -339,6 +340,7 @@
 initialization
   lastfilename := '';
   lastopenstabs := false;
+  canreusestab := false;
   BackTraceStrFunc:=@StabBackTraceStr;
 
 finalization

Denis Kozlov

2015-06-14 13:13

reporter   ~0084443

Last edited: 2015-06-14 13:14

View 2 revisions

The problem with always having to re-try failed files, is that about a half of the back trace is usually inside some external libraries. That means that for every one of those addresses a file will need to be opened and scanned, even though they will almost always fail.

Ultimately, it is a question of whether to use or not to use caching. First option gives improved performance, while the second gives stable operation when using invalid memory addresses.

I can make a cleaner patch once we decide what to do about it.

FPC developers have an opinion on this?

Andrey Zubarev

2015-06-14 14:01

reporter   ~0084445

lineinfo.pp_reuse_if_last_founded.patch is wrong.
See lineinfo.pp_reuse_if_last_founded2.patch - tested in win7x86

>>I can make a cleaner patch once we decide what to do about it.
I don't think there is an important performance, reliability is much more important

Andrey Zubarev

2015-06-14 14:02

reporter  

lineinfo.pp_reuse_if_last_founded2.patch (2,206 bytes)
Index: rtl/inc/lineinfo.pp
===================================================================
--- rtl/inc/lineinfo.pp	(revision 31027)
+++ rtl/inc/lineinfo.pp	(working copy)
@@ -81,6 +81,7 @@
   lastfilename,         { store last processed file }
   dbgfn : string;
   lastopenstabs: Boolean; { store last result of processing a file }
+  canreusestab:  Boolean; { last result GetLineInfo}
 
 
 function OpenStabs(addr : pointer) : boolean;
@@ -104,7 +105,7 @@
     exit;
 
   // If target filename same as previous, then re-use previous result
-  if filename = lastfilename then
+  if (filename = lastfilename) and canreusestab then
   begin
     OpenStabs:=lastopenstabs;
     exit;
@@ -169,10 +170,8 @@
   res,
   stabsleft,
   stabscnt,i : longint;
-  found : boolean;
   lastfunc : tstab;
 begin
-  GetLineInfo:=false;
 {$ifdef DEBUG_LINEINFO}
   writeln(stderr,'GetLineInfo called');
 {$endif DEBUG_LINEINFO}
@@ -182,6 +181,7 @@
 
   if not OpenStabs(pointer(addr)) then
     exit;
+  canreusestab:=false;
 
   { correct the value to the correct address in the file }
   { processaddress is set in OpenStabs                   }
@@ -196,7 +196,6 @@
   fillchar(dirstab,sizeof(tstab),0);
   fillchar(linestab,sizeof(tstab),0);
   fillchar(lastfunc,sizeof(tstab),0);
-  found:=false;
   seek(e.f,stabofs);
   stabsleft:=stabcnt;
   repeat
@@ -220,7 +219,7 @@
               begin
                 { if it's equal we can stop and take the last info }
                 if stabs[i].nvalue=addr then
-                 found:=true
+                 canreusestab:=true
                 else
                  linestab:=stabs[i];
               end;
@@ -261,7 +260,7 @@
        end;
      end;
     dec(stabsleft,stabscnt);
-  until found or (stabsleft=0);
+  until canreusestab or (stabsleft=0);
 
 { get the line,source,function info }
   line:=linestab.ndesc;
@@ -289,8 +288,8 @@
      if i>0 then
       Delete(func,i,255);
    end;
-
   GetLineInfo:=true;
+  if (func='') or (source='') then canreusestab:=false;
 end;
 
 
@@ -339,6 +338,7 @@
 initialization
   lastfilename := '';
   lastopenstabs := false;
+  canreusestab := false;
   BackTraceStrFunc:=@StabBackTraceStr;
 
 finalization

Denis Kozlov

2015-06-14 14:55

reporter   ~0084446

Last edited: 2015-06-14 14:56

View 2 revisions

This patch may not be the best solution as it works on the symptoms, rather than the cause.

Invalid memory address gets resolved into a correct "filename" but wrong "baseaddr", which then incorrectly adjusts "e.processaddress". These modifications are not controlled, so there is a chance that even invalid memory address may still result in some kind of bizarre debug info, and this patch will qualify it as valid and accept for reuse.

Could we verify somehow that "baseaddr" is valid? For example, if it is NIL (0), like when you supply invalid memory address, does that always imply an invalid address? Anybody with more knowledge in this area?

A cleaner solution could be to completely disable caching/reuse, which should prevent any kind of propagation of error.

Paul W

2015-10-25 22:05

reporter   ~0086871

I'm bumping this :) .
Baseaddr is base address, which can never be 0 except for drivers. So at least on Win32 it cannot be valid.
My suggestion would be to prevent caching if baseaddr is nil, since it should not happen under normal conditions.

Denis Kozlov

2016-01-09 12:28

reporter  

20160109-lineinfo.pp.patch (3,427 bytes)
Index: rtl/inc/lineinfo.pp
===================================================================
--- rtl/inc/lineinfo.pp	(revision 32893)
+++ rtl/inc/lineinfo.pp	(working copy)
@@ -17,6 +17,7 @@
   dependent on objpas unit.
 }
 unit lineinfo;
+
 interface
 
 {$S-}
@@ -23,7 +24,7 @@
 {$Q-}
 
 {$IF FPC_VERSION<3}
-Type 
+type
   CodePointer = Pointer;
 {$ENDIF}
 
@@ -31,6 +32,14 @@
 function StabBackTraceStr(addr:CodePointer):string;
 procedure CloseStabs;
 
+var
+  // Allows more efficient operation by reusing previously loaded debug data
+  // when the target module filename is the same. However, if an invalid memory
+  // address is supplied then further calls may result in an undefined behaviour.
+  // In summary: enable for speed, disable for resilience.
+  AllowReuseOfLineInfoData: Boolean = True;
+
+
 implementation
 
 uses
@@ -88,7 +97,7 @@
     baseaddr : pointer;
 begin
   // False by default
-  OpenStabs:=false;
+  Result:=false;
 
   // Empty so can test if GetModuleByAddr has worked
   filename := '';
@@ -104,9 +113,12 @@
     exit;
 
   // If target filename same as previous, then re-use previous result
-  if filename = lastfilename then
+  if AllowReuseOfLineInfoData and (filename = lastfilename) then
   begin
-    OpenStabs:=lastopenstabs;
+    {$ifdef DEBUG_LINEINFO}
+    writeln(stderr,'Reusing debug data');
+    {$endif DEBUG_LINEINFO}
+    Result:=lastopenstabs;
     exit;
   end;
 
@@ -142,13 +154,10 @@
     begin
       stabcnt:=stablen div sizeof(tstab);
       lastopenstabs:=true;
-      OpenStabs:=true;
+      Result:=true;
     end
   else
-    begin
-      CloseExeFile(e);
-      exit;
-    end;
+    CloseExeFile(e);
 end;
 
 
@@ -155,12 +164,10 @@
 procedure CloseStabs;
 begin
   if e.isopen then
-  begin
     CloseExeFile(e);
 
-    // Reset last processed filename
-    lastfilename := '';
-  end;
+  // Reset last processed filename
+  lastfilename := '';
 end;
 
 
@@ -172,7 +179,7 @@
   found : boolean;
   lastfunc : tstab;
 begin
-  GetLineInfo:=false;
+  Result:=false;
 {$ifdef DEBUG_LINEINFO}
   writeln(stderr,'GetLineInfo called');
 {$endif DEBUG_LINEINFO}
@@ -290,7 +297,10 @@
       Delete(func,i,255);
    end;
 
-  GetLineInfo:=true;
+  if not AllowReuseOfLineInfoData then
+    CloseStabs;
+
+  Result:=true;
 end;
 
 
@@ -315,23 +325,26 @@
 {$ifdef netware}
   { we need addr relative to code start on netware }
   dec(addr,ptruint(system.NWGetCodeStart));
-  StabBackTraceStr:='  CodeStart + $'+HexStr(ptruint(addr),sizeof(ptruint)*2);
+  Result:='  CodeStart + $'+HexStr(ptruint(addr),sizeof(ptruint)*2);
 {$else}
-  StabBackTraceStr:='  $'+HexStr(ptruint(addr),sizeof(ptruint)*2);
+  Result:='  $'+HexStr(ptruint(addr),sizeof(ptruint)*2);
 {$endif}
-  if func<>'' then
-    StabBackTraceStr:=StabBackTraceStr+'  '+func;
-  if source<>'' then
-   begin
-     if func<>'' then
-      StabBackTraceStr:=StabBackTraceStr+', ';
-     if line<>0 then
+  if Success then
+  begin
+    if func<>'' then
+      Result:=Result+'  '+func;
+    if source<>'' then
+    begin
+      if func<>'' then
+        Result:=Result+', ';
+      if line<>0 then
       begin
         str(line,hs);
-        StabBackTraceStr:=StabBackTraceStr+' line '+hs;
+        Result:=Result+' line '+hs;
       end;
-     StabBackTraceStr:=StabBackTraceStr+' of '+source;
-   end;
+      Result:=Result+' of '+source;
+    end;
+  end;
   BackTraceStrFunc:=Store;
 end;
 

Denis Kozlov

2016-01-09 12:29

reporter   ~0088737

Last edited: 2016-01-09 14:59

View 2 revisions

Attached patch fixes issues as discussed on the mailing list:
http://lists.freepascal.org/pipermail/fpc-devel/2016-January/036462.html

20160109-2-lineinfo.pp.patch [^] (2,582 bytes) 2016-01-09 13:58

Summary of changes:
1) Optional reuse of line info data via global AllowReuseOfLineInfoData variable.
2) Minor code clean up.

Denis Kozlov

2016-01-09 14:58

reporter  

20160109-2-lineinfo.pp.patch (2,582 bytes)
Index: rtl/inc/lineinfo.pp
===================================================================
--- rtl/inc/lineinfo.pp	(revision 32893)
+++ rtl/inc/lineinfo.pp	(working copy)
@@ -17,6 +17,7 @@
   dependent on objpas unit.
 }
 unit lineinfo;
+
 interface
 
 {$S-}
@@ -23,7 +24,7 @@
 {$Q-}
 
 {$IF FPC_VERSION<3}
-Type 
+type
   CodePointer = Pointer;
 {$ENDIF}
 
@@ -31,6 +32,14 @@
 function StabBackTraceStr(addr:CodePointer):string;
 procedure CloseStabs;
 
+var
+  // Allows more efficient operation by reusing previously loaded debug data
+  // when the target module filename is the same. However, if an invalid memory
+  // address is supplied then further calls may result in an undefined behaviour.
+  // In summary: enable for speed, disable for resilience.
+  AllowReuseOfLineInfoData: Boolean = True;
+
+
 implementation
 
 uses
@@ -104,8 +113,11 @@
     exit;
 
   // If target filename same as previous, then re-use previous result
-  if filename = lastfilename then
+  if AllowReuseOfLineInfoData and (filename = lastfilename) then
   begin
+    {$ifdef DEBUG_LINEINFO}
+    writeln(stderr,'Reusing debug data');
+    {$endif DEBUG_LINEINFO}
     OpenStabs:=lastopenstabs;
     exit;
   end;
@@ -145,10 +157,7 @@
       OpenStabs:=true;
     end
   else
-    begin
-      CloseExeFile(e);
-      exit;
-    end;
+    CloseExeFile(e);
 end;
 
 
@@ -155,12 +164,10 @@
 procedure CloseStabs;
 begin
   if e.isopen then
-  begin
     CloseExeFile(e);
 
-    // Reset last processed filename
-    lastfilename := '';
-  end;
+  // Reset last processed filename
+  lastfilename := '';
 end;
 
 
@@ -290,6 +297,9 @@
       Delete(func,i,255);
    end;
 
+  if not AllowReuseOfLineInfoData then
+    CloseStabs;
+
   GetLineInfo:=true;
 end;
 
@@ -319,19 +329,22 @@
 {$else}
   StabBackTraceStr:='  $'+HexStr(ptruint(addr),sizeof(ptruint)*2);
 {$endif}
-  if func<>'' then
-    StabBackTraceStr:=StabBackTraceStr+'  '+func;
-  if source<>'' then
-   begin
-     if func<>'' then
-      StabBackTraceStr:=StabBackTraceStr+', ';
-     if line<>0 then
+  if Success then
+  begin
+    if func<>'' then
+      StabBackTraceStr:=StabBackTraceStr+'  '+func;
+    if source<>'' then
+    begin
+      if func<>'' then
+        StabBackTraceStr:=StabBackTraceStr+', ';
+      if line<>0 then
       begin
         str(line,hs);
         StabBackTraceStr:=StabBackTraceStr+' line '+hs;
       end;
-     StabBackTraceStr:=StabBackTraceStr+' of '+source;
-   end;
+      StabBackTraceStr:=StabBackTraceStr+' of '+source;
+    end;
+  end;
   BackTraceStrFunc:=Store;
 end;
 

Michael Van Canneyt

2016-01-10 21:02

administrator   ~0088760

Applied the patch From Denis Kozlov. Thank you very much.

Issue History

Date Modified Username Field Change
2015-06-13 08:56 Andrey Zubarev New Issue
2015-06-13 08:59 Andrey Zubarev Note Added: 0084430
2015-06-13 14:24 Andrey Zubarev File Added: lineinfo.pp.patch
2015-06-13 14:29 Andrey Zubarev Note Added: 0084434
2015-06-13 23:11 Jonas Maebe Category - => RTL
2015-06-14 00:29 Denis Kozlov Note Added: 0084439
2015-06-14 00:30 Denis Kozlov Note Edited: 0084439 View Revisions
2015-06-14 00:54 Andrey Zubarev Note Added: 0084441
2015-06-14 12:27 Andrey Zubarev Note Added: 0084442
2015-06-14 12:27 Andrey Zubarev File Added: lineinfo.pp_reuse_if_last_founded.patch
2015-06-14 13:13 Denis Kozlov Note Added: 0084443
2015-06-14 13:14 Denis Kozlov Note Edited: 0084443 View Revisions
2015-06-14 14:01 Andrey Zubarev Note Added: 0084445
2015-06-14 14:02 Andrey Zubarev File Added: lineinfo.pp_reuse_if_last_founded2.patch
2015-06-14 14:55 Denis Kozlov Note Added: 0084446
2015-06-14 14:56 Denis Kozlov Note Edited: 0084446 View Revisions
2015-10-25 20:48 Jonas Maebe Relationship added has duplicate 0028907
2015-10-25 22:05 Paul W Note Added: 0086871
2016-01-09 12:28 Denis Kozlov File Added: 20160109-lineinfo.pp.patch
2016-01-09 12:29 Denis Kozlov Note Added: 0088737
2016-01-09 12:36 Denis Kozlov Tag Attached: patch
2016-01-09 14:58 Denis Kozlov File Added: 20160109-2-lineinfo.pp.patch
2016-01-09 14:59 Denis Kozlov Note Edited: 0088737 View Revisions
2016-01-10 21:02 Michael Van Canneyt Fixed in Revision => 32918
2016-01-10 21:02 Michael Van Canneyt Note Added: 0088760
2016-01-10 21:02 Michael Van Canneyt Status new => resolved
2016-01-10 21:02 Michael Van Canneyt Fixed in Version => 3.1.1
2016-01-10 21:02 Michael Van Canneyt Resolution open => fixed
2016-01-10 21:02 Michael Van Canneyt Assigned To => Michael Van Canneyt
2016-01-10 21:02 Michael Van Canneyt Target Version => 3.0.2
2016-09-19 10:19 Andrey Zubarev Status resolved => closed