mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-11-04 05:59:37 +01:00
945 lines
30 KiB
ObjectPascal
945 lines
30 KiB
ObjectPascal
{
|
|
$Id$
|
|
Copyright (c) 2000-2002 by Florian Klaempfl
|
|
|
|
Type checking and register allocation 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 nmat;
|
|
|
|
{$i fpcdefs.inc}
|
|
|
|
interface
|
|
|
|
uses
|
|
node;
|
|
|
|
type
|
|
tmoddivnode = class(tbinopnode)
|
|
function pass_1 : tnode;override;
|
|
function det_resulttype:tnode;override;
|
|
protected
|
|
{ override the following if you want to implement }
|
|
{ parts explicitely in the code generator (JM) }
|
|
function first_moddiv64bitint: tnode; virtual;
|
|
function firstoptimize: tnode; virtual;
|
|
function first_moddivint: tnode; virtual;
|
|
end;
|
|
tmoddivnodeclass = class of tmoddivnode;
|
|
|
|
tshlshrnode = class(tbinopnode)
|
|
function pass_1 : tnode;override;
|
|
function det_resulttype:tnode;override;
|
|
{ override the following if you want to implement }
|
|
{ parts explicitely in the code generator (CEC)
|
|
Should return nil, if everything will be handled
|
|
in the code generator
|
|
}
|
|
function first_shlshr64bitint: tnode; virtual;
|
|
end;
|
|
tshlshrnodeclass = class of tshlshrnode;
|
|
|
|
tunaryminusnode = class(tunarynode)
|
|
constructor create(expr : tnode);virtual;
|
|
function pass_1 : tnode;override;
|
|
function det_resulttype:tnode;override;
|
|
end;
|
|
tunaryminusnodeclass = class of tunaryminusnode;
|
|
|
|
tnotnode = class(tunarynode)
|
|
constructor create(expr : tnode);virtual;
|
|
function pass_1 : tnode;override;
|
|
function det_resulttype:tnode;override;
|
|
{$ifdef state_tracking}
|
|
function track_state_pass(exec_known:boolean):boolean;override;
|
|
{$endif}
|
|
end;
|
|
tnotnodeclass = class of tnotnode;
|
|
|
|
var
|
|
cmoddivnode : tmoddivnodeclass;
|
|
cshlshrnode : tshlshrnodeclass;
|
|
cunaryminusnode : tunaryminusnodeclass;
|
|
cnotnode : tnotnodeclass;
|
|
|
|
|
|
implementation
|
|
|
|
uses
|
|
systems,tokens,
|
|
verbose,globals,cutils,
|
|
globtype,
|
|
symconst,symtype,symtable,symdef,defutil,
|
|
htypechk,pass_1,cpubase,
|
|
cginfo,cgbase,
|
|
ncon,ncnv,ncal,nadd;
|
|
|
|
{****************************************************************************
|
|
TMODDIVNODE
|
|
****************************************************************************}
|
|
|
|
function tmoddivnode.det_resulttype:tnode;
|
|
var
|
|
hp,t : tnode;
|
|
rd,ld : torddef;
|
|
rv,lv : tconstexprint;
|
|
begin
|
|
result:=nil;
|
|
resulttypepass(left);
|
|
resulttypepass(right);
|
|
set_varstate(left,true);
|
|
set_varstate(right,true);
|
|
if codegenerror then
|
|
exit;
|
|
|
|
{ we need 2 orddefs always }
|
|
if (left.resulttype.def.deftype<>orddef) then
|
|
inserttypeconv(right,s32bittype);
|
|
if (right.resulttype.def.deftype<>orddef) then
|
|
inserttypeconv(right,s32bittype);
|
|
if codegenerror then
|
|
exit;
|
|
|
|
{ check for division by zero }
|
|
if is_constintnode(right) then
|
|
begin
|
|
rv:=tordconstnode(right).value;
|
|
if (rv=0) then
|
|
begin
|
|
Message(parser_e_division_by_zero);
|
|
{ recover }
|
|
rv:=1;
|
|
end;
|
|
if is_constintnode(left) then
|
|
begin
|
|
lv:=tordconstnode(left).value;
|
|
|
|
case nodetype of
|
|
modn:
|
|
t:=genintconstnode(lv mod rv);
|
|
divn:
|
|
t:=genintconstnode(lv div rv);
|
|
end;
|
|
result:=t;
|
|
exit;
|
|
end;
|
|
end;
|
|
|
|
{ allow operator overloading }
|
|
t:=self;
|
|
if isbinaryoverloaded(t) then
|
|
begin
|
|
result:=t;
|
|
exit;
|
|
end;
|
|
|
|
rd:=torddef(right.resulttype.def);
|
|
ld:=torddef(left.resulttype.def);
|
|
|
|
{ if one operand is a cardinal and the other is a positive constant, convert the }
|
|
{ constant to a cardinal as well so we don't have to do a 64bit division (JM) }
|
|
{ Do the same for qwords and positive constants as well, otherwise things like }
|
|
{ "qword mod 10" are evaluated with int64 as result, which is wrong if the }
|
|
{ "qword" was > high(int64) (JM) }
|
|
if (rd.typ in [u32bit,u64bit]) and
|
|
is_constintnode(left) and
|
|
(tordconstnode(left).value >= 0) then
|
|
inserttypeconv(left,right.resulttype)
|
|
else
|
|
if (ld.typ in [u32bit,u64bit]) and
|
|
is_constintnode(right) and
|
|
(tordconstnode(right).value >= 0) then
|
|
inserttypeconv(right,left.resulttype);
|
|
|
|
{ when there is one currency value, everything is done
|
|
using currency }
|
|
if (ld.typ=scurrency) or
|
|
(rd.typ=scurrency) then
|
|
begin
|
|
if (ld.typ<>scurrency) then
|
|
inserttypeconv(left,s64currencytype);
|
|
if (rd.typ<>scurrency) then
|
|
inserttypeconv(right,s64currencytype);
|
|
resulttype:=left.resulttype;
|
|
end
|
|
else
|
|
{ when there is one 64bit value, everything is done
|
|
in 64bit }
|
|
if (is_64bitint(left.resulttype.def) or
|
|
is_64bitint(right.resulttype.def)) then
|
|
begin
|
|
if is_signed(rd) or is_signed(ld) then
|
|
begin
|
|
if (torddef(ld).typ<>s64bit) then
|
|
inserttypeconv(left,cs64bittype);
|
|
if (torddef(rd).typ<>s64bit) then
|
|
inserttypeconv(right,cs64bittype);
|
|
end
|
|
else
|
|
begin
|
|
if (torddef(ld).typ<>u64bit) then
|
|
inserttypeconv(left,cu64bittype);
|
|
if (torddef(rd).typ<>u64bit) then
|
|
inserttypeconv(right,cu64bittype);
|
|
end;
|
|
resulttype:=left.resulttype;
|
|
end
|
|
else
|
|
{ when mixing cardinals and signed numbers, convert everythign to 64bit (JM) }
|
|
if ((rd.typ = u32bit) and
|
|
is_signed(left.resulttype.def)) or
|
|
((ld.typ = u32bit) and
|
|
is_signed(right.resulttype.def)) then
|
|
begin
|
|
CGMessage(type_w_mixed_signed_unsigned);
|
|
if (torddef(ld).typ<>s64bit) then
|
|
inserttypeconv(left,cs64bittype);
|
|
if (torddef(rd).typ<>s64bit) then
|
|
inserttypeconv(right,cs64bittype);
|
|
resulttype:=left.resulttype;
|
|
end
|
|
else
|
|
begin
|
|
{ Make everything always 32bit }
|
|
if not(torddef(right.resulttype.def).typ in [s32bit,u32bit]) then
|
|
inserttypeconv(right,s32bittype);
|
|
if not(torddef(left.resulttype.def).typ in [s32bit,u32bit]) then
|
|
inserttypeconv(left,s32bittype);
|
|
resulttype:=right.resulttype;
|
|
end;
|
|
|
|
{ when the result is currency we need some extra code for
|
|
division. this should not be done when the divn node is
|
|
created internally }
|
|
if (nodetype=divn) and
|
|
not(nf_is_currency in flags) and
|
|
is_currency(resulttype.def) then
|
|
begin
|
|
hp:=caddnode.create(muln,getcopy,cordconstnode.create(10000,s64currencytype,false));
|
|
include(hp.flags,nf_is_currency);
|
|
result:=hp;
|
|
end;
|
|
end;
|
|
|
|
|
|
function tmoddivnode.first_moddivint: tnode;
|
|
{$ifdef cpuneedsdiv32helper}
|
|
var
|
|
procname: string[31];
|
|
begin
|
|
result := nil;
|
|
|
|
{ otherwise create a call to a helper }
|
|
if nodetype = divn then
|
|
procname := 'fpc_div_'
|
|
else
|
|
procname := 'fpc_mod_';
|
|
{ only qword needs the unsigned code, the
|
|
signed code is also used for currency }
|
|
if is_signed(resulttype.def) then
|
|
procname := procname + 'longint'
|
|
else
|
|
procname := procname + 'dword';
|
|
|
|
result := ccallnode.createintern(procname,ccallparanode.create(left,
|
|
ccallparanode.create(right,nil)));
|
|
left := nil;
|
|
right := nil;
|
|
firstpass(result);
|
|
end;
|
|
{$else cpuneedsdiv32helper}
|
|
begin
|
|
result:=nil;
|
|
end;
|
|
{$endif cpuneedsdiv32helper}
|
|
|
|
|
|
function tmoddivnode.first_moddiv64bitint: tnode;
|
|
var
|
|
procname: string[31];
|
|
begin
|
|
result := nil;
|
|
|
|
{ when currency is used set the result of the
|
|
parameters to s64bit, so they are not converted }
|
|
if is_currency(resulttype.def) then
|
|
begin
|
|
left.resulttype:=cs64bittype;
|
|
right.resulttype:=cs64bittype;
|
|
end;
|
|
|
|
{ otherwise create a call to a helper }
|
|
if nodetype = divn then
|
|
procname := 'fpc_div_'
|
|
else
|
|
procname := 'fpc_mod_';
|
|
{ only qword needs the unsigned code, the
|
|
signed code is also used for currency }
|
|
if is_signed(resulttype.def) then
|
|
procname := procname + 'int64'
|
|
else
|
|
procname := procname + 'qword';
|
|
|
|
result := ccallnode.createintern(procname,ccallparanode.create(left,
|
|
ccallparanode.create(right,nil)));
|
|
left := nil;
|
|
right := nil;
|
|
firstpass(result);
|
|
end;
|
|
|
|
|
|
function tmoddivnode.firstoptimize: tnode;
|
|
var
|
|
power{,shiftval} : longint;
|
|
newtype: tnodetype;
|
|
begin
|
|
result := nil;
|
|
{ divide/mod a number by a constant which is a power of 2? }
|
|
if (cs_optimize in aktglobalswitches) and
|
|
(right.nodetype = ordconstn) and
|
|
{ ((nodetype = divn) or
|
|
not is_signed(resulttype.def)) and}
|
|
(not is_signed(resulttype.def)) and
|
|
ispowerof2(tordconstnode(right).value,power) then
|
|
begin
|
|
if nodetype = divn then
|
|
begin
|
|
(*
|
|
if is_signed(resulttype.def) then
|
|
begin
|
|
if is_64bitint(left.resulttype.def) then
|
|
if not (cs_littlesize in aktglobalswitches) then
|
|
shiftval := 63
|
|
else
|
|
{ the shift code is a lot bigger than the call to }
|
|
{ the divide helper }
|
|
exit
|
|
else
|
|
shiftval := 31;
|
|
{ we reuse left twice, so create once a copy of it }
|
|
{ !!! if left is a call is -> call gets executed twice }
|
|
left := caddnode.create(addn,left,
|
|
caddnode.create(andn,
|
|
cshlshrnode.create(sarn,left.getcopy,
|
|
cordconstnode.create(shiftval,s32bittype,false)),
|
|
cordconstnode.create(tordconstnode(right).value-1,
|
|
right.resulttype,false)));
|
|
newtype := sarn;
|
|
end
|
|
else
|
|
*)
|
|
newtype := shrn;
|
|
tordconstnode(right).value := power;
|
|
result := cshlshrnode.create(newtype,left,right)
|
|
end
|
|
else
|
|
begin
|
|
dec(tordconstnode(right).value);
|
|
result := caddnode.create(andn,left,right);
|
|
end;
|
|
{ left and right are reused }
|
|
left := nil;
|
|
right := nil;
|
|
firstpass(result);
|
|
exit;
|
|
end;
|
|
end;
|
|
|
|
|
|
function tmoddivnode.pass_1 : tnode;
|
|
begin
|
|
result:=nil;
|
|
firstpass(left);
|
|
firstpass(right);
|
|
if codegenerror then
|
|
exit;
|
|
|
|
result := firstoptimize;
|
|
if assigned(result) then
|
|
exit;
|
|
{ 64bit }
|
|
if (left.resulttype.def.deftype=orddef) and (right.resulttype.def.deftype=orddef) and
|
|
(is_64bitint(left.resulttype.def) or is_64bitint(right.resulttype.def)) then
|
|
begin
|
|
result := first_moddiv64bitint;
|
|
if assigned(result) then
|
|
exit;
|
|
expectloc:=LOC_REGISTER;
|
|
calcregisters(self,2,0,0);
|
|
end
|
|
else
|
|
begin
|
|
result := first_moddivint;
|
|
if assigned(result) then
|
|
exit;
|
|
left_right_max;
|
|
if left.registers32<=right.registers32 then
|
|
inc(registers32);
|
|
end;
|
|
expectloc:=LOC_REGISTER;
|
|
end;
|
|
|
|
|
|
|
|
{****************************************************************************
|
|
TSHLSHRNODE
|
|
****************************************************************************}
|
|
|
|
|
|
function tshlshrnode.first_shlshr64bitint: tnode;
|
|
var
|
|
procname: string[31];
|
|
begin
|
|
result := nil;
|
|
{ otherwise create a call to a helper }
|
|
if nodetype = shln then
|
|
procname := 'fpc_shl_int64'
|
|
else
|
|
procname := 'fpc_shr_int64';
|
|
{ if is_signed(resulttype.def) then
|
|
procname := procname + 'int64'
|
|
else
|
|
procname := procname + 'qword';
|
|
}
|
|
result := ccallnode.createintern(procname,ccallparanode.create(left,
|
|
ccallparanode.create(right,nil)));
|
|
left := nil;
|
|
right := nil;
|
|
firstpass(result);
|
|
end;
|
|
|
|
|
|
function tshlshrnode.det_resulttype:tnode;
|
|
var
|
|
t : tnode;
|
|
begin
|
|
result:=nil;
|
|
resulttypepass(left);
|
|
resulttypepass(right);
|
|
set_varstate(right,true);
|
|
set_varstate(left,true);
|
|
if codegenerror then
|
|
exit;
|
|
|
|
{ constant folding }
|
|
if is_constintnode(left) and is_constintnode(right) then
|
|
begin
|
|
case nodetype of
|
|
shrn:
|
|
t:=genintconstnode(tordconstnode(left).value shr tordconstnode(right).value);
|
|
shln:
|
|
t:=genintconstnode(tordconstnode(left).value shl tordconstnode(right).value);
|
|
end;
|
|
result:=t;
|
|
exit;
|
|
end;
|
|
|
|
{ allow operator overloading }
|
|
t:=self;
|
|
if isbinaryoverloaded(t) then
|
|
begin
|
|
result:=t;
|
|
exit;
|
|
end;
|
|
|
|
{ 64 bit ints have their own shift handling }
|
|
if not(is_64bitint(left.resulttype.def)) then
|
|
begin
|
|
if torddef(left.resulttype.def).typ <> u32bit then
|
|
inserttypeconv(left,s32bittype);
|
|
end;
|
|
|
|
inserttypeconv(right,s32bittype);
|
|
|
|
resulttype:=left.resulttype;
|
|
end;
|
|
|
|
|
|
function tshlshrnode.pass_1 : tnode;
|
|
var
|
|
regs : longint;
|
|
begin
|
|
result:=nil;
|
|
firstpass(left);
|
|
firstpass(right);
|
|
if codegenerror then
|
|
exit;
|
|
|
|
{ 64 bit ints have their own shift handling }
|
|
if not(is_64bit(left.resulttype.def)) then
|
|
begin
|
|
regs:=1
|
|
end
|
|
else
|
|
begin
|
|
result := first_shlshr64bitint;
|
|
if assigned(result) then
|
|
exit;
|
|
regs:=2;
|
|
end;
|
|
|
|
if (right.nodetype<>ordconstn) then
|
|
inc(regs);
|
|
expectloc:=LOC_REGISTER;
|
|
calcregisters(self,regs,0,0);
|
|
end;
|
|
|
|
|
|
{****************************************************************************
|
|
TUNARYMINUSNODE
|
|
****************************************************************************}
|
|
|
|
constructor tunaryminusnode.create(expr : tnode);
|
|
begin
|
|
inherited create(unaryminusn,expr);
|
|
end;
|
|
|
|
function tunaryminusnode.det_resulttype : tnode;
|
|
var
|
|
t : tnode;
|
|
minusdef : Tprocdef;
|
|
begin
|
|
result:=nil;
|
|
resulttypepass(left);
|
|
set_varstate(left,true);
|
|
if codegenerror then
|
|
exit;
|
|
|
|
{ constant folding }
|
|
if is_constintnode(left) then
|
|
begin
|
|
tordconstnode(left).value:=-tordconstnode(left).value;
|
|
result:=left;
|
|
left:=nil;
|
|
exit;
|
|
end;
|
|
if is_constrealnode(left) then
|
|
begin
|
|
trealconstnode(left).value_real:=-trealconstnode(left).value_real;
|
|
result:=left;
|
|
left:=nil;
|
|
exit;
|
|
end;
|
|
|
|
resulttype:=left.resulttype;
|
|
if (left.resulttype.def.deftype=floatdef) then
|
|
begin
|
|
end
|
|
{$ifdef SUPPORT_MMX}
|
|
else if (cs_mmx in aktlocalswitches) and
|
|
is_mmx_able_array(left.resulttype.def) then
|
|
begin
|
|
{ if saturation is on, left.resulttype.def isn't
|
|
"mmx able" (FK)
|
|
if (cs_mmx_saturation in aktlocalswitches^) and
|
|
(torddef(tarraydef(resulttype.def).definition).typ in
|
|
[s32bit,u32bit]) then
|
|
CGMessage(type_e_mismatch);
|
|
}
|
|
end
|
|
{$endif SUPPORT_MMX}
|
|
else if is_64bitint(left.resulttype.def) then
|
|
begin
|
|
end
|
|
else if (left.resulttype.def.deftype=orddef) then
|
|
begin
|
|
inserttypeconv(left,s32bittype);
|
|
resulttype:=left.resulttype;
|
|
end
|
|
else
|
|
begin
|
|
minusdef:=nil;
|
|
if assigned(overloaded_operators[_minus]) then
|
|
minusdef:=overloaded_operators[_minus].search_procdef_unary_operator(left.resulttype.def);
|
|
if assigned(minusdef) then
|
|
begin
|
|
inc(overloaded_operators[_minus].refs);
|
|
t:=ccallnode.create(ccallparanode.create(left,nil),
|
|
overloaded_operators[_minus],nil,nil);
|
|
left:=nil;
|
|
result:=t;
|
|
exit;
|
|
end;
|
|
CGMessage(type_e_mismatch);
|
|
end;
|
|
end;
|
|
|
|
{ generic code }
|
|
{ overridden by: }
|
|
{ i386 }
|
|
function tunaryminusnode.pass_1 : tnode;
|
|
begin
|
|
result:=nil;
|
|
firstpass(left);
|
|
if codegenerror then
|
|
exit;
|
|
|
|
registers32:=left.registers32;
|
|
registersfpu:=left.registersfpu;
|
|
{$ifdef SUPPORT_MMX}
|
|
registersmmx:=left.registersmmx;
|
|
{$endif SUPPORT_MMX}
|
|
|
|
if (left.resulttype.def.deftype=floatdef) then
|
|
begin
|
|
if (left.expectloc<>LOC_REGISTER) and
|
|
(registersfpu<1) then
|
|
registersfpu:=1;
|
|
expectloc:=LOC_FPUREGISTER;
|
|
end
|
|
{$ifdef SUPPORT_MMX}
|
|
else if (cs_mmx in aktlocalswitches) and
|
|
is_mmx_able_array(left.resulttype.def) then
|
|
begin
|
|
if (left.expectloc<>LOC_MMXREGISTER) and
|
|
(registersmmx<1) then
|
|
registersmmx:=1;
|
|
end
|
|
{$endif SUPPORT_MMX}
|
|
else if is_64bit(left.resulttype.def) then
|
|
begin
|
|
if (left.expectloc<>LOC_REGISTER) and
|
|
(registers32<2) then
|
|
registers32:=2;
|
|
expectloc:=LOC_REGISTER;
|
|
end
|
|
else if (left.resulttype.def.deftype=orddef) then
|
|
begin
|
|
if (left.expectloc<>LOC_REGISTER) and
|
|
(registers32<1) then
|
|
registers32:=1;
|
|
expectloc:=LOC_REGISTER;
|
|
end;
|
|
end;
|
|
|
|
|
|
{****************************************************************************
|
|
TNOTNODE
|
|
****************************************************************************}
|
|
|
|
const boolean_reverse:array[ltn..unequaln] of Tnodetype=
|
|
(gten,gtn,lten,ltn,unequaln,equaln);
|
|
|
|
constructor tnotnode.create(expr : tnode);
|
|
|
|
begin
|
|
inherited create(notn,expr);
|
|
end;
|
|
|
|
function tnotnode.det_resulttype : tnode;
|
|
var
|
|
t : tnode;
|
|
notdef : Tprocdef;
|
|
v : tconstexprint;
|
|
begin
|
|
result:=nil;
|
|
resulttypepass(left);
|
|
set_varstate(left,true);
|
|
if codegenerror then
|
|
exit;
|
|
|
|
resulttype:=left.resulttype;
|
|
|
|
{ Try optmimizing ourself away }
|
|
if left.nodetype=notn then
|
|
begin
|
|
{ Double not. Remove both }
|
|
result:=Tnotnode(left).left;
|
|
Tnotnode(left).left:=nil;
|
|
exit;
|
|
end;
|
|
|
|
if (left.nodetype in [ltn,lten,equaln,unequaln,gtn,gten]) then
|
|
begin
|
|
{ Not of boolean expression. Turn around the operator and remove
|
|
the not. This is not allowed for sets with the gten/lten,
|
|
because there is no ltn/gtn support }
|
|
if (taddnode(left).left.resulttype.def.deftype<>setdef) or
|
|
(left.nodetype in [equaln,unequaln]) then
|
|
begin
|
|
result:=left;
|
|
left.nodetype:=boolean_reverse[left.nodetype];
|
|
left:=nil;
|
|
exit;
|
|
end;
|
|
end;
|
|
|
|
{ constant folding }
|
|
if (left.nodetype=ordconstn) then
|
|
begin
|
|
v:=tordconstnode(left).value;
|
|
case torddef(left.resulttype.def).typ of
|
|
bool8bit,
|
|
bool16bit,
|
|
bool32bit :
|
|
begin
|
|
{ here we do a boolean(byte(..)) type cast because }
|
|
{ boolean(<int64>) is buggy in 1.00 }
|
|
v:=byte(not(boolean(byte(v))));
|
|
end;
|
|
uchar,
|
|
u8bit :
|
|
v:=byte(not byte(v));
|
|
s8bit :
|
|
v:=shortint(not shortint(v));
|
|
uwidechar,
|
|
u16bit :
|
|
v:=word(not word(v));
|
|
s16bit :
|
|
v:=smallint(not smallint(v));
|
|
u32bit :
|
|
v:=cardinal(not cardinal(v));
|
|
s32bit :
|
|
v:=longint(not longint(v));
|
|
u64bit :
|
|
v:=int64(not int64(v)); { maybe qword is required }
|
|
s64bit :
|
|
v:=int64(not int64(v));
|
|
else
|
|
CGMessage(type_e_mismatch);
|
|
end;
|
|
t:=cordconstnode.create(v,left.resulttype,true);
|
|
result:=t;
|
|
exit;
|
|
end;
|
|
|
|
if is_boolean(resulttype.def) then
|
|
begin
|
|
end
|
|
else
|
|
{$ifdef SUPPORT_MMX}
|
|
if (cs_mmx in aktlocalswitches) and
|
|
is_mmx_able_array(left.resulttype.def) then
|
|
begin
|
|
end
|
|
else
|
|
{$endif SUPPORT_MMX}
|
|
if is_64bitint(left.resulttype.def) then
|
|
begin
|
|
end
|
|
else if is_integer(left.resulttype.def) then
|
|
begin
|
|
end
|
|
else
|
|
begin
|
|
notdef:=nil;
|
|
if assigned(overloaded_operators[_op_not]) then
|
|
notdef:=overloaded_operators[_op_not].search_procdef_unary_operator(left.resulttype.def);
|
|
if notdef<>nil then
|
|
begin
|
|
inc(overloaded_operators[_op_not].refs);
|
|
t:=ccallnode.create(ccallparanode.create(left,nil),
|
|
overloaded_operators[_op_not],nil,nil);
|
|
left:=nil;
|
|
result:=t;
|
|
exit;
|
|
end;
|
|
CGMessage(type_e_mismatch);
|
|
end;
|
|
end;
|
|
|
|
|
|
function tnotnode.pass_1 : tnode;
|
|
begin
|
|
result:=nil;
|
|
firstpass(left);
|
|
if codegenerror then
|
|
exit;
|
|
|
|
expectloc:=left.expectloc;
|
|
registers32:=left.registers32;
|
|
{$ifdef SUPPORT_MMX}
|
|
registersmmx:=left.registersmmx;
|
|
{$endif SUPPORT_MMX}
|
|
if is_boolean(resulttype.def) then
|
|
begin
|
|
if (expectloc in [LOC_REFERENCE,LOC_CREFERENCE,LOC_CREGISTER]) then
|
|
begin
|
|
expectloc:=LOC_REGISTER;
|
|
if (registers32<1) then
|
|
registers32:=1;
|
|
end;
|
|
{ before loading it into flags we need to load it into
|
|
a register thus 1 register is need PM }
|
|
{$ifdef cpuflags}
|
|
if left.expectloc<>LOC_JUMP then
|
|
expectloc:=LOC_FLAGS;
|
|
{$endif def cpuflags}
|
|
end
|
|
else
|
|
{$ifdef SUPPORT_MMX}
|
|
if (cs_mmx in aktlocalswitches) and
|
|
is_mmx_able_array(left.resulttype.def) then
|
|
begin
|
|
if (left.expectloc<>LOC_MMXREGISTER) and
|
|
(registersmmx<1) then
|
|
registersmmx:=1;
|
|
end
|
|
else
|
|
{$endif SUPPORT_MMX}
|
|
if is_64bit(left.resulttype.def) then
|
|
begin
|
|
if (expectloc in [LOC_REFERENCE,LOC_CREFERENCE,LOC_CREGISTER]) then
|
|
begin
|
|
expectloc:=LOC_REGISTER;
|
|
if (registers32<2) then
|
|
registers32:=2;
|
|
end;
|
|
end
|
|
else if is_integer(left.resulttype.def) then
|
|
begin
|
|
if (left.expectloc<>LOC_REGISTER) and
|
|
(registers32<1) then
|
|
registers32:=1;
|
|
expectloc:=LOC_REGISTER;
|
|
end
|
|
end;
|
|
|
|
{$ifdef state_tracking}
|
|
function Tnotnode.track_state_pass(exec_known:boolean):boolean;
|
|
|
|
begin
|
|
track_state_pass:=true;
|
|
if left.track_state_pass(exec_known) then
|
|
begin
|
|
left.resulttype.def:=nil;
|
|
do_resulttypepass(left);
|
|
end;
|
|
end;
|
|
{$endif}
|
|
|
|
begin
|
|
cmoddivnode:=tmoddivnode;
|
|
cshlshrnode:=tshlshrnode;
|
|
cunaryminusnode:=tunaryminusnode;
|
|
cnotnode:=tnotnode;
|
|
end.
|
|
{
|
|
$Log$
|
|
Revision 1.51 2003-09-07 22:09:35 peter
|
|
* preparations for different default calling conventions
|
|
* various RA fixes
|
|
|
|
Revision 1.50 2003/09/03 11:18:37 florian
|
|
* fixed arm concatcopy
|
|
+ arm support in the common compiler sources added
|
|
* moved some generic cg code around
|
|
+ tfputype added
|
|
* ...
|
|
|
|
Revision 1.49 2003/05/24 16:32:34 jonas
|
|
* fixed expectloc of notnode for all processors that have flags
|
|
|
|
Revision 1.48 2003/05/09 17:47:02 peter
|
|
* self moved to hidden parameter
|
|
* removed hdisposen,hnewn,selfn
|
|
|
|
Revision 1.47 2003/04/25 20:59:33 peter
|
|
* removed funcretn,funcretsym, function result is now in varsym
|
|
and aliases for result and function name are added using absolutesym
|
|
* vs_hidden parameter for funcret passed in parameter
|
|
* vs_hidden fixes
|
|
* writenode changed to printnode and released from extdebug
|
|
* -vp option added to generate a tree.log with the nodetree
|
|
* nicer printnode for statements, callnode
|
|
|
|
Revision 1.46 2003/04/23 20:16:04 peter
|
|
+ added currency support based on int64
|
|
+ is_64bit for use in cg units instead of is_64bitint
|
|
* removed cgmessage from n386add, replace with internalerrors
|
|
|
|
Revision 1.45 2003/04/22 23:50:23 peter
|
|
* firstpass uses expectloc
|
|
* checks if there are differences between the expectloc and
|
|
location.loc from secondpass in EXTDEBUG
|
|
|
|
Revision 1.44 2002/11/25 17:43:20 peter
|
|
* splitted defbase in defutil,symutil,defcmp
|
|
* merged isconvertable and is_equal into compare_defs(_ext)
|
|
* made operator search faster by walking the list only once
|
|
|
|
Revision 1.43 2002/10/04 21:19:28 jonas
|
|
* fixed web bug 2139: checking for division by zero fixed
|
|
|
|
Revision 1.42 2002/09/07 12:16:04 carl
|
|
* second part bug report 1996 fix, testrange in cordconstnode
|
|
only called if option is set (also make parsing a tiny faster)
|
|
|
|
Revision 1.41 2002/09/03 16:26:26 daniel
|
|
* Make Tprocdef.defs protected
|
|
|
|
Revision 1.40 2002/08/25 11:32:33 peter
|
|
* don't optimize not([lten,gten]) for setdefs
|
|
|
|
Revision 1.39 2002/08/25 09:10:58 peter
|
|
* fixed not(not()) removal
|
|
|
|
Revision 1.38 2002/08/15 15:09:42 carl
|
|
+ fpu emulation helpers (ppu checking also)
|
|
|
|
Revision 1.37 2002/08/14 19:26:55 carl
|
|
+ generic int_to_real type conversion
|
|
+ generic unaryminus node
|
|
|
|
Revision 1.36 2002/07/20 11:57:54 florian
|
|
* types.pas renamed to defbase.pas because D6 contains a types
|
|
unit so this would conflicts if D6 programms are compiled
|
|
+ Willamette/SSE2 instructions to assembler added
|
|
|
|
Revision 1.35 2002/07/19 11:41:36 daniel
|
|
* State tracker work
|
|
* The whilen and repeatn are now completely unified into whilerepeatn. This
|
|
allows the state tracker to change while nodes automatically into
|
|
repeat nodes.
|
|
* Resulttypepass improvements to the notn. 'not not a' is optimized away and
|
|
'not(a>b)' is optimized into 'a<=b'.
|
|
* Resulttypepass improvements to the whilerepeatn. 'while not a' is optimized
|
|
by removing the notn and later switchting the true and falselabels. The
|
|
same is done with 'repeat until not a'.
|
|
|
|
Revision 1.34 2002/05/18 13:34:10 peter
|
|
* readded missing revisions
|
|
|
|
Revision 1.33 2002/05/16 19:46:39 carl
|
|
+ defines.inc -> fpcdefs.inc to avoid conflicts if compiling by hand
|
|
+ try to fix temp allocation (still in ifdef)
|
|
+ generic constructor calls
|
|
+ start of tassembler / tmodulebase class cleanup
|
|
|
|
Revision 1.31 2002/04/07 13:26:10 carl
|
|
+ change unit use
|
|
|
|
Revision 1.30 2002/04/02 17:11:29 peter
|
|
* tlocation,treference update
|
|
* LOC_CONSTANT added for better constant handling
|
|
* secondadd splitted in multiple routines
|
|
* location_force_reg added for loading a location to a register
|
|
of a specified size
|
|
* secondassignment parses now first the right and then the left node
|
|
(this is compatible with Kylix). This saves a lot of push/pop especially
|
|
with string operations
|
|
* adapted some routines to use the new cg methods
|
|
|
|
Revision 1.29 2002/03/04 19:10:11 peter
|
|
* removed compiler warnings
|
|
|
|
Revision 1.28 2002/02/11 11:45:51 michael
|
|
* Compilation without mmx support fixed from Peter
|
|
|
|
}
|