+ use rtl helpers for 64-bit shl/shr/sar/rol/ror modify in place operations, on

  platforms that don't have native 64-bit implementation of the corresponding
  64-bit shift/rotate operation

git-svn-id: trunk@35787 -

compiler/ninl.pas

@@ -91,6 +91,9 @@ interface
           function first_seg: tnode; virtual;
           function first_sar: tnode; virtual;
           function first_fma : tnode; virtual;
+{$ifndef cpu64bitalu}
+          function first_ShiftRot_assign_64bitint: tnode; virtual;
+{$endif not cpu64bitalu}
           function first_AndOrXorShiftRot_assign: tnode; virtual;
           function first_NegNot_assign: tnode; virtual;
         private
@@ -4668,10 +4671,52 @@ implementation
        end;
 
 
+{$ifndef cpu64bitalu}
+     function tinlinenode.first_ShiftRot_assign_64bitint: tnode;
+       var
+         procname: string[31];
+       begin
+         result := nil;
+         if is_signed(tcallparanode(left).right.resultdef) then
+           procname:='int64'
+         else
+           procname:='qword';
+         case inlinenumber of
+           in_sar_assign_x_y:
+             procname := 'fpc_sar_assign_'+procname;
+           in_shl_assign_x_y:
+             procname := 'fpc_shl_assign_'+procname;
+           in_shr_assign_x_y:
+             procname := 'fpc_shr_assign_'+procname;
+           in_rol_assign_x_y:
+             procname := 'fpc_rol_assign_'+procname;
+           in_ror_assign_x_y:
+             procname := 'fpc_ror_assign_'+procname;
+           else
+             internalerror(2017041301);
+         end;
+         result := ccallnode.createintern(procname,ccallparanode.create(tcallparanode(left).left,
+           ccallparanode.create(tcallparanode(tcallparanode(left).right).left,nil)));
+         tcallparanode(tcallparanode(left).right).left := nil;
+         tcallparanode(left).left := nil;
+         firstpass(result);
+       end;
+{$endif not cpu64bitalu}
+
+
      function tinlinenode.first_AndOrXorShiftRot_assign: tnode;
        begin
-         result:=nil;
-         expectloc:=tcallparanode(tcallparanode(left).right).left.expectloc;
+{$ifndef cpu64bitalu}
+         { 64 bit ints have their own shift handling }
+         if is_64bit(tcallparanode(left).right.resultdef) and
+            (inlinenumber in [in_sar_assign_x_y,in_shl_assign_x_y,in_shr_assign_x_y,in_rol_assign_x_y,in_ror_assign_x_y]) then
+           result := first_ShiftRot_assign_64bitint
+         else
+{$endif not cpu64bitalu}
+           begin
+             result:=nil;
+             expectloc:=tcallparanode(tcallparanode(left).right).left.expectloc;
+           end;
        end;
 
 

rtl/inc/compproc.inc

@@ -619,7 +619,21 @@ function fpc_shl_qword(value : qword; shift : sizeint) : qword; compilerproc;
 function fpc_shr_qword(value : qword; shift : sizeint) : qword; compilerproc;
 function fpc_shl_int64(value : int64; shift : sizeint) : int64; compilerproc;
 function fpc_shr_int64(value : int64; shift : sizeint) : int64; compilerproc;
+procedure fpc_shl_assign_qword(var value : qword; shift : sizeint); compilerproc;
+procedure fpc_shr_assign_qword(var value : qword; shift : sizeint); compilerproc;
+procedure fpc_shl_assign_int64(var value : int64; shift : sizeint); compilerproc;
+procedure fpc_shr_assign_int64(var value : int64; shift : sizeint); compilerproc;
 {$endif  FPC_INCLUDE_SOFTWARE_SHIFT_INT64}
+{$ifndef FPC_HAS_INTERNAL_SAR_ASSIGN_QWORD}
+procedure fpc_sar_assign_int64(var AValue : Int64;const Shift : Byte);compilerproc;
+procedure fpc_sar_assign_qword(var AValue : qword;const Shift : Byte);compilerproc;
+{$endif FPC_HAS_INTERNAL_SAR_ASSIGN_QWORD}
+{$ifndef FPC_HAS_INTERNAL_ROX_ASSIGN_QWORD}
+procedure fpc_ror_assign_int64(var AValue : int64;const Dist : Byte);compilerproc;
+procedure fpc_ror_assign_qword(var AValue : QWord;const Dist : Byte);compilerproc;
+procedure fpc_rol_assign_int64(var AValue : int64;const Dist : Byte);compilerproc;
+procedure fpc_rol_assign_qword(var AValue : QWord;const Dist : Byte);compilerproc;
+{$endif FPC_HAS_INTERNAL_ROX_ASSIGN_QWORD}
 
 
 function fpc_popcnt_byte(AValue : Byte): Byte;compilerproc;

rtl/inc/generic.inc

