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

* improved fannkuch benchmark

Browse Source 
git-svn-id: trunk@9668 -
This commit is contained in:
Vincent Snijders 2008-01-07 11:09:07 +00:00
parent 44f8ac7fc5
commit a1f7a9086c
1 changed files with 34 additions and 28 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

62
tests/bench/shootout/src/fannkuch.pp
View File

@ -1,3 +1,4 @@
program fannkuch;
{ The Computer Language Shootout { The Computer Language Shootout
http://shootout.alioth.debian.org/ http://shootout.alioth.debian.org/
@ -25,21 +26,12 @@ procedure swap(var a, b: longint); inline;
var tmp: longint; var tmp: longint;
begin tmp := a; a := b; b := tmp end; begin tmp := a; a := b; b := tmp end;
procedure roll_down( var a : array of longint ); inline; procedure reverse( k: longint); inline;
var tmp : longint;
begin
tmp := a[ 0 ];
move( a[1], a[0], high(a)*sizeof(longint) );
a[ high(a) ] := tmp;
end;
procedure reverse( var a: array of longint ); inline;
var var
pi, pj : pLongint; pi, pj : pLongint;
begin begin
pi := @a[0]; pi := @permu_copy[1];
pj := @a[high(a)]; pj := @permu_copy[k-1];
while pi<pj do while pi<pj do
begin begin
swap(pi^, pj^); swap(pi^, pj^);
@ -51,6 +43,8 @@ end;
function NextPermutation: boolean; function NextPermutation: boolean;
var var
r0: longint; r0: longint;
tmp: LongInt;
i : longint;
begin begin
r0 := r; // use local variable r0 := r; // use local variable
NextPermutation := true; NextPermutation := true;
@ -60,7 +54,11 @@ begin
NextPermutation := false; NextPermutation := false;
break; break;
end; end;
roll_down( permu[ 0 .. r0 ] ); tmp := permu[0];
for i := 1 to r0 do
permu[i-1] := permu[i];
permu[r0] := tmp;
dec(count[r0]); dec(count[r0]);
if count[r0] > 0 then if count[r0] > 0 then
break; break;
@ -69,9 +67,26 @@ begin
r := r0; r := r0;
end; end;
function countflips: integer; inline;
var
last: LongInt;
tmp: LongInt;
begin
countflips := 0;
last := permu_copy[0];
repeat
// Reverse part of the array.
reverse(last);
tmp := permu_copy[ last ];
permu_copy[ last ] := last;
last := tmp;
inc(countflips);
until last = 0;
end;
function fannkuch: longint; function fannkuch: longint;
var var
print30, m, i, last, tmp, flips: longint; print30, m, i, flips: longint;
begin begin
print30 := 0; print30 := 0;
fannkuch := 0; fannkuch := 0;
@ -84,8 +99,10 @@ begin
repeat repeat
if print30 < 30 then if print30 < 30 then
begin begin
for i := 0 to m do write(permu[i] + 1); for i := 0 to m do
writeln; inc(print30); write(permu[i] + 1);
writeln;
inc(print30);
end; end;
while r <> 1 do while r <> 1 do
begin begin
@ -95,18 +112,7 @@ begin
if (permu[0]<>0) and (permu[m]<>m) then if (permu[0]<>0) and (permu[m]<>m) then
begin begin
move(permu[0], permu_copy[0], sizeof(longint)*n); move(permu[0], permu_copy[0], sizeof(longint)*n);
flips := 0; flips := countflips;
last := permu_copy[0];
repeat
// Reverse part of the array.
reverse( permu_copy[ 1 .. last-1 ] );
tmp := permu_copy[ last ];
permu_copy[ last ] := last;
last := tmp;
inc(flips);
until last = 0;
if flips > fannkuch then if flips > fannkuch then
fannkuch := flips; fannkuch := flips;
end; end;