Merged revisions 6619,6631-6632,6682-6683 via svnmerge from

svn+ssh://[email protected]/FPC/svn/fpc/trunk

........
r6619 | jonas | 2007-02-23 18:02:28 +0100 (Fri, 23 Feb 2007) | 2 lines

  * fixed loading/storing of unaligned bitfields of size 2 to 7 bits

........
r6631 | jonas | 2007-02-24 18:03:04 +0100 (Sat, 24 Feb 2007) | 2 lines

  * fixed IE in case of trying to (un)pack an array of 0-byte records

........
r6632 | jonas | 2007-02-24 18:28:14 +0100 (Sat, 24 Feb 2007) | 2 lines

  * fixed syntax errors

........
r6682 | jonas | 2007-02-28 18:34:50 +0100 (Wed, 28 Feb 2007) | 9 lines

  * is_signed() only returns true for orddef's whose low value is < 0
    (and not for all s8bit..s64bit types, since subrange types may
     be marked like that but not have a lower bound < 0).

    This is needed for bitpacking negative values, because e.g.
    both 0..7 and -3..3 can be stored in 3 bits, but 0..7 must be
    zero-extended when extracted (so must be unsigned) and -3..3 must
    be sign-extended when extracted (so must be considered signed)

........
r6683 | jonas | 2007-02-28 18:42:41 +0100 (Wed, 28 Feb 2007) | 2 lines

  + support for bitpacking types with a negative lower bound

........

git-svn-id: branches/fpc_2_3@6684 -

.gitattributes

@@ -6787,6 +6787,7 @@ tests/test/tparray15.pp svneol=native#text/plain
 tests/test/tparray16.pp svneol=native#text/plain
 tests/test/tparray17.pp svneol=native#text/plain
 tests/test/tparray18.pp svneol=native#text/plain
+tests/test/tparray19.pp svneol=native#text/plain
 tests/test/tparray2.pp svneol=native#text/plain
 tests/test/tparray3.pp svneol=native#text/plain
 tests/test/tparray4.pp svneol=native#text/plain

compiler/cgobj.pas

@@ -917,10 +917,12 @@ implementation
 
 {$ifopt r+}
 {$define rangeon}
+{$r-}
 {$endif}
 
 {$ifopt q+}
 {$define overflowon}
+{$q-}
 {$endif}
 
    procedure tcg.a_load_subsetreg_reg(list : TAsmList; subsetsize, tosize: tcgsize; const sreg: tsubsetregister; destreg: tregister);
@@ -930,15 +932,25 @@ implementation
        stopbit: byte;
      begin
        tmpreg:=getintregister(list,sreg.subsetregsize);
-       a_op_const_reg_reg(list,OP_SHR,sreg.subsetregsize,sreg.startbit,sreg.subsetreg,tmpreg);
-       stopbit := sreg.startbit + sreg.bitlen;
-       // on x86(64), 1 shl 32(64) = 1 instead of 0
-       // use aword to prevent overflow with 1 shl 31
-       if (stopbit - sreg.startbit <> AIntBits) then
-         bitmask := (aword(1) shl (stopbit - sreg.startbit)) - 1
+       if (subsetsize in [OS_S8..OS_S128]) then
+         begin
+           { sign extend in case the value has a bitsize mod 8 <> 0 }
+           { both instructions will be optimized away if not        }
+           a_op_const_reg_reg(list,OP_SHL,sreg.subsetregsize,(tcgsize2size[sreg.subsetregsize]*8)-sreg.startbit-sreg.bitlen,sreg.subsetreg,tmpreg);
+           a_op_const_reg(list,OP_SAR,sreg.subsetregsize,(tcgsize2size[sreg.subsetregsize]*8)-sreg.bitlen,tmpreg);
+         end
        else
