paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-27 10:30:44 +02:00
Code Issues Packages Projects Releases Wiki Activity

* fixes to previous constant integer commit

Browse Source
This commit is contained in:
peter 2004-03-29 14:44:10 +00:00
parent 207e3b1231
commit e661df03ee
4 changed files with 55 additions and 30 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

28
compiler/defutil.pas
View File

@ -50,6 +50,8 @@ interface
{# Returns basetype of the specified integer range }
function range_to_basetype(l,h:TConstExprInt):tbasetype;
procedure range_to_type(l,h:TConstExprInt;var tt:ttype);
procedure int_to_type(v:TConstExprInt;var tt:ttype);
{# Returns true, if definition defines an integer type }
@ -266,25 +268,32 @@ implementation
end;
procedure int_to_type(v:TConstExprInt;var tt:ttype);
procedure range_to_type(l,h:TConstExprInt;var tt:ttype);
begin
if (v>=0) and (v<=255) then
{ generate a unsigned range if high<0 and low>=0 }
if (l>=0) and (h<=255) then
tt:=u8inttype
else if (v>=-128) and (v<=127) then
else if (l>=-128) and (h<=127) then
tt:=s8inttype
else if (v>=0) and (v<=65535) then
else if (l>=0) and (h<=65535) then
tt:=u16inttype
else if (v>=-32768) and (v<=32767) then
else if (l>=-32768) and (h<=32767) then
tt:=s16inttype
else if (v>=low(longint)) and (v<=high(longint)) then
else if (l>=low(longint)) and (h<=high(longint)) then
tt:=s32inttype
else if (v>=low(cardinal)) and (v<=high(cardinal)) then
else if (l>=low(cardinal)) and (h<=high(cardinal)) then
tt:=u32inttype
else
tt:=s64inttype;
end;
procedure int_to_type(v:TConstExprInt;var tt:ttype);
begin
range_to_type(v,v,tt);
end;
{ true if p is an ordinal }
function is_ordinal(def : tdef) : boolean;
var
@ -877,7 +886,10 @@ implementation
end.
{
$Log$
Revision 1.11 2004-03-23 22:34:49 peter
Revision 1.12 2004-03-29 14:44:10 peter
* fixes to previous constant integer commit
Revision 1.11 2004/03/23 22:34:49 peter
* constants ordinals now always have a type assigned
* integer constants have the smallest type, unsigned prefered over
signed

30
compiler/nadd.pas
View File

@ -283,16 +283,6 @@ implementation
begin
if not(equal_defs(ld,rd)) then
inserttypeconv(right,left.resulttype);
end
else if (lt=ordconstn) and (rt=ordconstn) then
begin
{ make left const type the biggest (u32bit is bigger than
s32bit for or,and,xor) }
if (rd.size>ld.size) or
((torddef(rd).typ=torddef(uinttype.def).typ) and
(torddef(ld).typ=torddef(sinttype.def).typ) and
(nodetype in [orn,andn,xorn])) then
inserttypeconv(left,right.resulttype);
end;
{ load values }
@ -340,11 +330,20 @@ implementation
else
t:=genintconstnode(int64(qword(lv)*qword(rv)));
xorn :
t:=cordconstnode.create(lv xor rv,left.resulttype,false);
if is_integer(ld) then
t:=genintconstnode(lv xor rv)
else
t:=cordconstnode.create(lv xor rv,left.resulttype,true);
orn :
t:=cordconstnode.create(lv or rv,left.resulttype,false);
if is_integer(ld) then
t:=genintconstnode(lv or rv)
else
t:=cordconstnode.create(lv or rv,left.resulttype,true);
andn :
t:=cordconstnode.create(lv and rv,left.resulttype,false);
if is_integer(ld) then
t:=genintconstnode(lv and rv)
else
t:=cordconstnode.create(lv and rv,left.resulttype,true);
ltn :
t:=cordconstnode.create(ord(lv<rv),booltype,true);
lten :
@ -1926,7 +1925,10 @@ begin
end.
{
$Log$
Revision 1.114 2004-03-23 22:34:49 peter
Revision 1.115 2004-03-29 14:44:10 peter
* fixes to previous constant integer commit
Revision 1.114 2004/03/23 22:34:49 peter
* constants ordinals now always have a type assigned
* integer constants have the smallest type, unsigned prefered over
signed

11
compiler/nmat.pas
View File

@ -536,7 +536,6 @@ implementation
function tunaryminusnode.det_resulttype : tnode;
var
t : tnode;
minusdef : Tprocdef;
begin
result:=nil;
resulttypepass(left);
@ -547,9 +546,7 @@ implementation
{ constant folding }
if is_constintnode(left) then
begin
tordconstnode(left).value:=-tordconstnode(left).value;
result:=left;
left:=nil;
result:=genintconstnode(-tordconstnode(left).value);
exit;
end;
if is_constrealnode(left) then
@ -671,7 +668,6 @@ implementation
var
t : tnode;
tt : ttype;
notdef : Tprocdef;
v : tconstexprint;
begin
result:=nil;
@ -856,7 +852,10 @@ begin
end.
{
$Log$
Revision 1.60 2004-03-23 22:34:49 peter
Revision 1.61 2004-03-29 14:44:10 peter
* fixes to previous constant integer commit
Revision 1.60 2004/03/23 22:34:49 peter
* constants ordinals now always have a type assigned
* integer constants have the smallest type, unsigned prefered over
signed

16
compiler/ptype.pas
View File

@ -408,6 +408,12 @@ implementation
if (trangenode(pt).left.nodetype=ordconstn) and
(trangenode(pt).right.nodetype=ordconstn) then
begin
{ make both the same type or give an error. This is not
done when both are integer values, because typecasting
between -3200..3200 will result in a signed-unsigned
conflict and give a range check error (PFV) }
if not(is_integer(trangenode(pt).left.resulttype.def) and is_integer(trangenode(pt).left.resulttype.def)) then
inserttypeconv(trangenode(pt).left,trangenode(pt).right.resulttype);
lowval:=tordconstnode(trangenode(pt).left).value;
highval:=tordconstnode(trangenode(pt).right).value;
if highval<lowval then
@ -415,7 +421,10 @@ implementation
Message(parser_e_array_lower_less_than_upper_bound);
highval:=lowval;
end;
arraytype:=trangenode(pt).right.resulttype;
if is_integer(trangenode(pt).left.resulttype.def) then
range_to_type(lowval,highval,arraytype)
else
arraytype:=trangenode(pt).left.resulttype;
end
else
Message(type_e_cant_eval_constant_expr);
@ -647,7 +656,10 @@ implementation
end.
{
$Log$
Revision 1.65 2004-03-23 22:34:49 peter
Revision 1.66 2004-03-29 14:44:10 peter
* fixes to previous constant integer commit
Revision 1.65 2004/03/23 22:34:49 peter
* constants ordinals now always have a type assigned
* integer constants have the smallest type, unsigned prefered over
signed