paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-11-01 06:19:41 +01: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; uses SysUtils;
function fib(N : integer) : longint; function fib(const N: cardinal): cardinal;
begin begin
if N < 2 then fib := 1 if N < 2 then fib := 1 else
else fib := fib(N-2) + fib(N-1); fib := fib(N-2) + fib(N-1);
End; end;
var var
NUM : integer; NUM : integer;
f : longint; f : cardinal;
begin begin
if ParamCount = 0 then if ParamCount = 0 then NUM := 1
NUM := 1 else NUM := StrToInt(ParamStr(1));
else
NUM := StrToInt(ParamStr(1));
if NUM < 1 then NUM := 1; if NUM < 1 then NUM := 1;
f := fib(NUM); f := fib(NUM);
WriteLn( IntToStr(f) ); WriteLn( IntToStr(f) );
end. end.

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

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