[gforth] / gforth / unix / pthread.fs  

gforth: gforth/unix/pthread.fs

Diff for /gforth/unix/pthread.fs between version 1.19 and 1.28

version 1.19, Sun Mar 18 17:35:56 2012 UTC version 1.28, Fri May 4 13:46:41 2012 UTC
Line 24 
Line 24 
     \c #include <unistd.h>      \c #include <unistd.h>
     \c #include <setjmp.h>      \c #include <setjmp.h>
     \c #include <stdio.h>      \c #include <stdio.h>
       \c #include <signal.h>
     \c #define wholepage(n) (((n)+pagesize-1)&~(pagesize-1))      \c #define wholepage(n) (((n)+pagesize-1)&~(pagesize-1))
     \c typedef struct {      \c typedef struct {
     \c   Cell next_task;      \c   Cell next_task;
Line 74 
Line 75 
     \c #elif PAGESIZE      \c #elif PAGESIZE
     \c   pagesize=PAGESIZE; /* in limits.h according to Gallmeister's POSIX.4 book */      \c   pagesize=PAGESIZE; /* in limits.h according to Gallmeister's POSIX.4 book */
     \c #endif      \c #endif
       \c #ifdef SIGSTKSZ
       \c   stack_t sigstack;
       \c   int sas_retval=-1;
       \c #endif
     \c   size_t totalsize;      \c   size_t totalsize;
     \c   Cell a;      \c   Cell a;
     \c   user_area * up0;      \c   user_area * up0;
Line 81 
Line 86 
     \c   Cell rsizep = wholepage(rsize);      \c   Cell rsizep = wholepage(rsize);
     \c   Cell fsizep = wholepage(fsize);      \c   Cell fsizep = wholepage(fsize);
     \c   Cell lsizep = wholepage(lsize);      \c   Cell lsizep = wholepage(lsize);
     \c   totalsize = dsize+fsize+rsize+lsize+6*pagesize;      \c   totalsize = dsizep+fsizep+rsizep+lsizep+6*pagesize;
       \c #ifdef SIGSTKSZ
       \c   totalsize += 2*SIGSTKSZ;
       \c #endif
     \c   a = (Cell)alloc_mmap(totalsize);      \c   a = (Cell)alloc_mmap(totalsize);
     \c   if (a != (Cell)MAP_FAILED) {      \c   if (a != (Cell)MAP_FAILED) {
     \c     up0=(user_area*)a; a+=pagesize;      \c     up0=(user_area*)a; a+=pagesize;
Line 89 
Line 97 
     \c     page_noaccess((void*)a); a+=pagesize; up0->fp0=a+fsize; a+=fsizep;      \c     page_noaccess((void*)a); a+=pagesize; up0->fp0=a+fsize; a+=fsizep;
     \c     page_noaccess((void*)a); a+=pagesize; up0->rp0=a+rsize; a+=rsizep;      \c     page_noaccess((void*)a); a+=pagesize; up0->rp0=a+rsize; a+=rsizep;
     \c     page_noaccess((void*)a); a+=pagesize; up0->lp0=a+lsize; a+=lsizep;      \c     page_noaccess((void*)a); a+=pagesize; up0->lp0=a+lsize; a+=lsizep;
     \c     page_noaccess((void*)a);      \c     page_noaccess((void*)a); a+=pagesize;
       \c #ifdef SIGSTKSZ
       \c     sigstack.ss_sp=(void*)a+SIGSTKSZ;
       \c     sigstack.ss_size=SIGSTKSZ;
       \c     sas_retval=sigaltstack(&sigstack,(stack_t *)0);
       \c #endif
     \c     return (Cell)up0;      \c     return (Cell)up0;
     \c   }      \c   }
     \c   return 0;      \c   return 0;
Line 98 
Line 111 
     \c void gforth_cleanup_thread(void * t)      \c void gforth_cleanup_thread(void * t)
     \c {      \c {
     \c   Cell size = wholepage((Cell)(((user_area*)t)->lp0)+pagesize-(Cell)t);      \c   Cell size = wholepage((Cell)(((user_area*)t)->lp0)+pagesize-(Cell)t);
       \c #ifdef SIGSTKSZ
       \c   size += 2*SIGSTKSZ;
       \c #endif
     \c   munmap(t, size);      \c   munmap(t, size);
     \c }      \c }
     \c      \c
Line 109 
Line 125 
     \c {      \c {
     \c   void *x;      \c   void *x;
     \c   int throw_code;      \c   int throw_code;
       \c   jmp_buf throw_jmp_buf;
     \c #ifndef HAS_BACKLINK      \c #ifndef HAS_BACKLINK
     \c   void *(*gforth_pointers)(Cell) = saved_gforth_pointers;      \c   void *(*gforth_pointers)(Cell) = saved_gforth_pointers;
     \c #endif      \c #endif
       \c   Cell signal_data_stack[24];
       \c   Cell signal_return_stack[16];
       \c   Float signal_fp_stack[1];
       \c   void *ip0=(void*)(t->save_task);
       \c   Cell *sp0=(Cell*)(t->sp0)-1;
       \c   Cell *rp0=(Cell*)(t->rp0);
       \c   Float *fp0=(Float*)(t->fp0);
       \c   void *lp0=(void*)(t->lp0);
       \c
     \c   pthread_cleanup_push(&gforth_cleanup_thread, (void*)t);      \c   pthread_cleanup_push(&gforth_cleanup_thread, (void*)t);
     \c      \c
     \c   if ((throw_code=setjmp(throw_jmp_buf))) {      \c   throw_jmp_handler = &throw_jmp_buf;
     \c     static Cell signal_data_stack[24];      \c   ((Cell*)(t->sp0))[-1]=(Cell)t;
     \c     static Cell signal_return_stack[16];  
     \c     static Float signal_fp_stack[1];  
     \c      \c
       \c   while((throw_code=setjmp(*throw_jmp_handler))) {
     \c     signal_data_stack[15]=throw_code;      \c     signal_data_stack[15]=throw_code;
     \c     x=gforth_engine((Cell*)(t->throw_entry), signal_data_stack+15,      \c     ip0=(void*)(t->throw_entry);
     \c                     signal_return_stack+16, signal_fp_stack, 0);      \c     sp0=signal_data_stack+15;
     \c   } else {      \c     rp0=signal_return_stack+16;
     \c     ((Cell*)(t->sp0))[-1]=(Cell)t;      \c     fp0=signal_fp_stack;
     \c     x=gforth_engine((void*)(t->save_task), (Cell*)(t->sp0)-1, (Cell*)(t->rp0), (Float*)(t->fp0), (void*)(t->lp0));  
     \c   }      \c   }
       \c   x=gforth_engine(ip0, sp0, rp0, fp0, lp0);
     \c   pthread_cleanup_pop(1);      \c   pthread_cleanup_pop(1);
     \c   return x;      \c   pthread_exit(x);
     \c }      \c }
     \c #ifdef HAS_BACKLINK      \c #ifdef HAS_BACKLINK
     \c void *gforth_thread_p()      \c void *gforth_thread_p()
Line 158 
Line 183 
     \c {      \c {
     \c   return thread*(int)sizeof(pthread_mutex_t);      \c   return thread*(int)sizeof(pthread_mutex_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 void create_pipe(FILE ** addr)
       \c {
       \c   int epipe[2];
       \c   pipe(epipe);
       \c   addr[0]=fdopen(epipe[0], "r");
       \c   addr[1]=fdopen(epipe[1], "a");
       \c   setvbuf(addr[1], NULL, _IONBF, 0);
       \c }
       \c #include <sys/ioctl.h>
       \c #include <errno.h>
       \c int check_read(FILE * fid)
       \c {
       \c   int pipe = fileno(fid);
       \c   int chars_avail;
       \c   int result = ioctl(pipe, FIONREAD, &chars_avail);
       \c   return (result==-1) ? -errno : chars_avail;
       \c }
       \c #include <poll.h>
       \c int wait_read(FILE * fid, Cell timeout)
       \c {
       \c   struct pollfd fds = { fileno(fid), POLLIN, 0 };
       \c #ifdef linux
       \c   struct timespec tout = { timeout/1000000000, timeout%1000000000 };
       \c   ppoll(&fds, 1, &tout, 0);
       \c #else
       \c   poll(&fds, 1, timeout/1000000);
       \c #endif
       \c   return check_read(fid);
       \c }
     c-function pthread+ pthread_plus a -- a ( addr -- addr' )      c-function pthread+ pthread_plus a -- a ( addr -- addr' )
     c-function pthreads pthreads n -- n ( n -- n' )      c-function pthreads pthreads n -- n ( n -- n' )
     c-function thread_start gforth_thread_p -- a ( -- addr )      c-function thread_start gforth_thread_p -- a ( -- addr )
Line 169 
Line 230 
     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 pause pthread_yield -- void ( -- )      c-function pause sched_yield -- void ( -- )
       c-function pthread_detatch_attr pthread_detach_attr -- a ( -- addr )
       c-function create_pipe create_pipe a -- void ( pipefd[2] -- )
       c-function check_read check_read a -- n ( pipefd -- n )
       c-function wait_read wait_read a n -- n ( pipefd timeout -- n )
 end-c-library  end-c-library
   
 User pthread-id  -1 cells pthread+ uallot drop  User pthread-id  -1 cells pthread+ uallot drop
   User epiper
   User epipew
   
   epiper create_pipe \ create pipe for main task
   
 :noname    ' >body @ ;  :noname    ' >body @ ;
 :noname    ' >body @ postpone literal ;  :noname    ' >body @ postpone literal ;
Line 182 
Line 251 
 : >task ( user task -- user' )  + next-task - ;  : >task ( user task -- user' )  + next-task - ;
   
 : kill-task ( -- )  : kill-task ( -- )
     0 (bye) ;      epiper @ close-file drop   epipew @ close-file drop  0 (bye) ;
   
 :noname ( -- )  :noname ( -- )
     [ here throw-entry ! ]      [ here throw-entry ! ]
Line 197 
Line 266 
     throw-entry r@ udp @ throw-entry next-task - /string move      throw-entry r@ udp @ throw-entry next-task - /string move
     word-pno-size chars dup allocate throw dup holdbufptr r@ >task !      word-pno-size chars dup allocate throw dup holdbufptr r@ >task !
     + dup holdptr r@ >task !  holdend r@ >task !      + dup holdptr r@ >task !  holdend r@ >task !
       epiper r@ >task create_pipe
     ['] kill-task >body  rp0 r@ >task @ 1 cells - dup rp0 r@ >task ! !      ['] kill-task >body  rp0 r@ >task @ 1 cells - dup rp0 r@ >task ! !
     handler r@ >task off      handler r@ >task off
     r> ;      r> ;
Line 205 
Line 275 
   
 : (activate) ( task -- )  : (activate) ( task -- )
     r> swap >r  save-task r@ >task !      r> swap >r  save-task r@ >task !
     pthread-id r@ >task 0 thread_start r> pthread_create drop ; compile-only      pthread-id r@ >task pthread_detatch_attr thread_start r> pthread_create drop ; compile-only
   
 : activate ( task -- )  : activate ( task -- )
     ]] (activate) up! [[ ; immediate compile-only      ]] (activate) up! [[ ; immediate compile-only
Line 233 
Line 303 
     2swap swap sp0 @ $FFF and -$1000 or + swap 2swap      2swap swap sp0 @ $FFF and -$1000 or + swap 2swap
     swap       fp0 @ $FFF and -$1000 or + swap ;      swap       fp0 @ $FFF and -$1000 or + swap ;
   
   \ event handling
   
   s" Undefined event"   exception Constant !!event!!
   s" Event buffer full" exception Constant !!ebuffull!!
   
   Variable event#  1 event# !
   
   User eventbuf# $100 uallot drop \ 256 bytes buffer for atomic event squences
   
   : <event  eventbuf# off ;
   : 'event ( -- addr )  eventbuf# dup @ + cell+ ;
   : event+ ( n -- addr )
       dup eventbuf# @ + $100 u>= !!ebuffull!! and throw
       'event swap eventbuf# +! ;
   : event> ( task -- )  >r eventbuf# cell+ eventbuf# @
       epipew r> >task @ write-file throw ;
   
   : event-crash  !!event!! throw ;
   
   Create event-table $100 0 [DO] ' event-crash , [LOOP]
   
   : event-does ( -- )  DOES>  @ 'event c! 1 eventbuf# +! ;
   : event:  Create event# @ ,  event-does
       here 0 , >r  noname : lastxt dup event# @ cells event-table + !
       r> ! 1 event# +! ;
   : stop ( -- )  epiper @ key-file cells event-table + perform ;
   : stop-ns ( timeout -- ) epiper @ swap wait_read 0> IF  stop  THEN ;
   : event? ( -- flag )  epiper @ check_read 0> ;
   : ?events ( -- )  BEGIN  event?  WHILE  stop  REPEAT ;
   : event-loop ( -- )  BEGIN  stop  AGAIN ;
   
   event: elit  0  sp@ cell  epiper @ read-file throw drop ;
   event: eflit 0e fp@ float epiper @ read-file throw drop ;
   event: wake-ev ;
   event: sleep-ev  stop ;
   
   : wake ( task -- )  <event wake-ev event> ;
   : sleep ( task -- ) <event sleep-ev event> ;
   
   : elit,  ( x -- ) elit cell event+ [ cell 8 = ] [IF] x! [ELSE] l! [THEN] ;
   : e$, ( addr u -- )  swap elit, elit, ;
   : eflit, ( x -- ) eflit fp@ float event+ float move fdrop ;
   
   false [IF] \ event test
       <event 1234 elit, next-task event> ?event 1234 = [IF] ." event ok" cr [THEN]
   [THEN]
   
 false [IF] \ test  false [IF] \ test
     semaphore testsem      semaphore testsem
   
     : test-thread1      : test-thread1
         stacksize NewTask activate  0 hex          stacksize4 NewTask4 activate  0 hex
         BEGIN          BEGIN
             testsem lock              testsem lock
             ." Thread-Test1 " dup . cr 1000 ms              ." Thread-Test1 " dup . cr 1000 ms
Line 246 
Line 363 
         AGAIN ;          AGAIN ;
   
     : test-thread2      : test-thread2
         stacksize NewTask activate  0 decimal          stacksize4 NewTask4 activate  0 decimal
         BEGIN          BEGIN
             testsem lock              testsem lock
             ." Thread-Test2 " dup . cr 1000 ms              ." Thread-Test2 " dup . cr 1000 ms

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

Powered by ViewCVS 1.0-dev 		(Powered by ViewCVS)

ViewCVS and CVS Help