MSP430-FORTH/TESTASM.F

   1 \ -*- coding: utf-8 -*-
   2
   3 ; -----------------------------------------------------------------------
   4 ; TEST_ASM.f
   5 ; -----------------------------------------------------------------------
   6 \
   7 \ TARGET SELECTION
   8 \ MSP_EXP430FR5739  MSP_EXP430FR5969    MSP_EXP430FR5994    MSP_EXP430FR6989
   9 \ MSP_EXP430FR4133  MSP_EXP430FR2433    MSP_EXP430FR2355    CHIPSTICK_FR2433
  10 \
  11 \ PUSHM order : PSP,TOS, IP,  S,  T,  W,  X,  Y, rEXIT,rDOVAR,rDOCON, rDODOES, R3, SR,RSP, PC
  12 \ PUSHM order : R15,R14,R13,R12,R11,R10, R9, R8,  R7  ,  R6  ,  R5  ,   R4   , R3, R2, R1, R0
  13 \
  14 \ example : PUSHM #6,IP pushes IP,S,T,W,X,Y registers to return stack
  15 \
  16 \ POPM  order :  PC,RSP, SR, R3, rDODOES,rDOCON,rDOVAR,rEXIT,  Y,  X,  W,  T,  S, IP,TOS,PSP
  17 \ POPM  order :  R0, R1, R2, R3,   R4   ,  R5  ,  R6  ,  R7 , R8, R9,R10,R11,R12,R13,R14,R15
  18 \
  19 \ example : POPM #6,IP   pop Y,X,W,T,S,IP registers from return stack
  20 \
  21 \ ASSEMBLER conditionnal usage after IF UNTIL WHILE : S< S>= U< U>= 0= 0<> 0>=
  22 \ ASSEMBLER conditionnal usage before ?JMP ?GOTO    : S< S>= U< U>= 0= 0<> 0<
  23 \
  24 \ FORTH conditionnal    : 0= 0< = < > U<
  25
  26 [UNDEFINED] + [IF]
  27 \ https://forth-standard.org/standard/core/Plus
  28 \ +       n1/u1 n2/u2 -- n3/u3     add n1+n2
  29 CODE +
  30 ADD @PSP+,TOS
  31 MOV @IP+,PC
  32 ENDCODE
  33 [THEN]
  34
  35 [UNDEFINED] MAX [IF]    \ MAX and MIN are defined in {UTILITY}
  36
  37 CODE MAX    \    n1 n2 -- n3       signed maximum
  38     CMP @PSP,TOS    \ n2-n1
  39     S<  ?GOTO FW1   \ n2<n1
  40 BW1 ADD #2,PSP
  41     MOV @IP+,PC
  42 ENDCODE
  43
  44 CODE MIN    \    n1 n2 -- n3       signed minimum
  45     CMP @PSP,TOS     \ n2-n1
  46     S<  ?GOTO BW1    \ n2<n1
  47 FW1 MOV @PSP+,TOS
  48     MOV @IP+,PC
  49 ENDCODE
  50
  51 [THEN]
  52
  53 [UNDEFINED] C@ [IF]
  54 \ https://forth-standard.org/standard/core/CFetch
  55 \ C@     c-addr -- char   fetch char from memory
  56 CODE C@
  57 MOV.B @TOS,TOS
  58 MOV @IP+,PC
  59 ENDCODE
  60 [THEN]
  61
  62 [UNDEFINED] VARIABLE [IF]
  63 \ https://forth-standard.org/standard/core/VARIABLE
  64 \ VARIABLE <name>       --                      define a Forth VARIABLE
  65 : VARIABLE
  66 DEFER
  67 HI2LO
  68 MOV @RSP+,IP
  69 MOV #DOVAR,-4(W)        \   CFA = DOVAR
  70 MOV @IP+,PC
  71 ENDCODE
  72 [THEN]
  73
  74 [UNDEFINED] CONSTANT [IF]
  75 \ https://forth-standard.org/standard/core/CONSTANT
  76 \ CONSTANT <name>     n --                      define a Forth CONSTANT
  77 : CONSTANT
  78 DEFER
  79 HI2LO
  80 MOV @RSP+,IP
  81 MOV #DOCON,-4(W)        \   CFA = DOCON
  82 MOV TOS,-2(W)           \   PFA = n
  83 MOV @PSP+,TOS
  84 MOV @IP+,PC
  85 ENDCODE
  86 [THEN]
  87
  88 [UNDEFINED] SPACE [IF]
  89 \ https://forth-standard.org/standard/core/SPACE
  90 \ SPACE   --               output a space
  91 : SPACE
  92 $20 EMIT ;
  93 [THEN]
  94
  95 [UNDEFINED] SPACES [IF]
  96 \ https://forth-standard.org/standard/core/SPACES
  97 \ SPACES   n --            output n spaces
  98 CODE SPACES
  99 CMP #0,TOS
 100 0<> IF
 101     PUSH IP
 102     BEGIN
 103         LO2HI
 104         $20 EMIT
 105         HI2LO
 106         SUB #2,IP
 107         SUB #1,TOS
 108     0= UNTIL
 109     MOV @RSP+,IP
 110 THEN
 111 MOV @PSP+,TOS           \ --         drop n
 112 NEXT
 113 ENDCODE
 114 [THEN]
 115
 116 [UNDEFINED] OVER [IF]
 117 \ https://forth-standard.org/standard/core/OVER
 118 \ OVER    x1 x2 -- x1 x2 x1
 119 CODE OVER
 120 MOV TOS,-2(PSP)     \ 3 -- x1 (x2) x2
 121 MOV @PSP,TOS        \ 2 -- x1 (x2) x1
 122 SUB #2,PSP          \ 1 -- x1 x2 x1
 123 MOV @IP+,PC
 124 ENDCODE
 125 [THEN]
 126
 127 [UNDEFINED] U.R [IF]        \ defined in {UTILITY}
 128 : U.R                       \ u n --           display u unsigned in n width (n >= 2)
 129   >R  <# 0 # #S #>
 130   R> OVER - 0 MAX SPACES TYPE
 131 ;
 132 [THEN]
 133
 134 [UNDEFINED] DUMP [IF]       \ defined in {UTILITY}
 135 \ https://forth-standard.org/standard/tools/DUMP
 136 CODE DUMP                   \ adr n  --   dump memory
 137 PUSH IP
 138 PUSH &BASEADR               \ save current base
 139 MOV #$10,&BASEADR           \ HEX base
 140 ADD @PSP,TOS                \ -- ORG END
 141 LO2HI
 142   SWAP                      \ -- END ORG
 143   DO  CR                    \ generate line
 144     I 4 U.R SPACE           \ generate address
 145       I 8 + I
 146       DO I C@ 3 U.R LOOP
 147       SPACE
 148       I $10 + I 8 +
 149       DO I C@ 3 U.R LOOP
 150       SPACE SPACE
 151       I $10 + I             \ display 16 chars
 152       DO I C@ $7E MIN $20 MAX EMIT LOOP
 153   $10 +LOOP
 154   R> BASEADR !              \ restore current base
 155 ;
 156 [THEN]
 157
 158 \ -----------------------------------------------------------------------
 159 \ test CPUx instructions PUSHM, POPM, RLAM, RRAM, RRCM, RRUM
 160 \ -----------------------------------------------------------------------
 161 CODE TESTPUSHM
 162 BW1
 163 \            PUSHM  #16,R14     \ uncomment to test error "out of bounds"
 164 \            PUSHM  #2,R0       \ uncomment to test error "out of bounds"
 165 \            PUSHM  #0,IP       \ uncomment to test error "out of bounds"
 166 \            POPM   #17,R15     \ uncomment to test error "out of bounds"
 167 \            POPM   #2,R0       \ uncomment to test error "out of bounds"
 168 \            POPM   #0,IP       \ uncomment to test error "out of bounds"
 169             MOV     #22222,Y
 170             MOV     #3,X
 171             MOV     #2,W
 172             MOV     #1,T
 173             MOV     #0,S
 174
 175             PUSHM   #4,IP       \ PUSHM IP,S,T,W
 176             POPM    #4,IP       \ POPM  W,T,S,IP
 177             SUB     #10,PSP
 178             MOV     TOS,8(PSP)  \ save old TOS
 179             MOV     S,6(PSP)
 180             MOV     T,4(PSP)
 181             MOV     W,2(PSP)
 182             MOV     X,0(PSP)
 183             MOV     Y,TOS
 184 \            RLAM    #0,TOS      \ uncomment to test error "out of bounds"
 185 \            RLAM    #5,TOS      \ uncomment to test error "out of bounds"
 186             RRAM    #1,TOS      \ 0 < shift value < 5
 187             RLAM    #2,TOS
 188             RRCM    #1,TOS
 189             RRUM    #1,TOS
 190             COLON               \ high level part of the word starts here...
 191             space . . . . .
 192             ;                   \ and finishes here.
 193     \
 194 TESTPUSHM  ; you should see 11111 3 2 1 0 -->
 195
 196 CODE TESTPOPM
 197             GOTO BW1            \ JMP TESTPUSHM
 198 ENDCODE
 199
 200     \
 201 TESTPOPM  ; you should see 11111 3 2 1 0 -->
 202
 203
 204
 205 \ -----------------------------------------------------------------------
 206 \ test symbolic branch in assembler
 207 \ test a FORTH section encapsulated in an assembly word
 208 \ -----------------------------------------------------------------------
 209 CODE TEST1                  \ the word "CODE" add ASSEMBLER as CONTEXT vocabulary...
 210
 211             MOV &BASEADR,&BASEADR \ to test &xxxx src operand
 212             CMP #%10,&BASEADR
 213 0<> IF      MOV #2,&BASEADR    \ if base <> 2
 214 ELSE        MOV #$0A,&BASEADR  \ else base = 2
 215 THEN
 216             COLON           \ tips : no "ok" displayed in start of line <==> compilation mode
 217             BASEADR @ U.       \ always display 10 !
 218             ;
 219     \
 220
 221 \ -----------------------------------------------------------------------
 222 \ test a word that starts as word FORTH and ends as assembly word
 223 \ -----------------------------------------------------------------------
 224 : TEST2                     \ ":" starts compilation
 225             BASEADR @ U.       \ always display 10 !
 226             HI2LO           \ switch FORTH to ASM : compile one word (next address)
 227                             \                       add vocabulary ASSEMBLER as CONTEXT vocabulary
 228                             \                       switch in interpret mode
 229             CMP #2, &BASEADR
 230 0<> IF      MOV #2, &BASEADR   \ if variable system BASE <> 2
 231 ELSE        MOV #10,&BASEADR   \ else (BASE = 2)
 232 THEN
 233 \           MOV #EXIT,PC    \ to pair with ":" i.e. to restore IP saved by : then execute NEXT.
 234 \ but even compile two words, it's better to compile an inline EXIT :
 235             MOV @RSP+,IP    \ restore IP
 236             MOV @IP+,PC     \ = NEXT
 237 ENDCODE                     \ ends assembler : remove vocabulary ASSEMBLER from CONTEXT
 238     \
 239
 240 \ -----------------------------------------------------------------------
 241 \ test a word that starts as assembly word and ends as FORTH word
 242 \ -----------------------------------------------------------------------
 243 CODE TEST3                  \ "CODE" starts assembler, i.e. add ASSEMBLER as CONTEXT vocabulary
 244             CMP #2, &BASEADR
 245 0<> IF      MOV #2, &BASEADR   \ if variable system BASE <> 2
 246 ELSE        MOV #10,&BASEADR   \ else (BASE = 2)
 247 THEN        COLON           \
 248             BASEADR @  U.      \ always display 10 !
 249 ;                           \
 250     \
 251
 252
 253 \ -----------------------------------------------------------------------
 254 \ test an assembly jump spanning a section written in FORTH
 255 \ -----------------------------------------------------------------------
 256 : TEST5
 257             SPACE
 258             HI2LO
 259             SUB #2,PSP
 260             MOV TOS,0(PSP)
 261             MOV #%1010,TOS  \ init count = 10
 262 BEGIN       SUB #$0001,TOS
 263             LO2HI
 264                             \ IP is already saved by word ":"
 265             DUP U.          \ display count
 266             HI2LO
 267             CMP #0,TOS
 268 0= UNTIL    MOV @PSP+,TOS
 269 \           MOV #EXIT,PC    \ to pair with ":" i.e. to restore IP saved by : then execute NEXT.
 270             MOV @RSP+,IP    \ restore IP
 271             MOV @IP+,PC     \ = NEXT
 272 ENDCODE
 273     \
 274 TEST5  ; you should see :  9 8 7 6 5 4 3 2 1 0 -->
 275     \
 276
 277 \ -----------------------------------------------------------------------
 278 \ tests indexing address
 279 \ -----------------------------------------------------------------------
 280
 281 [UNDEFINED] C, [IF]
 282 \ https://forth-standard.org/standard/core/CComma
 283 \ C,   char --        append char
 284 CODE C,
 285 MOV &DP,W
 286 MOV.B TOS,0(W)
 287 ADD #1,&DP
 288 MOV @PSP+,TOS
 289 MOV @IP+,PC
 290 ENDCODE
 291 [THEN]
 292
 293 [UNDEFINED] C@ [IF]
 294 \ https://forth-standard.org/standard/core/CFetch
 295 \ C@     c-addr -- char   fetch char from memory
 296 CODE C@
 297 MOV.B @TOS,TOS
 298 MOV @IP+,PC
 299 ENDCODE
 300 [THEN]
 301
 302 : BYTES_TABLE_IDX
 303 CREATE
 304 0 DO I C,
 305 LOOP
 306 DOES>
 307 +
 308 ;
 309
 310 8 BYTES_TABLE_IDX BYTES_TABLE \ create table "BYTES_TABLE" with bytes content = 0,1,2,3,4,5,6,7
 311     \
 312 2 BYTES_TABLE C@ . ; you should see 2 -->
 313 \
 314
 315
 316 VARIABLE BYTES_TABLE1
 317
 318 $0201 BYTES_TABLE1 !              \ words written in memory are little endian !
 319
 320 CODE IDX_TEST1                     \ index -- value
 321     MOV.B   BYTES_TABLE1(TOS),TOS  \ -- value
 322 COLON
 323     U.
 324 ;
 325
 326 0 IDX_TEST1     ; you should see 1 -->
 327
 328 CODE TEST6
 329             MOV 0(PSP),0(PSP)  \
 330             MOV @IP+,PC
 331 ENDCODE
 332
 333
 334 1 TEST6 .       ; you should see 1 -->
 335
 336
 337 \ -----------------------------------------------------------------------
 338 \ tests access to a CREATED word with assembler
 339 \ -----------------------------------------------------------------------
 340
 341
 342     \
 343 CREATE TABLE0
 344 0 C,
 345 1 C,
 346 2 C,
 347 3 C,
 348     \
 349
 350 CREATE TABLE10
 351 $10 C,
 352 $11 C,
 353 $12 C,
 354 $13 C,
 355
 356     \
 357
 358 CREATE TABLE20
 359 $20 C,
 360 $21 C,
 361 $22 C,
 362 $23 C,
 363     \
 364
 365 CREATE TABLE
 366
 367
 368 TABLE 2 - CONSTANT PFA_TABLE      \ PFA_TABLE leave the PFA of TABLE
 369
 370
 371 CODE REDIRECT       ; <table> --    redirects TABLE to argument <table>
 372 MOV TOS,&PFA_TABLE
 373 MOV @PSP+,TOS
 374 MOV @IP+,PC
 375 ENDCODE
 376     \
 377
 378 CODE REDIRECT0      ; --            redirects TABLE to TABLE0
 379 MOV #TABLE0,&PFA_TABLE
 380 MOV @IP+,PC
 381 ENDCODE
 382     \
 383
 384 CODE REDIRECT10     ; --            redirects TABLE to TABLE10
 385 MOV #TABLE10,&PFA_TABLE
 386 MOV @IP+,PC
 387 ENDCODE
 388     \
 389
 390 CODE REDIRECT20     ; --            redirects TABLE to TABLE20
 391 MOV #TABLE20,&PFA_TABLE
 392 MOV @IP+,PC
 393 ENDCODE
 394     \
 395
 396 ' TABLE0 10 DUMP
 397     \
 398 ' TABLE10 10 DUMP
 399     \
 400 ' TABLE20 10 DUMP
 401     \
 402     \
 403 TABLE0 REDIRECT TABLE 10 DUMP
 404     \
 405 TABLE10 REDIRECT TABLE 10 DUMP
 406     \
 407 TABLE20 REDIRECT TABLE 10 DUMP
 408     \
 409     \
 410 REDIRECT0 TABLE 10 DUMP
 411     \
 412 REDIRECT10 TABLE 10 DUMP
 413     \
 414 REDIRECT20 TABLE 10 DUMP
 415     \
 416
 417 TABLE0 PFA_TABLE ! TABLE 10 DUMP
 418     \
 419 TABLE10 PFA_TABLE ! TABLE 10 DUMP
 420     \
 421 TABLE20 PFA_TABLE ! TABLE 10 DUMP
 422     \
 423
 424 \ -----------------------------------------------------------------------
 425 \ tests behaviour of assembly error
 426 \ -----------------------------------------------------------------------
 427 \ R16 causes an error, assembler context is aborted and the word TEST7 is "hidden".
 428
 429 \CODE TEST7
 430 \           MOV 0(truc),0(R16)  ; display an error "out of bounds" -->
 431
 432 ; -----------------------------------------------------------------------
 433 ; create a primary DEFERred assembly word
 434 ; -----------------------------------------------------------------------
 435
 436
 437 DEFER TRUC              ; here, TRUC is a secondary DEFERred word (i.e. without BODY)
 438     \
 439
 440
 441 CODENNM                 ; leaves its execution address (CFA) on stack
 442     SUB #2,PSP
 443     MOV TOS,0(PSP)
 444     MOV @IP+,PC
 445 ENDCODE
 446
 447 DUP .
 448
 449 IS TRUC                 ; TRUC becomes a primary DEFERred word
 450                         ; with its default action (DUP) located at its BODY addresse.
 451
 452 TRUC .                  ; display TOS value -->
 453
 454
 455 ' TRUC >BODY IS TRUC    ; TRUC is reinitialzed with its default action
 456
 457
 458 TRUC .                  ; display TOS value -->
 459
 460 \ ' DROP IS TRUC          ; TRUC is redirected to DROP
 461 \
 462 \ 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? -->
 463 \
 464 \ bla
 465 \ bla
 466 \ bla
 467 \
 468 \
 469 \
 470 \
 471 \
 472 \
 473 \
 474 \ bla
 475 \ ...
 476
 477
 478
 479