src/runtime/trace-object.inc

   1 // -*- mode: c -*-
   2
   3 #include "weak-hash-pred.inc"
   4 #include "genesis/split-ordered-list.h"
   5
   6 /* TRACE_NAME = Base name for generated tracing functions
   7  * ACTION = Function name to call with every pointer
   8  * STRENGTHEN_WEAK_REFS = Whether to always trace through weak objects as if strong
   9  */
  10 #if !defined TRACE_NAME || \
  11     !defined ACTION || \
  12     !defined STRENGTHEN_WEAK_REFS || \
  13     !defined HT_ENTRY_LIVENESS_FUN_ARRAY_NAME
  14 #error "Please define all required macros before including trace-object"
  15 #endif
  16
  17 /* Function name to call with weak pointers that have been deferred */
  18 #ifndef WATCH_DEFERRED
  19 #define WATCH_DEFERRED(where, from, to) (void)(0)
  20 #endif
  21
  22 /* Mutex stuff */
  23 #ifndef LOCK
  24 #define LOCK (void)(0)
  25 #define UNLOCK (void)(0)
  26 #endif
  27
  28 /* Generated names */
  29 #define cat2(x, y) x ## y
  30 #define cat(x, y) cat2(x, y)
  31 #define USING_LAYOUT cat(TRACE_NAME, _using_layout)
  32 #define TRACE_PAIR cat(TRACE_NAME, _pair)
  33
  34 #define ORDINARY_SLOT(x) ACTION(x, &x, SOURCE_NORMAL)
  35 static void TRACE_PAIR(lispobj* where)
  36 {
  37     ORDINARY_SLOT(where[0]);
  38     ORDINARY_SLOT(where[1]);
  39 }
  40
  41 static void USING_LAYOUT(lispobj layout, lispobj* where, int nslots)
  42 {
  43     // Apart from the allowance for untagged pointers in lockfree list nodes,
  44     // this contains almost none of the special cases that gencgc does.
  45     if (!layout) return;
  46 #if !(defined LISP_FEATURE_MARK_REGION_GC && defined LISP_FEATURE_COMPACT_INSTANCE_HEADER)
  47   /* FIXME: pmrgc's incremental-compact has a problem here because the layout is a half-sized
  48    * pointer and compaction doesn't know how to write it back to the object header.
  49    * But (luckily?) we can only enable compact-instance and mark-region if #+permgen
  50    * in which case layouts are traced as roots and never GCable.
  51    * Any other feature combo needs this. As things are we're OK because the one other use of
  52    * trace-object.inc is from fullcgc which is not used with mark-region. However, it does mean
  53    * we could not use trace-object.inc to perform the path finding steps in traceroot */
  54     ACTION(layout, &layout_of(where), SOURCE_NORMAL);
  55 #endif
  56     if (lockfree_list_node_layout_p(LAYOUT(layout))) { // allow untagged 'next'
  57         struct list_node* node = (void*)where;
  58         lispobj next = node->_node_next;
  59         // ignore if 0
  60         if (fixnump(next) && next)
  61             ACTION(next|INSTANCE_POINTER_LOWTAG, &node->_node_next, SOURCE_ZERO_TAG);
  62     }
  63     struct bitmap bitmap = get_layout_bitmap(LAYOUT(layout));
  64     int i;
  65     lispobj* slots = where+1;
  66     for (i=0; i<nslots; ++i)
  67         if (bitmap_logbitp(i, bitmap) && is_lisp_pointer(slots[i]))
  68             ORDINARY_SLOT(slots[i]);
  69 }
  70
  71 static void TRACE_NAME(lispobj* where)
  72 {
  73     lispobj header = *where;
  74     int widetag = header_widetag(header);
  75
  76     if (instanceoid_widetag_p(widetag))
  77         return USING_LAYOUT(layout_of(where), where,
  78                             instanceoid_length(header));
  79     sword_t scan_from = 1;
  80     sword_t scan_to = sizetab[widetag](where);
  81     sword_t i;
  82     struct weak_pointer *weakptr;
  83     switch (widetag) {
  84     case SIMPLE_VECTOR_WIDETAG:
  85 #ifdef LISP_FEATURE_UBSAN
  86         if (is_lisp_pointer(where[1])) ORDINARY_SLOT(where[1]);
  87 #endif
  88         /* Would be more precise to only make hash-tables rehash when
  89          * some key actually moves, and we don't really trace large and
  90          * old tables when scavenging properly. So we _don't_ touch
  91          * rehash bits here. */
  92         // non-weak hashtable kv vectors are trivial in fullcgc. Keys don't move
  93         // so the table will not need rehash as a result of gc.
  94         // Ergo, those may be treated just like ordinary simple vectors.
  95         // However, weakness remains as a special case.
  96         if (!STRENGTHEN_WEAK_REFS && vector_flagp(header, VectorWeak)) {
  97             WATCH_DEFERRED(where, 1, scan_to);
  98             if (!vector_flagp(header, VectorHashing)) {
  99                 LOCK;
 100                 add_to_weak_vector_list(where, header);
 101                 UNLOCK;
 102                 return;
 103             }
 104             // Ok, we're looking at a weak hash-table.
 105             struct vector* v = (struct vector*)where;
 106             lispobj *plhash_table = &v->data[vector_len(v)-1];
 107             lispobj lhash_table = *plhash_table;
 108             gc_dcheck(instancep(lhash_table));
 109             ACTION(lhash_table, plhash_table, SOURCE_NORMAL);
 110             struct hash_table* hash_table = (void*)native_pointer(lhash_table);
 111             gc_assert(hashtable_weakp(hash_table));
 112             // An object can only be removed from the queue once.
 113             // Therefore the 'next' pointer has got to be nil.
 114             gc_assert((lispobj)hash_table->next_weak_hash_table == NIL);
 115             int weakness = hashtable_weakness(hash_table);
 116             bool defer = 1;
 117             LOCK;
 118             if (weakness != WEAKNESS_KEY_AND_VALUE)
 119                 defer = scan_weak_hashtable(hash_table, HT_ENTRY_LIVENESS_FUN_ARRAY_NAME[weakness],
 120                                             TRACE_PAIR);
 121             if (defer) {
 122                 hash_table->next_weak_hash_table = weak_hash_tables;
 123                 weak_hash_tables = hash_table;
 124             }
 125             UNLOCK;
 126             return;
 127         }
 128         break;
 129 #if defined(LISP_FEATURE_X86) || defined(LISP_FEATURE_X86_64) || defined (LISP_FEATURE_ARM64)
 130     /* on x86[-64], closure->fun is a fixnum-qua-pointer. Convert it to a lisp
 131      * pointer to mark it, but not on platforms where it's already a descriptor */
 132     case CLOSURE_WIDETAG: {
 133         lispobj *self = &((struct closure*)where)->fun;
 134         ACTION(fun_taggedptr_from_self(*self), self, SOURCE_CLOSURE);
 135         scan_from = 2;
 136         break; // scan slots normally
 137     }
 138 #endif
 139     case CODE_HEADER_WIDETAG:
 140         scan_to = code_header_words((struct code*)where);
 141 #ifdef LISP_FEATURE_UNTAGGED_FDEFNS
 142         {
 143         struct code* code = (struct code*)where;
 144         lispobj* where = code->constants + code_n_funs(code) * CODE_SLOTS_PER_SIMPLE_FUN;
 145         lispobj* limit = where + code_n_named_calls(code);
 146         for ( ; where < limit ; ++where )
 147             ACTION(*where | OTHER_POINTER_LOWTAG, where, SOURCE_ZERO_TAG);
 148         // Fall into general case. Untagged fdefns will be ignored as fixnums.
 149         }
 150 #endif
 151         break;
 152     case SYMBOL_WIDETAG:
 153         {
 154         struct symbol* s = (void*)where;
 155         ACTION(decode_symbol_name(s->name), &s->name, SOURCE_SYMBOL_NAME);
 156         ORDINARY_SLOT(s->value);
 157         ORDINARY_SLOT(s->info);
 158         ORDINARY_SLOT(s->fdefn);
 159         }
 160         return;
 161     case FDEFN_WIDETAG: {
 162         struct fdefn *fdefn = (struct fdefn*)where;
 163         ACTION(decode_fdefn_rawfun(fdefn), (lispobj*)&fdefn->raw_addr, SOURCE_FDEFN_RAW);
 164         scan_to = 3;
 165         break;
 166     }
 167     case WEAK_POINTER_WIDETAG:
 168         weakptr = (struct weak_pointer*)where;
 169         if (STRENGTHEN_WEAK_REFS) ORDINARY_SLOT(weakptr->value);
 170         else if (weakptr_vectorp(weakptr)) {
 171             WATCH_DEFERRED(where, 1, scan_to);
 172             LOCK;
 173             add_to_weak_vector_list(where, header);
 174             UNLOCK;
 175         } else if (is_lisp_pointer(weakptr->value) && interesting_pointer_p(weakptr->value)) {
 176             /* XXX: This hard-codes the layout of a weak pointer. Make a scalar WATCH_DEFERRED? */
 177             WATCH_DEFERRED(where, 1, 2);
 178             LOCK;
 179             add_to_weak_pointer_chain(weakptr);
 180             UNLOCK;
 181         }
 182         return;
 183     default:
 184         if (leaf_obj_widetag_p(widetag)) return;
 185     }
 186     for(i=scan_from; i<scan_to; ++i)
 187         ORDINARY_SLOT(where[i]);
 188 }
 189
 190 #undef ORDINARY_SLOT