MSP430-FORTH/RTC.f

   1 \ -*- coding: utf-8 -*-
   2 \
   3 \ ==============================================================================
   4 \ routines RTC for MSP430FR5xxx
   5 \ your target must have a LF_XTAL 32768Hz
   6 \ ==============================================================================
   7 \
   8 \ to see kernel options, download FastForthSpecs.f
   9 \ FastForth kernel minimal addons: MSP430ASSEMBLER, CONDCOMP
  10 \
  11 \ TARGET SELECTION ( = the name of \INC\target.pat file without the extension)
  12 \ MSP_EXP430FR5739  MSP_EXP430FR5969    MSP_EXP430FR5994    MSP_EXP430FR6989
  13 \
  14 \ from scite editor : copy your target selection in (shift+F8) parameter 1:
  15 \
  16 \ or, from windows explorer:
  17 \ drag and drop this file onto SendSourceFileToTarget.bat
  18 \ then select your TARGET when asked.
  19 \
  20 \ ASSEMBLER REGISTERS USAGE
  21 \ R4 to R7 must be saved before use and restored after
  22 \ scratch registers Y to S are free for use
  23 \ under interrupt, IP is free for use
  24 \
  25 \ PUSHM order : PSP,TOS, IP,  S,  T,  W,  X,  Y, rEXIT,rDOVAR,rDOCON, rDODOES, R3, SR,RSP, PC
  26 \ PUSHM order : R15,R14,R13,R12,R11,R10, R9, R8,  R7  ,  R6  ,  R5  ,   R4   , R3, R2, R1, R0
  27 \
  28 \ example : PUSHM #6,IP pushes IP,S,T,W,X,Y registers to return stack
  29 \
  30 \ POPM  order :  PC,RSP, SR, R3, rDODOES,rDOCON,rDOVAR,rEXIT,  Y,  X,  W,  T,  S, IP,TOS,PSP
  31 \ POPM  order :  R0, R1, R2, R3,   R4   ,  R5  ,  R6  ,  R7 , R8, R9,R10,R11,R12,R13,R14,R15
  32 \
  33 \ example : POPM #6,IP   pop Y,X,W,T,S,IP registers from return stack
  34 \
  35 \
  36 \ FORTH conditionnals:  unary{ 0= 0< 0> }, binary{ = < > U< }
  37 \
  38 \ ASSEMBLER conditionnal usage with IF UNTIL WHILE  S<  S>=  U<   U>=  0=  0<>  0>=
  39 \ ASSEMBLER conditionnal usage with ?JMP ?GOTO      S<  S>=  U<   U>=  0=  0<>  0<
  40 \
  41 \
  42
  43 ; --------------------
  44 ; RTC.f
  45 ; --------------------
  46 \ use :
  47 \ to set date, type : d m y DATE!
  48 \ to view date, type DATE?
  49 \ to set time, type : h m [s] TIME!
  50 \ to view time, type TIME?
  51 \
  52
  53 \ first, we do some tests allowing the download
  54     CODE ABORT_RTC
  55     SUB #4,PSP
  56     MOV TOS,2(PSP)
  57     MOV &KERNEL_ADDON,TOS
  58     BIT #BIT14,TOS
  59     0<> IF MOV #0,TOS THEN  \ if TOS <> 0 (FIXPOINT input), set TOS = 0
  60     MOV TOS,0(PSP)
  61     MOV &VERSION,TOS
  62     SUB #401,TOS        \   FastForth V4.1
  63     COLON
  64     $0D EMIT            \ return to column 1 without CR
  65     ABORT" FastForth V4.1 please!"
  66     ABORT" target without LF_XTAL !"
  67     RST_RET             \ if no abort remove this word
  68     ;
  69
  70     ABORT_RTC
  71
  72     MARKER {RTC}
  73
  74 ; ------------------------------------------------------------------
  75 ; first we download the set of definitions we need (from CORE_ANS.f)
  76 ; ------------------------------------------------------------------
  77
  78     [UNDEFINED] OR [IF]
  79 \ https://forth-standard.org/standard/core/OR
  80 \ C OR     x1 x2 -- x3           logical OR
  81     CODE OR
  82     BIS @PSP+,TOS
  83     MOV @IP+,PC
  84     ENDCODE
  85     [THEN]
  86
  87     [UNDEFINED] C@ [IF]
  88 \ https://forth-standard.org/standard/core/CFetch
  89 \ C@     c-addr -- char   fetch char from memory
  90     CODE C@
  91     MOV.B @TOS,TOS
  92     MOV @IP+,PC
  93     ENDCODE
  94     [THEN]
  95
  96     [UNDEFINED] C! [IF]
  97 \ https://forth-standard.org/standard/core/CStore
  98 \ C!      char c-addr --    store char in memory
  99     CODE C!
 100     MOV.B @PSP+,0(TOS)  \ 4
 101     ADD #1,PSP          \ 1
 102     MOV @PSP+,TOS       \ 2
 103     MOV @IP+,PC
 104     ENDCODE
 105     [THEN]
 106
 107     [UNDEFINED] SWAP [IF]
 108 \ https://forth-standard.org/standard/core/SWAP
 109 \ SWAP     x1 x2 -- x2 x1    swap top two items
 110     CODE SWAP
 111     MOV @PSP,W      \ 2
 112     MOV TOS,0(PSP)  \ 3
 113     MOV W,TOS       \ 1
 114     MOV @IP+,PC     \ 4
 115     ENDCODE
 116     [THEN]
 117
 118     [UNDEFINED] OVER [IF]
 119 \ https://forth-standard.org/standard/core/OVER
 120 \ OVER    x1 x2 -- x1 x2 x1
 121     CODE OVER
 122     MOV TOS,-2(PSP)     \ 3 -- x1 (x2) x2
 123     MOV @PSP,TOS        \ 2 -- x1 (x2) x1
 124     SUB #2,PSP          \ 1 -- x1 x2 x1
 125     MOV @IP+,PC
 126     ENDCODE
 127     [THEN]
 128
 129     [UNDEFINED] DUP [IF]    \ define DUP and DUP?
 130 \ https://forth-standard.org/standard/core/DUP
 131 \ DUP      x -- x x      duplicate top of stack
 132     CODE DUP
 133 BW1 SUB #2,PSP      \ 2  push old TOS..
 134     MOV TOS,0(PSP)  \ 3  ..onto stack
 135     MOV @IP+,PC     \ 4
 136     ENDCODE
 137
 138 \ https://forth-standard.org/standard/core/qDUP
 139 \ ?DUP     x -- 0 | x x    DUP if nonzero
 140     CODE ?DUP
 141     CMP #0,TOS      \ 2  test for TOS nonzero
 142     0<> ?GOTO BW1   \ 2
 143     MOV @IP+,PC     \ 4
 144     ENDCODE
 145     [THEN]
 146
 147     [UNDEFINED] DROP [IF]
 148 \ https://forth-standard.org/standard/core/DROP
 149 \ DROP     x --          drop top of stack
 150     CODE DROP
 151     MOV @PSP+,TOS   \ 2
 152     MOV @IP+,PC     \ 4
 153     ENDCODE
 154     [THEN]
 155
 156     [UNDEFINED] DEPTH [IF]
 157 \ https://forth-standard.org/standard/core/DEPTH
 158 \ DEPTH    -- +n        number of items on stack, must leave 0 if stack empty
 159     CODE DEPTH
 160     MOV TOS,-2(PSP)
 161     MOV #PSTACK,TOS
 162     SUB PSP,TOS     \ PSP-S0--> TOS
 163     RRA TOS         \ TOS/2   --> TOS
 164     SUB #2,PSP      \ post decrement stack...
 165     MOV @IP+,PC
 166     ENDCODE
 167     [THEN]
 168
 169     [UNDEFINED] >R [IF]
 170 \ https://forth-standard.org/standard/core/toR
 171 \ >R    x --   R: -- x   push to return stack
 172     CODE >R
 173     PUSH TOS        \ 3
 174     MOV @PSP+,TOS   \ 2
 175     MOV @IP+,PC     \ 4
 176     ENDCODE
 177     [THEN]
 178
 179     [UNDEFINED] R> [IF]
 180 \ https://forth-standard.org/standard/core/Rfrom
 181 \ R>    -- x    R: x --   pop from return stack ; CALL #RFROM performs DOVAR
 182     CODE R>
 183     SUB #2,PSP      \ 1
 184     MOV TOS,0(PSP)  \ 3
 185     MOV @RSP+,TOS   \ 2
 186     MOV @IP+,PC     \ 4
 187     ENDCODE
 188     [THEN]
 189
 190     [UNDEFINED] 1+ [IF]
 191 \ https://forth-standard.org/standard/core/OnePlus
 192 \ 1+      n1/u1 -- n2/u2       add 1 to TOS
 193     CODE 1+
 194     ADD #1,TOS
 195     MOV @IP+,PC
 196     ENDCODE
 197     [THEN]
 198
 199     [UNDEFINED] 1- [IF]
 200 \ https://forth-standard.org/standard/core/OneMinus
 201 \ 1-      n1/u1 -- n2/u2     subtract 1 from TOS
 202     CODE 1-
 203     SUB #1,TOS
 204     MOV @IP+,PC
 205     ENDCODE
 206     [THEN]
 207
 208     [UNDEFINED] U<
 209     [IF]
 210     CODE U<
 211     SUB @PSP+,TOS   \ 2 u2-u1
 212     0<> IF
 213         MOV #-1,TOS     \ 1
 214         U< IF           \ 2 flag
 215             AND #0,TOS  \ 1 flag Z = 1
 216         THEN
 217     THEN
 218     MOV @IP+,PC     \ 4
 219     ENDCODE
 220     [THEN]
 221
 222     [UNDEFINED] = [IF]
 223 \ https://forth-standard.org/standard/core/Equal
 224 \ =      x1 x2 -- flag         test x1=x2
 225     CODE =
 226     SUB @PSP+,TOS   \ 2
 227     0<> IF          \ 2
 228         AND #0,TOS  \ 1
 229         MOV @IP+,PC \ 4
 230     THEN
 231     XOR #-1,TOS     \ 1 flag Z = 1
 232     MOV @IP+,PC     \ 4
 233     ENDCODE
 234     [THEN]
 235
 236     [UNDEFINED] IF [IF]     \ define IF THEN
 237
 238 \ https://forth-standard.org/standard/core/IF
 239 \ IF       -- IFadr    initialize conditional forward branch
 240     CODE IF       \ immediate
 241     SUB #2,PSP              \
 242     MOV TOS,0(PSP)          \
 243     MOV &DP,TOS             \ -- HERE
 244     ADD #4,&DP            \           compile one word, reserve one word
 245     MOV #QFBRAN,0(TOS)      \ -- HERE   compile QFBRAN
 246     ADD #2,TOS              \ -- HERE+2=IFadr
 247     MOV @IP+,PC
 248     ENDCODE IMMEDIATE
 249
 250 \ https://forth-standard.org/standard/core/THEN
 251 \ THEN     IFadr --                resolve forward branch
 252     CODE THEN               \ immediate
 253     MOV &DP,0(TOS)          \ -- IFadr
 254     MOV @PSP+,TOS           \ --
 255     MOV @IP+,PC
 256     ENDCODE IMMEDIATE
 257     [THEN]
 258
 259     [UNDEFINED] ELSE [IF]
 260 \ https://forth-standard.org/standard/core/ELSE
 261 \ ELSE     IFadr -- ELSEadr        resolve forward IF branch, leave ELSEadr on stack
 262     CODE ELSE     \ immediate
 263     ADD #4,&DP              \ make room to compile two words
 264     MOV &DP,W               \ W=HERE+4
 265     MOV #BRAN,-4(W)
 266     MOV W,0(TOS)            \ HERE+4 ==> [IFadr]
 267     SUB #2,W                \ HERE+2
 268     MOV W,TOS               \ -- ELSEadr
 269     MOV @IP+,PC
 270     ENDCODE IMMEDIATE
 271
 272     [THEN]
 273
 274     [UNDEFINED] DO [IF] \ define DO LOOP +LOOP
 275
 276 \ https://forth-standard.org/standard/core/DO
 277 \ DO       -- DOadr   L: -- 0
 278     HDNCODE XDO         \ DO run time
 279     MOV #$8000,X        \ 2 compute 8000h-limit = "fudge factor"
 280     SUB @PSP+,X         \ 2
 281     MOV TOS,Y           \ 1 loop ctr = index+fudge
 282     ADD X,Y             \ 1 Y = INDEX
 283     PUSHM #2,X          \ 4 PUSHM X,Y, i.e. PUSHM LIMIT, INDEX
 284     MOV @PSP+,TOS       \ 2
 285     MOV @IP+,PC         \ 4
 286     ENDCODE
 287
 288     CODE DO
 289     SUB #2,PSP              \
 290     MOV TOS,0(PSP)          \
 291     ADD #2,&DP              \   make room to compile xdo
 292     MOV &DP,TOS             \ -- HERE+2
 293     MOV #XDO,-2(TOS)        \   compile xdo
 294     ADD #2,&LEAVEPTR        \ -- HERE+2     LEAVEPTR+2
 295     MOV &LEAVEPTR,W         \
 296     MOV #0,0(W)             \ -- HERE+2     L-- 0
 297     MOV @IP+,PC
 298     ENDCODE IMMEDIATE
 299
 300 \ https://forth-standard.org/standard/core/LOOP
 301 \ LOOP    DOadr --         L-- an an-1 .. a1 0
 302     HDNCODE XLOOP       \   LOOP run time
 303     ADD #1,0(RSP)       \ 4 increment INDEX
 304 BW1 BIT #$100,SR        \ 2 is overflow bit set?
 305     0= IF               \   branch if no overflow
 306         MOV @IP,IP
 307         MOV @IP+,PC
 308     THEN
 309     ADD #4,RSP          \ 1 empties RSP
 310     ADD #2,IP           \ 1 overflow = loop done, skip branch ofs
 311     MOV @IP+,PC         \ 4 14~ taken or not taken xloop/loop
 312     ENDCODE             \
 313
 314     CODE LOOP
 315     MOV #XLOOP,X
 316 BW2 ADD #4,&DP              \ make room to compile two words
 317     MOV &DP,W
 318     MOV X,-4(W)             \ xloop --> HERE
 319     MOV TOS,-2(W)           \ DOadr --> HERE+2
 320     BEGIN                   \ resolve all "leave" adr
 321         MOV &LEAVEPTR,TOS   \ -- Adr of top LeaveStack cell
 322         SUB #2,&LEAVEPTR    \ --
 323         MOV @TOS,TOS        \ -- first LeaveStack value
 324         CMP #0,TOS          \ -- = value left by DO ?
 325     0<> WHILE
 326         MOV W,0(TOS)        \ move adr after loop as UNLOOP adr
 327     REPEAT
 328     MOV @PSP+,TOS
 329     MOV @IP+,PC
 330     ENDCODE IMMEDIATE
 331
 332 \ https://forth-standard.org/standard/core/PlusLOOP
 333 \ +LOOP   adrs --   L-- an an-1 .. a1 0
 334     HDNCODE XPLOO   \   +LOOP run time
 335     ADD TOS,0(RSP)  \ 4 increment INDEX by TOS value
 336     MOV @PSP+,TOS   \ 2 get new TOS, doesn't change flags
 337     GOTO BW1        \ 2
 338     ENDCODE         \
 339
 340     CODE +LOOP
 341     MOV #XPLOO,X
 342     GOTO BW2        \ goto BW1 LOOP
 343     ENDCODE IMMEDIATE
 344
 345     [THEN]
 346
 347     [UNDEFINED] BEGIN [IF]  \ define BEGIN UNTIL AGAIN WHILE REPEAT
 348
 349 \ https://forth-standard.org/standard/core/BEGIN
 350 \ BEGIN    -- BEGINadr             initialize backward branch
 351     CODE BEGIN
 352     MOV #BEGIN,PC
 353     ENDCODE IMMEDIATE
 354
 355 \ https://forth-standard.org/standard/core/UNTIL
 356 \ UNTIL    BEGINadr --             resolve conditional backward branch
 357     CODE UNTIL
 358     MOV #QFBRAN,X
 359 BW1 ADD #4,&DP          \ compile two words
 360     MOV &DP,W           \ W = HERE
 361     MOV X,-4(W)         \ compile Bran or QFBRAN at HERE
 362     MOV TOS,-2(W)       \ compile bakcward adr at HERE+2
 363     MOV @PSP+,TOS
 364     MOV @IP+,PC
 365     ENDCODE IMMEDIATE
 366
 367 \ https://forth-standard.org/standard/core/AGAIN
 368 \ AGAIN    BEGINadr --             resolve uncondionnal backward branch
 369     CODE AGAIN
 370     MOV #BRAN,X
 371     GOTO BW1
 372     ENDCODE IMMEDIATE
 373
 374 \ https://forth-standard.org/standard/core/WHILE
 375 \ WHILE    BEGINadr -- WHILEadr BEGINadr
 376     : WHILE
 377     POSTPONE IF SWAP
 378     ; IMMEDIATE
 379
 380 \ https://forth-standard.org/standard/core/REPEAT
 381 \ REPEAT   WHILEadr BEGINadr --     resolve WHILE loop
 382     : REPEAT
 383     POSTPONE AGAIN POSTPONE THEN
 384     ; IMMEDIATE
 385
 386     [THEN]
 387
 388 \ https://forth-standard.org/standard/core/CASE
 389     [UNDEFINED] CASE [IF]   \ define CASE OF ENDOF ENDCASE
 390     : CASE
 391     0
 392     ; IMMEDIATE \ -- #of-1
 393
 394 \ https://forth-standard.org/standard/core/OF
 395     : OF \ #of-1 -- orgOF #of
 396     1+                      \ count OFs
 397     >R                      \ move off the stack in case the control-flow stack is the data stack.
 398     POSTPONE OVER POSTPONE = \ copy and test case value
 399     POSTPONE IF             \ add orig to control flow stack
 400     POSTPONE DROP               \ discards case value if =
 401     R>                      \ we can bring count back now
 402     ; IMMEDIATE
 403
 404 \ https://forth-standard.org/standard/core/ENDOF
 405     : ENDOF \ orgOF #of -- orgENDOF #of
 406     >R                      \ move off the stack in case the control-flow stack is the data stack.
 407     POSTPONE ELSE
 408     R>                      \ we can bring count back now
 409     ; IMMEDIATE
 410
 411 \ https://forth-standard.org/standard/core/ENDCASE
 412     : ENDCASE \ orgENDOF1..orgENDOFn #of --
 413     POSTPONE DROP
 414     0 DO
 415         POSTPONE THEN
 416     LOOP
 417     ; IMMEDIATE
 418     [THEN]
 419
 420     [UNDEFINED] + [IF]
 421 \ https://forth-standard.org/standard/core/Plus
 422 \ +       n1/u1 n2/u2 -- n3/u3
 423     CODE +
 424     ADD @PSP+,TOS
 425     MOV @IP+,PC
 426     ENDCODE
 427     [THEN]
 428
 429     [UNDEFINED] - [IF]
 430 \ https://forth-standard.org/standard/core/Minus
 431 \ -      n1/u1 n2/u2 -- n3/u3     n3 = n1-n2
 432     CODE -
 433     SUB @PSP+,TOS   \ 2  -- n2-n1 ( = -n3)
 434     XOR #-1,TOS     \ 1
 435     ADD #1,TOS      \ 1  -- n3 = -(n2-n1) = n1-n2
 436     MOV @IP+,PC
 437     ENDCODE
 438     [THEN]
 439
 440     [UNDEFINED] MAX [IF]    \define MAX and MIN
 441     CODE MAX        \    n1 n2 -- n3       signed maximum
 442     CMP @PSP,TOS    \ n2-n1
 443     S<  ?GOTO FW1   \ n2<n1
 444 BW1 ADD #2,PSP
 445     MOV @IP+,PC
 446     ENDCODE
 447
 448     CODE MIN        \    n1 n2 -- n3       signed minimum
 449     CMP @PSP,TOS    \ n2-n1
 450     S<  ?GOTO BW1   \ n2<n1
 451 FW1 MOV @PSP+,TOS
 452     MOV @IP+,PC
 453     ENDCODE
 454
 455     [THEN]  \ MAX
 456
 457     [UNDEFINED] 2* [IF]
 458 \ https://forth-standard.org/standard/core/TwoTimes
 459 \ 2*      x1 -- x2         arithmetic left shift
 460     CODE 2*
 461     ADD TOS,TOS
 462     MOV @IP+,PC
 463     ENDCODE
 464     [THEN]
 465
 466     [UNDEFINED] UM* [IF]    \ case of hardware_MPY
 467 \ https://forth-standard.org/standard/core/UMTimes
 468 \ UM*     u1 u2 -- udlo udhi   unsigned 16x16->32 mult.
 469     CODE UM*
 470     MOV @PSP,&MPY       \ Load 1st operand for unsigned multiplication
 471 BW1 MOV TOS,&OP2        \ Load 2nd operand
 472     MOV &RES0,0(PSP)    \ low result on stack
 473     MOV &RES1,TOS       \ high result in TOS
 474     MOV @IP+,PC
 475     ENDCODE
 476
 477 \ https://forth-standard.org/standard/core/MTimes
 478 \ M*     n1 n2 -- dlo dhi  signed 16*16->32 multiply
 479     CODE M*
 480     MOV @PSP,&MPYS      \ Load 1st operand for signed multiplication
 481     GOTO BW1
 482     ENDCODE
 483     [THEN]
 484
 485     [UNDEFINED] UM/MOD [IF]
 486 \ https://forth-standard.org/standard/core/UMDivMOD
 487 \ UM/MOD   udlo|udhi u1 -- ur uq   unsigned 32/16->r16 q16
 488     CODE UM/MOD
 489     PUSH #DROP      \
 490     MOV #MUSMOD,PC  \ execute MUSMOD then return to DROP
 491     ENDCODE
 492     [THEN]
 493
 494 ; --------------------------
 495 ; end of definitions we need
 496 ; --------------------------
 497
 498 \ U*/     u1 u2 u3 -- uq        u1*u2/u3
 499     : U*/
 500     >R UM* R> UM/MOD SWAP DROP
 501     ;
 502
 503 \ U/MOD   u1 u2 -- ur uq     unsigned division
 504     : U/MOD
 505     0 SWAP UM/MOD
 506     ;
 507
 508 \ UMOD   u1 u2 -- ur        unsigned division
 509     : UMOD
 510     U/MOD DROP
 511     ;
 512
 513 \ https://forth-standard.org/standard/core/Div
 514 \ U/      u1 u2 -- uq       signed quotient
 515     : U/
 516     U/MOD SWAP DROP
 517     ;
 518
 519     [UNDEFINED] SPACES [IF]
 520 \ https://forth-standard.org/standard/core/SPACES
 521 \ SPACES   n --            output n spaces
 522     : SPACES
 523     BEGIN
 524         ?DUP
 525     WHILE
 526         'SP' EMIT
 527         1-
 528     REPEAT
 529     ;
 530     [THEN]
 531
 532     [UNDEFINED] U.R
 533     [IF]
 534     : U.R                       \ u n --           display u unsigned in n width (n >= 2)
 535     >R  <# 0 # #S #>
 536     R> OVER - 0 MAX SPACES TYPE
 537     ;
 538     [THEN]
 539
 540     CODE TIME?
 541     BEGIN
 542         BIT.B #RTCRDY,&RTCCTL1
 543     0<> UNTIL                   \ wait until RTCRDY high
 544     COLON
 545     RTCHOUR C@ 2 U.R ':' EMIT
 546     RTCMIN C@  2 U.R ':' EMIT
 547     RTCSEC C@  2 U.R
 548     ;
 549
 550     : TIME!
 551     2 DEPTH
 552     U< IF                   \ if 3 numbers on stack
 553         RTCSEC C!
 554         RTCMIN C!
 555         RTCHOUR C!
 556     THEN
 557     ." it is " TIME?
 558     ;
 559
 560     CODE DATE?                  \ display date
 561     BEGIN
 562         BIT.B #RTCRDY,&RTCCTL1
 563     0<> UNTIL                   \ wait until windows time RTC_ReaDY is high
 564     COLON
 565
 566 \     [THEN]
 567
 568 \ ==============================================================================
 569 \ end of RTC software|harware calendar
 570 \ ==============================================================================
 571 \ resume with common part of DATE? definition:
 572
 573     RTCDOW C@                   \ -- weekday    {0=Sat...6=Fri}
 574     CASE
 575     0 OF ." Sat"    ENDOF
 576     1 OF ." Sun"    ENDOF
 577     2 OF ." Mon"    ENDOF
 578     3 OF ." Tue"    ENDOF
 579     4 OF ." Wed"    ENDOF
 580     5 OF ." Thu"    ENDOF
 581     6 OF ." Fri"    ENDOF
 582     ENDCASE
 583     RTCYEAR @
 584     RTCMON C@
 585     RTCDAY C@                   \ -- year mon day
 586     $20 EMIT
 587     2 U.R '/' EMIT              \ -- year mon
 588     2 U.R '/' EMIT              \ -- year
 589     .                           \ --
 590     ;
 591
 592     : DATE!                         \ year mon day --
 593     2 DEPTH
 594     U< IF                   \ if 3 numbers on stack
 595         RTCYEAR !
 596         RTCMON C!
 597         RTCDAY C!
 598     THEN
 599     RTCDAY C@
 600     RTCMON C@
 601     RTCYEAR @               \ -- day mon year
 602 \ ------------------------------------------
 603 \ Zeller's congruence for gregorian calendar
 604 \ see https://www.rosettacode.org/wiki/Day_of_the_week#Forth
 605 \ : ZELLER \ day mon year -- weekday          {0=Sat, ..., 6=Fri}
 606 \ OVER 3 <                \
 607 \ IF 1- SWAP 12 + SWAP
 608 \ THEN                    \ -- d m' y'  with m' {3=March, ..., 14=february}
 609 \ 100 /MOD                \ -- d m' K J   with K = y' in century, J = century
 610 \ DUP 4 / SWAP 2* -       \ -- d m' K (J/4 - 2J)
 611 \ SWAP DUP 4 / + +        \ -- d m' ((J/4 - 2J) + (K + K/4))
 612 \ SWAP 1+  13 5 */ + +    \ -- (d + (((J/4 - 2J) + (K + K/4)) + (m+1)*13/5))
 613 \ 7 MOD                   \ -- weekday        = {0=Sat, ..., 6=Fri}
 614 \ ------------------------------------------
 615     OVER 3 U<               \
 616     IF 1 - SWAP 12 + SWAP
 617     THEN                    \ -- d m' y'  with m' {3=March, ..., 14=february}
 618     100 U/MOD               \ -- d m' K J   with K = y' in century, J = century
 619     DUP 4 U/ SWAP 2* -      \ -- d m' K (J/4 - 2J)
 620     SWAP DUP 4 U/ + +       \ -- d m' ((J/4 - 2J) + (K + K/4))
 621     SWAP 1+  13 5 U*/ + +   \ -- (d + (((J/4 - 2J) + (K + K/4)) + (m+1)*13/5))
 622     7 UMOD                  \ -- weekday        = {0=Sat, ..., 6=Fri}
 623 \ ------------------------------------------
 624     RTCDOW C!               \ --
 625     ." we are on " DATE?
 626     ;
 627
 628     [UNDEFINED] S_ [IF]
 629     CODE S_             \           Squote alias with blank instead of double quote separator
 630     SUB #2,PSP
 631     MOV TOS,0(PSP)
 632     MOV #'SP',TOS
 633     MOV #S"+10,PC       \           addr S" + 10 --> PC
 634     ENDCODE IMMEDIATE
 635     [THEN]
 636
 637     [UNDEFINED] ESC [IF]
 638     CODE ESC
 639     CMP #0,&STATEADR
 640     0= IF MOV @IP+,PC   \ interpret time usage disallowed
 641     THEN
 642     COLON
 643     $1B                 \ -- char escape
 644     POSTPONE LITERAL    \ compile-time code : lit $1B
 645     POSTPONE EMIT       \ compile-time code : EMIT
 646     POSTPONE S_         \ compile-time code : S_ <escape_sequence>
 647     POSTPONE TYPE       \ compile-time code : TYPE
 648     ; IMMEDIATE
 649     [THEN]
 650
 651     [UNDEFINED] >BODY [IF]
 652 \ https://forth-standard.org/standard/core/toBODY
 653 \ >BODY     -- addr      leave BODY of a CREATEd word\ also leave default ACTION-OF primary DEFERred word
 654     CODE >BODY
 655     ADD #4,TOS
 656     MOV @IP+,PC
 657     ENDCODE
 658     [THEN]
 659
 660     [UNDEFINED] EXECUTE [IF]
 661 \ https://forth-standard.org/standard/core/EXECUTE
 662 \ EXECUTE   i*x xt -- j*x   execute Forth word at 'xt'
 663     CODE EXECUTE
 664     PUSH TOS                \ 3 push xt
 665     MOV @PSP+,TOS           \ 2
 666     MOV @RSP+,PC            \ 4 xt --> PC
 667     ENDCODE
 668     [THEN]
 669
 670     [UNDEFINED] EVALUATE [IF]
 671
 672 \ EVALUATE upside down...
 673     CODENNM                 \ as the end of EVALUATE
 674     MOV @RSP+,&TOIN         \ 4
 675     MOV @RSP+,&SOURCE_ORG   \ 4
 676     MOV @RSP+,&SOURCE_LEN   \ 4
 677     MOV @RSP+,IP
 678     MOV @IP+,PC
 679     ENDCODE                 \   -- end_of_EVALUATE_addr
 680
 681 \ https://forth-standard.org/standard/core/EVALUATE
 682 \ EVALUATE          \ i*x c-addr u -- j*x  interpret string
 683     CODE EVALUATE
 684     MOV #SOURCE_LEN,X       \ 2
 685     MOV @X+,S               \ 2 S = SOURCE_LEN
 686     MOV @X+,T               \ 2 T = SOURCE_ORG
 687     MOV @X+,W               \ 2 W = TOIN
 688     PUSHM #4,IP             \ 6 PUSHM IP,S,T,W
 689     MOV PC,IP               \ 1
 690     ADD #8,IP               \ 1 IP = address compiled after ENDCODE
 691     MOV #INTERPRET,PC       \ 3 addr defined in MSP430FRxxxx.pat
 692     NOP                     \ 1 stuffing instruction
 693     ENDCODE                 \
 694     ,                       \ end_of_EVALUATE_addr   --         compile the end_of_EVALUATE_addr
 695
 696     [THEN]
 697
 698     [UNDEFINED] CR [IF]
 699 \ https://forth-standard.org/standard/core/CR
 700 \ CR      --               send CR+LF to the output device
 701
 702 \    DEFER CR       \ DEFERed definition, by default executes that of :NONAME
 703     CODE CR         \ create a DEFER definition of CR
 704     MOV #NEXT_ADR,PC
 705     ENDCODE
 706
 707     :NONAME     \ starts at BODY address of DEFERed CR
 708     'CR' EMIT 'LF' EMIT
 709     ; IS CR     \ CR executes :NONAME by default
 710     [THEN]
 711
 712     : SET_TIME
 713     ESC [8;42;80t       \ set terminal display 42L * 80C
 714     42 0 DO CR LOOP     \ to avoid erasing any line of source, create 42 empty lines
 715     ESC [H              \ then set cursor home
 716     CR ." DATE (DMY): "
 717     PAD_ORG DUP PAD_LEN
 718     ['] ACCEPT >BODY    \ find default part of deferred ACCEPT (terminal input)
 719     EXECUTE             \ wait human input for D M Y
 720     EVALUATE            \ interpret this input
 721     CR DATE!            \ set date
 722     CR ." TIME (HMS): "
 723     PAD_ORG DUP PAD_LEN
 724     ['] ACCEPT >BODY    \ find default part of deferred ACCEPT (terminal input)
 725     EXECUTE             \ wait human input for H M S
 726     EVALUATE            \ interpret this input
 727     CR TIME!            \ set time
 728     ;
 729
 730     RST_SET
 731
 732     ECHO  SET_TIME