paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-09-08 10:39:29 +02:00
Code Issues Packages Projects Releases Wiki Activity

* common addnode code for x86-64 and i386

Browse Source
This commit is contained in:
florian 2004-01-20 12:59:36 +00:00
parent 7749a2a8fa
commit c37035a450
12 changed files with 1101 additions and 692 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
compiler/cgobj.pas
View File

@ -2092,8 +2092,10 @@ implementation
LOC_REGISTER,LOC_CREGISTER :
begin
cg.ungetregister(list,l.register);
{$ifndef cpu64bit}
if l.size in [OS_64,OS_S64] then
cg.ungetregister(list,l.registerhigh);
{$endif cpu64bit}
end;
LOC_FPUREGISTER,LOC_CFPUREGISTER :
cg.ungetregister(list,l.register);
@ -2135,7 +2137,10 @@ finalization
end.
{
$Log$
Revision 1.148 2004-01-12 22:11:38 peter
Revision 1.149 2004-01-20 12:59:36 florian
* common addnode code for x86-64 and i386
Revision 1.148 2004/01/12 22:11:38 peter
* use localalign info for alignment for locals and temps
* sparc fpu flags branching added
* moved powerpc copy_valye_openarray to generic

579
compiler/i386/n386add.pas
View File

@ -31,24 +31,14 @@ interface
type
ti386addnode = class(tx86addnode)
procedure pass_2;override;
protected
function first_addstring : tnode; override;
private
function getresflags(unsigned : boolean) : tresflags;
procedure left_must_be_reg(opsize:TOpSize;noswap:boolean);
procedure emit_op_right_left(op:TAsmOp;opsize:TOpSize);
procedure emit_generic_code(op:TAsmOp;opsize:TOpSize;unsigned,extra_not,mboverflow:boolean);
procedure set_result_location(cmpop,unsigned:boolean);
procedure second_addstring;
procedure second_addboolean;
procedure second_addsmallset;
procedure second_addmmxset;
procedure second_mul;
procedure second_addboolean;override;
procedure second_addsmallset;override;
procedure second_addmmxset;override;
procedure second_mul;override;
{$ifdef SUPPORT_MMX}
procedure second_addmmx;
procedure second_addmmx;override;
{$endif SUPPORT_MMX}
procedure second_add64bit;
procedure second_add64bit;override;
end;
implementation
@ -62,325 +52,6 @@ interface
ncon,nset,
cga,cgx86,ncgutil,cgobj,cg64f32;
{*****************************************************************************
Helpers
*****************************************************************************}
const
opsize_2_cgsize : array[S_B..S_L] of tcgsize = (OS_8,OS_16,OS_32);
function ti386addnode.getresflags(unsigned : boolean) : tresflags;
begin
case nodetype of
equaln : getresflags:=F_E;
unequaln : getresflags:=F_NE;
else
if not(unsigned) then
begin
if nf_swaped 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_swaped 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;
procedure ti386addnode.left_must_be_reg(opsize:TOpSize;noswap:boolean);
begin
{ left location is not a register? }
if (left.location.loc<>LOC_REGISTER) then
begin
{ if right is register then we can swap the locations }
if (not noswap) and
(right.location.loc=LOC_REGISTER) then
begin
location_swap(left.location,right.location);
toggleflag(nf_swaped);
end
else
begin
{ maybe we can reuse a constant register when the
operation is a comparison that doesn't change the
value of the register }
location_force_reg(exprasmlist,left.location,opsize_2_cgsize[opsize],(nodetype in [ltn,lten,gtn,gten,equaln,unequaln]));
end;
end;
end;
procedure ti386addnode.emit_op_right_left(op:TAsmOp;opsize:TOpsize);
begin
{ left must be a register }
case right.location.loc of
LOC_REGISTER,
LOC_CREGISTER :
exprasmlist.concat(taicpu.op_reg_reg(op,opsize,right.location.register,left.location.register));
LOC_REFERENCE,
LOC_CREFERENCE :
exprasmlist.concat(taicpu.op_ref_reg(op,opsize,right.location.reference,left.location.register));
LOC_CONSTANT :
exprasmlist.concat(taicpu.op_const_reg(op,opsize,right.location.value,left.location.register));
else
internalerror(200203232);
end;
end;
procedure ti386addnode.set_result_location(cmpop,unsigned:boolean);
begin
if cmpop then
begin
location_reset(location,LOC_FLAGS,OS_NO);
location.resflags:=getresflags(unsigned);
end
else
location_copy(location,left.location);
end;
procedure ti386addnode.emit_generic_code(op:TAsmOp;opsize:TOpSize;unsigned,extra_not,mboverflow:boolean);
var
power : longint;
hl4 : tasmlabel;
r : Tregister;
begin
{ at this point, left.location.loc should be LOC_REGISTER }
if right.location.loc=LOC_REGISTER then
begin
{ right.location is a LOC_REGISTER }
{ when swapped another result register }
if (nodetype=subn) and (nf_swaped in flags) then
begin
if extra_not then
emit_reg(A_NOT,S_L,left.location.register);
emit_reg_reg(op,opsize,left.location.register,right.location.register);
{ newly swapped also set swapped flag }
location_swap(left.location,right.location);
toggleflag(nf_swaped);
end
else
begin
if extra_not then
emit_reg(A_NOT,S_L,right.location.register);
if (op=A_ADD) or (op=A_OR) or (op=A_AND) or (op=A_XOR) or (op=A_IMUL) then
location_swap(left.location,right.location);
emit_reg_reg(op,opsize,right.location.register,left.location.register);
end;
end
else
begin
{ right.location is not a LOC_REGISTER }
if (nodetype=subn) and (nf_swaped in flags) then
begin
if extra_not then
emit_reg(A_NOT,opsize,left.location.register);
r:=cg.getintregister(exprasmlist,OS_INT);
cg.a_load_loc_reg(exprasmlist,OS_INT,right.location,r);
emit_reg_reg(op,opsize,left.location.register,r);
emit_reg_reg(A_MOV,opsize,r,left.location.register);
cg.ungetregister(exprasmlist,r);
end
else
begin
{ Optimizations when right.location is a constant value }
if (op=A_CMP) and
(nodetype in [equaln,unequaln]) and
(right.location.loc=LOC_CONSTANT) and
(right.location.value=0) then
begin
emit_reg_reg(A_TEST,opsize,left.location.register,left.location.register);
end
else
if (op=A_ADD) and
(right.location.loc=LOC_CONSTANT) and
(right.location.value=1) and
not(cs_check_overflow in aktlocalswitches) then
begin
emit_reg(A_INC,opsize,left.location.register);
end
else
if (op=A_SUB) and
(right.location.loc=LOC_CONSTANT) and
(right.location.value=1) and
not(cs_check_overflow in aktlocalswitches) then
begin
emit_reg(A_DEC,opsize,left.location.register);
end
else
if (op=A_IMUL) and
(right.location.loc=LOC_CONSTANT) and
(ispowerof2(right.location.value,power)) and
not(cs_check_overflow in aktlocalswitches) then
begin
emit_const_reg(A_SHL,opsize,power,left.location.register);
end
else
begin
if extra_not then
begin
r:=cg.getintregister(exprasmlist,OS_INT);
cg.a_load_loc_reg(exprasmlist,OS_INT,right.location,r);
emit_reg(A_NOT,S_L,r);
emit_reg_reg(A_AND,S_L,r,left.location.register);
cg.ungetregister(exprasmlist,r);
end
else
begin
emit_op_right_left(op,opsize);
end;
end;
end;
end;
{ only in case of overflow operations }
{ produce overflow code }
{ we must put it here directly, because sign of operation }
{ is in unsigned VAR!! }
if mboverflow then
begin
if cs_check_overflow in aktlocalswitches then
begin
objectlibrary.getlabel(hl4);
if unsigned then
cg.a_jmp_flags(exprasmlist,F_AE,hl4)
else
cg.a_jmp_flags(exprasmlist,F_NO,hl4);
cg.a_call_name(exprasmlist,'FPC_OVERFLOW');
cg.a_label(exprasmlist,hl4);
end;
end;
end;
{*****************************************************************************
Addstring
*****************************************************************************}
{ note: if you implemented an fpc_shortstr_concat similar to the }
{ one in i386.inc, you have to override first_addstring like in }
{ ti386addnode.first_string and implement the shortstring concat }
{ manually! The generic routine is different from the i386 one (JM) }
function ti386addnode.first_addstring : tnode;
begin
{ special cases for shortstrings, handled in pass_2 (JM) }
{ can't handle fpc_shortstr_compare with compilerproc either because it }
{ returns its results in the flags instead of in eax }
if (nodetype in [ltn,lten,gtn,gten,equaln,unequaln]) and
is_shortstring(left.resulttype.def) and
not(((left.nodetype=stringconstn) and (str_length(left)=0)) or
((right.nodetype=stringconstn) and (str_length(right)=0))) then
begin
expectloc:=LOC_FLAGS;
calcregisters(self,0,0,0);
result := nil;
exit;
end;
{ otherwise, use the generic code }
result := inherited first_addstring;
end;
procedure ti386addnode.second_addstring;
var
paraloc1,
paraloc2 : tparalocation;
hregister1,
hregister2 : tregister;
begin
{ string operations are not commutative }
if nf_swaped in flags then
swapleftright;
case tstringdef(left.resulttype.def).string_typ of
st_shortstring:
begin
case nodetype of
ltn,lten,gtn,gten,equaln,unequaln :
begin
paraloc1:=paramanager.getintparaloc(pocall_default,1);
paraloc2:=paramanager.getintparaloc(pocall_default,2);
{ process parameters }
secondpass(left);
location_release(exprasmlist,left.location);
if paraloc2.loc=LOC_REGISTER then
begin
hregister2:=cg.getaddressregister(exprasmlist);
cg.a_loadaddr_ref_reg(exprasmlist,left.location.reference,hregister2);
end
else
begin
paramanager.allocparaloc(exprasmlist,paraloc2);
cg.a_paramaddr_ref(exprasmlist,left.location.reference,paraloc2);
end;
secondpass(right);
location_release(exprasmlist,right.location);
if paraloc1.loc=LOC_REGISTER then
begin
hregister1:=cg.getaddressregister(exprasmlist);
cg.a_loadaddr_ref_reg(exprasmlist,right.location.reference,hregister1);
end
else
begin
paramanager.allocparaloc(exprasmlist,paraloc1);
cg.a_paramaddr_ref(exprasmlist,right.location.reference,paraloc1);
end;
{ push parameters }
if paraloc1.loc=LOC_REGISTER then
begin
cg.ungetregister(exprasmlist,hregister2);
paramanager.allocparaloc(exprasmlist,paraloc2);
cg.a_param_reg(exprasmlist,OS_ADDR,hregister2,paraloc2);
end;
if paraloc2.loc=LOC_REGISTER then
begin
cg.ungetregister(exprasmlist,hregister1);
paramanager.allocparaloc(exprasmlist,paraloc1);
cg.a_param_reg(exprasmlist,OS_ADDR,hregister1,paraloc1);
end;
paramanager.freeparaloc(exprasmlist,paraloc1);
paramanager.freeparaloc(exprasmlist,paraloc2);
cg.allocexplicitregisters(exprasmlist,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default));
cg.a_call_name(exprasmlist,'FPC_SHORTSTR_COMPARE');
cg.deallocexplicitregisters(exprasmlist,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default));
location_freetemp(exprasmlist,left.location);
location_freetemp(exprasmlist,right.location);
end;
end;
set_result_location(true,true);
end;
else
{ rest should be handled in first pass (JM) }
internalerror(200108303);
end;
end;
{*****************************************************************************
AddBoolean
*****************************************************************************}
@ -388,7 +59,7 @@ interface
procedure ti386addnode.second_addboolean;
var
op : TAsmOp;
opsize : TOpsize;
opsize : TCGSize;
cmpop,
isjump : boolean;
otl,ofl : tasmlabel;
@ -399,13 +70,13 @@ interface
cmpop:=false;
if (torddef(left.resulttype.def).typ=bool8bit) or
(torddef(right.resulttype.def).typ=bool8bit) then
opsize:=S_B
opsize:=OS_8
else
if (torddef(left.resulttype.def).typ=bool16bit) or
(torddef(right.resulttype.def).typ=bool16bit) then
opsize:=S_W
opsize:=OS_16
else
opsize:=S_L;
opsize:=OS_32;
if (cs_full_boolean_eval in aktlocalswitches) or
(nodetype in [unequaln,ltn,lten,gtn,gten,equaln,xorn]) then
@ -423,7 +94,7 @@ interface
end;
secondpass(left);
if left.location.loc in [LOC_FLAGS,LOC_JUMP] then
location_force_reg(exprasmlist,left.location,opsize_2_cgsize[opsize],false);
location_force_reg(exprasmlist,left.location,opsize,false);
if isjump then
begin
truelabel:=otl;
@ -442,7 +113,7 @@ interface
end;
secondpass(right);
if right.location.loc in [LOC_FLAGS,LOC_JUMP] then
location_force_reg(exprasmlist,right.location,opsize_2_cgsize[opsize],false);
location_force_reg(exprasmlist,right.location,opsize,false);
if isjump then
begin
truelabel:=otl;
@ -470,7 +141,7 @@ interface
else
internalerror(200203247);
end;
emit_op_right_left(op,opsize);
emit_op_right_left(op,TCGSize2Opsize[opsize]);
location_freetemp(exprasmlist,right.location);
location_release(exprasmlist,right.location);
if cmpop then
@ -525,7 +196,7 @@ interface
procedure ti386addnode.second_addsmallset;
var
opsize : TOpSize;
opsize : TCGSize;
op : TAsmOp;
cmpop,
pushedfpu,
@ -544,7 +215,7 @@ interface
cmpop:=false;
noswap:=false;
extra_not:=false;
opsize:=S_L;
opsize:=OS_32;
case nodetype of
addn :
begin
@ -562,8 +233,8 @@ interface
if assigned(tsetelementnode(right).right) then
internalerror(43244);
{ bts requires both elements to be registers }
location_force_reg(exprasmlist,left.location,opsize_2_cgsize[opsize],false);
location_force_reg(exprasmlist,right.location,opsize_2_cgsize[opsize],true);
location_force_reg(exprasmlist,left.location,opsize,false);
location_force_reg(exprasmlist,right.location,opsize,true);
op:=A_BTS;
noswap:=true;
end
@ -597,8 +268,8 @@ interface
if (not(nf_swaped in flags) and (nodetype = lten)) or
((nf_swaped in flags) and (nodetype = gten)) then
swapleftright;
location_force_reg(exprasmlist,left.location,opsize_2_cgsize[opsize],true);
emit_op_right_left(A_AND,opsize);
location_force_reg(exprasmlist,left.location,opsize,true);
emit_op_right_left(A_AND,TCGSize2Opsize[opsize]);
op:=A_CMP;
cmpop:=true;
{ warning: ugly hack, we need a JE so change the node to equaln }
@ -632,7 +303,7 @@ interface
procedure ti386addnode.second_addmmxset;
var opsize : TOpSize;
var opsize : TCGSize;
op : TAsmOp;
cmpop,
pushedfpu,
@ -642,7 +313,7 @@ interface
cmpop:=false;
noswap:=false;
opsize:=S_L;
opsize:=OS_32;
case nodetype of
addn:
begin
@ -678,8 +349,8 @@ interface
if (not(nf_swaped in flags) and (nodetype = lten)) or
((nf_swaped in flags) and (nodetype = gten)) then
swapleftright;
location_force_reg(exprasmlist,left.location,opsize_2_cgsize[opsize],true);
emit_op_right_left(A_AND,opsize);
location_force_reg(exprasmlist,left.location,opsize,true);
emit_op_right_left(A_AND,TCGSize2Opsize[opsize]);
op:=A_PCMPEQD;
cmpop:=true;
{ warning: ugly hack, we need a JE so change the node to equaln }
@ -1226,211 +897,15 @@ interface
end;
{*****************************************************************************
pass_2
*****************************************************************************}
procedure ti386addnode.pass_2;
{ is also being used for xor, and "mul", "sub, or and comparative }
{ operators }
var
pushedfpu,
mboverflow,cmpop : boolean;
op : tasmop;
opsize : topsize;
{ true, if unsigned types are compared }
unsigned : boolean;
{ is_in_dest if the result is put directly into }
{ the resulting refernce or varregister }
{is_in_dest : boolean;}
{ true, if for sets subtractions the extra not should generated }
extra_not : boolean;
begin
{ to make it more readable, string and set have their own procedures }
case left.resulttype.def.deftype of
orddef :
begin
{ handling boolean expressions }
if is_boolean(left.resulttype.def) and
is_boolean(right.resulttype.def) then
begin
second_addboolean;
exit;
end
{ 64bit operations }
else if is_64bit(left.resulttype.def) then
begin
second_add64bit;
exit;
end;
end;
stringdef :
begin
second_addstring;
exit;
end;
setdef :
begin
{Normalsets are already handled in pass1 if mmx
should not be used.}
if (tsetdef(left.resulttype.def).settype<>smallset) then
begin
{$ifdef MMXSET}
if cs_mmx in aktlocalswitches then
second_addmmxset
else
{$endif MMXSET}
internalerror(200109041);
end
else
second_addsmallset;
exit;
end;
arraydef :
begin
{$ifdef SUPPORT_MMX}
if is_mmx_able_array(left.resulttype.def) then
begin
second_addmmx;
exit;
end;
{$endif SUPPORT_MMX}
end;
floatdef :
begin
second_addfloat;
exit;
end;
end;
{ defaults }
{is_in_dest:=false;}
extra_not:=false;
mboverflow:=false;
cmpop:=false;
unsigned:=not(is_signed(left.resulttype.def)) or
not(is_signed(right.resulttype.def));
opsize:=def_opsize(left.resulttype.def);
pass_left_and_right(pushedfpu);
if (left.resulttype.def.deftype=pointerdef) or
(right.resulttype.def.deftype=pointerdef) or
(is_class_or_interface(right.resulttype.def) and is_class_or_interface(left.resulttype.def)) or
(left.resulttype.def.deftype=classrefdef) or
(left.resulttype.def.deftype=procvardef) or
((left.resulttype.def.deftype=enumdef) and
(left.resulttype.def.size=4)) or
((left.resulttype.def.deftype=orddef) and
(torddef(left.resulttype.def).typ in [s32bit,u32bit])) or
((right.resulttype.def.deftype=orddef) and
(torddef(right.resulttype.def).typ in [s32bit,u32bit])) then
begin
case nodetype of
addn :
begin
op:=A_ADD;
mboverflow:=true;
end;
muln :
begin
if unsigned then
op:=A_MUL
else
op:=A_IMUL;
mboverflow:=true;
end;
subn :
begin
op:=A_SUB;
mboverflow:=true;
end;
ltn,lten,
gtn,gten,
equaln,unequaln :
begin
op:=A_CMP;
cmpop:=true;
end;
xorn :
op:=A_XOR;
orn :
op:=A_OR;
andn :
op:=A_AND;
else
internalerror(200304229);
end;
{ filter MUL, which requires special handling }
if op=A_MUL then
begin
second_mul;
exit;
end;
{ Convert flags to register first }
if (left.location.loc=LOC_FLAGS) then
location_force_reg(exprasmlist,left.location,opsize_2_cgsize[opsize],false);
if (right.location.loc=LOC_FLAGS) then
location_force_reg(exprasmlist,right.location,opsize_2_cgsize[opsize],false);
left_must_be_reg(opsize,false);
emit_generic_code(op,opsize,unsigned,extra_not,mboverflow);
location_freetemp(exprasmlist,right.location);
location_release(exprasmlist,right.location);
if cmpop and
(left.location.loc<>LOC_CREGISTER) then
begin
location_freetemp(exprasmlist,left.location);
location_release(exprasmlist,left.location);
end;
set_result_location(cmpop,unsigned);
end
{ 8/16 bit enum,char,wchar types }
else
if ((left.resulttype.def.deftype=orddef) and
(torddef(left.resulttype.def).typ in [uchar,uwidechar])) or
((left.resulttype.def.deftype=enumdef) and
((left.resulttype.def.size=1) or
(left.resulttype.def.size=2))) then
begin
case nodetype of
ltn,lten,gtn,gten,
equaln,unequaln :
cmpop:=true;
else
internalerror(2003042210);
end;
left_must_be_reg(opsize,false);
emit_op_right_left(A_CMP,opsize);
location_freetemp(exprasmlist,right.location);
location_release(exprasmlist,right.location);
if left.location.loc<>LOC_CREGISTER then
begin
location_freetemp(exprasmlist,left.location);
location_release(exprasmlist,left.location);
end;
set_result_location(true,true);
end
else
internalerror(2003042211);
end;
begin
caddnode:=ti386addnode;
end.
{
$Log$
Revision 1.93 2004-01-14 17:19:04 peter
Revision 1.94 2004-01-20 12:59:37 florian
* common addnode code for x86-64 and i386
Revision 1.93 2004/01/14 17:19:04 peter
* disable addmmxset
Revision 1.92 2003/12/25 01:07:09 florian

108
compiler/i386/n386mat.pas
View File

@ -43,11 +43,7 @@ interface
ti386unaryminusnode = class(tx86unaryminusnode)
end;
ti386notnode = class(tcgnotnode)
procedure second_boolean;override;
{$ifdef SUPPORT_MMX}
procedure second_mmx;override;
{$endif SUPPORT_MMX}
ti386notnode = class(tx86notnode)
end;
@ -350,103 +346,6 @@ implementation
end;
{*****************************************************************************
TI386NOTNODE
*****************************************************************************}
procedure ti386notnode.second_boolean;
var
hl : tasmlabel;
opsize : topsize;
begin
opsize:=def_opsize(resulttype.def);
if left.expectloc=LOC_JUMP then
begin
location_reset(location,LOC_JUMP,OS_NO);
hl:=truelabel;
truelabel:=falselabel;
falselabel:=hl;
secondpass(left);
maketojumpbool(exprasmlist,left,lr_load_regvars);
hl:=truelabel;
truelabel:=falselabel;
falselabel:=hl;
end
else
begin
{ the second pass could change the location of left }
{ if it is a register variable, so we've to do }
{ this before the case statement }
secondpass(left);
case left.expectloc of
LOC_FLAGS :
begin
location_release(exprasmlist,left.location);
location_reset(location,LOC_FLAGS,OS_NO);
location.resflags:=left.location.resflags;
inverse_flags(location.resflags);
end;
LOC_CONSTANT,
LOC_REGISTER,
LOC_CREGISTER,
LOC_REFERENCE,
LOC_CREFERENCE :
begin
location_force_reg(exprasmlist,left.location,def_cgsize(resulttype.def),true);
location_release(exprasmlist,left.location);
emit_reg_reg(A_TEST,opsize,left.location.register,left.location.register);
location_reset(location,LOC_FLAGS,OS_NO);
location.resflags:=F_E;
end;
else
internalerror(200203224);
end;
end;
end;
{$ifdef SUPPORT_MMX}
procedure ti386notnode.second_mmx;
var hreg,r:Tregister;
begin
secondpass(left);
location_reset(location,LOC_MMXREGISTER,OS_NO);
r:=cg.getintregister(exprasmlist,OS_INT);
emit_const_reg(A_MOV,S_L,longint($ffffffff),r);
{ load operand }
case left.location.loc of
LOC_MMXREGISTER:
location_copy(location,left.location);
LOC_CMMXREGISTER:
begin
location.register:=cg.getmmxregister(exprasmlist,OS_M64);
emit_reg_reg(A_MOVQ,S_NO,left.location.register,location.register);
end;
LOC_REFERENCE,
LOC_CREFERENCE:
begin
location_release(exprasmlist,left.location);
location.register:=cg.getmmxregister(exprasmlist,OS_M64);
emit_ref_reg(A_MOVQ,S_NO,left.location.reference,location.register);
end;
end;
{ load mask }
hreg:=cg.getmmxregister(exprasmlist,OS_M64);
emit_reg_reg(A_MOVD,S_NO,r,hreg);
cg.ungetregister(exprasmlist,r);
{ lower 32 bit }
emit_reg_reg(A_PXOR,S_D,hreg,location.register);
{ shift mask }
emit_const_reg(A_PSLLQ,S_NO,32,hreg);
{ higher 32 bit }
cg.ungetregister(exprasmlist,hreg);
emit_reg_reg(A_PXOR,S_D,hreg,location.register);
end;
{$endif SUPPORT_MMX}
begin
cunaryminusnode:=ti386unaryminusnode;
cmoddivnode:=ti386moddivnode;
@ -455,7 +354,10 @@ begin
end.
{
$Log$
Revision 1.68 2003-12-26 13:19:16 florian
Revision 1.69 2004-01-20 12:59:37 florian
* common addnode code for x86-64 and i386
Revision 1.68 2003/12/26 13:19:16 florian
* rtl and compiler compile with -Cfsse2
Revision 1.67 2003/12/25 01:07:09 florian

29
compiler/nadd.pas
View File

@ -167,7 +167,7 @@ implementation
(right.resulttype.def.deftype=orddef) then
begin
{ insert explicit typecast to s32bit }
left:=ctypeconvnode.create_explicit(left,s32bittype);
left:=ctypeconvnode.create_explicit(left,inttype);
resulttypepass(left);
end
else
@ -175,7 +175,7 @@ implementation
(right.resulttype.def.deftype=enumdef) then
begin
{ insert explicit typecast to s32bit }
right:=ctypeconvnode.create_explicit(right,s32bittype);
right:=ctypeconvnode.create_explicit(right,inttype);
resulttypepass(right);
end;
end;
@ -846,8 +846,8 @@ implementation
CGMessage(type_w_signed_unsigned_always_false);
end;
inserttypeconv(right,s32bittype);
inserttypeconv(left,s32bittype);
inserttypeconv(right,inttype);
inserttypeconv(left,inttype);
end;
end
@ -956,7 +956,7 @@ implementation
end
else
CGMessage(type_e_mismatch);
resulttype:=s32bittype;
resulttype:=inttype;
exit;
end;
addn:
@ -972,7 +972,7 @@ implementation
end
else
CGMessage(type_e_mismatch);
resulttype:=s32bittype;
resulttype:=inttype;
exit;
end;
else
@ -1113,7 +1113,7 @@ implementation
resulttype.setdef(tpointerdef.create(tarraydef(rd).elementtype));
inserttypeconv(right,resulttype);
end;
inserttypeconv(left,s32bittype);
inserttypeconv(left,inttype);
if nodetype=addn then
begin
if not(cs_extsyntax in aktmoduleswitches) or
@ -1122,7 +1122,7 @@ implementation
if (rd.deftype=pointerdef) and
(tpointerdef(rd).pointertype.def.size>1) then
left:=caddnode.create(muln,left,
cordconstnode.create(tpointerdef(rd).pointertype.def.size,s32bittype,true));
cordconstnode.create(tpointerdef(rd).pointertype.def.size,inttype,true));
end
else
CGMessage(type_e_mismatch);
@ -1135,7 +1135,7 @@ implementation
resulttype.setdef(tpointerdef.create(tarraydef(ld).elementtype));
inserttypeconv(left,resulttype);
end;
inserttypeconv(right,s32bittype);
inserttypeconv(right,inttype);
if nodetype in [addn,subn] then
begin
if not(cs_extsyntax in aktmoduleswitches) or
@ -1144,7 +1144,7 @@ implementation
if (ld.deftype=pointerdef) and
(tpointerdef(ld).pointertype.def.size>1) then
right:=caddnode.create(muln,right,
cordconstnode.create(tpointerdef(ld).pointertype.def.size,s32bittype,true));
cordconstnode.create(tpointerdef(ld).pointertype.def.size,inttype,true));
end
else
CGMessage(type_e_mismatch);
@ -1174,8 +1174,8 @@ implementation
{ generic conversion, this is for error recovery }
else
begin
inserttypeconv(left,s32bittype);
inserttypeconv(right,s32bittype);
inserttypeconv(left,inttype);
inserttypeconv(right,inttype);
end;
{ set resulttype if not already done }
@ -1906,7 +1906,10 @@ begin
end.
{
$Log$
Revision 1.106 2004-01-14 17:19:04 peter
Revision 1.107 2004-01-20 12:59:36 florian
* common addnode code for x86-64 and i386
Revision 1.106 2004/01/14 17:19:04 peter
* disable addmmxset
Revision 1.105 2004/01/02 17:19:04 jonas

39
compiler/ncgmat.pas
View File

@ -29,7 +29,7 @@ interface
uses
node,nmat,cpubase,cgbase;
type
type
tcgunaryminusnode = class(tunaryminusnode)
protected
{ This routine is called to change the sign of the
@ -46,7 +46,9 @@ type
{$ifdef SUPPORT_MMX}
procedure second_mmx;virtual;abstract;
{$endif SUPPORT_MMX}
{$ifndef cpu64bit}
procedure second_64bit;virtual;
{$endif cpu64bit}
procedure second_integer;virtual;
procedure second_float;virtual;
public
@ -97,7 +99,9 @@ type
end;
tcgshlshrnode = class(tshlshrnode)
{$ifndef cpu64bit}
procedure second_64bit;virtual;
{$endif cpu64bit}
procedure second_integer;virtual;
procedure pass_2;override;
end;
@ -108,7 +112,9 @@ type
{$ifdef SUPPORT_MMX}
procedure second_mmx;virtual;abstract;
{$endif SUPPORT_MMX}
{$ifndef cpu64bit}
procedure second_64bit;virtual;
{$endif cpu64bit}
procedure second_integer;virtual;
public
procedure pass_2;override;
@ -124,7 +130,11 @@ implementation
pass_1,pass_2,
ncon,
cpuinfo,
tgobj,ncgutil,cgobj,paramgr,cg64f32;
tgobj,ncgutil,cgobj,paramgr
{$ifndef cpu64bit}
,cg64f32
{$endif cpu64bit}
;
{*****************************************************************************
TCGUNARYMINUSNODE
@ -176,6 +186,7 @@ implementation
end;
{$ifndef cpu64bit}
procedure tcgunaryminusnode.second_64bit;
begin
secondpass(left);
@ -185,7 +196,7 @@ implementation
cg64.a_op64_loc_reg(exprasmlist,OP_NEG,
location,joinreg64(location.registerlow,location.registerhigh));
end;
{$endif cpu64bit}
procedure tcgunaryminusnode.second_float;
begin
@ -231,14 +242,16 @@ implementation
procedure tcgunaryminusnode.pass_2;
begin
{$ifndef cpu64bit}
if is_64bit(left.resulttype.def) then
second_64bit
{$ifdef SUPPORT_MMX}
else
{$endif cpu64bit}
{$ifdef SUPPORT_MMX}
if (cs_mmx in aktlocalswitches) and is_mmx_able_array(left.resulttype.def) then
second_mmx
{$endif SUPPORT_MMX}
else
{$endif SUPPORT_MMX}
if (left.resulttype.def.deftype=floatdef) then
second_float
else
@ -276,6 +289,7 @@ implementation
exit;
location_copy(location,left.location);
{$ifndef cpu64bit}
if is_64bit(resulttype.def) then
begin
{ this code valid for 64-bit cpu's only ,
@ -289,6 +303,7 @@ implementation
joinreg64(location.registerlow,location.registerhigh));
end
else
{$endif cpu64bit}
begin
{ put numerator in register }
location_force_reg(exprasmlist,left.location,OS_INT,false);
@ -353,6 +368,7 @@ implementation
*****************************************************************************}
{$ifndef cpu64bit}
procedure tcgshlshrnode.second_64bit;
var
freescratch : boolean;
@ -389,6 +405,7 @@ implementation
internalerror(2002081501);
{$endif cpu64bit}
end;
{$endif cpu64bit}
procedure tcgshlshrnode.second_integer;
@ -448,10 +465,11 @@ implementation
begin
secondpass(left);
secondpass(right);
{$ifndef cpu64bit}
if is_64bit(left.resulttype.def) then
second_64bit
else
{$endif cpu64bit}
second_integer;
end;
@ -460,6 +478,7 @@ implementation
TCGNOTNODE
*****************************************************************************}
{$ifndef cpu64bit}
procedure tcgnotnode.second_64bit;
begin
secondpass(left);
@ -468,6 +487,7 @@ implementation
{ perform the NOT operation }
cg64.a_op64_reg_reg(exprasmlist,OP_NOT,left.location.register64,location.register64);
end;
{$endif cpu64bit}
procedure tcgnotnode.second_integer;
@ -488,8 +508,10 @@ implementation
else if (cs_mmx in aktlocalswitches) and is_mmx_able_array(left.resulttype.def) then
second_mmx
{$endif SUPPORT_MMX}
{$ifndef cpu64bit}
else if is_64bit(left.resulttype.def) then
second_64bit
{$endif cpu64bit}
else
second_integer;
end;
@ -502,7 +524,10 @@ begin
end.
{
$Log$
Revision 1.23 2003-12-06 01:15:22 florian
Revision 1.24 2004-01-20 12:59:37 florian
* common addnode code for x86-64 and i386
Revision 1.23 2003/12/06 01:15:22 florian
* reverted Peter's alloctemp patch; hopefully properly
Revision 1.22 2003/12/03 23:13:20 peter

16
compiler/psystem.pas
View File

@ -281,6 +281,11 @@ implementation
ordpointertype:=u32bittype;
defaultordconsttype:=s32bittype;
{$endif arm}
{$ifdef cpu64bit}
inttype:=cs64bittype;
{$else cpu64bit}
inttype:=s32bittype;
{$endif cpu64bit}
end;
@ -360,6 +365,12 @@ implementation
s80floattype.setdef(tfloatdef.create(s80real));
s64currencytype.setdef(torddef.create(scurrency,low(int64),high(int64)));
{$endif arm}
{$ifdef cpu64bit}
inttype:=cs64bittype;
{$else cpu64bit}
inttype:=s32bittype;
{$endif cpu64bit}
{ some other definitions }
voidpointertype.setdef(tpointerdef.create(voidtype));
charpointertype.setdef(tpointerdef.create(cchartype));
@ -510,7 +521,10 @@ implementation
end.
{
$Log$
Revision 1.58 2003-11-29 16:19:54 peter
Revision 1.59 2004-01-20 12:59:37 florian
* common addnode code for x86-64 and i386
Revision 1.58 2003/11/29 16:19:54 peter
* Initialize() added
Revision 1.57 2003/10/06 22:23:41 florian

10
compiler/symdef.pas
View File

@ -723,7 +723,10 @@ interface
colevarianttype,
{ unsigned ord type with the same size as a pointer }
ordpointertype,
defaultordconsttype, { pointer to type of ordinal constants }
{ pointer to type of ordinal constants }
defaultordconsttype,
{ default integer type s32bittype on 32 bit systems, s64bittype on 64 bit systems }
inttype,
pvmttype : ttype; { type of classrefs, used for stabs }
{ pointer to the anchestor of all classes }
@ -6164,7 +6167,10 @@ implementation
end.
{
$Log$
Revision 1.199 2004-01-15 15:16:18 daniel
Revision 1.200 2004-01-20 12:59:37 florian
* common addnode code for x86-64 and i386
Revision 1.199 2004/01/15 15:16:18 daniel
* Some minor stuff
* Managed to eliminate speed effects of string compression

573
compiler/x86/nx86add.pas
View File

@ -30,27 +30,259 @@ unit nx86add;
interface
uses
node,nadd,ncgadd,cpubase;
cgbase,
cpubase,
node,nadd,ncgadd;
type
tx86addnode = class(tcgaddnode)
procedure second_addfloat;override;
procedure second_addfloatsse;
procedure pass_left_and_right(var pushedfpu:boolean);
end;
tx86addnode = class(tcgaddnode)
function getresflags(unsigned : boolean) : tresflags;
procedure set_result_location(cmpop,unsigned:boolean);
procedure left_must_be_reg(opsize:TCGSize;noswap:boolean);
procedure emit_op_right_left(op:TAsmOp;opsize:TOpSize);
procedure emit_generic_code(op:TAsmOp;opsize:TCgSize;unsigned,extra_not,mboverflow:boolean);
function first_addstring : tnode; override;
procedure pass_2;override;
procedure second_addfloat;override;
procedure second_addfloatsse;
procedure second_addstring;
procedure second_mul;virtual;abstract;
procedure pass_left_and_right(var pushedfpu:boolean);
end;
implementation
uses
globals,
globtype,globals,
verbose,
aasmtai,
cutils,
aasmbase,aasmtai,aasmcpu,
cpuinfo,
cgbase,cgobj,cgx86,cga,
symconst,symdef,
cgobj,cgx86,cga,
paramgr,
htypechk,
pass_2,ncgutil,
ncon,
defutil;
{*****************************************************************************
Helpers
*****************************************************************************}
procedure tx86addnode.emit_generic_code(op:TAsmOp;opsize:TCGSize;unsigned,extra_not,mboverflow:boolean);
var
power : longint;
hl4 : tasmlabel;
r : Tregister;
begin
{ at this point, left.location.loc should be LOC_REGISTER }
if right.location.loc=LOC_REGISTER then
begin
{ right.location is a LOC_REGISTER }
{ when swapped another result register }
if (nodetype=subn) and (nf_swaped in flags) then
begin
if extra_not then
emit_reg(A_NOT,TCGSize2Opsize[opsize],left.location.register);
emit_reg_reg(op,TCGSize2Opsize[opsize],left.location.register,right.location.register);
{ newly swapped also set swapped flag }
location_swap(left.location,right.location);
toggleflag(nf_swaped);
end
else
begin
if extra_not then
emit_reg(A_NOT,TCGSize2Opsize[opsize],right.location.register);
if (op=A_ADD) or (op=A_OR) or (op=A_AND) or (op=A_XOR) or (op=A_IMUL) then
location_swap(left.location,right.location);
emit_reg_reg(op,TCGSize2Opsize[opsize],right.location.register,left.location.register);
end;
end
else
begin
{ right.location is not a LOC_REGISTER }
if (nodetype=subn) and (nf_swaped in flags) then
begin
if extra_not then
emit_reg(A_NOT,TCGSize2Opsize[opsize],left.location.register);
r:=cg.getintregister(exprasmlist,OS_INT);
cg.a_load_loc_reg(exprasmlist,OS_INT,right.location,r);
emit_reg_reg(op,TCGSize2Opsize[opsize],left.location.register,r);
emit_reg_reg(A_MOV,TCGSize2Opsize[opsize],r,left.location.register);
cg.ungetregister(exprasmlist,r);
end
else
begin
{ Optimizations when right.location is a constant value }
if (op=A_CMP) and
(nodetype in [equaln,unequaln]) and
(right.location.loc=LOC_CONSTANT) and
(right.location.value=0) then
begin
emit_reg_reg(A_TEST,TCGSize2Opsize[opsize],left.location.register,left.location.register);
end
else
if (op=A_ADD) and
(right.location.loc=LOC_CONSTANT) and
(right.location.value=1) and
not(cs_check_overflow in aktlocalswitches) then
begin
emit_reg(A_INC,TCGSize2Opsize[opsize],left.location.register);
end
else
if (op=A_SUB) and
(right.location.loc=LOC_CONSTANT) and
(right.location.value=1) and
not(cs_check_overflow in aktlocalswitches) then
begin
emit_reg(A_DEC,TCGSize2Opsize[opsize],left.location.register);
end
else
if (op=A_IMUL) and
(right.location.loc=LOC_CONSTANT) and
(ispowerof2(right.location.value,power)) and
not(cs_check_overflow in aktlocalswitches) then
begin
emit_const_reg(A_SHL,TCGSize2Opsize[opsize],power,left.location.register);
end
else
begin
if extra_not then
begin
r:=cg.getintregister(exprasmlist,OS_INT);
cg.a_load_loc_reg(exprasmlist,OS_INT,right.location,r);
emit_reg(A_NOT,TCGSize2Opsize[opsize],r);
emit_reg_reg(A_AND,TCGSize2Opsize[opsize],r,left.location.register);
cg.ungetregister(exprasmlist,r);
end
else
begin
emit_op_right_left(op,TCGSize2Opsize[opsize]);
end;
end;
end;
end;
{ only in case of overflow operations }
{ produce overflow code }
{ we must put it here directly, because sign of operation }
{ is in unsigned VAR!! }
if mboverflow then
begin
if cs_check_overflow in aktlocalswitches then
begin
objectlibrary.getlabel(hl4);
if unsigned then
cg.a_jmp_flags(exprasmlist,F_AE,hl4)
else
cg.a_jmp_flags(exprasmlist,F_NO,hl4);
cg.a_call_name(exprasmlist,'FPC_OVERFLOW');
cg.a_label(exprasmlist,hl4);
end;
end;
end;
procedure tx86addnode.left_must_be_reg(opsize:TCGSize;noswap:boolean);
begin
{ left location is not a register? }
if (left.location.loc<>LOC_REGISTER) then
begin
{ if right is register then we can swap the locations }
if (not noswap) and
(right.location.loc=LOC_REGISTER) then
begin
location_swap(left.location,right.location);
toggleflag(nf_swaped);
end
else
begin
{ maybe we can reuse a constant register when the
operation is a comparison that doesn't change the
value of the register }
location_force_reg(exprasmlist,left.location,opsize,(nodetype in [ltn,lten,gtn,gten,equaln,unequaln]));
end;
end;
end;
procedure tx86addnode.emit_op_right_left(op:TAsmOp;opsize:TOpsize);
begin
{ left must be a register }
case right.location.loc of
LOC_REGISTER,
LOC_CREGISTER :
exprasmlist.concat(taicpu.op_reg_reg(op,opsize,right.location.register,left.location.register));
LOC_REFERENCE,
LOC_CREFERENCE :
exprasmlist.concat(taicpu.op_ref_reg(op,opsize,right.location.reference,left.location.register));
LOC_CONSTANT :
exprasmlist.concat(taicpu.op_const_reg(op,opsize,right.location.value,left.location.register));
else
internalerror(200203232);
end;
end;
procedure tx86addnode.set_result_location(cmpop,unsigned:boolean);
begin
if cmpop then
begin
location_reset(location,LOC_FLAGS,OS_NO);
location.resflags:=getresflags(unsigned);
end
else
location_copy(location,left.location);
end;
function tx86addnode.getresflags(unsigned : boolean) : tresflags;
begin
case nodetype of
equaln : getresflags:=F_E;
unequaln : getresflags:=F_NE;
else
if not(unsigned) then
begin
if nf_swaped 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_swaped 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
*****************************************************************************}
@ -266,10 +498,331 @@ unit nx86add;
end;
end;
{*****************************************************************************
Addstring
*****************************************************************************}
{ note: if you implemented an fpc_shortstr_concat similar to the }
{ one in i386.inc, you have to override first_addstring like in }
{ ti386addnode.first_string and implement the shortstring concat }
{ manually! The generic routine is different from the i386 one (JM) }
function tx86addnode.first_addstring : tnode;
begin
{ special cases for shortstrings, handled in pass_2 (JM) }
{ can't handle fpc_shortstr_compare with compilerproc either because it }
{ returns its results in the flags instead of in eax }
if (nodetype in [ltn,lten,gtn,gten,equaln,unequaln]) and
is_shortstring(left.resulttype.def) and
not(((left.nodetype=stringconstn) and (str_length(left)=0)) or
((right.nodetype=stringconstn) and (str_length(right)=0))) then
begin
expectloc:=LOC_FLAGS;
calcregisters(self,0,0,0);
result := nil;
exit;
end;
{ otherwise, use the generic code }
result := inherited first_addstring;
end;
procedure tx86addnode.second_addstring;
var
paraloc1,
paraloc2 : tparalocation;
hregister1,
hregister2 : tregister;
begin
{ string operations are not commutative }
if nf_swaped in flags then
swapleftright;
case tstringdef(left.resulttype.def).string_typ of
st_shortstring:
begin
case nodetype of
ltn,lten,gtn,gten,equaln,unequaln :
begin
paraloc1:=paramanager.getintparaloc(pocall_default,1);
paraloc2:=paramanager.getintparaloc(pocall_default,2);
{ process parameters }
secondpass(left);
location_release(exprasmlist,left.location);
if paraloc2.loc=LOC_REGISTER then
begin
hregister2:=cg.getaddressregister(exprasmlist);
cg.a_loadaddr_ref_reg(exprasmlist,left.location.reference,hregister2);
end
else
begin
paramanager.allocparaloc(exprasmlist,paraloc2);
cg.a_paramaddr_ref(exprasmlist,left.location.reference,paraloc2);
end;
secondpass(right);
location_release(exprasmlist,right.location);
if paraloc1.loc=LOC_REGISTER then
begin
hregister1:=cg.getaddressregister(exprasmlist);
cg.a_loadaddr_ref_reg(exprasmlist,right.location.reference,hregister1);
end
else
begin
paramanager.allocparaloc(exprasmlist,paraloc1);
cg.a_paramaddr_ref(exprasmlist,right.location.reference,paraloc1);
end;
{ push parameters }
if paraloc1.loc=LOC_REGISTER then
begin
cg.ungetregister(exprasmlist,hregister2);
paramanager.allocparaloc(exprasmlist,paraloc2);
cg.a_param_reg(exprasmlist,OS_ADDR,hregister2,paraloc2);
end;
if paraloc2.loc=LOC_REGISTER then
begin
cg.ungetregister(exprasmlist,hregister1);
paramanager.allocparaloc(exprasmlist,paraloc1);
cg.a_param_reg(exprasmlist,OS_ADDR,hregister1,paraloc1);
end;
paramanager.freeparaloc(exprasmlist,paraloc1);
paramanager.freeparaloc(exprasmlist,paraloc2);
cg.allocexplicitregisters(exprasmlist,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default));
cg.a_call_name(exprasmlist,'FPC_SHORTSTR_COMPARE');
cg.deallocexplicitregisters(exprasmlist,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default));
location_freetemp(exprasmlist,left.location);
location_freetemp(exprasmlist,right.location);
end;
end;
set_result_location(true,true);
end;
else
{ rest should be handled in first pass (JM) }
internalerror(200108303);
end;
end;
{*****************************************************************************
pass_2
*****************************************************************************}
procedure tx86addnode.pass_2;
{ is also being used for xor, and "mul", "sub, or and comparative }
{ operators }
var
pushedfpu,
mboverflow,cmpop : boolean;
op : tasmop;
opsize : tcgsize;
{ true, if unsigned types are compared }
unsigned : boolean;
{ is_in_dest if the result is put directly into }
{ the resulting refernce or varregister }
{is_in_dest : boolean;}
{ true, if for sets subtractions the extra not should generated }
extra_not : boolean;
begin
{ to make it more readable, string and set have their own procedures }
case left.resulttype.def.deftype of
orddef :
begin
{ handling boolean expressions }
if is_boolean(left.resulttype.def) and
is_boolean(right.resulttype.def) then
begin
second_addboolean;
exit;
end
{$ifndef x86_64}
{ 64bit operations }
else if is_64bit(left.resulttype.def) then
begin
second_add64bit;
exit;
end
{$endif x86_64}
;
end;
stringdef :
begin
second_addstring;
exit;
end;
setdef :
begin
{Normalsets are already handled in pass1 if mmx
should not be used.}
if (tsetdef(left.resulttype.def).settype<>smallset) then
begin
{$ifdef MMXSET}
if cs_mmx in aktlocalswitches then
second_addmmxset
else
{$endif MMXSET}
internalerror(200109041);
end
else
second_addsmallset;
exit;
end;
arraydef :
begin
{$ifdef SUPPORT_MMX}
if is_mmx_able_array(left.resulttype.def) then
begin
second_addmmx;
exit;
end;
{$endif SUPPORT_MMX}
end;
floatdef :
begin
second_addfloat;
exit;
end;
end;
{ defaults }
{is_in_dest:=false;}
extra_not:=false;
mboverflow:=false;
cmpop:=false;
unsigned:=not(is_signed(left.resulttype.def)) or
not(is_signed(right.resulttype.def));
opsize:=def_cgsize(left.resulttype.def);
pass_left_and_right(pushedfpu);
if (left.resulttype.def.deftype=pointerdef) or
(right.resulttype.def.deftype=pointerdef) or
(is_class_or_interface(right.resulttype.def) and is_class_or_interface(left.resulttype.def)) or
(left.resulttype.def.deftype=classrefdef) or
(left.resulttype.def.deftype=procvardef) or
{$ifdef x86_64}
((left.resulttype.def.deftype=enumdef) and
(left.resulttype.def.size in [4,8])) or
((left.resulttype.def.deftype=orddef) and
(torddef(left.resulttype.def).typ in [s32bit,u32bit,s64bit,u64bit])) or
((right.resulttype.def.deftype=orddef) and
(torddef(right.resulttype.def).typ in [s32bit,u32bit,s64bit,u64bit])) then
{$else x86_64}
((left.resulttype.def.deftype=enumdef) and
(left.resulttype.def.size=4)) or
((left.resulttype.def.deftype=orddef) and
(torddef(left.resulttype.def).typ in [s32bit,u32bit])) or
((right.resulttype.def.deftype=orddef) and
(torddef(right.resulttype.def).typ in [s32bit,u32bit])) then
{$endif x86_64}
begin
case nodetype of
addn :
begin
op:=A_ADD;
mboverflow:=true;
end;
muln :
begin
if unsigned then
op:=A_MUL
else
op:=A_IMUL;
mboverflow:=true;
end;
subn :
begin
op:=A_SUB;
mboverflow:=true;
end;
ltn,lten,
gtn,gten,
equaln,unequaln :
begin
op:=A_CMP;
cmpop:=true;
end;
xorn :
op:=A_XOR;
orn :
op:=A_OR;
andn :
op:=A_AND;
else
internalerror(200304229);
end;
{ filter MUL, which requires special handling }
if op=A_MUL then
begin
second_mul;
exit;
end;
{ Convert flags to register first }
if (left.location.loc=LOC_FLAGS) then
location_force_reg(exprasmlist,left.location,opsize,false);
if (right.location.loc=LOC_FLAGS) then
location_force_reg(exprasmlist,right.location,opsize,false);
left_must_be_reg(opsize,false);
emit_generic_code(op,opsize,unsigned,extra_not,mboverflow);
location_freetemp(exprasmlist,right.location);
location_release(exprasmlist,right.location);
if cmpop and
(left.location.loc<>LOC_CREGISTER) then
begin
location_freetemp(exprasmlist,left.location);
location_release(exprasmlist,left.location);
end;
set_result_location(cmpop,unsigned);
end
{ 8/16 bit enum,char,wchar types }
else
if ((left.resulttype.def.deftype=orddef) and
(torddef(left.resulttype.def).typ in [uchar,uwidechar])) or
((left.resulttype.def.deftype=enumdef) and
((left.resulttype.def.size=1) or
(left.resulttype.def.size=2))) then
begin
case nodetype of
ltn,lten,gtn,gten,
equaln,unequaln :
cmpop:=true;
else
internalerror(2003042210);
end;
left_must_be_reg(opsize,false);
emit_op_right_left(A_CMP,TCGSize2Opsize[opsize]);
location_freetemp(exprasmlist,right.location);
location_release(exprasmlist,right.location);
if left.location.loc<>LOC_CREGISTER then
begin
location_freetemp(exprasmlist,left.location);
location_release(exprasmlist,left.location);
end;
set_result_location(true,true);
end
else
internalerror(2003042211);
end;
begin
caddnode:=tx86addnode;
end.
{
$Log$
Revision 1.5 2003-12-26 13:19:16 florian
Revision 1.6 2004-01-20 12:59:37 florian
* common addnode code for x86-64 and i386
Revision 1.5 2003/12/26 13:19:16 florian
* rtl and compiler compile with -Cfsse2
Revision 1.4 2003/12/26 00:32:22 florian

110
compiler/x86/nx86mat.pas
View File

@ -38,6 +38,13 @@ interface
function pass_1:tnode;override;
end;
tx86notnode = class(tcgnotnode)
procedure second_boolean;override;
{$ifdef SUPPORT_MMX}
procedure second_mmx;override;
{$endif SUPPORT_MMX}
end;
implementation
uses
@ -200,9 +207,110 @@ interface
end;
{*****************************************************************************
TX86NOTNODE
*****************************************************************************}
procedure tx86notnode.second_boolean;
var
hl : tasmlabel;
opsize : topsize;
begin
opsize:=def_opsize(resulttype.def);
if left.expectloc=LOC_JUMP then
begin
location_reset(location,LOC_JUMP,OS_NO);
hl:=truelabel;
truelabel:=falselabel;
falselabel:=hl;
secondpass(left);
maketojumpbool(exprasmlist,left,lr_load_regvars);
hl:=truelabel;
truelabel:=falselabel;
falselabel:=hl;
end
else
begin
{ the second pass could change the location of left }
{ if it is a register variable, so we've to do }
{ this before the case statement }
secondpass(left);
case left.expectloc of
LOC_FLAGS :
begin
location_release(exprasmlist,left.location);
location_reset(location,LOC_FLAGS,OS_NO);
location.resflags:=left.location.resflags;
inverse_flags(location.resflags);
end;
LOC_CONSTANT,
LOC_REGISTER,
LOC_CREGISTER,
LOC_REFERENCE,
LOC_CREFERENCE :
begin
location_force_reg(exprasmlist,left.location,def_cgsize(resulttype.def),true);
location_release(exprasmlist,left.location);
emit_reg_reg(A_TEST,opsize,left.location.register,left.location.register);
location_reset(location,LOC_FLAGS,OS_NO);
location.resflags:=F_E;
end;
else
internalerror(200203224);
end;
end;
end;
{$ifdef SUPPORT_MMX}
procedure tx86notnode.second_mmx;
var hreg,r:Tregister;
begin
secondpass(left);
location_reset(location,LOC_MMXREGISTER,OS_NO);
r:=cg.getintregister(exprasmlist,OS_INT);
emit_const_reg(A_MOV,S_L,longint($ffffffff),r);
{ load operand }
case left.location.loc of
LOC_MMXREGISTER:
location_copy(location,left.location);
LOC_CMMXREGISTER:
begin
location.register:=cg.getmmxregister(exprasmlist,OS_M64);
emit_reg_reg(A_MOVQ,S_NO,left.location.register,location.register);
end;
LOC_REFERENCE,
LOC_CREFERENCE:
begin
location_release(exprasmlist,left.location);
location.register:=cg.getmmxregister(exprasmlist,OS_M64);
emit_ref_reg(A_MOVQ,S_NO,left.location.reference,location.register);
end;
end;
{ load mask }
hreg:=cg.getmmxregister(exprasmlist,OS_M64);
emit_reg_reg(A_MOVD,S_NO,r,hreg);
cg.ungetregister(exprasmlist,r);
{ lower 32 bit }
emit_reg_reg(A_PXOR,S_D,hreg,location.register);
{ shift mask }
emit_const_reg(A_PSLLQ,S_NO,32,hreg);
{ higher 32 bit }
cg.ungetregister(exprasmlist,hreg);
emit_reg_reg(A_PXOR,S_D,hreg,location.register);
end;
{$endif SUPPORT_MMX}
end.
{
$Log$
Revision 1.1 2003-12-26 13:47:41 florian
Revision 1.2 2004-01-20 12:59:37 florian
* common addnode code for x86-64 and i386
Revision 1.1 2003/12/26 13:47:41 florian
* rtl and compiler compile with -Cfsse2
}

9
compiler/x86_64/cpunode.pas
View File

@ -46,13 +46,18 @@ unit cpunode;
// n386obj
{ the cpu specific node units must be used after the generic ones to
get the correct class pointer }
nx64cnv
nx64add,
nx64cnv,
nx64mat
;
end.
{
$Log$
Revision 1.4 2003-04-30 22:15:59 florian
Revision 1.5 2004-01-20 12:59:37 florian
* common addnode code for x86-64 and i386
Revision 1.4 2003/04/30 22:15:59 florian
* some 64 bit adaptions in ncgadd
* x86-64 now uses ncgadd
* tparamanager.ret_in_acc doesn't return true anymore for a void-def

97
compiler/x86_64/nx64add.pas Normal file
View File

@ -0,0 +1,97 @@
{
$Id$
Copyright (c) 2000-2002 by Florian Klaempfl
Code generation for add nodes on the x86-64
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 nx64add;
{$i fpcdefs.inc}
interface
uses
node,nadd,cpubase,nx86add;
type
tx8664addnode = class(tx86addnode)
procedure second_mul;override;
end;
implementation
uses
globtype,globals,
aasmbase,aasmtai,
cgbase,cga,cgobj;
{*****************************************************************************
MUL
*****************************************************************************}
procedure tx8664addnode.second_mul;
var r:Tregister;
hl4 : tasmlabel;
begin
{The location.register will be filled in later (JM)}
location_reset(location,LOC_REGISTER,OS_INT);
{Get a temp register and load the left value into it
and free the location.}
r:=cg.getintregister(exprasmlist,OS_INT);
cg.a_load_loc_reg(exprasmlist,OS_INT,left.location,r);
location_release(exprasmlist,left.location);
{Allocate EAX.}
cg.getexplicitregister(exprasmlist,NR_EAX);
{Load the right value.}
cg.a_load_loc_reg(exprasmlist,OS_INT,right.location,NR_EAX);
location_release(exprasmlist,right.location);
{The mul instruction frees register r.}
cg.ungetregister(exprasmlist,r);
{Also allocate EDX, since it is also modified by a mul (JM).}
cg.getexplicitregister(exprasmlist,NR_EDX);
emit_reg(A_MUL,S_L,r);
if cs_check_overflow in aktlocalswitches then
begin
objectlibrary.getlabel(hl4);
cg.a_jmp_flags(exprasmlist,F_AE,hl4);
cg.a_call_name(exprasmlist,'FPC_OVERFLOW');
cg.a_label(exprasmlist,hl4);
end;
{Free EDX}
cg.ungetregister(exprasmlist,NR_EDX);
{Free EAX}
cg.ungetregister(exprasmlist,NR_EAX);
{Allocate a new register and store the result in EAX in it.}
location.register:=cg.getintregister(exprasmlist,OS_INT);
emit_reg_reg(A_MOV,S_L,NR_EAX,location.register);
location_freetemp(exprasmlist,left.location);
location_freetemp(exprasmlist,right.location);
end;
begin
caddnode:=tx8664addnode;
end.
{
$Log$
Revision 1.1 2004-01-20 12:59:37 florian
* common addnode code for x86-64 and i386
}

216
compiler/x86_64/nx64mat.pas Normal file
View File

@ -0,0 +1,216 @@
{
$Id$
Copyright (c) 1998-2002 by Florian Klaempfl
Generate x86-64 assembler for math nodes
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 nx64mat;
{$i fpcdefs.inc}
interface
uses
node,nmat,ncgmat,nx86mat;
type
tx8664moddivnode = class(tmoddivnode)
procedure pass_2;override;
end;
tx8664shlshrnode = class(tshlshrnode)
procedure pass_2;override;
{ everything will be handled in pass_2 }
function first_shlshr64bitint: tnode; override;
end;
tx8664unaryminusnode = class(tx86unaryminusnode)
end;
implementation
uses
globtype,systems,
cutils,verbose,globals,
symconst,symdef,aasmbase,aasmtai,defutil,
cgbase,pass_1,pass_2,
ncon,
cpubase,cpuinfo,
cga,ncgutil,cgobj;
{*****************************************************************************
TX8664MODDIVNODE
*****************************************************************************}
procedure tx8664moddivnode.pass_2;
var
hreg1,hreg2:Tregister;
power:longint;
hl:Tasmlabel;
op:Tasmop;
begin
secondpass(left);
if codegenerror then
exit;
secondpass(right);
if codegenerror then
exit;
{ put numerator in register }
location_reset(location,LOC_REGISTER,OS_INT);
location_force_reg(exprasmlist,left.location,OS_INT,false);
hreg1:=left.location.register;
if (nodetype=divn) and (right.nodetype=ordconstn) and
ispowerof2(tordconstnode(right).value,power) then
begin
{ for signed numbers, the numerator must be adjusted before the
shift instruction, but not wih unsigned numbers! Otherwise,
"Cardinal($ffffffff) div 16" overflows! (JM) }
if is_signed(left.resulttype.def) Then
begin
{ use a sequence without jumps, saw this in
comp.compilers (JM) }
{ no jumps, but more operations }
hreg2:=cg.getintregister(exprasmlist,OS_INT);
emit_reg_reg(A_MOV,S_Q,hreg1,hreg2);
{If the left value is signed, hreg2=$ffffffff, otherwise 0.}
emit_const_reg(A_SAR,S_Q,63,hreg2);
{If signed, hreg2=right value-1, otherwise 0.}
emit_const_reg(A_AND,S_Q,tordconstnode(right).value-1,hreg2);
{ add to the left value }
emit_reg_reg(A_ADD,S_Q,hreg2,hreg1);
{ release EDX if we used it }
cg.ungetregister(exprasmlist,hreg2);
{ do the shift }
emit_const_reg(A_SAR,S_Q,power,hreg1);
end
else
emit_const_reg(A_SHR,S_Q,power,hreg1);
location.register:=hreg1;
end
else
begin
{Bring denominator to a register.}
cg.ungetregister(exprasmlist,hreg1);
cg.getexplicitregister(exprasmlist,NR_RAX);
emit_reg_reg(A_MOV,S_Q,hreg1,NR_RAX);
cg.getexplicitregister(exprasmlist,NR_RDX);
{Sign extension depends on the left type.}
if torddef(left.resulttype.def).typ=u64bit then
emit_reg_reg(A_XOR,S_L,NR_RDX,NR_RDX)
else
emit_none(A_CDQ,S_NO);
{Division depends on the right type.}
if Torddef(right.resulttype.def).typ=u64bit then
op:=A_DIV
else
op:=A_IDIV;
if right.location.loc in [LOC_REFERENCE,LOC_CREFERENCE] then
emit_ref(op,S_Q,right.location.reference)
else if right.location.loc in [LOC_REGISTER,LOC_CREGISTER] then
emit_reg(op,S_Q,right.location.register)
else
begin
hreg1:=cg.getintregister(exprasmlist,right.location.size);
cg.a_load_loc_reg(exprasmlist,OS_64,right.location,hreg1);
cg.ungetregister(exprasmlist,hreg1);
emit_reg(op,S_Q,hreg1);
end;
location_release(exprasmlist,right.location);
{ Copy the result into a new register. Release RAX & RDX.}
if nodetype=divn then
begin
cg.ungetregister(exprasmlist,NR_RDX);
cg.ungetregister(exprasmlist,NR_RAX);
location.register:=cg.getintregister(exprasmlist,OS_INT);
emit_reg_reg(A_MOV,S_Q,NR_RAX,location.register);
end
else
begin
cg.ungetregister(exprasmlist,NR_RAX);
cg.ungetregister(exprasmlist,NR_RDX);
location.register:=cg.getintregister(exprasmlist,OS_INT);
emit_reg_reg(A_MOV,S_Q,NR_RDX,location.register);
end;
end;
end;
{*****************************************************************************
TX8664SHLRSHRNODE
*****************************************************************************}
function tx8664shlshrnode.first_shlshr64bitint: tnode;
begin
result:=nil;
end;
procedure tx8664shlshrnode.pass_2;
var hregisterhigh,hregisterlow:Tregister;
op:Tasmop;
l1,l2,l3:Tasmlabel;
begin
secondpass(left);
secondpass(right);
{ determine operator }
if nodetype=shln then
op:=A_SHL
else
op:=A_SHR;
{ load left operators in a register }
location_copy(location,left.location);
location_force_reg(exprasmlist,location,OS_INT,false);
{ shifting by a constant directly coded: }
if (right.nodetype=ordconstn) then
{ l shl 32 should 0 imho, but neither TP nor Delphi do it in this way (FK)}
emit_const_reg(op,S_L,tordconstnode(right).value and 63,location.register)
else
begin
{ load right operators in a RCX }
if right.location.loc<>LOC_CREGISTER then
location_release(exprasmlist,right.location);
cg.getexplicitregister(exprasmlist,NR_RCX);
cg.a_load_loc_reg(exprasmlist,OS_64,right.location,NR_RCX);
{ right operand is in ECX }
cg.ungetregister(exprasmlist,NR_RCX);
emit_reg_reg(op,S_L,NR_CL,location.register);
end;
end;
begin
cunaryminusnode:=tx8664unaryminusnode;
cmoddivnode:=tx8664moddivnode;
cshlshrnode:=tx8664shlshrnode;
end.
{
$Log$
Revision 1.1 2004-01-20 12:59:37 florian
* common addnode code for x86-64 and i386
}