MSP430-FORTH/TESTASM.F

   1 \ -*- coding: utf-8 -*-
   2
   3 ; -----------------------------------------------------------------------
   4 ; TEST_ASM.f
   5 ; -----------------------------------------------------------------------
   6 \
   7 \ TARGET SELECTION ( = the name of \INC\target.pat file without the extension)
   8 \ MSP_EXP430FR5739  MSP_EXP430FR5969    MSP_EXP430FR5994    MSP_EXP430FR6989
   9 \ MSP_EXP430FR4133  MSP_EXP430FR2433    MSP_EXP430FR2355    CHIPSTICK_FR2433
  10 \ LP_MSP430FR2476
  11 \
  12 \ from scite editor : copy your target selection in (shift+F8) parameter 1:
  13 \
  14 \ OR
  15 \
  16 \ drag and drop this file onto SendSourceFileToTarget.bat
  17 \ then select your TARGET when asked.
  18 \
  19 \
  20 \
  21 \ PUSHM order : PSP,TOS, IP,  S,  T,  W,  X,  Y, rEXIT,rDOVAR,rDOCON, rDODOES, R3, SR,RSP, PC
  22 \ PUSHM order : R15,R14,R13,R12,R11,R10, R9, R8,  R7  ,  R6  ,  R5  ,   R4   , R3, R2, R1, R0
  23 \
  24 \ example : PUSHM #6,IP pushes IP,S,T,W,X,Y registers to return stack
  25 \
  26 \ POPM  order :  PC,RSP, SR, R3, rDODOES,rDOCON,rDOVAR,rEXIT,  Y,  X,  W,  T,  S, IP,TOS,PSP
  27 \ POPM  order :  R0, R1, R2, R3,   R4   ,  R5  ,  R6  ,  R7 , R8, R9,R10,R11,R12,R13,R14,R15
  28 \
  29 \ example : POPM #6,IP   pop Y,X,W,T,S,IP registers from return stack
  30 \
  31 \ ASSEMBLER conditionnal usage after IF UNTIL WHILE : S< S>= U< U>= 0= 0<> 0>=
  32 \ ASSEMBLER conditionnal usage before ?JMP ?GOTO    : S< S>= U< U>= 0= 0<> 0<
  33 \
  34 \ FORTH conditionnal    : 0= 0< = < > U<
  35
  36 \ first, we test for downloading driver only if UART TERMINAL target
  37     CODE ABORT_TEST_ASM
  38     SUB #2,PSP
  39     MOV TOS,0(PSP)
  40     MOV &VERSION,TOS
  41     SUB #309,TOS        \                   FastForth V3.9
  42     COLON
  43     'CR' EMIT            \ return to column 1 without 'LF'
  44     ABORT" FastForth V3.9 please!"
  45     RST_RET           \ remove ABORT_TEST_ASM definition before resuming
  46     ;
  47
  48     ABORT_TEST_ASM      \ abort test
  49
  50     MARKER {TEST_ASM}
  51
  52     [UNDEFINED] >R
  53     [IF]
  54 \ https://forth-standard.org/standard/core/toR
  55 \ >R    x --   R: -- x   push to return stack
  56     CODE >R
  57     PUSH TOS
  58     MOV @PSP+,TOS
  59     MOV @IP+,PC
  60     ENDCODE
  61     [THEN]
  62
  63     [UNDEFINED] R>
  64     [IF]
  65 \ https://forth-standard.org/standard/core/Rfrom
  66 \ R>    -- x    R: x --   pop from return stack ; CALL #RFROM performs DOVAR
  67     CODE R>
  68     MOV rDOVAR,PC
  69     ENDCODE
  70     [THEN]
  71
  72     [UNDEFINED] +
  73     [IF]
  74 \ https://forth-standard.org/standard/core/Plus
  75 \ +       n1/u1 n2/u2 -- n3/u3     add n1+n2
  76     CODE +
  77     ADD @PSP+,TOS
  78     MOV @IP+,PC
  79     ENDCODE
  80     [THEN]
  81
  82     [UNDEFINED] -
  83     [IF]
  84 \ https://forth-standard.org/standard/core/Minus
  85 \ -      n1/u1 n2/u2 -- n3/u3     n3 = n1-n2
  86     CODE -
  87     SUB @PSP+,TOS   \ 2  -- n2-n1 ( = -n3)
  88     XOR #-1,TOS     \ 1
  89     ADD #1,TOS      \ 1  -- n3 = -(n2-n1) = n1-n2
  90     MOV @IP+,PC
  91     ENDCODE
  92     [THEN]
  93
  94     [UNDEFINED] SWAP
  95     [IF]
  96 \ https://forth-standard.org/standard/core/SWAP
  97 \ SWAP     x1 x2 -- x2 x1    swap top two items
  98     CODE SWAP
  99     MOV @PSP,W      \ 2
 100     MOV TOS,0(PSP)  \ 3
 101     MOV W,TOS       \ 1
 102     MOV @IP+,PC     \ 4
 103     ENDCODE
 104     [THEN]
 105
 106     [UNDEFINED] MAX
 107     [IF]    \ MAX and MIN are defined in {UTILITY}
 108
 109     CODE MAX    \    n1 n2 -- n3       signed maximum
 110     CMP @PSP,TOS    \ n2-n1
 111     S<  ?GOTO FW1   \ n2<n1
 112 BW1 ADD #2,PSP
 113     MOV @IP+,PC
 114     ENDCODE
 115
 116     CODE MIN    \    n1 n2 -- n3       signed minimum
 117     CMP @PSP,TOS     \ n2-n1
 118     S<  ?GOTO BW1    \ n2<n1
 119 FW1 MOV @PSP+,TOS
 120     MOV @IP+,PC
 121     ENDCODE
 122
 123     [THEN]
 124
 125     [UNDEFINED] C@
 126     [IF]
 127 \ https://forth-standard.org/standard/core/CFetch
 128 \ C@     c-addr -- char   fetch char from memory
 129     CODE C@
 130     MOV.B @TOS,TOS
 131     MOV @IP+,PC
 132     ENDCODE
 133     [THEN]
 134
 135     [UNDEFINED] VARIABLE
 136     [IF]
 137 \ https://forth-standard.org/standard/core/VARIABLE
 138 \ VARIABLE <name>       --                      define a Forth VARIABLE
 139     : VARIABLE
 140     CREATE
 141     HI2LO
 142     MOV #$1287,-4(W)        \   CFA = CALL rDOVAR
 143     MOV @RSP+,IP
 144     MOV @IP+,PC
 145     ENDCODE
 146     [THEN]
 147
 148     [UNDEFINED] CONSTANT
 149     [IF]
 150 \ https://forth-standard.org/standard/core/CONSTANT
 151 \ CONSTANT <name>     n --                      define a Forth CONSTANT
 152     : CONSTANT
 153     CREATE
 154     HI2LO
 155     MOV TOS,-2(W)           \   PFA = n
 156     MOV @PSP+,TOS
 157     MOV @RSP+,IP
 158     MOV @IP+,PC
 159     ENDCODE
 160     [THEN]
 161
 162     [UNDEFINED] DEFER
 163     [IF]
 164 \ https://forth-standard.org/standard/core/DEFER
 165 \ DEFER "<spaces>name"   --
 166 \Skip leading space delimiters. Parse name delimited by a space.
 167 \Create a definition for name with the execution semantics defined below.
 168
 169 \name Execution:   --
 170 \Execute the xt that name is set to execute, i.e. NEXT (nothing),
 171 \until the phrase ' word IS name is executed, causing a new value of xt to be assigned to name.
 172     : DEFER
 173     CREATE
 174     HI2LO
 175     MOV #$4030,-4(W)        \ CFA = MOV @PC+,PC = BR MOV @IP+,PC
 176     MOV #NEXT_ADR,-2(W)     \ PFA = address of MOV @IP+,PC to do nothing.
 177     MOV @RSP+,IP
 178     MOV @IP+,PC
 179     ENDCODE
 180     [THEN]
 181
 182     [UNDEFINED] >BODY
 183     [IF]
 184 \ https://forth-standard.org/standard/core/toBODY
 185 \ >BODY     -- addr      leave BODY of a CREATEd word\ also leave default ACTION-OF primary DEFERred word
 186     CODE >BODY
 187     ADD #4,TOS
 188     MOV @IP+,PC
 189     ENDCODE
 190     [THEN]
 191
 192     [UNDEFINED] SPACE
 193     [IF]
 194 \ https://forth-standard.org/standard/core/SPACE
 195 \ SPACE   --               output a space
 196     : SPACE
 197     $20 EMIT ;
 198     [THEN]
 199
 200     [UNDEFINED] SPACES
 201     [IF]
 202 \ https://forth-standard.org/standard/core/SPACES
 203 \ SPACES   n --            output n spaces
 204     CODE SPACES
 205     CMP #0,TOS
 206     0<> IF
 207         PUSH IP
 208         BEGIN
 209             LO2HI
 210             $20 EMIT
 211             HI2LO
 212             SUB #2,IP
 213             SUB #1,TOS
 214         0= UNTIL
 215         MOV @RSP+,IP
 216     THEN
 217     MOV @PSP+,TOS           \ --         drop n
 218     NEXT
 219     ENDCODE
 220     [THEN]
 221
 222     [UNDEFINED] DUP
 223     [IF]    \ define DUP and ?DUP
 224 \ https://forth-standard.org/standard/core/DUP
 225 \ DUP      x -- x x      duplicate top of stack
 226     CODE DUP
 227 BW1 SUB #2,PSP      \ 2  push old TOS..
 228     MOV TOS,0(PSP)  \ 3  ..onto stack
 229     MOV @IP+,PC     \ 4
 230     ENDCODE
 231
 232 \ https://forth-standard.org/standard/core/qDUP
 233 \ ?DUP     x -- 0 | x x    DUP if nonzero
 234     CODE ?DUP
 235     CMP #0,TOS      \ 2  test for TOS nonzero
 236     0<> ?GOTO BW1   \ 2
 237     MOV @IP+,PC     \ 4
 238     ENDCODE
 239     [THEN]
 240
 241     [UNDEFINED] OVER
 242     [IF]
 243 \ https://forth-standard.org/standard/core/OVER
 244 \ OVER    x1 x2 -- x1 x2 x1
 245     CODE OVER
 246     MOV TOS,-2(PSP)     \ 3 -- x1 (x2) x2
 247     MOV @PSP,TOS        \ 2 -- x1 (x2) x1
 248     SUB #2,PSP          \ 1 -- x1 x2 x1
 249     MOV @IP+,PC
 250     ENDCODE
 251     [THEN]
 252
 253     [UNDEFINED] U.R
 254     [IF]            \ defined in {UTILITY}
 255     : U.R                       \ u n --           display u unsigned in n width (n >= 2)
 256     >R  <# 0 # #S #>
 257     R> OVER - 0 MAX SPACES TYPE
 258     ;
 259     [THEN]
 260
 261 \ https://forth-standard.org/standard/core/IF
 262 \ IF       -- IFadr    initialize conditional forward branch
 263     [UNDEFINED] IF
 264     [IF]     \ define IF THEN
 265
 266     CODE IF
 267     SUB #2,PSP              \
 268     MOV TOS,0(PSP)          \
 269     MOV &DP,TOS             \ -- HERE
 270     ADD #4,&DP            \           compile one word, reserve one word
 271     MOV #QFBRAN,0(TOS)      \ -- HERE   compile QFBRAN
 272     ADD #2,TOS              \ -- HERE+2=IFadr
 273     MOV @IP+,PC
 274     ENDCODE IMMEDIATE
 275
 276 \ https://forth-standard.org/standard/core/THEN
 277 \ THEN     IFadr --                resolve forward branch
 278     CODE THEN
 279     MOV &DP,0(TOS)          \ -- IFadr
 280     MOV @PSP+,TOS           \ --
 281     MOV @IP+,PC
 282     ENDCODE IMMEDIATE
 283     [THEN]
 284
 285 \ https://forth-standard.org/standard/core/SWAP
 286 \ SWAP     x1 x2 -- x2 x1    swap top two items
 287     [UNDEFINED] SWAP
 288     [IF]
 289     CODE SWAP
 290     PUSH TOS            \ 3
 291     MOV @PSP,TOS        \ 2
 292     MOV @RSP+,0(PSP)    \ 4
 293     MOV @IP+,PC         \ 4
 294     ENDCODE
 295     [THEN]
 296
 297 \ https://forth-standard.org/standard/core/BEGIN
 298 \ BEGIN    -- BEGINadr             initialize backward branch
 299     [UNDEFINED] BEGIN
 300     [IF]  \ define BEGIN UNTIL AGAIN WHILE REPEAT
 301
 302     CODE BEGIN
 303     MOV #HEREXEC,PC
 304     ENDCODE IMMEDIATE
 305
 306 \ https://forth-standard.org/standard/core/UNTIL
 307 \ UNTIL    BEGINadr --             resolve conditional backward branch
 308     CODE UNTIL
 309     MOV #QFBRAN,X
 310 BW1 ADD #4,&DP          \ compile two words
 311     MOV &DP,W           \ W = HERE
 312     MOV X,-4(W)         \ compile Bran or QFBRAN at HERE
 313     MOV TOS,-2(W)       \ compile bakcward adr at HERE+2
 314     MOV @PSP+,TOS
 315     MOV @IP+,PC
 316     ENDCODE IMMEDIATE
 317
 318 \ https://forth-standard.org/standard/core/AGAIN
 319 \ AGAIN    BEGINadr --             resolve uncondionnal backward branch
 320     CODE AGAIN
 321     MOV #BRAN,X
 322     GOTO BW1
 323     ENDCODE IMMEDIATE
 324
 325 \ https://forth-standard.org/standard/core/WHILE
 326 \ WHILE    BEGINadr -- WHILEadr BEGINadr
 327     : WHILE
 328     POSTPONE IF SWAP
 329     ; IMMEDIATE
 330
 331 \ https://forth-standard.org/standard/core/REPEAT
 332 \ REPEAT   WHILEadr BEGINadr --     resolve WHILE loop
 333     : REPEAT
 334     POSTPONE AGAIN POSTPONE THEN
 335     ; IMMEDIATE
 336     [THEN]
 337
 338     [UNDEFINED] DO
 339     [IF]     \ define DO LOOP +LOOP
 340
 341 \ https://forth-standard.org/standard/core/DO
 342 \ DO       -- DOadr   L: -- 0
 343     HDNCODE XDO         \ DO run time
 344     MOV #$8000,X        \ 2 compute 8000h-limit = "fudge factor"
 345     SUB @PSP+,X         \ 2
 346     MOV TOS,Y           \ 1 loop ctr = index+fudge
 347     ADD X,Y             \ 1 Y = INDEX
 348     PUSHM #2,X          \ 4 PUSHM X,Y, i.e. PUSHM LIMIT, INDEX
 349     MOV @PSP+,TOS       \ 2
 350     MOV @IP+,PC         \ 4
 351     ENDCODE
 352
 353     CODE DO
 354     SUB #2,PSP          \
 355     MOV TOS,0(PSP)      \
 356     ADD #2,&DP          \   make room to compile xdo
 357     MOV &DP,TOS         \ -- HERE+2
 358     MOV #XDO,-2(TOS)    \   compile xdo
 359     ADD #2,&LEAVEPTR    \ -- HERE+2     LEAVEPTR+2
 360     MOV &LEAVEPTR,W     \
 361     MOV #0,0(W)         \ -- HERE+2     L-- 0, init
 362     MOV @IP+,PC
 363     ENDCODE IMMEDIATE
 364
 365 \ https://forth-standard.org/standard/core/LOOP
 366 \ LOOP    DOadr --         L-- an an-1 .. a1 0
 367     HDNCODE XLOOP       \   LOOP run time
 368     ADD #1,0(RSP)       \ 4 increment INDEX
 369 BW1 BIT #$100,SR        \ 2 is overflow bit set?
 370     0= IF               \   branch if no overflow
 371         MOV @IP,IP
 372         MOV @IP+,PC
 373     THEN
 374     ADD #4,RSP          \ 1 empties RSP
 375     ADD #2,IP           \ 1 overflow = loop done, skip branch ofs
 376     MOV @IP+,PC         \ 4 14~ taken or not taken xloop/loop
 377     ENDCODE             \
 378
 379     CODE LOOP
 380     MOV #XLOOP,X
 381 BW2 ADD #4,&DP          \ make room to compile two words
 382     MOV &DP,W
 383     MOV X,-4(W)         \ xloop --> HERE
 384     MOV TOS,-2(W)       \ DOadr --> HERE+2
 385     BEGIN                   \ resolve all "leave" adr
 386         MOV &LEAVEPTR,TOS   \ -- Adr of top LeaveStack cell
 387         SUB #2,&LEAVEPTR    \ --
 388         MOV @TOS,TOS        \ -- first LeaveStack value
 389         CMP #0,TOS          \ -- = value left by DO ?
 390     0<> WHILE
 391         MOV W,0(TOS)        \ move adr after loop as UNLOOP adr
 392     REPEAT
 393     MOV @PSP+,TOS
 394     MOV @IP+,PC
 395     ENDCODE IMMEDIATE
 396
 397 \ https://forth-standard.org/standard/core/PlusLOOP
 398 \ +LOOP   adrs --   L-- an an-1 .. a1 0
 399     HDNCODE XPLOO   \   +LOOP run time
 400     ADD TOS,0(RSP)  \ 4 increment INDEX by TOS value
 401     MOV @PSP+,TOS   \ 2 get new TOS, doesn't change flags
 402     GOTO BW1        \ 2
 403     ENDCODE         \
 404
 405     CODE +LOOP
 406     MOV #XPLOO,X
 407     GOTO BW2
 408     ENDCODE IMMEDIATE
 409     [THEN]
 410
 411     [UNDEFINED] I
 412     [IF]
 413 \ https://forth-standard.org/standard/core/I
 414 \ I        -- n   R: sys1 sys2 -- sys1 sys2
 415 \                  get the innermost loop index
 416     CODE I
 417     SUB #2,PSP              \ 1 make room in TOS
 418     MOV TOS,0(PSP)          \ 3
 419     MOV @RSP,TOS            \ 2 index = loopctr - fudge
 420     SUB 2(RSP),TOS          \ 3
 421     MOV @IP+,PC             \ 4 13~
 422     ENDCODE
 423     [THEN]
 424
 425 \ https://forth-standard.org/standard/core/BASE
 426 \ BASE    -- a-addr       holds conversion radix
 427     [UNDEFINED] BASE
 428     [IF]
 429     BASEADR  CONSTANT BASE
 430     [THEN]
 431
 432 \ https://forth-standard.org/standard/core/CR
 433 \ CR      --               send CR+LF to the output device
 434     [UNDEFINED] CR
 435     [IF]
 436     DEFER CR    \ DEFERed definition, by default executes that of :NONAME
 437
 438     :NONAME
 439     'CR' EMIT 'LF' EMIT
 440     ; IS CR
 441     [THEN]
 442
 443     [UNDEFINED] DUMP
 444     [IF]       \ defined in {UTILITY}
 445 \ https://forth-standard.org/standard/tools/DUMP
 446     CODE DUMP                   \ adr n  --   dump memory
 447     PUSH IP
 448     PUSH &BASE               \ save current base
 449     MOV #$10,&BASEADR           \ HEX base
 450     ADD @PSP,TOS                \ -- ORG END
 451     LO2HI
 452     SWAP                      \ -- END ORG
 453     DO  CR                    \ generate line
 454         I 4 U.R SPACE           \ generate address
 455         I 8 + I
 456         DO I C@ 3 U.R LOOP
 457         SPACE
 458         I $10 + I 8 +
 459         DO I C@ 3 U.R LOOP
 460         SPACE SPACE
 461         I $10 + I             \ display 16 chars
 462         DO I C@ $7E MIN $20 MAX EMIT LOOP
 463     $10 +LOOP
 464     R> BASE !              \ restore current base
 465     ;
 466     [THEN]
 467
 468 \ -----------------------------------------------------------------------
 469 \ test CPUx instructions PUSHM, POPM, RLAM, RRAM, RRCM, RRUM
 470 \ -----------------------------------------------------------------------
 471     CODE TESTPUSHM
 472 BW1
 473 \    PUSHM  #16,R14     \ uncomment to test error "out of bounds"
 474 \    PUSHM  #2,R0       \ uncomment to test error "out of bounds"
 475 \    PUSHM  #0,IP       \ uncomment to test error "out of bounds"
 476 \    POPM   #17,R15     \ uncomment to test error "out of bounds"
 477 \    POPM   #2,R0       \ uncomment to test error "out of bounds"
 478 \    POPM   #0,IP       \ uncomment to test error "out of bounds"
 479     MOV     #22222,Y
 480     MOV     #3,X
 481     MOV     #2,W
 482     MOV     #1,T
 483     MOV     #0,S
 484
 485     PUSHM   #4,IP       \ PUSHM IP,S,T,W
 486     POPM    #4,IP       \ POPM  W,T,S,IP
 487     SUB     #10,PSP
 488     MOV     TOS,8(PSP)  \ save old TOS
 489     MOV     S,6(PSP)
 490     MOV     T,4(PSP)
 491     MOV     W,2(PSP)
 492     MOV     X,0(PSP)
 493     MOV     Y,TOS
 494 \    RLAM    #0,TOS      \ uncomment to test error "out of bounds"
 495 \    RLAM    #5,TOS      \ uncomment to test error "out of bounds"
 496     RRAM    #1,TOS      \ 0 < shift value < 5
 497     RLAM    #2,TOS
 498     RRCM    #1,TOS
 499     RRUM    #1,TOS
 500     COLON               \ high level part of the word starts here...
 501     space . . . . .
 502     ;                   \ and finishes here.
 503
 504     TESTPUSHM  ; you should see 11111 3 2 1 0 -->
 505
 506     CODE TESTPOPM
 507             GOTO BW1            \ JMP TESTPUSHM
 508     ENDCODE
 509
 510     TESTPOPM  ; you should see 11111 3 2 1 0 -->
 511
 512
 513
 514 \ -----------------------------------------------------------------------
 515 \ test symbolic branch in assembler
 516 \ test a FORTH section encapsulated in an assembly word
 517 \ -----------------------------------------------------------------------
 518     CODE TEST1                  \ the word "CODE" add ASSEMBLER as CONTEXT vocabulary...
 519
 520     MOV &BASE,&BASE \ to test &xxxx src operand
 521     CMP #%10,&BASE
 522     0<> IF  MOV #2,&BASE    \ if base <> 2
 523     ELSE    MOV #$0A,&BASE  \ else base = 2
 524     THEN
 525     COLON           \ tips : no "ok" displayed in start of line <==> compilation mode
 526     BASE @ U.       \ always display 10 !
 527     ;
 528     \
 529
 530 \ -----------------------------------------------------------------------
 531 \ test a word that starts as word FORTH and ends as assembly word
 532 \ -----------------------------------------------------------------------
 533     : TEST2                     \ ":" starts compilation
 534     BASE @ U.       \ always display 10 !
 535     HI2LO           \ switch FORTH to ASM : compile one word (next address)
 536                     \                       add vocabulary ASSEMBLER as CONTEXT vocabulary
 537                     \                       switch in interpret mode
 538     CMP #2, &BASE
 539     0<> IF  MOV #2, &BASE   \ if variable system BASE <> 2
 540     ELSE    MOV #10,&BASE   \ else (BASE = 2)
 541     THEN
 542 \           MOV #EXIT,PC    \ to pair with ":" i.e. to restore IP saved by : then execute NEXT.
 543 \ but even compile two words, it's better to compile an inline EXIT :
 544     MOV @RSP+,IP    \ restore IP
 545     MOV @IP+,PC     \ = NEXT
 546     ENDCODE                     \ ends assembler : remove vocabulary ASSEMBLER from CONTEXT
 547 \
 548
 549 \ -----------------------------------------------------------------------
 550 \ test a word that starts as assembly word and ends as FORTH word
 551 \ -----------------------------------------------------------------------
 552     CODE TEST3                  \ "CODE" starts assembler, i.e. add ASSEMBLER as CONTEXT vocabulary
 553     CMP #2, &BASE
 554     0<> IF  MOV #2, &BASE   \ if variable system BASE <> 2
 555     ELSE    MOV #10,&BASE   \ else (BASE = 2)
 556     THEN    COLON           \
 557     BASE @  U.      \ always display 10 !
 558     ;                           \
 559 \
 560
 561
 562 \ -----------------------------------------------------------------------
 563 \ test an assembly jump spanning a section written in FORTH
 564 \ -----------------------------------------------------------------------
 565 : TEST5
 566             SPACE
 567             HI2LO
 568             SUB #2,PSP
 569             MOV TOS,0(PSP)
 570             MOV #%1010,TOS  \ init count = 10
 571 BEGIN       SUB #$0001,TOS
 572             LO2HI
 573                             \ IP is already saved by word ":"
 574             DUP U.          \ display count
 575             HI2LO
 576             CMP #0,TOS
 577 0= UNTIL    MOV @PSP+,TOS
 578 \           MOV #EXIT,PC    \ to pair with ":" i.e. to restore IP saved by : then execute NEXT.
 579             MOV @RSP+,IP    \ restore IP
 580             MOV @IP+,PC     \ = NEXT
 581 ENDCODE
 582     \
 583 TEST5  ; you should see :  9 8 7 6 5 4 3 2 1 0 -->
 584     \
 585
 586 \ -----------------------------------------------------------------------
 587 \ tests indexing address
 588 \ -----------------------------------------------------------------------
 589
 590 [UNDEFINED] C, [IF]
 591 \ https://forth-standard.org/standard/core/CComma
 592 \ C,   char --        append char
 593 CODE C,
 594 MOV &DP,W
 595 MOV.B TOS,0(W)
 596 ADD #1,&DP
 597 MOV @PSP+,TOS
 598 MOV @IP+,PC
 599 ENDCODE
 600 [THEN]
 601
 602 [UNDEFINED] C@ [IF]
 603 \ https://forth-standard.org/standard/core/CFetch
 604 \ C@     c-addr -- char   fetch char from memory
 605 CODE C@
 606 MOV.B @TOS,TOS
 607 MOV @IP+,PC
 608 ENDCODE
 609 [THEN]
 610
 611 : BYTES_TABLE_IDX
 612 CREATE
 613 0 DO I C,
 614 LOOP
 615 DOES>
 616 +
 617 ;
 618
 619 8 BYTES_TABLE_IDX BYTES_TABLE \ create table "BYTES_TABLE" with bytes content = 0,1,2,3,4,5,6,7
 620     \
 621 2 BYTES_TABLE C@ . ; you should see 2 -->
 622 \
 623
 624
 625 VARIABLE BYTES_TABLE1
 626
 627 $0201 BYTES_TABLE1 !              \ words written in memory are little endian !
 628
 629 CODE IDX_TEST1                     \ index -- value
 630     MOV.B   BYTES_TABLE1(TOS),TOS  \ -- value
 631 COLON
 632     U.
 633 ;
 634
 635 0 IDX_TEST1     ; you should see 1 -->
 636
 637 CODE TEST6
 638             MOV 0(PSP),0(PSP)  \
 639             MOV @IP+,PC
 640 ENDCODE
 641
 642
 643 1 TEST6 .       ; you should see 1 -->
 644
 645
 646 \ -----------------------------------------------------------------------
 647 \ tests access to a CREATED word with assembler
 648 \ -----------------------------------------------------------------------
 649
 650
 651     \
 652 CREATE TABLE0
 653 0 C,
 654 1 C,
 655 2 C,
 656 3 C,
 657     \
 658
 659 CREATE TABLE10
 660 $10 C,
 661 $11 C,
 662 $12 C,
 663 $13 C,
 664
 665     \
 666
 667 CREATE TABLE20
 668 $20 C,
 669 $21 C,
 670 $22 C,
 671 $23 C,
 672     \
 673
 674 CREATE TABLE
 675
 676
 677 TABLE 2 - CONSTANT PFA_TABLE      \ PFA_TABLE leave the PFA of TABLE
 678
 679
 680 CODE REDIRECT       ; <table> --    redirects TABLE to argument <table>
 681 MOV TOS,&PFA_TABLE
 682 MOV @PSP+,TOS
 683 MOV @IP+,PC
 684 ENDCODE
 685     \
 686
 687 CODE REDIRECT0      ; --            redirects TABLE to TABLE0
 688 MOV #TABLE0,&PFA_TABLE
 689 MOV @IP+,PC
 690 ENDCODE
 691     \
 692
 693 CODE REDIRECT10     ; --            redirects TABLE to TABLE10
 694 MOV #TABLE10,&PFA_TABLE
 695 MOV @IP+,PC
 696 ENDCODE
 697     \
 698
 699 CODE REDIRECT20     ; --            redirects TABLE to TABLE20
 700 MOV #TABLE20,&PFA_TABLE
 701 MOV @IP+,PC
 702 ENDCODE
 703     \
 704
 705 ' TABLE0 10 DUMP
 706     \
 707 ' TABLE10 10 DUMP
 708     \
 709 ' TABLE20 10 DUMP
 710     \
 711     \
 712 TABLE0 REDIRECT TABLE 10 DUMP
 713     \
 714 TABLE10 REDIRECT TABLE 10 DUMP
 715     \
 716 TABLE20 REDIRECT TABLE 10 DUMP
 717     \
 718     \
 719 REDIRECT0 TABLE 10 DUMP
 720     \
 721 REDIRECT10 TABLE 10 DUMP
 722     \
 723 REDIRECT20 TABLE 10 DUMP
 724     \
 725
 726 TABLE0 PFA_TABLE ! TABLE 10 DUMP
 727     \
 728 TABLE10 PFA_TABLE ! TABLE 10 DUMP
 729     \
 730 TABLE20 PFA_TABLE ! TABLE 10 DUMP
 731     \
 732
 733 \ -----------------------------------------------------------------------
 734 \ tests behaviour of assembly error
 735 \ -----------------------------------------------------------------------
 736 \ R16 causes an error, assembler context is aborted and the word TEST7 is "hidden".
 737
 738 \CODE TEST7
 739 \           MOV 0(truc),0(R16)  ; display an error "out of bounds" -->
 740
 741 ; -----------------------------------------------------------------------
 742 ; create a primary DEFERred assembly word
 743 ; -----------------------------------------------------------------------
 744
 745
 746 DEFER TRUC              ; here, TRUC is a secondary DEFERred word (i.e. without BODY)
 747
 748
 749 CODENNM                 ; does DUP
 750     SUB #2,PSP
 751     MOV TOS,0(PSP)
 752     MOV @IP+,PC
 753 ENDCODE                 ; leaves its execution address (CFA) on stack
 754
 755 DUP .
 756
 757 IS TRUC                 ; TRUC becomes a primary DEFERred word
 758                         ; with its default action (DUP) located at its BODY addresse.
 759
 760 TRUC .                  ; display TOS value -->
 761
 762
 763 \ ' DROP IS TRUC          ; TRUC is redirected to DROP
 764 \
 765 \ TRUC                   ; The generated error displays stack empty! in reverse video, removes the TRUC definition and restarts the interpretation after the end of the file. And as you see, FastForth is able to display long lines, interesting, doesn't it? -->
 766 \
 767
 768 ' TRUC >BODY IS TRUC    ; TRUC is reinitialized with its default action
 769
 770
 771 TRUC .                  ; display TOS value -->
 772
 773 \ bla
 774 \ bla
 775 \ bla
 776 \
 777 \
 778 \
 779 \
 780 \
 781 \
 782 \
 783 \ bla
 784 \ ...
 785
 786
 787
 788