\ 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[]

40 constant /input
create input  /input chars allot

: get-float ( F: -- r )
  input dup /input accept  >float 0= abort" Invalid input" ;

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

: .test ( F: r -- )  fdup 400e f> if  ." TOO LARGE" fdrop  else  f.  then cr ;

: tpk ( -- )
  11 0 do  i .  get-float  i A[] f!  cr  loop
  0 10 do  i .  i A[] f@  f  .test  -1 +loop ;