MSP430-FORTH/DOUBLE.f

   1 \ -*- coding: utf-8 -*-
   2 \ TARGET SELECTION
   3 \ MSP_EXP430FR5739  MSP_EXP430FR5969    MSP_EXP430FR5994    MSP_EXP430FR6989
   4 \ MSP_EXP430FR4133  MSP_EXP430FR2433    MSP_EXP430FR2355    CHIPSTICK_FR2433
   5 \ MY_MSP430FR5738_1 MY_MSP430FR5738     MY_MSP430FR5948     MY_MSP430FR5948_1
   6 \ JMJ_BOX
   7
   8
   9 \ Fast Forth For Texas Instrument MSP430FRxxxx FRAM devices
  10 \ Copyright (C) <2015>  <J.M. THOORENS>
  11 \
  12 \ This program is free software: you can redistribute it and/or modify
  13 \ it under the terms of the GNU General Public License as published by
  14 \ the Free Software Foundation, either version 3 of the License, or
  15 \ (at your option) any later version.
  16 \
  17 \ This program is distributed in the hope that it will be useful,
  18 \ but WITHOUT ANY WARRANTY; without even the implied warranty of
  19 \ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  20 \ GNU General Public License for more details.
  21 \
  22 \ You should have received a copy of the GNU General Public License
  23 \ along with this program.  If not, see <http://www.gnu.org/licenses/>.
  24
  25 \ REGISTERS USAGE
  26 \ rDODOES to rEXIT must be saved before use and restored after
  27 \ scratch registers Y to S are free for use
  28 \ under interrupt, IP is free for use
  29
  30 \ FORTH conditionnals:  unary{ 0= 0< 0> }, binary{ = < > U< }
  31
  32 \ ASSEMBLER conditionnal usage with IF UNTIL WHILE  S<  S>=  U<   U>=  0=  0<>  0>=
  33
  34 \ ASSEMBLER conditionnal usage with ?JMP ?GOTO      S<  S>=  U<   U>=  0=  0<>  <0
  35
  36
  37 \ https://forth-standard.org/standard/double/DtoS
  38 \ D>S    d -- n          double prec -> single.
  39 CODE D>S
  40 MOV @PSP+,TOS
  41 NEXT
  42 ENDCODE
  43     \
  44
  45 [UNDEFINED] {ANS_COMP} [IF]
  46 \ https://forth-standard.org/standard/core/StoD
  47 \ S>D    n -- d          single -> double prec.
  48 : S>D
  49     DUP 0<
  50 ;
  51     \
  52
  53 \ https://forth-standard.org/standard/core/TwoFetch
  54 \ 2@    a-addr -- x1 x2    fetch 2 cells ; the lower address will appear on top of stack
  55 CODE 2@
  56 SUB #2,PSP
  57 MOV 2(TOS),0(PSP)
  58 MOV @TOS,TOS
  59 NEXT
  60 ENDCODE
  61     \
  62
  63 \ https://forth-standard.org/standard/core/TwoDUP
  64 \ 2DUP   x1 x2 -- x1 x2 x1 x2   dup top 2 cells
  65 CODE 2DUP
  66 SUB #4,PSP          \ -- x1 x x x2
  67 MOV TOS,2(PSP)      \ -- x1 x2 x x2
  68 MOV 4(PSP),0(PSP)   \ -- x1 x2 x1 x2
  69 NEXT
  70 ENDCODE
  71     \
  72
  73 \ https://forth-standard.org/standard/core/TwoDROP
  74 \ 2DROP  x1 x2 --          drop 2 cells
  75 CODE 2DROP
  76 ADD #2,PSP
  77 MOV @PSP+,TOS
  78 NEXT
  79 ENDCODE
  80     \
  81
  82 \ https://forth-standard.org/standard/core/TwoSWAP
  83 \ 2SWAP  x1 x2 x3 x4 -- x3 x4 x1 x2
  84 CODE 2SWAP
  85 MOV @PSP,W          \ -- x1 x2 x3 x4    W=x3
  86 MOV 4(PSP),0(PSP)   \ -- x1 x2 x1 x4
  87 MOV W,4(PSP)        \ -- x3 x2 x1 x4
  88 MOV TOS,W           \ -- x3 x2 x1 x4    W=x4
  89 MOV 2(PSP),TOS      \ -- x3 x2 x1 x2    W=x4
  90 MOV W,2(PSP)        \ -- x3 x4 x1 x2
  91 NEXT
  92 ENDCODE
  93     \
  94
  95 \ https://forth-standard.org/standard/core/TwoOVER
  96 \ 2OVER  x1 x2 x3 x4 -- x1 x2 x3 x4 x1 x2
  97 CODE 2OVER
  98 SUB #4,PSP          \ -- x1 x2 x3 x x x4
  99 MOV TOS,2(PSP)      \ -- x1 x2 x3 x4 x x4
 100 MOV 8(PSP),0(PSP)   \ -- x1 x2 x3 x4 x1 x4
 101 MOV 6(PSP),TOS      \ -- x1 x2 x3 x4 x1 x2
 102 NEXT
 103 ENDCODE
 104     \
 105
 106 [THEN] \ undefined ANS_COMP
 107
 108 \ https://forth-standard.org/standard/double/TwoROT
 109 \ Rotate the top three cell pairs on the stack bringing cell pair x1 x2 to the top of the stack.
 110 CODE 2ROT
 111 MOV 8(PSP),X        \ 3
 112 MOV 6(PSP),Y        \ 3
 113 MOV 4(PSP),8(PSP)   \ 5
 114 MOV 2(PSP),6(PSP)   \ 5
 115 MOV @PSP,4(PSP)     \ 4
 116 MOV TOS,2(PSP)      \ 3
 117 MOV X,0(PSP)        \ 3
 118 MOV Y,TOS           \ 1
 119 NEXT
 120 ENDCODE
 121     \
 122
 123 CODE 2NIP
 124 MOV @PSP,X
 125 ADD #4,PSP
 126 MOV X,0(PSP)
 127 NEXT
 128 ENDCODE
 129     \
 130
 131 CODE D0=
 132 CMP #0,TOS
 133 MOV #0,TOS
 134 0= IF
 135     CMP #0,0(PSP)
 136     0= IF
 137         MOV #-1,TOS
 138     THEN
 139 THEN
 140 ADD #2,PSP
 141 NEXT
 142 ENDCODE
 143     \
 144
 145 CODE D0<
 146 CMP #0,TOS
 147 MOV #0,TOS
 148 S< IF
 149     MOV #-1,TOS
 150 THEN
 151 ADD #2,PSP
 152 NEXT
 153 ENDCODE
 154     \
 155
 156 \ https://forth-standard.org/standard/double/DEqual
 157 CODE D=
 158 CMP TOS,2(PSP)      \ 3 ud1H - ud2H
 159 MOV #0,TOS          \ 1
 160 0= IF               \ 2
 161     CMP @PSP,4(PSP) \ 4 ud1L - ud2L
 162     0= IF           \ 2
 163     MOV #-1,TOS     \ 1
 164     THEN
 165 THEN
 166 ADD #6,PSP          \ 2
 167 NEXT                \ 4
 168 ENDCODE
 169     \
 170
 171 \ https://forth-standard.org/standard/double/Dless
 172 \ flag is true if and only if d1 is less than d2
 173 CODE D<
 174 CMP TOS,2(PSP)      \ 3 d1H - d2H
 175 MOV #0,TOS          \ 1
 176 S< IF               \ 2
 177     MOV #-1,TOS     \ 1
 178 THEN
 179 0= IF               \ 2
 180     CMP @PSP,4(PSP) \ 4 d1L - d2L
 181     S< IF           \ 2
 182         MOV #-1,TOS \ 1
 183     THEN
 184 THEN
 185 ADD #6,PSP          \ 2
 186 NEXT                \ 4
 187 ENDCODE
 188     \
 189
 190 CODE D>
 191 CMP 2(PSP),TOS      \ 3 d2H - d1H
 192 MOV #0,TOS          \ 1
 193 S< IF               \ 2
 194     MOV #-1,TOS     \ 1
 195 THEN
 196 0= IF               \ 2
 197     CMP 4(PSP),0(PSP) \ 4 d2L - d1L
 198     S< IF           \ 2
 199         MOV #-1,TOS \ 1
 200     THEN
 201 THEN
 202 ADD #6,PSP          \ 2
 203 NEXT                \ 4
 204 ENDCODE
 205     \
 206
 207 \ https://forth-standard.org/standard/double/DUless
 208 \ flag is true if and only if ud1 is less than ud2
 209 CODE DU<
 210 CMP TOS,2(PSP)      \ 3 ud1H - ud2H
 211 MOV #0,TOS          \ 1
 212 U< IF               \ 2
 213     MOV #-1,TOS     \ 1
 214 THEN
 215 0= IF               \ 2
 216     CMP @PSP,4(PSP) \ 4 ud1L - ud2L
 217     U< IF           \ 2
 218         MOV #-1,TOS \ 1
 219     THEN
 220 THEN
 221 ADD #6,PSP          \ 2
 222 NEXT                \ 4
 223 ENDCODE
 224     \
 225
 226
 227 CODE D+
 228 ADD @PSP+,2(PSP)
 229 ADDC @PSP+,TOS
 230 NEXT                \ 4
 231 ENDCODE
 232     \
 233
 234 CODE D-
 235 SUB @PSP+,2(PSP)
 236 SUBC TOS,0(PSP)
 237 MOV @PSP+,TOS
 238 NEXT                \ 4
 239 ENDCODE
 240     \
 241
 242 CODE DNEGATE
 243 XOR #-1,0(PSP)
 244 XOR #-1,TOS
 245 ADD #1,0(PSP)
 246 ADDC #0,TOS
 247 NEXT                \ 4
 248 ENDCODE
 249     \
 250
 251 \ https://forth-standard.org/standard/double/DTwoDiv
 252 CODE D2/
 253 RRA TOS
 254 RRC 0(PSP)
 255 NEXT                \ 4
 256 ENDCODE
 257     \
 258
 259 \ https://forth-standard.org/standard/double/DTwoTimes
 260 CODE D2*
 261 ADD @PSP,0(PSP)
 262 ADDC TOS,TOS
 263 NEXT                \ 4
 264 ENDCODE
 265     \
 266
 267 : DMAX
 268 2OVER 2OVER \ ( d1 d2 d1 d2 )
 269 D> IF 2DROP ELSE 2NIP THEN
 270 ;
 271     \
 272
 273 : DMIN
 274 2OVER 2OVER \ ( d1 d2 d1 d2 )
 275 D< IF 2DROP ELSE 2NIP THEN
 276 ;
 277     \
 278
 279 CODE M+
 280 ADD TOS,2(PSP)
 281 ADDC #0,0(PSP)
 282 MOV @PSP+,TOS
 283 NEXT                \ 4
 284 ENDCODE
 285     \
 286
 287 $1A04 C@ $EF > [IF] ; test tag value MSP430FR413x subfamily without hardware_MPY
 288     \
 289
 290 \ signed multiply 32*16 --> 48 / 16 = 32
 291 CODE M*/                \ d1lo d1hi n1 +n2 -- d2lo d2hi
 292     MOV 2(PSP),S        \
 293     XOR @PSP,S          \ S keep sign of M* result
 294     BIT #$8000,2(PSP)   \ MD < 0 ?
 295 0<> IF  XOR #-1,4(PSP)
 296         XOR #-1,2(PSP)
 297         ADD #1,4(PSP)
 298         ADDC #0,2(PSP)
 299 THEN
 300     BIT #$8000,TOS
 301 0<> IF  XOR #-1,TOS
 302         ADD #1,TOS
 303 THEN
 304 \ UDM*
 305 \            PUSHM R5,R4     \ 6 save R5 ~ R4 regs
 306             PUSHM #2,R5      \ 6 save R5,R4 regs
 307             MOV 4(PSP),Y    \ 3 MDlo
 308             MOV 2(PSP),T    \ 3 MDhi
 309             MOV @PSP+,W     \ 2 MRlo        -- d1lo d1hi +n2
 310             MOV #0,R4       \ 1 MDLO=0
 311             MOV #0,2(PSP)   \ 3 RESlo=0
 312             MOV #0,0(PSP)   \ 3 REShi=0     -- p1lo p1hi +n2
 313             MOV #0,R5       \ 1 RESLO=0
 314             MOV #1,X        \ 1 BIT TEST REGlo
 315 BEGIN       BIT X,W         \ 1 test actual bit
 316     0<> IF  ADD Y,2(PSP)    \ 3 IF 1: ADD MDlo TO RESlo
 317             ADDC T,0(PSP)   \ 3      ADDC MDhi TO REShi
 318             ADDC R4,R5      \ 1      ADDC MDLO TO RESLO
 319     THEN    ADD Y,Y         \ 1 (RLA LSBs) MDlo *2
 320             ADDC T,T        \ 1 (RLC MSBs) MDhi *2
 321             ADDC R4,R4      \ 1 (RLA LSBs) MDLO *2
 322             ADD X,X         \ 1 (RLA) NEXT BIT TO TEST
 323 U>= UNTIL   MOV R5,W        \ 1 IF BIT IN CARRY: FINISHED    32 * 16~ (average loop)
 324 \            POPM R4,R5      \ 6 restore R4 ~ R5 regs
 325             POPM #2,R5      \ 6 restore R4 R5 regs
 326 \ UDM*END
 327     MOV TOS,T               \
 328     MOV @PSP,TOS            \
 329     AND #-1,S               \ clear V, set N, test M* sign
 330     MOV 2(PSP),S
 331 S< IF   XOR #-1,S
 332         XOR #-1,TOS
 333         XOR #-1,W
 334         ADD #1,S
 335         ADDC #1,TOS
 336         ADDC #0,W
 337 THEN
 338 MOV #MU/MOD,X
 339 ADD #10,X           \ 2 X = MUSMOD2 addr
 340 CALL X              \ 4
 341 MOV @PSP+,0(PSP)    \ rem d2lo d2hi -- d2lo d2hi
 342 NEXT                \ 4
 343 ENDCODE
 344     \
 345 [ELSE]
 346     \
 347 CODE M*/            \ d1 * n1 / +n2 -- d2
 348 MOV 4(PSP),&MPYS32L \ 5 Load 1st operand
 349 MOV 2(PSP),&MPYS32H \ 5
 350 MOV @PSP+,&OP2      \ 4 load 2nd operand
 351 MOV #MU/MOD,X       \ 2
 352 ADD #10,X           \ 2 X = MUSMOD2 addr
 353 MOV TOS,T           \ 1 T = DIVlo
 354 MOV &RES0,S         \ 3 S = DVDlo
 355 MOV &RES1,TOS       \ 3 TOS = DVDhi
 356 MOV &RES2,W         \ 3 W = REMlo
 357 CALL X              \ 4
 358 MOV @PSP+,0(PSP)    \ rem dquot -- d2
 359 NEXT                \ 4
 360 ENDCODE
 361     \
 362 [THEN]
 363     \
 364
 365 \ https://forth-standard.org/standard/double/TwoVARIABLE
 366 : 2VARIABLE \  --
 367 VARIABLE
 368 2 ALLOT
 369 ;
 370     \
 371
 372 [UNDEFINED] 2CONSTANT [IF]
 373 \ https://forth-standard.org/standard/core/TwoFetch
 374 \ 2@    a-addr -- x1 x2    fetch 2 cells ; the lower address will appear on top of stack
 375 CODE 2@
 376 SUB #2,PSP
 377 MOV 2(TOS),0(PSP)
 378 MOV @TOS,TOS
 379 NEXT
 380 ENDCODE
 381     \
 382
 383 \ https://forth-standard.org/standard/double/TwoCONSTANT
 384 : 2CONSTANT \  udlo/dlo/Flo udhi/dhi/Shi --         to create double or s15q16 CONSTANT
 385 CREATE
 386 , ,             \ compile Shi then Flo
 387 DOES>
 388 2@              \ execution part
 389 ;
 390 [THEN]
 391     \
 392
 393 CODE 2VALUE
 394 MOV #CONSTANT,PC
 395 ENDCODE
 396     \
 397
 398 CODE 2LITERAL
 399 BIS #UF9,SR
 400 MOV #LITERAL,PC
 401 ENDCODE
 402     \
 403
 404 PWR_HERE
 405
 406 : ?floored [ -3 2 / -2 = ] LITERAL IF 1. D- THEN ;
 407
 408 5. 7 11 M*/             D.  ; 3  -->
 409 5. -7 11 M*/ ?floored   D.  ; -3 -->
 410 -5. 7 11 M*/ ?floored   D.  ; -3 -->
 411 -5. -7 11 M*/           D.  ; 3  -->
 412 $7FFFFFFF. 8 16 M*/     D.  ; $7FFF -->