Add timer and systick functionality

generic/CoreForth.s

@@ -1664,6 +1664,7 @@ print_xt_suffix:
 @ ---------------------------------------------------------------------
 @ -- Main task user variables -----------------------------------------
 
+    defvar "TASK0WAKE-AT", TASKZWAKE_AT
     defvar "TASK0UTOS", TASKZUTOS
     defvar "TASK0STATUS", TASKZSTATUS
     defvar "TASK0", TASKZ, 0

generic/Makefile

@@ -1,4 +1,4 @@
-GEN = ../generic/ansi.gen.s \
+GEN = ../generic/ansi.gen.s ../generic/systick.gen.s \
       ../generic/editor.gen.s ../generic/protothreads.gen.s \
       ../generic/find.gen.s ../generic/strings.gen.s ../generic/multitasking.gen.s \
       ../generic/blocks.gen.s ../generic/quit.gen.s

generic/multitasking.ft

@@ -2,78 +2,97 @@ HEX
 
 0      DUP   USER FOLLOWER      \ points to the follower's STATUS variable
 CELL - DUP   USER STATUS        \ PASS or WAKE - this needs to be one cell before FOLLOWER!
-CELL -       USER TOS           \ task's top of stack when switching
+CELL - DUP   USER TOS           \ task's top of stack when switching
+CELL - DUP   USER WAKE-AT       \ ticks when to wake the task regardless
+NEGATE CONSTANT USER#           \ save amount of allocated user variable space
+
+: TIMEOUT!   TICKS @ + WAKE-AT ! ;
+: TIMEOUT@   TICKS @ WAKE-AT @ - ;
+: TIMEOUT?   TIMEOUT@ 0>  DUP IF 0 WAKE-AT ! THEN ;
+
+VARIABLE LAST-AWAKE
 
 : PAUSE             \ suspend task at current execution point and switch to follower
     RP@             \ push current rp
     SP@ TOS !       \ save sp to task's TOS
     FOLLOWER @ >R   \ get follower's status and jump there
 ;
 
-: 'S   FOLLOWER - + ;
+: 'U   FOLLOWER - + ;
 
 : (WAKE)
     R> UP 2DUP !        \ take [rp] pointing to FOLLOWER and convert to TID
+    OVER LAST-AWAKE !   \ update last awake
     TOS @ SP!           \ restore sp for this task
     RP!                 \ rp was on the stack, restore it as well
 ;
 
 ' (WAKE) CONSTANT WAKE
 
+: AWAKE   ( tid -- ) DUP LAST-AWAKE !   WAKE SWAP STATUS 'U ! ;
+
 : (PASS)
-    R> @ >R         \ take [rp] pointing to FOLLOWER and jump there
+    R>
+    DUP WAKE-AT 'U @ ?DUP IF
+        TICKS @ < IF
+            DUP AWAKE
+        THEN
+    THEN
+    DUP LAST-AWAKE @ = IF WFI THEN   \ sleep the system if no task is awake
+    @ >R                \ take [rp] pointing to FOLLOWER and jump there
 ;
 
 ' (PASS) CONSTANT PASS
 
 : STOP   PASS STATUS ! PAUSE ;
