From 2eddd5e70446166652ad930c4c1598453cf1b6bd Mon Sep 17 00:00:00 2001 From: Jonas Maebe Date: Sat, 24 Apr 2010 12:46:02 +0000 Subject: [PATCH] * don't try to bitpack types > 32 bit on 32 bit cpus (mantis #16328) git-svn-id: trunk@15162 - --- .gitattributes | 1 + compiler/ncgmem.pas | 12 +++++++-- compiler/symdef.pas | 4 +++ tests/webtbs/tw16328.pp | 59 +++++++++++++++++++++++++++++++++++++++++ 4 files changed, 74 insertions(+), 2 deletions(-) create mode 100644 tests/webtbs/tw16328.pp diff --git a/.gitattributes b/.gitattributes index 6e2efdd076..004bf55ae6 100644 --- a/.gitattributes +++ b/.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 diff --git a/compiler/ncgmem.pas b/compiler/ncgmem.pas index ff5d50ce83..41b197ca0b 100644 --- a/compiler/ncgmem.pas +++ b/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 diff --git a/compiler/symdef.pas b/compiler/symdef.pas index 79054aaee7..8314989491 100644 --- a/compiler/symdef.pas +++ b/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 diff --git a/tests/webtbs/tw16328.pp b/tests/webtbs/tw16328.pp new file mode 100644 index 0000000000..1cec8914ef --- /dev/null +++ b/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.