+ merge support for boolean16, boolean32 and boolean64 into trunk

git-svn-id: trunk@17846 -
This commit is contained in:
florian 2011-06-27 19:21:07 +00:00
commit 3938f5e0b9
24 changed files with 703 additions and 137 deletions

View File

@ -1418,8 +1418,7 @@ implementation
]);
finish_entry;
end;
pasbool,
bool8bit :
pasbool8 :
begin
append_entry(DW_TAG_base_type,false,[
DW_AT_name,DW_FORM_string,'Boolean'#0,
@ -1428,6 +1427,24 @@ implementation
]);
finish_entry;
end;
bool8bit :
begin
append_entry(DW_TAG_base_type,false,[
DW_AT_name,DW_FORM_string,'ByteBool'#0,
DW_AT_encoding,DW_FORM_data1,DW_ATE_boolean,
DW_AT_byte_size,DW_FORM_data1,1
]);
finish_entry;
end;
pasbool16 :
begin
append_entry(DW_TAG_base_type,false,[
DW_AT_name,DW_FORM_string,'Boolean16'#0,
DW_AT_encoding,DW_FORM_data1,DW_ATE_boolean,
DW_AT_byte_size,DW_FORM_data1,2
]);
finish_entry;
end;
bool16bit :
begin
append_entry(DW_TAG_base_type,false,[
@ -1437,6 +1454,15 @@ implementation
]);
finish_entry;
end;
pasbool32 :
begin
append_entry(DW_TAG_base_type,false,[
DW_AT_name,DW_FORM_string,'Boolean32'#0,
DW_AT_encoding,DW_FORM_data1,DW_ATE_boolean,
DW_AT_byte_size,DW_FORM_data1,4
]);
finish_entry;
end;
bool32bit :
begin
append_entry(DW_TAG_base_type,false,[
@ -1446,6 +1472,15 @@ implementation
]);
finish_entry;
end;
pasbool64 :
begin
append_entry(DW_TAG_base_type,false,[
DW_AT_name,DW_FORM_string,'Boolean64'#0,
DW_AT_encoding,DW_FORM_data1,DW_ATE_boolean,
DW_AT_byte_size,DW_FORM_data1,8
]);
finish_entry;
end;
bool64bit :
begin
append_entry(DW_TAG_base_type,false,[

View File

@ -624,7 +624,10 @@ implementation
case def.ordtype of
uvoid :
ss:=def_stab_number(def);
pasbool,
pasbool8,
pasbool16,
pasbool32,
pasbool64,
bool8bit,
bool16bit,
bool32bit,
@ -647,13 +650,16 @@ implementation
ss:='-20;';
uwidechar :
ss:='-30;';
pasbool,
pasbool8,
bool8bit :
ss:='-21;';
pasbool16,
bool16bit :
ss:='-22;';
pasbool32,
bool32bit :
ss:='-23;';
pasbool64,
bool64bit :
{ no clue if this is correct (FK) }
ss:='-23;';

View File

@ -166,7 +166,8 @@ implementation
(bvoid,
bint,bint,bint,bint,
bint,bint,bint,bint,
bbool,bbool,bbool,bbool,bbool,
bbool,bbool,bbool,bbool,
bbool,bbool,bbool,bbool,
bchar,bchar,bint);
basedefconvertsimplicit : array[tbasedef,tbasedef] of tconverttype =
@ -241,7 +242,8 @@ implementation
end;
end;
uvoid,
pasbool,bool8bit,bool16bit,bool32bit,bool64bit:
pasbool8,pasbool16,pasbool32,pasbool64,
bool8bit,bool16bit,bool32bit,bool64bit:
eq:=te_equal;
else
internalerror(200210061);
@ -1551,8 +1553,9 @@ implementation
u8bit,u16bit,u32bit,u64bit,
s8bit,s16bit,s32bit,s64bit :
is_subequal:=(torddef(def2).ordtype in [s64bit,u64bit,s32bit,u32bit,u8bit,s8bit,s16bit,u16bit]);
pasbool,bool8bit,bool16bit,bool32bit,bool64bit :
is_subequal:=(torddef(def2).ordtype in [pasbool,bool8bit,bool16bit,bool32bit,bool64bit]);
pasbool8,pasbool16,pasbool32,pasbool64,
bool8bit,bool16bit,bool32bit,bool64bit :
is_subequal:=(torddef(def2).ordtype in [pasbool8,pasbool16,pasbool32,pasbool64,bool8bit,bool16bit,bool32bit,bool64bit]);
uchar :
is_subequal:=(torddef(def2).ordtype=uchar);
uwidechar :

View File

@ -387,7 +387,8 @@ implementation
is_ordinal:=dt in [uchar,uwidechar,
u8bit,u16bit,u32bit,u64bit,
s8bit,s16bit,s32bit,s64bit,
pasbool,bool8bit,bool16bit,bool32bit,bool64bit];
pasbool8,pasbool16,pasbool32,pasbool64,
bool8bit,bool16bit,bool32bit,bool64bit];
end;
enumdef :
is_ordinal:=true;
@ -444,14 +445,14 @@ implementation
function is_boolean(def : tdef) : boolean;
begin
result:=(def.typ=orddef) and
(torddef(def).ordtype in [pasbool,bool8bit,bool16bit,bool32bit,bool64bit]);
(torddef(def).ordtype in [pasbool8,pasbool16,pasbool32,pasbool64,bool8bit,bool16bit,bool32bit,bool64bit]);
end;
function is_pasbool(def : tdef) : boolean;
begin
result:=(def.typ=orddef) and
(torddef(def).ordtype = pasbool);
(torddef(def).ordtype in [pasbool8,pasbool16,pasbool32,pasbool64]);
end;
{ true if def is a C-style boolean (non-zero value = true, zero = false) }

View File

@ -2477,7 +2477,8 @@ implementation
variantorddef_cl: array[tordtype] of tvariantequaltype =
(tve_incompatible,tve_byte,tve_word,tve_cardinal,tve_chari64,
tve_shortint,tve_smallint,tve_longint,tve_chari64,
tve_boolformal,tve_boolformal,tve_boolformal,tve_boolformal,tve_boolformal,
tve_boolformal,tve_boolformal,tve_boolformal,tve_boolformal,
tve_boolformal,tve_boolformal,tve_boolformal,tve_boolformal,
tve_chari64,tve_chari64,tve_dblcurrency);
{ TODO: fixme for 128 bit floats }
variantfloatdef_cl: array[tfloattype] of tvariantequaltype =

View File

@ -334,17 +334,17 @@ implementation
else
t:=cordconstnode.create(lv and rv,resultdef,true);
ltn :
t:=cordconstnode.create(ord(lv<rv),booltype,true);
t:=cordconstnode.create(ord(lv<rv),pasbool8type,true);
lten :
t:=cordconstnode.create(ord(lv<=rv),booltype,true);
t:=cordconstnode.create(ord(lv<=rv),pasbool8type,true);
gtn :
t:=cordconstnode.create(ord(lv>rv),booltype,true);
t:=cordconstnode.create(ord(lv>rv),pasbool8type,true);
gten :
t:=cordconstnode.create(ord(lv>=rv),booltype,true);
t:=cordconstnode.create(ord(lv>=rv),pasbool8type,true);
equaln :
t:=cordconstnode.create(ord(lv=rv),booltype,true);
t:=cordconstnode.create(ord(lv=rv),pasbool8type,true);
unequaln :
t:=cordconstnode.create(ord(lv<>rv),booltype,true);
t:=cordconstnode.create(ord(lv<>rv),pasbool8type,true);
slashn :
begin
{ int/int becomes a real }
@ -387,30 +387,30 @@ implementation
case nodetype of
ltn:
if lv<low then
t:=Cordconstnode.create(1,booltype,true)
t:=Cordconstnode.create(1,pasbool8type,true)
else if lv>=high then
t:=Cordconstnode.create(0,booltype,true);
t:=Cordconstnode.create(0,pasbool8type,true);
lten:
if lv<=low then
t:=Cordconstnode.create(1,booltype,true)
t:=Cordconstnode.create(1,pasbool8type,true)
else if lv>high then
t:=Cordconstnode.create(0,booltype,true);
t:=Cordconstnode.create(0,pasbool8type,true);
gtn:
if lv<=low then
t:=Cordconstnode.create(0,booltype,true)
t:=Cordconstnode.create(0,pasbool8type,true)
else if lv>high then
t:=Cordconstnode.create(1,booltype,true);
t:=Cordconstnode.create(1,pasbool8type,true);
gten :
if lv<low then
t:=Cordconstnode.create(0,booltype,true)
t:=Cordconstnode.create(0,pasbool8type,true)
else if lv>=high then
t:=Cordconstnode.create(1,booltype,true);
t:=Cordconstnode.create(1,pasbool8type,true);
equaln:
if (lv<low) or (lv>high) then
t:=Cordconstnode.create(0,booltype,true);
t:=Cordconstnode.create(0,pasbool8type,true);
unequaln:
if (lv<low) or (lv>high) then
t:=Cordconstnode.create(1,booltype,true);
t:=Cordconstnode.create(1,pasbool8type,true);
end;
if t<>nil then
begin
@ -436,30 +436,30 @@ implementation
case nodetype of
ltn:
if high<rv then
t:=Cordconstnode.create(1,booltype,true)
t:=Cordconstnode.create(1,pasbool8type,true)
else if low>=rv then
t:=Cordconstnode.create(0,booltype,true);
t:=Cordconstnode.create(0,pasbool8type,true);
lten:
if high<=rv then
t:=Cordconstnode.create(1,booltype,true)
t:=Cordconstnode.create(1,pasbool8type,true)
else if low>rv then
t:=Cordconstnode.create(0,booltype,true);
t:=Cordconstnode.create(0,pasbool8type,true);
gtn:
if high<=rv then
t:=Cordconstnode.create(0,booltype,true)
t:=Cordconstnode.create(0,pasbool8type,true)
else if low>rv then
t:=Cordconstnode.create(1,booltype,true);
t:=Cordconstnode.create(1,pasbool8type,true);
gten:
if high<rv then
t:=Cordconstnode.create(0,booltype,true)
t:=Cordconstnode.create(0,pasbool8type,true)
else if low>=rv then
t:=Cordconstnode.create(1,booltype,true);
t:=Cordconstnode.create(1,pasbool8type,true);
equaln:
if (rv<low) or (rv>high) then
t:=Cordconstnode.create(0,booltype,true);
t:=Cordconstnode.create(0,pasbool8type,true);
unequaln:
if (rv<low) or (rv>high) then
t:=Cordconstnode.create(1,booltype,true);
t:=Cordconstnode.create(1,pasbool8type,true);
end;
if t<>nil then
begin
@ -563,17 +563,17 @@ implementation
slashn :
t:=crealconstnode.create(lvd/rvd,resultrealdef);
ltn :
t:=cordconstnode.create(ord(lvd<rvd),booltype,true);
t:=cordconstnode.create(ord(lvd<rvd),pasbool8type,true);
lten :
t:=cordconstnode.create(ord(lvd<=rvd),booltype,true);
t:=cordconstnode.create(ord(lvd<=rvd),pasbool8type,true);
gtn :
t:=cordconstnode.create(ord(lvd>rvd),booltype,true);
t:=cordconstnode.create(ord(lvd>rvd),pasbool8type,true);
gten :
t:=cordconstnode.create(ord(lvd>=rvd),booltype,true);
t:=cordconstnode.create(ord(lvd>=rvd),pasbool8type,true);
equaln :
t:=cordconstnode.create(ord(lvd=rvd),booltype,true);
t:=cordconstnode.create(ord(lvd=rvd),pasbool8type,true);
unequaln :
t:=cordconstnode.create(ord(lvd<>rvd),booltype,true);
t:=cordconstnode.create(ord(lvd<>rvd),pasbool8type,true);
else
internalerror(2008022102);
end;
@ -602,17 +602,17 @@ implementation
t:=cstringconstnode.createwstr(ws1);
end;
ltn :
t:=cordconstnode.create(byte(comparewidestrings(ws1,ws2)<0),booltype,true);
t:=cordconstnode.create(byte(comparewidestrings(ws1,ws2)<0),pasbool8type,true);
lten :
t:=cordconstnode.create(byte(comparewidestrings(ws1,ws2)<=0),booltype,true);
t:=cordconstnode.create(byte(comparewidestrings(ws1,ws2)<=0),pasbool8type,true);
gtn :
t:=cordconstnode.create(byte(comparewidestrings(ws1,ws2)>0),booltype,true);
t:=cordconstnode.create(byte(comparewidestrings(ws1,ws2)>0),pasbool8type,true);
gten :
t:=cordconstnode.create(byte(comparewidestrings(ws1,ws2)>=0),booltype,true);
t:=cordconstnode.create(byte(comparewidestrings(ws1,ws2)>=0),pasbool8type,true);
equaln :
t:=cordconstnode.create(byte(comparewidestrings(ws1,ws2)=0),booltype,true);
t:=cordconstnode.create(byte(comparewidestrings(ws1,ws2)=0),pasbool8type,true);
unequaln :
t:=cordconstnode.create(byte(comparewidestrings(ws1,ws2)<>0),booltype,true);
t:=cordconstnode.create(byte(comparewidestrings(ws1,ws2)<>0),pasbool8type,true);
else
internalerror(2008022103);
end;
@ -676,17 +676,17 @@ implementation
tstringconstnode(t).changestringtype(resultdef);
end;
ltn :
t:=cordconstnode.create(byte(compareansistrings(s1,s2,l1,l2)<0),booltype,true);
t:=cordconstnode.create(byte(compareansistrings(s1,s2,l1,l2)<0),pasbool8type,true);
lten :
t:=cordconstnode.create(byte(compareansistrings(s1,s2,l1,l2)<=0),booltype,true);
t:=cordconstnode.create(byte(compareansistrings(s1,s2,l1,l2)<=0),pasbool8type,true);
gtn :
t:=cordconstnode.create(byte(compareansistrings(s1,s2,l1,l2)>0),booltype,true);
t:=cordconstnode.create(byte(compareansistrings(s1,s2,l1,l2)>0),pasbool8type,true);
gten :
t:=cordconstnode.create(byte(compareansistrings(s1,s2,l1,l2)>=0),booltype,true);
t:=cordconstnode.create(byte(compareansistrings(s1,s2,l1,l2)>=0),pasbool8type,true);
equaln :
t:=cordconstnode.create(byte(compareansistrings(s1,s2,l1,l2)=0),booltype,true);
t:=cordconstnode.create(byte(compareansistrings(s1,s2,l1,l2)=0),pasbool8type,true);
unequaln :
t:=cordconstnode.create(byte(compareansistrings(s1,s2,l1,l2)<>0),booltype,true);
t:=cordconstnode.create(byte(compareansistrings(s1,s2,l1,l2)<>0),pasbool8type,true);
else
internalerror(2008022104);
end;
@ -724,22 +724,22 @@ implementation
unequaln :
begin
b:=tsetconstnode(right).value_set^ <> tsetconstnode(left).value_set^;
t:=cordconstnode.create(byte(b),booltype,true);
t:=cordconstnode.create(byte(b),pasbool8type,true);
end;
equaln :
begin
b:=tsetconstnode(right).value_set^ = tsetconstnode(left).value_set^;
t:=cordconstnode.create(byte(b),booltype,true);
t:=cordconstnode.create(byte(b),pasbool8type,true);
end;
lten :
begin
b:=tsetconstnode(left).value_set^ <= tsetconstnode(right).value_set^;
t:=cordconstnode.create(byte(b),booltype,true);
t:=cordconstnode.create(byte(b),pasbool8type,true);
end;
gten :
begin
b:=tsetconstnode(left).value_set^ >= tsetconstnode(right).value_set^;
t:=cordconstnode.create(byte(b),booltype,true);
t:=cordconstnode.create(byte(b),pasbool8type,true);
end;
else
internalerror(2008022105);
@ -1027,12 +1027,12 @@ implementation
begin
if not is_boolean(ld) then
begin
inserttypeconv(left,booltype);
inserttypeconv(left,pasbool8type);
ld := left.resultdef;
end;
if not is_boolean(rd) then
begin
inserttypeconv(right,booltype);
inserttypeconv(right,pasbool8type);
rd := right.resultdef;
end;
end;
@ -1857,7 +1857,7 @@ implementation
begin
case nodetype of
ltn,lten,gtn,gten,equaln,unequaln :
resultdef:=booltype;
resultdef:=pasbool8type;
slashn :
resultdef:=resultrealdef;
addn:
@ -2327,7 +2327,7 @@ implementation
{ otherwise, create the parameters for the helper }
right := ccallparanode.create(
cordconstnode.create(ord(cs_check_overflow in current_settings.localswitches),booltype,true),
cordconstnode.create(ord(cs_check_overflow in current_settings.localswitches),pasbool8type,true),
ccallparanode.create(right,ccallparanode.create(left,nil)));
left := nil;
{ only qword needs the unsigned code, the
@ -2457,7 +2457,7 @@ implementation
if not(target_info.system in systems_wince) then
begin
if nodetype in [ltn,lten,gtn,gten,equaln,unequaln] then
resultdef:=booltype;
resultdef:=pasbool8type;
result:=ctypeconvnode.create_internal(ccallnode.createintern(procname,ccallparanode.create(
ctypeconvnode.create_internal(right,fdef),
ccallparanode.create(
@ -2618,7 +2618,7 @@ implementation
internalerror(2011022301);
end;
result := ccallnode.createintern(procname,
ccallparanode.create(cordconstnode.create(0,booltype,false),
ccallparanode.create(cordconstnode.create(0,pasbool8type,false),
ccallparanode.create(right,
ccallparanode.create(left,nil))));
left := nil;

View File

@ -2340,12 +2340,12 @@ implementation
else
if vo_is_range_check in para.parasym.varoptions then
begin
para.left:=cordconstnode.create(Ord(cs_check_range in current_settings.localswitches),booltype,false);
para.left:=cordconstnode.create(Ord(cs_check_range in current_settings.localswitches),pasbool8type,false);
end
else
if vo_is_overflow_check in para.parasym.varoptions then
begin
para.left:=cordconstnode.create(Ord(cs_check_overflow in current_settings.localswitches),booltype,false);
para.left:=cordconstnode.create(Ord(cs_check_overflow in current_settings.localswitches),pasbool8type,false);
end
else
if vo_is_msgsel in para.parasym.varoptions then

View File

@ -463,15 +463,30 @@ interface
else
internalerror(200203247);
end;
if right.location.loc <> LOC_CONSTANT then
cg.a_op_reg_reg_reg(current_asmdata.CurrAsmList,cgop,location.size,
left.location.register,right.location.register,
location.register)
{$ifndef cpu64bitalu}
if right.location.size in [OS_64,OS_S64] then
begin
if right.location.loc <> LOC_CONSTANT then
cg64.a_op64_reg_reg_reg(current_asmdata.CurrAsmList,cgop,location.size,
left.location.register64,right.location.register64,
location.register64)
else
cg64.a_op64_const_reg_reg(current_asmdata.CurrAsmList,cgop,location.size,
right.location.value,left.location.register64,
location.register64);
end
else
cg.a_op_const_reg_reg(current_asmdata.CurrAsmList,cgop,location.size,
right.location.value,left.location.register,
location.register);
{$endif cpu64bitalu}
begin
if right.location.loc <> LOC_CONSTANT then
cg.a_op_reg_reg_reg(current_asmdata.CurrAsmList,cgop,location.size,
left.location.register,right.location.register,
location.register)
else
cg.a_op_const_reg_reg(current_asmdata.CurrAsmList,cgop,location.size,
right.location.value,left.location.register,
location.register);
end;
end;
end;

View File

@ -452,7 +452,7 @@ implementation
end;
{ we need to align by Tconstptruint here to satisfy the alignment rules set by
records: in the typinfo unit we overlay a TTypeData record on this data, which at
the innermost variant record needs an alignment of TConstPtrUint due to e.g.
the innermost variant record needs an alignment of TConstPtrUint due to e.g.
the "CompType" member for tkSet (also the "BaseType" member for tkEnumeration).
We need to adhere to this, otherwise things will break.
Note that other code (e.g. enumdef_rtti_calcstringtablestart()) relies on the
@ -490,7 +490,8 @@ implementation
(otUByte{otNone},
otUByte,otUWord,otULong,otUByte{otNone},
otSByte,otSWord,otSLong,otUByte{otNone},
otUByte,otSByte,otSWord,otSLong,otSByte,
otUByte,otUWord,otULong,otUByte,
otSByte,otSWord,otSLong,otSByte,
otUByte,otUWord,otUByte);
begin
write_header(def,typekind);
@ -523,7 +524,7 @@ implementation
{ high }
current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_64bit(def.high.svalue));
end;
pasbool:
pasbool8:
dointeger(tkBool);
uchar:
dointeger(tkChar);
@ -698,18 +699,18 @@ implementation
potype_class_constructor: methodkind:=mkClassConstructor;
potype_class_destructor: methodkind:=mkClassDestructor;
potype_operator: methodkind:=mkOperatorOverload;
potype_procedure:
if po_classmethod in def.procoptions then
potype_procedure:
if po_classmethod in def.procoptions then
methodkind:=mkClassProcedure
else
methodkind:=mkProcedure;
potype_function:
if po_classmethod in def.procoptions then
if po_classmethod in def.procoptions then
methodkind:=mkClassFunction
else
methodkind:=mkFunction;
else
begin
begin
if def.returndef = voidtype then
methodkind:=mkProcedure
else

View File

@ -913,7 +913,7 @@ implementation
addstatement(newstat,restemp);
addstatement(newstat,ccallnode.createintern('fpc_'+chartype+'array_to_shortstr',
ccallparanode.create(cordconstnode.create(
ord(tarraydef(left.resultdef).lowrange=0),booltype,false),
ord(tarraydef(left.resultdef).lowrange=0),pasbool8type,false),
ccallparanode.create(left,ccallparanode.create(
ctemprefnode.create(restemp),nil)))));
addstatement(newstat,ctempdeletenode.create_normal_temp(restemp));
@ -924,7 +924,7 @@ implementation
result:=ccallnode.createinternres(
'fpc_'+chartype+'array_to_'+tstringdef(resultdef).stringtypname,
ccallparanode.create(cordconstnode.create(
ord(tarraydef(left.resultdef).lowrange=0),booltype,false),
ord(tarraydef(left.resultdef).lowrange=0),pasbool8type,false),
ccallparanode.create(left,nil)),resultdef);
left:=nil;
end;
@ -3347,7 +3347,7 @@ implementation
CGMessage1(type_e_class_or_cominterface_type_expected,left.resultdef.typename);
case nodetype of
isn:
resultdef:=booltype;
resultdef:=pasbool8type;
asn:
resultdef:=tclassrefdef(right.resultdef).pointeddef;
end;
@ -3361,7 +3361,7 @@ implementation
case nodetype of
isn:
resultdef:=booltype;
resultdef:=pasbool8type;
asn:
resultdef:=right.resultdef;
end;

View File

@ -457,7 +457,7 @@ implementation
one }
hp:=cwhilerepeatnode.create(
{ repeat .. until false }
cordconstnode.create(0,booltype,false),innerloop,false,true);
cordconstnode.create(0,pasbool8type,false),innerloop,false,true);
addstatement(outerloopbodystatement,hp);
{ create the outer repeat/until and add it to the the main body }
@ -1074,7 +1074,7 @@ implementation
not(is_typeparam(left.resultdef)) then
begin
if left.resultdef.typ=variantdef then
inserttypeconv(left,booltype)
inserttypeconv(left,pasbool8type)
else
CGMessage1(type_e_boolean_expr_expected,left.resultdef.typename);
end;
@ -1311,7 +1311,7 @@ implementation
end;
if not is_constboolnode(condition) then
aktstate.store_fact(condition,
cordconstnode.create(byte(checknegate),booltype,true))
cordconstnode.create(byte(checknegate),pasbool8type,true))
else
condition.destroy;
end;
@ -1387,7 +1387,7 @@ implementation
not(is_typeparam(left.resultdef)) then
begin
if left.resultdef.typ=variantdef then
inserttypeconv(left,booltype)
inserttypeconv(left,pasbool8type)
else
Message1(type_e_boolean_expr_expected,left.resultdef.typename);
end;

View File

@ -314,7 +314,8 @@ implementation
scurrency,
s64bit:
procname := procname + 'int64';
pasbool,bool8bit,bool16bit,bool32bit,bool64bit:
pasbool8,pasbool16,pasbool32,pasbool64,
bool8bit,bool16bit,bool32bit,bool64bit:
procname := procname + 'bool';
{$endif}
else
@ -511,7 +512,10 @@ implementation
readfunctype:=s64currencytype;
is_real:=true;
end;
pasbool,
pasbool8,
pasbool16,
pasbool32,
pasbool64,
bool8bit,
bool16bit,
bool32bit,
@ -524,7 +528,7 @@ implementation
else
begin
name := procprefixes[do_read]+'boolean';
readfunctype:=booltype;
readfunctype:=pasbool8type;
end
else
begin
@ -746,7 +750,7 @@ implementation
{ zero-based }
if para.left.resultdef.typ=arraydef then
para := ccallparanode.create(cordconstnode.create(
ord(tarraydef(para.left.resultdef).lowrange=0),booltype,false),para);
ord(tarraydef(para.left.resultdef).lowrange=0),pasbool8type,false),para);
{ create the call statement }
addstatement(Tstatementnode(newstatement),
ccallnode.createintern(name,para));
@ -1635,7 +1639,7 @@ implementation
else
hp:=create_simplified_ord_const(sqr(vl.uvalue),resultdef,forinline);
in_const_odd :
hp:=cordconstnode.create(qword(odd(int64(vl))),booltype,true);
hp:=cordconstnode.create(qword(odd(int64(vl))),pasbool8type,true);
in_const_swap_word :
hp:=cordconstnode.create((vl and $ff) shl 8+(vl shr 8),left.resultdef,true);
in_const_swap_long :
@ -1691,19 +1695,32 @@ implementation
orddef :
begin
case torddef(left.resultdef).ordtype of
pasbool,
pasbool8,
uchar:
begin
{ change to byte() }
result:=ctypeconvnode.create_internal(left,u8inttype);
left:=nil;
end;
pasbool16,
uwidechar :
begin
{ change to word() }
result:=ctypeconvnode.create_internal(left,u16inttype);
left:=nil;
end;
pasbool32 :
begin
{ change to dword() }
result:=ctypeconvnode.create_internal(left,u32inttype);
left:=nil;
end;
pasbool64 :
begin
{ change to qword() }
result:=ctypeconvnode.create_internal(left,u64inttype);
left:=nil;
end;
bool8bit:
begin
{ change to shortint() }
@ -2357,7 +2374,7 @@ implementation
in procvar handling between FPC and Delphi handling, so
handle specially }
set_varstate(tcallparanode(left).left,vs_read,[vsf_must_be_valid]);
resultdef:=booltype;
resultdef:=pasbool8type;
end;
in_ofs_x :

