fpc/compiler/nadd.pas
Jonas Maebe ed449defca + searchsystype() and searchsystype() functions in symtable
* changed ninl and nadd to use these functions
  * i386 set comparison functions now return their results in al instead
    of in the flags so that they can be sued as compilerprocs
  - removed all processor specific code from n386add.pas that has to do
    with set handling, it's now all done in nadd.pas
  * fixed fpc_set_contains_sets in genset.inc
  * fpc_set_in_byte is now coded inline in n386set.pas and doesn't use a
    helper anymore
  * some small fixes in compproc.inc/set.inc regarding the declaration of
    internal helper types (fpc_small_set and fpc_normal_set)
2001-09-04 11:38:54 +00:00

1686 lines
65 KiB
ObjectPascal

{
$Id$
Copyright (c) 1998-2000 by Florian Klaempfl
Type checking and register allocation for add 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 nadd;
{$i defines.inc}
interface
uses
node;
type
taddnode = class(tbinopnode)
constructor create(tt : tnodetype;l,r : tnode);override;
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_addstring: tnode; virtual;
function first_addset: tnode; virtual;
end;
taddnodeclass = class of taddnode;
var
{ caddnode is used to create nodes of the add type }
{ the virtual constructor allows to assign }
{ another class type to caddnode => processor }
{ specific node types can be created }
caddnode : taddnodeclass;
implementation
uses
globtype,systems,
cutils,verbose,globals,widestr,
symconst,symtype,symbase,symdef,symsym,symtable,types,
cpuinfo,
cgbase,
htypechk,pass_1,
nmat,ncnv,nld,ncon,nset,nopt,ncal,ninl,
cpubase;
{*****************************************************************************
TADDNODE
*****************************************************************************}
{$ifdef fpc}
{$maxfpuregisters 0}
{$endif fpc}
constructor taddnode.create(tt : tnodetype;l,r : tnode);
begin
inherited create(tt,l,r);
end;
function taddnode.det_resulttype:tnode;
var
hp,t : tnode;
lt,rt : tnodetype;
rd,ld : tdef;
htype : ttype;
ot : tnodetype;
concatstrings : boolean;
resultset : pconstset;
i : longint;
b : boolean;
s1,s2 : pchar;
ws1,ws2 : pcompilerwidestring;
l1,l2 : longint;
rv,lv : tconstexprint;
rvd,lvd : bestreal;
begin
result:=nil;
{ first do the two subtrees }
resulttypepass(left);
resulttypepass(right);
{ both left and right need to be valid }
set_varstate(left,true);
set_varstate(right,true);
if codegenerror then
exit;
{ convert array constructors to sets, because there is no other operator
possible for array constructors }
if is_array_constructor(left.resulttype.def) then
begin
arrayconstructor_to_set(tarrayconstructornode(left));
resulttypepass(left);
end;
if is_array_constructor(right.resulttype.def) then
begin
arrayconstructor_to_set(tarrayconstructornode(right));
resulttypepass(right);
end;
{ allow operator overloading }
hp:=self;
if isbinaryoverloaded(hp) then
begin
result:=hp;
exit;
end;
{ Kylix allows enum+ordconstn in an enum declaration (blocktype
is bt_type), we need to do the conversion here before the
constant folding }
if (m_delphi in aktmodeswitches) and
(blocktype=bt_type) then
begin
if (left.resulttype.def.deftype=enumdef) and
(right.resulttype.def.deftype=orddef) then
begin
{ insert explicit typecast to s32bit }
left:=ctypeconvnode.create(left,s32bittype);
include(left.flags,nf_explizit);
resulttypepass(left);
end
else
if (left.resulttype.def.deftype=orddef) and
(right.resulttype.def.deftype=enumdef) then
begin
{ insert explicit typecast to s32bit }
right:=ctypeconvnode.create(right,s32bittype);
include(right.flags,nf_explizit);
resulttypepass(right);
end;
end;
{ is one a real float, then both need to be floats, this
need to be done before the constant folding so constant
operation on a float and int are also handled }
if (right.resulttype.def.deftype=floatdef) or (left.resulttype.def.deftype=floatdef) then
begin
inserttypeconv(right,pbestrealtype^);
inserttypeconv(left,pbestrealtype^);
end;
{ if one operand is a widechar or a widestring, both operands }
{ are converted to widestring. This must be done before constant }
{ folding to allow char+widechar etc. }
if is_widestring(right.resulttype.def) or
is_widestring(left.resulttype.def) or
is_widechar(right.resulttype.def) or
is_widechar(left.resulttype.def) then
begin
inserttypeconv(right,cwidestringtype);
inserttypeconv(left,cwidestringtype);
end;
{ load easier access variables }
rd:=right.resulttype.def;
ld:=left.resulttype.def;
rt:=right.nodetype;
lt:=left.nodetype;
{ both are int constants }
if (((is_constintnode(left) and is_constintnode(right)) or
(is_constboolnode(left) and is_constboolnode(right) and
(nodetype in [ltn,lten,gtn,gten,equaln,unequaln,andn,xorn,orn])))) or
{ support pointer arithmetics on constants (JM) }
((lt = pointerconstn) and is_constintnode(right) and
(nodetype in [addn,subn])) or
((lt = pointerconstn) and (rt = pointerconstn) and
(nodetype in [ltn,lten,gtn,gten,equaln,unequaln,subn])) then
begin
{ when comparing/substracting pointers, make sure they are }
{ of the same type (JM) }
if (lt = pointerconstn) and (rt = pointerconstn) then
begin
if not(cs_extsyntax in aktmoduleswitches) and
not(nodetype in [equaln,unequaln]) then
CGMessage(type_e_mismatch)
else
if (nodetype <> subn) and
is_voidpointer(rd) then
inserttypeconv(right,left.resulttype)
else if (nodetype <> subn) and
is_voidpointer(ld) then
inserttypeconv(left,right.resulttype)
else if not(is_equal(ld,rd)) then
CGMessage(type_e_mismatch);
end
else if (lt=ordconstn) and (rt=ordconstn) then
begin
{ make left const type the biggest, this type will be used
for orn,andn,xorn }
if rd.size>ld.size then
inserttypeconv(left,right.resulttype);
end;
{ load values }
if (lt = ordconstn) then
lv:=tordconstnode(left).value
else
lv:=tpointerconstnode(left).value;
if (rt = ordconstn) then
rv:=tordconstnode(right).value
else
rv:=tpointerconstnode(right).value;
if (lt = pointerconstn) and
(rt <> pointerconstn) then
rv := rv * tpointerdef(left.resulttype.def).pointertype.def.size;
if (rt = pointerconstn) and
(lt <> pointerconstn) then
lv := lv * tpointerdef(right.resulttype.def).pointertype.def.size;
case nodetype of
addn :
if (lt <> pointerconstn) then
t := genintconstnode(lv+rv)
else
t := cpointerconstnode.create(lv+rv,left.resulttype);
subn :
if (lt <> pointerconstn) or (rt = pointerconstn) then
t := genintconstnode(lv-rv)
else
t := cpointerconstnode.create(lv-rv,left.resulttype);
muln :
t:=genintconstnode(lv*rv);
xorn :
t:=cordconstnode.create(lv xor rv,left.resulttype);
orn :
t:=cordconstnode.create(lv or rv,left.resulttype);
andn :
t:=cordconstnode.create(lv and rv,left.resulttype);
ltn :
t:=cordconstnode.create(ord(lv<rv),booltype);
lten :
t:=cordconstnode.create(ord(lv<=rv),booltype);
gtn :
t:=cordconstnode.create(ord(lv>rv),booltype);
gten :
t:=cordconstnode.create(ord(lv>=rv),booltype);
equaln :
t:=cordconstnode.create(ord(lv=rv),booltype);
unequaln :
t:=cordconstnode.create(ord(lv<>rv),booltype);
slashn :
begin
{ int/int becomes a real }
rvd:=rv;
lvd:=lv;
if int(rvd)=0 then
begin
Message(parser_e_invalid_float_operation);
t:=crealconstnode.create(0,pbestrealtype^);
end
else
t:=crealconstnode.create(int(lvd)/int(rvd),pbestrealtype^);
end;
else
CGMessage(type_e_mismatch);
end;
result:=t;
exit;
end;
{ both real constants ? }
if (lt=realconstn) and (rt=realconstn) then
begin
lvd:=trealconstnode(left).value_real;
rvd:=trealconstnode(right).value_real;
case nodetype of
addn :
t:=crealconstnode.create(lvd+rvd,pbestrealtype^);
subn :
t:=crealconstnode.create(lvd-rvd,pbestrealtype^);
muln :
t:=crealconstnode.create(lvd*rvd,pbestrealtype^);
starstarn,
caretn :
begin
if lvd<0 then
begin
Message(parser_e_invalid_float_operation);
t:=crealconstnode.create(0,pbestrealtype^);
end
else if lvd=0 then
t:=crealconstnode.create(1.0,pbestrealtype^)
else
t:=crealconstnode.create(exp(ln(lvd)*rvd),pbestrealtype^);
end;
slashn :
begin
if rvd=0 then
begin
Message(parser_e_invalid_float_operation);
t:=crealconstnode.create(0,pbestrealtype^);
end
else
t:=crealconstnode.create(lvd/rvd,pbestrealtype^);
end;
ltn :
t:=cordconstnode.create(ord(lvd<rvd),booltype);
lten :
t:=cordconstnode.create(ord(lvd<=rvd),booltype);
gtn :
t:=cordconstnode.create(ord(lvd>rvd),booltype);
gten :
t:=cordconstnode.create(ord(lvd>=rvd),booltype);
equaln :
t:=cordconstnode.create(ord(lvd=rvd),booltype);
unequaln :
t:=cordconstnode.create(ord(lvd<>rvd),booltype);
else
CGMessage(type_e_mismatch);
end;
result:=t;
exit;
end;
{ first, we handle widestrings, so we can check later for }
{ stringconstn only }
{ widechars are converted above to widestrings too }
{ this isn't veryy efficient, but I don't think }
{ that it does matter that much (FK) }
if (lt=stringconstn) and (rt=stringconstn) and
(tstringconstnode(left).st_type=st_widestring) and
(tstringconstnode(right).st_type=st_widestring) then
begin
initwidestring(ws1);
initwidestring(ws2);
copywidestring(pcompilerwidestring(tstringconstnode(left).value_str),ws1);
copywidestring(pcompilerwidestring(tstringconstnode(right).value_str),ws2);
case nodetype of
addn :
begin
concatwidestrings(ws1,ws2);
t:=cstringconstnode.createwstr(ws1);
end;
ltn :
t:=cordconstnode.create(byte(comparewidestrings(ws1,ws2)<0),booltype);
lten :
t:=cordconstnode.create(byte(comparewidestrings(ws1,ws2)<=0),booltype);
gtn :
t:=cordconstnode.create(byte(comparewidestrings(ws1,ws2)>0),booltype);
gten :
t:=cordconstnode.create(byte(comparewidestrings(ws1,ws2)>=0),booltype);
equaln :
t:=cordconstnode.create(byte(comparewidestrings(ws1,ws2)=0),booltype);
unequaln :
t:=cordconstnode.create(byte(comparewidestrings(ws1,ws2)<>0),booltype);
end;
donewidestring(ws1);
donewidestring(ws2);
result:=t;
exit;
end;
{ concating strings ? }
concatstrings:=false;
s1:=nil;
s2:=nil;
if (lt=ordconstn) and (rt=ordconstn) and
is_char(ld) and is_char(rd) then
begin
s1:=strpnew(char(byte(tordconstnode(left).value)));
s2:=strpnew(char(byte(tordconstnode(right).value)));
l1:=1;
l2:=1;
concatstrings:=true;
end
else
if (lt=stringconstn) and (rt=ordconstn) and is_char(rd) then
begin
s1:=tstringconstnode(left).getpcharcopy;
l1:=tstringconstnode(left).len;
s2:=strpnew(char(byte(tordconstnode(right).value)));
l2:=1;
concatstrings:=true;
end
else
if (lt=ordconstn) and (rt=stringconstn) and is_char(ld) then
begin
s1:=strpnew(char(byte(tordconstnode(left).value)));
l1:=1;
s2:=tstringconstnode(right).getpcharcopy;
l2:=tstringconstnode(right).len;
concatstrings:=true;
end
else if (lt=stringconstn) and (rt=stringconstn) then
begin
s1:=tstringconstnode(left).getpcharcopy;
l1:=tstringconstnode(left).len;
s2:=tstringconstnode(right).getpcharcopy;
l2:=tstringconstnode(right).len;
concatstrings:=true;
end;
if concatstrings then
begin
case nodetype of
addn :
t:=cstringconstnode.createpchar(concatansistrings(s1,s2,l1,l2),l1+l2);
ltn :
t:=cordconstnode.create(byte(compareansistrings(s1,s2,l1,l2)<0),booltype);
lten :
t:=cordconstnode.create(byte(compareansistrings(s1,s2,l1,l2)<=0),booltype);
gtn :
t:=cordconstnode.create(byte(compareansistrings(s1,s2,l1,l2)>0),booltype);
gten :
t:=cordconstnode.create(byte(compareansistrings(s1,s2,l1,l2)>=0),booltype);
equaln :
t:=cordconstnode.create(byte(compareansistrings(s1,s2,l1,l2)=0),booltype);
unequaln :
t:=cordconstnode.create(byte(compareansistrings(s1,s2,l1,l2)<>0),booltype);
end;
ansistringdispose(s1,l1);
ansistringdispose(s2,l2);
result:=t;
exit;
end;
{ set constant evaluation }
if (right.nodetype=setconstn) and
not assigned(tsetconstnode(right).left) and
(left.nodetype=setconstn) and
not assigned(tsetconstnode(left).left) then
begin
{ check types }
inserttypeconv(left,right.resulttype);
if codegenerror then
begin
{ recover by only returning the left part }
result:=left;
left:=nil;
exit;
end;
new(resultset);
case nodetype of
addn :
begin
for i:=0 to 31 do
resultset^[i]:=tsetconstnode(right).value_set^[i] or tsetconstnode(left).value_set^[i];
t:=csetconstnode.create(resultset,left.resulttype);
end;
muln :
begin
for i:=0 to 31 do
resultset^[i]:=tsetconstnode(right).value_set^[i] and tsetconstnode(left).value_set^[i];
t:=csetconstnode.create(resultset,left.resulttype);
end;
subn :
begin
for i:=0 to 31 do
resultset^[i]:=tsetconstnode(left).value_set^[i] and not(tsetconstnode(right).value_set^[i]);
t:=csetconstnode.create(resultset,left.resulttype);
end;
symdifn :
begin
for i:=0 to 31 do
resultset^[i]:=tsetconstnode(left).value_set^[i] xor tsetconstnode(right).value_set^[i];
t:=csetconstnode.create(resultset,left.resulttype);
end;
unequaln :
begin
b:=true;
for i:=0 to 31 do
if tsetconstnode(right).value_set^[i]=tsetconstnode(left).value_set^[i] then
begin
b:=false;
break;
end;
t:=cordconstnode.create(ord(b),booltype);
end;
equaln :
begin
b:=true;
for i:=0 to 31 do
if tsetconstnode(right).value_set^[i]<>tsetconstnode(left).value_set^[i] then
begin
b:=false;
break;
end;
t:=cordconstnode.create(ord(b),booltype);
end;
lten :
begin
b := true;
For i := 0 to 31 Do
If (tsetconstnode(right).value_set^[i] And tsetconstnode(left).value_set^[i]) <>
tsetconstnode(left).value_set^[i] Then
Begin
b := false;
Break
End;
t := cordconstnode.create(ord(b),booltype);
End;
gten :
Begin
b := true;
For i := 0 to 31 Do
If (tsetconstnode(left).value_set^[i] And tsetconstnode(right).value_set^[i]) <>
tsetconstnode(right).value_set^[i] Then
Begin
b := false;
Break
End;
t := cordconstnode.create(ord(b),booltype);
End;
end;
dispose(resultset);
result:=t;
exit;
end;
{ but an int/int gives real/real! }
if nodetype=slashn then
begin
CGMessage(type_h_use_div_for_int);
inserttypeconv(right,pbestrealtype^);
inserttypeconv(left,pbestrealtype^);
end
{ if both are orddefs then check sub types }
else if (ld.deftype=orddef) and (rd.deftype=orddef) then
begin
{ 2 booleans? Make them equal to the largest boolean }
if is_boolean(ld) and is_boolean(rd) then
begin
if torddef(left.resulttype.def).size>torddef(right.resulttype.def).size then
begin
inserttypeconv(right,left.resulttype);
ttypeconvnode(right).convtype:=tc_bool_2_int;
include(right.flags,nf_explizit);
end
else if torddef(left.resulttype.def).size<torddef(right.resulttype.def).size then
begin
inserttypeconv(left,right.resulttype);
ttypeconvnode(left).convtype:=tc_bool_2_int;
include(left.flags,nf_explizit);
end;
case nodetype of
xorn,
ltn,
lten,
gtn,
gten,
andn,
orn:
begin
end;
unequaln,
equaln:
begin
if not(cs_full_boolean_eval in aktlocalswitches) then
begin
{ Remove any compares with constants }
if (left.nodetype=ordconstn) then
begin
hp:=right;
b:=(tordconstnode(left).value<>0);
ot:=nodetype;
left.free;
left:=nil;
right:=nil;
if (not(b) and (ot=equaln)) or
(b and (ot=unequaln)) then
begin
hp:=cnotnode.create(hp);
end;
result:=hp;
exit;
end;
if (right.nodetype=ordconstn) then
begin
hp:=left;
b:=(tordconstnode(right).value<>0);
ot:=nodetype;
right.free;
right:=nil;
left:=nil;
if (not(b) and (ot=equaln)) or
(b and (ot=unequaln)) then
begin
hp:=cnotnode.create(hp);
end;
result:=hp;
exit;
end;
end;
end;
else
CGMessage(type_e_mismatch);
end;
end
{ Both are chars? }
else if is_char(rd) and is_char(ld) then
begin
if nodetype=addn then
begin
resulttype:=cshortstringtype;
if not(is_constcharnode(left) and is_constcharnode(right)) then
begin
inserttypeconv(left,cshortstringtype);
hp := genaddsstringcharoptnode(self);
result := hp;
exit;
end;
end;
end
{ is there a signed 64 bit type ? }
else if ((torddef(rd).typ=s64bit) or (torddef(ld).typ=s64bit)) then
begin
if (torddef(ld).typ<>s64bit) then
inserttypeconv(left,cs64bittype);
if (torddef(rd).typ<>s64bit) then
inserttypeconv(right,cs64bittype);
end
{ is there a unsigned 64 bit type ? }
else if ((torddef(rd).typ=u64bit) or (torddef(ld).typ=u64bit)) then
begin
if (torddef(ld).typ<>u64bit) then
inserttypeconv(left,cu64bittype);
if (torddef(rd).typ<>u64bit) then
inserttypeconv(right,cu64bittype);
end
{ is there a cardinal? }
else if ((torddef(rd).typ=u32bit) or (torddef(ld).typ=u32bit)) then
begin
if is_signed(ld) and
{ then rd = u32bit }
{ convert positive constants to u32bit }
not(is_constintnode(left) and
(tordconstnode(left).value >= 0)) and
{ range/overflow checking on mixed signed/cardinal expressions }
{ is only possible if you convert everything to 64bit (JM) }
((aktlocalswitches * [cs_check_overflow,cs_check_range] <> []) and
(nodetype in [addn,subn,muln])) then
begin
{ perform the operation in 64bit }
CGMessage(type_w_mixed_signed_unsigned);
inserttypeconv(left,cs64bittype);
inserttypeconv(right,cs64bittype);
end
else
begin
if is_signed(ld) and
not(is_constintnode(left) and
(tordconstnode(left).value >= 0)) and
(cs_check_range in aktlocalswitches) then
CGMessage(type_w_mixed_signed_unsigned2);
inserttypeconv(left,u32bittype);
if is_signed(rd) and
{ then ld = u32bit }
{ convert positive constants to u32bit }
not(is_constintnode(right) and
(tordconstnode(right).value >= 0)) and
((aktlocalswitches * [cs_check_overflow,cs_check_range] <> []) and
(nodetype in [addn,subn,muln])) then
begin
{ perform the operation in 64bit }
CGMessage(type_w_mixed_signed_unsigned);
inserttypeconv(left,cs64bittype);
inserttypeconv(right,cs64bittype);
end
else
begin
if is_signed(rd) and
not(is_constintnode(right) and
(tordconstnode(right).value >= 0)) and
(cs_check_range in aktlocalswitches) then
CGMessage(type_w_mixed_signed_unsigned2);
inserttypeconv(right,u32bittype);
end;
end;
end
{ generic ord conversion is s32bit }
else
begin
inserttypeconv(right,s32bittype);
inserttypeconv(left,s32bittype);
end;
end
{ if both are floatdefs, conversion is already done before constant folding }
else if (ld.deftype=floatdef) then
begin
{ already converted }
end
{ left side a setdef, must be before string processing,
else array constructor can be seen as array of char (PFV) }
else if (ld.deftype=setdef) then
begin
{ trying to add a set element? }
if (nodetype=addn) and (rd.deftype<>setdef) then
begin
if (rt=setelementn) then
begin
if not(is_equal(tsetdef(ld).elementtype.def,rd)) then
CGMessage(type_e_set_element_are_not_comp);
end
else
CGMessage(type_e_mismatch)
end
else
begin
if not(nodetype in [addn,subn,symdifn,muln,equaln,unequaln,lten,gten]) then
CGMessage(type_e_set_operation_unknown);
{ right def must be a also be set }
if (rd.deftype<>setdef) or not(is_equal(rd,ld)) then
CGMessage(type_e_set_element_are_not_comp);
end;
{ ranges require normsets }
if (tsetdef(ld).settype=smallset) and
(rt=setelementn) and
assigned(tsetelementnode(right).right) then
begin
{ generate a temporary normset def, it'll be destroyed
when the symtable is unloaded }
htype.setdef(tsetdef.create(tsetdef(ld).elementtype,255));
inserttypeconv(left,htype);
end;
{ if the destination is not a smallset then insert a typeconv
which loads a smallset into a normal set }
if (tsetdef(ld).settype<>smallset) and
(tsetdef(rd).settype=smallset) then
begin
if (right.nodetype=setconstn) then
begin
t:=csetconstnode.create(tsetconstnode(right).value_set,left.resulttype);
tsetconstnode(t).left:=tsetconstnode(right).left;
tsetconstnode(right).left := nil;
right.free;
right:=t;
end
else
inserttypeconv(right,left.resulttype);
resulttypepass(right);
end;
end
{ compare pchar to char arrays by addresses like BP/Delphi }
else if (is_pchar(ld) and is_chararray(rd)) or
(is_pchar(rd) and is_chararray(ld)) then
begin
if is_chararray(rd) then
inserttypeconv(right,left.resulttype)
else
inserttypeconv(left,right.resulttype);
end
{ is one of the operands a string?,
chararrays are also handled as strings (after conversion), also take
care of chararray+chararray and chararray+char }
else if (rd.deftype=stringdef) or (ld.deftype=stringdef) or
((is_chararray(rd) or is_char(rd)) and
(is_chararray(ld) or is_char(ld))) then
begin
if is_widestring(rd) or is_widestring(ld) then
begin
if not(is_widestring(rd)) then
inserttypeconv(right,cwidestringtype);
if not(is_widestring(ld)) then
inserttypeconv(left,cwidestringtype);
end
else if is_ansistring(rd) or is_ansistring(ld) then
begin
if not(is_ansistring(rd)) then
inserttypeconv(right,cansistringtype);
if not(is_ansistring(ld)) then
inserttypeconv(left,cansistringtype);
end
else if is_longstring(rd) or is_longstring(ld) then
begin
if not(is_longstring(rd)) then
inserttypeconv(right,clongstringtype);
if not(is_longstring(ld)) then
inserttypeconv(left,clongstringtype);
location.loc:=LOC_MEM;
end
else
begin
if not(is_shortstring(ld)) then
inserttypeconv(left,cshortstringtype);
{ don't convert char, that can be handled by the optimized node }
if not(is_shortstring(rd) or is_char(rd)) then
inserttypeconv(right,cshortstringtype);
end;
end
{ pointer comparision and subtraction }
else if (rd.deftype=pointerdef) and (ld.deftype=pointerdef) then
begin
case nodetype of
equaln,unequaln :
begin
if is_voidpointer(right.resulttype.def) then
inserttypeconv(right,left.resulttype)
else if is_voidpointer(left.resulttype.def) then
inserttypeconv(left,right.resulttype)
else if not(is_equal(ld,rd)) then
CGMessage(type_e_mismatch);
end;
ltn,lten,gtn,gten:
begin
if (cs_extsyntax in aktmoduleswitches) then
begin
if is_voidpointer(right.resulttype.def) then
inserttypeconv(right,left.resulttype)
else if is_voidpointer(left.resulttype.def) then
inserttypeconv(left,right.resulttype)
else if not(is_equal(ld,rd)) then
CGMessage(type_e_mismatch);
end
else
CGMessage(type_e_mismatch);
end;
subn:
begin
if (cs_extsyntax in aktmoduleswitches) then
begin
if is_voidpointer(right.resulttype.def) then
inserttypeconv(right,left.resulttype)
else if is_voidpointer(left.resulttype.def) then
inserttypeconv(left,right.resulttype)
else if not(is_equal(ld,rd)) then
CGMessage(type_e_mismatch);
end
else
CGMessage(type_e_mismatch);
resulttype:=s32bittype;
exit;
end;
addn:
begin
if (cs_extsyntax in aktmoduleswitches) then
begin
if is_voidpointer(right.resulttype.def) then
inserttypeconv(right,left.resulttype)
else if is_voidpointer(left.resulttype.def) then
inserttypeconv(left,right.resulttype)
else if not(is_equal(ld,rd)) then
CGMessage(type_e_mismatch);
end
else
CGMessage(type_e_mismatch);
resulttype:=s32bittype;
exit;
end;
else
CGMessage(type_e_mismatch);
end;
end
{ class or interface equation }
else if is_class_or_interface(rd) or is_class_or_interface(ld) then
begin
if is_class_or_interface(rd) and is_class_or_interface(ld) then
begin
if tobjectdef(rd).is_related(tobjectdef(ld)) then
inserttypeconv(right,left.resulttype)
else
inserttypeconv(left,right.resulttype);
end
else if is_class_or_interface(rd) then
inserttypeconv(left,right.resulttype)
else
inserttypeconv(right,left.resulttype);
if not(nodetype in [equaln,unequaln]) then
CGMessage(type_e_mismatch);
end
else if (rd.deftype=classrefdef) and (ld.deftype=classrefdef) then
begin
if tobjectdef(tclassrefdef(rd).pointertype.def).is_related(
tobjectdef(tclassrefdef(ld).pointertype.def)) then
inserttypeconv(right,left.resulttype)
else
inserttypeconv(left,right.resulttype);
if not(nodetype in [equaln,unequaln]) then
CGMessage(type_e_mismatch);
end
{ allows comperasion with nil pointer }
else if is_class_or_interface(rd) or (rd.deftype=classrefdef) then
begin
inserttypeconv(left,right.resulttype);
if not(nodetype in [equaln,unequaln]) then
CGMessage(type_e_mismatch);
end
else if is_class_or_interface(ld) or (ld.deftype=classrefdef) then
begin
inserttypeconv(right,left.resulttype);
if not(nodetype in [equaln,unequaln]) then
CGMessage(type_e_mismatch);
end
{ support procvar=nil,procvar<>nil }
else if ((ld.deftype=procvardef) and (rt=niln)) or
((rd.deftype=procvardef) and (lt=niln)) then
begin
if not(nodetype in [equaln,unequaln]) then
CGMessage(type_e_mismatch);
end
{$ifdef SUPPORT_MMX}
{ mmx support, this must be before the zero based array
check }
else if (cs_mmx in aktlocalswitches) and
is_mmx_able_array(ld) and
is_mmx_able_array(rd) and
is_equal(ld,rd) then
begin
case nodetype of
addn,subn,xorn,orn,andn:
;
{ mul is a little bit restricted }
muln:
if not(mmx_type(ld) in [mmxu16bit,mmxs16bit,mmxfixed16]) then
CGMessage(type_e_mismatch);
else
CGMessage(type_e_mismatch);
end;
end
{$endif SUPPORT_MMX}
{ this is a little bit dangerous, also the left type }
{ pointer to should be checked! This broke the mmx support }
else if (rd.deftype=pointerdef) or is_zero_based_array(rd) then
begin
if is_zero_based_array(rd) then
begin
resulttype.setdef(tpointerdef.create(tarraydef(rd).elementtype));
inserttypeconv(right,resulttype);
end;
inserttypeconv(left,s32bittype);
if nodetype=addn then
begin
if not(cs_extsyntax in aktmoduleswitches) or
(not(is_pchar(ld)) and not(m_add_pointer in aktmodeswitches)) then
CGMessage(type_e_mismatch);
if (rd.deftype=pointerdef) and
(tpointerdef(rd).pointertype.def.size>1) then
left:=caddnode.create(muln,left,cordconstnode.create(tpointerdef(rd).pointertype.def.size,s32bittype));
end
else
CGMessage(type_e_mismatch);
end
else if (ld.deftype=pointerdef) or is_zero_based_array(ld) then
begin
if is_zero_based_array(ld) then
begin
resulttype.setdef(tpointerdef.create(tarraydef(ld).elementtype));
inserttypeconv(left,resulttype);
end;
inserttypeconv(right,s32bittype);
if nodetype in [addn,subn] then
begin
if not(cs_extsyntax in aktmoduleswitches) or
(not(is_pchar(ld)) and not(m_add_pointer in aktmodeswitches)) then
CGMessage(type_e_mismatch);
if (ld.deftype=pointerdef) and
(tpointerdef(ld).pointertype.def.size>1) then
right:=caddnode.create(muln,right,cordconstnode.create(tpointerdef(ld).pointertype.def.size,s32bittype));
end
else
CGMessage(type_e_mismatch);
end
else if (rd.deftype=procvardef) and (ld.deftype=procvardef) and is_equal(rd,ld) then
begin
if not (nodetype in [equaln,unequaln]) then
CGMessage(type_e_mismatch);
end
{ enums }
else if (ld.deftype=enumdef) and (rd.deftype=enumdef) then
begin
if not(is_equal(ld,rd)) then
inserttypeconv(right,left.resulttype);
if not(nodetype in [equaln,unequaln,ltn,lten,gtn,gten]) then
CGMessage(type_e_mismatch);
end
{ generic conversion, this is for error recovery }
else
begin
inserttypeconv(left,s32bittype);
inserttypeconv(right,s32bittype);
end;
{ set resulttype if not already done }
if not assigned(resulttype.def) then
begin
case nodetype of
ltn,lten,gtn,gten,equaln,unequaln :
resulttype:=booltype;
slashn :
resulttype:=pbestrealtype^;
addn:
begin
{ for strings, return is always a 255 char string }
if is_shortstring(left.resulttype.def) then
resulttype:=cshortstringtype
else
resulttype:=left.resulttype;
end;
else
resulttype:=left.resulttype;
end;
end;
end;
function taddnode.first_addstring: tnode;
var
p: tnode;
begin
{ when we get here, we are sure that both the left and the right }
{ node are both strings of the same stringtype (JM) }
case nodetype of
addn:
begin
{ note: if you implemented an fpc_shortstr_concat similar to the }
{ one in i386.inc, you have to override first_addstring like in }
{ ti386addnode.first_string and implement the shortstring concat }
{ manually! The generic routine is different from the i386 one (JM) }
{ create the call to the concat routine both strings as arguments }
result := ccallnode.createintern('fpc_'+
lower(tstringdef(resulttype.def).stringtypname)+'_concat',
ccallparanode.create(right,ccallparanode.create(left,nil)));
{ we reused the arguments }
left := nil;
right := nil;
firstpass(result);
end;
ltn,lten,gtn,gten,equaln,unequaln :
begin
{ generate better code for s='' and s<>'' }
if (nodetype in [equaln,unequaln]) and
(((left.nodetype=stringconstn) and (str_length(left)=0)) or
((right.nodetype=stringconstn) and (str_length(right)=0))) then
begin
{ switch so that the constant is always on the right }
if left.nodetype = stringconstn then
begin
p := left;
left := right;
right := p;
end;
if is_shortstring(left.resulttype.def) then
{ compare the length with 0 }
result := caddnode.create(nodetype,
cinlinenode.create(in_length_x,false,left),
cordconstnode.create(0,s32bittype))
else
begin
{ compare the pointer with nil (for ansistrings etc), }
{ faster than getting the length (JM) }
result:= caddnode.create(nodetype,
ctypeconvnode.create(left,voidpointertype),
cpointerconstnode.create(0,voidpointertype));
taddnode(result).left.toggleflag(nf_explizit);
end;
{ left is reused }
left := nil;
{ right isn't }
right.free;
right := nil;
firstpass(result);
exit;
end;
{ no string constant -> call compare routine }
result := ccallnode.createintern('fpc_'+
lower(tstringdef(left.resulttype.def).stringtypname)+'_compare',
ccallparanode.create(right,ccallparanode.create(left,nil)));
{ and compare its result with 0 according to the original operator }
result := caddnode.create(nodetype,result,
cordconstnode.create(0,s32bittype));
left := nil;
right := nil;
firstpass(result);
end;
end;
end;
function taddnode.first_addset: tnode;
var
procname: string[31];
tempn: tnode;
paras: tcallparanode;
srsym: ttypesym;
createset: boolean;
begin
{ get the sym that represents the fpc_normal_set type }
if not searchsystype('FPC_NORMAL_SET',srsym) then
internalerror(200108313);
case nodetype of
equaln,unequaln,lten,gten:
begin
case nodetype of
equaln,unequaln:
procname := 'fpc_set_comp_sets';
lten,gten:
begin
procname := 'fpc_set_contains_sets';
{ (left >= right) = (right <= left) }
if nodetype = gten then
begin
tempn := left;
left := right;
right := tempn;
end;
end;
end;
{ convert the arguments (explicitely) to fpc_normal_set's }
left := ctypeconvnode.create(left,srsym.restype);
left.toggleflag(nf_explizit);
right := ctypeconvnode.create(right,srsym.restype);
right.toggleflag(nf_explizit);
result := ccallnode.createintern(procname,ccallparanode.create(right,
ccallparanode.create(left,nil)));
{ left and right are reused as parameters }
left := nil;
right := nil;
{ for an unequaln, we have to negate the result of comp_sets }
if nodetype = unequaln then
result := cnotnode.create(result);
end;
addn:
begin
{ optimize first loading of a set }
if (right.nodetype=setelementn) and
not(assigned(tsetelementnode(right).right)) and
is_emptyset(left) then
begin
{ type cast the value to pass as argument to a byte, }
{ since that's what the helper expects }
tsetelementnode(right).left :=
ctypeconvnode.create(tsetelementnode(right).left,u8bittype);
tsetelementnode(right).left.toggleflag(nf_explizit);
{ set the resulttype to the actual one (otherwise it's }
{ "fpc_normal_set") }
result := ccallnode.createinternres('fpc_set_create_element',
ccallparanode.create(tsetelementnode(right).left,nil),
resulttype);
{ reused }
tsetelementnode(right).left := nil;
end
else
begin
if right.nodetype=setelementn then
begin
{ convert the arguments to bytes, since that's what }
{ the helper expects }
tsetelementnode(right).left :=
ctypeconvnode.create(tsetelementnode(right).left,
u8bittype);
tsetelementnode(right).left.toggleflag(nf_explizit);
{ convert the original set (explicitely) to an }
{ fpc_normal_set so we can pass it to the helper }
left := ctypeconvnode.create(left,srsym.restype);
left.toggleflag(nf_explizit);
{ add a range or a single element? }
if assigned(tsetelementnode(right).right) then
begin
tsetelementnode(right).right :=
ctypeconvnode.create(tsetelementnode(right).right,
u8bittype);
tsetelementnode(right).right.toggleflag(nf_explizit);
{ create the call }
result := ccallnode.createinternres('fpc_set_set_range',
ccallparanode.create(tsetelementnode(right).right,
ccallparanode.create(tsetelementnode(right).left,
ccallparanode.create(left,nil))),resulttype);
end
else
begin
result := ccallnode.createinternres('fpc_set_set_byte',
ccallparanode.create(tsetelementnode(right).left,
ccallparanode.create(left,nil)),resulttype);
end;
{ remove reused parts from original node }
tsetelementnode(right).right := nil;
tsetelementnode(right).left := nil;
left := nil;
end
else
begin
{ add two sets }
{ convert the sets to fpc_normal_set's }
left := ctypeconvnode.create(left,srsym.restype);
left.toggleflag(nf_explizit);
right := ctypeconvnode.create(right,srsym.restype);
right.toggleflag(nf_explizit);
result := ccallnode.createinternres('fpc_set_add_sets',
ccallparanode.create(right,
ccallparanode.create(left,nil)),resulttype);
{ remove reused parts from original node }
left := nil;
right := nil;
end;
end
end;
subn,symdifn,muln:
begin
{ convert the sets to fpc_normal_set's }
left := ctypeconvnode.create(left,srsym.restype);
left.toggleflag(nf_explizit);
right := ctypeconvnode.create(right,srsym.restype);
right.toggleflag(nf_explizit);
paras := ccallparanode.create(right,
ccallparanode.create(left,nil));
case nodetype of
subn:
result := ccallnode.createinternres('fpc_set_sub_sets',
paras,resulttype);
symdifn:
result := ccallnode.createinternres('fpc_set_symdif_sets',
paras,resulttype);
muln:
result := ccallnode.createinternres('fpc_set_mul_sets',
paras,resulttype);
end;
{ remove reused parts from original node }
left := nil;
right := nil;
end;
else
internalerror(200108311);
end;
firstpass(result);
end;
function taddnode.pass_1 : tnode;
var
hp : tnode;
lt,rt : tnodetype;
rd,ld : tdef;
begin
result:=nil;
{ first do the two subtrees }
firstpass(left);
firstpass(right);
if codegenerror then
exit;
{ load easier access variables }
rd:=right.resulttype.def;
ld:=left.resulttype.def;
rt:=right.nodetype;
lt:=left.nodetype;
{ int/int gives real/real! }
if nodetype=slashn then
begin
{ maybe we need an integer register to save }
{ a reference }
if ((left.location.loc<>LOC_FPU) or
(right.location.loc<>LOC_FPU)) and
(left.registers32=right.registers32) then
calcregisters(self,1,1,0)
else
calcregisters(self,0,1,0);
location.loc:=LOC_FPU;
end
{ if both are orddefs then check sub types }
else if (ld.deftype=orddef) and (rd.deftype=orddef) then
begin
{ 2 booleans ? }
if is_boolean(ld) and is_boolean(rd) then
begin
if not(cs_full_boolean_eval in aktlocalswitches) and
(nodetype in [andn,orn]) then
begin
calcregisters(self,0,0,0);
location.loc:=LOC_JUMP;
end
else
begin
if (left.location.loc in [LOC_JUMP,LOC_FLAGS]) and
(left.location.loc in [LOC_JUMP,LOC_FLAGS]) then
calcregisters(self,2,0,0)
else
calcregisters(self,1,0,0);
end;
end
else
{ Both are chars? only convert to shortstrings for addn }
if is_char(ld) then
begin
if nodetype=addn then
internalerror(200103291);
calcregisters(self,1,0,0);
end
{ is there a 64 bit type ? }
else if (torddef(ld).typ in [s64bit,u64bit]) then
calcregisters(self,2,0,0)
{ is there a cardinal? }
else if (torddef(ld).typ=u32bit) then
begin
calcregisters(self,1,0,0);
{ for unsigned mul we need an extra register }
if nodetype=muln then
inc(registers32);
end
{ generic s32bit conversion }
else
calcregisters(self,1,0,0);
end
{ left side a setdef, must be before string processing,
else array constructor can be seen as array of char (PFV) }
else if (ld.deftype=setdef) then
begin
if tsetdef(ld).settype=smallset then
begin
{ are we adding set elements ? }
if right.nodetype=setelementn then
calcregisters(self,2,0,0)
else
calcregisters(self,1,0,0);
location.loc:=LOC_REGISTER;
end
else
begin
result := first_addset;
if assigned(result) then
exit;
calcregisters(self,0,0,0);
{ here we call SET... }
procinfo^.flags:=procinfo^.flags or pi_do_call;
location.loc:=LOC_MEM;
end;
end
{ compare pchar by addresses like BP/Delphi }
else if is_pchar(ld) then
begin
location.loc:=LOC_REGISTER;
calcregisters(self,1,0,0);
end
{ is one of the operands a string }
else if (ld.deftype=stringdef) then
begin
if is_widestring(ld) then
begin
{ we use reference counted widestrings so no fast exit here }
procinfo^.no_fast_exit:=true;
{ this is only for add, the comparisaion is handled later }
location.loc:=LOC_REGISTER;
end
else if is_ansistring(ld) then
begin
{ we use ansistrings so no fast exit here }
procinfo^.no_fast_exit:=true;
{ this is only for add, the comparisaion is handled later }
location.loc:=LOC_REGISTER;
end
else if is_longstring(ld) then
begin
{ this is only for add, the comparisaion is handled later }
location.loc:=LOC_MEM;
end
else
begin
if canbeaddsstringcharoptnode(self) then
begin
hp := genaddsstringcharoptnode(self);
firstpass(hp);
pass_1 := hp;
exit;
end
else
begin
{ Fix right to be shortstring }
if is_char(right.resulttype.def) then
begin
inserttypeconv(right,cshortstringtype);
firstpass(right);
end;
end;
if canbeaddsstringcsstringoptnode(self) then
begin
hp := genaddsstringcsstringoptnode(self);
firstpass(hp);
pass_1 := hp;
exit;
end;
end;
{ otherwise, let addstring convert everything }
result := first_addstring;
exit;
end
{ is one a real float ? }
else if (rd.deftype=floatdef) or (ld.deftype=floatdef) then
begin
calcregisters(self,0,1,0);
location.loc:=LOC_FPU;
end
{ pointer comperation and subtraction }
else if (ld.deftype=pointerdef) then
begin
location.loc:=LOC_REGISTER;
calcregisters(self,1,0,0);
end
else if is_class_or_interface(ld) then
begin
location.loc:=LOC_REGISTER;
calcregisters(self,1,0,0);
end
else if (ld.deftype=classrefdef) then
begin
location.loc:=LOC_REGISTER;
calcregisters(self,1,0,0);
end
{ support procvar=nil,procvar<>nil }
else if ((ld.deftype=procvardef) and (rt=niln)) or
((rd.deftype=procvardef) and (lt=niln)) then
begin
calcregisters(self,1,0,0);
location.loc:=LOC_REGISTER;
end
{$ifdef SUPPORT_MMX}
{ mmx support, this must be before the zero based array
check }
else if (cs_mmx in aktlocalswitches) and is_mmx_able_array(ld) and
is_mmx_able_array(rd) then
begin
location.loc:=LOC_MMXREGISTER;
calcregisters(self,0,0,1);
end
{$endif SUPPORT_MMX}
else if (rd.deftype=pointerdef) or (ld.deftype=pointerdef) then
begin
location.loc:=LOC_REGISTER;
calcregisters(self,1,0,0);
end
else if (rd.deftype=procvardef) and (ld.deftype=procvardef) and is_equal(rd,ld) then
begin
calcregisters(self,1,0,0);
location.loc:=LOC_REGISTER;
end
else if (ld.deftype=enumdef) then
begin
calcregisters(self,1,0,0);
end
{$ifdef SUPPORT_MMX}
else if (cs_mmx in aktlocalswitches) and
is_mmx_able_array(ld) and
is_mmx_able_array(rd) then
begin
location.loc:=LOC_MMXREGISTER;
calcregisters(self,0,0,1);
end
{$endif SUPPORT_MMX}
{ the general solution is to convert to 32 bit int }
else
begin
calcregisters(self,1,0,0);
location.loc:=LOC_REGISTER;
end;
case nodetype of
ltn,lten,gtn,gten,equaln,unequaln:
begin
if is_64bitint(left.resulttype.def) then
location.loc:=LOC_JUMP
else
location.loc:=LOC_FLAGS;
end;
xorn:
begin
location.loc:=LOC_REGISTER;
end;
end;
end;
begin
caddnode:=taddnode;
end.
{
$Log$
Revision 1.38 2001-09-04 11:38:54 jonas
+ searchsystype() and searchsystype() functions in symtable
* changed ninl and nadd to use these functions
* i386 set comparison functions now return their results in al instead
of in the flags so that they can be sued as compilerprocs
- removed all processor specific code from n386add.pas that has to do
with set handling, it's now all done in nadd.pas
* fixed fpc_set_contains_sets in genset.inc
* fpc_set_in_byte is now coded inline in n386set.pas and doesn't use a
helper anymore
* some small fixes in compproc.inc/set.inc regarding the declaration of
internal helper types (fpc_small_set and fpc_normal_set)
Revision 1.37 2001/09/03 13:27:42 jonas
* compilerproc implementation of set addition/substraction/...
* changed the declaration of some set helpers somewhat to accomodate the
above change
* i386 still uses the old code for comparisons of sets, because its
helpers return the results in the flags
* dummy tc_normal_2_small_set type conversion because I need the original
resulttype of the set add nodes
NOTE: you have to start a cycle with 1.0.5!
Revision 1.36 2001/09/02 21:12:06 peter
* move class of definitions into type section for delphi
Revision 1.35 2001/08/31 15:42:15 jonas
* added missing type conversion from small to normal sets
Revision 1.34 2001/08/30 15:43:14 jonas
* converted adding/comparing of strings to compileproc. Note that due
to the way the shortstring helpers for i386 are written, they are
still handled by the old code (reason: fpc_shortstr_compare returns
results in the flags instead of in eax and fpc_shortstr_concat
has wierd parameter conventions). The compilerproc stuff should work
fine with the generic implementations though.
* removed some nested comments warnings
Revision 1.33 2001/08/26 13:36:38 florian
* some cg reorganisation
* some PPC updates
Revision 1.32 2001/08/06 21:40:46 peter
* funcret moved from tprocinfo to tprocdef
Revision 1.31 2001/07/08 21:00:14 peter
* various widestring updates, it works now mostly without charset
mapping supported
Revision 1.30 2001/06/04 21:41:26 peter
* readded generic conversion to s32bit that i removed yesterday. It
is still used for error recovery, added a small note about that
Revision 1.29 2001/06/04 18:13:53 peter
* Support kylix hack of having enum+integer in a enum declaration.
Revision 1.28 2001/05/27 14:30:55 florian
+ some widestring stuff added
Revision 1.27 2001/05/19 21:11:50 peter
* first check for overloaded operator before doing inserting any
typeconvs
Revision 1.26 2001/05/19 12:53:52 peter
* check set types when doing constant set evaluation
Revision 1.25 2001/04/13 01:22:08 peter
* symtable change to classes
* range check generation and errors fixed, make cycle DEBUG=1 works
* memory leaks fixed
Revision 1.24 2001/04/04 22:42:39 peter
* move constant folding into det_resulttype
Revision 1.23 2001/04/02 21:20:30 peter
* resulttype rewrite
Revision 1.22 2001/02/04 11:12:17 jonas
* fixed web bug 1377 & const pointer arithmtic
Revision 1.21 2001/01/14 22:13:13 peter
* constant calculation fixed. The type of the new constant is now
defined after the calculation is done. This should remove a lot
of wrong warnings (and errors with -Cr).
Revision 1.20 2000/12/31 11:14:10 jonas
+ implemented/fixed docompare() mathods for all nodes (not tested)
+ nopt.pas, nadd.pas, i386/n386opt.pas: optimized nodes for adding strings
and constant strings/chars together
* n386add.pas: don't copy temp strings (of size 256) to another temp string
when adding
Revision 1.19 2000/12/16 15:55:32 jonas
+ warning when there is a chance to get a range check error because of
automatic type conversion to u32bit
* arithmetic operations with a cardinal and a signed operand are carried
out in 64bit when range checking is on ("merged" from fixes branch)
Revision 1.18 2000/11/29 00:30:31 florian
* unused units removed from uses clause
* some changes for widestrings
Revision 1.17 2000/11/20 15:30:42 jonas
* changed types of values used for constant expression evaluation to
tconstexprint
Revision 1.16 2000/11/13 11:30:55 florian
* some bugs with interfaces and NIL fixed
Revision 1.15 2000/11/04 14:25:20 florian
+ merged Attila's changes for interfaces, not tested yet
Revision 1.14 2000/10/31 22:02:47 peter
* symtable splitted, no real code changes
Revision 1.13 2000/10/14 10:14:50 peter
* moehrendorf oct 2000 rewrite
Revision 1.12 2000/10/01 19:48:23 peter
* lot of compile updates for cg11
Revision 1.11 2000/09/30 16:08:45 peter
* more cg11 updates
Revision 1.10 2000/09/28 19:49:52 florian
*** empty log message ***
Revision 1.9 2000/09/27 21:33:22 florian
* finally nadd.pas compiles
Revision 1.8 2000/09/27 20:25:44 florian
* more stuff fixed
Revision 1.7 2000/09/27 18:14:31 florian
* fixed a lot of syntax errors in the n*.pas stuff
Revision 1.6 2000/09/24 15:06:19 peter
* use defines.inc
Revision 1.5 2000/09/22 22:42:52 florian
* more fixes
Revision 1.4 2000/09/21 12:22:42 jonas
* put piece of code between -dnewoptimizations2 since it wasn't
necessary otherwise
+ support for full boolean evaluation (from tcadd)
Revision 1.3 2000/09/20 21:50:59 florian
* updated
Revision 1.2 2000/08/29 08:24:45 jonas
* some modifications to -dcardinalmulfix code
Revision 1.1 2000/08/26 12:24:20 florian
* initial release
}