MSP430-FORTH/CORE_ANS.f

   1 \ -*- coding: utf-8 -*-
   2 \
   3 \ TARGET SELECTION ( = the name of \INC\target.pat file without the extension)
   4 \ (used by preprocessor GEMA to load the pattern: \inc\TARGET.pat)
   5 \ MSP_EXP430FR5739  MSP_EXP430FR5969    MSP_EXP430FR5994    MSP_EXP430FR6989
   6 \ MSP_EXP430FR4133  CHIPSTICK_FR2433    MSP_EXP430FR2433    MSP_EXP430FR2355
   7 \ LP_MSP430FR2476
   8 \ MY_MSP430FR5738_2
   9 \
  10 \ from scite editor : copy your target selection in (shift+F8) parameter 1:
  11 \
  12 \ OR
  13 \
  14 \ drag and drop this file onto SendSourceFileToTarget.bat
  15 \ then select your TARGET when asked.
  16 \
  17 \
  18 \ REGISTERS USAGE
  19 \ rDODOES to rEXIT must be saved before use and restored after
  20 \ scratch registers Y to S are free for use
  21 \ under interrupt, IP is free for use
  22 \
  23 \ PUSHM order : PSP,TOS, IP,  S,  T,  W,  X,  Y, rEXIT, rDOVAR, rDOCON, rDODOES
  24 \ example : PUSHM #6,IP pushes IP,S,T,W,X,Y registers to return stack
  25 \
  26 \ POPM  order :  rDODOES, rDOCON, rDOVAR, rEXIT,  Y,  X,  W,  T,  S, IP,TOS,PSP
  27 \ example : POPM #6,IP   pulls Y,X,W,T,S,IP registers from return stack
  28 \
  29 \ FORTH conditionnals:  unary{ 0= 0< 0> }, binary{ = < > U< }
  30 \
  31 \ ASSEMBLER conditionnal usage with IF UNTIL WHILE  S<  S>=  U<   U>=  0=  0<>  0>=
  32 \ ASSEMBLER conditionnal usage with ?GOTO           S<  S>=  U<   U>=  0=  0<>  0<
  33
  34     CODE ABORT_CORE_ANS
  35     SUB #2,PSP
  36     MOV TOS,0(PSP)
  37     MOV &VERSION,TOS
  38     SUB #401,TOS            \ FastForth V4.1
  39     COLON
  40     'CR' EMIT               \ return to column 1, no 'LF'
  41     ABORT" FastForth V4.1 please!"
  42     ;
  43
  44     ABORT_CORE_ANS
  45
  46     [UNDEFINED] BC! [IF]
  47 \  BC!     pattern @ --            Bits Clear in @
  48     CODE BC!
  49     BIC @PSP+,0(TOS)
  50     MOV @PSP+,TOS
  51     MOV @IP+,PC
  52     ENDCODE
  53     [THEN]
  54
  55     [UNDEFINED] BS! [IF]
  56 \  BS!     pattern @ --            Bits Set in @
  57     CODE BS!
  58     BIS @PSP+,0(TOS)
  59     MOV @PSP+,TOS
  60     MOV @IP+,PC
  61     ENDCODE
  62     [THEN]
  63
  64 \ =============================================================================
  65     $8000 KERNEL_ADDON BC! \ uncomment to select SYMMETRIC division
  66 \    $8000 KERNEL_ADDON BS! \ uncomment to select FLOORED division
  67 \ =============================================================================
  68
  69     RST_RET           \ remove all above before CORE_ANS downloading
  70
  71 ; ----------------------------------
  72 ; CORE_ANS.f
  73 ; ----------------------------------
  74 \
  75 \ words complement to pass CORETEST.4TH
  76
  77     [DEFINED] {CORE_ANS}
  78     [IF] {CORE_ANS} [THEN]   \ if already defined removes it before.
  79
  80     [UNDEFINED] {CORE_ANS} [IF]
  81     MARKER {CORE_ANS}
  82
  83     [UNDEFINED] ABORT [IF]
  84 \ https://forth-standard.org/standard/core/ABORT
  85 \ Empty the data stack and perform the function of QUIT
  86     CODE ABORT
  87     MOV #ABORT,PC           \ addr defined in MSP430FRxxxx.pat
  88     ENDCODE
  89     [THEN]
  90
  91     [UNDEFINED] QUIT [IF]
  92 \ https://forth-standard.org/standard/core/QUIT
  93 \ Empty the return stack, store zero in SOURCE-ID if it is present,
  94 \ make the user input device the input source, and enter interpretation state.
  95 \ Do not display a message. Repeat the following:
  96 \   Accept a line from the input source into the input buffer, set >IN to zero, and interpret.
  97 \   Display the implementation-defined system prompt if in interpretation state,
  98 \                                                       all processing has been completed,
  99 \                                                       and no ambiguous condition exists.
 100     CODE QUIT
 101     MOV #QUIT,PC            \ addr defined in MSP430FRxxxx.pat
 102     ENDCODE
 103     [THEN]
 104
 105     [UNDEFINED] HERE [IF]
 106 \ https://forth-standard.org/standard/core/HERE
 107 \ HERE          -- addr     addr is the data-space pointer.
 108     CODE HERE
 109     MOV #BEGIN,PC           \ execute ASM BEGIN
 110     ENDCODE
 111     [THEN]
 112
 113     [UNDEFINED] + [IF]
 114 \ https://forth-standard.org/standard/core/Plus
 115 \ +       n1/u1 n2/u2 -- n3/u3     add n1+n2
 116     CODE +
 117     ADD @PSP+,TOS
 118     MOV @IP+,PC
 119     ENDCODE
 120     [THEN]
 121
 122     [UNDEFINED] - [IF]
 123 \ https://forth-standard.org/standard/core/Minus
 124 \ -      n1/u1 n2/u2 -- n3/u3     n3 = n1-n2
 125     CODE -
 126     SUB @PSP+,TOS   \ 2  -- n2-n1 ( = -n3)
 127     XOR #-1,TOS     \ 1
 128     ADD #1,TOS      \ 1  -- n3 = -(n2-n1) = n1-n2
 129     MOV @IP+,PC
 130     ENDCODE
 131     [THEN]
 132
 133     [UNDEFINED] DUP [IF]    \ define DUP and ?DUP
 134
 135 \ https://forth-standard.org/standard/core/DUP
 136 \ DUP      x -- x x      duplicate top of stack
 137     CODE DUP
 138 BW1 SUB #2,PSP      \ 2  push old TOS..
 139     MOV TOS,0(PSP)  \ 3  ..onto stack
 140     MOV @IP+,PC     \ 4
 141     ENDCODE
 142
 143 \ https://forth-standard.org/standard/core/qDUP
 144 \ ?DUP     x -- 0 | x x    DUP if nonzero
 145     CODE ?DUP
 146     CMP #0,TOS      \ 2  test for TOS nonzero
 147     0<> ?GOTO BW1    \ 2
 148     MOV @IP+,PC     \ 4
 149     ENDCODE
 150     [THEN]
 151
 152     [UNDEFINED] EXIT [IF]
 153 \ https://forth-standard.org/standard/core/EXIT
 154 \ EXIT     --      exit a colon definition
 155     CODE EXIT
 156     MOV @RSP+,IP    \ 2 pop previous IP (or next PC) from return stack
 157     MOV @IP+,PC     \ 4 = NEXT
 158     ENDCODE
 159     [THEN]
 160
 161     [UNDEFINED] DEPTH [IF]
 162 \ https://forth-standard.org/standard/core/DEPTH
 163 \ DEPTH    -- +n        number of items on stack, must leave 0 if stack empty
 164     CODE DEPTH
 165     MOV TOS,-2(PSP)
 166     MOV #PSTACK,TOS
 167     SUB PSP,TOS     \ PSP-S0--> TOS
 168     RRA TOS         \ TOS/2   --> TOS
 169     SUB #2,PSP      \ post decrement stack...
 170     MOV @IP+,PC
 171     ENDCODE
 172     [THEN]
 173
 174     [UNDEFINED] SWAP [IF]
 175 \ https://forth-standard.org/standard/core/SWAP
 176 \ SWAP     x1 x2 -- x2 x1    swap top two items
 177     CODE SWAP
 178     PUSH TOS            \ 3
 179     MOV @PSP,TOS        \ 2
 180     MOV @RSP+,0(PSP)    \ 4
 181     MOV @IP+,PC         \ 4
 182     ENDCODE
 183     [THEN]
 184
 185     [UNDEFINED] DROP [IF]
 186 \ https://forth-standard.org/standard/core/DROP
 187 \ DROP     x --          drop top of stack
 188     CODE DROP
 189     MOV @PSP+,TOS   \ 2
 190     MOV @IP+,PC     \ 4
 191     ENDCODE
 192     [THEN]
 193
 194     [UNDEFINED] OVER [IF]
 195 \ https://forth-standard.org/standard/core/OVER
 196 \ OVER    x1 x2 -- x1 x2 x1
 197     CODE OVER
 198     MOV TOS,-2(PSP)     \ 3 -- x1 (x2) x2
 199     MOV @PSP,TOS        \ 2 -- x1 (x2) x1
 200     SUB #2,PSP          \ 1 -- x1 x2 x1
 201     MOV @IP+,PC
 202     ENDCODE
 203     [THEN]
 204
 205     [UNDEFINED] NIP [IF]
 206 \ https://forth-standard.org/standard/core/NIP
 207 \ NIP      x1 x2 -- x2         Drop the first item below the top of stack
 208     CODE NIP
 209     ADD #2,PSP
 210     MOV @IP+,PC
 211     ENDCODE
 212     [THEN]
 213
 214     [UNDEFINED] >R [IF]
 215 \ https://forth-standard.org/standard/core/toR
 216 \ >R    x --   R: -- x   push to return stack
 217     CODE >R
 218     PUSH TOS
 219     MOV @PSP+,TOS
 220     MOV @IP+,PC
 221     ENDCODE
 222     [THEN]
 223
 224     [UNDEFINED] R> [IF]
 225 \ https://forth-standard.org/standard/core/Rfrom
 226 \ R>    -- x    R: x --   pop from return stack
 227     CODE R>
 228     SUB #2,PSP      \ 1
 229     MOV TOS,0(PSP)  \ 3
 230     MOV @RSP+,TOS   \ 2
 231     MOV @IP+,PC     \ 4
 232     ENDCODE
 233     [THEN]
 234
 235     [UNDEFINED] C@ [IF]
 236 \ https://forth-standard.org/standard/core/Fetch
 237 \ C@     c-addr -- char   fetch char from memory
 238     CODE C@
 239     MOV.B @TOS,TOS
 240     MOV @IP+,PC
 241     ENDCODE
 242     [THEN]
 243
 244     [UNDEFINED] C! [IF]
 245 \ https://forth-standard.org/standard/core/CStore
 246 \ C!      char c-addr --    store char in memory
 247     CODE C!
 248     MOV.B @PSP+,0(TOS)  \ 4
 249     ADD #1,PSP          \ 1
 250     MOV @PSP+,TOS       \ 2
 251     MOV @IP+,PC
 252     ENDCODE
 253     [THEN]
 254
 255     [UNDEFINED] C, [IF]
 256 \ https://forth-standard.org/standard/core/CComma
 257 \ C,   char --        append char
 258     CODE C,
 259     MOV &DP,W
 260     MOV.B TOS,0(W)
 261     ADD #1,&DP
 262     MOV @PSP+,TOS
 263     MOV @IP+,PC
 264     ENDCODE
 265     [THEN]
 266
 267     [UNDEFINED] 0= [IF]
 268 \ https://forth-standard.org/standard/core/ZeroEqual
 269 \ 0=     n/u -- flag    return true if TOS=0
 270     CODE 0=
 271     SUB #1,TOS      \ 1 borrow (clear cy) if TOS was 0
 272     SUBC TOS,TOS    \ 1 TOS=-1 if borrow was set
 273     MOV @IP+,PC
 274     ENDCODE
 275     [THEN]
 276
 277     [UNDEFINED] 0<> [IF]
 278 \ https://forth-standard.org/standard/core/Zerone
 279 \ 0<>     n/u -- flag    return true if TOS<>0
 280     CODE 0<>
 281     SUB #1,TOS      \ 1 borrow (clear cy) if TOS was 0
 282     SUBC TOS,TOS    \ 1 TOS=-1 if borrow was set
 283     XOR #-1,TOS     \ 1
 284     MOV @IP+,PC
 285     ENDCODE
 286     [THEN]
 287
 288     [UNDEFINED] 0< [IF]
 289 \ https://forth-standard.org/standard/core/Zeroless
 290 \ 0<     n -- flag      true if TOS negative
 291     CODE 0<
 292     ADD TOS,TOS     \ 1 set carry if TOS negative
 293     SUBC TOS,TOS    \ 1 TOS=-1 if carry was clear
 294     XOR #-1,TOS     \ 1 TOS=-1 if carry was set
 295     MOV @IP+,PC     \
 296     ENDCODE
 297     [THEN]
 298
 299     [UNDEFINED] S>D [IF]
 300 \ https://forth-standard.org/standard/core/StoD
 301 \ S>D    n -- d          single -> double prec.
 302     : S>D
 303     DUP 0<
 304     ;
 305     [THEN]
 306
 307     [UNDEFINED] = [IF]
 308 \ https://forth-standard.org/standard/core/Equal
 309 \ =      x1 x2 -- flag         test x1=x2
 310     CODE =
 311     SUB @PSP+,TOS   \ 2
 312     SUB #1,TOS      \ 1 borrow (clear cy) if TOS was 0
 313     SUBC TOS,TOS    \ 1 TOS=-1 if borrow was set
 314     MOV @IP+,PC
 315     ENDCODE
 316     [THEN]
 317
 318     [UNDEFINED] U< [IF] \ define U< and U>
 319
 320 \ https://forth-standard.org/standard/core/Umore
 321 \ U>     n1 n2 -- flag
 322     CODE U>
 323     SUB @PSP+,TOS   \ 2
 324     U< ?GOTO FW1    \ 2 flag = true, Z = 0
 325 BW1 AND #0,TOS      \ 1 Z = 1
 326     MOV @IP+,PC     \ 4
 327     ENDCODE
 328
 329 \ https://forth-standard.org/standard/core/Uless
 330 \ U<    u1 u2 -- flag       test u1<u2, unsigned
 331     CODE U<
 332     SUB @PSP+,TOS   \ 2 u2-u1
 333     0= ?GOTO BW1
 334     U< ?GOTO BW1
 335 FW1 MOV #-1,TOS     \ 1
 336     MOV @IP+,PC     \ 4
 337     ENDCODE
 338     [THEN]
 339
 340     [UNDEFINED] < [IF]  \ define < and >
 341
 342 \ https://forth-standard.org/standard/core/more
 343 \ >     n1 n2 -- flag         test n1>n2, signed
 344     CODE >
 345     SUB @PSP+,TOS   \ 2 TOS=n2-n1
 346     S< ?GOTO FW1    \ 2 --> +5
 347 BW1 AND #0,TOS      \ 1 flag Z = 1
 348     MOV @IP+,PC
 349     ENDCODE
 350
 351 \ https://forth-standard.org/standard/core/less
 352 \ <      n1 n2 -- flag        test n1<n2, signed
 353     CODE <
 354     SUB @PSP+,TOS   \ 1 TOS=n2-n1
 355     0= ?GOTO BW1
 356     S< ?GOTO BW1    \ 2 signed
 357 FW1 MOV #-1,TOS \ 1 flag Z = 0
 358     MOV @IP+,PC
 359     ENDCODE
 360     [THEN]
 361
 362 \ ------------------------------------------------------------------------------
 363 \ CONTROL STRUCTURES
 364 \ ------------------------------------------------------------------------------
 365 \ THEN and BEGIN compile nothing
 366 \ DO compile one word
 367 \ IF, ELSE, AGAIN, UNTIL, WHILE, REPEAT, LOOP & +LOOP compile two words
 368 \ LEAVE compile three words
 369 \
 370     [UNDEFINED] IF [IF]     \ define IF THEN
 371
 372 \ https://forth-standard.org/standard/core/IF
 373 \ IF       -- IFadr    initialize conditional forward branch
 374     CODE IF
 375     SUB #2,PSP              \
 376     MOV TOS,0(PSP)          \
 377     MOV &DP,TOS             \ -- HERE
 378     ADD #4,&DP            \           compile one word, reserve one word
 379     MOV #QFBRAN,0(TOS)      \ -- HERE   compile QFBRAN
 380     ADD #2,TOS              \ -- HERE+2=IFadr
 381     MOV @IP+,PC
 382     ENDCODE IMMEDIATE
 383
 384 \ https://forth-standard.org/standard/core/THEN
 385 \ THEN     IFadr --                resolve forward branch
 386     CODE THEN
 387     MOV &DP,0(TOS)          \ -- IFadr
 388     MOV @PSP+,TOS           \ --
 389     MOV @IP+,PC
 390     ENDCODE IMMEDIATE
 391     [THEN]
 392
 393     [UNDEFINED] ELSE [IF]
 394 \ https://forth-standard.org/standard/core/ELSE
 395 \ ELSE     IFadr -- ELSEadr        resolve forward IF branch, leave ELSEadr on stack
 396     CODE ELSE
 397     ADD #4,&DP              \ make room to compile two words
 398     MOV &DP,W               \ W=HERE+4
 399     MOV #BRAN,-4(W)
 400     MOV W,0(TOS)            \ HERE+4 ==> [IFadr]
 401     SUB #2,W                \ HERE+2
 402     MOV W,TOS               \ -- ELSEadr
 403     MOV @IP+,PC
 404     ENDCODE IMMEDIATE
 405     [THEN]
 406
 407     [UNDEFINED] BEGIN [IF]  \ define BEGIN UNTIL AGAIN WHILE REPEAT
 408
 409 \ https://forth-standard.org/standard/core/BEGIN
 410 \ BEGIN    -- BEGINadr             initialize backward branch
 411     CODE BEGIN
 412     MOV #BEGIN,PC       \ execute ASM BEGIN !
 413     ENDCODE IMMEDIATE
 414
 415 \ https://forth-standard.org/standard/core/UNTIL
 416 \ UNTIL    BEGINadr --             resolve conditional backward branch
 417     CODE UNTIL
 418     MOV #QFBRAN,X
 419 BW1 ADD #4,&DP          \ compile two words
 420     MOV &DP,W           \ W = HERE
 421     MOV X,-4(W)         \ compile Bran or QFBRAN at HERE
 422     MOV TOS,-2(W)       \ compile bakcward adr at HERE+2
 423     MOV @PSP+,TOS
 424     MOV @IP+,PC
 425     ENDCODE IMMEDIATE
 426
 427 \ https://forth-standard.org/standard/core/AGAIN
 428 \ AGAIN    BEGINadr --             resolve uncondionnal backward branch
 429     CODE AGAIN
 430     MOV #BRAN,X
 431     GOTO BW1
 432     ENDCODE IMMEDIATE
 433
 434 \ https://forth-standard.org/standard/core/WHILE
 435 \ WHILE    BEGINadr -- WHILEadr BEGINadr
 436     : WHILE
 437     POSTPONE IF SWAP
 438     ; IMMEDIATE
 439
 440 \ https://forth-standard.org/standard/core/REPEAT
 441 \ REPEAT   WHILEadr BEGINadr --     resolve WHILE loop
 442     : REPEAT
 443     POSTPONE AGAIN POSTPONE THEN
 444     ; IMMEDIATE
 445     [THEN]
 446
 447     [UNDEFINED] DO [IF] \ define DO LOOP +LOOP
 448
 449     HDNCODE XDO         \ DO run time
 450     MOV #$8000,X        \ 2 compute 8000h-limit = "fudge factor"
 451     SUB @PSP+,X         \ 2
 452     MOV TOS,Y           \ 1 loop ctr = index+fudge
 453     ADD X,Y             \ 1 Y = INDEX
 454     PUSHM #2,X          \ 4 PUSHM X,Y, i.e. PUSHM LIMIT, INDEX
 455     MOV @PSP+,TOS       \ 2
 456     MOV @IP+,PC         \ 4
 457     ENDCODE
 458
 459 \ https://forth-standard.org/standard/core/DO
 460 \ DO       -- DOadr   L: -- 0
 461     CODE DO
 462     SUB #2,PSP          \
 463     MOV TOS,0(PSP)      \
 464     ADD #2,&DP          \   make room to compile xdo
 465     MOV &DP,TOS         \ -- HERE+2
 466     MOV #XDO,-2(TOS)    \   compile xdo
 467     ADD #2,&LEAVEPTR    \ -- HERE+2     LEAVEPTR+2
 468     MOV &LEAVEPTR,W     \
 469     MOV #0,0(W)         \ -- HERE+2     L-- 0, init
 470     MOV @IP+,PC
 471     ENDCODE IMMEDIATE
 472
 473     HDNCODE XLOOP       \   LOOP run time
 474     ADD #1,0(RSP)       \ 4 increment INDEX
 475 BW1 BIT #$100,SR        \ 2 is overflow bit set?
 476     0= IF               \   branch if no overflow
 477         MOV @IP,IP
 478         MOV @IP+,PC
 479     THEN
 480     ADD #4,RSP          \ 1 empties RSP
 481     ADD #2,IP           \ 1 overflow = loop done, skip branch ofs
 482     MOV @IP+,PC         \ 4 14~ taken or not taken xloop/loop
 483     ENDCODE             \
 484
 485 \ https://forth-standard.org/standard/core/LOOP
 486 \ LOOP    DOadr --         L-- an an-1 .. a1 0
 487     CODE LOOP
 488     MOV #XLOOP,X
 489 BW2 ADD #4,&DP          \ make room to compile two words
 490     MOV &DP,W
 491     MOV X,-4(W)         \ xloop --> HERE
 492     MOV TOS,-2(W)       \ DOadr --> HERE+2
 493     BEGIN                   \ resolve all "leave" adr
 494         MOV &LEAVEPTR,TOS   \ -- Adr of top LeaveStack cell
 495         SUB #2,&LEAVEPTR    \ --
 496         MOV @TOS,TOS        \ -- first LeaveStack value
 497         CMP #0,TOS          \ -- = value left by DO ?
 498     0<> WHILE
 499         MOV W,0(TOS)        \ move adr after loop as UNLOOP adr
 500     REPEAT
 501     MOV @PSP+,TOS
 502     MOV @IP+,PC
 503     ENDCODE IMMEDIATE
 504
 505 \ https://forth-standard.org/standard/core/PlusLOOP
 506 \ +LOOP   adrs --   L-- an an-1 .. a1 0
 507     HDNCODE XPLOO   \   +LOOP run time
 508     ADD TOS,0(RSP)  \ 4 increment INDEX by TOS value
 509     MOV @PSP+,TOS   \ 2 get new TOS, doesn't change flags
 510     GOTO BW1        \ 2
 511     ENDCODE         \
 512
 513     CODE +LOOP
 514     MOV #XPLOO,X
 515     GOTO BW2
 516     ENDCODE IMMEDIATE
 517     [THEN]
 518
 519     [UNDEFINED] I [IF]
 520 \ https://forth-standard.org/standard/core/I
 521 \ I        -- n   R: sys1 sys2 -- sys1 sys2
 522 \                  get the innermost loop index
 523     CODE I
 524     SUB #2,PSP              \ 1 make room in TOS
 525     MOV TOS,0(PSP)          \ 3
 526     MOV @RSP,TOS            \ 2 index = loopctr - fudge
 527     SUB 2(RSP),TOS          \ 3
 528     MOV @IP+,PC             \ 4 13~
 529     ENDCODE
 530     [THEN]
 531
 532     [UNDEFINED] J [IF]
 533 \ https://forth-standard.org/standard/core/J
 534 \ J        -- n   R: 4*sys -- 4*sys
 535 \ C                  get the second loop index
 536     CODE J
 537     SUB #2,PSP
 538     MOV TOS,0(PSP)
 539     MOV 4(RSP),TOS
 540     SUB 6(RSP),TOS
 541     MOV @IP+,PC
 542     ENDCODE
 543     [THEN]
 544
 545     [UNDEFINED] UNLOOP [IF]
 546 \ https://forth-standard.org/standard/core/UNLOOP
 547 \ UNLOOP   --   R: sys1 sys2 --  drop loop parms
 548     CODE UNLOOP
 549     ADD #4,RSP
 550     MOV @IP+,PC
 551     ENDCODE
 552     [THEN]
 553
 554     [UNDEFINED] LEAVE [IF]
 555 \ https://forth-standard.org/standard/core/LEAVE
 556 \ LEAVE    --    L: -- adrs
 557     CODE LEAVE
 558     MOV &DP,W               \ compile three words
 559     MOV #UNLOOP,0(W)        \ [HERE] = UNLOOP
 560     MOV #BRAN,2(W)          \ [HERE+2] = BRAN
 561     ADD #6,&DP              \ [HERE+4] = at adr After LOOP
 562     ADD #2,&LEAVEPTR
 563     ADD #4,W
 564     MOV &LEAVEPTR,X
 565     MOV W,0(X)              \ leave HERE+4 on LEAVEPTR stack
 566     MOV @IP+,PC
 567     ENDCODE IMMEDIATE
 568     [THEN]
 569
 570     [UNDEFINED] AND [IF]
 571 \ https://forth-standard.org/standard/core/AND
 572 \ C AND    x1 x2 -- x3           logical AND
 573     CODE AND
 574     AND @PSP+,TOS
 575     MOV @IP+,PC
 576     ENDCODE
 577     [THEN]
 578
 579     [UNDEFINED] OR [IF]
 580 \ https://forth-standard.org/standard/core/OR
 581 \ C OR     x1 x2 -- x3           logical OR (BIS, BIts Set)
 582     CODE OR
 583     BIS @PSP+,TOS
 584     AND #-1,TOS \ to set flags
 585     MOV @IP+,PC
 586     ENDCODE
 587     [THEN]
 588
 589     [UNDEFINED] XOR
 590     [IF]
 591 \ https://forth-standard.org/standard/core/XOR
 592 \ C XOR    x1 x2 -- x3           logical XOR
 593     CODE XOR
 594     XOR @PSP+,TOS
 595     MOV @IP+,PC
 596     ENDCODE
 597     [THEN]
 598
 599     [UNDEFINED] 1+ [IF]
 600 \ https://forth-standard.org/standard/core/OnePlus
 601 \ 1+      n1/u1 -- n2/u2       add 1 to TOS
 602     CODE 1+
 603     ADD #1,TOS
 604     MOV @IP+,PC
 605     ENDCODE
 606     [THEN]
 607
 608     [UNDEFINED] 1- [IF]
 609 \ https://forth-standard.org/standard/core/OneMinus
 610 \ 1-      n1/u1 -- n2/u2     subtract 1 from TOS
 611     CODE 1-
 612     SUB #1,TOS
 613     MOV @IP+,PC
 614     ENDCODE
 615     [THEN]
 616
 617     [UNDEFINED] INVERT [IF]
 618 \ https://forth-standard.org/standard/core/INVERT
 619 \ INVERT   x1 -- x2            bitwise inversion
 620     CODE INVERT
 621     XOR #-1,TOS
 622     MOV @IP+,PC
 623     ENDCODE
 624     [THEN]
 625
 626     [UNDEFINED] NEGATE [IF]
 627 \ https://forth-standard.org/standard/core/NEGATE
 628 \ C NEGATE   x1 -- x2            two's complement
 629     CODE NEGATE
 630     XOR #-1,TOS
 631     ADD #1,TOS
 632     MOV @IP+,PC
 633     ENDCODE
 634     [THEN]
 635
 636     [UNDEFINED] ABS [IF]
 637 \ https://forth-standard.org/standard/core/ABS
 638 \ C ABS     n1 -- +n2     absolute value
 639     CODE ABS
 640     CMP #0,TOS       \  1
 641     0>= IF
 642         MOV @IP+,PC
 643     THEN
 644     MOV #NEGATE,PC
 645     ENDCODE
 646     [THEN]
 647
 648     [UNDEFINED] LSHIFT [IF]
 649 \ https://forth-standard.org/standard/core/LSHIFT
 650 \ LSHIFT  x1 u -- x2    logical L shift u places
 651     CODE LSHIFT
 652     MOV @PSP+,W
 653     AND #$1F,TOS        \ no need to shift more than 16
 654     0<> IF
 655         BEGIN
 656             ADD W,W
 657             SUB #1,TOS
 658         0= UNTIL
 659     THEN
 660     MOV W,TOS
 661     MOV @IP+,PC
 662     ENDCODE
 663     [THEN]
 664
 665     [UNDEFINED] RSHIFT [IF]
 666 \ https://forth-standard.org/standard/core/RSHIFT
 667 \ RSHIFT  x1 u -- x2    logical R7 shift u places
 668     CODE RSHIFT
 669     MOV @PSP+,W
 670     AND #$1F,TOS       \ no need to shift more than 16
 671     0<> IF
 672         BEGIN
 673             BIC #C,SR           \ Clr Carry
 674             RRC W
 675             SUB #1,TOS
 676         0= UNTIL
 677     THEN
 678     MOV W,TOS
 679     MOV @IP+,PC
 680     ENDCODE
 681     [THEN]
 682
 683     [UNDEFINED] MAX [IF]    \ define MIN MAX
 684 \ https://forth-standard.org/standard/core/MAX
 685 \ MAX    n1 n2 -- n3       signed maximum
 686     CODE MAX
 687     CMP @PSP,TOS    \ n2-n1
 688     S<  ?GOTO FW1   \ n2<n1
 689 BW1 ADD #2,PSP
 690     MOV @IP+,PC
 691     ENDCODE
 692
 693 \ https://forth-standard.org/standard/core/MIN
 694 \ MIN    n1 n2 -- n3       signed minimum
 695     CODE MIN
 696     CMP @PSP,TOS    \ n2-n1
 697     S< ?GOTO BW1    \ n2<n1
 698 FW1 MOV @PSP+,TOS
 699     MOV @IP+,PC
 700     ENDCODE
 701     [THEN]
 702
 703     [UNDEFINED] 2* [IF]
 704 \ https://forth-standard.org/standard/core/TwoTimes
 705 \ 2*      x1 -- x2         arithmetic left shift
 706     CODE 2*
 707     ADD TOS,TOS
 708     MOV @IP+,PC
 709     ENDCODE
 710     [THEN]
 711
 712     [UNDEFINED] 2/ [IF]
 713 \ https://forth-standard.org/standard/core/TwoDiv
 714 \ 2/      x1 -- x2        arithmetic right shift
 715     CODE 2/
 716     RRA TOS
 717     MOV @IP+,PC
 718     ENDCODE
 719     [THEN]
 720
 721 \ --------------------
 722 \ ARITHMETIC OPERATORS
 723 \ --------------------
 724     RST_SET
 725
 726     CODE TSTBIT         \ addr bit_mask -- true/flase flag
 727     MOV @PSP+,X
 728     AND @X,TOS
 729     MOV @IP+,PC
 730     ENDCODE
 731
 732 \    $81EF DEVICEID @ U<
 733 \    DEVICEID @ $81F3 U<
 734 \    = [IF]   ; MSP430FR413x subfamily without hardware_MPY
 735     KERNEL_ADDON HMPY TSTBIT \   KERNEL_ADDON(BIT0) = hardware MPY flag
 736
 737     RST_RET
 738
 739     [IF]    ; MSP430FRxxxx subfamily with hardware_MPY
 740
 741         [UNDEFINED] UM* [IF]
 742 \ https://forth-standard.org/standard/core/MTimes
 743 \ M*     n1 n2 -- dlo dhi  signed 16*16->32 multiply
 744         CODE UM*
 745         MOV @PSP,&MPY       \ Load 1st operand for unsigned multiplication
 746 BW1     MOV TOS,&OP2        \ Load 2nd operand
 747         MOV &RES0,0(PSP)    \ low result on stack
 748         MOV &RES1,TOS       \ high result in TOS
 749         MOV @IP+,PC
 750         ENDCODE
 751
 752 \ https://forth-standard.org/standard/core/MTimes
 753 \ M*     n1 n2 -- dlo dhi  signed 16*16->32 multiply
 754         CODE M*
 755         MOV @PSP,&MPYS      \ Load 1st operand for signed multiplication
 756         GOTO BW1
 757         ENDCODE
 758         [THEN]
 759
 760     [ELSE]  ; MSP430FR413x without hardware_MPY
 761
 762         [UNDEFINED] UM* [IF]
 763 \ T.I. UNSIGNED MULTIPLY SUBROUTINE: U1 x U2 -> Ud
 764 \ https://forth-standard.org/standard/core/UMTimes
 765 \ UM*     u1 u2 -- ud   unsigned 16x16->32 mult.
 766         CODE UM*
 767         MOV @PSP,S              \2 ud1lo
 768         MOV #0,T                \1 ud1hi=0
 769         MOV #0,X                \1 RESlo=0
 770         MOV #0,Y                \1 REShi=0
 771         MOV #1,W                \1 BIT TEST REGISTER
 772         BEGIN
 773             BIT W,TOS           \1 TEST ACTUAL BIT ud2lo
 774             0<> IF
 775                 ADD S,X         \1 ADD ud1lo TO RESlo
 776                 ADDC T,Y        \1 ADDC ud1hi TO REShi
 777             THEN
 778             ADD S,S             \1 (RLA LSBs) ud1lo x 2
 779             ADDC T,T            \1 (RLC MSBs) ud1hi x 2
 780             ADD W,W             \1 (RLA) NEXT BIT TO TEST
 781         U>= UNTIL               \2 IF BIT IN CARRY: FINISHED    10~ loop
 782         MOV X,0(PSP)            \3 low result on stack
 783         MOV Y,TOS               \1 high result in TOS
 784         MOV @IP+,PC             \4 17 words
 785         ENDCODE
 786         [THEN]
 787
 788         [UNDEFINED] M* [IF]
 789 \ https://forth-standard.org/standard/core/UMTimes
 790 \ UM*     u1 u2 -- udlo udhi   unsigned 16x16->32 mult.
 791         CODE M*
 792         MOV @PSP,S          \ S= n1
 793         CMP #0,S            \ n1 > -1 ?
 794         S< IF
 795             XOR #-1,0(PSP)  \ n1 --> u1
 796             ADD #1,0(PSP)   \
 797         THEN
 798         XOR TOS,S           \ S contains sign of result
 799         CMP #0,TOS          \ n2 > -1 ?
 800         S< IF
 801             XOR #-1,TOS     \ n2 --> u2
 802             ADD #1,TOS      \
 803         THEN
 804         PUSHM #2,IP         \ UMSTAR use S,T,W,X,Y
 805         LO2HI               \ -- ud1 u2
 806         UM*
 807         HI2LO
 808         POPM #2,IP           \ pop S,IP
 809         CMP #0,S            \ sign of result > -1 ?
 810         S< IF
 811             XOR #-1,0(PSP)  \ ud --> d
 812             XOR #-1,TOS
 813             ADD #1,0(PSP)
 814             ADDC #0,TOS
 815         THEN
 816         MOV @IP+,PC
 817         ENDCODE
 818         [THEN]
 819     [THEN]  ;  endof hardware_MPY
 820
 821     [UNDEFINED] UM/MOD
 822     [IF]
 823 \ https://forth-standard.org/standard/core/UMDivMOD
 824 \ UM/MOD   udlo|udhi u1 -- r q   unsigned 32/16->r16 q16
 825     CODE UM/MOD
 826     PUSH #DROP      \
 827     MOV #MUSMOD,PC  \ execute MUSMOD then return to DROP
 828     ENDCODE
 829     [THEN]
 830
 831     KERNEL_ADDON @ 0<  ; test the switch: FLOORED/SYMETRIC DIVISION
 832     [IF]
 833         [UNDEFINED] FM/MOD [IF]
 834 \ https://forth-standard.org/standard/core/FMDivMOD
 835 \ FM/MOD   d1 n1 -- r q   floored signed div'n
 836         CODE FM/MOD
 837         MOV TOS,S           \           S=DIV
 838         MOV @PSP,T          \           T=DVDhi
 839         CMP #0,TOS          \           n2 >= 0 ?
 840         S< IF               \
 841             XOR #-1,TOS
 842             ADD #1,TOS      \ -- d1 u2
 843         THEN
 844         CMP #0,0(PSP)       \           d1hi >= 0 ?
 845         S< IF               \
 846             XOR #-1,2(PSP)  \           d1lo
 847             XOR #-1,0(PSP)  \           d1hi
 848             ADD #1,2(PSP)   \           d1lo+1
 849             ADDC #0,0(PSP)  \           d1hi+C
 850         THEN                \ -- uDVDlo uDVDhi uDIVlo
 851         PUSHM  #2,S         \ 4         PUSHM S,T
 852         CALL #MUSMOD
 853         MOV @PSP+,TOS
 854         POPM  #2,S          \ 4         POPM T,S
 855         CMP #0,T            \           T=DVDhi --> REM_sign
 856         S< IF
 857             XOR #-1,0(PSP)
 858             ADD #1,0(PSP)
 859         THEN
 860         XOR S,T             \           S=DIV XOR T=DVDhi = Quot_sign
 861         CMP #0,T            \ -- n3 u4  T=quot_sign
 862         S< IF
 863             XOR #-1,TOS
 864             ADD #1,TOS
 865         THEN                \ -- n3 n4  S=divisor
 866
 867         CMP #0,0(PSP)       \ remainder <> 0 ?
 868         0<> IF
 869             CMP #1,TOS      \ quotient < 1 ?
 870             S< IF
 871             ADD S,0(PSP)  \ add divisor to remainder
 872             SUB #1,TOS    \ decrement quotient
 873             THEN
 874         THEN
 875         MOV @IP+,PC
 876         ENDCODE
 877         [THEN]
 878     [ELSE]
 879         [UNDEFINED] SM/REM [IF]
 880 \ https://forth-standard.org/standard/core/SMDivREM
 881 \ SM/REM   DVDlo DVDhi DIV -- r3 q4  symmetric signed div
 882         CODE SM/REM
 883         MOV TOS,S           \           S=DIV
 884         MOV @PSP,T          \           T=DVDhi
 885         CMP #0,TOS          \           n2 >= 0 ?
 886         S< IF               \
 887             XOR #-1,TOS
 888             ADD #1,TOS      \ -- d1 u2
 889         THEN
 890         CMP #0,0(PSP)       \           d1hi >= 0 ?
 891         S< IF               \
 892             XOR #-1,2(PSP)  \           d1lo
 893             XOR #-1,0(PSP)  \           d1hi
 894             ADD #1,2(PSP)   \           d1lo+1
 895             ADDC #0,0(PSP)  \           d1hi+C
 896         THEN                \ -- uDVDlo uDVDhi uDIVlo
 897         PUSHM  #2,S         \ 4         PUSHM S,T
 898         CALL #MUSMOD
 899         MOV @PSP+,TOS
 900         POPM  #2,S          \ 4         POPM T,S
 901         CMP #0,T            \           T=DVDhi --> REM_sign
 902         S< IF
 903             XOR #-1,0(PSP)
 904             ADD #1,0(PSP)
 905         THEN
 906         XOR S,T             \           S=DIV XOR T=DVDhi = Quot_sign
 907         CMP #0,T            \ -- n3 u4  T=quot_sign
 908         S< IF
 909             XOR #-1,TOS
 910             ADD #1,TOS
 911         THEN                \ -- n3 n4  S=divisor
 912         MOV @IP+,PC
 913         ENDCODE
 914         [THEN]
 915     [THEN]
 916
 917     [UNDEFINED] * [IF]
 918 \ https://forth-standard.org/standard/core/Times
 919 \ *      n1 n2 -- n3       signed multiply
 920     : *
 921     M* DROP
 922     ;
 923     [THEN]
 924
 925     [UNDEFINED] /MOD [IF]
 926 \ https://forth-standard.org/standard/core/DivMOD
 927 \ /MOD   n1 n2 -- r3 q4     signed division
 928     : /MOD
 929     >R DUP 0< R>
 930     [ KERNEL_ADDON @ 0< ]   \ test the switch: FLOORED / SYMETRIC DIVISION
 931     [IF]    FM/MOD
 932     [ELSE]  SM/REM
 933     [THEN]
 934     ;
 935     [THEN]
 936
 937     [UNDEFINED] / [IF]
 938 \ https://forth-standard.org/standard/core/Div
 939 \ /      n1 n2 -- n3       signed quotient
 940     : /
 941     >R DUP 0< R>
 942     [ KERNEL_ADDON @ 0< ]   \ test the switch: FLOORED / SYMETRIC DIVISION
 943     [IF]    FM/MOD
 944     [ELSE]  SM/REM
 945     [THEN]
 946     NIP
 947     ;
 948     [THEN]
 949
 950     [UNDEFINED] MOD [IF]
 951 \ https://forth-standard.org/standard/core/MOD
 952 \ MOD    n1 n2 -- n3       signed remainder
 953     : MOD
 954     >R DUP 0< R>
 955     [ KERNEL_ADDON @ 0< ]   \ test the switch: FLOORED / SYMETRIC DIVISION
 956     [IF]    FM/MOD
 957     [ELSE]  SM/REM
 958     [THEN]
 959     DROP
 960     ;
 961     [THEN]
 962
 963     [UNDEFINED] */MOD [IF]
 964 \ https://forth-standard.org/standard/core/TimesDivMOD
 965 \ */MOD  n1 n2 n3 -- r4 q5    signed mult/div
 966     : */MOD
 967     >R M* R>
 968     [ KERNEL_ADDON @ 0< ]   \ test the switch: FLOORED / SYMETRIC DIVISION
 969     [IF]    FM/MOD
 970     [ELSE]  SM/REM
 971     [THEN]
 972     ;
 973     [THEN]
 974
 975     [UNDEFINED] */ [IF]
 976 \ https://forth-standard.org/standard/core/TimesDiv
 977 \ */     n1 n2 n3 -- n4        n1*n2/q3
 978     : */
 979     >R M* R>
 980     [ KERNEL_ADDON @ 0< ]   \ test the switch: FLOORED / SYMETRIC DIVISION
 981     [IF]    FM/MOD
 982     [ELSE]  SM/REM
 983     [THEN]
 984     NIP
 985     ;
 986     [THEN]
 987
 988 \ -------------------------------------------------------------------------------
 989 \  STACK OPERATIONS
 990 \ -------------------------------------------------------------------------------
 991     [UNDEFINED] ROT [IF]
 992 \ https://forth-standard.org/standard/core/ROT
 993 \ ROT    x1 x2 x3 -- x2 x3 x1
 994     CODE ROT
 995     MOV @PSP,W          \ 2 fetch x2
 996     MOV TOS,0(PSP)      \ 3 store x3
 997     MOV 2(PSP),TOS      \ 3 fetch x1
 998     MOV W,2(PSP)        \ 3 store x2
 999     MOV @IP+,PC