@@ -2704,6 +2704,33 @@ function RolQWord(Const AValue : QWord;const Dist : Byte): QWord;{$ifdef SYSTEMI
 {$endif FPC_SYSTEM_HAS_ROX_QWORD}
 {$endif FPC_HAS_INTERNAL_ROX_QWORD}
 
+{$ifndef FPC_HAS_INTERNAL_ROX_ASSIGN_QWORD}
+{$ifndef FPC_SYSTEM_HAS_ROX_ASSIGN_QWORD}
+procedure fpc_ror_assign_int64(var AValue : int64;const Dist : Byte); [Public,Alias:'FPC_ROR_ASSIGN_INT64']; compilerproc;
+  begin
+    AValue:=(AValue shr (Dist and 63)) or (AValue shl (64-(Dist and 63)));
+  end;
+
+
+procedure fpc_ror_assign_qword(var AValue : QWord;const Dist : Byte); [Public,Alias:'FPC_ROR_ASSIGN_QWORD']; compilerproc;
+  begin
+    AValue:=(AValue shr (Dist and 63)) or (AValue shl (64-(Dist and 63)));
+  end;
+
+
+procedure fpc_rol_assign_int64(var AValue : int64;const Dist : Byte); [Public,Alias:'FPC_ROL_ASSIGN_INT64']; compilerproc;
+  begin
+    AValue:=(AValue shl (Dist and 63)) or (AValue shr (64-(Dist and 63)));
+  end;
+
+
+procedure fpc_rol_assign_qword(var AValue : QWord;const Dist : Byte); [Public,Alias:'FPC_ROL_ASSIGN_QWORD']; compilerproc;
+  begin
+    AValue:=(AValue shl (Dist and 63)) or (AValue shr (64-(Dist and 63)));
+  end;
+{$endif FPC_SYSTEM_HAS_ROX_ASSIGN_QWORD}
+{$endif FPC_HAS_INTERNAL_ROX_ASSIGN_QWORD}
+
 {$ifndef FPC_HAS_INTERNAL_SAR_BYTE}
 {$ifndef FPC_SYSTEM_HAS_SAR_BYTE}
 function SarShortint(Const AValue : Shortint;const Shift : Byte): Shortint;
@@ -2740,6 +2767,19 @@ function fpc_SarInt64(Const AValue : Int64;const Shift : Byte): Int64; [Public,A
 {$endif FPC_HAS_INTERNAL_SAR_QWORD}
 {$endif FPC_SYSTEM_HAS_SAR_QWORD}
 
+{$ifndef FPC_HAS_INTERNAL_SAR_ASSIGN_QWORD}
+{$ifndef FPC_SYSTEM_HAS_SAR_ASSIGN_QWORD}
+procedure fpc_sar_assign_int64(var AValue : Int64;const Shift : Byte); [Public,Alias:'FPC_SAR_ASSIGN_INT64']; compilerproc;
+  begin
+    AValue:=int64(qword(qword(qword(AValue) shr (Shift and 63)) or (qword(int64(qword(0-qword(qword(AValue) shr 63)) and qword(int64(0-(ord((Shift and 63)<>0){ and 1}))))) shl (64-(Shift and 63)))));
+  end;
+procedure fpc_sar_assign_qword(var AValue : QWord;const Shift : Byte); [Public,Alias:'FPC_SAR_ASSIGN_QWORD']; compilerproc;
+  begin
+    AValue:=qword(qword(qword(qword(AValue) shr (Shift and 63)) or (qword(int64(qword(0-qword(qword(AValue) shr 63)) and qword(int64(0-(ord((Shift and 63)<>0){ and 1}))))) shl (64-(Shift and 63)))));
+  end;
+{$endif FPC_HAS_INTERNAL_SAR_ASSIGN_QWORD}
+{$endif FPC_SYSTEM_HAS_SAR_ASSIGN_QWORD}
+
 {$ifndef FPC_HAS_INTERNAL_BSF_BYTE}
 {$ifndef FPC_SYSTEM_HAS_BSF_BYTE}
 function BsfByte(Const AValue: Byte): Byte;

rtl/inc/int64.inc

@@ -53,6 +53,27 @@
 {$endif FPC_SYSTEM_HAS_SHL_QWORD}
 
 
+{$ifndef FPC_SYSTEM_HAS_SHL_ASSIGN_QWORD}
+    procedure fpc_shl_assign_qword(var value : qword;shift : sizeint); [public,alias: 'FPC_SHL_ASSIGN_QWORD']; compilerproc;
+      begin
+        shift:=shift and 63;
+        if shift<>0 then
+          begin
+            if shift>31 then
+              begin
+                tqwordrec(value).high:=tqwordrec(value).low shl (shift-32);
+                tqwordrec(value).low:=0;
+              end
+            else
+              begin
+                tqwordrec(value).high:=(tqwordrec(value).high shl shift) or (tqwordrec(value).low shr (32-shift));
+                tqwordrec(value).low:=tqwordrec(value).low shl shift;
+              end;
+          end;
+      end;
+{$endif FPC_SYSTEM_HAS_SHL_ASSIGN_QWORD}
+
+
 {$ifndef FPC_SYSTEM_HAS_SHR_QWORD}
    function fpc_shr_qword(value : qword;shift : sizeint) : qword; [public,alias: 'FPC_SHR_QWORD']; compilerproc;
       begin
@@ -73,6 +94,27 @@
 {$endif FPC_SYSTEM_HAS_SHR_QWORD}
 
 
+{$ifndef FPC_SYSTEM_HAS_SHR_ASSIGN_QWORD}
+   procedure fpc_shr_assign_qword(var value : qword;shift : sizeint); [public,alias: 'FPC_SHR_ASSIGN_QWORD']; compilerproc;
+      begin
+        shift:=shift and 63;
+        if shift<>0 then
+          begin
+            if shift>31 then
+              begin
+                tqwordrec(value).low:=tqwordrec(value).high shr (shift-32);
+                tqwordrec(value).high:=0;
+              end
+            else
+              begin
+                tqwordrec(value).low:=(tqwordrec(value).low shr shift) or (tqwordrec(value).high shl (32-shift));
+                tqwordrec(value).high:=tqwordrec(value).high shr shift;
+              end;
+          end;
+      end;
+{$endif FPC_SYSTEM_HAS_SHR_ASSIGN_QWORD}
+
+
 {$ifndef FPC_SYSTEM_HAS_SHL_INT64}
     function fpc_shl_int64(value : int64;shift : sizeint) : int64; [public,alias: 'FPC_SHL_INT64']; compilerproc;
       begin
@@ -93,6 +135,27 @@
 {$endif FPC_SYSTEM_HAS_SHL_INT64}
 
 
+{$ifndef FPC_SYSTEM_HAS_SHL_ASSIGN_INT64}
+    procedure fpc_shl_assign_int64(var value : int64;shift : sizeint); [public,alias: 'FPC_SHL_ASSIGN_INT64']; compilerproc;
+      begin
+        shift:=shift and 63;
+        if shift<>0 then
+          begin
+            if shift>31 then
+              begin
+                tqwordrec(value).high:=tqwordrec(value).low shl (shift-32);
+                tqwordrec(value).low:=0;
+              end
+            else
+              begin
+                tqwordrec(value).high:=(tqwordrec(value).high shl shift) or (tqwordrec(value).low shr (32-shift));
+                tqwordrec(value).low:=tqwordrec(value).low shl shift;
+              end;
+          end;
+      end;
+{$endif FPC_SYSTEM_HAS_SHL_ASSIGN_INT64}
+
+
 {$ifndef FPC_SYSTEM_HAS_SHR_INT64}
     function fpc_shr_int64(value : int64;shift : sizeint) : int64; [public,alias: 'FPC_SHR_INT64']; compilerproc;
       begin
@@ -113,6 +176,27 @@
 {$endif FPC_SYSTEM_HAS_SHR_INT64}
 
 
+{$ifndef FPC_SYSTEM_HAS_SHR_ASSIGN_INT64}
+    procedure fpc_shr_assign_int64(var value : int64;shift : sizeint); [public,alias: 'FPC_SHR_ASSIGN_INT64']; compilerproc;
+      begin
+        shift:=shift and 63;
+        if shift<>0 then
+          begin
+            if shift>31 then
+              begin
+                tqwordrec(value).low:=tqwordrec(value).high shr (shift-32);
+                tqwordrec(value).high:=0;
+              end
+            else
+              begin
+                tqwordrec(value).low:=(tqwordrec(value).low shr shift) or (tqwordrec(value).high shl (32-shift));
+                tqwordrec(value).high:=tqwordrec(value).high shr shift;
+              end;
+          end;
+      end;
+{$endif FPC_SYSTEM_HAS_SHR_ASSIGN_INT64}
+
+
 {$endif FPC_INCLUDE_SOFTWARE_SHIFT_INT64}
 
 

rtl/inc/systemh.inc

@@ -915,6 +915,7 @@ function NtoLE(const AValue: QWord): QWord;{$ifdef SYSTEMINLINE}inline;{$endif}
 
 {$if defined(cpux86_64) or defined(powerpc64) or defined(cpuaarch64)}
 {$define FPC_HAS_INTERNAL_ROX_QWORD}
+{$define FPC_HAS_INTERNAL_ROX_ASSIGN_QWORD}
 {$endif defined(cpux86_64) or defined(powerpc64) or defined(cpuaarch64)}
 
 {$endif FPC_HAS_INTERNAL_ROX}
@@ -992,6 +993,7 @@ function RolQWord(Const AValue : QWord;const Dist : Byte): QWord;{$ifdef SYSTEMI
 
 {$if defined(cpux86_64) or defined(powerpc64) or defined(cpuaarch64)}
 {$define FPC_HAS_INTERNAL_SAR_QWORD}
+{$define FPC_HAS_INTERNAL_SAR_ASSIGN_QWORD}
 {$endif defined(cpux86_64) or defined(powerpc64) or defined(cpuaarch64)}
 
 {$endif FPC_HAS_INTERNAL_SAR}