gc.c 6.62 KB
Newer Older
1 2 3
#include <pthread.h>
int gp_gc_p = 0;

4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45
// guile 2.2 internals normal API does not work in gc hooks

#define SCM_WEAK_TABLE(x) ((scm_t_weak_table *) SCM_CELL_WORD_1 (x))

typedef struct {
  unsigned long hash;
  scm_t_bits key;
  scm_t_bits value;
} scm_t_weak_entry;

typedef struct {
  scm_t_weak_entry *entries;    /* the data */
  scm_i_pthread_mutex_t lock;   /* the lock */
  scm_t_weak_table_kind kind;   /* what kind of table it is */
  unsigned long size;    	/* total number of slots. */
  unsigned long n_items;	/* number of items in table */
  unsigned long lower;		/* when to shrink */
  unsigned long upper;		/* when to grow */
  int size_index;		/* index into hashtable_size */
  int min_size_index;		/* minimum size_index */
} scm_t_weak_table;

static void
copy_weak_entry_gc (scm_t_weak_entry *src, scm_t_weak_entry *dst)
{
  dst->key   = src->key;
  dst->value = src->value;
}


SCM
scm_c_weak_table_fold_in_gc (scm_t_table_fold_fn proc, void *closure,
                       SCM init, SCM table)
{
  scm_t_weak_table *t;
  scm_t_weak_entry *entries;
  unsigned long k, size;

  t = SCM_WEAK_TABLE (table);

  size = t->size;
  entries = t->entries;
46

47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66
  for (k = 0; k < size; k++)
    {
      if (entries[k].hash)
        {
          scm_t_weak_entry copy;
          
          copy_weak_entry_gc (&entries[k], &copy);
      
          if (copy.key && copy.value)
            {
              /* Release table lock while we call the function.  */
              init = proc (closure,
                           SCM_PACK (copy.key), SCM_PACK (copy.value),
                           init);
            }
        }
    }

  return init;
}
67

68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144
inline void enlarge_stack(struct gp_stack *gp, int N, int NN)         
{
  SCM * old = gp->gp_stack; 
  gp->gp_stack = 
    (SCM *) scm_gc_malloc_pointerless(sizeof(SCM) * NN,"gp->gp_stack");
  
  SCM *pt, *pt2;
  for(pt = old, pt2 = gp->gp_stack; pt < gp->gp_si; pt++, pt2++)
    {
      *pt2 = *pt;
    }
  gp->gp_nns = gp->gp_stack + NN - 2; 
  gp->gp_si  = pt2;

  for(; pt2 < gp->gp_nns; pt2++)
    {
      *pt2 = SCM_BOOL_F;
    }



}

inline void enlarge_frstack(struct gp_stack *gp, int N, int NN)
{
  SCM * old = gp->gp_frstack; 
  gp->gp_frstack = 
    (SCM *) scm_gc_malloc_pointerless(sizeof(SCM) * NN,"gp->gp_stack");
  
  SCM *pt, *pt2;
  for(pt = old, pt2 = gp->gp_frstack; pt < gp->gp_fr; pt++, pt2++)
    {
      *pt2 = *pt;
    }
  gp->gp_nnfr = gp->gp_frstack + NN - 2; 

  gp->gp_fr  = pt2;
}

inline void enlarge_cstack(struct gp_stack *gp, int N, int NN)
{
  SCM * old = gp->gp_cstack; 
  gp->gp_cstack = 
    (SCM *) scm_gc_malloc_pointerless(sizeof(SCM) * NN,"gp->gp_cstack");
  
  SCM *pt, *pt2;
  for(pt = old, pt2 = gp->gp_cstack; pt < gp->gp_ci; pt++, pt2++)
    {
      *pt2 = *pt;
    }
  gp->gp_nnc = gp->gp_cstack + NN - 2; 
  
  gp->gp_ci  = pt2;
}


inline void enlarge_csstack(struct gp_stack *gp, int N, int NN)         
{
  SCM * old = gp->gp_cons_stack; 
  gp->gp_cons_stack = 
    (SCM *) scm_gc_malloc_pointerless(sizeof(SCM) * NN,"gp->gp_stack");
  
  SCM *pt, *pt2;
  for(pt = old, pt2 = gp->gp_cons_stack; pt < gp->gp_cs; pt++, pt2++)
    {
      *pt2 = *pt;
    }

  gp->gp_nncs = gp->gp_cons_stack + NN - 2; 
  gp->gp_cs  = pt2;

  for(; pt2 < gp->gp_nncs; pt2++)
    {
      *pt2 = SCM_BOOL_F;
    }
}

145 146
static int isBefore = 1;