-: SLEEP   ( tid -- ) PASS SWAP STATUS 'S ! ;
-: AWAKE   ( tid -- ) WAKE SWAP STATUS 'S ! ;
+: SLEEP   ( tid -- ) PASS SWAP STATUS 'U ! ;
 
 : ACTIVATE   ( s: tid -- ) ( r: n' -- )
-     DUP S0 'S @ CELL - ( tid sp )      \ get sp and decrement before push
-     OVER R0 'S @       ( tid sp rp )
+     DUP S0 'U @ CELL - ( tid sp )      \ get sp and decrement before push
+     OVER R0 'U @       ( tid sp rp )
      R> OVER !          ( tid sp rp )   \ save next word to rp
      OVER !             ( tid sp )      \ save rp to sp
-     OVER TOS 'S !      ( tid )         \ save sp in tos
+     OVER TOS 'U !      ( tid )         \ save sp in tos
      AWAKE              ( -- )
 ;
 
 : ALSOTASK   ( tid -- )             \ link new task after current task
      DUP SLEEP                      \ sleep new task
-     FOLLOWER @ OVER FOLLOWER 'S !  \ set new task's follower to this task's follower
-     STATUS 'S FOLLOWER !           \ set this task's follower to the new task's status
+     FOLLOWER @ OVER FOLLOWER 'U !  \ set new task's follower to this task's follower
+     STATUS 'U FOLLOWER !           \ set this task's follower to the new task's status
 ;
 
 : ONLYTASK   ( tid -- )
     DUP SLEEP                           \ sleep this task
-    DUP STATUS 'S SWAP FOLLOWER 'S !    \ set task's follower to own stats
+    DUP STATUS 'U SWAP FOLLOWER 'U !    \ set task's follower to own stats
 ;
 
 : NEWTASK   ( u s+r "name" -- ) ( -- tid )
-    CREATE SWAP FOLLOWER TOS - + CELL + HERE +  \ reserve user space and calculate TID
-    DUP ,                           \ save TID to pfa
-    OVER + ,                        \ save TOS to TOS field
-    HERE PASS , ,                   \ set STATUS to PASS and FOLLOWER to STATUS
-    HERE 2 CELLS + , DUP HERE + , ALLOT       \ set R0 and S0 and reserve stack space
+    CREATE SWAP USER# + CELL + HERE +   \ reserve user space and calculate TID
+    DUP ,                               \ save TID
+    0 ,                                 \ clear WAKE-AT
+    OVER + ,                            \ save TOS to TOS field
+    HERE PASS , ,                       \ set STATUS to PASS and FOLLOWER to STATUS
+    HERE 2 CELLS + , DUP HERE + , ALLOT \ set R0 and S0 and reserve stack space
     DOES> @
 ;
 
 : .TASK
     CR
     DUP                 ." ID:       " . CR
     DUP ANY>LINK LINK>NAME      ." Name:     " COUNT TYPE CR
-    DUP S0 'S @ OVER R0 'S @    ." Stacks:   " . . CR
-    DUP STATUS 'S @     ." Status:   " WAKE = IF ." WAKE" ELSE ." PASS" THEN CR
-    DUP FOLLOWER 'S @   ." Follower: " CELL + . CR
-        TOS 'S @        ." TOS:      " . CR
+    DUP S0 'U @ OVER R0 'U @    ." Stacks:   " . . CR
+    DUP STATUS 'U @     ." Status:   " WAKE = IF ." WAKE" ELSE ." PASS" THEN CR
+    DUP FOLLOWER 'U @   ." Follower: " CELL + . CR
+    DUP WAKE-AT 'U @    ." Wake at:  " . CR
+        TOS 'U @        ." TOS:      " . CR
 ;
 
 : .TASKS
     UP@
     BEGIN
         DUP .TASK
-        FOLLOWER 'S @ CELL +
+        FOLLOWER 'U @ CELL +
         DUP UP@ =
     UNTIL
     DROP

generic/systick.ft

@@ -0,0 +1,10 @@
+VARIABLE SYSTICKS/TICK
+VARIABLE TICKS
+
+: SYSTICK-IRQ   1 TICKS +! ;I
+: SYSTICK-ENABLE
+    ['] SYSTICK-IRQ IVT $0E CELLS + !
+    0 TICKS !
+    SYSTICKS/TICK @ STRELOAD !
+    7 STCTRL !
+;

lm3s811/lm3s811_board.s

@@ -352,8 +352,6 @@ pendsv_handler:
     b .
 
 systick_handler:
-    b .
-
 gpioa_handler:
 gpiob_handler:
 gpioc_handler:

lm3s811/lm3s811_ram.ft

@@ -2,6 +2,7 @@ HEX
 
 0 SCR !
 -1 BLOCK# !
+#125000 SYSTICKS/TICK !
 
 0 100 NEWTASK T1
 0 100 NEWTASK T2
@@ -22,9 +23,16 @@ TASK0 AWAKE
     BEGIN ." Task 2 " PAUSE AGAIN
 ;
 
-\ T1RUN
+ANSI-IO
+SYSTICK-ENABLE
+
+T1RUN
 \ T2RUN
 
-ANSI-IO
+: TIMEOUT-TEST
+    T1 SLEEP
+    TICKS @ #1000 + T1 WAKE-AT 'U !
+    STOP
+;
 
 ABORT

lm3s811/precompiled_words.s

@@ -523,6 +523,18 @@
     defword "LED0!", LEDZSTORE, 0x0
     .word LIT, 0x1, EQU, LIT, 0x20, AND, LIT, 0x20, GPIOC, GPIO_DATASTORE, EXIT
 
+    defvar "SYSTICKS/TICK", SYSTICKSSLASHTICK, 0x4
+
+
+    defvar "TICKS", TICKS, 0x4
+
+
+    defword "SYSTICK-IRQ", SYSTICK_IRQ, 0x0
+    .word LIT, 0x1, TICKS, PLUSSTORE, RETI
+
+    defword "SYSTICK-ENABLE", SYSTICK_ENABLE, 0x0
+    .word LIT, SYSTICK_IRQ, IVT, LIT, 0xE, CELLS, PLUS, STORE, LIT, 0x0, TICKS, STORE, SYSTICKSSLASHTICK, FETCH, STRELOAD, STORE, LIT, 0x7, STCTRL, STORE, EXIT
+
     defword "ANSI-ESC-START", ANSI_ESC_START, 0x0
     .word LIT, 0x1B, EMIT, LIT, 0x5B, EMIT, EXIT
 
@@ -744,20 +756,41 @@
     defword "TOS", TOS, 0x0, USER_XT
     .word 0xFFFFFFF8
 
+    defword "WAKE-AT", WAKE_AT, 0x0, USER_XT
+    .word 0xFFFFFFF4
+
+    defconst "USER#", USERNUM, 0xC
+
+
+    defword "TIMEOUT!", TIMEOUTSTORE, 0x0
+    .word TICKS, FETCH, PLUS, WAKE_AT, STORE, EXIT
+
+    defword "TIMEOUT@", TIMEOUTFETCH, 0x0
+    .word TICKS, FETCH, WAKE_AT, FETCH, MINUS, EXIT
+
+    defword "TIMEOUT?", TIMEOUTQ, 0x0
+    .word TIMEOUTFETCH, ZGT, DUP, QBRANCH, 0x14, LIT, 0x0, WAKE_AT, STORE, EXIT
+
+    defvar "LAST-AWAKE", LAST_AWAKE, 0x4
+
+
     defword "PAUSE", PAUSE, 0x0
     .word RPFETCH, SPFETCH, TOS, STORE, FOLLOWER, FETCH, GTR, EXIT
 
-    defword "'S", TICKS, 0x0
+    defword "'U", TICKU, 0x0
     .word FOLLOWER, MINUS, PLUS, EXIT
 
     defword "(WAKE)", LPARENWAKERPAREN, 0x0
-    .word RGT, UP, TWODUP, STORE, TOS, FETCH, SPSTORE, RPSTORE, EXIT
+    .word RGT, UP, TWODUP, STORE, OVER, LAST_AWAKE, STORE, TOS, FETCH, SPSTORE, RPSTORE, EXIT
 
     defconst "WAKE", WAKE, LPARENWAKERPAREN
 
 
+    defword "AWAKE", AWAKE, 0x0
+    .word DUP, LAST_AWAKE, STORE, WAKE, SWAP, STATUS, TICKU, STORE, EXIT
+
     defword "(PASS)", LPARENPASSRPAREN, 0x0
-    .word RGT, FETCH, GTR, EXIT
+    .word RGT, DUP, WAKE_AT, TICKU, FETCH, QDUP, QBRANCH, 0x20, TICKS, FETCH, LT, QBRANCH, 0xC, DUP, AWAKE, DUP, LAST_AWAKE, FETCH, EQU, QBRANCH, 0x8, WFI, FETCH, GTR, EXIT
 
     defconst "PASS", PASS, LPARENPASSRPAREN
 
@@ -766,30 +799,33 @@
     .word PASS, STATUS, STORE, PAUSE, EXIT
 
     defword "SLEEP", SLEEP, 0x0
-    .word PASS, SWAP, STATUS, TICKS, STORE, EXIT
-
-    defword "AWAKE", AWAKE, 0x0
-    .word WAKE, SWAP, STATUS, TICKS, STORE, EXIT
+    .word PASS, SWAP, STATUS, TICKU, STORE, EXIT
 
     defword "ACTIVATE", ACTIVATE, 0x0
-    .word DUP, SZ, TICKS, FETCH, CELL, MINUS, OVER, RZ, TICKS, FETCH, RGT, OVER, STORE, OVER, STORE, OVER, TOS, TICKS, STORE, AWAKE, EXIT
+    .word DUP, SZ, TICKU, FETCH, CELL, MINUS, OVER, RZ, TICKU, FETCH, RGT, OVER, STORE, OVER, STORE, OVER, TOS, TICKU, STORE, AWAKE, EXIT
 
     defword "ALSOTASK", ALSOTASK, 0x0
-    .word DUP, SLEEP, FOLLOWER, FETCH, OVER, FOLLOWER, TICKS, STORE, STATUS, TICKS, FOLLOWER, STORE, EXIT
+    .word DUP, SLEEP, FOLLOWER, FETCH, OVER, FOLLOWER, TICKU, STORE, STATUS, TICKU, FOLLOWER, STORE, EXIT
 
     defword "ONLYTASK", ONLYTASK, 0x0
-    .word DUP, SLEEP, DUP, STATUS, TICKS, SWAP, FOLLOWER, TICKS, STORE, EXIT
+    .word DUP, SLEEP, DUP, STATUS, TICKU, SWAP, FOLLOWER, TICKU, STORE, EXIT
 
     defword "NEWTASK", NEWTASK, 0x0
-    .word CREATE, SWAP, FOLLOWER, TOS, MINUS, PLUS, CELL, PLUS, HERE, PLUS, DUP, COMMA, OVER, PLUS, COMMA, HERE, PASS, COMMA, COMMA, HERE, LIT, 0x2, CELLS, PLUS, COMMA, DUP, HERE, PLUS, COMMA, ALLOT, LPARENDOESGTRPAREN
+    .word CREATE, SWAP, USERNUM, PLUS, CELL, PLUS, HERE, PLUS, DUP, COMMA, LIT, 0x0, COMMA, OVER, PLUS, COMMA, HERE, PASS, COMMA, COMMA, HERE, LIT, 0x2, CELLS, PLUS, COMMA, DUP, HERE, PLUS, COMMA, ALLOT, LPARENDOESGTRPAREN
     .set NEWTASK_XT, .
     .word 0x47884900, DODOES + 1, FETCH, EXIT
 
     defword ".TASK", DOTTASK, 0x0
-    .word CR, DUP, LPARENSQUOTRPAREN, 0x3A44490A, 0x20202020, 0x202020, TYPE, DOT, CR, DUP, ANYGTLINK, LINKGTNAME, LPARENSQUOTRPAREN, 0x6D614E0A, 0x20203A65, 0x202020, TYPE, COUNT, TYPE, CR, DUP, SZ, TICKS, FETCH, OVER, RZ, TICKS, FETCH, LPARENSQUOTRPAREN, 0x6174530A, 0x3A736B63, 0x202020, TYPE, DOT, DOT, CR, DUP, STATUS, TICKS, FETCH, LPARENSQUOTRPAREN, 0x6174530A, 0x3A737574, 0x202020, TYPE, WAKE, EQU, QBRANCH, 0x1C, LPARENSQUOTRPAREN, 0x4B415704, 0x45, TYPE, BRANCH, 0x14, LPARENSQUOTRPAREN, 0x53415004, 0x53, TYPE, CR, DUP, FOLLOWER, TICKS, FETCH, LPARENSQUOTRPAREN, 0x6C6F460A, 0x65776F6C, 0x203A72, TYPE, CELL, PLUS, DOT, CR, TOS, TICKS, FETCH, LPARENSQUOTRPAREN, 0x534F540A, 0x2020203A, 0x202020, TYPE, DOT, CR, EXIT
+    .word CR, DUP, LPARENSQUOTRPAREN, 0x3A44490A, 0x20202020, 0x202020, TYPE, DOT, CR, DUP, ANYGTLINK, LINKGTNAME, LPARENSQUOTRPAREN, 0x6D614E0A, 0x20203A65, 0x202020, TYPE, COUNT, TYPE, CR, DUP, SZ, TICKU, FETCH, OVER, RZ, TICKU, FETCH, LPARENSQUOTRPAREN, 0x6174530A, 0x3A736B63, 0x202020, TYPE, DOT, DOT, CR, DUP, STATUS, TICKU, FETCH, LPARENSQUOTRPAREN, 0x6174530A, 0x3A737574, 0x202020, TYPE, WAKE, EQU, QBRANCH, 0x1C, LPARENSQUOTRPAREN, 0x4B415704, 0x45, TYPE, BRANCH, 0x14, LPARENSQUOTRPAREN, 0x53415004, 0x53, TYPE, CR, DUP, FOLLOWER, TICKU, FETCH, LPARENSQUOTRPAREN, 0x6C6F460A, 0x65776F6C, 0x203A72, TYPE, CELL, PLUS, DOT, CR, DUP, WAKE_AT, TICKU, FETCH, LPARENSQUOTRPAREN, 0x6B61570A, 0x74612065, 0x20203A, TYPE, DOT, CR, TOS, TICKU, FETCH, LPARENSQUOTRPAREN, 0x534F540A, 0x2020203A, 0x202020, TYPE, DOT, CR, EXIT
 
     defword ".TASKS", DOTTASKS, 0x0
-    .word UPFETCH, DUP, DOTTASK, FOLLOWER, TICKS, FETCH, CELL, PLUS, DUP, UPFETCH, EQU, QBRANCH, 0xFFFFFFD4, DROP, EXIT
+    .word UPFETCH, DUP, DOTTASK, FOLLOWER, TICKU, FETCH, CELL, PLUS, DUP, UPFETCH, EQU, QBRANCH, 0xFFFFFFD4, DROP, EXIT
+
+    defword "STOP-FOR-KEY", STOP_FOR_KEY, 0x0
+    .word KEYQ, ZEQU, QBRANCH, 0x10, STOP, BRANCH, 0xFFFFFFE8, EXIT
+
+    defword "MULTITASKING-KEY", MULTITASKING_KEY, 0x0
+    .word UPFETCH, UARTZ_TASK, STORE, LIT, STOP_FOR_KEY, TICKWAIT_KEY, STORE, EXIT
 
     defword "STOP-FOR-KEY", STOP_FOR_KEY, 0x0
     .word KEYQ, ZEQU, QBRANCH, 0x10, STOP, BRANCH, 0xFFFFFFE8, EXIT

lm3s811/precompiler.s

@@ -3,6 +3,7 @@
 
 precompile_words:
     .include "lm3s811.gen.s"
+    .include "systick.gen.s"
     .include "ansi.gen.s"
     .include "editor.gen.s"
     .include "blocks.gen.s"