{
Copyright (c) 2000-2002 by the FPC development team
Code generation for add nodes (generic version)
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 ncgadd;
{$i fpcdefs.inc}
interface
uses
node,nadd,cpubase;
type
tcgaddnode = class(taddnode)
{ function pass_1: tnode; override;}
procedure pass_generate_code;override;
protected
{ call secondpass for both left and right }
procedure pass_left_right;
{ set the register of the result location }
procedure set_result_location_reg;
{ load left and right nodes into registers }
procedure force_reg_left_right(allow_swap,allow_constant:boolean);
procedure second_opfloat;
procedure second_opboolean;
procedure second_opsmallset;
procedure second_op64bit;
procedure second_opordinal;
procedure second_addstring;virtual;
procedure second_addfloat;virtual;abstract;
procedure second_addboolean;virtual;
procedure second_addsmallset;virtual;
{$ifdef x86}
{$ifdef SUPPORT_MMX}
procedure second_opmmxset;virtual;abstract;
procedure second_opmmx;virtual;abstract;
{$endif SUPPORT_MMX}
{$endif x86}
procedure second_opvector;virtual;abstract;
procedure second_add64bit;virtual;
procedure second_addordinal;virtual;
procedure second_cmpfloat;virtual;abstract;
procedure second_cmpboolean;virtual;
procedure second_cmpsmallset;virtual;abstract;
procedure second_cmp64bit;virtual;abstract;
procedure second_cmpordinal;virtual;abstract;
end;
implementation
uses
globtype,systems,
cutils,verbose,globals,
symconst,symdef,paramgr,
aasmbase,aasmtai,aasmdata,defutil,
cgbase,procinfo,pass_2,
ncon,nset,ncgutil,cgobj,cgutils
;
{*****************************************************************************
Helpers
*****************************************************************************}
procedure tcgaddnode.pass_left_right;
var
tmpreg : tregister;
isjump,
pushedfpu : boolean;
otl,ofl : tasmlabel;
begin
{ calculate the operator which is more difficult }
firstcomplex(self);
{ in case of constant put it to the left }
if (left.nodetype=ordconstn) then
swapleftright;
isjump:=(left.expectloc=LOC_JUMP);
if isjump then
begin
otl:=current_procinfo.CurrTrueLabel;
current_asmdata.getjumplabel(current_procinfo.CurrTrueLabel);
ofl:=current_procinfo.CurrFalseLabel;
current_asmdata.getjumplabel(current_procinfo.CurrFalseLabel);
end;
secondpass(left);
if left.location.loc in [LOC_FLAGS,LOC_JUMP] then
location_force_reg(current_asmdata.CurrAsmList,left.location,def_cgsize(resultdef),false);
if isjump then
begin
current_procinfo.CurrTrueLabel:=otl;
current_procinfo.CurrFalseLabel:=ofl;
end;
{ are too few registers free? }
if left.location.loc=LOC_FPUREGISTER then
pushedfpu:=maybe_pushfpu(current_asmdata.CurrAsmList,right.registersfpu,left.location)
else
pushedfpu:=false;
isjump:=(right.expectloc=LOC_JUMP);
if isjump then
begin
otl:=current_procinfo.CurrTrueLabel;
current_asmdata.getjumplabel(current_procinfo.CurrTrueLabel);
ofl:=current_procinfo.CurrFalseLabel;
current_asmdata.getjumplabel(current_procinfo.CurrFalseLabel);
end;
secondpass(right);
if right.location.loc in [LOC_FLAGS,LOC_JUMP] then
location_force_reg(current_asmdata.CurrAsmList,right.location,def_cgsize(resultdef),false);
if isjump then
begin
current_procinfo.CurrTrueLabel:=otl;
current_procinfo.CurrFalseLabel:=ofl;
end;
if pushedfpu then
begin
tmpreg := cg.getfpuregister(current_asmdata.CurrAsmList,left.location.size);
cg.a_loadfpu_loc_reg(current_asmdata.CurrAsmList,left.location.size,left.location,tmpreg);
location_reset(left.location,LOC_FPUREGISTER,left.location.size);
left.location.register := tmpreg;
{$ifdef x86}
{ left operand is now on top of the stack, instead of the right one! }
toggleflag(nf_swapped);
{$endif x86}
end;
end;
procedure tcgaddnode.set_result_location_reg;
begin
location_reset(location,LOC_REGISTER,def_cgsize(resultdef));
{$ifdef x86}
if left.location.loc=LOC_REGISTER then
begin
if TCGSize2Size[left.location.size]<>TCGSize2Size[location.size] then
internalerror(200307041);
{$ifndef cpu64bit}
if location.size in [OS_64,OS_S64] then
begin
location.register64.reglo := left.location.register64.reglo;
location.register64.reghi := left.location.register64.reghi;
end
else
{$endif}
location.register := left.location.register;
end
else
if right.location.loc=LOC_REGISTER then
begin
if TCGSize2Size[right.location.size]<>TCGSize2Size[location.size] then
internalerror(200307042);
{$ifndef cpu64bit}
if location.size in [OS_64,OS_S64] then
begin
location.register64.reglo := right.location.register64.reglo;
location.register64.reghi := right.location.register64.reghi;
end
else
{$endif}
location.register := right.location.register;
end
else
{$endif}
begin
{$ifndef cpu64bit}
if location.size in [OS_64,OS_S64] then
begin
location.register64.reglo := cg.getintregister(current_asmdata.CurrAsmList,OS_INT);
location.register64.reghi := cg.getintregister(current_asmdata.CurrAsmList,OS_INT);
end
else
{$endif}
location.register := cg.getintregister(current_asmdata.CurrAsmList,location.size);
end;
end;
procedure tcgaddnode.force_reg_left_right(allow_swap,allow_constant:boolean);
begin
if (left.location.loc<>LOC_REGISTER) and
not(
allow_constant and
(left.location.loc in [LOC_CONSTANT,LOC_CREGISTER])
) then
location_force_reg(current_asmdata.CurrAsmList,left.location,left.location.size,false);
if (right.location.loc<>LOC_REGISTER) and
not(
allow_constant and
(right.location.loc in [LOC_CONSTANT,LOC_CREGISTER]) and
(left.location.loc<>LOC_CONSTANT)
) then
location_force_reg(current_asmdata.CurrAsmList,right.location,right.location.size,false);
{ Left is always a register, right can be register or constant }
if left.location.loc=LOC_CONSTANT then
begin
{ when it is not allowed to swap we have a constant on
left, that will give problems }
if not allow_swap then
internalerror(200307043);
swapleftright;
end;
end;
{*****************************************************************************
Smallsets
*****************************************************************************}
procedure tcgaddnode.second_opsmallset;
begin
{ when a setdef is passed, it has to be a smallset }
if is_varset(left.resultdef) or
is_normalset(left.resultdef) or
is_varset(right.resultdef) or
is_normalset(right.resultdef) then
internalerror(200203302);
if nodetype in [equaln,unequaln,gtn,gten,lten,ltn] then
second_cmpsmallset
else
second_addsmallset;
end;
procedure tcgaddnode.second_addsmallset;
var
cgop : TOpCg;
tmpreg : tregister;
opdone : boolean;
begin
opdone := false;
pass_left_right;
force_reg_left_right(true,true);
{ setelementn is a special case, it must be on right.
We need an extra check if left is a register because the
default case can skip the register loading when the
setelementn is in a register (PFV) }
if (nf_swapped in flags) and
(left.nodetype=setelementn) then
swapleftright;
if (right.nodetype=setelementn) and
(left.location.loc<>LOC_REGISTER) then
location_force_reg(current_asmdata.CurrAsmList,left.location,left.location.size,false);
set_result_location_reg;
case nodetype of
addn :
begin
{ are we adding set elements ? }
if right.nodetype=setelementn then
begin
{ no range support for smallsets! }
if assigned(tsetelementnode(right).right) then
internalerror(43244);
if (right.location.loc = LOC_CONSTANT) then
cg.a_op_const_reg_reg(current_asmdata.CurrAsmList,OP_OR,location.size,
aint(1 shl right.location.value),
left.location.register,location.register)
else
begin
tmpreg := cg.getintregister(current_asmdata.CurrAsmList,location.size);
cg.a_load_const_reg(current_asmdata.CurrAsmList,location.size,1,tmpreg);
cg.a_op_reg_reg(current_asmdata.CurrAsmList,OP_SHL,location.size,
right.location.register,tmpreg);
if left.location.loc <> LOC_CONSTANT then
cg.a_op_reg_reg_reg(current_asmdata.CurrAsmList,OP_OR,location.size,tmpreg,
left.location.register,location.register)
else
cg.a_op_const_reg_reg(current_asmdata.CurrAsmList,OP_OR,location.size,
left.location.value,tmpreg,location.register);
end;
opdone := true;
end
else
cgop := OP_OR;
end;
symdifn :
cgop:=OP_XOR;
muln :
cgop:=OP_AND;
subn :
begin
cgop:=OP_AND;
if (not(nf_swapped in flags)) then
if (right.location.loc=LOC_CONSTANT) then
right.location.value := not(right.location.value)
else
opdone := true
else if (left.location.loc=LOC_CONSTANT) then
left.location.value := not(left.location.value)
else
begin
swapleftright;
opdone := true;
end;
if opdone then
begin
if left.location.loc = LOC_CONSTANT then
begin
tmpreg := cg.getintregister(current_asmdata.CurrAsmList,location.size);
cg.a_load_const_reg(current_asmdata.CurrAsmList,location.size,
left.location.value,tmpreg);
cg.a_op_reg_reg(current_asmdata.CurrAsmList,OP_NOT,location.size,right.location.register,right.location.register);
cg.a_op_reg_reg(current_asmdata.CurrAsmList,OP_AND,location.size,right.location.register,tmpreg);
cg.a_load_reg_reg(current_asmdata.CurrAsmList,OS_INT,location.size,tmpreg,location.register);
end
else
begin
cg.a_op_reg_reg(current_asmdata.CurrAsmList,OP_NOT,right.location.size,right.location.register,right.location.register);
cg.a_op_reg_reg(current_asmdata.CurrAsmList,OP_AND,left.location.size,right.location.register,left.location.register);
cg.a_load_reg_reg(current_asmdata.CurrAsmList,left.location.size,location.size,left.location.register,location.register);
end;
end;
end;
else
internalerror(2002072701);
end;
if not opdone then
begin
// these are all commutative operations
if (left.location.loc = LOC_CONSTANT) then
swapleftright;
if (right.location.loc = LOC_CONSTANT) then
cg.a_op_const_reg_reg(current_asmdata.CurrAsmList,cgop,location.size,
right.location.value,left.location.register,
location.register)
else
cg.a_op_reg_reg_reg(current_asmdata.CurrAsmList,cgop,location.size,
right.location.register,left.location.register,
location.register);
end;
end;
{*****************************************************************************
Boolean
*****************************************************************************}
procedure tcgaddnode.second_opboolean;
begin
if nodetype in [ltn,lten,gtn,gten,equaln,unequaln] then
second_cmpboolean
else
second_addboolean;
end;
procedure tcgaddnode.second_addboolean;
var
cgop : TOpCg;
otl,ofl : tasmlabel;
oldflowcontrol : tflowcontrol;
begin
{ And,Or will only evaluate from left to right only the
needed nodes unless full boolean evaluation is enabled }
if (nodetype in [orn,andn]) and
(not(cs_full_boolean_eval in current_settings.localswitches) or
(nf_short_bool in flags)) then
begin
location_reset(location,LOC_JUMP,OS_NO);
case nodetype of
andn :
begin
otl:=current_procinfo.CurrTrueLabel;
current_asmdata.getjumplabel(current_procinfo.CurrTrueLabel);
secondpass(left);
maketojumpbool(current_asmdata.CurrAsmList,left,lr_load_regvars);
cg.a_label(current_asmdata.CurrAsmList,current_procinfo.CurrTrueLabel);
current_procinfo.CurrTrueLabel:=otl;
end;
orn :
begin
ofl:=current_procinfo.CurrFalseLabel;
current_asmdata.getjumplabel(current_procinfo.CurrFalseLabel);
secondpass(left);
maketojumpbool(current_asmdata.CurrAsmList,left,lr_load_regvars);
cg.a_label(current_asmdata.CurrAsmList,current_procinfo.CurrFalseLabel);
current_procinfo.CurrFalseLabel:=ofl;
end;
else
internalerror(200307044);
end;
{ these jumps mean we're now in a flow control construct }
oldflowcontrol:=flowcontrol;
include(flowcontrol,fc_inflowcontrol);
secondpass(right);
maketojumpbool(current_asmdata.CurrAsmList,right,lr_load_regvars);
flowcontrol:=oldflowcontrol+(flowcontrol-[fc_inflowcontrol]);
end
else
begin
pass_left_right;
force_reg_left_right(false,true);
set_result_location_reg;
case nodetype of
xorn :
cgop:=OP_XOR;
orn :
cgop:=OP_OR;
andn :
cgop:=OP_AND;
else
internalerror(200203247);
end;
if right.location.loc <> LOC_CONSTANT then
cg.a_op_reg_reg_reg(current_asmdata.CurrAsmList,cgop,location.size,
left.location.register,right.location.register,
location.register)
else
cg.a_op_const_reg_reg(current_asmdata.CurrAsmList,cgop,location.size,
right.location.value,left.location.register,
location.register);
end;
end;
{*****************************************************************************
64-bit
*****************************************************************************}
procedure tcgaddnode.second_op64bit;
begin
if nodetype in [ltn,lten,gtn,gten,equaln,unequaln] then
second_cmp64bit
else
second_add64bit;
end;
procedure tcgaddnode.second_add64bit;
var
op : TOpCG;
checkoverflow : boolean;
ovloc : tlocation;
begin
ovloc.loc:=LOC_VOID;
pass_left_right;
force_reg_left_right(false,true);
set_result_location_reg;
{ assume no overflow checking is required }
checkoverflow := false;
case nodetype of
addn :
begin
op:=OP_ADD;
checkoverflow:=true;
end;
subn :
begin
op:=OP_SUB;
checkoverflow:=true;
end;
xorn:
op:=OP_XOR;
orn:
op:=OP_OR;
andn:
op:=OP_AND;
muln:
begin
{ should be handled in pass_1 (JM) }
internalerror(200109051);
end;
else
internalerror(2002072705);
end;
checkoverflow:=
checkoverflow and
(left.resultdef.typ<>pointerdef) and
(right.resultdef.typ<>pointerdef);
{$ifdef cpu64bit}
case nodetype of
xorn,orn,andn,addn:
begin
if (right.location.loc = LOC_CONSTANT) then
cg.a_op_const_reg_reg(current_asmdata.CurrAsmList,op,location.size,right.location.value,
left.location.register,location.register)
else
cg.a_op_reg_reg_reg(current_asmdata.CurrAsmList,op,location.size,right.location.register,
left.location.register,location.register);
end;
subn:
begin
if (nf_swapped in flags) then
swapleftright;
if left.location.loc <> LOC_CONSTANT then
begin
if right.location.loc <> LOC_CONSTANT then
// reg64 - reg64
cg.a_op_reg_reg_reg_checkoverflow(current_asmdata.CurrAsmList,OP_SUB,location.size,
right.location.register,left.location.register,location.register,
checkoverflow and (cs_check_overflow in current_settings.localswitches),ovloc)
else
// reg64 - const64
cg.a_op_const_reg_reg_checkoverflow(current_asmdata.CurrAsmList,OP_SUB,location.size,
right.location.value,left.location.register,location.register,
checkoverflow and (cs_check_overflow in current_settings.localswitches),ovloc);
end
else
begin
// const64 - reg64
location_force_reg(current_asmdata.CurrAsmList,left.location,left.location.size,true);
cg.a_op_reg_reg_reg_checkoverflow(current_asmdata.CurrAsmList,OP_SUB,location.size,
right.location.register,left.location.register,location.register,
checkoverflow and (cs_check_overflow in current_settings.localswitches),ovloc);
end;
end;
else
internalerror(2002072803);
end;
{$else cpu64bit}
case nodetype of
xorn,orn,andn,addn:
begin
if (right.location.loc = LOC_CONSTANT) then
cg64.a_op64_const_reg_reg_checkoverflow(current_asmdata.CurrAsmList,op,location.size,right.location.value64,
left.location.register64,location.register64,
checkoverflow and (cs_check_overflow in current_settings.localswitches),ovloc)
else
cg64.a_op64_reg_reg_reg_checkoverflow(current_asmdata.CurrAsmList,op,location.size,right.location.register64,
left.location.register64,location.register64,
checkoverflow and (cs_check_overflow in current_settings.localswitches),ovloc);
end;
subn:
begin
if (nf_swapped in flags) then
swapleftright;
if left.location.loc <> LOC_CONSTANT then
begin
if right.location.loc <> LOC_CONSTANT then
// reg64 - reg64
cg64.a_op64_reg_reg_reg_checkoverflow(current_asmdata.CurrAsmList,OP_SUB,location.size,
right.location.register64,left.location.register64,
location.register64,
checkoverflow and (cs_check_overflow in current_settings.localswitches),ovloc)
else
// reg64 - const64
cg64.a_op64_const_reg_reg_checkoverflow(current_asmdata.CurrAsmList,OP_SUB,location.size,
right.location.value64,left.location.register64,
location.register64,
checkoverflow and (cs_check_overflow in current_settings.localswitches),ovloc)
end
else
begin
// const64 - reg64
location_force_reg(current_asmdata.CurrAsmList,left.location,left.location.size,true);
cg64.a_op64_reg_reg_reg_checkoverflow(current_asmdata.CurrAsmList,OP_SUB,location.size,
right.location.register64,left.location.register64,
location.register64,
checkoverflow and (cs_check_overflow in current_settings.localswitches),ovloc);
end;
end;
else
internalerror(2002072803);
end;
{$endif cpu64bit}
{ emit overflow check if enabled }
if checkoverflow then
cg.g_overflowcheck_loc(current_asmdata.CurrAsmList,Location,resultdef,ovloc);
end;
{*****************************************************************************
Strings
*****************************************************************************}
procedure tcgaddnode.second_addstring;
begin
{ this should already be handled in pass1 }
internalerror(2002072402);
end;
{*****************************************************************************
Floats
*****************************************************************************}
procedure tcgaddnode.second_opfloat;
begin
if nodetype in [ltn,lten,gtn,gten,equaln,unequaln] then
second_cmpfloat
else
second_addfloat;
end;
{*****************************************************************************
Ordinals
*****************************************************************************}
procedure tcgaddnode.second_opordinal;
begin
if (nodetype in [ltn,lten,gtn,gten,equaln,unequaln]) then
second_cmpordinal
else
second_addordinal;
end;
procedure tcgaddnode.second_addordinal;
var
unsigned,
checkoverflow : boolean;
cgop : topcg;
tmpreg : tregister;
ovloc : tlocation;
begin
ovloc.loc:=LOC_VOID;
pass_left_right;
force_reg_left_right(false,true);
set_result_location_reg;
{ determine if the comparison will be unsigned }
unsigned:=not(is_signed(left.resultdef)) or
not(is_signed(right.resultdef));
{ assume no overflow checking is require }
checkoverflow := false;
case nodetype of
addn:
begin
cgop:=OP_ADD;
checkoverflow:=true;
end;
xorn :
begin
cgop:=OP_XOR;
end;
orn :
begin
cgop:=OP_OR;
end;
andn:
begin
cgop:=OP_AND;
end;
muln:
begin
checkoverflow:=true;
if unsigned then
cgop:=OP_MUL
else
cgop:=OP_IMUL;
end;
subn :
begin
checkoverflow:=true;
cgop:=OP_SUB;
end;
end;
checkoverflow:=
checkoverflow and
(left.resultdef.typ<>pointerdef) and
(right.resultdef.typ<>pointerdef);
if nodetype<>subn then
begin
if (right.location.loc<>LOC_CONSTANT) then
cg.a_op_reg_reg_reg_checkoverflow(current_asmdata.CurrAsmList,cgop,location.size,
left.location.register,right.location.register,
location.register,checkoverflow and (cs_check_overflow in current_settings.localswitches),ovloc)
else
cg.a_op_const_reg_reg_checkoverflow(current_asmdata.CurrAsmList,cgop,location.size,
right.location.value,left.location.register,
location.register,checkoverflow and (cs_check_overflow in current_settings.localswitches),ovloc);
end
else { subtract is a special case since its not commutative }
begin
if (nf_swapped in flags) then
swapleftright;
if left.location.loc<>LOC_CONSTANT then
begin
if right.location.loc<>LOC_CONSTANT then
cg.a_op_reg_reg_reg_checkoverflow(current_asmdata.CurrAsmList,OP_SUB,location.size,
right.location.register,left.location.register,
location.register,checkoverflow and (cs_check_overflow in current_settings.localswitches),ovloc)
else
cg.a_op_const_reg_reg_checkoverflow(current_asmdata.CurrAsmList,OP_SUB,location.size,
right.location.value,left.location.register,
location.register,checkoverflow and (cs_check_overflow in current_settings.localswitches),ovloc);
end
else
begin
tmpreg:=cg.getintregister(current_asmdata.CurrAsmList,location.size);
cg.a_load_const_reg(current_asmdata.CurrAsmList,location.size,
left.location.value,tmpreg);
cg.a_op_reg_reg_reg_checkoverflow(current_asmdata.CurrAsmList,OP_SUB,location.size,
right.location.register,tmpreg,location.register,checkoverflow and (cs_check_overflow in current_settings.localswitches),ovloc);
end;
end;
{ emit overflow check if required }
if checkoverflow then
cg.g_overflowcheck_loc(current_asmdata.CurrAsmList,Location,resultdef,ovloc);
end;
procedure tcgaddnode.second_cmpboolean;
begin
second_cmpordinal;
end;
{*****************************************************************************
pass_generate_code;
*****************************************************************************}
procedure tcgaddnode.pass_generate_code;
begin
case left.resultdef.typ of
orddef :
begin
{ handling boolean expressions }
if is_boolean(left.resultdef) and
is_boolean(right.resultdef) then
second_opboolean
{ 64bit operations }
else if is_64bit(left.resultdef) then
second_op64bit
else
second_opordinal;
end;
stringdef :
begin
second_addstring;
end;
setdef :
begin
{Normalsets are already handled in pass1 if mmx
should not be used.}
if is_varset(tsetdef(left.resultdef)) or
is_normalset(tsetdef(left.resultdef)) then
begin
{$ifdef SUPPORT_MMX}
{$ifdef i386}
if cs_mmx in current_settings.localswitches then
second_opmmxset
else
{$endif}
{$endif SUPPORT_MMX}
internalerror(200109041);
end
else
second_opsmallset;
end;
arraydef :
begin
{ support dynarr=nil }
if is_dynamic_array(left.resultdef) then
second_opordinal
else
if (cs_support_vectors in current_settings.globalswitches) and
is_vector(left.resultdef) then
second_opvector
{$ifdef SUPPORT_MMX}
else
if is_mmx_able_array(left.resultdef) then
second_opmmx
{$endif SUPPORT_MMX}
else
internalerror(200306016);
end;
floatdef :
second_opfloat;
else
second_opordinal;
end;
end;
begin
caddnode:=tcgaddnode;
end.
syntax highlighted by Code2HTML, v. 0.9.1