Data commit

Task/Pi/FutureBasic/pi.basic

@@ -0,0 +1,168 @@
+_maxlong = 0x7fffffff
+
+begin globals
+long kf, ks
+xref mf(_maxLong - 1) as long
+xref ms(_maxLong - 1) as long
+long cnt, n, temp, nd
+long col, col1
+long lloc, stor(50)
+end globals
+
+local mode
+local fn FmtStr( nn as long, s as Str255 ) as Str255
+  long l
+  Str255 f
+  l = s[0]
+  select case
+    case (  nn => l ) : f = string$( nn-l, 32 ) + s
+    case ( -nn  > l ) : f = s + string$( -nn-l, 32 )
+    case else : f = s
+  end select
+end fn = f
+
+local mode
+local fn FmtInt( nn as long, s as Str255 ) as Str255
+  if ( left$( s, 1 ) = " " ) then s = mid$( s, 2 )
+end fn = fn FmtStr( nn, s )
+
+
+local fn yprint( m as long )
+  if ( cnt < n )
+    col++
+    if ( col == 11 )
+      col = 1
+      col1++
+      if ( col1 == 6 )
+        col1 = 0
+        print
+        print fn FmtInt( 4, str$( m mod 10) );
+      else
+        print fn FmtInt( 3, str$ (m mod 10) );
+      end if
+    else
+      print mid$( str$( m ), 2 ) ;
+    end if
+  end if
+  cnt++
+end fn
+
+
+local fn xprint( m as long )
+  long ii, wk, wk1
+
+  if ( m < 8 )
+    ii = 1
+    while ( ii <= lloc )
+      fn yprint( stor(ii) )
+      ii++
+    wend
+    lloc = 0
+  else
+    if ( m > 9 )
+      wk = m / 10
+      m = m mod 10
+      wk1 = lloc
+      while ( wk1 >= 1 )
+        wk += stor(wk1)
+        stor(wk1) = wk mod 10
+        wk = wk/10
+        wk1--
+      wend
+    end if
+  end if
+  lloc++
+  stor(lloc) = m
+end fn
+
+
+local mode
+local fn shift( l1 as ^long, l2 as ^long, lp as long, lmod as long )
+  long k
+
+  if ( l2.nil& > 0 )
+    k = ( l2.nil& ) / lmod
+  else
+    k =  -( -l2.nil&  / lmod ) - 1
+  end if
+  l2.nil& = l2.nil& - k*lmod
+  l1.nil& = l1.nil& + k*lp
+end fn
+
+
+local fn Main( nDig as long )
+  long i
+
+  n = nDig
+  stor(0) = 0
+
+  mf = fn malloc( ( n + 10 ) * sizeof(long) )
+  if ( 0 == mf ) then stop "Out of memory"
+
+  ms = fn malloc( ( n + 10 ) * sizeof(long) )
+  if ( 0 == ms ) then stop "Out of memory"
+
+  print : printf @"Approximation of π to %ld digits", n
+
+  cnt = 0
+  kf  = 25
+  ks  = 57121
+  mf(1) = 1
+
+  i = 2
+  while ( i <= n )
+    mf(i)     = -16
+    mf(i + 1) =  16
+    i += 2
+  wend
+
+  i = 1
+  while ( i <= n )
+    ms(i)     = -4
+    ms(i + 1) =  4
+    i += 2
+  wend
+
+  print : print " 3.";
+
+  while ( cnt < n )
+    i = 0
+    i++
+    while ( i <= n - cnt )
+      mf(i) = mf(i) * 10
+      ms(i) = ms(i) * 10
+      i++
+    wend
+
+    i = ( n - cnt + 1 )
+    i--
+    while ( i >= 2 )
+      temp = 2 * i - 1
+      fn shift( @mf(i - 1), @mf(i), temp - 2, temp * kf )
+      fn shift( @ms(i - 1), @ms(i), temp - 2, temp * ks )
+      i--
+    wend
+
+    nd = 0
+
+    fn shift( @nd, @mf(1), 1, 5 )
+    fn shift( @nd, @ms(1), 1, 239 )
+    fn xprint( nd )
+
+  wend
+
+  print : print "Done"
+  fn free( ms )
+  fn free( mf )
+end fn
+
+window 1
+
+CFTimeInterval t
+
+t = fn CACurrentMediaTime
+// Here we specify the number of decimal places
+fn Main( 4000 )
+print : printf @"Compute time: %.3f ms",(fn CACurrentMediaTime-t)*1000
+
+HandleEvents