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

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

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

revision 1.230 by hanwen, Sun Aug 4 14:09:14 2002 UTC revision 1.231 by hanwen, Thu Aug 8 19:47:31 2002 UTC
# Line 90  extern unsigned long * __libc_ia64_regis Line 90  extern unsigned long * __libc_ia64_regis
90    
91  unsigned int scm_gc_running_p = 0;  unsigned int scm_gc_running_p = 0;
92    
 #if (SCM_DEBUG_CELL_ACCESSES == 1)  
   
93  /* Set this to != 0 if every cell that is accessed shall be checked:  /* Set this to != 0 if every cell that is accessed shall be checked:
94   */   */
95  unsigned int scm_debug_cell_accesses_p = 1;  int scm_debug_cell_accesses_p = 0;
96    int scm_expensive_debug_cell_accesses_p = 0;
97    
98  /* Set this to 0 if no additional gc's shall be performed, otherwise set it to  /* Set this to 0 if no additional gc's shall be performed, otherwise set it to
99   * the number of cell accesses after which a gc shall be called.   * the number of cell accesses after which a gc shall be called.
100   */   */
101  static unsigned int debug_cells_gc_interval = 0;  int scm_debug_cells_gc_interval = 0;
102    
103    /*
104  /* Assert that the given object is a valid reference to a valid cell.  This    Global variable, so you can switch it off at runtime by setting
105   * test involves to determine whether the object is a cell pointer, whether    scm_i_cell_validation_already_running.
  * this pointer actually points into a heap segment and whether the cell  
  * pointed to is not a free cell.  Further, additional garbage collections may  
  * get executed after a user defined number of cell accesses.  This helps to  
  * find places in the C code where references are dropped for extremely short  
  * periods.  
106   */   */
107    int scm_i_cell_validation_already_running ;
108    
109    #if (SCM_DEBUG_CELL_ACCESSES == 1)
110    
111    
112    /*
113      
114      Assert that the given object is a valid reference to a valid cell.  This
115      test involves to determine whether the object is a cell pointer, whether
116      this pointer actually points into a heap segment and whether the cell
117      pointed to is not a free cell.  Further, additional garbage collections may
118      get executed after a user defined number of cell accesses.  This helps to
119      find places in the C code where references are dropped for extremely short
120      periods.
121    
122    */
123    
124    
125  void  void
126  scm_assert_cell_valid (SCM cell)  scm_i_expensive_validation_check (SCM cell)
127  {  {
128    static unsigned int already_running = 0;    if (!scm_in_heap_p (cell))
129        {
130          fprintf (stderr, "scm_assert_cell_valid: this object does not live in the heap: %lux\n",
131                   (unsigned long) SCM_UNPACK (cell));
132          abort ();
133        }
134    
135      /* If desired, perform additional garbage collections after a user
136       * defined number of cell accesses.
137       */
138      if (scm_debug_cells_gc_interval)
139        {
140          static unsigned int counter = 0;
141    
142          if (counter != 0)
143            {
144              --counter;
145            }
146          else
147            {
148              counter = scm_debug_cells_gc_interval;
149              scm_igc ("scm_assert_cell_valid");
150            }
151        }
152    }
153    
154    if (!already_running)  void
155    scm_assert_cell_valid (SCM cell)
156    {
157      if (!scm_i_cell_validation_already_running && scm_debug_cell_accesses_p)
158      {      {
159        already_running = 1;  /* set to avoid recursion */        scm_i_cell_validation_already_running = 1;  /* set to avoid recursion */
160    
161        /*        /*
162          During GC, no user-code should be run, and the guile core should          During GC, no user-code should be run, and the guile core
163          use non-protected accessors.          should use non-protected accessors.
164         */        */
165        if (scm_gc_running_p)        if (scm_gc_running_p)
166          abort();          return;
167    
168        /*        /*
169          Only scm_in_heap_p is wildly expensive.          Only scm_in_heap_p and rescanning the heap is wildly
170         */          expensive.
171        if (scm_debug_cell_accesses_p)        */
172          if (!scm_in_heap_p (cell))        if (scm_expensive_debug_cell_accesses_p)
173            {          scm_i_expensive_validation_check (cell);
             fprintf (stderr, "scm_assert_cell_valid: this object does not live in the heap: %lux\n",  
                      (unsigned long) SCM_UNPACK (cell));  
             abort ();  
           }  
174                
175        if (!SCM_GC_MARK_P (cell))        if (!SCM_GC_MARK_P (cell))
176          {          {
# Line 148  scm_assert_cell_valid (SCM cell) Line 182  scm_assert_cell_valid (SCM cell)
182            abort ();            abort ();
183          }          }
184    
185          scm_i_cell_validation_already_running = 0;  /* re-enable */
       /* If desired, perform additional garbage collections after a user  
        * defined number of cell accesses.  
        */  
       if (scm_debug_cell_accesses_p && debug_cells_gc_interval)  
         {  
           static unsigned int counter = 0;  
   
           if (counter != 0)  
             {  
               --counter;  
             }  
           else  
             {  
               counter = debug_cells_gc_interval;  
               scm_igc ("scm_assert_cell_valid");  
             }  
         }  
       already_running = 0;  /* re-enable */  
186      }      }
187  }  }
188    
189    
190    
191  SCM_DEFINE (scm_set_debug_cell_accesses_x, "set-debug-cell-accesses!", 1, 0, 0,  SCM_DEFINE (scm_set_debug_cell_accesses_x, "set-debug-cell-accesses!", 1, 0, 0,
192              (SCM flag),              (SCM flag),
193              "If @var{flag} is @code{#f}, cell access checking is disabled.\n"              "If @var{flag} is @code{#f}, cell access checking is disabled.\n"
194              "If @var{flag} is @code{#t}, cell access checking is enabled,\n"              "If @var{flag} is @code{#t}, cheap cell access checking is enabled,\n"
195              "but no additional calls to garbage collection are issued.\n"              "but no additional calls to garbage collection are issued.\n"
196              "If @var{flag} is a number, cell access checking is enabled,\n"              "If @var{flag} is a number, strict cell access checking is enabled,\n"
197              "with an additional garbage collection after the given\n"              "with an additional garbage collection after the given\n"
198              "number of cell accesses.\n"              "number of cell accesses.\n"
199              "This procedure only exists when the compile-time flag\n"              "This procedure only exists when the compile-time flag\n"
200              "@code{SCM_DEBUG_CELL_ACCESSES} was set to 1.")              "@code{SCM_DEBUG_CELL_ACCESSES} was set to 1.")
201  #define FUNC_NAME s_scm_set_debug_cell_accesses_x  #define FUNC_NAME s_scm_set_debug_cell_accesses_x
202  {  {
203    if (SCM_FALSEP (flag)) {    if (SCM_FALSEP (flag))
204      scm_debug_cell_accesses_p = 0;      {
205    } else if (SCM_EQ_P (flag, SCM_BOOL_T)) {        scm_debug_cell_accesses_p = 0;
206      debug_cells_gc_interval = 0;      }
207      scm_debug_cell_accesses_p = 1;    else if (SCM_EQ_P (flag, SCM_BOOL_T))
208    } else if (SCM_INUMP (flag)) {      {
209      long int f = SCM_INUM (flag);        scm_debug_cells_gc_interval = 0;
210      if (f <= 0) SCM_OUT_OF_RANGE (1, flag);        scm_debug_cell_accesses_p = 1;
211      debug_cells_gc_interval = f;        scm_expensive_debug_cell_accesses_p = 0;
212      scm_debug_cell_accesses_p = 1;      }
213    } else {    else if (SCM_INUMP (flag))
214      SCM_WRONG_TYPE_ARG (1, flag);      {
215    }        long int f = SCM_INUM (flag);
216          if (f <= 0)
217            SCM_OUT_OF_RANGE (1, flag);
218          scm_debug_cells_gc_interval = f;
219          scm_debug_cell_accesses_p = 1;
220          scm_expensive_debug_cell_accesses_p = 1;
221        }
222      else
223        {
224          SCM_WRONG_TYPE_ARG (1, flag);
225        }
226    return SCM_UNSPECIFIED;    return SCM_UNSPECIFIED;
227  }  }
228  #undef FUNC_NAME  #undef FUNC_NAME
# Line 497  scm_gc_for_newcell (scm_t_cell_type_stat Line 524  scm_gc_for_newcell (scm_t_cell_type_stat
524    --scm_ints_disabled;    --scm_ints_disabled;
525    
526    *free_cells = SCM_FREE_CELL_CDR (cell);    *free_cells = SCM_FREE_CELL_CDR (cell);
527    
528    
529    return cell;    return cell;
530  }  }
531    
# Line 525  scm_igc (const char *what) Line 554  scm_igc (const char *what)
554    /* During the critical section, only the current thread may run. */    /* During the critical section, only the current thread may run. */
555    SCM_CRITICAL_SECTION_START;    SCM_CRITICAL_SECTION_START;
556    
557    if (!scm_stack_base || scm_block_gc)    if (!scm_root || !scm_stack_base || scm_block_gc)
558      {      {
559        --scm_gc_running_p;        --scm_gc_running_p;
560        return;        return;
# Line 585  scm_igc (const char *what) Line 614  scm_igc (const char *what)
614    SCM_CRITICAL_SECTION_END;    SCM_CRITICAL_SECTION_END;
615    scm_c_hook_run (&scm_after_gc_c_hook, 0);    scm_c_hook_run (&scm_after_gc_c_hook, 0);
616    --scm_gc_running_p;    --scm_gc_running_p;
 }  
   
   
   
617    
618      /*
619        For debugging purposes, you could do
620        scm_i_sweep_all_segments("debug"), but then the remains of the
621        cell aren't left to analyse.
622       */
623    }
624    
625    
626  /* {GC Protection Helper Functions}  /* {GC Protection Helper Functions}
# Line 939  mark_gc_async (void * hook_data SCM_UNUS Line 966  mark_gc_async (void * hook_data SCM_UNUS
966     * after-gc-hook.     * after-gc-hook.
967     */     */
968  #if (SCM_DEBUG_CELL_ACCESSES == 1)  #if (SCM_DEBUG_CELL_ACCESSES == 1)
969    if (debug_cells_gc_interval == 0)    if (scm_debug_cells_gc_interval == 0)
970      scm_system_async_mark (gc_async);      scm_system_async_mark (gc_async);
971  #else  #else
972    scm_system_async_mark (gc_async);    scm_system_async_mark (gc_async);

Legend:
Removed from v.1.230  
changed lines
  Added in v.1.231

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