/[guile]/guile/guile-core/libguile/threads.c
ViewVC logotype

Diff of /guile/guile-core/libguile/threads.c

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.39 by mdj, Wed Dec 11 06:54:59 2002 UTC revision 1.40 by mdj, Sun Dec 15 14:24:34 2002 UTC
# Line 490  SCM_DEFINE (scm_join_thread, "join-threa Line 490  SCM_DEFINE (scm_join_thread, "join-threa
490  }  }
491  #undef FUNC_NAME  #undef FUNC_NAME
492    
493    SCM *scm_loc_sys_thread_handler;
494    
495    SCM
496    scm_i_make_future (SCM thunk)
497    {
498      SCM_RETURN_NEWSMOB2 (scm_tc16_future,
499                           create_thread ((scm_t_catch_body) scm_call_0,
500                                          thunk,
501                                          (scm_t_catch_handler) scm_apply_1,
502                                          *scm_loc_sys_thread_handler,
503                                          scm_cons (thunk,
504                                                    *scm_loc_sys_thread_handler)),
505                           scm_make_rec_mutex ());
506    }
507    
508    static size_t
509    future_free (SCM future)
510    {
511      scm_rec_mutex_free (SCM_FUTURE_MUTEX (future));
512      return 0;
513    }
514    
515    static int
516    future_print (SCM exp, SCM port, scm_print_state *pstate)
517    {
518      int writingp = SCM_WRITINGP (pstate);
519      scm_puts ("#<future ", port);
520      SCM_SET_WRITINGP (pstate, 1);
521      scm_iprin1 (SCM_FUTURE_DATA (exp), port, pstate);
522      SCM_SET_WRITINGP (pstate, writingp);
523      scm_putc ('>', port);
524      return !0;
525    }
526    
527    SCM_DEFINE (scm_future_ref, "future-ref", 1, 0, 0,
528                (SCM future),
529                "If the future @var{x} has not been computed yet, compute and\n"
530                "return @var{x}, otherwise just return the previously computed\n"
531                "value.")
532    #define FUNC_NAME s_scm_future_ref
533    {
534      SCM_VALIDATE_FUTURE (1, future);
535      scm_rec_mutex_lock (SCM_FUTURE_MUTEX (future));
536      if (!SCM_FUTURE_COMPUTED_P (future))
537        {
538          SCM value = scm_join_thread (SCM_FUTURE_DATA (future));
539          if (!SCM_FUTURE_COMPUTED_P (future))
540            {
541              SCM_SET_FUTURE_DATA (future, value);
542              SCM_SET_FUTURE_COMPUTED (future);
543            }
544        }
545      scm_rec_mutex_unlock (SCM_FUTURE_MUTEX (future));
546      return SCM_FUTURE_DATA (future);
547    }
548    #undef FUNC_NAME
549    
550  /*** Fair mutexes */  /*** Fair mutexes */
551    
552  /* We implement our own mutex type since we want them to be 'fair', we  /* We implement our own mutex type since we want them to be 'fair', we
# Line 1068  scm_mutex_lock (scm_t_mutex *m) Line 1125  scm_mutex_lock (scm_t_mutex *m)
1125    return res;    return res;
1126  }  }
1127    
1128    scm_t_rec_mutex *
1129    scm_make_rec_mutex ()
1130    {
1131      scm_t_rec_mutex *m = scm_malloc (sizeof (scm_t_rec_mutex));
1132      scm_i_plugin_rec_mutex_init (m, &scm_i_plugin_rec_mutex);
1133      return m;
1134    }
1135    
1136    void
1137    scm_rec_mutex_free (scm_t_rec_mutex *m)
1138    {
1139      scm_i_plugin_rec_mutex_destroy (m);
1140      free (m);
1141    }
1142    
1143    int
1144    scm_rec_mutex_lock (scm_t_rec_mutex *m)
1145    {
1146      scm_thread *t = scm_i_leave_guile ();
1147      int res = scm_i_plugin_rec_mutex_lock (m);
1148      scm_i_enter_guile (t);
1149      return res;  
1150    }
1151    
1152  int  int
1153  scm_cond_wait (scm_t_cond *c, scm_t_mutex *m)  scm_cond_wait (scm_t_cond *c, scm_t_mutex *m)
1154  {  {
# Line 1166  scm_c_thread_exited_p (SCM thread) Line 1247  scm_c_thread_exited_p (SCM thread)
1247    
1248  static scm_t_cond wake_up_cond;  static scm_t_cond wake_up_cond;
1249  int scm_i_thread_go_to_sleep;  int scm_i_thread_go_to_sleep;
1250  static scm_t_mutex gc_section_mutex;  static scm_t_rec_mutex gc_section_mutex;
 static scm_thread *gc_section_owner;  
1251  static int gc_section_count = 0;  static int gc_section_count = 0;
1252  static int threads_initialized_p = 0;  static int threads_initialized_p = 0;
1253    
1254  void  void
1255  scm_i_thread_put_to_sleep ()  scm_i_thread_put_to_sleep ()
1256  {  {
1257    SCM_REC_CRITICAL_SECTION_START (gc_section);    scm_rec_mutex_lock (&gc_section_mutex);
1258    if (threads_initialized_p && gc_section_count == 1)    if (threads_initialized_p && !gc_section_count++)
1259      {      {
1260        SCM threads;        SCM threads;
1261        scm_i_plugin_mutex_lock (&thread_admin_mutex);        scm_i_plugin_mutex_lock (&thread_admin_mutex);
# Line 1209  scm_i_thread_invalidate_freelists () Line 1289  scm_i_thread_invalidate_freelists ()
1289  void  void
1290  scm_i_thread_wake_up ()  scm_i_thread_wake_up ()
1291  {  {
1292    if (threads_initialized_p && gc_section_count == 1)    if (threads_initialized_p && !--gc_section_count)
1293      {      {
1294        SCM threads;        SCM threads;
1295        /* Need to lock since woken threads can die and be deleted from list */        /* Need to lock since woken threads can die and be deleted from list */
# Line 1224  scm_i_thread_wake_up () Line 1304  scm_i_thread_wake_up ()
1304            }            }
1305        scm_i_plugin_mutex_unlock (&thread_admin_mutex);        scm_i_plugin_mutex_unlock (&thread_admin_mutex);
1306      }      }
1307    SCM_REC_CRITICAL_SECTION_END (gc_section);    scm_rec_mutex_unlock (&gc_section_mutex);
1308  }  }
1309    
1310  void  void
# Line 1236  scm_i_thread_sleep_for_gc () Line 1316  scm_i_thread_sleep_for_gc ()
1316    resume (t);    resume (t);
1317  }  }
1318    
 /* The mother of all recursive critical sections */  
 scm_t_mutex scm_i_section_mutex;  
   
