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

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

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

revision 1.53 by mvo, Sun Oct 27 20:13:24 2002 UTC revision 1.54 by mvo, Sun Nov 3 22:05:09 2002 UTC
# Line 1477  SCM_DEFINE (scm_sys_invalidate_class, "% Line 1477  SCM_DEFINE (scm_sys_invalidate_class, "%
1477  static scm_t_bits **hell;  static scm_t_bits **hell;
1478  static long n_hell = 1;         /* one place for the evil one himself */  static long n_hell = 1;         /* one place for the evil one himself */
1479  static long hell_size = 4;  static long hell_size = 4;
 #ifdef USE_THREADS  
1480  static SCM hell_mutex;  static SCM hell_mutex;
 #endif  
1481    
1482  static long  static long
1483  burnin (SCM o)  burnin (SCM o)
# Line 1495  static void Line 1493  static void
1493  go_to_hell (void *o)  go_to_hell (void *o)
1494  {  {
1495    SCM obj = SCM_PACK ((scm_t_bits) o);    SCM obj = SCM_PACK ((scm_t_bits) o);
 #ifdef USE_THREADS  
1496    scm_lock_mutex (hell_mutex);    scm_lock_mutex (hell_mutex);
 #endif  
1497    if (n_hell == hell_size)    if (n_hell == hell_size)
1498      {      {
1499        long new_size = 2 * hell_size;        long new_size = 2 * hell_size;
# Line 1505  go_to_hell (void *o) Line 1501  go_to_hell (void *o)
1501        hell_size = new_size;        hell_size = new_size;
1502      }      }
1503    hell[n_hell++] = SCM_STRUCT_DATA (obj);    hell[n_hell++] = SCM_STRUCT_DATA (obj);
 #ifdef USE_THREADS  
1504    scm_unlock_mutex (hell_mutex);    scm_unlock_mutex (hell_mutex);
 #endif  
1505  }  }
1506    
1507  static void  static void
1508  go_to_heaven (void *o)  go_to_heaven (void *o)
1509  {  {
 #ifdef USE_THREADS  
1510    scm_lock_mutex (hell_mutex);    scm_lock_mutex (hell_mutex);
 #endif  
1511    hell[burnin (SCM_PACK ((scm_t_bits) o))] = hell[--n_hell];    hell[burnin (SCM_PACK ((scm_t_bits) o))] = hell[--n_hell];
 #ifdef USE_THREADS  
1512    scm_unlock_mutex (hell_mutex);    scm_unlock_mutex (hell_mutex);
 #endif  
1513  }  }
1514    
1515    
# Line 1955  scm_m_atdispatch (SCM xorig, SCM env) Line 1945  scm_m_atdispatch (SCM xorig, SCM env)
1945  #undef FUNC_NAME  #undef FUNC_NAME
1946    
1947    
 #ifdef USE_THREADS  
1948  static void  static void
1949  lock_cache_mutex (void *m)  lock_cache_mutex (void *m)
1950  {  {
# Line 1969  unlock_cache_mutex (void *m) Line 1958  unlock_cache_mutex (void *m)
1958    SCM mutex = SCM_PACK ((scm_t_bits) m);    SCM mutex = SCM_PACK ((scm_t_bits) m);
1959    scm_unlock_mutex (mutex);    scm_unlock_mutex (mutex);
1960  }  }
 #endif  
