* counterpart of r12844 for storing elements to a bitpacked array:

    do not access any data after the array in that case either
  * adapted tparray7 so it checks this on unix platforms

git-svn-id: trunk@12851 -

compiler/cgobj.pas

@@ -1437,6 +1437,7 @@ implementation
 
     procedure tcg.a_load_regconst_subsetref_intern(list : TAsmList; fromsize, subsetsize: tcgsize; fromreg: tregister; const sref: tsubsetreference; slopt: tsubsetloadopt);
       var
+        hl: tasmlabel;
         tmpreg, tmpindexreg, valuereg, extra_value_reg, maskreg: tregister;
         tosreg, fromsreg: tsubsetregister;
         tmpref: treference;
@@ -1676,21 +1677,24 @@ implementation
                 valuereg := makeregsize(list,valuereg,loadsize);
                 a_load_reg_ref(list,loadsize,loadsize,valuereg,sref.ref);
 
+                { make sure we do not read/write past the end of the array }
+                current_asmdata.getjumplabel(hl);
+                a_cmp_const_reg_label(list,OS_INT,OC_BE,loadbitsize-sref.bitlen,sref.bitindexreg,hl);
 
                 a_load_ref_reg(list,loadsize,OS_INT,tmpref,extra_value_reg);
                 tmpindexreg := getintregister(list,OS_INT);
 
-               { load current array value }
-               if (slopt <> SL_SETZERO) then
-                 begin
-                   tmpreg := getintregister(list,OS_INT);
-                   if (slopt <> SL_SETMAX) then
-                     a_load_reg_reg(list,fromsize,OS_INT,fromreg,tmpreg)
-                   else if (sref.bitlen <> AIntBits) then
-                     a_load_const_reg(list,OS_INT,aint((aword(1) shl sref.bitlen) - 1), tmpreg)
-                   else
-                     a_load_const_reg(list,OS_INT,-1,tmpreg);
-                 end;
+                { load current array value }
+                if (slopt <> SL_SETZERO) then
+                  begin
+                    tmpreg := getintregister(list,OS_INT);
+                    if (slopt <> SL_SETMAX) then
+                       a_load_reg_reg(list,fromsize,OS_INT,fromreg,tmpreg)
+                    else if (sref.bitlen <> AIntBits) then
+                      a_load_const_reg(list,OS_INT,aint((aword(1) shl sref.bitlen) - 1), tmpreg)
+                    else
+                      a_load_const_reg(list,OS_INT,-1,tmpreg);
+                  end;
 
                 { generate mask to zero the bits we have to insert }
                 if (slopt <> SL_SETMAX) then
@@ -1702,20 +1706,6 @@ implementation
                         a_op_reg_reg(list,OP_NEG,OS_INT,tmpindexreg,tmpindexreg);
                         a_load_const_reg(list,OS_INT,aint((aword(1) shl sref.bitlen)-1),maskreg);
                         a_op_reg_reg(list,OP_SHL,OS_INT,tmpindexreg,maskreg);
-{$ifdef sparc}
-                        {  on sparc, "shr X" = "shr (X and (bitsize-1))" -> fix so shr (x>32) = 0 }
-                        if (loadbitsize = AIntBits) then
-                          begin
-                            { if (tmpindexreg >= cpu_bit_size) then tmpreg := 1 else tmpreg := 0 }
-                            a_op_const_reg_reg(list,OP_SHR,OS_INT,{$ifdef cpu64bitalu}6{$else}5{$endif},tmpindexreg,valuereg);
-                            { if (tmpindexreg = cpu_bit_size) then maskreg := 0 else maskreg := -1 }
-                            a_op_const_reg(list,OP_SUB,OS_INT,1,valuereg);
-                            { if (tmpindexreg = cpu_bit_size) then maskreg := 0 }
-                            if (slopt <> SL_SETZERO) then
-                              a_op_reg_reg(list,OP_AND,OS_INT,valuereg,tmpreg);
-                            a_op_reg_reg(list,OP_AND,OS_INT,valuereg,maskreg);
-                          end;
-{$endif sparc}
                       end
                     else
                       begin
@@ -1724,21 +1714,6 @@ implementation
                         a_op_reg_reg(list,OP_NEG,OS_INT,tmpindexreg,tmpindexreg);
                         a_load_const_reg(list,OS_INT,aint((aword(1) shl sref.bitlen)-1),maskreg);
                         a_op_reg_reg(list,OP_SHR,OS_INT,tmpindexreg,maskreg);
