samples/pi.f

   1 \ Calculation of digits of pi without floating-point
   2 \ The algorithm calculate one digit at the time
   3 \ Michel Jean, April 2020
   4 \ adapded to UrForth by Ketmar Dark
   5
   6 1001 constant nbr-digits                \ number of digit - add one, the last digit is not printed
   7 0 var pos                               \ position in the array
   8 0 var ret                               \ carry (retenue in french ;-) )
   9 nbr-digits  10 3 */ constant nbr-cells  \ initialisation on the number of cells
  10 0 var arr-cells nbr-cells cells allot
  11
  12 : initialisation ( -- ) \ initialisation of the array
  13   nbr-cells for 2 arr-cells i +cells ! endfor
  14 ;
  15
  16 : algo-base ( -- )
  17   pos @ 1 = if
  18     cell arr-cells + @ 10 * ret @ +
  19     dup
  20     10 mod arr-cells cell+ !
  21     10 / ret !
  22   else
  23     pos @ cells arr-cells + @ 10 * ret @ +
  24     2 pos @ * 1-
  25     2dup
  26     mod arr-cells pos @ +cells !
  27     / pos @ 1- * ret !
  28   endif
  29 ;
  30
  31 : release-stack  \ hold the last digit and release other digits of the stack
  32   depth 1- +if depth 1- roll 0 .r recurse endif
  33 ;
  34
  35 : release-stack+1  \ hold the last digit and release other digits of the stack + 1 modulo 10
  36   depth 1- +if depth 1- roll 1+ 10 mod 0 .r recurse endif
  37 ;
  38
  39 : set-predigit ( -- n )
  40   ret @ dup 9 < if release-stack else
  41   dup 10 = if release-stack+1 drop 0
  42   endif endif
  43 ;
  44
  45 : 1digit ( -- )  \ calculate 1 digit at the time
  46   1 nbr-cells do i pos ! algo-base -1 +loop set-predigit
  47 ;
  48
  49 : run ( -- )
  50   ret 0! initialisation
  51   nbr-digits 50 / for
  52     50 for 1digit endfor     \ 50 digits by line
  53   cr endfor
  54   drop  \ drop the last digit (value not safe)
  55 ;
  56
  57 run
  58
  59 .stack bye