mirror of
				https://gitlab.com/freepascal.org/fpc/source.git
				synced 2025-11-04 15:39:24 +01:00 
			
		
		
		
	* fixes to previous constant integer commit
This commit is contained in:
		
							parent
							
								
									207e3b1231
								
							
						
					
					
						commit
						e661df03ee
					
				@ -50,6 +50,8 @@ interface
 | 
				
			|||||||
    {# Returns basetype of the specified integer range }
 | 
					    {# Returns basetype of the specified integer range }
 | 
				
			||||||
    function range_to_basetype(l,h:TConstExprInt):tbasetype;
 | 
					    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);
 | 
					    procedure int_to_type(v:TConstExprInt;var tt:ttype);
 | 
				
			||||||
 | 
					
 | 
				
			||||||
    {# Returns true, if definition defines an integer type }
 | 
					    {# Returns true, if definition defines an integer type }
 | 
				
			||||||
@ -266,25 +268,32 @@ implementation
 | 
				
			|||||||
      end;
 | 
					      end;
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					
 | 
				
			||||||
    procedure int_to_type(v:TConstExprInt;var tt:ttype);
 | 
					    procedure range_to_type(l,h:TConstExprInt;var tt:ttype);
 | 
				
			||||||
      begin
 | 
					      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
 | 
					         tt:=u8inttype
 | 
				
			||||||
        else if (v>=-128) and (v<=127) then
 | 
					        else if (l>=-128) and (h<=127) then
 | 
				
			||||||
         tt:=s8inttype
 | 
					         tt:=s8inttype
 | 
				
			||||||
        else if (v>=0) and (v<=65535) then
 | 
					        else if (l>=0) and (h<=65535) then
 | 
				
			||||||
         tt:=u16inttype
 | 
					         tt:=u16inttype
 | 
				
			||||||
        else if (v>=-32768) and (v<=32767) then
 | 
					        else if (l>=-32768) and (h<=32767) then
 | 
				
			||||||
         tt:=s16inttype
 | 
					         tt:=s16inttype
 | 
				
			||||||
        else if (v>=low(longint)) and (v<=high(longint)) then
 | 
					        else if (l>=low(longint)) and (h<=high(longint)) then
 | 
				
			||||||
         tt:=s32inttype
 | 
					         tt:=s32inttype
 | 
				
			||||||
        else if (v>=low(cardinal)) and (v<=high(cardinal)) then
 | 
					        else if (l>=low(cardinal)) and (h<=high(cardinal)) then
 | 
				
			||||||
         tt:=u32inttype
 | 
					         tt:=u32inttype
 | 
				
			||||||
        else
 | 
					        else
 | 
				
			||||||
         tt:=s64inttype;
 | 
					         tt:=s64inttype;
 | 
				
			||||||
      end;
 | 
					      end;
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					    procedure int_to_type(v:TConstExprInt;var tt:ttype);
 | 
				
			||||||
 | 
					      begin
 | 
				
			||||||
 | 
					        range_to_type(v,v,tt);
 | 
				
			||||||
 | 
					      end;
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					
 | 
				
			||||||
    { true if p is an ordinal }
 | 
					    { true if p is an ordinal }
 | 
				
			||||||
    function is_ordinal(def : tdef) : boolean;
 | 
					    function is_ordinal(def : tdef) : boolean;
 | 
				
			||||||
      var
 | 
					      var
 | 
				
			||||||
@ -877,7 +886,10 @@ implementation
 | 
				
			|||||||
end.
 | 
					end.
 | 
				
			||||||
{
 | 
					{
 | 
				
			||||||
  $Log$
 | 
					  $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
 | 
					    * constants ordinals now always have a type assigned
 | 
				
			||||||
    * integer constants have the smallest type, unsigned prefered over
 | 
					    * integer constants have the smallest type, unsigned prefered over
 | 
				
			||||||
      signed
 | 
					      signed
 | 
				
			||||||
 | 
				
			|||||||
@ -283,16 +283,6 @@ implementation
 | 
				
			|||||||
               begin
 | 
					               begin
 | 
				
			||||||
                 if not(equal_defs(ld,rd)) then
 | 
					                 if not(equal_defs(ld,rd)) then
 | 
				
			||||||
                   inserttypeconv(right,left.resulttype);
 | 
					                   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;
 | 
					                end;
 | 
				
			||||||
 | 
					
 | 
				
			||||||
              { load values }
 | 
					              { load values }
 | 
				
			||||||
@ -340,11 +330,20 @@ implementation
 | 
				
			|||||||
                  else
 | 
					                  else
 | 
				
			||||||
                    t:=genintconstnode(int64(qword(lv)*qword(rv)));
 | 
					                    t:=genintconstnode(int64(qword(lv)*qword(rv)));
 | 
				
			||||||
                xorn :
 | 
					                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 :
 | 
					                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 :
 | 
					                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 :
 | 
					                ltn :
 | 
				
			||||||
                  t:=cordconstnode.create(ord(lv<rv),booltype,true);
 | 
					                  t:=cordconstnode.create(ord(lv<rv),booltype,true);
 | 
				
			||||||
                lten :
 | 
					                lten :
 | 
				
			||||||
@ -1926,7 +1925,10 @@ begin
 | 
				
			|||||||
end.
 | 
					end.
 | 
				
			||||||
{
 | 
					{
 | 
				
			||||||
  $Log$
 | 
					  $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
 | 
					    * constants ordinals now always have a type assigned
 | 
				
			||||||
    * integer constants have the smallest type, unsigned prefered over
 | 
					    * integer constants have the smallest type, unsigned prefered over
 | 
				
			||||||
      signed
 | 
					      signed
 | 
				
			||||||
 | 
				
			|||||||
@ -536,7 +536,6 @@ implementation
 | 
				
			|||||||
    function tunaryminusnode.det_resulttype : tnode;
 | 
					    function tunaryminusnode.det_resulttype : tnode;
 | 
				
			||||||
      var
 | 
					      var
 | 
				
			||||||
         t : tnode;
 | 
					         t : tnode;
 | 
				
			||||||
         minusdef : Tprocdef;
 | 
					 | 
				
			||||||
      begin
 | 
					      begin
 | 
				
			||||||
         result:=nil;
 | 
					         result:=nil;
 | 
				
			||||||
         resulttypepass(left);
 | 
					         resulttypepass(left);
 | 
				
			||||||
@ -547,9 +546,7 @@ implementation
 | 
				
			|||||||
         { constant folding }
 | 
					         { constant folding }
 | 
				
			||||||
         if is_constintnode(left) then
 | 
					         if is_constintnode(left) then
 | 
				
			||||||
           begin
 | 
					           begin
 | 
				
			||||||
              tordconstnode(left).value:=-tordconstnode(left).value;
 | 
					              result:=genintconstnode(-tordconstnode(left).value);
 | 
				
			||||||
              result:=left;
 | 
					 | 
				
			||||||
              left:=nil;
 | 
					 | 
				
			||||||
              exit;
 | 
					              exit;
 | 
				
			||||||
           end;
 | 
					           end;
 | 
				
			||||||
         if is_constrealnode(left) then
 | 
					         if is_constrealnode(left) then
 | 
				
			||||||
@ -671,7 +668,6 @@ implementation
 | 
				
			|||||||
      var
 | 
					      var
 | 
				
			||||||
         t : tnode;
 | 
					         t : tnode;
 | 
				
			||||||
         tt : ttype;
 | 
					         tt : ttype;
 | 
				
			||||||
         notdef : Tprocdef;
 | 
					 | 
				
			||||||
         v : tconstexprint;
 | 
					         v : tconstexprint;
 | 
				
			||||||
      begin
 | 
					      begin
 | 
				
			||||||
         result:=nil;
 | 
					         result:=nil;
 | 
				
			||||||
@ -856,7 +852,10 @@ begin
 | 
				
			|||||||
end.
 | 
					end.
 | 
				
			||||||
{
 | 
					{
 | 
				
			||||||
  $Log$
 | 
					  $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
 | 
					    * constants ordinals now always have a type assigned
 | 
				
			||||||
    * integer constants have the smallest type, unsigned prefered over
 | 
					    * integer constants have the smallest type, unsigned prefered over
 | 
				
			||||||
      signed
 | 
					      signed
 | 
				
			||||||
 | 
				
			|||||||
@ -408,6 +408,12 @@ implementation
 | 
				
			|||||||
                             if (trangenode(pt).left.nodetype=ordconstn) and
 | 
					                             if (trangenode(pt).left.nodetype=ordconstn) and
 | 
				
			||||||
                                (trangenode(pt).right.nodetype=ordconstn) then
 | 
					                                (trangenode(pt).right.nodetype=ordconstn) then
 | 
				
			||||||
                              begin
 | 
					                              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;
 | 
					                                lowval:=tordconstnode(trangenode(pt).left).value;
 | 
				
			||||||
                                highval:=tordconstnode(trangenode(pt).right).value;
 | 
					                                highval:=tordconstnode(trangenode(pt).right).value;
 | 
				
			||||||
                                if highval<lowval then
 | 
					                                if highval<lowval then
 | 
				
			||||||
@ -415,7 +421,10 @@ implementation
 | 
				
			|||||||
                                   Message(parser_e_array_lower_less_than_upper_bound);
 | 
					                                   Message(parser_e_array_lower_less_than_upper_bound);
 | 
				
			||||||
                                   highval:=lowval;
 | 
					                                   highval:=lowval;
 | 
				
			||||||
                                 end;
 | 
					                                 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
 | 
					                              end
 | 
				
			||||||
                             else
 | 
					                             else
 | 
				
			||||||
                              Message(type_e_cant_eval_constant_expr);
 | 
					                              Message(type_e_cant_eval_constant_expr);
 | 
				
			||||||
@ -647,7 +656,10 @@ implementation
 | 
				
			|||||||
end.
 | 
					end.
 | 
				
			||||||
{
 | 
					{
 | 
				
			||||||
  $Log$
 | 
					  $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
 | 
					    * constants ordinals now always have a type assigned
 | 
				
			||||||
    * integer constants have the smallest type, unsigned prefered over
 | 
					    * integer constants have the smallest type, unsigned prefered over
 | 
				
			||||||
      signed
 | 
					      signed
 | 
				
			||||||
 | 
				
			|||||||
		Loading…
	
		Reference in New Issue
	
	Block a user