From b14f277e8fa5b76fe7c2fc73c790d5cc99a9ab19 Mon Sep 17 00:00:00 2001 From: nickysn Date: Thu, 13 Apr 2017 15:24:32 +0000 Subject: [PATCH] + 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 | 49 ++++++++++++++++++++++++-- rtl/inc/compproc.inc | 14 ++++++++ rtl/inc/generic.inc | 40 +++++++++++++++++++++ rtl/inc/int64.inc | 84 ++++++++++++++++++++++++++++++++++++++++++++ rtl/inc/systemh.inc | 2 ++ 5 files changed, 187 insertions(+), 2 deletions(-) diff --git a/compiler/ninl.pas b/compiler/ninl.pas index fa92d7fb26..27c33dc86e 100644 --- a/compiler/ninl.pas +++ b/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; diff --git a/rtl/inc/compproc.inc b/rtl/inc/compproc.inc index 8178eeccbc..152bc96630 100644 --- a/rtl/inc/compproc.inc +++ b/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; diff --git a/rtl/inc/generic.inc b/rtl/inc/generic.inc index 05747a6a6e..59fe40e625 100644 --- a/rtl/inc/generic.inc +++ b/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; diff --git a/rtl/inc/int64.inc b/rtl/inc/int64.inc index 066d43ab5f..d40b4e32b6 100644 --- a/rtl/inc/int64.inc +++ b/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} diff --git a/rtl/inc/systemh.inc b/rtl/inc/systemh.inc index b9eaf827a3..aac15d6862 100644 --- a/rtl/inc/systemh.inc +++ b/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}