( -*-forth-*- )

( some objects )


( queues - see c-kernel for more info : r/w queue access is written in c )
fields
: queue.mask field @ ;  ( constant field )
: queue.read-index field ;
: queue.write-index field ;


: queue.comma ( size -- queue.struct )
    dup
    neg >r             ( save mask  : TODO round size up to nearest power of 2 )
    cells allot here   ( allocate buffer and save it's endx address )
    r  comma           ( compile mask )
    r  comma           ( .. read index )
    r> comma ;         ( .. write index )
    
: queue ( size -- )
    queue.comma constant ;    ( define a constant pointing to the queue structure )

: queue.size  ( queue -- cells )
    @ neg ;

: queue.reset >r ( reset read and write pointers )
    r queue.mask
    dup r queue.read-index !
    r> queue.write-index ! ;

: queue.clear ( fill the queue with zeros )
    dup queue.reset
    dup queue.size
    for 0 over queue.write next ;

: queue.delay >r ( cells queue -- ) ( set an initial nb of elements )
    r  queue.write-index @ sub  ( get write index and subtract nb of cells )
    r  queue.mask or            ( apply mask )
    r> queue.read-index ! ;     ( set read index )

( stack
stacks are organized as 2 pointer cells [stack.ptr bootomx.ptr]
followed by the stack body. )

fields
: stack.top  field ;
: stack.botx field ;

: stack.comma ( stack.size -- )
    cells dup >r
    here add [ 2 cells ]L add ( compute bottomx pointer )
    dup comma comma           ( compile pointers )
    r> allot ;                ( create stack )

: stack.next cell+ @ ; ( get next stack in an array of stacks )




( TASKS : lightweight round robin task scheduler
a task is represented by a return stack pointer
tasks do not have a separate data stack. this is
to keep things simple and allow parameter passing between
tasks. 

while storing rsps is very simple of course
this does limit some manipulation. no easy way to
translate a rsp into it's original task. )


: queue.yield ( queue -- ) ( yields to next task in task queue saving current )
    rsp@ swap queue.tick rsp! ;
: queue.pass  ( queue -- ) ( stops current task and yields to next )
    queue.read rsp! ;

( trampoline : executes xt on return stack )
here ] ( R: xt -- ) r> pass execute [ constant trampoline



( initialize an execution context )
: xc.init  ( xt xc -- rsp )
    >r
        r stack.push             ( load xt )
        trampoline r stack.push  ( load trampoline )
    r> @ ;

: xc.comma  ( stack.size -- ) stack.comma ;
: xc.noname ( stack.size -- rsp )
    ( create an initialized anonymous execution context )
    here >r xc.comma r> xc.init ;

: xc create ( stack.size -- )
    ( create an uninitalized named execution context )
    xc.comma ;

( [re]start a task in a non-anonymous context )
: queue.restart ( xt xc queue -- )
    >r xc.init r> queue.write ;

( start an anonymous task )
: queue.start ( xt task.stack.size queue -- )
    >r xc.noname r> queue.write ;


( rr scheduler setup
  these words create curried task queue manipulators )

: def-rr-yield   ( queue -- ) ['] queue.yield curry ;
: def-rr-restart ( queue -- ) ['] queue.restart curry ;
: def-rr-start   ( queue -- ) ['] queue.start curry ;



local  ( object dictionary )
floats ( numbers are floats )


: empty  [s] no.more.marks .s ;