paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-11-04 15:39:24 +01:00
Code Issues Packages Projects Releases Wiki Activity

+ 64 bit operations (badly tested), everything is implemented now!

Browse Source 
* some small fixes
This commit is contained in:
Jonas Maebe 2002-07-28 16:02:49 +00:00
parent e3cbc3cf22
commit 046ee7bf2b
1 changed files with 192 additions and 237 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

357
compiler/powerpc/nppcadd.pas
View File

@ -34,7 +34,7 @@ interface
procedure pass_2;override; procedure pass_2;override;
private private
procedure pass_left_and_right; procedure pass_left_and_right;
procedure load_left_right(cmpop: boolean); procedure load_left_right(cmpop, load_constants: boolean);
procedure clear_left_right(cmpop: boolean); procedure clear_left_right(cmpop: boolean);
function getresflags : tresflags; function getresflags : tresflags;
procedure emit_compare(unsigned : boolean); procedure emit_compare(unsigned : boolean);
@ -44,7 +44,7 @@ interface
{$ifdef SUPPORT_MMX} {$ifdef SUPPORT_MMX}
procedure second_addmmx; procedure second_addmmx;
{$endif SUPPORT_MMX} {$endif SUPPORT_MMX}
procedure second_add64bit; virtual; abstract; procedure second_add64bit;
end; end;
implementation implementation
@ -95,31 +95,44 @@ interface
end; end;
procedure tppcaddnode.load_left_right(cmpop: boolean); procedure tppcaddnode.load_left_right(cmpop, load_constants: boolean);
procedure load_node(var n: tnode);
begin begin
case left.location.loc of case n.location.loc of
LOC_REGISTER: LOC_REGISTER:
if not cmpop then if not cmpop then
location.register := left.location.register; begin
location.register := n.location.register;
if is_64bitint(n.resulttype.def) then
location.registerhigh := n.location.registerhigh;
end;
LOC_REFERENCE,LOC_CREFERENCE: LOC_REFERENCE,LOC_CREFERENCE:
begin begin
location_force_reg(exprasmlist,left.location,def_cgsize(left.resulttype.def),false); location_force_reg(exprasmlist,n.location,def_cgsize(n.resulttype.def),false);
if not cmpop then if not cmpop then
location.register := left.location.register; location.register := n.location.register;
if is_64bitint(n.resulttype.def) then
location.registerhigh := n.location.registerhigh;
end; end;
end; LOC_CONSTANT:
case right.location.loc of
LOC_REGISTER:
if not cmpop then
location.register := right.location.register;
LOC_REFERENCE,LOC_CREFERENCE:
begin begin
location_force_reg(exprasmlist,right.location,def_cgsize(right.resulttype.def),false); if load_constants then
begin
location_force_reg(exprasmlist,n.location,def_cgsize(n.resulttype.def),false);
if not cmpop then if not cmpop then
location.register := right.location.register; location.register := n.location.register;
if is_64bitint(n.resulttype.def) then
location.registerhigh := n.location.registerhigh;
end; end;
end; end;
end; end;
end;
begin
load_node(left);
load_node(right);
end;
procedure tppcaddnode.clear_left_right(cmpop: boolean); procedure tppcaddnode.clear_left_right(cmpop: boolean);
@ -127,11 +140,19 @@ interface
if (right.location.loc in [LOC_REGISTER,LOC_FPUREGISTER]) and if (right.location.loc in [LOC_REGISTER,LOC_FPUREGISTER]) and
(cmpop or (cmpop or
(location.register <> right.location.register)) then (location.register <> right.location.register)) then
begin
rg.ungetregister(exprasmlist,right.location.register); rg.ungetregister(exprasmlist,right.location.register);
if is_64bitint(right.resulttype.def) then
rg.ungetregister(exprasmlist,right.location.registerhigh);
end;
if (left.location.loc in [LOC_REGISTER,LOC_FPUREGISTER]) and if (left.location.loc in [LOC_REGISTER,LOC_FPUREGISTER]) and
(cmpop or (cmpop or
(location.register <> left.location.register)) then (location.register <> left.location.register)) then
begin
rg.ungetregister(exprasmlist,left.location.register); rg.ungetregister(exprasmlist,left.location.register);
if is_64bitint(left.resulttype.def) then
rg.ungetregister(exprasmlist,left.location.registerhigh);
end;
end; end;
@ -162,6 +183,7 @@ interface
end end
end; end;
procedure tppcaddnode.emit_compare(unsigned: boolean); procedure tppcaddnode.emit_compare(unsigned: boolean);
var var
op : tasmop; op : tasmop;
@ -177,13 +199,12 @@ interface
begin begin
if (nodetype in [equaln,unequaln]) then if (nodetype in [equaln,unequaln]) then
if (unsigned and if (unsigned and
(right.location.value > high(aword))) or (right.location.value > high(word))) or
(not unsigned and (not unsigned and
((longint(right.location.value) < low(smallint)) or ((longint(right.location.value) < low(smallint)) or
(longint(right.location.value) > high(smallint)))) then (longint(right.location.value) > high(smallint)))) then
// we can then maybe use a constant in if we use a constant // we can then maybe use a constant in the 'othersigned' case
// for the 'othersigned' case and the sign doesn't matter in // (the sign doesn't matter for // equal/unequal)
// this case
unsigned := not unsigned; unsigned := not unsigned;
if (unsigned and if (unsigned and
@ -308,7 +329,7 @@ interface
else else
location_reset(location,LOC_FLAGS,OS_NO); location_reset(location,LOC_FLAGS,OS_NO);
load_left_right(cmpop); load_left_right(cmpop,false);
if (left.location.loc = LOC_CONSTANT) then if (left.location.loc = LOC_CONSTANT) then
swapleftright; swapleftright;
@ -507,7 +528,7 @@ interface
else else
location_reset(location,LOC_FLAGS,OS_NO); location_reset(location,LOC_FLAGS,OS_NO);
load_left_right(cmpop); load_left_right(cmpop,false);
if not(cmpop) and if not(cmpop) and
(location.register = R_NO) then (location.register = R_NO) then
@ -559,8 +580,7 @@ interface
right.location.value := not(right.location.value) right.location.value := not(right.location.value)
else else
opdone := true opdone := true
else else if (left.location.loc=LOC_CONSTANT) then
if (left.location.loc=LOC_CONSTANT) then
left.location.value := not(left.location.value) left.location.value := not(left.location.value)
else else
begin begin
@ -650,35 +670,60 @@ interface
Add64bit Add64bit
*****************************************************************************} *****************************************************************************}
(* procedure tppcaddnode.second_add64bit;
procedure ti386addnode.second_add64bit;
var var
op : TOpCG; op : TOpCG;
op1,op2 : TAsmOp; op1,op2 : TAsmOp;
opsize : TOpSize;
hregister,
hregister2 : tregister;
href : treference;
hl4 : tasmlabel; hl4 : tasmlabel;
mboverflow,
cmpop, cmpop,
unsigned : boolean; unsigned : boolean;
procedure emit_cmp64_hi;
var
oldleft, oldright: tlocation;
begin
// put the high part of the location in the low part
location_copy(oldleft,left.location);
location_copy(oldright,right.location);
if left.location.loc = LOC_CONSTANT then
left.location.value := left.location.value shr 32
else
left.location.registerlow := left.location.registerhigh;
if right.location.loc = LOC_CONSTANT then
right.location.value := right.location.value shr 32
else
right.location.registerlow := right.location.registerhigh;
// and call the normal emit_compare
emit_compare(unsigned);
location_copy(left.location,oldleft);
location_copy(right.location,oldright);
end;
procedure emit_cmp64_lo;
begin
emit_compare(true);
end;
procedure firstjmp64bitcmp; procedure firstjmp64bitcmp;
var var
oldnodetype : tnodetype; oldnodetype: tnodetype;
begin begin
load_all_regvars(exprasmlist); load_all_regvars(exprasmlist);
{ the jump the sequence is a little bit hairy } { the jump the sequence is a little bit hairy }
case nodetype of case nodetype of
ltn,gtn: ltn,gtn:
begin begin
emitjmp(flags_to_cond(getresflags(unsigned)),truelabel); cg.a_jmp_flags(exprasmlist,getresflags,truelabel);
{ cheat a little bit for the negative test } { cheat a little bit for the negative test }
toggleflag(nf_swaped); toggleflag(nf_swaped);
emitjmp(flags_to_cond(getresflags(unsigned)),falselabel); cg.a_jmp_flags(exprasmlist,getresflags,falselabel);
toggleflag(nf_swaped); toggleflag(nf_swaped);
end; end;
lten,gten: lten,gten:
@ -688,19 +733,27 @@ interface
nodetype:=ltn nodetype:=ltn
else else
nodetype:=gtn; nodetype:=gtn;
emitjmp(flags_to_cond(getresflags(unsigned)),truelabel); cg.a_jmp_flags(exprasmlist,getresflags,truelabel);
{ cheat for the negative test } { cheat for the negative test }
if nodetype=ltn then if nodetype=ltn then
nodetype:=gtn nodetype:=gtn
else else
nodetype:=ltn; nodetype:=ltn;
emitjmp(flags_to_cond(getresflags(unsigned)),falselabel); cg.a_jmp_flags(exprasmlist,getresflags,falselabel);
nodetype:=oldnodetype; nodetype:=oldnodetype;
end; end;
equaln: equaln:
emitjmp(C_NE,falselabel); begin
nodetype := unequaln;
cg.a_jmp_flags(exprasmlist,getresflags,falselabel);
nodetype := equaln;
end;
unequaln: unequaln:
emitjmp(C_NE,truelabel); begin
nodetype := equaln;
cg.a_jmp_flags(exprasmlist,getresflags,truelabel);
nodetype := unequaln;
end;
end; end;
end; end;
@ -714,17 +767,19 @@ interface
begin begin
{ the comparisaion of the low dword have to be } { the comparisaion of the low dword have to be }
{ always unsigned! } { always unsigned! }
emitjmp(flags_to_cond(getresflags(true)),truelabel); cg.a_jmp_flags(exprasmlist,getresflags,truelabel);
cg.a_jmp_always(exprasmlist,falselabel); cg.a_jmp_always(exprasmlist,falselabel);
end; end;
equaln: equaln:
begin begin
emitjmp(C_NE,falselabel); nodetype := unequaln;
cg.a_jmp_flags(exprasmlist,getresflags,falselabel);
cg.a_jmp_always(exprasmlist,truelabel); cg.a_jmp_always(exprasmlist,truelabel);
nodetype := equaln;
end; end;
unequaln: unequaln:
begin begin
emitjmp(C_NE,truelabel); cg.a_jmp_flags(exprasmlist,getresflags,truelabel);
cg.a_jmp_always(exprasmlist,falselabel); cg.a_jmp_always(exprasmlist,falselabel);
end; end;
end; end;
@ -735,11 +790,7 @@ interface
pass_left_and_right; pass_left_and_right;
op1:=A_NONE;
op2:=A_NONE;
mboverflow:=false;
cmpop:=false; cmpop:=false;
opsize:=S_L;
unsigned:=((left.resulttype.def.deftype=orddef) and unsigned:=((left.resulttype.def.deftype=orddef) and
(torddef(left.resulttype.def).typ=u64bit)) or (torddef(left.resulttype.def).typ=u64bit)) or
((right.resulttype.def.deftype=orddef) and ((right.resulttype.def.deftype=orddef) and
@ -748,14 +799,10 @@ interface
addn : addn :
begin begin
op:=OP_ADD; op:=OP_ADD;
mboverflow:=true;
end; end;
subn : subn :
begin begin
op:=OP_SUB; op:=OP_SUB;
op1:=A_SUB;
op2:=A_SBB;
mboverflow:=true;
end; end;
ltn,lten, ltn,lten,
gtn,gten, gtn,gten,
@ -776,163 +823,86 @@ interface
internalerror(200109051); internalerror(200109051);
end; end;
else else
CGMessage(type_e_mismatch); internalerror(2002072705);
end; end;
{ left and right no register? } { set result location }
{ then one must be demanded } if not cmpop then
if (left.location.loc<>LOC_REGISTER) then location_reset(location,LOC_REGISTER,def_cgsize(resulttype.def))
begin
if (right.location.loc<>LOC_REGISTER) then
begin
{ we can reuse a CREGISTER for comparison }
if not((left.location.loc=LOC_CREGISTER) and cmpop) then
begin
if (left.location.loc<>LOC_CREGISTER) then
begin
location_freetemp(exprasmlist,left.location);
location_release(exprasmlist,left.location);
end;
hregister:=rg.getregisterint(exprasmlist);
hregister2:=rg.getregisterint(exprasmlist);
cg64.a_load64_loc_reg(exprasmlist,left.location,joinreg64(hregister,hregister2));
location_reset(left.location,LOC_REGISTER,OS_64);
left.location.registerlow:=hregister;
left.location.registerhigh:=hregister2;
end;
end
else else
location_reset(location,LOC_JUMP,OS_NO);
load_left_right(cmpop,(cs_check_overflow in aktlocalswitches) and
(nodetype in [addn,subn]));
// can't do much with a constant on the left side here
if (nodetype = subn) then
begin begin
location_swap(left.location,right.location); if (nf_swaped in flags) then
toggleflag(nf_swaped); swapleftright;
if left.location.loc = LOC_CONSTANT then
begin
location_force_reg(exprasmlist,left.location,
def_cgsize(left.resulttype.def),false);
location.register64 := left.location.register64;
end; end;
end; end;
{ at this point, left.location.loc should be LOC_REGISTER } if not(cs_check_overflow in aktlocalswitches) or
if right.location.loc=LOC_REGISTER then not(nodetype in [addn,subn]) then
begin begin
{ when swapped another result register } case nodetype of
if (nodetype=subn) and (nf_swaped in flags) then ltn,lten,
gtn,gten,
equaln,unequaln:
begin begin
cg64.a_op64_reg_reg(exprasmlist,op, emit_cmp64_hi;
left.location.register64,
right.location.register64);
location_swap(left.location,right.location);
toggleflag(nf_swaped);
end
else if cmpop then
begin
emit_reg_reg(A_CMP,S_L,right.location.registerhigh,left.location.registerhigh);
firstjmp64bitcmp; firstjmp64bitcmp;
emit_reg_reg(A_CMP,S_L,right.location.registerlow,left.location.registerlow); emit_cmp64_lo;
secondjmp64bitcmp;
end
else
begin
cg64.a_op64_reg_reg(exprasmlist,op,
right.location.register64,
left.location.register64);
end;
location_release(exprasmlist,right.location);
end
else
begin
{ right.location<>LOC_REGISTER }
if (nodetype=subn) and (nf_swaped in flags) then
begin
rg.getexplicitregisterint(exprasmlist,R_EDI);
cg64.a_load64low_loc_reg(exprasmlist,right.location,R_EDI);
emit_reg_reg(op1,opsize,left.location.registerlow,R_EDI);
emit_reg_reg(A_MOV,opsize,R_EDI,left.location.registerlow);
cg64.a_load64high_loc_reg(exprasmlist,right.location,R_EDI);
{ the carry flag is still ok }
emit_reg_reg(op2,opsize,left.location.registerhigh,R_EDI);
emit_reg_reg(A_MOV,opsize,R_EDI,left.location.registerhigh);
rg.ungetregisterint(exprasmlist,R_EDI);
if right.location.loc<>LOC_CREGISTER then
begin
location_freetemp(exprasmlist,right.location);
location_release(exprasmlist,right.location);
end;
end
else if cmpop then
begin
case right.location.loc of
LOC_CREGISTER :
begin
emit_reg_reg(A_CMP,S_L,right.location.registerhigh,left.location.registerhigh);
firstjmp64bitcmp;
emit_reg_reg(A_CMP,S_L,right.location.registerlow,left.location.registerlow);
secondjmp64bitcmp; secondjmp64bitcmp;
end; end;
LOC_CREFERENCE, xorn,orn,andn,addn,subn:
LOC_REFERENCE :
begin begin
href:=right.location.reference; if left.location.loc = LOC_CONSTANT then
inc(href.offset,4); swapleftright;
emit_ref_reg(A_CMP,S_L,href,left.location.registerhigh); if (right.location.loc = LOC_CONSTANT) then
firstjmp64bitcmp; cg64.a_op64_const_reg_reg(exprasmlist,op,right.location.value,
emit_ref_reg(A_CMP,S_L,right.location.reference,left.location.registerlow); left.location.register64,location.register64)
secondjmp64bitcmp; else
cg.a_jmp_always(exprasmlist,falselabel); cg64.a_op64_reg_reg_reg(exprasmlist,op,right.location.register64,
location_freetemp(exprasmlist,right.location); left.location.register64,location.register64);
location_release(exprasmlist,right.location);
end;
LOC_CONSTANT :
begin
exprasmlist.concat(taicpu.op_const_reg(A_CMP,S_L,right.location.valuehigh,left.location.registerhigh));
firstjmp64bitcmp;
exprasmlist.concat(taicpu.op_const_reg(A_CMP,S_L,right.location.valuelow,left.location.registerlow));
secondjmp64bitcmp;
end; end;
else else
internalerror(200203282); internalerror(2002072803);
end; end;
end end
else else
begin begin
cg64.a_op64_loc_reg(exprasmlist,op,right.location, case nodetype of
left.location.register64); addn:
if (right.location.loc<>LOC_CREGISTER) then
begin begin
location_freetemp(exprasmlist,right.location); op1 := A_ADDC;
location_release(exprasmlist,right.location); op2 := A_ADDZEO;
end; end;
end; subn:
end;
if (left.location.loc<>LOC_CREGISTER) and cmpop then
begin begin
location_freetemp(exprasmlist,left.location); op1 := A_SUBC;
location_release(exprasmlist,left.location); op2 := A_SUBFMEO;
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
getlabel(hl4);
if unsigned then
emitjmp(C_NB,hl4)
else else
emitjmp(C_NO,hl4); internalerror(2002072806);
cg.a_call_name(exprasmlist,'FPC_OVERFLOW');
cg.a_label(exprasmlist,hl4);
end; end;
exprasmlist.concat(taicpu.op_reg_reg_reg(op1,location.registerlow,
left.location.registerlow,right.location.registerlow));
exprasmlist.concat(taicpu.op_reg_reg_reg(op2,location.registerhigh,
right.location.registerhigh,left.location.registerhigh));
cg.g_overflowcheck(exprasmlist,self);
end; end;
{ we have LOC_JUMP as result } clear_left_right(cmpop);
if cmpop then
location_reset(location,LOC_JUMP,OS_NO)
else
location_copy(location,left.location);
end; end;
*)
{***************************************************************************** {*****************************************************************************
@ -1209,28 +1179,8 @@ interface
else else
location_reset(location,LOC_FLAGS,OS_NO); location_reset(location,LOC_FLAGS,OS_NO);
load_left_right(cmpop); load_left_right(cmpop, (cs_check_overflow in aktlocalswitches) and
(nodetype in [addn,subn,muln]));
// when overflow checking is on, all operands have to be in
// a register
if (cs_check_overflow in aktlocalswitches) and
not cmpop and
not (nodetype in [orn,andn,xorn]) then
begin
{ left and right can't be both constants }
if (left.location.loc = LOC_CONSTANT) then
begin
location_force_reg(exprasmlist,left.location,
def_cgsize(left.resulttype.def),false);
location.register := left.location.register;
end
else if (right.location.loc = LOC_CONSTANT) then
begin
location_force_reg(exprasmlist,right.location,
def_cgsize(right.resulttype.def),false);
location.register := right.location.register;
end;
end;
if (location.register = R_NO) and if (location.register = R_NO) and
not(cmpop) then not(cmpop) then
@ -1321,6 +1271,7 @@ interface
end; end;
exprasmlist.concat(taicpu.op_reg_reg_reg(op,location.register, exprasmlist.concat(taicpu.op_reg_reg_reg(op,location.register,
left.location.register,right.location.register)); left.location.register,right.location.register));
cg.g_overflowcheck(exprasmlist,self);
end; end;
clear_left_right(cmpop); clear_left_right(cmpop);
@ -1331,7 +1282,11 @@ begin
end. end.
{ {
$Log$ $Log$
Revision 1.2 2002-07-27 20:00:59 jonas Revision 1.3 2002-07-28 16:02:49 jonas
+ 64 bit operations (badly tested), everything is implemented now!
* some small fixes
Revision 1.2 2002/07/27 20:00:59 jonas
+ second_addboolean(), second_addfloat() and second_addsmallset() + second_addboolean(), second_addfloat() and second_addsmallset()
(64bit stuff is all that's left to do) (64bit stuff is all that's left to do)