paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-15 10:40:13 +02:00
Code Issues Packages Projects Releases Wiki Activity

* cardinal-cardinal is calculated using int64

Browse Source 
* 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:
peter 2007-02-21 11:52:06 +00:00
parent 41bf70cf2a
commit 9a37c04131
5 changed files with 51 additions and 19 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitattributes vendored
View File

@ -8057,6 +8057,7 @@ tests/webtbs/tw8258a.pp svneol=native#text/plain
tests/webtbs/tw8264.pp svneol=native#text/plain
tests/webtbs/tw8304.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/ub1883.pp svneol=native#text/plain
tests/webtbs/uw0555.pp svneol=native#text/plain

23
compiler/defcmp.pas
View File

@ -892,22 +892,19 @@ implementation
eq:=te_convert_l2;
end;
end;
{ delphi compatible, allow explicit typecasts from
ordinals to pointer.
{ allow explicit typecasts from 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) }
if (eq=te_incompatible) and
not is_void(def_from) and
(
(
(m_delphi in current_settings.modeswitches) and
(cdo_explicit in cdoptions)
) or
(cdo_internal in cdoptions)
) then
begin
doconv:=tc_int_2_int;
eq:=te_convert_l1;
end;
(cdo_explicit in cdoptions) or
(cdo_internal in cdoptions) then
begin
doconv:=tc_int_2_int;
eq:=te_convert_l1;
end;
end;
arraydef :
begin

11
compiler/nadd.pas
View File

@ -990,13 +990,16 @@ implementation
is_constintnode(right) and
(tordconstnode(right).value >= 0) then
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
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
is_signed(right.resultdef) then
is_signed(right.resultdef) or
(nodetype=subn) then
begin
CGMessage(type_w_mixed_signed_unsigned);
if nodetype<>subn then
CGMessage(type_w_mixed_signed_unsigned);
inserttypeconv(left,s64inttype);
inserttypeconv(right,s64inttype);
end

5
tests/tbs/tb0162.pp
View File

@ -75,13 +75,14 @@ begin
doerror(8);
end;
// The calculation will be done in int64 and
// give a rangecheck instead of a overflow
c := 0;
try
c := c-1;
doerror(9);
except
on eintoverflow do
on erangecheck do
;
else
doerror(10);

30
tests/webtbs/tw8321.pp Normal file
View 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.