-         bitmask := high(aword);
-       a_op_const_reg(list,OP_AND,sreg.subsetregsize,aint(bitmask),tmpreg);
+         begin
+           a_op_const_reg_reg(list,OP_SHR,sreg.subsetregsize,sreg.startbit,sreg.subsetreg,tmpreg);
+           stopbit := sreg.startbit + sreg.bitlen;
+           // on x86(64), 1 shl 32(64) = 1 instead of 0
+           // use aword to prevent overflow with 1 shl 31
+           if (stopbit - sreg.startbit <> AIntBits) then
+             bitmask := (aword(1) shl (stopbit - sreg.startbit)) - 1
+           else
+             bitmask := high(aword);
+           a_op_const_reg(list,OP_AND,sreg.subsetregsize,aint(bitmask),tmpreg);
+         end;
        tmpreg := makeregsize(list,tmpreg,subsetsize);
        a_load_reg_reg(list,tcgsize2unsigned[subsetsize],subsetsize,tmpreg,tmpreg);
        a_load_reg_reg(list,subsetsize,tosize,tmpreg,destreg);
@@ -1081,7 +1093,7 @@ implementation
 (*
   Subsetrefs are used for (bit)packed arrays and (bit)packed records stored
   in memory. They are like a regular reference, but contain an extra bit
-  offset (either constant -startbit- or variable -bitindexreg, always OS_INT)
+  offset (either constant -startbit- or variable -bitindexreg-, always OS_INT)
   and a bit length (always constant).
 
   Bit packed values are stored differently in memory depending on whether we
@@ -1101,7 +1113,7 @@ implementation
   the right, but the bits in the next byte are all more significant than
   those in the previous byte (e.g., the 222 in the first byte are the low
   three bits of that value, while the 22 in the second byte are the upper
-  three bits.
+  two bits.
 
   Big endian, 9 bit values:
     11111111 12222222 22333333 33344444 ...
@@ -1157,7 +1169,7 @@ implementation
           internalerror(2006081312);
 
         extra_load :=
-          (intloadsize <> 1) and
+          (sref.bitlen <> 1) and
           ((sref.bitindexreg <> NR_NO) or
            (byte(sref.startbit+sref.bitlen) > byte(intloadsize*8)));
       end;
@@ -1171,20 +1183,37 @@ implementation
           begin
             { valuereg contains the upper bits, extra_value_reg the lower }
             restbits := (sref.bitlen - (loadbitsize - sref.startbit));
-            a_op_const_reg(list,OP_SHL,OS_INT,restbits,valuereg);
-            { mask other bits }
-            if (sref.bitlen <> AIntBits) then
-              a_op_const_reg(list,OP_AND,OS_INT,aint((aword(1) shl sref.bitlen)-1),valuereg);
+            if (subsetsize in [OS_S8..OS_S128]) then
+              begin
+                { sign extend }
+                a_op_const_reg(list,OP_SHL,OS_INT,AIntBits-loadbitsize+sref.startbit,valuereg);
+                a_op_const_reg(list,OP_SAR,OS_INT,AIntBits-sref.bitlen,valuereg);
+              end
+            else
+              begin
+                a_op_const_reg(list,OP_SHL,OS_INT,restbits,valuereg);
+                { mask other bits }
+                if (sref.bitlen <> AIntBits) then
+                  a_op_const_reg(list,OP_AND,OS_INT,aint((aword(1) shl sref.bitlen)-1),valuereg);
+              end;
             a_op_const_reg(list,OP_SHR,OS_INT,loadbitsize-restbits,extra_value_reg)
           end
         else
           begin
             { valuereg contains the lower bits, extra_value_reg the upper }
             a_op_const_reg(list,OP_SHR,OS_INT,sref.startbit,valuereg);
-            a_op_const_reg(list,OP_SHL,OS_INT,loadbitsize-sref.startbit,extra_value_reg);
-            { mask other bits }
-            if (sref.bitlen <> AIntBits) then
-              a_op_const_reg(list,OP_AND,OS_INT,aint((aword(1) shl sref.bitlen)-1),extra_value_reg);
+            if (subsetsize in [OS_S8..OS_S128]) then
+              begin
+                a_op_const_reg(list,OP_SHL,OS_INT,AIntBits-sref.bitlen+loadbitsize-sref.startbit,extra_value_reg);
+                a_op_const_reg(list,OP_SAR,OS_INT,AIntBits-sref.bitlen,extra_value_reg);
+              end
+            else
+              begin
+                a_op_const_reg(list,OP_SHL,OS_INT,loadbitsize-sref.startbit,extra_value_reg);
+                { mask other bits }
+                if (sref.bitlen <> AIntBits) then
+                  a_op_const_reg(list,OP_AND,OS_INT,aint((aword(1) shl sref.bitlen)-1),extra_value_reg);
+              end;
           end;
         { merge }
         a_op_reg_reg(list,OP_OR,OS_INT,extra_value_reg,valuereg);
@@ -1203,10 +1232,18 @@ implementation
 
             { get the data in valuereg in the right place }
             a_op_reg_reg(list,OP_SHL,OS_INT,sref.bitindexreg,valuereg);
-            a_op_const_reg(list,OP_SHR,OS_INT,loadbitsize-sref.bitlen,valuereg);
-            if (loadbitsize <> AIntBits) then
-              { mask left over bits }
-              a_op_const_reg(list,OP_AND,OS_INT,aint((aword(1) shl sref.bitlen)-1),valuereg);
+            if (subsetsize in [OS_S8..OS_S128]) then
+              begin
+                a_op_const_reg(list,OP_SHL,OS_INT,AIntBits-loadbitsize,valuereg);
+                a_op_const_reg(list,OP_SAR,OS_INT,AIntBits-sref.bitlen,valuereg)
+              end
+            else
+              begin
+                a_op_const_reg(list,OP_SHR,OS_INT,loadbitsize-sref.bitlen,valuereg);
+                if (loadbitsize <> AIntBits) then
+                  { mask left over bits }
+                  a_op_const_reg(list,OP_AND,OS_INT,aint((aword(1) shl sref.bitlen)-1),valuereg);
+              end;
             tmpreg := getintregister(list,OS_INT);
             { the bits in extra_value_reg (if any) start at the most significant bit =>         }
             { extra_value_reg must be shr by (loadbitsize-sref.bitlen)+(loadsize-sref.bitindex) }
@@ -1245,8 +1282,14 @@ implementation
 {$endif x86}
             { merge }
             a_op_reg_reg(list,OP_OR,OS_INT,extra_value_reg,valuereg);
-            { mask other bits }
-            a_op_const_reg(list,OP_AND,OS_INT,aint((aword(1) shl sref.bitlen)-1),valuereg);
+            { sign extend or mask other bits }
+            if (subsetsize in [OS_S8..OS_S128]) then
+              begin
+                a_op_const_reg(list,OP_SHL,OS_INT,AIntBits-sref.bitlen,valuereg);
+                a_op_const_reg(list,OP_SAR,OS_INT,AIntBits-sref.bitlen,valuereg);
+              end
+            else
+              a_op_const_reg(list,OP_AND,OS_INT,aint((aword(1) shl sref.bitlen)-1),valuereg);
           end;
       end;
 
@@ -1292,12 +1335,27 @@ implementation
                 if (target_info.endian = endian_big) then
                   begin
                     a_op_reg_reg(list,OP_SHL,OS_INT,sref.bitindexreg,valuereg);
-                    a_op_const_reg(list,OP_SHR,OS_INT,loadbitsize-sref.bitlen,valuereg);
+                    if (subsetsize in [OS_S8..OS_S128]) then
+                      begin
+                        { sign extend to entire register }
+                        a_op_const_reg(list,OP_SHL,OS_INT,AIntBits-loadbitsize,valuereg);
+                        a_op_const_reg(list,OP_SAR,OS_INT,AIntBits-sref.bitlen,valuereg);
+                      end
+                    else
+                      a_op_const_reg(list,OP_SHR,OS_INT,loadbitsize-sref.bitlen,valuereg);
                   end
                 else
-                  a_op_reg_reg(list,OP_SHR,OS_INT,sref.bitindexreg,valuereg);
-                { mask other bits }
-                a_op_const_reg(list,OP_AND,OS_INT,aint((aword(1) shl sref.bitlen)-1),valuereg);
+                  begin
+                    a_op_reg_reg(list,OP_SHR,OS_INT,sref.bitindexreg,valuereg);
+                    if (subsetsize in [OS_S8..OS_S128]) then
+                      begin
+                        a_op_const_reg(list,OP_SHL,OS_INT,AIntBits-sref.bitlen,valuereg);
+                        a_op_const_reg(list,OP_SAR,OS_INT,AIntBits-sref.bitlen,valuereg);
+                      end
+                  end;
+                { mask other bits/sign extend }
+                if not(subsetsize in [OS_S8..OS_S128]) then
+                  a_op_const_reg(list,OP_AND,OS_INT,aint((aword(1) shl sref.bitlen)-1),valuereg);
               end
           end
         else
@@ -1320,22 +1378,11 @@ implementation
           end;
 
         { store in destination }
-          { (types with a negative lower bound are always a base type (8, 16, 32, 64 bits) }
-        if ((sref.bitlen mod 8) = 0) then
-          begin
-            { since we know all necessary bits are already masked, avoid unnecessary }
-            { zero-extensions                                                        }
-            valuereg := makeregsize(list,valuereg,tosize);
-            a_load_reg_reg(list,tcgsize2unsigned[tosize],tosize,valuereg,destreg)
-          end
-        else
-          begin
-            { avoid unnecessary sign extension and zeroing }
-            valuereg := makeregsize(list,valuereg,OS_INT);
-            destreg := makeregsize(list,destreg,OS_INT);
-            a_load_reg_reg(list,OS_INT,OS_INT,valuereg,destreg);
-            destreg := makeregsize(list,destreg,tosize);
-          end
+        { avoid unnecessary sign extension and zeroing }
+        valuereg := makeregsize(list,valuereg,OS_INT);
+        destreg := makeregsize(list,destreg,OS_INT);
+        a_load_reg_reg(list,OS_INT,OS_INT,valuereg,destreg);
+        destreg := makeregsize(list,destreg,tosize);
       end;
 
 
@@ -1541,16 +1588,14 @@ implementation
                     if (target_info.endian = endian_big) then
                       begin
                         a_op_const_reg(list,OP_SHL,OS_INT,loadbitsize-sref.bitlen,tmpreg);
-                        if not(slopt in [SL_REGNOSRCMASK,SL_SETMAX]) and
-                           (loadbitsize <> AIntBits) then
+                        if not(slopt in [SL_REGNOSRCMASK,SL_SETMAX]) then
                           { mask left over bits }
                           a_op_const_reg(list,OP_AND,OS_INT,aint(((aword(1) shl sref.bitlen)-1) shl (loadbitsize-sref.bitlen)),tmpreg);
                         a_op_reg_reg(list,OP_SHR,OS_INT,sref.bitindexreg,tmpreg);
                       end
                     else
                       begin
-                        if not(slopt in [SL_REGNOSRCMASK,SL_SETMAX]) and
-                           (loadbitsize <> AIntBits) then
+                        if not(slopt in [SL_REGNOSRCMASK,SL_SETMAX]) then
                           { mask left over bits }
                           a_op_const_reg(list,OP_AND,OS_INT,aint((aword(1) shl sref.bitlen)-1),tmpreg);
                         a_op_reg_reg(list,OP_SHL,OS_INT,sref.bitindexreg,tmpreg);
@@ -1669,11 +1714,14 @@ implementation
         tmpreg: tregister;
         slopt: tsubsetloadopt;
       begin
+        { perform masking of the source value in advance }
         slopt := SL_REGNOSRCMASK;
+        if (sref.bitlen <> AIntBits) then
+          aword(a) := aword(a) and ((aword(1) shl sref.bitlen) -1); 
         if (
             { broken x86 "x shl regbitsize = x" }
             ((sref.bitlen <> AIntBits) and
-             (aword(a) = (aword(1) shl sref.bitlen) -1)) or
+             ((aword(a) and ((aword(1) shl sref.bitlen) -1)) = (aword(1) shl sref.bitlen) -1)) or
             ((sref.bitlen = AIntBits) and
              (a = -1))
            ) then

compiler/defutil.pas

@@ -437,7 +437,7 @@ implementation
       begin
          case def.typ of
            orddef :
-             result:=(torddef(def).ordtype in [s8bit,s16bit,s32bit,s64bit,scurrency]);
+             result:=torddef(def).low < 0;
            enumdef :
              result:=tenumdef(def).min < 0;
            arraydef :

compiler/ninl.pas

@@ -1431,6 +1431,10 @@ implementation
           set_varstate(target.left,vs_written,[]);
           { index in the unpacked array is read and must be valid }
           set_varstate(index.left,vs_read,[vsf_must_be_valid]);
+          { if the size of the arrays is 0 (array of empty records), }
+          { do nothing                                               }
+          if (source.resultdef.size = 0) then
+            result:=cnothingnode.create;
         end;
 
 

compiler/powerpc/cgcpu.pas

@@ -409,11 +409,17 @@ const
              list.concat(taicpu.op_reg_reg_const_const_const(A_RLWINM,destreg,
                sreg.subsetreg,(32-sreg.startbit) and 31,32-sreg.bitlen,31));
              { types with a negative lower bound are always a base type (8, 16, 32 bits) }
-             if ((sreg.bitlen mod 8) = 0) then
-               begin
-                 a_load_reg_reg(list,tcgsize2unsigned[subsetsize],subsetsize,destreg,destreg);
-                 a_load_reg_reg(list,subsetsize,tosize,destreg,destreg);
-               end;
+             if (subsetsize in [OS_S8..OS_S128]) then
+               if ((sreg.bitlen mod 8) = 0) then
+                 begin
+                   a_load_reg_reg(list,tcgsize2unsigned[subsetsize],subsetsize,destreg,destreg);
+                   a_load_reg_reg(list,subsetsize,tosize,destreg,destreg);
+                 end
+               else
+                 begin
+                   a_op_const_reg(list,OP_SHL,OS_INT,32-sreg.bitlen,destreg);
+                   a_op_const_reg(list,OP_SAR,OS_INT,32-sreg.bitlen,destreg);
+                 end;
            end
          else
            a_load_reg_reg(list,subsetsize,tosize,sreg.subsetreg,destreg);

compiler/powerpc64/cgcpu.pas

@@ -817,12 +817,20 @@ begin
     extend the sign correctly. (The latter is actually required only for signed subsets and if that
    subset is not >= the tosize). }
   extrdi_startbit := 64 - (sreg.bitlen + sreg.startbit);
-  if (sreg.startbit <> 0) then begin
+  if (sreg.startbit <> 0) or
+     (sreg.bitlen <> tcgsize2size[subsetsize]*8) then begin
     list.concat(taicpu.op_reg_reg_const_const(A_EXTRDI, destreg, sreg.subsetreg, sreg.bitlen, extrdi_startbit));
-    a_load_reg_reg(list, tcgsize2unsigned[subsetsize], subsetsize, destreg, destreg);
-    a_load_reg_reg(list, subsetsize, tosize, destreg, destreg);
+    if (subsetsize in [OS_S8..OS_S128]) then
+      if ((sreg.bitlen mod 8) = 0) then begin
+        a_load_reg_reg(list, tcgsize2unsigned[subsetsize], subsetsize, destreg, destreg);
+        a_load_reg_reg(list, subsetsize, tosize, destreg, destreg);
+      end else begin
+        a_op_const_reg(list,OP_SHL,OS_INT,64-sreg.bitlen,destreg);
+        a_op_const_reg(list,OP_SAR,OS_INT,64-sreg.bitlen,destreg);
+     end;
   end else begin
     a_load_reg_reg(list, tcgsize2unsigned[sreg.subsetregsize], subsetsize, sreg.subsetreg, destreg);
+    a_load_reg_reg(list, subsetsize, tosize, destreg, destreg);
   end;
 end;
 

compiler/ppcgen/cgppc.pas

@@ -412,26 +412,29 @@ unit cgppc;
       restbits: byte;
     begin
       restbits := (sref.bitlen - (loadbitsize - sref.startbit));
-      a_op_const_reg(list,OP_SHL,OS_INT,restbits,valuereg);
-      { mask other bits }
-      if (sref.bitlen <> AIntBits) then
-        a_op_const_reg(list,OP_AND,OS_INT,(aword(1) shl sref.bitlen)-1,valuereg);
+      if (subsetsize in [OS_S8..OS_S128]) then
+        begin
+         { sign extend }
+         a_op_const_reg(list,OP_SHL,OS_INT,AIntBits-loadbitsize+sref.startbit,valuereg);
+         a_op_const_reg(list,OP_SAR,OS_INT,AIntBits-sref.bitlen,valuereg);
+        end
+      else
+        begin
+          a_op_const_reg(list,OP_SHL,OS_INT,restbits,valuereg);
+          { mask other bits }
+          if (sref.bitlen <> AIntBits) then
+            a_op_const_reg(list,OP_AND,OS_INT,(aword(1) shl sref.bitlen)-1,valuereg);
+        end;
       { use subsetreg routine, it may have been overridden with an optimized version }
       fromsreg.subsetreg := extra_value_reg;
       fromsreg.subsetregsize := OS_INT;
       { subsetregs always count bits from right to left }
-      if (target_info.endian = endian_big) then
-        fromsreg.startbit := loadbitsize-restbits
-      else
-        fromsreg.startbit := 0;
+      fromsreg.startbit := loadbitsize-restbits;
       fromsreg.bitlen := restbits;
   
       tosreg.subsetreg := valuereg;
       tosreg.subsetregsize := OS_INT;
-      if (target_info.endian = endian_big) then
-        tosreg.startbit := 0
-      else
-        tosreg.startbit := loadbitsize-sref.startbit;
+      tosreg.startbit := 0;
       tosreg.bitlen := restbits;
   
       a_load_subsetreg_subsetreg(list,subsetsize,subsetsize,fromsreg,tosreg);

compiler/symdef.pas

@@ -1331,21 +1331,23 @@ implementation
 
     function tenumdef.packedbitsize: aint;
       var
+        sizeval: tconstexprint;
         power: longint;
       begin
         result := 0;
-        if (minval < 0) then
-          result := inherited packedbitsize
+        if (minval >= 0) and
+           (maxval <= 1) then
+          result := 1
         else
           begin
-            if (maxval <= 1) then
-              result := 1
+            if (minval>=0) then
+              sizeval:=maxval
             else
-              begin
-                { 256 must become 512 etc. }
-                nextpowerof2(maxval+1,power);
-                result := power;
-              end;
+              { don't count 0 twice }
+              sizeval:=(cutils.max(-minval,maxval)*2)-1;
+            { 256 must become 512 etc. }
+            nextpowerof2(sizeval+1,power);
+            result := power;
           end;
       end;
 
@@ -1496,26 +1498,32 @@ implementation
 
     function torddef.packedbitsize: aint;
       var
+        sizeval: tconstexprint;
         power: longint;
       begin
         result := 0;
         if ordtype = uvoid then
           exit;
-        if (low < 0) then
-          result := inherited packedbitsize
+
+        if (low >= 0) and
+           (high <= 1) then
+          result := 1
+        else if (ordtype = u64bit) or
+                ((ordtype = s64bit) and
+                 ((low <= (system.low(int64) div 2)) or
+                  (high > (system.high(int64) div 2)))) then
+          result := 64
         else
           begin
-            if (high <= 1) then
-              result := 1
-            else if (ordtype = u64bit) then
-              result := 64
+            if (low>=0) then
+              sizeval:=high
             else
-              begin
-                { 256 must become 512 etc. }
-                nextpowerof2(high+1,power);
-                result := power;
-              end;
-          end;
+              { don't count 0 twice }
+              sizeval:=(cutils.max(-low,high)*2)-1;
+            { 256 must become 512 etc. }
+            nextpowerof2(sizeval+1,power);
+            result := power;
+         end;
       end;
 
 

tests/test/tparray19.pp

@@ -0,0 +1,247 @@
+{$mode macpas}
+
+{$r-}
+
+procedure error(l: longint);
+begin
+  writeln('error near ',l);
+  halt(1);
+end;
+
+
+procedure test8bit;
+type
+  ta = -1..0;
+  tb = packed array[0..999] of ta;
+  tc = array[0..124] of byte;
+const
+  results: array[0..9] of ta = (-1,0,-1,-1,-1,0,-1,-1,-1,0);
+var
+  a: ta;
+  b: tb;
+  i,j: longint;
+begin
+  fillchar(b,sizeof(b),0);
+  for i := low(results) to high(results) do
+    begin
+      b[i] := results[i];
+      for j := succ(i) to high(results) do
+        if b[j] <> 0 then
+          error(201);
+      if b[i] <> results[i] then
+        error(202);
+    end;
+  if (b[0] <> results[0]) then
+    error(1);
+  if (b[1] <> results[1]) then
+    error(2);
+  if (b[2] <> results[2]) then
+    error(3);
+  if (b[3] <> results[3]) then
+    error(4);
+  if (b[4] <> results[4]) then
+    error(5);
+  for i := low(results) to high(results) do
+    if b[i] <> results[i] then
+      error(7);
+end;
+
+
+procedure test8to16bit;
+type
+  ta = -3..3;
+  tb = packed array[0..1000] of ta;
+const
+  results: array[0..5] of ta = (2,-2,1,-1,-3,1);
+var
+  a: ta;
+  b: tb;
+  i,j: longint;
+begin
+  fillchar(b,sizeof(b),0);
+  for i := low(results) to high(results) do
+    begin
+      b[i] := results[i];
+      for j := succ(i) to high(results) do
+        if b[j] <> 0 then
+          error(211);
+      if b[i] <> results[i] then
+        error(212);
+    end;
+  if (b[0] <> results[0]) then
+    error(11);
+  if (b[1] <> results[1]) then
+    error(12);
+  if (b[2] <> results[2]) then
+    error(13);
+  if (b[3] <> results[3]) then
+    error(14);
+  if (b[4] <> results[4]) then
+    error(15);
+  if (b[5] <> results[5]) then
+    error(155);
+  for i := low(results) to high(results) do
+    if b[i] <> results[i] then
+      error(17);
+end;
+
+
+procedure test16bit;
+type
+  ta = -255..255;
+  tb = packed array[0..799] of ta;
+  tc = array[0..899] of byte;
+const
+  results: array[0..4] of ta = (256-356,39,256-485,100,256-500);
+var
+  a: ta;
+  b: tb;
+  i,j: longint;
+begin
+  fillchar(b,sizeof(b),$ff);
+  for i := low(results) to high(results) do
+    begin
+      b[i] := results[i];
+      for j := succ(i) to high(results) do
+        if b[j] <> -1 then
+          error(221);
+      if b[i] <> results[i] then
+        error(222);
+    end;
+  if (b[0] <> results[0]) then
+    error(21);
+  if (b[1] <> results[1]) then
+    error(22);
+  if (b[2] <> results[2]) then
+    error(23);
+  if (b[3] <> results[3]) then
+    error(24);
+  if (b[4] <> results[4]) then
+    error(25);
+  for i := low(results) to high(results) do
+    if b[i] <> results[i] then
+      error(27);
+end;
+
+
+procedure test16to24bit;
+type
+  ta = -1023..1023;
+  tb = packed array[0..799] of ta;
+  tc = array[0..1099] of byte;
+const
+  results: array[0..4] of ta = (1000,67-1023,853,512-1023,759);
+var
+  a: ta;
+  b: tb;
+  i,j: longint;
+begin
+  fillchar(b,sizeof(b),0);
+  for i := low(results) to high(results) do
+    begin
+      b[i] := results[i];
+      for j := succ(i) to high(results) do
+        if b[j] <> 0 then
+          error(231);
+      if b[i] <> results[i] then
+        error(232);
+    end;
+  if (b[0] <> results[0]) then
+    error(31);
+  if (b[1] <> results[1]) then
+    error(32);
+  if (b[2] <> results[2]) then
+    error(33);
+  if (b[3] <> results[3]) then
+    error(34);
+  if (b[4] <> results[4]) then
+    error(35);
+  for i := low(results) to high(results) do
+    if b[i] <> results[i] then
+      error(37);
+end;
+
+
+procedure test32bit;
+type
+  ta = -((1 shl 18)-1)..(1 shl 18) - 1;
+  tb = packed array[0..799] of ta;
+  tc = array[0..1899] of byte;
+const
+  results: array[0..4] of ta = ($0002F687,$00032222-(1 shl 18),$000178EE,$000057970-(1 shl 18),$0007E1D2-(1 shl 18));
+var
+  a: ta;
+  b: tb;
+  i,j: longint;
+begin
+  fillchar(b,sizeof(b),$00);
+  for i := low(results) to high(results) do
+    begin
+      b[i] := results[i];
+      for j := succ(i) to high(results) do
+        if b[j] <> 0 then
+          error(241);
+      if b[i] <> results[i] then
+        error(242);
+    end;
+  if (b[0] <> results[0]) then
+    error(41);
+  if (b[1] <> results[1]) then
+    error(42);
+  if (b[2] <> results[2]) then
+    error(43);
+  if (b[3] <> results[3]) then
+    error(44);
+  if (b[4] <> results[4]) then
+    error(45);
+  for i := low(results) to high(results) do
+    if b[i] <> results[i] then
+      error(47);
+end;
+
+
+procedure test32to40bit;
+type
+  ta = -$3fffffff..$3fffffff;
+  tb = packed array[0..799] of ta;
+  tc = array[0..3099] of byte;
+const
+  results: array[0..4] of ta = ($3fffffff-$71567851,$3fffffff-$56789ABD,$3fffffff-$50F11178,$39D68DDC,$3fffffff-$6C7A5A7);
+var
+  a: ta;
+  b: tb;
+  i,j: longint;
+begin
+  fillchar(b,sizeof(b),0);
+  for i := low(results) to high(results) do
+    begin
+      b[i] := results[i];
+      for j := succ(i) to high(results) do
+        if b[j] <> 0 then
+          error(251);
+      if b[i] <> results[i] then
+        error(252);
+    end;
+  if (b[0] <> results[0]) then
+    error(51);
+  if (b[1] <> results[1]) then
+    error(52);
+  if (b[2] <> results[2]) then
+    error(53);
+  if (b[3] <> results[3]) then
+    error(54);
+  if (b[4] <> results[4]) then
+    error(55);
+  for i := low(results) to high(results) do
+    if b[i] <> results[i] then
+      error(57);
+end;
+
+begin
+  test8bit;
+  test8to16bit;
+  test16bit;
+  test16to24bit;
+  test32bit;
+  test32to40bit;
+end.

tests/test/uprec7.pp

@@ -8,7 +8,8 @@ Type TRecord = packed Record
                  a, b, c, d, e, f, g, h, i: Boolean
                end;
 
-Var ARecord:TRecord = (False, True, True, True, False, True, False, False, True);
+Var ARecord:TRecord = (a: False; b: True; c: True; d: True; e: False;
+                       f: True; g: False; h: False; i: True);
     s: Integer;
 
 Implementation