From ebd2b038fd18dbcb6b70692db613052e3e73e73f Mon Sep 17 00:00:00 2001 From: florian Date: Fri, 22 Sep 2000 22:46:03 +0000 Subject: [PATCH] + initial revision --- compiler/nflw.pas | 845 ++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 845 insertions(+) create mode 100644 compiler/nflw.pas diff --git a/compiler/nflw.pas b/compiler/nflw.pas new file mode 100644 index 0000000000..aa5369e68c --- /dev/null +++ b/compiler/nflw.pas @@ -0,0 +1,845 @@ +{ + $Id$ + Copyright (c) 1998-2000 by Florian Klaempfl + + Type checking and register allocation for nodes that influence + the flow + + 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 nflw; +interface + + uses + node,aasm,cpubase,symtable; + + type + tloopnode = class(tbinarynode) + t1,t2 : tnode; + constructor create(tt : tnodetype;l,r,_t1,_t2 : tnode);virtual; + destructor destroy;override; + function getcopy : tnode;override; + end; + + tlabelednode = class(tnode) + labelnr : pasmlabel; + exceptionblock : tnode; + labsym : plabelsym; + destructor destroy;override; + function getcopy : tnode;override; + end; + + twhilerepeatnode = class(tloopnode) + function pass_1 : tnode;override; + end; + + tifnode = class(tloopnode) + constructor create(l,r,_t1 : tnode);virtual; + function pass_1 : tnode;override; + end; + + tfornode = class(tloopnode) + constructor create(l,r,_t1,_t2 : tnode;back : boolean); + function pass_1 : tnode;override; + end; + + texitnode = class(tunarynode) + constructor create;virtual; + function pass_1 : tnode;override; + end; + + tgotonode = class(tlabelednode) + constructor create;virtual; + function pass_1 : tnode;override; + end; + + tlabelnode = class(tlabelednode) + constructor create;virtual; + function pass_1 : tnode;override; + end; + + traisenode = class(tbinarynode) + constructor create;virtual; + function pass_1 : tnode;override; + end; + + ttryexceptnode = class(tloopnode) + constructor create;virtual; + function pass_1 : tnode;override; + end; + + ttryfinallynode = class(tbinarynode) + constructor create;virtual; + function pass_1 : tnode;override; + end; + + tonnode = class(tbinarynode) + exceptsymtable : psymtable; + excepttype : pobjectdef; + constructor create;virtual; + function pass_1 : tnode;override; + destructor destroy;override; + function getcopy : tnode;override; + end; + + { for compatibilty } + function genloopnode(t : tnodetype;l,r,n1 : tnode;back : boolean) : tnode; + + var + cwhilerepeatnode : class of twhilerepeatnode; + cifnode : class of tifnode; + cfornode : class of tfornode; + cexitnode : class of texitnode; + cgotonode : class of tgotonode; + clabelnode : class of tlabelnode; + craisenode : class of traisenode; + ctryexceptnode : class of ttryexceptnode; + ctryfinallynode : class of ttryfinallynode; + connode : class of tonnode; + { the block node of the current exception block to check gotos } + aktexceptblock : tnode; + + +implementation + + uses + globtype,systems, + cutils,cobjects,verbose,globals, + symconst,types,htypechk,pass_1 +{$ifdef newcg} + ,tgobj + ,tgcpu + ,cgbase +{$else newcg} + ,hcodegen + ,temp_gen +{$ifdef i386} + ,tgeni386 +{$endif} +{$ifdef m68k} + ,tgen68k +{$endif m68k} +{$endif newcg} + ; + + function genloopnode(t : tnodetype;l,r,n1 : tnode;back : boolean) : tnode; + + var + p : tnode; + + begin + case t of + ifn: + p:=cifnode.create(l,r,n1); + repeatn: + p:=cwhilerepeatnode.create(repeatn,l,r,n1,nil); + whilen: + p:=cwhilerepeatnode.create(whilen,l,r,n1,nil); + forn: + p:=cfornode.create(l,r,n1,nil,back); + end; + genloopnode:=p; + end; + +{**************************************************************************** + TLOOPNODE +*****************************************************************************} + + constructor tloopnode.create(tt : tnodetype;l,r,_t1,_t2 : tnode); + + begin + inherited create(tt,l,r); + t1:=_t1; + t2:=_t2; + set_file_line(l); + end; + + destructor tloopnode.destroy; + + begin + t1.free; + t2.free; + inherited destroy; + end; + + function tloopnode.getcopy : tnode; + + var + p : tloopnode; + + begin + p:=tloopnode(inherited getcopy); + p.t1:=t1.getcopy; + p.t2:=t2.getcopy; + getcopy:=p; + end; + +{**************************************************************************** + TTLABELDNODE +*****************************************************************************} + + destructor tlabelednode.destroy; + + begin + end; + + function tlabelednode.getcopy : tnode; + + var + p : tlabelednode; + + begin + p:=tlabelednode(inherited getcopy); + p.labelnr:=labelnr; + p.exceptionblock:=exceptionblock; + p.labsym:=labsym; + end; + +{**************************************************************************** + TWHILEREPEATNODE +*****************************************************************************} + + function twhilerepeatnode.pass_1 : tnode; + + var + old_t_times : longint; + begin + pass_1:=nil; + old_t_times:=t_times; + + { calc register weight } + if not(cs_littlesize in aktglobalswitches ) then + t_times:=t_times*8; +{$ifdef newcg} + tg.cleartempgen; +{$else newcg} + cleartempgen; +{$endif newcg} + + firstpass(left); + left.set_varstate(true); + if codegenerror then + exit; + if not is_boolean(left.resulttype) then + begin + CGMessage(type_e_mismatch); + exit; + end; + + registers32:=left.registers32; + registersfpu:=left.registersfpu; +{$ifdef SUPPORT_MMX} + registersmmx:=left.registersmmx; +{$endif SUPPORT_MMX} + + { loop instruction } + if assigned(right) then + begin +{$ifdef newcg} + tg.cleartempgen; +{$else newcg} + cleartempgen; +{$endif newcg} + firstpass(right); + if codegenerror then + exit; + + if registers32assignn then + CGMessage(cg_e_illegal_expression); + +{$ifdef newcg} + tg.cleartempgen; +{$else newcg} + cleartempgen; +{$endif newcg} + firstpass(left); + set_varstate(left,false); + +{$ifdef newcg} + tg.cleartempgen; +{$else newcg} + cleartempgen; +{$endif newcg} + if assigned(t1) then + begin + firstpass(t1); + if codegenerror then + exit; + end; + + registers32:=t1^.registers32; + registersfpu:=t1^.registersfpu; +{$ifdef SUPPORT_MMX} + registersmmx:=left.registersmmx; +{$endif SUPPORT_MMX} + if left.registers32>registers32 then + registers32:=left.registers32; + if left.registersfpu>registersfpu then + registersfpu:=left.registersfpu; +{$ifdef SUPPORT_MMX} + if left.registersmmx>registersmmx then + registersmmx:=left.registersmmx; +{$endif SUPPORT_MMX} + + { process count var } +{$ifdef newcg} + tg.cleartempgen; +{$else newcg} + cleartempgen; +{$endif newcg} + firstpass(t2); + set_varstate(t2,true); + if codegenerror then + exit; + + { Check count var, record fields are also allowed in tp7 } + hp:=t2; + while (hp.treetype=subscriptn) do + hp:=hp.left; + { we need a simple loadn, but the load must be in a global symtable or + in the same lexlevel } + if (hp.treetype=funcretn) or + ((hp.treetype=loadn) and + ((hp.symtable^.symtablelevel<=1) or + (hp.symtable^.symtablelevel=lexlevel))) then + begin + if hp.symtableentry^.typ=varsym then + pvarsym(hp.symtableentry)^.varstate:=vs_used; + if (not(is_ordinal(t2^.resulttype)) or is_64bitint(t2^.resulttype)) then + CGMessagePos(hp.fileinfo,type_e_ordinal_expr_expected); + end + else + CGMessagePos(hp.fileinfo,cg_e_illegal_count_var); + + if t2^.registers32>registers32 then + registers32:=t2^.registers32; + if t2^.registersfpu>registersfpu then + registersfpu:=t2^.registersfpu; +{$ifdef SUPPORT_MMX} + if t2^.registersmmx>registersmmx then + registersmmx:=t2^.registersmmx; +{$endif SUPPORT_MMX} + +{$ifdef newcg} + tg.cleartempgen; +{$else newcg} + cleartempgen; +{$endif newcg} + firstpass(right); + set_varstate(right,true); + if right.treetype<>ordconstn then + begin + right:=gentypeconvnode(right,t2^.resulttype); +{$ifdef newcg} + tg.cleartempgen; +{$else newcg} + cleartempgen; +{$endif newcg} + firstpass(right); + end; + + if right.registers32>registers32 then + registers32:=right.registers32; + if right.registersfpu>registersfpu then + registersfpu:=right.registersfpu; +{$ifdef SUPPORT_MMX} + if right.registersmmx>registersmmx then + registersmmx:=right.registersmmx; +{$endif SUPPORT_MMX} + { we need at least one register for comparisons PM } + if registers32=0 then + inc(registers32); + t_times:=old_t_times; + end; + + +{***************************************************************************** + TEXITNODE +*****************************************************************************} + + constructor texitnode.create; + + begin + end; + + function texitnode.pass_1 : tnode; + var + pt : tnode; + begin + pass_1:=nil; + resulttype:=voiddef; + if assigned(left) then + begin + firstpass(left); + procinfo^.funcret_state:=vs_assigned; + if codegenerror then + exit; + { Check the 2 types } + left:=gentypeconvnode(left,procinfo^.returntype.def); + firstpass(left); + if ret_in_param(procinfo^.returntype.def) or procinfo^.no_fast_exit then + begin + pt:=genzeronode(funcretn); + pt^.rettype.setdef(procinfo^.returntype.def); + pt^.funcretprocinfo:=procinfo; + left:=gennode(assignn,pt,left); + firstpass(left); + end; + registers32:=left.registers32; + registersfpu:=left.registersfpu; +{$ifdef SUPPORT_MMX} + registersmmx:=left.registersmmx; +{$endif SUPPORT_MMX} + end; + end; + + +{***************************************************************************** + TGOTONODE +*****************************************************************************} + + constructor tgotonode.create; + + begin + end; + + function tgotonode.pass_1 : tnode; + begin + pass_1:=nil; + resulttype:=voiddef; + end; + +{***************************************************************************** + TLABELNODE +*****************************************************************************} + + constructor tlabelnode.create; + + begin + end; + + function tlabelnode.pass_1 : tnode; + + begin + pass_1:=nil; +{$ifdef newcg} + tg.cleartempgen; +{$else newcg} + cleartempgen; +{$endif newcg} + exceptionblock:=aktexceptblock; + firstpass(left); + registers32:=left.registers32; + registersfpu:=left.registersfpu; +{$ifdef SUPPORT_MMX} + registersmmx:=left.registersmmx; +{$endif SUPPORT_MMX} + resulttype:=voiddef; + end; + + +{***************************************************************************** + TRAISENODE +*****************************************************************************} + + constructor traisenode.create; + + begin + end; + + function traisenode.pass_1 : tnode; + begin + pass_1:=nil; + resulttype:=voiddef; + if assigned(left) then + begin + { first para must be a _class_ } + firstpass(left); + if assigned(left.resulttype) and + ((left.resulttype^.deftype<>objectdef) or + not(pobjectdef(left.resulttype)^.is_class)) then + CGMessage(type_e_mismatch); + set_varstate(left,true); + if codegenerror then + exit; + { insert needed typeconvs for addr,frame } + if assigned(right) then + begin + { addr } + firstpass(right); + right:=gentypeconvnode(right,s32bitdef); + firstpass(right); + if codegenerror then + exit; + { frame } + if assigned(frametree) then + begin + firstpass(frametree); + frametree:=gentypeconvnode(frametree,s32bitdef); + firstpass(frametree); + if codegenerror then + exit; + end; + end; + left_right_max(p); + end; + end; + + +{***************************************************************************** + TTRYEXCEPTNODE +*****************************************************************************} + + constructor ttryexceptnode.create; + + begin + end; + + function ttryexceptnode.pass_1 : tnode; + + var + oldexceptblock : tnode; + + begin + pass_1:=nil; +{$ifdef newcg} + tg.cleartempgen; +{$else newcg} + cleartempgen; +{$endif newcg} + oldexceptblock:=aktexceptblock; + aktexceptblock:=left; + firstpass(left); + aktexceptblock:=oldexceptblock; + { on statements } + if assigned(right) then + begin +{$ifdef newcg} + tg.cleartempgen; +{$else newcg} + cleartempgen; +{$endif newcg} + oldexceptblock:=aktexceptblock; + aktexceptblock:=right; + firstpass(right); + aktexceptblock:=oldexceptblock; + registers32:=max(registers32,right.registers32); + registersfpu:=max(registersfpu,right.registersfpu); +{$ifdef SUPPORT_MMX} + registersmmx:=max(registersmmx,right.registersmmx); +{$endif SUPPORT_MMX} + end; + { else block } + if assigned(t1) then + begin + oldexceptblock:=aktexceptblock; + aktexceptblock:=t1; + firstpass(t1); + aktexceptblock:=oldexceptblock; + registers32:=max(registers32,t1^.registers32); + registersfpu:=max(registersfpu,t1^.registersfpu); +{$ifdef SUPPORT_MMX} + registersmmx:=max(registersmmx,t1^.registersmmx); +{$endif SUPPORT_MMX} + end; + end; + + +{***************************************************************************** + TTRYFINALLYNODE +*****************************************************************************} + + constructor ttryfinallynode.create; + + begin + end; + + function ttryfinallynode.pass_1 : tnode; + + var + oldexceptblock : tnode; + + begin + pass_1:=nil; + resulttype:=voiddef; +{$ifdef newcg} + tg.cleartempgen; +{$else newcg} + cleartempgen; +{$endif newcg} + oldexceptblock:=aktexceptblock; + aktexceptblock:=left; + firstpass(left); + aktexceptblock:=oldexceptblock; + set_varstate(left,true); +{$ifdef newcg} + tg.cleartempgen; +{$else newcg} + cleartempgen; +{$endif newcg} + oldexceptblock:=aktexceptblock; + aktexceptblock:=right; + firstpass(right); + aktexceptblock:=oldexceptblock; + set_varstate(right,true); + if codegenerror then + exit; + left_right_max(p); + end; + + +{***************************************************************************** + TONNODE +*****************************************************************************} + + constructor tonnode.create; + + begin + end; + + function tonnode.pass_1 : tnode; + + var + oldexceptblock : tnode; + + begin + pass_1:=nil; + { that's really an example procedure for a firstpass :) } + if (excepttype^.deftype<>objectdef) or + not(pobjectdef(excepttype)^.is_class) then + CGMessage(type_e_mismatch); +{$ifdef newcg} + tg.cleartempgen; +{$else newcg} + cleartempgen; +{$endif newcg} + resulttype:=voiddef; + registers32:=0; + registersfpu:=0; +{$ifdef SUPPORT_MMX} + registersmmx:=0; +{$endif SUPPORT_MMX} + if assigned(left) then + begin + firstpass(left); + registers32:=left.registers32; + registersfpu:=left.registersfpu; +{$ifdef SUPPORT_MMX} + registersmmx:=left.registersmmx; +{$endif SUPPORT_MMX} + end; + +{$ifdef newcg} + tg.cleartempgen; +{$else newcg} + cleartempgen; +{$endif newcg} + if assigned(right) then + begin + oldexceptblock:=aktexceptblock; + aktexceptblock:=right; + firstpass(right); + aktexceptblock:=oldexceptblock; + registers32:=max(registers32,right.registers32); + registersfpu:=max(registersfpu,right.registersfpu); +{$ifdef SUPPORT_MMX} + registersmmx:=max(registersmmx,right.registersmmx); +{$endif SUPPORT_MMX} + end; + end; + +begin + cwhilerepeatnode:=twhilerepeatnode; + cifnode:=tifnode; + cfornode:=tfornode; + cexitnode:=texitnode; + cgotonode:=tgotonode; + clabelnode:=tlabelnode; + craisenode:=traisenode; + ctryexceptnode:=ttryexceptnode; + ctryfinallynode:=ttryfinallynode; + connode:=tonnode; +end. +{ + $Log$ + Revision 1.1 2000-09-22 22:46:03 florian + + initial revision + +} \ No newline at end of file