diff --git a/tests/bench/shootout/src/ackerm.pp b/tests/bench/shootout/src/ackerm.pp new file mode 100644 index 0000000000..cd54061826 --- /dev/null +++ b/tests/bench/shootout/src/ackerm.pp @@ -0,0 +1,23 @@ +{ 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. diff --git a/tests/bench/shootout/src/array.pp b/tests/bench/shootout/src/array.pp new file mode 100644 index 0000000000..b73d3dea39 --- /dev/null +++ b/tests/bench/shootout/src/array.pp @@ -0,0 +1,38 @@ +{ Array Access } + +Program ary3; + +uses SysUtils, Classes; + +var + n, i, k, last : longint; + X, Y : TList; +begin + if ParamCount = 0 then + n := 1 + else + n := StrToInt(ParamStr(1)); + + if n < 1 then n := 1; + + last := n - 1; + X := TList.Create; + X.Capacity := n; + For i := 0 To last do + X.Add( Pointer(i+1) ); + + Y := TList.Create; + Y.Capacity := n; + For i := 0 To last do + Y.Add( Pointer(0) ); + + + For k := 0 To 999 do + begin + For i := last downto 0 do + begin + Y.Items[i] := Pointer(longint(Y.Items[i]) + longint(X.Items[i])); + end; + end; + Writeln (IntToStr(longint(Y.Items[0])), ' ', IntToStr(longint(Y.Items[last]))); +end. diff --git a/tests/bench/shootout/src/fibo.pp b/tests/bench/shootout/src/fibo.pp new file mode 100644 index 0000000000..a43aa6de50 --- /dev/null +++ b/tests/bench/shootout/src/fibo.pp @@ -0,0 +1,25 @@ +{ Fibonacci Numbers } + +program fibo; +uses SysUtils; + +function fib(N : integer) : longint; +begin + if N < 2 then fib := 1 + else fib := fib(N-2) + fib(N-1); +End; + +var + NUM : integer; + f : longint; + +begin + if ParamCount = 0 then + NUM := 1 + else + NUM := StrToInt(ParamStr(1)); + + if NUM < 1 then NUM := 1; + f := fib(NUM); + WriteLn( IntToStr(f) ); +end. diff --git a/tests/bench/shootout/src/hash.pp b/tests/bench/shootout/src/hash.pp new file mode 100644 index 0000000000..6211e41904 --- /dev/null +++ b/tests/bench/shootout/src/hash.pp @@ -0,0 +1,131 @@ +{ Hash (Associative Array) Access } +{$mode objfpc} + +Program hash; + +uses SysUtils, Classes; + + +type + THashEntryPtr = ^THashEntryRec; + THashEntryRec = record + name : string; + number : longint; + next : THashEntryPtr; + end; + +const + TABLE_SIZE = 100000; + +type THash = class + private + hashtable : array[0..TABLE_SIZE - 1] of THashEntryRec; + function hash(s : string) : longint; + public + constructor Create; + function store(name : string; number : longint; var error : longint) +: boolean; + function fetch(name : string; var number : longint) : boolean; + function exists(name : string) : boolean; +end; + +constructor THash.Create; +var + i : longint; +begin + for i := 0 to TABLE_SIZE - 1 do + hashtable[i].next := nil; +end; + + +function THash.hash(s : string) : longint; +var + i, j : longint; +begin + if length(s) = 0 then Result := 0 + else + begin + j := ord(s[1]) mod TABLE_SIZE; + for i := 2 to length(s) do + j := (j shl 8 + ord(s[i])) mod TABLE_SIZE; + Result := j; + end; +end; + +function THash.store(name : string; number : longint; var error : longint) : +boolean; +var + node, prev : THashEntryPtr; +begin + error := 0; + + prev := @hashtable[hash(name)]; + node := prev^.next; + + while (node <> nil) and (node^.name <> name) do + begin + prev := node; + node := node^.next; + end; + + if node <> nil then error := 1 + else begin + new(prev^.next); + node := prev^.next; + if node = nil then error := -1 + else begin + node^.name := name; + node^.number := number; + node^.next := nil; + end; + end; + + Result := error = 0; +end; + +function THash.fetch(name : string; var number : longint) : boolean; +var + node : THashEntryPtr; +begin + node := hashtable[hash(name)].next; + while (node <> nil) and (node^.name <> name) do + node := node^.next; + if node <> nil then number := node^.number; + Result := node <> nil; +end; + +function THash.exists(name : string) : boolean; +var + node : THashEntryPtr; +begin + node := hashtable[hash(name)].next; + while (node <> nil) and (node^.name <> name) do + node := node^.next; + Result := node <> nil; +end; + + +var + n, i, c, err : longint; + X : THash; +begin + if ParamCount = 0 then + n := 1 + else + n := StrToInt(ParamStr(1)); + + if n < 1 then n := 1; + + X := THash.Create(); + + For i := 1 To n do + X.store( Format('%x', [i]), i, err ); + + c := 0; + For i:= n downto 1 do + begin + if X.exists( IntToStr(i) ) Then Inc(c); + end; + + Writeln (IntToStr(c)); +end. diff --git a/tests/bench/shootout/src/heapsort.pp b/tests/bench/shootout/src/heapsort.pp new file mode 100644 index 0000000000..c26840d018 --- /dev/null +++ b/tests/bench/shootout/src/heapsort.pp @@ -0,0 +1,126 @@ +{ Heapsort } + +program heapsort; +uses SysUtils, Classes; + +const + IM = 139968; + IA = 3877; + IC = 29573; + +var + ary: TList; + r : real; + rr : ^real; + N, i, LAST : longint; + +function gen_random(n : longint) : real; +begin + LAST := (LAST * IA + IC) mod IM; + gen_random := n * LAST / IM; +end; + +procedure myheapsort(n : longint; var ra : TList); +var + rr : ^real; + rra : real; + i, j, l, ir : longint; +begin + rra := 0; + i := 0; + j := 0; + l := n shr 1 + 1; + ir := n; + + while 1 = 1 do + begin + if l > 1 then begin + Dec(l); + rra := real(ra.Items[l]^); + end + else begin + rra := real(ra.Items[ir]^); + + + + GetMem(rr, SizeOf(real)); + rr^ := real(ra.Items[1]^); + ra.items[ir] := rr; + + + Dec(ir); + if ir = 1 then + begin + + + GetMem(rr, SizeOf(real)); + rr^ := rra; + ra.items[1] := rr; + + exit; + end; + end; + + i := l; + j := l shl 1; + + + + while j <= ir do begin + if (j < ir) and (real(ra.items[j]^) < real(ra.items[j+1]^)) then +Inc(j); + + + + + if rra < real(ra.items[j]^) then begin + + + GetMem(rr, SizeOf(real)); + rr^ := real(ra.items[j]^); + ra.items[i] := rr; + + i := j; + Inc(j, i); + end + else begin + j := ir + 1; + end; + end; + + GetMem(rr, SizeOf(real)); + rr^ := rra; + ra.items[i] := rr; + + end; +end; + +begin + if ParamCount = 0 then + N := 1 + else + N := StrToInt(ParamStr(1)); + if N < 1 then N := 1; + LAST := 42; + ary := TList.Create; + ary.Capacity := N; + r := 0.0; + GetMem( rr, SizeOf(real) ); + rr^ := r; + ary.Add( rr ); + for i:= 1 to N do begin + r := gen_random(1); + GetMem( rr, SizeOf(real) ); + rr^ := r; + + ary.Add( rr ); + end; + for i:= 1 to N do begin + r := real(ary.items[i]^); + + end; + myheapsort(N, ary); + r := real(ary.items[N]^); + WriteLn( r:10:10 ); + ary.Free; +end. diff --git a/tests/bench/shootout/src/hello.pp b/tests/bench/shootout/src/hello.pp new file mode 100644 index 0000000000..b40842843c --- /dev/null +++ b/tests/bench/shootout/src/hello.pp @@ -0,0 +1,8 @@ +{ Hello World } + +program hello; +uses SysUtils; + +begin + WriteLn( 'hello world' ); +end. diff --git a/tests/bench/shootout/src/lists.pp b/tests/bench/shootout/src/lists.pp new file mode 100644 index 0000000000..2be10b1c08 --- /dev/null +++ b/tests/bench/shootout/src/lists.pp @@ -0,0 +1,104 @@ +{ List Operations } + +Program lists; + +uses SysUtils, classes; + +const SIZE : longint = 10000; + +Function test_lists : integer; +var + i, len1, len2 : longint; + Li1, Li2, Li3 : TList; + lists_equal : Integer; +begin + + Li1 := TList.Create; + Li1.Capacity := SIZE; + For i := 0 to SIZE Do + Li1.Add(Pointer(i)); + + + + Li2 := TList.Create; + Li2.Capacity := SIZE; + For i:= 0 to SIZE Do + Li2.Add(Li1.Items[i]); + + { remove each individual item from left side of Li2 and + append to right side of Li3 (preserving order) } + Li3 := TList.Create; + Li3.Capacity := SIZE; + For i := 0 to SIZE Do + begin + Li3.Add( Li2.First ); + Li2.Remove( Li2.First ); + end; + + + { remove each individual item from right side of Li3 and + append to right side of Li2 (reversing list) } + For i := 0 To SIZE Do + begin + Li2.Add( Li3.Last ); + Li3.Count -= 1; + end; + + + + + For i := 0 To (SIZE div 2) Do + begin + Li1.Exchange( i, SIZE-i ); + end; + + + If longint(Li1.first) <> SIZE Then + begin + + test_lists := 0; + exit; + end; + + + len1 := Li1.Count - 1; + len2 := Li2.Count - 1; + If len1 <> len2 Then + begin + test_lists := 0; + exit; + end; + + lists_equal := 1; + For i := 0 To len1 Do + begin + If longint(Li1.items[i]) <> longint(Li2.items[i]) Then + begin + lists_equal := 0; + break; + end; + end; + + If lists_equal = 0 Then + begin + test_lists := 0; + end + else + test_lists := len1; +end; + +var + ITER, i, result: integer; + +begin + if ParamCount = 0 then + ITER := 1 + else + ITER := StrToInt(ParamStr(1)); + + if ITER < 1 then ITER := 1; + + For i := 1 To ITER Do result := test_lists(); + Writeln (IntToStr(result)); + +end. diff --git a/tests/bench/shootout/src/matrix.pp b/tests/bench/shootout/src/matrix.pp new file mode 100644 index 0000000000..9fc76500f0 --- /dev/null +++ b/tests/bench/shootout/src/matrix.pp @@ -0,0 +1,71 @@ +{ Matrix Multiplication } + +program matrix; +uses SysUtils; + +const + size = 30; + +type tMatrix = array[0..size, 0..size] of longint; + +procedure mkmatrix( rows, cols : integer; var mx : tMatrix); +var + R, C : integer; + count : longint; +begin + Dec(rows); + Dec(cols); + count := 1; + for R := 0 to rows do + begin + for C := 0 to cols do + begin + mx[R, C] := count; + Inc(count); + end; + end; +End; + +procedure mmult(rows, cols : integer; m1, m2 : tMatrix; var mm : tMatrix ); +var + i, j, k : integer; + val: longint; +begin + Dec(rows); + Dec(cols); + For i := 0 To rows do + begin + For j := 0 To cols do + begin + val := 0; + For k := 0 To cols do + begin + Inc(val, m1[i, k] * m2[k, j]); + end; + mm[i, j] := val; + end; + end; +End; + + +var NUM, I : integer; + M1, M2, MM : tMatrix; + +begin + if ParamCount = 0 then + NUM := 1 + else + NUM := StrToInt(ParamStr(1)); + + if NUM < 1 then NUM := 1; + + mkmatrix(size, size, M1); + mkmatrix(size, size, M2); + + for I := 0 To NUM do + begin + mmult(size, size, M1, M2, MM); + end; + WriteLn( IntToStr(MM[0, 0]) + ' ' + IntToStr(MM[2, 3]) + ' ' + + IntToStr(MM[3, 2]) + ' ' + IntToStr(MM[4, 4])); +end. diff --git a/tests/bench/shootout/src/methcall.pp b/tests/bench/shootout/src/methcall.pp new file mode 100644 index 0000000000..bba79d930c --- /dev/null +++ b/tests/bench/shootout/src/methcall.pp @@ -0,0 +1,94 @@ +{ Method Calls } + +program methcall; + + +uses SysUtils; + +type TToggle = class + private + value : boolean; + + public + property Bool : boolean read value write value; + procedure Activate; +end; + +type TNthToggle = class + constructor Create; + private + value : boolean; + counter : integer; + cmax : integer; + public + property CountMax : integer read cmax write cmax; + property Bool : boolean read value write value; + procedure Activate; +end; + +constructor TNthToggle.Create; +begin + counter := 0; +end; + +procedure TToggle.Activate; +begin + if value = True Then + value := False + else + value := True; +end; + +procedure TNthToggle.Activate; +begin + counter := counter + 1; + if counter >= cmax Then begin + if value = True Then + value := False + Else + value := True; + counter := 0; + end; +end; + + +var + NUM, i : longint; + val : boolean; + oToggle : TToggle; + onToggle : TNthToggle; +begin + if ParamCount = 0 then + NUM := 1 + else + NUM := StrToInt(ParamStr(1)); + + if NUM < 1 then NUM := 1; + + val := True; + oToggle := TToggle.Create; + oToggle.Bool := val; + For i := 1 to NUM do + begin + oToggle.Activate; + val := oToggle.Bool; + end; + If val = True Then + WriteLn('true') + else + WriteLn('false'); + + val := True; + onToggle := TNthToggle.Create; + onToggle.Bool := val; + onToggle.CountMax := 3; + For i := 1 to NUM do + begin + onToggle.Activate; + val := onToggle.Bool; + end; + If val = True Then + WriteLn('true') + else + WriteLn('false'); +end. diff --git a/tests/bench/shootout/src/moments.pp b/tests/bench/shootout/src/moments.pp new file mode 100644 index 0000000000..00c4832725 --- /dev/null +++ b/tests/bench/shootout/src/moments.pp @@ -0,0 +1,88 @@ +{ Statistical Moments } + +Program moments; +uses SysUtils, Classes; + +function Power(Base : Real ; Exponent: Integer): Real; +var i : integer; +var pow : real; +begin + pow := Base; + For i:= 2 To Exponent do pow := pow * Base; + Power := pow; +end; + +function Compare(A, B : Pointer) : longint; +begin + if A > B then + Compare := 1 + else if A < B Then + Compare := -1 + else + Compare := 0; +end; + + +var + i, N, sum, num, middle : longint; + list : TList; + median, mean, deviation, + average_deviation, standard_deviation, + variance, skew, kurtosis : real; +begin + list := TList.Create; + While Not Eof(input) do + begin + Readln(input, num); + list.Add( Pointer(num) ); + end; + N := list.Count; + For i := 0 To N-1 do Inc(sum, longint(list.Items[i])); + mean := sum / N; + average_deviation := 0; + standard_deviation := 0; + variance := 0; + skew := 0; + kurtosis := 0; + + For i := 0 To N-1 do + begin + deviation := longint(list.Items[i]) - mean; + average_deviation := average_deviation + Abs(deviation); + variance := variance + Power(deviation, 2); + skew := skew + Power(deviation, 3); + kurtosis := kurtosis + Power(deviation, 4); + + end; + average_deviation := average_deviation / N; + variance := variance / (N-1); + standard_deviation := Sqrt(variance); + + + If variance <> 0 Then + begin + skew := skew / (N * variance * standard_deviation); + kurtosis := kurtosis / (N * variance * variance ) - 3.0; + end; + + list.Sort(@Compare); + + + middle := N Div 2; + + If (N Mod 2) <> 0 Then + median := longint(list.Items[middle]) + Else + median := (longint(list.Items[middle]) + +longint(list.Items[middle-1])) / 2; + + + WriteLn('n: ', N); + WriteLn('median: ', median:6:6); + WriteLn('mean: ', mean:6:6); + WriteLn('average_deviation: ', average_deviation:6:6); + WriteLn('standard_deviation: ', standard_deviation:6:6); + WriteLn('variance: ', variance:6:6); + WriteLn('skew: ', skew:6:6); + WriteLn('kurtosis: ', kurtosis:6:6); +end. diff --git a/tests/bench/shootout/src/nestedloop.pp b/tests/bench/shootout/src/nestedloop.pp new file mode 100644 index 0000000000..abd3e8335c --- /dev/null +++ b/tests/bench/shootout/src/nestedloop.pp @@ -0,0 +1,27 @@ +{ Nested Loops } + + + + +program nestedloop; +uses SysUtils; + +var n, a, b, c, d, e, f : integer; +var x : longint; + +begin + if ParamCount = 0 then + n := 1 + else + n := StrToInt(ParamStr(1)); + if n < 1 then n := 1; + x := 0; + For a := 1 to n Do + For b := 1 to n Do + For c := 1 to n Do + For d := 1 to n Do + For e := 1 to n Do + For f := 1 to n Do + Inc(x); + WriteLn( IntToStr(x) ); +end. diff --git a/tests/bench/shootout/src/random.pp b/tests/bench/shootout/src/random.pp new file mode 100644 index 0000000000..c3c0360a97 --- /dev/null +++ b/tests/bench/shootout/src/random.pp @@ -0,0 +1,33 @@ +{ Random Number Generator } + +program random; +uses SysUtils; + +const + IM = 139968; + IA = 3877; + IC = 29573; + +var + LAST, NUM, i : longint; + result : real; + +function gen_random(n : integer) : real; +begin + 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 ); +end. diff --git a/tests/bench/shootout/src/reversefile.pp b/tests/bench/shootout/src/reversefile.pp new file mode 100644 index 0000000000..4f6df9961c --- /dev/null +++ b/tests/bench/shootout/src/reversefile.pp @@ -0,0 +1,22 @@ +{ Reverse a File } + +Program reversefile; +uses SysUtils, Classes; + +var + i, N : longint; + list : TList; + line : string; + pline : pointer; +begin + list := TList.Create; + While Not Eof(input) do + begin + Readln(input, line); + Getmem(pline, Length(line)+1); + Move(line, pline^, Length(line)+1); + list.Add( pline ); + end; + N := list.Count; + For i := N-1 Downto 0 do WriteLn( string(list.items[i]^) ); +end. diff --git a/tests/bench/shootout/src/sieve.pp b/tests/bench/shootout/src/sieve.pp new file mode 100644 index 0000000000..64f2f247c7 --- /dev/null +++ b/tests/bench/shootout/src/sieve.pp @@ -0,0 +1,41 @@ +{ Sieve of Erathostenes } + +program sieve; +uses SysUtils; + +var + NUM, i, k, count : integer; + flags : array[0..8192] of integer; + +begin + if ParamCount = 0 then + NUM := 1 + else + NUM := StrToInt(ParamStr(1)); + + if NUM < 1 then NUM := 1; + + while NUM > 0 do + begin + Dec(NUM); + count := 0; + for i := 0 to 8192 do + begin + flags[i] := i; + end; + for i := 2 to 8192 do + begin + if flags[i] <> -1 then + begin + k := i+i; + while k <= 8192 do + begin + flags[k] := -1; + Inc(k, i); + end; + Inc(count); + end; + end; + end; + WriteLn('Count: ' + IntToStr(Count)); +end. diff --git a/tests/bench/shootout/src/strcat.pp b/tests/bench/shootout/src/strcat.pp new file mode 100644 index 0000000000..8d136cee5b --- /dev/null +++ b/tests/bench/shootout/src/strcat.pp @@ -0,0 +1,20 @@ +{ String Concatenation } + +program strcat; + +uses SysUtils; +var + NUM, i : longint; + str : string; + +begin + if ParamCount = 0 then NUM := 1 + else NUM := StrToInt(ParamStr(1)); + if NUM < 1 then NUM := 1; + + str := ''; + For i := 1 To NUM Do + str := str + 'hello'#13; + WriteLn( Longint(Length(str)) ); + WriteLn( str ); +end. diff --git a/tests/bench/shootout/src/sumcol.pp b/tests/bench/shootout/src/sumcol.pp new file mode 100644 index 0000000000..4390f03980 --- /dev/null +++ b/tests/bench/shootout/src/sumcol.pp @@ -0,0 +1,14 @@ +{ Sum a Column of Integers } + +program sumcol; + +var + num, tot: longint; +begin + While Not Eof(input) Do + begin + ReadLn(input, num); + tot := tot + num; + end; + WriteLn(tot); +end. diff --git a/tests/bench/shootout/src/wc.pp b/tests/bench/shootout/src/wc.pp new file mode 100644 index 0000000000..4e06f6fb5e --- /dev/null +++ b/tests/bench/shootout/src/wc.pp @@ -0,0 +1,46 @@ + +{ Count Lines/Words/Chars } + +program wc; + + +uses SysUtils; + +var + nl, nw, nc: longint; + Buf: array[1..4096] of byte; + NumRead: Integer; + + A: Integer; + Tmp: String; + TmpPos : Byte; + Ch: String; + InWord: Boolean; +begin + nl := 0; + nc := 0; + nw := 0; + InWord := False; + NumRead := FileRead(StdInputHandle, Buf, 4096); + While NumRead > 0 Do + begin + Inc(nc, NumRead); + For A := 1 To NumRead Do + begin + if Buf[A] = 10 Then Inc(nl); + if Buf[A] = 13 Then Dec(nc); + if (Buf[A] = 32) Or (Buf[A] = 10) Or (Buf[A] = 13) Or (Buf[A] = 9) Then + InWord := False + else + begin + If InWord = False Then + begin + Inc(nw); + InWord := True; + end; + end; + end; + NumRead := FileRead(StdInputHandle, Buf, 4096); + end; + WriteLn(IntToStr(nl) + ' ' + IntToStr(nw) + ' ' + IntToStr(nc)); +end.