From c9dfdcfbcdfa9a3150e2afbbf390b9b00e34889e Mon Sep 17 00:00:00 2001 From: florian Date: Fri, 22 Sep 2000 21:45:35 +0000 Subject: [PATCH] * some updates e.g. getcopy added --- compiler/node.inc | 204 ++++++++++++++++++++++++++++++++++++++++++++- compiler/node.pas | 7 +- compiler/nodeh.inc | 36 +++++--- 3 files changed, 232 insertions(+), 15 deletions(-) diff --git a/compiler/node.inc b/compiler/node.inc index 15c9621a14..6dd3fdf5af 100644 --- a/compiler/node.inc +++ b/compiler/node.inc @@ -1,4 +1,4 @@ -{ +7{ $Id$ Copyright (c) 1999-2000 by Florian Klaempfl @@ -44,6 +44,11 @@ flags:=[]; end; + constructor tnode.createforcopy; + + begin + end; + destructor tnode.destroy; begin @@ -183,6 +188,36 @@ 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:=classtype.createforcopy; + p.nodetype:=nodetype; + p.location:=location; + p.varstateset:=varstateset; + 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.set_file_line(from : tnode); begin @@ -196,6 +231,148 @@ fileinfo:=filepos; end; + procedure tnode.unset_varstate; + + begin + internalerror(220920002); + end; + + procedure tnode.set_varstate(must_be_valid : boolean); + + begin + internalerror(220920001); + end; + +{$warning FIX ME !!!!!} +{$ifdef dummy} + procedure unset_varstate(p : ptree); + begin + while assigned(p) do + begin + p^.varstateset:=false; + case p^.treetype of + typeconvn, + subscriptn, + vecn : + p:=p^.left; + else + break; + end; + end; + end; + + + procedure set_varstate(p : ptree;must_be_valid : boolean); + + begin + if not assigned(p) then + exit + else + begin + if p^.varstateset then + exit; + case p^.treetype of + typeconvn : + if p^.convtyp in + [ + tc_cchar_2_pchar, + tc_cstring_2_pchar, + tc_array_2_pointer + ] then + set_varstate(p^.left,false) + else if p^.convtyp in + [ + tc_pchar_2_string, + tc_pointer_2_array + ] then + set_varstate(p^.left,true) + else + set_varstate(p^.left,must_be_valid); + subscriptn : + set_varstate(p^.left,must_be_valid); + vecn: + begin + if (p^.left^.resulttype^.deftype in [stringdef,arraydef]) then + set_varstate(p^.left,must_be_valid) + else + set_varstate(p^.left,true); + set_varstate(p^.right,true); + end; + { do not parse calln } + calln : ; + callparan: + begin + set_varstate(p^.left,must_be_valid); + set_varstate(p^.right,must_be_valid); + end; + loadn : + if (p^.symtableentry^.typ=varsym) then + begin + if must_be_valid and p^.is_first then + begin + if (pvarsym(p^.symtableentry)^.varstate=vs_declared_and_first_found) or + (pvarsym(p^.symtableentry)^.varstate=vs_set_but_first_not_passed) then + if (assigned(pvarsym(p^.symtableentry)^.owner) and + assigned(aktprocsym) and + (pvarsym(p^.symtableentry)^.owner = aktprocsym^.definition^.localst)) then + begin + if p^.symtable^.symtabletype=localsymtable then + CGMessage1(sym_n_uninitialized_local_variable,pvarsym(p^.symtableentry)^.name) + else + CGMessage1(sym_n_uninitialized_variable,pvarsym(p^.symtableentry)^.name); + end; + end; + if (p^.is_first) then + begin + if pvarsym(p^.symtableentry)^.varstate=vs_declared_and_first_found then + { this can only happen at left of an assignment, no ? PM } + if (parsing_para_level=0) and not must_be_valid then + pvarsym(p^.symtableentry)^.varstate:=vs_assigned + else + pvarsym(p^.symtableentry)^.varstate:=vs_used; + if pvarsym(p^.symtableentry)^.varstate=vs_set_but_first_not_passed then + pvarsym(p^.symtableentry)^.varstate:=vs_used; + p^.is_first:=false; + end + else + begin + if (pvarsym(p^.symtableentry)^.varstate=vs_assigned) and + (must_be_valid or (parsing_para_level>0) or + (p^.resulttype^.deftype=procvardef)) then + pvarsym(p^.symtableentry)^.varstate:=vs_used; + if (pvarsym(p^.symtableentry)^.varstate=vs_declared_and_first_found) and + (must_be_valid or (parsing_para_level>0) or + (p^.resulttype^.deftype=procvardef)) then + pvarsym(p^.symtableentry)^.varstate:=vs_set_but_first_not_passed; + end; + end; + funcretn: + begin + { no claim if setting higher return value_str } + if must_be_valid and + (procinfo=pprocinfo(p^.funcretprocinfo)) and + ((procinfo^.funcret_state=vs_declared) or + ((p^.is_first_funcret) and + (procinfo^.funcret_state=vs_declared_and_first_found))) then + begin + CGMessage(sym_w_function_result_not_set); + { avoid multiple warnings } + procinfo^.funcret_state:=vs_assigned; + end; + if p^.is_first_funcret and not must_be_valid then + pprocinfo(p^.funcretprocinfo)^.funcret_state:=vs_assigned; + end; + else + begin + {internalerror(565656);} + end; + end;{case } + p^.varstateset:=true; + end; + end; + +{$endif} + {**************************************************************************** TUNARYNODE ****************************************************************************} @@ -214,6 +391,16 @@ left.isequal(tunarynode(p).left); end; + function.tunarynode.getcopy : tnode; + + var + p : tunarynode; + + begin + p:=tunarynode(inherited getcopy); + p.left:=left.getcopy; + end; + {$ifdef extdebug} procedure tunarynode.dowrite; @@ -302,6 +489,16 @@ right.isequal(tbinarynode(p).right); end; + function.tbinarynode.getcopy : tnode; + + var + p : tbinarynode; + + begin + p:=tbinarynode(inherited getcopy); + p.right:=right.getcopy; + end; + function tbinarynode.isbinaryoverloaded(var t : tnode) : boolean; var @@ -420,7 +617,10 @@ end; { $Log$ - Revision 1.2 2000-09-20 21:52:38 florian + Revision 1.3 2000-09-22 21:45:36 florian + * some updates e.g. getcopy added + + 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 diff --git a/compiler/node.pas b/compiler/node.pas index cb6266d751..ef0058a970 100644 --- a/compiler/node.pas +++ b/compiler/node.pas @@ -33,14 +33,17 @@ unit node; implementation uses - htypechk,ncal,hcodegen,verbose; + htypechk,ncal,hcodegen,verbose,nmat,pass_1; {$I node.inc} end. { $Log$ - Revision 1.2 2000-09-20 21:52:38 florian + Revision 1.3 2000-09-22 21:45:35 florian + * some updates e.g. getcopy added + + 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 diff --git a/compiler/nodeh.inc b/compiler/nodeh.inc index 8253568cac..17c8256700 100644 --- a/compiler/nodeh.inc +++ b/compiler/nodeh.inc @@ -183,7 +183,11 @@ nf_exact_match_found, nf_convlevel1found, nf_convlevel2found, - nf_is_colon_para + nf_is_colon_para, + + { 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 } ); tnodeflagset = set of tnodeflags; @@ -191,7 +195,7 @@ const { contains the flags which must be equal for the equality } { of nodes } - flagsequal : tnodeflagset = [nf_error,nf_static_call]; + flagsequal : tnodeflagset = [nf_error,nf_static_call,nf_backward]; type { later (for the newcg) tnode will inherit from tlinkedlist_item } @@ -199,15 +203,13 @@ nodetype : tnodetype; { the location of the result of this node } location : tlocation; - { do we need to parse childs to set var state } - varstateset : boolean; { 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 } - registersint,registersfpu : longint; { must be longint !!!! } + registers32,registersfpu : longint; { must be longint !!!! } {$ifdef SUPPORT_MMX} registersmmx,registerskni : longint; {$endif SUPPORT_MMX} @@ -218,7 +220,10 @@ firstpasscount : longint; {$endif extdebug} list : paasmoutput; - constructor create(tt : tnodetype);virtual; + constructor create(tt : tnodetype); + { this constructor is only for creating copies of class } + { the fields are copied by getcopy } + constructor createforcopy; destructor destroy;virtual; { the 1.1 code generator may override pass_1 } @@ -238,6 +243,10 @@ 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 unset_varstate;virtual; + procedure set_varstate(must_be_valid : boolean);virtual; {$ifdef EXTDEBUG} { writes a node for debugging purpose, shouldn't be called } { direct, because there is no test for nil, use writenode } @@ -263,18 +272,19 @@ {$ifdef extdebug} procedure dowrite;override; {$endif extdebug} - constructor create(tt : tnodetype;l : tnode);virtual; + constructor create(tt : tnodetype;l : tnode); 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; + function getcopy : tnode;override; end; pbinarynode = ^tbinarynode; tbinarynode = class(tunarynode) right : tnode; - constructor create(tt : tnodetype;l,r : tnode);virtual; + constructor create(tt : tnodetype;l,r : tnode); procedure concattolist(l : plinkedlist);override; function ischild(p : tnode) : boolean;override; procedure det_resulttype;override; @@ -282,19 +292,23 @@ function docompare(p : tnode) : boolean;override; procedure swapleftright; function isbinaryoverloaded(var t : tnode) : boolean; + function getcopy : tnode;override; end; pbinopnode = ^tbinopnode; tbinopnode = class(tbinarynode) - constructor create(tt : tnodetype;l,r : tnode);virtual; + constructor create(tt : tnodetype;l,r : tnode); function docompare(p : tnode) : boolean;override; end; + { $Log$ - Revision 1.2 2000-09-20 21:52:38 florian + Revision 1.3 2000-09-22 21:45:36 florian + * some updates e.g. getcopy added + + 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