paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-22 16:09:17 +02:00
Code Issues Packages Projects Releases Wiki Activity

* bugfix of assigning to external filename output

Browse Source
This commit is contained in:
carl 2002-10-05 15:19:46 +00:00
parent d170f6625f
commit 302c977a8b
1 changed files with 21 additions and 14 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

35
rtl/inc/heaptrc.pp
View File

@ -88,6 +88,9 @@ const
display_extra_info_proc : TDisplayExtraInfoProc = nil; display_extra_info_proc : TDisplayExtraInfoProc = nil;
error_in_heap : boolean = false; error_in_heap : boolean = false;
inside_trace_getmem : boolean = false; inside_trace_getmem : boolean = false;
{ indicates where the output will be redirected }
{ only set using environment variables }
outputstr : shortstring = '';
type type
pheap_extra_info = ^theap_extra_info; pheap_extra_info = ^theap_extra_info;
@ -182,7 +185,7 @@ var
crc : longword; crc : longword;
pl : plongint; pl : plongint;
begin begin
crc:=longword($ffffffff); crc:=cardinal($ffffffff);
crc:=UpdateCrc32(crc,p^.size,sizeof(longint)); crc:=UpdateCrc32(crc,p^.size,sizeof(longint));
crc:=UpdateCrc32(crc,p^.calls,tracesize*sizeof(longint)); crc:=UpdateCrc32(crc,p^.calls,tracesize*sizeof(longint));
if p^.extra_info_size>0 then if p^.extra_info_size>0 then
@ -702,9 +705,9 @@ end;
{$ifdef go32v2} {$ifdef go32v2}
var var
__stklen : cardinal;external name '__stklen'; __stklen : longword;external name '__stklen';
__stkbottom : cardinal;external name '__stkbottom'; __stkbottom : longword;external name '__stkbottom';
edata : cardinal; external name 'edata'; edata : longword; external name 'edata';
heap_at_init : pointer; heap_at_init : pointer;
{$endif go32v2} {$endif go32v2}
@ -714,16 +717,16 @@ var
{ I found no symbol for start of text section :( { I found no symbol for start of text section :(
so we usee the _mainCRTStartup which should be so we usee the _mainCRTStartup which should be
in wprt0.ow or wdllprt0.ow PM } in wprt0.ow or wdllprt0.ow PM }
text_begin : cardinal;external name '_mainCRTStartup'; text_begin : longword;external name '_mainCRTStartup';
data_end : cardinal;external name '__data_end__'; data_end : longword;external name '__data_end__';
{$endif} {$endif}
procedure CheckPointer(p : pointer);[saveregisters,public, alias : 'FPC_CHECKPOINTER']; procedure CheckPointer(p : pointer);[saveregisters,public, alias : 'FPC_CHECKPOINTER'];
var var
i : longint; i : longint;
pp : pheap_mem_info; pp : pheap_mem_info;
get_ebp,stack_top : cardinal; get_ebp,stack_top : longword;
data_end : cardinal; data_end : longword;
label label
_exit; _exit;
begin begin
@ -999,6 +1002,8 @@ begin
MakeCRC32Tbl; MakeCRC32Tbl;
SetMemoryManager(TraceManager); SetMemoryManager(TraceManager);
ptext:=@stderr; ptext:=@stderr;
if outputstr <> '' then
SetHeapTraceOutput(outputstr);
{$ifdef EXTRA} {$ifdef EXTRA}
Assign(error_file,'heap.err'); Assign(error_file,'heap.err');
Rewrite(error_file); Rewrite(error_file);
@ -1124,12 +1129,11 @@ begin
i:=pos('log=',s); i:=pos('log=',s);
if i>0 then if i>0 then
begin begin
hs:=copy(s,i+4,255); outputstr:=copy(s,i+4,255);
j:=pos(' ',hs); j:=pos(' ',outputstr);
if j=0 then if j=0 then
j:=length(hs)+1; j:=length(outputstr)+1;
delete(hs,j,255); delete(outputstr,j,255);
SetHeapTraceOutput(hs);
end; end;
end; end;
@ -1145,7 +1149,10 @@ finalization
end. end.
{ {
$Log$ $Log$
Revision 1.18 2002-09-09 15:45:49 jonas Revision 1.19 2002-10-05 15:19:46 carl
* bugfix of assigning to external filename output
Revision 1.18 2002/09/09 15:45:49 jonas
* made result type of calculate_release_sig() a longword instead of a * made result type of calculate_release_sig() a longword instead of a
longint longint