mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-16 13:19:12 +02:00
* cardinal-cardinal is calculated using int64
* support pointer(int64) for all modes, this is needed to support pointer(cardinal+longint) and pointer(cardinal-cardinal) git-svn-id: trunk@6586 -
This commit is contained in:
parent
41bf70cf2a
commit
9a37c04131
1
.gitattributes
vendored
1
.gitattributes
vendored
@ -8057,6 +8057,7 @@ tests/webtbs/tw8258a.pp svneol=native#text/plain
|
|||||||
tests/webtbs/tw8264.pp svneol=native#text/plain
|
tests/webtbs/tw8264.pp svneol=native#text/plain
|
||||||
tests/webtbs/tw8304.pp svneol=native#text/plain
|
tests/webtbs/tw8304.pp svneol=native#text/plain
|
||||||
tests/webtbs/tw8312.pp svneol=native#text/plain
|
tests/webtbs/tw8312.pp svneol=native#text/plain
|
||||||
|
tests/webtbs/tw8321.pp svneol=native#text/plain
|
||||||
tests/webtbs/ub1873.pp svneol=native#text/plain
|
tests/webtbs/ub1873.pp svneol=native#text/plain
|
||||||
tests/webtbs/ub1883.pp svneol=native#text/plain
|
tests/webtbs/ub1883.pp svneol=native#text/plain
|
||||||
tests/webtbs/uw0555.pp svneol=native#text/plain
|
tests/webtbs/uw0555.pp svneol=native#text/plain
|
||||||
|
@ -892,22 +892,19 @@ implementation
|
|||||||
eq:=te_convert_l2;
|
eq:=te_convert_l2;
|
||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
{ delphi compatible, allow explicit typecasts from
|
{ allow explicit typecasts from ordinals to pointer.
|
||||||
ordinals to pointer.
|
Support for delphi compatibility
|
||||||
|
Support constructs like pointer(cardinal-cardinal) or pointer(longint+cardinal) where
|
||||||
|
the result of the ordinal operation is int64 also on 32 bit platforms.
|
||||||
It is also used by the compiler internally for inc(pointer,ordinal) }
|
It is also used by the compiler internally for inc(pointer,ordinal) }
|
||||||
if (eq=te_incompatible) and
|
if (eq=te_incompatible) and
|
||||||
not is_void(def_from) and
|
not is_void(def_from) and
|
||||||
(
|
(cdo_explicit in cdoptions) or
|
||||||
(
|
(cdo_internal in cdoptions) then
|
||||||
(m_delphi in current_settings.modeswitches) and
|
begin
|
||||||
(cdo_explicit in cdoptions)
|
doconv:=tc_int_2_int;
|
||||||
) or
|
eq:=te_convert_l1;
|
||||||
(cdo_internal in cdoptions)
|
end;
|
||||||
) then
|
|
||||||
begin
|
|
||||||
doconv:=tc_int_2_int;
|
|
||||||
eq:=te_convert_l1;
|
|
||||||
end;
|
|
||||||
end;
|
end;
|
||||||
arraydef :
|
arraydef :
|
||||||
begin
|
begin
|
||||||
|
@ -990,13 +990,16 @@ implementation
|
|||||||
is_constintnode(right) and
|
is_constintnode(right) and
|
||||||
(tordconstnode(right).value >= 0) then
|
(tordconstnode(right).value >= 0) then
|
||||||
inserttypeconv(right,u32inttype);
|
inserttypeconv(right,u32inttype);
|
||||||
{ when one of the operand is signed perform
|
{ when one of the operand is signed or the operation is subn then perform
|
||||||
the operation in 64bit, can't use rd/ld here because there
|
the operation in 64bit, can't use rd/ld here because there
|
||||||
could be already typeconvs inserted }
|
could be already typeconvs inserted.
|
||||||
|
This is compatible with the code below for other unsigned types (PFV) }
|
||||||
if is_signed(left.resultdef) or
|
if is_signed(left.resultdef) or
|
||||||
is_signed(right.resultdef) then
|
is_signed(right.resultdef) or
|
||||||
|
(nodetype=subn) then
|
||||||
begin
|
begin
|
||||||
CGMessage(type_w_mixed_signed_unsigned);
|
if nodetype<>subn then
|
||||||
|
CGMessage(type_w_mixed_signed_unsigned);
|
||||||
inserttypeconv(left,s64inttype);
|
inserttypeconv(left,s64inttype);
|
||||||
inserttypeconv(right,s64inttype);
|
inserttypeconv(right,s64inttype);
|
||||||
end
|
end
|
||||||
|
@ -75,13 +75,14 @@ begin
|
|||||||
doerror(8);
|
doerror(8);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
// The calculation will be done in int64 and
|
||||||
|
// give a rangecheck instead of a overflow
|
||||||
c := 0;
|
c := 0;
|
||||||
try
|
try
|
||||||
c := c-1;
|
c := c-1;
|
||||||
doerror(9);
|
doerror(9);
|
||||||
except
|
except
|
||||||
on eintoverflow do
|
on erangecheck do
|
||||||
;
|
;
|
||||||
else
|
else
|
||||||
doerror(10);
|
doerror(10);
|
||||||
|
30
tests/webtbs/tw8321.pp
Normal file
30
tests/webtbs/tw8321.pp
Normal file
@ -0,0 +1,30 @@
|
|||||||
|
var
|
||||||
|
A: byte;
|
||||||
|
w : word;
|
||||||
|
B,B2: cardinal;
|
||||||
|
s : string;
|
||||||
|
p : pointer;
|
||||||
|
err : boolean;
|
||||||
|
begin
|
||||||
|
B := $ffffffed;
|
||||||
|
B2 := $fffffffd;
|
||||||
|
p:=POinter(B-B2);
|
||||||
|
Str(B-B2,s);
|
||||||
|
writeln(s);
|
||||||
|
if s<>'-16' then
|
||||||
|
err:=true;
|
||||||
|
|
||||||
|
W:=65535;
|
||||||
|
A:=20;
|
||||||
|
Str(a * w - 256000000,s);
|
||||||
|
p:=POinter(a * w - 256000000);
|
||||||
|
writeln(s);
|
||||||
|
if s<>'-254689300' then
|
||||||
|
err:=true;
|
||||||
|
|
||||||
|
|
||||||
|
if err then
|
||||||
|
halt(1);
|
||||||
|
|
||||||
|
end.
|
||||||
|
|
Loading…
Reference in New Issue
Block a user