TPK

\ tpk.fs:  Knuth's TPK program in ISO/ANS Standard Forth (compiled by Gforth 0.6.2)

: farray ( u "name" -- )
  create floats allot  does> ( i -- f-addr )  swap floats + ;

10 farray A[]

80 constant /input
create input  /input chars allot

: getfloat ( F: -- r )
  begin
    input dup /input accept  >float 0= while
      ." Invalid input, please re-enter:" cr
  repeat ;

: f ( F: r1 -- r2 )
\  f(x) = sqrt(|x|) + 5*x**3
  fdup fabs fsqrt  fswap  3e f** 5e f*  f+ ;

: tpk ( -- )
  11 0 do  i . getfloat i A[] f! cr  loop  cr
  0 10 do  i A[] f@ f
    fdup 400e f> if  i . ."  too large"  fdrop  else  i . f.  then  cr
  -1 +loop ;