1 /*
2  * Part of Scheme 48 1.9.  See file COPYING for notices and license.
3  *
4  * Authors: David Frese
5  */
6 
7 #ifndef __S48_AREA_ROOTS
8 #define __S48_AREA_ROOTS
9 
10 #include "data.h"
11 #include "areas.h"
12 #include "memory.h"
13 #include "memory_map.h"
14 #include "scheme48.h"
15 #include "measure.h"
16 
17 /* Cards & Dirty Vector */
18 
19 #define S48_CARD_SIZE (1 << S48_LOG_CARD_SIZE)
20 
21 void s48_init_dirty_vector(Area* area);
22 void s48_deinit_dirty_vector(Area* area);
23 
24 void s48_trace_areas_roots(Area* areas);
25 
26 /* implementation of the write-barrier */
27 
28 void s48_set_dirty_vector(Area* area, s48_address addr, long stob,
29 			  Area* maybe_to_area);
30 
31 /* Marks the card containing addr as dirty. called from
32    s48_write_barrier and s48_internal_write_barrier */
s48_set_dirty_vector_inline(Area * area,s48_address addr,long stob,Area * maybe_to_area)33 inline static void s48_set_dirty_vector_inline(Area* area, s48_address addr,
34 					       long stob, Area* maybe_to_area)
35 {
36 #if S48_DIRTY_VECTOR_METHOD==S48_ADDRESS_DIRTY_VECTORS
37   unsigned long area_offset = addr - area->start;
38   unsigned int card_number = area_offset >> S48_LOG_CARD_SIZE ;
39   s48_address current_dirty_address = area->dirty_vector.items[card_number];
40   assert(card_number < area->dirty_vector.length);
41   /* Only update if Nullpointer or smaller than current_dirty_address */
42   if ((current_dirty_address == NULL) || (addr < current_dirty_address))
43     area->dirty_vector.items[card_number] = addr;
44 #endif
45 }
46 
47 S48_EXTERN void s48_write_barrier(long stob, s48_address address, long value);
48 S48_EXTERN char s48_stob_in_heapP(s48_value);
49 
50 /* the value VALUE will be written at location ADDRESS which is within the stob STOB */
s48_write_barrier_inline(long stob,s48_address address,long value)51 inline static void s48_write_barrier_inline(long stob, s48_address address,
52 					    long value) {
53   /* The area of the stob */
54   Area* area = s48_memory_map_ref(address);
55 #if (MEASURE_GC)
56   if (S48_STOB_P(value)) {
57     Area* meas_to_area  = s48_memory_map_ref(S48_ADDRESS_AT_HEADER(value));
58     if (area->generation_index > meas_to_area->generation_index) {
59       measure_write_barrier(1);
60     } else {
61       measure_write_barrier(0);
62     }
63   }
64 #endif
65   /* Detect errors early... */
66   if (S48_STOB_P(value)) {
67     assert(s48_stob_in_heapP(value));
68   }
69 
70   /* somehow the write_barrier gets called from some strange places --
71      e.g. in read_image, that's why area can get NULL. */
72   if (area == NULL)
73     return;
74 
75   assert(address < area->frontier);
76 
77   if (area->generation_index == 0)
78     return;
79 
80 #if S48_WRITE_BARRIER_COMPLEXITY == S48_MUTATED_LOCATION
81   s48_set_dirty_vector(area, address, value, NULL);
82 #else
83     if (S48_STOB_P(value)) {
84 #if S48_WRITE_BARRIER_COMPLEXITY == S48_STOB_LOCATION
85       s48_set_dirty_vector(area, address, value, NULL);
86 #elif S48_WRITE_BARRIER_COMPLEXITY == S48_INTERGEN_STOB_LOCATION
87       Area* to_area = s48_memory_map_ref(S48_ADDRESS_AT_HEADER(value));
88 
89       if (area->generation_index > to_area->generation_index)
90 	s48_set_dirty_vector_inline(area, address, value, to_area);
91 #endif
92     }
93 #endif
94 }
95 
96 /* called after a stob in AREA, stored at ADDR pointing into TO_AREA, has
97    been updated, either because the object has been copied to a new
98    area, a large area has been linked into a new list, or the object
99    has been traced but ignored. */
100 
s48_internal_write_barrier(Area * area,s48_address addr,long value,Area * to_area)101 inline static void s48_internal_write_barrier(Area* area, s48_address addr,
102 					      long value, Area* to_area) {
103   /* we're not interested in locations in an other-space area. This
104      test should be sufficient. This happens because of root-set
105      functions, that trace a stob inside an area that is beeing
106      collected (other-space). */
107   if (area->action != GC_ACTION_IGNORE)
108     return;
109 #if (S48_HAVE_TRANSPORT_LINK_CELLS)
110   /* We could ignore the key field here for optimization, but maybe
111      it's not worth the test. */
112 #endif
113   /* We're only interested in pointers from old to young */
114   if (area->generation_index > to_area->generation_index) {
115 #if (MEASURE_GC)
116     measure_gc_write_barrier();
117 #endif
118 #if (S48_USE_REMEMBERED_SETS)
119     /* if the rememberd-set can store this pointer, then we're done,
120        otherwise mark the card anyway */
121     if (s48_remset_add(addr, to_area->remset))
122       return;
123 #endif
124     s48_set_dirty_vector_inline(area, addr, value, to_area);
125   }
126 }
127 
128 #endif
129