fpc/compiler/cg386add.pas
2000-07-13 06:29:38 +00:00

2497 lines
115 KiB
ObjectPascal
Raw Blame History

{
$Id$
Copyright (c) 1998-2000 by Florian Klaempfl
Generate i386 assembler for in add node
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.
****************************************************************************
}
{$ifdef FPC}
{$goto on}
{$endif FPC}
unit cg386add;
interface
{$define usecreateset}
uses
tree;
procedure secondadd(var p : ptree);
implementation
uses
globtype,systems,
cobjects,verbose,globals,
symconst,symtable,aasm,types,
hcodegen,temp_gen,pass_2,
cpubase,cpuasm,
cgai386,tgeni386;
{*****************************************************************************
Helpers
*****************************************************************************}
procedure locflags2reg(var l:tlocation;opsize:topsize);
var
hregister : tregister;
begin
if (l.loc=LOC_FLAGS) then
begin
case opsize of
S_L : hregister:=getregister32;
S_W : hregister:=reg32toreg16(getregister32);
S_B : hregister:=reg32toreg8(getregister32);
end;
emit_flag2reg(l.resflags,hregister);
l.loc:=LOC_REGISTER;
l.register:=hregister;
end;
end;
function getresflags(p : ptree;unsigned : boolean) : tresflags;
begin
if not(unsigned) then
begin
if p^.swaped then
case p^.treetype of
equaln : getresflags:=F_E;
unequaln : getresflags:=F_NE;
ltn : getresflags:=F_G;
lten : getresflags:=F_GE;
gtn : getresflags:=F_L;
gten : getresflags:=F_LE;
end
else
case p^.treetype of
equaln : getresflags:=F_E;
unequaln : getresflags:=F_NE;
ltn : getresflags:=F_L;
lten : getresflags:=F_LE;
gtn : getresflags:=F_G;
gten : getresflags:=F_GE;
end;
end
else
begin
if p^.swaped then
case p^.treetype of
equaln : getresflags:=F_E;
unequaln : getresflags:=F_NE;
ltn : getresflags:=F_A;
lten : getresflags:=F_AE;
gtn : getresflags:=F_B;
gten : getresflags:=F_BE;
end
else
case p^.treetype of
equaln : getresflags:=F_E;
unequaln : getresflags:=F_NE;
ltn : getresflags:=F_B;
lten : getresflags:=F_BE;
gtn : getresflags:=F_A;
gten : getresflags:=F_AE;
end;
end;
end;
procedure SetResultLocation(cmpop,unsigned:boolean;var p :ptree);
begin
{ remove temporary location if not a set or string }
{ that's a bad hack (FK) who did this ? }
if (p^.left^.resulttype^.deftype<>stringdef) and
((p^.left^.resulttype^.deftype<>setdef) or (psetdef(p^.left^.resulttype)^.settype=smallset)) and
(p^.left^.location.loc in [LOC_MEM,LOC_REFERENCE]) then
ungetiftemp(p^.left^.location.reference);
if (p^.right^.resulttype^.deftype<>stringdef) and
((p^.right^.resulttype^.deftype<>setdef) or (psetdef(p^.right^.resulttype)^.settype=smallset)) and
(p^.right^.location.loc in [LOC_MEM,LOC_REFERENCE]) then
ungetiftemp(p^.right^.location.reference);
{ in case of comparison operation the put result in the flags }
if cmpop then
begin
clear_location(p^.location);
p^.location.loc:=LOC_FLAGS;
p^.location.resflags:=getresflags(p,unsigned);
end;
end;
{*****************************************************************************
Addstring
*****************************************************************************}
procedure addstring(var p : ptree);
var
{$ifdef newoptimizations2}
l: pasmlabel;
hreg: tregister;
href2: preference;
oldregisterdef: boolean;
{$endif newoptimizations2}
pushedregs : tpushed;
href : treference;
pushed,
cmpop : boolean;
regstopush : byte;
begin
{ string operations are not commutative }
if p^.swaped then
swaptree(p);
case pstringdef(p^.left^.resulttype)^.string_typ of
st_ansistring:
begin
case p^.treetype of
addn:
begin
cmpop:=false;
secondpass(p^.left);
{ to avoid problem with maybe_push and restore }
set_location(p^.location,p^.left^.location);
pushed:=maybe_push(p^.right^.registers32,p,false);
secondpass(p^.right);
if pushed then
begin
restore(p,false);
set_location(p^.left^.location,p^.location);
end;
{ get the temp location, must be done before regs are
released/pushed because after the release the regs are
still used for the push (PFV) }
clear_location(p^.location);
p^.location.loc:=LOC_MEM;
gettempansistringreference(p^.location.reference);
decrstringref(cansistringdef,p^.location.reference);
{ release used registers }
del_location(p^.right^.location);
del_location(p^.left^.location);
{ push the still used registers }
pushusedregisters(pushedregs,$ff);
{ push data }
emitpushreferenceaddr(p^.location.reference);
emit_push_loc(p^.right^.location);
emit_push_loc(p^.left^.location);
emitcall('FPC_ANSISTR_CONCAT');
popusedregisters(pushedregs);
maybe_loadesi;
ungetiftempansi(p^.left^.location.reference);
ungetiftempansi(p^.right^.location.reference);
end;
ltn,lten,gtn,gten,
equaln,unequaln:
begin
cmpop:=true;
if (p^.treetype in [equaln,unequaln]) and
(p^.left^.treetype=stringconstn) and
(p^.left^.length=0) then
begin
secondpass(p^.right);
{ release used registers }
del_location(p^.right^.location);
del_location(p^.left^.location);
case p^.right^.location.loc of
LOC_REFERENCE,LOC_MEM:
emit_const_ref(A_CMP,S_L,0,newreference(p^.right^.location.reference));
LOC_REGISTER,LOC_CREGISTER:
emit_const_reg(A_CMP,S_L,0,p^.right^.location.register);
end;
ungetiftempansi(p^.left^.location.reference);
ungetiftempansi(p^.right^.location.reference);
end
else if (p^.treetype in [equaln,unequaln]) and
(p^.right^.treetype=stringconstn) and
(p^.right^.length=0) then
begin
secondpass(p^.left);
{ release used registers }
del_location(p^.right^.location);
del_location(p^.left^.location);
case p^.right^.location.loc of
LOC_REFERENCE,LOC_MEM:
emit_const_ref(A_CMP,S_L,0,newreference(p^.left^.location.reference));
LOC_REGISTER,LOC_CREGISTER:
emit_const_reg(A_CMP,S_L,0,p^.left^.location.register);
end;
ungetiftempansi(p^.left^.location.reference);
ungetiftempansi(p^.right^.location.reference);
end
else
begin
secondpass(p^.left);
pushed:=maybe_push(p^.right^.registers32,p^.left,false);
secondpass(p^.right);
if pushed then
restore(p^.left,false);
{ release used registers }
del_location(p^.right^.location);
del_location(p^.left^.location);
{ push the still used registers }
pushusedregisters(pushedregs,$ff);
{ push data }
case p^.right^.location.loc of
LOC_REFERENCE,LOC_MEM:
emit_push_mem(p^.right^.location.reference);
LOC_REGISTER,LOC_CREGISTER:
emit_reg(A_PUSH,S_L,p^.right^.location.register);
end;
case p^.left^.location.loc of
LOC_REFERENCE,LOC_MEM:
emit_push_mem(p^.left^.location.reference);
LOC_REGISTER,LOC_CREGISTER:
emit_reg(A_PUSH,S_L,p^.left^.location.register);
end;
emitcall('FPC_ANSISTR_COMPARE');
emit_reg_reg(A_OR,S_L,R_EAX,R_EAX);
popusedregisters(pushedregs);
maybe_loadesi;
ungetiftempansi(p^.left^.location.reference);
ungetiftempansi(p^.right^.location.reference);
end;
end;
end;
{ the result of ansicompare is signed }
SetResultLocation(cmpop,false,p);
end;
st_shortstring:
begin
case p^.treetype of
addn:
begin
cmpop:=false;
secondpass(p^.left);
{ if str_concat is set in expr
s:=s+ ... no need to create a temp string (PM) }
if (p^.left^.treetype<>addn) and not (p^.use_strconcat) then
begin
{ can only reference be }
{ string in register would be funny }
{ therefore produce a temporary string }
gettempofsizereference(256,href);
copyshortstring(href,p^.left^.location.reference,255,false,true);
{ release the registers }
{ done by copyshortstring now (JM) }
{ del_reference(p^.left^.location.reference); }
ungetiftemp(p^.left^.location.reference);
{ does not hurt: }
clear_location(p^.left^.location);
p^.left^.location.loc:=LOC_MEM;
p^.left^.location.reference:=href;
{$ifdef newoptimizations2}
{ length of temp string = 255 (JM) }
{ *** redefining a type is not allowed!! (thanks, Pierre) }
{ also problem with constant string! }
pstringdef(p^.left^.resulttype)^.len := 255;
{$endif newoptimizations2}
end;
secondpass(p^.right);
{$ifdef newoptimizations2}
{ special case for string := string + char (JM) }
{ needs string length stuff from above! }
hreg := R_NO;
if is_shortstring(p^.left^.resulttype) and
is_char(p^.right^.resulttype) then
begin
getlabel(l);
getexplicitregister32(R_EDI);
{ load the current string length }
emit_ref_reg(A_MOVZX,S_BL,
newreference(p^.left^.location.reference),R_EDI);
{ is it already maximal? }
emit_const_reg(A_CMP,S_L,
pstringdef(p^.left^.resulttype)^.len,R_EDI);
emitjmp(C_E,l);
{ no, so add the new character }
{ is it a constant char? }
if (p^.right^.treetype <> ordconstn) then
{ no, make sure it is in a register }
if p^.right^.location.loc in [LOC_REFERENCE,LOC_MEM] then
begin
{ free the registers of p^.right }
del_reference(p^.right^.location.reference);
{ get register for the char }
hreg := reg32toreg8(getregister32);
emit_ref_reg(A_MOV,S_B,
newreference(p^.right^.location.reference),
hreg);
{ I don't think a temp char exists, but it won't hurt (JM)<29>}
ungetiftemp(p^.right^.location.reference);
end
else hreg := p^.right^.location.register;
href2 := newreference(p^.left^.location.reference);
{ we need a new reference to store the character }
{ at the end of the string. Check if the base or }
{ index register is still free }
if (p^.left^.location.reference.base <> R_NO) and
(p^.left^.location.reference.index <> R_NO) then
begin
{ they're not free, so add the base reg to }
{ the string length (since the index can }
{ have a scalefactor) and use EDI as base }
emit_reg_reg(A_ADD,S_L,
p^.left^.location.reference.base,R_EDI);
href2^.base := R_EDI;
end
else
{ at least one is still free, so put EDI there }
if href2^.base = R_NO then
href2^.base := R_EDI
else
begin
href2^.index := R_EDI;
href2^.scalefactor := 1;
end;
{ we need to be one position after the last char }
inc(href2^.offset);
{ increase the string length }
emit_ref(A_INC,S_B,newreference(p^.left^.location.reference));
{ and store the character at the end of the string }
if (p^.right^.treetype <> ordconstn) then
begin
{ no new_reference(href2) because it's only }
{ used once (JM) }
emit_reg_ref(A_MOV,S_B,hreg,href2);
ungetregister(hreg);
end
else
emit_const_ref(A_MOV,S_B,p^.right^.value,href2);
emitlab(l);
ungetregister32(R_EDI);
end
else
begin
{$endif newoptimizations2}
{ on the right we do not need the register anymore too }
{ Instead of releasing them already, simply do not }
{ push them (so the release is in the right place, }
{ because emitpushreferenceaddr doesn't need extra }
{ registers) (JM) }
regstopush := $ff;
remove_non_regvars_from_loc(p^.right^.location,
regstopush);
pushusedregisters(pushedregs,regstopush);
{ push the maximum possible length of the result }
{$ifdef newoptimizations2}
{ string (could be < 255 chars now) (JM) }
emit_const(A_PUSH,S_L,
pstringdef(p^.left^.resulttype)^.len);
{$endif newoptimizations2}
emitpushreferenceaddr(p^.left^.location.reference);
{ the optimizer can more easily put the }
{ deallocations in the right place if it happens }
{ too early than when it happens too late (if }
{ the pushref needs a "lea (..),edi; push edi") }
del_reference(p^.right^.location.reference);
emitpushreferenceaddr(p^.right^.location.reference);
{$ifdef newoptimizations2}
emitcall('FPC_SHORTSTR_CONCAT_LEN');
{$else newoptimizations2}
emitcall('FPC_SHORTSTR_CONCAT');
{$endif newoptimizations2}
ungetiftemp(p^.right^.location.reference);
maybe_loadesi;
popusedregisters(pushedregs);
{$ifdef newoptimizations2}
end;
{$endif newoptimizations2}
set_location(p^.location,p^.left^.location);
end;
ltn,lten,gtn,gten,
equaln,unequaln :
begin
cmpop:=true;
{ generate better code for s='' and s<>'' }
if (p^.treetype in [equaln,unequaln]) and
(((p^.left^.treetype=stringconstn) and (str_length(p^.left)=0)) or
((p^.right^.treetype=stringconstn) and (str_length(p^.right)=0))) then
begin
secondpass(p^.left);
{ are too few registers free? }
pushed:=maybe_push(p^.right^.registers32,p^.left,false);
secondpass(p^.right);
if pushed then
restore(p^.left,false);
{ only one node can be stringconstn }
{ else pass 1 would have evaluted }
{ this node }
if p^.left^.treetype=stringconstn then
emit_const_ref(
A_CMP,S_B,0,newreference(p^.right^.location.reference))
else
emit_const_ref(
A_CMP,S_B,0,newreference(p^.left^.location.reference));
del_reference(p^.right^.location.reference);
del_reference(p^.left^.location.reference);
end
else
begin
pushusedregisters(pushedregs,$ff);
secondpass(p^.left);
emitpushreferenceaddr(p^.left^.location.reference);
del_reference(p^.left^.location.reference);
secondpass(p^.right);
emitpushreferenceaddr(p^.right^.location.reference);
del_reference(p^.right^.location.reference);
emitcall('FPC_SHORTSTR_COMPARE');
maybe_loadesi;
popusedregisters(pushedregs);
end;
ungetiftemp(p^.left^.location.reference);
ungetiftemp(p^.right^.location.reference);
end;
else CGMessage(type_e_mismatch);
end;
SetResultLocation(cmpop,true,p);
end;
end;
end;
{*****************************************************************************
Addset
*****************************************************************************}
procedure addset(var p : ptree);
var
createset,
cmpop,
pushed : boolean;
href : treference;
pushedregs : tpushed;
regstopush: byte;
begin
cmpop:=false;
{ not commutative }
if p^.swaped then
swaptree(p);
{ optimize first loading of a set }
{$ifdef usecreateset}
if (p^.right^.treetype=setelementn) and
not(assigned(p^.right^.right)) and
is_emptyset(p^.left) then
createset:=true
else
{$endif}
begin
createset:=false;
secondpass(p^.left);
end;
{ are too few registers free? }
pushed:=maybe_push(p^.right^.registers32,p^.left,false);
secondpass(p^.right);
if codegenerror then
exit;
if pushed then
restore(p^.left,false);
set_location(p^.location,p^.left^.location);
{ handle operations }
case p^.treetype of
equaln,
unequaln
{$IfNDef NoSetInclusion}
,lten, gten
{$EndIf NoSetInclusion}
: begin
cmpop:=true;
del_location(p^.left^.location);
del_location(p^.right^.location);
pushusedregisters(pushedregs,$ff);
{$IfNDef NoSetInclusion}
If (p^.treetype in [equaln, unequaln, lten]) Then
Begin
{$EndIf NoSetInclusion}
emitpushreferenceaddr(p^.right^.location.reference);
emitpushreferenceaddr(p^.left^.location.reference);
{$IfNDef NoSetInclusion}
End
Else {gten = lten, if the arguments are reversed}
Begin
emitpushreferenceaddr(p^.left^.location.reference);
emitpushreferenceaddr(p^.right^.location.reference);
End;
Case p^.treetype of
equaln, unequaln:
{$EndIf NoSetInclusion}
emitcall('FPC_SET_COMP_SETS');
{$IfNDef NoSetInclusion}
lten, gten:
Begin
emitcall('FPC_SET_CONTAINS_SETS');
{ we need a jne afterwards, not a jnbe/jnae }
p^.treetype := equaln;
End;
End;
{$EndIf NoSetInclusion}
maybe_loadesi;
popusedregisters(pushedregs);
ungetiftemp(p^.left^.location.reference);
ungetiftemp(p^.right^.location.reference);
end;
addn : begin
{ add can be an other SET or Range or Element ! }
{ del_location(p^.right^.location);
done in pushsetelement below PM
And someone added it again because those registers must
not be pushed by the pushusedregisters, however this
breaks the optimizer (JM)
del_location(p^.right^.location);
pushusedregisters(pushedregs,$ff);}
regstopush := $ff;
remove_non_regvars_from_loc(p^.right^.location,regstopush);
remove_non_regvars_from_loc(p^.left^.location,regstopush);
pushusedregisters(pushedregs,regstopush);
{ this is still right before the instruction that uses }
{ p^.left^.location, but that can be fixed by the }
{ optimizer. There must never be an additional }
{ between the release and the use, because that is not }
{ detected/fixed. As Pierre said above, p^.right^.loc }
{ will be released in pushsetelement (JM) }
del_location(p^.left^.location);
href.symbol:=nil;
gettempofsizereference(32,href);
if createset then
begin
pushsetelement(p^.right^.left);
emitpushreferenceaddr(href);
emitcall('FPC_SET_CREATE_ELEMENT');
end
else
begin
{ add a range or a single element? }
if p^.right^.treetype=setelementn then
begin
{$IfNDef regallocfix}
concatcopy(p^.left^.location.reference,href,32,false,false);
{$Else regallocfix}
concatcopy(p^.left^.location.reference,href,32,true,false);
{$EndIf regallocfix}
if assigned(p^.right^.right) then
begin
pushsetelement(p^.right^.right);
pushsetelement(p^.right^.left);
emitpushreferenceaddr(href);
emitcall('FPC_SET_SET_RANGE');
end
else
begin
pushsetelement(p^.right^.left);
emitpushreferenceaddr(href);
emitcall('FPC_SET_SET_BYTE');
end;
end
else
begin
{ must be an other set }
emitpushreferenceaddr(href);
emitpushreferenceaddr(p^.right^.location.reference);
{$IfDef regallocfix}
del_location(p^.right^.location);
{$EndIf regallocfix}
emitpushreferenceaddr(p^.left^.location.reference);
{$IfDef regallocfix}
del_location(p^.left^.location);
{$EndIf regallocfix}
emitcall('FPC_SET_ADD_SETS');
end;
end;
maybe_loadesi;
popusedregisters(pushedregs);
ungetiftemp(p^.left^.location.reference);
ungetiftemp(p^.right^.location.reference);
p^.location.loc:=LOC_MEM;
p^.location.reference:=href;
end;
subn,
symdifn,
muln : begin
{ Find out which registers have to pushed (JM) }
regstopush := $ff;
remove_non_regvars_from_loc(p^.left^.location,regstopush);
remove_non_regvars_from_loc(p^.right^.location,regstopush);
{ Push them (JM) }
pushusedregisters(pushedregs,regstopush);
href.symbol:=nil;
gettempofsizereference(32,href);
emitpushreferenceaddr(href);
{ Release the registers right before they're used, }
{ see explanation in cgai386.pas:loadansistring for }
{ info why this is done right before the push (JM) }
del_location(p^.right^.location);
emitpushreferenceaddr(p^.right^.location.reference);
{ The same here }
del_location(p^.left^.location);
emitpushreferenceaddr(p^.left^.location.reference);
case p^.treetype of
subn : emitcall('FPC_SET_SUB_SETS');
symdifn : emitcall('FPC_SET_SYMDIF_SETS');
muln : emitcall('FPC_SET_MUL_SETS');
end;
maybe_loadesi;
popusedregisters(pushedregs);
ungetiftemp(p^.left^.location.reference);
ungetiftemp(p^.right^.location.reference);
p^.location.loc:=LOC_MEM;
p^.location.reference:=href;
end;
else
CGMessage(type_e_mismatch);
end;
SetResultLocation(cmpop,true,p);
end;
{*****************************************************************************
SecondAdd
*****************************************************************************}
procedure secondadd(var p : ptree);
{ is also being used for xor, and "mul", "sub, or and comparative }
{ operators }
label do_normal;
var
hregister,hregister2 : tregister;
noswap,popeax,popedx,
pushed,mboverflow,cmpop : boolean;
op,op2 : tasmop;
flags : tresflags;
otl,ofl,hl : pasmlabel;
power : longint;
opsize : topsize;
hl4: pasmlabel;
hr : preference;
{ true, if unsigned types are compared }
unsigned : boolean;
{ true, if a small set is handled with the longint code }
is_set : 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;
{$ifdef SUPPORT_MMX}
mmxbase : tmmxtype;
{$endif SUPPORT_MMX}
pushedreg : tpushed;
hloc : tlocation;
regstopush: byte;
procedure firstjmp64bitcmp;
var
oldtreetype : ttreetyp;
begin
{ the jump the sequence is a little bit hairy }
case p^.treetype of
ltn,gtn:
begin
emitjmp(flag_2_cond[getresflags(p,unsigned)],truelabel);
{ cheat a little bit for the negative test }
p^.swaped:=not(p^.swaped);
emitjmp(flag_2_cond[getresflags(p,unsigned)],falselabel);
p^.swaped:=not(p^.swaped);
end;
lten,gten:
begin
oldtreetype:=p^.treetype;
if p^.treetype=lten then
p^.treetype:=ltn
else
p^.treetype:=gtn;
emitjmp(flag_2_cond[getresflags(p,unsigned)],truelabel);
{ cheat for the negative test }
if p^.treetype=ltn then
p^.treetype:=gtn
else
p^.treetype:=ltn;
emitjmp(flag_2_cond[getresflags(p,unsigned)],falselabel);
p^.treetype:=oldtreetype;
end;
equaln:
emitjmp(C_NE,falselabel);
unequaln:
emitjmp(C_NE,truelabel);
end;
end;
procedure secondjmp64bitcmp;
begin
{ the jump the sequence is a little bit hairy }
case p^.treetype of
ltn,gtn,lten,gten:
begin
{ the comparisaion of the low dword have to be }
{ always unsigned! }
emitjmp(flag_2_cond[getresflags(p,true)],truelabel);
emitjmp(C_None,falselabel);
end;
equaln:
begin
emitjmp(C_NE,falselabel);
emitjmp(C_None,truelabel);
end;
unequaln:
begin
emitjmp(C_NE,truelabel);
emitjmp(C_None,falselabel);
end;
end;
end;
begin
{ to make it more readable, string and set (not smallset!) have their
own procedures }
case p^.left^.resulttype^.deftype of
stringdef : begin
addstring(p);
exit;
end;
setdef : begin
{ normalsets are handled separate }
if not(psetdef(p^.left^.resulttype)^.settype=smallset) then
begin
addset(p);
exit;
end;
end;
end;
{ defaults }
unsigned:=false;
is_in_dest:=false;
extra_not:=false;
noswap:=false;
opsize:=S_L;
{ are we a (small)set, must be set here because the side can be
swapped ! (PFV) }
is_set:=(p^.left^.resulttype^.deftype=setdef);
{ calculate the operator which is more difficult }
firstcomplex(p);
{ handling boolean expressions extra: }
if is_boolean(p^.left^.resulttype) and
is_boolean(p^.right^.resulttype) then
begin
if (porddef(p^.left^.resulttype)^.typ=bool8bit) or
(porddef(p^.right^.resulttype)^.typ=bool8bit) then
opsize:=S_B
else
if (porddef(p^.left^.resulttype)^.typ=bool16bit) or
(porddef(p^.right^.resulttype)^.typ=bool16bit) then
opsize:=S_W
else
opsize:=S_L;
case p^.treetype of
andn,
orn : begin
clear_location(p^.location);
p^.location.loc:=LOC_JUMP;
cmpop:=false;
case p^.treetype of
andn : begin
otl:=truelabel;
getlabel(truelabel);
secondpass(p^.left);
maketojumpbool(p^.left);
emitlab(truelabel);
truelabel:=otl;
end;
orn : begin
ofl:=falselabel;
getlabel(falselabel);
secondpass(p^.left);
maketojumpbool(p^.left);
emitlab(falselabel);
falselabel:=ofl;
end;
else
CGMessage(type_e_mismatch);
end;
secondpass(p^.right);
maketojumpbool(p^.right);
end;
unequaln,ltn,lten,gtn,gten,
equaln,xorn : begin
if p^.left^.treetype=ordconstn then
swaptree(p);
if p^.left^.location.loc=LOC_JUMP then
begin
otl:=truelabel;
getlabel(truelabel);
ofl:=falselabel;
getlabel(falselabel);
end;
secondpass(p^.left);
{ if in flags then copy first to register, because the
flags can be destroyed }
case p^.left^.location.loc of
LOC_FLAGS:
locflags2reg(p^.left^.location,opsize);
LOC_JUMP:
begin
case opsize of
S_L : hregister:=getregister32;
S_W : hregister:=reg32toreg16(getregister32);
S_B : hregister:=reg32toreg8(getregister32);
end;
p^.left^.location.loc:=LOC_REGISTER;
p^.left^.location.register:=hregister;
emitlab(truelabel);
truelabel:=otl;
emit_const_reg(A_MOV,opsize,1,hregister);
getlabel(hl);
emitjmp(C_None,hl);
emitlab(falselabel);
falselabel:=ofl;
emit_reg_reg(A_XOR,S_L,makereg32(hregister),
makereg32(hregister));
emitlab(hl);
end;
end;
set_location(p^.location,p^.left^.location);
pushed:=maybe_push(p^.right^.registers32,p,false);
if p^.right^.location.loc=LOC_JUMP then
begin
otl:=truelabel;
getlabel(truelabel);
ofl:=falselabel;
getlabel(falselabel);
end;
secondpass(p^.right);
if pushed then
begin
restore(p,false);
set_location(p^.left^.location,p^.location);
end;
case p^.right^.location.loc of
LOC_FLAGS:
locflags2reg(p^.right^.location,opsize);
LOC_JUMP:
begin
case opsize of
S_L : hregister:=getregister32;
S_W : hregister:=reg32toreg16(getregister32);
S_B : hregister:=reg32toreg8(getregister32);
end;
p^.right^.location.loc:=LOC_REGISTER;
p^.right^.location.register:=hregister;
emitlab(truelabel);
truelabel:=otl;
emit_const_reg(A_MOV,opsize,1,hregister);
getlabel(hl);
emitjmp(C_None,hl);
emitlab(falselabel);
falselabel:=ofl;
emit_reg_reg(A_XOR,S_L,makereg32(hregister),
makereg32(hregister));
emitlab(hl);
end;
end;
goto do_normal;
end
else
CGMessage(type_e_mismatch);
end
end
else
begin
{ in case of constant put it to the left }
if (p^.left^.treetype=ordconstn) then
swaptree(p);
secondpass(p^.left);
{ this will be complicated as
a lot of code below assumes that
p^.location and p^.left^.location are the same }
{$ifdef test_dest_loc}
if dest_loc_known and (dest_loc_tree=p) and
((dest_loc.loc=LOC_REGISTER) or (dest_loc.loc=LOC_CREGISTER)) then
begin
set_location(p^.location,dest_loc);
in_dest_loc:=true;
is_in_dest:=true;
end
else
{$endif test_dest_loc}
set_location(p^.location,p^.left^.location);
{ are too few registers free? }
pushed:=maybe_push(p^.right^.registers32,p,is_64bitint(p^.left^.resulttype));
secondpass(p^.right);
if pushed then
begin
restore(p,is_64bitint(p^.left^.resulttype));
set_location(p^.left^.location,p^.location);
end;
if (p^.left^.resulttype^.deftype=pointerdef) or
(p^.right^.resulttype^.deftype=pointerdef) or
((p^.right^.resulttype^.deftype=objectdef) and
pobjectdef(p^.right^.resulttype)^.is_class and
(p^.left^.resulttype^.deftype=objectdef) and
pobjectdef(p^.left^.resulttype)^.is_class
) or
(p^.left^.resulttype^.deftype=classrefdef) or
(p^.left^.resulttype^.deftype=procvardef) or
((p^.left^.resulttype^.deftype=enumdef) and
(p^.left^.resulttype^.size=4)) or
((p^.left^.resulttype^.deftype=orddef) and
(porddef(p^.left^.resulttype)^.typ=s32bit)) or
((p^.right^.resulttype^.deftype=orddef) and
(porddef(p^.right^.resulttype)^.typ=s32bit)) or
((p^.left^.resulttype^.deftype=orddef) and
(porddef(p^.left^.resulttype)^.typ=u32bit)) or
((p^.right^.resulttype^.deftype=orddef) and
(porddef(p^.right^.resulttype)^.typ=u32bit)) or
{ as well as small sets }
is_set then
begin
do_normal:
mboverflow:=false;
cmpop:=false;
{$ifndef cardinalmulfix}
unsigned :=
(p^.left^.resulttype^.deftype=pointerdef) or
(p^.right^.resulttype^.deftype=pointerdef) or
((p^.left^.resulttype^.deftype=orddef) and
(porddef(p^.left^.resulttype)^.typ=u32bit)) or
((p^.right^.resulttype^.deftype=orddef) and
(porddef(p^.right^.resulttype)^.typ=u32bit));
{$else cardinalmulfix}
unsigned := not(is_signed(p^.left^.resulttype)) or
not(is_signed(p^.right^.resulttype));
{$endif cardinalmulfix}
case p^.treetype of
addn : begin
{ this is a really ugly hack!!!!!!!!!! }
{ this could be done later using EDI }
{ as it is done for subn }
{ instead of two registers!!!! }
if is_set then
begin
{ adding elements is not commutative }
if p^.swaped and (p^.left^.treetype=setelementn) then
swaptree(p);
{ are we adding set elements ? }
if p^.right^.treetype=setelementn then
begin
{ no range support for smallsets! }
if assigned(p^.right^.right) then
internalerror(43244);
{ bts requires both elements to be registers }
if p^.left^.location.loc in [LOC_MEM,LOC_REFERENCE] then
begin
ungetiftemp(p^.left^.location.reference);
del_location(p^.left^.location);
{!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!}
hregister:=getregister32;
emit_ref_reg(A_MOV,opsize,
newreference(p^.left^.location.reference),hregister);
clear_location(p^.left^.location);
p^.left^.location.loc:=LOC_REGISTER;
p^.left^.location.register:=hregister;
set_location(p^.location,p^.left^.location);
end;
if p^.right^.location.loc in [LOC_MEM,LOC_REFERENCE] then
begin
ungetiftemp(p^.right^.location.reference);
del_location(p^.right^.location);
hregister:=getregister32;
emit_ref_reg(A_MOV,opsize,
newreference(p^.right^.location.reference),hregister);
clear_location(p^.right^.location);
p^.right^.location.loc:=LOC_REGISTER;
p^.right^.location.register:=hregister;
end;
op:=A_BTS;
noswap:=true;
end
else
op:=A_OR;
mboverflow:=false;
unsigned:=false;
end
else
begin
op:=A_ADD;
mboverflow:=true;
end;
end;
symdifn : begin
{ the symetric diff is only for sets }
if is_set then
begin
op:=A_XOR;
mboverflow:=false;
unsigned:=false;
end
else
CGMessage(type_e_mismatch);
end;
muln : begin
if is_set then
begin
op:=A_AND;
mboverflow:=false;
unsigned:=false;
end
else
begin
if unsigned then
op:=A_MUL
else
op:=A_IMUL;
mboverflow:=true;
end;
end;
subn : begin
if is_set then
begin
op:=A_AND;
mboverflow:=false;
unsigned:=false;
{$IfNDef NoSetConstNot}
If (p^.right^.treetype = setconstn) then
p^.right^.location.reference.offset := not(p^.right^.location.reference.offset)
Else
{$EndIf NoNosetConstNot}
extra_not:=true;
end
else
begin
op:=A_SUB;
mboverflow:=true;
end;
end;
ltn,lten,
gtn,gten,
equaln,unequaln : begin
{$IfNDef NoSetInclusion}
If is_set Then
Case p^.treetype of
lten,gten:
Begin
If p^.treetype = lten then
swaptree(p);
if p^.left^.location.loc in [LOC_MEM,LOC_REFERENCE] then
begin
ungetiftemp(p^.left^.location.reference);
del_reference(p^.left^.location.reference);
hregister:=getregister32;
emit_ref_reg(A_MOV,opsize,
newreference(p^.left^.location.reference),hregister);
clear_location(p^.left^.location);
p^.left^.location.loc:=LOC_REGISTER;
p^.left^.location.register:=hregister;
set_location(p^.location,p^.left^.location);
end
else
if p^.left^.location.loc = LOC_CREGISTER Then
{save the register var in a temp register, because
its value is going to be modified}
begin
hregister := getregister32;
emit_reg_reg(A_MOV,opsize,
p^.left^.location.register,hregister);
clear_location(p^.left^.location);
p^.left^.location.loc:=LOC_REGISTER;
p^.left^.location.register:=hregister;
set_location(p^.location,p^.left^.location);
end;
{here, p^.left^.location should be LOC_REGISTER}
If p^.right^.location.loc in [LOC_MEM,LOC_REFERENCE] Then
emit_ref_reg(A_AND,opsize,
newreference(p^.right^.location.reference),p^.left^.location.register)
Else
emit_reg_reg(A_AND,opsize,
p^.right^.location.register,p^.left^.location.register);
{warning: ugly hack ahead: we need a "jne" after the cmp, so
change the treetype from lten/gten to equaln}
p^.treetype := equaln
End;
{no < or > support for sets}
ltn,gtn: CGMessage(type_e_mismatch);
End;
{$EndIf NoSetInclusion}
op:=A_CMP;
cmpop:=true;
end;
xorn : op:=A_XOR;
orn : op:=A_OR;
andn : op:=A_AND;
else
CGMessage(type_e_mismatch);
end;
{ filter MUL, which requires special handling }
if op=A_MUL then
begin
popeax:=false;
popedx:=false;
{ here you need to free the symbol first }
{ p^.left^.location and p^.right^.location must }
{ only be freed when they are really released, }
{ because the optimizer NEEDS correct regalloc }
{ info!!! (JM) }
clear_location(p^.location);
{ the p^.location.register will be filled in later (JM) }
p^.location.loc:=LOC_REGISTER;
{$IfNDef NoShlMul}
if p^.right^.treetype=ordconstn then
swaptree(p);
If (p^.left^.treetype = ordconstn) and
ispowerof2(p^.left^.value, power) and
not(cs_check_overflow in aktlocalswitches) then
Begin
{ This release will be moved after the next }
{ instruction by the optimizer. No need to }
{ release p^.left^.location, since it's a }
{ constant (JM) }
release_loc(p^.right^.location);
p^.location.register := getregister32;
emitloadord2reg(p^.right^.location,u32bitdef,p^.location.register,false);
emit_const_reg(A_SHL,S_L,power,p^.location.register)
End
Else
Begin
{$EndIf NoShlMul}
regstopush := $ff;
remove_non_regvars_from_loc(p^.right^.location,regstopush);
remove_non_regvars_from_loc(p^.left^.location,regstopush);
{ now, regstopush does NOT contain EAX and/or EDX if they are }
{ used in either the left or the right location, excepts if }
{they are regvars. It DOES contain them if they are used in }
{ another location (JM) }
if not(R_EAX in unused) and ((regstopush and ($80 shr byte(R_EAX))) <> 0) then
begin
emit_reg(A_PUSH,S_L,R_EAX);
popeax:=true;
end;
if not(R_EDX in unused) and ((regstopush and ($80 shr byte(R_EDX))) <> 0) then
begin
emit_reg(A_PUSH,S_L,R_EDX);
popedx:=true;
end;
{ p^.left^.location can be R_EAX !!! }
{$ifndef noAllocEdi}
getexplicitregister32(R_EDI);
{$endif noAllocEdi}
{ load the left value }
emitloadord2reg(p^.left^.location,u32bitdef,R_EDI,true);
release_loc(p^.left^.location);
{ allocate EAX }
if R_EAX in unused then
exprasmlist^.concat(new(pairegalloc,alloc(R_EAX)));
{ load he right value }
emitloadord2reg(p^.right^.location,u32bitdef,R_EAX,true);
release_loc(p^.right^.location);
{ allocate EAX if it isn't yet allocated (JM) }
if (R_EAX in unused) then
exprasmlist^.concat(new(pairegalloc,alloc(R_EAX)));
{$ifndef noAllocEdi}
{ also allocate EDX, since it is also modified by }
{ a mul (JM) }
if R_EDX in unused then
exprasmlist^.concat(new(pairegalloc,alloc(R_EDX)));
{$endif noAllocEdi}
emit_reg(A_MUL,S_L,R_EDI);
{$ifndef noAllocEdi}
ungetregister32(R_EDI);
if R_EDX in unused then
exprasmlist^.concat(new(pairegalloc,dealloc(R_EDX)));
{$endif noAllocEdi}
if R_EAX in unused then
exprasmlist^.concat(new(pairegalloc,dealloc(R_EAX)));
p^.location.register := getregister32;
emit_reg_reg(A_MOV,S_L,R_EAX,p^.location.register);
if popedx then
emit_reg(A_POP,S_L,R_EDX);
if popeax then
emit_reg(A_POP,S_L,R_EAX);
{$IfNDef NoShlMul}
End;
{$endif NoShlMul}
SetResultLocation(false,true,p);
exit;
end;
{ Convert flags to register first }
if (p^.left^.location.loc=LOC_FLAGS) then
locflags2reg(p^.left^.location,opsize);
if (p^.right^.location.loc=LOC_FLAGS) then
locflags2reg(p^.right^.location,opsize);
{ left and right no register? }
{ then one must be demanded }
if (p^.left^.location.loc<>LOC_REGISTER) and
(p^.right^.location.loc<>LOC_REGISTER) then
begin
{ register variable ? }
if (p^.left^.location.loc=LOC_CREGISTER) then
begin
{ it is OK if this is the destination }
if is_in_dest then
begin
hregister:=p^.location.register;
emit_reg_reg(A_MOV,opsize,p^.left^.location.register,
hregister);
end
else
if cmpop then
begin
{ do not disturb the register }
hregister:=p^.location.register;
end
else
begin
case opsize of
S_L : hregister:=getregister32;
S_B : hregister:=reg32toreg8(getregister32);
end;
emit_reg_reg(A_MOV,opsize,p^.left^.location.register,
hregister);
end
end
else
begin
ungetiftemp(p^.left^.location.reference);
del_reference(p^.left^.location.reference);
if is_in_dest then
begin
hregister:=p^.location.register;
emit_ref_reg(A_MOV,opsize,
newreference(p^.left^.location.reference),hregister);
end
else
begin
{ first give free, then demand new register }
case opsize of
S_L : hregister:=getregister32;
S_W : hregister:=reg32toreg16(getregister32);
S_B : hregister:=reg32toreg8(getregister32);
end;
emit_ref_reg(A_MOV,opsize,
newreference(p^.left^.location.reference),hregister);
end;
end;
clear_location(p^.location);
p^.location.loc:=LOC_REGISTER;
p^.location.register:=hregister;
end
else
{ if on the right the register then swap }
if not(noswap) and (p^.right^.location.loc=LOC_REGISTER) then
begin
swap_location(p^.location,p^.right^.location);
{ newly swapped also set swapped flag }
p^.swaped:=not(p^.swaped);
end;
{ at this point, p^.location.loc should be LOC_REGISTER }
{ and p^.location.register should be a valid register }
{ containing the left result }
if p^.right^.location.loc<>LOC_REGISTER then
begin
if (p^.treetype=subn) and p^.swaped then
begin
if p^.right^.location.loc=LOC_CREGISTER then
begin
if extra_not then
emit_reg(A_NOT,opsize,p^.location.register);
{$ifndef noAllocEdi}
getexplicitregister32(R_EDI);
{$endif noAllocEdi}
emit_reg_reg(A_MOV,opsize,p^.right^.location.register,R_EDI);
emit_reg_reg(op,opsize,p^.location.register,R_EDI);
emit_reg_reg(A_MOV,opsize,R_EDI,p^.location.register);
{$ifndef noAllocEdi}
ungetregister32(R_EDI);
{$endif noAllocEdi}
end
else
begin
if extra_not then
emit_reg(A_NOT,opsize,p^.location.register);
{$ifndef noAllocEdi}
getexplicitregister32(R_EDI);
{$endif noAllocEdi}
emit_ref_reg(A_MOV,opsize,
newreference(p^.right^.location.reference),R_EDI);
emit_reg_reg(op,opsize,p^.location.register,R_EDI);
emit_reg_reg(A_MOV,opsize,R_EDI,p^.location.register);
{$ifndef noAllocEdi}
ungetregister32(R_EDI);
{$endif noAllocEdi}
ungetiftemp(p^.right^.location.reference);
del_reference(p^.right^.location.reference);
end;
end
else
begin
if (p^.right^.treetype=ordconstn) and
(op=A_CMP) and
(p^.right^.value=0) then
begin
emit_reg_reg(A_TEST,opsize,p^.location.register,
p^.location.register);
end
else if (p^.right^.treetype=ordconstn) and
(op=A_ADD) and
(p^.right^.value=1) and
not(cs_check_overflow in aktlocalswitches) then
begin
emit_reg(A_INC,opsize,
p^.location.register);
end
else if (p^.right^.treetype=ordconstn) and
(op=A_SUB) and
(p^.right^.value=1) and
not(cs_check_overflow in aktlocalswitches) then
begin
emit_reg(A_DEC,opsize,
p^.location.register);
end
else if (p^.right^.treetype=ordconstn) and
(op=A_IMUL) and
(ispowerof2(p^.right^.value,power)) and
not(cs_check_overflow in aktlocalswitches) then
begin
emit_const_reg(A_SHL,opsize,power,
p^.location.register);
end
else
begin
if (p^.right^.location.loc=LOC_CREGISTER) then
begin
if extra_not then
begin
{$ifndef noAllocEdi}
getexplicitregister32(R_EDI);
{$endif noAllocEdi}
emit_reg_reg(A_MOV,S_L,p^.right^.location.register,R_EDI);
emit_reg(A_NOT,S_L,R_EDI);
emit_reg_reg(A_AND,S_L,R_EDI,
p^.location.register);
{$ifndef noAllocEdi}
ungetregister32(R_EDI);
{$endif noAllocEdi}
end
else
begin
emit_reg_reg(op,opsize,p^.right^.location.register,
p^.location.register);
end;
end
else
begin
if extra_not then
begin
{$ifndef noAllocEdi}
getexplicitregister32(R_EDI);
{$endif noAllocEdi}
emit_ref_reg(A_MOV,S_L,newreference(
p^.right^.location.reference),R_EDI);
emit_reg(A_NOT,S_L,R_EDI);
emit_reg_reg(A_AND,S_L,R_EDI,
p^.location.register);
{$ifndef noAllocEdi}
ungetregister32(R_EDI);
{$endif noAllocEdi}
end
else
begin
emit_ref_reg(op,opsize,newreference(
p^.right^.location.reference),p^.location.register);
end;
ungetiftemp(p^.right^.location.reference);
del_reference(p^.right^.location.reference);
end;
end;
end;
end
else
begin
{ when swapped another result register }
if (p^.treetype=subn) and p^.swaped then
begin
if extra_not then
emit_reg(A_NOT,S_L,p^.location.register);
emit_reg_reg(op,opsize,
p^.location.register,p^.right^.location.register);
swap_location(p^.location,p^.right^.location);
{ newly swapped also set swapped flag }
{ just to maintain ordering }
p^.swaped:=not(p^.swaped);
end
else
begin
if extra_not then
emit_reg(A_NOT,S_L,p^.right^.location.register);
emit_reg_reg(op,opsize,
p^.right^.location.register,
p^.location.register);
end;
case opsize of
S_L : ungetregister32(p^.right^.location.register);
S_B : ungetregister32(reg8toreg32(p^.right^.location.register));
end;
end;
if cmpop then
case opsize of
S_L : ungetregister32(p^.location.register);
S_B : ungetregister32(reg8toreg32(p^.location.register));
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
emitjmp(C_NO,hl4);
emitcall('FPC_OVERFLOW');
emitlab(hl4);
end;
end;
end
else
{ Char type }
if ((p^.left^.resulttype^.deftype=orddef) and
(porddef(p^.left^.resulttype)^.typ=uchar)) or
{ enumeration type 16 bit }
((p^.left^.resulttype^.deftype=enumdef) and
(p^.left^.resulttype^.size=1)) then
begin
case p^.treetype of
ltn,lten,gtn,gten,
equaln,unequaln :
cmpop:=true;
else CGMessage(type_e_mismatch);
end;
unsigned:=true;
{ left and right no register? }
{ the one must be demanded }
if (p^.location.loc<>LOC_REGISTER) and
(p^.right^.location.loc<>LOC_REGISTER) then
begin
if p^.location.loc=LOC_CREGISTER then
begin
if cmpop then
{ do not disturb register }
hregister:=p^.location.register
else
begin
hregister:=reg32toreg8(getregister32);
emit_reg_reg(A_MOV,S_B,p^.location.register,
hregister);
end;
end
else
begin
del_reference(p^.location.reference);
{ first give free then demand new register }
hregister:=reg32toreg8(getregister32);
emit_ref_reg(A_MOV,S_B,newreference(p^.location.reference),
hregister);
end;
clear_location(p^.location);
p^.location.loc:=LOC_REGISTER;
p^.location.register:=hregister;
end;
{ now p always a register }
if (p^.right^.location.loc=LOC_REGISTER) and
(p^.location.loc<>LOC_REGISTER) then
begin
swap_location(p^.location,p^.right^.location);
{ newly swapped also set swapped flag }
p^.swaped:=not(p^.swaped);
end;
if p^.right^.location.loc<>LOC_REGISTER then
begin
if p^.right^.location.loc=LOC_CREGISTER then
begin
emit_reg_reg(A_CMP,S_B,
p^.right^.location.register,p^.location.register);
end
else
begin
emit_ref_reg(A_CMP,S_B,newreference(
p^.right^.location.reference),p^.location.register);
del_reference(p^.right^.location.reference);
end;
end
else
begin
emit_reg_reg(A_CMP,S_B,p^.right^.location.register,
p^.location.register);
ungetregister32(reg8toreg32(p^.right^.location.register));
end;
ungetregister32(reg8toreg32(p^.location.register));
end
else
{ 16 bit enumeration type }
if ((p^.left^.resulttype^.deftype=enumdef) and
(p^.left^.resulttype^.size=2)) then
begin
case p^.treetype of
ltn,lten,gtn,gten,
equaln,unequaln :
cmpop:=true;
else CGMessage(type_e_mismatch);
end;
unsigned:=true;
{ left and right no register? }
{ the one must be demanded }
if (p^.location.loc<>LOC_REGISTER) and
(p^.right^.location.loc<>LOC_REGISTER) then
begin
if p^.location.loc=LOC_CREGISTER then
begin
if cmpop then
{ do not disturb register }
hregister:=p^.location.register
else
begin
hregister:=reg32toreg16(getregister32);
emit_reg_reg(A_MOV,S_W,p^.location.register,
hregister);
end;
end
else
begin
del_reference(p^.location.reference);
{ first give free then demand new register }
hregister:=reg32toreg16(getregister32);
emit_ref_reg(A_MOV,S_W,newreference(p^.location.reference),
hregister);
end;
clear_location(p^.location);
p^.location.loc:=LOC_REGISTER;
p^.location.register:=hregister;
end;
{ now p always a register }
if (p^.right^.location.loc=LOC_REGISTER) and
(p^.location.loc<>LOC_REGISTER) then
begin
swap_location(p^.location,p^.right^.location);
{ newly swapped also set swapped flag }
p^.swaped:=not(p^.swaped);
end;
if p^.right^.location.loc<>LOC_REGISTER then
begin
if p^.right^.location.loc=LOC_CREGISTER then
begin
emit_reg_reg(A_CMP,S_W,
p^.right^.location.register,p^.location.register);
end
else
begin
emit_ref_reg(A_CMP,S_W,newreference(
p^.right^.location.reference),p^.location.register);
del_reference(p^.right^.location.reference);
end;
end
else
begin
emit_reg_reg(A_CMP,S_W,p^.right^.location.register,
p^.location.register);
ungetregister32(reg16toreg32(p^.right^.location.register));
end;
ungetregister32(reg16toreg32(p^.location.register));
end
else
{ 64 bit types }
if is_64bitint(p^.left^.resulttype) then
begin
mboverflow:=false;
cmpop:=false;
unsigned:=((p^.left^.resulttype^.deftype=orddef) and
(porddef(p^.left^.resulttype)^.typ=u64bit)) or
((p^.right^.resulttype^.deftype=orddef) and
(porddef(p^.right^.resulttype)^.typ=u64bit));
case p^.treetype of
addn : begin
begin
op:=A_ADD;
op2:=A_ADC;
mboverflow:=true;
end;
end;
subn : begin
op:=A_SUB;
op2:=A_SBB;
mboverflow:=true;
end;
ltn,lten,
gtn,gten,
equaln,unequaln:
begin
op:=A_CMP;
op2:=A_CMP;
cmpop:=true;
end;
xorn:
begin
op:=A_XOR;
op2:=A_XOR;
end;
orn:
begin
op:=A_OR;
op2:=A_OR;
end;
andn:
begin
op:=A_AND;
op2:=A_AND;
end;
muln:
;
else
CGMessage(type_e_mismatch);
end;
if p^.treetype=muln then
begin
{ save p^.lcoation, because we change it now }
set_location(hloc,p^.location);
release_qword_loc(p^.location);
release_qword_loc(p^.right^.location);
p^.location.registerlow:=getexplicitregister32(R_EAX);
p^.location.registerhigh:=getexplicitregister32(R_EDX);
pushusedregisters(pushedreg,$ff
and not($80 shr byte(p^.location.registerlow))
and not($80 shr byte(p^.location.registerhigh)));
if cs_check_overflow in aktlocalswitches then
push_int(1)
else
push_int(0);
{ the left operand is in hloc, because the
location of left is p^.location but p^.location
is already destroyed
}
emit_pushq_loc(hloc);
clear_location(hloc);
emit_pushq_loc(p^.right^.location);
if porddef(p^.resulttype)^.typ=u64bit then
emitcall('FPC_MUL_QWORD')
else
emitcall('FPC_MUL_INT64');
emit_reg_reg(A_MOV,S_L,R_EAX,p^.location.registerlow);
emit_reg_reg(A_MOV,S_L,R_EDX,p^.location.registerhigh);
popusedregisters(pushedreg);
p^.location.loc:=LOC_REGISTER;
end
else
begin
{ left and right no register? }
{ then one must be demanded }
if (p^.left^.location.loc<>LOC_REGISTER) and
(p^.right^.location.loc<>LOC_REGISTER) then
begin
{ register variable ? }
if (p^.left^.location.loc=LOC_CREGISTER) then
begin
{ it is OK if this is the destination }
if is_in_dest then
begin
hregister:=p^.location.registerlow;
hregister2:=p^.location.registerhigh;
emit_reg_reg(A_MOV,S_L,p^.left^.location.registerlow,
hregister);
emit_reg_reg(A_MOV,S_L,p^.left^.location.registerlow,
hregister2);
end
else
if cmpop then
begin
{ do not disturb the register }
hregister:=p^.location.registerlow;
hregister2:=p^.location.registerhigh;
end
else
begin
hregister:=getregister32;
hregister2:=getregister32;
emit_reg_reg(A_MOV,S_L,p^.left^.location.registerlow,
hregister);
emit_reg_reg(A_MOV,S_L,p^.left^.location.registerhigh,
hregister2);
end
end
else
begin
ungetiftemp(p^.left^.location.reference);
del_reference(p^.left^.location.reference);
if is_in_dest then
begin
hregister:=p^.location.registerlow;
hregister2:=p^.location.registerhigh;
emit_mov_ref_reg64(p^.left^.location.reference,hregister,hregister2);
end
else
begin
hregister:=getregister32;
hregister2:=getregister32;
emit_mov_ref_reg64(p^.left^.location.reference,hregister,hregister2);
end;
end;
clear_location(p^.location);
p^.location.loc:=LOC_REGISTER;
p^.location.registerlow:=hregister;
p^.location.registerhigh:=hregister2;
end
else
{ if on the right the register then swap }
if not(noswap) and (p^.right^.location.loc=LOC_REGISTER) then
begin
swap_location(p^.location,p^.right^.location);
{ newly swapped also set swapped flag }
p^.swaped:=not(p^.swaped);
end;
{ at this point, p^.location.loc should be LOC_REGISTER }
{ and p^.location.register should be a valid register }
{ containing the left result }
if p^.right^.location.loc<>LOC_REGISTER then
begin
if (p^.treetype=subn) and p^.swaped then
begin
if p^.right^.location.loc=LOC_CREGISTER then
begin
{$ifndef noAllocEdi}
getexplicitregister32(R_EDI);
{$endif noAllocEdi}
emit_reg_reg(A_MOV,opsize,p^.right^.location.register,R_EDI);
emit_reg_reg(op,opsize,p^.location.register,R_EDI);
emit_reg_reg(A_MOV,opsize,R_EDI,p^.location.register);
{$ifndef noAllocEdi}
ungetregister32(R_EDI);
getexplicitregister32(R_EDI);
{$endif noAllocEdi}
emit_reg_reg(A_MOV,opsize,p^.right^.location.registerhigh,R_EDI);
{ the carry flag is still ok }
emit_reg_reg(op2,opsize,p^.location.registerhigh,R_EDI);
emit_reg_reg(A_MOV,opsize,R_EDI,p^.location.registerhigh);
{$ifndef noAllocEdi}
ungetregister32(R_EDI);
{$endif noAllocEdi}
end
else
begin
{$ifndef noAllocEdi}
getexplicitregister32(R_EDI);
{$endif noAllocEdi}
emit_ref_reg(A_MOV,opsize,
newreference(p^.right^.location.reference),R_EDI);
emit_reg_reg(op,opsize,p^.location.registerlow,R_EDI);
emit_reg_reg(A_MOV,opsize,R_EDI,p^.location.registerlow);
{$ifndef noAllocEdi}
ungetregister32(R_EDI);
getexplicitregister32(R_EDI);
{$endif noAllocEdi}
hr:=newreference(p^.right^.location.reference);
inc(hr^.offset,4);
emit_ref_reg(A_MOV,opsize,
hr,R_EDI);
{ here the carry flag is still preserved }
emit_reg_reg(op2,opsize,p^.location.registerhigh,R_EDI);
emit_reg_reg(A_MOV,opsize,R_EDI,
p^.location.registerhigh);
{$ifndef noAllocEdi}
ungetregister32(R_EDI);
{$endif noAllocEdi}
ungetiftemp(p^.right^.location.reference);
del_reference(p^.right^.location.reference);
end;
end
else if cmpop then
begin
if (p^.right^.location.loc=LOC_CREGISTER) then
begin
emit_reg_reg(A_CMP,S_L,p^.right^.location.registerhigh,
p^.location.registerhigh);
firstjmp64bitcmp;
emit_reg_reg(A_CMP,S_L,p^.right^.location.registerlow,
p^.location.registerlow);
secondjmp64bitcmp;
end
else
begin
hr:=newreference(p^.right^.location.reference);
inc(hr^.offset,4);
emit_ref_reg(A_CMP,S_L,
hr,p^.location.registerhigh);
firstjmp64bitcmp;
emit_ref_reg(A_CMP,S_L,newreference(
p^.right^.location.reference),p^.location.registerlow);
secondjmp64bitcmp;
emitjmp(C_None,falselabel);
ungetiftemp(p^.right^.location.reference);
del_reference(p^.right^.location.reference);
end;
end
else
begin
{
if (p^.right^.treetype=ordconstn) and
(op=A_CMP) and
(p^.right^.value=0) then
begin
emit_reg_reg(A_TEST,opsize,p^.location.register,
p^.location.register);
end
else if (p^.right^.treetype=ordconstn) and
(op=A_IMUL) and
(ispowerof2(p^.right^.value,power)) then
begin
emit_const_reg(A_SHL,opsize,power,
p^.location.register);
end
else
}
begin
if (p^.right^.location.loc=LOC_CREGISTER) then
begin
emit_reg_reg(op,S_L,p^.right^.location.registerlow,
p^.location.registerlow);
emit_reg_reg(op2,S_L,p^.right^.location.registerhigh,
p^.location.registerhigh);
end
else
begin
emit_ref_reg(op,S_L,newreference(
p^.right^.location.reference),p^.location.registerlow);
hr:=newreference(p^.right^.location.reference);
inc(hr^.offset,4);
emit_ref_reg(op2,S_L,
hr,p^.location.registerhigh);
ungetiftemp(p^.right^.location.reference);
del_reference(p^.right^.location.reference);
end;
end;
end;
end
else
begin
{ when swapped another result register }
if (p^.treetype=subn) and p^.swaped then
begin
emit_reg_reg(op,S_L,
p^.location.registerlow,
p^.right^.location.registerlow);
emit_reg_reg(op2,S_L,
p^.location.registerhigh,
p^.right^.location.registerhigh);
swap_location(p^.location,p^.right^.location);
{ newly swapped also set swapped flag }
{ just to maintain ordering }
p^.swaped:=not(p^.swaped);
end
else if cmpop then
begin
emit_reg_reg(A_CMP,S_L,
p^.right^.location.registerhigh,
p^.location.registerhigh);
firstjmp64bitcmp;
emit_reg_reg(A_CMP,S_L,
p^.right^.location.registerlow,
p^.location.registerlow);
secondjmp64bitcmp;
end
else
begin
emit_reg_reg(op,S_L,
p^.right^.location.registerlow,
p^.location.registerlow);
emit_reg_reg(op2,S_L,
p^.right^.location.registerhigh,
p^.location.registerhigh);
end;
ungetregister32(p^.right^.location.registerlow);
ungetregister32(p^.right^.location.registerhigh);
end;
if cmpop then
begin
ungetregister32(p^.location.registerlow);
ungetregister32(p^.location.registerhigh);
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
emitjmp(C_NO,hl4);
emitcall('FPC_OVERFLOW');
emitlab(hl4);
end;
end;
{ we have LOC_JUMP as result }
if cmpop then
begin
clear_location(p^.location);
p^.location.loc:=LOC_JUMP;
cmpop:=false;
end;
end;
end
else
{ Floating point }
if (p^.left^.resulttype^.deftype=floatdef) and
(pfloatdef(p^.left^.resulttype)^.typ<>f32bit) then
begin
{ real constants to the right, but only if it
isn't on the FPU stack, i.e. 1.0 or 0.0! }
if (p^.left^.treetype=realconstn) and
(p^.left^.location.loc<>LOC_FPU) then
swaptree(p);
cmpop:=false;
case p^.treetype of
addn : op:=A_FADDP;
muln : op:=A_FMULP;
subn : op:=A_FSUBP;
slashn : op:=A_FDIVP;
ltn,lten,gtn,gten,
equaln,unequaln : begin
op:=A_FCOMPP;
cmpop:=true;
end;
else CGMessage(type_e_mismatch);
end;
if (p^.right^.location.loc<>LOC_FPU) then
begin
if p^.right^.location.loc=LOC_CFPUREGISTER then
begin
emit_reg( A_FLD,S_NO,
correct_fpuregister(p^.right^.location.register,fpuvaroffset));
inc(fpuvaroffset);
end
else
floatload(pfloatdef(p^.right^.resulttype)^.typ,p^.right^.location.reference);
if (p^.left^.location.loc<>LOC_FPU) then
begin
if p^.left^.location.loc=LOC_CFPUREGISTER then
begin
emit_reg( A_FLD,S_NO,
correct_fpuregister(p^.left^.location.register,fpuvaroffset));
inc(fpuvaroffset);
end
else
floatload(pfloatdef(p^.left^.resulttype)^.typ,p^.left^.location.reference)
end
{ left was on the stack => swap }
else
p^.swaped:=not(p^.swaped);
{ releases the right reference }
del_reference(p^.right^.location.reference);
end
{ the nominator in st0 }
else if (p^.left^.location.loc<>LOC_FPU) then
begin
if p^.left^.location.loc=LOC_CFPUREGISTER then
begin
emit_reg( A_FLD,S_NO,
correct_fpuregister(p^.left^.location.register,fpuvaroffset));
inc(fpuvaroffset);
end
else
floatload(pfloatdef(p^.left^.resulttype)^.typ,p^.left^.location.reference)
end
{ fpu operands are always in the wrong order on the stack }
else
p^.swaped:=not(p^.swaped);
{ releases the left reference }
if (p^.left^.location.loc in [LOC_MEM,LOC_REFERENCE]) then
del_reference(p^.left^.location.reference);
{ if we swaped the tree nodes, then use the reverse operator }
if p^.swaped then
begin
if (p^.treetype=slashn) then
op:=A_FDIVRP
else if (p^.treetype=subn) then
op:=A_FSUBRP;
end;
{ to avoid the pentium bug
if (op=FDIVP) and (opt_processors=pentium) then
emitcall('EMUL_FDIVP')
else
}
{ the Intel assemblers want operands }
if op<>A_FCOMPP then
begin
emit_reg_reg(op,S_NO,R_ST,R_ST1);
dec(fpuvaroffset);
end
else
begin
emit_none(op,S_NO);
dec(fpuvaroffset,2);
end;
{ on comparison load flags }
if cmpop then
begin
if not(R_EAX in unused) then
begin
{$ifndef noAllocEdi}
getexplicitregister32(R_EDI);
{$endif noAllocEdi}
emit_reg_reg(A_MOV,S_L,R_EAX,R_EDI);
end;
emit_reg(A_FNSTSW,S_NO,R_AX);
emit_none(A_SAHF,S_NO);
if not(R_EAX in unused) then
begin
emit_reg_reg(A_MOV,S_L,R_EDI,R_EAX);
{$ifndef noAllocEdi}
ungetregister32(R_EDI);
{$endif noAllocEdi}
end;
if p^.swaped then
begin
case p^.treetype of
equaln : flags:=F_E;
unequaln : flags:=F_NE;
ltn : flags:=F_A;
lten : flags:=F_AE;
gtn : flags:=F_B;
gten : flags:=F_BE;
end;
end
else
begin
case p^.treetype of
equaln : flags:=F_E;
unequaln : flags:=F_NE;
ltn : flags:=F_B;
lten : flags:=F_BE;
gtn : flags:=F_A;
gten : flags:=F_AE;
end;
end;
clear_location(p^.location);
p^.location.loc:=LOC_FLAGS;
p^.location.resflags:=flags;
cmpop:=false;
end
else
begin
clear_location(p^.location);
p^.location.loc:=LOC_FPU;
end;
end
{$ifdef SUPPORT_MMX}
else
{ MMX Arrays }
if is_mmx_able_array(p^.left^.resulttype) then
begin
cmpop:=false;
mmxbase:=mmx_type(p^.left^.resulttype);
case p^.treetype of
addn : begin
if (cs_mmx_saturation in aktlocalswitches) then
begin
case mmxbase of
mmxs8bit:
op:=A_PADDSB;
mmxu8bit:
op:=A_PADDUSB;
mmxs16bit,mmxfixed16:
op:=A_PADDSB;
mmxu16bit:
op:=A_PADDUSW;
end;
end
else
begin
case mmxbase of
mmxs8bit,mmxu8bit:
op:=A_PADDB;
mmxs16bit,mmxu16bit,mmxfixed16:
op:=A_PADDW;
mmxs32bit,mmxu32bit:
op:=A_PADDD;
end;
end;
end;
muln : begin
case mmxbase of
mmxs16bit,mmxu16bit:
op:=A_PMULLW;
mmxfixed16:
op:=A_PMULHW;
end;
end;
subn : begin
if (cs_mmx_saturation in aktlocalswitches) then
begin
case mmxbase of
mmxs8bit:
op:=A_PSUBSB;
mmxu8bit:
op:=A_PSUBUSB;
mmxs16bit,mmxfixed16:
op:=A_PSUBSB;
mmxu16bit:
op:=A_PSUBUSW;
end;
end
else
begin
case mmxbase of
mmxs8bit,mmxu8bit:
op:=A_PSUBB;
mmxs16bit,mmxu16bit,mmxfixed16:
op:=A_PSUBW;
mmxs32bit,mmxu32bit:
op:=A_PSUBD;
end;
end;
end;
{
ltn,lten,gtn,gten,
equaln,unequaln :
begin
op:=A_CMP;
cmpop:=true;
end;
}
xorn:
op:=A_PXOR;
orn:
op:=A_POR;
andn:
op:=A_PAND;
else CGMessage(type_e_mismatch);
end;
{ left and right no register? }
{ then one must be demanded }
if (p^.left^.location.loc<>LOC_MMXREGISTER) and
(p^.right^.location.loc<>LOC_MMXREGISTER) then
begin
{ register variable ? }
if (p^.left^.location.loc=LOC_CMMXREGISTER) then
begin
{ it is OK if this is the destination }
if is_in_dest then
begin
hregister:=p^.location.register;
emit_reg_reg(A_MOVQ,S_NO,p^.left^.location.register,
hregister);
end
else
begin
hregister:=getregistermmx;
emit_reg_reg(A_MOVQ,S_NO,p^.left^.location.register,
hregister);
end
end
else
begin
del_reference(p^.left^.location.reference);
if is_in_dest then
begin
hregister:=p^.location.register;
emit_ref_reg(A_MOVQ,S_NO,
newreference(p^.left^.location.reference),hregister);
end
else
begin
hregister:=getregistermmx;
emit_ref_reg(A_MOVQ,S_NO,
newreference(p^.left^.location.reference),hregister);
end;
end;
clear_location(p^.location);
p^.location.loc:=LOC_MMXREGISTER;
p^.location.register:=hregister;
end
else
{ if on the right the register then swap }
if (p^.right^.location.loc=LOC_MMXREGISTER) then
begin
swap_location(p^.location,p^.right^.location);
{ newly swapped also set swapped flag }
p^.swaped:=not(p^.swaped);
end;
{ at this point, p^.location.loc should be LOC_MMXREGISTER }
{ and p^.location.register should be a valid register }
{ containing the left result }
if p^.right^.location.loc<>LOC_MMXREGISTER then
begin
if (p^.treetype=subn) and p^.swaped then
begin
if p^.right^.location.loc=LOC_CMMXREGISTER then
begin
emit_reg_reg(A_MOVQ,S_NO,p^.right^.location.register,R_MM7);
emit_reg_reg(op,S_NO,p^.location.register,R_MM0);
emit_reg_reg(A_MOVQ,S_NO,R_MM7,p^.location.register);
end
else
begin
emit_ref_reg(A_MOVQ,S_NO,
newreference(p^.right^.location.reference),R_MM7);
emit_reg_reg(op,S_NO,p^.location.register,
R_MM7);
emit_reg_reg(A_MOVQ,S_NO,
R_MM7,p^.location.register);
del_reference(p^.right^.location.reference);
end;
end
else
begin
if (p^.right^.location.loc=LOC_CREGISTER) then
begin
emit_reg_reg(op,S_NO,p^.right^.location.register,
p^.location.register);
end
else
begin
emit_ref_reg(op,S_NO,newreference(
p^.right^.location.reference),p^.location.register);
del_reference(p^.right^.location.reference);
end;
end;
end
else
begin
{ when swapped another result register }
if (p^.treetype=subn) and p^.swaped then
begin
emit_reg_reg(op,S_NO,
p^.location.register,p^.right^.location.register);
swap_location(p^.location,p^.right^.location);
{ newly swapped also set swapped flag }
{ just to maintain ordering }
p^.swaped:=not(p^.swaped);
end
else
begin
emit_reg_reg(op,S_NO,
p^.right^.location.register,
p^.location.register);
end;
ungetregistermmx(p^.right^.location.register);
end;
end
{$endif SUPPORT_MMX}
else CGMessage(type_e_mismatch);
end;
SetResultLocation(cmpop,unsigned,p);
end;
end.
{
$Log$
Revision 1.1 2000-07-13 06:29:44 michael
+ Initial import
Revision 1.103 2000/06/10 17:32:44 jonas
* fixed bug in shlmul code
Revision 1.102 2000/05/26 20:16:00 jonas
* fixed wrong register deallocations in several ansistring related
procedures. The IDE's now function fine when compiled with -OG3p3r
Revision 1.101 2000/04/25 14:43:36 jonas
- disabled "string_var := string_var + ... " and "string_var + char_var"
optimizations (were only active with -dnewoptimizations) because of
several internal issues
Revision 1.100 2000/04/23 09:28:19 jonas
* use FPC_SHPRTSTR_CONCAT_LEN for -dnewoptimizations (temp)
* more precise reg deallocation when calling the above)
Revision 1.99 2000/04/21 12:35:05 jonas
+ special code for string + char, between -dnewoptimizations
Revision 1.98 2000/04/10 12:23:19 jonas
* modified copyshortstring so it takes an extra paramter which allows it
to delete the sref itself (so the reg deallocations are put in the
right place for the optimizer)
Revision 1.97 2000/02/29 23:57:36 pierre
Use $GOTO ON
Revision 1.96 2000/02/18 21:25:48 florian
* fixed a bug in int64/qword handling was a quite ugly one
Revision 1.95 2000/02/18 16:13:28 florian
* optimized ansistring compare with ''
* fixed 852
Revision 1.94 2000/02/14 22:34:28 florian
* fixed another internalerror
Revision 1.93 2000/02/09 13:22:45 peter
* log truncated
Revision 1.92 2000/01/23 13:57:52 jonas
* fixed bug introduced by my regalloc fixed :(
Revision 1.91 2000/01/23 11:11:36 michael
+ Fixes from Jonas.
Revision 1.90 2000/01/22 16:02:38 jonas
* fixed more regalloc bugs (for set adding and unsigned
multiplication)
Revision 1.89 2000/01/13 16:52:47 jonas
* moved deallocation of registers used in reference that points to string after
copyshortstring (this routine doesn't require extra regs)
Revision 1.88 2000/01/09 19:44:53 florian
* bug in secondadd(subn) with swaped mmx operands fixed
Revision 1.87 2000/01/09 16:35:39 jonas
+ comment about badly placed release_loc calls for a_mul which
causes wrong regdeallocations. Don't know how to fix :(
Revision 1.86 2000/01/09 12:34:59 jonas
* changed edi allocation to use getexplicitregister32/ungetregister
(adapted tgeni386 a bit for this) and enabled it by default
* fixed very big and stupid bug of mine in cg386mat that broke the
include() code (and make cycle :( ) if you compiled without
-dnewoptimizations
Revision 1.85 2000/01/09 01:44:18 jonas
+ (de)allocation info for EDI to fix reported bug on mailinglist.
Also some (de)allocation info for ESI added. Between -dallocEDI
because at this time of the night bugs could easily slip in ;)
Revision 1.84 2000/01/07 01:14:20 peter
* updated copyright to 2000
Revision 1.83 1999/12/11 18:53:31 jonas
* fixed type conversions of results of operations with cardinals
(between -dcardinalmulfix)
Revision 1.82 1999/11/06 14:34:17 peter
* truncated log to 20 revs
Revision 1.81 1999/09/28 19:43:45 florian
* the maybe_push fix of Pierre wasn't 100%, the tree parameter
must contain a valid location (which is saved if necessary)
Revision 1.80 1999/09/26 13:26:01 florian
* exception patch of Romio nevertheless the excpetion handling
needs some corections regarding register saving
* gettempansistring is again a procedure
Revision 1.79 1999/09/21 20:53:21 florian
* fixed 1/s problem from mailing list
Revision 1.78 1999/09/07 07:52:19 peter
* > < >= <= support for boolean
* boolean constants are now calculated like integer constants
Revision 1.77 1999/08/30 12:00:45 pierre
* problem with maybe_push/restore solved hopefully
Revision 1.76 1999/08/23 23:31:00 pierre
* double del_location removed in add_set
Revision 1.75 1999/08/23 10:35:13 jonas
* fixed <= and >= for sets
Revision 1.74 1999/08/19 13:08:43 pierre
* emit_??? used
Revision 1.73 1999/08/07 11:29:26 peter
* better fix for muln register allocation
}