paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-17 13:39:36 +02:00
Code Issues Packages Projects Releases Wiki Activity

* memdebug enhancements

Browse Source
This commit is contained in:
peter 2002-09-05 19:29:42 +00:00
parent 8b5e92cb3c
commit 20af604613
10 changed files with 188 additions and 38 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
compiler/assemble.pas
View File

@ -602,13 +602,13 @@ Implementation
{$endif}
begin
{$ifdef MEMDEBUG}
d := tmemdebug.create('agbin');
d := tmemdebug.create(name+' - agbin');
{$endif}
objectdata.free;
objectoutput.free;
objectalloc.free;
{$ifdef MEMDEBUG}
d.free;
d.free;
{$endif}
end;
@ -1608,7 +1608,10 @@ Implementation
end.
{
$Log$
Revision 1.43 2002-08-20 16:55:38 peter
Revision 1.44 2002-09-05 19:29:42 peter
* memdebug enhancements
Revision 1.43 2002/08/20 16:55:38 peter
* don't write (stabs)line info when inlining a procedure
Revision 1.42 2002/08/12 15:08:39 carl

37
compiler/cclasses.pas
View File

@ -36,12 +36,15 @@ interface
type
tmemdebug = class
private
totalmem,
startmem : integer;
infostr : string[40];
public
constructor Create(const s:string);
destructor Destroy;override;
procedure show;
procedure start;
procedure stop;
end;
{********************************************
@ -293,6 +296,13 @@ implementation
constructor tmemdebug.create(const s:string);
begin
infostr:=s;
totalmem:=0;
Start;
end;
procedure tmemdebug.start;
begin
{$ifdef Delphi}
startmem:=0;
{$else}
@ -301,25 +311,31 @@ implementation
end;
procedure tmemdebug.stop;
begin
if startmem<>0 then
begin
inc(TotalMem,memavail-startmem);
startmem:=0;
end;
end;
destructor tmemdebug.destroy;
begin
Stop;
show;
end;
procedure tmemdebug.show;
{$ifndef Delphi}
var
l : integer;
{$endif}
begin
{$ifndef Delphi}
write('memory [',infostr,'] ');
l:=memavail;
if l>startmem then
writeln(l-startmem,' released')
if TotalMem>0 then
writeln(DStr(TotalMem shr 10),' Kb released')
else
writeln(startmem-l,' allocated');
writeln(DStr((-TotalMem) shr 10),' Kb allocated');
{$endif Delphi}
end;
@ -1735,7 +1751,10 @@ end;
end.
{
$Log$
Revision 1.17 2002-08-11 13:24:11 peter
Revision 1.18 2002-09-05 19:29:42 peter
* memdebug enhancements
Revision 1.17 2002/08/11 13:24:11 peter
* saving of asmsymbols in ppu supported
* asmsymbollist global is removed and moved into a new class
tasmlibrarydata that will hold the info of a .a file which

7
compiler/cgbase.pas
View File

@ -520,7 +520,7 @@ implementation
{$endif}
begin
{$ifdef MEMDEBUG}
d:=tmemdebug.create('asmlist');
d:=tmemdebug.create(current_module.modulename^+' - asmlists');
{$endif}
exprasmlist.free;
codesegment.free;
@ -655,7 +655,10 @@ begin
end.
{
$Log$
Revision 1.26 2002-08-18 20:06:23 peter
Revision 1.27 2002-09-05 19:29:42 peter
* memdebug enhancements
Revision 1.26 2002/08/18 20:06:23 peter
* inlining is now also allowed in interface
* renamed write/load to ppuwrite/ppuload
* tnode storing in ppu

14
compiler/comphook.pas
View File

@ -143,10 +143,11 @@ implementation
uses
{$ifdef delphi}
dmisc
dmisc,
{$else}
dos
dos,
{$endif}
cutils
;
{****************************************************************************
@ -217,10 +218,10 @@ begin
{$endif Delphi}
if (status.currentline>0) and (status.currentline mod 100=0) then
{$ifdef FPC}
WriteLn(status.currentline,' ',memavail shr 10,'/',system.heapsize shr 10,' Kb Free');
WriteLn(status.currentline,' ',DStr(memavail shr 10),'/',DStr(system.heapsize shr 10),' Kb Free');
{$else}
{$ifndef Delphi}
WriteLn(status.currentline,' ',memavail shr 10,' Kb Free');
WriteLn(status.currentline,' ',DStr(memavail shr 10),' Kb Free');
{$endif Delphi}
{$endif}
end
@ -355,7 +356,10 @@ end;
end.
{
$Log$
Revision 1.19 2002-05-18 13:34:06 peter
Revision 1.20 2002-09-05 19:29:42 peter
* memdebug enhancements
Revision 1.19 2002/05/18 13:34:06 peter
* readded missing revisions
Revision 1.18 2002/05/16 19:46:35 carl

23
compiler/cutils.pas
View File

@ -67,6 +67,7 @@ interface
function tostr(i : longint) : string;
function int64tostr(i : int64) : string;
function tostr_with_plus(i : longint) : string;
function DStr(l:longint):string;
procedure valint(S : string;var V : longint;var code : integer);
{# Returns true if the string s is a number }
function is_number(const s : string) : boolean;
@ -374,6 +375,23 @@ uses
end;
function DStr(l:longint):string;
var
TmpStr : string[32];
i : longint;
begin
Str(l,TmpStr);
i:=Length(TmpStr);
while (i>3) do
begin
dec(i,3);
if TmpStr[i]<>'-' then
insert('.',TmpStr,i+1);
end;
DStr:=TmpStr;
end;
function trimbspace(const s:string):string;
{
return s with all leading spaces and tabs removed
@ -803,7 +821,10 @@ initialization
end.
{
$Log$
Revision 1.21 2002-07-26 11:16:35 jonas
Revision 1.22 2002-09-05 19:29:42 peter
* memdebug enhancements
Revision 1.21 2002/07/26 11:16:35 jonas
* fixed (actual and potential) range errors
Revision 1.20 2002/07/07 11:13:34 carl

11
compiler/fmodule.pas
View File

@ -455,7 +455,6 @@ uses
stringdispose(exefilename);
stringdispose(outputpath);
stringdispose(path);
stringdispose(modulename);
stringdispose(realmodulename);
stringdispose(mainsource);
stringdispose(asmprefix);
@ -464,7 +463,7 @@ uses
localincludesearchpath.free;
locallibrarysearchpath.free;
{$ifdef MEMDEBUG}
d:=tmemdebug.create('symtable');
d:=tmemdebug.create(modulename^+' - symtable');
{$endif}
if assigned(globalsymtable) then
globalsymtable.free;
@ -474,12 +473,13 @@ uses
d.free;
{$endif}
{$ifdef MEMDEBUG}
d:=tmemdebug.create('librarydata');
d:=tmemdebug.create(modulename^+' - librarydata');
{$endif}
librarydata.free;
{$ifdef MEMDEBUG}
d.free;
{$endif}
stringdispose(modulename);
inherited Destroy;
end;
@ -603,7 +603,10 @@ uses
end.
{
$Log$
Revision 1.27 2002-08-16 15:31:08 peter
Revision 1.28 2002-09-05 19:29:42 peter
* memdebug enhancements
Revision 1.27 2002/08/16 15:31:08 peter
* fixed possible crashes with current_scanner
Revision 1.26 2002/08/12 16:46:04 peter

49
compiler/symdef.pas
View File

@ -821,10 +821,6 @@ implementation
fillchar(localrttilab,sizeof(localrttilab),0);
end;
{$ifdef MEMDEBUG}
var
manglenamesize : longint;
{$endif}
constructor tstoreddef.ppuloaddef(ppufile:tcompilerppufile);
begin
@ -3441,17 +3437,49 @@ implementation
end;
aliasnames.free;
if assigned(parast) then
parast.free;
begin
{$ifdef MEMDEBUG}
memprocparast.start;
{$endif MEMDEBUG}
parast.free;
{$ifdef MEMDEBUG}
memprocparast.stop;
{$endif MEMDEBUG}
end;
if assigned(localst) and (localst.symtabletype<>staticsymtable) then
localst.free;
begin
{$ifdef MEMDEBUG}
memproclocalst.start;
{$endif MEMDEBUG}
localst.free;
{$ifdef MEMDEBUG}
memproclocalst.start;
{$endif MEMDEBUG}
end;
if (proccalloption=pocall_inline) and assigned(code) then
tnode(code).free;
begin
{$ifdef MEMDEBUG}
memprocnodetree.start;
{$endif MEMDEBUG}
tnode(code).free;
{$ifdef MEMDEBUG}
memprocnodetree.start;
{$endif MEMDEBUG}
end;
if assigned(regvarinfo) then
dispose(pregvarinfo(regvarinfo));
if (po_msgstr in procoptions) then
strdispose(messageinf.str);
if assigned(_mangledname) then
stringdispose(_mangledname);
begin
{$ifdef MEMDEBUG}
memmanglednames.start;
{$endif MEMDEBUG}
stringdispose(_mangledname);
{$ifdef MEMDEBUG}
memmanglednames.stop;
{$endif MEMDEBUG}
end;
inherited destroy;
end;
@ -5509,7 +5537,10 @@ implementation
end.
{
$Log$
Revision 1.91 2002-08-25 19:25:20 peter
Revision 1.92 2002-09-05 19:29:42 peter
* memdebug enhancements
Revision 1.91 2002/08/25 19:25:20 peter
* sym.insert_in_data removed
* symtable.insertvardata/insertconstdata added
* removed insert_in_data call from symtable.insert, it needs to be

21
compiler/symsym.pas
View File

@ -527,11 +527,25 @@ implementation
destructor tstoredsym.destroy;
begin
if assigned(_mangledname) then
stringdispose(_mangledname);
begin
{$ifdef MEMDEBUG}
memmanglednames.start;
{$endif MEMDEBUG}
stringdispose(_mangledname);
{$ifdef MEMDEBUG}
memmanglednames.stop;
{$endif MEMDEBUG}
end;
if assigned(defref) then
begin
{$ifdef MEMDEBUG}
membrowser.start;
{$endif MEMDEBUG}
defref.freechain;
defref.free;
{$ifdef MEMDEBUG}
membrowser.stop;
{$endif MEMDEBUG}
end;
inherited destroy;
end;
@ -2482,7 +2496,10 @@ implementation
end.
{
$Log$
Revision 1.60 2002-09-05 14:51:42 peter
Revision 1.61 2002-09-05 19:29:45 peter
* memdebug enhancements
Revision 1.60 2002/09/05 14:51:42 peter
* internalerror instead of crash in getprocdef
Revision 1.59 2002/09/03 16:26:27 daniel

7
compiler/symtable.pas
View File

@ -1048,7 +1048,7 @@ implementation
else if (varalign>1) and (dataalignment<2) then
dataalignment:=2;
end;
dataalignment:=max(dataalignment,aktalignment.maxCrecordalign);
dataalignment:=min(dataalignment,aktalignment.maxCrecordalign);
end
else
varalign:=vardef.alignment;
@ -2299,7 +2299,10 @@ implementation
end.
{
$Log$
Revision 1.69 2002-08-25 19:25:21 peter
Revision 1.70 2002-09-05 19:29:45 peter
* memdebug enhancements
Revision 1.69 2002/08/25 19:25:21 peter
* sym.insert_in_data removed
* symtable.insertvardata/insertconstdata added
* removed insert_in_data call from symtable.insert, it needs to be

48
compiler/symtype.pas
View File

@ -27,6 +27,9 @@ interface
uses
{ common }
cutils,
{$ifdef MEMDEBUG}
cclasses,
{$endif MEMDEBUG}
{ global }
globtype,globals,
{ symtable }
@ -140,6 +143,16 @@ interface
procedure resolvesym(var sym:pointer);
procedure resolvedef(var def:pointer);
{$ifdef MEMDEBUG}
var
membrowser,
memrealnames,
memmanglednames,
memprocparast,
memproclocalst,
memprocnodetree : tmemdebug;
{$endif MEMDEBUG}
implementation
@ -212,7 +225,13 @@ implementation
destructor tsym.destroy;
begin
{$ifdef MEMDEBUG}
memrealnames.start;
{$endif MEMDEBUG}
stringdispose(_realname);
{$ifdef MEMDEBUG}
memrealnames.stop;
{$endif MEMDEBUG}
inherited destroy;
end;
@ -525,10 +544,37 @@ implementation
sym:=nil;
end;
{$ifdef MEMDEBUG}
initialization
membrowser:=TMemDebug.create('BrowserRefs');
membrowser.stop;
memrealnames:=TMemDebug.create('Realnames');
memrealnames.stop;
memmanglednames:=TMemDebug.create('Manglednames');
memmanglednames.stop;
memprocparast:=TMemDebug.create('ProcParaSt');
memprocparast.stop;
memproclocalst:=TMemDebug.create('ProcLocalSt');
memproclocalst.stop;
memprocnodetree:=TMemDebug.create('ProcNodeTree');
memprocnodetree.stop;
finalization
membrowser.free;
memrealnames.free;
memmanglednames.free;
memprocparast.free;
memproclocalst.free;
memprocnodetree.free;
{$endif MEMDEBUG}
end.
{
$Log$
Revision 1.21 2002-08-18 20:06:28 peter
Revision 1.22 2002-09-05 19:29:46 peter
* memdebug enhancements
Revision 1.21 2002/08/18 20:06:28 peter
* inlining is now also allowed in interface
* renamed write/load to ppuwrite/ppuload
* tnode storing in ppu