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

* fixed initialising 32 resp. 64 bit regvars with -g-t if the compiler is

Browse Source 
an i386 resp. x86-64 binary (mantis #16668)

git-svn-id: trunk@15398 -
This commit is contained in:
Jonas Maebe 2010-06-09 15:58:39 +00:00
parent 909ffa4ee3
commit 7c372ede44
3 changed files with 36 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitattributes vendored
View File

@ -10497,6 +10497,7 @@ tests/webtbs/tw16366.pp svneol=native#text/plain
tests/webtbs/tw16377.pp svneol=native#text/plain
tests/webtbs/tw16402.pp svneol=native#text/plain
tests/webtbs/tw1658.pp svneol=native#text/plain
tests/webtbs/tw16668.pp svneol=native#text/plain
tests/webtbs/tw1677.pp svneol=native#text/plain
tests/webtbs/tw1681.pp svneol=native#text/plain
tests/webtbs/tw1696.pp svneol=native#text/plain

21
compiler/ncgutil.pas
View File

@ -1357,9 +1357,24 @@ implementation
{$define overflowon}
{$q-}
{$endif}
cg.a_load_const_reg(list,reg_cgsize(tabstractnormalvarsym(p).initialloc.register),
trashintval and (aword(1) shl (tcgsize2size[reg_cgsize(tabstractnormalvarsym(p).initialloc.register)] * 8) - 1),
tabstractnormalvarsym(p).initialloc.register);
begin
{ avoid problems with broken x86 shifts }
case tcgsize2size[tabstractnormalvarsym(p).initialloc.size] of
1: cg.a_load_const_reg(list,OS_8,byte(trashintval),tabstractnormalvarsym(p).initialloc.register);
2: cg.a_load_const_reg(list,OS_16,word(trashintval),tabstractnormalvarsym(p).initialloc.register);
4: cg.a_load_const_reg(list,OS_32,longint(trashintval),tabstractnormalvarsym(p).initialloc.register);
8:
begin
{$ifdef cpu64bitalu}
cg.a_load_const_reg(list,OS_64,aint(trashintval),tabstractnormalvarsym(p).initialloc.register);
{$else}
cg64.a_load64_const_reg(list,int64(trashintval) shl 32 or int64(trashintval),tabstractnormalvarsym(p).initialloc.register64);
{$endif}
end;
else
internalerror(2010060801);
end;
end;
{$ifdef overflowon}
{$undef overflowon}
{$q+}

17
tests/webtbs/tw16668.pp Normal file
View File

@ -0,0 +1,17 @@
{ %opt=-g-t }
program Project1;
{$mode objfpc}{$H+}
procedure Foo;
var
a: TObject;
begin
if ptruint(a)<>$55555555 then
halt(1);
end;
begin
Foo;
end.