paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-12 23:09:40 +02:00
Code Issues Packages Projects Releases Wiki Activity

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

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

git-svn-id: trunk@35787 -
This commit is contained in:
nickysn 2017-04-13 15:24:32 +00:00
parent a1ad705646
commit b14f277e8f
5 changed files with 187 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

49
compiler/ninl.pas
View File

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

14
rtl/inc/compproc.inc
View File

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

40
rtl/inc/generic.inc
View File

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

84
rtl/inc/int64.inc
View File

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

2
rtl/inc/systemh.inc
View File

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