{
$Id: nbas.pas,v 1.74 2003/12/10 20:31:40 jonas Exp $
Copyright (c) 2000-2002 by Florian Klaempfl
This unit implements some basic nodes
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 nbas;
{$i fpcdefs.inc}
interface
uses
cpubase,cgbase,
aasmbase,aasmtai,aasmcpu,
node,tgobj,
symtype,symppu;
type
tnothingnode = class(tnode)
constructor create;virtual;
function pass_1 : tnode;override;
function det_resulttype:tnode;override;
end;
tnothingnodeclass = class of tnothingnode;
terrornode = class(tnode)
constructor create;virtual;
function pass_1 : tnode;override;
function det_resulttype:tnode;override;
procedure mark_write;override;
end;
terrornodeclass = class of terrornode;
tasmnode = class(tnode)
p_asm : taasmoutput;
currenttai : tai;
getposition : boolean;
{ Used registers in assembler block }
used_regs_int,
used_regs_fpu : tcpuregisterset;
constructor create(p : taasmoutput);virtual;
constructor create_get_position;
destructor destroy;override;
constructor ppuload(t:tnodetype;ppufile:tcompilerppufile);override;
procedure ppuwrite(ppufile:tcompilerppufile);override;
procedure buildderefimpl;override;
procedure derefimpl;override;
function getcopy : tnode;override;
function pass_1 : tnode;override;
function det_resulttype:tnode;override;
function docompare(p: tnode): boolean; override;
end;
tasmnodeclass = class of tasmnode;
tstatementnode = class(tbinarynode)
constructor create(l,r : tnode);virtual;
function pass_1 : tnode;override;
function det_resulttype:tnode;override;
procedure printnodetree(var t:text);override;
end;
tstatementnodeclass = class of tstatementnode;
tblocknode = class(tunarynode)
constructor create(l : tnode);virtual;
destructor destroy; override;
function pass_1 : tnode;override;
function det_resulttype:tnode;override;
{$ifdef state_tracking}
function track_state_pass(exec_known:boolean):boolean;override;
{$endif state_tracking}
end;
tblocknodeclass = class of tblocknode;
ttempcreatenode = class;
{ to allow access to the location by temp references even after the temp has }
{ already been disposed and to make sure the coherency between temps and }
{ temp references is kept after a getcopy }
ptempinfo = ^ttempinfo;
ttempinfo = record
{ set to the copy of a tempcreate pnode (if it gets copied) so that the }
{ refs and deletenode can hook to this copy once they get copied too }
hookoncopy : ptempinfo;
ref : treference;
restype : ttype;
temptype : ttemptype;
valid : boolean;
nextref_set_hookoncopy_nil : boolean;
owner : ttempcreatenode;
end;
{ a node which will create a (non)persistent temp of a given type with a given }
{ size (the size is separate to allow creating "void" temps with a custom size) }
ttempcreatenode = class(tnode)
size: longint;
tempinfo: ptempinfo;
{ * persistent temps are used in manually written code where the temp }
{ be usable among different statements and where you can manually say }
{ when the temp has to be freed (using a ttempdeletenode) }
{ * non-persistent temps are mostly used in typeconversion helpers, }
{ where the node that receives the temp becomes responsible for }
{ freeing it. In this last case, you should use only one reference }
{ to it and *not* generate a ttempdeletenode }
constructor create(const _restype: ttype; _size: longint; _temptype: ttemptype); virtual;
constructor ppuload(t:tnodetype;ppufile:tcompilerppufile);override;
procedure ppuwrite(ppufile:tcompilerppufile);override;
procedure buildderefimpl;override;
procedure derefimpl;override;
function getcopy: tnode; override;
function pass_1 : tnode; override;
function det_resulttype: tnode; override;
function docompare(p: tnode): boolean; override;
procedure printnodedata(var t:text);override;
end;
ttempcreatenodeclass = class of ttempcreatenode;
{ a node which is a reference to a certain temp }
ttemprefnode = class(tnode)
constructor create(const temp: ttempcreatenode); virtual;
constructor create_offset(const temp: ttempcreatenode;aoffset:longint);
constructor ppuload(t:tnodetype;ppufile:tcompilerppufile);override;
procedure ppuwrite(ppufile:tcompilerppufile);override;
function getcopy: tnode; override;
procedure derefnode;override;
function pass_1 : tnode; override;
function det_resulttype : tnode; override;
procedure mark_write;override;
function docompare(p: tnode): boolean; override;
protected
tempinfo: ptempinfo;
offset : longint;
private
tempidx : longint;
end;
ttemprefnodeclass = class of ttemprefnode;
{ a node which removes a temp }
ttempdeletenode = class(tnode)
constructor create(const temp: ttempcreatenode); virtual;
{ this will convert the persistant temp to a normal temp
for returning to the other nodes }
constructor create_normal_temp(const temp: ttempcreatenode);
constructor ppuload(t:tnodetype;ppufile:tcompilerppufile);override;
procedure ppuwrite(ppufile:tcompilerppufile);override;
function getcopy: tnode; override;
procedure derefnode;override;
function pass_1: tnode; override;
function det_resulttype: tnode; override;
function docompare(p: tnode): boolean; override;
destructor destroy; override;
protected
tempinfo: ptempinfo;
release_to_normal : boolean;
private
tempidx : longint;
end;
ttempdeletenodeclass = class of ttempdeletenode;
var
cnothingnode : tnothingnodeclass;
cerrornode : terrornodeclass;
casmnode : tasmnodeclass;
cstatementnode : tstatementnodeclass;
cblocknode : tblocknodeclass;
ctempcreatenode : ttempcreatenodeclass;
ctemprefnode : ttemprefnodeclass;
ctempdeletenode : ttempdeletenodeclass;
{ Create a blocknode and statement node for multiple statements
generated internally by the parser }
function internalstatements(var laststatement:tstatementnode):tblocknode;
procedure addstatement(var laststatement:tstatementnode;n:tnode);
implementation
uses
cutils,
verbose,globals,globtype,systems,
symconst,symdef,defutil,defcmp,
pass_1,
nld,ncal,nflw,
procinfo
;
{*****************************************************************************
Helpers
*****************************************************************************}
function internalstatements(var laststatement:tstatementnode):tblocknode;
begin
{ create dummy initial statement }
laststatement := cstatementnode.create(cnothingnode.create,nil);
internalstatements := cblocknode.create(laststatement);
end;
procedure addstatement(var laststatement:tstatementnode;n:tnode);
begin
if assigned(laststatement.right) then
internalerror(200204201);
laststatement.right:=cstatementnode.create(n,nil);
laststatement:=tstatementnode(laststatement.right);
end;
{*****************************************************************************
TFIRSTNOTHING
*****************************************************************************}
constructor tnothingnode.create;
begin
inherited create(nothingn);
end;
function tnothingnode.det_resulttype:tnode;
begin
result:=nil;
resulttype:=voidtype;
end;
function tnothingnode.pass_1 : tnode;
begin
result:=nil;
expectloc:=LOC_VOID;
end;
{*****************************************************************************
TFIRSTERROR
*****************************************************************************}
constructor terrornode.create;
begin
inherited create(errorn);
end;
function terrornode.det_resulttype:tnode;
begin
result:=nil;
include(flags,nf_error);
codegenerror:=true;
resulttype:=generrortype;
end;
function terrornode.pass_1 : tnode;
begin
result:=nil;
expectloc:=LOC_VOID;
codegenerror:=true;
end;
procedure terrornode.mark_write;
begin
end;
{*****************************************************************************
TSTATEMENTNODE
*****************************************************************************}
constructor tstatementnode.create(l,r : tnode);
begin
inherited create(statementn,l,r);
end;
function tstatementnode.det_resulttype:tnode;
begin
result:=nil;
resulttype:=voidtype;
{ left is the statement itself calln assignn or a complex one }
resulttypepass(left);
if (not (cs_extsyntax in aktmoduleswitches)) and
assigned(left.resulttype.def) and
not((left.nodetype=calln) and
{ don't complain when funcretrefnode is set, because then the
value is already used. And also not for constructors }
(assigned(tcallnode(left).funcretnode) or
(tcallnode(left).procdefinition.proctypeoption=potype_constructor))) and
not(is_void(left.resulttype.def)) then
CGMessage(cg_e_illegal_expression);
if codegenerror then
exit;
{ right is the next statement in the list }
if assigned(right) then
resulttypepass(right);
if codegenerror then
exit;
end;
function tstatementnode.pass_1 : tnode;
begin
result:=nil;
{ left is the statement itself calln assignn or a complex one }
firstpass(left);
if codegenerror then
exit;
expectloc:=left.expectloc;
registers32:=left.registers32;
registersfpu:=left.registersfpu;
{$ifdef SUPPORT_MMX}
registersmmx:=left.registersmmx;
{$endif SUPPORT_MMX}
{ right is the next in the list }
if assigned(right) then
firstpass(right);
if codegenerror then
exit;
end;
procedure tstatementnode.printnodetree(var t:text);
begin
printnodelist(t);
end;
{*****************************************************************************
TBLOCKNODE
*****************************************************************************}
constructor tblocknode.create(l : tnode);
begin
inherited create(blockn,l);
end;
destructor tblocknode.destroy;
var
hp, next: tstatementnode;
begin
hp := tstatementnode(left);
left := nil;
while assigned(hp) do
begin
next := tstatementnode(hp.right);
hp.right := nil;
hp.free;
hp := next;
end;
inherited destroy;
end;
function tblocknode.det_resulttype:tnode;
var
hp : tstatementnode;
begin
result:=nil;
resulttype:=voidtype;
hp:=tstatementnode(left);
while assigned(hp) do
begin
if assigned(hp.left) then
begin
codegenerror:=false;
resulttypepass(hp.left);
if not(codegenerror) and
not(cs_extsyntax in aktmoduleswitches) and
(hp.left.nodetype=calln) and
not(is_void(hp.left.resulttype.def)) and
not(nf_return_value_used in tcallnode(hp.left).flags) and
not((tcallnode(hp.left).procdefinition.proctypeoption=potype_constructor) and
assigned(tprocdef(tcallnode(hp.left).procdefinition)._class) and
is_object(tprocdef(tcallnode(hp.left).procdefinition)._class)) then
CGMessagePos(hp.left.fileinfo,cg_e_illegal_expression);
{ the resulttype of the block is the last type that is
returned. Normally this is a voidtype. But when the
compiler inserts a block of multiple statements then the
last entry can return a value }
resulttype:=hp.left.resulttype;
end;
hp:=tstatementnode(hp.right);
end;
end;
function tblocknode.pass_1 : tnode;
var
hp : tstatementnode;
count : longint;
begin
result:=nil;
expectloc:=LOC_VOID;
count:=0;
hp:=tstatementnode(left);
while assigned(hp) do
begin
(*
if cs_regvars in aktglobalswitches then
begin
{ node transformations }
{ concat function result to exit }
{ this is wrong for string or other complex
result types !!! }
if {ret_in_acc(current_procinfo.procdef.rettype.def) and }
(is_ordinal(current_procinfo.procdef.rettype.def) or
is_smallset(current_procinfo.procdef.rettype.def)) and
assigned(hp.right) and
assigned(tstatementnode(hp.right).left) and
(tstatementnode(hp.right).left.nodetype=exitn) and
(hp.left.nodetype=assignn) and
{ !!!! this tbinarynode should be tassignmentnode }
(tbinarynode(hp.left).left.nodetype=loadn) and
(is_funcret_sym(tloadnode(tbinarynode(hp.left).left).symtableentry)) then
begin
if assigned(texitnode(tstatementnode(hp.right).left).left) then
CGMessage(cg_n_inefficient_code)
else
begin
texitnode(tstatementnode(hp.right).left).left:=tassignmentnode(hp.left).right;
tassignmentnode(hp.left).right:=nil;
hp.left.free;
hp.left:=nil;
end;
end
{ warning if unreachable code occurs and elimate this }
else if (hp.left.nodetype in
[exitn,breakn,continuen,goton]) and
{ statement node (JM) }
assigned(hp.right) and
{ kind of statement! (JM) }
assigned(tstatementnode(hp.right).left) and
(tstatementnode(hp.right).left.nodetype<>labeln) then
begin
{ use correct line number }
aktfilepos:=hp.right.fileinfo;
hp.right.free;
hp.right:=nil;
CGMessage(cg_w_unreachable_code);
{ old lines }
aktfilepos:=hp.left.fileinfo;
end;
end;
*)
if assigned(hp.left) then
begin
codegenerror:=false;
firstpass(hp.left);
hp.expectloc:=hp.left.expectloc;
hp.registers32:=hp.left.registers32;
hp.registersfpu:=hp.left.registersfpu;
{$ifdef SUPPORT_MMX}
hp.registersmmx:=hp.left.registersmmx;
{$endif SUPPORT_MMX}
end
else
hp.registers32:=0;
if hp.registers32>registers32 then
registers32:=hp.registers32;
if hp.registersfpu>registersfpu then
registersfpu:=hp.registersfpu;
{$ifdef SUPPORT_MMX}
if hp.registersmmx>registersmmx then
registersmmx:=hp.registersmmx;
{$endif}
expectloc:=hp.expectloc;
inc(count);
hp:=tstatementnode(hp.right);
end;
end;
{$ifdef state_tracking}
function Tblocknode.track_state_pass(exec_known:boolean):boolean;
var hp:Tstatementnode;
begin
track_state_pass:=false;
hp:=Tstatementnode(left);
while assigned(hp) do
begin
if hp.left.track_state_pass(exec_known) then
track_state_pass:=true;
hp:=Tstatementnode(hp.right);
end;
end;
{$endif state_tracking}
{*****************************************************************************
TASMNODE
*****************************************************************************}
constructor tasmnode.create(p : taasmoutput);
begin
inherited create(asmn);
p_asm:=p;
getposition:=false;
currenttai:=nil;
used_regs_int:=[];
used_regs_fpu:=[];
end;
constructor tasmnode.create_get_position;
begin
inherited create(asmn);
p_asm:=nil;
getposition:=true;
currenttai:=nil;
end;
destructor tasmnode.destroy;
begin
if assigned(p_asm) then
p_asm.free;
inherited destroy;
end;
constructor tasmnode.ppuload(t:tnodetype;ppufile:tcompilerppufile);
var
hp : tai;
begin
inherited ppuload(t,ppufile);
getposition:=boolean(ppufile.getbyte);
if not getposition then
begin
p_asm:=taasmoutput.create;
repeat
hp:=ppuloadai(ppufile);
if hp=nil then
break;
p_asm.concat(hp);
until false;
end
else
p_asm:=nil;
currenttai:=nil;
end;
procedure tasmnode.ppuwrite(ppufile:tcompilerppufile);
var
hp : tai;
begin
inherited ppuwrite(ppufile);
ppufile.putbyte(byte(getposition));
{$warning FIXME Add saving of register sets}
if not getposition then
begin
hp:=tai(p_asm.first);
while assigned(hp) do
begin
ppuwriteai(ppufile,hp);
hp:=tai(hp.next);
end;
{ end is marked by a nil }
ppuwriteai(ppufile,nil);
end;
end;
procedure tasmnode.buildderefimpl;
var
hp : tai;
begin
inherited buildderefimpl;
if not getposition then
begin
hp:=tai(p_asm.first);
while assigned(hp) do
begin
hp.buildderefimpl;
hp:=tai(hp.next);
end;
end;
end;
procedure tasmnode.derefimpl;
var
hp : tai;
begin
inherited derefimpl;
if not getposition then
begin
hp:=tai(p_asm.first);
while assigned(hp) do
begin
hp.derefimpl;
hp:=tai(hp.next);
end;
end;
end;
function tasmnode.getcopy: tnode;
var
n: tasmnode;
begin
n := tasmnode(inherited getcopy);
if assigned(p_asm) then
begin
n.p_asm:=taasmoutput.create;
n.p_asm.concatlistcopy(p_asm);
end
else n.p_asm := nil;
n.getposition:=getposition;
n.currenttai:=currenttai;
getcopy := n;
end;
function tasmnode.det_resulttype:tnode;
begin
result:=nil;
resulttype:=voidtype;
if not getposition then
include(current_procinfo.flags,pi_uses_asm);
end;
function tasmnode.pass_1 : tnode;
begin
result:=nil;
expectloc:=LOC_VOID;
end;
function tasmnode.docompare(p: tnode): boolean;
begin
{ comparing of asmlists is not implemented (JM) }
docompare := false;
end;
{*****************************************************************************
TEMPCREATENODE
*****************************************************************************}
constructor ttempcreatenode.create(const _restype: ttype; _size: longint; _temptype: ttemptype);
begin
inherited create(tempcreaten);
size := _size;
new(tempinfo);
fillchar(tempinfo^,sizeof(tempinfo^),0);
tempinfo^.restype := _restype;
tempinfo^.temptype := _temptype;
tempinfo^.owner:=self;
end;
function ttempcreatenode.getcopy: tnode;
var
n: ttempcreatenode;
begin
n := ttempcreatenode(inherited getcopy);
n.size := size;
new(n.tempinfo);
fillchar(n.tempinfo^,sizeof(n.tempinfo^),0);
n.tempinfo^.owner:=n;
n.tempinfo^.restype := tempinfo^.restype;
n.tempinfo^.temptype := tempinfo^.temptype;
{ when the tempinfo has already a hookoncopy then it is not
reset by a tempdeletenode }
if assigned(tempinfo^.hookoncopy) then
internalerror(200211262);
{ signal the temprefs that the temp they point to has been copied, }
{ so that if the refs get copied as well, they can hook themselves }
{ to the copy of the temp }
tempinfo^.hookoncopy := n.tempinfo;
tempinfo^.nextref_set_hookoncopy_nil := false;
result := n;
end;
constructor ttempcreatenode.ppuload(t:tnodetype;ppufile:tcompilerppufile);
begin
inherited ppuload(t,ppufile);
size:=ppufile.getlongint;
new(tempinfo);
fillchar(tempinfo^,sizeof(tempinfo^),0);
ppufile.gettype(tempinfo^.restype);
tempinfo^.temptype := ttemptype(ppufile.getbyte);
tempinfo^.owner:=self;
end;
procedure ttempcreatenode.ppuwrite(ppufile:tcompilerppufile);
begin
inherited ppuwrite(ppufile);
ppufile.putlongint(size);
ppufile.puttype(tempinfo^.restype);
ppufile.putbyte(byte(tempinfo^.temptype));
end;
procedure ttempcreatenode.buildderefimpl;
begin
tempinfo^.restype.buildderef;
end;
procedure ttempcreatenode.derefimpl;
begin
tempinfo^.restype.resolve;
end;
function ttempcreatenode.pass_1 : tnode;
begin
result := nil;
expectloc:=LOC_VOID;
end;
function ttempcreatenode.det_resulttype: tnode;
begin
result := nil;
{ a tempcreatenode doesn't have a resulttype, only temprefnodes do }
resulttype := voidtype;
end;
function ttempcreatenode.docompare(p: tnode): boolean;
begin
result :=
inherited docompare(p) and
(ttempcreatenode(p).size = size) and
equal_defs(ttempcreatenode(p).tempinfo^.restype.def,tempinfo^.restype.def);
end;
procedure ttempcreatenode.printnodedata(var t:text);
begin
inherited printnodedata(t);
writeln(t,printnodeindention,'size = ',size);
end;
{*****************************************************************************
TEMPREFNODE
*****************************************************************************}
constructor ttemprefnode.create(const temp: ttempcreatenode);
begin
inherited create(temprefn);
tempinfo := temp.tempinfo;
offset:=0;
end;
constructor ttemprefnode.create_offset(const temp: ttempcreatenode;aoffset:longint);
begin
self.create(temp);
offset := aoffset;
end;
function ttemprefnode.getcopy: tnode;
var
n: ttemprefnode;
begin
n := ttemprefnode(inherited getcopy);
n.offset := offset;
if assigned(tempinfo^.hookoncopy) then
{ if the temp has been copied, assume it becomes a new }
{ temp which has to be hooked by the copied reference }
begin
{ hook the ref to the copied temp }
n.tempinfo := tempinfo^.hookoncopy;
{ if we passed a ttempdeletenode that changed the temp }
{ from a persistent one into a normal one, we must be }
{ the last reference (since our parent should free the }
{ temp (JM) }
if (tempinfo^.nextref_set_hookoncopy_nil) then
tempinfo^.hookoncopy := nil;
end
else
{ if the temp we refer to hasn't been copied, assume }
{ we're just a new reference to that temp }
begin
n.tempinfo := tempinfo;
end;
result := n;
end;
constructor ttemprefnode.ppuload(t:tnodetype;ppufile:tcompilerppufile);
begin
inherited ppuload(t,ppufile);
tempidx:=ppufile.getlongint;
offset:=ppufile.getlongint;
end;
procedure ttemprefnode.ppuwrite(ppufile:tcompilerppufile);
begin
inherited ppuwrite(ppufile);
ppufile.putlongint(tempinfo^.owner.ppuidx);
ppufile.putlongint(offset);
end;
procedure ttemprefnode.derefnode;
var
temp : ttempcreatenode;
begin
temp:=ttempcreatenode(nodeppuidxget(tempidx));
if temp.nodetype<>tempcreaten then
internalerror(200311075);
tempinfo:=temp.tempinfo;
end;
function ttemprefnode.pass_1 : tnode;
begin
expectloc:=LOC_REFERENCE;
result := nil;
end;
function ttemprefnode.det_resulttype: tnode;
begin
{ check if the temp is already resulttype passed }
if not assigned(tempinfo^.restype.def) then
internalerror(200108233);
result := nil;
resulttype := tempinfo^.restype;
end;
function ttemprefnode.docompare(p: tnode): boolean;
begin
result :=
inherited docompare(p) and
(ttemprefnode(p).tempinfo = tempinfo) and
(ttemprefnode(p).offset = offset);
end;
procedure Ttemprefnode.mark_write;
begin
include(flags,nf_write);
end;
{*****************************************************************************
TEMPDELETENODE
*****************************************************************************}
constructor ttempdeletenode.create(const temp: ttempcreatenode);
begin
inherited create(tempdeleten);
tempinfo := temp.tempinfo;
release_to_normal := false;
end;
constructor ttempdeletenode.create_normal_temp(const temp: ttempcreatenode);
begin
inherited create(tempdeleten);
tempinfo := temp.tempinfo;
release_to_normal := true;
if tempinfo^.temptype <> tt_persistent then
internalerror(200204211);
end;
function ttempdeletenode.getcopy: tnode;
var
n: ttempdeletenode;
begin
n := ttempdeletenode(inherited getcopy);
n.release_to_normal := release_to_normal;
if assigned(tempinfo^.hookoncopy) then
{ if the temp has been copied, assume it becomes a new }
{ temp which has to be hooked by the copied deletenode }
begin
{ hook the tempdeletenode to the copied temp }
n.tempinfo := tempinfo^.hookoncopy;
{ the temp shall not be used, reset hookoncopy }
{ Only if release_to_normal is false, otherwise }
{ the temp can still be referenced once more (JM) }
if (not release_to_normal) then
tempinfo^.hookoncopy:=nil
else
tempinfo^.nextref_set_hookoncopy_nil := true;
end
else
{ if the temp we refer to hasn't been copied, we have a }
{ problem since that means we now have two delete nodes }
{ for one temp }
internalerror(200108234);
result := n;
end;
constructor ttempdeletenode.ppuload(t:tnodetype;ppufile:tcompilerppufile);
begin
inherited ppuload(t,ppufile);
tempidx:=ppufile.getlongint;
release_to_normal:=(ppufile.getbyte<>0);
end;
procedure ttempdeletenode.ppuwrite(ppufile:tcompilerppufile);
begin
inherited ppuwrite(ppufile);
ppufile.putlongint(tempinfo^.owner.ppuidx);
ppufile.putbyte(byte(release_to_normal));
end;
procedure ttempdeletenode.derefnode;
var
temp : ttempcreatenode;
begin
temp:=ttempcreatenode(nodeppuidxget(tempidx));
if temp.nodetype<>tempcreaten then
internalerror(200311075);
tempinfo:=temp.tempinfo;
end;
function ttempdeletenode.pass_1 : tnode;
begin
expectloc:=LOC_VOID;
result := nil;
end;
function ttempdeletenode.det_resulttype: tnode;
begin
result := nil;
resulttype := voidtype;
end;
function ttempdeletenode.docompare(p: tnode): boolean;
begin
result :=
inherited docompare(p) and
(ttemprefnode(p).tempinfo = tempinfo);
end;
destructor ttempdeletenode.destroy;
begin
dispose(tempinfo);
end;
begin
cnothingnode:=tnothingnode;
cerrornode:=terrornode;
casmnode:=tasmnode;
cstatementnode:=tstatementnode;
cblocknode:=tblocknode;
ctempcreatenode:=ttempcreatenode;
ctemprefnode:=ttemprefnode;
ctempdeletenode:=ttempdeletenode;
end.
{
$Log: nbas.pas,v $
Revision 1.74 2003/12/10 20:31:40 jonas
* override tblocknode.destroy so all statements are freed sequentially
instead of recusively.
Revision 1.73 2003/11/10 22:02:52 peter
* cross unit inlining fixed
Revision 1.72 2003/11/04 15:35:13 peter
* fix for referencecounted temps
Revision 1.71 2003/10/31 15:51:47 peter
* fix crashes in asmnode.deref when p_asm=nil
Revision 1.70 2003/10/29 20:34:20 peter
* move check for unused object constructor result to blocknode
Revision 1.69 2003/10/23 14:44:07 peter
* splitted buildderef and buildderefimpl to fix interface crc
calculation
Revision 1.68 2003/10/22 20:40:00 peter
* write derefdata in a separate ppu entry
Revision 1.67 2003/10/21 18:15:16 peter
* fixed check for $X- result usage
Revision 1.66 2003/10/19 01:34:30 florian
* some ppc stuff fixed
* memory leak fixed
Revision 1.65 2003/10/17 14:38:32 peter
* 64k registers supported
* fixed some memory leaks
Revision 1.64 2003/10/10 17:48:13 peter
* old trgobj moved to x86/rgcpu and renamed to trgx86fpu
* tregisteralloctor renamed to trgobj
* removed rgobj from a lot of units
* moved location_* and reference_* to cgobj
* first things for mmx register allocation
Revision 1.63 2003/10/01 20:34:48 peter
* procinfo unit contains tprocinfo
* cginfo renamed to cgbase
* moved cgmessage to verbose
* fixed ppc and sparc compiles
Revision 1.62 2003/09/23 17:56:05 peter
* locals and paras are allocated in the code generation
* tvarsym.localloc contains the location of para/local when
generating code for the current procedure
Revision 1.61 2003/09/07 22:09:35 peter
* preparations for different default calling conventions
* various RA fixes
Revision 1.60 2003/09/03 15:55:00 peter
* NEWRA branch merged
Revision 1.59.2.1 2003/08/27 20:23:55 peter
* remove old ra code
Revision 1.59 2003/08/09 18:56:54 daniel
* cs_regalloc renamed to cs_regvars to avoid confusion with register
allocator
* Some preventive changes to i386 spillinh code
Revision 1.58 2003/06/13 21:19:30 peter
* current_procdef removed, use current_procinfo.procdef instead
Revision 1.57 2003/06/10 09:10:47 jonas
* patch from Peter to fix tempinfo copying
Revision 1.56 2003/06/09 18:26:46 peter
* remove temptype, use tempinfo.temptype instead
Revision 1.55 2003/06/09 12:20:47 peter
* getposition added to retrieve the the current tai item
Revision 1.54 2003/06/08 18:27:15 jonas
+ ability to change the location of a ttempref node with changelocation()
method. Useful to use instead of copying the contents from one temp to
another
+ some shortstring optimizations in tassignmentnode that avoid some
copying (required some shortstring optimizations to be moved from
resulttype to firstpass, because they work on callnodes and string
addnodes are only changed to callnodes in the firstpass)
* allow setting/changing the funcretnode of callnodes after the
resulttypepass has been done, funcretnode is now a property
(all of the above should have a quite big effect on callparatemp)
Revision 1.53 2003/05/30 21:01:44 jonas
- disabled "result := value; exit;" -> exit(value) optimization because
a) it was wrong
b) exit(value) works now exactly the same as that
(it was only activated with -Or)
Revision 1.52 2003/05/23 14:27:35 peter
* remove some unit dependencies
* current_procinfo changes to store more info
Revision 1.51 2003/05/17 13:30:08 jonas
* changed tt_persistant to tt_persistent :)
* tempcreatenode now doesn't accept a boolean anymore for persistent
temps, but a ttemptype, so you can also create ansistring temps etc
Revision 1.50 2003/05/13 19:14:41 peter
* failn removed
* inherited result code check moven to pexpr
Revision 1.49 2003/05/11 14:45:12 peter
* tloadnode does not support objectsymtable,withsymtable anymore
* withnode cleanup
* direct with rewritten to use temprefnode
Revision 1.48 2003/04/27 11:21:33 peter
* aktprocdef renamed to current_procinfo.procdef
* procinfo renamed to current_procinfo
* procinfo will now be stored in current_module so it can be
cleaned up properly
* gen_main_procsym changed to create_main_proc and release_main_proc
to also generate a tprocinfo structure
* fixed unit implicit initfinal
Revision 1.47 2003/04/25 20:59:33 peter
* removed funcretn,funcretsym, function result is now in varsym
and aliases for result and function name are added using absolutesym
* vs_hidden parameter for funcret passed in parameter
* vs_hidden fixes
* writenode changed to printnode and released from extdebug
* -vp option added to generate a tree.log with the nodetree
* nicer printnode for statements, callnode
Revision 1.46 2002/04/25 20:15:39 florian
* block nodes within expressions shouldn't release the used registers,
fixed using a flag till the new rg is ready
Revision 1.45 2003/04/23 08:41:34 jonas
* fixed ttemprefnode.compare and .getcopy to take offset field into
account
Revision 1.44 2003/04/22 23:50:22 peter
* firstpass uses expectloc
* checks if there are differences between the expectloc and
location.loc from secondpass in EXTDEBUG
Revision 1.43 2003/04/21 15:00:22 jonas
* fixed tstatementnode.det_resulttype and tststatementnode.pass_1
* fixed some getcopy issues with ttemp*nodes
Revision 1.42 2003/04/17 07:50:24 daniel
* Some work on interference graph construction
Revision 1.41 2003/04/12 14:53:59 jonas
* ttempdeletenode.create now sets the nodetype to tempdeleten instead of
temprefn
Revision 1.40 2003/03/17 20:30:46 peter
* errornode.mark_write added
Revision 1.39 2003/01/03 12:15:55 daniel
* Removed ifdefs around notifications
ifdefs around for loop optimizations remain
Revision 1.38 2002/11/27 02:37:12 peter
* case statement inlining added
* fixed inlining of write()
* switched statementnode left and right parts so the statements are
processed in the correct order when getcopy is used. This is
required for tempnodes
Revision 1.37 2002/11/25 17:43:17 peter
* splitted defbase in defutil,symutil,defcmp
* merged isconvertable and is_equal into compare_defs(_ext)
* made operator search faster by walking the list only once
Revision 1.36 2002/10/05 15:15:19 peter
* don't complain in X- mode for internal generated function calls
with funcretrefnode set
* give statement error at the correct line position instead of the
block begin
Revision 1.35 2002/09/01 08:01:16 daniel
* Removed sets from Tcallnode.det_resulttype
+ Added read/write notifications of variables. These will be usefull
for providing information for several optimizations. For example
the value of the loop variable of a for loop does matter is the
variable is read after the for loop, but if it's no longer used
or written, it doesn't matter and this can be used to optimize
the loop code generation.
Revision 1.34 2002/08/18 20:06:23 peter
* inlining is now also allowed in interface
* renamed write/load to ppuwrite/ppuload
* tnode storing in ppu
* nld,ncon,nbas are already updated for storing in ppu
Revision 1.33 2002/08/17 22:09:44 florian
* result type handling in tcgcal.pass_2 overhauled
* better tnode.printnodetree
* some ppc stuff fixed
Revision 1.32 2002/08/17 09:23:34 florian
* first part of procinfo rewrite
Revision 1.31 2002/08/15 19:10:35 peter
* first things tai,tnode storing in ppu
Revision 1.30 2002/07/20 11:57:53 florian
* types.pas renamed to defbase.pas because D6 contains a types
unit so this would conflicts if D6 programms are compiled
+ Willamette/SSE2 instructions to assembler added
Revision 1.29 2002/07/19 11:41:35 daniel
* State tracker work
* The whilen and repeatn are now completely unified into whilerepeatn. This
allows the state tracker to change while nodes automatically into
repeat nodes.
* Resulttypepass improvements to the notn. 'not not a' is optimized away and
'not(a>b)' is optimized into 'a<=b'.
* Resulttypepass improvements to the whilerepeatn. 'while not a' is optimized
by removing the notn and later switchting the true and falselabels. The
same is done with 'repeat until not a'.
Revision 1.28 2002/07/14 18:00:43 daniel
+ Added the beginning of a state tracker. This will track the values of
variables through procedures and optimize things away.
Revision 1.27 2002/07/01 18:46:22 peter
* internal linker
* reorganized aasm layer
Revision 1.26 2002/06/24 12:43:00 jonas
* fixed errors found with new -CR code from Peter when cycling with -O2p3r
Revision 1.25 2002/05/18 13:34:09 peter
* readded missing revisions
Revision 1.24 2002/05/16 19:46:37 carl
+ defines.inc -> fpcdefs.inc to avoid conflicts if compiling by hand
+ try to fix temp allocation (still in ifdef)
+ generic constructor calls
+ start of tassembler / tmodulebase class cleanup
Revision 1.22 2002/04/23 19:16:34 peter
* add pinline unit that inserts compiler supported functions using
one or more statements
* moved finalize and setlength from ninl to pinline
Revision 1.21 2002/04/21 19:02:03 peter
* removed newn and disposen nodes, the code is now directly
inlined from pexpr
* -an option that will write the secondpass nodes to the .s file, this
requires EXTDEBUG define to actually write the info
* fixed various internal errors and crashes due recent code changes
Revision 1.20 2002/04/04 19:05:57 peter
* removed unused units
* use tlocation.size in cg.a_*loc*() routines
Revision 1.19 2002/03/31 20:26:33 jonas
+ a_loadfpu_* and a_loadmm_* methods in tcg
* register allocation is now handled by a class and is mostly processor
independent (+rgobj.pas and i386/rgcpu.pas)
* temp allocation is now handled by a class (+tgobj.pas, -i386\tgcpu.pas)
* some small improvements and fixes to the optimizer
* some register allocation fixes
* some fpuvaroffset fixes in the unary minus node
* push/popusedregisters is now called rg.save/restoreusedregisters and
(for i386) uses temps instead of push/pop's when using -Op3 (that code is
also better optimizable)
* fixed and optimized register saving/restoring for new/dispose nodes
* LOC_FPU locations now also require their "register" field to be set to
R_ST, not R_ST0 (the latter is used for LOC_CFPUREGISTER locations only)
- list field removed of the tnode class because it's not used currently
and can cause hard-to-find bugs
}
syntax highlighted by Code2HTML, v. 0.9.1