* __scm.h (SCM_ALLOW_INTS_ONLY): Removed.

[bpt/guile.git] / libguile / gc.c

diff --git a/libguile/gc.c b/libguile/gc.c
index b291385..6ad9c4e 100644 (file)
--- a/libguile/gc.c
+++ b/libguile/gc.c
@@ -120,8 +120,6 @@ int scm_i_cell_validation_already_running ;
   periods.
 
 */
-
-
 void
 scm_i_expensive_validation_check (SCM cell)
 {
@@ -146,7 +144,9 @@ scm_i_expensive_validation_check (SCM cell)
       else
        {
          counter = scm_debug_cells_gc_interval;
+         scm_i_thread_put_to_sleep ();
          scm_igc ("scm_assert_cell_valid");
+         scm_i_thread_wake_up ();
        }
     }
 }
@@ -241,7 +241,7 @@ SCM_DEFINE (scm_set_debug_cell_accesses_x, "set-debug-cell-accesses!", 1, 0, 0,
   /*
     do nothing
    */
-
+  fprintf (stderr, "\nWARNING: GUILE was not compiled with SCM_DEBUG_CELL_ACCESSES");
   scm_remember_upto_here (flag);
   return SCM_UNSPECIFIED;
 }
@@ -251,8 +251,8 @@ SCM_DEFINE (scm_set_debug_cell_accesses_x, "set-debug-cell-accesses!", 1, 0, 0,
 
 \f
 
-SCM scm_i_freelist = SCM_EOL;
-SCM scm_i_freelist2 = SCM_EOL;
+scm_t_key scm_i_freelist;
+scm_t_key scm_i_freelist2;
 
 
 /* scm_mtrigger
@@ -277,13 +277,9 @@ int scm_block_gc = 1;
  */
 SCM scm_weak_vectors;
 
-/* During collection, this accumulates structures which are to be freed.
- */
-SCM scm_structs_to_free;
-
 /* GC Statistics Keeping
  */
-long scm_cells_allocated = 0;
+unsigned long scm_cells_allocated = 0;
 unsigned long scm_mallocated = 0;
 unsigned long scm_gc_cells_collected;
 unsigned long scm_gc_cells_collected_1 = 0; /* previous GC yield */
@@ -337,7 +333,7 @@ SCM_DEFINE (scm_gc_stats, "gc-stats", 0, 0, 0,
   unsigned long int local_scm_heap_size;
   int local_scm_gc_cell_yield_percentage;
   int local_scm_gc_malloc_yield_percentage;
-  long int local_scm_cells_allocated;
+  unsigned long int local_scm_cells_allocated;
   unsigned long int local_scm_gc_time_taken;
   unsigned long int local_scm_gc_times;
   unsigned long int local_scm_gc_mark_time_taken;
@@ -392,7 +388,7 @@ SCM_DEFINE (scm_gc_stats, "gc-stats", 0, 0, 0,
     }
   
   answer = scm_list_n (scm_cons (sym_gc_time_taken, scm_ulong2num (local_scm_gc_time_taken)),
-                      scm_cons (sym_cells_allocated, scm_long2num (local_scm_cells_allocated)),
+                      scm_cons (sym_cells_allocated, scm_ulong2num (local_scm_cells_allocated)),
                       scm_cons (sym_heap_size, scm_ulong2num (local_scm_heap_size)),
                       scm_cons (sym_mallocated, scm_ulong2num (local_scm_mallocated)),
                       scm_cons (sym_mtrigger, scm_ulong2num (local_scm_mtrigger)),
@@ -463,7 +459,9 @@ SCM_DEFINE (scm_gc, "gc", 0, 0, 0,
 #define FUNC_NAME s_scm_gc
 {
   SCM_DEFER_INTS;
+  scm_i_thread_put_to_sleep ();
   scm_igc ("call");
+  scm_i_thread_wake_up ();
   SCM_ALLOW_INTS;
   return SCM_UNSPECIFIED;
 }
@@ -481,6 +479,8 @@ scm_gc_for_newcell (scm_t_cell_type_statistics *freelist, SCM *free_cells)
 {
   SCM cell;
  
+  scm_i_thread_put_to_sleep ();
+
   ++scm_ints_disabled;
 
   *free_cells = scm_i_sweep_some_segments (freelist);
@@ -525,6 +525,7 @@ scm_gc_for_newcell (scm_t_cell_type_statistics *freelist, SCM *free_cells)
 
   *free_cells = SCM_FREE_CELL_CDR (cell);
 
+  scm_i_thread_wake_up ();
 
   return cell;
 }
@@ -546,13 +547,17 @@ scm_igc (const char *what)
   fprintf (stderr,"gc reason %s\n", what);
   
   fprintf (stderr,
-          SCM_NULLP (scm_i_freelist)
+          SCM_NULLP (*SCM_FREELIST_LOC (scm_i_freelist))
           ? "*"
-          : (SCM_NULLP (scm_i_freelist2) ? "o" : "m"));
+          : (SCM_NULLP (*SCM_FREELIST_LOC (scm_i_freelist2)) ? "o" : "m"));
 #endif
 
   /* During the critical section, only the current thread may run. */
+#if 0 /* MDJ 021207 <djurfeldt@nada.kth.se>
+       Currently, a much larger piece of the GC is single threaded.
+       Can we shrink it again? */
   SCM_CRITICAL_SECTION_START;
+#endif
 
   if (!scm_root || !scm_stack_base || scm_block_gc)
     {
@@ -608,10 +613,21 @@ scm_igc (const char *what)
 
   scm_gc_sweep ();
 
+
+  /*
+    TODO: this hook should probably be moved to just before the mark,
+    since that's where the  sweep is finished in lazy sweeping.
+   */
   scm_c_hook_run (&scm_after_sweep_c_hook, 0);
   gc_end_stats ();
 
+#if 0 /* MDJ 021207 <djurfeldt@nada.kth.se> */
   SCM_CRITICAL_SECTION_END;
+#endif
+
+  /*
+    See above.
+   */
   scm_c_hook_run (&scm_after_gc_c_hook, 0);
   --scm_gc_running_p;
 
@@ -892,9 +908,9 @@ scm_init_storage ()
   scm_c_hook_init (&scm_after_gc_c_hook, 0, SCM_C_HOOK_NORMAL);
 
   /* Initialise the list of ports.  */
-  scm_port_table = (scm_t_port **)
-    malloc (sizeof (scm_t_port *) * scm_port_table_room);
-  if (!scm_port_table)
+  scm_i_port_table = (scm_t_port **)
+    malloc (sizeof (scm_t_port *) * scm_i_port_table_room);
+  if (!scm_i_port_table)
     return 1;
 
 #ifdef HAVE_ATEXIT
@@ -978,17 +994,13 @@ mark_gc_async (void * hook_data SCM_UNUSED,
 void
 scm_init_gc ()
 {
-  SCM after_gc_thunk;
-
-
   scm_gc_init_mark ();
 
   scm_after_gc_hook = scm_permanent_object (scm_make_hook (SCM_INUM0));
   scm_c_define ("after-gc-hook", scm_after_gc_hook);
 
-  after_gc_thunk = scm_c_make_subr ("%gc-thunk", scm_tc7_subr_0,
-                                   gc_async_thunk);
-  gc_async = scm_system_async (after_gc_thunk);  /* protected via scm_asyncs */
+  gc_async = scm_c_make_subr ("%gc-thunk", scm_tc7_subr_0,
+                             gc_async_thunk);
 
   scm_c_hook_add (&scm_after_gc_c_hook, mark_gc_async, NULL, 0);
 
@@ -1012,8 +1024,8 @@ scm_gc_sweep (void)
   
   /* When we move to POSIX threads private freelists should probably
      be GC-protected instead. */
-  scm_i_freelist = SCM_EOL;
-  scm_i_freelist2 = SCM_EOL;
+  *SCM_FREELIST_LOC (scm_i_freelist) = SCM_EOL;
+  *SCM_FREELIST_LOC (scm_i_freelist2) = SCM_EOL;
 }
 
 #undef FUNC_NAME