MSP430-FORTH/TSTWORDS.f

   1 \ -----------------------------
   2 \ MSP-EXP430FR5969_TSTWORDS.f
   3 \ -----------------------------
   4
   5 \ first, we test for downloading driver only if UART TERMINAL target
   6     CODE ABORT_TSTWORDS
   7     SUB #2,PSP
   8     MOV TOS,0(PSP)
   9     MOV &VERSION,TOS
  10     SUB #309,TOS        \                   FastForth V3.9
  11     COLON
  12     'CR' EMIT            \ return to column 1 without 'LF'
  13     ABORT" FastForth V3.9 please!"
  14     RST_RET           \ remove ABORT_TEST_ASM definition before resuming
  15     ;
  16
  17     ABORT_TSTWORDS      \ abort test
  18
  19     [DEFINED] {TSTWORDS} [IF]  {TSTWORDS} [THEN] \ remove it
  20
  21     MARKER {TSTWORDS}
  22
  23
  24 \ https://forth-standard.org/standard/core/ZeroEqual
  25 \ 0=     n/u -- flag    return true if TOS=0
  26     [UNDEFINED] 0=
  27     [IF]
  28     CODE 0=
  29     SUB #1,TOS      \ 1 borrow (clear cy) if TOS was 0
  30     SUBC TOS,TOS    \ 1 TOS=-1 if borrow was set
  31     MOV @IP+,PC
  32     ENDCODE
  33     [THEN]
  34
  35     [UNDEFINED] DUP
  36     [IF]    \ define DUP and ?DUP
  37 \ https://forth-standard.org/standard/core/DUP
  38 \ DUP      x -- x x      duplicate top of stack
  39     CODE DUP
  40 BW1 SUB #2,PSP      \ 2  push old TOS..
  41     MOV TOS,0(PSP)  \ 3  ..onto stack
  42     MOV @IP+,PC     \ 4
  43     ENDCODE
  44
  45 \ https://forth-standard.org/standard/core/qDUP
  46 \ ?DUP     x -- 0 | x x    DUP if nonzero
  47     CODE ?DUP
  48     CMP #0,TOS      \ 2  test for TOS nonzero
  49     0<> ?GOTO BW1   \ 2
  50     MOV @IP+,PC     \ 4
  51     ENDCODE
  52     [THEN]
  53
  54 \ https://forth-standard.org/standard/core/IF
  55 \ IF       -- IFadr    initialize conditional forward branch
  56     [UNDEFINED] IF
  57     [IF]     \ define IF THEN
  58
  59     CODE IF
  60     SUB #2,PSP              \
  61     MOV TOS,0(PSP)          \
  62     MOV &DP,TOS             \ -- HERE
  63     ADD #4,&DP            \           compile one word, reserve one word
  64     MOV #QFBRAN,0(TOS)      \ -- HERE   compile QFBRAN
  65     ADD #2,TOS              \ -- HERE+2=IFadr
  66     MOV @IP+,PC
  67     ENDCODE IMMEDIATE
  68
  69 \ https://forth-standard.org/standard/core/THEN
  70 \ THEN     IFadr --                resolve forward branch
  71     CODE THEN
  72     MOV &DP,0(TOS)          \ -- IFadr
  73     MOV @PSP+,TOS           \ --
  74     MOV @IP+,PC
  75     ENDCODE IMMEDIATE
  76     [THEN]
  77
  78 \ https://forth-standard.org/standard/core/ELSE
  79 \ ELSE     IFadr -- ELSEadr        resolve forward IF branch, leave ELSEadr on stack
  80     [UNDEFINED] ELSE
  81     [IF]
  82     CODE ELSE
  83     ADD #4,&DP              \ make room to compile two words
  84     MOV &DP,W               \ W=HERE+4
  85     MOV #BRAN,-4(W)
  86     MOV W,0(TOS)            \ HERE+4 ==> [IFadr]
  87     SUB #2,W                \ HERE+2
  88     MOV W,TOS               \ -- ELSEadr
  89     MOV @IP+,PC
  90     ENDCODE IMMEDIATE
  91     [THEN]
  92
  93 \ https://forth-standard.org/standard/core/SWAP
  94 \ SWAP     x1 x2 -- x2 x1    swap top two items
  95     [UNDEFINED] SWAP
  96     [IF]
  97     CODE SWAP
  98     PUSH TOS            \ 3
  99     MOV @PSP,TOS        \ 2
 100     MOV @RSP+,0(PSP)    \ 4
 101     MOV @IP+,PC         \ 4
 102     ENDCODE
 103     [THEN]
 104
 105 \ https://forth-standard.org/standard/core/BEGIN
 106 \ BEGIN    -- BEGINadr             initialize backward branch
 107     [UNDEFINED] BEGIN
 108     [IF]  \ define BEGIN UNTIL AGAIN WHILE REPEAT
 109
 110     CODE BEGIN
 111     MOV #HEREXEC,PC
 112     ENDCODE IMMEDIATE
 113
 114 \ https://forth-standard.org/standard/core/UNTIL
 115 \ UNTIL    BEGINadr --             resolve conditional backward branch
 116     CODE UNTIL
 117     MOV #QFBRAN,X
 118 BW1 ADD #4,&DP          \ compile two words
 119     MOV &DP,W           \ W = HERE
 120     MOV X,-4(W)         \ compile Bran or QFBRAN at HERE
 121     MOV TOS,-2(W)       \ compile bakcward adr at HERE+2
 122     MOV @PSP+,TOS
 123     MOV @IP+,PC
 124     ENDCODE IMMEDIATE
 125
 126 \ https://forth-standard.org/standard/core/AGAIN
 127 \ AGAIN    BEGINadr --             resolve uncondionnal backward branch
 128     CODE AGAIN
 129     MOV #BRAN,X
 130     GOTO BW1
 131     ENDCODE IMMEDIATE
 132
 133 \ https://forth-standard.org/standard/core/WHILE
 134 \ WHILE    BEGINadr -- WHILEadr BEGINadr
 135     : WHILE
 136     POSTPONE IF SWAP
 137     ; IMMEDIATE
 138
 139 \ https://forth-standard.org/standard/core/REPEAT
 140 \ REPEAT   WHILEadr BEGINadr --     resolve WHILE loop
 141     : REPEAT
 142     POSTPONE AGAIN POSTPONE THEN
 143     ; IMMEDIATE
 144     [THEN]
 145
 146     [UNDEFINED] DO
 147     [IF]     \ define DO LOOP +LOOP
 148
 149 \ https://forth-standard.org/standard/core/DO
 150 \ DO       -- DOadr   L: -- 0
 151     HDNCODE XDO         \ DO run time
 152     MOV #$8000,X        \ 2 compute 8000h-limit = "fudge factor"
 153     SUB @PSP+,X         \ 2
 154     MOV TOS,Y           \ 1 loop ctr = index+fudge
 155     ADD X,Y             \ 1 Y = INDEX
 156     PUSHM #2,X          \ 4 PUSHM X,Y, i.e. PUSHM LIMIT, INDEX
 157     MOV @PSP+,TOS       \ 2
 158     MOV @IP+,PC         \ 4
 159     ENDCODE
 160
 161     CODE DO
 162     SUB #2,PSP          \
 163     MOV TOS,0(PSP)      \
 164     ADD #2,&DP          \   make room to compile xdo
 165     MOV &DP,TOS         \ -- HERE+2
 166     MOV #XDO,-2(TOS)    \   compile xdo
 167     ADD #2,&LEAVEPTR    \ -- HERE+2     LEAVEPTR+2
 168     MOV &LEAVEPTR,W     \
 169     MOV #0,0(W)         \ -- HERE+2     L-- 0, init
 170     MOV @IP+,PC
 171     ENDCODE IMMEDIATE
 172
 173 \ https://forth-standard.org/standard/core/LOOP
 174 \ LOOP    DOadr --         L-- an an-1 .. a1 0
 175     HDNCODE XLOOP       \   LOOP run time
 176     ADD #1,0(RSP)       \ 4 increment INDEX
 177 BW1 BIT #$100,SR        \ 2 is overflow bit set?
 178     0= IF               \   branch if no overflow
 179         MOV @IP,IP
 180         MOV @IP+,PC
 181     THEN
 182     ADD #4,RSP          \ 1 empties RSP
 183     ADD #2,IP           \ 1 overflow = loop done, skip branch ofs
 184     MOV @IP+,PC         \ 4 14~ taken or not taken xloop/loop
 185     ENDCODE             \
 186
 187     CODE LOOP
 188     MOV #XLOOP,X
 189 BW2 ADD #4,&DP          \ make room to compile two words
 190     MOV &DP,W
 191     MOV X,-4(W)         \ xloop --> HERE
 192     MOV TOS,-2(W)       \ DOadr --> HERE+2
 193     BEGIN                   \ resolve all "leave" adr
 194         MOV &LEAVEPTR,TOS   \ -- Adr of top LeaveStack cell
 195         SUB #2,&LEAVEPTR    \ --
 196         MOV @TOS,TOS        \ -- first LeaveStack value
 197         CMP #0,TOS          \ -- = value left by DO ?
 198     0<> WHILE
 199         MOV W,0(TOS)        \ move adr after loop as UNLOOP adr
 200     REPEAT
 201     MOV @PSP+,TOS
 202     MOV @IP+,PC
 203     ENDCODE IMMEDIATE
 204
 205 \ https://forth-standard.org/standard/core/PlusLOOP
 206 \ +LOOP   adrs --   L-- an an-1 .. a1 0
 207     HDNCODE XPLOO   \   +LOOP run time
 208     ADD TOS,0(RSP)  \ 4 increment INDEX by TOS value
 209     MOV @PSP+,TOS   \ 2 get new TOS, doesn't change flags
 210     GOTO BW1        \ 2
 211     ENDCODE         \
 212
 213     CODE +LOOP
 214     MOV #XPLOO,X
 215     GOTO BW2
 216     ENDCODE IMMEDIATE
 217     [THEN]
 218
 219
 220     RST_SET
 221 \ -----------------------------------------------------------------------
 222 \ test some assembler words and show how to mix FORTH/ASSEMBLER routines
 223 \ -----------------------------------------------------------------------
 224 LOAD" \misc\TestASM.4th"
 225
 226 ECHO
 227
 228 \ -------------------------------------
 229 \ here we returned in the TestWords.4th
 230 \ -------------------------------------
 231
 232 \ ----------
 233 \ LOOP tests
 234 \ ----------
 235 : LOOP_TEST 8 0 DO I . LOOP
 236 ;
 237
 238 LOOP_TEST   \ you should see 0 1 2 3 4 5 6 7 -->
 239
 240
 241 : LOOP_TEST1    \   n <LOOP_TEST1> ---
 242     BEGIN   DUP U. 1 -
 243     ?DUP
 244     0= UNTIL
 245 ;
 246 \
 247 \ : LOOP_MAX      \ FIND_NOTHING      --
 248 \     0 0
 249 \     DO
 250 \     LOOP            \ 14 cycles by loop
 251 \     ABORT" 65536 LOOP "
 252 \ ;
 253 \
 254 : FIND_TEST            \ FIND_TEST <word>     --
 255    $20 WORD             \ -- c-addr
 256        50000 0
 257        DO              \ -- c-addr
 258            DUP
 259            FIND DROP DROP
 260        LOOP
 261     FIND
 262     0=  IF ABORT" <-- not found !"
 263         ELSE ABORT" <-- found !"
 264         THEN
 265  ;
 266 \
 267 \ \ seeking $ word, FIND jumps all words on their first character so time of word loop is 20 cycles
 268 \ \ see FIND in the source file for more information
 269 \ \
 270 \ \ FIND_TEST <lastword> result @ 8MHz, monothread : 1,2s
 271 \ \
 272 \ \ FIND_TEST $ results @ 8MHz, monothread, 201 words in vocabulary FORTH :
 273 \ \ 27 seconds with only FORTH vocabulary in CONTEXT
 274 \ \ 540 us for one search ( which gives the delay for QNUMBER in INTERPRET routine)
 275 \ \ 2.6866 us / word, 21,49 cycles / word (for 20 cycles calculated (see FIND in source file)
 276 \ \
 277 \ \
 278 \ \ FIND_TEST $ results @ 8MHz, 2 threads, 201 words in vocabulary FORTH :
 279 \ \ 13 second with only FORTH vocabulary in CONTEXT
 280 \ \ 260 us for one search ( which gives the delay for QNUMBER in INTERPRET routine)
 281 \ \ 1,293 us / word, 10,34 cycles / word
 282 \ \
 283 \ \ FIND_TEST $ results @ 8MHz, 4 threads, 201 words in vocabulary FORTH :
 284 \ \ 8 second with only FORTH vocabulary in CONTEXT
 285 \ \ 160 us for one search ( which gives the delay for QNUMBER in INTERPRET routine)
 286 \ \ 0,796 us / word, 6,37 cycles / word
 287 \ \
 288 \ \ FIND_TEST $ results @ 8MHz, 8 threads, 201 words in vocabulary FORTH :
 289 \ \ 4.66 second with only FORTH vocabulary in CONTEXT
 290 \ \ 93 us for one search ( which gives the delay for QNUMBER in INTERPRET routine)
 291 \ \ 0,4463 us / word, 3,7 cycles / word
 292 \ \
 293 \ \ FIND_TEST $ results @ 8MHz, 16 threads, 201 words in vocabulary FORTH :
 294 \ \ 2,8 second with only FORTH vocabulary in CONTEXT
 295 \ \ 56 us for one search ( which gives the delay for QNUMBER in INTERPRET routine)
 296 \ \ 0,278 us / word, 2,22 cycles / word
 297 \ \
 298 \ \ --------
 299 \ \ KEY test
 300 \ \ --------
 301 \ : KEY_TEST
 302 \     ."  type a key : "
 303 \     KEY EMIT    \ wait for a KEY, then emit it
 304 \ ;
 305 \ \ KEY_TEST
 306 \