[gforth] / gforth / unix / pthread.fs  

gforth: gforth/unix/pthread.fs

Diff for /gforth/unix/pthread.fs between version 1.31 and 1.32

version 1.31, Fri May 4 22:53:01 2012 UTC version 1.32, Wed May 9 22:23:52 2012 UTC
Line 183 
Line 183 
     \c {      \c {
     \c   return thread*(int)sizeof(pthread_mutex_t);      \c   return thread*(int)sizeof(pthread_mutex_t);
     \c }      \c }
       \c void *pthread_cond_plus(void * thread)
       \c {
       \c   return thread+sizeof(pthread_cond_t);
       \c }
       \c Cell pthread_conds(Cell thread)
       \c {
       \c   return thread*(int)sizeof(pthread_cond_t);
       \c }
     \c pthread_attr_t * pthread_detach_attr(void)      \c pthread_attr_t * pthread_detach_attr(void)
     \c {      \c {
     \c   static pthread_attr_t attr;      \c   static pthread_attr_t attr;
Line 230 
Line 238 
     c-function pthread_mutex_unlock pthread_mutex_unlock a -- n ( mutex -- r )      c-function pthread_mutex_unlock pthread_mutex_unlock a -- n ( mutex -- r )
     c-function pthread-mutex+ pthread_mutex_plus a -- a ( mutex -- mutex' )      c-function pthread-mutex+ pthread_mutex_plus a -- a ( mutex -- mutex' )
     c-function pthread-mutexes pthread_mutexes n -- n ( n -- n' )      c-function pthread-mutexes pthread_mutexes n -- n ( n -- n' )
       c-function pthread-cond+ pthread_cond_plus a -- a ( cond -- cond' )
       c-function pthread-conds pthread_conds n -- n ( n -- n' )
     c-function pause sched_yield -- void ( -- )      c-function pause sched_yield -- void ( -- )
     c-function pthread_detatch_attr pthread_detach_attr -- a ( -- addr )      c-function pthread_detatch_attr pthread_detach_attr -- a ( -- addr )
       c-function pthread_cond_signal pthread_cond_signal a -- n ( cond -- r )
       c-function pthread_cond_broadcast pthread_cond_broadcast a -- n ( cond -- r )
       c-function pthread_cond_wait pthread_cond_wait a a -- n ( cond mutex -- r )
       c-function pthread_cond_timedwait pthread_cond_timedwait a a a -- n ( cond mutex abstime -- r )
     c-function create_pipe create_pipe a -- void ( pipefd[2] -- )      c-function create_pipe create_pipe a -- void ( pipefd[2] -- )
     c-function check_read check_read a -- n ( pipefd -- n )      c-function check_read check_read a -- n ( pipefd -- n )
     c-function wait_read wait_read a n -- n ( pipefd timeout -- n )      c-function wait_read wait_read a n -- n ( pipefd timeout -- n )
Line 293 
Line 307 
     \G create a named semaphore      \G create a named semaphore
     Create here 1 pthread-mutexes allot 0 pthread_mutex_init drop ;      Create here 1 pthread-mutexes allot 0 pthread_mutex_init drop ;
   
   : cond ( "name" -- ) \ gforth
       \G create a named condition
       Create here 1 pthread-conds dup allot erase ;
   
 : lock ( addr -- )  pthread_mutex_lock drop ;  : lock ( addr -- )  pthread_mutex_lock drop ;
 : unlock ( addr -- )  pthread_mutex_unlock drop ;  : unlock ( addr -- )  pthread_mutex_unlock drop ;
   
Line 311 
Line 329 
 Variable event#  1 event# !  Variable event#  1 event# !
   
 User eventbuf# $100 uallot drop \ 256 bytes buffer for atomic event squences  User eventbuf# $100 uallot drop \ 256 bytes buffer for atomic event squences
   -1 eventbuf# !
   
 : <event  eventbuf# off ;  : <event  eventbuf# off ;
 : 'event ( -- addr )  eventbuf# dup @ + cell+ ;  : 'event ( -- addr )  eventbuf# dup @ + cell+ ;
 : event+ ( n -- addr )  : event+ ( n -- addr )
     dup eventbuf# @ + $100 u>= !!ebuffull!! and throw      dup eventbuf# @ + $100 u>= !!ebuffull!! and throw
     'event swap eventbuf# +! ;      'event swap eventbuf# +! ;
 : event> ( task -- )  >r eventbuf# cell+ eventbuf# @  : event> ( task -- )  >r eventbuf# cell+ eventbuf# @ -1 eventbuf# !
     epipew r> >task @ write-file throw ;      epipew r> >task @ write-file throw ;
   
 : event-crash  !!event!! throw ;  : event-crash  !!event!! throw ;
   
 Create event-table $100 0 [DO] ' event-crash , [LOOP]  Create event-table $100 0 [DO] ' event-crash , [LOOP]
   
 : event-does ( -- )  DOES>  @ 'event c! 1 eventbuf# +! ;  : event-does ( task/ -- )  DOES>  @ eventbuf# @ 0< dup >r IF  <event  THEN
       'event c! 1 eventbuf# +!  r> IF  event>  THEN ;
 : event:  Create event# @ ,  event-does  : event:  Create event# @ ,  event-does
     here 0 , >r  noname : lastxt dup event# @ cells event-table + !      here 0 , >r  noname : lastxt dup event# @ cells event-table + !
     r> ! 1 event# +! ;      r> ! 1 event# +! ;

Generate output suitable for use with a patch program
Legend:
Removed from v.1.31  
changed lines
  Added in v.1.32
CVS Admin

Powered by ViewCVS 1.0-dev 		(Powered by ViewCVS)

ViewCVS and CVS Help