View File

@ -884,14 +884,17 @@ implementation
v:=tordconstnode(left).value;
def:=left.resultdef;
case torddef(left.resultdef).ordtype of
pasbool,
pasbool8,
pasbool16,
pasbool32,
pasbool64,
bool8bit,
bool16bit,
bool32bit,
bool64bit:
begin
v:=byte(not(boolean(int64(v))));
if (torddef(left.resultdef).ordtype<>pasbool) then
if is_cbool(left.resultdef) then
v:=-v;
end;
uchar,

View File

@ -213,7 +213,7 @@ implementation
begin
result:=nil;
resultdef:=booltype;
resultdef:=pasbool8type;
typecheckpass(right);
set_varstate(right,vs_read,[vsf_must_be_valid]);
if codegenerror then
@ -256,7 +256,7 @@ implementation
}
if (
(left.resultdef.typ = orddef) and not
(torddef(left.resultdef).ordtype in [s8bit,u8bit,uchar,pasbool,bool8bit])
(torddef(left.resultdef).ordtype in [s8bit,u8bit,uchar,pasbool8,bool8bit])
)
or
(
@ -294,7 +294,7 @@ implementation
((right.nodetype = setconstn) and
(tnormalset(tsetconstnode(right).value_set^) = [])) then
begin
t:=cordconstnode.create(0,booltype,false);
t:=cordconstnode.create(0,pasbool8type,false);
typecheckpass(t);
result:=t;
exit;
@ -321,10 +321,10 @@ implementation
{ into account }
if Tordconstnode(left).value.signed then
t:=cordconstnode.create(byte(tordconstnode(left).value.svalue in Tsetconstnode(right).value_set^),
booltype,true)
pasbool8type,true)
else
t:=cordconstnode.create(byte(tordconstnode(left).value.uvalue in Tsetconstnode(right).value_set^),
booltype,true);
pasbool8type,true);
typecheckpass(t);
result:=t;
exit;
@ -334,7 +334,7 @@ implementation
if (Tordconstnode(left).value<int64(tsetdef(right.resultdef).setbase)) or
(Tordconstnode(left).value>int64(Tsetdef(right.resultdef).setmax)) then
begin
t:=cordconstnode.create(0, booltype, true);
t:=cordconstnode.create(0, pasbool8type, true);
typecheckpass(t);
result:=t;
exit;

