src/runtime/coalesce.c

   1 /*
   2  * Coalescing of constant vectors for SAVE-LISP-AND-DIE
   3  */
   4
   5 /*
   6  * This software is part of the SBCL system. See the README file for
   7  * more information.
   8  *
   9  * This software is derived from the CMU CL system, which was
  10  * written at Carnegie Mellon University and released into the
  11  * public domain. The software is in the public domain and is
  12  * provided with absolutely no warranty. See the COPYING and CREDITS
  13  * files for more information.
  14  */
  15
  16 #include <stdbool.h>
  17 #include "genesis/sbcl.h"
  18 #include "gc.h"
  19 #include "genesis/vector.h"
  20 #include "genesis/gc-tables.h"
  21 #include "genesis/instance.h"
  22 #include "genesis/symbol.h"
  23 #include "immobile-space.h"
  24 #include "hopscotch.h"
  25 #include "code.h"
  26 #include "genesis/static-symbols.h"
  27 #include "validate.h"
  28
  29 static bool gcable_pointer_p(lispobj pointer)
  30 {
  31 #ifdef LISP_FEATURE_CHENEYGC
  32    return pointer >= (lispobj)current_dynamic_space
  33        && pointer < (lispobj)get_alloc_pointer();
  34 #endif
  35 #ifdef LISP_FEATURE_GENERATIONAL
  36    return find_page_index((void*)pointer) >= 0 || immobile_space_p(pointer);
  37 #endif
  38 }
  39
  40 static bool coalescible_number_p(lispobj* where)
  41 {
  42     int widetag = widetag_of(where);
  43     return widetag == BIGNUM_WIDETAG
  44         // Ratios and complex integers containing pointers to bignums don't work.
  45         || ((widetag == RATIO_WIDETAG || widetag == COMPLEX_RATIONAL_WIDETAG)
  46             && fixnump(where[1]) && fixnump(where[2]))
  47 #ifndef LISP_FEATURE_64_BIT
  48         || widetag == SINGLE_FLOAT_WIDETAG
  49 #endif
  50         || widetag == DOUBLE_FLOAT_WIDETAG
  51         || widetag == COMPLEX_SINGLE_FLOAT_WIDETAG
  52         || widetag == COMPLEX_DOUBLE_FLOAT_WIDETAG;
  53 }
  54
  55 /// Return true of fixnums, bignums, strings, symbols.
  56 /// Strings are considered eql-comparable,
  57 /// because they're coalesced before comparing.
  58 static bool eql_comparable_p(lispobj obj)
  59 {
  60     if (fixnump(obj) || obj == NIL) return 1;
  61     if (lowtag_of(obj) != OTHER_POINTER_LOWTAG) return 0;
  62     int widetag = widetag_of(native_pointer(obj));
  63     return widetag == BIGNUM_WIDETAG
  64         || widetag == SYMBOL_WIDETAG
  65 #ifdef SIMPLE_CHARACTER_STRING_WIDETAG
  66         || widetag == SIMPLE_CHARACTER_STRING_WIDETAG
  67 #endif
  68         || widetag == SIMPLE_BASE_STRING_WIDETAG;
  69 }
  70
  71 static bool vector_isevery(bool (*pred)(lispobj), struct vector* v)
  72 {
  73     int i;
  74     for (i = vector_len(v)-1; i >= 0; --i)
  75         if (!pred(v->data[i])) return 0;
  76     return 1;
  77 }
  78
  79 /* FIXME: we should actually be even more careful about coalescing objects
  80  * that appear as keys in hash-tables.  While we do take the precaution of
  81  * updating the need-to-rehash indicator, we might create keys that compare
  82  * the same under the table's comparator.  It seems like doing that could
  83  * cause various kinds of weirdness in some applications. Nobody has reported
  84  * misbehavior in the 3 years or so that coalescing has been the default,
  85  * so it doesn't seem horribly bad, but does seem a bit broken */
  86 static void coalesce_obj(lispobj* where, struct hopscotch_table* ht)
  87 {
  88     lispobj ptr = *where;
  89     if (lowtag_of(ptr) != OTHER_POINTER_LOWTAG || !gc_managed_heap_space_p(ptr))
  90         return;
  91
  92     extern char gc_coalesce_string_literals;
  93     // gc_coalesce_string_literals represents the "aggressiveness" level.
  94     // If 1, then we share vectors tagged as +VECTOR-SHAREABLE+,
  95     // but if >1, those and also +VECTOR-SHAREABLE-NONSTD+.
  96     int mask = gc_coalesce_string_literals > 1
  97       ? (VECTOR_SHAREABLE|VECTOR_SHAREABLE_NONSTD)<<ARRAY_FLAGS_POSITION
  98       : (VECTOR_SHAREABLE                        )<<ARRAY_FLAGS_POSITION;
  99
 100     lispobj* obj = native_pointer(ptr);
 101     lispobj header = *obj;
 102     int widetag = header_widetag(header);
 103
 104     if ((((header & mask) != 0) // optimistically assume it's a vector
 105          && ((widetag == SIMPLE_VECTOR_WIDETAG
 106               && vector_isevery(eql_comparable_p, (struct vector*)obj))
 107              || specialized_vector_widetag_p(widetag)))
 108         || coalescible_number_p(obj)) {
 109         if (widetag == SIMPLE_VECTOR_WIDETAG) {
 110             struct vector* v = (void*)obj;
 111             sword_t n_elts = vector_len(v), i;
 112             for (i = 0 ; i < n_elts ; ++i) coalesce_obj(v->data+i, ht);
 113         }
 114         int index = hopscotch_get(ht, (uword_t)obj, 0);
 115         if (!index) // Not found
 116             hopscotch_insert(ht, (uword_t)obj, 1);
 117         else {
 118             ptr = make_lispobj((void*)ht->keys[index-1],
 119                                OTHER_POINTER_LOWTAG);
 120             // Check for no read-only to dynamic-space pointer
 121             if ((uintptr_t)where >= READ_ONLY_SPACE_START &&
 122                 (uintptr_t)where < READ_ONLY_SPACE_END &&
 123                 gcable_pointer_p(ptr))
 124                 lose("Coalesce produced RO->DS ptr");
 125             *where = ptr;
 126         }
 127     }
 128 }
 129
 130 /* FIXME: there are 10+ variants of the skeleton of an object traverser.
 131  * Pick one and try to make it customizable. I tried a callback-based approach,
 132  * but it's way too slow. Next best thing is a ".inc" file which defines the shape
 133  * of the function, with pieces inserted by #define.
 134  *
 135  * (1) gc-common's table-based mechanism
 136  * (2) gencgc's verify_range()
 137  * (3) immobile space {fixedobj,text}_points_to_younger_p()
 138  *     and fixup_space() for defrag. [and the table-based thing is used too]
 139  * (4) fullcgc's trace_object()
 140  * (5) coreparse's relocate_space()
 141  * (6) traceroot's find_ref() and build_refs() which itself has two modes
 142  * (7) sanity_check_loaded_core() which is quite possibly the prettiest yet
 143  * (8) purify()
 144  * (9) coalesce_range()
 145  * plus the Lisp variant:
 146  * (10) do-referenced-object which thank goodness is common to 2 uses
 147  * and if you want to count 'print.c' as another, there's that.
 148  * There's also cheneygc's print_garbage() which uses the dispatch tables.
 149  * And now there's update_writeprotection() which is also ad-hoc.
 150  */
 151
 152 static uword_t coalesce_range(lispobj* where, lispobj* limit, uword_t arg)
 153 {
 154     struct hopscotch_table* ht = (struct hopscotch_table*)arg;
 155     sword_t nwords, i;
 156
 157     where = next_object(where, 0, limit);
 158     while (where) {
 159         lispobj word = *where;
 160         if (is_header(word)) {
 161             int widetag = header_widetag(word);
 162             nwords = sizetab[widetag](where);
 163             lispobj *next = next_object(where, nwords, limit);
 164             if (leaf_obj_widetag_p(widetag)) {
 165               // Ignore this object.
 166               where = next;
 167               continue;
 168             }
 169             sword_t coalesce_nwords = nwords;
 170             if (instanceoid_widetag_p(widetag)) {
 171                 lispobj layout = layout_of(where);
 172                 struct bitmap bitmap = get_layout_bitmap(LAYOUT(layout));
 173                 for (i=0; i<(nwords-1); ++i)
 174                     if (bitmap_logbitp(i, bitmap)) coalesce_obj(where+1+i, ht);
 175                 where = next;
 176                 continue;
 177             }
 178             switch (widetag) {
 179             case SYMBOL_WIDETAG:
 180             {
 181                 struct symbol* symbol = (void*)where;
 182                 lispobj name = decode_symbol_name(symbol->name);
 183                 coalesce_obj(&name, ht);
 184                 set_symbol_name(symbol, name);
 185                 where = next;
 186                 continue;
 187             }
 188             case CODE_HEADER_WIDETAG:
 189                 coalesce_nwords = code_header_words((struct code*)where);
 190                 break;
 191             }
 192             for(i=1; i<coalesce_nwords; ++i)
 193                 coalesce_obj(where+i, ht);
 194             where = next;
 195         } else {
 196             nwords = 2;
 197             coalesce_obj(where+0, ht);
 198             coalesce_obj(where+1, ht);
 199             where = next_object(where, 2, limit);
 200         }
 201     }
 202     return 0;
 203 }
 204
 205 /* Do as good as job as we can to de-duplicate strings
 206  * This doesn't need to scan stacks or anything fancy.
 207  * It's not wrong to fail to coalesce things that could have been */
 208 void coalesce_similar_objects()
 209 {
 210     struct hopscotch_table ht;
 211     uword_t arg = (uword_t)&ht;
 212
 213     hopscotch_create(&ht, HOPSCOTCH_VECTOR_HASH, 0, 1<<17, 0);
 214     coalesce_range((lispobj*)READ_ONLY_SPACE_START, read_only_space_free_pointer, arg);
 215     lispobj* the_symbol_nil = (lispobj*)(NIL - LIST_POINTER_LOWTAG - N_WORD_BYTES);
 216     coalesce_range(the_symbol_nil, ALIGN_UP(SYMBOL_SIZE,2) + the_symbol_nil, arg);
 217     coalesce_range((lispobj*)STATIC_SPACE_OBJECTS_START, static_space_free_pointer, arg);
 218     coalesce_range((lispobj*)PERMGEN_SPACE_START, permgen_space_free_pointer, arg);
 219
 220 #ifdef LISP_FEATURE_IMMOBILE_SPACE
 221     coalesce_range((lispobj*)FIXEDOBJ_SPACE_START, fixedobj_free_pointer, arg);
 222     coalesce_range((lispobj*)TEXT_SPACE_START, text_space_highwatermark, arg);
 223 #endif
 224 #ifdef LISP_FEATURE_GENERATIONAL
 225     walk_generation(coalesce_range, -1, arg);
 226 #else
 227     coalesce_range(current_dynamic_space, get_alloc_pointer(), arg);
 228 #endif
 229     hopscotch_destroy(&ht);
 230 }