vm/data_heap.c

   1 #include "master.h"
   2
   3 CELL init_zone(F_ZONE *z, CELL size, CELL start)
   4 {
   5         z->size = size;
   6         z->start = z->here = start;
   7         z->end = start + size;
   8         return z->end;
   9 }
  10
  11 void init_card_decks(void)
  12 {
  13         CELL start = align(data_heap->segment->start,DECK_SIZE);
  14         allot_markers_offset = (CELL)data_heap->allot_markers - (start >> CARD_BITS);
  15         cards_offset = (CELL)data_heap->cards - (start >> CARD_BITS);
  16         decks_offset = (CELL)data_heap->decks - (start >> DECK_BITS);
  17 }
  18
  19 F_DATA_HEAP *alloc_data_heap(CELL gens,
  20         CELL young_size,
  21         CELL aging_size,
  22         CELL tenured_size)
  23 {
  24         young_size = align(young_size,DECK_SIZE);
  25         aging_size = align(aging_size,DECK_SIZE);
  26         tenured_size = align(tenured_size,DECK_SIZE);
  27
  28         F_DATA_HEAP *data_heap = safe_malloc(sizeof(F_DATA_HEAP));
  29         data_heap->young_size = young_size;
  30         data_heap->aging_size = aging_size;
  31         data_heap->tenured_size = tenured_size;
  32         data_heap->gen_count = gens;
  33
  34         CELL total_size;
  35         if(data_heap->gen_count == 2)
  36                 total_size = young_size + 2 * tenured_size;
  37         else if(data_heap->gen_count == 3)
  38                 total_size = young_size + 2 * aging_size + 2 * tenured_size;
  39         else
  40         {
  41                 fatal_error("Invalid number of generations",data_heap->gen_count);
  42                 return NULL; /* can't happen */
  43         }
  44
  45         total_size += DECK_SIZE;
  46
  47         data_heap->segment = alloc_segment(total_size);
  48
  49         data_heap->generations = safe_malloc(sizeof(F_ZONE) * data_heap->gen_count);
  50         data_heap->semispaces = safe_malloc(sizeof(F_ZONE) * data_heap->gen_count);
  51
  52         CELL cards_size = total_size >> CARD_BITS;
  53         data_heap->allot_markers = safe_malloc(cards_size);
  54         data_heap->allot_markers_end = data_heap->allot_markers + cards_size;
  55
  56         data_heap->cards = safe_malloc(cards_size);
  57         data_heap->cards_end = data_heap->cards + cards_size;
  58
  59         CELL decks_size = total_size >> DECK_BITS;
  60         data_heap->decks = safe_malloc(decks_size);
  61         data_heap->decks_end = data_heap->decks + decks_size;
  62
  63         CELL alloter = align(data_heap->segment->start,DECK_SIZE);
  64
  65         alloter = init_zone(&data_heap->generations[TENURED],tenured_size,alloter);
  66         alloter = init_zone(&data_heap->semispaces[TENURED],tenured_size,alloter);
  67
  68         if(data_heap->gen_count == 3)
  69         {
  70                 alloter = init_zone(&data_heap->generations[AGING],aging_size,alloter);
  71                 alloter = init_zone(&data_heap->semispaces[AGING],aging_size,alloter);
  72         }
  73
  74         if(data_heap->gen_count >= 2)
  75         {
  76                 alloter = init_zone(&data_heap->generations[NURSERY],young_size,alloter);
  77                 alloter = init_zone(&data_heap->semispaces[NURSERY],0,alloter);
  78         }
  79
  80         if(data_heap->segment->end - alloter > DECK_SIZE)
  81                 critical_error("Bug in alloc_data_heap",alloter);
  82
  83         return data_heap;
  84 }
  85
  86 F_DATA_HEAP *grow_data_heap(F_DATA_HEAP *data_heap, CELL requested_bytes)
  87 {
  88         CELL new_tenured_size = (data_heap->tenured_size * 2) + requested_bytes;
  89
  90         return alloc_data_heap(data_heap->gen_count,
  91                 data_heap->young_size,
  92                 data_heap->aging_size,
  93                 new_tenured_size);
  94 }
  95
  96 void dealloc_data_heap(F_DATA_HEAP *data_heap)
  97 {
  98         dealloc_segment(data_heap->segment);
  99         free(data_heap->generations);
 100         free(data_heap->semispaces);
 101         free(data_heap->allot_markers);
 102         free(data_heap->cards);
 103         free(data_heap->decks);
 104         free(data_heap);
 105 }
 106
 107 void clear_cards(CELL from, CELL to)
 108 {
 109         /* NOTE: reverse order due to heap layout. */
 110         F_CARD *first_card = ADDR_TO_CARD(data_heap->generations[to].start);
 111         F_CARD *last_card = ADDR_TO_CARD(data_heap->generations[from].end);
 112         memset(first_card,0,last_card - first_card);
 113 }
 114
 115 void clear_decks(CELL from, CELL to)
 116 {
 117         /* NOTE: reverse order due to heap layout. */
 118         F_DECK *first_deck = ADDR_TO_DECK(data_heap->generations[to].start);
 119         F_DECK *last_deck = ADDR_TO_DECK(data_heap->generations[from].end);
 120         memset(first_deck,0,last_deck - first_deck);
 121 }
 122
 123 void clear_allot_markers(CELL from, CELL to)
 124 {
 125         /* NOTE: reverse order due to heap layout. */
 126         F_CARD *first_card = ADDR_TO_ALLOT_MARKER(data_heap->generations[to].start);
 127         F_CARD *last_card = ADDR_TO_ALLOT_MARKER(data_heap->generations[from].end);
 128         memset(first_card,INVALID_ALLOT_MARKER,last_card - first_card);
 129 }
 130
 131 void reset_generation(CELL i)
 132 {
 133         F_ZONE *z = (i == NURSERY ? &nursery : &data_heap->generations[i]);
 134
 135         z->here = z->start;
 136         if(secure_gc)
 137                 memset((void*)z->start,69,z->size);
 138 }
 139
 140 /* After garbage collection, any generations which are now empty need to have
 141 their allocation pointers and cards reset. */
 142 void reset_generations(CELL from, CELL to)
 143 {
 144         CELL i;
 145         for(i = from; i <= to; i++)
 146                 reset_generation(i);
 147
 148         clear_cards(from,to);
 149         clear_decks(from,to);
 150         clear_allot_markers(from,to);
 151 }
 152
 153 void set_data_heap(F_DATA_HEAP *data_heap_)
 154 {
 155         data_heap = data_heap_;
 156         nursery = data_heap->generations[NURSERY];
 157         init_card_decks();
 158         clear_cards(NURSERY,TENURED);
 159         clear_decks(NURSERY,TENURED);
 160         clear_allot_markers(NURSERY,TENURED);
 161 }
 162
 163 void init_data_heap(CELL gens,
 164         CELL young_size,
 165         CELL aging_size,
 166         CELL tenured_size,
 167         bool secure_gc_)
 168 {
 169         set_data_heap(alloc_data_heap(gens,young_size,aging_size,tenured_size));
 170
 171         gc_locals_region = alloc_segment(getpagesize());
 172         gc_locals = gc_locals_region->start - CELLS;
 173
 174         extra_roots_region = alloc_segment(getpagesize());
 175         extra_roots = extra_roots_region->start - CELLS;
 176
 177         secure_gc = secure_gc_;
 178 }
 179
 180 /* Size of the object pointed to by a tagged pointer */
 181 CELL object_size(CELL tagged)
 182 {
 183         if(immediate_p(tagged))
 184                 return 0;
 185         else
 186                 return untagged_object_size(UNTAG(tagged));
 187 }
 188
 189 /* Size of the object pointed to by an untagged pointer */
 190 CELL untagged_object_size(CELL pointer)
 191 {
 192         return align8(unaligned_object_size(pointer));
 193 }
 194
 195 /* Size of the data area of an object pointed to by an untagged pointer */
 196 CELL unaligned_object_size(CELL pointer)
 197 {
 198         F_TUPLE *tuple;
 199         F_TUPLE_LAYOUT *layout;
 200
 201         switch(untag_header(get(pointer)))
 202         {
 203         case ARRAY_TYPE:
 204         case BIGNUM_TYPE:
 205                 return array_size(array_capacity((F_ARRAY*)pointer));
 206         case BYTE_ARRAY_TYPE:
 207                 return byte_array_size(
 208                         byte_array_capacity((F_BYTE_ARRAY*)pointer));
 209         case STRING_TYPE:
 210                 return string_size(string_capacity((F_STRING*)pointer));
 211         case TUPLE_TYPE:
 212                 tuple = untag_object(pointer);
 213                 layout = untag_object(tuple->layout);
 214                 return tuple_size(layout);
 215         case QUOTATION_TYPE:
 216                 return sizeof(F_QUOTATION);
 217         case WORD_TYPE:
 218                 return sizeof(F_WORD);
 219         case RATIO_TYPE:
 220                 return sizeof(F_RATIO);
 221         case FLOAT_TYPE:
 222                 return sizeof(F_FLOAT);
 223         case COMPLEX_TYPE:
 224                 return sizeof(F_COMPLEX);
 225         case DLL_TYPE:
 226                 return sizeof(F_DLL);
 227         case ALIEN_TYPE:
 228                 return sizeof(F_ALIEN);
 229         case WRAPPER_TYPE:
 230                 return sizeof(F_WRAPPER);
 231         case CALLSTACK_TYPE:
 232                 return callstack_size(
 233                         untag_fixnum_fast(((F_CALLSTACK *)pointer)->length));
 234         default:
 235                 critical_error("Invalid header",pointer);
 236                 return -1; /* can't happen */
 237         }
 238 }
 239
 240 void primitive_size(void)
 241 {
 242         box_unsigned_cell(object_size(dpop()));
 243 }
 244
 245 /* The number of cells from the start of the object which should be scanned by
 246 the GC. Some types have a binary payload at the end (string, word, DLL) which
 247 we ignore. */
 248 CELL binary_payload_start(CELL pointer)
 249 {
 250         F_TUPLE *tuple;
 251         F_TUPLE_LAYOUT *layout;
 252
 253         switch(untag_header(get(pointer)))
 254         {
 255         /* these objects do not refer to other objects at all */
 256         case FLOAT_TYPE:
 257         case BYTE_ARRAY_TYPE:
 258         case BIGNUM_TYPE:
 259         case CALLSTACK_TYPE:
 260                 return 0;
 261         /* these objects have some binary data at the end */
 262         case WORD_TYPE:
 263                 return sizeof(F_WORD) - CELLS * 3;
 264         case ALIEN_TYPE:
 265                 return CELLS * 3;
 266         case DLL_TYPE:
 267                 return CELLS * 2;
 268         case QUOTATION_TYPE:
 269                 return sizeof(F_QUOTATION) - CELLS * 2;
 270         case STRING_TYPE:
 271                 return sizeof(F_STRING);
 272         /* everything else consists entirely of pointers */
 273         case ARRAY_TYPE:
 274                 return array_size(array_capacity((F_ARRAY*)pointer));
 275         case TUPLE_TYPE:
 276                 tuple = untag_object(pointer);
 277                 layout = untag_object(tuple->layout);
 278                 return tuple_size(layout);
 279         case RATIO_TYPE:
 280                 return sizeof(F_RATIO);
 281         case COMPLEX_TYPE:
 282                 return sizeof(F_COMPLEX);
 283         case WRAPPER_TYPE:
 284                 return sizeof(F_WRAPPER);
 285         default:
 286                 critical_error("Invalid header",pointer);
 287                 return -1; /* can't happen */
 288         }
 289 }
 290
 291 /* Push memory usage statistics in data heap */
 292 void primitive_data_room(void)
 293 {
 294         F_ARRAY *a = allot_array(ARRAY_TYPE,data_heap->gen_count * 2,F);
 295         int gen;
 296
 297         dpush(tag_fixnum((data_heap->cards_end - data_heap->cards) >> 10));
 298         dpush(tag_fixnum((data_heap->decks_end - data_heap->decks) >> 10));
 299
 300         for(gen = 0; gen < data_heap->gen_count; gen++)
 301         {
 302                 F_ZONE *z = (gen == NURSERY ? &nursery : &data_heap->generations[gen]);
 303                 set_array_nth(a,gen * 2,tag_fixnum((z->end - z->here) >> 10));
 304                 set_array_nth(a,gen * 2 + 1,tag_fixnum((z->size) >> 10));
 305         }
 306
 307         dpush(tag_object(a));
 308 }
 309
 310 /* Disables GC and activates next-object ( -- obj ) primitive */
 311 void begin_scan(void)
 312 {
 313         heap_scan_ptr = data_heap->generations[TENURED].start;
 314         gc_off = true;
 315 }
 316
 317 void primitive_begin_scan(void)
 318 {
 319         begin_scan();
 320 }
 321
 322 CELL next_object(void)
 323 {
 324         if(!gc_off)
 325                 general_error(ERROR_HEAP_SCAN,F,F,NULL);
 326
 327         CELL value = get(heap_scan_ptr);
 328         CELL obj = heap_scan_ptr;
 329         CELL type;
 330
 331         if(heap_scan_ptr >= data_heap->generations[TENURED].here)
 332                 return F;
 333
 334         type = untag_header(value);
 335         heap_scan_ptr += untagged_object_size(heap_scan_ptr);
 336
 337         return RETAG(obj,type <= HEADER_TYPE ? type : OBJECT_TYPE);
 338 }
 339
 340 /* Push object at heap scan cursor and advance; pushes f when done */
 341 void primitive_next_object(void)
 342 {
 343         dpush(next_object());
 344 }
 345
 346 /* Re-enables GC */
 347 void primitive_end_scan(void)
 348 {
 349         gc_off = false;
 350 }
 351
 352 CELL find_all_words(void)
 353 {
 354         GROWABLE_ARRAY(words);
 355
 356         begin_scan();
 357
 358         CELL obj;
 359         while((obj = next_object()) != F)
 360         {
 361                 if(type_of(obj) == WORD_TYPE)
 362                         GROWABLE_ARRAY_ADD(words,obj);
 363         }
 364
 365         /* End heap scan */
 366         gc_off = false;
 367
 368         GROWABLE_ARRAY_TRIM(words);
 369
 370         return words;
 371 }