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

* use SarInt64 to optimize 64 bit divs on 32 bit platforms, resolves #20998

Browse Source 
git-svn-id: trunk@19968 -
This commit is contained in:
florian 2012-01-04 22:58:25 +00:00
parent fd07f51f35
commit 4765728fc4
5 changed files with 63 additions and 25 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitattributes vendored
View File

@ -12066,6 +12066,7 @@ tests/webtbs/tw20889.pp svneol=native#text/pascal
tests/webtbs/tw20962.pp svneol=native#text/plain
tests/webtbs/tw20995a.pp svneol=native#text/pascal
tests/webtbs/tw20995b.pp svneol=native#text/pascal
tests/webtbs/tw20998.pp svneol=native#text/pascal
tests/webtbs/tw2109.pp svneol=native#text/plain
tests/webtbs/tw2110.pp svneol=native#text/plain
tests/webtbs/tw2128.pp svneol=native#text/plain

64
compiler/nmat.pas
View File

@ -102,7 +102,7 @@ implementation
defutil,
htypechk,pass_1,
cgbase,
ncon,ncnv,ncal,nadd,nld,nbas,nflw,
ncon,ncnv,ncal,nadd,nld,nbas,nflw,ninl,
nutils;
{****************************************************************************
@ -419,47 +419,63 @@ implementation
function tmoddivnode.firstoptimize: tnode;
var
power{,shiftval} : longint;
power,shiftval : longint;
newtype: tnodetype;
statements : tstatementnode;
temp : ttempcreatenode;
begin
result := nil;
{ divide/mod a number by a constant which is a power of 2? }
if (cs_opt_peephole in current_settings.optimizerswitches) and
(right.nodetype = ordconstn) and
{ ((nodetype = divn) or
not is_signed(resultdef)) and}
(not is_signed(resultdef)) and
if (right.nodetype = ordconstn) and
{$ifdef cpu64bitalu}
{ for 64 bit, we leave the optimization to the cg }
(not is_signed(resultdef)) and
{$else cpu64bitalu}
((nodetype=divn) and (is_64bit(resultdef)) or
not is_signed(resultdef)) and
{$endif cpu64bitalu}
ispowerof2(tordconstnode(right).value,power) then
begin
if nodetype = divn then
if nodetype=divn then
begin
(*
if is_signed(resultdef) then
begin
if is_64bitint(left.resultdef) then
if not (cs_opt_size in current_settings.optimizerswitches) then
shiftval := 63
shiftval:=63
else
{ the shift code is a lot bigger than the call to }
{ the divide helper }
exit
else
shiftval := 31;
{ we reuse left twice, so create once a copy of it }
{ !!! if left is a call is -> call gets executed twice }
left := caddnode.create(addn,left,
caddnode.create(andn,
cshlshrnode.create(sarn,left.getcopy,
cordconstnode.create(shiftval,sinttype,false)),
cordconstnode.create(tordconstnode(right).value-1,
right.resultdef,false)));
newtype := sarn;
shiftval:=31;
result:=internalstatements(statements);
temp:=ctempcreatenode.create(left.resultdef,left.resultdef.size,tt_persistent,true);
addstatement(statements,temp);
addstatement(statements,cassignmentnode.create(ctemprefnode.create(temp),
left));
left:=nil;
addstatement(statements,ccallnode.createintern('fpc_sarint64',
ccallparanode.create(cordconstnode.create(power,u8inttype,false),
ccallparanode.create(caddnode.create(addn,ctemprefnode.create(temp),
caddnode.create(andn,
ccallnode.createintern('fpc_sarint64',
ccallparanode.create(cordconstnode.create(shiftval,u8inttype,false),
ccallparanode.create(ctemprefnode.create(temp),nil))
),
cordconstnode.create(tordconstnode(right).value-1,
right.resultdef,false)
)),nil
)))
);
end
else
*)
newtype := shrn;
tordconstnode(right).value := power;
result := cshlshrnode.create(newtype,left,right)
begin
tordconstnode(right).value:=power;
result:=cshlshrnode.create(shrn,left,right)
end;
end
else
begin

4
rtl/inc/generic.inc
View File

@ -2296,10 +2296,12 @@ function SarLongint(Const AValue : Longint;const Shift : Byte): Longint;
{$ifndef FPC_HAS_INTERNAL_SAR_QWORD}
{$ifndef FPC_SYSTEM_HAS_SAR_QWORD}
function SarInt64(Const AValue : Int64;const Shift : Byte): Int64;
function fpc_SarInt64(Const AValue : Int64;const Shift : Byte): Int64; [Public,Alias:'FPC_SARINT64']; compilerproc;
begin
Result:=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;
function SarInt64(Const AValue : Int64;const Shift : Byte = 1): Int64; [external name 'FPC_SARINT64'];
{$endif FPC_HAS_INTERNAL_SAR_QWORD}
{$endif FPC_SYSTEM_HAS_SAR_QWORD}

1
rtl/inc/systemh.inc
View File

@ -783,6 +783,7 @@ function SarLongint(Const AValue : Longint;const Shift : Byte = 1): Longint;
function SarInt64(Const AValue : Int64): Int64;[internproc:fpc_in_sar_x];
function SarInt64(Const AValue : Int64;Shift : Byte): Int64;[internproc:fpc_in_sar_x_y];
{$else FPC_HAS_INTERNAL_SAR_QWORD}
function fpc_SarInt64(Const AValue : Int64;const Shift : Byte): Int64;compilerproc;
function SarInt64(Const AValue : Int64;const Shift : Byte = 1): Int64;
{$endif FPC_HAS_INTERNAL_SAR_QWORD}

18
tests/webtbs/tw20998.pp Normal file
View File

@ -0,0 +1,18 @@
var
i : int64;
begin
i:=6400;
i:=i div 64;
if i<>100 then
halt(1);
i:=6500;
i:=i div 65;
if i<>100 then
halt(1);
i:=-6400;
i:=i div 64;
if i<>-100 then
halt(1);
writeln('ok');
end.