View File

@ -1468,7 +1468,7 @@ implementation
end;
if (optoken in [_EQ,_NE,_GT,_LT,_GTE,_LTE,_OP_IN]) and
((pd.returndef.typ<>orddef) or
(torddef(pd.returndef).ordtype<>pasbool)) then
(torddef(pd.returndef).ordtype<>pasbool8)) then
Message(parser_e_comparative_operator_return_boolean);
if (optoken in [_ASSIGNMENT,_OP_EXPLICIT]) and
equal_defs(pd.returndef,tparavarsym(pd.parast.SymList[0]).vardef) and

View File

@ -674,7 +674,7 @@ implementation
storedprocdef:=tprocvardef.create(normal_function_level);
include(storedprocdef.procoptions,po_methodpointer);
{ Return type must be boolean }
storedprocdef.returndef:=booltype;
storedprocdef.returndef:=pasbool8type;
{ Add index parameter if needed }
if ppo_indexed in p.propoptions then
begin

View File

@ -2745,13 +2745,13 @@ implementation
_TRUE :
begin
consume(_TRUE);
p1:=cordconstnode.create(1,booltype,false);
p1:=cordconstnode.create(1,pasbool8type,false);
end;
_FALSE :
begin
consume(_FALSE);
p1:=cordconstnode.create(0,booltype,false);
p1:=cordconstnode.create(0,pasbool8type,false);
end;
_NIL :

