paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-14 10:20:21 +02:00
Code Issues Packages Projects Releases Wiki Activity

* current_module old scanner tagged as invalid if unit is recompiled

Browse Source 
+ added ppheap for better info on tracegetmem of heaptrc
    (adds line column and file index)
  * several memory leaks removed ith help of heaptrc !!
This commit is contained in:
pierre 1998-10-08 17:17:07 +00:00
parent 64b0e99cc9
commit bf6369f1b5
20 changed files with 450 additions and 66 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
compiler/aasm.pas
View File

@ -602,7 +602,8 @@ uses
destructor tai_label.done;
begin
if (l^.is_used) then
if (l^.refcount>0) then
{ can now be disposed by a tai_labeled instruction !! }
l^.is_set:=false
else
dispose(l);
@ -795,8 +796,10 @@ uses
lab2str:=target_asm.labelprefix+tostr(l^.nb);
end;
{ inside the WriteTree we must not count the refs PM }
{$ifndef HEAPTRC}
if countlabelref then
inc(l^.refcount);
{$endif HEAPTRC}
l^.is_used:=true;
end;
@ -875,7 +878,13 @@ uses
end.
{
$Log$
Revision 1.20 1998-10-06 17:16:31 pierre
Revision 1.21 1998-10-08 17:17:07 pierre
* current_module old scanner tagged as invalid if unit is recompiled
+ added ppheap for better info on tracegetmem of heaptrc
(adds line column and file index)
* several memory leaks removed ith help of heaptrc !!
Revision 1.20 1998/10/06 17:16:31 pierre
* some memory leaks fixed (thanks to Peter for heaptrc !)
Revision 1.19 1998/10/01 20:19:11 jonas

10
compiler/browser.pas
View File

@ -353,7 +353,7 @@ implementation
begin
if hp^.modulename^=upper(ss) then
begin
symt:=hp^.symtable;
symt:=hp^.globalsymtable;
break;
end;
hp:=pmodule(hp^.next);
@ -476,7 +476,13 @@ begin
end.
{
$Log$
Revision 1.10 1998-09-28 16:57:12 pierre
Revision 1.11 1998-10-08 17:17:09 pierre
* current_module old scanner tagged as invalid if unit is recompiled
+ added ppheap for better info on tracegetmem of heaptrc
(adds line column and file index)
* several memory leaks removed ith help of heaptrc !!
Revision 1.10 1998/09/28 16:57:12 pierre
* changed all length(p^.value_str^) into str_length(p)
to get it work with and without ansistrings
* changed sourcefiles field of tmodule to a pointer

14
compiler/cg386add.pas
View File

@ -170,6 +170,7 @@ implementation
ungetiftemp(p^.left^.location.reference);
{ does not hurt: }
clear_location(p^.left^.location);
p^.left^.location.loc:=LOC_MEM;
p^.left^.location.reference:=href;
end;
@ -602,6 +603,7 @@ implementation
hregister:=getregister32;
exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,opsize,
newreference(p^.left^.location.reference),hregister)));
clear_location(p^.left^.location);
p^.left^.location.loc:=LOC_REGISTER;
p^.left^.location.register:=hregister;
set_location(p^.location,p^.left^.location);
@ -612,6 +614,7 @@ implementation
hregister:=getregister32;
exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,opsize,
newreference(p^.right^.location.reference),hregister)));
clear_location(p^.right^.location);
p^.right^.location.loc:=LOC_REGISTER;
p^.right^.location.register:=hregister;
end;
@ -735,6 +738,7 @@ implementation
newreference(p^.left^.location.reference),hregister)));
end;
end;
clear_location(p^.location);
p^.location.loc:=LOC_REGISTER;
p^.location.register:=hregister;
end
@ -934,6 +938,7 @@ implementation
exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_B,newreference(p^.location.reference),
hregister)));
end;
clear_location(p^.left^.location);
p^.location.loc:=LOC_REGISTER;
p^.location.register:=hregister;
end;
@ -1066,6 +1071,7 @@ implementation
gten : flags:=F_AE;
end;
end;
clear_location(p^.left^.location);
p^.location.loc:=LOC_FLAGS;
p^.location.resflags:=flags;
cmpop:=false;
@ -1278,7 +1284,13 @@ implementation
end.
{
$Log$
Revision 1.14 1998-09-28 16:57:13 pierre
Revision 1.15 1998-10-08 17:17:10 pierre
* current_module old scanner tagged as invalid if unit is recompiled
+ added ppheap for better info on tracegetmem of heaptrc
(adds line column and file index)
* several memory leaks removed ith help of heaptrc !!
Revision 1.14 1998/09/28 16:57:13 pierre
* changed all length(p^.value_str^) into str_length(p)
to get it work with and without ansistrings
* changed sourcefiles field of tmodule to a pointer

31
compiler/cg386cnv.pas
View File

@ -384,6 +384,7 @@ implementation
else exprasmlist^.concat(new(pai386,op_ref_reg(op,opsize,
newreference(p^.left^.location.reference),hregister)));
end;
clear_location(p^.location);
p^.location.loc:=LOC_REGISTER;
p^.location.register:=hregister;
maybe_rangechecking(p,p^.left^.resulttype,p^.resulttype);
@ -545,6 +546,7 @@ implementation
procedure second_cstring_charpointer(p,hp : ptree;convtyp : tconverttype);
begin
clear_location(p^.location);
p^.location.loc:=LOC_REGISTER;
p^.location.register:=getregister32;
inc(p^.left^.location.reference.offset);
@ -562,6 +564,7 @@ implementation
begin
del_reference(p^.left^.location.reference);
clear_location(p^.location);
p^.location.loc:=LOC_REGISTER;
p^.location.register:=getregister32;
exprasmlist^.concat(new(pai386,op_ref_reg(A_LEA,S_L,newreference(p^.left^.location.reference),
@ -571,6 +574,7 @@ implementation
procedure second_pointer_to_array(p,hp : ptree;convtyp : tconverttype);
begin
clear_location(p^.location);
p^.location.loc:=LOC_REFERENCE;
clear_reference(p^.location.reference);
if p^.left^.location.loc=LOC_REGISTER then
@ -603,6 +607,7 @@ implementation
begin
{ this is a type conversion which copies the data, so we can't }
{ return a reference }
clear_location(p^.location);
p^.location.loc:=LOC_MEM;
{ first get the memory for the string }
@ -641,6 +646,9 @@ implementation
p^.left:=p;
loadstring(p);
p^.left:=nil; { reset left tree, which is empty }
{ p^.right is not disposed for typeconv !! PM }
disposetree(p^.right);
p^.right:=nil;
end;
procedure second_int_real(p,hp : ptree;convtyp : tconverttype);
@ -694,6 +702,7 @@ implementation
else
exprasmlist^.concat(new(pai386,op_reg(A_POP,S_L,R_EDI)));
clear_location(p^.location);
p^.location.loc:=LOC_FPU;
end;
@ -732,6 +741,7 @@ implementation
{ better than an add on all processors }
exprasmlist^.concat(new(pai386,op_reg(A_POP,S_L,R_EDI)));
clear_location(p^.location);
p^.location.loc:=LOC_REGISTER;
p^.location.register:=rreg;
end;
@ -750,6 +760,7 @@ implementation
del_reference(p^.left^.location.reference);
end;
end;
clear_location(p^.location);
p^.location.loc:=LOC_FPU;
end;
@ -827,6 +838,7 @@ implementation
if popeax then
exprasmlist^.concat(new(pai386,op_reg(A_POP,S_L,R_EAX)));
clear_location(p^.location);
p^.location.loc:=LOC_FPU;
end;
@ -861,6 +873,7 @@ implementation
end;
exprasmlist^.concat(new(pai386,op_const_reg(A_SHL,S_L,16,hregister)));
clear_location(p^.location);
p^.location.loc:=LOC_REGISTER;
p^.location.register:=hregister;
end;
@ -868,7 +881,8 @@ implementation
procedure second_proc_to_procvar(p,hp : ptree;convtyp : tconverttype);
begin
begin
clear_location(p^.location);
p^.location.loc:=LOC_REGISTER;
del_reference(hp^.location.reference);
p^.location.register:=getregister32;
@ -890,6 +904,7 @@ implementation
getlabel(truelabel);
getlabel(falselabel);
secondpass(hp);
clear_location(p^.location);
p^.location.loc:=LOC_REGISTER;
del_reference(hp^.location.reference);
case hp^.resulttype^.size of
@ -994,6 +1009,7 @@ implementation
var
hregister : tregister;
begin
clear_location(p^.location);
p^.location.loc:=LOC_REGISTER;
del_reference(hp^.location.reference);
case hp^.location.loc of
@ -1042,8 +1058,8 @@ implementation
emitcall('FPC_SET_LOAD_SMALL',true);
maybe_loadesi;
popusedregisters(pushedregs);
clear_location(p^.location);
p^.location.loc:=LOC_MEM;
stringdispose(p^.location.reference.symbol);
p^.location.reference:=href;
end;
@ -1054,6 +1070,7 @@ implementation
hr : preference;
begin
clear_location(p^.location);
p^.location.loc:=LOC_REGISTER;
getlabel(l1);
getlabel(l2);
@ -1137,6 +1154,7 @@ implementation
end;
else
begin
clear_location(p^.location);
p^.location.loc:=LOC_REGISTER;
internalerror(12121);
end;
@ -1216,6 +1234,7 @@ implementation
{ save all used registers }
pushusedregisters(pushed,$ff);
secondpass(p^.left);
clear_location(p^.location);
p^.location.loc:=LOC_FLAGS;
p^.location.resflags:=F_NE;
@ -1312,7 +1331,13 @@ implementation
end.
{
$Log$
Revision 1.27 1998-10-06 17:16:40 pierre
Revision 1.28 1998-10-08 17:17:11 pierre
* current_module old scanner tagged as invalid if unit is recompiled
+ added ppheap for better info on tracegetmem of heaptrc
(adds line column and file index)
* several memory leaks removed ith help of heaptrc !!
Revision 1.27 1998/10/06 17:16:40 pierre
* some memory leaks fixed (thanks to Peter for heaptrc !)
Revision 1.26 1998/10/02 07:20:35 florian

14
compiler/cg386inl.pas
View File

@ -446,6 +446,8 @@ implementation
exit;
dummycoll.paratyp:=vs_const;
disposetree(p^.left);
p^.left:=nil;
{ second arg }
hp:=node;
node:=node^.right;
@ -460,6 +462,7 @@ implementation
);
if codegenerror then
exit;
disposetree(hp);
hp:=node;
node:=node^.right;
hp^.right:=nil;
@ -478,6 +481,7 @@ implementation
);
if codegenerror then
exit;
disposetree(hp);
hp:=node;
node:=node^.right;
hp^.right:=nil;
@ -492,6 +496,8 @@ implementation
secondcallparan(hp,@dummycoll,false
,false,0
);
disposetree(hp);
if codegenerror then
exit;
@ -933,7 +939,13 @@ implementation
end.
{
$Log$
Revision 1.11 1998-10-05 21:33:15 peter
Revision 1.12 1998-10-08 17:17:12 pierre
* current_module old scanner tagged as invalid if unit is recompiled
+ added ppheap for better info on tracegetmem of heaptrc
(adds line column and file index)
* several memory leaks removed ith help of heaptrc !!
Revision 1.11 1998/10/05 21:33:15 peter
* fixed 161,165,166,167,168
Revision 1.10 1998/10/05 12:32:44 peter

19
compiler/cg386set.pas
View File

@ -85,7 +85,7 @@ implementation
opsize : topsize;
setparts : array[1..8] of Tsetpart;
i,numparts : byte;
href,href2 : Treference;
{href,href2 : Treference;}
l,l2 : plabel;
function analizeset(Aset:pconstset;is_small:boolean):boolean;
@ -209,18 +209,19 @@ implementation
else
p^.location.resflags:=F_E;
reset_reference(href);
{reset_reference(href);}
getlabel(l);
href.symbol:=stringdup(lab2str(l));
{href.symbol:=stringdup(lab2str(l));}
for i:=1 to numparts do
if setparts[i].range then
begin
{ Check if left is in a range }
{ Get a label to jump over the check }
reset_reference(href2);
{reset_reference(href2);}
getlabel(l2);
href.symbol:=stringdup(lab2str(l2));
{shouldn't it be href2 here ??
href.symbol:=stringdup(lab2str(l2));}
if setparts[i].start=setparts[i].stop-1 then
begin
case p^.left^.location.loc of
@ -784,7 +785,13 @@ implementation
end.
{
$Log$
Revision 1.17 1998-09-17 09:42:20 peter
Revision 1.18 1998-10-08 17:17:14 pierre
* current_module old scanner tagged as invalid if unit is recompiled
+ added ppheap for better info on tracegetmem of heaptrc
(adds line column and file index)
* several memory leaks removed ith help of heaptrc !!
Revision 1.17 1998/09/17 09:42:20 peter
+ pass_2 for cg386
* Message() -> CGMessage() for pass_1/pass_2

9
compiler/cg68kadd.pas
View File

@ -265,6 +265,7 @@ implementation
ungetiftemp(p^.left^.location.reference);
{ does not hurt: }
clear_location(p^.left^.location);
p^.left^.location.loc:=LOC_MEM;
p^.left^.location.reference:=href;
end;
@ -1263,7 +1264,13 @@ implementation
end.
{
$Log$
Revision 1.6 1998-09-28 16:57:16 pierre
Revision 1.7 1998-10-08 17:17:15 pierre
* current_module old scanner tagged as invalid if unit is recompiled
+ added ppheap for better info on tracegetmem of heaptrc
(adds line column and file index)
* several memory leaks removed ith help of heaptrc !!
Revision 1.6 1998/09/28 16:57:16 pierre
* changed all length(p^.value_str^) into str_length(p)
to get it work with and without ansistrings
* changed sourcefiles field of tmodule to a pointer

20
compiler/compiler.pas
View File

@ -162,11 +162,15 @@ var
olddo_stop : tstopprocedure;
{$endif}
{$IfDef Extdebug}
EntryMemAvail : longint;
{$ifdef FPC}
EntryMemUsed : longint;
{$endif FPC}
{$EndIf}
begin
{$ifdef EXTDEBUG}
EntryMemAvail:=MemAvail;
{$ifdef FPC}
EntryMemUsed:=system.HeapSize-MemAvail;
{$endif FPC}
{$endif}
{ Initialize the compiler }
@ -207,7 +211,9 @@ begin
do_stop:=olddo_stop;
{$endif USEEXCEPT}
{$ifdef EXTDEBUG}
Comment(V_Info,'Memory Lost = '+tostr(EntryMemAvail-MemAvail));
{$ifdef FPC}
Comment(V_Info,'Memory Lost = '+tostr(system.HeapSize-MemAvail+EntryMemUsed));
{$endif FPC}
Comment(V_Info,'Repetitive firstpass = '+tostr(firstpass_several)+'/'+tostr(total_of_firstpass));
{$endif EXTDEBUG}
@ -224,7 +230,13 @@ end;
end.
{
$Log$
Revision 1.9 1998-10-06 17:16:46 pierre
Revision 1.10 1998-10-08 17:17:18 pierre
* current_module old scanner tagged as invalid if unit is recompiled
+ added ppheap for better info on tracegetmem of heaptrc
(adds line column and file index)
* several memory leaks removed ith help of heaptrc !!
Revision 1.9 1998/10/06 17:16:46 pierre
* some memory leaks fixed (thanks to Peter for heaptrc !)
Revision 1.8 1998/09/01 09:00:27 peter

41
compiler/files.pas
View File

@ -102,10 +102,19 @@ unit files;
type
{$ifndef NEWMAP}
tunitmap = array[0..maxunits-1] of pointer;
punitmap = ^tunitmap;
pmodule = ^tmodule;
{$else NEWMAP}
pmodule = ^tmodule;
tunitmap = array[0..maxunits-1] of pmodule;
punitmap = ^tunitmap;
{$endif NEWMAP}
tmodule = object(tlinkedlist_item)
ppufile : pppufile; { the PPU file }
crc,
@ -186,7 +195,7 @@ unit files;
implementation
uses
dos,verbose,systems
dos,verbose,systems,scanner
{$ifndef VER0_99_8}
,symtable
{$endif}
@ -228,6 +237,8 @@ unit files;
destructor tinputfile.done;
begin
if not closed then
close;
stringdispose(path);
stringdispose(name);
{ free memory }
@ -307,6 +318,7 @@ unit files;
if is_macro then
begin
Freemem(buf,maxbufsize);
buf:=nil;
is_macro:=false;
closed:=true;
exit;
@ -317,10 +329,13 @@ unit files;
system.close(f);
{$I+}
i:=ioresult;
Freemem(buf,maxbufsize);
closed:=true;
end;
buf:=nil;
if assigned(buf) then
begin
Freemem(buf,maxbufsize);
buf:=nil;
end;
bufstart:=0;
end;
@ -492,6 +507,11 @@ unit files;
f^.ref_next:=files;
f^.ref_index:=last_ref_index;
files:=f;
{$ifdef FPC}
{$ifdef heaptrc}
writeln(stderr,f^.name^,' index ',current_module^.unit_index*100000+f^.ref_index);
{$endif heaptrc}
{$endif FPC}
end;
@ -779,6 +799,8 @@ unit files;
procedure tmodule.reset;
begin
if assigned(scanner) then
pscannerfile(scanner)^.invalid:=true;
{$ifndef VER0_99_8}
if assigned(globalsymtable) then
begin
@ -816,7 +838,8 @@ unit files;
uses_imports:=false;
do_assemble:=false;
do_compile:=false;
sources_avail:=true;
{ sources_avail:=true;
should not be changed PM }
compiled:=false;
in_implementation:=false;
in_global:=true;
@ -904,6 +927,8 @@ unit files;
dispose(ppufile,done);
if assigned(imports) then
dispose(imports,done);
if assigned(scanner) then
pscannerfile(scanner)^.invalid:=true;
if assigned(sourcefiles) then
dispose(sourcefiles,done);
used_units.done;
@ -969,7 +994,13 @@ unit files;
end.
{
$Log$
Revision 1.53 1998-10-08 13:48:43 peter
Revision 1.54 1998-10-08 17:17:19 pierre
* current_module old scanner tagged as invalid if unit is recompiled
+ added ppheap for better info on tracegetmem of heaptrc
(adds line column and file index)
* several memory leaks removed ith help of heaptrc !!
Revision 1.53 1998/10/08 13:48:43 peter
* fixed memory leaks for do nothing source
* fixed unit interdependency

25
compiler/i386.pas
View File

@ -315,6 +315,7 @@ unit i386;
procedure clear_reference(var ref : treference);
function newreference(const r : treference) : preference;
procedure disposereference(var r : preference);
function reg2str(r : tregister) : string;
@ -1069,6 +1070,15 @@ unit i386;
end;
procedure disposereference(var r : preference);
begin
if assigned(r^.symbol) then
stringdispose(r^.symbol);
dispose(r);
r:=nil;
end;
function newreference(const r : treference) : preference;
var
p : preference;
@ -1253,6 +1263,7 @@ unit i386;
begin
opxt:=top_const;
op1:=pointer(_op1^.offset);
disposereference(_op1);
end
else
begin
@ -1317,6 +1328,7 @@ unit i386;
begin
opxt:=opxt+top_const shl 4;
op2:=pointer(_op2^.offset);
disposereference(_op2);
end
else
begin
@ -1455,6 +1467,7 @@ unit i386;
begin
opxt:=opxt+top_const shl 4;
op2:=pointer(_op2^.offset);
disposereference(_op2);
end
else
begin
@ -1507,6 +1520,7 @@ unit i386;
begin
opxt:=opxt+top_const;
op1:=pointer(_op1^.offset);
disposereference(_op1);
end
else
begin
@ -1528,6 +1542,7 @@ unit i386;
begin
opxt:=top_const;
op1:=pointer(_op1^.offset);
disposereference(_op1);
end
else
begin
@ -1539,6 +1554,7 @@ unit i386;
begin
opxt:=opxt+top_const shl 4;
op2:=pointer(_op2^.offset);
disposereference(_op2);
end
else
begin
@ -1589,6 +1605,7 @@ unit i386;
begin
opxt:=opxt+top_const shl 4;
op2:=pointer(_op2^.offset);
disposereference(_op2);
end
else
begin
@ -1707,7 +1724,13 @@ unit i386;
end.
{
$Log$
Revision 1.11 1998-09-20 17:11:23 jonas
Revision 1.12 1998-10-08 17:17:20 pierre
* current_module old scanner tagged as invalid if unit is recompiled
+ added ppheap for better info on tracegetmem of heaptrc
(adds line column and file index)
* several memory leaks removed ith help of heaptrc !!
Revision 1.11 1998/09/20 17:11:23 jonas
* released REGALLOC
Revision 1.10 1998/09/14 21:30:45 peter

42
compiler/parser.pas
View File

@ -41,7 +41,7 @@ unit parser;
{$ifdef UseBrowser}
browser,
{$endif UseBrowser}
scanner,pbase,pdecl,psystem,pmodules;
tree,scanner,pbase,pdecl,psystem,pmodules;
procedure initparser;
@ -111,7 +111,8 @@ unit parser;
oldpattern,
oldorgpattern : string;
old_block_type : tblock_type;
oldcurrent_scanner : pscannerfile;
oldcurrent_scanner,prev_scanner,
scanner : pscannerfile;
{ symtable }
oldmacros,
oldrefsymtable,
@ -210,7 +211,12 @@ unit parser;
{ reset the unit or create a new program }
if assigned(current_module) then
current_module^.reset
begin
{current_module^.reset this is wrong !! }
scanner:=current_module^.scanner;
current_module^.reset;
current_module^.scanner:=scanner;
end
else
begin
current_module:=new(pmodule,init(filename,false));
@ -233,6 +239,7 @@ unit parser;
{ startup scanner, and save in current_module }
current_scanner:=new(pscannerfile,Init(filename));
current_scanner^.readtoken;
prev_scanner:=current_module^.scanner;
current_module^.scanner:=current_scanner;
{ init code generator for a new module }
@ -284,6 +291,15 @@ unit parser;
dispose(current_module^.ppufile,done);
current_module^.ppufile:=nil;
end;
{ free scanner }
dispose(current_scanner,done);
{ restore previous scanner !! }
current_module^.scanner:=prev_scanner;
if assigned(prev_scanner) then
prev_scanner^.invalid:=true;
(* Peter I do not agree here because
most time current_scanner is from another unit !! PM
end;
{ free scanner, but it can already be freed due a 2nd compile }
if assigned(current_scanner) then
@ -292,7 +308,7 @@ unit parser;
current_scanner:=nil;
end;
current_module^.scanner:=nil;
*)
{ free macros }
{!!! No check for unused macros yet !!! }
dispose(macros,done);
@ -366,6 +382,16 @@ unit parser;
else
Browse.list_elements;
{$endif UseBrowser}
if assigned(aktprocsym) then
begin
if (aktprocsym^.owner=nil) then
begin
{ init parts are not needed in units !! }
if current_module^.is_unit then
aktprocsym^.definition^.forwarddef:=false;
dispose(aktprocsym,done);
end;
end;
end;
dec(compile_level);
@ -374,7 +400,13 @@ unit parser;
end.
{
$Log$
Revision 1.56 1998-10-08 13:48:45 peter
Revision 1.57 1998-10-08 17:17:23 pierre
* current_module old scanner tagged as invalid if unit is recompiled
+ added ppheap for better info on tracegetmem of heaptrc
(adds line column and file index)
* several memory leaks removed ith help of heaptrc !!
Revision 1.56 1998/10/08 13:48:45 peter
* fixed memory leaks for do nothing source
* fixed unit interdependency

84
compiler/pmodules.pas
View File

@ -1,3 +1,4 @@
{
$Id$
Copyright (c) 1998 by Florian Klaempfl
@ -182,6 +183,9 @@ unit pmodules;
{ init the map }
new(current_module^.map);
fillchar(current_module^.map^,sizeof(tunitmap),#0);
{$ifdef NEWMAP}
current_module^.map^[0]:=current_module;
{$endif NEWMAP}
nextmapentry:=1;
{ load the used units from interface }
current_module^.in_implementation:=false;
@ -206,7 +210,11 @@ unit pmodules;
exit;
end;
{ setup the map entry for deref }
{$ifndef NEWMAP}
current_module^.map^[nextmapentry]:=loaded_unit^.globalsymtable;
{$else NEWMAP}
current_module^.map^[nextmapentry]:=loaded_unit;
{$endif NEWMAP}
inc(nextmapentry);
if nextmapentry>maxunits then
Message(unit_f_too_much_units);
@ -248,7 +256,11 @@ unit pmodules;
end;
{$endif TEST_IMPL}
{ setup the map entry for deref }
{$ifndef NEWMAP}
current_module^.map^[nextmapentry]:=loaded_unit^.globalsymtable;
{$else NEWMAP}
current_module^.map^[nextmapentry]:=loaded_unit;
{$endif NEWMAP}
inc(nextmapentry);
if nextmapentry>maxunits then
Message(unit_f_too_much_units);
@ -257,13 +269,13 @@ unit pmodules;
end;
{$ifdef UseBrowser}
if cs_browser in aktmoduleswitches then
punitsymtable(current_module^.symtable)^.load_symtable_refs;
punitsymtable(current_module^.globalsymtable)^.load_symtable_refs;
if ((current_module^.flags and uf_has_browser)<>0) and
(cs_local_browser in aktmoduleswitches) then
begin
current_module^.implsymtable:=new(psymtable,load);
psymtable(current_module^.implsymtable)^.name:=
stringdup('implementation of '+psymtable(current_module^.symtable)^.name^);
stringdup('implementation of '+psymtable(current_module^.globalsymtable)^.name^);
psymtable(current_module^.implsymtable)^.load_browser;
end;
{$endif UseBrowser}
@ -280,6 +292,9 @@ unit pmodules;
st : punitsymtable;
old_current_ppu : pppufile;
old_current_module,hp,hp2 : pmodule;
name : string;{ necessary because
current_module^.mainsource^ is reset in compile !! }
scanner : pscannerfile;
procedure loadppufile;
begin
@ -299,16 +314,33 @@ unit pmodules;
current_module^.ppufile:=nil;
end;
{ recompile the unit or give a fatal error if sources not available }
if not(current_module^.sources_avail) then
if (not current_module^.search_unit(current_module^.modulename^))
and (length(current_module^.modulename^)>8) then
current_module^.search_unit(copy(current_module^.modulename^,1,8));
if not(current_module^.sources_avail) then
Message1(unit_f_cant_compile_unit,current_module^.modulename^)
else
begin
if current_module^.in_second_compile then
Message1(parser_d_compiling_second_time,current_module^.modulename^);
current_scanner^.tempcloseinputfile;
name:=current_module^.mainsource^;
if assigned(scanner) then
scanner^.invalid:=true;
compile(name,compile_system);
if (not current_scanner^.invalid) then
current_scanner^.tempopeninputfile;
(*
if assigned(old_current_module^.scanner) then
begin
current_scanner^.tempcloseinputfile;
current_scanner:=nil;
{ the current_scanner is always the same
as current_module^.scanner (PFV) }
NO !!! unless you changed the code
because it is only change in compile
whereas current_module is changed here !!
end;
compile(current_module^.mainsource^,compile_system);
if (not old_current_module^.compiled) and
@ -316,7 +348,7 @@ unit pmodules;
begin
current_scanner:=old_current_module^.scanner;
current_scanner^.tempopeninputfile;
end;
end; *)
end;
end
else
@ -386,14 +418,19 @@ unit pmodules;
begin
{ remove the old unit }
loaded_units.remove(hp);
scanner:=hp^.scanner;
hp^.reset;
hp^.scanner:=scanner;
current_module:=hp;
current_module^.in_second_compile:=true;
current_module^.do_compile:=true;
end
else
{ generates a new unit info record }
current_module:=new(pmodule,init(s,true));
begin
current_module:=new(pmodule,init(s,true));
scanner:=nil;
end;
current_ppu:=current_module^.ppufile;
{ now we can register the unit }
current_module^.loaded_from:=old_current_module;
@ -680,7 +717,11 @@ unit pmodules;
loadunits;
{ has it been compiled at a higher level ?}
if current_module^.compiled then
exit;
begin
{ this unit symtable is obsolete }
dispose(unitst,done);
exit;
end;
unitst^.symtabletype:=globalsymtable;
end;
{ ... but insert the symbol table later }
@ -740,6 +781,19 @@ unit pmodules;
{ Read the implementation units }
parse_implementation_uses(unitst);
if current_module^.compiled then
begin
{ this unit symtable is obsolete }
dispose(unitst,done);
{ avoid self recursive destructor call !! PM }
aktprocsym^.definition^.localst:=nil;
{ absence does not matter here !! }
aktprocsym^.definition^.forwarddef:=false;
dispose(st,done);
exit;
end;
{ All units are read, now give them a number }
numberunits;
@ -806,6 +860,10 @@ unit pmodules;
{ the last char should always be a point }
consume(POINT);
{ avoid self recursive destructor call !! PM }
aktprocsym^.definition^.localst:=nil;
{ absence does not matter here !! }
aktprocsym^.definition^.forwarddef:=false;
{ test static symtable }
st^.allsymbolsused;
@ -833,7 +891,9 @@ unit pmodules;
dellexlevel; }
{ remove static symtable here to save some mem ;) }
{$ifndef UseBrowser}
dispose(st,done);
{$endif UseBrowser}
current_module^.localsymtable:=nil;
{ tests, if all (interface) forwards are resolved }
@ -882,6 +942,9 @@ unit pmodules;
if current_module^.uses_imports then
importlib^.generatelib;
{$ifndef UseBrowser}
dispose(refsymtable,done);
{$endif UseBrowser}
{ finish asmlist by adding segment starts }
insertsegment;
@ -974,11 +1037,12 @@ unit pmodules;
{$endif}
compile_proc_body(names,true,false);
names.done;
codegen_doneprocedure;
{ avoid self recursive destructor call !! PM }
aktprocsym^.definition^.localst:=nil;
codegen_doneprocedure;
{ consume the last point }
consume(POINT);
@ -1022,7 +1086,13 @@ unit pmodules;
end.
{
$Log$
Revision 1.61 1998-10-08 13:48:47 peter
Revision 1.62 1998-10-08 17:17:25 pierre
* current_module old scanner tagged as invalid if unit is recompiled
+ added ppheap for better info on tracegetmem of heaptrc
(adds line column and file index)
* several memory leaks removed ith help of heaptrc !!
Revision 1.61 1998/10/08 13:48:47 peter
* fixed memory leaks for do nothing source
* fixed unit interdependency

12
compiler/pp.pas
View File

@ -107,9 +107,11 @@ uses
{$ifdef profile}
profile,
{$endif profile}
{$ifdef FPC}
{$ifdef heaptrc}
heaptrc,
ppheap,
{$endif heaptrc}
{$endif FPC}
globals,compiler;
{$ifdef useoverlay}
@ -259,7 +261,13 @@ begin
end.
{
$Log$
Revision 1.32 1998-10-02 17:03:51 peter
Revision 1.33 1998-10-08 17:17:26 pierre
* current_module old scanner tagged as invalid if unit is recompiled
+ added ppheap for better info on tracegetmem of heaptrc
(adds line column and file index)
* several memory leaks removed ith help of heaptrc !!
Revision 1.32 1998/10/02 17:03:51 peter
* ifdef heaptrc for heaptrc
Revision 1.31 1998/09/28 16:57:23 pierre

45
compiler/ppheap.pas Normal file
View File

@ -0,0 +1,45 @@
{
$Id$
Copyright (c) 1993-98 by FPC development team
Simple unit to add source line and column to each
memory allocation made with heaptrc unit
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
****************************************************************************}
unit ppheap;
interface
uses heaptrc;
implementation
uses
globals,files;
procedure ppextra_info(p : pointer);
begin
longint(p^):=aktfilepos.line;
plongint(cardinal(p)+4)^:=aktfilepos.column;
plongint(cardinal(p)+8)^:=current_module^.unit_index*100000+aktfilepos.fileindex;
end;
begin
set_extra_info(12,ppextra_info);
end.

14
compiler/scandir.inc
View File

@ -695,9 +695,15 @@ const
end;
procedure dir_wait(t:tdirectivetoken);
var had_info : boolean;
begin
had_info:=(status.verbosity and V_Info)<>0;
{ this message should allways appear !! }
status.verbosity:=status.verbosity or V_Info;
Message(scan_i_press_enter);
readln;
If not(had_info) then
status.verbosity:=status.verbosity and (not V_Info);
end;
@ -938,7 +944,13 @@ const
{
$Log$
Revision 1.35 1998-10-08 13:44:39 peter
Revision 1.36 1998-10-08 17:17:29 pierre
* current_module old scanner tagged as invalid if unit is recompiled
+ added ppheap for better info on tracegetmem of heaptrc
(adds line column and file index)
* several memory leaks removed ith help of heaptrc !!
Revision 1.35 1998/10/08 13:44:39 peter
* fixed $I %date% not in uppercase
Revision 1.34 1998/09/28 16:57:24 pierre

44
compiler/scanner.pas
View File

@ -72,6 +72,7 @@ unit scanner;
yylexcount : longint;
lastasmgetchar : char;
preprocstack : ppreprocstack;
invalid : boolean; { flag if sourcefiles have been destroyed ! }
constructor init(const fn:string);
destructor done;
@ -134,7 +135,10 @@ implementation
var
tokenidx:array[2..tokenidlen] of tokenidxrec;
const
{ use any special name that is an invalid file name to avoid problems }
macro_special_name = '__##&&Macro&&##__';
procedure create_tokenidx;
{ create an index with the first and last token for every possible token
length, so a search only will be done in that small part }
@ -216,6 +220,7 @@ implementation
lasttokenpos:=0;
lasttoken:=_END;
lastasmgetchar:=#0;
invalid:=false;
{ load block }
if not openinputfile then
Message1(scan_f_cannot_open_input,fn);
@ -225,13 +230,17 @@ implementation
destructor tscannerfile.done;
begin
checkpreprocstack;
{ close file, but only if we are the first compile }
if not current_module^.in_second_compile then
begin
if not inputfile^.closed then
closeinputfile;
end;
if not invalid then
begin
checkpreprocstack;
{ close file, but only if we are the first compile }
{ probably not necessary anymore with invalid flag PM }
if not current_module^.in_second_compile then
begin
if not inputfile^.closed then
closeinputfile;
end;
end;
end;
@ -301,10 +310,18 @@ implementation
procedure tscannerfile.nextfile;
var
to_dispose : pinputfile;
begin
if assigned(inputfile^.next) then
begin
if inputfile^.is_macro then
to_dispose:=inputfile
else
to_dispose:=nil;
inputfile:=inputfile^.next;
if assigned(to_dispose) then
dispose(to_dispose,done);
restoreinputfile;
end;
end;
@ -383,7 +400,8 @@ implementation
dec(longint(inputpointer));
tempcloseinputfile;
{ create macro 'file' }
hp:=new(pinputfile,init('Macro'));
{ use special name to dispose after !! }
hp:=new(pinputfile,init(macro_special_name));
addfile(hp);
with inputfile^ do
begin
@ -1431,7 +1449,13 @@ begin
end.
{
$Log$
Revision 1.57 1998-10-08 13:45:25 peter
Revision 1.58 1998-10-08 17:17:30 pierre
* current_module old scanner tagged as invalid if unit is recompiled
+ added ppheap for better info on tracegetmem of heaptrc
(adds line column and file index)
* several memory leaks removed ith help of heaptrc !!
Revision 1.57 1998/10/08 13:45:25 peter
* EOF position is now correctly saved in aktfilepos
Revision 1.56 1998/09/30 16:43:38 peter

14
compiler/symsym.inc
View File

@ -1596,8 +1596,9 @@
begin
if definition^.sym=nil then
definition^.sym:=@self;
if (definition^.deftype=recorddef) and assigned(precdef(definition)^.symtable) then
precdef(definition)^.symtable^.name:=stringdup('record '+name);
if (definition^.deftype=recorddef) and assigned(precdef(definition)^.symtable) and
(definition^.sym=@self) then
precdef(definition)^.symtable^.name:=stringdup('record '+name);
end;
end;
@ -1704,6 +1705,7 @@
constructor tmacrosym.init(const n : string);
begin
inherited init(n);
typ:=macrosym;
defined:=true;
buftext:=nil;
buflen:=0;
@ -1719,7 +1721,13 @@
{
$Log$
Revision 1.51 1998-10-08 13:48:50 peter
Revision 1.52 1998-10-08 17:17:32 pierre
* current_module old scanner tagged as invalid if unit is recompiled
+ added ppheap for better info on tracegetmem of heaptrc
(adds line column and file index)
* several memory leaks removed ith help of heaptrc !!
Revision 1.51 1998/10/08 13:48:50 peter
* fixed memory leaks for do nothing source
* fixed unit interdependency

11
compiler/symsymh.inc
View File

@ -29,7 +29,8 @@
{ possible types for symtable entries }
tsymtyp = (abstractsym,varsym,typesym,procsym,unitsym,programsym,
constsym,enumsym,typedconstsym,errorsym,syssym,
labelsym,absolutesym,propertysym,funcretsym);
labelsym,absolutesym,propertysym,funcretsym,
macrosym);
{ varsym_C,typedconstsym_C); }
{ this object is the base for all symbol objects }
@ -314,7 +315,13 @@
{
$Log$
Revision 1.2 1998-09-24 15:11:18 peter
Revision 1.3 1998-10-08 17:17:34 pierre
* current_module old scanner tagged as invalid if unit is recompiled
+ added ppheap for better info on tracegetmem of heaptrc
(adds line column and file index)
* several memory leaks removed ith help of heaptrc !!
Revision 1.2 1998/09/24 15:11:18 peter
* fixed enum for not GDB
Revision 1.1 1998/09/23 12:03:57 peter

35
compiler/tree.pas
View File

@ -276,6 +276,7 @@ unit tree;
procedure disposetree(p : ptree);
procedure putnode(p : ptree);
function getnode : ptree;
procedure clear_location(var loc : tlocation);
procedure set_location(var destloc,sourceloc : tlocation);
procedure swap_location(var destloc,sourceloc : tlocation);
procedure set_file_line(from,_to : ptree);
@ -430,6 +431,8 @@ unit tree;
deletecaselabels(p^.greater);
if assigned(p^.less) then
deletecaselabels(p^.less);
freelabel(p^._at);
freelabel(p^.statement);
dispose(p);
end;
@ -447,6 +450,10 @@ unit tree;
procedure disposetree(p : ptree);
var
symt : psymtable;
i : longint;
begin
if not(assigned(p)) then
exit;
@ -511,8 +518,16 @@ unit tree;
disposetree(p^.left);
if assigned(p^.right) then
disposetree(p^.right);
if assigned(p^.withsymtable) then
dispose(p^.withsymtable,done);
symt:=p^.withsymtable;
for i:=1 to p^.tablecount do
begin
if assigned(symt) then
begin
p^.withsymtable:=symt^.next;
dispose(symt,done);
end;
symt:=p^.withsymtable;
end;
end;
else internalerror(12);
end;
@ -1511,6 +1526,14 @@ unit tree;
end;
end;
procedure clear_location(var loc : tlocation);
begin
if assigned(loc.reference.symbol) then
stringdispose(loc.reference.symbol);
loc.loc:=LOC_INVALID;
end;
{This is needed if you want to be able to delete the string with the nodes !!}
procedure set_location(var destloc,sourceloc : tlocation);
@ -1597,7 +1620,13 @@ unit tree;
end.
{
$Log$
Revision 1.45 1998-10-05 21:33:33 peter
Revision 1.46 1998-10-08 17:17:37 pierre
* current_module old scanner tagged as invalid if unit is recompiled
+ added ppheap for better info on tracegetmem of heaptrc
(adds line column and file index)
* several memory leaks removed ith help of heaptrc !!
Revision 1.45 1998/10/05 21:33:33 peter
* fixed 161,165,166,167,168
Revision 1.44 1998/09/28 16:57:28 pierre

19
compiler/verbose.pas
View File

@ -399,6 +399,11 @@ end;
procedure InitVerbose;
begin
{ Init }
{$ifndef EXTERN_MSG}
msg:=new(pmessage,Init(@msgtxt,ord(endmsgconst)));
{$else}
LoadMsgFile(exepath+'errore.msg');
{$endif}
FillChar(Status,sizeof(TCompilerStatus),0);
status.verbosity:=V_Default;
Status.MaxErrorCount:=50;
@ -410,17 +415,17 @@ begin
dispose(msg,Done);
end;
begin
{$ifndef EXTERN_MSG}
msg:=new(pmessage,Init(@msgtxt,ord(endmsgconst)));
{$else}
LoadMsgFile(exepath+'errore.msg');
{$endif}
end.
{
$Log$
Revision 1.23 1998-10-06 17:17:01 pierre
Revision 1.24 1998-10-08 17:17:39 pierre
* current_module old scanner tagged as invalid if unit is recompiled
+ added ppheap for better info on tracegetmem of heaptrc
(adds line column and file index)
* several memory leaks removed ith help of heaptrc !!
Revision 1.23 1998/10/06 17:17:01 pierre
* some memory leaks fixed (thanks to Peter for heaptrc !)
Revision 1.22 1998/10/05 13:51:36 peter