paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-06 11:36:03 +02:00
Code Issues Packages Projects Releases Wiki Activity

* use new heaptrc version

Browse Source
This commit is contained in:
peter 2001-04-11 12:36:26 +00:00
parent d0d1b0a16a
commit de5140d1f7
1 changed files with 35 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

48
compiler/ppheap.pas
View File

@ -38,17 +38,34 @@ implementation
uses uses
globtype,globals,fmodule; globtype,globals,fmodule;
procedure ppextra_info(p : pointer); type
var pl : plongint; pextra_info = ^textra_info;
textra_info = record
line,
col,
fileindex : longint;
end;
procedure set_extra_info(p : pointer);
begin begin
longint(p^):=aktfilepos.line; with pextra_info(p)^ do
pl:=plongint(cardinal(p)+4); begin
pl^:=aktfilepos.column; line:=aktfilepos.line;
pl:=plongint(cardinal(p)+8); col:=aktfilepos.column;
if assigned(current_module) then if assigned(current_module) then
pl^:=current_module.unit_index*100000+aktfilepos.fileindex fileindex:=current_module.unit_index*100000+aktfilepos.fileindex
else else
pl^:=aktfilepos.fileindex fileindex:=aktfilepos.fileindex;
end;
end;
procedure show_extra_info(var t : text;p : pointer);
begin
with pextra_info(p)^ do
begin
writeln(t,'fileinfo: (',line,',',col,') ',fileindex);
end;
end; end;
const const
@ -58,8 +75,10 @@ implementation
begin begin
if not pp_heap_inited then if not pp_heap_inited then
begin begin
setheaptraceoutput('heap.log'); SetHeapTraceOutput('heap.log');
SetExtraInfo(12,{$ifdef FPCPROCVAR}@{$endif}ppextra_info); SetHeapExtraInfo(sizeof(textra_info),
{$ifdef FPCPROCVAR}@{$endif}set_extra_info,
{$ifdef FPCPROCVAR}@{$endif}show_extra_info);
end; end;
pp_heap_inited:=true; pp_heap_inited:=true;
end; end;
@ -70,7 +89,10 @@ begin
end. end.
{ {
$Log$ $Log$
Revision 1.5 2001-03-13 18:43:17 peter Revision 1.6 2001-04-11 12:36:26 peter
* use new heaptrc version
Revision 1.5 2001/03/13 18:43:17 peter
* made memdebug and heaptrc compilable again * made memdebug and heaptrc compilable again
Revision 1.4 2000/10/14 21:52:56 peter Revision 1.4 2000/10/14 21:52:56 peter