View File

@ -154,7 +154,10 @@ implementation
s32inttype:=torddef.create(s32bit,int64(low(longint)),int64(high(longint)));
u64inttype:=torddef.create(u64bit,low(qword),high(qword));
s64inttype:=torddef.create(s64bit,low(int64),high(int64));
booltype:=torddef.create(pasbool,0,1);
pasbool8type:=torddef.create(pasbool8,0,1);
pasbool16type:=torddef.create(pasbool16,0,1);
pasbool32type:=torddef.create(pasbool32,0,1);
pasbool64type:=torddef.create(pasbool64,0,1);
bool8type:=torddef.create(bool8bit,low(int64),high(int64));
bool16type:=torddef.create(bool16bit,low(int64),high(int64));
bool32type:=torddef.create(bool32bit,low(int64),high(int64));
@ -293,7 +296,10 @@ implementation
addtype('UnicodeString',cunicodestringtype);
addtype('OpenString',openshortstringtype);
addtype('Boolean',booltype);
addtype('Boolean',pasbool8type);
addtype('Boolean16',pasbool16type);
addtype('Boolean32',pasbool32type);
addtype('Boolean64',pasbool64type);
addtype('ByteBool',bool8type);
addtype('WordBool',bool16type);
addtype('LongBool',bool32type);
@ -333,11 +339,14 @@ implementation
addtype('$widestring',cwidestringtype);
addtype('$unicodestring',cunicodestringtype);
addtype('$openshortstring',openshortstringtype);
addtype('$boolean',booltype);
addtype('$boolean8',bool8type);
addtype('$boolean16',bool16type);
addtype('$boolean32',bool32type);
addtype('$boolean64',bool64type);
addtype('$boolean',pasbool8type);
addtype('$boolean16',pasbool16type);
addtype('$boolean32',pasbool32type);
addtype('$boolean64',pasbool64type);
addtype('$bytebool',bool8type);
addtype('$wordbool',bool16type);
addtype('$longbool',bool32type);
addtype('$qwordbool',bool64type);
addtype('$void_pointer',voidpointertype);
addtype('$char_pointer',charpointertype);
addtype('$widechar_pointer',widecharpointertype);
@ -438,11 +447,14 @@ implementation
loadtype('sc80real',sc80floattype);
end;
loadtype('s64currency',s64currencytype);
loadtype('boolean',booltype);
loadtype('boolean8',bool8type);
loadtype('boolean16',bool16type);
loadtype('boolean32',bool32type);
loadtype('boolean64',bool64type);
loadtype('boolean',pasbool8type);
loadtype('boolean16',pasbool16type);
loadtype('boolean32',pasbool32type);
loadtype('boolean64',pasbool64type);
loadtype('bytebool',bool8type);
loadtype('wordbool',bool16type);
loadtype('longbool',bool32type);
loadtype('qwordbool',bool64type);
loadtype('void_pointer',voidpointertype);
loadtype('char_pointer',charpointertype);
loadtype('widechar_pointer',widecharpointertype);

