Changeset 11675


Ignore:
Timestamp:
Feb 1, 2009, 12:36:00 PM (11 years ago)
Author:
gb
Message:

Add a mechanism that allows user-defined functions to be used to free
GCable pointers.

Move the xmacptr_flag* constants form architecure-specific headers to
gc.h (they were all identical.) Define xmacptr_flag_user_first and
xmacptr_flag_user_last, so that some xmacptr flags denote user-specified
"dispose" functions.

Define 'register_xmacptr_dispose_function' and add it to imports.s.
This function provides a very simple way to associate a foreign function
with a dynamically-allocated user-defined xmacptr_flag value.

If we discover an umarked xmacptr whose flags denote a user-defined
dispose function, enqueue the macptr for later (postGC) disposal. (We
can't necessarily call the dispose function in the middle of the GC,
since other suspended threads may own locks.) Since we aren't really
sure what fields in the foreign pointer could be used to link pointers
together, we basically have to mark the (otherwise unreachable)
xmacptr object and link it onto a new list via its "class" cell and
arrange for forward_gcable_ptrs() to update this linked list. (The
xmacptr is unreachable and will be GCed next time.)

Make freeGCptrs handle post-GC freeing pf xmacptrs with user-defined
dispose functions.

Note that the order in which user-defined dispose functions are
registered must be consistent (e.g., a saved image must register
the same set of dispose functions in the same order as were registered
before the image was saved.)

All of this fuss is to allow for things like GCable handles.

Location:
trunk/source/lisp-kernel
Files:
7 edited

Legend:

