MSP430-FORTH/CORDIC.f

   1 \ -*- coding: utf-8 -*-
   2 \ see CORDICforDummies.pdf
   3 \
   4 \ to see kernel options, download FastForthSpecs.f
   5 \ FastForth kernel options: MSP430ASSEMBLER, CONDCOMP, FIXPOINT_INPUT
   6 \
   7 \
   8 \ TARGET SELECTION ( = the name of \INC\target.pat file without the extension)
   9 \ LP_MSP430FR2476
  10 \ MSP_EXP430FR5739  MSP_EXP430FR5969    MSP_EXP430FR5994    MSP_EXP430FR6989
  11 \ MSP_EXP430FR2433  CHIPSTICK_FR2433    MSP_EXP430FR2355
  12 \
  13 \ from scite editor : copy your target selection in (shift+F8) parameter 1:
  14 \
  15 \ OR
  16 \
  17 \ drag and drop this file onto SendSourceFileToTarget.bat
  18 \ then select your TARGET when asked.
  19 \
  20 \
  21 \ REGISTERS USAGE
  22 \ rDODOES to rEXIT must be saved before use and restored after
  23 \ scratch registers Y to S are free for use
  24 \ under interrupt, IP is free for use
  25 \
  26 \ PUSHM order : PSP,TOS, IP,  S,  T,  W,  X,  Y, rEXIT, rDOVAR, rDOCON, rDODOES
  27 \ example : PUSHM #6,IP pushes IP,S,T,W,X,Y registers to return stack
  28 \
  29 \ POPM  order :  rDODOES, rDOCON, rDOVAR, rEXIT,  Y,  X,  W,  T,  S, IP,TOS,PSP
  30 \ example : POPM #6,IP   pulls Y,X,W,T,S,IP registers from return stack
  31 \
  32 \ FORTH conditionnals:  unary{ 0= 0< 0> }, binary{ = < > U< }
  33 \
  34 \ ASSEMBLER conditionnal usage with IF UNTIL WHILE  S<  S>=  U<   U>=  0=  0<>  0>=
  35 \ ASSEMBLER conditionnal usage with ?JMP ?GOTO      S<  S>=  U<   U>=  0=  0<>  0<
  36
  37 CODE ABORT_CORDIC
  38 SUB #4,PSP
  39 MOV TOS,2(PSP)
  40 MOV &KERNEL_ADDON,TOS
  41 BIT #BIT10,TOS
  42 0<> IF MOV #0,TOS THEN  \ if TOS <> 0 (FIXPOINT input), set TOS = 0
  43 MOV TOS,0(PSP)
  44 MOV &VERSION,TOS
  45 SUB #308,TOS            \ FastForth V3.8
  46 COLON
  47 $0D EMIT    \ return to column 1 without CR
  48 ABORT" FastForth V3.8 please!"
  49 ABORT" build FastForth with FIXPOINT_INPUT addon !"
  50 PWR_STATE           \ if no abort remove this word
  51 ;
  52
  53 ABORT_CORDIC
  54
  55 ; ----------
  56 ; CORDIC.f
  57 ; ----------
  58
  59 [DEFINED] {CORDIC} [IF] {CORDIC} [THEN]
  60
  61 MARKER {CORDIC}
  62
  63
  64 \ CORDIC USES
  65 \   OPERATION   |   MODE    |   INITIALIZE x y z    |   DIRECTION   |     RESULT        | post operation
  66 \ --------------|-----------|-----------------------|---------------|-------------------|
  67 \ sine, cosine  | Rotation  | x=1, y=0,  z=angle    | Reduce z to 0 | cos=x*Gi,sin=y*Gi | mutiply by 1/Gi
  68 \ --------------|-----------|-----------------------|---------------|-------------------|
  69 \ Polar to Rect | Rotation  | x=magnit, y=0, Z=angle| Reduce z to 0 |  X=x*Gi, Y=y*Gi   | mutiply by 1/Gi
  70 \ --------------|-----------|-----------------------|---------------|-------------------|
  71 \ Rotation      | Rotation  | x=X, y=Y, z=angle     | Reduce z to 0 | X'=x*Gi,Y'=y*Gi   | <=== not implemented
  72 \ --------------|-----------|-----------------------|---------------|-------------------|
  73 \ Rect to Polar |  Vector   | x=X, y=Y, z=0         | Reduce y to 0 | hyp=x*Gi, angle=z | mutiply hyp by 1/Gi
  74 \ --------------|-----------|-----------------------|---------------|-------------------|
  75 \ Gi = CORDIC gain for i iterations; Gi < 1
  76 \
  77
  78 CREATE T_ARCTAN \ ArcTan table
  79 12870 ,         \ 286 * 45      =
  80 7598 ,          \ 286 * 26.565  = 7597,605
  81 4014 ,          \ 286 * 14.036  = 4014,366
  82 2038 ,          \ 286 * 7.125   = 2037,755
  83 1023 ,          \ 286 * 3.576   = 1022,832
  84 512 ,           \ 286 * 1.790   = 511,914
  85 256 ,           \ 286 * 0.895   = 256,020
  86 128 ,           \ 286 * 0.448   = 128,017
  87 64 ,            \ 286 * 0.224   = 64,010
  88 32 ,            \ 286 * 0.112   = 32,005
  89 16 ,            \ 286 * 0.056   = 16,0025
  90 8 ,             \ 286 * 0.028   = 8,00126
  91 4 ,             \ 286 * 0.014   = 4
  92 2 ,             \ 286 * 0.007   = 2
  93 1 ,             \ 286 * 0.003   = 1
  94
  95 CREATE T_SCALE  \ 1/Gi table
  96 46340 ,         \ = 65536 * cos(45)
  97 41448 ,         \ = 65536 * cos(45) * cos(26.565)
  98 40211 ,         \ = 65536 * cos(45) * cos(26.565) * cos(14.036)
  99 39900 ,         \ = 65536 * cos(45) * cos(26.565) * cos(14.036) * ...
 100 39822 ,
 101 39803 ,
 102 39798 ,
 103 39797 ,
 104 39797 ,
 105 39797 ,
 106 39797 ,
 107 39797 ,
 108 39797 ,
 109 39797 ,
 110 39797 ,
 111
 112 [UNDEFINED] = [IF]
 113 \ https://forth-standard.org/standard/core/Equal
 114 \ =      x1 x2 -- flag         test x1=x2
 115 CODE =
 116 SUB @PSP+,TOS   \ 2
 117 0<> IF          \ 2
 118     AND #0,TOS  \ 1
 119     MOV @IP+,PC \ 4
 120 THEN
 121 XOR #-1,TOS     \ 1 flag Z = 1
 122 MOV @IP+,PC     \ 4
 123 ENDCODE
 124 [THEN]
 125
 126 \ https://forth-standard.org/standard/core/Uless
 127 \ U<    u1 u2 -- flag       test u1<u2, unsigned
 128 [UNDEFINED] U< [IF]
 129 CODE U<
 130 SUB @PSP+,TOS   \ 2 u2-u1
 131 0<> IF
 132     MOV #-1,TOS     \ 1
 133     U< IF           \ 2 flag
 134         AND #0,TOS  \ 1 flag Z = 1
 135     THEN
 136 THEN
 137 MOV @IP+,PC     \ 4
 138 ENDCODE
 139 [THEN]
 140
 141 [UNDEFINED] DABS [IF]
 142 \ https://forth-standard.org/standard/double/DABS
 143 \ DABS     d1 -- |d1|     absolute value
 144 CODE DABS
 145 AND #-1,TOS         \ clear V, set N
 146 S< IF               \
 147     XOR #-1,0(PSP)  \ 4
 148     XOR #-1,TOS     \ 1
 149     ADD #1,0(PSP)   \ 4
 150     ADDC #0,TOS     \ 1
 151 THEN
 152 MOV @IP+,PC
 153 ENDCODE
 154 [THEN]
 155
 156 [UNDEFINED] R> [IF]
 157 \ https://forth-standard.org/standard/core/Rfrom
 158 \ R>    -- x    R: x --   pop from return stack ; CALL #RFROM performs DOVAR
 159 CODE R>
 160 SUB #2,PSP      \ 1
 161 MOV TOS,0(PSP)  \ 3
 162 MOV @RSP+,TOS   \ 2
 163 MOV @IP+,PC     \ 4
 164 ENDCODE
 165 [THEN]
 166
 167 [UNDEFINED] HOLDS [IF]
 168 \ https://forth-standard.org/standard/core/HOLDS
 169 \ Adds the string represented by addr u to the pictured numeric output string
 170 \ compilation use: <# S" string" HOLDS #>
 171 \ free chars area in the 32+2 bytes HOLD buffer = {26,23,2} chars with a 32 bits sized {hexa,decimal,binary} number.
 172 \ (2 supplementary bytes are room for sign - and decimal point)
 173 \ C HOLDS    addr u --
 174 CODE HOLDS
 175             MOV @PSP+,X         \ 2     X=src
 176 BW3         ADD TOS,X           \ 1     X=src_end
 177             MOV &HP,Y           \ 3     Y=dst
 178 BEGIN       SUB #1,X            \ 1     src-1
 179             SUB #1,TOS          \ 1     cnt-1
 180 U>= WHILE   SUB #1,Y            \ 1     dst-1
 181             MOV.B @X,0(Y)       \ 4
 182 REPEAT      MOV Y,&HP           \ 3
 183             MOV @PSP+,TOS       \ 2
 184             MOV @IP+,PC         \ 4  15 words
 185 ENDCODE
 186 [THEN]
 187
 188 $81EF DEVICEID @ U<
 189 DEVICEID @ $81F3 U<
 190 = [IF]   ; MSP430FR413x subfamily without hardware_MPY
 191
 192 [UNDEFINED] F#S [IF]
 193 \ F#S    Qlo Qhi len -- Qhi 0   convert fractional part Qlo of Q15.16 fixed point number
 194 \                               with len digits
 195 CODE F#S
 196             MOV @PSP,S          \ -- Qlo Qhi len        S = Qhi
 197             MOV #0,T            \                       T = count
 198             PUSHM #3,IP         \                       R-- IP Qhi count
 199             MOV 2(PSP),0(PSP)   \ -- Qlo Qlo len
 200             MOV TOS,2(PSP)      \ -- len Qlo len
 201 BEGIN       MOV &BASEADR,TOS    \ -- len Qlo base
 202             LO2HI
 203             UM*                 \                       u1 u2 -- RESlo REShi
 204             HI2LO               \ -- len RESlo digit
 205             CMP #10,TOS         \                       digit to char
 206     U>= IF  ADD #7,TOS
 207     THEN    ADD #$30,TOS        \ -- len RESlo char
 208             MOV @RSP,T          \                       T=count
 209             MOV.B TOS,HOLDS_ORG(T)  \                   char to string_org(T)
 210             ADD #1,T            \                       count+1
 211             MOV T,0(RSP)        \
 212             CMP 2(PSP),T        \ -- len RESlo char     count=len ?
 213 U>= UNTIL   POPM #3,IP          \                       S=Qhi, T=len
 214             MOV T,TOS           \ -- len RESlo len
 215             MOV S,2(PSP)        \ -- Qhi RESlo len
 216             MOV #0,0(PSP)       \ -- Qhi 0 len
 217             MOV #HOLDS_ORG,X    \ -- Qhi 0 len          X=HOLDS_ORG
 218             GOTO BW3            \ 36~ JMP HOLDS
 219 ENDCODE
 220 [THEN]
 221
 222 HDNCODE XSCALE              \ X --> X*Cordic_Gain
 223 \ T.I. UNSIGNED MULTIPLY SUBROUTINE: U1 x U2 -> Ud
 224 \ https://forth-standard.org/standard/core/UMTimes
 225 \ UM*     u1 u2 -- ud   unsigned 16x16->32 mult.
 226             MOV T_SCALE(W),rDOCON   \ rDOCON=MR, X=MDlo
 227 UMSTAR1     MOV #0,Y                \ 1 MDhi=0
 228             MOV #0,S                \ 1 RES0=0
 229             MOV #0,T                \ 1 RES1=0
 230             MOV #1,W                \ 1 BIT TEST REGISTER
 231 BEGIN       BIT W,rDOCON            \ 1 TEST ACTUAL BIT MRlo
 232     0<> IF  ADD X,S                 \ 1 IF 1: ADD MDlo TO RES0
 233             ADDC Y,T                \ 1      ADDC MDhi TO RES1
 234     THEN    ADD X,X                 \ 1 (RLA LSBs) MDlo x 2
 235             ADDC Y,Y                \ 1 (RLC MSBs) MDhi x 2
 236             ADD W,W                 \ 1 (RLA) NEXT BIT TO TEST
 237 U>= UNTIL                           \ S = RESlo, T=REShi
 238             MOV T,X                 \ 2 IF BIT IN CARRY: FINISHED    10~ loop
 239             MOV #XDOCON,rDOCON      \ restore rDOCON
 240             MOV @RSP+,PC            \ RET
 241 ENDCODE
 242
 243 [ELSE] ; hardware multiplier
 244
 245 [UNDEFINED] F#S [IF]
 246 \ F#S    Qlo Qhi u -- Qhi 0   convert fractionnal part of Q15.16 fixed point number
 247 \                             with u digits
 248 CODE F#S
 249             MOV 2(PSP),X        \ -- Qlo Qhi u      X = Qlo
 250             MOV @PSP,2(PSP)     \ -- Qhi Qhi u
 251             MOV X,0(PSP)        \ -- Qhi Qlo u
 252             MOV TOS,T           \                   T = len
 253             MOV #0,S            \                   S = count
 254 BEGIN       MOV @PSP,&MPY       \                   Load 1st operand
 255             MOV &BASEADR,&OP2   \                   Load 2nd operand
 256             MOV &RES0,0(PSP)    \ -- Qhi RESlo x        low result on stack
 257             MOV &RES1,TOS       \ -- Qhi RESlo REShi    high result in TOS
 258             CMP #10,TOS         \                   digit to char
 259     U>= IF  ADD #7,TOS
 260     THEN    ADD #$30,TOS
 261             MOV.B TOS,HOLDS_ORG(S)  \ -- Qhi RESlo char     char to string
 262             ADD #1,S            \                   count+1
 263             CMP T,S             \                   count=len ?
 264 0= UNTIL    MOV T,TOS           \ -- len RESlo len
 265             MOV #0,0(PSP)       \ -- Qhi 0 len
 266             MOV #HOLDS_ORG,X    \ -- Qhi 0 len          X=HOLDS_ORG
 267             GOTO BW3            \ 35~ JMP HOLDS+2
 268 ENDCODE
 269 [THEN]
 270
 271 HDNCODE XSCALE              \ X = X*Cordic_Gain
 272 MOV T_SCALE(W),&MPYS32L     \ 3     CORDIC Gain * 65536
 273 MOV #0,&MPYS32H
 274 MOV X,&OP2                  \ 3     Load 1st operand
 275 MOV &RES1,X                 \ 3     hi result
 276 MOV @RSP+,PC                \ RET
 277 ENDCODE
 278
 279 [THEN]  ; end of hardware multiplier
 280
 281 CODE POL2REC   \ u F -- X Y
 282 \ input ; u = module {1000...16384}, F = angle (15Q16 number) in degrees {-89,9...89,9}
 283 \ output ; X Y
 284 \ TOS = Fhi, 0(PSP) = Flo, 2(PSP) = u
 285 PUSH IP             \ save IP before use
 286 MOV @PSP+,&MPY32L     \ multiply angle by 286
 287 MOV TOS,&MPY32H
 288 MOV #286,&OP2
 289 MOV &RES0,Y
 290 MOV &RES1,TOS       \ -- module angle*286
 291 \ =====================
 292 \ CORDIC 16 bits engine
 293 \ =====================
 294 MOV #-1,IP          \ IP = i-1
 295 MOV @PSP,X          \ X = Xi
 296 MOV #0,Y            \ Y = Yi
 297 BEGIN               \ i loops with init i = -1
 298     ADD #1,IP       \ i = i+1
 299     MOV X,S         \ S = Xi to be right shifted
 300     MOV Y,T         \ T = Yi to be right shifted
 301     MOV #0,W        \
 302     GOTO FW1
 303     BEGIN
 304         RRA S       \ (Xi >> 1)
 305         RRA T       \ (Yi >> 1)
 306         ADD #1,W
 307 FW1     CMP IP,W    \ W = i ?
 308     0= UNTIL        \ loop back if W < i
 309     ADD W,W         \ W = 2i = T_SCALE displacement
 310     CMP #0,TOS      \ TOS = z
 311     0>= IF          \ TOS >= 0 : Rotate clockwise
 312         SUB T,X     \ Xi+1 = Xi - ( Yi >> i)
 313         ADD S,Y     \ Yi+1 = Yi + ( Xi >> i)
 314         SUB T_ARCTAN(W),TOS
 315     ELSE            \ TOS < 0 : Rotate counter-clockwise
 316         ADD T,X     \ Xi+1 = Xi + ( Yi >> i)
 317         SUB S,Y     \ Yi+1 = Yi - ( Xi >> i)
 318         ADD T_ARCTAN(W),TOS
 319     THEN
 320     CMP #0,TOS      \ if angle*256 = 0 quit loop
 321     0<> WHILE       \ search "Extended control-flow patterns" in https://forth-standard.org/standard/rationale
 322         CMP #14,IP  \ IP = size of ARC_TAN table ?
 323 0= UNTIL
 324     THEN            \ search "Extended control-flow patterns" in https://forth-standard.org/standard/rationale
 325 \ multiply cos by factor scale
 326 CALL #XSCALE
 327 MOV X,0(PSP)        \ 3     hi result = cos
 328 \ multiply sin by factor scale
 329 MOV Y,X             \ 3
 330 CALL #XSCALE
 331 MOV X,TOS           \ 3     hi result = sin
 332 \ ==================
 333 \ endof CORDIC engine   \ X = cos, Y = sin
 334 \ ==================
 335 MOV @RSP+,IP
 336 MOV @IP+,PC
 337 ENDCODE                 \ -- cos sin
 338
 339
 340 \ REC2POL version with inputs scaling, to increase the accuracy of the angle:
 341 \ REC2POL   X Y -- u f
 342 \ input : X < 16384, Y < 16384
 343 \ output ; u = hypothenuse, f = angle (15Q16 number) in degrees
 344 \ rounded hypothenuse, 1 mn accuracy angle
 345 CODE REC2POL        \ X Y -- u f
 346 MOV @PSP,X          \ X = Xi
 347 MOV TOS,Y           \ Y = Yi
 348 \ normalize X Y to 16384 maxi
 349 \ 1- calculate T = |Y|
 350 MOV Y,T
 351 CMP #0,T
 352 S< IF
 353     XOR #-1,T
 354     ADD #1,T
 355 THEN
 356 \ 2- calculate S = |X|
 357 MOV X,S
 358 CMP #0,S
 359 S< IF
 360     XOR #-1,S
 361     ADD #1,S
 362 THEN
 363 \ 3- abort if null inputs
 364 MOV #-1,TOS \ set TOS TRUE for the two ABORT" below
 365 CMP #0,X
 366 0= IF
 367     CMP #0,Y
 368     0= IF
 369         LO2HI
 370             ABORT" null inputs!"
 371         HI2LO
 372     THEN
 373 THEN
 374 \ 4- select max of |X|,|Y|
 375 CMP S,T
 376 U< IF       \ |X| > |Y|
 377     MOV S,T
 378 THEN
 379 \ 5- abort if |X| or |Y| >= 16384
 380 CMP #16384,T
 381     U>= IF
 382     LO2HI
 383         ABORT" |x| or |y| >= 16384"
 384     HI2LO
 385     THEN
 386 \ 6- multiply inputs by 2^n scale factor
 387 MOV #1,S        \ init scale factor
 388 RLAM #3,T       \ test bit 2^13 of max(X,Y)
 389 GOTO FW1
 390 BEGIN
 391     ADD X,X     \ X=X*2
 392     ADD Y,Y     \ Y=Y*2
 393     ADD S,S     \ scale factor *2
 394     ADD T,T     \ to test next bit 2^(n-1)
 395 FW1
 396 U>= UNTIL       \ until carry set
 397 \ 7- save IP and scale factor n
 398 PUSHM #2,IP     \ push IP,S
 399 \ ==================
 400 \ CORDIC engine
 401 \ ==================
 402 MOV #-1,IP          \ IP = i-1, X = Xi, Y = Yi
 403 MOV #0,TOS          \ init z=0
 404  BEGIN              \ i loops with init: i = -1
 405     ADD #1,IP       \ i = i+1
 406     MOV X,S         \ S = Xi to be right shifted
 407     MOV Y,T         \ T = Yi to be right shifted
 408     MOV #0,W        \ W = right shift loop count
 409     GOTO FW1
 410     BEGIN
 411         RRA S       \ (X >> i)
 412         RRA T       \ (Y >> i)
 413         ADD #1,W    \
 414 FW1     CMP IP,W    \ W = i ?
 415     0= UNTIL        \ 6~ loop
 416     ADD W,W         \ W = 2i = T_SCALE displacement
 417     CMP #0,Y        \ Y sign ?
 418     S>= IF          \ Y >= 0 : Rotate counter-clockwise
 419         ADD T,X     \ Xi+1 = Xi + ( Yi >> i)
 420         SUB S,Y     \ Yi+1 = Yi - ( Xi >> i)
 421         ADD T_ARCTAN(W),TOS
 422     ELSE            \ Y < 0 : Rotate clockwise
 423         SUB T,X     \ Xi+1 = Xi - ( Yi >> i)
 424         ADD S,Y     \ Yi+1 = Yi + ( Xi >> i)
 425         SUB T_ARCTAN(W),TOS
 426     THEN
 427     CMP #0,Y        \
 428     0<> WHILE       \ if Y = 0 quit loop ---+
 429     CMP #14,IP      \                       |
 430  0= UNTIL           \                       |
 431     THEN            \ <---------------------+
 432 \ multiply x by CORDIC gain
 433 CALL #XSCALE             \ 3     hi result = hypothenuse
 434 \ ==================
 435 \ endof CORDIC engine   \ X = hypothenuse, TOS = 256*angle
 436 \ ==================
 437 \ divide x by scale factor
 438 POPM #2,IP              \ S = scale factor, restore IP
 439 GOTO FW1
 440 BEGIN                   \ 4~ loop
 441     RRA X               \ divide x by 2
 442 FW1 RRA S               \ shift right scale factor
 443 U>= UNTIL               \ until carry set
 444 MOV X,0(PSP)
 445
 446 \ divide z by 286 to display it as a Q15.16 number
 447 SUB #4,PSP              \ -- X * * Zhi
 448 MOV TOS,rDOCON          \ -- rDOCON as sign of QUOT
 449 CMP #0,rDOCON
 450 S< IF
 451     XOR #-1,TOS
 452     ADD #1,TOS
 453 THEN
 454 MOV #0,2(PSP)           \ -- X Zlo * Zhi
 455 MOV TOS,0(PSP)          \ -- X Zlo Zhi Zhi
 456 MOV #286,TOS            \ -- X Zlo Zhi DIV
 457 CALL #MUSMOD            \ -- X rem QUOTlo QUOThi
 458 MOV @PSP+,0(PSP)        \    remove remainder
 459 CMP #0,rDOCON
 460 S< IF
 461     XOR #-1,0(PSP)
 462     XOR #-1,TOS
 463     ADD #1,0(PSP)
 464     ADDC #0,TOS
 465 THEN
 466 MOV #XDOCON,rDOCON
 467 MOV @IP+,PC
 468 ENDCODE
 469
 470
 471 [UNDEFINED] F. [IF]
 472 CODE F.             \ display a Q15.16 number with 4/5/16 digits after comma
 473 MOV TOS,S           \ S = sign
 474 MOV #4,T            \ T = 4     preset 4 digits for base 16 and by default
 475 MOV &BASEADR,W
 476 CMP ##10,W
 477 0= IF               \           if base 10
 478     ADD #1,T        \ T = 5     set 5 digits
 479 ELSE
 480     CMP #%10,W
 481     0= IF           \           if base 2
 482         MOV #16,T   \ T = 16    set 16 digits
 483     THEN
 484 THEN
 485 PUSHM #3,IP         \                   R-- IP sign #digit
 486 LO2HI
 487     <# DABS         \ -- uQlo uQhi      R-- IP sign #digit
 488     R> F#S          \ -- uQhi 0         R-- IP sign
 489     $2C HOLD        \                   $2C = char ','
 490     #S              \ -- 0 0
 491     R> SIGN #>      \ -- addr len       R-- IP
 492     TYPE $20 EMIT   \ --
 493 ;
 494
 495 [THEN]
 496
 497 PWR_HERE
 498
 499 [UNDEFINED] SWAP [IF]
 500 \ https://forth-standard.org/standard/core/SWAP
 501 \ SWAP     x1 x2 -- x2 x1    swap top two items
 502 CODE SWAP
 503 MOV @PSP,W      \ 2
 504 MOV TOS,0(PSP)  \ 3
 505 MOV W,TOS       \ 1
 506 MOV @IP+,PC     \ 4
 507 ENDCODE
 508 [THEN]
 509
 510 ECHO
 511
 512 [UNDEFINED] ROT [IF] \
 513 \ https://forth-standard.org/standard/core/ROT
 514 \ ROT    x1 x2 x3 -- x2 x3 x1
 515 CODE ROT
 516 MOV @PSP,W          \ 2 fetch x2
 517 MOV TOS,0(PSP)      \ 3 store x3
 518 MOV 2(PSP),TOS      \ 3 fetch x1
 519 MOV W,2(PSP)        \ 3 store x2
 520 MOV @IP+,PC
 521 ENDCODE
 522 [THEN]
 523
 524 ; -----------------------------------------------------------
 525 ; requires FIXPOINT_INPUT kernel addon, see forthMSP430FR.asm
 526 ; -----------------------------------------------------------
 527
 528
 529 10000 89,0 POL2REC . .  ; sin, cos -->
 530 10000 75,0 POL2REC . .  ; sin, cos -->
 531 10000 60,0 POL2REC . .  ; sin, cos -->
 532 10000 45,0 POL2REC . .  ; sin, cos -->
 533 10000 30,0 POL2REC . .  ; sin, cos -->
 534 10000 15,0 POL2REC . .  ; sin, cos -->
 535 10000 1,0 POL2REC . .   ; sin, cos -->
 536 \ module phase -- X Y
 537 16384 30,0 POL2REC SWAP . . ; x, y -->
 538 16384 45,0 POL2REC SWAP . . ; x, y -->
 539 16384 60,0 POL2REC SWAP . . ; x, y -->
 540
 541 \
 542 10000 -89,0 POL2REC . .  ; sin, cos -->
 543 10000 -75,0 POL2REC . .  ; sin, cos -->
 544 10000 -60,0 POL2REC . .  ; sin, cos -->
 545 10000 -45,0 POL2REC . .  ; sin, cos -->
 546 10000 -30,0 POL2REC . .  ; sin, cos -->
 547 10000 -15,0 POL2REC . .  ; sin, cos -->
 548 10000 -1,0 POL2REC . .   ; sin, cos -->
 549 \ module phase -- X Y
 550 16384 -30,0 POL2REC SWAP . . ; x, y -->
 551 16384 -45,0 POL2REC SWAP . . ; x, y -->
 552 16384 -60,0 POL2REC SWAP . . ; x, y -->
 553
 554 \
 555 -10000 89,0 POL2REC . .  ; sin, cos -->
 556 -10000 75,0 POL2REC . .  ; sin, cos -->
 557 -10000 60,0 POL2REC . .  ; sin, cos -->
 558 -10000 45,0 POL2REC . .  ; sin, cos -->
 559 -10000 30,0 POL2REC . .  ; sin, cos -->
 560 -10000 15,0 POL2REC . .  ; sin, cos -->
 561 -10000 1,0 POL2REC . .   ; sin, cos -->
 562 \ module phase -- X Y
 563 -16384 30,0 POL2REC SWAP . . ; x, y -->
 564 -16384 45,0 POL2REC SWAP . . ; x, y -->
 565 -16384 60,0 POL2REC SWAP . . ; x, y -->
 566 \
 567
 568 -10000 -89,0 POL2REC . .  ; sin, cos -->
 569 -10000 -75,0 POL2REC . .  ; sin, cos -->
 570 -10000 -60,0 POL2REC . .  ; sin, cos -->
 571 -10000 -45,0 POL2REC . .  ; sin, cos -->
 572 -10000 -30,0 POL2REC . .  ; sin, cos -->
 573 -10000 -15,0 POL2REC . .  ; sin, cos -->
 574 -10000 -1,0 POL2REC . .   ; sin, cos -->
 575 \ module phase -- X Y
 576 -16384 -30,0 POL2REC SWAP . . ; x, y -->
 577 -16384 -45,0 POL2REC SWAP . . ; x, y -->
 578 -16384 -60,0 POL2REC SWAP . . ; x, y -->
 579 \
 580
 581
 582 2  1  REC2POL F. .          ; phase module -->
 583 2 -1  REC2POL F. .          ; phase module -->
 584 20  10  REC2POL F. .        ; phase module -->
 585 20 -10  REC2POL F. .        ; phase module -->
 586 200 100 REC2POL F. .        ; phase module -->
 587 100 -100 REC2POL F. .       ; phase module -->
 588 2000 1000 REC2POL F. .      ; phase module -->
 589 1000 -1000 REC2POL F. .     ; phase module -->
 590 16000 8000 REC2POL F. .     ; phase module -->
 591 16000 -8000 REC2POL F. .    ; phase module -->
 592 16000 0 REC2POL F. .        ; phase module -->
 593 0 16000 REC2POL F. .        ; phase module -->
 594 \ 16384 -8192 REC2POL F. .    ; --> abort
 595 \ 0 0 REC2POL F. .            ; --> abort
 596
 597 -2  1  REC2POL F. .          ; phase module -->
 598 -2 -1  REC2POL F. .          ; phase module -->
 599 -20  10  REC2POL F. .        ; phase module -->
 600 -20 -10  REC2POL F. .        ; phase module -->
 601 -200 100 REC2POL F. .        ; phase module -->
 602 -100 -100 REC2POL F. .       ; phase module -->
 603 -2000 1000 REC2POL F. .      ; phase module -->
 604 -1000 -1000 REC2POL F. .     ; phase module -->
 605 -16000 8000 REC2POL F. .     ; phase module -->
 606 -16000 -8000 REC2POL F. .    ; phase module -->
 607 16000 0 REC2POL F. .        ; phase module -->
 608 0 16000 REC2POL F. .        ; phase module -->
 609 \ 16384 -8192 REC2POL F. .    ; --> abort
 610 \ 0 0 REC2POL F. .            ; --> abort
 611
 612 10000 89,0 POL2REC REC2POL   ROT . F.
 613 10000 75,0 POL2REC REC2POL   ROT . F.
 614 10000 60,0 POL2REC REC2POL   ROT . F.
 615 10000 45,0 POL2REC REC2POL   ROT . F.
 616 10000 30,0 POL2REC REC2POL   ROT . F.
 617 10000 26,565 POL2REC REC2POL ROT . F.
 618 10000 15,0 POL2REC REC2POL   ROT . F.
 619 10000 14,036 POL2REC REC2POL ROT . F.
 620 10000 7,125 POL2REC REC2POL  ROT . F.
 621 10000 1,0 POL2REC REC2POL    ROT . F.
 622
 623