View File

@ -196,7 +196,7 @@ implementation
if is_cbool(def) then
inserttypeconv(n,def);
case def.ordtype of
pasbool,
pasbool8,
bool8bit :
begin
if is_constboolnode(n) then
@ -204,6 +204,7 @@ implementation
else
do_error;
end;
pasbool16,
bool16bit :
begin
if is_constboolnode(n) then
@ -211,6 +212,7 @@ implementation
else
do_error;
end;
pasbool32,
bool32bit :
begin
if is_constboolnode(n) then
@ -218,6 +220,7 @@ implementation
else
do_error;
end;
pasbool64,
bool64bit :
begin
if is_constboolnode(n) then

View File

@ -685,7 +685,7 @@ implementation
member_blocktype:=bt_type;
{ local and anonymous records can not have inner types. skip top record symtable }
if (current_structdef.objname^='') or
if (current_structdef.objname^='') or
not(symtablestack.stack^.next^.symtable.symtabletype in [globalsymtable,staticsymtable,objectsymtable,recordsymtable]) then
Message(parser_e_no_types_in_local_anonymous_records);
end;
@ -1052,7 +1052,7 @@ implementation
def:=torddef.create(uchar,lv,hv)
else
if is_boolean(pt1.resultdef) then
def:=torddef.create(pasbool,lv,hv)
def:=torddef.create(pasbool8,lv,hv)
else if is_signed(pt1.resultdef) then
def:=torddef.create(range_to_basetype(lv,hv),lv,hv)
else
@ -1172,7 +1172,8 @@ implementation
{$ifdef cpu64bitaddr}
u32bit,s64bit,
{$endif cpu64bitaddr}
pasbool,bool8bit,bool16bit,bool32bit,bool64bit,
pasbool8,pasbool16,pasbool32,pasbool64,
bool8bit,bool16bit,bool32bit,bool64bit,
uwidechar] then
begin
lowval:=torddef(def).low;

