diff --git a/compiler/new/cgflw.pas b/compiler/new/cgflw.pas index 865e38ef06..b80a8db6f5 100644 --- a/compiler/new/cgflw.pas +++ b/compiler/new/cgflw.pas @@ -2,7 +2,7 @@ $Id$ Copyright (c) 1998-2000 by Florian Klaempfl - Generate assembler for nodes that influence the flow + Generate ppc assembler 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 @@ -20,51 +20,87 @@ **************************************************************************** } +unit ncpuflw; +{$i defines.inc} -{ in sync with cg386flw rev 1.55 of the main branch } - -unit cg386flw; interface uses - tree; + node,nflw; - procedure second_while_repeatn(list: paasmoutput; var p : ptree); - procedure secondifn(list: paasmoutput; var p : ptree); - procedure secondfor(list: paasmoutput; var p : ptree); - procedure secondexitn(list: paasmoutput; var p : ptree); - procedure secondbreakn(list: paasmoutput; var p : ptree); - procedure secondcontinuen( list: paasmoutput; var p : ptree); - procedure secondgoto(list: paasmoutput; var p : ptree); - procedure secondlabel(list: paasmoutput; var p : ptree); - procedure secondraise(list: paasmoutput; var p : ptree); - procedure secondtryexcept(list: paasmoutput; var p : ptree); - procedure secondtryfinally(list: paasmoutput; var p : ptree); - procedure secondon(list: paasmoutput; var p : ptree); - procedure secondfail(list: paasmoutput; var p : ptree); + type + tcpuwhilerepeatnode = class(twhilerepeatnode) + procedure pass_2;override; + end; + tcpuifnode = class(tifnode) + procedure pass_2;override; + end; + + tcpufornode = class(tfornode) + procedure pass_2;override; + end; + + tcpuexitnode = class(texitnode) + procedure pass_2;override; + end; + + tcpubreaknode = class(tbreaknode) + procedure pass_2;override; + end; + + tcpucontinuenode = class(tcontinuenode) + procedure pass_2;override; + end; + + tcpugotonode = class(tgotonode) + procedure pass_2;override; + end; + + tcpulabelnode = class(tlabelnode) + procedure pass_2;override; + end; + + tcpuraisenode = class(traisenode) + procedure pass_2;override; + end; + + tcputryexceptnode = class(ttryexceptnode) + procedure pass_2;override; + end; + + tcputryfinallynode = class(ttryfinallynode) + procedure pass_2;override; + end; + + tcpuonnode = class(tonnode) + procedure pass_2;override; + end; + + tcpufailnode = class(tfailnode) + procedure pass_2;override; + end; implementation uses - cobjects,verbose,globtype,globals,systems, - symconst,symtable,aasm,types, - hcodegen,temp_gen,pass_2, - cpubase,cpuasm{, - cgai386,tgeni386}, cgcpu; + verbose,globtype,globals,systems, + symconst,symdef,symsym,aasm,types, + cgbase,temp_gen,pass_2, + cpubase,cpuasm, + pass_1,nld,ncon, + cga,tgcpu,n386util,regvars; {***************************************************************************** Second_While_RepeatN *****************************************************************************} - procedure second_while_repeatn(list: paasmoutput; var p : ptree); - { converted, problems left: } - { * maketojumpbool } + procedure tcpuwhilerepeatnode.pass_2; var lcont,lbreak,lloop, - oldclabel,oldblabel : pasmlabel; - otlabel,oflabel : pasmlabel; + oldclabel,oldblabel : tasmlabel; + otlabel,oflabel : tasmlabel; begin getlabel(lloop); @@ -74,22 +110,28 @@ implementation 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 p^.treetype=whilen then - a_jmp_cond(list,C_None,lcont); + if nodetype=whilen then + cgcpu.a_jmp_cond(exprasmlist,OC_None,lcont); - a_label(list,lloop); + { align loop target } + exprasmList.concat(Tai_align.Create(aktalignment.loopalign)); + cgcpu.cgcpu.a_label(exprasmlist,lloop); aktcontinuelabel:=lcont; aktbreaklabel:=lbreak; cleartempgen; - if assigned(p^.right) then - secondpass(list,p^.right); - a_label(list,lcont); + if assigned(right) then + secondpass(right); + + load_all_regvars(exprasmlist); + + cgcpu.a_label(exprasmlist,lcont); otlabel:=truelabel; oflabel:=falselabel; - if p^.treetype=whilen then + if nodetype=whilen then begin truelabel:=lloop; falselabel:=lbreak; @@ -101,30 +143,31 @@ implementation falselabel:=lloop; end; cleartempgen; - secondpass(list,p^.left); - { has to be implemented processor dependently !!!! } - maketojumpbool(list, p^.left); - a_label(ist,lbreak); - freelabel(lloop); - freelabel(lcont); - freelabel(lbreak); + secondpass(left); + + load_all_regvars(exprasmlist); + + maketojumpbool(left); + cgcpu.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; {***************************************************************************** - SecondIfN + TCPUIFNODE *****************************************************************************} - procedure secondifn(list: paasmoutput; var p : ptree); - { converted, problems left: } - { * maketojumpbool } + procedure tcpuifnode.pass_2; + var - hl,otlabel,oflabel : pasmlabel; + hl,otlabel,oflabel : tasmlabel; begin otlabel:=truelabel; @@ -132,39 +175,41 @@ implementation getlabel(truelabel); getlabel(falselabel); cleartempgen; - secondpass(list,p^.left); - maketojumpbool(list,p^.left); - if assigned(p^.right) then + secondpass(left); + load_all_regvars(exprasmlist); + maketojumpbool(left); + if assigned(right) then begin - a_label(list, truelabel); + cgcpu.a_label(truelabel); cleartempgen; - secondpass(list,p^.right); + secondpass(right); + { automatically done for blocks, but not for statements (JM) } + load_all_regvars(exprasmlist); end; - if assigned(p^.t1) then + if assigned(t1) then begin - if assigned(p^.right) then + if assigned(right) then begin getlabel(hl); { do go back to if line !! } - aktfilepos:=list^.getlasttaifilepos^; - a_jmp_cond(list,C_None,hl); + aktfilepos:=exprasmList.getlasttaifilepos^; + cgcpu.a_jmp_cond(exprasmlist,OC_None,hl); end; - a_label(list,falselabel); + cgcpu.a_label(exprasmlist,falselabel); cleartempgen; - secondpass(list,p^.t1); - if assigned(p^.right) then - a_label(list,hl); + secondpass(t1); + load_all_regvars(exprasmlist); + if assigned(right) then + cgcpu.a_label(exprasmlist,hl); end else begin - a_label(list,falselabel); + cgcpu.a_label(exprasmlist,falselabel); end; - if not(assigned(p^.right)) then + if not(assigned(right)) then begin - a_label(list,truelabel); + cgcpu.a_label(exprasmlist,truelabel); end; - freelabel(truelabel); - freelabel(falselabel); truelabel:=otlabel; falselabel:=oflabel; end; @@ -174,20 +219,15 @@ implementation SecondFor *****************************************************************************} - procedure secondfor(list: paasmoutput; var p : ptree); - { still being converted, problems left: } - { * getregister32 } - { * size issues (" p^.t2^.resulttype^.size") } - + procedure tcpufornode.pass_2; var - l3,oldclabel,oldblabel : pasmlabel; + l3,oldclabel,oldblabel : tasmlabel; omitfirstcomp,temptovalue : boolean; hs : byte; temp1 : treference; hop : tasmop; - hcond : tasmcond; - cmpreg,cmp32 : tregister; - opsize : topsize; + hcond : topcg; + opsize : tcgsize; count_var_is_signed : boolean; begin @@ -199,191 +239,137 @@ implementation { could we spare the first comparison ? } omitfirstcomp:=false; - if p^.right^.treetype=ordconstn then - if p^.left^.right^.treetype=ordconstn then - omitfirstcomp:=(p^.backward and (p^.left^.right^.value>=p^.right^.value)) - or (not(p^.backward) and (p^.left^.right^.value<=p^.right^.value)); + if right.nodetype=ordconstn then + if tassignmentnode(left).right.nodetype=ordconstn then + omitfirstcomp:=((nf_backward in flags) and + (tordconstnode(tassignmentnode(left).right).value>=tordconstnode(right).value)) + or (not(nf_backward in flags) and + (tordconstnode(tassignmentnode(left).right).value<=tordconstnode(right).value)); { only calculate reference } cleartempgen; - secondpass(list,p^.t2); - hs:=p^.t2^.resulttype^.size; - cmp32:=getregister32; - case hs of - 1 : begin - opsize:=S_B; - cmpreg:=reg32toreg8(cmp32); - end; - 2 : begin - opsize:=S_W; - cmpreg:=reg32toreg16(cmp32); - end; - 4 : begin - opsize:=S_L; - cmpreg:=cmp32; - end; - end; + secondpass(t2); + hs := t2.resulttype.def.size; + opsize := def_opsize(t2.resulttype.def); { first set the to value because the count var can be in the expression !! } cleartempgen; - secondpass(list,p^.right); + secondpass(right); { calculate pointer value and check if changeable and if so } { load into temporary variable } - if p^.right^.treetype<>ordconstn then + if right.nodetype<>ordconstn then begin temp1.symbol:=nil; gettempofsizereference(hs,temp1); temptovalue:=true; - if (p^.right^.location.loc=LOC_REGISTER) or - (p^.right^.location.loc=LOC_CREGISTER) then + if (right.location.loc=LOC_REGISTER) or + (right.location.loc=LOC_CREGISTER) then begin - emit_reg_ref(A_MOV,opsize,p^.right^.location.register, - newreference(temp1)); + cgcpu.a_load_reg_ref(exprasmlist,opsize, + right.location.register,newreference(temp1)); end else - concatcopy(p^.right^.location.reference,temp1,hs,false,false); + cgcpu.concatcopy(exprasmlist,right.location.reference,temp1, + hs,false,false); end else temptovalue:=false; { produce start assignment } cleartempgen; - secondpass(p^.left); - count_var_is_signed:=is_signed(porddef(p^.t2^.resulttype)); + secondpass(left); + count_var_is_signed:=is_signed(torddef(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 - if p^.t2^.location.loc=LOC_CREGISTER then - begin - emit_ref_reg(A_CMP,opsize,newreference(temp1), - p^.t2^.location.register); - end - else - begin - emit_ref_reg(A_MOV,opsize,newreference(p^.t2^.location.reference), - cmpreg); - emit_ref_reg(A_CMP,opsize,newreference(temp1), - cmpreg); - end; + begin + cgcpu.a_cmp_ref_loc_label(exprasmlist,opsize,hcond, + newreference(temp1),t2.location,aktbreaklabel); end else - begin - if not(omitfirstcomp) then - begin - if p^.t2^.location.loc=LOC_CREGISTER then - emit_const_reg(A_CMP,opsize,p^.right^.value, - p^.t2^.location.register) - else - emit_const_ref(A_CMP,opsize,p^.right^.value, - newreference(p^.t2^.location.reference)); - end; + begin + if not(omitfirstcomp) then + begin + cgcpu.a_cmp_const_loc(exprasmlist,opsize,hcond, + tordconstnode(right).value,t2.location,aktbreaklabel); + end; end; - if p^.backward then - if count_var_is_signed then - hcond:=C_L - else - hcond:=C_B - else - if count_var_is_signed then - hcond:=C_G - else - hcond:=C_A; - - if not(omitfirstcomp) or temptovalue then - emitjmp(hcond,aktbreaklabel); { align loop target } - if not(cs_littlesize in aktglobalswitches) then - exprasmlist^.concat(new(pai_align,init_op(4,$90))); - - emitlab(l3); + exprasmList.concat(Tai_align.Create(aktalignment.loopalign)); + cgcpu.a_label(exprasmlist,l3); { help register must not be in instruction block } cleartempgen; - if assigned(p^.t1) then - secondpass(p^.t1); + if assigned(t1) then + begin + secondpass(t1); + load_all_regvars(exprasmlist); + end; - emitlab(aktcontinuelabel); + cgcpu.a_label(exprasmlist,aktcontinuelabel); { makes no problems there } cleartempgen; - { demand help register again } - cmp32:=getregister32; - case hs of - 1 : begin - opsize:=S_B; - cmpreg:=reg32toreg8(cmp32); - end; - 2 : begin - opsize:=S_W; - cmpreg:=reg32toreg16(cmp32); - end; - 4 : opsize:=S_L; - end; + if nf_backward in flags then + if count_var_is_signed then + hcond:=OC_LE + else + hcond:=OC_BE + else + if count_var_is_signed then + hcond:=OC_GE + else + hcond:=OC_AE; + load_all_regvars(exprasmlist); { produce comparison and the corresponding } { jump } if temptovalue then begin - if p^.t2^.location.loc=LOC_CREGISTER then - begin - emit_ref_reg(A_CMP,opsize,newreference(temp1), - p^.t2^.location.register); - end - else - begin - emit_ref_reg(A_MOV,opsize,newreference(p^.t2^.location.reference), - cmpreg); - emit_ref_reg(A_CMP,opsize,newreference(temp1), - cmpreg); - end; + cgcpu.a_cmp_ref_loc(exprasmlist,opsize,hcond,newreference(temp1), + t2.location,aktbreaklabel); end else begin - if p^.t2^.location.loc=LOC_CREGISTER then - emit_const_reg(A_CMP,opsize,p^.right^.value, - p^.t2^.location.register) - else - emit_const_ref(A_CMP,opsize,p^.right^.value, - newreference(p^.t2^.location.reference)); + cgcpu.a_cmp_const_loc_label(exprasmlist,opsize,hcond,tordconstnode(right).value, + t2.location,aktbreaklabel); end; - if p^.backward then - if count_var_is_signed then - hcond:=C_LE - else - hcond:=C_BE - else - if count_var_is_signed then - hcond:=C_GE - else - hcond:=C_AE; - emitjmp(hcond,aktbreaklabel); + e(hcond,aktbreaklabel); { according to count direction DEC or INC... } - { must be after the test because of 0to 255 for bytes !! } - if p^.backward then - hop:=A_DEC + { must be after the test because of 0 to 255 for bytes !! } + if nf_backward in flags then + hop:=OP_ADD else - hop:=A_INC; + hop:=OP_SUB; - if p^.t2^.location.loc=LOC_CREGISTER then - emit_reg(hop,opsize,p^.t2^.location.register) - else - emit_ref(hop,opsize,newreference(p^.t2^.location.reference)); - emitjmp(C_None,l3); - - { this is the break label: } - emitlab(aktbreaklabel); - ungetregister32(cmp32); + a_op_loc_const(exprasmlist,hop,opsize,t2.location,1); + a_jmp_cond(exprasmlist,OC_None,l3); if temptovalue then ungetiftemp(temp1); - freelabel(aktcontinuelabel); - freelabel(aktbreaklabel); - freelabel(l3); + { this is the break label: } + cgcpu.a_label(exptrasmlist,aktbreaklabel); + aktcontinuelabel:=oldclabel; aktbreaklabel:=oldblabel; + { a break/continue in a for block can't be seen outside } + flowcontrol:=flowcontrol-[fc_break,fc_continue]; end; @@ -391,40 +377,68 @@ implementation SecondExitN *****************************************************************************} - procedure secondexitn(list: paasmoutput; var p : ptree); + procedure ti386exitnode.pass_2; + var - is_mem : boolean; {op : tasmop; s : topsize;} - otlabel,oflabel : pasmlabel; + otlabel,oflabel : tasmlabel; + r : preference; + is_mem, + allocated_eax, + allocated_edx: boolean; + + procedure cleanleft; + begin + if is_mem then + begin + del_reference(left.location.reference); + ungetiftemp(left.location.reference); + end + else + begin + ungetregister(left.location.register); + if left.location.registerhigh <> R_NO then + ungetregister(left.location.registerhigh); + end; + end; + label do_jmp; begin - if assigned(p^.left) then - if p^.left^.treetype=assignn then + 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(p^.left); + secondpass(left); emitjmp(C_None,aktexitlabel); end else begin + allocated_eax := false; + allocated_edx := false; otlabel:=truelabel; oflabel:=falselabel; getlabel(truelabel); getlabel(falselabel); - secondpass(p^.left); - case p^.left^.location.loc of + secondpass(left); + case left.location.loc of LOC_FPU : goto do_jmp; LOC_MEM, LOC_REFERENCE : is_mem:=true; LOC_CREGISTER, LOC_REGISTER : is_mem:=false; LOC_FLAGS : begin - emit_flag2reg(p^.left^.location.resflags,R_AL); + exprasmlist.concat(tairegalloc.alloc(R_EAX)); + allocated_eax := true; + emit_flag2reg(left.location.resflags,R_AL); goto do_jmp; end; LOC_JUMP : begin + exprasmlist.concat(tairegalloc.alloc(R_EAX)); + allocated_eax := true; emitlab(truelabel); emit_const_reg(A_MOV,S_B,1,R_AL); emitjmp(C_None,aktexit2label); @@ -435,61 +449,84 @@ implementation else internalerror(2001); end; - case procinfo^.retdef^.deftype of - orddef, - enumdef : begin - case procinfo^.retdef^.size of - 4 : if is_mem then - emit_ref_reg(A_MOV,S_L, - newreference(p^.left^.location.reference),R_EAX) - else - emit_reg_reg(A_MOV,S_L,p^.left^.location.register,R_EAX); - 2 : if is_mem then - emit_ref_reg(A_MOV,S_W, - newreference(p^.left^.location.reference),R_AX) - else - emit_reg_reg(A_MOV,S_W,makereg16(p^.left^.location.register),R_AX); - 1 : if is_mem then - emit_ref_reg(A_MOV,S_B, - newreference(p^.left^.location.reference),R_AL) - else - emit_reg_reg(A_MOV,S_B,makereg8(p^.left^.location.register),R_AL); - end; - end; + case aktprocsym.definition.rettype.def.deftype of pointerdef, procvardef : begin + cleanleft; + exprasmlist.concat(tairegalloc.alloc(R_EAX)); + allocated_eax := true; if is_mem then emit_ref_reg(A_MOV,S_L, - newreference(p^.left^.location.reference),R_EAX) + newreference(left.location.reference),R_EAX) else emit_reg_reg(A_MOV,S_L, - p^.left^.location.register,R_EAX); + left.location.register,R_EAX); end; floatdef : begin - if pfloatdef(procinfo^.retdef)^.typ=f32bit then - begin - if is_mem then - emit_ref_reg(A_MOV,S_L, - newreference(p^.left^.location.reference),R_EAX) - else - emit_reg_reg(A_MOV,S_L,p^.left^.location.register,R_EAX); - end - else - if is_mem then - floatload(pfloatdef(procinfo^.retdef)^.typ,p^.left^.location.reference); + cleanleft; + if is_mem then + floatload(tfloatdef(aktprocsym.definition.rettype.def).typ,left.location.reference); + end; + { orddef, + enumdef : } + else + { it can be anything shorter than 4 bytes PM + this caused form bug 711 } + begin + cleanleft; + exprasmlist.concat(tairegalloc.alloc(R_EAX)); + allocated_eax := true; + case aktprocsym.definition.rettype.def.size of + { it can be a qword/int64 too ... } + 8 : if is_mem then + begin + emit_ref_reg(A_MOV,S_L, + newreference(left.location.reference),R_EAX); + r:=newreference(left.location.reference); + inc(r^.offset,4); + exprasmlist.concat(tairegalloc.alloc(R_EDX)); + allocated_edx := true; + emit_ref_reg(A_MOV,S_L,r,R_EDX); + end + else + begin + emit_reg_reg(A_MOV,S_L,left.location.registerlow,R_EAX); + exprasmlist.concat(tairegalloc.alloc(R_EDX)); + allocated_edx := true; + emit_reg_reg(A_MOV,S_L,left.location.registerhigh,R_EDX); + end; + { if its 3 bytes only we can still + copy one of garbage ! PM } + 4,3 : if is_mem then + emit_ref_reg(A_MOV,S_L, + newreference(left.location.reference),R_EAX) + else + emit_reg_reg(A_MOV,S_L,left.location.register,R_EAX); + 2 : if is_mem then + emit_ref_reg(A_MOV,S_W, + newreference(left.location.reference),R_AX) + else + emit_reg_reg(A_MOV,S_W,makereg16(left.location.register),R_AX); + 1 : if is_mem then + emit_ref_reg(A_MOV,S_B, + newreference(left.location.reference),R_AL) + else + emit_reg_reg(A_MOV,S_B,makereg8(left.location.register),R_AL); + else internalerror(605001); + end; end; end; do_jmp: - freelabel(truelabel); - freelabel(falselabel); truelabel:=otlabel; falselabel:=oflabel; emitjmp(C_None,aktexit2label); + if allocated_eax then + exprasmlist.concat(tairegalloc.dealloc(R_EAX)); + if allocated_edx then + exprasmlist.concat(tairegalloc.dealloc(R_EDX)); end else - begin - emitjmp(C_None,aktexitlabel); - end; + emitjmp(C_None,aktexitlabel); end; @@ -497,10 +534,14 @@ do_jmp: SecondBreakN *****************************************************************************} - procedure secondbreakn(list: paasmoutput; var p : ptree); + procedure ti386breaknode.pass_2; begin + include(flowcontrol,fc_break); if aktbreaklabel<>nil then - emitjmp(C_None,aktbreaklabel) + begin + load_all_regvars(exprasmlist); + emitjmp(C_None,aktbreaklabel) + end else CGMessage(cg_e_break_not_allowed); end; @@ -510,10 +551,14 @@ do_jmp: SecondContinueN *****************************************************************************} - procedure secondcontinuen(list: paasmoutput; var p : ptree); + procedure ti386continuenode.pass_2; begin + include(flowcontrol,fc_continue); if aktcontinuelabel<>nil then - emitjmp(C_None,aktcontinuelabel) + begin + load_all_regvars(exprasmlist); + emitjmp(C_None,aktcontinuelabel) + end else CGMessage(cg_e_continue_not_allowed); end; @@ -523,10 +568,11 @@ do_jmp: SecondGoto *****************************************************************************} - procedure secondgoto(list: paasmoutput; var p : ptree); + procedure ti386gotonode.pass_2; begin - emitjmp(C_None,p^.labelnr); + load_all_regvars(exprasmlist); + emitjmp(C_None,labelnr); end; @@ -534,11 +580,12 @@ do_jmp: SecondLabel *****************************************************************************} - procedure secondlabel(list: paasmoutput; var p : ptree); + procedure ti386labelnode.pass_2; begin - emitlab(p^.labelnr); + load_all_regvars(exprasmlist); + emitlab(labelnr); cleartempgen; - secondpass(p^.left); + secondpass(left); end; @@ -546,46 +593,51 @@ do_jmp: SecondRaise *****************************************************************************} - procedure secondraise(list: paasmoutput; var p : ptree); + procedure ti386raisenode.pass_2; var - a : pasmlabel; - + a : tasmlabel; begin - if assigned(p^.left) then + if assigned(left) then begin - { generate the address } - if assigned(p^.right) then + { multiple parameters? } + if assigned(right) then begin - secondpass(p^.right); - if codegenerror then - exit; + { push frame } + if assigned(frametree) then + begin + secondpass(frametree); + if codegenerror then + exit; + emit_push_loc(frametree.location); + end + else + emit_const(A_PUSH,S_L,0); + { push address } + secondpass(right); + if codegenerror then + exit; + emit_push_loc(right.location); end else begin - getlabel(a); + getaddrlabel(a); emitlab(a); + emit_reg(A_PUSH,S_L,R_EBP); emit_sym(A_PUSH,S_L,a); end; - secondpass(p^.left); + { push object } + secondpass(left); if codegenerror then exit; - - case p^.left^.location.loc of - LOC_MEM,LOC_REFERENCE: - emit_ref(A_PUSH,S_L, - newreference(p^.left^.location.reference)); - LOC_CREGISTER,LOC_REGISTER : emit_reg(A_PUSH,S_L, - p^.left^.location.register); - else CGMessage(type_e_mismatch); - end; + emit_push_loc(left.location); emitcall('FPC_RAISEEXCEPTION'); - end - else - begin - emitcall('FPC_POPADDRSTACK'); - emitcall('FPC_RERAISE'); - end; + end + else + begin + emitcall('FPC_POPADDRSTACK'); + emitcall('FPC_RERAISE'); + end; end; @@ -594,177 +646,603 @@ do_jmp: *****************************************************************************} var - endexceptlabel : pasmlabel; + endexceptlabel : tasmlabel; - procedure secondtryexcept(list: paasmoutput; var p : ptree); + { does the necessary things to clean up the object stack } + { in the except block } + procedure cleanupobjectstack; + + begin + emitcall('FPC_POPOBJECTSTACK'); + exprasmList.concat(Tairegalloc.Alloc(R_EAX)); + emit_reg(A_PUSH,S_L,R_EAX); + emitcall('FPC_DESTROYEXCEPTION'); + exprasmList.concat(Tairegalloc.DeAlloc(R_EAX)); + maybe_loadself; + end; + + { pops one element from the exception address stack } + { and removes the flag } + procedure cleanupaddrstack; + + begin + emitcall('FPC_POPADDRSTACK'); + { allocate eax } + exprasmList.concat(Tairegalloc.Alloc(R_EAX)); + emit_reg(A_POP,S_L,R_EAX); + { deallocate eax } + exprasmList.concat(Tairegalloc.DeAlloc(R_EAX)); + end; + + procedure ti386tryexceptnode.pass_2; var exceptlabel,doexceptlabel,oldendexceptlabel, - lastonlabel : pasmlabel; + lastonlabel, + exitexceptlabel, + continueexceptlabel, + breakexceptlabel, + exittrylabel, + continuetrylabel, + breaktrylabel, + doobjectdestroy, + doobjectdestroyandreraise, + oldaktexitlabel, + oldaktexit2label, + oldaktcontinuelabel, + oldaktbreaklabel : tasmlabel; + oldflowcontrol,tryflowcontrol, + exceptflowcontrol : tflowcontrol; + tempbuf,tempaddr : treference; + label + errorexit; begin + oldflowcontrol:=flowcontrol; + flowcontrol:=[]; { this can be called recursivly } oldendexceptlabel:=endexceptlabel; + { we modify EAX } usedinproc:=usedinproc or ($80 shr byte(R_EAX)); + { save the old labels for control flow statements } + oldaktexitlabel:=aktexitlabel; + oldaktexit2label:=aktexit2label; + if assigned(aktbreaklabel) then + begin + oldaktcontinuelabel:=aktcontinuelabel; + oldaktbreaklabel:=aktbreaklabel; + end; + + { get new labels for the control flow statements } + getlabel(exittrylabel); + getlabel(exitexceptlabel); + if assigned(aktbreaklabel) then + begin + getlabel(breaktrylabel); + getlabel(continuetrylabel); + getlabel(breakexceptlabel); + getlabel(continueexceptlabel); + end; + getlabel(exceptlabel); getlabel(doexceptlabel); getlabel(endexceptlabel); getlabel(lastonlabel); + + gettempofsizereferencepersistant(24,tempbuf); + gettempofsizereferencepersistant(12,tempaddr); + emitpushreferenceaddr(tempaddr); + emitpushreferenceaddr(tempbuf); push_int (1); { push type of exceptionframe } emitcall('FPC_PUSHEXCEPTADDR'); + + { allocate eax } + exprasmList.concat(Tairegalloc.Alloc(R_EAX)); emit_reg(A_PUSH,S_L,R_EAX); emitcall('FPC_SETJMP'); emit_reg(A_PUSH,S_L,R_EAX); emit_reg_reg(A_TEST,S_L,R_EAX,R_EAX); + { deallocate eax } + exprasmList.concat(Tairegalloc.DeAlloc(R_EAX)); emitjmp(C_NE,exceptlabel); - { try code } - secondpass(p^.left); + { try block } + { set control flow labels for the try block } + aktexitlabel:=exittrylabel; + aktexit2label:=exittrylabel; + if assigned(oldaktbreaklabel) then + begin + aktcontinuelabel:=continuetrylabel; + aktbreaklabel:=breaktrylabel; + end; + + flowcontrol:=[]; + secondpass(left); + tryflowcontrol:=flowcontrol; if codegenerror then - exit; + goto errorexit; emitlab(exceptlabel); emitcall('FPC_POPADDRSTACK'); + ungetpersistanttempreference(tempaddr); + ungetpersistanttempreference(tempbuf); + + exprasmList.concat(Tairegalloc.Alloc(R_EAX)); emit_reg(A_POP,S_L,R_EAX); emit_reg_reg(A_TEST,S_L,R_EAX,R_EAX); + exprasmList.concat(Tairegalloc.DeAlloc(R_EAX)); + emitjmp(C_E,endexceptlabel); emitlab(doexceptlabel); - if assigned(p^.right) then - secondpass(p^.right); + { set control flow labels for the except block } + { and the on statements } + aktexitlabel:=exitexceptlabel; + aktexit2label:=exitexceptlabel; + if assigned(oldaktbreaklabel) then + begin + aktcontinuelabel:=continueexceptlabel; + aktbreaklabel:=breakexceptlabel; + end; + + flowcontrol:=[]; + { on statements } + if assigned(right) then + secondpass(right); emitlab(lastonlabel); - { default handling } - if assigned(p^.t1) then + { default handling except handling } + if assigned(t1) then begin { FPC_CATCHES must be called with 'default handler' flag (=-1) } push_int (-1); emitcall('FPC_CATCHES'); - maybe_loadesi; - secondpass(p^.t1); - emitcall('FPC_POPOBJECTSTACK'); - maybe_loadesi; + maybe_loadself; + + { the destruction of the exception object must be also } + { guarded by an exception frame } + getlabel(doobjectdestroy); + getlabel(doobjectdestroyandreraise); + + gettempofsizereferencepersistant(12,tempaddr); + gettempofsizereferencepersistant(24,tempbuf); + emitpushreferenceaddr(tempaddr); + emitpushreferenceaddr(tempbuf); + exprasmList.concat(Taicpu.Op_const(A_PUSH,S_L,1)); + emitcall('FPC_PUSHEXCEPTADDR'); + + exprasmList.concat(Tairegalloc.Alloc(R_EAX)); + exprasmList.concat(Taicpu.op_reg(A_PUSH,S_L,R_EAX)); + exprasmList.concat(Tairegalloc.DeAlloc(R_EAX)); + emitcall('FPC_SETJMP'); + exprasmList.concat(Tairegalloc.Alloc(R_EAX)); + exprasmList.concat(Taicpu.op_reg(A_PUSH,S_L,R_EAX)); + exprasmList.concat(Taicpu.op_reg_reg(A_TEST,S_L,R_EAX,R_EAX)); + exprasmList.concat(Tairegalloc.DeAlloc(R_EAX)); + emitjmp(C_NE,doobjectdestroyandreraise); + + { here we don't have to reset flowcontrol } + { the default and on flowcontrols are handled equal } + secondpass(t1); + exceptflowcontrol:=flowcontrol; + + emitlab(doobjectdestroyandreraise); + emitcall('FPC_POPADDRSTACK'); + ungetpersistanttempreference(tempaddr); + ungetpersistanttempreference(tempbuf); + + exprasmList.concat(Tairegalloc.Alloc(R_EAX)); + exprasmList.concat(Taicpu.op_reg(A_POP,S_L,R_EAX)); + exprasmList.concat(Taicpu.op_reg_reg(A_TEST,S_L,R_EAX,R_EAX)); + exprasmList.concat(Tairegalloc.DeAlloc(R_EAX)); + emitjmp(C_E,doobjectdestroy); + emitcall('FPC_POPSECONDOBJECTSTACK'); + exprasmList.concat(Tairegalloc.Alloc(R_EAX)); + emit_reg(A_PUSH,S_L,R_EAX); + emitcall('FPC_DESTROYEXCEPTION'); + exprasmList.concat(Tairegalloc.DeAlloc(R_EAX)); + { we don't need to restore esi here because reraise never } + { returns } + emitcall('FPC_RERAISE'); + + emitlab(doobjectdestroy); + cleanupobjectstack; + emitjmp(C_None,endexceptlabel); end else - emitcall('FPC_RERAISE'); - { reraise doesn't need a maybe_loadesi because it never } - { returns (FK) } + begin + emitcall('FPC_RERAISE'); + exceptflowcontrol:=flowcontrol; + end; + + if fc_exit in exceptflowcontrol then + begin + { do some magic for exit in the try block } + emitlab(exitexceptlabel); + { we must also destroy the address frame which guards } + { exception object } + cleanupaddrstack; + cleanupobjectstack; + emitjmp(C_None,oldaktexitlabel); + end; + + if fc_break in exceptflowcontrol then + begin + emitlab(breakexceptlabel); + { we must also destroy the address frame which guards } + { exception object } + cleanupaddrstack; + cleanupobjectstack; + emitjmp(C_None,oldaktbreaklabel); + end; + + if fc_continue in exceptflowcontrol then + begin + emitlab(continueexceptlabel); + { we must also destroy the address frame which guards } + { exception object } + cleanupaddrstack; + cleanupobjectstack; + emitjmp(C_None,oldaktcontinuelabel); + end; + + if fc_exit in tryflowcontrol then + begin + { do some magic for exit in the try block } + emitlab(exittrylabel); + cleanupaddrstack; + emitjmp(C_None,oldaktexitlabel); + end; + + if fc_break in tryflowcontrol then + begin + emitlab(breaktrylabel); + cleanupaddrstack; + emitjmp(C_None,oldaktbreaklabel); + end; + + if fc_continue in tryflowcontrol then + begin + emitlab(continuetrylabel); + cleanupaddrstack; + emitjmp(C_None,oldaktcontinuelabel); + end; + emitlab(endexceptlabel); - freelabel(exceptlabel); - freelabel(doexceptlabel); - freelabel(endexceptlabel); - freelabel(lastonlabel); + + errorexit: + { restore all saved labels } endexceptlabel:=oldendexceptlabel; + + { restore the control flow labels } + aktexitlabel:=oldaktexitlabel; + aktexit2label:=oldaktexit2label; + if assigned(oldaktbreaklabel) then + begin + aktcontinuelabel:=oldaktcontinuelabel; + aktbreaklabel:=oldaktbreaklabel; + end; + + { return all used control flow statements } + flowcontrol:=oldflowcontrol+exceptflowcontrol+ + tryflowcontrol; end; - procedure secondon(list: paasmoutput; var p : ptree); - + procedure ti386onnode.pass_2; var - nextonlabel : pasmlabel; + nextonlabel, + exitonlabel, + continueonlabel, + breakonlabel, + oldaktexitlabel, + oldaktexit2label, + oldaktcontinuelabel, + doobjectdestroyandreraise, + doobjectdestroy, + oldaktbreaklabel : tasmlabel; ref : treference; + oldflowcontrol : tflowcontrol; + tempbuf,tempaddr : treference; begin + oldflowcontrol:=flowcontrol; + flowcontrol:=[]; getlabel(nextonlabel); { push the vmt } emit_sym(A_PUSH,S_L, - newasmsymbol(p^.excepttype^.vmt_mangledname)); + newasmsymbol(excepttype.vmt_mangledname)); emitcall('FPC_CATCHES'); + { allocate eax } + exprasmList.concat(Tairegalloc.Alloc(R_EAX)); emit_reg_reg(A_TEST,S_L,R_EAX,R_EAX); emitjmp(C_E,nextonlabel); ref.symbol:=nil; gettempofsizereference(4,ref); { what a hack ! } - if assigned(p^.exceptsymtable) then - pvarsym(p^.exceptsymtable^.symindex^.first)^.address:=ref.offset; + if assigned(exceptsymtable) then + tvarsym(exceptsymtable.symindex.first).address:=ref.offset; emit_reg_ref(A_MOV,S_L, R_EAX,newreference(ref)); + { deallocate eax } + exprasmList.concat(Tairegalloc.DeAlloc(R_EAX)); - if assigned(p^.right) then + { in the case that another exception is risen } + { we've to destroy the old one } + getlabel(doobjectdestroyandreraise); + + gettempofsizereferencepersistant(12,tempaddr); + gettempofsizereferencepersistant(24,tempbuf); + emitpushreferenceaddr(tempaddr); + emitpushreferenceaddr(tempbuf); + exprasmList.concat(Taicpu.Op_const(A_PUSH,S_L,1)); + emitcall('FPC_PUSHEXCEPTADDR'); + + exprasmList.concat(Tairegalloc.Alloc(R_EAX)); + exprasmList.concat(Taicpu.op_reg(A_PUSH,S_L,R_EAX)); + exprasmList.concat(Tairegalloc.DeAlloc(R_EAX)); + emitcall('FPC_SETJMP'); + exprasmList.concat(Tairegalloc.Alloc(R_EAX)); + exprasmList.concat(Taicpu.op_reg(A_PUSH,S_L,R_EAX)); + exprasmList.concat(Taicpu.op_reg_reg(A_TEST,S_L,R_EAX,R_EAX)); + exprasmList.concat(Tairegalloc.DeAlloc(R_EAX)); + emitjmp(C_NE,doobjectdestroyandreraise); + + if assigned(right) then begin - { esi is destroyed by FPC_CATCHES } - maybe_loadesi; - secondpass(p^.right); + oldaktexitlabel:=aktexitlabel; + oldaktexit2label:=aktexit2label; + getlabel(exitonlabel); + aktexitlabel:=exitonlabel; + aktexit2label:=exitonlabel; + if assigned(aktbreaklabel) then + begin + oldaktcontinuelabel:=aktcontinuelabel; + oldaktbreaklabel:=aktbreaklabel; + getlabel(breakonlabel); + getlabel(continueonlabel); + aktcontinuelabel:=continueonlabel; + aktbreaklabel:=breakonlabel; + end; + + { esi is destroyed by FPC_CATCHES } + maybe_loadself; + secondpass(right); end; + getlabel(doobjectdestroy); + emitlab(doobjectdestroyandreraise); + emitcall('FPC_POPADDRSTACK'); + ungetpersistanttempreference(tempaddr); + ungetpersistanttempreference(tempbuf); - - emit_ref(A_PUSH,S_L, - newreference(ref)); + exprasmList.concat(Tairegalloc.Alloc(R_EAX)); + exprasmList.concat(Taicpu.op_reg(A_POP,S_L,R_EAX)); + exprasmList.concat(Taicpu.op_reg_reg(A_TEST,S_L,R_EAX,R_EAX)); + exprasmList.concat(Tairegalloc.DeAlloc(R_EAX)); + emitjmp(C_E,doobjectdestroy); + emitcall('FPC_POPSECONDOBJECTSTACK'); + exprasmList.concat(Tairegalloc.Alloc(R_EAX)); + emit_reg(A_PUSH,S_L,R_EAX); emitcall('FPC_DESTROYEXCEPTION'); - emitcall('FPC_POPOBJECTSTACK'); + exprasmList.concat(Tairegalloc.DeAlloc(R_EAX)); + { we don't need to restore esi here because reraise never } + { returns } + emitcall('FPC_RERAISE'); + emitlab(doobjectdestroy); + cleanupobjectstack; { clear some stuff } ungetiftemp(ref); emitjmp(C_None,endexceptlabel); + + if assigned(right) then + begin + { special handling for control flow instructions } + if fc_exit in flowcontrol then + begin + { the address and object pop does secondtryexcept } + emitlab(exitonlabel); + emitjmp(C_None,oldaktexitlabel); + end; + + if fc_break in flowcontrol then + begin + { the address and object pop does secondtryexcept } + emitlab(breakonlabel); + emitjmp(C_None,oldaktbreaklabel); + end; + + if fc_continue in flowcontrol then + begin + { the address and object pop does secondtryexcept } + emitlab(continueonlabel); + emitjmp(C_None,oldaktcontinuelabel); + end; + + aktexitlabel:=oldaktexitlabel; + aktexit2label:=oldaktexit2label; + if assigned(oldaktbreaklabel) then + begin + aktcontinuelabel:=oldaktcontinuelabel; + aktbreaklabel:=oldaktbreaklabel; + end; + end; + emitlab(nextonlabel); + flowcontrol:=oldflowcontrol+flowcontrol; { next on node } - if assigned(p^.left) then - secondpass(p^.left); + if assigned(left) then + begin + cleartempgen; + secondpass(left); + end; end; {***************************************************************************** SecondTryFinally *****************************************************************************} - procedure secondtryfinally(list: paasmoutput; var p : ptree); - + procedure ti386tryfinallynode.pass_2; var - finallylabel,noreraiselabel : pasmlabel; - oldaktexitlabel,exitfinallylabel : pasmlabel; - oldaktexit2label : pasmlabel; + reraiselabel, + finallylabel, + endfinallylabel, + exitfinallylabel, + continuefinallylabel, + breakfinallylabel, + oldaktexitlabel, + oldaktexit2label, + oldaktcontinuelabel, + oldaktbreaklabel : tasmlabel; + oldflowcontrol,tryflowcontrol : tflowcontrol; + decconst : longint; + tempbuf,tempaddr : treference; begin + { check if child nodes do a break/continue/exit } + oldflowcontrol:=flowcontrol; + flowcontrol:=[]; { we modify EAX } usedinproc:=usedinproc or ($80 shr byte(R_EAX)); getlabel(finallylabel); - getlabel(noreraiselabel); + getlabel(endfinallylabel); + getlabel(reraiselabel); + + { the finally block must catch break, continue and exit } + { statements } oldaktexitlabel:=aktexitlabel; oldaktexit2label:=aktexit2label; getlabel(exitfinallylabel); aktexitlabel:=exitfinallylabel; aktexit2label:=exitfinallylabel; + if assigned(aktbreaklabel) then + begin + oldaktcontinuelabel:=aktcontinuelabel; + oldaktbreaklabel:=aktbreaklabel; + getlabel(breakfinallylabel); + getlabel(continuefinallylabel); + aktcontinuelabel:=continuefinallylabel; + aktbreaklabel:=breakfinallylabel; + end; + gettempofsizereferencepersistant(12,tempaddr); + gettempofsizereferencepersistant(24,tempbuf); + emitpushreferenceaddr(tempaddr); + emitpushreferenceaddr(tempbuf); push_int(1); { Type of stack-frame must be pushed} emitcall('FPC_PUSHEXCEPTADDR'); + + { allocate eax } + exprasmList.concat(Tairegalloc.Alloc(R_EAX)); emit_reg(A_PUSH,S_L,R_EAX); emitcall('FPC_SETJMP'); emit_reg(A_PUSH,S_L,R_EAX); emit_reg_reg(A_TEST,S_L,R_EAX,R_EAX); + { deallocate eax } + exprasmList.concat(Tairegalloc.DeAlloc(R_EAX)); emitjmp(C_NE,finallylabel); { try code } - secondpass(p^.left); - if codegenerror then - exit; + if assigned(left) then + begin + secondpass(left); + tryflowcontrol:=flowcontrol; + if codegenerror then + exit; + end; emitlab(finallylabel); emitcall('FPC_POPADDRSTACK'); + ungetpersistanttempreference(tempaddr); + ungetpersistanttempreference(tempbuf); + { finally code } - secondpass(p^.right); + flowcontrol:=[]; + secondpass(right); + if flowcontrol<>[] then + CGMessage(cg_e_control_flow_outside_finally); if codegenerror then exit; + { allocate eax } + exprasmList.concat(Tairegalloc.Alloc(R_EAX)); emit_reg(A_POP,S_L,R_EAX); emit_reg_reg(A_TEST,S_L,R_EAX,R_EAX); - emitjmp(C_E,noreraiselabel); + emitjmp(C_E,endfinallylabel); emit_reg(A_DEC,S_L,R_EAX); - emitjmp(C_NE,oldaktexitlabel); + emitjmp(C_Z,reraiselabel); + if fc_exit in tryflowcontrol then + begin + emit_reg(A_DEC,S_L,R_EAX); + emitjmp(C_Z,oldaktexitlabel); + decconst:=1; + end + else + decconst:=2; + if fc_break in tryflowcontrol then + begin + emit_const_reg(A_SUB,S_L,decconst,R_EAX); + emitjmp(C_Z,oldaktbreaklabel); + decconst:=1; + end + else + inc(decconst); + if fc_continue in tryflowcontrol then + begin + emit_const_reg(A_SUB,S_L,decconst,R_EAX); + emitjmp(C_Z,oldaktcontinuelabel); + end; + { deallocate eax } + exprasmList.concat(Tairegalloc.DeAlloc(R_EAX)); + emitlab(reraiselabel); emitcall('FPC_RERAISE'); - { reraise never returns ! } - emitlab(exitfinallylabel); + { do some magic for exit,break,continue in the try block } + if fc_exit in tryflowcontrol then + begin + emitlab(exitfinallylabel); + { allocate eax } + exprasmList.concat(Tairegalloc.Alloc(R_EAX)); + emit_reg(A_POP,S_L,R_EAX); + exprasmList.concat(Tairegalloc.Alloc(R_EAX)); + emit_const(A_PUSH,S_L,2); + emitjmp(C_NONE,finallylabel); + end; + if fc_break in tryflowcontrol then + begin + emitlab(breakfinallylabel); + { allocate eax } + exprasmList.concat(Tairegalloc.Alloc(R_EAX)); + emit_reg(A_POP,S_L,R_EAX); + { deallocate eax } + exprasmList.concat(Tairegalloc.DeAlloc(R_EAX)); + emit_const(A_PUSH,S_L,3); + emitjmp(C_NONE,finallylabel); + end; + if fc_continue in tryflowcontrol then + begin + emitlab(continuefinallylabel); + exprasmList.concat(Tairegalloc.Alloc(R_EAX)); + emit_reg(A_POP,S_L,R_EAX); + exprasmList.concat(Tairegalloc.Alloc(R_EAX)); + emit_const(A_PUSH,S_L,4); + emitjmp(C_NONE,finallylabel); + end; + + emitlab(endfinallylabel); - { do some magic for exit in the try block } - emit_reg(A_POP,S_L,R_EAX); - emit_const(A_PUSH,S_L,2); - emitjmp(C_NONE,finallylabel); - emitlab(noreraiselabel); aktexitlabel:=oldaktexitlabel; aktexit2label:=oldaktexit2label; + if assigned(aktbreaklabel) then + begin + aktcontinuelabel:=oldaktcontinuelabel; + aktbreaklabel:=oldaktbreaklabel; + end; + flowcontrol:=oldflowcontrol+tryflowcontrol; end; @@ -772,23 +1250,35 @@ do_jmp: SecondFail *****************************************************************************} - procedure secondfail(list: paasmoutput; var p : ptree); + procedure ti386failnode.pass_2; begin emitjmp(C_None,faillabel); end; +begin + cwhilerepeatnode:=ti386whilerepeatnode; + cifnode:=ti386ifnode; + cfornode:=ti386fornode; + cexitnode:=ti386exitnode; + cbreaknode:=ti386breaknode; + ccontinuenode:=ti386continuenode; + cgotonode:=ti386gotonode; + clabelnode:=ti386labelnode; + craisenode:=ti386raisenode; + ctryexceptnode:=ti386tryexceptnode; + ctryfinallynode:=ti386tryfinallynode; + connode:=ti386onnode; + cfailnode:=ti386failnode; end. { $Log$ - Revision 1.1 2000-07-13 06:30:07 michael - + Initial import - - Revision 1.2 2000/01/07 01:14:52 peter - * updated copyright to 2000 - - Revision 1.1 1999/11/03 14:13:59 jonas - + initial implementation + Revision 1.2 2001-09-05 20:21:03 jonas + * new cgflow based on n386flw with all nodes until forn "translated" + + a_cmp_loc_*_label methods for tcg + + base implementatino for a_cmp_ref_*_label methods + * small bugfixes to powerpc cg } + diff --git a/compiler/new/cgobj.pas b/compiler/new/cgobj.pas index 9210df0ea6..af7afab719 100644 --- a/compiler/new/cgobj.pas +++ b/compiler/new/cgobj.pas @@ -129,12 +129,14 @@ unit cgobj; procedure a_load_reg_reg(list : paasmoutput;size : tcgsize;reg1,reg2 : tregister);virtual; { comparison operations } - procedure a_cmp_reg_const_label(list : paasmoutput;size : tcgsize;cmp_op : topcmp;a : aword;reg : tregister; + procedure a_cmp_const_reg_label(list : paasmoutput;size : tcgsize;cmp_op : topcmp;a : aword;reg : tregister; l : pasmlabel);virtual; - procedure a_cmp_reg_reg_label(list : paasmoutput;size : tcgsize;cmp_op : topcmp;reg1,reg2 : tregister;l : pasmlabel); - procedure a_cmp_reg_ref_label(list : paasmoutput;size : tcgsize;cmp_op : topcmp;reg : tregister;l : pasmlabel); - procedure a_cmp_ref_const_label(list : paasmoutput;size : tcgsize;cmp_op : topcmp;a : aword;reg : tregister; - l : pasmlabel); + procedure a_cmp_reg_reg_label(list : paasmoutput;size : tcgsize;cmp_op : topcmp;reg1,reg2 : tregister;l : pasmlabel); virtual; + procedure a_cmp_reg_ref_label(list : paasmoutput;size : tcgsize;cmp_op : topcmp;reg : tregister; const ref: treference; l : pasmlabel); virtual; + procedure a_cmp_const_ref_label(list : paasmoutput;size : tcgsize;cmp_op : topcmp;a : aword;const ref : treference; + l : pasmlabel); virtual; + procedure a_cmp_const_loc_label(list: paasmoutput; size: tcgsiwe;cmp_op: topcmp; const loc: tlocation; + l : pasmlabel); virtual; procedure a_jmp_cond(list : paasmoutput;cond : TOpCmp;l: pasmlabel); @@ -1029,7 +1031,7 @@ unit cgobj; a_call_name(list,'FPC_POPADDRSTACK',0); a_reg_alloc(list,accumulator); g_pop_exception_value_reg(list,accumulator); - a_cmp_reg_const_label(list,OS_32,OC_EQ,0,accumulator,noreraiselabel); + a_cmp_const_reg_label(list,OS_32,OC_EQ,0,accumulator,noreraiselabel); a_reg_dealloc(list,accumulator); {$IFDEF NEWST} @@ -1273,7 +1275,7 @@ unit cgobj; abstract; end; - procedure tcg.a_cmp_reg_const_label(list : paasmoutput;size : tcgsize;cmp_op : topcmp;a : aword;reg : tregister; + procedure tcg.a_cmp_const_reg_label(list : paasmoutput;size : tcgsize;cmp_op : topcmp;a : aword;reg : tregister; l : pasmlabel); begin @@ -1286,17 +1288,58 @@ unit cgobj; abstract; end; - procedure tcg.a_cmp_reg_ref_label(list : paasmoutput;size : tcgsize;cmp_op : topcmp;reg : tregister;l : pasmlabel); - + procedure tcg.a_cmp_ref_reg_label(list : paasmoutput;size : tcgsize;cmp_op : topcmp; const ref: treference; reg : tregister; l : pasmlabel); + var + tmpreg: tregister; begin - abstract; + tmpreg := get_scratch_reg(list); + a_load_ref_reg(list,size,ref,tmpreg); + a_cmp_reg_reg_label(list,size,cmp_op,a,tmpreg,l); + free_scratch_reg(tmpreg); end; - procedure tcg.a_cmp_ref_const_label(list : paasmoutput;size : tcgsize;cmp_op : topcmp;a : aword;reg : tregister; + procedure tcg.a_cmp_const_ref_label(list : paasmoutput;size : tcgsize;cmp_op : topcmp;a : aword;const ref : treference; l : pasmlabel); + var + tmpreg: tregister; + begin - abstract; + tmpreg := get_scratch_reg(list); + a_load_ref_reg(list,size,ref,tmpreg); + a_cmp_const_reg_label(list,size,cmp_op,a,tmpreg,l); + free_scratch_reg(tmpreg); + end; + + procedure tcg.a_cmp_const_loc_label(list : paasmoutput;size : tcgsize;cmp_op : topcmp;a : aword;const loc : tlocation; + l : pasmlabel); + + begin + case loc.loc of + LOC_REGISTER,LOC_CREGISTER: + !!!!!! 64bit locations -> two registers!! + a_cmp_const_reg_label(list,size,cmp_op,a,loc.register,l); + LOC_REFERENCE,LOC_MEM: + a_cmp_const_ref_label(list,size,cmp_op,a,loc.reference,l); + end; + end; + + procedure tcg.a_cmp_ref_loc_label(list : paasmoutput;size : tcgsize;cmp_op : topcmp;const ref: treference;const loc : tlocation; + l : pasmlabel); + var + tmpreg: tregister; + begin + case loc.loc of + LOC_REGISTER,LOC_CREGISTER: + a_cmp_ref_reg_label(list,size,cmp_op,ref,loc.register,l); + LOC_REFERENCE,LOC_MEM: + begin + tmpreg := get_scratch_reg(list); + a_load_ref_reg(size,location.reference,tmpreg); + a_cmp_ref_reg(list,size,cmp_op,ref,tmpreg,l); + free_scratch_reg(list,tmpreg); + end; + end; end; procedure tcg.a_jmp_cond(list : paasmoutput;cond : TOpCmp;l: pasmlabel); @@ -1326,7 +1369,13 @@ unit cgobj; end. { $Log$ - Revision 1.2 2001-08-26 13:37:04 florian + Revision 1.3 2001-09-05 20:21:03 jonas + * new cgflow based on n386flw with all nodes until forn "translated" + + a_cmp_loc_*_label methods for tcg + + base implementatino for a_cmp_ref_*_label methods + * small bugfixes to powerpc cg + + Revision 1.2 2001/08/26 13:37:04 florian * some cg reorganisation * some PPC updates diff --git a/compiler/powerpc/cgcpu.pas b/compiler/powerpc/cgcpu.pas index 9810e05c52..c5d52784a9 100644 --- a/compiler/powerpc/cgcpu.pas +++ b/compiler/powerpc/cgcpu.pas @@ -54,7 +54,7 @@ unit cgcpu; procedure a_load_reg_reg(list : paasmoutput;size : tcgsize;reg1,reg2 : tregister);virtual; { comparison operations } - procedure a_cmp_reg_const_label(list : paasmoutput;size : tcgsize;cmp_op : topcmp;a : aword;reg : tregister; + procedure a_cmp_const_reg_label(list : paasmoutput;size : tcgsize;cmp_op : topcmp;a : aword;reg : tregister; l : pasmlabel);virtual; procedure a_cmp_reg_reg_label(list : paasmoutput;size : tcgsize;cmp_op : topcmp;reg1,reg2 : tregister;l : pasmlabel); procedure a_jmp_cond(list : paasmoutput;cond : TOpCmp;l: pasmlabel); @@ -70,7 +70,7 @@ unit cgcpu; procedure a_loadaddress_ref_reg(list : paasmoutput;const ref2 : treference;r : tregister);virtual; - procedure g_concatcopy(list : paasmoutput;const source,dest : treference;len : aword;loadref : boolean);virtual; + procedure g_concatcopy(list : paasmoutput;const source,dest : treference;len : aword; delsource,loadref : boolean);virtual; private @@ -235,7 +235,8 @@ const Begin list^.concat(new(paicpu,op_reg_const(A_LI,reg,a and $ffff))); If (a shr 16) <> 0 Then - list^.concat(new(paicpu,op_reg_const(A_ORIS,reg,a shr 16))) + list^.concat(new(paicpu,op_reg_const(A_ADDIS,reg, + (a shr 16)+ord(smallint(a and $ffff) < 0)))) End Else list^.concat(new(paicpu,op_reg_const(A_LIS,reg,a shr 16))); @@ -310,7 +311,7 @@ const {*************** compare instructructions ****************} - procedure tcgppc.a_cmp_reg_const_label(list : paasmoutput;size : tcgsize;cmp_op : topcmp;a : aword;reg : tregister; + procedure tcgppc.a_cmp_const_reg_label(list : paasmoutput;size : tcgsize;cmp_op : topcmp;a : aword;reg : tregister; l : pasmlabel); var p: paicpu; @@ -329,8 +330,8 @@ const list^.concat(new(paicpu,op_const_reg_reg(A_CMP,0,reg,scratch_register))); free_scratch_reg(list,scratch_register); end - else - if (a <= $ffff) then + else + if (a <= $ffff) then list^.concat(new(paicpu,op_const_reg_const(A_CMPLI,0,reg,a))) else begin @@ -594,7 +595,7 @@ const { ************* concatcopy ************ } - procedure tcgppc.g_concatcopy(list : paasmoutput;const source,dest : treference;len : aword;loadref : boolean); + procedure tcgppc.g_concatcopy(list : paasmoutput;const source,dest : treference;len : aword; delsource,loadref : boolean); var p: paicpu; @@ -615,6 +616,8 @@ const if loadref then a_load_ref_reg(list,OS_32,source,src.base) else a_loadaddress_ref_reg(list,source,src.base); + if delsource then + del_reference(list,source); { load the address of dest into dst.base } dst.base := get_scratch_reg(list); a_loadaddress_ref_reg(list,dest,dst.base); @@ -702,7 +705,7 @@ const if (a and $ffff) <> 0 Then list^.concat(new(paicpu,op_reg_reg_const(OpLo,reg1,reg2,a and $ffff))); If (a shr 16) <> 0 Then - list^.concat(new(paicpu,op_reg_reg_const(OpHi,reg1,reg2,a shr 16))) + list^.concat(new(paicpu,op_reg_reg_const(OpHi,reg1,reg1,a shr 16))) end; procedure tcgppc.a_load_store(list:paasmoutput;op: tasmop;reg:tregister; @@ -745,7 +748,13 @@ const end. { $Log$ - Revision 1.1 2001-08-26 13:31:04 florian + Revision 1.2 2001-09-05 20:21:03 jonas + * new cgflow based on n386flw with all nodes until forn "translated" + + a_cmp_loc_*_label methods for tcg + + base implementatino for a_cmp_ref_*_label methods + * small bugfixes to powerpc cg + + Revision 1.1 2001/08/26 13:31:04 florian * some cg reorganisation * some PPC updates