paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-18 15:29:11 +02:00
Code Issues Packages Projects Releases Wiki Activity

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

Browse Source 
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 -
This commit is contained in:
Jonas Maebe 2009-03-01 13:33:34 +00:00
parent 273e1f54c9
commit d24f232485
2 changed files with 111 additions and 36 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

68
compiler/cgobj.pas
View File

@ -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);
if (sref.bitindexreg = NR_NO) then
begin
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)
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;

73
tests/test/tparray13.pp
View File

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