ADDON/CORE_ANS.asm

   1 ; -*- coding: utf-8 -*-
   2
   3     FORTHWORD "{CORE_ANS}"
   4     MOV @IP+,PC
   5
   6 ;-------------------------------------------------------------------------------
   7 ; RETURN from high level word
   8 ;-------------------------------------------------------------------------------
   9             FORTHWORD "EXIT"
  10 ; https://forth-standard.org/standard/core/EXIT
  11 ; EXIT     --      exit a colon definition; CALL #EXIT performs ASMtoFORTH (10 cycles)
  12 ;                                           JMP #EXIT performs EXIT
  13             MOV @RSP+,IP    ; 2 pop previous IP (or next PC) from return stack
  14             MOV @IP+,PC     ; 4 = NEXT
  15                             ; 6 (ITC-2)
  16
  17 ;https://forth-standard.org/standard/core/SPACE
  18 ;C SPACE   --               output a space
  19             FORTHWORD "SPACE"
  20 SPACE       SUB #2,PSP              ;1
  21             MOV TOS,0(PSP)          ;3
  22             MOV #20h,TOS            ;2
  23             JMP EMIT                ;17~  23~
  24
  25 ;https://forth-standard.org/standard/core/SPACES
  26 ;C SPACES   n --            output n spaces
  27             FORTHWORD "SPACES"
  28 SPACES      CMP #0,TOS
  29             JZ SPACESNEXT2
  30             PUSH IP
  31             MOV #SPACESNEXT,IP
  32             JMP SPACE               ;25~
  33 SPACESNEXT  .word   $+2
  34             SUB #2,IP               ;1
  35             SUB #1,TOS              ;1
  36             JNZ SPACE               ;25~ ==> 27~ by space ==> 2.963 MBds @ 8 MHz
  37             MOV @RSP+,IP            ;
  38 SPACESNEXT2 MOV @PSP+,TOS           ; --         drop n
  39             MOV @IP+,PC                   ;
  40
  41     .IFDEF MPY
  42
  43 ;https://forth-standard.org/standard/core/UMTimes
  44 ;C UM*     u1 u2 -- ud   unsigned 16x16->32 mult.
  45             FORTHWORD "UM*"
  46 UMSTAR      MOV @PSP,&MPY       ; Load 1st operand
  47             MOV TOS,&OP2        ; Load 2nd operand
  48             MOV &RES0,0(PSP)    ; low result on stack
  49             MOV &RES1,TOS       ; high result in TOS
  50             MOV @IP+,PC
  51
  52 ;https://forth-standard.org/standard/core/MTimes
  53 ;C M*     n1 n2 -- dlo dhi  signed 16*16->32 multiply
  54             FORTHWORD "M*"
  55 MSTAR       MOV @PSP,&MPYS
  56             MOV TOS,&OP2
  57             MOV &RES0,0(PSP)
  58             MOV &RES1,TOS
  59             MOV @IP+,PC
  60
  61     .ELSE
  62
  63 ;https://forth-standard.org/standard/core/MTimes
  64 ;C M*     n1 n2 -- dlo dhi  signed 16*16->32 multiply
  65             FORTHWORD "M*"
  66 MSTAR       MOV TOS,S           ; TOS= n2
  67             XOR @PSP,S          ; S contains sign of result
  68             CMP #0,0(PSP)       ; n1 > -1 ?
  69             JGE u1n2MSTAR       ; yes
  70             XOR #-1,0(PSP)      ; no : n1 --> u1
  71             ADD #1,0(PSP)       ;
  72 u1n2MSTAR   CMP #0,TOS          ; n2 <= -1 ?
  73             JGE u1u2MSTAR       ; no
  74             XOR #-1,TOS         ; y: n2 --> u2
  75             ADD #1,TOS          ;
  76 u1u2MSTAR   PUSHM #2,IP         ;           PUSHM IP,S
  77             ASMtoFORTH
  78             .word UMSTAR        ; UMSTAR use S,T,W,X,Y
  79             .word   $+2
  80             POPM #2,IP          ;           POPM S,IP
  81             CMP #0,S            ; result > -1 ?
  82             JGE MSTARend        ; yes
  83             XOR #-1,0(PSP)      ; no : ud --> d
  84             XOR #-1,TOS
  85             ADD #1,0(PSP)
  86             ADDC #0,TOS
  87 MSTARend    MOV @IP+,PC
  88
  89     .ENDIF ;MPY
  90
  91 ;https://forth-standard.org/standard/core/UMDivMOD
  92 ; UM/MOD   udlo|udhi u1 -- r q   unsigned 32/16->r16 q16
  93             FORTHWORD "UM/MOD"
  94 UMSLASHMOD  PUSH #DROP          ;3 as return address for MU/MOD
  95             MOV #MUSMOD,PC
  96
  97 ;https://forth-standard.org/standard/core/SMDivREM
  98 ;C SM/REM   d1lo d1hi n2 -- n3 n4  symmetric signed div
  99             FORTHWORD "SM/REM"
 100 SMSLASHREM  MOV TOS,S           ;1            S=divisor
 101             MOV @PSP,T          ;2            T=rem_sign
 102             CMP #0,TOS          ;1            n2 >= 0 ?
 103             JGE d1u2SMSLASHREM  ;2            yes
 104             XOR #-1,TOS         ;1
 105             ADD #1,TOS          ;1
 106 d1u2SMSLASHREM                  ;   -- d1 u2
 107             CMP #0,0(PSP)       ;3           d1hi >= 0 ?
 108             JGE ud1u2SMSLASHREM ;2           yes
 109             XOR #-1,2(PSP)      ;4           d1lo
 110             XOR #-1,0(PSP)      ;4           d1hi
 111             ADD #1,2(PSP)       ;4           d1lo+1
 112             ADDC #0,0(PSP)      ;4           d1hi+C
 113 ud1u2SMSLASHREM                 ;   -- ud1 u2
 114             PUSHM  #2,S          ;4         PUSHM S,T
 115             CALL #MUSMOD
 116             MOV @PSP+,TOS
 117             POPM  #2,S          ;4          POPM T,S
 118             CMP #0,T            ;1  -- ur uq  T=rem_sign>=0?
 119             JGE SMSLASHREMnruq  ;2           yes
 120             XOR #-1,0(PSP)      ;3
 121             ADD #1,0(PSP)       ;3
 122 SMSLASHREMnruq
 123             XOR S,T             ;1           S=divisor T=quot_sign
 124             CMP #0,T            ;1  -- nr uq  T=quot_sign>=0?
 125             JGE SMSLASHREMnrnq  ;2           yes
 126 NEGAT       XOR #-1,TOS         ;1
 127             ADD #1,TOS          ;1
 128 SMSLASHREMnrnq                  ;   -- nr nq  S=divisor
 129             MOV @IP+,PC         ;4 34 words
 130
 131 ;https://forth-standard.org/standard/core/FMDivMOD
 132 ;C FM/MOD   d1 n1 -- r q   floored signed div'n
 133             FORTHWORD "FM/MOD"
 134 FMSLASHMOD  PUSH IP
 135             MOV #FMSLASHMOD1,IP
 136             JMP SMSLASHREM
 137 FMSLASHMOD1 .word   $+2         ; -- remainder quotient       S=divisor
 138             CMP #0,0(PSP)       ;
 139             JZ FMSLASHMODEND
 140             CMP #1,TOS          ; quotient < 1 ?
 141             JGE FMSLASHMODEND   ;
 142 QUOTLESSONE ADD S,0(PSP)        ; add divisor to remainder
 143             SUB #1,TOS          ; decrement quotient
 144 FMSLASHMODEND
 145             MOV @RSP+,IP
 146             MOV @IP+,PC                   ;
 147
 148 ;https://forth-standard.org/standard/core/NEGATE
 149 ;C NEGATE   x1 -- x2            two's complement
 150             FORTHWORD "NEGATE"
 151             JMP NEGAT
 152
 153 ;https://forth-standard.org/standard/core/ABS
 154 ;C ABS     n1 -- +n2     absolute value
 155             FORTHWORD "ABS"
 156             CMP #0,TOS           ; 1
 157             JN NEGAT
 158             MOV @IP+,PC
 159
 160 ;https://forth-standard.org/standard/core/Times
 161 ;C *      n1 n2 -- n3       signed multiply
 162             FORTHWORD "*"
 163 STAR        mDOCOL
 164             .word   MSTAR,DROP,EXIT
 165
 166 ;https://forth-standard.org/standard/core/DivMOD
 167 ;C /MOD   n1 n2 -- n3 n4    signed divide/rem'dr
 168             FORTHWORD "/MOD"
 169 SLASHMOD    mDOCOL
 170             .word   TOR,STOD,RFROM,FMSLASHMOD,EXIT
 171
 172 ;https://forth-standard.org/standard/core/Div
 173 ;C /      n1 n2 -- n3       signed divide
 174             FORTHWORD "/"
 175 SLASH       mDOCOL
 176             .word   TOR,STOD,RFROM,FMSLASHMOD,NIP,EXIT
 177
 178 ;https://forth-standard.org/standard/core/MOD
 179 ;C MOD    n1 n2 -- n3       signed remainder
 180             FORTHWORD "MOD"
 181 MODD        mDOCOL
 182             .word   TOR,STOD,RFROM,FMSLASHMOD,DROP,EXIT
 183
 184 ;https://forth-standard.org/standard/core/TimesDivMOD
 185 ;C */MOD  n1 n2 n3 -- n4 n5    n1*n2/n3, rem&quot
 186             FORTHWORD "*/MOD"
 187 SSMOD       mDOCOL
 188             .word   TOR,MSTAR,RFROM,FMSLASHMOD,EXIT
 189
 190 ;https://forth-standard.org/standard/core/TimesDiv
 191 ;C */     n1 n2 n3 -- n4        n1*n2/n3
 192             FORTHWORD "*/"
 193 STARSLASH   mDOCOL
 194             .word   TOR,MSTAR,RFROM,FMSLASHMOD,NIP,EXIT
 195
 196
 197
 198 ;https://forth-standard.org/standard/core/ALIGNED
 199 ;C ALIGNED  addr -- a-addr       align given addr
 200             FORTHWORD "ALIGNED"
 201 ALIGNED     BIT #1,TOS
 202             ADDC #0,TOS
 203             MOV @IP+,PC
 204
 205 ;https://forth-standard.org/standard/core/ALIGN
 206 ;C ALIGN    --                         align HERE
 207             FORTHWORD "ALIGN"
 208 ALIGNN      BIT #1,&DDP    ; 3
 209             ADDC #0,&DDP   ; 4
 210             MOV @IP+,PC
 211
 212 ;https://forth-standard.org/standard/core/CHARS
 213 ;C CHARS    n1 -- n2            chars->adrs units
 214             FORTHWORD "CHARS"
 215             MOV @IP+,PC
 216
 217 ;https://forth-standard.org/standard/core/CHARPlus
 218 ;C CHAR+    c-addr1 -- c-addr2   add char size
 219             FORTHWORD "CHAR+"
 220             ADD #1,TOS
 221             MOV @IP+,PC
 222
 223 ;https://forth-standard.org/standard/core/CELLS
 224 ;C CELLS    n1 -- n2            cells->adrs units
 225             FORTHWORD "CELLS"
 226             ADD TOS,TOS
 227             MOV @IP+,PC
 228
 229 ;https://forth-standard.org/standard/core/CELLPlus
 230 ;C CELL+    a-addr1 -- a-addr2      add cell size
 231             FORTHWORD "CELL+"
 232             ADD #2,TOS
 233             MOV @IP+,PC
 234
 235 ;----------------------------------------------------------------------
 236 ; DOUBLE OPERATORS
 237 ;----------------------------------------------------------------------
 238
 239 ; https://forth-standard.org/standard/core/StoD
 240 ; S>D    n -- d          single -> double prec.
 241             FORTHWORD "S>D"
 242 STOD        SUB #2,PSP
 243             MOV TOS,0(PSP)
 244             JMP ZEROLESS
 245
 246 ; https://forth-standard.org/standard/core/TwoFetch
 247 ; 2@    a-addr -- x1 x2    fetch 2 cells ; the lower address will appear on top of stack
 248             FORTHWORD "2@"
 249 TWOFETCH    SUB #2, PSP
 250             MOV 2(TOS),0(PSP)
 251             MOV @TOS,TOS
 252             MOV @IP+,PC
 253
 254 ; https://forth-standard.org/standard/core/TwoStore
 255 ; 2!    x1 x2 a-addr --    store 2 cells ; the top of stack is stored at the lower adr
 256             FORTHWORD "2!"
 257 TWOSTORE    MOV @PSP+,0(TOS)
 258             MOV @PSP+,2(TOS)
 259             MOV @PSP+,TOS
 260             MOV @IP+,PC
 261
 262 ; https://forth-standard.org/standard/core/TwoDROP
 263 ; 2DROP  x1 x2 --          drop 2 cells
 264             FORTHWORD "2DROP"
 265             ADD #2,PSP
 266             MOV @PSP+,TOS
 267             MOV @IP+,PC
 268
 269 ; https://forth-standard.org/standard/core/TwoSWAP
 270 ; 2SWAP  x1 x2 x3 x4 -- x3 x4 x1 x2
 271             FORTHWORD "2SWAP"
 272             MOV @PSP,W          ; -- x1 x2 x3 x4    W=x3
 273             MOV 4(PSP),0(PSP)   ; -- x1 x2 x1 x4
 274             MOV W,4(PSP)        ; -- x3 x2 x1 x4
 275             MOV TOS,W           ; -- x3 x2 x1 x4    W=x4
 276             MOV 2(PSP),TOS      ; -- x3 x2 x1 x2    W=x4
 277             MOV W,2(PSP)        ; -- x3 x4 x1 x2
 278             MOV @IP+,PC
 279
 280 ; https://forth-standard.org/standard/core/TwoOVER
 281 ; 2OVER  x1 x2 x3 x4 -- x1 x2 x3 x4 x1 x2
 282             FORTHWORD "2OVER"
 283             SUB #4,PSP          ; -- x1 x2 x3 x x x4
 284             MOV TOS,2(PSP)      ; -- x1 x2 x3 x4 x x4
 285             MOV 8(PSP),0(PSP)   ; -- x1 x2 x3 x4 x1 x4
 286             MOV 6(PSP),TOS      ; -- x1 x2 x3 x4 x1 x2
 287             MOV @IP+,PC
 288
 289 ;https://forth-standard.org/standard/core/CFetch
 290 ; C@     c-addr -- char   fetch char from memory
 291             FORTHWORD "C@"
 292 CFETCH      MOV.B @TOS,TOS      ;2
 293             MOV @IP+,PC         ;4
 294
 295 ;https://forth-standard.org/standard/core/CStore
 296 ; C!      char c-addr --    store char in memory
 297             FORTHWORD "C!"
 298 CSTORE      MOV.B @PSP+,0(TOS)  ;4
 299             ADD #1,PSP          ;1
 300             MOV @PSP+,TOS       ;2
 301             MOV @IP+,PC
 302
 303 ;https://forth-standard.org/standard/core/CComma
 304 ; C,   char --        append char
 305             FORTHWORD "C,"
 306 CCOMMA      MOV &DDP,W
 307             MOV.B TOS,0(W)
 308             ADD #1,&DDP
 309             MOV @PSP+,TOS
 310             MOV @IP+,PC
 311
 312 ;https://forth-standard.org/standard/core/AND
 313 ;C AND    x1 x2 -- x3           logical AND
 314             FORTHWORD "AND"
 315 ANDD        AND @PSP+,TOS
 316             MOV @IP+,PC
 317
 318 ;https://forth-standard.org/standard/core/OR
 319 ;C OR     x1 x2 -- x3           logical OR
 320             FORTHWORD "OR"
 321 ORR         BIS @PSP+,TOS
 322             MOV @IP+,PC
 323
 324 ;https://forth-standard.org/standard/core/XOR
 325 ;C XOR    x1 x2 -- x3           logical XOR
 326             FORTHWORD "XOR"
 327 XORR        XOR @PSP+,TOS
 328             MOV @IP+,PC
 329
 330 ;https://forth-standard.org/standard/core/INVERT
 331 ;C INVERT   x1 -- x2            bitwise inversion
 332             FORTHWORD "INVERT"
 333             XOR #-1,TOS
 334             MOV @IP+,PC
 335
 336 ;https://forth-standard.org/standard/core/LSHIFT
 337 ;C LSHIFT  x1 u -- x2    logical L shift u places
 338             FORTHWORD "LSHIFT"
 339 LSHIFT      MOV @PSP+,W
 340             AND #1Fh,TOS        ; no need to shift more than 16
 341             JZ LSH_X
 342 LSH_1       ADD W,W
 343             SUB #1,TOS
 344             JNZ LSH_1
 345 LSH_X       MOV W,TOS
 346             MOV @IP+,PC
 347
 348 ;https://forth-standard.org/standard/core/RSHIFT
 349 ;C RSHIFT  x1 u -- x2    logical R shift u places
 350             FORTHWORD "RSHIFT"
 351 RSHIFT      MOV @PSP+,W
 352             AND #1Fh,TOS        ; no need to shift more than 16
 353             JZ RSH_X
 354 RSH_1       BIC #1,SR           ; CLRC
 355             RRC W
 356             SUB #1,TOS
 357             JNZ RSH_1
 358 RSH_X       MOV W,TOS
 359             MOV @IP+,PC
 360
 361 ;https://forth-standard.org/standard/core/TwoTimes
 362 ;C 2*      x1 -- x2         arithmetic left shift
 363             FORTHWORD "2*"
 364 TWOTIMES    ADD TOS,TOS
 365             MOV @IP+,PC
 366
 367 ;https://forth-standard.org/standard/core/TwoDiv
 368 ;C 2/      x1 -- x2        arithmetic right shift
 369             FORTHWORD "2/"
 370 TWODIV      RRA TOS
 371             MOV @IP+,PC
 372
 373 ;https://forth-standard.org/standard/core/MAX
 374 ;C MAX    n1 n2 -- n3       signed maximum
 375             FORTHWORD "MAX"
 376 MAX         CMP @PSP,TOS    ; n2-n1
 377             JL SELn1        ; n2<n1
 378 SELn2       ADD #2,PSP
 379             MOV @IP+,PC
 380
 381 ;https://forth-standard.org/standard/core/MIN
 382 ;C MIN    n1 n2 -- n3       signed minimum
 383             FORTHWORD "MIN"
 384 MIN         CMP @PSP,TOS    ; n2-n1
 385             JL SELn2        ; n2<n1
 386 SELn1       MOV @PSP+,TOS
 387             MOV @IP+,PC
 388
 389 ;https://forth-standard.org/standard/core/PlusStore
 390 ;C +!     n/u a-addr --       add to memory
 391             FORTHWORD "+!"
 392 PLUSSTORE   ADD @PSP+,0(TOS)
 393             MOV @PSP+,TOS
 394             MOV @IP+,PC
 395
 396 ;https://forth-standard.org/standard/core/CHAR
 397 ;C CHAR   -- char           parse ASCII character
 398             FORTHWORD "CHAR"
 399 CHARR       mDOCOL
 400             .word   FBLANK,WORDD,ONEPLUS,CFETCH,EXIT
 401
 402 ;https://forth-standard.org/standard/core/BracketCHAR
 403 ;C [CHAR]   --          compile character literal
 404             FORTHWORDIMM "[CHAR]"        ; immediate
 405 BRACCHAR    mDOCOL
 406             .word   CHARR
 407             .word   lit,lit,COMMA
 408             .word   COMMA,EXIT
 409
 410 ;https://forth-standard.org/standard/core/FILL
 411 ;C FILL   c-addr u char --  fill memory with char
 412             FORTHWORD "FILL"
 413 FILL        MOV @PSP+,X     ; count
 414             MOV @PSP+,W     ; address
 415             CMP #0,X
 416             JZ FILL_X
 417 FILL_1      MOV.B TOS,0(W)    ; store char in memory
 418             ADD #1,W
 419             SUB #1,X
 420             JNZ FILL_1
 421 FILL_X      MOV @PSP+,TOS   ; pop new TOS
 422             MOV @IP+,PC
 423
 424 ;https://forth-standard.org/standard/core/HEX
 425             FORTHWORD "HEX"
 426 HEX         MOV #16,&BASE
 427             MOV @IP+,PC
 428
 429 ;https://forth-standard.org/standard/core/DECIMAL
 430             FORTHWORD "DECIMAL"
 431 DECIMAL     MOV #10,&BASE
 432             MOV @IP+,PC
 433
 434 ; https://forth-standard.org/standard/core/HERE
 435 ; HERE    -- addr      returns memory ptr
 436             FORTHWORD "HERE"
 437             MOV #HERE,PC
 438
 439 ;https://forth-standard.org/standard/core/p
 440 ;C (                \  --     paren ; skip input until )
 441             FORTHWORDIMM "\40"      ; immediate
 442 PARENT       mDOCOL
 443             .word   lit,')',WORDD,DROP,EXIT
 444
 445 ;https://forth-standard.org/standard/core/Dotp
 446 ; .(                \  --     dotparen ; type comment immediatly.
 447             FORTHWORDIMM ".\40"        ; immediate
 448 DOTPAREN    MOV #0,&CAPS
 449             mDOCOL
 450             .word   lit,')',WORDD
 451             .word   COUNT,TYPE
 452             .word   FBLANK,LIT,CAPS,STORE
 453             .word   EXIT
 454
 455 ;https://forth-standard.org/standard/core/J
 456 ;C J        -- n   R: 4*sys -- 4*sys
 457 ;C                  get the second loop index
 458             FORTHWORD "J"
 459 JJ          SUB #2,PSP      ; make room in TOS
 460             MOV TOS,0(PSP)
 461             MOV 4(RSP),TOS  ; index = loopctr - fudge
 462             SUB 6(RSP),TOS
 463             MOV @IP+,PC
 464
 465 ;https://forth-standard.org/standard/core/UNLOOP
 466 ;UNLOOP   --   R: sys1 sys2 --  drop loop parms
 467             FORTHWORD "UNLOOP"
 468 UNLOOP      ADD #4,RSP
 469             MOV @IP+,PC
 470
 471 ;https://forth-standard.org/standard/core/LEAVE
 472 ;C LEAVE    --    L: -- adrs
 473             FORTHWORDIMM "LEAVE"    ; immediate
 474 LEAV        MOV &DDP,W              ; compile three words
 475             MOV #UNLOOP,0(W)        ; [HERE] = UNLOOP
 476             MOV #BRAN,2(W)          ; [HERE+2] = BRAN
 477             ADD #6,&DDP             ; [HERE+4] = After LOOP adr
 478             ADD #2,&LEAVEPTR
 479             ADD #4,W
 480             MOV &LEAVEPTR,X
 481             MOV W,0(X)              ; leave HERE+4 on LEAVEPTR stack
 482             MOV @IP+,PC
 483
 484 ;https://forth-standard.org/standard/core/RECURSE
 485 ;C RECURSE  --      recurse to current definition (compile current definition)
 486             FORTHWORDIMM "RECURSE"  ; immediate
 487 RECURSE     MOV &DDP,X              ;
 488             MOV &LAST_CFA,0(X)      ;
 489             ADD #2,&DDP             ;
 490             MOV @IP+,PC
 491
 492 ; https://forth-standard.org/standard/core/toBODY
 493 ; >BODY     -- addr      leave BODY of a CREATEd word; also leave default ACTION-OF primary DEFERred word
 494             FORTHWORD ">BODY"
 495 TOBODY      ADD #4,TOS
 496             MOV @IP+,PC
 497
 498 ;https://forth-standard.org/standard/core/SOURCE
 499 ;C SOURCE   -- adr u   of  current input buffer
 500             FORTHWORD "SOURCE"
 501             SUB #4,PSP
 502             MOV TOS,2(PSP)
 503             MOV &SOURCE_LEN,TOS
 504             MOV &SOURCE_ORG,0(PSP)
 505             MOV @IP+,PC
 506
 507 ;https://forth-standard.org/standard/core/STATE
 508 ;C STATE   -- a-addr       holds compiler state
 509             FORTHWORD "STATE"
 510             CALL rDOCON
 511             .word   STATE   ; VARIABLE address in RAM space
 512
 513 ;https://forth-standard.org/standard/core/BASE
 514 ;C BASE    -- a-addr       holds conversion radix
 515             FORTHWORD "BASE"
 516             CALL rDOCON
 517             .word   BASE    ; VARIABLE address in RAM space
 518
 519 ;https://forth-standard.org/standard/core/toIN
 520 ;C >IN     -- a-addr       holds offset in input stream
 521             FORTHWORD ">IN"
 522 FTOIN       CALL rDOCON
 523             .word   TOIN    ; VARIABLE address in RAM space
 524
 525 ;https://forth-standard.org/standard/core/PAD
 526 ; PAD           --  pad address
 527             FORTHWORD "PAD"
 528 PAD         CALL rDOCON
 529             .WORD    PAD_ORG
 530
 531 ; https://forth-standard.org/standard/core/TO
 532 ; TO name Run-time: ( x -- )
 533 ; Assign the value x to named VALUE.
 534             FORTHWORD "TO"
 535             BIS #UF9,SR
 536             MOV @IP+,PC
 537
 538 ; https://forth-standard.org/standard/core/VALUE
 539 ; ( x "<spaces>name" -- )                      define a Forth VALUE
 540 ; Skip leading space delimiters. Parse name delimited by a space.
 541 ; Create a definition for name with the execution semantics defined below,
 542 ; with an initial value equal to x.
 543 ;
 544 ; name Execution: ( -- x )
 545 ; Place x on the stack. The value of x is that given when name was created,
 546 ; until the phrase x TO name is executed, causing a new value of x to be assigned to name.
 547             FORTHWORD "VALUE"
 548             mDOCOL
 549             .word CREATE,COMMA
 550             .word DOES
 551             .word $+2
 552             MOV @RSP+,IP
 553             BIT #UF9,SR         ; see TO
 554             JNZ VALUENEXT
 555             MOV @TOS,TOS        ; execute Fetch
 556             MOV @IP+,PC
 557 VALUENEXT   BIC #UF9,SR         ; clear 'TO' flag
 558             MOV @PSP+,0(TOS)    ; 4 execute Store
 559             MOV @PSP+,TOS       ; 2
 560             MOV @IP+,PC         ; 4