1 | {
|
---|
2 | This file is part of the Free Pascal run time library.
|
---|
3 | Copyright (c) 2000 by Peter Vreman
|
---|
4 |
|
---|
5 | Stabs Line Info Retriever
|
---|
6 |
|
---|
7 | See the file COPYING.FPC, included in this distribution,
|
---|
8 | for details about the copyright.
|
---|
9 |
|
---|
10 | This program is distributed in the hope that it will be useful,
|
---|
11 | but WITHOUT ANY WARRANTY; without even the implied warranty of
|
---|
12 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
|
---|
13 |
|
---|
14 | **********************************************************************}
|
---|
15 | {
|
---|
16 | This unit should not be compiled in objfpc mode, since this would make it
|
---|
17 | dependent on objpas unit.
|
---|
18 | }
|
---|
19 | unit CustomLineInfo;
|
---|
20 | interface
|
---|
21 |
|
---|
22 | {$S-}
|
---|
23 | {$Q-}
|
---|
24 |
|
---|
25 | function GetLineInfo(addr:ptruint;var func,source:shortstring;var line:longint) : boolean;
|
---|
26 | function StabBackTraceStr(addr:Pointer):shortstring;
|
---|
27 |
|
---|
28 | implementation
|
---|
29 |
|
---|
30 | uses
|
---|
31 | exeinfo,strings;
|
---|
32 |
|
---|
33 | const
|
---|
34 | N_Function = $24;
|
---|
35 | N_TextLine = $44;
|
---|
36 | N_DataLine = $46;
|
---|
37 | N_BssLine = $48;
|
---|
38 | N_SourceFile = $64;
|
---|
39 | N_IncludeFile = $84;
|
---|
40 |
|
---|
41 | maxstabs = 40; { size of the stabs buffer }
|
---|
42 |
|
---|
43 | var
|
---|
44 | { GDB after 4.18 uses offset to function begin
|
---|
45 | in text section but OS/2 version still uses 4.16 PM }
|
---|
46 | StabsFunctionRelative: boolean;
|
---|
47 |
|
---|
48 | type
|
---|
49 | pstab=^tstab;
|
---|
50 | tstab=packed record
|
---|
51 | strpos : longint;
|
---|
52 | ntype : byte;
|
---|
53 | nother : byte;
|
---|
54 | ndesc : word;
|
---|
55 | nvalue : dword;
|
---|
56 | end;
|
---|
57 |
|
---|
58 | { We use static variable so almost no stack is required, and is thus
|
---|
59 | more safe when an error has occured in the program }
|
---|
60 | var
|
---|
61 | e : TExeFile;
|
---|
62 | stabcnt, { amount of stabs }
|
---|
63 | stablen,
|
---|
64 | stabofs, { absolute stab section offset in executable }
|
---|
65 | stabstrlen,
|
---|
66 | stabstrofs : longint; { absolute stabstr section offset in executable }
|
---|
67 | dirlength : longint; { length of the dirctory part of the source file }
|
---|
68 | stabs : array[0..maxstabs-1] of tstab; { buffer }
|
---|
69 | funcstab, { stab with current function info }
|
---|
70 | linestab, { stab with current line info }
|
---|
71 | dirstab, { stab with current directory info }
|
---|
72 | filestab : tstab; { stab with current file info }
|
---|
73 | filename: shortstring;
|
---|
74 | dbgfn : string;
|
---|
75 |
|
---|
76 |
|
---|
77 | var
|
---|
78 | Crc32Tbl : array[0..255] of cardinal;
|
---|
79 |
|
---|
80 | procedure MakeCRC32Tbl;
|
---|
81 | var
|
---|
82 | crc : cardinal;
|
---|
83 | i,n : integer;
|
---|
84 | begin
|
---|
85 | for i:=0 to 255 do
|
---|
86 | begin
|
---|
87 | crc:=i;
|
---|
88 | for n:=1 to 8 do
|
---|
89 | if (crc and 1)<>0 then
|
---|
90 | crc:=(crc shr 1) xor cardinal($edb88320)
|
---|
91 | else
|
---|
92 | crc:=crc shr 1;
|
---|
93 | Crc32Tbl[i]:=crc;
|
---|
94 | end;
|
---|
95 | end;
|
---|
96 |
|
---|
97 | Function UpdateCrc32(InitCrc:cardinal;const InBuf;InLen:LongInt):cardinal;
|
---|
98 | var
|
---|
99 | i : LongInt;
|
---|
100 | p : pchar;
|
---|
101 | begin
|
---|
102 | if Crc32Tbl[1]=0 then
|
---|
103 | MakeCrc32Tbl;
|
---|
104 | p:=@InBuf;
|
---|
105 | Result:=not InitCrc;
|
---|
106 | for i:=1 to InLen do
|
---|
107 | begin
|
---|
108 | UpdateCrc32:=Crc32Tbl[byte(Result) xor byte(p^)] xor (Result shr 8);
|
---|
109 | inc(p);
|
---|
110 | end;
|
---|
111 | Result:=not Result;
|
---|
112 | end;
|
---|
113 |
|
---|
114 | function CheckDbgFile(var e:TExeFile;const fn:string;dbgcrc:cardinal):boolean;
|
---|
115 | var
|
---|
116 | c : cardinal;
|
---|
117 | ofm : word;
|
---|
118 | g : file;
|
---|
119 | begin
|
---|
120 | CheckDbgFile:=false;
|
---|
121 | assign(g,fn);
|
---|
122 | {$I-}
|
---|
123 | ofm:=filemode;
|
---|
124 | filemode:=$40;
|
---|
125 | reset(g,1);
|
---|
126 | filemode:=ofm;
|
---|
127 | {$I+}
|
---|
128 | if ioresult<>0 then
|
---|
129 | exit;
|
---|
130 | { We reuse the buffer from e here to prevent too much stack allocation }
|
---|
131 | c:=0;
|
---|
132 | repeat
|
---|
133 | blockread(g,e.buf,e.bufsize,e.bufcnt);
|
---|
134 | c:=UpdateCrc32(c,e.buf,e.bufcnt);
|
---|
135 | until e.bufcnt<e.bufsize;
|
---|
136 | close(g);
|
---|
137 | CheckDbgFile:=(dbgcrc=c);
|
---|
138 | end;
|
---|
139 |
|
---|
140 | function ReadDebugLink(var e:TExeFile;var dbgfn:string):boolean;
|
---|
141 | var
|
---|
142 | dbglink : array[0..512] of char;
|
---|
143 | i,
|
---|
144 | dbglinklen,
|
---|
145 | dbglinkofs : longint;
|
---|
146 | dbgcrc : cardinal;
|
---|
147 | begin
|
---|
148 | ReadDebugLink:=false;
|
---|
149 | if not FindExeSection(e,'.gnu_debuglink',dbglinkofs,dbglinklen) then
|
---|
150 | exit;
|
---|
151 | if dbglinklen>sizeof(dbglink)-1 then
|
---|
152 | exit;
|
---|
153 | fillchar(dbglink,sizeof(dbglink),0);
|
---|
154 | seek(e.f,dbglinkofs);
|
---|
155 | blockread(e.f,dbglink,dbglinklen);
|
---|
156 | dbgfn:=strpas(dbglink);
|
---|
157 | if length(dbgfn)=0 then
|
---|
158 | exit;
|
---|
159 | i:=align(length(dbgfn)+1,4);
|
---|
160 | if (i+4)>dbglinklen then
|
---|
161 | exit;
|
---|
162 | move(dbglink[i],dbgcrc,4);
|
---|
163 | { current dir }
|
---|
164 | if CheckDbgFile(e,dbgfn,dbgcrc) then
|
---|
165 | begin
|
---|
166 | ReadDebugLink:=true;
|
---|
167 | exit;
|
---|
168 | end;
|
---|
169 | { executable dir }
|
---|
170 | i:=length(e.filename);
|
---|
171 | while (i>0) and not(e.filename[i] in AllowDirectorySeparators) do
|
---|
172 | dec(i);
|
---|
173 | if i>0 then
|
---|
174 | begin
|
---|
175 | dbgfn:=copy(e.filename,1,i)+dbgfn;
|
---|
176 | if CheckDbgFile(e,dbgfn,dbgcrc) then
|
---|
177 | begin
|
---|
178 | ReadDebugLink:=true;
|
---|
179 | exit;
|
---|
180 | end;
|
---|
181 | end;
|
---|
182 | end;
|
---|
183 |
|
---|
184 | function OpenStabs(addr : pointer) : boolean;
|
---|
185 | var
|
---|
186 | baseaddr : pointer;
|
---|
187 | begin
|
---|
188 | OpenStabs:=false;
|
---|
189 |
|
---|
190 | GetModuleByAddr(addr,baseaddr,filename);
|
---|
191 | {$ifdef DEBUG_LINEINFO}
|
---|
192 | writeln(stderr,filename,' Baseaddr: ',hexstr(ptruint(baseaddr),sizeof(baseaddr)*2));
|
---|
193 | {$endif DEBUG_LINEINFO}
|
---|
194 |
|
---|
195 | if not OpenExeFile(e,filename) then
|
---|
196 | exit;
|
---|
197 | if ReadDebugLink(e,dbgfn) then
|
---|
198 | begin
|
---|
199 | CloseExeFile(e);
|
---|
200 | if not OpenExeFile(e,dbgfn) then
|
---|
201 | exit;
|
---|
202 | end;
|
---|
203 | if ptruint(BaseAddr) < e.processaddress then Exit;
|
---|
204 |
|
---|
205 | e.processaddress := ptruint(baseaddr) - e.processaddress;
|
---|
206 | StabsFunctionRelative := E.FunctionRelative;
|
---|
207 | if FindExeSection(e,'.stab',stabofs,stablen) and
|
---|
208 | FindExeSection(e,'.stabstr',stabstrofs,stabstrlen) then
|
---|
209 | begin
|
---|
210 | stabcnt:=stablen div sizeof(tstab);
|
---|
211 | OpenStabs:=true;
|
---|
212 | end
|
---|
213 | else
|
---|
214 | begin
|
---|
215 | CloseExeFile(e);
|
---|
216 | exit;
|
---|
217 | end;
|
---|
218 | end;
|
---|
219 |
|
---|
220 | procedure CloseStabs;
|
---|
221 | begin
|
---|
222 | CloseExeFile(e);
|
---|
223 | end;
|
---|
224 |
|
---|
225 | function GetLineInfo(addr:ptruint;var func,source:shortstring;var line:longint) : boolean;
|
---|
226 | var
|
---|
227 | res,
|
---|
228 | stabsleft,
|
---|
229 | stabscnt,i : longint;
|
---|
230 | found : boolean;
|
---|
231 | lastfunc : tstab;
|
---|
232 | begin
|
---|
233 | GetLineInfo:=false;
|
---|
234 | {$ifdef DEBUG_LINEINFO}
|
---|
235 | writeln(stderr,'GetLineInfo called');
|
---|
236 | {$endif DEBUG_LINEINFO}
|
---|
237 | fillchar(func,high(func)+1,0);
|
---|
238 | fillchar(source,high(source)+1,0);
|
---|
239 | line:=0;
|
---|
240 | if not e.isopen then
|
---|
241 | begin
|
---|
242 | if not OpenStabs(pointer(addr)) then
|
---|
243 | exit;
|
---|
244 | end;
|
---|
245 |
|
---|
246 | { correct the value to the correct address in the file }
|
---|
247 | { processaddress is set in OpenStabs }
|
---|
248 | addr := dword(addr - e.processaddress);
|
---|
249 |
|
---|
250 | {$ifdef DEBUG_LINEINFO}
|
---|
251 | writeln(stderr,'Addr: ',hexstr(addr,sizeof(addr)*2));
|
---|
252 | {$endif DEBUG_LINEINFO}
|
---|
253 |
|
---|
254 | fillchar(funcstab,sizeof(tstab),0);
|
---|
255 | fillchar(filestab,sizeof(tstab),0);
|
---|
256 | fillchar(dirstab,sizeof(tstab),0);
|
---|
257 | fillchar(linestab,sizeof(tstab),0);
|
---|
258 | fillchar(lastfunc,sizeof(tstab),0);
|
---|
259 | found:=false;
|
---|
260 | seek(e.f,stabofs);
|
---|
261 | stabsleft:=stabcnt;
|
---|
262 | repeat
|
---|
263 | if stabsleft>maxstabs then
|
---|
264 | stabscnt:=maxstabs
|
---|
265 | else
|
---|
266 | stabscnt:=stabsleft;
|
---|
267 | blockread(e.f,stabs,stabscnt*sizeof(tstab),res);
|
---|
268 | stabscnt:=res div sizeof(tstab);
|
---|
269 | for i:=0 to stabscnt-1 do
|
---|
270 | begin
|
---|
271 | case stabs[i].ntype of
|
---|
272 | N_BssLine,
|
---|
273 | N_DataLine,
|
---|
274 | N_TextLine :
|
---|
275 | begin
|
---|
276 | if (stabs[i].ntype=N_TextLine) and StabsFunctionRelative then
|
---|
277 | inc(stabs[i].nvalue,lastfunc.nvalue);
|
---|
278 | if (stabs[i].nvalue<=addr) and
|
---|
279 | (stabs[i].nvalue>linestab.nvalue) then
|
---|
280 | begin
|
---|
281 | { if it's equal we can stop and take the last info }
|
---|
282 | if stabs[i].nvalue=addr then
|
---|
283 | found:=true
|
---|
284 | else
|
---|
285 | linestab:=stabs[i];
|
---|
286 | end;
|
---|
287 | end;
|
---|
288 | N_Function :
|
---|
289 | begin
|
---|
290 | lastfunc:=stabs[i];
|
---|
291 | if (stabs[i].nvalue<=addr) and
|
---|
292 | (stabs[i].nvalue>funcstab.nvalue) then
|
---|
293 | begin
|
---|
294 | funcstab:=stabs[i];
|
---|
295 | fillchar(linestab,sizeof(tstab),0);
|
---|
296 | end;
|
---|
297 | end;
|
---|
298 | N_SourceFile,
|
---|
299 | N_IncludeFile :
|
---|
300 | begin
|
---|
301 | if (stabs[i].nvalue<=addr) and
|
---|
302 | (stabs[i].nvalue>=filestab.nvalue) then
|
---|
303 | begin
|
---|
304 | { if same value and type then the first one
|
---|
305 | contained the directory PM }
|
---|
306 | if (stabs[i].nvalue=filestab.nvalue) and
|
---|
307 | (stabs[i].ntype=filestab.ntype) then
|
---|
308 | dirstab:=filestab
|
---|
309 | else
|
---|
310 | fillchar(dirstab,sizeof(tstab),0);
|
---|
311 | filestab:=stabs[i];
|
---|
312 | fillchar(linestab,sizeof(tstab),0);
|
---|
313 | { if new file then func is not valid anymore PM }
|
---|
314 | if stabs[i].ntype=N_SourceFile then
|
---|
315 | begin
|
---|
316 | fillchar(funcstab,sizeof(tstab),0);
|
---|
317 | fillchar(lastfunc,sizeof(tstab),0);
|
---|
318 | end;
|
---|
319 | end;
|
---|
320 | end;
|
---|
321 | end;
|
---|
322 | end;
|
---|
323 | dec(stabsleft,stabscnt);
|
---|
324 | until found or (stabsleft=0);
|
---|
325 |
|
---|
326 | { get the line,source,function info }
|
---|
327 | line:=linestab.ndesc;
|
---|
328 | if dirstab.ntype<>0 then
|
---|
329 | begin
|
---|
330 | seek(e.f,stabstrofs+dirstab.strpos);
|
---|
331 | blockread(e.f,source[1],high(source)-1,res);
|
---|
332 | dirlength:=strlen(@source[1]);
|
---|
333 | source[0]:=chr(dirlength);
|
---|
334 | end
|
---|
335 | else
|
---|
336 | dirlength:=0;
|
---|
337 | if filestab.ntype<>0 then
|
---|
338 | begin
|
---|
339 | seek(e.f,stabstrofs+filestab.strpos);
|
---|
340 | blockread(e.f,source[dirlength+1],high(source)-(dirlength+1),res);
|
---|
341 | source[0]:=chr(strlen(@source[1]));
|
---|
342 | end;
|
---|
343 | if funcstab.ntype<>0 then
|
---|
344 | begin
|
---|
345 | seek(e.f,stabstrofs+funcstab.strpos);
|
---|
346 | blockread(e.f,func[1],high(func)-1,res);
|
---|
347 | func[0]:=chr(strlen(@func[1]));
|
---|
348 | i:=pos(':',func);
|
---|
349 | if i>0 then
|
---|
350 | Delete(func,i,255);
|
---|
351 | end;
|
---|
352 | // if e.isopen then
|
---|
353 | // CloseStabs;
|
---|
354 | GetLineInfo:=true;
|
---|
355 | end;
|
---|
356 |
|
---|
357 | function StabBackTraceStr(addr:Pointer):shortstring;
|
---|
358 | var
|
---|
359 | func,
|
---|
360 | source : shortstring;
|
---|
361 | hs : string[32];
|
---|
362 | line : longint;
|
---|
363 | Store : TBackTraceStrFunc;
|
---|
364 | Success : boolean;
|
---|
365 | begin
|
---|
366 | {$ifdef DEBUG_LINEINFO}
|
---|
367 | writeln(stderr,'StabBackTraceStr called');
|
---|
368 | {$endif DEBUG_LINEINFO}
|
---|
369 | { reset to prevent infinite recursion if problems inside the code PM }
|
---|
370 | Success:=false;
|
---|
371 | Store:=BackTraceStrFunc;
|
---|
372 | BackTraceStrFunc:=@SysBackTraceStr;
|
---|
373 | Success:=GetLineInfo(ptruint(addr),func,source,line);
|
---|
374 | { create string }
|
---|
375 | {$ifdef netware}
|
---|
376 | { we need addr relative to code start on netware }
|
---|
377 | dec(addr,ptruint(system.NWGetCodeStart));
|
---|
378 | StabBackTraceStr:=' CodeStart + $'+HexStr(ptruint(addr),sizeof(ptruint)*2);
|
---|
379 | {$else}
|
---|
380 | StabBackTraceStr:=' $'+HexStr(ptruint(addr),sizeof(ptruint)*2);
|
---|
381 | {$endif}
|
---|
382 | if func<>'' then
|
---|
383 | Result := Result +' '+func;
|
---|
384 | if source<>'' then
|
---|
385 | begin
|
---|
386 | if func<>'' then
|
---|
387 | Result := Result + ', ';
|
---|
388 | if line<>0 then
|
---|
389 | begin
|
---|
390 | str(line,hs);
|
---|
391 | Result := Result + ' line ' + hs;
|
---|
392 | end;
|
---|
393 | Result := Result + ' of ' + source;
|
---|
394 | end;
|
---|
395 | if Success then
|
---|
396 | BackTraceStrFunc:=Store;
|
---|
397 | end;
|
---|
398 |
|
---|
399 | initialization
|
---|
400 | BackTraceStrFunc := @StabBackTraceStr;
|
---|
401 |
|
---|
402 | finalization
|
---|
403 | if e.isopen then
|
---|
404 | CloseStabs;
|
---|
405 | end.
|
---|