mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-20 17:49:27 +02:00
* 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 -
This commit is contained in:
Jonas Maebe
parent
d24f232485
commit
0af39c77d9
@ -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;
|
||||
|
||||
@ -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.
|
||||
|
||||
Loading…
Reference in New Issue
Block a user