MSP430-FORTH/FixPoint.f

   1 \ -*- coding: utf-8 -*-
   2 \
   3 \ to see kernel options, download FastForthSpecs.f
   4 \ FastForth kernel options: MSP430ASSEMBLER, CONDCOMP, FIXPOINT_INPUT
   5 \
   6 \ TARGET SELECTION ( = the name of \INC\target.pat file without the extension)
   7 \ MSP_EXP430FR5739  MSP_EXP430FR5969    MSP_EXP430FR5994    MSP_EXP430FR6989
   8 \ MSP_EXP430FR2433  MSP_EXP430FR4133    CHIPSTICK_FR2433    MSP_EXP430FR2355
   9 \ LP_MSP430FR2476
  10 \
  11 \ from scite editor : copy your target selection in (shift+F8) parameter 1:
  12 \
  13 \ OR
  14 \
  15 \ drag and drop this file onto SendSourceFileToTarget.bat
  16 \ then select your TARGET when asked.
  17 \
  18 \
  19 \ REGISTERS USAGE
  20 \ rDODOES to rEXIT must be saved before use and restored after
  21 \ scratch registers Y to S are free for use
  22 \ under interrupt, IP is free for use
  23 \
  24 \ PUSHM order : PSP,TOS, IP,  S,  T,  W,  X,  Y, rEXIT,rDOVAR,rDOCON, rDODOES, R3, SR,RSP, PC
  25 \ PUSHM order : PSP,TOS,IP,S,T,W, X, Y,  rDOCOL  ,  rDOVAR  ,  rDOCON  ,   rDODOES   , R3, SR, RSP, PC
  26 \
  27 \ example : PUSHM #6,IP pushes IP,S,T,W,X,Y registers to return stack
  28 \
  29 \ POPM  order :  PC,RSP, SR, R3, rDODOES,rDOCON,rDOVAR,rEXIT,  Y,  X,  W,  T,  S, IP,TOS,PSP
  30 \ POPM  order :  PC, RSP, SR, R3,   rDODOES   ,  rDOCON  ,  rDOVAR  ,  rDOCOL , Y, X,W,T,S,IP,TOS,PSP
  31 \
  32 \ example : POPM #6,IP   pop Y,X,W,T,S,IP registers from return stack
  33 \
  34 \ FORTH conditionnals:  unary{ 0= 0< 0> }, binary{ = < > U< }
  35 \
  36 \ ASSEMBLER conditionnal usage with IF UNTIL WHILE  S<  S>=  U<   U>=  0=  0<>  0>=
  37 \ ASSEMBLER conditionnal usage with ?JMP ?GOTO      S<  S>=  U<   U>=  0=  0<>  0<
  38 \
  39
  40 ; -----------------------------------------------------
  41 ; FIXPOINT.f
  42 ; -----------------------------------------------------
  43
  44     CODE ABORT_FIXPOINT
  45     SUB #4,PSP
  46     MOV TOS,2(PSP)
  47     MOV &KERNEL_ADDON,TOS
  48     BIT #BIT8,TOS
  49     0<> IF MOV #0,TOS THEN  \ if TOS <> 0 (FIXPOINT input), set TOS = 0
  50     MOV TOS,0(PSP)
  51     MOV &VERSION,TOS
  52     SUB #401,TOS            \ FastForth V4.1
  53     COLON
  54     $0D EMIT                \ return to column 1 without CR
  55     ABORT" FastForth V4.1 please!"
  56     ABORT" build FastForth with Q15.16_INPUT addon !"
  57     RST_RET                 \ if no abort remove this word
  58     $1B EMIT $63 EMIT       \ send 'ESC c' (clear screen)
  59     ;
  60
  61     ABORT_FIXPOINT
  62
  63     [DEFINED] {FIXPOINT}
  64     [IF] {FIXPOINT}
  65     [THEN]
  66     [UNDEFINED] {FIXPOINT}
  67     [IF]
  68     MARKER {FIXPOINT}
  69
  70 ; ------------------------------------------------------------------
  71 ; first we download the set of definitions we need (from CORE_ANS.f)
  72 ; ------------------------------------------------------------------
  73
  74     [UNDEFINED] + [IF]
  75 \ https://forth-standard.org/standard/core/Plus
  76 \ +       n1/u1 n2/u2 -- n3/u3     add n1+n2
  77     CODE +
  78     ADD @PSP+,TOS
  79     MOV @IP+,PC
  80     ENDCODE
  81     [THEN]
  82
  83     [UNDEFINED] R> [IF]
  84 \ https://forth-standard.org/standard/core/Rfrom
  85 \ R>    -- x    R: x --   pop from return stack ; CALL #RFROM performs DOVAR
  86     CODE R>
  87     SUB #2,PSP      \ 1
  88     MOV TOS,0(PSP)  \ 3
  89     MOV @RSP+,TOS   \ 2
  90     MOV @IP+,PC     \ 4
  91     ENDCODE
  92     [THEN]
  93
  94     [UNDEFINED] = [IF]
  95 \ https://forth-standard.org/standard/core/Equal
  96 \ =      x1 x2 -- flag         test x1=x2
  97     CODE =
  98     SUB @PSP+,TOS   \ 2
  99     0<> IF          \ 2
 100         AND #0,TOS  \ 1
 101         MOV @IP+,PC \ 4
 102     THEN
 103     XOR #-1,TOS     \ 1 flag Z = 1
 104     MOV @IP+,PC     \ 4
 105     ENDCODE
 106     [THEN]
 107
 108     [UNDEFINED] U< [IF]
 109 \ https://forth-standard.org/standard/core/Uless
 110 \ U<    u1 u2 -- flag       test u1<u2, unsigned
 111     CODE U<
 112     SUB @PSP+,TOS   \ 2 u2-u1
 113     0<> IF
 114         MOV #-1,TOS     \ 1
 115         U< IF           \ 2 flag
 116             AND #0,TOS  \ 1 flag Z = 1
 117         THEN
 118     THEN
 119     MOV @IP+,PC     \ 4
 120     ENDCODE
 121     [THEN]
 122
 123     [UNDEFINED] DABS [IF]
 124 \ https://forth-standard.org/standard/double/DABS
 125 \ DABS     d1 -- |d1|     absolute value
 126     CODE DABS
 127     AND #-1,TOS         \ clear V, set N
 128     S< IF               \
 129         XOR #-1,0(PSP)  \ 4
 130         XOR #-1,TOS     \ 1
 131         ADD #1,0(PSP)   \ 4
 132         ADDC #0,TOS     \ 1
 133     THEN
 134     MOV @IP+,PC
 135     ENDCODE
 136     [THEN]
 137
 138     [UNDEFINED] HOLDS [IF]
 139 \ https://forth-standard.org/standard/core/HOLDS
 140 \ Adds the string represented by addr u to the pictured numeric output string
 141 \ compilation use: <# S" string" HOLDS #>
 142 \ free chars area in the 32+2 bytes HOLD buffer = {26,23,2} chars with a 32 bits sized {hexa,decimal,binary} number.
 143 \ (2 supplementary bytes are room for sign - and decimal point)
 144 \ C HOLDS    addr u --
 145     CODE HOLDS
 146     MOV @PSP+,X         \ 2     X=src
 147 BW3 ADD TOS,X           \ 1     X=src_end
 148     MOV &HP,Y           \ 3     Y=dst
 149     BEGIN
 150         SUB #1,X        \ 1     src-1
 151         SUB #1,TOS      \ 1     cnt-1
 152     U>= WHILE
 153         SUB #1,Y        \ 1     dst-1
 154         MOV.B @X,0(Y)   \ 4
 155     REPEAT
 156     MOV Y,&HP           \ 3
 157     MOV @PSP+,TOS       \ 2
 158     MOV @IP+,PC         \ 4  15 words
 159     ENDCODE
 160     [THEN]
 161
 162 ; --------------------------
 163 ; end of definitions we need
 164 ; --------------------------
 165
 166     [UNDEFINED] F+ [IF]
 167     CODE F+ \ add Q15.16|double numbers
 168     ADD @PSP+,2(PSP)    \ -- sumlo  d1hi d2hi
 169     ADDC @PSP+,TOS      \ -- sumlo sumhi
 170     MOV @IP+,PC
 171     ENDCODE
 172     [THEN]
 173
 174     [UNDEFINED] F- [IF]
 175     CODE F- \ substract Q15.16|double numbers
 176     SUB @PSP+,2(PSP)    \ -- diflo d1hi d2hi
 177     SUBC TOS,0(PSP)     \ -- diflo difhi d2hi
 178     MOV @PSP+,TOS
 179     MOV @IP+,PC
 180     ENDCODE
 181     [THEN]
 182
 183     TLV_ORG 4 + @ $81F3 U<
 184     $81EF TLV_ORG 4 + @ U<
 185     = [IF]              ; MSP430FR413x subfamily without hardware_MPY
 186
 187     [UNDEFINED] UDM* [IF]
 188 \ unsigned multiply 32*32 = 64
 189 \ don't use S reg (keep sign)
 190     CODE UDM*
 191     PUSH IP                 \ 3
 192     PUSHM #4,rDOVAR         \ 6 save rDOVAR to rDOCOL regs to use M to R alias
 193     MOV 4(PSP),IP           \ 3 MDlo
 194     MOV 2(PSP),T            \ 3 MDhi
 195     MOV @PSP,W              \ 2 MRlo
 196     MOV #0,M                \ 1 MDLO=0
 197     MOV #0,P                \ 1 MDHI=0
 198     MOV #0,4(PSP)           \ 3 RESlo=0
 199     MOV #0,2(PSP)           \ 3 REShi=0
 200     MOV #0,Q                \ 1 RESLO=0
 201     MOV #0,R                \ 1 RESHI=0
 202     MOV #1,X                \ 1 BIT TEST REGlo
 203     MOV #0,Y                \ 1 BIT TEST2 REGhi
 204     BEGIN
 205         CMP #0,X
 206         0<> IF
 207             BIT X,W         \ 2+1 TEST ACTUAL BIT MRlo
 208         ELSE
 209             BIT Y,TOS       \ 2+1 TEST ACTUAL BIT MRhi
 210         THEN
 211         0<> IF
 212             ADD IP,4(PSP)   \ 2+3 IF 1: ADD MDlo TO RESlo
 213             ADDC T,2(PSP)   \ 3      ADDC MDhi TO REShi
 214             ADDC M,Q        \ 1      ADDC MDLO TO RESLO
 215             ADDC P,R        \ 1      ADDC MDHI TO RESHI
 216         THEN
 217         ADD IP,IP           \ 1 (RLA LSBs) MDlo *2
 218         ADDC T,T            \ 1 (RLC MSBs) MDhi *2
 219         ADDC M,M            \ 1 (RLC LSBs) MDLO *2
 220         ADDC P,P            \ 1 (RLC MSBs) MDHI *2
 221         ADD X,X             \ 1 (RLA) NEXT BIT TO TEST
 222         ADDC Y,Y            \ 1 (RLC) NEXT BIT TO TEST
 223     U>= UNTIL
 224     MOV Q,0(PSP)            \ 2+2 IF BIT IN CARRY: FINISHED    32 * 16~ (average loop)
 225     MOV R,TOS               \ 1 high result in TOS
 226     POPM #4,rDOVAR          \ 6 restore rDOCOL to rDOVAR
 227     MOV @RSP+,IP            \ 2
 228     MOV @IP+,PC
 229     ENDCODE
 230     [THEN]
 231
 232     [UNDEFINED] F* [IF]
 233     CODE F*                         \ s15.16 * s15.16 --> s15.16 result
 234     MOV 2(PSP),S        \
 235     XOR TOS,S           \ 1s15 XOR 2s15 --> S keep sign of result
 236     BIT #$8000,2(PSP)   \ MD < 0 ?
 237     0<> IF
 238         XOR #-1,2(PSP)
 239         XOR #-1,4(PSP)
 240         ADD #1,4(PSP)
 241         ADDC #0,2(PSP)
 242     THEN
 243     COLON
 244     DABS UDM*           \ -- RES0 RES1 RES2 RES3
 245     HI2LO
 246     MOV @RSP+,IP
 247     MOV @PSP+,TOS       \ -- RES0 RES1 RES2
 248     MOV @PSP+,0(PSP)    \ -- RES1 RES2
 249     AND #-1,S           \ clear V, set N; process S sign
 250     S< IF
 251         XOR #-1,0(PSP)      \ INV(QUOTlo)
 252         XOR #-1,TOS         \ INV(QUOThi)
 253         ADD #1,0(PSP)       \ INV(QUOTlo)+1
 254         ADDC #0,TOS         \ INV(QUOThi)+C
 255     THEN
 256     MOV @IP+,PC
 257     ENDCODE
 258     [THEN]
 259
 260     [UNDEFINED] F#S [IF]
 261     CODE F#S
 262 \ F#S    Qlo Qhi len -- Qhi 0   convert fractional part Qlo of Q15.16 fixed point number
 263 \                               with len digits
 264     MOV @PSP,S          \ -- Qlo Qhi len        S = Qhi
 265     MOV #0,T            \                       T = count
 266     PUSHM #3,IP         \                       R-- IP Qhi count
 267     MOV 2(PSP),0(PSP)   \ -- Qlo Qlo len
 268     MOV TOS,2(PSP)      \ -- len Qlo len
 269     BEGIN
 270         MOV &BASEADR,TOS    \ -- len Qlo base
 271         LO2HI
 272         UM*                 \                       u1 u2 -- RESlo REShi
 273         HI2LO               \ -- len RESlo digit
 274         CMP #10,TOS         \                       digit to char
 275         U>= IF
 276             ADD #7,TOS
 277         THEN
 278         ADD #$30,TOS        \ -- len RESlo char
 279         MOV @RSP,T          \                       T=count
 280         MOV.B TOS,HOLDS_ORG(T)  \                   char to string_org(T)
 281         ADD #1,T            \                       count+1
 282         MOV T,0(RSP)        \
 283         CMP 2(PSP),T        \ -- len RESlo char     count=len ?
 284     U>= UNTIL
 285     POPM #3,IP          \                       S=Qhi, T=len
 286     MOV T,TOS           \ -- len RESlo len
 287     MOV S,2(PSP)        \ -- Qhi RESlo len
 288     MOV #0,0(PSP)       \ -- Qhi 0 len
 289     MOV #HOLDS_ORG,X    \ -- Qhi 0 len          X=HOLDS_ORG
 290     GOTO BW3            \ 36~ JMP HOLDS
 291     ENDCODE
 292     [THEN]
 293
 294     [ELSE] ; hardware multiplier
 295
 296     [UNDEFINED] F* [IF]
 297     CODE F* \ signed s15.16 multiplication --> s15.16 result
 298     MOV 4(PSP),&MPYS32L \ 5 Load 1st operand
 299     MOV 2(PSP),&MPYS32H \ 5
 300     MOV @PSP,&OP2L      \ 4 load 2nd operand
 301     MOV TOS,&OP2H       \ 3
 302     ADD #4,PSP          \ 1 remove 2 cells
 303     MOV &RES1,0(PSP)    \ 5
 304     MOV &RES2,TOS       \ 5
 305     MOV @IP+,PC
 306     ENDCODE
 307     [THEN]
 308
 309     [UNDEFINED] F#S [IF]
 310 \ F#S    Qlo Qhi len -- Qhi 0   convert fractionnal part of Q15.16 fixed point number
 311 \                             with len digits
 312     CODE F#S
 313     MOV 2(PSP),X        \ -- Qlo Qhi len    X = Qlo
 314     MOV @PSP,2(PSP)     \ -- Qhi Qhi len
 315     MOV X,0(PSP)        \ -- Qhi Qlo len
 316     MOV TOS,T           \                   T = len
 317     MOV #0,S            \                   S = count
 318     BEGIN
 319         MOV @PSP,&MPY       \                   Load 1st operand
 320         MOV &BASEADR,&OP2   \                   Load 2nd operand
 321         MOV &RES0,0(PSP)    \ -- Qhi RESlo x        low result on stack
 322         MOV &RES1,TOS       \ -- Qhi RESlo REShi    high result in TOS
 323         CMP #10,TOS         \                   digit to char
 324         U>= IF
 325             ADD #7,TOS
 326         THEN
 327         ADD #$30,TOS
 328         MOV.B TOS,HOLDS_ORG(S)  \ -- Qhi RESlo char     char to string
 329         ADD #1,S            \                   count+1
 330         CMP T,S             \                   count=len ?
 331     0= UNTIL
 332     MOV T,TOS           \ -- len RESlo len
 333     MOV #0,0(PSP)       \ -- Qhi 0 len
 334     MOV #HOLDS_ORG,X    \ -- Qhi 0 len          X=HOLDS_ORG
 335     GOTO BW3            \ 35~ JMP HOLDS+2
 336     ENDCODE
 337     [THEN]
 338
 339     [THEN]  ; end of hardware/software multiplier
 340
 341     [UNDEFINED] F/ [IF]
 342     CODE F/             \ Q15.16 / Q15.16 --> Q15.16 result
 343     MOV TOS,Y           \ 1 Y=DVRhi
 344     MOV @PSP+,W         \ 2 W=DVRlo
 345     MOV @PSP+,X         \ 2 X=DVDhi
 346     MOV @PSP,T          \ 2 T=DVDlo
 347     PUSHM #5,X          \ 7 PUSHM DVDhi,DVRhi, M, P, Q
 348     AND #-1,Y           \ 1 Y=DVRhi < 0 ?
 349     S< IF
 350         XOR #-1,W       \ 1 W=INV(DVRlo)
 351         XOR #-1,Y       \ 1 Y=INV(DVRhi)
 352         ADD #1,W        \ 1 W=INV(DVRlo)+1
 353         ADDC #0,Y       \ 1 Y=INV(DVRhi)+C
 354     THEN
 355     AND #-1,X           \ 1 X=DVDhi < 0 ?
 356     S< IF
 357         XOR #-1,T       \ 1 T=INV(DVDlo)
 358         XOR #-1,X       \ 1 X=INV(DVDhi)
 359         ADD #1,T        \ 1 T=INV(DVDlo)+1
 360         ADDC #0,X       \ 1 X=INV(DVDhi)+C
 361     THEN
 362     MOV X,M             \ 1 DVDhi --> REMlo     to adjust Q15.16 division
 363     MOV T,X             \ 1 DVDlo --> DVDhi
 364     MOV #0,T            \ 1     0 --> DVDlo
 365 \ ------------------------------------------------------------------------
 366 \ don't uncomment lines below, don't rub out, please !
 367 \ ------------------------------------------------------------------------
 368 \           UD/MOD    DVDlo DVDhi DVRlo DVRhi -- REMlo REMhi QUOTlo QUOThi
 369 \ ------------------------------------------------------------------------
 370 \            MOV TOS,Y           \ 1 Y=DVRhi
 371 \            MOV @PSP+,W         \ 2 W=DVRlo
 372 \            MOV @PSP+,X         \ 2 X=DVDhi
 373 \            MOV @PSP,T          \ 2 T=DVDlo
 374 \            PUSHM #5,X          \ 7 PUSHM DVDhi,DVRhi, M, P, Q
 375 \            MOV #0,M            \ 1 M=REMlo = 0
 376     MOV #0,P            \ 1 P=REMhi = 0
 377     MOV #32,Q           \ 2 Q=count
 378 BW1 CMP Y,P             \ 1 REMhi = DVRhi ?
 379     0= IF
 380         CMP W,M             \ 1 REMlo U< DVRlo ?
 381     THEN
 382     U>= IF
 383         SUB W,M             \ 1 no:  REMlo - DVRlo  (carry is set)
 384         SUBC Y,P            \ 1      REMhi - DVRhi
 385     THEN
 386     BEGIN
 387         ADDC S,S            \ 1 RLC quotLO
 388         ADDC TOS,TOS        \ 1 RLC quotHI
 389         SUB #1,Q            \ 1 Decrement loop counter
 390     U>= WHILE                   \ 2 out of loop if count<0
 391         ADD T,T             \ 1 RLA DVDlo
 392         ADDC X,X            \ 1 RLC DVDhi
 393         ADDC M,M            \ 1 RLC REMlo
 394         ADDC P,P            \ 1 RLC REMhi
 395         U< ?GOTO BW1        \ 2 19~ loop
 396         SUB W,M             \ 1 REMlo - DVRlo
 397         SUBC Y,P            \ 1 REMhi - DVRhi
 398         BIS #1,SR           \ 1
 399     REPEAT                  \ 2 16~ loop
 400 \            MOV M,T         \ 1 T=REMlo
 401 \            MOV P,W         \ 1 W=REMhi
 402     POPM #5,X               \ 7 X=DVDhi, Y=DVRhi, system regs M,P,Q restored
 403 \            CMP #0,X        \ 1 sign of Rem ?
 404 \    S< IF   XOR #-1,T       \ 1 INV(REMlo)
 405 \            XOR #-1,W       \ 1 INV(REMhi)
 406 \            ADD #1,T        \ 1 INV(REMlo)+1
 407 \            ADDC #0,W       \ 1 INV(REMhi)+C
 408 \    THEN
 409 \           SUB #4,PSP      \
 410 \           MOV T,4(PSP)    \   REMlo
 411 \           MOV W,2(PSP)    \   REMhi
 412     XOR X,Y                 \ Y = sign of Quot
 413     CMP #0,Y                \ sign of Quot ?
 414     S< IF
 415         XOR #-1,S           \ 1 INV(QUOTlo)
 416     XOR #-1,TOS             \ 1 INV(QUOThi)
 417     ADD #1,S                \ 1 INV(QUOTlo)+1
 418     ADDC #0,TOS             \ 1 INV(QUOThi)+C
 419     THEN
 420     MOV S,0(PSP)            \ 3 QUOTlo
 421     MOV @IP+,PC             \ 4
 422     ENDCODE
 423     [THEN]
 424
 425     [UNDEFINED] F. [IF]
 426     CODE F. \ display a Q15.16 number with 4/5/16 digits after comma
 427     MOV TOS,S           \ S = sign
 428     MOV #4,T            \ T = 4     preset 4 digits for base 16 and by default
 429     MOV &BASEADR,W
 430     CMP #$0A,W
 431     0= IF               \           if base 10
 432         ADD #1,T        \ T = 5     set 5 digits
 433     ELSE
 434         CMP #2,W
 435         0= IF           \           if base 2
 436             MOV #$10,T  \ T = 16    set 16 digits
 437         THEN
 438     THEN
 439     PUSHM #3,IP         \                   R-- IP sign #digit
 440     LO2HI
 441     <# DABS         \ -- uQlo uQhi      R-- IP sign #digit
 442     R> F#S          \ -- uQhi 0         R-- IP sign
 443     $2C HOLD        \                   $2C = char ','
 444     #S              \ -- 0 0
 445     R> SIGN #>      \ -- addr len       R-- IP
 446     TYPE $20 EMIT   \ --
 447     ;
 448     [THEN]
 449
 450     [UNDEFINED] S>F [IF]
 451     CODE S>F    \ convert a signed number to a Q15.16 (signed) number
 452     SUB #2,PSP
 453     MOV #0,0(PSP)
 454     MOV @IP+,PC
 455     ENDCODE
 456     [THEN]
 457
 458     RST_SET
 459
 460     [THEN] \ endof [UNDEFINED] {FIXPOINT}
 461
 462 ; -----------------------
 463 ; complement (volatile) for tests below
 464 ; -----------------------
 465
 466 \ https://forth-standard.org/standard/core/CONSTANT
 467 \ CONSTANT <name>     n --                      define a Forth CONSTANT
 468     [UNDEFINED] CONSTANT [IF]
 469     : CONSTANT
 470     CREATE
 471     HI2LO
 472     MOV TOS,-2(W)           \   PFA = n
 473     MOV @PSP+,TOS
 474     MOV @RSP+,IP
 475     MOV @IP+,PC
 476     ENDCODE
 477     [THEN]
 478
 479 \ https://forth-standard.org/standard/double/TwoCONSTANT
 480     [UNDEFINED] 2CONSTANT [IF]
 481     : 2CONSTANT \  udlo/dlo/Qlo udhi/dhi/Qhi --         to create double or Q15.16 CONSTANT
 482     CREATE , ,  \ compile Qhi then Qlo
 483     DOES>       \ execution part    addr -- Qhi Qlo
 484     HI2LO
 485     SUB #2,PSP
 486     MOV 2(TOS),0(PSP)
 487     MOV @TOS,TOS
 488     MOV @RSP+,IP
 489     NEXT
 490     ENDCODE
 491     [THEN]
 492
 493 \ https://forth-standard.org/standard/double/Dd
 494 \ D.     dlo dhi --           display d (signed)
 495     [UNDEFINED] D. [IF]
 496     CODE D.
 497     MOV #U.+10,PC   \ U. + 10 = D.
 498     ENDCODE
 499     [THEN]
 500
 501 \ https://forth-standard.org/standard/core/BASE
 502 \ BASE    -- a-addr       holds conversion radix
 503     [UNDEFINED] BASE [IF]
 504     BASEADR CONSTANT BASE
 505     [THEN]
 506
 507     ECHO
 508
 509 ; ------------------------------------------------
 510 ; (volatile) tests for FIXPOINT.asm | FIXPOINT.4th
 511 ; ------------------------------------------------
 512
 513 3,14159 2CONSTANT PI
 514 PI -1,0 F* 2CONSTANT -PI
 515
 516 PI D.   ; D. is not appropriate -->
 517 -PI D.  ; D. is not appropriate -->
 518
 519 PI F.   ; F. is a good choice! --->
 520 -PI F.  ; F. is a good choice! --->
 521
 522 $10 BASE !   PI F.
 523             -PI F.
 524 %10 BASE !   PI F.
 525             -PI F.
 526 #10 BASE !   PI F.
 527             -PI F.
 528
 529  PI  2,0 F* F.
 530  PI -2,0 F* F.
 531 -PI  2,0 F* F.
 532 -PI -2,0 F* F.
 533
 534  PI  2,0 F/ F.
 535  PI -2,0 F/ F.
 536 -PI  2,0 F/ F.
 537 -PI -2,0 F/ F.
 538
 539  32768,0  1,0 F* F. ; overflow! -->
 540  32768,0  1,0 F/ F. ; overflow! -->
 541 -32768,0 -1,0 F* F. ; overflow! -->
 542 -32768,0 -1,0 F/ F. ; overflow! -->
 543
 544 32767,99999 1,0  F* F.
 545 32767,99999 1,0  F/ F.
 546 32767,99999 2,0  F/ F.
 547 32767,99999 4,0  F/ F.
 548 32767,99999 8,0  F/ F.
 549 32767,99999 16,0 F/ F.
 550
 551 -32768,0 -2,0    F/ F.
 552 -32768,0 -4,0    F/ F.
 553 -32768,0 -8,0    F/ F.
 554 -32768,0 -16,0   F/ F.
 555 -32768,0 -32,0   F/ F.
 556 -32768,0 -64,0   F/ F.
 557
 558 -3276,80 -1,0    F/ F.
 559 -327,680 -1,0    F/ F.
 560 -32,7680 -1,0    F/ F.
 561 -3,27680 -1,0    F/ F.
 562 -0,32768 -1,0    F/ F.
 563
 564 ; SQRT(32768)^2 = 32768
 565  181,01933598375  181,01933598375 F* F.
 566  181,01933598375 -181,01933598375 F* F.
 567 -181,01933598375  181,01933598375 F* F.
 568 -181,01933598375 -181,01933598375 F* F.
 569
 570 RST_RET