mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-06 16:27:57 +02:00
03cd0cce59
generate unique calls every time we write to it
* replace calls to high(ansistring/dynarray) in the inner body of the pi
function with a variable that gets assigned once
-> the FPC version is now just as fast as the C version
git-svn-id: trunk@42695 -
105 lines
2.0 KiB
ObjectPascal
105 lines
2.0 KiB
ObjectPascal
program pi;
|
|
|
|
{$ifdef fpc}
|
|
{$mode objfpc}
|
|
{$endif fpc}
|
|
|
|
{$APPTYPE CONSOLE}
|
|
{$implicitexceptions off}
|
|
|
|
{$h+}
|
|
|
|
uses
|
|
timer;
|
|
|
|
type
|
|
tchararray = array of char;
|
|
|
|
function ComputePi(NumDigits: Integer): tchararray;
|
|
var
|
|
A: array of LongInt;
|
|
I, J, K, P, Q, X, Nines, Predigit: Integer;
|
|
PiLength, ArrHigh: Integer;
|
|
begin
|
|
start;
|
|
SetLength(A, 10*NumDigits div 3);
|
|
SetLength(Result, NumDigits+1);
|
|
PiLength := 0;
|
|
ArrHigh:=high(A);
|
|
for I := Low(A) to ArrHigh do
|
|
A[I] := 2;
|
|
Nines := 0;
|
|
Predigit := 0;
|
|
for J := 0 to NumDigits-1 do
|
|
begin
|
|
Q := 0;
|
|
P := 2 * ArrHigh + 1;
|
|
for I := ArrHigh downto Low(A) do
|
|
begin
|
|
X := 10*A[I] + Q*(I+1);
|
|
A[I] := X mod P;
|
|
Q := X div P;
|
|
P := P - 2;
|
|
end;
|
|
A[Low(A)] := Q mod 10;
|
|
Q := Q div 10;
|
|
if Q = 9 then
|
|
Inc(Nines)
|
|
else if Q = 10 then
|
|
begin
|
|
Result[PiLength] := Chr(Predigit + 1 + Ord('0'));
|
|
for K := 1 to Nines do
|
|
Result[PiLength+K] := '0';
|
|
PiLength := PiLength + Nines + 1;
|
|
Predigit := 0;
|
|
Nines := 0;
|
|
end
|
|
else
|
|
begin
|
|
Result[PiLength] := Chr(Predigit + Ord('0'));
|
|
Predigit := Q;
|
|
for K := 1 to Nines do
|
|
Result[PiLength+K] := '9';
|
|
PiLength := PiLength + Nines + 1;
|
|
Nines := 0;
|
|
end;
|
|
end;
|
|
Result[PiLength] := Chr(Predigit + Ord('0'));
|
|
stop;
|
|
end;
|
|
|
|
var
|
|
NumDigits: Integer;
|
|
Code: Integer;
|
|
F: TextFile;
|
|
arrayresult: tchararray;
|
|
result : string;
|
|
begin
|
|
if ParamCount = 0 then
|
|
WriteLn('usage: pi #DIGITS [FILE]')
|
|
else
|
|
begin
|
|
Val(ParamStr(1), NumDigits, Code);
|
|
if Code <> 0 then
|
|
begin
|
|
WriteLn('Invalid # digits: ', ParamStr(1));
|
|
Halt(1);
|
|
end;
|
|
|
|
arrayresult:=ComputePi(NumDigits);
|
|
setlength(result,NumDigits+1);
|
|
move(arrayresult[0],result[1],(NumDigits+1)*sizeof(result[1]));
|
|
if ParamCount > 1 then
|
|
begin
|
|
AssignFile(F, ParamStr(2));
|
|
Rewrite(F);
|
|
WriteLn(F, result);
|
|
CloseFile(F);
|
|
end
|
|
else
|
|
begin
|
|
WriteLn(result);
|
|
end;
|
|
end;
|
|
end.
|