Unmodified
Added
Removed
  • trunk/source/lisp-kernel/gc-common.c

    r11623 r11675  
    639639
    640640void *postGCptrs = NULL;
     641struct xmacptr *user_postGC_macptrs = NULL;
     642
    641643
    642644void
     
    648650
    649651void
     652postGCfreexmacptr(struct xmacptr *p)
     653{
     654  p->class = (LispObj) user_postGC_macptrs;
     655  user_postGC_macptrs = p;
     656}
     657
     658
     659xmacptr_dispose_fn xmacptr_dispose_functions[xmacptr_flag_user_last-xmacptr_flag_user_first];
     660
     661
     662
     663void
    650664freeGCptrs()
    651665{
    652   void *p, *next;
     666  void *p, *next, *addr;
     667  struct xmacptr *x, *xnext;
     668  int i, flags;
     669  xmacptr_dispose_fn fn;
    653670
    654671  for (p = postGCptrs; p; p = next) {
     
    657674  }
    658675  postGCptrs = NULL;
     676 
     677  for (x = user_postGC_macptrs; x; x = xnext) {
     678    xnext = (xmacptr *) (x->class);;
     679    flags = x->flags - xmacptr_flag_user_first;
     680    fn = xmacptr_dispose_functions[flags];
     681    addr = (void *) x->address;
     682    x->address = 0;
     683    x->flags = 0;
     684    x->link = 0;
     685    x->class = 0;
     686    if (fn && addr) {
     687      fn(addr);
     688    }
     689  }
     690
     691  user_postGC_macptrs = NULL;
     692}
     693
     694int
     695register_xmacptr_dispose_function(void *fn)
     696{
     697  int i, k;
     698 
     699  for( i = 0, k = xmacptr_flag_user_first; k < xmacptr_flag_user_last; i++, k++) {
     700    if (xmacptr_dispose_functions[i]==NULL) {
     701      xmacptr_dispose_functions[i] = fn;
     702      return k;
     703    }
     704    if (xmacptr_dispose_functions[i] == fn) {
     705      return k;
     706    }
     707  }
     708  return 0;
    659709}
    660710
     
    698748
    699749        default:
     750          if ((flag >= xmacptr_flag_user_first) &&
     751              (flag < xmacptr_flag_user_last)) {
     752            set_n_bits(GCmarkbits,dnode,3);
     753            postGCfreexmacptr(x);
     754            break;
     755          }
    700756          /* (warn "unknown xmacptr_flag: ~s" flag) */
    701757          /* Unknowd, and perhaps unknowdable. */
     
    838894{
    839895  LispObj *prev = &(lisp_global(GCABLE_POINTERS)), next, new;
     896  struct xmacptr **xprev, *xnext, *xnew;
    840897
    841898  while ((next = *prev) != (LispObj)NULL) {
     
    845902    }
    846903    prev = &(((xmacptr *)ptr_from_lispobj(untag(next)))->link);
     904  }
     905  xprev = &user_postGC_macptrs;
     906  while (xnext = *xprev) {
     907    xnew = (struct xmacptr *)locative_forwarding_address((LispObj)xnext);
     908    if (xnew != xnext) {
     909      *xprev = xnew;
     910    }
     911    xprev = (struct xmacptr **)(&(xnext->class));
    847912  }
    848913}
  • trunk/source/lisp-kernel/gc.h

    r11522 r11675  
    226226
    227227
     228typedef enum {
     229  xmacptr_flag_none = 0,        /* Maybe already disposed by Lisp */
     230  xmacptr_flag_recursive_lock,  /* recursive-lock */
     231  xmacptr_flag_ptr,             /* malloc/free */
     232  xmacptr_flag_rwlock,          /* read/write lock */
     233  xmacptr_flag_semaphore,        /* semaphore */
     234  xmacptr_flag_user_first = 8,  /* first user-defined dispose fn */
     235  xmacptr_flag_user_last = 16   /* exclusive upper bound */
     236} xmacptr_flag;
     237
     238
     239typedef void (*xmacptr_dispose_fn)(void *);
     240
     241extern xmacptr_dispose_fn xmacptr_dispose_functions[];
     242
    228243#endif                          /* __GC_H__ */
  • trunk/source/lisp-kernel/imports.s

    r11659 r11675  
    5050        defimport(jvm_init)
    5151        defimport(tcr_frame_ptr)
    52         defimport(register_cstack_holding_area_lock)
     52        defimport(register_xmacptr_dispose_function)
    5353        defimport(open_debug_output)
    5454        defimport(get_r_debug)
  • trunk/source/lisp-kernel/ppc-constants32.h

    r10969 r11675  
    380380#define lfbits_noname_mask fixnum_bitmask(29)
    381381
    382 /*
    383   known values of an "extended" (gcable) macptr's flags word:
    384 */
    385 
    386 typedef enum {
    387   xmacptr_flag_none = 0,        /* Maybe already disposed by Lisp */
    388   xmacptr_flag_recursive_lock,  /* recursive-lock */
    389   xmacptr_flag_ptr,             /* malloc/free */
    390   xmacptr_flag_rwlock,          /* read/write lock */
    391   xmacptr_flag_semaphore        /* semaphore */
    392 } xmacptr_flag;
    393382
    394383/* Creole */
  • trunk/source/lisp-kernel/ppc-constants64.h

    r10969 r11675  
    360360#define lfbits_noname_mask fixnum_bitmask(29)
    361361
    362 /*
    363   known values of an "extended" (gcable) macptr's flags word:
    364 */
    365 
    366 typedef enum {
    367   xmacptr_flag_none = 0,        /* Maybe already disposed by Lisp */
    368   xmacptr_flag_recursive_lock,  /* recursive-lock */
    369   xmacptr_flag_ptr,             /* malloc/free */
    370   xmacptr_flag_rwlock,          /* read/write lock */
    371   xmacptr_flag_semaphore        /* semaphore */
    372 } xmacptr_flag;
    373362
    374363/* Creole */
  • trunk/source/lisp-kernel/x86-constants32.h

    r11330 r11675  
    371371#define lfbits_noname_mask fixnum_bitmask(29)
    372372
    373 /*
    374   known values of an "extended" (gcable) macptr's flags word:
    375 */
    376 
    377 typedef enum {
    378   xmacptr_flag_none = 0,        /* Maybe already disposed by Lisp */
    379   xmacptr_flag_recursive_lock,  /* recursive-lock */
    380   xmacptr_flag_ptr,             /* malloc/free */
    381   xmacptr_flag_rwlock,          /* read/write lock */
    382   xmacptr_flag_semaphore        /* semaphore */
    383 } xmacptr_flag;
    384373
    385374/* Creole */
  • trunk/source/lisp-kernel/x86-constants64.h

    r11241 r11675  
    444444*/
    445445
    446 typedef enum {
    447   xmacptr_flag_none = 0,        /* Maybe already disposed by Lisp */
    448   xmacptr_flag_recursive_lock,  /* recursive-lock */
    449   xmacptr_flag_ptr,             /* malloc/free */
    450   xmacptr_flag_rwlock,          /* read/write lock */
    451   xmacptr_flag_semaphore        /* semaphore */
    452 } xmacptr_flag;
    453446
    454447/* Creole */
Note: See TracChangeset for help on using the changeset viewer.