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

Fix bitpacking 62/63 bit fields on 64 bit targets

Browse Source 
As reported on the lazarus forum:
* https://forum.lazarus.freepascal.org/index.php?topic=56341.new
* https://forum.lazarus.freepascal.org/index.php/topic,56339.msg418608/topicseen.html

Also optimized nextpowerof2 in the compiler
This commit is contained in:
Jonas Maebe 2021-10-03 13:59:33 +02:00
parent 41db71c21c
commit 3fb0fab410
3 changed files with 54 additions and 21 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

31
compiler/cutils.pas
View File

@ -115,8 +115,9 @@ interface
{# Returns true if abs(value) is a power of 2, the actual
exponent value is returned in power.
}
function isabspowerof2(const value : Tconstexprint;out power : longint) : boolean;
function nextpowerof2(value : int64; out power: longint) : int64;
function isabspowerof2(const value : Tconstexprint; out power : longint) : boolean;
{ # Returns the power of 2 >= value }
function nextpowerof2(value : qword; out power: longint) : qword;
function backspace_quote(const s:string;const qchars:Tcharset):string;
function octal_quote(const s:string;const qchars:Tcharset):string;
@ -985,26 +986,18 @@ implementation
end;
function nextpowerof2(value : int64; out power: longint) : int64;
{
returns the power of 2 >= value
}
var
i : longint;
function nextpowerof2(value : qword; out power: longint) : qword;
begin
result := 0;
power := -1;
if ((value <= 0) or
(value >= $4000000000000000)) then
power:=-1;
result:=0;
if (value=0) or (value>qword($8000000000000000)) then
exit;
result := 1;
for i:=0 to 63 do
power:=BsrQWord(value);
result:=qword(1) shl power;
if (value and (value-1))<>0 then
begin
if result>=value then
begin
power := i;
exit;
end;
inc(power);
result:=result shl 1;
end;
end;

6
compiler/symdef.pas
View File

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

38
tests/test/tprec25.pp Normal file
View File

@ -0,0 +1,38 @@
type
{ bit types for bitfields }
_62bits = 0 .. $3FFFFFFFFFFFFFFF;
_63bits = 0 .. $7FFFFFFFFFFFFFFF;
_64bits1 = 0 .. qword($8000000000000000);
_64bits2 = -1 .. $7FFFFFFFFFFFFFFF;
_64bits3 = -1 .. $7F00000000000000;
var
v2: bitpacked record
f1: _62bits;
f2: _63bits;
f3: _64bits1;
f4: _64bits2;
f5: _64bits3;
end;
begin
writeln('bitsizeof(_62bits): ',bitsizeof(v2.f1));
writeln('bitsizeof(_63bits): ',bitsizeof(v2.f2));
writeln('bitsizeof(_64bits1): ',bitsizeof(v2.f3));
writeln('bitsizeof(_64bits2): ',bitsizeof(v2.f4));
writeln('bitsizeof(_64bits3): ',bitsizeof(v2.f5));
{$ifdef cpu64}
if bitsizeof(v2.f1)<>62 then
halt(1);
if bitsizeof(v2.f2)<>63 then
halt(1);
{$endif}
if bitsizeof(v2.f3)<>64 then
halt(3);
if bitsizeof(v2.f3)<>64 then
halt(4);
if bitsizeof(v2.f3)<>64 then
halt(5);
end.