View File

@ -210,7 +210,8 @@ type
uvoid,
u8bit,u16bit,u32bit,u64bit,
s8bit,s16bit,s32bit,s64bit,
pasbool,bool8bit,bool16bit,bool32bit,bool64bit,
pasbool8,pasbool16,pasbool32,pasbool64,
bool8bit,bool16bit,bool32bit,bool64bit,
uchar,uwidechar,scurrency
);

View File

@ -677,7 +677,10 @@ interface
voidtype, { Void (procedure) }
cchartype, { Char }
cwidechartype, { WideChar }
booltype, { boolean type }
pasbool8type, { boolean type }
pasbool16type,
pasbool32type,
pasbool64type,
bool8type,
bool16type,
bool32type,
@ -1766,7 +1769,8 @@ implementation
0,
1,2,4,8,
1,2,4,8,
1,1,2,4,8,
1,2,4,8,
1,2,4,8,
1,2,8
);
begin
@ -1815,7 +1819,8 @@ implementation
varUndefined,
varbyte,varword,varlongword,varqword,
varshortint,varsmallint,varinteger,varint64,
varboolean,varboolean,varboolean,varUndefined,varUndefined,
varboolean,varboolean,varboolean,varboolean,
varboolean,varboolean,varUndefined,varUndefined,
varUndefined,varUndefined,varCurrency);
begin
result:=basetype2vardef[ordtype];
@ -1844,7 +1849,8 @@ implementation
'untyped',
'Byte','Word','DWord','QWord',
'ShortInt','SmallInt','LongInt','Int64',
'Boolean','ByteBool','WordBool','LongBool','QWordBool',
'Boolean','Boolean16','Boolean32','Boolean64',
'ByteBool','WordBool','LongBool','QWordBool',
'Char','WideChar','Currency');
begin
@ -3929,7 +3935,8 @@ implementation
'v',
'h','t','j','y',
'a','s','i','x',
'b','b','b','b','b',
'b','b','b','b',
'b','b','b','b',
'c','w','x');
floattype2str : array[tfloattype] of string[1] = (

View File

@ -2208,7 +2208,7 @@ unit cgx86;
current_asmdata.getjumplabel(hl);
if not ((def.typ=pointerdef) or
((def.typ=orddef) and
(torddef(def).ordtype in [u64bit,u16bit,u32bit,u8bit,uchar,pasbool]))) then
(torddef(def).ordtype in [u64bit,u16bit,u32bit,u8bit,uchar,pasbool8,pasbool16,pasbool32,pasbool64]))) then
cond:=C_NO
else
cond:=C_NB;