1319  scm_t_mutex scm_i_critical_section_mutex;  scm_t_mutex scm_i_critical_section_mutex;
1320  scm_t_mutex scm_i_defer_mutex;  scm_t_rec_mutex scm_i_defer_mutex;
1321  int scm_i_defer_count = 0;  
1322  scm_thread *scm_i_defer_owner = 0;  #ifdef USE_PTHREAD_THREADS
1323    #include "libguile/pthread-threads.c"
1324    #endif
1325    
1326  /*** Initialization */  /*** Initialization */
1327    
# Line 1250  void Line 1329  void
1329  scm_threads_prehistory ()  scm_threads_prehistory ()
1330  {  {
1331    scm_thread *t;    scm_thread *t;
1332    scm_i_plugin_mutex_init (&thread_admin_mutex, 0);    scm_i_plugin_mutex_init (&thread_admin_mutex, &scm_i_plugin_mutex);
1333    scm_i_plugin_mutex_init (&gc_section_mutex, 0);    scm_i_plugin_rec_mutex_init (&gc_section_mutex, &scm_i_plugin_rec_mutex);
1334    scm_i_plugin_cond_init (&wake_up_cond, 0);    scm_i_plugin_cond_init (&wake_up_cond, 0);
1335    scm_i_plugin_mutex_init (&scm_i_critical_section_mutex, 0);    scm_i_plugin_mutex_init (&scm_i_critical_section_mutex, &scm_i_plugin_mutex);
1336    thread_count = 1;    thread_count = 1;
1337    scm_i_plugin_key_create (&scm_i_thread_key, 0);    scm_i_plugin_key_create (&scm_i_thread_key, 0);
1338    scm_i_plugin_key_create (&scm_i_root_state_key, 0);    scm_i_plugin_key_create (&scm_i_root_state_key, 0);
1339    scm_i_plugin_mutex_init (&scm_i_defer_mutex, 0);    scm_i_plugin_rec_mutex_init (&scm_i_defer_mutex, &scm_i_plugin_rec_mutex);
   scm_i_plugin_mutex_init (&scm_i_section_mutex, 0);  
1340    /* Allocate a fake thread object to be used during bootup. */    /* Allocate a fake thread object to be used during bootup. */
1341    t = malloc (sizeof (scm_thread));    t = malloc (sizeof (scm_thread));
1342    t->base = NULL;    t->base = NULL;
1343    t->clear_freelists_p = 0;    t->clear_freelists_p = 0;
1344    scm_setspecific (scm_i_thread_key, t);    scm_setspecific (scm_i_thread_key, t);
1345    #ifdef USE_PTHREAD_THREADS
1346      scm_init_pthread_threads ();
1347    #endif  
1348  }  }
1349    
1350  scm_t_bits scm_tc16_thread;  scm_t_bits scm_tc16_thread;
1351    scm_t_bits scm_tc16_future;
1352  scm_t_bits scm_tc16_mutex;  scm_t_bits scm_tc16_mutex;
1353  scm_t_bits scm_tc16_fair_mutex;  scm_t_bits scm_tc16_fair_mutex;
1354  scm_t_bits scm_tc16_condvar;  scm_t_bits scm_tc16_condvar;
# Line 1305  scm_init_threads (SCM_STACKITEM *base) Line 1387  scm_init_threads (SCM_STACKITEM *base)
1387    
1388    scm_set_smob_mark (scm_tc16_fair_condvar, fair_cond_mark);    scm_set_smob_mark (scm_tc16_fair_condvar, fair_cond_mark);
1389    
1390      scm_tc16_future = scm_make_smob_type ("future", 0);
1391      scm_set_smob_mark (scm_tc16_future, scm_markcdr);
1392      scm_set_smob_free (scm_tc16_future, future_free);
1393      scm_set_smob_print (scm_tc16_future, future_print);
1394    
1395    threads_initialized_p = 1;    threads_initialized_p = 1;
1396  }  }
1397    
1398  void  void
1399  scm_init_thread_procs ()  scm_init_thread_procs ()
1400  {  {
1401      scm_loc_sys_thread_handler
1402        = SCM_VARIABLE_LOC (scm_c_define ("%thread-handler", SCM_BOOL_F));
1403  #include "libguile/threads.x"  #include "libguile/threads.x"
1404  }  }
1405    

Legend:
Removed from v.1.39  
changed lines
  Added in v.1.40

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26