MSP430-FORTH/CORE_ANS.f

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