OSDN Git Service

la der de der
[fast-forth/master.git] / MSP430-FORTH / CORE_ANS.f
1 \ -*- coding: utf-8 -*-
2 \
3 \ TARGET SELECTION ( = the name of \INC\target.pat file without the extension)
4 \ (used by preprocessor GEMA to load the pattern: \inc\TARGET.pat)
5 \ MSP_EXP430FR5739  MSP_EXP430FR5969    MSP_EXP430FR5994    MSP_EXP430FR6989
6 \ MSP_EXP430FR4133  CHIPSTICK_FR2433    MSP_EXP430FR2433    MSP_EXP430FR2355
7 \ LP_MSP430FR2476
8 \ MY_MSP430FR5738_2
9 \
10 \ from scite editor : copy your target selection in (shift+F8) parameter 1:
11 \
12 \ OR
13 \
14 \ drag and drop this file onto SendSourceFileToTarget.bat
15 \ then select your TARGET when asked.
16 \
17 \
18 \ REGISTERS USAGE
19 \ rDODOES to rEXIT must be saved before use and restored after
20 \ scratch registers Y to S are free for use
21 \ under interrupt, IP is free for use
22 \
23 \ PUSHM order : PSP,TOS, IP,  S,  T,  W,  X,  Y, rEXIT, rDOVAR, rDOCON, rDODOES
24 \ example : PUSHM #6,IP pushes IP,S,T,W,X,Y registers to return stack
25 \
26 \ POPM  order :  rDODOES, rDOCON, rDOVAR, rEXIT,  Y,  X,  W,  T,  S, IP,TOS,PSP
27 \ example : POPM #6,IP   pulls Y,X,W,T,S,IP registers from return stack
28 \
29 \ FORTH conditionnals:  unary{ 0= 0< 0> }, binary{ = < > U< }
30 \
31 \ ASSEMBLER conditionnal usage with IF UNTIL WHILE  S<  S>=  U<   U>=  0=  0<>  0>=
32 \ ASSEMBLER conditionnal usage with ?GOTO           S<  S>=  U<   U>=  0=  0<>  0<
33
34     CODE ABORT_CORE_ANS
35     SUB #2,PSP
36     MOV TOS,0(PSP)
37     MOV &VERSION,TOS
38     SUB #401,TOS            \ FastForth V4.1
39     COLON
40     'CR' EMIT               \ return to column 1, no 'LF'
41     ABORT" FastForth V4.1 please!"
42     ;
43
44     ABORT_CORE_ANS
45
46     [UNDEFINED] BC! [IF] 
47 \  BC!     pattern @ --            Bits Clear in @
48     CODE BC!
49     BIC @PSP+,0(TOS)
50     MOV @PSP+,TOS
51     MOV @IP+,PC
52     ENDCODE
53     [THEN]
54
55     [UNDEFINED] BS! [IF]
56 \  BS!     pattern @ --            Bits Set in @
57     CODE BS!
58     BIS @PSP+,0(TOS)
59     MOV @PSP+,TOS
60     MOV @IP+,PC
61     ENDCODE
62     [THEN]
63
64 \ =============================================================================
65     $8000 KERNEL_ADDON BC! \ uncomment to select SYMMETRIC division
66 \    $8000 KERNEL_ADDON BS! \ uncomment to select FLOORED division
67 \ =============================================================================
68
69     RST_RET           \ remove all above before CORE_ANS downloading
70
71 ; ----------------------------------
72 ; CORE_ANS.f
73 ; ----------------------------------
74 \
75 \ words complement to pass CORETEST.4TH
76
77     [DEFINED] {CORE_ANS} 
78     [IF] {CORE_ANS} [THEN]   \ if already defined removes it before.
79
80     [UNDEFINED] {CORE_ANS} [IF]
81     MARKER {CORE_ANS}
82
83     [UNDEFINED] ABORT [IF]
84 \ https://forth-standard.org/standard/core/ABORT
85 \ Empty the data stack and perform the function of QUIT
86     CODE ABORT
87     MOV #ABORT,PC           \ addr defined in MSP430FRxxxx.pat
88     ENDCODE
89     [THEN]
90
91     [UNDEFINED] QUIT [IF]
92 \ https://forth-standard.org/standard/core/QUIT
93 \ Empty the return stack, store zero in SOURCE-ID if it is present, 
94 \ make the user input device the input source, and enter interpretation state.
95 \ Do not display a message. Repeat the following:
96 \   Accept a line from the input source into the input buffer, set >IN to zero, and interpret.
97 \   Display the implementation-defined system prompt if in interpretation state, 
98 \                                                       all processing has been completed, 
99 \                                                       and no ambiguous condition exists.
100     CODE QUIT
101     MOV #QUIT,PC            \ addr defined in MSP430FRxxxx.pat
102     ENDCODE
103     [THEN]
104
105     [UNDEFINED] HERE [IF]
106 \ https://forth-standard.org/standard/core/HERE
107 \ HERE          -- addr     addr is the data-space pointer.
108     CODE HERE
109     MOV #BEGIN,PC           \ execute ASM BEGIN
110     ENDCODE
111     [THEN]
112
113     [UNDEFINED] + [IF]
114 \ https://forth-standard.org/standard/core/Plus
115 \ +       n1/u1 n2/u2 -- n3/u3     add n1+n2
116     CODE +
117     ADD @PSP+,TOS
118     MOV @IP+,PC
119     ENDCODE
120     [THEN]
121
122     [UNDEFINED] - [IF]
123 \ https://forth-standard.org/standard/core/Minus
124 \ -      n1/u1 n2/u2 -- n3/u3     n3 = n1-n2
125     CODE -
126     SUB @PSP+,TOS   \ 2  -- n2-n1 ( = -n3)
127     XOR #-1,TOS     \ 1
128     ADD #1,TOS      \ 1  -- n3 = -(n2-n1) = n1-n2
129     MOV @IP+,PC
130     ENDCODE
131     [THEN]
132
133     [UNDEFINED] DUP [IF]    \ define DUP and ?DUP
134
135 \ https://forth-standard.org/standard/core/DUP
136 \ DUP      x -- x x      duplicate top of stack
137     CODE DUP
138 BW1 SUB #2,PSP      \ 2  push old TOS..
139     MOV TOS,0(PSP)  \ 3  ..onto stack
140     MOV @IP+,PC     \ 4
141     ENDCODE
142
143 \ https://forth-standard.org/standard/core/qDUP
144 \ ?DUP     x -- 0 | x x    DUP if nonzero
145     CODE ?DUP
146     CMP #0,TOS      \ 2  test for TOS nonzero
147     0<> ?GOTO BW1    \ 2
148     MOV @IP+,PC     \ 4
149     ENDCODE
150     [THEN]
151
152     [UNDEFINED] EXIT [IF]
153 \ https://forth-standard.org/standard/core/EXIT
154 \ EXIT     --      exit a colon definition
155     CODE EXIT
156     MOV @RSP+,IP    \ 2 pop previous IP (or next PC) from return stack
157     MOV @IP+,PC     \ 4 = NEXT
158     ENDCODE
159     [THEN]
160
161     [UNDEFINED] DEPTH [IF]
162 \ https://forth-standard.org/standard/core/DEPTH
163 \ DEPTH    -- +n        number of items on stack, must leave 0 if stack empty
164     CODE DEPTH
165     MOV TOS,-2(PSP)
166     MOV #PSTACK,TOS
167     SUB PSP,TOS     \ PSP-S0--> TOS
168     RRA TOS         \ TOS/2   --> TOS
169     SUB #2,PSP      \ post decrement stack...
170     MOV @IP+,PC
171     ENDCODE
172     [THEN]
173
174     [UNDEFINED] SWAP [IF]
175 \ https://forth-standard.org/standard/core/SWAP
176 \ SWAP     x1 x2 -- x2 x1    swap top two items
177     CODE SWAP
178     PUSH TOS            \ 3
179     MOV @PSP,TOS        \ 2
180     MOV @RSP+,0(PSP)    \ 4
181     MOV @IP+,PC         \ 4
182     ENDCODE
183     [THEN]
184
185     [UNDEFINED] DROP [IF]
186 \ https://forth-standard.org/standard/core/DROP
187 \ DROP     x --          drop top of stack
188     CODE DROP
189     MOV @PSP+,TOS   \ 2
190     MOV @IP+,PC     \ 4
191     ENDCODE
192     [THEN]
193
194     [UNDEFINED] OVER [IF]
195 \ https://forth-standard.org/standard/core/OVER
196 \ OVER    x1 x2 -- x1 x2 x1
197     CODE OVER
198     MOV TOS,-2(PSP)     \ 3 -- x1 (x2) x2
199     MOV @PSP,TOS        \ 2 -- x1 (x2) x1
200     SUB #2,PSP          \ 1 -- x1 x2 x1
201     MOV @IP+,PC
202     ENDCODE
203     [THEN]
204
205     [UNDEFINED] NIP [IF]
206 \ https://forth-standard.org/standard/core/NIP
207 \ NIP      x1 x2 -- x2         Drop the first item below the top of stack
208     CODE NIP
209     ADD #2,PSP
210     MOV @IP+,PC
211     ENDCODE
212     [THEN]
213
214     [UNDEFINED] >R [IF]
215 \ https://forth-standard.org/standard/core/toR
216 \ >R    x --   R: -- x   push to return stack
217     CODE >R
218     PUSH TOS
219     MOV @PSP+,TOS
220     MOV @IP+,PC
221     ENDCODE
222     [THEN]
223
224     [UNDEFINED] R> [IF]
225 \ https://forth-standard.org/standard/core/Rfrom
226 \ R>    -- x    R: x --   pop from return stack
227     CODE R>
228     SUB #2,PSP      \ 1
229     MOV TOS,0(PSP)  \ 3
230     MOV @RSP+,TOS   \ 2
231     MOV @IP+,PC     \ 4
232     ENDCODE
233     [THEN]
234
235     [UNDEFINED] C@ [IF]
236 \ https://forth-standard.org/standard/core/Fetch
237 \ C@     c-addr -- char   fetch char from memory
238     CODE C@
239     MOV.B @TOS,TOS
240     MOV @IP+,PC
241     ENDCODE
242     [THEN]
243
244     [UNDEFINED] C! [IF]
245 \ https://forth-standard.org/standard/core/CStore
246 \ C!      char c-addr --    store char in memory
247     CODE C!
248     MOV.B @PSP+,0(TOS)  \ 4
249     ADD #1,PSP          \ 1
250     MOV @PSP+,TOS       \ 2
251     MOV @IP+,PC
252     ENDCODE
253     [THEN]
254
255     [UNDEFINED] C, [IF]
256 \ https://forth-standard.org/standard/core/CComma
257 \ C,   char --        append char
258     CODE C,
259     MOV &DP,W
260     MOV.B TOS,0(W)
261     ADD #1,&DP
262     MOV @PSP+,TOS
263     MOV @IP+,PC
264     ENDCODE
265     [THEN]
266
267     [UNDEFINED] 0= [IF]
268 \ https://forth-standard.org/standard/core/ZeroEqual
269 \ 0=     n/u -- flag    return true if TOS=0
270     CODE 0=
271     SUB #1,TOS      \ 1 borrow (clear cy) if TOS was 0
272     SUBC TOS,TOS    \ 1 TOS=-1 if borrow was set
273     MOV @IP+,PC
274     ENDCODE
275     [THEN]
276
277     [UNDEFINED] 0<> [IF]
278 \ https://forth-standard.org/standard/core/Zerone
279 \ 0<>     n/u -- flag    return true if TOS<>0
280     CODE 0<>
281     SUB #1,TOS      \ 1 borrow (clear cy) if TOS was 0
282     SUBC TOS,TOS    \ 1 TOS=-1 if borrow was set
283     XOR #-1,TOS     \ 1
284     MOV @IP+,PC
285     ENDCODE
286     [THEN]
287
288     [UNDEFINED] 0< [IF]
289 \ https://forth-standard.org/standard/core/Zeroless
290 \ 0<     n -- flag      true if TOS negative
291     CODE 0<
292     ADD TOS,TOS     \ 1 set carry if TOS negative
293     SUBC TOS,TOS    \ 1 TOS=-1 if carry was clear
294     XOR #-1,TOS     \ 1 TOS=-1 if carry was set
295     MOV @IP+,PC     \
296     ENDCODE
297     [THEN]
298
299     [UNDEFINED] S>D [IF]
300 \ https://forth-standard.org/standard/core/StoD
301 \ S>D    n -- d          single -> double prec.
302     : S>D
303     DUP 0<
304     ;
305     [THEN]
306
307     [UNDEFINED] = [IF]
308 \ https://forth-standard.org/standard/core/Equal
309 \ =      x1 x2 -- flag         test x1=x2
310     CODE =
311     SUB @PSP+,TOS   \ 2
312     SUB #1,TOS      \ 1 borrow (clear cy) if TOS was 0
313     SUBC TOS,TOS    \ 1 TOS=-1 if borrow was set
314     MOV @IP+,PC
315     ENDCODE
316     [THEN]
317
318     [UNDEFINED] U< [IF] \ define U< and U>
319
320 \ https://forth-standard.org/standard/core/Umore
321 \ U>     n1 n2 -- flag
322     CODE U>
323     SUB @PSP+,TOS   \ 2
324     U< ?GOTO FW1    \ 2 flag = true, Z = 0
325 BW1 AND #0,TOS      \ 1 Z = 1
326     MOV @IP+,PC     \ 4
327     ENDCODE
328
329 \ https://forth-standard.org/standard/core/Uless
330 \ U<    u1 u2 -- flag       test u1<u2, unsigned
331     CODE U<
332     SUB @PSP+,TOS   \ 2 u2-u1
333     0= ?GOTO BW1
334     U< ?GOTO BW1
335 FW1 MOV #-1,TOS     \ 1
336     MOV @IP+,PC     \ 4
337     ENDCODE
338     [THEN]
339
340     [UNDEFINED] < [IF]  \ define < and >
341
342 \ https://forth-standard.org/standard/core/more
343 \ >     n1 n2 -- flag         test n1>n2, signed
344     CODE >
345     SUB @PSP+,TOS   \ 2 TOS=n2-n1
346     S< ?GOTO FW1    \ 2 --> +5
347 BW1 AND #0,TOS      \ 1 flag Z = 1
348     MOV @IP+,PC
349     ENDCODE
350
351 \ https://forth-standard.org/standard/core/less
352 \ <      n1 n2 -- flag        test n1<n2, signed
353     CODE <
354     SUB @PSP+,TOS   \ 1 TOS=n2-n1
355     0= ?GOTO BW1
356     S< ?GOTO BW1    \ 2 signed
357 FW1 MOV #-1,TOS \ 1 flag Z = 0
358     MOV @IP+,PC
359     ENDCODE
360     [THEN]
361
362 \ ------------------------------------------------------------------------------
363 \ CONTROL STRUCTURES
364 \ ------------------------------------------------------------------------------
365 \ THEN and BEGIN compile nothing
366 \ DO compile one word
367 \ IF, ELSE, AGAIN, UNTIL, WHILE, REPEAT, LOOP & +LOOP compile two words
368 \ LEAVE compile three words
369 \
370     [UNDEFINED] IF [IF]     \ define IF THEN
371
372 \ https://forth-standard.org/standard/core/IF
373 \ IF       -- IFadr    initialize conditional forward branch
374     CODE IF
375     SUB #2,PSP              \
376     MOV TOS,0(PSP)          \
377     MOV &DP,TOS             \ -- HERE
378     ADD #4,&DP            \           compile one word, reserve one word
379     MOV #QFBRAN,0(TOS)      \ -- HERE   compile QFBRAN
380     ADD #2,TOS              \ -- HERE+2=IFadr
381     MOV @IP+,PC
382     ENDCODE IMMEDIATE
383
384 \ https://forth-standard.org/standard/core/THEN
385 \ THEN     IFadr --                resolve forward branch
386     CODE THEN
387     MOV &DP,0(TOS)          \ -- IFadr
388     MOV @PSP+,TOS           \ --
389     MOV @IP+,PC
390     ENDCODE IMMEDIATE
391     [THEN]
392
393     [UNDEFINED] ELSE [IF]
394 \ https://forth-standard.org/standard/core/ELSE
395 \ ELSE     IFadr -- ELSEadr        resolve forward IF branch, leave ELSEadr on stack
396     CODE ELSE
397     ADD #4,&DP              \ make room to compile two words
398     MOV &DP,W               \ W=HERE+4
399     MOV #BRAN,-4(W)
400     MOV W,0(TOS)            \ HERE+4 ==> [IFadr]
401     SUB #2,W                \ HERE+2
402     MOV W,TOS               \ -- ELSEadr
403     MOV @IP+,PC
404     ENDCODE IMMEDIATE
405     [THEN]
406
407     [UNDEFINED] BEGIN [IF]  \ define BEGIN UNTIL AGAIN WHILE REPEAT
408
409 \ https://forth-standard.org/standard/core/BEGIN
410 \ BEGIN    -- BEGINadr             initialize backward branch
411     CODE BEGIN
412     MOV #BEGIN,PC       \ execute ASM BEGIN !
413     ENDCODE IMMEDIATE
414
415 \ https://forth-standard.org/standard/core/UNTIL
416 \ UNTIL    BEGINadr --             resolve conditional backward branch
417     CODE UNTIL
418     MOV #QFBRAN,X
419 BW1 ADD #4,&DP          \ compile two words
420     MOV &DP,W           \ W = HERE
421     MOV X,-4(W)         \ compile Bran or QFBRAN at HERE
422     MOV TOS,-2(W)       \ compile bakcward adr at HERE+2
423     MOV @PSP+,TOS
424     MOV @IP+,PC
425     ENDCODE IMMEDIATE
426
427 \ https://forth-standard.org/standard/core/AGAIN
428 \ AGAIN    BEGINadr --             resolve uncondionnal backward branch
429     CODE AGAIN
430     MOV #BRAN,X
431     GOTO BW1
432     ENDCODE IMMEDIATE
433
434 \ https://forth-standard.org/standard/core/WHILE
435 \ WHILE    BEGINadr -- WHILEadr BEGINadr
436     : WHILE
437     POSTPONE IF SWAP
438     ; IMMEDIATE
439
440 \ https://forth-standard.org/standard/core/REPEAT
441 \ REPEAT   WHILEadr BEGINadr --     resolve WHILE loop
442     : REPEAT
443     POSTPONE AGAIN POSTPONE THEN
444     ; IMMEDIATE
445     [THEN]
446
447     [UNDEFINED] DO [IF] \ define DO LOOP +LOOP
448
449     HDNCODE XDO         \ DO run time
450     MOV #$8000,X        \ 2 compute 8000h-limit = "fudge factor"
451     SUB @PSP+,X         \ 2
452     MOV TOS,Y           \ 1 loop ctr = index+fudge
453     ADD X,Y             \ 1 Y = INDEX
454     PUSHM #2,X          \ 4 PUSHM X,Y, i.e. PUSHM LIMIT, INDEX
455     MOV @PSP+,TOS       \ 2
456     MOV @IP+,PC         \ 4
457     ENDCODE
458
459 \ https://forth-standard.org/standard/core/DO
460 \ DO       -- DOadr   L: -- 0
461     CODE DO
462     SUB #2,PSP          \
463     MOV TOS,0(PSP)      \
464     ADD #2,&DP          \   make room to compile xdo
465     MOV &DP,TOS         \ -- HERE+2
466     MOV #XDO,-2(TOS)    \   compile xdo
467     ADD #2,&LEAVEPTR    \ -- HERE+2     LEAVEPTR+2
468     MOV &LEAVEPTR,W     \
469     MOV #0,0(W)         \ -- HERE+2     L-- 0, init
470     MOV @IP+,PC
471     ENDCODE IMMEDIATE
472
473     HDNCODE XLOOP       \   LOOP run time
474     ADD #1,0(RSP)       \ 4 increment INDEX
475 BW1 BIT #$100,SR        \ 2 is overflow bit set?
476     0= IF               \   branch if no overflow
477         MOV @IP,IP
478         MOV @IP+,PC
479     THEN
480     ADD #4,RSP          \ 1 empties RSP
481     ADD #2,IP           \ 1 overflow = loop done, skip branch ofs
482     MOV @IP+,PC         \ 4 14~ taken or not taken xloop/loop
483     ENDCODE             \
484
485 \ https://forth-standard.org/standard/core/LOOP
486 \ LOOP    DOadr --         L-- an an-1 .. a1 0
487     CODE LOOP
488     MOV #XLOOP,X
489 BW2 ADD #4,&DP          \ make room to compile two words
490     MOV &DP,W
491     MOV X,-4(W)         \ xloop --> HERE
492     MOV TOS,-2(W)       \ DOadr --> HERE+2
493     BEGIN                   \ resolve all "leave" adr
494         MOV &LEAVEPTR,TOS   \ -- Adr of top LeaveStack cell
495         SUB #2,&LEAVEPTR    \ --
496         MOV @TOS,TOS        \ -- first LeaveStack value
497         CMP #0,TOS          \ -- = value left by DO ?
498     0<> WHILE
499         MOV W,0(TOS)        \ move adr after loop as UNLOOP adr
500     REPEAT
501     MOV @PSP+,TOS
502     MOV @IP+,PC
503     ENDCODE IMMEDIATE
504
505 \ https://forth-standard.org/standard/core/PlusLOOP
506 \ +LOOP   adrs --   L-- an an-1 .. a1 0
507     HDNCODE XPLOO   \   +LOOP run time
508     ADD TOS,0(RSP)  \ 4 increment INDEX by TOS value
509     MOV @PSP+,TOS   \ 2 get new TOS, doesn't change flags
510     GOTO BW1        \ 2
511     ENDCODE         \
512
513     CODE +LOOP
514     MOV #XPLOO,X
515     GOTO BW2
516     ENDCODE IMMEDIATE
517     [THEN]
518
519     [UNDEFINED] I [IF]
520 \ https://forth-standard.org/standard/core/I
521 \ I        -- n   R: sys1 sys2 -- sys1 sys2
522 \                  get the innermost loop index
523     CODE I
524     SUB #2,PSP              \ 1 make room in TOS
525     MOV TOS,0(PSP)          \ 3
526     MOV @RSP,TOS            \ 2 index = loopctr - fudge
527     SUB 2(RSP),TOS          \ 3
528     MOV @IP+,PC             \ 4 13~
529     ENDCODE
530     [THEN]
531
532     [UNDEFINED] J [IF]
533 \ https://forth-standard.org/standard/core/J
534 \ J        -- n   R: 4*sys -- 4*sys
535 \ C                  get the second loop index
536     CODE J
537     SUB #2,PSP
538     MOV TOS,0(PSP)
539     MOV 4(RSP),TOS
540     SUB 6(RSP),TOS
541     MOV @IP+,PC
542     ENDCODE
543     [THEN]
544
545     [UNDEFINED] UNLOOP [IF]
546 \ https://forth-standard.org/standard/core/UNLOOP
547 \ UNLOOP   --   R: sys1 sys2 --  drop loop parms
548     CODE UNLOOP
549     ADD #4,RSP
550     MOV @IP+,PC
551     ENDCODE
552     [THEN]
553
554     [UNDEFINED] LEAVE [IF]
555 \ https://forth-standard.org/standard/core/LEAVE
556 \ LEAVE    --    L: -- adrs
557     CODE LEAVE
558     MOV &DP,W               \ compile three words
559     MOV #UNLOOP,0(W)        \ [HERE] = UNLOOP
560     MOV #BRAN,2(W)          \ [HERE+2] = BRAN
561     ADD #6,&DP              \ [HERE+4] = at adr After LOOP
562     ADD #2,&LEAVEPTR
563     ADD #4,W
564     MOV &LEAVEPTR,X
565     MOV W,0(X)              \ leave HERE+4 on LEAVEPTR stack
566     MOV @IP+,PC
567     ENDCODE IMMEDIATE
568     [THEN]
569
570     [UNDEFINED] AND [IF]
571 \ https://forth-standard.org/standard/core/AND
572 \ C AND    x1 x2 -- x3           logical AND
573     CODE AND
574     AND @PSP+,TOS
575     MOV @IP+,PC
576     ENDCODE
577     [THEN]
578
579     [UNDEFINED] OR [IF]
580 \ https://forth-standard.org/standard/core/OR
581 \ C OR     x1 x2 -- x3           logical OR (BIS, BIts Set)
582     CODE OR
583     BIS @PSP+,TOS
584     AND #-1,TOS \ to set flags
585     MOV @IP+,PC
586     ENDCODE
587     [THEN]
588
589     [UNDEFINED] XOR
590     [IF]
591 \ https://forth-standard.org/standard/core/XOR
592 \ C XOR    x1 x2 -- x3           logical XOR
593     CODE XOR
594     XOR @PSP+,TOS
595     MOV @IP+,PC
596     ENDCODE
597     [THEN]
598
599     [UNDEFINED] 1+ [IF]
600 \ https://forth-standard.org/standard/core/OnePlus
601 \ 1+      n1/u1 -- n2/u2       add 1 to TOS
602     CODE 1+
603     ADD #1,TOS
604     MOV @IP+,PC
605     ENDCODE
606     [THEN]
607
608     [UNDEFINED] 1- [IF]
609 \ https://forth-standard.org/standard/core/OneMinus
610 \ 1-      n1/u1 -- n2/u2     subtract 1 from TOS
611     CODE 1-
612     SUB #1,TOS
613     MOV @IP+,PC
614     ENDCODE
615     [THEN]
616
617     [UNDEFINED] INVERT [IF]
618 \ https://forth-standard.org/standard/core/INVERT
619 \ INVERT   x1 -- x2            bitwise inversion
620     CODE INVERT
621     XOR #-1,TOS
622     MOV @IP+,PC
623     ENDCODE
624     [THEN]
625
626     [UNDEFINED] NEGATE [IF]
627 \ https://forth-standard.org/standard/core/NEGATE
628 \ C NEGATE   x1 -- x2            two's complement
629     CODE NEGATE
630     XOR #-1,TOS
631     ADD #1,TOS
632     MOV @IP+,PC
633     ENDCODE
634     [THEN]
635
636     [UNDEFINED] ABS [IF]
637 \ https://forth-standard.org/standard/core/ABS
638 \ C ABS     n1 -- +n2     absolute value
639     CODE ABS
640     CMP #0,TOS       \  1
641     0>= IF
642         MOV @IP+,PC
643     THEN
644     MOV #NEGATE,PC
645     ENDCODE
646     [THEN]
647
648     [UNDEFINED] LSHIFT [IF]
649 \ https://forth-standard.org/standard/core/LSHIFT
650 \ LSHIFT  x1 u -- x2    logical L shift u places
651     CODE LSHIFT
652     MOV @PSP+,W
653     AND #$1F,TOS        \ no need to shift more than 16
654     0<> IF
655         BEGIN
656             ADD W,W
657             SUB #1,TOS
658         0= UNTIL
659     THEN
660     MOV W,TOS
661     MOV @IP+,PC
662     ENDCODE
663     [THEN]
664
665     [UNDEFINED] RSHIFT [IF]
666 \ https://forth-standard.org/standard/core/RSHIFT
667 \ RSHIFT  x1 u -- x2    logical R7 shift u places
668     CODE RSHIFT
669     MOV @PSP+,W
670     AND #$1F,TOS       \ no need to shift more than 16
671     0<> IF
672         BEGIN
673             BIC #C,SR           \ Clr Carry
674             RRC W
675             SUB #1,TOS
676         0= UNTIL
677     THEN
678     MOV W,TOS
679     MOV @IP+,PC
680     ENDCODE
681     [THEN]
682
683     [UNDEFINED] MAX [IF]    \ define MIN MAX
684 \ https://forth-standard.org/standard/core/MAX
685 \ MAX    n1 n2 -- n3       signed maximum
686     CODE MAX
687     CMP @PSP,TOS    \ n2-n1
688     S<  ?GOTO FW1   \ n2<n1
689 BW1 ADD #2,PSP
690     MOV @IP+,PC
691     ENDCODE
692
693 \ https://forth-standard.org/standard/core/MIN
694 \ MIN    n1 n2 -- n3       signed minimum
695     CODE MIN
696     CMP @PSP,TOS    \ n2-n1
697     S< ?GOTO BW1    \ n2<n1
698 FW1 MOV @PSP+,TOS
699     MOV @IP+,PC
700     ENDCODE
701     [THEN]
702
703     [UNDEFINED] 2* [IF]
704 \ https://forth-standard.org/standard/core/TwoTimes
705 \ 2*      x1 -- x2         arithmetic left shift
706     CODE 2*
707     ADD TOS,TOS
708     MOV @IP+,PC
709     ENDCODE
710     [THEN]
711
712     [UNDEFINED] 2/ [IF]
713 \ https://forth-standard.org/standard/core/TwoDiv
714 \ 2/      x1 -- x2        arithmetic right shift
715     CODE 2/
716     RRA TOS
717     MOV @IP+,PC
718     ENDCODE
719     [THEN]
720
721 \ --------------------
722 \ ARITHMETIC OPERATORS
723 \ --------------------
724     RST_SET
725
726     CODE TSTBIT         \ addr bit_mask -- true/flase flag
727     MOV @PSP+,X
728     AND @X,TOS
729     MOV @IP+,PC
730     ENDCODE
731
732 \    $81EF DEVICEID @ U<
733 \    DEVICEID @ $81F3 U<
734 \    = [IF]   ; MSP430FR413x subfamily without hardware_MPY
735     KERNEL_ADDON HMPY TSTBIT \   KERNEL_ADDON(BIT0) = hardware MPY flag
736
737     RST_RET
738
739     [IF]    ; MSP430FRxxxx subfamily with hardware_MPY
740
741         [UNDEFINED] UM* [IF]
742 \ https://forth-standard.org/standard/core/MTimes
743 \ M*     n1 n2 -- dlo dhi  signed 16*16->32 multiply
744         CODE UM*
745         MOV @PSP,&MPY       \ Load 1st operand for unsigned multiplication
746 BW1     MOV TOS,&OP2        \ Load 2nd operand
747         MOV &RES0,0(PSP)    \ low result on stack
748         MOV &RES1,TOS       \ high result in TOS
749         MOV @IP+,PC
750         ENDCODE
751
752 \ https://forth-standard.org/standard/core/MTimes
753 \ M*     n1 n2 -- dlo dhi  signed 16*16->32 multiply
754         CODE M*
755         MOV @PSP,&MPYS      \ Load 1st operand for signed multiplication
756         GOTO BW1
757         ENDCODE
758         [THEN]
759
760     [ELSE]  ; MSP430FR413x without hardware_MPY
761
762         [UNDEFINED] UM* [IF]
763 \ T.I. UNSIGNED MULTIPLY SUBROUTINE: U1 x U2 -> Ud
764 \ https://forth-standard.org/standard/core/UMTimes
765 \ UM*     u1 u2 -- ud   unsigned 16x16->32 mult.
766         CODE UM*
767         MOV @PSP,S              \2 ud1lo
768         MOV #0,T                \1 ud1hi=0
769         MOV #0,X                \1 RESlo=0
770         MOV #0,Y                \1 REShi=0
771         MOV #1,W                \1 BIT TEST REGISTER
772         BEGIN
773             BIT W,TOS           \1 TEST ACTUAL BIT ud2lo
774             0<> IF 
775                 ADD S,X         \1 ADD ud1lo TO RESlo
776                 ADDC T,Y        \1 ADDC ud1hi TO REShi
777             THEN
778             ADD S,S             \1 (RLA LSBs) ud1lo x 2
779             ADDC T,T            \1 (RLC MSBs) ud1hi x 2
780             ADD W,W             \1 (RLA) NEXT BIT TO TEST
781         U>= UNTIL               \2 IF BIT IN CARRY: FINISHED    10~ loop
782         MOV X,0(PSP)            \3 low result on stack
783         MOV Y,TOS               \1 high result in TOS
784         MOV @IP+,PC             \4 17 words
785         ENDCODE
786         [THEN]
787
788         [UNDEFINED] M* [IF]
789 \ https://forth-standard.org/standard/core/UMTimes
790 \ UM*     u1 u2 -- udlo udhi   unsigned 16x16->32 mult.
791         CODE M*
792         MOV @PSP,S          \ S= n1
793         CMP #0,S            \ n1 > -1 ?
794         S< IF
795             XOR #-1,0(PSP)  \ n1 --> u1
796             ADD #1,0(PSP)   \
797         THEN
798         XOR TOS,S           \ S contains sign of result
799         CMP #0,TOS          \ n2 > -1 ?
800         S< IF
801             XOR #-1,TOS     \ n2 --> u2
802             ADD #1,TOS      \
803         THEN
804         PUSHM #2,IP         \ UMSTAR use S,T,W,X,Y
805         LO2HI               \ -- ud1 u2
806         UM*
807         HI2LO
808         POPM #2,IP           \ pop S,IP
809         CMP #0,S            \ sign of result > -1 ?
810         S< IF
811             XOR #-1,0(PSP)  \ ud --> d
812             XOR #-1,TOS
813             ADD #1,0(PSP)
814             ADDC #0,TOS
815         THEN
816         MOV @IP+,PC
817         ENDCODE
818         [THEN]
819     [THEN]  ;  endof hardware_MPY
820
821     [UNDEFINED] UM/MOD
822     [IF]
823 \ https://forth-standard.org/standard/core/UMDivMOD
824 \ UM/MOD   udlo|udhi u1 -- r q   unsigned 32/16->r16 q16
825     CODE UM/MOD
826     PUSH #DROP      \
827     MOV #MUSMOD,PC  \ execute MUSMOD then return to DROP
828     ENDCODE
829     [THEN]
830
831     KERNEL_ADDON @ 0<  ; test the switch: FLOORED/SYMETRIC DIVISION
832     [IF]
833         [UNDEFINED] FM/MOD [IF]
834 \ https://forth-standard.org/standard/core/FMDivMOD
835 \ FM/MOD   d1 n1 -- r q   floored signed div'n
836         CODE FM/MOD
837         MOV TOS,S           \           S=DIV
838         MOV @PSP,T          \           T=DVDhi
839         CMP #0,TOS          \           n2 >= 0 ?
840         S< IF               \
841             XOR #-1,TOS
842             ADD #1,TOS      \ -- d1 u2
843         THEN
844         CMP #0,0(PSP)       \           d1hi >= 0 ?
845         S< IF               \
846             XOR #-1,2(PSP)  \           d1lo
847             XOR #-1,0(PSP)  \           d1hi
848             ADD #1,2(PSP)   \           d1lo+1
849             ADDC #0,0(PSP)  \           d1hi+C
850         THEN                \ -- uDVDlo uDVDhi uDIVlo
851         PUSHM  #2,S         \ 4         PUSHM S,T
852         CALL #MUSMOD
853         MOV @PSP+,TOS
854         POPM  #2,S          \ 4         POPM T,S
855         CMP #0,T            \           T=DVDhi --> REM_sign
856         S< IF
857             XOR #-1,0(PSP)
858             ADD #1,0(PSP)
859         THEN
860         XOR S,T             \           S=DIV XOR T=DVDhi = Quot_sign
861         CMP #0,T            \ -- n3 u4  T=quot_sign
862         S< IF
863             XOR #-1,TOS
864             ADD #1,TOS
865         THEN                \ -- n3 n4  S=divisor
866
867         CMP #0,0(PSP)       \ remainder <> 0 ?
868         0<> IF
869             CMP #1,TOS      \ quotient < 1 ?
870             S< IF
871             ADD S,0(PSP)  \ add divisor to remainder
872             SUB #1,TOS    \ decrement quotient
873             THEN
874         THEN
875         MOV @IP+,PC
876         ENDCODE
877         [THEN]
878     [ELSE]
879         [UNDEFINED] SM/REM [IF]
880 \ https://forth-standard.org/standard/core/SMDivREM
881 \ SM/REM   DVDlo DVDhi DIV -- r3 q4  symmetric signed div
882         CODE SM/REM
883         MOV TOS,S           \           S=DIV
884         MOV @PSP,T          \           T=DVDhi
885         CMP #0,TOS          \           n2 >= 0 ?
886         S< IF               \
887             XOR #-1,TOS
888             ADD #1,TOS      \ -- d1 u2
889         THEN
890         CMP #0,0(PSP)       \           d1hi >= 0 ?
891         S< IF               \
892             XOR #-1,2(PSP)  \           d1lo
893             XOR #-1,0(PSP)  \           d1hi
894             ADD #1,2(PSP)   \           d1lo+1
895             ADDC #0,0(PSP)  \           d1hi+C
896         THEN                \ -- uDVDlo uDVDhi uDIVlo
897         PUSHM  #2,S         \ 4         PUSHM S,T
898         CALL #MUSMOD
899         MOV @PSP+,TOS
900         POPM  #2,S          \ 4         POPM T,S
901         CMP #0,T            \           T=DVDhi --> REM_sign
902         S< IF
903             XOR #-1,0(PSP)
904             ADD #1,0(PSP)
905         THEN
906         XOR S,T             \           S=DIV XOR T=DVDhi = Quot_sign
907         CMP #0,T            \ -- n3 u4  T=quot_sign
908         S< IF
909             XOR #-1,TOS
910             ADD #1,TOS
911         THEN                \ -- n3 n4  S=divisor
912         MOV @IP+,PC
913         ENDCODE
914         [THEN]
915     [THEN]
916
917     [UNDEFINED] * [IF]
918 \ https://forth-standard.org/standard/core/Times
919 \ *      n1 n2 -- n3       signed multiply
920     : *
921     M* DROP
922     ;
923     [THEN]
924
925     [UNDEFINED] /MOD [IF]
926 \ https://forth-standard.org/standard/core/DivMOD
927 \ /MOD   n1 n2 -- r3 q4     signed division
928     : /MOD
929     >R DUP 0< R>
930     [ KERNEL_ADDON @ 0< ]   \ test the switch: FLOORED / SYMETRIC DIVISION
931     [IF]    FM/MOD
932     [ELSE]  SM/REM
933     [THEN]
934     ;
935     [THEN]
936
937     [UNDEFINED] / [IF]
938 \ https://forth-standard.org/standard/core/Div
939 \ /      n1 n2 -- n3       signed quotient
940     : /
941     >R DUP 0< R>
942     [ KERNEL_ADDON @ 0< ]   \ test the switch: FLOORED / SYMETRIC DIVISION
943     [IF]    FM/MOD
944     [ELSE]  SM/REM
945     [THEN]
946     NIP
947     ;
948     [THEN]
949
950     [UNDEFINED] MOD [IF]
951 \ https://forth-standard.org/standard/core/MOD
952 \ MOD    n1 n2 -- n3       signed remainder
953     : MOD
954     >R DUP 0< R>
955     [ KERNEL_ADDON @ 0< ]   \ test the switch: FLOORED / SYMETRIC DIVISION
956     [IF]    FM/MOD
957     [ELSE]  SM/REM
958     [THEN]
959     DROP
960     ;
961     [THEN]
962
963     [UNDEFINED] */MOD [IF]
964 \ https://forth-standard.org/standard/core/TimesDivMOD
965 \ */MOD  n1 n2 n3 -- r4 q5    signed mult/div
966     : */MOD
967     >R M* R>
968     [ KERNEL_ADDON @ 0< ]   \ test the switch: FLOORED / SYMETRIC DIVISION
969     [IF]    FM/MOD
970     [ELSE]  SM/REM
971     [THEN]
972     ;
973     [THEN]
974
975     [UNDEFINED] */ [IF]
976 \ https://forth-standard.org/standard/core/TimesDiv
977 \ */     n1 n2 n3 -- n4        n1*n2/q3
978     : */
979     >R M* R>
980     [ KERNEL_ADDON @ 0< ]   \ test the switch: FLOORED / SYMETRIC DIVISION
981     [IF]    FM/MOD
982     [ELSE]  SM/REM
983     [THEN]
984     NIP
985     ;
986     [THEN]
987
988 \ -------------------------------------------------------------------------------
989 \  STACK OPERATIONS
990 \ -------------------------------------------------------------------------------
991     [UNDEFINED] ROT [IF]
992 \ https://forth-standard.org/standard/core/ROT
993 \ ROT    x1 x2 x3 -- x2 x3 x1
994     CODE ROT
995     MOV @PSP,W          \ 2 fetch x2
996     MOV TOS,0(PSP)      \ 3 store x3
997     MOV 2(PSP),TOS      \ 3 fetch x1
998     MOV W,2(PSP)        \ 3 store x2
999     MOV @IP+,PC
1000     ENDCODE
1001     [THEN]
1002
1003     [UNDEFINED] R@ [IF]
1004 \ https://forth-standard.org/standard/core/RFetch
1005 \ R@    -- x     R: x -- x   fetch from return stack
1006     CODE R@
1007     SUB #2,PSP
1008     MOV TOS,0(PSP)
1009     MOV @RSP,TOS
1010     MOV @IP+,PC
1011     ENDCODE
1012     [THEN]
1013
1014     [UNDEFINED] TUCK [IF]
1015 \ https://forth-standard.org/standard/core/TUCK
1016 \ TUCK  ( x1 x2 -- x2 x1 x2 )
1017     : TUCK SWAP OVER ;
1018     [THEN]
1019
1020 \ ----------------------------------------------------------------------
1021 \ DOUBLE OPERATORS
1022 \ ----------------------------------------------------------------------
1023     [UNDEFINED] 2@ [IF]
1024 \ https://forth-standard.org/standard/core/TwoFetch
1025 \ 2@    a-addr -- x1 x2    fetch 2 cells ; the lower address will appear on top of stack
1026     CODE 2@
1027     SUB #2,PSP
1028     MOV 2(TOS),0(PSP)
1029     MOV @TOS,TOS
1030     MOV @IP+,PC
1031     ENDCODE
1032     [THEN]
1033
1034     [UNDEFINED] 2! [IF]
1035 \ https://forth-standard.org/standard/core/TwoStore
1036 \ 2!    x1 x2 a-addr --    store 2 cells ; the top of stack is stored at the lower adr
1037     CODE 2!
1038     MOV @PSP+,0(TOS)
1039     MOV @PSP+,2(TOS)
1040     MOV @PSP+,TOS
1041     MOV @IP+,PC
1042     ENDCODE
1043     [THEN]
1044
1045     [UNDEFINED] 2DUP [IF]
1046 \ https://forth-standard.org/standard/core/TwoDUP
1047 \ 2DUP   x1 x2 -- x1 x2 x1 x2   dup top 2 cells
1048     CODE 2DUP
1049     MOV @PSP,-4(PSP)    \ 4
1050     MOV TOS,-2(PSP)     \ 3
1051     SUB #4,PSP          \ 1
1052     MOV @IP+,PC         \ 4
1053     ENDCODE
1054     [THEN]
1055
1056     [UNDEFINED] 2DROP [IF]
1057 \ https://forth-standard.org/standard/core/TwoDROP
1058 \ 2DROP  x1 x2 --          drop 2 cells
1059     CODE 2DROP
1060     ADD #2,PSP
1061     MOV @PSP+,TOS
1062     MOV @IP+,PC
1063     ENDCODE
1064     [THEN]
1065
1066     [UNDEFINED] 2SWAP [IF]
1067 \ https://forth-standard.org/standard/core/TwoSWAP
1068 \ 2SWAP  x1 x2 x3 x4 -- x3 x4 x1 x2
1069     CODE 2SWAP
1070     MOV @PSP,W          \ -- x1 x2 x3 x4    W=x3
1071     MOV 4(PSP),0(PSP)   \ -- x1 x2 x1 x4
1072     MOV W,4(PSP)        \ -- x3 x2 x1 x4
1073     MOV TOS,W           \ -- x3 x2 x1 x4    W=x4
1074     MOV 2(PSP),TOS      \ -- x3 x2 x1 x2    W=x4
1075     MOV W,2(PSP)        \ -- x3 x4 x1 x2
1076     MOV @IP+,PC
1077     ENDCODE
1078     [THEN]
1079
1080     [UNDEFINED] 2OVER [IF]
1081 \ https://forth-standard.org/standard/core/TwoOVER
1082 \ 2OVER  x1 x2 x3 x4 -- x1 x2 x3 x4 x1 x2
1083     CODE 2OVER
1084     SUB #4,PSP          \ -- x1 x2 x3 x x x4
1085     MOV TOS,2(PSP)      \ -- x1 x2 x3 x4 x x4
1086     MOV 8(PSP),0(PSP)   \ -- x1 x2 x3 x4 x1 x4
1087     MOV 6(PSP),TOS      \ -- x1 x2 x3 x4 x1 x2
1088     MOV @IP+,PC
1089     ENDCODE
1090     [THEN]
1091
1092 \ ----------------------------------------------------------------------
1093 \ ALIGNMENT OPERATORS
1094 \ ----------------------------------------------------------------------
1095     [UNDEFINED] ALIGNED [IF]
1096 \ https://forth-standard.org/standard/core/ALIGNED
1097 \ ALIGNED  addr -- a-addr       align given addr
1098     CODE ALIGNED
1099     BIT #1,TOS
1100     ADDC #0,TOS
1101     MOV @IP+,PC
1102     ENDCODE
1103     [THEN]
1104
1105     [UNDEFINED] ALIGN [IF]
1106 \ https://forth-standard.org/standard/core/ALIGN
1107 \ ALIGN    --                         align HERE
1108     CODE ALIGN
1109     BIT #1,&DP  \ 3
1110     ADDC #0,&DP \ 4
1111     MOV @IP+,PC
1112     ENDCODE
1113     [THEN]
1114
1115 \ ---------------------
1116 \ PORTABILITY OPERATORS
1117 \ ---------------------
1118     [UNDEFINED] CHARS [IF]
1119 \ https://forth-standard.org/standard/core/CHARS
1120 \ CHARS    n1 -- n2            chars->adrs units
1121     CODE CHARS
1122     MOV @IP+,PC
1123     ENDCODE
1124     [THEN]
1125
1126     [UNDEFINED] CHAR+ [IF]
1127 \ https://forth-standard.org/standard/core/CHARPlus
1128 \ CHAR+    c-addr1 -- c-addr2   add char size
1129     CODE CHAR+
1130     ADD #1,TOS
1131     MOV @IP+,PC
1132     ENDCODE
1133     [THEN]
1134
1135     [UNDEFINED] CELLS [IF]
1136 \ https://forth-standard.org/standard/core/CELLS
1137 \ CELLS    n1 -- n2            cells->adrs units
1138     CODE CELLS
1139     ADD TOS,TOS
1140     MOV @IP+,PC
1141     ENDCODE
1142     [THEN]
1143
1144     [UNDEFINED] CELL+ [IF]
1145 \ https://forth-standard.org/standard/core/CELLPlus
1146 \ CELL+    a-addr1 -- a-addr2      add cell size
1147     CODE CELL+
1148     ADD #2,TOS
1149     MOV @IP+,PC
1150     ENDCODE
1151     [THEN]
1152
1153 \ ---------------------------
1154 \ BLOCK AND STRING COMPLEMENT
1155 \ ---------------------------
1156
1157     [UNDEFINED] CHAR [IF]
1158 \ https://forth-standard.org/standard/core/CHAR
1159 \ CHAR   -- char           parse ASCII character
1160     : CHAR
1161     $20 WORD 1+ C@
1162     ;
1163     [THEN]
1164
1165     [UNDEFINED] [CHAR] [IF]
1166 \ https://forth-standard.org/standard/core/BracketCHAR
1167 \ [CHAR]   --          compile character literal
1168     : [CHAR]
1169     CHAR POSTPONE LITERAL
1170     ; IMMEDIATE
1171     [THEN]
1172
1173     [UNDEFINED] +! [IF]
1174 \ https://forth-standard.org/standard/core/PlusStore
1175 \ +!     n/u a-addr --       add n/u to memory
1176     CODE +!
1177     ADD @PSP+,0(TOS)
1178     MOV @PSP+,TOS
1179     MOV @IP+,PC
1180     ENDCODE
1181     [THEN]
1182
1183     [UNDEFINED] MOVE [IF]
1184 \ https://forth-standard.org/standard/core/MOVE
1185 \ MOVE    addr1 addr2 u --     smart move
1186 \             VERSION FOR 1 ADDRESS UNIT = 1 CHAR
1187     CODE MOVE
1188     MOV TOS,W           \ W = cnt
1189     MOV @PSP+,Y         \ Y = addr2 = dst
1190     MOV @PSP+,X         \ X = addr1 = src
1191     MOV @PSP+,TOS       \ pop new TOS
1192     CMP #0,W            \ count = 0 ?
1193     0<> IF              \ if 0, already done !
1194         CMP X,Y         \ dst = src ?
1195         0<> IF          \ if 0, already done !
1196             U< IF       \ U< if src > dst
1197                 BEGIN   \ copy W bytes
1198                     MOV.B @X+,0(Y)
1199                     ADD #1,Y
1200                     SUB #1,W
1201                 0= UNTIL
1202                 MOV @IP+,PC \ out 1 of MOVE ====>
1203             THEN        \ U>= if dst > src
1204             ADD W,Y     \ copy W bytes beginning with the end
1205             ADD W,X
1206             BEGIN
1207                 SUB #1,X
1208                 SUB #1,Y
1209                 MOV.B @X,0(Y)
1210                 SUB #1,W
1211             0= UNTIL
1212         THEN
1213     THEN
1214     MOV @IP+,PC \ out 2 of MOVE ====>
1215     ENDCODE
1216     [THEN]
1217
1218     [UNDEFINED] FILL [IF]
1219 \ https://forth-standard.org/standard/core/FILL
1220 \ FILL   c-addr u char --  fill memory with char
1221     CODE FILL
1222     MOV @PSP+,X     \ count
1223     MOV @PSP+,W     \ address
1224     CMP #0,X
1225     0<> IF
1226         BEGIN
1227             MOV.B TOS,0(W)    \ store char in memory
1228             ADD #1,W
1229             SUB #1,X
1230         0= UNTIL
1231     THEN
1232     MOV @PSP+,TOS     \ empties stack
1233     MOV @IP+,PC
1234     ENDCODE
1235     [THEN]
1236
1237 \ --------------------
1238 \ INTERPRET COMPLEMENT
1239 \ --------------------
1240     [UNDEFINED] HEX [IF]
1241 \ https://forth-standard.org/standard/core/HEX
1242     CODE HEX
1243     MOV #$10,&BASEADR
1244     MOV @IP+,PC
1245     ENDCODE
1246     [THEN]
1247
1248     [UNDEFINED] DECIMAL [IF]
1249     \ https://forth-standard.org/standard/core/DECIMAL
1250     CODE DECIMAL
1251     MOV #$0A,&BASEADR
1252     MOV @IP+,PC
1253     ENDCODE
1254     [THEN]
1255
1256     [UNDEFINED] ( [IF]
1257 \ https://forth-standard.org/standard/core/p
1258 \ (         --          skip input until char ) or EOL
1259     : (
1260     ')' WORD DROP
1261     ; IMMEDIATE
1262     [THEN]
1263
1264     [UNDEFINED] .( [IF] ; "
1265 \ https://forth-standard.org/standard/core/Dotp
1266 \ .(        --          type comment immediatly.
1267     CODE .(         ; "
1268     MOV #0,T            \ CAPS OFF
1269     COLON
1270     ')' 
1271     [ ' WORD 16 + , ]   \ for volatile CAPS OFF
1272     COUNT TYPE
1273     HI2LO
1274     MOV @RSP+,IP
1275     MOV @IP+,PC
1276     ENDCODE IMMEDIATE
1277     [THEN]
1278
1279     [UNDEFINED] >BODY [IF]
1280 \ https://forth-standard.org/standard/core/toBODY
1281 \ >BODY     -- addr      leave BODY of a CREATEd word\ also leave default ACTION-OF primary DEFERred word
1282     CODE >BODY
1283     ADD #4,TOS
1284     MOV @IP+,PC
1285     ENDCODE
1286     [THEN]
1287
1288     [UNDEFINED] EXECUTE [IF]
1289 \ https://forth-standard.org/standard/core/EXECUTE
1290 \ EXECUTE   i*x xt -- j*x   execute Forth word at 'xt'
1291     CODE EXECUTE
1292     MOV #EXECUTE,PC
1293     ENDCODE
1294     [THEN]
1295
1296     [UNDEFINED] EVALUATE [IF]
1297 \ EVALUATE upside down...
1298     CODENNM                 \ as the end of EVALUATE
1299     MOV @RSP+,&TOIN         \ 4
1300     MOV @RSP+,&SOURCE_ORG   \ 4
1301     MOV @RSP+,&SOURCE_LEN   \ 4
1302     MOV @RSP+,IP
1303     MOV @IP+,PC
1304     ENDCODE                 \   -- end_of_EVALUATE_addr
1305
1306 \ https://forth-standard.org/standard/core/EVALUATE
1307 \ EVALUATE          \ i*x c-addr u -- j*x  interpret string
1308     CODE EVALUATE
1309     MOV #SOURCE_LEN,X       \ 2
1310     MOV @X+,S               \ 2 S = SOURCE_LEN
1311     MOV @X+,T               \ 2 T = SOURCE_ORG
1312     MOV @X+,W               \ 2 W = TOIN
1313     PUSHM #4,IP             \ 6 PUSHM IP,S,T,W
1314     MOV PC,IP               \ 1
1315     ADD #8,IP               \ 1 IP = ENDCODE PC address 
1316     MOV #INTERPRET,PC       \ 3 addr defined in MSP430FRxxxx.pat
1317     NOP                     \ 0 stuffing instruction (never executed)
1318     ENDCODE                 \
1319     ,                       \ end_of_EVALUATE_addr   --         compile the end_of_EVALUATE_addr
1320
1321     [THEN]
1322
1323     [UNDEFINED] RECURSE [IF]
1324 \ https://forth-standard.org/standard/core/RECURSE
1325 \ C RECURSE  --      recurse to current definition
1326     CODE RECURSE
1327     MOV &DP,X
1328     MOV &LAST_CFA,0(X)
1329     ADD #2,&DP
1330     MOV @IP+,PC
1331     ENDCODE IMMEDIATE
1332     [THEN]
1333
1334     [UNDEFINED] SOURCE [IF]
1335 \ https://forth-standard.org/standard/core/SOURCE
1336 \ SOURCE    -- adr u    of current input buffer
1337     CODE SOURCE
1338     SUB #4,PSP
1339     MOV TOS,2(PSP)
1340     MOV &SOURCE_LEN,TOS
1341     MOV &SOURCE_ORG,0(PSP)
1342     MOV @IP+,PC
1343     ENDCODE
1344     [THEN]
1345
1346     [UNDEFINED] VARIABLE [IF]
1347 \ https://forth-standard.org/standard/core/VARIABLE
1348 \ VARIABLE <name>       --                      define a Forth VARIABLE
1349     : VARIABLE
1350     CREATE
1351     HI2LO
1352     MOV #DOVAR,-4(W)        \   CFA = CALL rDOVAR
1353     MOV @RSP+,IP
1354     MOV @IP+,PC
1355     ENDCODE
1356     [THEN]
1357
1358     [UNDEFINED] CONSTANT [IF]
1359 \ https://forth-standard.org/standard/core/CONSTANT
1360 \ CONSTANT <name>     n --                      define a Forth CONSTANT
1361     : CONSTANT
1362     CREATE
1363     HI2LO
1364     MOV TOS,-2(W)           \   PFA = n
1365     MOV @PSP+,TOS
1366     MOV @RSP+,IP
1367     MOV @IP+,PC
1368     ENDCODE
1369     [THEN]
1370
1371     [UNDEFINED] STATE [IF]
1372 \ https://forth-standard.org/standard/core/STATE
1373 \ STATE   -- a-addr       holds compiler state
1374     STATEADR CONSTANT STATE
1375     [THEN]
1376
1377     [UNDEFINED] BASE [IF]
1378 \ https://forth-standard.org/standard/core/BASE
1379 \ BASE    -- a-addr       holds conversion radix
1380     BASEADR  CONSTANT BASE
1381     [THEN]
1382
1383     [UNDEFINED] >IN [IF]
1384 \ https://forth-standard.org/standard/core/toIN
1385 \ C >IN     -- a-addr       holds offset in input stream
1386     TOIN CONSTANT >IN
1387     [THEN]
1388
1389     [UNDEFINED] PAD [IF]
1390 \ https://forth-standard.org/standard/core/PAD
1391 \  PAD           --  addr
1392     PAD_ORG CONSTANT PAD
1393     [THEN]
1394
1395     [UNDEFINED] BL [IF]
1396 \ https://forth-standard.org/standard/core/BL
1397 \ BL      -- char            an ASCII space
1398     'SP' CONSTANT BL
1399     [THEN]
1400
1401     [UNDEFINED] SPACE [IF]
1402 \ https://forth-standard.org/standard/core/SPACE
1403 \ SPACE   --               output a space
1404     : SPACE
1405     'SP' EMIT ;
1406     [THEN]
1407
1408     [UNDEFINED] SPACES [IF]
1409 \ https://forth-standard.org/standard/core/SPACES
1410 \ SPACES   n --            output n spaces
1411     : SPACES
1412     BEGIN
1413         ?DUP
1414     WHILE
1415         'SP' EMIT
1416         1-
1417     REPEAT
1418     ;
1419     [THEN]
1420
1421     [UNDEFINED] DEFER [IF]
1422 \ https://forth-standard.org/standard/core/DEFER
1423 \ Skip leading space delimiters. Parse name delimited by a space.
1424 \ Create a definition for name with the execution semantics defined below.
1425 \
1426 \ name Execution:   --
1427 \ Execute the xt that name is set to execute, i.e. NEXT (nothing),
1428 \ until the phrase ' word IS name is executed, causing a new value of xt to be assigned to name.
1429     : DEFER                 \ useless definition for FAST FORTH...
1430     CREATE
1431     HI2LO
1432     MOV #$4030,-4(W)        \4 first CELL = MOV @PC+,PC = BR #addr
1433     MOV #NEXT_ADR,-2(W)     \3 second CELL              =   ...mNEXT : do nothing by default
1434     MOV @RSP+,IP
1435     MOV @IP+,PC
1436     ENDCODE
1437     [THEN]
1438
1439     [UNDEFINED] CR [IF]
1440 \ https://forth-standard.org/standard/core/CR
1441 \ CR      --               send CR+LF to the output device
1442 \    DEFER CR
1443 \
1444 \    :NONAME
1445 \    'CR' EMIT 'LF' EMIT
1446 \    ; IS CR
1447 \
1448     CODE CR
1449     MOV #NEXT_ADR,PC    \ compile same as DEFER
1450     ENDCODE
1451
1452     :NONAME
1453     'CR' EMIT 'LF' EMIT
1454     ; IS CR
1455     [THEN]
1456
1457     [UNDEFINED] TO [IF]
1458 \ https://forth-standard.org/standard/core/TO
1459 \ TO name Run-time: ( x -- )
1460 \ Assign the value x to named VALUE.
1461     CODE TO
1462     BIS #UF9,SR
1463     MOV @IP+,PC
1464     ENDCODE
1465     [THEN]
1466
1467     [UNDEFINED] VALUE [IF]
1468 \ https://forth-standard.org/standard/core/VALUE
1469 \ ( x "<spaces>name" -- )                      define a Forth VALUE
1470 \ Skip leading space delimiters. Parse name delimited by a space.
1471 \ Create a definition for name with the execution semantics defined below,
1472 \ with an initial value equal to x.
1473 \
1474 \ name Execution: ( -- x )
1475 \ Place x on the stack. The value of x is that given when name was created,
1476 \ until the phrase x TO name is executed, causing a new value of x to be assigned to name.
1477     : VALUE             \ x "<spaces>name" --
1478     CREATE ,
1479     DOES>
1480     HI2LO
1481     MOV @RSP+,IP
1482     BIT #UF9,SR         \ 2 see TO
1483     0= IF               \ 2 if UF9 is not set
1484         MOV #@,PC       \       execute FETCH
1485     THEN                \   else
1486     BIC #UF9,SR         \ 2     clear UF9 flag
1487     MOV #!,PC           \       execute STORE
1488     ENDCODE
1489     [THEN]
1490
1491     [UNDEFINED] CASE [IF]   \ define CASE OF ENDOF ENDCASE
1492
1493 \ https://forth-standard.org/standard/core/CASE
1494     : CASE 
1495     0
1496     ; IMMEDIATE \ -- #of-1
1497
1498 \ https://forth-standard.org/standard/core/OF
1499     : OF \ #of-1 -- orgOF #of
1500     1+                      \ count OFs
1501     >R                      \ move off the stack in case the control-flow stack is the data stack.
1502     POSTPONE OVER POSTPONE = \ copy and test case value
1503     POSTPONE IF             \ add orig to control flow stack
1504     POSTPONE DROP               \ discards case value if =
1505     R>                      \ we can bring count back now
1506     ; IMMEDIATE
1507
1508 \ https://forth-standard.org/standard/core/ENDOF
1509     : ENDOF \ orgOF #of -- orgENDOF #of
1510     >R                      \ move off the stack in case the control-flow stack is the data stack.
1511     POSTPONE ELSE
1512     R>                      \ we can bring count back now
1513     ; IMMEDIATE
1514
1515 \ https://forth-standard.org/standard/core/ENDCASE
1516     : ENDCASE \ orgENDOF1..orgENDOFn #of --
1517     POSTPONE DROP
1518     0 DO POSTPONE THEN
1519     LOOP
1520     ; IMMEDIATE
1521     [THEN]
1522
1523     RST_SET
1524
1525     [THEN]
1526
1527     ECHO
1528
1529 ; CORE_ANS.f is loaded