CR .( eForth multitasker extensions, tests and tools )
CR ( Copyright Bill Muench All rights reserved. )

( Bill Muench \ OntoLogic )
(             \ Santa Cruz  CA  95065 )

MARKER E4.TASK
BASE @ !CSP
DECIMAL

( multitask information exchange extension ================== )
( changed from original by Michael B. Montvelishsky )

: CHAN ( "name" -- ) ( -- a )
  VARIABLE [ 1 CELLS ] LITERAL ALLOT ;

: C> ( a -- n ) ( get data from a channel )
  >R ( save channel )
  BEGIN R@ R@ @ XOR ( channel empty ? )
  WHILE PAUSE ( yes, wait )
  REPEAT R@ CELL+ @  0 R> ! ( get data, flag empty )
;

: >C ( n a -- ) ( put data to a channel )
  >R ( save channel )
  BEGIN R@ @ ( channel full ? )
  WHILE PAUSE ( yes, do not overwrite )
  REPEAT R@ R> 2! ( put data, flag full )
;

( =========================================================== )

: BUFF ( n "name" -- ) ( -- a ) ( ONLY powers of 2 )
  CREATE 0 , ( in and out index )
  DUP 1 - , ALLOT ( mask and circular buffer )
;

: B> ( a -- n ) ( get data from the buffer )
  >R ( save buffer )
  R@ CHAR+ C@ ( out index )
  BEGIN DUP R@ C@ = ( buffer empty ? )
  WHILE PAUSE ( yes, wait )
  REPEAT DUP R@ CELL+ CELL+ + @ ( get data )
  SWAP CELL+ R@ CELL+ C@ AND
  R> CHAR+ C! ( update out index )
;

: >B ( n a -- ) ( put data to the buffer )
  >R ( save buffer )
  R@ C@ ( in index )
  DUP CELL+ R@ CELL+ C@ AND ( next in index )
  BEGIN DUP R@ CHAR+ C@ = ( buffer full ? )
  WHILE PAUSE ( yes, wait )
  REPEAT R@ C! ( update in index )
  R> CELL+ CELL+ + ! ( put data )
;

( examples ================================================== )

HEX

0BB CONSTANT FILLER

DECIMAL

VARIABLE JJ ( shared resource semaphore )
  0 JJ ! ( force release )

( =========================================================== )

0  16 CELLS  DUP HAT J1

J1 2@ SWAP OVER - FILLER FILL ( debug tracer )

J1 BUILD

VARIABLE V1

: J1GO ( -- )
  0 V1 !
  J1 ACTIVATE
  BEGIN
    JJ GET
    1 V1 +!
    JJ RELEASE
  AGAIN ;

( =========================================================== )

0  16 CELLS  DUP HAT J2

J2 2@ SWAP OVER - FILLER FILL ( debug tracer )

J2 BUILD

VARIABLE V2

: J2GO ( -- )
  0 V2 !
  J2 ACTIVATE
  BEGIN  PAUSE  1 V2 +!
  AGAIN ;

( =========================================================== )

0  16 CELLS  DUP HAT J3

J3 2@ SWAP OVER - FILLER FILL ( debug tracer )

J3 BUILD

VARIABLE V3

: J3GO ( -- )
  0 V3 !
  J3 ACTIVATE  1 2 3 4
  BEGIN  PAUSE  1 V3 +!
  AGAIN ;

: P ( -- ) V1 ?  V2 ?  V3 ? ;

( tools ===================================================== )

: .T ( tid -- )
  >R
\  R@ STATUS 'S DUP @ ( save STATUS )
\  R@ SLEEP
  R> 2@ SWAP OVER - DUMP
\  SWAP ! ( restore status )
;

: TASKS ( -- )
  BASE @ DECIMAL  STATUS DUP
  BEGIN
    CR CELL+ @ DUP >R ( STATUS )
    DUP CELL- CELL- 2@ ( tos tid )
    DUP CELL- CELL- NAMED? .ID SPACE
    R> @ WAKE XOR IF ." PASS" ELSE ." WAKE" THEN
    CELL+ @ SWAP - 1 CELLS / ."  depth=" 0 .R
    2DUP = NUF? OR
  UNTIL 2DROP BASE ! ;

( =========================================================== )

?CSP BASE !

FROM CON