[gforth] / gforth / unix / pthread.fs  

gforth: gforth/unix/pthread.fs

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

version 1.14, Fri Mar 16 21:32:03 2012 UTC version 1.19, Sun Mar 18 17:35:56 2012 UTC
Line 77 
Line 77 
     \c   size_t totalsize;      \c   size_t totalsize;
     \c   Cell a;      \c   Cell a;
     \c   user_area * up0;      \c   user_area * up0;
     \c   dsize = wholepage(dsize);      \c   Cell dsizep = wholepage(dsize);
     \c   rsize = wholepage(rsize);      \c   Cell rsizep = wholepage(rsize);
     \c   fsize = wholepage(fsize);      \c   Cell fsizep = wholepage(fsize);
     \c   lsize = wholepage(lsize);      \c   Cell lsizep = wholepage(lsize);
     \c   totalsize = dsize+fsize+rsize+lsize+6*pagesize;      \c   totalsize = dsize+fsize+rsize+lsize+6*pagesize;
     \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;
     \c     page_noaccess((void*)a); a+=pagesize; a+=dsize; up0->sp0=a;      \c     page_noaccess((void*)a); a+=pagesize; up0->sp0=a+dsize; a+=dsizep;
     \c     page_noaccess((void*)a); a+=pagesize; a+=fsize; up0->fp0=a;      \c     page_noaccess((void*)a); a+=pagesize; up0->fp0=a+fsize; a+=fsizep;
     \c     page_noaccess((void*)a); a+=pagesize; a+=rsize; up0->rp0=a;      \c     page_noaccess((void*)a); a+=pagesize; up0->rp0=a+rsize; a+=rsizep;
     \c     page_noaccess((void*)a); a+=pagesize; a+=lsize; up0->lp0=a;      \c     page_noaccess((void*)a); a+=pagesize; up0->lp0=a+lsize; a+=lsizep;
     \c     page_noaccess((void*)a);      \c     page_noaccess((void*)a);
     \c     return (Cell)up0;      \c     return (Cell)up0;
     \c   }      \c   }
Line 101 
Line 101 
     \c   munmap(t, size);      \c   munmap(t, size);
     \c }      \c }
     \c      \c
     \c extern __thread jmp_buf throw_jmp_buf;      \c #ifndef HAS_BACKLINK
       \c static void *(*saved_gforth_pointers)(Cell);
       \c #endif
     \c      \c
     \c void *gforth_thread(user_area * t)      \c void *gforth_thread(user_area * t)
     \c {      \c {
     \c   void *x;      \c   void *x;
     \c   int throw_code;      \c   int throw_code;
     \c   gforth_UP = (char*)((void*)t);      \c #ifndef HAS_BACKLINK
       \c   void *(*gforth_pointers)(Cell) = saved_gforth_pointers;
       \c #endif
     \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   if ((throw_code=setjmp(throw_jmp_buf))) {
Line 117 
Line 121 
     \c      \c
     \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     x=gforth_engine((Cell*)(t->throw_entry), signal_data_stack+15,
     \c                     signal_return_stack+16, signal_fp_stack, 0, (char*)(t->save_task));      \c                     signal_return_stack+16, signal_fp_stack, 0);
     \c   } else {      \c   } else {
     \c     x=gforth_engine(*(void**)(t->save_task), (Cell*)(t->sp0), (Cell*)(t->rp0), (Float*)(t->fp0), (void*)(t->lp0), (char*)(t->save_task));      \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   pthread_cleanup_pop(1);
     \c   return x;      \c   return x;
     \c }      \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 158 
Line 172 
     c-function pause pthread_yield -- void ( -- )      c-function pause pthread_yield -- void ( -- )
 end-c-library  end-c-library
   
 User saved-ip  
 User saved-up  
 User pthread-id  -1 cells pthread+ uallot drop  User pthread-id  -1 cells pthread+ uallot drop
 User thread-retval  
   
 saved-ip save-task !  
   
 :noname    ' >body @ ;  :noname    ' >body @ ;
 :noname    ' >body @ postpone literal ;  :noname    ' >body @ postpone literal ;
Line 175 
Line 184 
 : kill-task ( -- )  : kill-task ( -- )
     0 (bye) ;      0 (bye) ;
   
 : thread-throw ( -- )  :noname ( -- )
     [ here throw-entry ! ]      [ here throw-entry ! ]
     handler @ ?dup-0=-IF      handler @ ?dup-0=-IF
         >stderr cr ." uncaught thread exception: " .error cr          >stderr cr ." uncaught thread exception: " .error cr
         0 (bye)          kill-task
     THEN      THEN
     (throw1) ;      (throw1) ; drop
   
 : NewTask4 ( dsize rsize fsize lsize -- task )  : NewTask4 ( dsize rsize fsize lsize -- task )
     gforth_create_thread >r      gforth_create_thread >r
     throw-entry r@ udp @ throw-entry next-task - /string move      throw-entry r@ udp @ throw-entry next-task - /string move
     saved-ip r@ >task save-task r@ >task !  
     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 !
     ['] kill-task >body  rp0 r@ >task @ 1 cells - dup rp0 r@ >task ! !      ['] kill-task >body  rp0 r@ >task @ 1 cells - dup rp0 r@ >task ! !
Line 195 
Line 203 
   
 : NewTask ( stacksize -- task )  dup 2dup NewTask4 ;  : 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 ( task -- )  : activate ( task -- )
     r> swap >r  saved-ip r@ >task !      ]] (activate) up! [[ ; immediate compile-only
     pthread-id r@ >task 0 thread_start r> pthread_create drop ;  
   
 : (pass) ( x1 .. xn n task -- )  : (pass) ( x1 .. xn n task -- )
     r> swap >r  saved-ip r@ >task !      r> swap >r  save-task r@ >task !
     1+ dup cells negate  sp0 r@ >task @ -rot  sp0 r@ >task +!      1+ dup cells negate  sp0 r@ >task @ -rot  sp0 r@ >task +!
     sp0 r@ >task @ swap 0 ?DO  tuck ! cell+  LOOP  drop      sp0 r@ >task @ swap 0 ?DO  tuck ! cell+  LOOP  drop
     pthread-id r@ >task 0 thread_start r> pthread_create drop ;      pthread-id r@ >task 0 thread_start r> pthread_create drop ; compile-only
   
 : pass  ]] (pass) sp0 ! [[ ; immediate  : pass ( x1 .. xn n task -- )
       ]] (pass) up! sp0 ! [[ ; immediate compile-only
   
 : sema ( "name" -- ) \ gforth  : sema ( "name" -- ) \ gforth
     \G create a named semaphore      \G create a named semaphore
Line 214 
Line 226 
 : 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 + @ ;  : stacksize ( -- n ) forthstart 4 cells + @
       sp0 @ $FFF and -$1000 or + ;
 : stacksize4 ( -- dsize rsize fsize lsize )  : stacksize4 ( -- dsize rsize fsize lsize )
     forthstart 4 cells + 4 cells bounds DO  I @  cell +LOOP ;      forthstart 4 cells + 4 cells bounds DO  I @  cell +LOOP
       2swap swap sp0 @ $FFF and -$1000 or + swap 2swap
       swap       fp0 @ $FFF and -$1000 or + swap ;
   
 false [IF] \ test  false [IF] \ test
     semaphore testsem      semaphore testsem

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

Powered by ViewCVS 1.0-dev 		(Powered by ViewCVS)

ViewCVS and CVS Help