[gforth] / gforth / unix / pthread.fs  

gforth: gforth/unix/pthread.fs

Diff for /gforth/unix/pthread.fs between version 1.6 and 1.18

version 1.6, Wed Mar 14 23:06:25 2012 UTC version 1.18, Sat Mar 17 22:18:59 2012 UTC
Line 22 
Line 22 
     \c #include <limits.h>      \c #include <limits.h>
     \c #include <sys/mman.h>      \c #include <sys/mman.h>
     \c #include <unistd.h>      \c #include <unistd.h>
       \c #include <setjmp.h>
       \c #include <stdio.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 data_stack_size;      \c   Cell next_task;
     \c   Cell fp_stack_size;      \c   Cell prev_task;
     \c   Cell return_stack_size;      \c   Cell save_task;
     \c   Cell locals_stack_size;      \c   Cell sp0, rp0, fp0, lp0;
     \c   Cell sp0, fp0, rp0, lp0;      \c   Cell throw_entry;
     \c   Cell boot_entry;      \c } user_area;
     \c   Cell saved_ip, saved_rp;  
     \c } threadId;  
     \c int pagesize = 1;      \c int pagesize = 1;
     \c void page_noaccess(void *a)      \c void page_noaccess(void *a)
     \c {      \c {
Line 65 
Line 65 
     \c   return r;      \c   return r;
     \c }      \c }
     \c      \c
     \c int gforth_create_thread(threadId * t)      \c Cell gforth_create_thread(Cell dsize, Cell rsize, Cell fsize, Cell lsize)
     \c {      \c {
     \c #if HAVE_GETPAGESIZE      \c #if HAVE_GETPAGESIZE
     \c   pagesize=getpagesize(); /* Linux/GNU libc offers this */      \c   pagesize=getpagesize(); /* Linux/GNU libc offers this */
Line 74 
Line 74 
     \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   Cell dsize = wholepage(t->data_stack_size);      \c   size_t totalsize;
     \c   Cell rsize = wholepage(t->return_stack_size);      \c   Cell a;
     \c   Cell fsize = wholepage(t->fp_stack_size);      \c   user_area * up0;
     \c   Cell lsize = wholepage(t->locals_stack_size);      \c   dsize = wholepage(dsize);
     \c   size_t totalsize = dsize+fsize+rsize+lsize+5*pagesize;      \c   rsize = wholepage(rsize);
     \c   Cell a = (Cell)alloc_mmap(totalsize);      \c   fsize = wholepage(fsize);
       \c   lsize = wholepage(lsize);
       \c   totalsize = dsize+fsize+rsize+lsize+6*pagesize;
       \c   a = (Cell)alloc_mmap(totalsize);
     \c   if (a != (Cell)MAP_FAILED) {      \c   if (a != (Cell)MAP_FAILED) {
     \c     page_noaccess((void*)a); a+=pagesize; a+=dsize; t->sp0=a;      \c     up0=(user_area*)a; a+=pagesize;
     \c     page_noaccess((void*)a); a+=pagesize; a+=fsize; t->fp0=a;      \c     page_noaccess((void*)a); a+=pagesize; a+=dsize; up0->sp0=a;
     \c     page_noaccess((void*)a); a+=pagesize; a+=rsize; t->rp0=a;      \c     page_noaccess((void*)a); a+=pagesize; a+=fsize; up0->fp0=a;
     \c     page_noaccess((void*)a); a+=pagesize; a+=lsize; t->lp0=a;      \c     page_noaccess((void*)a); a+=pagesize; a+=rsize; up0->rp0=a;
       \c     page_noaccess((void*)a); a+=pagesize; a+=lsize; up0->lp0=a;
     \c     page_noaccess((void*)a);      \c     page_noaccess((void*)a);
     \c     return 1;      \c     return (Cell)up0;
     \c   }      \c   }
     \c   return 0;      \c   return 0;
     \c }      \c }
     \c      \c
     \c void *gforth_thread(threadId * t)      \c void gforth_cleanup_thread(void * t)
     \c {      \c {
     \c   if(gforth_create_thread(t)) {      \c   Cell size = wholepage((Cell)(((user_area*)t)->lp0)+pagesize-(Cell)t);
     \c     return gforth_engine((void*)(t->boot_entry), (Cell*)(t->sp0), (Cell*)(t->rp0), (Float*)(t->fp0), (void*)(t->lp0), (char*)&(t->saved_ip));      \c   munmap(t, size);
     \c   }      \c   }
     \c   return NULL;      \c
       \c #ifndef HAS_BACKLINK
       \c static void *(*saved_gforth_pointers)(Cell);
       \c #endif
       \c
       \c void *gforth_thread(user_area * t)
       \c {
       \c   void *x;
       \c   int throw_code;
       \c #ifndef HAS_BACKLINK
       \c   void *(*gforth_pointers)(Cell) = saved_gforth_pointers;
       \c #endif
       \c   pthread_cleanup_push(&gforth_cleanup_thread, (void*)t);
       \c
       \c   if ((throw_code=setjmp(throw_jmp_buf))) {
       \c     static Cell signal_data_stack[24];
       \c     static Cell signal_return_stack[16];
       \c     static Float signal_fp_stack[1];
       \c
       \c     signal_data_stack[15]=throw_code;
       \c     x=gforth_engine((Cell*)(t->throw_entry), signal_data_stack+15,
       \c                     signal_return_stack+16, signal_fp_stack, 0);
       \c   } else {
       \c     ((Cell*)(t->sp0))[-1]=(Cell)t;
       \c     x=gforth_engine((void*)(t->save_task), (Cell*)(t->sp0)-1, (Cell*)(t->rp0), (Float*)(t->fp0), (void*)(t->lp0));
     \c }      \c }
       \c   pthread_cleanup_pop(1);
       \c   return x;
       \c }
       \c #ifdef HAS_BACKLINK
     \c void *gforth_thread_p()      \c void *gforth_thread_p()
     \c {      \c {
     \c   return (void*)&gforth_thread;      \c   return (void*)&gforth_thread;
     \c }      \c }
       \c #else
       \c #define gforth_thread_p() gforth_thread_ptr(gforth_pointers)
       \c void *gforth_thread_ptr(GFORTH_ARGS)
       \c {
       \c   saved_gforth_pointers=gforth_pointers;
       \c   return (void*)&gforth_thread;
       \c }
       \c #endif
     \c void *pthread_plus(void * thread)      \c void *pthread_plus(void * thread)
     \c {      \c {
     \c   return thread+sizeof(pthread_t);      \c   return thread+sizeof(pthread_t);
Line 121 
Line 161 
     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 )
       c-function gforth_create_thread gforth_create_thread n n n n -- a ( dsize rsize fsize lsize -- task )
     c-function pthread_create pthread_create a a a a -- n ( thread attr start arg )      c-function pthread_create pthread_create a a a a -- n ( thread attr start arg )
     c-function pthread_exit pthread_exit a -- void ( retaddr -- )      c-function pthread_exit pthread_exit a -- void ( retaddr -- )
     c-function pthread_mutex_init pthread_mutex_init a a -- n ( mutex addr -- r )      c-function pthread_mutex_init pthread_mutex_init a a -- n ( mutex addr -- r )
Line 131 
Line 172 
     c-function pause pthread_yield -- void ( -- )      c-function pause pthread_yield -- void ( -- )
 end-c-library  end-c-library
   
 begin-structure threadId  User pthread-id  -1 cells pthread+ uallot drop
 field: data_stack_size  
 field: fp_stack_size  :noname    ' >body @ ;
 field: return_stack_size  :noname    ' >body @ postpone literal ;
 field: locals_stack_size  interpret/compile: user' ( 'user' -- n )
 field: t_sp0  \G USER' computes the task offset of a user variable
 field: t_fp0  
 field: t_rp0  : >task ( user task -- user' )  + next-task - ;
 field: t_lp0  
 field: boot_entry  : kill-task ( -- )
 field: saved_ip      0 (bye) ;
 field: saved_rp  
 1 pthreads +field t_pthread  :noname ( -- )
 end-structure      [ here throw-entry ! ]
       handler @ ?dup-0=-IF
 : new-thread ( xt -- id )          >stderr cr ." uncaught thread exception: " .error cr
     threadId allocate throw >r          kill-task
     forthstart 3 cells + r@ 4 cells move      THEN
     >body r@ boot_entry !      (throw1) ; drop
     r@ t_pthread 0 thread_start r@ pthread_create  
     drop \ fixme  : NewTask4 ( dsize rsize fsize lsize -- task )
       gforth_create_thread >r
       throw-entry r@ udp @ throw-entry next-task - /string move
       word-pno-size chars dup allocate throw dup holdbufptr r@ >task !
       + dup holdptr r@ >task !  holdend r@ >task !
       ['] kill-task >body  rp0 r@ >task @ 1 cells - dup rp0 r@ >task ! !
       handler r@ >task off
     r> ;      r> ;
   
 : semaphore ( "name" -- )  : NewTask ( stacksize -- task )  dup 2dup NewTask4 ;
   
   : (activate) ( task -- )
       r> swap >r  save-task r@ >task !
       pthread-id r@ >task 0 thread_start r> pthread_create drop ; compile-only
   
   : activate  ]] (activate) up! [[ ; immediate compile-only
   
   : (pass) ( x1 .. xn n task -- )
       r> swap >r  save-task r@ >task !
       1+ dup cells negate  sp0 r@ >task @ -rot  sp0 r@ >task +!
       sp0 r@ >task @ swap 0 ?DO  tuck ! cell+  LOOP  drop
       pthread-id r@ >task 0 thread_start r> pthread_create drop ; compile-only
   
   : pass  ]] (pass) up! sp0 ! [[ ; immediate compile-only
   
   : sema ( "name" -- ) \ gforth
       \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 ;
   
 : lock ( addr -- )  pthread_mutex_lock drop ;  : lock ( addr -- )  pthread_mutex_lock drop ;
 : unlock ( addr -- )  pthread_mutex_unlock drop ;  : unlock ( addr -- )  pthread_mutex_unlock drop ;
   
   : stacksize ( -- n ) forthstart 4 cells + @ ;
   : stacksize4 ( -- dsize rsize fsize lsize )
       forthstart 4 cells + 4 cells bounds DO  I @  cell +LOOP ;
   
 false [IF] \ test  false [IF] \ test
     semaphore testsem      semaphore testsem
   
     : test-thread1      : test-thread1
           stacksize NewTask activate  0 hex
         BEGIN          BEGIN
             testsem lock              testsem lock
             ." Thread-Test1" cr 1000 ms              ." Thread-Test1 " dup . cr 1000 ms
             testsem unlock              testsem unlock  1+
             100 0 DO  pause  LOOP              100 0 DO  pause  LOOP
         AGAIN ;          AGAIN ;
   
     : test-thread2      : test-thread2
           stacksize NewTask activate  0 decimal
         BEGIN          BEGIN
             testsem lock              testsem lock
             ." Thread-Test2" cr 1000 ms              ." Thread-Test2 " dup . cr 1000 ms
             testsem unlock              testsem unlock  1+
             100 0 DO  pause  LOOP              100 0 DO  pause  LOOP
         AGAIN ;          AGAIN ;
   
     ' test-thread1 new-thread Constant test-id1      test-thread1
     ' test-thread2 new-thread Constant test-id2      test-thread2
 [THEN]  [THEN]

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

Powered by ViewCVS 1.0-dev 		(Powered by ViewCVS)

ViewCVS and CVS Help