MSP430-FORTH/UTILITY.f

   1 \ -*- coding: utf-8 -*-
   2 \
   3 \ to see kernel options, download FastForthSpecs.f
   4 \ FastForth kernel options: MSP430ASSEMBLER, CONDCOMP
   5 \
   6 \ TARGET SELECTION ( = the name of \INC\target.pat file without the extension)
   7 \ MSP_EXP430FR5739  MSP_EXP430FR5969    MSP_EXP430FR5994    MSP_EXP430FR6989
   8 \ MSP_EXP430FR4133  MSP_EXP430FR2433    CHIPSTICK_FR2433    MSP_EXP430FR2355
   9 \ LP_MSP430FR2476
  10 \
  11 \ from scite editor : copy your target selection in (shift+F8) parameter 1:
  12 \
  13 \ OR
  14 \
  15 \ drag and drop this file onto SendSourceFileToTarget.bat
  16 \ then select your TARGET when asked.
  17 \
  18 \
  19 \ REGISTERS USAGE
  20 \ R4 to R7 must be saved before use and restored after
  21 \ scratch registers Y to S are free for use
  22 \ under interrupt, IP is free for use
  23 \
  24 \ PUSHM order : PSP,TOS, IP,  S,  T,  W,  X,  Y, rEXIT,rDOVAR,rDOCON, rDODOES, R3, SR,RSP, PC
  25 \ PUSHM order : R15,R14,R13,R12,R11,R10, R9, R8,  R7  ,  R6  ,  R5  ,   R4   , R3, R2, R1, R0
  26 \
  27 \ example : PUSHM #6,IP pushes IP,S,T,W,X,Y registers to return stack
  28 \
  29 \ POPM  order :  PC,RSP, SR, R3, rDODOES,rDOCON,rDOVAR,rEXIT,  Y,  X,  W,  T,  S, IP,TOS,PSP
  30 \ POPM  order :  R0, R1, R2, R3,   R4   ,  R5  ,  R6  ,  R7 , R8, R9,R10,R11,R12,R13,R14,R15
  31 \
  32 \ example : POPM #6,IP   pop Y,X,W,T,S,IP registers from return stack
  33 \
  34 \
  35 \ FORTH conditionnals:  unary{ 0= 0< 0> }, binary{ = < > U< }
  36 \
  37 \ ASSEMBLER conditionnal usage with IF UNTIL WHILE  S<  S>=  U<   U>=  0=  0<>  0>=
  38 \ ASSEMBLER conditionnal usage with ?JMP ?GOTO      S<  S>=  U<   U>=  0=  0<>  0<
  39
  40 ; --------------------------------
  41 ; UTILITY.f
  42 ; --------------------------------
  43
  44 \ first, we do some tests allowing the download
  45     CODE ABORT_UTILITY
  46     SUB #2,PSP
  47     MOV TOS,0(PSP)
  48     MOV &VERSION,TOS
  49     SUB #401,TOS        \ FastForth V4.1
  50     COLON
  51     'CR' EMIT           \ return to column 1 without 'LF'
  52     ABORT" FastForth V4.1 please!"
  53     RST_RET             \ remove ABORT_UTILITY definition before resuming
  54     ;
  55
  56     ABORT_UTILITY
  57
  58     [DEFINED] {UTILITY}
  59     [IF] {UTILITY}
  60     [THEN]
  61     [UNDEFINED] {UTILITY}
  62     [IF]
  63     MARKER {UTILITY}
  64
  65 ; ------------------------------------------------------------------
  66 ; first we download the set of definitions we need (from CORE_ANS.f)
  67 ; ------------------------------------------------------------------
  68
  69     [UNDEFINED] EXIT [IF]
  70 \ https://forth-standard.org/standard/core/EXIT
  71 \ EXIT     --      exit a colon definition; CALL #EXIT performs ASMtoFORTH (10 cycles)
  72 \                                           JMP #EXIT performs EXIT
  73     CODE EXIT
  74     MOV @RSP+,IP    \ 2 pop previous IP (or next PC) from return stack
  75     MOV @IP+,PC     \ 4 = NEXT
  76                     \ 6 (ITC-2)
  77     ENDCODE
  78     [THEN]
  79
  80     [UNDEFINED] SWAP [IF]
  81 \ https://forth-standard.org/standard/core/SWAP
  82 \ SWAP     x1 x2 -- x2 x1    swap top two items
  83     CODE SWAP
  84     MOV @PSP,W      \ 2
  85     MOV TOS,0(PSP)  \ 3
  86     MOV W,TOS       \ 1
  87     MOV @IP+,PC     \ 4
  88     ENDCODE
  89     [THEN]
  90
  91     [UNDEFINED] U< [IF]
  92 \ https://forth-standard.org/standard/core/Uless
  93 \ U<    u1 u2 -- flag       test u1<u2, unsigned
  94     CODE U<
  95     SUB @PSP+,TOS       \ 2 u2-u1
  96     0<> IF
  97         MOV #-1,TOS     \ 1
  98         U< IF           \ 2 flag
  99             AND #0,TOS  \ 1 flag Z = 1
 100         THEN
 101     THEN
 102     MOV @IP+,PC         \ 4
 103     ENDCODE
 104     [THEN]
 105
 106     [UNDEFINED] IF [IF]     \ define IF and THEN
 107 \ https://forth-standard.org/standard/core/IF
 108 \ IF       -- IFadr    initialize conditional forward branch
 109     CODE IF             \ immediate
 110     SUB #2,PSP          \
 111     MOV TOS,0(PSP)      \
 112     MOV &DP,TOS         \ -- HERE
 113     ADD #4,&DP          \           compile one word, reserve one word
 114     MOV #QFBRAN,0(TOS)  \ -- HERE   compile QFBRAN
 115     ADD #2,TOS          \ -- HERE+2=IFadr
 116     MOV @IP+,PC
 117     ENDCODE IMMEDIATE
 118
 119 \ https://forth-standard.org/standard/core/THEN
 120 \ THEN     IFadr --                resolve forward branch
 121     CODE THEN           \ immediate
 122     MOV &DP,0(TOS)      \ -- IFadr
 123     MOV @PSP+,TOS       \ --
 124     MOV @IP+,PC
 125     ENDCODE IMMEDIATE
 126     [THEN]
 127
 128     [UNDEFINED] BEGIN [IF]  \ define BEGIN UNTIL AGAIN WHILE REPEAT
 129 \ https://forth-standard.org/standard/core/BEGIN
 130 \ BEGIN    -- BEGINadr             initialize backward branch
 131     CODE BEGIN
 132     MOV #BEGIN,PC
 133     ENDCODE IMMEDIATE
 134
 135 \ https://forth-standard.org/standard/core/UNTIL
 136 \ UNTIL    BEGINadr --             resolve conditional backward branch
 137     CODE UNTIL              \ immediate
 138     MOV #QFBRAN,X
 139 BW1 ADD #4,&DP          \ compile two words
 140     MOV &DP,W           \ W = HERE
 141     MOV X,-4(W)         \ compile Bran or QFBRAN at HERE
 142     MOV TOS,-2(W)       \ compile bakcward adr at HERE+2
 143     MOV @PSP+,TOS
 144     MOV @IP+,PC
 145     ENDCODE IMMEDIATE
 146
 147 \ https://forth-standard.org/standard/core/AGAIN
 148 \ AGAIN    BEGINadr --             resolve uncondionnal backward branch
 149     CODE AGAIN     \ immediate
 150     MOV #BRAN,X
 151     GOTO BW1
 152     ENDCODE IMMEDIATE
 153
 154 \ https://forth-standard.org/standard/core/WHILE
 155 \ WHILE    BEGINadr -- WHILEadr BEGINadr
 156     : WHILE     \ immediate
 157     POSTPONE IF SWAP
 158     ; IMMEDIATE
 159
 160 \ https://forth-standard.org/standard/core/REPEAT
 161 \ REPEAT   WHILEadr BEGINadr --     resolve WHILE loop
 162     : REPEAT
 163     POSTPONE AGAIN POSTPONE THEN
 164     ; IMMEDIATE
 165     [THEN]
 166
 167     [UNDEFINED] DO [IF]     \ define DO LOOP +LOOP
 168
 169     HDNCODE XDO         \ DO run time
 170     MOV #$8000,X        \ 2 compute 8000h-limit = "fudge factor"
 171     SUB @PSP+,X         \ 2
 172     MOV TOS,Y           \ 1 loop ctr = index+fudge
 173     ADD X,Y             \ 1 Y = INDEX
 174     PUSHM #2,X          \ 4 PUSHM X,Y, i.e. PUSHM LIMIT, INDEX
 175     MOV @PSP+,TOS       \ 2
 176     MOV @IP+,PC         \ 4
 177     ENDCODE
 178
 179 \ https://forth-standard.org/standard/core/DO
 180 \ DO       -- DOadr   L: -- 0
 181     CODE DO                 \ immediate
 182     SUB #2,PSP              \
 183     MOV TOS,0(PSP)          \
 184     ADD #2,&DP              \   make room to compile xdo
 185     MOV &DP,TOS             \ -- HERE+2
 186     MOV #XDO,-2(TOS)        \   compile xdo
 187     ADD #2,&LEAVEPTR        \ -- HERE+2     LEAVEPTR+2
 188     MOV &LEAVEPTR,W         \
 189     MOV #0,0(W)             \ -- HERE+2     L-- 0
 190     MOV @IP+,PC
 191     ENDCODE IMMEDIATE
 192
 193     HDNCODE XLOOP       \   LOOP run time
 194     ADD #1,0(RSP)       \ 4 increment INDEX
 195 BW1 BIT #$100,SR        \ 2 is overflow bit set?
 196     0= IF               \   branch if no overflow
 197         MOV @IP,IP
 198         MOV @IP+,PC
 199     THEN
 200     ADD #4,RSP          \ 1 empties RSP
 201     ADD #2,IP           \ 1 overflow = loop done, skip branch ofs
 202     MOV @IP+,PC         \ 4 14~ taken or not taken xloop/loop
 203     ENDCODE             \
 204
 205 \ https://forth-standard.org/standard/core/LOOP
 206 \ LOOP    DOadr --         L-- an an-1 .. a1 0
 207     CODE LOOP
 208     MOV #XLOOP,X
 209 BW2 ADD #4,&DP          \ make room to compile two words
 210     MOV &DP,W
 211     MOV X,-4(W)         \ xloop --> HERE
 212     MOV TOS,-2(W)       \ DOadr --> HERE+2
 213     BEGIN                   \ resolve all "leave" adr
 214         MOV &LEAVEPTR,TOS   \ -- Adr of top LeaveStack cell
 215         SUB #2,&LEAVEPTR    \ --
 216         MOV @TOS,TOS        \ -- first LeaveStack value
 217         CMP #0,TOS          \ -- = value left by DO ?
 218     0<> WHILE
 219         MOV W,0(TOS)        \ move adr after loop as UNLOOP adr
 220     REPEAT
 221     MOV @PSP+,TOS
 222     MOV @IP+,PC
 223     ENDCODE IMMEDIATE
 224
 225     HDNCODE XPLOO   \   +LOOP run time
 226     ADD TOS,0(RSP)  \ 4 increment INDEX by TOS value
 227     MOV @PSP+,TOS   \ 2 get new TOS, doesn't change flags
 228     GOTO BW1        \ 2
 229     ENDCODE         \
 230
 231 \ https://forth-standard.org/standard/core/PlusLOOP
 232 \ +LOOP   adrs --   L-- an an-1 .. a1 0
 233     CODE +LOOP
 234     MOV #XPLOO,X
 235     GOTO BW2
 236     ENDCODE IMMEDIATE
 237     [THEN]
 238
 239     [UNDEFINED] I [IF]
 240 \ https://forth-standard.org/standard/core/I
 241 \ I        -- n   R: sys1 sys2 -- sys1 sys2
 242 \                  get the innermost loop index
 243     CODE I
 244     SUB #2,PSP      \ 1 make room in TOS
 245     MOV TOS,0(PSP)  \ 3
 246     MOV @RSP,TOS    \ 2 index = loopctr - fudge
 247     SUB 2(RSP),TOS  \ 3
 248     MOV @IP+,PC     \ 4 13~
 249     ENDCODE
 250     [THEN]
 251
 252     [UNDEFINED] DUP [IF]    \ define DUP and ?DUP
 253 \ https://forth-standard.org/standard/core/DUP
 254 \ DUP      x -- x x      duplicate top of stack
 255     CODE DUP
 256 BW1 SUB #2,PSP      \ 2  push old TOS..
 257     MOV TOS,0(PSP)  \ 3  ..onto stack
 258     MOV @IP+,PC     \ 4
 259     ENDCODE
 260
 261 \ https://forth-standard.org/standard/core/qDUP
 262 \ ?DUP     x -- 0 | x x    DUP if nonzero
 263     CODE ?DUP
 264     CMP #0,TOS      \ 2  test for TOS nonzero
 265     0<> ?GOTO BW1   \ 2
 266     MOV @IP+,PC     \ 4
 267     ENDCODE
 268     [THEN]
 269
 270     [UNDEFINED] DROP [IF]
 271 \ https://forth-standard.org/standard/core/DROP
 272 \ DROP     x --          drop top of stack
 273     CODE DROP
 274     MOV @PSP+,TOS   \ 2
 275     MOV @IP+,PC     \ 4
 276     ENDCODE
 277     [THEN]
 278
 279     [UNDEFINED] >R [IF]
 280 \ https://forth-standard.org/standard/core/toR
 281 \ >R    x --   R: -- x   push to return stack
 282     CODE >R
 283     PUSH TOS
 284     MOV @PSP+,TOS
 285     MOV @IP+,PC
 286     ENDCODE
 287     [THEN]
 288
 289     [UNDEFINED] R> [IF]
 290 \ https://forth-standard.org/standard/core/Rfrom
 291 \ R>    -- x    R: x --   pop from return stack ; CALL #RFROM performs DOVAR
 292     CODE R>
 293     SUB #2,PSP      \ 1
 294     MOV TOS,0(PSP)  \ 3
 295     MOV @RSP+,TOS   \ 2
 296     MOV @IP+,PC     \ 4
 297     ENDCODE
 298     [THEN]
 299
 300     [UNDEFINED] SPACE [IF]
 301 \ https://forth-standard.org/standard/core/SPACE
 302 \ SPACE   --               output a space
 303     : SPACE
 304     $20 EMIT ;
 305     [THEN]
 306
 307     [UNDEFINED] SPACES [IF]
 308 \ https://forth-standard.org/standard/core/SPACES
 309 \ SPACES   n --            output n spaces
 310     CODE SPACES
 311     CMP #0,TOS
 312     0<> IF
 313         PUSH IP
 314         BEGIN
 315             LO2HI
 316             $20 EMIT
 317             HI2LO
 318             SUB #2,IP
 319             SUB #1,TOS
 320         0= UNTIL
 321         MOV @RSP+,IP
 322     THEN
 323     MOV @PSP+,TOS           \ --         drop n
 324     NEXT
 325     ENDCODE
 326     [THEN]
 327
 328     [UNDEFINED] 2DUP [IF]
 329 \ https://forth-standard.org/standard/core/TwoDUP
 330 \ 2DUP   x1 x2 -- x1 x2 x1 x2   dup top 2 cells
 331     CODE 2DUP
 332     MOV TOS,-2(PSP)     \ 3
 333     MOV @PSP,-4(PSP)    \ 4
 334     SUB #4,PSP          \ 1
 335     MOV @IP+,PC         \ 4
 336     ENDCODE
 337     [THEN]
 338
 339     [UNDEFINED] 1+ [IF]
 340 \ https://forth-standard.org/standard/core/OnePlus
 341 \ 1+      n1/u1 -- n2/u2       add 1 to TOS
 342     CODE 1+
 343     ADD #1,TOS
 344     MOV @IP+,PC
 345     ENDCODE
 346     [THEN]
 347
 348     [UNDEFINED] + [IF]
 349 \ https://forth-standard.org/standard/core/Plus
 350 \ +       n1/u1 n2/u2 -- n3/u3     add n1+n2
 351     CODE +
 352     ADD @PSP+,TOS
 353     MOV @IP+,PC
 354     ENDCODE
 355     [THEN]
 356
 357     [UNDEFINED] - [IF]
 358 \ https://forth-standard.org/standard/core/Minus
 359 \ -      n1/u1 n2/u2 -- n3/u3      n3 = n1-n2
 360     CODE -
 361     SUB @PSP+,TOS   \ 2  -- n2-n1
 362     XOR #-1,TOS     \ 1
 363     ADD #1,TOS      \ 1  -- n3 = -(n2-n1) = n1-n2
 364     MOV @IP+,PC
 365     ENDCODE
 366     [THEN]
 367
 368     [UNDEFINED] C@ [IF]
 369 \ https://forth-standard.org/standard/core/CFetch
 370 \ C@     c-addr -- char   fetch char from memory
 371     CODE C@
 372     MOV.B @TOS,TOS
 373     MOV @IP+,PC
 374     ENDCODE
 375     [THEN]
 376
 377     [UNDEFINED] ROT [IF]
 378 \ https://forth-standard.org/standard/core/ROT
 379 \ ROT    x1 x2 x3 -- x2 x3 x1
 380     CODE ROT
 381     MOV @PSP,W      \ 2 fetch x2
 382     MOV TOS,0(PSP)  \ 3 store x3
 383     MOV 2(PSP),TOS  \ 3 fetch x1
 384     MOV W,2(PSP)    \ 3 store x2
 385     MOV @IP+,PC
 386     ENDCODE
 387     [THEN]
 388
 389     [UNDEFINED] MAX [IF]    \ define MAX and MIN
 390     CODE MAX        \ n1 n2 -- n3       signed maximum
 391     CMP @PSP,TOS    \ n2-n1
 392     S< ?GOTO FW1    \ n2<n1
 393 BW1 ADD #2,PSP
 394     MOV @IP+,PC
 395     ENDCODE
 396
 397     CODE MIN        \    n1 n2 -- n3       signed minimum
 398     CMP @PSP,TOS    \ n2-n1
 399     S< ?GOTO BW1    \ n2<n1
 400 FW1 MOV @PSP+,TOS
 401     MOV @IP+,PC
 402     ENDCODE
 403     [THEN]
 404
 405     [UNDEFINED] OVER [IF]
 406 \ https://forth-standard.org/standard/core/OVER
 407 \ OVER    x1 x2 -- x1 x2 x1
 408     CODE OVER
 409     MOV TOS,-2(PSP)     \ 3 -- x1 (x2) x2
 410     MOV @PSP,TOS        \ 2 -- x1 (x2) x1
 411     SUB #2,PSP          \ 1 -- x1 x2 x1
 412     MOV @IP+,PC
 413     ENDCODE
 414     [THEN]
 415
 416     [UNDEFINED] MOVE [IF]
 417 \ https://forth-standard.org/standard/core/MOVE
 418 \ MOVE    addr1 addr2 u --     smart move
 419 \             VERSION FOR 1 ADDRESS UNIT = 1 CHAR
 420     CODE MOVE
 421     MOV TOS,W           \ W = cnt
 422     MOV @PSP+,Y         \ Y = addr2 = dst
 423     MOV @PSP+,X         \ X = addr1 = src
 424     MOV @PSP+,TOS       \ pop new TOS
 425     CMP #0,W            \ count = 0 ?
 426     0<> IF              \ if 0, already done !
 427         CMP X,Y         \ Y-X \ dst - src
 428         0= ?GOTO FW1    \ already done !
 429         U< IF           \ U< if src > dst
 430             BEGIN       \ copy W bytes
 431                 MOV.B @X+,0(Y)
 432                 ADD #1,Y
 433                 SUB #1,W
 434             0= UNTIL
 435             MOV @IP+,PC
 436         ELSE            \ U>= if dst > src
 437             ADD W,Y     \ copy W bytes beginning with the end
 438             ADD W,X
 439             BEGIN
 440                 SUB #1,X
 441                 SUB #1,Y
 442                 MOV.B @X,0(Y)
 443                 SUB #1,W
 444             0= UNTIL
 445         THEN
 446     THEN
 447 FW1 MOV @IP+,PC
 448     ENDCODE
 449     [THEN]
 450
 451     [UNDEFINED] CR [IF]
 452 \ https://forth-standard.org/standard/core/CR
 453 \ CR      --               send CR+LF to the output device
 454     CODE CR         \ create a DEFER definition of CR
 455     MOV #NEXT_ADR,PC
 456     ENDCODE
 457
 458     :NONAME
 459     'CR' EMIT 'LF' EMIT
 460     ; IS CR
 461     [THEN]
 462
 463     [UNDEFINED] 2* [IF]
 464 \ https://forth-standard.org/standard/core/TwoTimes
 465 \ 2*      x1 -- x2         arithmetic left shift
 466     CODE 2*
 467     ADD TOS,TOS
 468     MOV @IP+,PC
 469     ENDCODE
 470     [THEN]
 471
 472     [UNDEFINED] 2/ [IF]
 473 \ https://forth-standard.org/standard/core/TwoDiv
 474 \ 2/      x1 -- x2        arithmetic right shift
 475     CODE 2/
 476     RRA TOS
 477     MOV @IP+,PC
 478     ENDCODE
 479     [THEN]
 480
 481     [UNDEFINED] CONSTANT [IF]
 482 \ https://forth-standard.org/standard/core/CONSTANT
 483 \ CONSTANT <name>     n --                      define a Forth CONSTANT
 484     : CONSTANT
 485     CREATE
 486     HI2LO
 487     MOV TOS,-2(W)           \   PFA = n
 488     MOV @PSP+,TOS
 489     MOV @RSP+,IP
 490     MOV @IP+,PC
 491     ENDCODE
 492     [THEN]
 493
 494     [UNDEFINED] BASE [IF]
 495 \ https://forth-standard.org/standard/core/BASE
 496 \ BASE    -- a-addr       holds conversion radix
 497     BASEADR  CONSTANT BASE
 498     [THEN]
 499
 500     [UNDEFINED] HERE [IF]
 501 \ https://forth-standard.org/standard/core/HERE
 502 \ HERE          -- addr     addr is the data-space pointer.
 503     CODE HERE
 504     MOV #BEGIN,PC       \ execute ASM BEGIN
 505     ENDCODE
 506     [THEN]
 507
 508 ; --------------------------
 509 ; end of definitions we need
 510 ; --------------------------
 511
 512     [UNDEFINED] .S [IF]
 513 \ https://forth-standard.org/standard/tools/DotS
 514 \ .S        TOS -- TOS          display <depth> of param Stack and stack contents in hexadecimal if not empty
 515     CODE .S
 516     MOV     TOS,-2(PSP) \ -- TOS ( TOS x x )
 517     MOV     PSP,TOS     \ -- PSP ( TOS x x )
 518     SUB     #2,TOS      \ -- PSP ( TOS x x )  to take count that TOS is first cell
 519     MOV     TOS,-6(PSP) \ -- TOS ( TOS x  PSP )
 520     MOV     #PSTACK,TOS \ -- P0  ( TOS x  PSP )
 521     SUB     #2,TOS      \ -- P0  ( TOS x  PSP ) to take count that TOS is first cell
 522 BW1 MOV     TOS,-4(PSP) \ -- S0  ( TOS S0 PSP ) |  -- TOS ( TOS R0 RSP )
 523     SUB     #6,PSP      \ -- TOS S0 PSP S0      |  -- TOS R0 RSP R0
 524     SUB     @PSP,TOS    \ -- TOS S0 PSP S0-SP   |  -- TOS R0 RSP R0-RSP
 525     RRA     TOS         \ -- TOS S0 PSP #cells  |  -- TOS R0 RSP #cells
 526     COLON
 527     $3C EMIT            \ char '<'
 528     .                   \ display #cells
 529     $08 EMIT            \ backspace
 530     $3E EMIT SPACE      \ char '>' SPACE
 531     2DUP 1+             \
 532     U< IF
 533         DROP DROP EXIT
 534     THEN                \ display content of stack in hexadecimal
 535     BASE @ >R   \ base_address @ >R
 536     $10 BASE !
 537     DO
 538         '$' EMIT
 539         I @ U.
 540     2 +LOOP
 541     R> BASE !
 542     ;
 543     [THEN]
 544
 545     [UNDEFINED] .RS [IF]
 546 \ .RS         TOS -- TOS           display <depth> of Return Stack and stack contents if not empty
 547     CODE .RS
 548     MOV     TOS,-2(PSP) \ -- TOS ( TOS x x )
 549     MOV     RSP,-6(PSP) \ -- TOS ( TOS x  RSP )
 550     MOV     #RSTACK,TOS \ -- R0  ( TOS x  RSP )
 551     GOTO    BW1
 552     ENDCODE
 553     [THEN]
 554
 555     [UNDEFINED] ? [IF]
 556 \ https://forth-standard.org/standard/tools/q
 557 \ ?         adr --            display the content of adr
 558     CODE ?
 559     MOV @TOS,TOS
 560     MOV #U.,PC  \ goto U.
 561     ENDCODE
 562     [THEN]
 563
 564     [UNDEFINED] WORDS [IF]
 565 \ https://forth-standard.org/standard/tools/WORDS
 566 \ list all words of vocabulary first in CONTEXT.
 567     : WORDS                         \ --
 568     CR
 569     CONTEXT @                       \ -- VOC_BODY
 570     PAD_ORG                         \ -- VOC_BODY PAD_ORG                  MOVE all threads of VOC_BODY in PAD_ORG
 571     THREADS @ 2*                    \ -- VOC_BODY PAD_ORG THREAD*2
 572     MOVE                            \ -- vocabumary entries are copied in PAD_ORG
 573     BEGIN                           \ --
 574         0 DUP                       \ -- ptr=0 MAX=0
 575         THREADS @ 2* 0              \ -- ptr=0 MAX=0 THREADS*2 0
 576             DO                      \ -- ptr MAX            I =  PAD_ptr = thread*2
 577             DUP I PAD_ORG + @       \ -- ptr MAX MAX NFAx
 578                 U< IF               \ -- ptr MAX            if MAX U< NFAx
 579                     DROP DROP       \ --                    drop ptr and MAX
 580                     I DUP
 581                     PAD_ORG + @     \ -- new_ptr new_MAX
 582                 THEN                \
 583             2 +LOOP                 \ -- ptr MAX
 584         ?DUP                        \ -- ptr MAX MAX | -- ptr 0 (all threads in PAD_ORG = 0)
 585     WHILE                           \ -- ptr MAX                    replace it by its LFA
 586         DUP                         \ -- ptr MAX MAX
 587         2 - @                       \ -- ptr MAX [LFA]
 588         ROT                         \ -- MAX [LFA] ptr
 589         PAD_ORG +                   \ -- MAX [LFA] thread
 590         !                           \ -- MAX                MAX=highest_NFA [LFA]=new_NFA updates PAD_ORG+ptr
 591         COUNT 2/                    \ -- addr count         2/ to hide Immediate flag
 592         DUP >R TYPE                 \ --      R-- count
 593         R> $10 SWAP - SPACES        \ --      R--           complete with spaces modulo 16 chars
 594     REPEAT                          \ --
 595     DROP                            \ ptr --
 596     ;                               \ all threads in PAD_ORG are filled with 0
 597     [THEN]
 598
 599     [UNDEFINED] U.R
 600     [IF]
 601     : U.R                       \ u n --           display u unsigned in n width (n >= 2)
 602     >R  <# 0 # #S #>
 603     R> OVER - 0 MAX SPACES TYPE
 604     ;
 605     [THEN]
 606
 607     [UNDEFINED] DUMP [IF]
 608 \ https://forth-standard.org/standard/tools/DUMP
 609     CODE DUMP                   \ adr n  --   dump memory
 610     PUSH IP
 611     PUSH &BASEADR               \ save current base
 612     MOV #$10,&BASEADR           \ HEX base
 613     ADD @PSP,TOS                \ -- ORG END
 614     LO2HI
 615     SWAP                        \ -- END ORG
 616     CR
 617     4 SPACES $10 0 DO I 3 U.R LOOP
 618     DO  CR                      \ generate line
 619         I 4 U.R                 \ generate address
 620         I $10 + I
 621         DO I C@ 3 U.R LOOP
 622         SPACE SPACE
 623         I $10 + I             \ display 16 chars
 624         DO I C@ $7E MIN $20 MAX EMIT LOOP
 625     $10 +LOOP
 626     R> BASE  !                 \ restore current base
 627     ;
 628     [THEN]  \ endof [UNDEFINED] DUMP
 629
 630     RST_SET
 631
 632     [THEN] \ endof [UNDEFINED] {UTILITY}
 633
 634     ECHO
 635