mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-10-31 14:31:38 +01:00
899 lines
26 KiB
ObjectPascal
899 lines
26 KiB
ObjectPascal
{
|
|
$Id$
|
|
Copyright (c) 2000-2002 by Florian Klaempfl
|
|
|
|
Basic node handling
|
|
|
|
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 node;
|
|
|
|
{$i fpcdefs.inc}
|
|
|
|
interface
|
|
|
|
uses
|
|
cclasses,
|
|
globtype,globals,
|
|
cpubase,
|
|
aasmbase,
|
|
symtype;
|
|
|
|
type
|
|
pconstset = ^tconstset;
|
|
{$ifdef oldset}
|
|
tconstset = array[0..31] of byte;
|
|
pconst32bitset = ^tconst32bitset;
|
|
tconst32bitset = array[0..7] of longint;
|
|
{$else}
|
|
tconstset = set of 0..255;
|
|
{$endif}
|
|
|
|
tnodetype = (
|
|
addn, {Represents the + operator.}
|
|
muln, {Represents the * operator.}
|
|
subn, {Represents the - operator.}
|
|
divn, {Represents the div operator.}
|
|
symdifn, {Represents the >< operator.}
|
|
modn, {Represents the mod operator.}
|
|
assignn, {Represents an assignment.}
|
|
loadn, {Represents the use of a variabele.}
|
|
rangen, {Represents a range (i.e. 0..9).}
|
|
ltn, {Represents the < operator.}
|
|
lten, {Represents the <= operator.}
|
|
gtn, {Represents the > operator.}
|
|
gten, {Represents the >= operator.}
|
|
equaln, {Represents the = operator.}
|
|
unequaln, {Represents the <> operator.}
|
|
inn, {Represents the in operator.}
|
|
orn, {Represents the or operator.}
|
|
xorn, {Represents the xor operator.}
|
|
shrn, {Represents the shr operator.}
|
|
shln, {Represents the shl operator.}
|
|
slashn, {Represents the / operator.}
|
|
andn, {Represents the and operator.}
|
|
subscriptn, {??? Field in a record/object?}
|
|
derefn, {Dereferences a pointer.}
|
|
addrn, {Represents the @ operator.}
|
|
doubleaddrn, {Represents the @@ operator.}
|
|
ordconstn, {Represents an ordinal value.}
|
|
typeconvn, {Represents type-conversion/typecast.}
|
|
calln, {Represents a call node.}
|
|
callparan, {Represents a parameter.}
|
|
realconstn, {Represents a real value.}
|
|
unaryminusn, {Represents a sign change (i.e. -2).}
|
|
asmn, {Represents an assembler node }
|
|
vecn, {Represents array indexing.}
|
|
pointerconstn,
|
|
stringconstn, {Represents a string constant.}
|
|
funcretn, {Represents the function result var.}
|
|
selfn, {Represents the self parameter.}
|
|
notn, {Represents the not operator.}
|
|
inlinen, {Internal procedures (i.e. writeln).}
|
|
niln, {Represents the nil pointer.}
|
|
errorn, {This part of the tree could not be
|
|
parsed because of a compiler error.}
|
|
typen, {A type name. Used for i.e. typeof(obj).}
|
|
hnewn, {The new operation, constructor call.}
|
|
hdisposen, {The dispose operation with destructor call.}
|
|
setelementn, {A set element(s) (i.e. [a,b] and also [a..b]).}
|
|
setconstn, {A set constant (i.e. [1,2]).}
|
|
blockn, {A block of statements.}
|
|
statementn, {One statement in a block of nodes.}
|
|
loopn, { used in genloopnode, must be converted }
|
|
ifn, {An if statement.}
|
|
breakn, {A break statement.}
|
|
continuen, {A continue statement.}
|
|
(* repeatn, {A repeat until block.}
|
|
whilen, {A while do statement.}*)
|
|
whilerepeatn, {A while or repeat statement.}
|
|
forn, {A for loop.}
|
|
exitn, {An exit statement.}
|
|
withn, {A with statement.}
|
|
casen, {A case statement.}
|
|
labeln, {A label.}
|
|
goton, {A goto statement.}
|
|
tryexceptn, {A try except block.}
|
|
raisen, {A raise statement.}
|
|
tryfinallyn, {A try finally statement.}
|
|
onn, {For an on statement in exception code.}
|
|
isn, {Represents the is operator.}
|
|
asn, {Represents the as typecast.}
|
|
caretn, {Represents the ^ operator.}
|
|
failn, {Represents the fail statement.}
|
|
starstarn, {Represents the ** operator exponentiation }
|
|
procinlinen, {Procedures that can be inlined }
|
|
arrayconstructorn, {Construction node for [...] parsing}
|
|
arrayconstructorrangen, {Range element to allow sets in array construction tree}
|
|
tempn, { for temps in the result/firstpass }
|
|
temprefn, { references to temps }
|
|
{ added for optimizations where we cannot suppress }
|
|
addoptn,
|
|
nothingn,
|
|
loadvmtn,
|
|
guidconstn,
|
|
rttin {Rtti information so they can be accessed in result/firstpass.}
|
|
);
|
|
|
|
const
|
|
nodetype2str : array[tnodetype] of string[20] = (
|
|
'addn',
|
|
'muln',
|
|
'subn',
|
|
'divn',
|
|
'symdifn',
|
|
'modn',
|
|
'assignn',
|
|
'loadn',
|
|
'rangen',
|
|
'ltn',
|
|
'lten',
|
|
'gtn',
|
|
'gten',
|
|
'equaln',
|
|
'unequaln',
|
|
'inn',
|
|
'orn',
|
|
'xorn',
|
|
'shrn',
|
|
'shln',
|
|
'slashn',
|
|
'andn',
|
|
'subscriptn',
|
|
'derefn',
|
|
'addrn',
|
|
'doubleaddrn',
|
|
'ordconstn',
|
|
'typeconvn',
|
|
'calln',
|
|
'callparan',
|
|
'realconstn',
|
|
'umminusn',
|
|
'asmn',
|
|
'vecn',
|
|
'pointerconstn',
|
|
'stringconstn',
|
|
'funcretn',
|
|
'selfn',
|
|
'notn',
|
|
'inlinen',
|
|
'niln',
|
|
'errorn',
|
|
'typen',
|
|
'hnewn',
|
|
'hdisposen',
|
|
'setelementn',
|
|
'setconstn',
|
|
'blockn',
|
|
'statementn',
|
|
'loopn',
|
|
'ifn',
|
|
'breakn',
|
|
'continuen',
|
|
(* 'repeatn',
|
|
'whilen',*)
|
|
'whilerepeatn',
|
|
'forn',
|
|
'exitn',
|
|
'withn',
|
|
'casen',
|
|
'labeln',
|
|
'goton',
|
|
'tryexceptn',
|
|
'raisen',
|
|
'tryfinallyn',
|
|
'onn',
|
|
'isn',
|
|
'asn',
|
|
'caretn',
|
|
'failn',
|
|
'starstarn',
|
|
'procinlinen',
|
|
'arrayconstructn',
|
|
'arrayconstructrangen',
|
|
'tempn',
|
|
'temprefn',
|
|
'addoptn',
|
|
'nothingn',
|
|
'loadvmtn',
|
|
'guidconstn',
|
|
'rttin');
|
|
|
|
type
|
|
{ all boolean field of ttree are now collected in flags }
|
|
tnodeflags = (
|
|
nf_needs_truefalselabel,
|
|
nf_swapable, { tbinop operands can be swaped }
|
|
nf_swaped, { tbinop operands are swaped }
|
|
nf_error,
|
|
|
|
{ flags used by tcallnode }
|
|
nf_return_value_used,
|
|
nf_static_call,
|
|
|
|
{ flags used by tcallparanode }
|
|
nf_varargs_para, { belongs this para to varargs }
|
|
|
|
{ flags used by loop nodes }
|
|
nf_backward, { set if it is a for ... downto ... do loop }
|
|
nf_varstate, { do we need to parse childs to set var state }
|
|
nf_testatbegin,{ Do a test at the begin of the loop?}
|
|
nf_checknegate,{ Negate the loop test?}
|
|
|
|
{ taddrnode }
|
|
nf_procvarload,
|
|
|
|
{ tvecnode }
|
|
nf_memindex,
|
|
nf_memseg,
|
|
nf_callunique,
|
|
|
|
{ twithnode }
|
|
nf_islocal,
|
|
|
|
{ tloadnode }
|
|
nf_absolute,
|
|
nf_first,
|
|
|
|
{ tassignmentnode }
|
|
nf_concat_string,
|
|
|
|
{ tfuncretnode }
|
|
nf_is_first_funcret, { 20th }
|
|
|
|
{ tarrayconstructnode }
|
|
nf_cargs,
|
|
nf_cargswap,
|
|
nf_forcevaria,
|
|
nf_novariaallowed,
|
|
|
|
{ ttypeconvnode }
|
|
nf_explizit,
|
|
|
|
{ tinlinenode }
|
|
nf_inlineconst,
|
|
|
|
{ general }
|
|
nf_isproperty,
|
|
nf_varstateset,
|
|
|
|
{ tasmnode }
|
|
nf_object_preserved,
|
|
|
|
{ taddnode }
|
|
nf_use_strconcat
|
|
);
|
|
|
|
tnodeflagset = set of tnodeflags;
|
|
|
|
const
|
|
{ contains the flags which must be equal for the equality }
|
|
{ of nodes }
|
|
flagsequal : tnodeflagset = [nf_error,nf_static_call,nf_backward];
|
|
|
|
type
|
|
tnodelist = class
|
|
end;
|
|
|
|
{ later (for the newcg) tnode will inherit from tlinkedlist_item }
|
|
tnode = class
|
|
public
|
|
{ type of this node }
|
|
nodetype : tnodetype;
|
|
{ type of the current code block, general/const/type }
|
|
blocktype : tblock_type;
|
|
{ the location of the result of this node }
|
|
location : tlocation;
|
|
{ the parent node of this is node }
|
|
{ this field is set by concattolist }
|
|
parent : tnode;
|
|
{ there are some properties about the node stored }
|
|
flags : tnodeflagset;
|
|
{ the number of registers needed to evalute the node }
|
|
registers32,registersfpu : longint; { must be longint !!!! }
|
|
{$ifdef SUPPORT_MMX}
|
|
registersmmx,registerskni : longint;
|
|
{$endif SUPPORT_MMX}
|
|
resulttype : ttype;
|
|
fileinfo : tfileposinfo;
|
|
localswitches : tlocalswitches;
|
|
{$ifdef extdebug}
|
|
maxfirstpasscount,
|
|
firstpasscount : longint;
|
|
{$endif extdebug}
|
|
{$ifdef TEMPS_NOT_PUSH}
|
|
temp_offset: longint;
|
|
{$endif TEMPS_NOT_PUSH}
|
|
{ list : taasmoutput; }
|
|
constructor create(tt : tnodetype);
|
|
{ this constructor is only for creating copies of class }
|
|
{ the fields are copied by getcopy }
|
|
constructor createforcopy;
|
|
destructor destroy;override;
|
|
|
|
{ toggles the flag }
|
|
procedure toggleflag(f : tnodeflags);
|
|
|
|
{ the 1.1 code generator may override pass_1 }
|
|
{ and it need not to implement det_* then }
|
|
{ 1.1: pass_1 returns a value<>0 if the node has been transformed }
|
|
{ 2.0: runs det_resulttype and det_temp }
|
|
function pass_1 : tnode;virtual;abstract;
|
|
{ dermines the resulttype of the node }
|
|
function det_resulttype : tnode;virtual;abstract;
|
|
{ dermines the number of necessary temp. locations to evaluate
|
|
the node }
|
|
{$ifdef state_tracking}
|
|
{ Does optimizations by keeping track of the variable states
|
|
in a procedure }
|
|
function track_state_pass(exec_known:boolean):boolean;virtual;
|
|
{$endif}
|
|
procedure det_temp;virtual;abstract;
|
|
|
|
procedure pass_2;virtual;abstract;
|
|
|
|
{ comparing of nodes }
|
|
function isequal(p : tnode) : boolean;
|
|
{ to implement comparisation, override this method }
|
|
function docompare(p : tnode) : boolean;virtual;
|
|
{ gets a copy of the node }
|
|
function getcopy : tnode;virtual;
|
|
|
|
procedure insertintolist(l : tnodelist);virtual;
|
|
{$ifdef EXTDEBUG}
|
|
{ writes a node for debugging purpose, shouldn't be called }
|
|
{ direct, because there is no test for nil, use writenode }
|
|
{ to write a complete tree }
|
|
procedure dowrite;virtual;
|
|
procedure dowritenodetype;virtual;
|
|
{$endif EXTDEBUG}
|
|
procedure concattolist(l : tlinkedlist);virtual;
|
|
function ischild(p : tnode) : boolean;virtual;
|
|
procedure set_file_line(from : tnode);
|
|
procedure set_tree_filepos(const filepos : tfileposinfo);
|
|
end;
|
|
|
|
{ this node is the anchestor for all nodes with at least }
|
|
{ one child, you have to use it if you want to use }
|
|
{ true- and falselabel }
|
|
tparentnode = class(tnode)
|
|
{$ifdef newcg}
|
|
falselabel,truelabel : tasmlabel;
|
|
{$endif newcg}
|
|
end;
|
|
|
|
tnodeclass = class of tnode;
|
|
|
|
punarynode = ^tunarynode;
|
|
tunarynode = class(tparentnode)
|
|
left : tnode;
|
|
constructor create(tt : tnodetype;l : tnode);
|
|
destructor destroy;override;
|
|
procedure concattolist(l : tlinkedlist);override;
|
|
function ischild(p : tnode) : boolean;override;
|
|
function docompare(p : tnode) : boolean;override;
|
|
function getcopy : tnode;override;
|
|
procedure insertintolist(l : tnodelist);override;
|
|
procedure left_max;
|
|
{$ifdef extdebug}
|
|
procedure dowrite;override;
|
|
{$endif extdebug}
|
|
end;
|
|
|
|
pbinarynode = ^tbinarynode;
|
|
tbinarynode = class(tunarynode)
|
|
right : tnode;
|
|
constructor create(tt : tnodetype;l,r : tnode);
|
|
destructor destroy;override;
|
|
procedure concattolist(l : tlinkedlist);override;
|
|
function ischild(p : tnode) : boolean;override;
|
|
function docompare(p : tnode) : boolean;override;
|
|
procedure swapleftright;
|
|
function getcopy : tnode;override;
|
|
procedure insertintolist(l : tnodelist);override;
|
|
procedure left_right_max;
|
|
{$ifdef extdebug}
|
|
procedure dowrite;override;
|
|
{$endif extdebug}
|
|
end;
|
|
|
|
pbinopnode = ^tbinopnode;
|
|
tbinopnode = class(tbinarynode)
|
|
constructor create(tt : tnodetype;l,r : tnode);virtual;
|
|
function docompare(p : tnode) : boolean;override;
|
|
end;
|
|
|
|
{$ifdef EXTDEBUG}
|
|
var
|
|
writenodeindention : string;
|
|
|
|
procedure writenode(t:tnode);
|
|
{$endif EXTDEBUG}
|
|
|
|
{$ifdef tempregdebug}
|
|
type
|
|
pptree = ^tnode;
|
|
var
|
|
curptree: pptree;
|
|
{$endif tempregdebug}
|
|
|
|
implementation
|
|
|
|
uses
|
|
cutils;
|
|
|
|
{****************************************************************************
|
|
TNODE
|
|
****************************************************************************}
|
|
|
|
constructor tnode.create(tt : tnodetype);
|
|
|
|
begin
|
|
inherited create;
|
|
nodetype:=tt;
|
|
blocktype:=block_type;
|
|
{ this allows easier error tracing }
|
|
location.loc:=LOC_INVALID;
|
|
{ save local info }
|
|
fileinfo:=aktfilepos;
|
|
localswitches:=aktlocalswitches;
|
|
resulttype.reset;
|
|
registers32:=0;
|
|
registersfpu:=0;
|
|
{$ifdef SUPPORT_MMX}
|
|
registersmmx:=0;
|
|
{$endif SUPPORT_MMX}
|
|
{$ifdef EXTDEBUG}
|
|
maxfirstpasscount:=0;
|
|
firstpasscount:=0;
|
|
{$endif EXTDEBUG}
|
|
flags:=[];
|
|
end;
|
|
|
|
constructor tnode.createforcopy;
|
|
|
|
begin
|
|
end;
|
|
|
|
procedure tnode.toggleflag(f : tnodeflags);
|
|
|
|
begin
|
|
if f in flags then
|
|
exclude(flags,f)
|
|
else
|
|
include(flags,f);
|
|
end;
|
|
|
|
destructor tnode.destroy;
|
|
|
|
begin
|
|
{$ifdef EXTDEBUG}
|
|
if firstpasscount>maxfirstpasscount then
|
|
maxfirstpasscount:=firstpasscount;
|
|
{$endif EXTDEBUG}
|
|
end;
|
|
|
|
|
|
procedure tnode.concattolist(l : tlinkedlist);
|
|
|
|
begin
|
|
{$ifdef newcg}
|
|
//!!!!!!! l^.concat(self);
|
|
{$warning fixme}
|
|
{$endif newcg}
|
|
end;
|
|
|
|
function tnode.ischild(p : tnode) : boolean;
|
|
|
|
begin
|
|
ischild:=false;
|
|
end;
|
|
|
|
{$ifdef EXTDEBUG}
|
|
procedure tnode.dowrite;
|
|
begin
|
|
dowritenodetype;
|
|
end;
|
|
|
|
procedure tnode.dowritenodetype;
|
|
begin
|
|
write(writenodeindention,'(',nodetype2str[nodetype]);
|
|
end;
|
|
{$endif EXTDEBUG}
|
|
|
|
function tnode.isequal(p : tnode) : boolean;
|
|
|
|
begin
|
|
isequal:=
|
|
(not assigned(self) and not assigned(p)) or
|
|
(assigned(self) and assigned(p) and
|
|
{ optimized subclasses have the same nodetype as their }
|
|
{ superclass (for compatibility), so also check the classtype (JM) }
|
|
(p.classtype=classtype) and
|
|
(p.nodetype=nodetype) and
|
|
(flags*flagsequal=p.flags*flagsequal) and
|
|
docompare(p));
|
|
end;
|
|
|
|
{$ifdef state_tracking}
|
|
function Tnode.track_state_pass(exec_known:boolean):boolean;
|
|
|
|
begin
|
|
track_state_pass:=false;
|
|
end;
|
|
{$endif state_tracking}
|
|
|
|
function tnode.docompare(p : tnode) : boolean;
|
|
|
|
begin
|
|
docompare:=true;
|
|
end;
|
|
|
|
|
|
function tnode.getcopy : tnode;
|
|
|
|
var
|
|
p : tnode;
|
|
|
|
begin
|
|
{ this is quite tricky because we need a node of the current }
|
|
{ node type and not one of tnode! }
|
|
p:=tnodeclass(classtype).createforcopy;
|
|
p.nodetype:=nodetype;
|
|
p.location:=location;
|
|
p.parent:=parent;
|
|
p.flags:=flags;
|
|
p.registers32:=registers32;
|
|
p.registersfpu:=registersfpu;
|
|
{$ifdef SUPPORT_MMX}
|
|
p.registersmmx:=registersmmx;
|
|
p.registerskni:=registerskni;
|
|
{$endif SUPPORT_MMX}
|
|
p.resulttype:=resulttype;
|
|
p.fileinfo:=fileinfo;
|
|
p.localswitches:=localswitches;
|
|
{$ifdef extdebug}
|
|
p.firstpasscount:=firstpasscount;
|
|
{$endif extdebug}
|
|
{ p.list:=list; }
|
|
getcopy:=p;
|
|
end;
|
|
|
|
procedure tnode.insertintolist(l : tnodelist);
|
|
|
|
begin
|
|
end;
|
|
|
|
procedure tnode.set_file_line(from : tnode);
|
|
|
|
begin
|
|
if assigned(from) then
|
|
fileinfo:=from.fileinfo;
|
|
end;
|
|
|
|
procedure tnode.set_tree_filepos(const filepos : tfileposinfo);
|
|
|
|
begin
|
|
fileinfo:=filepos;
|
|
end;
|
|
|
|
|
|
{****************************************************************************
|
|
TUNARYNODE
|
|
****************************************************************************}
|
|
|
|
constructor tunarynode.create(tt : tnodetype;l : tnode);
|
|
|
|
begin
|
|
inherited create(tt);
|
|
left:=l;
|
|
end;
|
|
|
|
destructor tunarynode.destroy;
|
|
begin
|
|
left.free;
|
|
inherited destroy;
|
|
end;
|
|
|
|
function tunarynode.docompare(p : tnode) : boolean;
|
|
|
|
begin
|
|
docompare:=(inherited docompare(p) and
|
|
((left=nil) or left.isequal(tunarynode(p).left))
|
|
);
|
|
end;
|
|
|
|
function tunarynode.getcopy : tnode;
|
|
|
|
var
|
|
p : tunarynode;
|
|
|
|
begin
|
|
p:=tunarynode(inherited getcopy);
|
|
if assigned(left) then
|
|
p.left:=left.getcopy
|
|
else
|
|
p.left:=nil;
|
|
getcopy:=p;
|
|
end;
|
|
|
|
procedure tunarynode.insertintolist(l : tnodelist);
|
|
|
|
begin
|
|
end;
|
|
|
|
{$ifdef extdebug}
|
|
procedure tunarynode.dowrite;
|
|
|
|
begin
|
|
inherited dowrite;
|
|
writeln(',');
|
|
writenodeindention:=writenodeindention+' ';
|
|
writenode(left);
|
|
write(')');
|
|
delete(writenodeindention,1,4);
|
|
end;
|
|
{$endif}
|
|
|
|
procedure tunarynode.left_max;
|
|
|
|
begin
|
|
registers32:=left.registers32;
|
|
registersfpu:=left.registersfpu;
|
|
{$ifdef SUPPORT_MMX}
|
|
registersmmx:=left.registersmmx;
|
|
{$endif SUPPORT_MMX}
|
|
end;
|
|
|
|
procedure tunarynode.concattolist(l : tlinkedlist);
|
|
|
|
begin
|
|
left.parent:=self;
|
|
left.concattolist(l);
|
|
inherited concattolist(l);
|
|
end;
|
|
|
|
function tunarynode.ischild(p : tnode) : boolean;
|
|
|
|
begin
|
|
ischild:=p=left;
|
|
end;
|
|
|
|
{****************************************************************************
|
|
TBINARYNODE
|
|
****************************************************************************}
|
|
|
|
constructor tbinarynode.create(tt : tnodetype;l,r : tnode);
|
|
|
|
begin
|
|
inherited create(tt,l);
|
|
right:=r
|
|
end;
|
|
|
|
destructor tbinarynode.destroy;
|
|
begin
|
|
right.free;
|
|
inherited destroy;
|
|
end;
|
|
|
|
procedure tbinarynode.concattolist(l : tlinkedlist);
|
|
|
|
begin
|
|
{ we could change that depending on the number of }
|
|
{ required registers }
|
|
left.parent:=self;
|
|
left.concattolist(l);
|
|
left.parent:=self;
|
|
left.concattolist(l);
|
|
inherited concattolist(l);
|
|
end;
|
|
|
|
function tbinarynode.ischild(p : tnode) : boolean;
|
|
|
|
begin
|
|
ischild:=(p=right);
|
|
end;
|
|
|
|
function tbinarynode.docompare(p : tnode) : boolean;
|
|
|
|
begin
|
|
docompare:=(inherited docompare(p) and
|
|
((right=nil) or right.isequal(tbinarynode(p).right))
|
|
);
|
|
end;
|
|
|
|
function tbinarynode.getcopy : tnode;
|
|
|
|
var
|
|
p : tbinarynode;
|
|
|
|
begin
|
|
p:=tbinarynode(inherited getcopy);
|
|
if assigned(right) then
|
|
p.right:=right.getcopy
|
|
else
|
|
p.right:=nil;
|
|
getcopy:=p;
|
|
end;
|
|
|
|
procedure tbinarynode.insertintolist(l : tnodelist);
|
|
|
|
begin
|
|
end;
|
|
|
|
procedure tbinarynode.swapleftright;
|
|
|
|
var
|
|
swapp : tnode;
|
|
|
|
begin
|
|
swapp:=right;
|
|
right:=left;
|
|
left:=swapp;
|
|
if nf_swaped in flags then
|
|
exclude(flags,nf_swaped)
|
|
else
|
|
include(flags,nf_swaped);
|
|
end;
|
|
|
|
procedure tbinarynode.left_right_max;
|
|
begin
|
|
if assigned(left) then
|
|
begin
|
|
if assigned(right) then
|
|
begin
|
|
registers32:=max(left.registers32,right.registers32);
|
|
registersfpu:=max(left.registersfpu,right.registersfpu);
|
|
{$ifdef SUPPORT_MMX}
|
|
registersmmx:=max(left.registersmmx,right.registersmmx);
|
|
{$endif SUPPORT_MMX}
|
|
end
|
|
else
|
|
begin
|
|
registers32:=left.registers32;
|
|
registersfpu:=left.registersfpu;
|
|
{$ifdef SUPPORT_MMX}
|
|
registersmmx:=left.registersmmx;
|
|
{$endif SUPPORT_MMX}
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
{$ifdef extdebug}
|
|
procedure tbinarynode.dowrite;
|
|
|
|
begin
|
|
inherited dowrite;
|
|
writeln(',');
|
|
writenodeindention:=writenodeindention+' ';
|
|
writenode(right);
|
|
write(')');
|
|
delete(writenodeindention,1,4);
|
|
end;
|
|
{$endif}
|
|
|
|
{****************************************************************************
|
|
TBINOPYNODE
|
|
****************************************************************************}
|
|
|
|
constructor tbinopnode.create(tt : tnodetype;l,r : tnode);
|
|
|
|
begin
|
|
inherited create(tt,l,r);
|
|
end;
|
|
|
|
function tbinopnode.docompare(p : tnode) : boolean;
|
|
|
|
begin
|
|
docompare:=(inherited docompare(p)) or
|
|
{ if that's in the flags, is p then always a tbinopnode (?) (JM) }
|
|
((nf_swapable in flags) and
|
|
left.isequal(tbinopnode(p).right) and
|
|
right.isequal(tbinopnode(p).left));
|
|
end;
|
|
|
|
|
|
{****************************************************************************
|
|
WRITENODE
|
|
****************************************************************************}
|
|
|
|
{$ifdef EXTDEBUG}
|
|
procedure writenode(t:tnode);
|
|
begin
|
|
if assigned(t) then
|
|
t.dowrite
|
|
else
|
|
write(writenodeindention,'nil');
|
|
if writenodeindention='' then
|
|
writeln;
|
|
end;
|
|
{$endif EXTDEBUG}
|
|
|
|
|
|
end.
|
|
{
|
|
$Log$
|
|
Revision 1.33 2002-07-23 12:34:30 daniel
|
|
* Readded old set code. To use it define 'oldset'. Activated by default
|
|
for ppc.
|
|
|
|
Revision 1.32 2002/07/22 11:48:04 daniel
|
|
* Sets are now internally sets.
|
|
|
|
Revision 1.31 2002/07/21 06:58:49 daniel
|
|
* Changed booleans into flags
|
|
|
|
Revision 1.30 2002/07/19 11:41:36 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.29 2002/07/14 18:00:44 daniel
|
|
+ Added the beginning of a state tracker. This will track the values of
|
|
variables through procedures and optimize things away.
|
|
|
|
Revision 1.28 2002/07/01 18:46:24 peter
|
|
* internal linker
|
|
* reorganized aasm layer
|
|
|
|
Revision 1.27 2002/05/18 13:34:10 peter
|
|
* readded missing revisions
|
|
|
|
Revision 1.26 2002/05/16 19:46:39 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.24 2002/04/21 19:02:04 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.23 2002/04/06 18:13:01 jonas
|
|
* several powerpc-related additions and fixes
|
|
|
|
Revision 1.22 2002/03/31 20:26:35 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
|
|
|
|
Revision 1.21 2002/01/19 11:52:32 peter
|
|
* dynarr:=nil support added
|
|
|
|
}
|