1 /* Updating all heap objects in the world (i.e. in the heap and stack). */ 2 3 /* -------------------------- Specification ---------------------------- */ 4 5 /* For the following macros, the macro update(objptr) must be defined, with the 6 signature: local void update (object* objptr); 7 8 Update all the world, except the heaps and the stacks. 9 update_tables(); 10 11 Update the cons heaps. 12 #define update_conspage ... 13 update_conses(); 14 #undef update_conspage 15 Some possible implementation of update_conspage. 16 update_conspage_normal 17 18 Update the varobject heaps. 19 #define update_hashtable_invalid ... 20 #define update_ht_invalid ... 21 #define update_unrealloc ... 22 #define update_ss_unrealloc ... 23 #define update_in_unrealloc ... 24 #define update_fpointer_invalid ... 25 #define update_fp_invalid ... 26 #define update_fsubr_function ... 27 #define update_fs_function ... 28 #define update_page ... 29 update_varobjects(); 30 #undef update_page 31 #undef update_fs_function 32 #undef update_fsubr_function 33 #undef update_fp_invalid 34 #undef update_fpointer_invalid 35 #undef update_in_unrealloc 36 #undef update_ss_unrealloc 37 #undef update_unrealloc 38 #undef update_ht_invalid 39 #undef update_hashtable_invalid 40 Some possible implementation of update_page. 41 update_page_normal 42 43 Update the stacks. 44 #define update_stackobj ... 45 update_stacks(); 46 #undef update_stackobj 47 Some possible implementation of update_stackobj. 48 update_stackobj_normal 49 50 Update the C stacks. 51 update_back_traces(); */ 52 53 /* -------------------------- Implementation --------------------------- */ 54 55 /* update program constants: */ 56 #define update_subr_tab() \ 57 for_all_subrs({ \ 58 var gcv_object_t* p; \ 59 p = &ptr->name; update(p); \ 60 p = &ptr->keywords; update(p); \ 61 }) 62 #define update_symbol_tab() \ 63 for_all_constsyms({ /* traverse symbol_tab */ \ 64 var gcv_object_t* p; \ 65 p = &ptr->symvalue; update(p); \ 66 p = &ptr->symfunction; update(p); \ 67 p = &ptr->hashcode; update(p); \ 68 p = &ptr->proplist; update(p); \ 69 p = &ptr->pname; update(p); \ 70 p = &ptr->homepackage; update(p); \ 71 }) 72 #define update_object_tab() \ 73 do { \ 74 for_all_constobjs( update(objptr); ); /* traverse object_tab */ \ 75 for_all_threadobjs( update(objptr); ); /* traverse threads */ \ 76 } while(0) 77 #define update_tables() \ 78 do { \ 79 update_subr_tab(); \ 80 update_symbol_tab(); \ 81 update_object_tab(); \ 82 } while(0) 83 84 /* update the pointers in the Cons-cells: */ 85 #define update_conspage_normal(page) \ 86 do { \ 87 var aint objptr = page->page_start; \ 88 var aint objptrend = page->page_end; \ 89 /* update all pointers in the (new) CONS-region start <= address < end: */ \ 90 while (objptr != objptrend) { \ 91 update((gcv_object_t*)objptr); \ 92 objptr += sizeof(gcv_object_t); \ 93 update((gcv_object_t*)objptr); \ 94 objptr += sizeof(gcv_object_t); \ 95 } \ 96 } while(0) 97 #define update_conses() for_each_cons_page(page, update_conspage(page) ) 98 99 /* update pointers in the objects of variable length: */ 100 #define update_page_normal(page,updater) \ 101 do { \ 102 var aint ptr = page->page_start; \ 103 var aint ptrend = page->page_end; \ 104 /* traverse all objects with address >=ptr, <ptrend : */ \ 105 while (ptr != ptrend) {/* until ptr has reached the end */ \ 106 /* traverse next object with address ptr (< ptrend) : */ \ 107 updater(typecode_at(ptr)); /* and advance */ \ 108 } \ 109 } while(0) 110 /* subroutines: */ 111 #define do_update_symbol() \ 112 do { \ 113 gcv_object_t* p = (gcv_object_t*)pointerplus(ptr,symbol_objects_offset); \ 114 uintC count; \ 115 dotimespC(count,symbol_length, { \ 116 update(p); p++; \ 117 }); \ 118 } while(0) 119 #define do_update_svector() \ 120 do { \ 121 var uintL count = svector_length((Svector)ptr); \ 122 if (count != 0) { \ 123 var gcv_object_t* p = &((Svector)ptr)->data[0]; \ 124 dotimespL(count,count, { update(p); p++; } ); \ 125 } \ 126 } while(0) 127 #define do_update_iarray() \ 128 do { var gcv_object_t* p = &((Iarray)ptr)->data; update(p); } while(0) 129 #define do_update_sistring() \ 130 do { var gcv_object_t* p = &((Sistring)ptr)->data; update(p); } while(0) 131 #define do_update_sxrecord() \ 132 do { \ 133 /* on update of pointers, the hash-tables are invalidated \ 134 (because the hash function of an object depends on its address, \ 135 which is now changed). */ \ 136 if (update_hashtable_invalid && /* a hash-table ? */ \ 137 record_type((Record)ptr) == Rectype_Hashtable) { \ 138 update_ht_invalid((Hashtable)ptr); /* yes -> note for reorganisation */ \ 139 } else if (update_unrealloc && /* Instance ? */ \ 140 (record_type((Record)ptr) == Rectype_Instance \ 141 || (record_type((Record)ptr) == Rectype_Closure \ 142 && (closure_flags((Closure)ptr) & closflags_instance_B)))) { \ 143 update_in_unrealloc((Record)ptr); /* yes -> cleanup forward ptr mark */ \ 144 } else if (update_fpointer_invalid && /* foreign-pointer ? */ \ 145 (record_type((Record)ptr) == Rectype_Fpointer)) { \ 146 update_fp_invalid((Record)ptr); /* yes -> poss. invalidate */ \ 147 } else if (update_fsubr_function && /* Fsubr ? */ \ 148 (record_type((Record)ptr) == Rectype_Fsubr)) { \ 149 update_fs_function((Fsubr)ptr); /* yes -> poss. update address */ \ 150 } \ 151 {var uintC count = (record_type((Record)ptr) < rectype_limit \ 152 ? srecord_length((Srecord)ptr) \ 153 : xrecord_length((Xrecord)ptr)); \ 154 if (count != 0) { \ 155 var gcv_object_t* p = &((Record)ptr)->recdata[0]; \ 156 dotimespC(count,count, { update(p); p++; } ); \ 157 } \ 158 }} while(0) 159 #define do_update_lrecord() \ 160 do { \ 161 var uintC count = lrecord_length((Lrecord)ptr); \ 162 if (count != 0) { \ 163 var gcv_object_t* p = &((Record)ptr)->recdata[0]; \ 164 dotimespC(count,count, { update(p); p++; } ); \ 165 } \ 166 } while(0) 167 /* updates the object at 'ptr', whose typecode is given by 'type_expr' 168 and advances ptr: */ 169 #ifdef SPVW_MIXED 170 #ifdef TYPECODES 171 #define update_varobject(type_expr) \ 172 do { \ 173 var tint type = (type_expr); /* typeinfo */ \ 174 var uintM laenge = objsize((Varobject)ptr); /* determine length */ \ 175 var aint newptr = ptr+laenge; /* pointer to next object */ \ 176 /* fall differentiation according to: \ 177 symbol; simple-vector; non-simple array; \ 178 Record (esp. hash-table); rest. */ \ 179 switch (type) { \ 180 case_symbolwithflags: /* Symbol: update all pointers */ \ 181 do_update_symbol(); \ 182 break; \ 183 case_svector: /* Simple-vector: update all pointers */ \ 184 do_update_svector(); \ 185 break; \ 186 case_sstring: /* Simple-string */ \ 187 if_HAVE_SMALL_SSTRING( \ 188 if (sstring_reallocatedp((Sstring)ptr)) \ 189 do_update_sistring(); /* update data vector */ \ 190 else if (update_unrealloc) { \ 191 update_ss_unrealloc((Sstring)ptr); /* cleanup forward ptr mark */ \ 192 } \ 193 ) \ 194 break; \ 195 case_mdarray: case_obvector: case_ob2vector: case_ob4vector: \ 196 case_ob8vector: case_ob16vector: case_ob32vector: case_ostring: \ 197 case_ovector: /* non-simple array: update data vector */ \ 198 do_update_iarray(); \ 199 break; \ 200 case_sxrecord: /* Record: update all pointers */ \ 201 do_update_sxrecord(); \ 202 break; \ 203 case_lrecord: /* Lrecord: update all pointers */ \ 204 do_update_lrecord(); \ 205 break; \ 206 default: /* all others contain no pointer that need update */ \ 207 break; /* -> do nothing */ \ 208 } \ 209 /* advance to the next object */ \ 210 ptr = newptr; \ 211 } while(0) 212 #else /* TYPECODES */ 213 #define update_varobject(type_expr) \ 214 do { \ 215 var uintM laenge = objsize((Varobject)ptr); /* determine length */ \ 216 var aint newptr = ptr+laenge; /* pointer to the next object */ \ 217 switch (record_type((Record)ptr)) { /* type of the next object */ \ 218 case Rectype_mdarray: \ 219 case Rectype_bvector: \ 220 case Rectype_b2vector: \ 221 case Rectype_b4vector: \ 222 case Rectype_b8vector: \ 223 case Rectype_b16vector: \ 224 case Rectype_b32vector: \ 225 case Rectype_string: \ 226 case Rectype_vector: \ 227 /* non-simple array: update data vector */ \ 228 do_update_iarray(); \ 229 break; \ 230 if_HAVE_SMALL_SSTRING( \ 231 case Rectype_reallocstring: \ 232 /* reallocated simple string: update data vector */ \ 233 do_update_sistring(); \ 234 break; \ 235 ) \ 236 case Rectype_S16string: case Rectype_Imm_S16string: \ 237 case Rectype_S32string: case Rectype_Imm_S32string: \ 238 if_HAVE_SMALL_SSTRING( \ 239 if (update_unrealloc) { \ 240 update_ss_unrealloc((Sstring)ptr); /* cleanup forward ptr mark */ \ 241 } \ 242 ) \ 243 break; \ 244 case Rectype_Svector: \ 245 /* Simple-vector: update all pointers */ \ 246 do_update_svector(); \ 247 break; \ 248 case Rectype_Sbvector: \ 249 case Rectype_Sb2vector: \ 250 case Rectype_Sb4vector: \ 251 case Rectype_Sb8vector: \ 252 case Rectype_Sb16vector: \ 253 case Rectype_Sb32vector: \ 254 case Rectype_S8string: case Rectype_Imm_S8string: \ 255 case Rectype_Bignum: case Rectype_Ffloat: \ 256 case Rectype_Dfloat: case Rectype_Lfloat: \ 257 /* these contain no pointers that need update -> do nothing */ \ 258 break; \ 259 default: /* Record: update all pointers */ \ 260 if (record_type((Record)ptr) < rectype_longlimit) \ 261 do_update_sxrecord(); \ 262 else \ 263 do_update_lrecord(); \ 264 break; \ 265 } \ 266 /* advance to the next object */ \ 267 ptr = newptr; \ 268 } while(0) 269 #endif /* TYPECODES */ 270 #define update_varobjects() \ 271 for_each_varobject_page(page, update_page(page,update_varobject); ) 272 #endif /* SPVW_MIXED */ 273 #ifdef SPVW_PURE 274 #define update_symbol(type_expr) /* ignores type_expr */ \ 275 do { \ 276 var uintL laenge = objsize_symbol((void*)ptr); /* determine length */ \ 277 var aint newptr = ptr+laenge; /* pointer to the next object */ \ 278 /* Symbol: update all pointers */ \ 279 do_update_symbol(); \ 280 ptr = newptr; /* advance to the next object */ \ 281 } while(0) 282 #define update_svector(type_expr) /* ignores type_expr */ \ 283 do { \ 284 var uintM laenge = objsize_svector((void*)ptr); /* determine length */ \ 285 var aint newptr = ptr+laenge; /* pointer to the next object */ \ 286 /* Simple-vector: update all pointers */ \ 287 do_update_svector(); \ 288 ptr = newptr; /* advance to the next object */ \ 289 } while(0) 290 #define update_iarray(type_expr) /* ignores type_expr */ \ 291 do { \ 292 var uintL laenge = objsize_iarray((void*)ptr); /* determine length */ \ 293 var aint newptr = ptr+laenge; /* pointer to the next object */ \ 294 /* non-simple array: update data vector */ \ 295 do_update_iarray(); \ 296 ptr = newptr; /* advance to the next object */ \ 297 } while(0) 298 #define update_sstring(type_expr) /* ignores type_expr */ \ 299 do { \ 300 var uintL laenge = objsize_sstring((void*)ptr); /* determine length */ \ 301 var aint newptr = ptr+laenge; /* pointer to the next object */ \ 302 if (sstring_reallocatedp((Sstring)ptr)) { \ 303 /* reallocated simple string: update data vector */ \ 304 do_update_sistring(); \ 305 } else if (update_unrealloc) { \ 306 update_ss_unrealloc((Sstring)ptr); /* cleanup forward ptr mark */ \ 307 } \ 308 ptr = newptr; /* advance to the next object */ \ 309 } while(0) 310 #define update_sxrecord(type_expr) /* ignores type_expr */ \ 311 do { \ 312 var uintL laenge = objsize_sxrecord((void*)ptr); /* determine length */ \ 313 var aint newptr = ptr+laenge; /* pointer to the next object */ \ 314 /* Record: update all pointers */ \ 315 do_update_sxrecord(); \ 316 ptr = newptr; /* advance to the next object */ \ 317 } while(0) 318 #define update_lrecord(type_expr) /* ignores type_expr */ \ 319 do { \ 320 var uintL laenge = objsize_lrecord((void*)ptr); /* determine length */ \ 321 var aint newptr = ptr+laenge; /* pointer to the next object */ \ 322 /* Record: update all pointers */ \ 323 do_update_lrecord(); \ 324 ptr = newptr; /* advance to the next object */ \ 325 } while(0) 326 #define update_varobjects() \ 327 for_each_varobject_page(page,{ \ 328 /* fall differentiation according to: \ 329 symbol; simple-vector; non-simpler array; \ 330 Record (esp. hash-table); rest. */ \ 331 switch (heapnr) { \ 332 case_symbol: update_page(page,update_symbol); break; \ 333 case_sstring: \ 334 if_HAVE_SMALL_SSTRING( update_page(page,update_sstring); ) \ 335 break; \ 336 case_svector: update_page(page,update_svector); break; \ 337 case_mdarray: case_obvector: case_ob2vector: case_ob4vector: \ 338 case_ob8vector: case_ob16vector: case_ob32vector: case_ostring: \ 339 case_ovector: update_page(page,update_iarray); break; \ 340 case_sxrecord: update_page(page,update_sxrecord); break; \ 341 case_lrecord: update_page(page,update_lrecord); break; \ 342 default: /* all others contain no pointer that need update */ \ 343 break; /* -> do nothing */ \ 344 } \ 345 }) 346 #endif /* SPVW_PURE */ 347 348 349 /* update STACKs : */ 350 #define update_stackobj_normal(objptr) update(objptr); 351 #define update_STACKs() \ 352 for_all_STACKs(while (!eq(*objptr,nullobj)) { /* until STACK is finished: */ \ 353 if (as_oint(*objptr) & wbit(frame_bit_o)) { /* here starts a frame? */ \ 354 if (framecode(*objptr) < skip2_limit_t) { /* below skip2-limit? */ \ 355 if (framecode(*objptr) == C_HANDLER_frame_info) \ 356 objptr skipSTACKop 3; /* yes -> advance by 3 */ \ 357 else \ 358 objptr skipSTACKop 2; /* ... or 2 */ \ 359 } else \ 360 objptr skipSTACKop 1; /* no -> advance by 1 */ \ 361 } else { /* normal object, update: */ \ 362 update_stackobj(objptr); \ 363 objptr skipSTACKop 1; /* advance */ \ 364 } \ 365 }) 366 367 /* Update C stacks: */ 368 #define update_back_traces() \ 369 for_all_back_traces( \ 370 for (; bt != NULL; bt = bt->bt_next) \ 371 update(&bt->bt_function)) 372