paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-11-03 06:49:26 +01:00
Code Issues Packages Projects Releases Wiki Activity

* converted range checking for open arrays/array of const from the code

Browse Source 
generator to the typecheck pass, so that it also works for platforms
    that use the parentfpstruct way to handle accesses to nested frames
    in case the array has been migrated to such a parentfpstruct
   o additionally, the number of comparisons for such range checks
     has been reduced from 3 (for signed indices) or 2 (for unsigned
     indices) to 1 in all cases
   o the range checking code is disabled for the JVM target, as the
     JVM automatically range checks all array accesses itself anyway

git-svn-id: trunk@34034 -
This commit is contained in:
Jonas Maebe 2016-06-30 15:33:47 +00:00
parent 33b44443b8
commit 996e325175
9 changed files with 250 additions and 66 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
.gitattributes vendored
View File

@ -15634,6 +15634,11 @@ tests/webtbs/tw8935.pp svneol=native#text/plain
tests/webtbs/tw8950.pp svneol=native#text/plain
tests/webtbs/tw8975.pp svneol=native#text/plain
tests/webtbs/tw8975a.pp svneol=native#text/plain
tests/webtbs/tw8975b.pp svneol=native#text/plain
tests/webtbs/tw8975c.pp svneol=native#text/plain
tests/webtbs/tw8975d.pp svneol=native#text/plain
tests/webtbs/tw8975e.pp svneol=native#text/plain
tests/webtbs/tw8975f.pp svneol=native#text/plain
tests/webtbs/tw8977.pp svneol=native#text/plain
tests/webtbs/tw9025.pp svneol=native#text/plain
tests/webtbs/tw9026.pp svneol=native#text/plain

10
compiler/jvm/njvmmem.pas
View File

@ -57,6 +57,9 @@ interface
end;
tjvmvecnode = class(tcgvecnode)
protected
function gen_array_rangecheck: tnode; override;
public
function pass_1: tnode; override;
procedure pass_generate_code;override;
end;
@ -355,6 +358,13 @@ implementation
TJVMVECNODE
*****************************************************************************}
function tjvmvecnode.gen_array_rangecheck: tnode;
begin
{ JVM does the range checking for us }
result:=nil;
end;
function tjvmvecnode.pass_1: tnode;
var
psym: tsym;

38
compiler/ncgmem.pas
View File

