浏览代码

* fixed initialising 32 resp. 64 bit regvars with -g-t if the compiler is
an i386 resp. x86-64 binary (mantis #16668)

git-svn-id: trunk@15398 -

Jonas Maebe 15 年之前
父节点
当前提交
7c372ede44
共有 3 个文件被更改,包括 36 次插入3 次删除
  1. 1 0
      .gitattributes
  2. 18 3
      compiler/ncgutil.pas
  3. 17 0
      tests/webtbs/tw16668.pp

+ 1 - 0
.gitattributes

@@ -10497,6 +10497,7 @@ tests/webtbs/tw16366.pp svneol=native#text/plain
 tests/webtbs/tw16377.pp svneol=native#text/plain
 tests/webtbs/tw16377.pp svneol=native#text/plain
 tests/webtbs/tw16402.pp svneol=native#text/plain
 tests/webtbs/tw16402.pp svneol=native#text/plain
 tests/webtbs/tw1658.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/tw1677.pp svneol=native#text/plain
 tests/webtbs/tw1681.pp svneol=native#text/plain
 tests/webtbs/tw1681.pp svneol=native#text/plain
 tests/webtbs/tw1696.pp svneol=native#text/plain
 tests/webtbs/tw1696.pp svneol=native#text/plain

+ 18 - 3
compiler/ncgutil.pas

@@ -1357,9 +1357,24 @@ implementation
 {$define overflowon}
 {$define overflowon}
 {$q-}
 {$q-}
 {$endif}
 {$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}
 {$ifdef overflowon}
 {$undef overflowon}
 {$undef overflowon}
 {$q+}
 {$q+}

+ 17 - 0
tests/webtbs/tw16668.pp

@@ -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.