MSP430-FORTH/RTC.f

   1 \ -*- coding: utf-8 -*-
   2
   3 ; --------------------
   4 ; RTC.f
   5 ; --------------------
   6 \
   7 \ ==============================================================================
   8 \ routines RTC for MSP430fr5xxx and MSP430FR6xxx families only
   9 \ your target must have a LF_XTAL 32768Hz
  10 \ if no present, add a LF_XTAL line for your target in ThingsInFirst.inc.
  11 \ ==============================================================================
  12 \
  13 \ to see kernel options, download FastForthSpecs.f
  14 \ FastForth kernel options: MSP430ASSEMBLER, CONDCOMP
  15 \
  16 \ TARGET SELECTION
  17 \ MSP_EXP430FR5739  MSP_EXP430FR5969    MSP_EXP430FR5994    MSP_EXP430FR6989
  18 \
  19 \ REGISTERS USAGE
  20 \ R4 to R7 must be saved before use and restored after
  21 \ scratch registers Y to S are free for use
  22 \ under interrupt, IP is free for use
  23 \
  24 \ PUSHM order : PSP,TOS, IP,  S,  T,  W,  X,  Y, rEXIT,rDOVAR,rDOCON, rDODOES, R3, SR,RSP, PC
  25 \ PUSHM order : R15,R14,R13,R12,R11,R10, R9, R8,  R7  ,  R6  ,  R5  ,   R4   , R3, R2, R1, R0
  26 \
  27 \ example : PUSHM #6,IP pushes IP,S,T,W,X,Y registers to return stack
  28 \
  29 \ POPM  order :  PC,RSP, SR, R3, rDODOES,rDOCON,rDOVAR,rEXIT,  Y,  X,  W,  T,  S, IP,TOS,PSP
  30 \ POPM  order :  R0, R1, R2, R3,   R4   ,  R5  ,  R6  ,  R7 , R8, R9,R10,R11,R12,R13,R14,R15
  31 \
  32 \ example : POPM #6,IP   pop Y,X,W,T,S,IP registers from return stack
  33 \
  34 \
  35 \ FORTH conditionnals:  unary{ 0= 0< 0> }, binary{ = < > U< }
  36 \
  37 \ ASSEMBLER conditionnal usage with IF UNTIL WHILE  S<  S>=  U<   U>=  0=  0<>  0>=
  38 \ ASSEMBLER conditionnal usage with ?JMP ?GOTO      S<  S>=  U<   U>=  0=  0<>  0<
  39 \
  40 \ use :
  41 \ to set date, type : d m y DATE!
  42 \ to view date, type DATE?
  43 \ to set time, type : h m s TIME!, or h m TIME!
  44 \ to view time, type TIME?
  45 \
  46 \ allow to write a file on a SD_Card with a valid date and a valid time
  47 \
  48
  49 PWR_STATE
  50
  51 [DEFINED] {RTC} [IF]  {RTC} [THEN]
  52
  53 MARKER {RTC}
  54
  55 [UNDEFINED] IF [IF]     \ define IF THEN
  56 \ https://forth-standard.org/standard/core/IF
  57 \ IF       -- IFadr    initialize conditional forward branch
  58 CODE IF       \ immediate
  59 SUB #2,PSP              \
  60 MOV TOS,0(PSP)          \
  61 MOV &DP,TOS             \ -- HERE
  62 ADD #4,&DP            \           compile one word, reserve one word
  63 MOV #QFBRAN,0(TOS)      \ -- HERE   compile QFBRAN
  64 ADD #2,TOS              \ -- HERE+2=IFadr
  65 MOV @IP+,PC
  66 ENDCODE IMMEDIATE
  67
  68 \ https://forth-standard.org/standard/core/THEN
  69 \ THEN     IFadr --                resolve forward branch
  70 CODE THEN               \ immediate
  71 MOV &DP,0(TOS)          \ -- IFadr
  72 MOV @PSP+,TOS           \ --
  73 MOV @IP+,PC
  74 ENDCODE IMMEDIATE
  75 [THEN]
  76
  77 : NORTC
  78 IF
  79     {RTC}           \ remove MARKER
  80     ECHO $0D EMIT   \ return to column 0
  81     ABORT" no RTC on this device !"
  82 THEN
  83 ;
  84
  85 [UNDEFINED] @ [IF]
  86 \ https://forth-standard.org/standard/core/Fetch
  87 \ @     c-addr -- char   fetch char from memory
  88 CODE @
  89 MOV @TOS,TOS
  90 MOV @IP+,PC
  91 ENDCODE
  92 [THEN]
  93
  94 [UNDEFINED] U< [IF]
  95 CODE U<
  96 SUB @PSP+,TOS   \ 2 u2-u1
  97 0<> IF
  98     MOV #-1,TOS     \ 1
  99     U< IF           \ 2 flag
 100         AND #0,TOS  \ 1 flag Z = 1
 101     THEN
 102 THEN
 103 MOV @IP+,PC     \ 4
 104 ENDCODE
 105 [THEN]
 106
 107 [UNDEFINED] = [IF]
 108 \ https://forth-standard.org/standard/core/Equal
 109 \ =      x1 x2 -- flag         test x1=x2
 110 CODE =
 111 SUB @PSP+,TOS   \ 2
 112 0<> IF          \ 2
 113     AND #0,TOS  \ 1
 114     MOV @IP+,PC \ 4
 115 THEN
 116 XOR #-1,TOS     \ 1 flag Z = 1
 117 MOV @IP+,PC     \ 4
 118 ENDCODE
 119 [THEN]
 120
 121 [UNDEFINED] OR [IF]
 122 \ https://forth-standard.org/standard/core/OR
 123 \ C OR     x1 x2 -- x3           logical OR
 124 CODE OR
 125 BIS @PSP+,TOS
 126 MOV @IP+,PC
 127 ENDCODE
 128 [THEN]
 129
 130                         ; search devide ID:
 131 $81EF DEVICEID @ U<        ; MSP430FR4133 or...
 132 DEVICEID @ $8241 U<        ; ...MSP430FR2433
 133 =
 134 $830B DEVICEID @ U<        ; MSP430FR21xx/23xx/24xx/25xx/26xx
 135 OR                      ; -- flag       0 ==> RTC, -1 ==> no RTC
 136 NORTC                   \
 137
 138 [UNDEFINED] SWAP [IF]
 139 \ https://forth-standard.org/standard/core/SWAP
 140 \ SWAP     x1 x2 -- x2 x1    swap top two items
 141 CODE SWAP
 142 MOV @PSP,W      \ 2
 143 MOV TOS,0(PSP)  \ 3
 144 MOV W,TOS       \ 1
 145 MOV @IP+,PC     \ 4
 146 ENDCODE
 147 [THEN]
 148
 149 [UNDEFINED] OVER [IF]
 150 \ https://forth-standard.org/standard/core/OVER
 151 \ OVER    x1 x2 -- x1 x2 x1
 152 CODE OVER
 153 MOV TOS,-2(PSP)     \ 3 -- x1 (x2) x2
 154 MOV @PSP,TOS        \ 2 -- x1 (x2) x1
 155 SUB #2,PSP          \ 1 -- x1 x2 x1
 156 MOV @IP+,PC
 157 ENDCODE
 158 [THEN]
 159
 160 [UNDEFINED] EXECUTE [IF] \ "
 161 \ https://forth-standard.org/standard/core/EXECUTE
 162 \ EXECUTE   i*x xt -- j*x   execute Forth word at 'xt'
 163 CODE EXECUTE
 164 MOV TOS,W               \ 1 put word address into W
 165 MOV @PSP+,TOS           \ 2 fetch new TOS
 166 MOV W,PC                \ 3 fetch code address into PC
 167 ENDCODE
 168 [THEN]
 169
 170 [UNDEFINED] DO [IF]     \ define DO LOOP +LOOP
 171 \ https://forth-standard.org/standard/core/DO
 172 \ DO       -- DOadr   L: -- 0
 173 CODE DO                 \ immediate
 174 SUB #2,PSP              \
 175 MOV TOS,0(PSP)          \
 176 ADD #2,&DP              \   make room to compile xdo
 177 MOV &DP,TOS             \ -- HERE+2
 178 MOV #XDO,-2(TOS)        \   compile xdo
 179 ADD #2,&LEAVEPTR        \ -- HERE+2     LEAVEPTR+2
 180 MOV &LEAVEPTR,W         \
 181 MOV #0,0(W)             \ -- HERE+2     L-- 0
 182 MOV @IP+,PC
 183 ENDCODE IMMEDIATE
 184
 185 \ https://forth-standard.org/standard/core/LOOP
 186 \ LOOP    DOadr --         L-- an an-1 .. a1 0
 187 CODE LOOP               \ immediate
 188     MOV #XLOOP,X
 189 BW1 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 CODE +LOOP
 208 MOV #XPLOOP,X
 209 GOTO BW1        \ goto BW1 LOOP
 210 ENDCODE IMMEDIATE
 211 [THEN]
 212
 213 [UNDEFINED] - [IF]
 214 \ https://forth-standard.org/standard/core/Minus
 215 \ -      n1/u1 n2/u2 -- n3/u3     n3 = n1-n2
 216 CODE -
 217 SUB @PSP+,TOS   \ 2  -- n2-n1 ( = -n3)
 218 XOR #-1,TOS     \ 1
 219 ADD #1,TOS      \ 1  -- n3 = -(n2-n1) = n1-n2
 220 MOV @IP+,PC
 221 ENDCODE
 222 [THEN]
 223
 224 [UNDEFINED] MAX [IF]    \define MAX and MIN
 225
 226 CODE MAX    \    n1 n2 -- n3       signed maximum
 227     CMP @PSP,TOS    \ n2-n1
 228     S<  ?GOTO FW1   \ n2<n1
 229 BW1 ADD #2,PSP
 230     MOV @IP+,PC
 231 ENDCODE
 232
 233 CODE MIN    \    n1 n2 -- n3       signed minimum
 234     CMP @PSP,TOS     \ n2-n1
 235     S<  ?GOTO BW1    \ n2<n1
 236 FW1 MOV @PSP+,TOS
 237     MOV @IP+,PC
 238 ENDCODE
 239
 240 [THEN]  \ MAX
 241
 242 [UNDEFINED] SPACES [IF]
 243 \ https://forth-standard.org/standard/core/SPACES
 244 \ SPACES   n --            output n spaces
 245 CODE SPACES
 246 CMP #0,TOS
 247 0<> IF
 248     PUSH IP
 249     BEGIN
 250         LO2HI
 251         $20 EMIT
 252         HI2LO
 253         SUB #2,IP
 254         SUB #1,TOS
 255     0= UNTIL
 256     MOV @RSP+,IP
 257 THEN
 258 MOV @PSP+,TOS           \ --         drop n
 259 NEXT
 260 ENDCODE
 261 [THEN]
 262
 263 [UNDEFINED] DUP [IF]    \define DUP and DUP?
 264 \ https://forth-standard.org/standard/core/DUP
 265 \ DUP      x -- x x      duplicate top of stack
 266 CODE DUP
 267 BW1 SUB #2,PSP      \ 2  push old TOS..
 268     MOV TOS,0(PSP)  \ 3  ..onto stack
 269     MOV @IP+,PC     \ 4
 270 ENDCODE
 271
 272 \ https://forth-standard.org/standard/core/qDUP
 273 \ ?DUP     x -- 0 | x x    DUP if nonzero
 274 CODE ?DUP
 275 CMP #0,TOS      \ 2  test for TOS nonzero
 276 0<> ?GOTO BW1   \ 2
 277 MOV @IP+,PC     \ 4
 278 ENDCODE
 279 [THEN]
 280
 281 [UNDEFINED] DEPTH [IF]
 282 \ https://forth-standard.org/standard/core/DEPTH
 283 \ DEPTH    -- +n        number of items on stack, must leave 0 if stack empty
 284 CODE DEPTH
 285 MOV TOS,-2(PSP)
 286 MOV #PSTACK,TOS
 287 SUB PSP,TOS     \ PSP-S0--> TOS
 288 RRA TOS         \ TOS/2   --> TOS
 289 SUB #2,PSP      \ post decrement stack...
 290 MOV @IP+,PC
 291 ENDCODE
 292 [THEN]
 293
 294 [UNDEFINED] >R [IF]
 295 \ https://forth-standard.org/standard/core/toR
 296 \ >R    x --   R: -- x   push to return stack
 297 CODE >R
 298 PUSH TOS
 299 MOV @PSP+,TOS
 300 MOV @IP+,PC
 301 ENDCODE
 302 [THEN]
 303
 304 [UNDEFINED] R> [IF]
 305 \ https://forth-standard.org/standard/core/Rfrom
 306 \ R>    -- x    R: x --   pop from return stack ; CALL #RFROM performs DOVAR
 307 CODE R>
 308 SUB #2,PSP      \ 1
 309 MOV TOS,0(PSP)  \ 3
 310 MOV @RSP+,TOS   \ 2
 311 MOV @IP+,PC     \ 4
 312 ENDCODE
 313 [THEN]
 314
 315 [UNDEFINED] >BODY [IF]
 316 \ https://forth-standard.org/standard/core/toBODY
 317 \ >BODY     -- addr      leave BODY of a CREATEd word\ also leave default ACTION-OF primary DEFERred word
 318 CODE >BODY
 319 ADD #4,TOS
 320 MOV @IP+,PC
 321 ENDCODE
 322 [THEN]
 323
 324 [UNDEFINED] EVALUATE [IF]
 325 \ https://forth-standard.org/standard/core/EVALUATE
 326 \ EVALUATE          \ i*x c-addr u -- j*x  interpret string
 327 CODE EVALUATE
 328 MOV #SOURCE_LEN,X       \ 2
 329 MOV @X+,S               \ 2 S = SOURCE_LEN
 330 MOV @X+,T               \ 2 T = SOURCE_ORG
 331 MOV @X+,W               \ 2 W = TOIN
 332 PUSHM #4,IP             \ 6 PUSHM IP,S,T,W
 333 LO2HI
 334 INTERPRET
 335 HI2LO
 336 MOV @RSP+,&TOIN         \ 4
 337 MOV @RSP+,&SOURCE_ORG   \ 4
 338 MOV @RSP+,&SOURCE_LEN   \ 4
 339 MOV @RSP+,IP
 340 MOV @IP+,PC
 341 ENDCODE
 342 [THEN]
 343
 344 [UNDEFINED] EXECUTE [IF] \ "
 345 \ https://forth-standard.org/standard/core/EXECUTE
 346 \ EXECUTE   i*x xt -- j*x   execute Forth word at 'xt'
 347 CODE EXECUTE
 348 MOV TOS,W               \ 1 put word address into W
 349 MOV @PSP+,TOS           \ 2 fetch new TOS
 350 MOV W,PC                \ 3 fetch code address into PC
 351 ENDCODE
 352 [THEN]
 353
 354 [UNDEFINED] U.R [IF]
 355 : U.R                       \ u n --           display u unsigned in n width (n >= 2)
 356   >R  <# 0 # #S #>
 357   R> OVER - 0 MAX SPACES TYPE
 358 ;
 359 [THEN]  \ U.R
 360
 361 CODE DATE?
 362     SUB     #6,PSP
 363     MOV     TOS,4(PSP)
 364     BEGIN
 365         BIT.B #RTCRDY,&RTCCTL1  \ test RTCRDY flag
 366     0<> UNTIL                   \ wait until RTCRDY high
 367     MOV     &RTCYEARL,2(PSP)    \ year
 368     MOV.B   &RTCMON,TOS
 369     MOV     TOS,0(PSP)          \ month
 370     MOV.B   &RTCDAY,TOS         \ day
 371 COLON
 372     2 U.R $2F EMIT
 373     2 U.R $2F EMIT .
 374 ;
 375
 376 : DATE!
 377 2 DEPTH U< IF
 378     HI2LO
 379     MOV     TOS,&RTCYEARL   \ year
 380     MOV.B   @PSP,&RTCMON    \ month     \ @PSP+ don't work because byte format !
 381     MOV.B   2(PSP),&RTCDAY  \ day       \ @PSP+ don't work because byte format !
 382     ADD     #4,PSP
 383     MOV     @PSP+,TOS       \
 384     LO2HI
 385 THEN
 386     ." we are on " DATE?
 387 ;
 388
 389 CODE TIME?
 390     SUB     #6,PSP
 391     MOV     TOS,4(PSP)      \ save TOS
 392     BEGIN
 393         BIT.B #RTCRDY,&RTCCTL1 \
 394     0<> UNTIL               \ wait until RTCRDY high
 395     MOV.B   &RTCSEC,TOS
 396     MOV     TOS,2(PSP)      \ seconds
 397     MOV.B   &RTCMIN,TOS
 398     MOV     TOS,0(PSP)      \ minutes
 399     MOV.B   &RTCHOUR,TOS    \ hours
 400 COLON
 401     2 U.R $3A EMIT
 402     2 U.R $3A EMIT 2 U.R
 403 ;
 404
 405 : TIME!
 406 2 DEPTH U< IF
 407     HI2LO
 408     MOV     TOS,&RTCSEC     \ seconds
 409     MOV.B   @PSP,&RTCMIN    \ minutes   \ @PSP+ don't work because byte format !
 410     MOV.B   2(PSP),&RTCHOUR \ hours     \ @PSP+ don't work because byte format !
 411     ADD     #4,PSP
 412     MOV     @PSP+,TOS       \
 413     LO2HI
 414 THEN
 415     ." it is " TIME?
 416 ;
 417
 418 PWR_HERE
 419
 420
 421 [UNDEFINED] S_ [IF]
 422 CODE S_             \           Squote alias with blank instead quote separator
 423 MOV #0,&CAPS        \           turn CAPS OFF
 424 COLON
 425 XSQUOTE ,           \           compile run-time code
 426 $20 WORD            \ -- c-addr (= HERE)
 427 HI2LO
 428 MOV.B @TOS,TOS      \ -- len    compile string
 429 ADD #1,TOS          \ -- len+1
 430 BIT #1,TOS          \           C = ~Z
 431 ADDC TOS,&DP        \           store aligned DP
 432 MOV @PSP+,TOS       \ --
 433 MOV @RSP+,IP        \           pop paired with push COLON
 434 MOV #$20,&CAPS      \           turn CAPS ON (default state)
 435 MOV @IP+,PC         \ NEXT
 436 ENDCODE IMMEDIATE
 437 [THEN]
 438
 439 [UNDEFINED] ESC [IF]
 440 CODE ESC
 441 CMP #0,&STATEADR
 442 0= IF MOV @IP+,PC   \ interpret time usage disallowed
 443 THEN
 444 COLON
 445 $1B                 \ -- char escape
 446 POSTPONE LITERAL    \ compile-time code : lit $1B
 447 POSTPONE EMIT       \ compile-time code : EMIT
 448 POSTPONE S_         \ compile-time code : S_ <escape_sequence>
 449 POSTPONE TYPE       \ compile-time code : TYPE
 450 ; IMMEDIATE
 451 [THEN]
 452
 453 : PAD_ACCEPT    \ -- org len
 454 PAD_ORG
 455 DUP PAD_LEN     \ -- org org len
 456     ['] ACCEPT DUP @
 457         $4030 =             \ if CFA content = $4030 (MOV @PC+,PC), ACCEPT is deferred
 458         IF >BODY            \ find default part address of deferred ACCEPT
 459         THEN
 460     EXECUTE     \ -- org len'
 461 ;
 462
 463 : GET_TIME
 464 PWR_STATE       \ all words after PWR_HERE marker will be lost
 465 42              \ number of terminal lines
 466 0 DO CR LOOP    \ don't erase any line of source
 467 ESC [H          \ cursor home
 468
 469 CR ." DATE (DMY): "
 470 PAD_ACCEPT
 471 EVALUATE CR DATE!
 472
 473 CR ." TIME (HMS): "
 474 PAD_ACCEPT
 475 EVALUATE CR TIME!
 476 ;
 477
 478 ECHO GET_TIME