OSDN Git Service

V3.7
[fast-forth/master.git] / MSP430-FORTH / RTC.f
1 \ -*- coding: utf-8 -*-
2 \
3 \ ==============================================================================
4 \ routines RTC for MSP430FRxxxx
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 \ MSP_EXP430FR4133  CHIPSTICK_FR2433    MSP_EXP430FR2433    MSP_EXP430FR2355
14 \ LP_MSP430FR2476
15 \
16 \ from scite editor : copy your target selection in (shift+F8) parameter 1:
17 \
18 \ or, from windows explorer:
19 \ drag and drop this file onto SendSourceFileToTarget.bat
20 \ then select your TARGET when asked.
21 \
22 \ ASSEMBLER REGISTERS USAGE
23 \ R4 to R7 must be saved before use and restored after
24 \ scratch registers Y to S are free for use
25 \ under interrupt, IP is free for use
26 \
27 \ PUSHM order : PSP,TOS, IP,  S,  T,  W,  X,  Y, rEXIT,rDOVAR,rDOCON, rDODOES, R3, SR,RSP, PC
28 \ PUSHM order : R15,R14,R13,R12,R11,R10, R9, R8,  R7  ,  R6  ,  R5  ,   R4   , R3, R2, R1, R0
29 \
30 \ example : PUSHM #6,IP pushes IP,S,T,W,X,Y registers to return stack
31 \
32 \ POPM  order :  PC,RSP, SR, R3, rDODOES,rDOCON,rDOVAR,rEXIT,  Y,  X,  W,  T,  S, IP,TOS,PSP
33 \ POPM  order :  R0, R1, R2, R3,   R4   ,  R5  ,  R6  ,  R7 , R8, R9,R10,R11,R12,R13,R14,R15
34 \
35 \ example : POPM #6,IP   pop Y,X,W,T,S,IP registers from return stack
36 \
37 \
38 \ FORTH conditionnals:  unary{ 0= 0< 0> }, binary{ = < > U< }
39 \
40 \ ASSEMBLER conditionnal usage with IF UNTIL WHILE  S<  S>=  U<   U>=  0=  0<>  0>=
41 \ ASSEMBLER conditionnal usage with ?JMP ?GOTO      S<  S>=  U<   U>=  0=  0<>  0<
42 \
43 \
44
45 CODE ABORT_RTC
46 SUB #4,PSP
47 MOV TOS,2(PSP)
48 MOV &KERNEL_ADDON,TOS
49 BIT #BIT15,TOS
50 0<> IF MOV #0,TOS THEN  \ if TOS <> 0 (FIXPOINT input), set TOS = 0  
51 MOV TOS,0(PSP)
52 MOV &VERSION,TOS
53 SUB #307,TOS            \ FastForth V3.7
54 COLON
55 $0D EMIT    \ return to column 1 without CR
56 ABORT" FastForth version = 3.7 please!"
57 ABORT" target without LF_XTAL !"
58 PWR_STATE           \ if no abort remove this word
59 ;
60
61 ABORT_RTC
62
63 ; --------------------
64 ; RTC.f
65 ; --------------------
66
67 \ use :
68 \ to set date, type : d m y DATE!
69 \ to view date, type DATE?
70 \ to set time, type : h m s TIME!, or h m TIME!
71 \ to view time, type TIME?
72 \
73 [DEFINED] {RTC} [IF] {RTC} [THEN] 
74
75 MARKER {RTC}    \ restore the state before MARKER definition
76 \      {RTC}+8 = BODY+4 = RET_ADR: MARKER_DOES does a call to RET_ADR by default
77 8 ALLOT \ make room for:
78 \      {RTC}+10 for content of previous RTC_VEC
79 \      {RTC}+12 for content of previous COLD_PFA
80 \      {RTC}+14 for content of previous WARM_PFA
81 \      {RTC}+16 for content of previous SLEEP_PFA
82
83
84 [UNDEFINED] OR [IF]
85 \ https://forth-standard.org/standard/core/OR
86 \ C OR     x1 x2 -- x3           logical OR
87 CODE OR
88 BIS @PSP+,TOS
89 MOV @IP+,PC
90 ENDCODE
91 [THEN]
92
93 [UNDEFINED] C@ [IF]
94 \ https://forth-standard.org/standard/core/CFetch
95 \ C@     c-addr -- char   fetch char from memory
96 CODE C@
97 MOV.B @TOS,TOS
98 MOV @IP+,PC
99 ENDCODE
100 [THEN]
101
102 [UNDEFINED] C! [IF]
103 \ https://forth-standard.org/standard/core/CStore
104 \ C!      char c-addr --    store char in memory
105 CODE C!
106 MOV.B @PSP+,0(TOS)  \ 4
107 ADD #1,PSP          \ 1
108 MOV @PSP+,TOS       \ 2
109 MOV @IP+,PC
110 ENDCODE
111 [THEN]
112
113 [UNDEFINED] SWAP [IF]
114 \ https://forth-standard.org/standard/core/SWAP
115 \ SWAP     x1 x2 -- x2 x1    swap top two items
116 CODE SWAP
117 MOV @PSP,W      \ 2
118 MOV TOS,0(PSP)  \ 3
119 MOV W,TOS       \ 1
120 MOV @IP+,PC     \ 4
121 ENDCODE
122 [THEN]
123
124 [UNDEFINED] OVER [IF]
125 \ https://forth-standard.org/standard/core/OVER
126 \ OVER    x1 x2 -- x1 x2 x1
127 CODE OVER
128 MOV TOS,-2(PSP)     \ 3 -- x1 (x2) x2
129 MOV @PSP,TOS        \ 2 -- x1 (x2) x1
130 SUB #2,PSP          \ 1 -- x1 x2 x1
131 MOV @IP+,PC
132 ENDCODE
133 [THEN]
134
135 [UNDEFINED] DUP [IF]    \define DUP and DUP?
136 \ https://forth-standard.org/standard/core/DUP
137 \ DUP      x -- x x      duplicate top of stack
138 CODE DUP
139 BW1 SUB #2,PSP      \ 2  push old TOS..
140     MOV TOS,0(PSP)  \ 3  ..onto stack
141     MOV @IP+,PC     \ 4
142 ENDCODE
143
144 \ https://forth-standard.org/standard/core/qDUP
145 \ ?DUP     x -- 0 | x x    DUP if nonzero
146 CODE ?DUP
147 CMP #0,TOS      \ 2  test for TOS nonzero
148 0<> ?GOTO BW1   \ 2
149 MOV @IP+,PC     \ 4
150 ENDCODE
151 [THEN]
152
153 [UNDEFINED] DROP [IF]
154 \ https://forth-standard.org/standard/core/DROP
155 \ DROP     x --          drop top of stack
156 CODE DROP
157 MOV @PSP+,TOS   \ 2
158 MOV @IP+,PC     \ 4
159 ENDCODE
160 [THEN]
161
162 [UNDEFINED] DEPTH [IF]
163 \ https://forth-standard.org/standard/core/DEPTH
164 \ DEPTH    -- +n        number of items on stack, must leave 0 if stack empty
165 CODE DEPTH
166 MOV TOS,-2(PSP)
167 MOV #PSTACK,TOS
168 SUB PSP,TOS     \ PSP-S0--> TOS
169 RRA TOS         \ TOS/2   --> TOS
170 SUB #2,PSP      \ post decrement stack...
171 MOV @IP+,PC
172 ENDCODE
173 [THEN]
174
175 [UNDEFINED] >R [IF]
176 \ https://forth-standard.org/standard/core/toR
177 \ >R    x --   R: -- x   push to return stack
178 CODE >R
179 PUSH TOS        \ 3
180 MOV @PSP+,TOS   \ 2
181 MOV @IP+,PC     \ 4
182 ENDCODE
183 [THEN]
184
185 [UNDEFINED] R> [IF]
186 \ https://forth-standard.org/standard/core/Rfrom
187 \ R>    -- x    R: x --   pop from return stack ; CALL #RFROM performs DOVAR
188 CODE R>
189 SUB #2,PSP      \ 1
190 MOV TOS,0(PSP)  \ 3
191 MOV @RSP+,TOS   \ 2
192 MOV @IP+,PC     \ 4
193 ENDCODE
194 [THEN]
195
196 [UNDEFINED] 1+ [IF]
197 \ https://forth-standard.org/standard/core/OnePlus
198 \ 1+      n1/u1 -- n2/u2       add 1 to TOS
199 CODE 1+
200 ADD #1,TOS
201 MOV @IP+,PC
202 ENDCODE
203 [THEN]
204
205 [UNDEFINED] U< [IF]
206 CODE U<
207 SUB @PSP+,TOS   \ 2 u2-u1
208 0<> IF
209     MOV #-1,TOS     \ 1
210     U< IF           \ 2 flag 
211         AND #0,TOS  \ 1 flag Z = 1
212     THEN
213 THEN
214 MOV @IP+,PC     \ 4
215 ENDCODE
216 [THEN]
217
218 [UNDEFINED] = [IF]
219 \ https://forth-standard.org/standard/core/Equal
220 \ =      x1 x2 -- flag         test x1=x2
221 CODE =
222 SUB @PSP+,TOS   \ 2
223 0<> IF          \ 2
224     AND #0,TOS  \ 1
225     MOV @IP+,PC \ 4
226 THEN
227 XOR #-1,TOS     \ 1 flag Z = 1
228 MOV @IP+,PC     \ 4
229 ENDCODE
230 [THEN]
231
232 [UNDEFINED] IF [IF]     \ define IF THEN
233 \ https://forth-standard.org/standard/core/IF
234 \ IF       -- IFadr    initialize conditional forward branch
235 CODE IF       \ immediate
236 SUB #2,PSP              \
237 MOV TOS,0(PSP)          \
238 MOV &DP,TOS             \ -- HERE
239 ADD #4,&DP            \           compile one word, reserve one word
240 MOV #QFBRAN,0(TOS)      \ -- HERE   compile QFBRAN
241 ADD #2,TOS              \ -- HERE+2=IFadr
242 MOV @IP+,PC
243 ENDCODE IMMEDIATE
244
245 \ https://forth-standard.org/standard/core/THEN
246 \ THEN     IFadr --                resolve forward branch
247 CODE THEN               \ immediate
248 MOV &DP,0(TOS)          \ -- IFadr
249 MOV @PSP+,TOS           \ --
250 MOV @IP+,PC
251 ENDCODE IMMEDIATE
252 [THEN]
253
254 [UNDEFINED] ELSE [IF]
255 \ https://forth-standard.org/standard/core/ELSE
256 \ ELSE     IFadr -- ELSEadr        resolve forward IF branch, leave ELSEadr on stack
257 CODE ELSE     \ immediate
258 ADD #4,&DP              \ make room to compile two words
259 MOV &DP,W               \ W=HERE+4
260 MOV #BRAN,-4(W)
261 MOV W,0(TOS)            \ HERE+4 ==> [IFadr]
262 SUB #2,W                \ HERE+2
263 MOV W,TOS               \ -- ELSEadr
264 MOV @IP+,PC
265 ENDCODE IMMEDIATE
266 [THEN]
267
268 [UNDEFINED] DO [IF]     \ define DO LOOP +LOOP
269 \ https://forth-standard.org/standard/core/DO
270 \ DO       -- DOadr   L: -- 0
271 CODE DO                 \ immediate
272 SUB #2,PSP              \
273 MOV TOS,0(PSP)          \
274 ADD #2,&DP              \   make room to compile xdo
275 MOV &DP,TOS             \ -- HERE+2
276 MOV #XDO,-2(TOS)        \   compile xdo
277 ADD #2,&LEAVEPTR        \ -- HERE+2     LEAVEPTR+2
278 MOV &LEAVEPTR,W         \
279 MOV #0,0(W)             \ -- HERE+2     L-- 0
280 MOV @IP+,PC
281 ENDCODE IMMEDIATE
282
283 \ https://forth-standard.org/standard/core/LOOP
284 \ LOOP    DOadr --         L-- an an-1 .. a1 0
285 CODE LOOP               \ immediate
286     MOV #XLOOP,X
287 BW1 ADD #4,&DP          \ make room to compile two words
288     MOV &DP,W
289     MOV X,-4(W)         \ xloop --> HERE
290     MOV TOS,-2(W)       \ DOadr --> HERE+2
291 BEGIN                   \ resolve all "leave" adr
292     MOV &LEAVEPTR,TOS   \ -- Adr of top LeaveStack cell
293     SUB #2,&LEAVEPTR    \ --
294     MOV @TOS,TOS        \ -- first LeaveStack value
295     CMP #0,TOS          \ -- = value left by DO ?
296 0<> WHILE
297     MOV W,0(TOS)        \ move adr after loop as UNLOOP adr
298 REPEAT
299     MOV @PSP+,TOS
300     MOV @IP+,PC
301 ENDCODE IMMEDIATE
302
303 \ https://forth-standard.org/standard/core/PlusLOOP
304 \ +LOOP   adrs --   L-- an an-1 .. a1 0
305 CODE +LOOP
306 MOV #XPLOOP,X
307 GOTO BW1        \ goto BW1 LOOP
308 ENDCODE IMMEDIATE
309 [THEN]
310
311 [UNDEFINED] CASE [IF]
312 \ https://forth-standard.org/standard/core/CASE
313 : CASE 0 ; IMMEDIATE \ -- #of-1 
314
315 \ https://forth-standard.org/standard/core/OF
316 : OF \ #of-1 -- orgOF #of 
317 1+                          \ count OFs 
318 >R                          \ move off the stack in case the control-flow stack is the data stack. 
319 POSTPONE OVER POSTPONE = \ copy and test case value
320 POSTPONE IF                 \ add orig to control flow stack 
321 POSTPONE DROP           \ discards case value if = 
322 R>                          \ we can bring count back now 
323 ; IMMEDIATE 
324
325 \ https://forth-standard.org/standard/core/ENDOF
326 : ENDOF \ orgOF #of -- orgENDOF #of 
327 >R                          \ move off the stack in case the control-flow stack is the data stack. 
328 POSTPONE ELSE 
329 R>                          \ we can bring count back now 
330 ; IMMEDIATE 
331
332 \ https://forth-standard.org/standard/core/ENDCASE
333 : ENDCASE \ orgENDOF1..orgENDOFn #of -- 
334 POSTPONE DROP
335 0 DO 
336     POSTPONE THEN 
337 LOOP 
338 ; IMMEDIATE 
339 [THEN]
340
341 [UNDEFINED] + [IF]
342 \ https://forth-standard.org/standard/core/Plus
343 \ +       n1/u1 n2/u2 -- n3/u3
344 CODE +
345 ADD @PSP+,TOS
346 MOV @IP+,PC
347 ENDCODE
348 [THEN]
349
350 [UNDEFINED] - [IF]
351 \ https://forth-standard.org/standard/core/Minus
352 \ -      n1/u1 n2/u2 -- n3/u3     n3 = n1-n2
353 CODE -
354 SUB @PSP+,TOS   \ 2  -- n2-n1 ( = -n3)
355 XOR #-1,TOS     \ 1
356 ADD #1,TOS      \ 1  -- n3 = -(n2-n1) = n1-n2
357 MOV @IP+,PC
358 ENDCODE
359 [THEN]
360
361 [UNDEFINED] MAX [IF]    \define MAX and MIN
362
363 CODE MAX    \    n1 n2 -- n3       signed maximum
364     CMP @PSP,TOS    \ n2-n1
365     S<  ?GOTO FW1   \ n2<n1
366 BW1 ADD #2,PSP
367     MOV @IP+,PC
368 ENDCODE
369
370 CODE MIN    \    n1 n2 -- n3       signed minimum
371     CMP @PSP,TOS     \ n2-n1
372     S<  ?GOTO BW1    \ n2<n1
373 FW1 MOV @PSP+,TOS
374     MOV @IP+,PC
375 ENDCODE
376
377 [THEN]  \ MAX
378
379 [UNDEFINED] 2* [IF]
380 \ https://forth-standard.org/standard/core/TwoTimes
381 \ 2*      x1 -- x2         arithmetic left shift
382 CODE 2*
383 ADD TOS,TOS
384 MOV @IP+,PC
385 ENDCODE
386 [THEN]
387
388 [UNDEFINED] UM* [IF]    
389 \ https://forth-standard.org/standard/core/UMTimes
390 \ UM*     u1 u2 -- ud   unsigned 16x16->32 mult.
391 CODE UM*
392     MOV @PSP,&MPY       \ Load 1st operand for unsigned multiplication
393     MOV TOS,&OP2        \ Load 2nd operand
394     MOV &RES0,0(PSP)    \ low result on stack
395     MOV &RES1,TOS       \ high result in TOS
396     MOV @IP+,PC
397 ENDCODE
398 [THEN] 
399
400 [UNDEFINED] UM/MOD [IF]
401 \ https://forth-standard.org/standard/core/UMDivMOD
402 \ UM/MOD   udlo|udhi u1 -- ur uq   unsigned 32/16->r16 q16
403 CODE UM/MOD
404     PUSH #DROP      \
405     MOV #MUSMOD,PC  \ execute MUSMOD then return to DROP
406 ENDCODE
407 [THEN]
408
409 [UNDEFINED] U*/ [IF]
410 \ U*/     u1 u2 u3 -- uq        u1*u2/u3
411 : U*/
412 >R UM* R> UM/MOD SWAP DROP
413 ;
414 [THEN]
415
416 [UNDEFINED] U/MOD [IF]
417 \ U/MOD   u1 u2 -- ur uq     unsigned division
418 : U/MOD
419 0 SWAP UM/MOD
420 ;
421 [THEN]
422
423 [UNDEFINED] U/ [IF]
424 \ https://forth-standard.org/standard/core/Div
425 \ U/      u1 u2 -- uq       signed quotient
426 : U/
427 U/MOD SWAP DROP
428 ;
429 [THEN]
430
431 [UNDEFINED] SPACES [IF]
432 \ https://forth-standard.org/standard/core/SPACES
433 \ SPACES   n --            output n spaces
434 CODE SPACES
435 CMP #0,TOS
436 0<> IF
437     PUSH IP
438     BEGIN
439         LO2HI
440         $20 EMIT
441         HI2LO
442         SUB #2,IP 
443         SUB #1,TOS
444     0= UNTIL
445     MOV @RSP+,IP
446 THEN
447 MOV @PSP+,TOS           \ --         drop n
448 NEXT              
449 ENDCODE
450 [THEN]
451
452 [UNDEFINED] HERE [IF]
453 CODE HERE
454 MOV #HEREXEC,PC
455 ENDCODE
456 [THEN]
457
458 [UNDEFINED] U.R [IF]
459 : U.R                       \ u n --           display u unsigned in n width (n >= 2)
460   >R  <# 0 # #S #>  
461   R> OVER - 0 MAX SPACES TYPE
462 ;
463 [THEN]  \ U.R
464
465 $81EF DEVICEID @ U<     ; search device ID: MSP430FR4133 or...
466 DEVICEID @ $8241 U<     ; ...MSP430FR2433
467 =   
468 $830B DEVICEID @ U<     ; MSP430FR21xx/23xx/24xx/25xx/26xx
469 OR                      ; -- flag
470
471 [IF] 
472
473 \ ==============================================================================
474 \ driver for RTC without calendar
475 \ ==============================================================================
476
477     CREATE RTCSEC 2 ALLOT
478     CREATE RTCMIN 2 ALLOT
479     CREATE RTCHOUR 2 ALLOT
480     CREATE RTCDOW 2 ALLOT
481     CREATE RTCDAY 2 ALLOT
482     CREATE RTCMON 2 ALLOT
483     CREATE RTCYEAR 2 ALLOT
484
485 \   ************************************\
486     CODE RTC_INT                        \ computes sec min hour day month year
487 \   ************************************\
488     ADD #2,RSP                          \ remove previous_SR
489     BIT #1,&RTCIV                       \ clear RTC_IFG
490     ADD.B #1,&RTCSEC                    \ sec+1
491     CMP.B #60,&RTCSEC
492     U>= IF               
493         MOV.B #0,&RTCSEC                \ sec=0
494         ADD.B #1,&RTCMIN                \ min+1
495         CMP.B #60,&RTCMIN
496         U>= IF               
497             MOV.B #0,&RTCMIN            \ min=0
498             ADD.B #1,&RTCHOUR           \ hour+1
499             CMP.B #24,&RTCHOUR
500             U>= IF                
501                 MOV.B #0,&RTCHOUR       \ hour=0
502                 ADD.B #1,&RTCDOW        \ dow+1
503                 CMP.B #7,&RTCDOW
504                 U>= IF
505                     MOV.B #0,&RTCDOW    \ dow=0
506                 THEN
507                 ADD.B #1,&RTCDAY        \ day+1
508                 CMP.B #2,&RTCMON        \ February month ?
509 \               ------------------------\ here we compute leap year
510                 0= IF                   \ yes
511                     COLON
512                     RTCYEAR @ 4 MOD 
513                     IF 29
514                     ELSE
515                         RTCYEAR @ 100 MOD 
516                         IF 30
517                         ELSE
518                             RTCYEAR @ 400 MOD
519                             IF 29
520                             ELSE 30
521                             THEN
522                         THEN
523                     THEN
524                     HI2LO
525                     MOV @RSP+,IP
526                     MOV TOS,X           \ X = 29|30
527                     MOV @PSP+,TOS
528 \               ------------------------\
529                 ELSE                    \ month other than Feb
530                     MOV #31,X
531                     MOV.B &RTCMON,W
532                     CMP.B #8,W
533                     0>= IF              \ month >= August?
534                         ADD.B #1,W      
535                     THEN
536                     BIT.B #1,W          \
537                     0<> IF      
538                         ADD #1,X        \ 31 days / month
539                     THEN
540                 THEN
541                 CMP.B X,&RTCDAY
542                 U>= IF                  \ max day of month is exceeded
543                     MOV.B #1,&RTCDAY    \ day=1
544                     ADD.B #1,&RTCMON    \ mon+1
545                     CMP.B #13,&RTCMON
546                     U>= IF
547                     MOV.B #1,&RTCMON    \ mon=1
548                         ADD #1,&RTCYEAR \ year+1
549                     THEN
550                 THEN
551             THEN
552         THEN
553     THEN                \
554     MOV @RSP+,PC        \ RET to BACKGrouND routine, with GIE disabled
555     ENDCODE    
556
557 \   ------------------------\
558     ASM STOP_RTC            \ define STOP_RTC as new COLD_APP subroutine, called by {RTC}|WIPE|RST|COLD|SYS_failures.
559 \   ------------------------\ ------------------------------------------
560     CMP #RET_ADR,&{RTC}+8   \ 
561     0<> IF                  \ and only if RTC_APP is started by START_RTC
562     MOV #{RTC}+10,X         \
563         MOV #RET_ADR,-2(X)  \ restore {RTC}+8 default value
564         MOV @X+,&RTC_VEC    \ restore previous RTC_VEC content from {RTC}+10 
565         MOV @X+,&COLD+2     \ restore previous STOP_APP from {RTC}+12 to COLD_PFA
566         MOV @X+,&WARM+2     \ restore previous INI_APP from {RTC}+14 to WARM_PFA
567 \        MOV @X+,&SLEEP+2    \ restore previous BACKGND_APP from {RTC}+16 to SLEEP_PFA
568     THEN
569 \   ------------------------\
570     MOV #0,&RTCCTL          \ stops RTC and RTC_INT, see RTC15 in MSP430FR2xxx errata sheet
571     MOV.B #XIN,X            \ X = bit_position of XT1 Xtal
572     BIC.B X,&XT1_SEL        \ XIN as GPIO
573     BIS.B X,&XT1_DIR        \ XIN as output
574     BIC.B X,&XT1_OUT        \ RTC15 :"toggle twice XIN ouput"
575     BIS.B X,&XT1_OUT        \ "with at least 2 rising or falling edges". 
576     BIC.B X,&XT1_OUT        \
577     BIS.B X,&XT1_OUT        \ 
578     BIC.B X,&XT1_DIR        \ restore default state of XIN
579     BIS.B X,&XT1_SEL        \ XIN as XT1 input
580 \   ------------------------\
581     MOV &COLD+2,PC          \ 5 link (branch) to the previous STOP_APP subroutine,
582 \   ------------------------\ then RET to MARKER_DOES  or to COLD+4
583     ENDASM                  \
584 \   ------------------------\
585
586 \   ----------------------------------------\ 
587     ASM INI_RTC                             \ define INI_HDWR_APP called first by START_RTC then by WARM
588 \   ----------------------------------------\ ---------------------------------------------------------
589     CALL &{RTC}+14                          \ call previous INI_APP (which sets TOS = RSTIV_MEM)
590     CMP #0,&RTCCTL                          \ if RTCCTL = 0 = reset state, app is STOPPED and must to be started
591     0= IF                                   \ and if RTCCTL <> 0, we don't restart app and no time is lost.
592         MOV #$7F,&RTCMOD                    \ RTCMOD = 127
593         BIT #-1,&RTCIV                      \ clear RTC_IFG
594         MOV #%0010_0110_0100_0010,&RTCCTL   \ starts RTC with XT1CLK/256, enables RTC_INT
595     THEN
596     MOV @RSP+,PC                            \ RET to BODYWARM|START_RTC
597     ENDASM                                  \
598 \   ----------------------------------------\
599
600 \\  -------------------------------------------------------------------------------
601 \\  WARNING! because RTC_INT have higher priority than eUSCI used for TERMINAL, 
602 \\  BACKGND_APP default subroutine execute pending RTC_INT, so you can download a file without RTC time lost.
603 \\  but if you manualy type a command, pending RTC_INT may not be executed during this time.
604 \\  -------------------------------------------------------------------------------
605 \\   --------------------\
606 \\   ASM BACKGND_RTC     \ define BACKGND_RTC to replace actual BACKGND_APP
607 \\   --------------------\
608 \    BEGIN               \
609 \       MOV &LPM_MODE,SR \ enter to SLEEP mode, waiting RTC_INT
610 \    AGAIN               \ loop back to BEGIN is executed before CPU shut down
611 \\   --------------------\
612 \    ENDASM              \
613 \\   -------------------------------------------------------------------------------
614 \\   WARNING! because unlinked, this BACKGND_APP doesn't execute XON, TERMINAL is MUTEd
615 \\   but maybe that is what you want: RTC time keeps its accuracy.
616 \\   -------------------------------------------------------------------------------
617
618 \   --------------------------------\
619     CODE START_RTC                  \ save current content of WARM_PFA, COLD_PFA, SLEEP_PFA, RTC_VEC
620 \   --------------------------------\ then replace them by INI_RTC, STOP_RTC, BACKGND_RTC, RTC_INT then execute INI_RTC.
621     CMP #STOP_RTC,&{RTC}+8          \ content of {RTC}+8 = STOP_RTC ?
622     0<> IF                          \ if not
623         MOV #STOP_RTC,&{RTC}+8      \ STOP_RTC must be executed by MARKER_DOES of {RTC}, else RTC15 hangs out!
624         MOV &RTC_VEC,&{RTC}+10      \ save content of RTC_VEC to {RTC}+10...
625         MOV #RTC_INT,&RTC_VEC       \ then set RTC_VEC with RTC_INT
626         MOV &COLD+2,&{RTC}+12       \ save content of COLD_PFA to {RTC}+12...
627         MOV #STOP_RTC,&COLD+2       \ ...and replace it by STOP_RTC, else RTC15 hangs out with Deep_RST!
628         MOV &WARM+2,&{RTC}+14       \ save content of WARM_PFA to {RTC}+14...
629         MOV #INI_RTC,&WARM+2        \ ...and replace it by INI_RTC
630 \        MOV &SLEEP+2,&{RTC}+16      \ save content of SLEEP_PFA to {RTC}+16...
631 \        MOV #BACKGND_RTC,&SLEEP+2   \ ...and replace it by BACKGND_RTC
632     THEN                            \
633     CALL #INI_RTC                   \
634     MOV @IP+,PC                     \
635 \   --------------------------------\
636     ENDCODE                 
637 \   --------------------------------\
638
639     : TIME?                 \ display time
640     RTCHOUR C@ 2 U.R $3A EMIT
641     RTCMIN C@  2 U.R $3A EMIT
642     RTCSEC C@  2 U.R 
643     ;
644     
645     : TIME!                 \ hour min sec ---
646     START_RTC               \ if not yet done, obviously!
647     2 DEPTH
648     U< IF                   \ if 3 numbers on stack
649         RTCSEC C!
650         RTCMIN C!
651         RTCHOUR C!
652     THEN
653     ." it is " TIME? 
654     ;
655
656     : DATE?                     \ display date
657
658 [ELSE]
659
660 \ ==============================================================================
661 \ driver RTC for RTC_B|RTC_C hardware with calendar
662 \ ==============================================================================
663
664     CODE TIME?
665     BEGIN
666         BIT.B #RTCRDY,&RTCCTL1
667     0<> UNTIL                   \ wait until RTCRDY high
668     COLON
669     RTCHOUR C@ 2 U.R $3A EMIT
670     RTCMIN C@  2 U.R $3A EMIT
671     RTCSEC C@  2 U.R 
672     ;
673     
674     : TIME!
675     2 DEPTH
676     U< IF                   \ if 3 numbers on stack
677         RTCSEC C!
678         RTCMIN C!
679         RTCHOUR C!
680     THEN
681     ." it is " TIME? 
682     ;
683
684     CODE DATE?                  \ display date
685     BEGIN
686         BIT.B #RTCRDY,&RTCCTL1
687     0<> UNTIL                   \ wait until windows time RTC_ReaDY is high
688     COLON
689
690 [THEN]
691
692 \ ==============================================================================
693 \ end of RTC software|harware calendar
694 \ ==============================================================================
695 \ resume with common part of DATE? definition:
696
697     RTCDOW C@                   \ -- weekday    {0=Sat...6=Fri}
698     CASE
699     0 OF ." Sat"    ENDOF
700     1 OF ." Sun"    ENDOF
701     2 OF ." Mon"    ENDOF
702     3 OF ." Tue"    ENDOF
703     4 OF ." Wed"    ENDOF
704     5 OF ." Thu"    ENDOF
705     6 OF ." Fri"    ENDOF
706     ENDCASE  
707     RTCYEAR @
708     RTCMON C@
709     RTCDAY C@                   \ -- year mon day
710     $20 EMIT
711     2 U.R $2F EMIT              \ -- year mon
712     2 U.R $2F EMIT              \ -- year
713     .                           \ --
714 ;
715
716
717
718 : DATE!                         \ year mon day --
719 2 DEPTH
720 U< IF                   \ if 3 numbers on stack
721     RTCYEAR !
722     RTCMON C!
723     RTCDAY C!
724 THEN
725 RTCDAY C@
726 RTCMON C@
727 RTCYEAR @               \ -- day mon year
728 \ ------------------------------------------
729 \ Zeller's congruence for gregorian calendar
730 \ see https://www.rosettacode.org/wiki/Day_of_the_week#Forth
731 \ : ZELLER \ day mon year -- weekday          {0=Sat, ..., 6=Fri}
732 \ OVER 3 <                \             
733 \ IF 1- SWAP 12 + SWAP 
734 \ THEN                    \ -- d m' y'  with m' {3=March, ..., 14=february}
735 \ 100 /MOD                \ -- d m' K J   with K = y' in century, J = century
736 \ DUP 4 / SWAP 2* -       \ -- d m' K (J/4 - 2J) 
737 \ SWAP DUP 4 / + +        \ -- d m' ((J/4 - 2J) + (K + K/4)) 
738 \ SWAP 1+  13 5 */ + +    \ -- (d + (((J/4 - 2J) + (K + K/4)) + (m+1)*13/5))
739 \ 7 MOD                   \ -- weekday        = {0=Sat, ..., 6=Fri} 
740 \ ------------------------------------------
741 OVER 3 U<               \             
742 IF 1- SWAP 12 + SWAP 
743 THEN                    \ -- d m' y'  with m' {3=March, ..., 14=february}
744 100 U/MOD               \ -- d m' K J   with K = y' in century, J = century
745 DUP 4 U/ SWAP 2* -      \ -- d m' K (J/4 - 2J) 
746 SWAP DUP 4 U/ + +       \ -- d m' ((J/4 - 2J) + (K + K/4)) 
747 SWAP 1+  13 5 U*/ + +   \ -- (d + (((J/4 - 2J) + (K + K/4)) + (m+1)*13/5))
748 7 U/MOD DROP            \ -- weekday        = {0=Sat, ..., 6=Fri} 
749 \ ------------------------------------------
750 RTCDOW C!               \ --
751 ." we are on " DATE? 
752 ;
753
754 RST_HERE
755
756 [UNDEFINED] S_ [IF]
757 CODE S_             \           Squote alias with blank instead quote separator
758 MOV #0,&CAPS        \           turn CAPS OFF
759 COLON
760 XSQUOTE ,           \           compile run-time code
761 $20 WORD            \ -- c-addr (= HERE)
762 HI2LO
763 MOV.B @TOS,TOS      \ -- len    compile string
764 ADD #1,TOS          \ -- len+1
765 BIT #1,TOS          \           C = ~Z
766 ADDC TOS,&DP        \           store aligned DP
767 MOV @PSP+,TOS       \ --
768 MOV @RSP+,IP        \           pop paired with push COLON
769 MOV #$20,&CAPS      \           turn CAPS ON (default state)
770 MOV @IP+,PC         \ NEXT
771 ENDCODE IMMEDIATE
772 [THEN]
773
774 [UNDEFINED] ESC [IF]
775 CODE ESC
776 CMP #0,&STATEADR
777 0= IF MOV @IP+,PC   \ interpret time usage disallowed
778 THEN
779 COLON          
780 $1B                 \ -- char escape
781 POSTPONE LITERAL    \ compile-time code : lit $1B  
782 POSTPONE EMIT       \ compile-time code : EMIT
783 POSTPONE S_         \ compile-time code : S_ <escape_sequence>
784 POSTPONE TYPE       \ compile-time code : TYPE
785 ; IMMEDIATE
786 [THEN]
787
788 [UNDEFINED] >BODY [IF]
789 \ https://forth-standard.org/standard/core/toBODY
790 \ >BODY     -- addr      leave BODY of a CREATEd word\ also leave default ACTION-OF primary DEFERred word
791 CODE >BODY
792 ADD #4,TOS
793 MOV @IP+,PC
794 ENDCODE
795 [THEN]
796
797 [UNDEFINED] EXECUTE [IF] \ "
798 \ https://forth-standard.org/standard/core/EXECUTE
799 \ EXECUTE   i*x xt -- j*x   execute Forth word at 'xt'
800 CODE EXECUTE
801 PUSH TOS                \ 3 push xt
802 MOV @PSP+,TOS           \ 2 
803 MOV @RSP+,PC            \ 4 xt --> PC
804 ENDCODE
805 [THEN]
806
807 [UNDEFINED] EVALUATE [IF]
808 \ https://forth-standard.org/standard/core/EVALUATE
809 \ EVALUATE          \ i*x c-addr u -- j*x  interpret string
810 CODE EVALUATE
811 MOV #SOURCE_LEN,X       \ 2
812 MOV @X+,S               \ 2 S = SOURCE_LEN
813 MOV @X+,T               \ 2 T = SOURCE_ORG
814 MOV @X+,W               \ 2 W = TOIN
815 PUSHM #4,IP             \ 6 PUSHM IP,S,T,W
816 LO2HI
817 INTERPRET
818 HI2LO
819 MOV @RSP+,&TOIN         \ 4
820 MOV @RSP+,&SOURCE_ORG   \ 4
821 MOV @RSP+,&SOURCE_LEN   \ 4
822 MOV @RSP+,IP 
823 MOV @IP+,PC
824 ENDCODE
825 [THEN]
826
827 : SET_TIME
828 ESC [8;42;96t       \ set terminal display 42L * 96C
829 42 0 DO CR LOOP     \ to avoid erasing any line of source, create 42 empty lines
830 ESC [H              \ then set cursor home
831 CR ." DATE (DMY): "
832 PAD_ORG DUP PAD_LEN
833 ['] ACCEPT >BODY    \ find default part of deferred ACCEPT (from terminal input)
834 EXECUTE             \ wait human input for D M Y
835 EVALUATE            \ interpret this input
836 CR DATE!            \ set date
837 CR ." TIME (HMS): "
838 PAD_ORG DUP PAD_LEN
839 ['] ACCEPT >BODY    \ find default part of deferred ACCEPT (from terminal input)
840 EXECUTE             \ wait human input for H M S
841 EVALUATE            \ interpret this input
842 CR TIME!            \ set time
843 RST_STATE           \ remove code beyond RST_HERE
844 ;
845  
846 ECHO
847 SET_TIME