{ Copyright (c) 2000-2002 by Florian Klaempfl and Jonas Maebe Code generation for add nodes on the Motorola 680x0 family 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 n68kadd; {$i fpcdefs.inc} interface uses node,nadd,ncgadd,cpubase,cgbase; type t68kaddnode = class(tcgaddnode) private function getresflags(unsigned: boolean) : tresflags; protected procedure second_addfloat;override; procedure second_cmpfloat;override; procedure second_cmpordinal;override; procedure second_cmpsmallset;override; procedure second_cmp64bit;override; end; implementation uses globtype,systems, cutils,verbose,globals, symconst,symdef,paramgr,symtype, aasmbase,aasmtai,aasmdata,aasmcpu,defutil,htypechk, cpuinfo,pass_1,pass_2,regvars, cpupara,cgutils,procinfo, ncon,nset, ncgutil,tgobj,rgobj,rgcpu,cgobj,cgcpu,hlcgobj,cg64f32; {***************************************************************************** Helpers *****************************************************************************} function t68kaddnode.getresflags(unsigned : boolean) : tresflags; begin case nodetype of equaln : getresflags:=F_E; unequaln : getresflags:=F_NE; else if not(unsigned) then begin if nf_swapped in flags then case nodetype of ltn : getresflags:=F_G; lten : getresflags:=F_GE; gtn : getresflags:=F_L; gten : getresflags:=F_LE; end else case nodetype of ltn : getresflags:=F_L; lten : getresflags:=F_LE; gtn : getresflags:=F_G; gten : getresflags:=F_GE; end; end else begin if nf_swapped in flags then case nodetype of ltn : getresflags:=F_A; lten : getresflags:=F_AE; gtn : getresflags:=F_B; gten : getresflags:=F_BE; end else case nodetype of ltn : getresflags:=F_B; lten : getresflags:=F_BE; gtn : getresflags:=F_A; gten : getresflags:=F_AE; end; end; end; end; {***************************************************************************** AddFloat *****************************************************************************} procedure t68kaddnode.second_addfloat; var op : TAsmOp; begin pass_left_right; case nodetype of addn : op:=A_FADD; muln : op:=A_FMUL; subn : op:=A_FSUB; slashn : op:=A_FDIV; else internalerror(200403182); end; // get the operands in the correct order, there are no special cases // here, everything is register-based if nf_swapped in flags then swapleftright; // put both operands in a register hlcg.location_force_fpureg(current_asmdata.CurrAsmList,right.location,right.resultdef,true); hlcg.location_force_fpureg(current_asmdata.CurrAsmList,left.location,left.resultdef,true); // initialize de result location_reset(location,LOC_FPUREGISTER,def_cgsize(resultdef)); if left.location.loc = LOC_FPUREGISTER then location.register := left.location.register else if right.location.loc = LOC_FPUREGISTER then location.register := right.location.register else location.register := cg.getfpuregister(current_asmdata.CurrAsmList,location.size); // emit the actual operation { current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_reg(op, location.register,left.location.register, right.location.register)) } end; procedure t68kaddnode.second_cmpfloat; begin pass_left_right; { if (nf_swapped in flags) then swapleftright; } { force fpureg as location, left right doesn't matter as both will be in a fpureg } hlcg.location_force_fpureg(current_asmdata.CurrAsmList,left.location,left.resultdef,true); hlcg.location_force_fpureg(current_asmdata.CurrAsmList,right.location,right.resultdef,true); location_reset(location,LOC_FLAGS,OS_NO); location.resflags:=getresflags(true); { if nodetype in [equaln,unequaln] then current_asmdata.CurrAsmList.concat(setoppostfix(taicpu.op_reg_reg(A_CMF, left.location.register,right.location.register), cgsize2fpuoppostfix[def_cgsize(resultdef)])) else current_asmdata.CurrAsmList.concat(setoppostfix(taicpu.op_reg_reg(A_CMFE, left.location.register,right.location.register), cgsize2fpuoppostfix[def_cgsize(resultdef)])); location_reset(location,LOC_FLAGS,OS_NO); location.resflags:=getresflags(false); } end; {***************************************************************************** Smallsets *****************************************************************************} procedure t68kaddnode.second_cmpsmallset; var tmpreg : tregister; begin pass_left_right; location_reset(location,LOC_FLAGS,OS_NO); if (not(nf_swapped in flags) and (nodetype = lten)) or ((nf_swapped in flags) and (nodetype = gten)) then swapleftright; { Try to keep right as a constant } if right.location.loc<>LOC_CONSTANT then hlcg.location_force_reg(current_asmdata.CurrAsmList,right.location,right.resultdef,right.resultdef,true); hlcg.location_force_reg(current_asmdata.CurrAsmList,left.location,left.resultdef,left.resultdef,true); case nodetype of equaln, unequaln: begin if right.location.loc=LOC_CONSTANT then current_asmdata.CurrAsmList.concat(taicpu.op_const_reg(A_CMP,S_L,right.location.value,left.location.register)) else current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(A_CMP,S_L,right.location.register,left.location.register)); if nodetype=equaln then location.resflags:=F_E else location.resflags:=F_NE; end; lten, gten: begin tmpreg:=cg.getintregister(current_asmdata.CurrAsmList,left.location.size); if right.location.loc=LOC_CONSTANT then hlcg.location_force_reg(current_asmdata.CurrAsmList,right.location,right.resultdef,right.resultdef,false); cg.a_op_reg_reg_reg(current_asmdata.CurrAsmList,OP_AND,OS_32,left.location.register,right.location.register,tmpreg); current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(A_CMP,S_L,tmpreg,right.location.register)); location.resflags:=F_E; end; else internalerror(2013092701); end; end; {***************************************************************************** Ordinals *****************************************************************************} procedure t68kaddnode.second_cmpordinal; var unsigned : boolean; useconst : boolean; tmpreg : tregister; opsize : topsize; cmpsize : tcgsize; href: treference; begin { determine if the comparison will be unsigned } unsigned:=not(is_signed(left.resultdef)) or not(is_signed(right.resultdef)); { this puts constant operand (if any) to the right } pass_left_right; { tentatively assume left size (correct for possible TST/CMPI, will fix later) } cmpsize:=def_cgsize(left.resultdef); opsize:=tcgsize2opsize[cmpsize]; { set result location } location_reset(location,LOC_FLAGS,OS_NO); location.resflags := getresflags(unsigned); { see if we can optimize into TST } if (right.location.loc=LOC_CONSTANT) and (right.location.value=0) and ((nodetype in [equaln,unequaln]) or (not unsigned)) then begin case left.location.loc of LOC_REFERENCE, LOC_CREFERENCE: begin href:=left.location.reference; tcg68k(cg).fixref(current_asmdata.CurrAsmList,href); current_asmdata.CurrAsmList.concat(taicpu.op_ref(A_TST,opsize,href)); location_freetemp(current_asmdata.CurrAsmList,left.location); end; else hlcg.location_force_reg(current_asmdata.CurrAsmList,left.location,left.resultdef,left.resultdef,true); current_asmdata.CurrAsmList.concat(taicpu.op_reg(A_TST,opsize,left.location.register)); end; exit; end; { ToDo : set "allowconstants" to True, but this seems to upset Coldfire a bit for the CMP instruction => check manual and implement exception accordingly below } { load values into registers (except constants) } force_reg_left_right(true, false); useconst := false; if tcgsize2size[right.location.size]=tcgsize2size[left.location.size] then cmpsize:=left.location.size else { ToDo : zero/sign extend??? } if tcgsize2size[right.location.size]