* when loading data from a bitpacked array, make sure we never load

    anything from past the end of the array (it was discarded, but this
    can cause crashes if the array lies at the end of a memory block)
   -- todo: also for writing
  * adapted tparray13 so it checks this on unix platforms

git-svn-id: trunk@12844 -

compiler/cgobj.pas

@@ -488,7 +488,7 @@ unit cgobj;
         protected
           procedure get_subsetref_load_info(const sref: tsubsetreference; out loadsize: tcgsize; out extra_load: boolean);
           procedure a_load_subsetref_regs_noindex(list: TAsmList; subsetsize: tcgsize; loadbitsize: byte; const sref: tsubsetreference; valuereg, extra_value_reg: tregister); virtual;
-          procedure a_load_subsetref_regs_index(list: TAsmList; subsetsize: tcgsize; loadbitsize: byte; const sref: tsubsetreference; valuereg, extra_value_reg: tregister); virtual;
+          procedure a_load_subsetref_regs_index(list: TAsmList; subsetsize: tcgsize; loadbitsize: byte; const sref: tsubsetreference; valuereg: tregister); virtual;
 
           procedure a_load_regconst_subsetref_intern(list : TAsmList; fromsize, subsetsize: tcgsize; fromreg: tregister; const sref: tsubsetreference; slopt: tsubsetloadopt); virtual;
           procedure a_load_regconst_subsetreg_intern(list : TAsmList; fromsize, subsetsize: tcgsize; fromreg: tregister; const sreg: tsubsetregister; slopt: tsubsetloadopt); virtual;
@@ -1248,11 +1248,18 @@ implementation
       end;
 
 
-    procedure tcg.a_load_subsetref_regs_index(list: TAsmList; subsetsize: tcgsize; loadbitsize: byte; const sref: tsubsetreference; valuereg, extra_value_reg: tregister);
+    procedure tcg.a_load_subsetref_regs_index(list: TAsmList; subsetsize: tcgsize; loadbitsize: byte; const sref: tsubsetreference; valuereg: tregister);
       var
+        hl: tasmlabel;
+        tmpref: treference;
+        extra_value_reg,
         tmpreg: tregister;
       begin
         tmpreg := getintregister(list,OS_INT);