1000     ENDCODE
1001     [THEN]
1002
1003     [UNDEFINED] R@ [IF]
1004 \ https://forth-standard.org/standard/core/RFetch
1005 \ R@    -- x     R: x -- x   fetch from return stack
1006     CODE R@
1007     SUB #2,PSP
1008     MOV TOS,0(PSP)
1009     MOV @RSP,TOS
1010     MOV @IP+,PC
1011     ENDCODE
1012     [THEN]
1013
1014     [UNDEFINED] TUCK [IF]
1015 \ https://forth-standard.org/standard/core/TUCK
1016 \ TUCK  ( x1 x2 -- x2 x1 x2 )
1017     : TUCK SWAP OVER ;
1018     [THEN]
1019
1020 \ ----------------------------------------------------------------------
1021 \ DOUBLE OPERATORS
1022 \ ----------------------------------------------------------------------
1023     [UNDEFINED] 2@ [IF]
1024 \ https://forth-standard.org/standard/core/TwoFetch
1025 \ 2@    a-addr -- x1 x2    fetch 2 cells ; the lower address will appear on top of stack
1026     CODE 2@
1027     SUB #2,PSP
1028     MOV 2(TOS),0(PSP)
1029     MOV @TOS,TOS
1030     MOV @IP+,PC
1031     ENDCODE
1032     [THEN]
1033
1034     [UNDEFINED] 2! [IF]
1035 \ https://forth-standard.org/standard/core/TwoStore
1036 \ 2!    x1 x2 a-addr --    store 2 cells ; the top of stack is stored at the lower adr
1037     CODE 2!
1038     MOV @PSP+,0(TOS)
1039     MOV @PSP+,2(TOS)
1040     MOV @PSP+,TOS
1041     MOV @IP+,PC
1042     ENDCODE
1043     [THEN]
1044
1045     [UNDEFINED] 2DUP [IF]
1046 \ https://forth-standard.org/standard/core/TwoDUP
1047 \ 2DUP   x1 x2 -- x1 x2 x1 x2   dup top 2 cells
1048     CODE 2DUP
1049     MOV @PSP,-4(PSP)    \ 4
1050     MOV TOS,-2(PSP)     \ 3
1051     SUB #4,PSP          \ 1
1052     MOV @IP+,PC         \ 4
1053     ENDCODE
1054     [THEN]
1055
1056     [UNDEFINED] 2DROP [IF]
1057 \ https://forth-standard.org/standard/core/TwoDROP
1058 \ 2DROP  x1 x2 --          drop 2 cells
1059     CODE 2DROP
1060     ADD #2,PSP
1061     MOV @PSP+,TOS
1062     MOV @IP+,PC
1063     ENDCODE
1064     [THEN]
1065
1066     [UNDEFINED] 2SWAP [IF]
1067 \ https://forth-standard.org/standard/core/TwoSWAP
1068 \ 2SWAP  x1 x2 x3 x4 -- x3 x4 x1 x2
1069     CODE 2SWAP
1070     MOV @PSP,W          \ -- x1 x2 x3 x4    W=x3
1071     MOV 4(PSP),0(PSP)   \ -- x1 x2 x1 x4
1072     MOV W,4(PSP)        \ -- x3 x2 x1 x4
1073     MOV TOS,W           \ -- x3 x2 x1 x4    W=x4
1074     MOV 2(PSP),TOS      \ -- x3 x2 x1 x2    W=x4
1075     MOV W,2(PSP)        \ -- x3 x4 x1 x2
1076     MOV @IP+,PC
1077     ENDCODE
1078     [THEN]
1079
1080     [UNDEFINED] 2OVER [IF]
1081 \ https://forth-standard.org/standard/core/TwoOVER
1082 \ 2OVER  x1 x2 x3 x4 -- x1 x2 x3 x4 x1 x2
1083     CODE 2OVER
1084     SUB #4,PSP          \ -- x1 x2 x3 x x x4
1085     MOV TOS,2(PSP)      \ -- x1 x2 x3 x4 x x4
1086     MOV 8(PSP),0(PSP)   \ -- x1 x2 x3 x4 x1 x4
1087     MOV 6(PSP),TOS      \ -- x1 x2 x3 x4 x1 x2
1088     MOV @IP+,PC
1089     ENDCODE
1090     [THEN]
1091
1092 \ ----------------------------------------------------------------------
1093 \ ALIGNMENT OPERATORS
1094 \ ----------------------------------------------------------------------
1095     [UNDEFINED] ALIGNED [IF]
1096 \ https://forth-standard.org/standard/core/ALIGNED
1097 \ ALIGNED  addr -- a-addr       align given addr
1098     CODE ALIGNED
1099     BIT #1,TOS
1100     ADDC #0,TOS
1101     MOV @IP+,PC
1102     ENDCODE
1103     [THEN]
1104
1105     [UNDEFINED] ALIGN [IF]
1106 \ https://forth-standard.org/standard/core/ALIGN
1107 \ ALIGN    --                         align HERE
1108     CODE ALIGN
1109     BIT #1,&DP  \ 3
1110     ADDC #0,&DP \ 4
1111     MOV @IP+,PC
1112     ENDCODE
1113     [THEN]
1114
1115 \ ---------------------
1116 \ PORTABILITY OPERATORS
1117 \ ---------------------
1118     [UNDEFINED] CHARS [IF]
1119 \ https://forth-standard.org/standard/core/CHARS
1120 \ CHARS    n1 -- n2            chars->adrs units
1121     CODE CHARS
1122     MOV @IP+,PC
1123     ENDCODE
1124     [THEN]
1125
1126     [UNDEFINED] CHAR+ [IF]
1127 \ https://forth-standard.org/standard/core/CHARPlus
1128 \ CHAR+    c-addr1 -- c-addr2   add char size
1129     CODE CHAR+
1130     ADD #1,TOS
1131     MOV @IP+,PC
1132     ENDCODE
1133     [THEN]
1134
1135     [UNDEFINED] CELLS [IF]
1136 \ https://forth-standard.org/standard/core/CELLS
1137 \ CELLS    n1 -- n2            cells->adrs units
1138     CODE CELLS
1139     ADD TOS,TOS
1140     MOV @IP+,PC
1141     ENDCODE
1142     [THEN]
1143
1144     [UNDEFINED] CELL+ [IF]
1145 \ https://forth-standard.org/standard/core/CELLPlus
1146 \ CELL+    a-addr1 -- a-addr2      add cell size
1147     CODE CELL+
1148     ADD #2,TOS
1149     MOV @IP+,PC
1150     ENDCODE
1151     [THEN]
1152
1153 \ ---------------------------
1154 \ BLOCK AND STRING COMPLEMENT
1155 \ ---------------------------
1156
1157     [UNDEFINED] CHAR [IF]
1158 \ https://forth-standard.org/standard/core/CHAR
1159 \ CHAR   -- char           parse ASCII character
1160     : CHAR
1161     $20 WORD 1+ C@
1162     ;
1163     [THEN]
1164
1165     [UNDEFINED] [CHAR] [IF]
1166 \ https://forth-standard.org/standard/core/BracketCHAR
1167 \ [CHAR]   --          compile character literal
1168     : [CHAR]
1169     CHAR POSTPONE LITERAL
1170     ; IMMEDIATE
1171     [THEN]
1172
1173     [UNDEFINED] +! [IF]
1174 \ https://forth-standard.org/standard/core/PlusStore
1175 \ +!     n/u a-addr --       add n/u to memory
1176     CODE +!
1177     ADD @PSP+,0(TOS)
1178     MOV @PSP+,TOS
1179     MOV @IP+,PC
1180     ENDCODE
1181     [THEN]
1182
1183     [UNDEFINED] MOVE [IF]
1184 \ https://forth-standard.org/standard/core/MOVE
1185 \ MOVE    addr1 addr2 u --     smart move
1186 \             VERSION FOR 1 ADDRESS UNIT = 1 CHAR
1187     CODE MOVE
1188     MOV TOS,W           \ W = cnt
1189     MOV @PSP+,Y         \ Y = addr2 = dst
1190     MOV @PSP+,X         \ X = addr1 = src
1191     MOV @PSP+,TOS       \ pop new TOS
1192     CMP #0,W            \ count = 0 ?
1193     0<> IF              \ if 0, already done !
1194         CMP X,Y         \ dst = src ?
1195         0<> IF          \ if 0, already done !
1196             U< IF       \ U< if src > dst
1197                 BEGIN   \ copy W bytes
1198                     MOV.B @X+,0(Y)
1199                     ADD #1,Y
1200                     SUB #1,W
1201                 0= UNTIL
1202                 MOV @IP+,PC \ out 1 of MOVE ====>
1203             THEN        \ U>= if dst > src
1204             ADD W,Y     \ copy W bytes beginning with the end
1205             ADD W,X
1206             BEGIN
1207                 SUB #1,X
1208                 SUB #1,Y
1209                 MOV.B @X,0(Y)
1210                 SUB #1,W
1211             0= UNTIL
1212         THEN
1213     THEN
1214     MOV @IP+,PC \ out 2 of MOVE ====>
1215     ENDCODE
1216     [THEN]
1217
1218     [UNDEFINED] FILL [IF]
1219 \ https://forth-standard.org/standard/core/FILL
1220 \ FILL   c-addr u char --  fill memory with char
1221     CODE FILL
1222     MOV @PSP+,X     \ count
1223     MOV @PSP+,W     \ address
1224     CMP #0,X
1225     0<> IF
1226         BEGIN
1227             MOV.B TOS,0(W)    \ store char in memory
1228             ADD #1,W
1229             SUB #1,X
1230         0= UNTIL
1231     THEN
1232     MOV @PSP+,TOS     \ empties stack
1233     MOV @IP+,PC
1234     ENDCODE
1235     [THEN]
1236
1237 \ --------------------
1238 \ INTERPRET COMPLEMENT
1239 \ --------------------
1240     [UNDEFINED] HEX [IF]
1241 \ https://forth-standard.org/standard/core/HEX
1242     CODE HEX
1243     MOV #$10,&BASEADR
1244     MOV @IP+,PC
1245     ENDCODE
1246     [THEN]
1247
1248     [UNDEFINED] DECIMAL [IF]
1249     \ https://forth-standard.org/standard/core/DECIMAL
1250     CODE DECIMAL
1251     MOV #$0A,&BASEADR
1252     MOV @IP+,PC
1253     ENDCODE
1254     [THEN]
1255
1256     [UNDEFINED] ( [IF]
1257 \ https://forth-standard.org/standard/core/p
1258 \ (         --          skip input until char ) or EOL
1259     : (
1260     ')' WORD DROP
1261     ; IMMEDIATE
1262     [THEN]
1263
1264     [UNDEFINED] .( [IF] ; "
1265 \ https://forth-standard.org/standard/core/Dotp
1266 \ .(        --          type comment immediatly.
1267     CODE .(         ; "
1268     MOV #0,T            \ CAPS OFF
1269     COLON
1270     ')'
1271     [ ' WORD 16 + , ]   \ for volatile CAPS OFF
1272     COUNT TYPE
1273     HI2LO
1274     MOV @RSP+,IP
1275     MOV @IP+,PC
1276     ENDCODE IMMEDIATE
1277     [THEN]
1278
1279     [UNDEFINED] >BODY [IF]
1280 \ https://forth-standard.org/standard/core/toBODY
1281 \ >BODY     -- addr      leave BODY of a CREATEd word\ also leave default ACTION-OF primary DEFERred word
1282     CODE >BODY
1283     ADD #4,TOS
1284     MOV @IP+,PC
1285     ENDCODE
1286     [THEN]
1287
1288     [UNDEFINED] EXECUTE [IF]
1289 \ https://forth-standard.org/standard/core/EXECUTE
1290 \ EXECUTE   i*x xt -- j*x   execute Forth word at 'xt'
1291     CODE EXECUTE
1292     MOV #EXECUTE,PC
1293     ENDCODE
1294     [THEN]
1295
1296     [UNDEFINED] EVALUATE [IF]
1297 \ EVALUATE upside down...
1298     CODENNM                 \ as the end of EVALUATE
1299     MOV @RSP+,&TOIN         \ 4
1300     MOV @RSP+,&SOURCE_ORG   \ 4
1301     MOV @RSP+,&SOURCE_LEN   \ 4
1302     MOV @RSP+,IP
1303     MOV @IP+,PC
1304     ENDCODE                 \   -- end_of_EVALUATE_addr
1305
1306 \ https://forth-standard.org/standard/core/EVALUATE
1307 \ EVALUATE          \ i*x c-addr u -- j*x  interpret string
1308     CODE EVALUATE
1309     MOV #SOURCE_LEN,X       \ 2
1310     MOV @X+,S               \ 2 S = SOURCE_LEN
1311     MOV @X+,T               \ 2 T = SOURCE_ORG
1312     MOV @X+,W               \ 2 W = TOIN
1313     PUSHM #4,IP             \ 6 PUSHM IP,S,T,W
1314     MOV PC,IP               \ 1
1315     ADD #8,IP               \ 1 IP = ENDCODE PC address
1316     MOV #INTERPRET,PC       \ 3 addr defined in MSP430FRxxxx.pat
1317     NOP                     \ 0 stuffing instruction (never executed)
1318     ENDCODE                 \
1319     ,                       \ end_of_EVALUATE_addr   --         compile the end_of_EVALUATE_addr
1320
1321     [THEN]
1322
1323     [UNDEFINED] RECURSE [IF]
1324 \ https://forth-standard.org/standard/core/RECURSE
1325 \ C RECURSE  --      recurse to current definition
1326     CODE RECURSE
1327     MOV &DP,X
1328     MOV &LAST_CFA,0(X)
1329     ADD #2,&DP
1330     MOV @IP+,PC
1331     ENDCODE IMMEDIATE
1332     [THEN]
1333
1334     [UNDEFINED] SOURCE [IF]
1335 \ https://forth-standard.org/standard/core/SOURCE
1336 \ SOURCE    -- adr u    of current input buffer
1337     CODE SOURCE
1338     SUB #4,PSP
1339     MOV TOS,2(PSP)
1340     MOV &SOURCE_LEN,TOS
1341     MOV &SOURCE_ORG,0(PSP)
1342     MOV @IP+,PC
1343     ENDCODE
1344     [THEN]
1345
1346     [UNDEFINED] VARIABLE [IF]
1347 \ https://forth-standard.org/standard/core/VARIABLE
1348 \ VARIABLE <name>       --                      define a Forth VARIABLE
1349     : VARIABLE
1350     CREATE
1351     HI2LO
1352     MOV #DOVAR,-4(W)        \   CFA = CALL rDOVAR
1353     MOV @RSP+,IP
1354     MOV @IP+,PC
1355     ENDCODE
1356     [THEN]
1357
1358     [UNDEFINED] CONSTANT [IF]
1359 \ https://forth-standard.org/standard/core/CONSTANT
1360 \ CONSTANT <name>     n --                      define a Forth CONSTANT
1361     : CONSTANT
1362     CREATE
1363     HI2LO
1364     MOV TOS,-2(W)           \   PFA = n
1365     MOV @PSP+,TOS
1366     MOV @RSP+,IP
1367     MOV @IP+,PC
1368     ENDCODE
1369     [THEN]
1370
1371     [UNDEFINED] STATE [IF]
1372 \ https://forth-standard.org/standard/core/STATE
1373 \ STATE   -- a-addr       holds compiler state
1374     STATEADR CONSTANT STATE
1375     [THEN]
1376
1377     [UNDEFINED] BASE [IF]
1378 \ https://forth-standard.org/standard/core/BASE
1379 \ BASE    -- a-addr       holds conversion radix
1380     BASEADR  CONSTANT BASE
1381     [THEN]
1382
1383     [UNDEFINED] >IN [IF]
1384 \ https://forth-standard.org/standard/core/toIN
1385 \ C >IN     -- a-addr       holds offset in input stream
1386     TOIN CONSTANT >IN
1387     [THEN]
1388
1389     [UNDEFINED] PAD [IF]
1390 \ https://forth-standard.org/standard/core/PAD
1391 \  PAD           --  addr
1392     PAD_ORG CONSTANT PAD
1393     [THEN]
1394
1395     [UNDEFINED] BL [IF]
1396 \ https://forth-standard.org/standard/core/BL
1397 \ BL      -- char            an ASCII space
1398     'SP' CONSTANT BL
1399     [THEN]
1400
1401     [UNDEFINED] SPACE [IF]
1402 \ https://forth-standard.org/standard/core/SPACE
1403 \ SPACE   --               output a space
1404     : SPACE
1405     'SP' EMIT ;
1406     [THEN]
1407
1408     [UNDEFINED] SPACES [IF]
1409 \ https://forth-standard.org/standard/core/SPACES
1410 \ SPACES   n --            output n spaces
1411     : SPACES
1412     BEGIN
1413         ?DUP
1414     WHILE
1415         'SP' EMIT
1416         1-
1417     REPEAT
1418     ;
1419     [THEN]
1420
1421     [UNDEFINED] DEFER [IF]
1422 \ https://forth-standard.org/standard/core/DEFER
1423 \ Skip leading space delimiters. Parse name delimited by a space.
1424 \ Create a definition for name with the execution semantics defined below.
1425 \
1426 \ name Execution:   --
1427 \ Execute the xt that name is set to execute, i.e. NEXT (nothing),
1428 \ until the phrase ' word IS name is executed, causing a new value of xt to be assigned to name.
1429     : DEFER                 \ useless definition for FAST FORTH...
1430     CREATE
1431     HI2LO
1432     MOV #$4030,-4(W)        \4 first CELL = MOV @PC+,PC = BR #addr
1433     MOV #NEXT_ADR,-2(W)     \3 second CELL              =   ...mNEXT : do nothing by default
1434     MOV @RSP+,IP
1435     MOV @IP+,PC
1436     ENDCODE
1437     [THEN]
1438
1439     [UNDEFINED] CR [IF]
1440 \ https://forth-standard.org/standard/core/CR
1441 \ CR      --               send CR+LF to the output device
1442 \    DEFER CR
1443 \
1444 \    :NONAME
1445 \    'CR' EMIT 'LF' EMIT
1446 \    ; IS CR
1447 \
1448     CODE CR
1449     MOV #NEXT_ADR,PC    \ compile same as DEFER
1450     ENDCODE
1451
1452     :NONAME
1453     'CR' EMIT 'LF' EMIT
1454     ; IS CR
1455     [THEN]
1456
1457     [UNDEFINED] TO [IF]
1458 \ https://forth-standard.org/standard/core/TO
1459 \ TO name Run-time: ( x -- )
1460 \ Assign the value x to named VALUE.
1461     CODE TO
1462     BIS #UF9,SR
1463     MOV @IP+,PC
1464     ENDCODE
1465     [THEN]
1466
1467     [UNDEFINED] VALUE [IF]
1468 \ https://forth-standard.org/standard/core/VALUE
1469 \ ( x "<spaces>name" -- )                      define a Forth VALUE
1470 \ Skip leading space delimiters. Parse name delimited by a space.
1471 \ Create a definition for name with the execution semantics defined below,
1472 \ with an initial value equal to x.
1473 \
1474 \ name Execution: ( -- x )
1475 \ Place x on the stack. The value of x is that given when name was created,
1476 \ until the phrase x TO name is executed, causing a new value of x to be assigned to name.
1477     : VALUE             \ x "<spaces>name" --
1478     CREATE ,
1479     DOES>
1480     HI2LO
1481     MOV @RSP+,IP
1482     BIT #UF9,SR         \ 2 see TO
1483     0= IF               \ 2 if UF9 is not set
1484         MOV #@,PC       \       execute FETCH
1485     THEN                \   else
1486     BIC #UF9,SR         \ 2     clear UF9 flag
1487     MOV #!,PC           \       execute STORE
1488     ENDCODE
1489     [THEN]
1490
1491     [UNDEFINED] CASE [IF]   \ define CASE OF ENDOF ENDCASE
1492
1493 \ https://forth-standard.org/standard/core/CASE
1494     : CASE
1495     0
1496     ; IMMEDIATE \ -- #of-1
1497
1498 \ https://forth-standard.org/standard/core/OF
1499     : OF \ #of-1 -- orgOF #of
1500     1+                      \ count OFs
1501     >R                      \ move off the stack in case the control-flow stack is the data stack.
1502     POSTPONE OVER POSTPONE = \ copy and test case value
1503     POSTPONE IF             \ add orig to control flow stack
1504     POSTPONE DROP               \ discards case value if =
1505     R>                      \ we can bring count back now
1506     ; IMMEDIATE
1507
1508 \ https://forth-standard.org/standard/core/ENDOF
1509     : ENDOF \ orgOF #of -- orgENDOF #of
1510     >R                      \ move off the stack in case the control-flow stack is the data stack.
1511     POSTPONE ELSE
1512     R>                      \ we can bring count back now
1513     ; IMMEDIATE
1514
1515 \ https://forth-standard.org/standard/core/ENDCASE
1516     : ENDCASE \ orgENDOF1..orgENDOFn #of --
1517     POSTPONE DROP
1518     0 DO POSTPONE THEN
1519     LOOP
1520     ; IMMEDIATE
1521     [THEN]
1522
1523     RST_SET
1524
1525     [THEN]
1526
1527     ECHO
1528
1529 ; CORE_ANS.f is loaded