{ $Id$ Copyright (c) 1998-2002 by Florian Klaempfl Generate assembler for nodes that influence the flow which are the same for all (most?) processors 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 ncgflw; {$i fpcdefs.inc} interface uses node,nflw; type tcgwhilerepeatnode = class(twhilerepeatnode) procedure pass_2;override; end; tcgifnode = class(tifnode) procedure pass_2;override; end; tcgfornode = class(tfornode) procedure pass_2;override; end; tcgexitnode = class(texitnode) procedure pass_2;override; end; tcgbreaknode = class(tbreaknode) procedure pass_2;override; end; tcgcontinuenode = class(tcontinuenode) procedure pass_2;override; end; tcggotonode = class(tgotonode) procedure pass_2;override; end; tcglabelnode = class(tlabelnode) procedure pass_2;override; end; tcgfailnode = class(tfailnode) procedure pass_2;override; end; implementation uses verbose,globals,systems,globtype, symconst,symsym,aasmbase,aasmtai,aasmcpu,defbase, cginfo,cgbase,pass_2, cpubase,cpuinfo, nld,ncon, ncgutil, cga, tgobj,rgobj, regvars,cgobj,cgcpu,cg64f32; {***************************************************************************** Second_While_RepeatN *****************************************************************************} procedure tcgwhilerepeatnode.pass_2; var lcont,lbreak,lloop, oldclabel,oldblabel : tasmlabel; otlabel,oflabel : tasmlabel; begin getlabel(lloop); getlabel(lcont); getlabel(lbreak); { arrange continue and breaklabels: } oldclabel:=aktcontinuelabel; oldblabel:=aktbreaklabel; load_all_regvars(exprasmlist); { handling code at the end as it is much more efficient, and makes while equal to repeat loop, only the end true/false is swapped (PFV) } if nf_testatbegin in flags then cg.a_jmp_always(exprasmlist,lcont); if not(cs_littlesize in aktglobalswitches) then { align loop target } exprasmList.concat(Tai_align.Create(aktalignment.loopalign)); cg.a_label(exprasmlist,lloop); aktcontinuelabel:=lcont; aktbreaklabel:=lbreak; rg.cleartempgen; if assigned(right) then secondpass(right); load_all_regvars(exprasmlist); cg.a_label(exprasmlist,lcont); otlabel:=truelabel; oflabel:=falselabel; if nf_checknegate in flags then begin truelabel:=lbreak; falselabel:=lloop; end else begin truelabel:=lloop; falselabel:=lbreak; end; rg.cleartempgen; secondpass(left); maketojumpbool(exprasmlist,left,lr_load_regvars); cg.a_label(exprasmlist,lbreak); truelabel:=otlabel; falselabel:=oflabel; aktcontinuelabel:=oldclabel; aktbreaklabel:=oldblabel; { a break/continue in a while/repeat block can't be seen outside } flowcontrol:=flowcontrol-[fc_break,fc_continue]; end; {***************************************************************************** tcgIFNODE *****************************************************************************} procedure tcgifnode.pass_2; var hl,otlabel,oflabel : tasmlabel; org_regvar_loaded, then_regvar_loaded, else_regvar_loaded : regvar_booleanarray; org_list, then_list, else_list : taasmoutput; begin otlabel:=truelabel; oflabel:=falselabel; getlabel(truelabel); getlabel(falselabel); rg.cleartempgen; secondpass(left); { save regvars loaded in the beginning so that we can restore them } { when processing the else-block } if cs_regalloc in aktglobalswitches then begin org_list := exprasmlist; exprasmlist := taasmoutput.create; end; maketojumpbool(exprasmlist,left,lr_dont_load_regvars); if cs_regalloc in aktglobalswitches then org_regvar_loaded := rg.regvar_loaded; if assigned(right) then begin cg.a_label(exprasmlist,truelabel); rg.cleartempgen; secondpass(right); end; { save current asmlist (previous instructions + then-block) and } { loaded regvar state and create new clean ones } if cs_regalloc in aktglobalswitches then begin then_regvar_loaded := rg.regvar_loaded; rg.regvar_loaded := org_regvar_loaded; then_list := exprasmlist; exprasmlist := taasmoutput.create; end; if assigned(t1) then begin if assigned(right) then begin getlabel(hl); { do go back to if line !! } if not(cs_regalloc in aktglobalswitches) then aktfilepos:=exprasmList.getlasttaifilepos^ else aktfilepos:=then_list.getlasttaifilepos^; cg.a_jmp_always(exprasmlist,hl); end; cg.a_label(exprasmlist,falselabel); rg.cleartempgen; secondpass(t1); { save current asmlist (previous instructions + else-block) } { and loaded regvar state and create a new clean list } if cs_regalloc in aktglobalswitches then begin else_regvar_loaded := rg.regvar_loaded; else_list := exprasmlist; exprasmlist := taasmoutput.create; end; if assigned(right) then cg.a_label(exprasmlist,hl); end else begin if cs_regalloc in aktglobalswitches then begin else_regvar_loaded := rg.regvar_loaded; else_list := exprasmlist; exprasmlist := taasmoutput.create; end; cg.a_label(exprasmlist,falselabel); end; if not(assigned(right)) then begin cg.a_label(exprasmlist,truelabel); end; if cs_regalloc in aktglobalswitches then begin { add loads of regvars at the end of the then- and else-blocks } { so that at the end of both blocks the same regvars are loaded } { no else block? } if not assigned(t1) then sync_regvars(org_list,then_list,org_regvar_loaded, then_regvar_loaded) { no then block? } else if not assigned(right) then sync_regvars(org_list,else_list,org_regvar_loaded, else_regvar_loaded) { both else and then blocks } else sync_regvars(then_list,else_list,then_regvar_loaded, else_regvar_loaded); { add all lists together } org_list.concatlist(then_list); then_list.free; org_list.concatlist(else_list); else_list.free; org_list.concatlist(exprasmlist); exprasmlist.free; exprasmlist := org_list; end; truelabel:=otlabel; falselabel:=oflabel; end; {***************************************************************************** SecondFor *****************************************************************************} procedure tcgfornode.pass_2; var l3,oldclabel,oldblabel : tasmlabel; temptovalue : boolean; hs : byte; temp1 : treference; hop : topcg; hcond : topcmp; opsize : tcgsize; count_var_is_signed : boolean; begin oldclabel:=aktcontinuelabel; oldblabel:=aktbreaklabel; getlabel(aktcontinuelabel); getlabel(aktbreaklabel); getlabel(l3); { only calculate reference } rg.cleartempgen; secondpass(t2); hs := t2.resulttype.def.size; opsize := def_cgsize(t2.resulttype.def); { first set the to value because the count var can be in the expression !! } rg.cleartempgen; secondpass(right); { calculate pointer value and check if changeable and if so } { load into temporary variable } if right.nodetype<>ordconstn then begin temp1.symbol:=nil; tg.gettempofsizereference(exprasmlist,hs,temp1); temptovalue:=true; if (right.location.loc=LOC_REGISTER) or (right.location.loc=LOC_CREGISTER) then begin cg.a_load_reg_ref(exprasmlist,opsize, right.location.register,temp1); rg.ungetregister(exprasmlist,right.location.register); end else cg.g_concatcopy(exprasmlist,right.location.reference,temp1, hs,true,false); end else temptovalue:=false; { produce start assignment } rg.cleartempgen; secondpass(left); count_var_is_signed:=is_signed(t2.resulttype.def); if nf_backward in flags then if count_var_is_signed then hcond:=OC_LT else hcond:=OC_B else if count_var_is_signed then hcond:=OC_GT else hcond:=OC_A; load_all_regvars(exprasmlist); if temptovalue then begin cg.a_cmp_ref_loc_label(exprasmlist,opsize,hcond, temp1,t2.location,aktbreaklabel); end else begin if nf_testatbegin in flags then begin cg.a_cmp_const_loc_label(exprasmlist,opsize,hcond, aword(tordconstnode(right).value), t2.location,aktbreaklabel); end; end; if nf_backward in flags then hop:=OP_ADD else hop:=OP_SUB; cg.a_op_const_loc(exprasmlist,hop,1,t2.location); if not(cs_littlesize in aktglobalswitches) then { align loop target } exprasmList.concat(Tai_align.Create(aktalignment.loopalign)); cg.a_label(exprasmlist,l3); { according to count direction DEC or INC... } if nf_backward in flags then hop:=OP_SUB else hop:=OP_ADD; cg.a_op_const_loc(exprasmlist,hop,1,t2.location); { help register must not be in instruction block } rg.cleartempgen; if assigned(t1) then begin secondpass(t1); load_all_regvars(exprasmlist); end; cg.a_label(exprasmlist,aktcontinuelabel); { makes no problems there } rg.cleartempgen; if nf_backward in flags then if count_var_is_signed then hcond:=OC_GT else hcond:=OC_A else if count_var_is_signed then hcond:=OC_LT else hcond:=OC_B; load_all_regvars(exprasmlist); { produce comparison and the corresponding } { jump } if temptovalue then begin cg.a_cmp_ref_loc_label(exprasmlist,opsize,hcond,temp1, t2.location,l3); end else begin cg.a_cmp_const_loc_label(exprasmlist,opsize,hcond, aword(tordconstnode(right).value),t2.location,l3); end; if temptovalue then tg.ungetiftemp(exprasmlist,temp1); { this is the break label: } cg.a_label(exprasmlist,aktbreaklabel); aktcontinuelabel:=oldclabel; aktbreaklabel:=oldblabel; { a break/continue in a for block can't be seen outside } flowcontrol:=flowcontrol-[fc_break,fc_continue]; end; {***************************************************************************** SecondExitN *****************************************************************************} procedure tcgexitnode.pass_2; var {op : tasmop; s : topsize;} otlabel,oflabel : tasmlabel; cgsize : tcgsize; hreg : tregister; allocated_acc, allocated_acchigh: boolean; label do_jmp; begin { load_all_regvars(exprasmlist); } include(flowcontrol,fc_exit); if assigned(left) then if left.nodetype=assignn then begin { just do a normal assignment followed by exit } secondpass(left); cg.a_jmp_always(exprasmlist,aktexitlabel); end else begin allocated_acc := false; allocated_acchigh := false; otlabel:=truelabel; oflabel:=falselabel; getlabel(truelabel); getlabel(falselabel); secondpass(left); { the result of left is not needed anymore after this node } location_freetemp(exprasmlist,left.location); location_release(exprasmlist,left.location); case left.location.loc of LOC_FPUREGISTER : goto do_jmp; LOC_FLAGS : begin cg.a_reg_alloc(exprasmlist,accumulator); allocated_acc := true; cg.g_flags2reg(exprasmlist,left.location.resflags,accumulator); goto do_jmp; end; LOC_JUMP : begin cg.a_reg_alloc(exprasmlist,accumulator); { get an 8-bit register } hreg:=rg.makeregsize(accumulator,OS_8); allocated_acc := true; cg.a_label(exprasmlist,truelabel); cg.a_load_const_reg(exprasmlist,OS_8,1,hreg); cg.a_jmp_always(exprasmlist,aktexit2label); cg.a_label(exprasmlist,falselabel); cg.a_load_const_reg(exprasmlist,OS_8,0,hreg); goto do_jmp; end; end; case aktprocdef.rettype.def.deftype of pointerdef, procvardef : begin cg.a_reg_alloc(exprasmlist,accumulator); allocated_acc := true; cg.a_load_loc_reg(exprasmlist,left.location,accumulator); end; floatdef : begin {$ifndef i386} cg.a_reg_alloc(exprasmlist,fpuresultreg); {$endif not i386} cg.a_loadfpu_loc_reg(exprasmlist,left.location,fpuresultreg); end; else begin cgsize:=def_cgsize(aktprocdef.rettype.def); cg.a_reg_alloc(exprasmlist,accumulator); allocated_acc := true; case cgsize of OS_64,OS_S64 : begin cg.a_reg_alloc(exprasmlist,accumulatorhigh); allocated_acchigh := true; cg64.a_load64_loc_reg(exprasmlist,left.location, joinreg64(accumulator,accumulatorhigh)); end else begin hreg:=rg.makeregsize(accumulator,cgsize); cg.a_load_loc_reg(exprasmlist,left.location,hreg); end; end; end; end; do_jmp: truelabel:=otlabel; falselabel:=oflabel; cg.a_jmp_always(exprasmlist,aktexit2label); if allocated_acc then cg.a_reg_dealloc(exprasmlist,accumulator); if allocated_acchigh then cg.a_reg_dealloc(exprasmlist,accumulatorhigh); {$ifndef i386} if (aktprocdef.rettype.def.deftype = floatdef) then cg.a_reg_dealloc(exprasmlist,fpuresultreg); {$endif not i386} end else cg.a_jmp_always(exprasmlist,aktexitlabel); end; {***************************************************************************** SecondBreakN *****************************************************************************} procedure tcgbreaknode.pass_2; begin include(flowcontrol,fc_break); if aktbreaklabel<>nil then begin load_all_regvars(exprasmlist); cg.a_jmp_always(exprasmlist,aktbreaklabel) end else CGMessage(cg_e_break_not_allowed); end; {***************************************************************************** SecondContinueN *****************************************************************************} procedure tcgcontinuenode.pass_2; begin include(flowcontrol,fc_continue); if aktcontinuelabel<>nil then begin load_all_regvars(exprasmlist); cg.a_jmp_always(exprasmlist,aktcontinuelabel) end else CGMessage(cg_e_continue_not_allowed); end; {***************************************************************************** SecondGoto *****************************************************************************} procedure tcggotonode.pass_2; begin load_all_regvars(exprasmlist); cg.a_jmp_always(exprasmlist,labelnr) end; {***************************************************************************** SecondLabel *****************************************************************************} procedure tcglabelnode.pass_2; begin load_all_regvars(exprasmlist); cg.a_label(exprasmlist,labelnr); rg.cleartempgen; secondpass(left); end; {***************************************************************************** SecondFail *****************************************************************************} procedure tcgfailnode.pass_2; begin cg.a_jmp_always(exprasmlist,faillabel); end; begin cwhilerepeatnode:=tcgwhilerepeatnode; cifnode:=tcgifnode; cfornode:=tcgfornode; cexitnode:=tcgexitnode; cbreaknode:=tcgbreaknode; ccontinuenode:=tcgcontinuenode; cgotonode:=tcggotonode; clabelnode:=tcglabelnode; cfailnode:=tcgfailnode; end. { $Log$ Revision 1.28 2002-07-21 06:58:49 daniel * Changed booleans into flags Revision 1.27 2002/07/20 12:54:53 daniel * Optimized the code generated for for nodes. The shootout/nestloop benchmark now runs 5% faster on my computer. Revision 1.26 2002/07/20 11:57:54 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.25 2002/07/20 11:15:51 daniel * The for node does a check if the first comparision can be skipped. I moved the check from the second pass to the resulttype pass. The advantage is that the state tracker can now decide to skip the first comparision too. Revision 1.24 2002/07/20 08:14:24 daniel * Loops should not be aligned when optimizing for size Revision 1.23 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.22 2002/07/04 20:43:01 florian * first x86-64 patches Revision 1.21 2002/07/01 18:46:22 peter * internal linker * reorganized aasm layer Revision 1.20 2002/07/01 16:23:53 peter * cg64 patch * basics for currency * asnode updates for class and interface (not finished) Revision 1.19 2002/05/20 13:30:40 carl * bugfix of hdisponen (base must be set, not index) * more portability fixes Revision 1.18 2002/05/18 13:34:09 peter * readded missing revisions Revision 1.17 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.15 2002/05/13 19:54:37 peter * removed n386ld and n386util units * maybe_save/maybe_restore added instead of the old maybe_push Revision 1.14 2002/05/12 16:53:07 peter * moved entry and exitcode to ncgutil and cgobj * foreach gets extra argument for passing local data to the iterator function * -CR checks also class typecasts at runtime by changing them into as * fixed compiler to cycle with the -CR option * fixed stabs with elf writer, finally the global variables can be watched * removed a lot of routines from cga unit and replaced them by calls to cgobj * u32bit-s32bit updates for and,or,xor nodes. When one element is u32bit then the other is typecasted also to u32bit without giving a rangecheck warning/error. * fixed pascal calling method with reversing also the high tree in the parast, detected by tcalcst3 test Revision 1.13 2002/04/21 15:24:38 carl + a_jmp_cond -> a_jmp_always (a_jmp_cond is NOT portable) + changeregsize -> rg.makeregsize Revision 1.12 2002/04/15 19:44:19 peter * fixed stackcheck that would be called recursively when a stack error was found * generic changeregsize(reg,size) for i386 register resizing * removed some more routines from cga unit * fixed returnvalue handling * fixed default stacksize of linux and go32v2, 8kb was a bit small :-) Revision 1.11 2002/04/04 19:05:57 peter * removed unused units * use tlocation.size in cg.a_*loc*() routines Revision 1.10 2002/04/02 17:11:28 peter * tlocation,treference update * LOC_CONSTANT added for better constant handling * secondadd splitted in multiple routines * location_force_reg added for loading a location to a register of a specified size * secondassignment parses now first the right and then the left node (this is compatible with Kylix). This saves a lot of push/pop especially with string operations * adapted some routines to use the new cg methods Revision 1.9 2002/03/31 20:26:34 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.8 2002/03/04 19:10:11 peter * removed compiler warnings }