\ From: "Neal Bridges" <nbridges@interlog.com>
\ Newsgroups: comp.lang.forth
\ Subject: Re: CORDIC demo
\ Date: Fri, 20 Oct 2006 01:39:13 -0400
\ Organization: Posted via Supernews, http://www.supernews.com
\ Message-ID: <12jgo837fj2hf5b@corp.supernews.com>
\ References: <2dd3f$4537c75d$94408783$19876@STARBAND.NET> <1wqshd7stlz50.k34v2nolj7z9$.dlg@40tude.net> <1161295659.375741.31030@k70g2000cwa.googlegroups.com> <1161295943.408357.78640@h48g2000cwc.googlegroups.com> <5d1e7$453806af$94408783$22956@STARBAND.NET>
\ X-Priority: 3
\ X-MSMail-Priority: Normal
\ X-Newsreader: Microsoft Outlook Express 6.00.2800.1807
\ X-MimeOLE: Produced By Microsoft MimeOLE V6.00.2800.1807
\ X-Complaints-To: abuse@supernews.com
\ Lines: 105
\ Xref: tunews.univie.ac.at comp.lang.forth:121358

\ "Noel Henson" <noel@noels-lab.com> wrote in message
\ news:5d1e7$453806af$94408783$22956@STARBAND.NET...
\ > You're both right. I /should/ have coded it correctly. I'll fix it as soon
\ > as I can.

\ Noel, I did a bit of Forthifying -- factoring and elminating variables.
\ Still more can be done; hopefully I didn't break anything in the process
\ (the examples give the same results).  Tested under both Gforth 0.6.2, and
\ RetroForth with my Standard layer.

\ CORDIC Demo for Forth
\ Supports 16-bit sines and cosines for +/-90 degrees
\
\ Number format
\  bit 15: sign
\  bit 14: integer
\  bits 13-0: fraction
\
\ Original by Noel Henson.
\ Refactored by Neal Bridges, Oct. 2006.

hex

4000 constant one

: negative? ( n -- 0 | $8000 )  8000 and ;

decimal

: array  create cells allot does> swap cells + ;

15 constant #cordic

#cordic array cordic-table

variable x
variable y
variable z
variable kk

: reciprocal ( -- )
  one  0
  #cordic 0 do
    2*  over x w@ >= if  1+  swap x w@ -  swap  then
    swap 2* swap
  loop
  swap x w@ >= if 1+ then  kk ! ;

: circle-process ( n1 n2 -- n3 )
  2dup rshift
  rot negative? if  swap  $ffff  14 rot - lshift  or  else  nip  then ;

: circle ( -- )
  #cordic 0 do
    x w@  i circle-process
    y w@  i circle-process
    i cordic-table @
    z w@ negative? 0= if  negate z +!  negate x +!  y +!
    else  z +!  x +!  negate y +!  then
  loop ;

: fill-cordic-table ( x#cordic ... x0 )  #cordic 0 do  i cordic-table !
loop ;

: init-vars ( x#cordic ... x0 -- )
  fill-cordic-table
  one x !  0 y !  0 z !  circle  reciprocal ;

hex

: init-rad ( -- )
  1 2 4 8 10 20 40 80 100 200 3ff 7f5 0fae 1dac 3244  init-vars ;
: init-deg ( -- )
  1 1 3 5 0a 14 29 51 0a3 146 28b 511 9fb 12e4 2000  init-vars ;

decimal

: sincos ( angle -- )  z !  kk @ x !  0 y !  circle x w@ y w@ ;

: sin ( angle -- magnitude )  sincos nip ;
: cos ( angle -- magnitude )  sincos drop ;
: tan ( angle -- tangent )  sincos one * swap /  ;
: deg ( angle -- binangle )  one 90 */ ;

: deg10ths ( angle -- binangle )  one 900 */ ;

: .frac ( fraction_of_one -- )  10000 one */ . ;

\ init-rad  \ for radians angle*one/(pi/2)
init-deg  \ for degrees angle*one/90

\ examples
cr
45 cr dup . deg sin .frac
105 cr dup . deg10ths sin .frac \ sin for 10.5
30 cr dup . deg cos .frac
554 cr dup . deg10ths cos .frac \ cos for 55.4
30 cr dup . deg tan .frac
cr

\ -- 
\ Neal Bridges
\ http://quartus.net  Home of Quartus Forth for the Palm OS!