1961    
1962  static SCM  static SCM
1963  call_memoize_method (void *a)  call_memoize_method (void *a)
# Line 1991  SCM Line 1979  SCM
1979  scm_memoize_method (SCM x, SCM args)  scm_memoize_method (SCM x, SCM args)
1980  {  {
1981    SCM gf = SCM_CAR (scm_last_pair (x));    SCM gf = SCM_CAR (scm_last_pair (x));
 #ifdef USE_THREADS  
1982    return scm_internal_dynamic_wind (    return scm_internal_dynamic_wind (
1983      lock_cache_mutex,      lock_cache_mutex,
1984      call_memoize_method,      call_memoize_method,
1985      unlock_cache_mutex,      unlock_cache_mutex,
1986      (void *) SCM_UNPACK (scm_cons2 (gf, x, args)),      (void *) SCM_UNPACK (scm_cons2 (gf, x, args)),
1987      (void *) SCM_UNPACK (SCM_SLOT (gf, scm_si_cache_mutex)));      (void *) SCM_UNPACK (SCM_SLOT (gf, scm_si_cache_mutex)));
 #else  
   return call_memoize_method ((void *) SCM_UNPACK (scm_cons2 (gf, x, args)));  
 #endif  
1988  }  }
1989    
1990  /******************************************************************************  /******************************************************************************
# Line 2037  SCM_DEFINE (scm_make, "make",  0, 0, 1, Line 2021  SCM_DEFINE (scm_make, "make",  0, 0, 1,
2021    
2022    if (class == scm_class_generic || class == scm_class_generic_with_setter)    if (class == scm_class_generic || class == scm_class_generic_with_setter)
2023      {      {
 #ifdef USE_THREADS  
2024        z = scm_make_struct (class, SCM_INUM0,        z = scm_make_struct (class, SCM_INUM0,
2025                             scm_list_4 (SCM_EOL,                             scm_list_4 (SCM_EOL,
2026                                         SCM_INUM0,                                         SCM_INUM0,
2027                                         SCM_BOOL_F,                                         SCM_BOOL_F,
2028                                         scm_make_mutex ()));                                         scm_make_mutex ()));
 #else  
       z = scm_make_struct (class, SCM_INUM0,  
                            scm_list_3 (SCM_EOL, SCM_INUM0, SCM_BOOL_F));  
 #endif  
2029        scm_set_procedure_property_x (z, scm_sym_name,        scm_set_procedure_property_x (z, scm_sym_name,
2030                                      scm_get_keyword (k_name,                                      scm_get_keyword (k_name,
2031                                                       args,                                                       args,
# Line 2194  create_standard_classes (void) Line 2173  create_standard_classes (void)
2173    SCM amethod_slots = scm_list_1 (scm_list_3 (scm_str2symbol ("slot-definition"),    SCM amethod_slots = scm_list_1 (scm_list_3 (scm_str2symbol ("slot-definition"),
2174                                                k_init_keyword,                                                k_init_keyword,
2175                                                k_slot_definition));                                                k_slot_definition));
 #ifdef USE_THREADS  
2176    SCM mutex_slot = scm_list_1 (scm_str2symbol ("make-mutex"));    SCM mutex_slot = scm_list_1 (scm_str2symbol ("make-mutex"));
 #else  
   SCM mutex_slot = SCM_BOOL_F;  
 #endif  
2177    SCM gf_slots = scm_list_4 (scm_str2symbol ("methods"),    SCM gf_slots = scm_list_4 (scm_str2symbol ("methods"),
2178                               scm_list_3 (scm_str2symbol ("n-specialized"),                               scm_list_3 (scm_str2symbol ("n-specialized"),
2179                                           k_init_value,                                           k_init_value,
# Line 2695  scm_init_goops_builtins (void) Line 2670  scm_init_goops_builtins (void)
2670    list_of_no_method = scm_permanent_object (scm_list_1 (sym_no_method));    list_of_no_method = scm_permanent_object (scm_list_1 (sym_no_method));
2671    
2672    hell = scm_malloc (hell_size);    hell = scm_malloc (hell_size);
 #ifdef USE_THREADS  
2673    hell_mutex = scm_permanent_object (scm_make_mutex ());    hell_mutex = scm_permanent_object (scm_make_mutex ());
 #endif  
2674    
2675    create_basic_classes ();    create_basic_classes ();
2676    create_standard_classes ();    create_standard_classes ();

Legend:
Removed from v.1.53  
changed lines
  Added in v.1.54

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