* insert proper type conversions when optimising logical operations and

compares by avoiding unnecessary sign extensions (fixes bug reported in
    http://lists.freepascal.org/lists/fpc-pascal/2010-January/023907.html )
  * never throw away int2int type conversions on bitpacked loads, because
    in these cases the proper bits still need to be selected

git-svn-id: trunk@14892 -

.gitattributes

@@ -8306,6 +8306,7 @@ tests/tbs/tb0566.pp svneol=native#text/plain
 tests/tbs/tb0567.pp svneol=native#text/plain
 tests/tbs/tb0568.pp svneol=native#text/plain
 tests/tbs/tb0569.pp svneol=native#text/pascal
+tests/tbs/tb0570.pp svneol=native#text/plain
 tests/tbs/tb205.pp svneol=native#text/plain
 tests/tbs/ub0060.pp svneol=native#text/plain
 tests/tbs/ub0069.pp svneol=native#text/plain

compiler/defutil.pas

@@ -249,6 +249,11 @@ interface
     { # returns true if the procdef has no parameters and no specified return type }
     function is_bareprocdef(pd : tprocdef): boolean;
 
+    { # returns the smallest base integer type whose range encompasses that of
+        both ld and rd; if keep_sign_if_equal, then if ld and rd have the same
+        signdness, the result will also get that signdness }
+    function get_common_intdef(ld, rd: torddef; keep_sign_if_equal: boolean): torddef;
+
 implementation
 
     uses
@@ -1046,4 +1051,54 @@ implementation
                  (pd.proctypeoption = potype_constructor));
       end;
 
+
+    function get_common_intdef(ld, rd: torddef; keep_sign_if_equal: boolean): torddef;
+      var
+        llow, lhigh: tconstexprint;
+      begin
+        llow:=rd.low;
+        if llow<ld.low then
+          llow:=ld.low;
+        lhigh:=rd.high;
+        if lhigh<ld.high then
+          lhigh:=ld.high;
+        case range_to_basetype(llow,lhigh) of
+          s8bit:
+            result:=torddef(s8inttype);
+          u8bit:
+            result:=torddef(u8inttype);
+          s16bit:
+            result:=torddef(s16inttype);
+          u16bit:
+            result:=torddef(u16inttype);
+          s32bit:
+            result:=torddef(s32inttype);
+          u32bit:
+            result:=torddef(u32inttype);
+          s64bit:
+            result:=torddef(s64inttype);
+          u64bit:
+            result:=torddef(u64inttype);
+          else
+            begin
+              { avoid warning }
+              result:=nil;
+              internalerror(200802291);
+            end;
+        end;
+        if keep_sign_if_equal and
+           (is_signed(ld)=is_signed(rd)) and
+           (is_signed(result)<>is_signed(ld)) then
+          case result.ordtype of
+            s8bit:
+              result:=torddef(u8inttype);
+            s16bit:
+              result:=torddef(u16inttype);
+            s32bit:
+              result:=torddef(u32inttype);
+            s64bit:
+              result:=torddef(u64inttype);
+          end;
+      end;
+
 end.

compiler/nadd.pas

@@ -371,8 +371,7 @@ implementation
               hp:=right;
               realdef:=hp.resultdef;
               while (hp.nodetype=typeconvn) and
-                    ([nf_internal,nf_explicit] * hp.flags = []) and
+                    ([nf_internal,nf_explicit] * hp.flags = []) do
-                    is_in_limit(ttypeconvnode(hp).left.resultdef,realdef) do
                 begin
                   hp:=ttypeconvnode(hp).left;
                   realdef:=hp.resultdef;
@@ -421,8 +420,7 @@ implementation
               hp:=left;
               realdef:=hp.resultdef;
               while (hp.nodetype=typeconvn) and
-                    ([nf_internal,nf_explicit] * hp.flags = []) and
+                    ([nf_internal,nf_explicit] * hp.flags = []) do
-                    is_in_limit(ttypeconvnode(hp).left.resultdef,realdef) do
                 begin
                   hp:=ttypeconvnode(hp).left;
                   realdef:=hp.resultdef;
@@ -1157,17 +1155,28 @@ implementation
                    begin
                      if (rd.size=ld.size) and
                         is_signed(ld) then
-                       inserttypeconv_internal(left,right.resultdef)
+                       inserttypeconv_internal(left,rd)
                      else
-                       inserttypeconv(left,right.resultdef)
+                       begin
+                         { not to left right.resultdef, because that may
+                           cause a range error if left and right's def don't
+                           completely overlap }
+                         nd:=get_common_intdef(torddef(ld),torddef(rd),true);
+                         inserttypeconv(left,nd);
+                         inserttypeconv(right,nd);
+                       end;
                    end
                  else
                    begin
                      if (rd.size=ld.size) and
                         is_signed(rd) then
-                       inserttypeconv_internal(right,left.resultdef)
+                       inserttypeconv_internal(right,ld)
                      else
-                       inserttypeconv(right,left.resultdef)
+                       begin
+                         nd:=get_common_intdef(torddef(ld),torddef(rd),true);
+                         inserttypeconv(left,nd);
+                         inserttypeconv(right,nd);
+                       end;
                    end
                end
              { is there a signed 64 bit type ? }
@@ -1278,32 +1287,7 @@ implementation
                    begin
 {$ifdef cpunodefaultint}
                      { for small cpus we use the smallest common type }
-                      llow:=torddef(rd).low;
+                     nd:=get_common_intdef(torddef(ld),torddef(rd),false);
-                      if llow<torddef(ld).low then
-                        llow:=torddef(ld).low;
-                      lhigh:=torddef(rd).high;
-                      if lhigh<torddef(ld).high then
-                        lhigh:=torddef(ld).high;
-                      case range_to_basetype(llow,lhigh) of
-                        s8bit:
-                          nd:=s8inttype;
-                        u8bit:
-                          nd:=u8inttype;
-                        s16bit:
-                          nd:=s16inttype;
-                        u16bit:
-                          nd:=u16inttype;
-                        s32bit:
-                          nd:=s32inttype;
-                        u32bit:
-                          nd:=u32inttype;
-                        s64bit:
-                          nd:=s64inttype;
-                        u64bit:
-                          nd:=u64inttype;
-                        else
-                          internalerror(200802291);
-                      end;
                      inserttypeconv(right,nd);
                      inserttypeconv(left,nd);
 {$else cpunodefaultint}

compiler/ncgcnv.pas

@@ -60,7 +60,7 @@ interface
     uses
       cutils,verbose,globtype,globals,
       aasmbase,aasmtai,aasmdata,aasmcpu,symconst,symdef,paramgr,
-      ncon,ncal,
+      nutils,ncon,ncal,
       cpubase,systems,
       procinfo,pass_2,
       cgbase,
@@ -88,7 +88,8 @@ interface
           nothing that we can load in a register }
         ressize := resultdef.size;
         leftsize := left.resultdef.size;