+        tmpref := sref.ref;
+        inc(tmpref.offset,loadbitsize div 8);
+        extra_value_reg := getintregister(list,OS_INT);
+
         if (target_info.endian = endian_big) then
           begin
             { since this is a dynamic index, it's possible that the value   }
@@ -1273,56 +1280,49 @@ implementation
                   a_op_const_reg(list,OP_AND,OS_INT,aint((aword(1) shl sref.bitlen)-1),valuereg);
               end;
             tmpreg := getintregister(list,OS_INT);
+
+            { ensure we don't load anything 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);
+
             { 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) }
             { => = -(sref.bitindex+(sref.bitlen-2*loadbitsize))                                 }
             a_op_const_reg_reg(list,OP_ADD,OS_INT,sref.bitlen-2*loadbitsize,sref.bitindexreg,tmpreg);
             a_op_reg_reg(list,OP_NEG,OS_INT,tmpreg,tmpreg);
+
+            { load next "loadbitsize" bits of the array }
+            a_load_ref_reg(list,int_cgsize(loadbitsize div 8),OS_INT,tmpref,extra_value_reg);
+
             a_op_reg_reg(list,OP_SHR,OS_INT,tmpreg,extra_value_reg);
             { if there are no bits in extra_value_reg, then sref.bitindex was      }
             { < loadsize-sref.bitlen, and therefore tmpreg will now be >= loadsize }
             { => extra_value_reg is now 0                                          }
-
-{$ifdef sparc}
-            { except on sparc, where "shr X" = "shr (X and (bitsize-1))" }
-            if (loadbitsize = AIntBits) then
-              begin
-                { if (tmpreg >= cpu_bit_size) then tmpreg := 1 else tmpreg := 0 }
-                a_op_const_reg(list,OP_SHR,OS_INT,{$ifdef cpu64bitalu}6{$else}5{$endif},tmpreg);
-                { if (tmpreg = cpu_bit_size) then tmpreg := 0 else tmpreg := -1 }
-                a_op_const_reg(list,OP_SUB,OS_INT,1,tmpreg);
-                { if (tmpreg = cpu_bit_size) then extra_value_reg := 0 }
-                a_op_reg_reg(list,OP_AND,OS_INT,tmpreg,extra_value_reg);
-              end;
-{$endif sparc}
-
             { merge }
             a_op_reg_reg(list,OP_OR,OS_INT,extra_value_reg,valuereg);
             { no need to mask, necessary masking happened earlier on }
+            a_label(list,hl);
           end
         else
           begin
             a_op_reg_reg(list,OP_SHR,OS_INT,sref.bitindexreg,valuereg);
+
+            { ensure we don't load anything 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);
+
             { Y-x = -(Y-x) }
             a_op_const_reg_reg(list,OP_SUB,OS_INT,loadbitsize,sref.bitindexreg,tmpreg);
             a_op_reg_reg(list,OP_NEG,OS_INT,tmpreg,tmpreg);
-            { tmpreg is in the range 1..<cpu_bitsize> -> will zero extra_value_reg }
-            { if all bits are in valuereg                                          }
+
+            { load next "loadbitsize" bits of the array }
+            a_load_ref_reg(list,int_cgsize(loadbitsize div 8),OS_INT,tmpref,extra_value_reg);
+
+            { tmpreg is in the range 1..<cpu_bitsize>-1 -> always ok }
             a_op_reg_reg(list,OP_SHL,OS_INT,tmpreg,extra_value_reg);
-{$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
-                { if (tmpreg >= cpu_bit_size) then tmpreg := 1 else tmpreg := 0 }
-                a_op_const_reg(list,OP_SHR,OS_INT,{$ifdef cpu64bitalu}6{$else}5{$endif},tmpreg);
-                { if (tmpreg = cpu_bit_size) then tmpreg := 0 else tmpreg := -1 }
-                a_op_const_reg(list,OP_SUB,OS_INT,1,tmpreg);
-                { if (tmpreg = cpu_bit_size) then extra_value_reg := 0 }
-                a_op_reg_reg(list,OP_AND,OS_INT,tmpreg,extra_value_reg);
-              end;
-{$endif x86}
             { merge }
             a_op_reg_reg(list,OP_OR,OS_INT,extra_value_reg,valuereg);
+            a_label(list,hl);
             { sign extend or mask other bits }
             if (subsetsize in [OS_S8..OS_S128]) then
               begin
@@ -1403,18 +1403,20 @@ implementation
           begin
             { load next value as well }
             extra_value_reg := getintregister(list,OS_INT);
-            tmpref := sref.ref;
-            inc(tmpref.offset,loadbitsize div 8);
-            a_load_ref_reg(list,loadsize,OS_INT,tmpref,extra_value_reg);
 
             if (sref.bitindexreg = NR_NO) then
-              { can be overridden to optimize }
-              a_load_subsetref_regs_noindex(list,subsetsize,loadbitsize,sref,valuereg,extra_value_reg)
+              begin
+                tmpref := sref.ref;
+                inc(tmpref.offset,loadbitsize div 8);
+                a_load_ref_reg(list,loadsize,OS_INT,tmpref,extra_value_reg);
+                { can be overridden to optimize }
+                a_load_subsetref_regs_noindex(list,subsetsize,loadbitsize,sref,valuereg,extra_value_reg)
+              end
             else
               begin
                 if (sref.startbit <> 0) then
                   internalerror(2006080610);
-                a_load_subsetref_regs_index(list,subsetsize,loadbitsize,sref,valuereg,extra_value_reg);
+                a_load_subsetref_regs_index(list,subsetsize,loadbitsize,sref,valuereg);
               end;
           end;
 

tests/test/tparray13.pp

@@ -2,6 +2,11 @@
 
 {$r-}
 
+{$ifdef unix}
+uses
+  baseunix,unix;
+{$endif}
+
 procedure error(l: longint);
 begin
   writeln('error near ',l);
@@ -94,6 +99,73 @@ begin
 end;
 
 
+procedure test32bit2;
+type
+  ta = 0..(1 shl 24) - 1;
+  taa = packed array[0..3*32-1] of ta;
+  paa = ^taa;
+const
+  b: packed 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
+  );
+
+  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
+  i: longint;
+{$ifdef unix}
+  p,p2: pbyte;
+  bp: paa;
+{$endif}
+begin
+  if (sizeof(b)<>3*length(results)) then
+    error(48);
+{$ifdef unix}
+  { check for reading 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);
+  move(b,pbyte(ptruint(p)+4096-sizeof(b))^,sizeof(b));
+  bp := paa(ptruint(p)+4096-sizeof(b));
+  for i := low(results) to high(results) do
+    if bp^[i] <> results[i] then
+      begin
+        writeln(i);
+        error(49);
+      end;
+  fpmunmap(p,4096);
+{$else}
+  for i := low(results) to high(results) do
+    if b[i] <> results[i] then
+      begin
+        writeln(i);
+        error(49);
+      end;
+{$endif}
+end;
+
+
 procedure test32to40bit;
 type
   ta = 0..$7fffffff;
@@ -116,5 +188,6 @@ begin
   test16bit;
   test16to24bit;
   test32bit;
+  test32bit2;
   test32to40bit;
 end.