diff --git a/compiler/cgobj.pas b/compiler/cgobj.pas index 365d286cf6..1e8dcb0f33 100644 --- a/compiler/cgobj.pas +++ b/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.. -> 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..-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; diff --git a/tests/test/tparray13.pp b/tests/test/tparray13.pp index 798fd36e40..1bda413b2d 100644 --- a/tests/test/tparray13.pp +++ b/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.