-{$ifdef x86}
-                        { on i386 "x shl 32 = x shl 0", on x86/64 "x shl 64 = x shl 0". Fix so it's 0. }
-                        if (loadbitsize = AIntBits) then
-                          begin
-                            valuereg := getintregister(list,OS_INT);
-                            { if (tmpindexreg >= cpu_bit_size) then valuereg := 1 else valuereg := 0 }
-                            a_op_const_reg_reg(list,OP_SHR,OS_INT,{$ifdef cpu64bitalu}6{$else}5{$endif},tmpindexreg,valuereg);
-                            { if (tmpindexreg = cpu_bit_size) then valuereg := 0 else valuereg := -1 }
-                            a_op_const_reg(list,OP_SUB,OS_INT,1,valuereg);
-                            { if (tmpindexreg = cpu_bit_size) then tmpreg := maskreg := 0 }
-                            if (slopt <> SL_SETZERO) then
-                              a_op_reg_reg(list,OP_AND,OS_INT,valuereg,tmpreg);
-                            a_op_reg_reg(list,OP_AND,OS_INT,valuereg,maskreg);
-                          end;
-{$endif x86}
                       end;
 
                     a_op_reg_reg(list,OP_NOT,OS_INT,maskreg,maskreg);
@@ -1759,6 +1734,8 @@ implementation
                   end;
                 extra_value_reg := makeregsize(list,extra_value_reg,loadsize);
                 a_load_reg_ref(list,loadsize,loadsize,extra_value_reg,tmpref);
+
+                a_label(list,hl);
               end;
           end;
       end;

tests/test/tparray7.pp

@@ -2,6 +2,11 @@
 
 {$r-}
 
+{$ifdef unix}
+uses
+  baseunix, unix;
+{$endif}
+
 procedure error(l: longint);
 begin
   writeln('error near ',l);
@@ -200,6 +205,104 @@ begin
 end;
 
 
+procedure test32bit2;
+type
+  ta = 0..(1 shl 24) - 1;
+  tb = packed array[0..3*32-1] of ta;
+  paa = ^tb;
+const
+  results: array[0..3*32-1] of ta = (
+$17E546,$6D0CA6,$BC9CCD,$34E268,$F2C58F,$492C7D,$DBDC0F,$375B2C,$8DCC08,$96FE74,
+$EF0AAD,$8BBB1A,$DF4554,$B75B0C,$728566,$81059B,$8D51F1,$88EF21,$CFF51E,$29BAAC,
+$C52266,$53315E,$A558E9,$093C36,$1357E7,$95CD2E,$173011,$770CB1,$85F746,$7601FE,
+$F5CD6A,$4E77B1,$F99073,$7520DB,$3F86DF,$2E5B82,$3282B8,$3A9FCD,$831B0B,$2DC3E6,
+$38426E,$22CA1A,$E4FE56,$1B562F,$9A7757,$33BE8B,$013A7A,$7A0A4D,$7BC0B0,$48BFFB,
+$62FA6C,$B3D806,$BFD49E,$3B5AB0,$696A18,$CADC48,$458E79,$834F63,$97D7A5,$5C92CB,
+$E8E260,$D95895,$3D2DF0,$7257F7,$33D25C,$389DD8,$21107B,$002344,$655E49,$FBA7EF,
+$D91F7E,$F694A2,$60F469,$160183,$275CAD,$1B8D0B,$41512E,$4184DE,$4319A9,$C93977,
+$D8D40A,$6EBEA5,$C137B8,$82BED4,$67DAC6,$142013,$614C0E,$38867C,$BE1CDD,$6A40E5,
+$518787,$219852,$48BD56,$827F40,$3CC0A6,$E79AF6
+  );
+var
+  a: ta;
+  i,j: longint;
+{$ifdef unix}
+  p,p2: pbyte;
+  bp: paa;
+{$else}
+  b: tb;
+{$endif}
+begin
+{$ifdef unix}
+  { check for reading/writing past end of array }
+  repeat
+    p := fpmmap(nil,4096,PROT_READ or PROT_WRITE,MAP_PRIVATE or MAP_ANONYMOUS,-1,0);
+    p2 := fpmmap(nil,4096,PROT_READ or PROT_WRITE,MAP_PRIVATE or MAP_ANONYMOUS,-1,0);
+  until (ptruint(p2) = ptruint(p) + 4096);
+  fpmunmap(p2,4096);
+  fillchar(p^,4096,$ff);
+  bp := paa(ptruint(p)+4096-sizeof(tb));
+  for i := low(results) to high(results) do
+    begin
+      bp^[i] := results[i];
+      for j := succ(i) to high(results) do
+        if bp^[j] <> high(ta) then
+          error(241);
+      if bp^[i] <> results[i] then
+        error(242);
+    end;
+  for i := low(results) to high(results) do
+    if bp^[i] <> results[i] then
+      begin
+        writeln(i);
+        error(47);
+      end;
+  if (bp^[0] <> results[0]) then
+    error(41);
+  if (bp^[1] <> results[1]) then
+    error(42);
+  if (bp^[2] <> results[2]) then
+    error(43);
+  if (bp^[3] <> results[3]) then
+    error(44);
+  if (bp^[4] <> results[4]) then
+    error(45);
+  if (bp^[3*32-2] <> results[3*32-2]) then
+    error(46);
+  if (bp^[3*32-1] <> results[3*32-1]) then
+    error(47);
+  for i := low(results) to high(results) do
+    if bp^[i] <> results[i] then
+      error(48);
+  fpmunmap(p,4096);
+{$else}
+  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] <> high(ta) 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);
+{$endif}
+end;
+
+
 procedure test32to40bit;
 type
   ta = 0..$7fffffff;
@@ -243,5 +346,6 @@ begin
   test16bit;
   test16to24bit;
   test32bit;
+  test32bit2;
   test32to40bit;
 end.