Source code in the futurebasic programming language

_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