@ -767,43 +767,7 @@ implementation
exit;
paraloc1.init;
paraloc2.init;
if is_open_array(left.resultdef) or
is_array_of_const(left.resultdef) then
begin
{ cdecl functions don't have high() so we can not check the range }
{ (can't use current_procdef, since it may be a nested procedure) }
if not(tprocdef(tparasymtable(tparavarsym(tloadnode(get_open_const_array(left)).symtableentry).owner).defowner).proccalloption in cdecl_pocalls) then
begin
{ Get high value }
hightree:=load_high_value_node(tparavarsym(tloadnode(get_open_const_array(left)).symtableentry));
{ it must be available }
if not assigned(hightree) then
internalerror(200212201);
firstpass(hightree);
secondpass(hightree);
{ generate compares }
{$ifndef cpuhighleveltarget}
if (right.location.loc in [LOC_REGISTER,LOC_CREGISTER]) then
hreg:=cg.makeregsize(current_asmdata.CurrAsmList,right.location.register,OS_INT)
else
{$endif not cpuhighleveltarget}
begin
hreg:=hlcg.getintregister(current_asmdata.CurrAsmList,ossinttype);
hlcg.a_load_loc_reg(current_asmdata.CurrAsmList,right.resultdef,ossinttype,right.location,hreg);
end;
current_asmdata.getjumplabel(neglabel);
current_asmdata.getjumplabel(poslabel);
hlcg.a_cmp_const_reg_label(current_asmdata.CurrAsmList,ossinttype,OC_LT,0,hreg,poslabel);
hlcg.a_cmp_loc_reg_label(current_asmdata.CurrAsmList,osuinttype,OC_BE,hightree.location,hreg,neglabel);
hlcg.a_label(current_asmdata.CurrAsmList,poslabel);
hlcg.g_call_system_proc(current_asmdata.CurrAsmList,'fpc_rangeerror',[],nil).resetiftemp;
hlcg.a_label(current_asmdata.CurrAsmList,neglabel);
{ release hightree }
hightree.free;
end;
end
else
if is_dynamic_array(left.resultdef) then
if is_dynamic_array(left.resultdef) then
begin
pd:=search_system_proc('fpc_dynarray_rangecheck');
paramanager.getintparaloc(current_asmdata.CurrAsmList,pd,1,paraloc1);

127
compiler/nmem.pas
View File

@ -117,6 +117,7 @@ interface
tvecnode = class(tbinarynode)
protected
function first_arraydef: tnode; virtual;
function gen_array_rangecheck: tnode; virtual;
public
constructor create(l,r : tnode);virtual;
function pass_1 : tnode;override;
@ -154,7 +155,7 @@ implementation
globtype,systems,constexp,
cutils,verbose,globals,
symconst,symbase,defutil,defcmp,
nbas,ninl,nutils,objcutil,
nadd,nbas,nflw,ninl,nutils,objcutil,
wpobase,
{$ifdef i8086}
cpuinfo,
@ -867,7 +868,6 @@ implementation
function tvecnode.pass_typecheck:tnode;
var
hightree: tnode;
htype,elementdef,elementptrdef : tdef;
newordtyp: tordtype;
valid : boolean;
@ -920,6 +920,23 @@ implementation
handle_variantarray in pexpr.pas. Therefore, encountering a variant array is an
internal error... }
internalerror(200707031)
{ open array and array constructor range checking is handled
below at the node level, where the validity of the index
will be checked -> use a regular type conversion to either
the signed or unsigned native int type to prevent another
range check from getting inserted here (unless the type is
larger than the int type). Exception: if it's an ordinal
constant, because then this check should be performed at
compile time }
else if is_open_array(left.resultdef) or
is_array_constructor(left.resultdef) then
begin
if is_signed(right.resultdef) and
not is_constnode(right) then
inserttypeconv(right,sinttype)
else
inserttypeconv(right,uinttype)
end
else if is_special_array(left.resultdef) then
{Arrays without a high bound (dynamic arrays, open arrays) are zero based,
convert indexes into these arrays to aword.}
@ -1010,33 +1027,10 @@ implementation
else
resultdef:=Tarraydef(left.resultdef).elementdef;
{ if we are range checking an open array or array of const, we }
{ need to load the high parameter. If the current procedure is }
{ nested inside the procedure to which the open array/of const }
{ was passed, then the high parameter must not be a regvar. }
{ So create a loadnode for the high parameter here and }
{ typecheck it, then the loadnode will make the high parameter }
{ not regable. Otherwise this would only happen inside pass_2, }
{ which is too late since by then the regvars are already }
{ assigned (pass_1 is also already too late, because then the }
{ regvars of the parent are also already assigned). }
{ webtbs/tw8975 }
if (cs_check_range in current_settings.localswitches) and
(is_open_array(left.resultdef) or
is_array_of_const(left.resultdef)) then
begin
{ expect to find the load node }
if get_open_const_array(left).nodetype<>loadn then
internalerror(2014040601);
{ cdecl functions don't have high() so we can not check the range }
{ (can't use current_procdef, since it may be a nested procedure) }
if not(tprocdef(tparasymtable(tparavarsym(tloadnode(get_open_const_array(left)).symtableentry).owner).defowner).proccalloption in cdecl_pocalls) then
begin
{ load_high_value_node already typechecks }
hightree:=load_high_value_node(tparavarsym(tloadnode(get_open_const_array(left)).symtableentry));
hightree.free;
end;
end;
result:=gen_array_rangecheck;
if assigned(result) then
exit;
{ in case of a bitpacked array of enums that are size 2 (due to
packenum 2) but whose values all fit in one byte, the size of
bitpacked array elements will be 1 byte while the resultdef of
@ -1186,6 +1180,81 @@ implementation
expectloc:=LOC_SUBSETREF;
end;
function tvecnode.gen_array_rangecheck: tnode;
var
htype: tdef;
temp: ttempcreatenode;
stat: tstatementnode;
indextree: tnode;
hightree: tnode;
begin
result:=nil;
{ Range checking an array of const/open array/dynamic array is
more complicated than regular arrays, because the bounds must
be checked dynamically. Additionally, in case of array of const
and open array we need the high parameter, which must not be
made a regvar in case this is a nested rountine relative to the
array parameter -> generate te check at the node tree level
rather than in the code generator }
if (cs_check_range in current_settings.localswitches) and
(is_open_array(left.resultdef) or
is_array_of_const(left.resultdef)) and
(right.nodetype<>rangen) then
begin
{ expect to find the load node }
if get_open_const_array(left).nodetype<>loadn then
internalerror(2014040601);
{ cdecl functions don't have high() so we can not check the range }
{ (can't use current_procdef, since it may be a nested procedure) }
if not(tprocdef(tparasymtable(tparavarsym(tloadnode(get_open_const_array(left)).symtableentry).owner).defowner).proccalloption in cdecl_pocalls) then
begin
temp:=nil;
result:=internalstatements(stat);
{ can't use node_complexity here, assumes that the code has
already been firstpassed }
if not is_const(right) then
begin
temp:=ctempcreatenode.create(right.resultdef,right.resultdef.size,tt_persistent,true);
addstatement(stat,temp);
{ needed so we can typecheck its temprefnodes }
typecheckpass(tnode(temp));
addstatement(stat,cassignmentnode.create(
ctemprefnode.create(temp),right)
);
right:=ctemprefnode.create(temp);
{ right.resultdef is used below }
typecheckpass(right);
end;
{ range check will be made explicit here }
exclude(localswitches,cs_check_range);
hightree:=load_high_value_node(tparavarsym(tloadnode(
get_open_const_array(left)).symtableentry));
{ make index unsigned so we only need one comparison;
lower bound is always zero for these arrays, but
hightree can be -1 in case the array was empty ->
add 1 before comparing (ignoring overflows) }
htype:=get_unsigned_inttype(right.resultdef);
inserttypeconv_explicit(hightree,htype);
hightree:=caddnode.create(addn,hightree,genintconstnode(1));
hightree.localswitches:=hightree.localswitches-[cs_check_range,
cs_check_overflow];
indextree:=ctypeconvnode.create_explicit(right.getcopy,htype);
{ range error if index >= hightree+1 }
addstatement(stat,
cifnode.create_internal(
caddnode.create_internal(gten,indextree,hightree),
ccallnode.createintern('fpc_rangeerror',nil),
nil
)
);
if assigned(temp) then
addstatement(stat,ctempdeletenode.create_normal_temp(temp));
addstatement(stat,self.getcopy);
end;
end;
end;
{*****************************************************************************
TWITHNODE

38
tests/webtbs/tw8975b.pp Normal file
View File

@ -0,0 +1,38 @@
{ %opt=-CRriot -O-2 -Ooregvar }
{Internal FPC2.1.4 error, compile with fpc -B -dDebug -O3}
procedure bug(var b: array of longint);
var
l: longint;
procedure intern;
begin
if (b[l] <> 1) then {Fatal: Internal error 200409241}
halt(1);
inc(b[l]);
if (b[l] <> 2) then {Fatal: Internal error 200409241}
halt(2);
if (b[l+1] <> 2) then {Fatal: Internal error 200409241}
halt(3);
if (b[l+2] <> 3) then {Fatal: Internal error 200409241}
halt(4);
if (b[low(b)] <> 2) then {Fatal: Internal error 200409241}
halt(5);
if (b[low(b)+1] <> 2) then {Fatal: Internal error 200409241}
halt(6);
if (b[low(b)+2] <> 3) then {Fatal: Internal error 200409241}
halt(7);
end;
begin
l:=0;
intern;
end;
const
a: array[1..3] of longint = (1,2,3);
begin
bug(a);
end.

25
tests/webtbs/tw8975c.pp Normal file
View File

@ -0,0 +1,25 @@
{ %opt=-CRriot -O-2 -Ooregvar }
{ %result=201 }
{Internal FPC2.1.4 error, compile with fpc -B -dDebug -O3}
procedure bug(var b: array of longint);
var
l: longint;
procedure intern;
begin
if (b[l] <> 1) then {Fatal: Internal error 200409241}
halt(1);
end;
begin
l:=-1;
intern;
end;
const
a: array[1..3] of longint = (1,2,3);
begin
bug(a);
end.

25
tests/webtbs/tw8975d.pp Normal file
View File

@ -0,0 +1,25 @@
{ %opt=-CRriot -O-2 -Ooregvar }
{ %result=201 }
{Internal FPC2.1.4 error, compile with fpc -B -dDebug -O3}
procedure bug(var b: array of longint);
var
l: longint;
procedure intern;
begin
if (b[l] <> 1) then {Fatal: Internal error 200409241}
halt(1);
end;
begin
l:=3;
intern;
end;
const
a: array[1..3] of longint = (1,2,3);
begin
bug(a);
end.

22
tests/webtbs/tw8975e.pp Normal file
View File

@ -0,0 +1,22 @@
{ %opt=-CRriot -O-2 -Ooregvar }
{ %fail }
{Internal FPC2.1.4 error, compile with fpc -B -dDebug -O3}
procedure bug(var b: array of longint);
procedure intern;
begin
if (b[low(b)-1] <> 1) then {Fatal: Internal error 200409241}
halt(1);
end;
begin
intern;
end;
const
a: array[1..3] of longint = (1,2,3);
begin
bug(a);
end.

26
tests/webtbs/tw8975f.pp Normal file
View File

@ -0,0 +1,26 @@
{ %opt=-CRriot -O-2 -Ooregvar }
{ %result=201 }
{Internal FPC2.1.4 error, compile with fpc -B -dDebug -O3}
procedure bug(var b: array of longint);
var
l: int64;
procedure intern;
begin
if (b[l] <> 1) then {Fatal: Internal error 200409241}
halt(1);
end;
begin
{ ensure the top bits are also checked and not truncated }
l:=int64(1) shl 32 + 1;
intern;
end;
const
a: array[1..3] of longint = (1,2,3);
begin
bug(a);
end.