Răsfoiți Sursa

* fixes to previous constant integer commit

peter 21 ani în urmă
părinte
comite
e661df03ee
4 a modificat fișierele cu 55 adăugiri și 30 ștergeri
  1. 20 8
      compiler/defutil.pas
  2. 16 14
      compiler/nadd.pas
  3. 5 6
      compiler/nmat.pas
  4. 14 2
      compiler/ptype.pas

+ 20 - 8
compiler/defutil.pas

@@ -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

+ 16 - 14
compiler/nadd.pas

@@ -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

+ 5 - 6
compiler/nmat.pas

@@ -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

+ 14 - 2
compiler/ptype.pas

@@ -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