فهرست منبع

Fix bitpacking 62/63 bit fields on 64 bit targets

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
Jonas Maebe 3 سال پیش
والد
کامیت
3fb0fab410
3فایلهای تغییر یافته به همراه54 افزوده شده و 21 حذف شده
  1. 12 19
      compiler/cutils.pas
  2. 4 2
      compiler/symdef.pas
  3. 38 0
      tests/test/tprec25.pp

+ 12 - 19
compiler/cutils.pas

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

+ 4 - 2
compiler/symdef.pas

@@ -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 - 0
tests/test/tprec25.pp

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