View File

@ -26,6 +26,9 @@ end;
procedure BoolTestAnd;
var
b1, b2: boolean;
b161, b162: boolean16;
b321, b322: boolean32;
b641, b642: boolean64;
bb1, bb2: bytebool;
wb1, wb2: wordbool;
lb1, lb2: longbool;
@ -62,6 +65,96 @@ begin
else
Fail;
{ BOOLEAN16 AND BOOLEAN16 }
Write('boolean16 AND boolean16 test...');
b161 := true;
b162 := false;
if b161 and b162 then
result := false;
if b162 then
result := false;
b161 := false;
b162 := false;
if b161 and b162 then
result := false;
b161 := b161 and b162;
if b161 then
result := false;
if b161 and FALSE then
result := false;
b161 := true;
b162 := true;
if b161 and b162 then
begin
if result then
WriteLn('Success.')
else
Fail;
end
else
Fail;
{ BOOLEAN32 AND BOOLEAN32 }
Write('boolean32 AND boolean32 test...');
b321 := true;
b322 := false;
if b321 and b322 then
result := false;
if b322 then
result := false;
b321 := false;
b322 := false;
if b321 and b322 then
result := false;
b321 := b321 and b322;
if b321 then
result := false;
if b321 and FALSE then
result := false;
b321 := true;
b322 := true;
if b321 and b322 then
begin
if result then
WriteLn('Success.')
else
Fail;
end
else
Fail;
{ BOOLEAN64 AND BOOLEAN64 }
Write('boolean64 AND boolean64 test...');
b641 := true;
b642 := false;
if b641 and b642 then
result := false;
if b642 then
result := false;
b641 := false;
b642 := false;
if b641 and b642 then
result := false;
b641 := b641 and b642;
if b641 then
result := false;
if b641 and FALSE then
result := false;
b641 := true;
b642 := true;
if b641 and b642 then
begin
if result then
WriteLn('Success.')
else
Fail;
end
else
Fail;
{ BYTEBOOL AND BYTEBOOL }
Write('bytebool AND bytebool test...');
bb1 := true;
@ -161,13 +254,16 @@ end;
procedure BoolTestOr;
var
b1, b2: boolean;
b161, b162: boolean16;
b321, b322: boolean32;
b641, b642: boolean64;
bb1, bb2: bytebool;
wb1, wb2: wordbool;
lb1, lb2: longbool;
result : boolean;
begin
result := false;
{ BOOLEAN AND BOOLEAN }
{ BOOLEAN OR BOOLEAN }
Write('boolean OR boolean test...');
b1 := true;
b2 := false;
@ -197,7 +293,97 @@ begin
else
Fail;
{ BYTEBOOL AND BYTEBOOL }
{ BOOLEAN16 OR BOOLEAN16 }
Write('boolean16 OR boolean16 test...');
b161 := true;
b162 := false;
if b161 or b162 then
result := true;
b161 := false;
b162 := false;
if b161 or b162 then
result := false;
b161 := b161 or b162;
if b161 then
result := false;
if b161 or FALSE then
result := false;
b161 := true;
b162 := true;
if b161 or b162 then
begin
if result then
WriteLn('Success.')
else
Fail;
end
else
Fail;
{ BOOLEAN32 OR BOOLEAN32 }
Write('boolean32 OR boolean32 test...');
b321 := true;
b322 := false;
if b321 or b322 then
result := true;
b321 := false;
b322 := false;
if b321 or b322 then
result := false;
b321 := b321 or b322;
if b321 then
result := false;
if b321 or FALSE then
result := false;
b321 := true;
b322 := true;
if b321 or b322 then
begin
if result then
WriteLn('Success.')
else
Fail;
end
else
Fail;
{ BOOLEAN64 OR BOOLEAN64 }
Write('boolean64 OR boolean64 test...');
b641 := true;
b642 := false;
if b641 or b642 then
result := true;
b641 := false;
b642 := false;
if b641 or b642 then
result := false;
b641 := b641 or b642;
if b641 then
result := false;
if b641 or FALSE then
result := false;
b641 := true;
b642 := true;
if b641 or b642 then
begin
if result then
WriteLn('Success.')
else
Fail;
end
else
Fail;
{ BYTEBOOL OR BYTEBOOL }
Write('bytebool OR bytebool test...');
bb1 := true;
bb2 := false;
@ -227,7 +413,7 @@ begin
else
Fail;
{ WORDBOOL AND WORDBOOL }
{ WORDBOOL OR WORDBOOL }
result := false;
Write('wordbool OR wordbool test...');
wb1 := true;
@ -257,7 +443,7 @@ begin
else
Fail;
{ LONGBOOL AND LONGBOOL }
{ LONGBOOL OR LONGBOOL }
result := false;
Write('longbool OR longbool test...');
lb1 := true;
@ -294,6 +480,9 @@ end;
Procedure BoolTestXor;
var
b1, b2: boolean;
b161, b162: boolean16;
b321, b322: boolean32;
b641, b642: boolean64;
bb1, bb2: bytebool;
wb1, wb2: wordbool;
lb1, lb2: longbool;
@ -332,6 +521,102 @@ begin
Fail;
end;
{ BOOLEAN16 XOR BOOLEAN16 }
Write('boolean16 XOR boolean16 test...');
b161 := true;
b162 := false;
if b161 xor b162 then
result := true;
b161 := false;
b162 := false;
if b161 xor b162 then
result := false;
b161 := b161 xor b162;
if b161 then
result := false;
if b161 xor FALSE then
result := false;
b161 := true;
b162 := true;
if b161 xor b162 then
begin
Fail;
end
else
begin
if result then
WriteLn('Success.')
else
Fail;
end;
{ BOOLEAN32 XOR BOOLEAN32 }
Write('boolean32 XOR boolean32 test...');
b321 := true;
b322 := false;
if b321 xor b322 then
result := true;
b321 := false;
b322 := false;
if b321 xor b322 then
result := false;
b321 := b321 xor b322;
if b321 then
result := false;
if b321 xor FALSE then
result := false;
b321 := true;
b322 := true;
if b321 xor b322 then
begin
Fail;
end
else
begin
if result then
WriteLn('Success.')
else
Fail;
end;
{ BOOLEAN64 XOR BOOLEAN64 }
Write('boolean64 XOR boolean64 test...');
b641 := true;
b642 := false;
if b641 xor b642 then
result := true;
b641 := false;
b642 := false;
if b641 xor b642 then
result := false;
b641 := b641 xor b642;
if b641 then
result := false;
if b641 xor FALSE then
result := false;
b641 := true;
b642 := true;
if b641 xor b642 then
begin
Fail;
end
else
begin
if result then
WriteLn('Success.')
else
Fail;
end;
{ BYTEBOOL XOR BYTEBOOL }
Write('bytebool XOR bytebool test...');
bb1 := true;
@ -434,6 +719,9 @@ end;
Procedure BoolTestEqual;
var
b1, b2, b3: boolean;
b161, b162, b163: boolean16;
b321, b322, b323: boolean32;
b641, b642, b643: boolean64;
bb1, bb2, bb3: bytebool;
wb1, wb2, wb3: wordbool;
lb1, lb2, lb3: longbool;
@ -441,6 +729,7 @@ var
values : longint;
Begin
values := $02020202;
{ BOOLEAN = BOOLEAN }
result := true;
Write('boolean = boolean test...');
@ -465,6 +754,82 @@ Begin
end
else
Fail;
{ BOOLEAN16 = BOOLEAN16 }
result := true;
Write('boolean16 = boolean16 test...');
b161 := true;
b162 := true;
b163 := false;
b161 := (b161 = b162) and (b162 and false);
if b161 then
result := false;
b161 := true;
b162 := true;
b163 := false;
b161 := (b161 = b162) and (b162 and true);
if not b161 then
result := false;
if b161 = b162 then
begin
if result then
WriteLn('Success.')
else
Fail;
end
else
Fail;
{ BOOLEAN32 = BOOLEAN32 }
result := true;
Write('boolean32 = boolean32 test...');
b321 := true;
b322 := true;
b323 := false;
b321 := (b321 = b322) and (b322 and false);
if b321 then
result := false;
b321 := true;
b322 := true;
b323 := false;
b321 := (b321 = b322) and (b322 and true);
if not b321 then
result := false;
if b321 = b322 then
begin
if result then
WriteLn('Success.')
else
Fail;
end
else
Fail;
{ BOOLEAN64 = BOOLEAN64 }
result := true;
Write('boolean64 = boolean64 test...');
b641 := true;
b642 := true;
b643 := false;
b641 := (b641 = b642) and (b642 and false);
if b641 then
result := false;
b641 := true;
b642 := true;
b643 := false;
b641 := (b641 = b642) and (b642 and true);
if not b641 then
result := false;
if b641 = b642 then
begin
if result then
WriteLn('Success.')
else
Fail;
end
else
Fail;
{ BYTEBOOL = BYTEBOOL }
result := true;
Write('bytebool = bytebool test...');
@ -489,6 +854,7 @@ Begin
end
else
Fail;
{ WORDBOOL = WORDBOOL }
result := true;
Write('wordbool = wordbool test...');
@ -522,6 +888,7 @@ Begin
WriteLn('Success.')
else
Fail;
{ LONGBOOL = LONGBOOL }
result := true;
Write('longbool = longbool test...');
@ -561,6 +928,9 @@ end;
Procedure BoolTestNotEqual;
var
b1, b2, b3: boolean;
b161, b162, b163: boolean16;
b321, b322, b323: boolean32;
b641, b642, b643: boolean64;
bb1, bb2, bb3: bytebool;
wb1, wb2, wb3: wordbool;
lb1, lb2, lb3: longbool;
@ -594,6 +964,94 @@ Begin
else
Fail;
end;
{ BOOLEAN16 <> BOOLEAN16 }
result := true;
Write('boolean16 <> boolean16 test...');
b161 := true;
b162 := true;
b163 := false;
b161 := (b161 <> b162) and (b162 <> false);
if b161 then
result := false;
b161 := true;
b162 := true;
b163 := false;
b161 := (b161 <> b162) and (b162 <> true);
if b161 then
result := false;
b161 := false;
b162 := false;
if b161 <> b162 then
begin
Fail;
end
else
begin
if result then
WriteLn('Success.')
else
Fail;
end;
{ BOOLEAN32 <> BOOLEAN32 }
result := true;
Write('boolean32 <> boolean32 test...');
b321 := true;
b322 := true;
b323 := false;
b321 := (b321 <> b322) and (b322 <> false);
if b321 then
result := false;
b321 := true;
b322 := true;
b323 := false;
b321 := (b321 <> b322) and (b322 <> true);
if b321 then
result := false;
b321 := false;
b322 := false;
if b321 <> b322 then
begin
Fail;
end
else
begin
if result then
WriteLn('Success.')
else
Fail;
end;
{ BOOLEAN64 <> BOOLEAN64 }
result := true;
Write('boolean64 <> boolean64 test...');
b641 := true;
b642 := true;
b643 := false;
b641 := (b641 <> b642) and (b642 <> false);
if b641 then
result := false;
b641 := true;
b642 := true;
b643 := false;
b641 := (b641 <> b642) and (b642 <> true);
if b641 then
result := false;
b641 := false;
b642 := false;
if b641 <> b642 then
begin
Fail;
end
else
begin
if result then
WriteLn('Success.')
else
Fail;
end;
{ BYTEBOOL <> BYTEBOOL }
result := true;
Write('bytebool <> bytebool test...');
@ -622,6 +1080,7 @@ Begin
else
Fail;
end;
{ WORDBOOL <> WORDBOOL }
result := true;
Write('wordbool <> wordbool test...');
@ -650,6 +1109,7 @@ Begin
else
Fail;
end;
{ LONGBOOL <> LONGBOOL }
result := true;
Write('longbool <> longbool test...');