multi.f

   1 \\r
   2 \ hForth multitasker\r
   3 \\r
   4 \ Originally written by Bill Muench.\r
   5 \ Adapted to hForth by Wonyong Koh\r
   6 \\r
   7 \ Usage:\r
   8 \   HAT  ( user_size ds_size rs_size "<spaces>name" -- )\r
   9 \        Run-time: ( -- tid )\r
  10 \       Create a new task.\r
  11 \   BUILD  ( tid -- )\r
  12 \       Initialize and link new task into PAUSE chain.\r
  13 \   ACTIVATE  ( tid -- )\r
  14 \       Activate the task identified by tid. ACTIVATE must be used\r
  15 \       only in definition. The code following ACTIVATE must not\r
  16 \       EXIT. In other words it must be infinite loop like QUIT.\r
  17 \   .TASKS  ( -- )\r
  18 \       Display tasks list in status-follower chain.\r
  19 \   SLEEP  ( tid -- )\r
  20 \       Sleep another task.\r
  21 \   AWAKE  ( tid -- )\r
  22 \       Awake another task.\r
  23 \   PAUSE  ( -- )\r
  24 \       Stop current task and transfer control to the task of which\r
  25 \       'status' USER variable is stored in 'follower' USER variable\r
  26 \       of current task.\r
  27 \   STOP  ( -- )\r
  28 \       Sleep current task.\r
  29 \\r
  30 \ 1997. 2. 28.\r
  31 \       Facelift to be used with other CPUs.\r
  32 \ 1995. 11. 3.\r
  33 \       Fix ACTIVATE. sp@ should return a value not larger than sp0.\r
  34 \r
  35 BASE @ HEX\r
  36 GET-CURRENT\r
  37 NONSTANDARD-WORDLIST SET-CURRENT\r
  38 \r
  39 \ Structure of a task created by HAT\r
  40 \ userP points follower.\r
  41 \ //userP//return_stack//data_stack\r
  42 \ //user_area/user1/taskName/throwFrame/stackTop/status/follower/sp0/rp0\r
  43 \r
  44 \ 'PAUSE' and 'wake' are defined in assembler source.\r
  45 \r
  46 \   PAUSE       ( -- )\r
  47 \               Stop current task and transfer control to the task of which\r
  48 \               'status' USER variable is stored in 'follower' USER variable\r
  49 \               of current task.\r
  50 \ CHAR " PARSE systemID" ENVIRONMENT? DROP\r
  51 \ CHAR " PARSE hForth 8086 ROM Model" COMPARE 0=\r
  52 \ CHAR " PARSE systemID" ENVIRONMENT? DROP\r
  53 \ CHAR " PARSE hForth 8086 RAM Model" COMPARE 0= OR\r
  54 \ [IF]\r
  55 \   : PAUSE     rp@ sp@ stackTop !  follower @ >R ; COMPILE-ONLY\r
  56 \ [THEN]\r
  57 \ CHAR " PARSE systemID" ENVIRONMENT? DROP\r
  58 \ CHAR " PARSE hForth 8086 EXE Model" COMPARE 0=\r
  59 \ [IF]\r
  60 \   : PAUSE     rp@ sp@ stackTop !  follower @ code@ >R ; COMPILE-ONLY\r
  61 \ [THEN]\r
  62 \r
  63 \   wake        ( -- )\r
  64 \               Wake current task.\r
  65 \ CHAR " PARSE systemID" ENVIRONMENT? DROP\r
  66 \ CHAR " PARSE hForth 8086 ROM Model" COMPARE 0=\r
  67 \ CHAR " PARSE systemID" ENVIRONMENT? DROP\r
  68 \ CHAR " PARSE hForth 8086 RAM Model" COMPARE 0= OR\r
  69 \ [IF]\r
  70 \   : wake      R> userP !        \ userP points 'follower' of current task\r
  71 \               stackTop @ sp!          \ set data stack\r
  72 \               rp! ; COMPILE-ONLY      \ set return stack\r
  73 \ [THEN]\r
  74 \ CHAR " PARSE systemID" ENVIRONMENT? DROP\r
  75 \ CHAR " PARSE hForth 8086 EXE Model" COMPARE 0= OR\r
  76 \ [IF]\r
  77 \   : wake      R> CELL+ code@ userP !  \ userP points 'follower' of current task\r
  78 \               stackTop @ sp!          \ set data stack\r
  79 \               rp! ; COMPILE-ONLY      \ set return stack\r
  80 \ [THEN]\r
  81 \r
  82 \   STOP        ( -- )\r
  83 \               Sleep current task.\r
  84 CHAR " PARSE model" ENVIRONMENT? DROP\r
  85 CHAR " PARSE ROM Model" COMPARE 0=\r
  86 CHAR " PARSE model" ENVIRONMENT? DROP\r
  87 CHAR " PARSE RAM Model" COMPARE 0= OR\r
  88 [IF]\r
  89   : STOP   ['] branch status ! PAUSE ;\r
  90 [THEN]\r
  91 CHAR " PARSE model" ENVIRONMENT? DROP\r
  92 CHAR " PARSE EXE Model" COMPARE 0=\r
  93 [IF]\r
  94   : STOP   ['] branch status @ code! PAUSE ;\r
  95 [THEN]\r
  96 \r
  97 \   's          ( tid a-addr -- a-addr' )\r
  98 \               Index another task's USER variable\r
  99 : 's\r
 100     userP @ -  SWAP     \ offset tid\r
 101     @  + ;\r
 102 \r
 103 \   SLEEP       ( tid -- )\r
 104 \               Sleep another task.\r
 105 CHAR " PARSE model" ENVIRONMENT? DROP\r
 106 CHAR " PARSE ROM Model" COMPARE 0=\r
 107 CHAR " PARSE model" ENVIRONMENT? DROP\r
 108 CHAR " PARSE RAM Model" COMPARE 0= OR\r
 109 [IF]\r
 110   : SLEEP   status 's  ['] branch  SWAP ! ;\r
 111 [THEN]\r
 112 CHAR " PARSE model" ENVIRONMENT? DROP\r
 113 CHAR " PARSE EXE Model" COMPARE 0=\r
 114 [IF]\r
 115   : SLEEP   status 's @  ['] branch  SWAP code! ;\r
 116 [THEN]\r
 117 \r
 118 \   AWAKE       ( tid -- )\r
 119 \               Awake another task.\r
 120 CHAR " PARSE model" ENVIRONMENT? DROP\r
 121 CHAR " PARSE ROM Model" COMPARE 0=\r
 122 CHAR " PARSE model" ENVIRONMENT? DROP\r
 123 CHAR " PARSE RAM Model" COMPARE 0= OR\r
 124 [IF]\r
 125   : AWAKE   status 's  ['] wake  SWAP ! ;\r
 126 [THEN]\r
 127 CHAR " PARSE model" ENVIRONMENT? DROP\r
 128 CHAR " PARSE EXE Model" COMPARE 0=\r
 129 [IF]\r
 130   : AWAKE   status 's @  ['] wake  SWAP code! ;\r
 131 [THEN]\r
 132 \r
 133 \   HAT         ( user_size ds_size rs_size "<spaces>name" -- )\r
 134 \               Run-time: ( -- tid )\r
 135 \               Create a new task.\r
 136 CHAR " PARSE model" ENVIRONMENT? DROP\r
 137 CHAR " PARSE ROM Model" COMPARE 0=\r
 138 [IF]\r
 139   : HAT\r
 140       RAM/ROM@ >R RAM\r
 141       CREATE HERE >R            \ user_size ds_size rs_size  R: tid\r
 142       0 ,       ( reserve space for userP pointer)\r
 143       ALLOT     ( Use 'HERE OVER ALLOT SWAP 0AA FILL')\r
 144                 ( to see how deep return stack grows.)\r
 145       ALIGN HERE cell- >R       \ user_size ds_size      R: tid rp0\r
 146       ALLOT     ( Use 'HERE OVER ALLOT SWAP 055 FILL')\r
 147                 ( to see how deep data stack grows.)\r
 148       ALIGN HERE cell- >R       \ user_size          R: tid rp0 sp0\r
 149       ALLOT ALIGN\r
 150       [ 6 ( minimul USER variables) CELLS ] LITERAL ALLOT\r
 151       HERE cell-                \ user_pointer       R: tid rp0 sp0\r
 152       R> , R> , ( store sp0 and rp0  )\r
 153       R@ !      ( store userP pointer)\r
 154       lastName R> taskName 's ! \ store task name in new task's 'taskName'\r
 155       R> RAM/ROM! ;\r
 156 [THEN]\r
 157 CHAR " PARSE model" ENVIRONMENT? DROP\r
 158 CHAR " PARSE RAM Model" COMPARE 0=\r
 159 [IF]\r
 160   : HAT\r
 161       CREATE HERE >R            \ user_size ds_size rs_size  R: tid\r
 162       0 ,       ( reserve space for userP pointer)\r
 163       ALLOT     ( Use 'HERE OVER ALLOT SWAP 0AA FILL')\r
 164                 ( to see how deep return stack grows.)\r
 165       ALIGN HERE cell- >R       \ user_size ds_size      R: tid rp0\r
 166       ALLOT     ( Use 'HERE OVER ALLOT SWAP 055 FILL')\r
 167                 ( to see how deep data stack grows.)\r
 168       ALIGN HERE cell- >R       \ user_size          R: tid rp0 sp0\r
 169       ALLOT ALIGN\r
 170       [ 6 ( minimul USER variables) CELLS ] LITERAL ALLOT\r
 171       HERE cell-                \ user_pointer       R: tid rp0 sp0\r
 172       R> , R> , ( store sp0 and rp0  )\r
 173       R@ !      ( store userP pointer)\r
 174       lastName R> taskName 's ! ; \ store task name in new task's 'taskName'\r
 175 [THEN]\r
 176 CHAR " PARSE model" ENVIRONMENT? DROP\r
 177 CHAR " PARSE EXE Model" COMPARE 0=\r
 178 [IF]\r
 179   : HAT\r
 180       CREATE HERE >R            \ user_size ds_size rs_size  R: tid\r
 181       0 ,       ( reserve space for userP pointer)\r
 182       ALLOT     ( Use 'HERE OVER ALLOT SWAP 0AA FILL')\r
 183                 ( to see how deep return stack grows.)\r
 184       ALIGN HERE cell- >R       \ user_size ds_size      R: tid rp0\r
 185       ALLOT     ( Use 'HERE OVER ALLOT SWAP 055 FILL')\r
 186                 ( to see how deep data stack grows.)\r
 187       ALIGN HERE cell- >R       \ user_size          R: tid rp0 sp0\r
 188       ALLOT ALIGN\r
 189       [ 4 ( minimul USER variables less 'status' and 'follower') CELLS ]\r
 190       LITERAL ALLOT\r
 191       xhere ALIGNED DUP CELL+ CELL+ TO xhere\r
 192       DUP ,             ( store 'status' code-address)\r
 193       CELL+ ,           ( store 'follower' code-address)\r
 194       HERE cell-                \ user_pointer       R: tid rp0 sp0\r
 195       DUP COMPILE,      ( store 'userP' pointer in code space)\r
 196       R> , R> , ( store sp0 and rp0  )\r
 197       R@ !      ( store userP pointer)\r
 198       lastName R> taskName 's ! ; \ store task name in new task's 'taskName'\r
 199 [THEN]\r
 200 \r
 201 \   BUILD       ( tid -- )\r
 202 \               Initialize and link new task into PAUSE chain.\r
 203 CHAR " PARSE model" ENVIRONMENT? DROP\r
 204 CHAR " PARSE ROM Model" COMPARE 0=\r
 205 CHAR " PARSE model" ENVIRONMENT? DROP\r
 206 CHAR " PARSE RAM Model" COMPARE 0= OR\r
 207 [IF]\r
 208   : BUILD\r
 209       DUP SLEEP                 \ sleep new task\r
 210       follower @ OVER           \ current task's 'follwer'\r
 211       follower 's !             \ store it in new task's 'follower'\r
 212       status 's follower ! ;    \ store new 'status' in current 'follower'\r
 213 [THEN]\r
 214 CHAR " PARSE model" ENVIRONMENT? DROP\r
 215 CHAR " PARSE EXE Model" COMPARE 0=\r
 216 [IF]\r
 217   : BUILD\r
 218       DUP SLEEP                 \ sleep new task\r
 219       follower @ code@ OVER\r
 220       follower 's @ code!       \ store current task's 'follwer' in new one\r
 221       status 's @ follower @ code! ; \ new 'status' in current task's follower\r
 222 [THEN]\r
 223 \r
 224 \   ACTIVATE    ( tid -- )\r
 225 \               Activate the task identified by tid. ACTIVATE must be used\r
 226 \               only in definition. The code following ACTIVATE must not\r
 227 \               EXIT. In other words it must be infinite loop like QUIT.\r
 228 : ACTIVATE\r
 229     DUP @ CELL+ 2@ cell-        \ top of stack is in BX register\r
 230     SWAP                        \ tid sp0 rp0\r
 231     R> OVER !                   \ save entry at rp\r
 232     OVER !                      \ save rp at sp\r
 233     OVER stackTop 's !          \ save sp in stackTop\r
 234     AWAKE ; COMPILE-ONLY\r
 235 \r
 236 \   .TASKS  ( -- )\r
 237 \       Display tasks list in status-follower chain.\r
 238 CHAR " PARSE model" ENVIRONMENT? DROP\r
 239 CHAR " PARSE ROM Model" COMPARE 0=\r
 240 CHAR " PARSE model" ENVIRONMENT? DROP\r
 241 CHAR " PARSE RAM Model" COMPARE 0= OR\r
 242 [IF]\r
 243   : .TASKS\r
 244       follower                  \ current task's follower\r
 245       BEGIN\r
 246         CR DUP [ taskName follower - ] LITERAL + @ .name\r
 247         DUP cell- @ ['] wake = IF ." awaked " ELSE  ." sleeping " THEN\r
 248         @ CELL+                 \ next task's follower\r
 249       DUP follower =\r
 250       UNTIL DROP CR ;\r
 251 [THEN]\r
 252 CHAR " PARSE model" ENVIRONMENT? DROP\r
 253 CHAR " PARSE EXE Model" COMPARE 0=\r
 254 [IF]\r
 255   : .TASKS\r
 256       follower                          \ current task's follower\r
 257       BEGIN\r
 258         CR DUP [ taskName follower - ] LITERAL + @ .name\r
 259         DUP @ cell- code@ ['] wake = IF ." awaked " ELSE  ." sleeping " THEN\r
 260         @ code@ CELL+ CELL+ code@       \ next task's follower\r
 261       DUP follower =\r
 262       UNTIL DROP CR ;\r
 263 [THEN]\r
 264 \r
 265 \r
 266 SET-CURRENT\r
 267 BASE !\r
 268 \r
 269 CHAR " PARSE FILE" ENVIRONMENT?\r
 270 [IF]\r
 271   0= [IF] << CON [THEN]\r
 272 [ELSE] << CON\r
 273 [THEN]\r