paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-10-16 23:46:25 +02:00
Code Issues Packages Projects Releases Wiki Activity

* support inc(pointer) in TP mode with range/overflow checking on as well

Browse Source 
git-svn-id: trunk@5605 -
This commit is contained in:
Jonas Maebe 2006-12-15 13:02:00 +00:00
parent 87e7e435bf
commit 991c7da136
4 changed files with 54 additions and 20 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitattributes vendored
View File

@ -7779,6 +7779,7 @@ tests/webtbs/tw7679.pp svneol=native#text/plain
tests/webtbs/tw7756.pp svneol=native#text/plain
tests/webtbs/tw7817a.pp svneol=native#text/plain
tests/webtbs/tw7817b.pp svneol=native#text/plain
tests/webtbs/tw7847.pp svneol=native#text/plain
tests/webtbs/tw7963.pp svneol=native#text/plain
tests/webtbs/ub1873.pp svneol=native#text/plain
tests/webtbs/ub1883.pp svneol=native#text/plain

25
compiler/ncginl.pas
View File

@ -464,16 +464,21 @@ implementation
cg.a_op_reg_loc(current_asmdata.CurrAsmList,addsubop[inlinenumber],
hregister,tcallparanode(left).left.location);
end;
{ things which can overflow must NOT pass via here, but have to be }
{ handled via a regular add node (conversion in tinlinenode.pass_1) }
{ Or someone has to rewrite the above to use a_op_const_reg_reg_ov }
{ and friends in case of overflow checking, and ask everyone to }
{ implement these methods since they don't exist for all cpus (JM) }
if (cs_check_overflow in current_settings.localswitches) then
internalerror(2006111010);
// cg.g_overflowcheck(current_asmdata.CurrAsmList,tcallparanode(left).left.location,tcallparanode(left).resultdef);
cg.g_rangecheck(current_asmdata.CurrAsmList,tcallparanode(left).left.location,tcallparanode(left).left.resultdef,
tcallparanode(left).left.resultdef);
{ no overflow checking for pointers (see ninl), and range checking }
{ is not applicable for them }
if (tcallparanode(left).left.resultdef.typ <> pointerdef) then
begin
{ things which can overflow must NOT pass via here, but have to be }
{ handled via a regular add node (conversion in tinlinenode.pass_1) }
{ Or someone has to rewrite the above to use a_op_const_reg_reg_ov }
{ and friends in case of overflow checking, and ask everyone to }
{ implement these methods since they don't exist for all cpus (JM) }
if (cs_check_overflow in current_settings.localswitches) then
internalerror(2006111010);
// cg.g_overflowcheck(current_asmdata.CurrAsmList,tcallparanode(left).left.location,tcallparanode(left).resultdef);
cg.g_rangecheck(current_asmdata.CurrAsmList,tcallparanode(left).left.location,tcallparanode(left).left.resultdef,
tcallparanode(left).left.resultdef);
end;
end;

17
compiler/ninl.pas
View File

@ -2310,7 +2310,11 @@ implementation
{ range/overflow checking doesn't work properly }
{ with the inc/dec code that's generated (JM) }
if (current_settings.localswitches * [cs_check_overflow,cs_check_range] <> []) then
if (current_settings.localswitches * [cs_check_overflow,cs_check_range] <> []) and
{ No overflow check for pointer operations, because inc(pointer,-1) will always
trigger an overflow. For uint32 it works because then the operation is done
in 64bit. Range checking is not applicable to pointers either }
(tcallparanode(left).left.resultdef.typ<>pointerdef) then
{ convert to simple add (JM) }
begin
newblock := internalstatements(newstatement);
@ -2337,11 +2341,6 @@ implementation
(torddef(hpp.resultdef).ordtype<>u64bit)) then
{$endif not cpu64bit}
inserttypeconv_internal(hpp,sinttype);
{ No overflow check for pointer operations, because inc(pointer,-1) will always
trigger an overflow. For uint32 it works because then the operation is done
in 64bit }
if (tcallparanode(left).left.resultdef.typ=pointerdef) then
exclude(current_settings.localswitches,cs_check_overflow);
{ make sure we don't call functions part of the left node twice (and generally }
{ optimize the code generation) }
if node_complexity(tcallparanode(left).left) > 1 then
@ -2361,8 +2360,7 @@ implementation
resultnode := hp.getcopy;
{ avoid type errors from the addn/subn }
if not is_integer(resultnode.resultdef) and
(resultnode.resultdef.typ <> pointerdef) then
if not is_integer(resultnode.resultdef) then
begin
inserttypeconv_internal(hp,sinttype);
inserttypeconv_internal(hpp,sinttype);
@ -2374,8 +2372,7 @@ implementation
else
hpp := caddnode.create(subn,hp,hpp);
{ assign result of addition }
if not(is_integer(resultnode.resultdef)) and
(resultnode.resultdef.typ <> pointerdef) then
if not(is_integer(resultnode.resultdef)) then
inserttypeconv(hpp,torddef.create(
{$ifdef cpu64bit}
s64bit,

31
tests/webtbs/tw7847.pp Normal file
View File

@ -0,0 +1,31 @@
{$mode tp}
{$r+}
{$q+}
FUNCTION MemCompare(VAR Rec1, Rec2; Count : WORD) : INTEGER;
TYPE PByte = ^BYTE;
VAR PB1, PB2 : PBYTE;
i : INTEGER;
BEGIN
MemCompare := 0;
PB1 := PByte(@Rec1);
PB2 := PByte(@Rec2);
FOR i := 1 TO Count DO
BEGIN
IF PB1^ <> PB2^ THEN
BEGIN
IF PB1^ > PB2^ THEN
MemCompare := 1
ELSE
MemCompare := -1;
BREAK;
END;
Inc(PB1); { Error is generated at this line }
Inc(PB2);
END;
END;
begin
end.