diff --git a/compiler/ncal.pas b/compiler/ncal.pas index eb7e9c0019..d7f4634170 100644 --- a/compiler/ncal.pas +++ b/compiler/ncal.pas @@ -2,7 +2,6 @@ $Id$ Copyright (c) 1998-2000 by Florian Klaempfl - Type checking and register allocation for add 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 @@ -37,16 +36,57 @@ unit ncal; { the definition of the procedure to call } procdefinition : pabstractprocdef; methodpointer : tnode; - constructor create(v : pprocsym;st : psymtable); + { only the processor specific nodes need to override this } + { constructor } + constructor create(v : pprocsym;st : psymtable);virtual; end; + tcallparanode = class(tbinarynode) + hightree : tnode; + { only the processor specific nodes need to override this } + { constructor } + constructor create(expr,next : tnode);virtual; + destructor destroy;override; + end; + + function gencallparanode(expr,next : tnode) : tnode; function gencallnode(v : pprocsym;st : psymtable) : tnode; var ccallnode : class of tcallnode; + ccallparanode : class of tcallparanode; implementation +{**************************************************************************** + TCALLPARANODE + ****************************************************************************} + + function gencallparanode(expr,next : tnode) : tnode; + + begin + gencallparanode:=ccallparanode.create(expr,next); + end; + + constructor tcallparanode.create(expr,next : tnode); + + begin + inherited create(callparan,expr,next); + hightree:=nil; + expr.set_file_line(self); + end; + + destructor tcallparanode.destroy; + + begin + hightree.free; + inherited destroy; + end; + +{**************************************************************************** + TCALLNODE + ****************************************************************************} + function gencallnode(v : pprocsym;st : psymtable) : tnode; begin @@ -66,10 +106,14 @@ unit ncal; begin ccallnode:=tcallnode; + ccallparanode:=tcallparanode; end. { $Log$ - Revision 1.1 2000-09-20 20:52:16 florian + Revision 1.2 2000-09-20 21:52:38 florian + * removed a lot of errors + + Revision 1.1 2000/09/20 20:52:16 florian * initial revision } \ No newline at end of file diff --git a/compiler/node.inc b/compiler/node.inc index c3c066a724..15c9621a14 100644 --- a/compiler/node.inc +++ b/compiler/node.inc @@ -25,11 +25,11 @@ TNODE ****************************************************************************} - constructor tnode.init(tt : tnodetype); + constructor tnode.create(tt : tnodetype); begin - inherited init; - treetype:=tt; + inherited create; + nodetype:=tt; { this allows easier error tracing } location.loc:=LOC_INVALID; { save local info } @@ -44,7 +44,7 @@ flags:=[]; end; - destructor tnode.done; + destructor tnode.destroy; begin { reference info } @@ -57,7 +57,7 @@ {$endif EXTDEBUG} end; - procedure tnode.pass_1; + function tnode.pass_1 : tnode; begin if not(assigned(resulttype)) then @@ -66,36 +66,19 @@ det_temp; end; - procedure tnode.det_resulttype; - - begin - abstract; - end; - - procedure tnode.det_temp; - - begin - abstract; - end; - - procedure tnode.secondpass; - - begin - abstract; - end; - procedure tnode.concattolist(l : plinkedlist); begin - l^.concat(@self); +{$ifdef newcg} + l^.concat(self); +{$endif newcg} end; - function tnode.ischild(p : pnode) : boolean; + function tnode.ischild(p : tnode) : boolean; begin ischild:=false; end; - {$ifdef EXTDEBUG} procedure tnode.dowrite; @@ -186,36 +169,49 @@ end; {$endif EXTDEBUG} - function tnode.isequal(p : node) : boolean; + function tnode.isequal(p : tnode) : boolean; begin - isequal:=assigned(p) and (p^.nodetype=nodetype) and - (flags*flagsequal=p^.flags*flagsequal) and + isequal:=assigned(p) and (p.nodetype=nodetype) and + (flags*flagsequal=p.flags*flagsequal) and docompare(p); end; - function tnode.docompare(p : pnode) : boolean; + function tnode.docompare(p : tnode) : boolean; begin docompare:=true; 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.init(tt : tnodetype;l : pnode); + constructor tunarynode.create(tt : tnodetype;l : tnode); begin - inherited init(tt); + inherited create(tt); left:=l; end; - function tunarynode.docompare(p : pnode) : boolean; + function tunarynode.docompare(p : tnode) : boolean; begin docompare:=(inherited docompare(p)) and - left^.isequal(p^.left); + left.isequal(tunarynode(p).left); end; {$ifdef extdebug} @@ -233,12 +229,12 @@ procedure tunarynode.concattolist(l : plinkedlist); begin - left^.parent:=@self; - left^.concattolist(l); + left.parent:=self; + left.concattolist(l); inherited concattolist(l); end; - function tunarynode.ischild(p : pnode) : boolean; + function tunarynode.ischild(p : tnode) : boolean; begin ischild:=p=left; @@ -247,23 +243,23 @@ procedure tunarynode.det_resulttype; begin - left^.det_resulttype; + left.det_resulttype; end; procedure tunarynode.det_temp; begin - left^.det_temp; + left.det_temp; end; {**************************************************************************** TBINARYNODE ****************************************************************************} - constructor tbinarynode.init(tt : tnodetype;l,r : pnode); + constructor tbinarynode.create(tt : tnodetype;l,r : tnode); begin - inherited init(tt,l); + inherited create(tt,l); right:=r end; @@ -272,14 +268,14 @@ begin { we could change that depending on the number of } { required registers } - left^.parent:=@self; - left^.concattolist(l); - left^.parent:=@self; - left^.concattolist(l); + left.parent:=self; + left.concattolist(l); + left.parent:=self; + left.concattolist(l); inherited concattolist(l); end; - function tbinarynode.ischild(p : pnode) : boolean; + function tbinarynode.ischild(p : tnode) : boolean; begin ischild:=(p=right) or (p=right); @@ -288,45 +284,146 @@ procedure tbinarynode.det_resulttype; begin - left^.det_resulttype; - right^.det_resulttype; + left.det_resulttype; + right.det_resulttype; end; procedure tbinarynode.det_temp; begin - left^.det_temp; - right^.det_temp; + left.det_temp; + right.det_temp; end; - function tbinarynode.docompare(p : pnode) : boolean; + function tbinarynode.docompare(p : tnode) : boolean; begin - docompare:=left^.isequal(p^.left) and - right^.isequal(p^.right); + docompare:=left.isequal(tbinarynode(p).left) and + right.isequal(tbinarynode(p).right); + end; + + function tbinarynode.isbinaryoverloaded(var t : tnode) : boolean; + + var + rd,ld : pdef; + optoken : ttoken; + + begin + t:=nil; + isbinaryoverloaded:=false; + { overloaded operator ? } + { load easier access variables } + rd:=right.resulttype; + ld:=left.resulttype; + if isbinaryoperatoroverloadable(ld,rd,voiddef,nodetype) then + begin + isbinaryoverloaded:=true; + {!!!!!!!!! handle paras } + case nodetype of + { the nil as symtable signs firstcalln that this is + an overloaded operator } + addn: + optoken:=_PLUS; + subn: + optoken:=_MINUS; + muln: + optoken:=_STAR; + starstarn: + optoken:=_STARSTAR; + slashn: + optoken:=_SLASH; + ltn: + optoken:=tokens._lt; + gtn: + optoken:=tokens._gt; + lten: + optoken:=_lte; + gten: + optoken:=_gte; + equaln,unequaln : + optoken:=_EQUAL; + symdifn : + optoken:=_SYMDIF; + modn : + optoken:=_OP_MOD; + orn : + optoken:=_OP_OR; + xorn : + optoken:=_OP_XOR; + andn : + optoken:=_OP_AND; + divn : + optoken:=_OP_DIV; + shln : + optoken:=_OP_SHL; + shrn : + optoken:=_OP_SHR; + else + exit; + end; + t:=gencallnode(overloaded_operators[optoken],nil); + { we have to convert p^.left and p^.right into + callparanodes } + if tcallnode(t).symtableprocentry=nil then + begin + CGMessage(parser_e_operator_not_overloaded); + t.free; + end + else + begin + inc(tcallnode(t).symtableprocentry^.refs); + tcallnode(t).left:=gencallparanode(left,nil); + tcallnode(t).left:=gencallparanode(right,tcallnode(t).left); + if nodetype=unequaln then + t:=cnotnode.create(t); + + firstpass(t); + + putnode(p); + p:=t; + end; + end; + 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; {**************************************************************************** TBINOPYNODE ****************************************************************************} - constructor tbinopnode.init(tt : tnodetype;l,r : pnode); + constructor tbinopnode.create(tt : tnodetype;l,r : tnode); begin - inherited init(tt,l,r); + inherited create(tt,l,r); end; - function tbinopnode.docompare(p : pnode) : boolean; + function tbinopnode.docompare(p : tnode) : boolean; begin docompare:=(inherited docompare(p)) or ((nf_swapable in flags) and - left^.isequal(p^.right) and - right^.isequal(p^.left)); + left.isequal(tbinopnode(p).right) and + right.isequal(tbinopnode(p).left)); end; { $Log$ - Revision 1.1 2000-08-26 12:27:17 florian - * initial release + Revision 1.2 2000-09-20 21:52:38 florian + * removed a lot of errors + + Revision 1.1 2000/08/26 12:27:17 florian + * createial release } \ No newline at end of file diff --git a/compiler/node.pas b/compiler/node.pas index 96419810a6..cb6266d751 100644 --- a/compiler/node.pas +++ b/compiler/node.pas @@ -24,16 +24,25 @@ unit node; interface + uses + globtype,globals,cobjects,aasm,cpubase,symtable, + tokens; + {$I nodeh.inc} implementation + uses + htypechk,ncal,hcodegen,verbose; + {$I node.inc} end. { $Log$ - Revision 1.1 2000-08-26 12:27:35 florian - * initial release + Revision 1.2 2000-09-20 21:52:38 florian + * removed a lot of errors + Revision 1.1 2000/08/26 12:27:35 florian + * initial release } \ No newline at end of file diff --git a/compiler/nodeh.inc b/compiler/nodeh.inc index d5f3120d6d..8253568cac 100644 --- a/compiler/nodeh.inc +++ b/compiler/nodeh.inc @@ -171,7 +171,19 @@ nf_callunique, nf_swapable, { tbinop operands can be swaped } nf_swaped, { tbinop operands are swaped } - nf_error + nf_error, + + { flags used by tcallnode } + nf_no_check, + nf_unit_specific, + nf_return_value_used, + nf_static_call, + + { flags used by tcallparanode } + nf_exact_match_found, + nf_convlevel1found, + nf_convlevel2found, + nf_is_colon_para ); tnodeflagset = set of tnodeflags; @@ -179,7 +191,7 @@ const { contains the flags which must be equal for the equality } { of nodes } - flagsequal : tnodeflagset = [nf_error]; + flagsequal : tnodeflagset = [nf_error,nf_static_call]; type { later (for the newcg) tnode will inherit from tlinkedlist_item } @@ -191,7 +203,7 @@ varstateset : boolean; { the parent node of this is node } { this field is set by concattolist } - parent : pnode; + parent : tnode; { there are some properties about the node stored } flags : tnodeflagset; { the number of registers needed to evalute the node } @@ -206,8 +218,8 @@ firstpasscount : longint; {$endif extdebug} list : paasmoutput; - constructor init(tt : tnodetype);virtual; - destructor done;virtual; + constructor create(tt : tnodetype);virtual; + destructor destroy;virtual; { the 1.1 code generator may override pass_1 } { and it need not to implement det_* then } @@ -215,12 +227,12 @@ { 2.0: runs det_resulttype and det_temp } function pass_1 : tnode;virtual; { dermines the resulttype of the node } - procedure det_resulttype;virtual; + procedure det_resulttype;virtual;abstract; { dermines the number of necessary temp. locations to evaluate the node } - procedure det_temp;virtual; + procedure det_temp;virtual;abstract; - procedure secondpass;virtual; + procedure pass_2;virtual;abstract; { comparing of nodes } function isequal(p : tnode) : boolean; @@ -234,45 +246,55 @@ {$endif EXTDEBUG} procedure concattolist(l : plinkedlist);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); - falselabel,truelabel : plabel; + tparentnode = class(tnode) + falselabel,truelabel : pasmlabel; end; punarynode = ^tunarynode; tunarynode = class(tparentnode) left : tnode; {$ifdef extdebug} - procedure dowrite;virtual; + procedure dowrite;override; {$endif extdebug} - constructor init(tt : tnodetype;l : tnode);virtual - procedure concattolist(l : plinkedlist);virtual; - function ischild(p : tnode) : boolean;virtual; - procedure det_resulttype;virtual; - procedure det_temp;virtual; + constructor create(tt : tnodetype;l : tnode);virtual; + procedure concattolist(l : plinkedlist);override; + function ischild(p : tnode) : boolean;override; + procedure det_resulttype;override; + procedure det_temp;override; + function docompare(p : tnode) : boolean;override; end; pbinarynode = ^tbinarynode; tbinarynode = class(tunarynode) right : tnode; - constructor init(tt : tnodetype;l,r : pnode);virtual; - procedure concattolist(l : plinkedlist);virtual; - function ischild(p : pnode) : boolean;virtual; - procedure det_resulttype;virtual; - procedure det_temp;virtual; + constructor create(tt : tnodetype;l,r : tnode);virtual; + procedure concattolist(l : plinkedlist);override; + function ischild(p : tnode) : boolean;override; + procedure det_resulttype;override; + procedure det_temp;override; + function docompare(p : tnode) : boolean;override; + procedure swapleftright; + function isbinaryoverloaded(var t : tnode) : boolean; end; pbinopnode = ^tbinopnode; tbinopnode = class(tbinarynode) - constructor init(tt : tnodetype;l,r : pnode);virtual; + constructor create(tt : tnodetype;l,r : tnode);virtual; + function docompare(p : tnode) : boolean;override; end; { $Log$ - Revision 1.1 2000-08-26 12:27:04 florian + Revision 1.2 2000-09-20 21:52:38 florian + * removed a lot of errors + + Revision 1.1 2000/08/26 12:27:04 florian * initial release -} +} \ No newline at end of file