multi-tasking

\ Forth task supprt for POSIX. The mutex/condvar logic used here for
\ STOP and AWAKEN is more complex than the simple futex() calls in
\ Linux or _lwp_park() used in BSD Unix, but it's much more portable.

require unix/libc.fs

c-library posix-task-support
    \c #include <pthread.h>
    \c #include <assert.h>
    \c #include <stdio.h>
    \c #include <unistd.h>
    \c
    \c static void *gforth_run_impl(user_area *t) {
    \c   Cell x;
    \c   int throw_code;
    \c   void *ip0=(void*)(t->save_task);
    \c   sigset_t set;
    \c   gforth_UP=t;
    \c   gforth_setstacks(t);
    \c
    \c   *--gforth_SP=(Cell)t;
    \c
    \c   gforth_sigset(&set, SIGINT, SIGQUIT, SIGTERM, SIGWINCH, 0);
    \c   pthread_sigmask(SIG_BLOCK, &set, NULL);
    \c   x=gforth_go(ip0);
    \c   pthread_exit((void*)x);
    \c }
    \c
    \c static void *gforth_run()
    \c {
    \c   return (void*)&gforth_run_impl;
    \c }
    \c
    \c typedef struct {
    \c   volatile int32_t _status;
    \c   pthread_mutex_t _mutex;
    \c   pthread_cond_t _cond;
    \c } task_state_t;
    \c
    \c // TASK_STOP sets status to 0 and returns if > 0, else waits for
    \c // _cond.  AWAKEN sets count to 1 and signals _cond. _mutex is
    \c // used to avoid a race condition which would lose an AWAKEN.
    \c
    \c void task_stop(task_state_t *task) {
    \c   if (__atomic_exchange_n(&(task->_status), 0, __ATOMIC_SEQ_CST) > 0)
    \c     return;
    \c
    \c   int retcode;
    \c   retcode = pthread_mutex_lock(&(task->_mutex));
    \c   assert(retcode == 0);
    \c
    \c   if (task->_status > 0) {
    \c     task->_status = 0;
    \c     retcode = pthread_mutex_unlock(&(task->_mutex));
    \c     assert(retcode == 0);
    \c     // Probably unnecessary: surely pthread mutex operations are full
    \c     // fences?
    \c     __atomic_thread_fence(__ATOMIC_SEQ_CST);
    \c     return;
    \c   }
    \c
    \c   retcode = pthread_cond_wait(&(task->_cond), &(task->_mutex));
    \c   assert(retcode == 0);
    \c   task->_status = 0;
    \c
    \c   retcode = pthread_mutex_unlock(&(task->_mutex));
    \c   assert(retcode == 0);
    \c
    \c   // Probably unnecessary: surely pthread mutex operations are full
    \c   // fences?
    \c   __atomic_thread_fence(__ATOMIC_SEQ_CST);
    \c }
    \c
    \c void task_awaken(task_state_t *task) {
    \c   int retcode = pthread_mutex_lock(&(task->_mutex));
    \c   assert(retcode == 0);
    \c
    \c   int s = task->_status;
    \c   task->_status = 1;
    \c
    \c   if (s < 1) {
    \c     // thread is definitely stopped
    \c     retcode = pthread_cond_signal(&(task->_cond));
    \c     assert(retcode == 0);
    \c   }
    \c   retcode = pthread_mutex_unlock(&(task->_mutex));
    \c   assert(retcode == 0);
    \c }
    \c
    \c void task_init(task_state_t *task) {
    \c   int retcode = pthread_cond_init(&(task->_cond), NULL);
    \c   assert(retcode == 0);
    \c   retcode = pthread_mutex_init(&(task->_mutex), NULL);
    \c   assert(retcode == 0);
    \c   task->_status = 0;
    \c }
    \c
    \c size_t task_state_size() {
    \c   return sizeof (task_state_t);
    \c }
    \c
    \c pthread_attr_t * pthread_detach_attr(void)
    \c {
    \c   static pthread_attr_t attr;
    \c   pthread_attr_init(&attr);
    \c   pthread_attr_setdetachstate(&attr, PTHREAD_CREATE_DETACHED);
    \c   return &attr;
    \c }

    c-function task-stop task_stop a -- void ( addr -- )
    c-function task-awaken task_awaken a -- void ( addr -- )
    c-function task-state-size task_state_size -- n (  -- n )
    c-function task-init task_init a -- void ( addr -- )

    c-function pthread_create pthread_create a{(pthread_t*)} a a a -- n ( thread attr start arg )
    c-function pthread_detach_attr pthread_detach_attr -- a ( -- addr )
    c-function gforth_stacks gforth_stacks n n n n -- a ( dsize fsize rsize lsize -- task )
    c-function gforth_run gforth_run -- a ( -- addr )

    c-function setbuf setbuf a a -- void ( stream buf -- )
    
end-c-library