paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-09-03 21:50:18 +02:00
Code Issues Packages Projects Releases Wiki Activity

* updates from Ales Katona

Browse Source
This commit is contained in:
peter 2005-02-19 21:30:04 +00:00
parent 52337789b9
commit fc70da304e
5 changed files with 76 additions and 62 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

23
tests/bench/shootout/src/ackerm.pp
View File

@ -1,23 +0,0 @@
{ Ackermann's Function }
program ackermann;
uses SysUtils;
function Ack(M, N : integer) : integer;
begin
if M = 0 then Ack := N+1
else if N = 0 then Ack := Ack(M-1, 1)
else Ack := Ack(M-1, Ack(M, N-1))
End;
var NUM, a : integer;
begin
if ParamCount = 0 then
NUM := 1
else
NUM := StrToInt(ParamStr(1));
if NUM < 1 then NUM := 1;
a := Ack(3, NUM);
WriteLn( 'Ack(3,' + IntToStr(NUM) + '): ' + IntToStr(a) );
end.

23
tests/bench/shootout/src/ackermann.pp Normal file
View File

@ -0,0 +1,23 @@
program ackerman;
{$mode objfpc}
uses SysUtils;
function Ack(const M, N : integer) : integer;
begin
if M = 0 then Ack := N+1
else if N = 0 then Ack := Ack(M-1, 1)
else Ack := Ack(M-1, Ack(M, N-1));
end;
var NUM, a: integer;
begin
if ParamCount = 0 then NUM := 1
else NUM := StrToInt(ParamStr(1));
if NUM < 1 then NUM := 1;
a := Ack(3, NUM);
WriteLn( 'Ack(3,' + IntToStr(NUM) + '): ' + IntToStr(a) );
end.

30
tests/bench/shootout/src/fibo.pp
View File

@ -1,25 +1,25 @@
{ Fibonacci Numbers }
program fibonacci;
{$mode objfpc}
program fibo;
uses SysUtils;
function fib(N : integer) : longint;
function fib(const N: cardinal): cardinal;
begin
if N < 2 then fib := 1
else fib := fib(N-2) + fib(N-1);
End;
if N < 2 then fib := 1 else
fib := fib(N-2) + fib(N-1);
end;
var
NUM : integer;
f : longint;
NUM : integer;
f : cardinal;
begin
if ParamCount = 0 then
NUM := 1
else
NUM := StrToInt(ParamStr(1));
if ParamCount = 0 then NUM := 1
else NUM := StrToInt(ParamStr(1));
if NUM < 1 then NUM := 1;
f := fib(NUM);
WriteLn( IntToStr(f) );
if NUM < 1 then NUM := 1;
f := fib(NUM);
WriteLn( IntToStr(f) );
end.

43
tests/bench/shootout/src/random.pp
View File

@ -1,33 +1,28 @@
{ Random Number Generator }
program random;
{$mode objfpc}
uses SysUtils;
const
IM = 139968;
IA = 3877;
IC = 29573;
const IM = 139968;
IA = 3877;
IC = 29573;
var
LAST, NUM, i : longint;
result : real;
function gen_random(n : integer) : real;
var LAST, NUM, i: longint;
value: double;
function gen_random(const n: integer): double; inline;
begin
LAST := (LAST * IA + IC) mod IM;
gen_random := n * LAST / IM;
LAST := (LAST * IA + IC) mod IM;
gen_random := n * LAST / IM;
end;
begin
if ParamCount = 0 then
NUM := 1
else
NUM := StrToInt(ParamStr(1));
if NUM < 1 then NUM := 1;
LAST := 42;
for i:= 1 to NUM do
begin
result := gen_random(100);
end;
WriteLn( result:10:9 );
if ParamCount = 0 then NUM := 1
else NUM := StrToInt(ParamStr(1));
if NUM < 1 then NUM := 1;
LAST := 42;
for i:= 1 to NUM do
value:=gen_random(100);
WriteLn(value:10:9);
end.

19
tests/bench/shootout/src/takfp.pp Normal file
View File

@ -0,0 +1,19 @@
program takfp;
{$mode objfpc}
uses SysUtils;
function Tak(const x, y, z: double): double;
begin
if y >= x then Tak:=z else
Tak:=Tak(Tak(x-1,y,z), Tak(y-1,z,x), Tak(z-1,x,y));
end;
var n: integer;
begin
if paramcount<1 then n:=1
else n:=StrToInt(paramstr(1));
writeln(Tak(n*3, n*2, n*1):0:1);
end.