147
#ifdef HAS_GP_GC
148 149
int gp_gc_counter = 0;
inline void gp_gc_inc(struct gp_stack *gp)
150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171
{      
    long Ns = gp->gp_nns  - gp->gp_stack;
    long Nc = gp->gp_nncs - gp->gp_cons_stack;
    long Nf = gp->gp_nnfr - gp->gp_frstack;
    long N  = gp->gp_nnc  - gp->gp_cstack;

    long ns = gp->gp_nns  - gp->gp_si;
    long nc = gp->gp_nncs - gp->gp_cs;
    long nf = gp->gp_nnfr - gp->gp_fr;
    long n  = gp->gp_nnc  - gp->gp_ci;


    if(ns < 5)
      {
        enlarge_stack(gp,Ns,2*Ns);
        ns = gp->gp_nns  - gp->gp_si;
      }
    if(nc < 5)
      {
        enlarge_csstack(gp,Nc,2*Nc);
        nc = gp->gp_nncs - gp->gp_cs;
      }
172
    if(nf < 10)
173 174 175 176 177 178 179 180 181 182 183
      {
        enlarge_frstack(gp,Nf,2*Nf);
        nf = gp->gp_nnfr - gp->gp_fr;
      }
    if(n  < 5)
      {
        enlarge_cstack(gp,N,2*N);
        n  = gp->gp_nnc  - gp->gp_ci;
      }

    n = (nf > n) ? ((nc > n) ? (n > ns ? ns : n) 
184 185 186
		   : (nc > ns ? ns : nc))
               :  ((nc > nf) ? (nf > ns ? ns : nf)
		   : (nc > ns ? ns : nc));
187

188 189 190 191
    N = (Nf > N) ? ((Nc > Nf) ? (Ns > Nc ? Ns : N) :
                    (Ns > Nf ? Ns : Nf)) :
      ((Nc > N) ? (Ns > Nc ? Ns : Nc) : (Ns > N ? Ns : N));

192
  if(N < 20000) return;
193

194
  gp_gc_counter++;
195
  if (n > 1000)
196 197 198 199
    {
      if(gp_gc_counter >= 10000)
        {
          scm_gc();
200
	  gp_gc();
201 202 203 204 205 206 207 208
          gp_gc_counter = 0;
        }
    }
  else if (n > 100)
    {
      if(gp_gc_counter >= 1000)
        {
          scm_gc();
209
	  gp_gc();
210 211 212 213 214 215 216 217
          gp_gc_counter = 0;
        }
    }
  else
    {
      if(gp_gc_counter >= 100)
        {
          scm_gc();
218
	  gp_gc();
219 220 221 222 223 224 225 226
          gp_gc_counter = 0;
        }
    }
}
#else
inline void gp_gc_inc(struct gp_stack *gp)
{
}
227
#endif
228

229 230 231
pthread_mutex_t gp_gc_lock = PTHREAD_MUTEX_INITIALIZER;
void gp_no_gc()
{
232
#ifdef HAS_GP_GC
233 234 235
  pthread_mutex_lock(&gp_gc_lock);
  gp_gc_p ++;
  pthread_mutex_unlock(&gp_gc_lock);
236
#endif
237 238 239 240
}

void gp_do_gc()
{
241
#ifdef HAS_GP_GC
242 243 244
  pthread_mutex_lock(&gp_gc_lock);
  gp_gc_p --;
  pthread_mutex_unlock(&gp_gc_lock);
245
  gp_gc();
246
#endif
247 248
}

249 250 251 252 253 254 255 256 257 258 259 260 261 262
int is_gc_locked()
{
  int ret = 0;

  pthread_mutex_lock(&gp_gc_lock);
  if(gp_gc_p)
    ret = 1;
  else
    ret = 0;
  pthread_mutex_unlock(&gp_gc_lock);
  
  return ret;
}

263 264 265 266 267 268 269
SCM sweep_folder (void* closure, SCM stack, SCM val, SCM seed)
{
  gp_sweep_handle(stack);
  //gp_clear_marks(stack, !isBefore);
  return seed;
}

270 271
void *gp_after_mark_hook(void *hook_data, void *fn_data, void *data)
{
272
#ifdef HAS_GP_GC
273
  if(scm_is_true(gp_stacks))
274
    {
275 276 277 278 279 280 281 282
      pthread_mutex_lock(&gp_gc_lock);
      if(!gp_gc_p)
        {
          register_weak_keys();
          scm_c_weak_table_fold_in_gc
            (sweep_folder,(void *)0, SCM_BOOL_F, gp_stacks);          
        }
      pthread_mutex_unlock(&gp_gc_lock);
283
    }
284
#endif
285 286 287
  return (void *)0;
}

288 289 290 291 292 293
SCM before_folder (void* closure, SCM stack, SCM val, SCM seed)
{
  gp_clear_marks(stack, isBefore);
  return seed;
}

294 295
void *gp_before_mark_hook(void *hook_data, void *fn_data, void *data)
{
296
#ifdef HAS_GP_GC
297
  if(scm_is_true(gp_stacks))
298
    {
299 300 301 302
      prepare_weak_keys();
      register_weak_keys();
      scm_c_weak_table_fold_in_gc
        (before_folder,(void *)0, SCM_BOOL_F, gp_stacks);                
303
    }
304
#endif
305 306 307
  return (void *)0;
}

308 309
void init_gpgc()
{
310
#ifdef HAS_GP_GC
311 312 313
  const int appendp = 0;
  void  *data = (void *) 0;
  scm_c_hook_add(&scm_after_gc_c_hook, gp_after_mark_hook, data, appendp);
314
  scm_c_hook_add(&scm_before_gc_c_hook, gp_before_mark_hook, data, appendp);
315
#endif
316 317
}