-        if (ressize<>leftsize) and
+        if ((ressize<>leftsize) or
+            is_bitpacked_access(left)) and
            not is_void(left.resultdef) then
           begin
             location_copy(location,left.location);

compiler/ncnv.pas

@@ -243,8 +243,11 @@ implementation
             exit;
          end;
 
-        { don't insert obsolete type conversions }
+        { don't insert superfluous type conversions, but
-        if equal_defs(p.resultdef,def) then
+          in case of bitpacked accesses, the original type must
+          remain too so that not too many/few bits are laoded }
+        if equal_defs(p.resultdef,def) and
+           not is_bitpacked_access(p) then
           p.resultdef:=def
         else
          begin
@@ -265,8 +268,11 @@ implementation
             exit;
          end;
 
-        { don't insert obsolete type conversions }
+        { don't insert superfluous type conversions, but
-        if equal_defs(p.resultdef,def) then
+          in case of bitpacked accesses, the original type must
+          remain too so that not too many/few bits are laoded }
+        if equal_defs(p.resultdef,def) and
+           not is_bitpacked_access(p) then
           p.resultdef:=def
         else
          begin
@@ -1692,6 +1698,10 @@ implementation
                   if assigned(result) then
                     exit;
 
+                  { in case of bitpacked accesses, the original type must
+                    remain so that not too many/few bits are laoded }
+                  if is_bitpacked_access(left) then
+                    convtype:=tc_int_2_int;
                   { Only leave when there is no conversion to do.
                     We can still need to call a conversion routine,
                     like the routine to convert a stringconstnode }

compiler/nutils.pas

@@ -90,6 +90,12 @@ interface
     procedure propaccesslist_to_node(var p1:tnode;st:TSymtable;pl:tpropaccesslist);
     function node_to_propaccesslist(p1:tnode):tpropaccesslist;
 
+    { returns true if n is an array element access of a bitpacked array with
+      elements of the which the vitsize mod 8 <> 0, or if is a field access
+      with bitsize mod 8 <> 0 or bitoffset mod 8 <> 0 of an element in a
+      bitpacked structure }
+    function is_bitpacked_access(n: tnode): boolean;
+
 implementation
 
     uses
@@ -1071,6 +1077,24 @@ implementation
       end;
 
 
+    function is_bitpacked_access(n: tnode): boolean;
+      begin
+        case n.nodetype of
+          vecn:
+            result:=
+              is_packed_array(tvecnode(n).left.resultdef) and
+              (tarraydef(tvecnode(n).left.resultdef).elepackedbitsize mod 8 <> 0);
+          subscriptn:
+            result:=
+              is_packed_record_or_object(tsubscriptnode(n).left.resultdef) and
+              ((tsubscriptnode(n).vs.vardef.packedbitsize mod 8 <> 0) or
+               (tsubscriptnode(n).vs.fieldoffset mod 8 <> 0));
+          else
+            result:=false;
+        end;
+      end;
+
+
     function has_no_code(n : tnode) : boolean;
       begin
         if n=nil then

tests/tbs/tb0570.pp

@@ -0,0 +1,36 @@
+program rangtest ;
+
+type
+  trange = 0..2030 ;
+  ytrange = 1990..2030 ;
+
+CONST
+  lrange =   low ( trange ) ;
+  hrange =  high ( trange ) ;
+  ylrange =  low ( ytrange ) ;
+  yhrange = high ( ytrange ) ;
+
+var
+  bbb : trange ;
+  kkk : longint ;
+  xyzzy : array [ ytrange, 1..100 ] of
+            record
+              xyzp : longint ;
+              xyzb : boolean ;
+             end ;
+
+begin       (*$r+,s+,o+*)
+  bbb := 0 ;
+  kkk := 1 ;
+  IF ( bbb >= ylrange )                   //  this IFstatement can not be found in the assembler file
+     AND ( bbb <= yhrange )         //  and the program stops with range error
+    THEN begin                             //
+      WITH xyzzy[bbb,kkk] DO
+        BEGIN
+          halt(1);
+          xyzp := 2 ;
+          xyzb := True ;
+         END ;
+     end
+    else writeln ( 'out' ) ;
+ end.