From mboxrd@z Thu Jan  1 00:00:00 1970
X-Spam-Checker-Version: SpamAssassin 3.4.4 (2020-01-24) on polar.synack.me
X-Spam-Level: 
X-Spam-Status: No, score=-1.9 required=5.0 tests=BAYES_00 autolearn=ham
	autolearn_force=no version=3.4.4
X-Google-Thread: 103376,278bf0771374076e
X-Google-Attributes: gid103376,public
X-Google-Language: ENGLISH,ASCII-7-bit
Path: 
 g2news2.google.com!news3.google.com!news4.google.com!border1.nntp.dca.giganews.com!nntp.giganews.com!wns14feed!worldnet.att.net!attbi_s22.POSTED!53ab2750!not-for-mail
From: "Jeffrey R. Carter" <spam.not.jrcarter@acm.not.spam.org>
Organization: jrcarter at acm dot org
User-Agent: Thunderbird 1.5.0.7 (Windows/20060909)
MIME-Version: 1.0
Newsgroups: comp.lang.ada
Subject: Re: ada is getting spanked :(
References: <1162052997.664967.135910@e3g2000cwe.googlegroups.com>
 <3321666.DLNnW6yRHq@linux1.krischik.com> <ei5g46$44r$1@news.task.gda.pl>
 <4546f186$1@news.post.ch> <zGq2h.130890$aJ.85400@attbi_s21>
 <454b30c9$1@news.post.ch>
In-Reply-To: <454b30c9$1@news.post.ch>
Content-Type: text/plain; charset=ISO-8859-1; format=flowed
Content-Transfer-Encoding: 7bit
Message-ID: <NcN2h.1049454$084.676225@attbi_s22>
NNTP-Posting-Host: 12.201.97.213
X-Complaints-To: abuse@mchsi.com
X-Trace: attbi_s22 1162583981 12.201.97.213 (Fri, 03 Nov 2006 19:59:41 GMT)
NNTP-Posting-Date: Fri, 03 Nov 2006 19:59:41 GMT
Date: Fri, 03 Nov 2006 19:59:41 GMT
Xref: g2news2.google.com comp.lang.ada:7366
Date: 2006-11-03T19:59:41+00:00
List-Id: <comp.lang.ada>

Martin Krischik wrote:
> 
> Would you mind adding it to the wikibook ada subversion archive
> 
> http://sourceforge.net/projects/wikibook-ada
> 
> So we will never loose it.

Loose, an adjective, is the opposite of Tight. Lose is a verb.

I don't have subversion or the time right now to get it and figure out 
how to do this. I'll stick the code here so you can copy it and add it.

I compiled with

-O3 -gnatnpws -march=pentium4 -fomit-frame-pointer

-gnatws (suppress all warnings) because there's unreachable code in the 
big-num packages that generates a bunch of warnings.

Here it is:

-- Shootout header should go here.

with Ada.Command_Line;
with Ada.Text_IO;
with Ada.Integer_Text_IO;
with Big_Number;
procedure Pi_Digits is
    type Big_Index is mod 2 ** 16;

    package Bignum is new Big_Number
       (Index_Type => Big_Index, Nb_Item => 3300);

    subtype Big is Bignum.Big_Signed;

    use Bignum.Signed_Number;

    function To_Big is new
    Bignum.Generic_Conversion.Int_Number2Big_Signed
       (Int_Generic => Integer);
    function To_Float (Num : Big) return Long_Long_Float renames
    Bignum.Conversion.Big_Signed2Long_Long_Float;

    procedure Output_Pi (Num_Digits : in Integer) is
       -- State : transformation matrix components
       Q : Big := Bignum.Big_Signed_One;
       R : Big := Bignum.Big_Signed_Zero;
       S : Big := Bignum.Big_Signed_Zero;
       T : Big := Bignum.Big_Signed_One;

       -- Work variables
       U     : Big;
       V     : Big;
       W     : Big;
       X_Big : Big;
       K_Big : Big;
       K2    : Big;
       K4    : Big;

       K     : Natural := 0;
       Digit : Integer;

       Ten : constant Big := To_Big (10);

       function Extract (X : Natural) return Integer is
          -- null;
       begin -- Extract
          X_Big := To_Big (X);
          U := Q * X_Big + R;
          V := S * X_Big + T;
          W := U / V;

          return Integer (To_Float (W) );
       end Extract;

       function Safe (Digit : Integer) return Boolean is
          -- null;
       begin -- Safe
          return Digit = Extract (4);
       end Safe;
       pragma Inline (Safe);

       procedure Produce is
          -- null;
       begin -- Produce
          V := T * To_Big (-10 * Digit);
          R := Ten * R + V;
          Q := Ten * Q;
       end Produce;

       procedure Consume is
          -- null;
       begin -- Consume
          K := K + 1;
          K_Big := To_Big (K);
          K2 := To_Big (2 * K + 1);
          K4 := To_Big (4 * K + 2);
          U := Q * K4;
          R := R * K2 + U;
          V := S * K4;
          T := T * K2 + V;
          S := S * K_Big;
          Q := Q * K_Big;
       end Consume;

       subtype Line_Str is String (1 .. 10);

       I    : Natural := 0;
       C    : Natural := 0;
       Line : Line_Str;
    begin -- Output_Pi
       loop
          exit when I >= Num_Digits;

          loop
             Digit := Extract (3);

             exit when Safe (Digit);

             Consume;
          end loop;

          Produce;
          C := C + 1;
          Line (C) := Character'Val (Character'Pos ('0') + Digit);
          I := I + 1;

          if C >= 10 then
             C := 0;
             Ada.Text_IO.Put (Item => Line & ASCII.HT & ':');
             Ada.Integer_Text_IO.Put (Item => I, Width => 1);
             Ada.Text_IO.New_Line;
          end if;
       end loop;

       if C /= 0 then
          Ada.Text_IO.Put (Item => Line (1 .. C) &
                                   String'(C + 1 .. 10 => ' ') &
                                   ASCII.HT & ':');
          Ada.Integer_Text_IO.Put (Item => I, Width => 1);
          Ada.Text_IO.New_Line;
       end if;
    end Output_Pi;

    N: Positive := 2500;
begin -- Pi_Digits
    if Ada.Command_Line.Argument_Count > 0 then
       N := Integer'Value (Ada.Command_Line.Argument (1) );
    end if;

    Output_Pi (Num_Digits => N);
end Pi_Digits;

-- 
Jeff Carter
"We call your door-opening request a silly thing."
Monty Python & the Holy Grail
17