\\                   *** Multitasker ***          32b  18mar92py                                                                Diese File enth„lt den Multitasker                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                              \ Multitasker Loadscreen                          32b  07jul01pyModule Tasker                                                                                                                   02 $0C +thru   \ Tasker                                         [IFUNDEF] go32   include idle.fs                                [ELSE]  ' 2drop IS idle  [THEN]                                    $0E +load   \ Background Garbage collection                     $0F +load   \ load tasker cold                                                                                               multitask                                                       [IFDEF] unix                                                    export singletask multitask unlock-all activate pass kill            timer@ time !time after till wait timeout? seconds minutes      ms ms>time >us .time autostart rendezvous task's tasks          Task NewTask !name doshift idle' idle+ ;                   [THEN]                                          -->             \ Multitasker Loadscreen                          32b  06jan00py                                                                [IFDEF] go32                                                    export singletask multitask unlock-all activate pass kill            timer@ time !time after till wait timeout? seconds minutes      ms>time >us .time autostart rendezvous task's tasks             Task NewTask !name doshift ;                               [THEN]                                                          [IFDEF] win32                                                   export singletask multitask unlock-all activate pass kill            timer@ time !time after till wait timeout? seconds minutes      ms ms>time >us .time autostart rendezvous task's tasks          Task NewTask !name doshift re-time idle' idle+ ;           [THEN]                                                          Module;                                                                                                                         \ singletask multitask                            32b  02jul00py                                                                Label taskpause   :R  pushf  BX push  DI push  AX push  SI push       CX call  SI pop  AX pop  DI pop  BX pop  popf  ret        Label tboot       :R DI pop  SI pop  lods  BX BX xor                  ret  end-code                                                                                                             : singletask   ['] noop   Tsave ! ;                             : multitask    taskpause  Tsave ! ;     multitask               : unlock-all ( task -- )  semalink                                BEGIN  @ dup  WHILE  dup >r [ 2 cells ] Literal - 2dup @ =             IF   up@ over ! unlock                                          ELSE cell+ BEGIN  dup @  WHILE  2dup @ =                                          IF dup user' lock> + @ over ! THEN @                     REPEAT drop  THEN  r>  REPEAT  2drop ;      | : stopit       up@ unlock-all  BEGIN  stop  AGAIN ;           \ pass activate                                   32b  02jul00py                                                                | Code ^  AX push   OP AX mov  Next end-code  hmacro  :ax 0 T&P | : >Task ( n1 nm cells addr -- )                                   @ over - under >r bounds ?DO  I ! cell +LOOP  r> ;          | : (pass   ( n0 ... nm-1 m Taskaddr -- ) rdrop                     >r cells r@ user' s0 + >Task                                    r> r> -rot >r ^ tboot  \ --> ip sp op tboot  r: task            4  cells r@ user' r0 + >Task                                    r@ user' TsaveRP + ! r> wake ;                                                                                              : activate   ( Taddr -- )        0 swap (pass ; restrict        : pass  ( n0 ... nm-1 m Taskaddr -- )   (pass ; restrict                                                                        : autostart  ( Taddr -- Taddr )  r@ over user' tstart + ! ;     : kill       ( Taddr -- )  hostsem unlock  activate ;           \ sleep wake taskerror                            32b  12dec98py                                                                : rendezvous   ( semaphoraddr -- )  dup unlock  pause  lock ;   : task's   ( Taddr -- addr.of.tasks.userarea ) compile user'      state @ IF compile + ELSE + THEN ; immediate                  | : .task  dup 8 u.r space  dup mroot @ u>                          IF task's r0 @ cell+ @ .name ELSE drop ." MAIN " THEN ;     | : (tasks ( link -- ) dup                                          BEGIN  @ 2dup = 0=  WHILE  cr dup .task dup                            task's TsaveRP @ 0= IF ." dead" THEN  REPEAT 2drop ; : tasks   ( -- )  cr up@ .task      up@      (tasks                               cr ." Sleepers:"  sleepers (tasks ;           | : taskerror   ( string -- )                                       standardi/o  singletask  7 con!                                 at?  rows 1- 0 at  ." Task " up@ .task  Ascii : emit            rot  count type  at  multitask r0 @ rp! ;                   \ Task                                            32b  29mar95py                                                                | : !task  ( rlen slen task -- rlen slen )  >r                      up@ r@ udp @ move  r@ over - dup 0                              4 pick r@ + r@ $10 - 0 ['] drop tsave @ 0  sleepers dup @       r@ [ $B cells ] Literal bounds DO I ! cell +LOOP r@ sleep       ['] taskerror  user' errorhandler r@ + !                        ['] noop [ ' 'quit 2+ w@ ] Literal r> + ! ;                 : Task   ( rlen slen -- ) >r udp @ + aligned r> aligned $10 +     0 AValue  here >r             \ Task-dp                         dup allot here r> cell- !                                       Mroot @ dup cell+ @ + relinfo                                   [ udp 8+ Mroot @ - 2/ ] Literal here >rel 2/ udp @ 2/ movebits  here !task  drop allot  ['] stopit A,                           last @ A, ;                                                                                                                   \ exact timer                                          31apr97py[IFDEF] go32                                                    | $40 Constant #timer                                                                                                           Code timer@  ( -- timer )  AX push  AX AX xor  CX CX xor             BEGIN  $46C DOS#) DX mov                                               AL AL xor   .b #timer 3 + # out                     \ this latches the internal counter in $40/$40 (lo/hi)                      .b #timer # in  AL CL mov  .b #timer # in  AL CH mov            $46C DOS#) DX cmp  0=  UNTIL                             .w CX not CX $10 # shl  CX AX mov                               $1800B0 # CX mov CX div                                         Next end-code                                              [THEN]                                                          \\                                                              : ttest >r r@ 0 ?DO timer@ LOOP r> 1- 0 ?DO over - . LOOP drop ;\ exact timer                                          21jun09py[IFDEF] unix                                                    also dos                                                                                                                        : timer@  timeval timezone gettimeofday drop                      timeval 2@ swap $CB9CB68 um* nip swap                           $2000000 um* &675 ud/mod drop nip + ;                                                                                         previous                                                        [THEN]                                                                                                                                                                                                                                                                                                                                                                                                                                                          \ exact timer                                          06jul97py                                                                : ms>time ( ms -- time ) \ 0 swap &86400000 um/mod nip ;          $C6D750EB um* $3FFFFFF. d+ 6 lshift swap $1A rshift or ;                                                                      [IFDEF] win32                                                   also DOS                                                        0 kernel32 GetTickCount GetTickCount                            previous                                                        : timer@ GetTickCount ms>time ;                                 [THEN]                                                                                                                                                                                                                                                                                                                                                                                          \ mstimer                                              07jul01pyUser time                                                       : !time ( -- )  timer@ time ! ;                                 : after ( ms -- time )  ms>time timer@ + ;                      [IFDEF] go32   false [THEN]                                     [IFDEF] win32  true  [THEN]                                     [IFDEF] unix   true  [THEN]                                     [IF]                                                            : till ( time -- )                                                BEGIN  dup timer@ - dup 0> WHILE  dup [ &10 ms>time ] Literal          > IF &86400000 um* nip -1 swap idle ELSE drop  THEN             pause  REPEAT  2drop ;                                 [ELSE]                                                          : till ( time -- )                                                BEGIN dup timer@ - 0> WHILE  pause  REPEAT drop ;  [THEN]     [THEN]                                                          \ mstimer                                              07aug10py                                                                : wait  ( ms -- )    after till ;                               ' wait Alias ms                                                 : timeout? ( time -- time f )  pause dup timer@ - 0<= ;         : seconds  ( sec -- time )  &1000 * ;                           : minutes  ( min -- time ) &60000 * ;                           : >us ( time -- dus )  &86400000 um*                              &1000 um* >r >r &1000 um* r> + r> rot 0< extend d- ;          : .time  timer@ time @ - >us  base push decimal                   <<# [ 5 ] [FOR] # [NEXT] ', hold                                   &60 um/mod tuck                                                 IF  0 # # ': hold  2drop 0 &60 um/mod tuck                          IF  0 # # drop ': hold #S  ELSE  0 #S drop  THEN            ELSE  0 #S drop  THEN  #>  type #>> ."  sec " ;                                                                            \ NewTask                                              19oct02pyMemory also Tasker                                              | : terminate   ( -- )  up@ unlock-all                              s^ @ DisposPtr up@ 2@ 2dup cell+ ! swap ! pause ;                                                                           : NewTask   ( rlen slen -- Task )                                 >r udp @ + r> $10 + 2dup + 8+ NewPtr over + >r                  r@ !task                                                        r@ swap - >r here count r@ place                                r> ['] terminate rot r@ + 2! r> ;                             : !name  last @ compile ALiteral  compile r0 compile @            compile cell+ compile ! ; immediate restrict                  toss Tasker                                                                                                                                                                                                                                                     \ Remove Tasks                                         25jun01py| : (remove-tasks ( dic link -- ) dup  >r                           BEGIN  dup @ r@ = 0=  WHILE  2dup @ swap here within                   IF  dup unlock-all  dup @ dup linkTask  ELSE  @  THEN    REPEAT  drop rdrop ;                                        | : remove-tasks ( dic sym -- ) defers custom-remove over           up@ (remove-tasks  sleepers (remove-tasks drop ;            ' remove-tasks is custom-remove                                 | : sleeptasks ( link -- ) r> swap dup @  0 >r                      BEGIN  2dup = 0=  WHILE  dup >r @  r@ unlock-all                       r@ sleep  REPEAT 2drop >r ;                          bye:  r>  up@ sleeptasks  sleepers dup 2@ 2>r dup dup 2!              execute  2r> sleepers 2!                                        BEGIN r> dup WHILE wake REPEAT drop ;                                                                                                                                                     \ showtime clock start wait                       32b  06mar94pyalso DOS                                                        | : showtime   ( time -- )  singletask                              at? 0 cols 8 - at rot >time type at  multitask ;            | 0 Value clocktask                                             : clock   ( -- )                                                  $100 dup NewTask  activate  decimal  dattime                    up@ to clocktask !name                                          BEGIN  BEGIN  pause  dattime under  = 0=  UNTIL                        &990 after over showtime  till                           AGAIN ;                                                       toss                                                            : startc    clocktask wake ;                                    : waitc     clocktask sleep ;                                   : noclock   clocktask ?dup IF  kill 0 to clocktask  THEN ;      clock                                                           \ ShiftTask                                            21dec08pyalso Memory definitions also DOS                                $20000 Value MinMem                                             [IFDEF] linux                                                   : FreePool ( -- )  0 -1 $32 $7                                    Pool @ dup dup @ + cell- -$1000 and >r $1007 + -$1000 and       r> over - swap 2dup munmap drop mmap drop ;                   [ELSE]  | ' noop Alias FreePool immediate          [THEN]       toss toss definitions also Memory                               : DoShift  $1000 dup NewTask  activate   !name                    BEGIN  ['] Shift>all catch drop Shift? unlock                          FreePool  BEGIN  pause HeapStart 0> UNTIL              [IFDEF] go32   &10000 after                                                    BEGIN  timeout? FreeMem MinMem <  or UNTIL  drop [ELSE]         &10000 wait  [THEN]  AGAIN ;                     DoShift                                         toss            \ task initializer at cold                             07jul01py                                                                cold: up@ @ up@ <> ?exit                                              [IFDEF] unix   idler  [THEN]                                    [IFDEF] win32  idler  [THEN]                                    [IFDEF] go32 $46C dos@ BEGIN dup $46C dos@ <> UNTIL drop                $34 $43 pc! 0 $40 pc! 0 $40 pc! [THEN]                  sleepers @                                                      BEGIN  dup sleepers = 0=  WHILE  dup @ >r dup                          [ user' tstart ] Literal + perform r>  REPEAT drop       [IFDEF] clock clock [THEN]                                      [IFDEF] doshift doshift [THEN] ;