瀏覽代碼

* don't try to bitpack types > 32 bit on 32 bit cpus (mantis #16328)

git-svn-id: trunk@15162 -
Jonas Maebe 15 年之前
父節點
當前提交
2eddd5e704
共有 4 個文件被更改,包括 74 次插入2 次删除
  1. 1 0
      .gitattributes
  2. 10 2
      compiler/ncgmem.pas
  3. 4 0
      compiler/symdef.pas
  4. 59 0
      tests/webtbs/tw16328.pp

+ 1 - 0
.gitattributes

@@ -10352,6 +10352,7 @@ tests/webtbs/tw1622.pp svneol=native#text/plain
 tests/webtbs/tw16222.pp svneol=native#text/pascal
 tests/webtbs/tw1623.pp svneol=native#text/plain
 tests/webtbs/tw16311.pp svneol=native#text/plain
+tests/webtbs/tw16328.pp svneol=native#text/plain
 tests/webtbs/tw1634.pp svneol=native#text/plain
 tests/webtbs/tw1658.pp svneol=native#text/plain
 tests/webtbs/tw1677.pp svneol=native#text/plain

+ 10 - 2
compiler/ncgmem.pas

@@ -584,7 +584,11 @@ implementation
          { everything can be handled using the the regular array code.        }
          if ((l mod 8) = 0) and
             (ispowerof2(l div 8,temp) or
-             not is_ordinal(resultdef)) then
+             not is_ordinal(resultdef)
+{$ifndef cpu64bitalu}
+             or is_64bitint(resultdef)
+{$endif not cpu64bitalu}
+             ) then
            begin
              update_reference_reg_mul(maybe_const_reg,l div 8);
              exit;
@@ -818,7 +822,11 @@ implementation
              ((mulsize mod 8 = 0) and
               ispowerof2(mulsize div 8,temp)) or
               { only orddefs are bitpacked }
-              not is_ordinal(resultdef)) then
+              not is_ordinal(resultdef)
+{$ifndef cpu64bitalu}
+              or is_64bitint(resultdef)
+{$endif not cpu64bitalu}
+              ) then
            dec(location.reference.offset,bytemulsize*tarraydef(left.resultdef).lowrange);
 
          if right.nodetype=ordconstn then

+ 4 - 0
compiler/symdef.pas

@@ -1661,10 +1661,14 @@ implementation
         if ordtype = uvoid then
           exit;
 
+{$ifndef cpu64bitalu}
+        if (ordtype in [s64bit,u64bit]) then
+{$else not cpu64bitalu}
         if (ordtype = u64bit) or
            ((ordtype = s64bit) and
             ((low <= (system.low(int64) div 2)) or
              (high > (system.high(int64) div 2)))) then
+{$endif cpu64bitalu}
           result := 64
         else if (low >= 0) and
            (high <= 1) then

+ 59 - 0
tests/webtbs/tw16328.pp

@@ -0,0 +1,59 @@
+program test;
+
+{$mode objfpc}
+{$r+,q+}
+{$inline on}
+
+const
+  DBIDMASK = $FFFFFFFFFFFF;
+
+type
+  TmydbID = type Longword;
+  TmydbCLSID = type Word;
+  TmydbDBID   = 0..(1 shl 48)-1;  // Unique ID of the database
+  TmydbDBTYPE = type Byte;
+
+  tarr = bitpacked array[0..10] of TmydbDBID;
+
+  TmydbUID = bitpacked record
+    DBID  : TmydbDBID;            // Database Identifier
+    PROID : TmydbID;              // Profile Identifier
+    OID   : TmydbID;              // Object Identifier
+    CLSID : TmydbCLSID;           // Object Class
+  end;
+
+function mydbMakeUID(const DBID: TmydbDBID; const PROID: TmydbID; const CLSID: TmydbCLSID; const OID: TmydbID): TmydbUID; inline;
+begin
+  Result.CLSID := CLSID;
+  Result.DBID := DBID and DBIDMASK;
+  Result.PROID := PROID;
+  Result.OID := OID;
+end;
+
+var
+  uid: TmydbUID;
+  arr: tarr;
+  i: longint;
+begin
+  uid:=mydbMakeUID($987654321654,$12345678,$5432,$18273645);
+  if (uid.CLSID<>$5432) then
+    halt(1);
+  if (uid.DBID<>($987654321654 and DBIDMASK)) then
+    halt(2);
+  if (uid.PROID<>$12345678) then
+    halt(3);
+  if (uid.OID<>$18273645) then
+    halt(4);
+  i:=2;
+  arr[2]:=$987654321654;
+  if (arr[i]<>$987654321654) or
+     (arr[1]<>0) or
+     (arr[3]<>0) then
+    halt(5);
+  arr[2]:=0;
+  arr[i]:=$987654321654;
+  if (arr[i]<>$987654321654) or
+     (arr[1]<>0) or
+     (arr[3]<>0) then
+    halt(6);
+end.