1static IGEN copy(thread_gc *tgc, ptr p, seginfo *si, ptr *dest) 2{ 3 check_triggers(tgc, si); 4 { 5 ptr new_p; 6 IGEN tg = TARGET_GENERATION(si); 7 { 8 ITYPE t = TYPEBITS(p); 9 if (t == type_typed_object) 10 { 11 ptr tf = TYPEFIELD(p); 12 if (TYPEP(tf, mask_record, type_record)) 13 { 14 /* Do not inspect the type or first field of the rtd, because 15 it may have been overwritten for forwarding. */ 16 { 17 ptr rtd = RECORDINSTTYPE(p); 18 ISPC p_spc = (((RECORDDESCPM(rtd)) == (FIX(-1))) 19 ? (((RECORDDESCMPM(rtd)) == (FIX(0))) 20 ? space_pure 21 : space_impure) 22 : (((RECORDDESCMPM(rtd)) == (FIX(0))) 23 ? space_pure_typed_object 24 : space_impure_record)); 25 { 26 uptr len = UNFIX((RECORDDESCSIZE(rtd))); 27 { 28 uptr p_sz = size_record_inst(len); 29 find_gc_room(tgc, p_spc, tg, type_typed_object, p_sz, new_p); 30 RECORDINSTTYPE(new_p) = rtd; 31 memcpy_aligned(&RECORDINSTIT(new_p, 0), &RECORDINSTIT(p, 0), len - ptr_bytes); 32 if ((p_spc == space_pure) || ((p_spc == space_impure) || 0)) 33 { 34 { 35 uptr ua_size = unaligned_size_record_inst(len); 36 if (p_sz != ua_size) 37 { 38 *(((ptr*)(TO_VOIDP((((uptr)(UNTYPE(new_p, type_typed_object))) + ua_size))))) = FIX(0); 39 } 40 } 41 } 42 } 43 } 44 } 45 } 46 else if (TYPEP(tf, mask_vector, type_vector)) 47 { 48 ISPC p_spc = ((((uptr)tf) & vector_immutable_flag) 49 ? space_pure 50 : space_impure); 51 { 52 uptr len = Svector_length(p); 53 { 54 uptr p_sz = size_vector(len); 55 find_gc_room(tgc, p_spc, tg, type_typed_object, p_sz, new_p); 56 VECTTYPE(new_p) = (uptr)tf; 57 memcpy_aligned(&INITVECTIT(new_p, 0), &INITVECTIT(p, 0), ptr_bytes * len); 58 if ((len & 1) == 0) 59 { 60 INITVECTIT(new_p, len) = FIX(0); 61 } 62 } 63 } 64 } 65 else if (TYPEP(tf, mask_stencil_vector, type_stencil_vector)) 66 { 67 ISPC p_spc = space_impure; 68 { 69 uptr len = Sstencil_vector_length(p); 70 { 71 uptr p_sz = size_stencil_vector(len); 72 find_gc_room(tgc, p_spc, tg, type_typed_object, p_sz, new_p); 73 STENVECTTYPE(new_p) = (uptr)tf; 74 memcpy_aligned(&INITSTENVECTIT(new_p, 0), &INITSTENVECTIT(p, 0), ptr_bytes * len); 75 if ((len & 1) == 0) 76 { 77 INITSTENVECTIT(new_p, len) = FIX(0); 78 } 79 } 80 } 81 } 82 else if (TYPEP(tf, mask_string, type_string)) 83 { 84 ISPC p_spc = space_data; 85 { 86 uptr sz = size_string((Sstring_length(p))); 87 { 88 uptr p_sz = sz; 89 find_gc_room(tgc, p_spc, tg, type_typed_object, p_sz, new_p); 90 memcpy_aligned(&STRTYPE(new_p), &STRTYPE(p), sz); 91 } 92 } 93 } 94 else if (TYPEP(tf, mask_fxvector, type_fxvector)) 95 { 96 ISPC p_spc = space_data; 97 { 98 uptr sz = size_fxvector((Sfxvector_length(p))); 99 { 100 uptr p_sz = sz; 101 find_gc_room(tgc, p_spc, tg, type_typed_object, p_sz, new_p); 102 memcpy_aligned(&FXVECTOR_TYPE(new_p), &FXVECTOR_TYPE(p), sz); 103 } 104 } 105 } 106 else if (TYPEP(tf, mask_flvector, type_flvector)) 107 { 108 ISPC p_spc = space_data; 109 { 110 uptr sz = size_flvector((Sflvector_length(p))); 111 { 112 uptr p_sz = sz; 113 find_gc_room(tgc, p_spc, tg, type_typed_object, p_sz, new_p); 114 memcpy_aligned(&FLVECTOR_TYPE(new_p), &FLVECTOR_TYPE(p), sz); 115 } 116 } 117 } 118 else if (TYPEP(tf, mask_bytevector, type_bytevector)) 119 { 120 { 121 ISPC p_at_spc = si->space; 122 if (p_at_spc == space_reference_array) 123 { 124 ISPC p_spc = space_reference_array; 125 { 126 uptr sz = size_bytevector((Sbytevector_length(p))); 127 { 128 uptr p_sz = sz; 129 find_gc_room(tgc, p_spc, tg, type_typed_object, p_sz, new_p); 130 BYTEVECTOR_TYPE(new_p) = (uptr)tf; 131 { 132 uptr len = Sbytevector_reference_length(p); 133 memcpy_aligned(&BVIT(new_p, 0), &BVIT(p, 0), ptr_bytes * len); 134 if ((len & 1) == 0) 135 { 136 INITBVREFIT(new_p, len) = FIX(0); 137 } 138 } 139 } 140 } 141 } 142 else 143 { 144 ISPC p_spc = space_data; 145 { 146 uptr sz = size_bytevector((Sbytevector_length(p))); 147 { 148 uptr p_sz = sz; 149 find_gc_room(tgc, p_spc, tg, type_typed_object, p_sz, new_p); 150 memcpy_aligned(&BYTEVECTOR_TYPE(new_p), &BYTEVECTOR_TYPE(p), sz); 151 } 152 } 153 } 154 } 155 } 156 else if ((iptr)tf == type_tlc) 157 { 158 ISPC p_spc = space_impure; 159 { 160 uptr p_sz = size_tlc; 161 find_gc_room(tgc, p_spc, tg, type_typed_object, p_sz, new_p); 162 TLCTYPE(new_p) = type_tlc; 163 INITTLCHT(new_p) = INITTLCHT(p); 164 { 165 ptr next = INITTLCNEXT(p); 166 { 167 ptr keyval = INITTLCKEYVAL(p); 168 INITTLCNEXT(new_p) = next; 169 INITTLCKEYVAL(new_p) = keyval; 170 if ((next != Sfalse) && (OLDSPACE(keyval))) 171 { 172 GC_MUTEX_ACQUIRE(); 173 tlcs_to_rehash = S_cons_in(tgc -> tc, space_new, 0, new_p, tlcs_to_rehash); 174 GC_MUTEX_RELEASE(); 175 } 176 } 177 } 178 } 179 } 180 else if (TYPEP(tf, mask_box, type_box)) 181 { 182 ISPC p_spc = (((BOXTYPE(p)) == type_immutable_box) 183 ? space_pure 184 : space_impure); 185 { 186 uptr p_sz = size_box; 187 find_gc_room(tgc, p_spc, tg, type_typed_object, p_sz, new_p); 188 BOXTYPE(new_p) = (uptr)tf; 189 INITBOXREF(new_p) = INITBOXREF(p); 190 } 191 } 192 else if ((iptr)tf == type_ratnum) 193 { 194 ISPC p_spc = space_data; 195 { 196 uptr p_sz = size_ratnum; 197 find_gc_room(tgc, p_spc, tg, type_typed_object, p_sz, new_p); 198 RATTYPE(new_p) = type_ratnum; 199 { 200 ptr tmp_p = RATNUM(p); 201 relocate_pure(&tmp_p); 202 RATNUM(new_p) = tmp_p; 203 } 204 { 205 ptr tmp_p = RATDEN(p); 206 relocate_pure(&tmp_p); 207 RATDEN(new_p) = tmp_p; 208 } 209 } 210 } 211 else if ((iptr)tf == type_exactnum) 212 { 213 ISPC p_spc = space_data; 214 { 215 uptr p_sz = size_exactnum; 216 find_gc_room(tgc, p_spc, tg, type_typed_object, p_sz, new_p); 217 EXACTNUM_TYPE(new_p) = type_exactnum; 218 { 219 ptr tmp_p = EXACTNUM_REAL_PART(p); 220 relocate_pure(&tmp_p); 221 EXACTNUM_REAL_PART(new_p) = tmp_p; 222 } 223 { 224 ptr tmp_p = EXACTNUM_IMAG_PART(p); 225 relocate_pure(&tmp_p); 226 EXACTNUM_IMAG_PART(new_p) = tmp_p; 227 } 228 } 229 } 230 else if ((iptr)tf == type_inexactnum) 231 { 232 ISPC p_spc = space_data; 233 { 234 uptr p_sz = size_inexactnum; 235 find_gc_room(tgc, p_spc, tg, type_typed_object, p_sz, new_p); 236 INEXACTNUM_TYPE(new_p) = type_inexactnum; 237 { 238 ptr tmp_p = TYPE(TO_PTR(&INEXACTNUM_REAL_PART(p)), type_flonum); 239 if (flonum_is_forwarded_p(tmp_p, si)) 240 INEXACTNUM_REAL_PART(new_p) = FLODAT(FLONUM_FWDADDRESS(tmp_p)); 241 else 242 INEXACTNUM_REAL_PART(new_p) = INEXACTNUM_REAL_PART(p); 243 } 244 { 245 ptr tmp_p = TYPE(TO_PTR(&INEXACTNUM_IMAG_PART(p)), type_flonum); 246 if (flonum_is_forwarded_p(tmp_p, si)) 247 INEXACTNUM_IMAG_PART(new_p) = FLODAT(FLONUM_FWDADDRESS(tmp_p)); 248 else 249 INEXACTNUM_IMAG_PART(new_p) = INEXACTNUM_IMAG_PART(p); 250 } 251 } 252 } 253 else if (TYPEP(tf, mask_bignum, type_bignum)) 254 { 255 ISPC p_spc = space_data; 256 { 257 uptr sz = size_bignum((BIGLEN(p))); 258 { 259 uptr p_sz = sz; 260 find_gc_room(tgc, p_spc, tg, type_typed_object, p_sz, new_p); 261 memcpy_aligned(&BIGTYPE(new_p), &BIGTYPE(p), sz); 262 } 263 } 264 } 265 else if (TYPEP(tf, mask_port, type_port)) 266 { 267 ISPC p_spc = space_port; 268 { 269 uptr p_sz = size_port; 270 find_gc_room(tgc, p_spc, tg, type_typed_object, p_sz, new_p); 271 PORTTYPE(new_p) = (uptr)tf; 272 PORTHANDLER(new_p) = PORTHANDLER(p); 273 PORTOCNT(new_p) = PORTOCNT(p); 274 PORTICNT(new_p) = PORTICNT(p); 275 PORTOLAST(new_p) = PORTOLAST(p); 276 PORTOBUF(new_p) = PORTOBUF(p); 277 PORTILAST(new_p) = PORTILAST(p); 278 PORTIBUF(new_p) = PORTIBUF(p); 279 PORTINFO(new_p) = PORTINFO(p); 280 PORTNAME(new_p) = PORTNAME(p); 281 } 282 } 283 else if (TYPEP(tf, mask_code, type_code)) 284 { 285 ISPC p_spc = space_code; 286 { 287 uptr len = CODELEN(p); 288 { 289 uptr p_sz = size_code(len); 290 find_gc_room(tgc, p_spc, tg, type_typed_object, p_sz, new_p); 291 CODETYPE(new_p) = (uptr)tf; 292 CODELEN(new_p) = CODELEN(p); 293 CODERELOC(new_p) = CODERELOC(p); 294 CODENAME(new_p) = CODENAME(p); 295 CODEARITYMASK(new_p) = CODEARITYMASK(p); 296 CODEFREE(new_p) = CODEFREE(p); 297 CODEINFO(new_p) = CODEINFO(p); 298 CODEPINFOS(new_p) = CODEPINFOS(p); 299 memcpy_aligned(&CODEIT(new_p, 0), &CODEIT(p, 0), len); 300 } 301 } 302 } 303 else if ((iptr)tf == type_thread) 304 { 305 ISPC p_spc = space_pure_typed_object; 306 { 307 uptr p_sz = size_thread; 308 find_gc_room(tgc, p_spc, tg, type_typed_object, p_sz, new_p); 309 THREADTYPE(new_p) = type_thread; 310 THREADTC(new_p) = THREADTC(p); 311 } 312 } 313 else if ((iptr)tf == type_rtd_counts) 314 { 315 ISPC p_spc = space_data; 316 { 317 uptr p_sz = size_rtd_counts; 318 find_gc_room(tgc, p_spc, tg, type_typed_object, p_sz, new_p); 319 memcpy_aligned(&RTDCOUNTSTYPE(new_p), &RTDCOUNTSTYPE(p), size_rtd_counts); 320 } 321 } 322 else if ((iptr)tf == type_phantom) 323 { 324 ISPC p_spc = space_data; 325 { 326 uptr p_sz = size_phantom; 327 find_gc_room(tgc, p_spc, tg, type_typed_object, p_sz, new_p); 328 PHANTOMTYPE(new_p) = type_phantom; 329 PHANTOMLEN(new_p) = PHANTOMLEN(p); 330 GC_MUTEX_ACQUIRE(); 331 (S_G.bytesof[tg])[countof_phantom] += PHANTOMLEN(p); 332 GC_MUTEX_RELEASE(); 333 } 334 } 335 else 336 { 337 S_error_abort("copy: illegal typed object type"); 338 } 339 } 340 else if (t == type_pair) 341 { 342 { 343 ISPC p_at_spc = si->space; 344 if (p_at_spc < space_weakpair) 345 { 346 ISPC p_spc = space_impure; 347 { 348 ptr cdr_p = Scdr(p); 349 if ((cdr_p != p) && (((TYPEBITS(cdr_p)) == type_pair) && (((ptr_get_segment(cdr_p)) == (ptr_get_segment(p))) && (((FWDMARKER(cdr_p)) != forward_marker) && (!(si -> marked_mask)))))) 350 { 351 uptr p_sz = 2 * (size_pair); 352 find_gc_room(tgc, p_spc, tg, type_pair, p_sz, new_p); 353 { 354 ptr new_cdr_p = (ptr)(((uptr)new_p) + size_pair); 355 INITCAR(new_p) = INITCAR(p); 356 INITCDR(new_p) = new_cdr_p; 357 INITCAR(new_cdr_p) = INITCAR(cdr_p); 358 INITCDR(new_cdr_p) = INITCDR(cdr_p); 359 FWDMARKER(cdr_p) = forward_marker; 360 FWDADDRESS(cdr_p) = new_cdr_p; 361 } 362 } 363 else 364 { 365 uptr p_sz = size_pair; 366 find_gc_room(tgc, p_spc, tg, type_pair, p_sz, new_p); 367 INITCAR(new_p) = INITCAR(p); 368 INITCDR(new_p) = INITCDR(p); 369 } 370 } 371 } 372 else if (p_at_spc == space_ephemeron) 373 { 374 ISPC p_spc = space_ephemeron; 375 { 376 uptr p_sz = size_ephemeron; 377 find_gc_room(tgc, p_spc, tg, type_pair, p_sz, new_p); 378 INITCAR(new_p) = INITCAR(p); 379 INITCDR(new_p) = INITCDR(p); 380 INITEPHEMERONPREVREF(new_p) = 0; 381 INITEPHEMERONNEXT(new_p) = 0; 382 } 383 } 384 else if (p_at_spc == space_weakpair) 385 { 386 ISPC p_spc = space_weakpair; 387 { 388 ptr cdr_p = Scdr(p); 389 if ((cdr_p != p) && (((TYPEBITS(cdr_p)) == type_pair) && (((ptr_get_segment(cdr_p)) == (ptr_get_segment(p))) && (((FWDMARKER(cdr_p)) != forward_marker) && (!(si -> marked_mask)))))) 390 { 391 uptr p_sz = 2 * (size_pair); 392 find_gc_room(tgc, p_spc, tg, type_pair, p_sz, new_p); 393 { 394 ptr new_cdr_p = (ptr)(((uptr)new_p) + size_pair); 395 INITCAR(new_p) = INITCAR(p); 396 INITCDR(new_p) = new_cdr_p; 397 INITCAR(new_cdr_p) = INITCAR(cdr_p); 398 INITCDR(new_cdr_p) = INITCDR(cdr_p); 399 FWDMARKER(cdr_p) = forward_marker; 400 FWDADDRESS(cdr_p) = new_cdr_p; 401 } 402 } 403 else 404 { 405 uptr p_sz = size_pair; 406 find_gc_room(tgc, p_spc, tg, type_pair, p_sz, new_p); 407 INITCAR(new_p) = INITCAR(p); 408 INITCDR(new_p) = INITCDR(p); 409 } 410 } 411 } 412 else 413 { 414 S_error_abort("misplaced pair"); 415 } 416 } 417 } 418 else if (t == type_closure) 419 { 420 ptr code = CLOSCODE(p); 421 relocate_pure(&code); 422 if ((CODETYPE(code)) & (code_flag_continuation << code_flags_offset)) 423 { 424 ISPC p_spc = space_continuation; 425 { 426 uptr p_sz = size_continuation; 427 find_gc_room(tgc, p_spc, tg, type_closure, p_sz, new_p); 428 SETCLOSCODE(new_p, code); 429 if ((CONTLENGTH(p)) == opportunistic_1_shot_flag) 430 { 431 CONTLENGTH(new_p) = CONTCLENGTH(p); 432 GC_MUTEX_ACQUIRE(); 433 conts_to_promote = S_cons_in(tgc -> tc, space_new, 0, new_p, conts_to_promote); 434 GC_MUTEX_RELEASE(); 435 } 436 else 437 { 438 CONTLENGTH(new_p) = CONTLENGTH(p); 439 } 440 CONTCLENGTH(new_p) = CONTCLENGTH(p); 441 CONTWINDERS(new_p) = CONTWINDERS(p); 442 CONTATTACHMENTS(new_p) = CONTATTACHMENTS(p); 443 if ((CONTLENGTH(p)) == scaled_shot_1_shot_flag) 444 { 445 } 446 else 447 { 448 CONTLINK(new_p) = CONTLINK(p); 449 CONTRET(new_p) = CONTRET(p); 450 CONTSTACK(new_p) = CONTSTACK(p); 451 } 452 } 453 } 454 else 455 { 456 ISPC p_spc = (((CODETYPE(code)) & (code_flag_mutable_closure << code_flags_offset)) 457 ? space_impure 458 : space_pure); 459 { 460 uptr len = CODEFREE(code); 461 { 462 uptr p_sz = size_closure(len); 463 find_gc_room(tgc, p_spc, tg, type_closure, p_sz, new_p); 464 SETCLOSCODE(new_p, code); 465 memcpy_aligned(&CLOSIT(new_p, 0), &CLOSIT(p, 0), ptr_bytes * len); 466 if ((len & 1) == 0) 467 { 468 CLOSIT(new_p, len) = FIX(0); 469 } 470 } 471 } 472 } 473 } 474 else if (t == type_symbol) 475 { 476 ISPC p_spc = space_symbol; 477 { 478 uptr p_sz = size_symbol; 479 find_gc_room(tgc, p_spc, tg, type_symbol, p_sz, new_p); 480 INITSYMVAL(new_p) = INITSYMVAL(p); 481 INITSYMPVAL(new_p) = INITSYMPVAL(p); 482 INITSYMPLIST(new_p) = INITSYMPLIST(p); 483 INITSYMNAME(new_p) = INITSYMNAME(p); 484 INITSYMSPLIST(new_p) = INITSYMSPLIST(p); 485 INITSYMHASH(new_p) = INITSYMHASH(p); 486 } 487 } 488 else if (t == type_flonum) 489 { 490 ISPC p_spc = space_data; 491 { 492 uptr p_sz = size_flonum; 493 find_gc_room(tgc, p_spc, tg, type_flonum, p_sz, new_p); 494 FLODAT(new_p) = FLODAT(p); 495 flonum_set_forwarded(tgc, p, si); 496 FLONUM_FWDADDRESS(p) = new_p; 497 *dest = new_p; 498 tgc->sweep_change = SWEEP_CHANGE_PROGRESS; 499 return tg; 500 } 501 } 502 else 503 { 504 S_error_abort("copy: illegal type"); 505 } 506 } 507 tgc->sweep_change = SWEEP_CHANGE_PROGRESS; 508 FWDADDRESS(p) = new_p; 509 FWDMARKER(p) = forward_marker; 510 *dest = new_p; 511 return tg; 512 } 513} 514 515static void sweep(thread_gc *tgc, ptr p, IGEN from_g) 516{ 517 FLUSH_REMOTE_BLOCK 518 { 519 ITYPE t = TYPEBITS(p); 520 if (t == type_typed_object) 521 { 522 ptr tf = TYPEFIELD(p); 523 if (TYPEP(tf, mask_record, type_record)) 524 { 525 relocate_pure(&RECORDINSTTYPE(p)); 526 { 527 ptr rtd = RECORDINSTTYPE(p); 528 { 529 uptr len = UNFIX((RECORDDESCSIZE(rtd))); 530 { 531 ptr num = RECORDDESCPM(rtd); 532 ptr* pp = &(RECORDINSTIT(p, 0)); 533 if (Sfixnump(num)) 534 { 535 { 536 uptr mask = ((uptr)(UNFIX(num))) >> 1; 537 if (mask == (((uptr)-1) >> 1)) 538 { 539 { 540 ptr* ppend = ((ptr*)(TO_VOIDP((((uptr)(TO_PTR(pp))) + len)))) - 1; 541 while (pp < ppend) 542 { 543 relocate_impure(&(*(pp)), from_g); 544 pp += 1; 545 } 546 } 547 } 548 else 549 { 550 while (mask != 0) 551 { 552 if (mask & 1) 553 { 554 relocate_impure(&(*(pp)), from_g); 555 } 556 mask >>= 1; 557 pp += 1; 558 } 559 } 560 } 561 } 562 else 563 { 564 relocate_pure(&(RECORDDESCPM(rtd))); 565 num = RECORDDESCPM(rtd); 566 { 567 iptr index = (BIGLEN(num)) - 1; 568 bigit mask = (BIGIT(num, index)) >> 1; 569 INT bits = bigit_bits - 1; 570 while (1) 571 { 572 do 573 { 574 if (mask & 1) 575 { 576 relocate_impure(&(*(pp)), from_g); 577 } 578 mask >>= 1; 579 pp += 1; 580 bits -= 1; 581 } 582 while (bits > 0); 583 if (index == 0) 584 { 585 break; 586 } 587 index -= 1; 588 mask = BIGIT(num, index); 589 bits = bigit_bits; 590 } 591 } 592 } 593 } 594 } 595 } 596 } 597 else if (TYPEP(tf, mask_vector, type_vector)) 598 { 599 uptr len = Svector_length(p); 600 { 601 uptr idx, p_len = len; 602 ptr *p_p = &INITVECTIT(p, 0); 603 for (idx = 0; idx < p_len; idx++) 604 { 605 relocate_impure(&(p_p[idx]), from_g); 606 } 607 } 608 } 609 else if (TYPEP(tf, mask_stencil_vector, type_stencil_vector)) 610 { 611 uptr len = Sstencil_vector_length(p); 612 { 613 uptr idx, p_len = len; 614 ptr *p_p = &INITSTENVECTIT(p, 0); 615 for (idx = 0; idx < p_len; idx++) 616 { 617 relocate_impure(&(p_p[idx]), from_g); 618 } 619 } 620 } 621 else if (TYPEP(tf, mask_string, type_string)) 622 { 623 } 624 else if (TYPEP(tf, mask_fxvector, type_fxvector)) 625 { 626 } 627 else if (TYPEP(tf, mask_flvector, type_flvector)) 628 { 629 } 630 else if (TYPEP(tf, mask_bytevector, type_bytevector)) 631 { 632 { 633 ISPC p_at_spc = SPACE(p); 634 if (p_at_spc == space_reference_array) 635 { 636 { 637 uptr len = Sbytevector_reference_length(p); 638 { 639 uptr idx, p_len = len; 640 ptr *p_p = (ptr*)&BVIT(p, 0); 641 for (idx = 0; idx < p_len; idx++) 642 { 643 relocate_reference(&(p_p[idx]), from_g); 644 } 645 } 646 } 647 } 648 else 649 { 650 } 651 } 652 } 653 else if ((iptr)tf == type_tlc) 654 { 655 relocate_impure(&INITTLCHT(p), from_g); 656 relocate_impure(&INITTLCKEYVAL(p), from_g); 657 relocate_impure(&INITTLCNEXT(p), from_g); 658 } 659 else if (TYPEP(tf, mask_box, type_box)) 660 { 661 relocate_impure(&INITBOXREF(p), from_g); 662 } 663 else if ((iptr)tf == type_ratnum) 664 { 665 relocate_pure(&RATNUM(p)); 666 relocate_pure(&RATDEN(p)); 667 } 668 else if ((iptr)tf == type_exactnum) 669 { 670 relocate_pure(&EXACTNUM_REAL_PART(p)); 671 relocate_pure(&EXACTNUM_IMAG_PART(p)); 672 } 673 else if ((iptr)tf == type_inexactnum) 674 { 675 } 676 else if (TYPEP(tf, mask_bignum, type_bignum)) 677 { 678 } 679 else if (TYPEP(tf, mask_port, type_port)) 680 { 681 relocate_impure(&PORTHANDLER(p), from_g); 682 if (((uptr)tf) & PORT_FLAG_OUTPUT) 683 { 684 iptr n = ((iptr)(PORTOLAST(p))) - ((iptr)(PORTOBUF(p))); 685 relocate_impure(&PORTOBUF(p), from_g); 686 PORTOLAST(p) = (ptr)(((iptr)(PORTOBUF(p))) + n); 687 } 688 if (((uptr)tf) & PORT_FLAG_INPUT) 689 { 690 iptr n = ((iptr)(PORTILAST(p))) - ((iptr)(PORTIBUF(p))); 691 relocate_impure(&PORTIBUF(p), from_g); 692 PORTILAST(p) = (ptr)(((iptr)(PORTIBUF(p))) + n); 693 } 694 relocate_impure(&PORTINFO(p), from_g); 695 relocate_impure(&PORTNAME(p), from_g); 696 } 697 else if (TYPEP(tf, mask_code, type_code)) 698 { 699 relocate_pure(&CODENAME(p)); 700 relocate_pure(&CODEARITYMASK(p)); 701 relocate_pure(&CODEINFO(p)); 702 relocate_pure(&CODEPINFOS(p)); 703 { 704 ptr t = CODERELOC(p); 705 { 706 iptr m = (t 707 ? (RELOCSIZE(t)) 708 : 0); 709 { 710 ptr oldco = (t 711 ? (RELOCCODE(t)) 712 : 0); 713 { 714 iptr a = 0; 715 { 716 iptr n = 0; 717 while (n < m) 718 { 719 { 720 uptr entry = RELOCIT(t, n); 721 uptr item_off = 0; 722 uptr code_off = 0; 723 n = n + 1; 724 if (RELOC_EXTENDED_FORMAT(entry)) 725 { 726 item_off = RELOCIT(t, n); 727 n = n + 1; 728 code_off = RELOCIT(t, n); 729 n = n + 1; 730 } 731 else 732 { 733 item_off = RELOC_ITEM_OFFSET(entry); 734 code_off = RELOC_CODE_OFFSET(entry); 735 } 736 a = a + code_off; 737 { 738 ptr obj = S_get_code_obj(RELOC_TYPE(entry), oldco, a, item_off); 739 relocate_pure(&obj); 740 S_set_code_obj("gc", RELOC_TYPE(entry), p, a, obj, item_off); 741 } 742 } 743 } 744 if ((from_g == static_generation) && ((!S_G.retain_static_relocation) && (0 == ((CODETYPE(p)) & (code_flag_template << code_flags_offset))))) 745 { 746 CODERELOC(p) = (ptr)0; 747 } 748 else 749 { 750 { 751 seginfo* t_si = SegInfo((ptr_get_segment(t))); 752 if (t_si -> old_space) 753 { 754 if (SEGMENT_IS_LOCAL(t_si, t)) 755 { 756 n = size_reloc_table((RELOCSIZE(t))); 757 if (t_si -> use_marks) 758 { 759 if (!(marked(t_si, t))) 760 { 761 mark_untyped_data_object(tgc, t, n, t_si); 762 } 763 } 764 else 765 { 766 { 767 ptr oldt = t; 768 find_gc_room(tgc, space_data, from_g, type_untyped, n, t); 769 memcpy_aligned(TO_VOIDP(t), TO_VOIDP(oldt), n); 770 } 771 } 772 } 773 else 774 { 775 RECORD_REMOTE(t_si); 776 } 777 } 778 } 779 RELOCCODE(t) = p; 780 CODERELOC(p) = t; 781 } 782 S_record_code_mod(tgc -> tc, (uptr)(TO_PTR((&(CODEIT(p, 0))))), (uptr)(CODELEN(p))); 783 } 784 } 785 } 786 } 787 } 788 } 789 else if ((iptr)tf == type_thread) 790 { 791 { 792 ptr tc = (ptr)(THREADTC(p)); 793 if (tc != ((ptr)0)) 794 { 795 { 796 ptr old_stack = SCHEMESTACK(tc); 797 if (OLDSPACE(old_stack)) 798 { 799 { 800 iptr clength = ((uptr)(SFP(tc))) - ((uptr)old_stack); 801 SCHEMESTACK(tc) = copy_stack(tgc, old_stack, &(SCHEMESTACKSIZE(tc)), clength + (sizeof(ptr))); 802 SFP(tc) = (ptr)(((uptr)(SCHEMESTACK(tc))) + clength); 803 ESP(tc) = (ptr)((((uptr)(SCHEMESTACK(tc))) + (SCHEMESTACKSIZE(tc))) - stack_slop); 804 } 805 } 806 } 807 STACKCACHE(tc) = Snil; 808 relocate_pure(&(CCHAIN(tc))); 809 relocate_pure(&(STACKLINK(tc))); 810 relocate_pure(&(WINDERS(tc))); 811 relocate_pure(&(ATTACHMENTS(tc))); 812 CACHEDFRAME(tc) = Sfalse; 813 { 814 ptr xcp = FRAME(tc, 0); 815 { 816 iptr co = (ENTRYOFFSET(xcp)) + (((uptr)xcp) - ((uptr)(TO_PTR((ENTRYOFFSETADDR(xcp)))))); 817 { 818 ptr c_p = (ptr)(((uptr)xcp) - co); 819 { 820 seginfo* x_si = SegInfo((ptr_get_segment(c_p))); 821 if (x_si -> old_space) 822 { 823 relocate_code(c_p, x_si); 824 FRAME(tc, 0) = (ptr)(((uptr)c_p) + co); 825 } 826 { 827 uptr base = (uptr)(SCHEMESTACK(tc)); 828 { 829 uptr fp = (uptr)(SFP(tc)); 830 { 831 uptr ret = (uptr)(FRAME(tc, 0)); 832 while (fp != base) 833 { 834 if (fp < base) 835 { 836 S_error_abort("sweep_stack(gc): malformed stack"); 837 } 838 fp = fp - (ENTRYFRAMESIZE(ret)); 839 { 840 ptr* pp = (ptr*)(TO_VOIDP(fp)); 841 iptr oldret = ret; 842 ret = (iptr)(*(pp)); 843 { 844 ptr xcp = *(pp); 845 { 846 iptr co = (ENTRYOFFSET(xcp)) + (((uptr)xcp) - ((uptr)(TO_PTR((ENTRYOFFSETADDR(xcp)))))); 847 { 848 ptr c_p = (ptr)(((uptr)xcp) - co); 849 { 850 seginfo* x_si = SegInfo((ptr_get_segment(c_p))); 851 if (x_si -> old_space) 852 { 853 relocate_code(c_p, x_si); 854 *(pp) = (ptr)(((uptr)c_p) + co); 855 } 856 { 857 ptr num = ENTRYLIVEMASK(oldret); 858 if (Sfixnump(num)) 859 { 860 { 861 uptr mask = UNFIX(num); 862 while (mask != 0) 863 { 864 pp += 1; 865 if (mask & 1) 866 { 867 relocate_pure(&(*(pp))); 868 } 869 mask >>= 1; 870 } 871 } 872 } 873 else 874 { 875 seginfo* n_si = SegInfo((ptr_get_segment(num))); 876 if (!(n_si -> old_space)) 877 { 878 } 879 else if (SEGMENT_IS_LOCAL(n_si, num)) 880 { 881 relocate_pure(&(*((ENTRYNONCOMPACTLIVEMASKADDR(oldret))))); 882 num = ENTRYLIVEMASK(oldret); 883 } 884 else 885 { 886 RECORD_REMOTE(n_si); 887 num = S_G.zero_length_bignum; 888 } 889 { 890 iptr index = BIGLEN(num); 891 while (index != 0) 892 { 893 index -= 1; 894 { 895 INT bits = bigit_bits; 896 bigit mask = BIGIT(num, index); 897 while (bits > 0) 898 { 899 bits -= 1; 900 pp += 1; 901 if (mask & 1) 902 { 903 relocate_pure(&(*(pp))); 904 } 905 mask >>= 1; 906 } 907 } 908 } 909 } 910 } 911 } 912 } 913 } 914 } 915 } 916 } 917 } 918 U(tc) = 0; 919 V(tc) = 0; 920 W(tc) = 0; 921 X(tc) = 0; 922 Y(tc) = 0; 923 relocate_pure(&(THREADNO(tc))); 924 relocate_pure(&(CURRENTINPUT(tc))); 925 relocate_pure(&(CURRENTOUTPUT(tc))); 926 relocate_pure(&(CURRENTERROR(tc))); 927 relocate_pure(&(SFD(tc))); 928 relocate_pure(&(CURRENTMSO(tc))); 929 relocate_pure(&(TARGETMACHINE(tc))); 930 relocate_pure(&(FXLENGTHBV(tc))); 931 relocate_pure(&(FXFIRSTBITSETBV(tc))); 932 relocate_pure(&(COMPILEPROFILE(tc))); 933 relocate_pure(&(SUBSETMODE(tc))); 934 relocate_pure(&(DEFAULTRECORDEQUALPROCEDURE(tc))); 935 relocate_pure(&(DEFAULTRECORDHASHPROCEDURE(tc))); 936 relocate_pure(&(COMPRESSFORMAT(tc))); 937 relocate_pure(&(COMPRESSLEVEL(tc))); 938 relocate_pure(&(PARAMETERS(tc))); 939 DSTBV(tc) = Sfalse; 940 SRCBV(tc) = Sfalse; 941 { 942 INT i = 0; 943 while (i < virtual_register_count) 944 { 945 relocate_pure(&(VIRTREG(tc, i))); 946 i += 1; 947 } 948 } 949 } 950 } 951 } 952 } 953 } 954 } 955 } 956 } 957 } 958 } 959 else if ((iptr)tf == type_rtd_counts) 960 { 961 } 962 else if ((iptr)tf == type_phantom) 963 { 964 } 965 else 966 { 967 S_error_abort("sweep: illegal typed object type"); 968 } 969 } 970 else if (t == type_pair) 971 { 972 { 973 ISPC p_at_spc = SPACE(p); 974 if (p_at_spc < space_weakpair) 975 { 976 relocate_impure(&INITCAR(p), from_g); 977 relocate_impure(&INITCDR(p), from_g); 978 } 979 else if (p_at_spc == space_ephemeron) 980 { 981 add_ephemeron_to_pending(tgc, p); 982 } 983 else if (p_at_spc == space_weakpair) 984 { 985 relocate_impure(&INITCDR(p), from_g); 986 } 987 else 988 { 989 relocate_reference(&INITCAR(p), from_g); 990 relocate_reference(&INITCDR(p), from_g); 991 } 992 } 993 } 994 else if (t == type_closure) 995 { 996 ptr code = CLOSCODE(p); 997 relocate_pure(&code); 998 if ((CODETYPE(code)) & (code_flag_continuation << code_flags_offset)) 999 { 1000 SETCLOSCODE(p, code); 1001 relocate_pure(&CONTWINDERS(p)); 1002 relocate_impure(&CONTATTACHMENTS(p), from_g); 1003 if ((CONTLENGTH(p)) == scaled_shot_1_shot_flag) 1004 { 1005 } 1006 else 1007 { 1008 ptr stk = CONTSTACK(p); 1009 { 1010 seginfo* s_si = NULL; 1011 if ((stk != ((ptr)0)) && ((s_si = (SegInfo((ptr_get_segment(stk))))), (s_si -> old_space))) 1012 { 1013 if (!(SEGMENT_IS_LOCAL(s_si, stk))) 1014 { 1015 RECORD_REMOTE(s_si); 1016 } 1017 else 1018 { 1019 CONTSTACK(p) = copy_stack(tgc, CONTSTACK(p), &(CONTLENGTH(p)), CONTCLENGTH(p)); 1020 } 1021 } 1022 relocate_pure(&CONTLINK(p)); 1023 { 1024 ptr xcp = CONTRET(p); 1025 { 1026 iptr co = (ENTRYOFFSET(xcp)) + (((uptr)xcp) - ((uptr)(TO_PTR((ENTRYOFFSETADDR(xcp)))))); 1027 { 1028 ptr c_p = (ptr)(((uptr)xcp) - co); 1029 { 1030 seginfo* x_si = SegInfo((ptr_get_segment(c_p))); 1031 if (x_si -> old_space) 1032 { 1033 relocate_code(c_p, x_si); 1034 CONTRET(p) = (ptr)(((uptr)c_p) + co); 1035 } 1036 { 1037 uptr stack = (uptr)(CONTSTACK(p)); 1038 { 1039 uptr base = stack; 1040 { 1041 uptr fp = stack + (CONTCLENGTH(p)); 1042 { 1043 uptr ret = (uptr)(CONTRET(p)); 1044 while (fp != base) 1045 { 1046 if (fp < base) 1047 { 1048 S_error_abort("sweep_stack(gc): malformed stack"); 1049 } 1050 fp = fp - (ENTRYFRAMESIZE(ret)); 1051 { 1052 ptr* pp = (ptr*)(TO_VOIDP(fp)); 1053 iptr oldret = ret; 1054 ret = (iptr)(*(pp)); 1055 { 1056 ptr xcp = *(pp); 1057 { 1058 iptr co = (ENTRYOFFSET(xcp)) + (((uptr)xcp) - ((uptr)(TO_PTR((ENTRYOFFSETADDR(xcp)))))); 1059 { 1060 ptr c_p = (ptr)(((uptr)xcp) - co); 1061 { 1062 seginfo* x_si = SegInfo((ptr_get_segment(c_p))); 1063 if (x_si -> old_space) 1064 { 1065 relocate_code(c_p, x_si); 1066 *(pp) = (ptr)(((uptr)c_p) + co); 1067 } 1068 { 1069 ptr num = ENTRYLIVEMASK(oldret); 1070 if (Sfixnump(num)) 1071 { 1072 { 1073 uptr mask = UNFIX(num); 1074 while (mask != 0) 1075 { 1076 pp += 1; 1077 if (mask & 1) 1078 { 1079 relocate_pure(&(*(pp))); 1080 } 1081 mask >>= 1; 1082 } 1083 } 1084 } 1085 else 1086 { 1087 seginfo* n_si = SegInfo((ptr_get_segment(num))); 1088 if (!(n_si -> old_space)) 1089 { 1090 } 1091 else if (SEGMENT_IS_LOCAL(n_si, num)) 1092 { 1093 relocate_pure(&(*((ENTRYNONCOMPACTLIVEMASKADDR(oldret))))); 1094 num = ENTRYLIVEMASK(oldret); 1095 } 1096 else 1097 { 1098 RECORD_REMOTE(n_si); 1099 num = S_G.zero_length_bignum; 1100 } 1101 { 1102 iptr index = BIGLEN(num); 1103 while (index != 0) 1104 { 1105 index -= 1; 1106 { 1107 INT bits = bigit_bits; 1108 bigit mask = BIGIT(num, index); 1109 while (bits > 0) 1110 { 1111 bits -= 1; 1112 pp += 1; 1113 if (mask & 1) 1114 { 1115 relocate_pure(&(*(pp))); 1116 } 1117 mask >>= 1; 1118 } 1119 } 1120 } 1121 } 1122 } 1123 } 1124 } 1125 } 1126 } 1127 } 1128 } 1129 } 1130 } 1131 } 1132 } 1133 } 1134 } 1135 } 1136 } 1137 } 1138 } 1139 } 1140 } 1141 else 1142 { 1143 uptr len = CODEFREE(code); 1144 if ((CODETYPE(code)) & (code_flag_mutable_closure << code_flags_offset)) 1145 { 1146 SETCLOSCODE(p, code); 1147 { 1148 uptr idx, p_len = len; 1149 ptr *p_p = &CLOSIT(p, 0); 1150 for (idx = 0; idx < p_len; idx++) 1151 { 1152 relocate_impure(&(p_p[idx]), from_g); 1153 } 1154 } 1155 } 1156 else 1157 { 1158 SETCLOSCODE(p, code); 1159 { 1160 uptr idx, p_len = len; 1161 ptr *p_p = &CLOSIT(p, 0); 1162 for (idx = 0; idx < p_len; idx++) 1163 { 1164 relocate_pure(&(p_p[idx])); 1165 } 1166 } 1167 } 1168 } 1169 } 1170 else if (t == type_symbol) 1171 { 1172 relocate_impure(&INITSYMVAL(p), from_g); 1173 { 1174 ptr val = INITSYMVAL(p); 1175 { 1176 ptr code = ((Sprocedurep(val)) 1177 ? (CLOSCODE(val)) 1178 : (SYMCODE(p))); 1179 relocate_pure(&code); 1180 INITSYMCODE(p, code); 1181 relocate_impure(&INITSYMPLIST(p), from_g); 1182 relocate_impure(&INITSYMNAME(p), from_g); 1183 relocate_impure(&INITSYMSPLIST(p), from_g); 1184 relocate_impure(&INITSYMHASH(p), from_g); 1185 } 1186 } 1187 } 1188 else if (t == type_flonum) 1189 { 1190 } 1191 else 1192 { 1193 S_error_abort("sweep: illegal type"); 1194 } 1195 } 1196 FLUSH_REMOTE(tgc, p); 1197} 1198 1199static void sweep_object_in_old(thread_gc *tgc, ptr p) 1200{ 1201 FLUSH_REMOTE_BLOCK 1202 { 1203 ITYPE t = TYPEBITS(p); 1204 if (t == type_typed_object) 1205 { 1206 ptr tf = TYPEFIELD(p); 1207 if (TYPEP(tf, mask_record, type_record)) 1208 { 1209 relocate_pure(&RECORDINSTTYPE(p)); 1210 { 1211 ptr rtd = RECORDINSTTYPE(p); 1212 { 1213 uptr len = UNFIX((RECORDDESCSIZE(rtd))); 1214 { 1215 ptr num = RECORDDESCPM(rtd); 1216 ptr* pp = &(RECORDINSTIT(p, 0)); 1217 if (Sfixnump(num)) 1218 { 1219 { 1220 uptr mask = ((uptr)(UNFIX(num))) >> 1; 1221 if (mask == (((uptr)-1) >> 1)) 1222 { 1223 { 1224 ptr* ppend = ((ptr*)(TO_VOIDP((((uptr)(TO_PTR(pp))) + len)))) - 1; 1225 while (pp < ppend) 1226 { 1227 relocate_indirect((*(pp))); 1228 pp += 1; 1229 } 1230 } 1231 } 1232 else 1233 { 1234 while (mask != 0) 1235 { 1236 if (mask & 1) 1237 { 1238 relocate_indirect((*(pp))); 1239 } 1240 mask >>= 1; 1241 pp += 1; 1242 } 1243 } 1244 } 1245 } 1246 else 1247 { 1248 relocate_pure(&(RECORDDESCPM(rtd))); 1249 num = RECORDDESCPM(rtd); 1250 { 1251 iptr index = (BIGLEN(num)) - 1; 1252 bigit mask = (BIGIT(num, index)) >> 1; 1253 INT bits = bigit_bits - 1; 1254 while (1) 1255 { 1256 do 1257 { 1258 if (mask & 1) 1259 { 1260 relocate_indirect((*(pp))); 1261 } 1262 mask >>= 1; 1263 pp += 1; 1264 bits -= 1; 1265 } 1266 while (bits > 0); 1267 if (index == 0) 1268 { 1269 break; 1270 } 1271 index -= 1; 1272 mask = BIGIT(num, index); 1273 bits = bigit_bits; 1274 } 1275 } 1276 } 1277 } 1278 } 1279 } 1280 } 1281 else if (TYPEP(tf, mask_vector, type_vector)) 1282 { 1283 uptr len = Svector_length(p); 1284 { 1285 uptr idx, p_len = len; 1286 ptr *p_p = &INITVECTIT(p, 0); 1287 for (idx = 0; idx < p_len; idx++) 1288 { 1289 relocate_indirect((p_p[idx])); 1290 } 1291 } 1292 } 1293 else if (TYPEP(tf, mask_stencil_vector, type_stencil_vector)) 1294 { 1295 uptr len = Sstencil_vector_length(p); 1296 { 1297 uptr idx, p_len = len; 1298 ptr *p_p = &INITSTENVECTIT(p, 0); 1299 for (idx = 0; idx < p_len; idx++) 1300 { 1301 relocate_indirect((p_p[idx])); 1302 } 1303 } 1304 } 1305 else if (TYPEP(tf, mask_string, type_string)) 1306 { 1307 } 1308 else if (TYPEP(tf, mask_fxvector, type_fxvector)) 1309 { 1310 } 1311 else if (TYPEP(tf, mask_flvector, type_flvector)) 1312 { 1313 } 1314 else if (TYPEP(tf, mask_bytevector, type_bytevector)) 1315 { 1316 { 1317 ISPC p_at_spc = SPACE(p); 1318 if (p_at_spc == space_reference_array) 1319 { 1320 { 1321 uptr len = Sbytevector_reference_length(p); 1322 { 1323 uptr idx, p_len = len; 1324 ptr *p_p = (ptr*)&BVIT(p, 0); 1325 for (idx = 0; idx < p_len; idx++) 1326 { 1327 relocate_reference_indirect((p_p[idx])); 1328 } 1329 } 1330 } 1331 } 1332 else 1333 { 1334 } 1335 } 1336 } 1337 else if ((iptr)tf == type_tlc) 1338 { 1339 relocate_indirect(INITTLCHT(p)); 1340 relocate_indirect(INITTLCKEYVAL(p)); 1341 relocate_indirect(INITTLCNEXT(p)); 1342 } 1343 else if (TYPEP(tf, mask_box, type_box)) 1344 { 1345 relocate_indirect(INITBOXREF(p)); 1346 } 1347 else if ((iptr)tf == type_ratnum) 1348 { 1349 relocate_pure(&RATNUM(p)); 1350 relocate_pure(&RATDEN(p)); 1351 } 1352 else if ((iptr)tf == type_exactnum) 1353 { 1354 relocate_pure(&EXACTNUM_REAL_PART(p)); 1355 relocate_pure(&EXACTNUM_IMAG_PART(p)); 1356 } 1357 else if ((iptr)tf == type_inexactnum) 1358 { 1359 } 1360 else if (TYPEP(tf, mask_bignum, type_bignum)) 1361 { 1362 } 1363 else if (TYPEP(tf, mask_port, type_port)) 1364 { 1365 relocate_indirect(PORTHANDLER(p)); 1366 if (((uptr)tf) & PORT_FLAG_OUTPUT) 1367 { 1368 relocate_indirect(PORTOBUF(p)); 1369 } 1370 if (((uptr)tf) & PORT_FLAG_INPUT) 1371 { 1372 relocate_indirect(PORTIBUF(p)); 1373 } 1374 relocate_indirect(PORTINFO(p)); 1375 relocate_indirect(PORTNAME(p)); 1376 } 1377 else if (TYPEP(tf, mask_code, type_code)) 1378 { 1379 relocate_pure(&CODENAME(p)); 1380 relocate_pure(&CODEARITYMASK(p)); 1381 relocate_pure(&CODEINFO(p)); 1382 relocate_pure(&CODEPINFOS(p)); 1383 { 1384 ptr t = CODERELOC(p); 1385 { 1386 iptr m = (t 1387 ? (RELOCSIZE(t)) 1388 : 0); 1389 { 1390 ptr oldco = (t 1391 ? (RELOCCODE(t)) 1392 : 0); 1393 { 1394 iptr a = 0; 1395 { 1396 iptr n = 0; 1397 while (n < m) 1398 { 1399 { 1400 uptr entry = RELOCIT(t, n); 1401 uptr item_off = 0; 1402 uptr code_off = 0; 1403 n = n + 1; 1404 if (RELOC_EXTENDED_FORMAT(entry)) 1405 { 1406 item_off = RELOCIT(t, n); 1407 n = n + 1; 1408 code_off = RELOCIT(t, n); 1409 n = n + 1; 1410 } 1411 else 1412 { 1413 item_off = RELOC_ITEM_OFFSET(entry); 1414 code_off = RELOC_CODE_OFFSET(entry); 1415 } 1416 a = a + code_off; 1417 { 1418 ptr obj = S_get_code_obj(RELOC_TYPE(entry), oldco, a, item_off); 1419 relocate_pure(&obj); 1420 } 1421 } 1422 } 1423 } 1424 } 1425 } 1426 } 1427 } 1428 } 1429 else if ((iptr)tf == type_thread) 1430 { 1431 { 1432 ptr tc = (ptr)(THREADTC(p)); 1433 if (tc != ((ptr)0)) 1434 { 1435 STACKCACHE(tc) = Snil; 1436 relocate_pure(&(CCHAIN(tc))); 1437 relocate_pure(&(STACKLINK(tc))); 1438 relocate_pure(&(WINDERS(tc))); 1439 relocate_pure(&(ATTACHMENTS(tc))); 1440 { 1441 ptr xcp = FRAME(tc, 0); 1442 { 1443 iptr co = (ENTRYOFFSET(xcp)) + (((uptr)xcp) - ((uptr)(TO_PTR((ENTRYOFFSETADDR(xcp)))))); 1444 { 1445 ptr c_p = (ptr)(((uptr)xcp) - co); 1446 { 1447 seginfo* x_si = SegInfo((ptr_get_segment(c_p))); 1448 if (x_si -> old_space) 1449 { 1450 relocate_code(c_p, x_si); 1451 } 1452 { 1453 uptr base = (uptr)(SCHEMESTACK(tc)); 1454 { 1455 uptr fp = (uptr)(SFP(tc)); 1456 { 1457 uptr ret = (uptr)(FRAME(tc, 0)); 1458 while (fp != base) 1459 { 1460 if (fp < base) 1461 { 1462 S_error_abort("sweep_stack(gc): malformed stack"); 1463 } 1464 fp = fp - (ENTRYFRAMESIZE(ret)); 1465 { 1466 ptr* pp = (ptr*)(TO_VOIDP(fp)); 1467 iptr oldret = ret; 1468 ret = (iptr)(*(pp)); 1469 { 1470 ptr xcp = *(pp); 1471 { 1472 iptr co = (ENTRYOFFSET(xcp)) + (((uptr)xcp) - ((uptr)(TO_PTR((ENTRYOFFSETADDR(xcp)))))); 1473 { 1474 ptr c_p = (ptr)(((uptr)xcp) - co); 1475 { 1476 seginfo* x_si = SegInfo((ptr_get_segment(c_p))); 1477 if (x_si -> old_space) 1478 { 1479 relocate_code(c_p, x_si); 1480 } 1481 { 1482 ptr num = ENTRYLIVEMASK(oldret); 1483 if (Sfixnump(num)) 1484 { 1485 { 1486 uptr mask = UNFIX(num); 1487 while (mask != 0) 1488 { 1489 pp += 1; 1490 if (mask & 1) 1491 { 1492 relocate_pure(&(*(pp))); 1493 } 1494 mask >>= 1; 1495 } 1496 } 1497 } 1498 else 1499 { 1500 seginfo* n_si = SegInfo((ptr_get_segment(num))); 1501 if (!(n_si -> old_space)) 1502 { 1503 } 1504 else if (SEGMENT_IS_LOCAL(n_si, num)) 1505 { 1506 relocate_pure(&(*((ENTRYNONCOMPACTLIVEMASKADDR(oldret))))); 1507 num = ENTRYLIVEMASK(oldret); 1508 } 1509 else 1510 { 1511 RECORD_REMOTE(n_si); 1512 num = S_G.zero_length_bignum; 1513 } 1514 { 1515 iptr index = BIGLEN(num); 1516 while (index != 0) 1517 { 1518 index -= 1; 1519 { 1520 INT bits = bigit_bits; 1521 bigit mask = BIGIT(num, index); 1522 while (bits > 0) 1523 { 1524 bits -= 1; 1525 pp += 1; 1526 if (mask & 1) 1527 { 1528 relocate_pure(&(*(pp))); 1529 } 1530 mask >>= 1; 1531 } 1532 } 1533 } 1534 } 1535 } 1536 } 1537 } 1538 } 1539 } 1540 } 1541 } 1542 } 1543 relocate_pure(&(THREADNO(tc))); 1544 relocate_pure(&(CURRENTINPUT(tc))); 1545 relocate_pure(&(CURRENTOUTPUT(tc))); 1546 relocate_pure(&(CURRENTERROR(tc))); 1547 relocate_pure(&(SFD(tc))); 1548 relocate_pure(&(CURRENTMSO(tc))); 1549 relocate_pure(&(TARGETMACHINE(tc))); 1550 relocate_pure(&(FXLENGTHBV(tc))); 1551 relocate_pure(&(FXFIRSTBITSETBV(tc))); 1552 relocate_pure(&(COMPILEPROFILE(tc))); 1553 relocate_pure(&(SUBSETMODE(tc))); 1554 relocate_pure(&(DEFAULTRECORDEQUALPROCEDURE(tc))); 1555 relocate_pure(&(DEFAULTRECORDHASHPROCEDURE(tc))); 1556 relocate_pure(&(COMPRESSFORMAT(tc))); 1557 relocate_pure(&(COMPRESSLEVEL(tc))); 1558 relocate_pure(&(PARAMETERS(tc))); 1559 { 1560 INT i = 0; 1561 while (i < virtual_register_count) 1562 { 1563 relocate_pure(&(VIRTREG(tc, i))); 1564 i += 1; 1565 } 1566 } 1567 } 1568 } 1569 } 1570 } 1571 } 1572 } 1573 } 1574 } 1575 } 1576 } 1577 else if ((iptr)tf == type_rtd_counts) 1578 { 1579 } 1580 else if ((iptr)tf == type_phantom) 1581 { 1582 } 1583 else 1584 { 1585 S_error_abort("sweep-in-old: illegal typed object type"); 1586 } 1587 } 1588 else if (t == type_pair) 1589 { 1590 { 1591 ISPC p_at_spc = SPACE(p); 1592 if (p_at_spc < space_weakpair) 1593 { 1594 relocate_indirect(INITCAR(p)); 1595 relocate_indirect(INITCDR(p)); 1596 } 1597 else if (p_at_spc == space_ephemeron) 1598 { 1599 } 1600 else if (p_at_spc == space_weakpair) 1601 { 1602 relocate_indirect(INITCDR(p)); 1603 } 1604 else 1605 { 1606 S_error_abort("misplaced pair"); 1607 } 1608 } 1609 } 1610 else if (t == type_closure) 1611 { 1612 ptr code = CLOSCODE(p); 1613 relocate_pure(&code); 1614 if ((CODETYPE(code)) & (code_flag_continuation << code_flags_offset)) 1615 { 1616 SETCLOSCODE(p, code); 1617 relocate_pure(&CONTWINDERS(p)); 1618 relocate_indirect(CONTATTACHMENTS(p)); 1619 if ((CONTLENGTH(p)) == scaled_shot_1_shot_flag) 1620 { 1621 } 1622 else 1623 { 1624 relocate_pure(&CONTLINK(p)); 1625 { 1626 ptr xcp = CONTRET(p); 1627 { 1628 iptr co = (ENTRYOFFSET(xcp)) + (((uptr)xcp) - ((uptr)(TO_PTR((ENTRYOFFSETADDR(xcp)))))); 1629 { 1630 ptr c_p = (ptr)(((uptr)xcp) - co); 1631 { 1632 seginfo* x_si = SegInfo((ptr_get_segment(c_p))); 1633 if (x_si -> old_space) 1634 { 1635 relocate_code(c_p, x_si); 1636 } 1637 { 1638 uptr stack = (uptr)(CONTSTACK(p)); 1639 { 1640 uptr base = stack; 1641 { 1642 uptr fp = stack + (CONTCLENGTH(p)); 1643 { 1644 uptr ret = (uptr)(CONTRET(p)); 1645 while (fp != base) 1646 { 1647 if (fp < base) 1648 { 1649 S_error_abort("sweep_stack(gc): malformed stack"); 1650 } 1651 fp = fp - (ENTRYFRAMESIZE(ret)); 1652 { 1653 ptr* pp = (ptr*)(TO_VOIDP(fp)); 1654 iptr oldret = ret; 1655 ret = (iptr)(*(pp)); 1656 { 1657 ptr xcp = *(pp); 1658 { 1659 iptr co = (ENTRYOFFSET(xcp)) + (((uptr)xcp) - ((uptr)(TO_PTR((ENTRYOFFSETADDR(xcp)))))); 1660 { 1661 ptr c_p = (ptr)(((uptr)xcp) - co); 1662 { 1663 seginfo* x_si = SegInfo((ptr_get_segment(c_p))); 1664 if (x_si -> old_space) 1665 { 1666 relocate_code(c_p, x_si); 1667 } 1668 { 1669 ptr num = ENTRYLIVEMASK(oldret); 1670 if (Sfixnump(num)) 1671 { 1672 { 1673 uptr mask = UNFIX(num); 1674 while (mask != 0) 1675 { 1676 pp += 1; 1677 if (mask & 1) 1678 { 1679 relocate_pure(&(*(pp))); 1680 } 1681 mask >>= 1; 1682 } 1683 } 1684 } 1685 else 1686 { 1687 seginfo* n_si = SegInfo((ptr_get_segment(num))); 1688 if (!(n_si -> old_space)) 1689 { 1690 } 1691 else if (SEGMENT_IS_LOCAL(n_si, num)) 1692 { 1693 relocate_pure(&(*((ENTRYNONCOMPACTLIVEMASKADDR(oldret))))); 1694 num = ENTRYLIVEMASK(oldret); 1695 } 1696 else 1697 { 1698 RECORD_REMOTE(n_si); 1699 num = S_G.zero_length_bignum; 1700 } 1701 { 1702 iptr index = BIGLEN(num); 1703 while (index != 0) 1704 { 1705 index -= 1; 1706 { 1707 INT bits = bigit_bits; 1708 bigit mask = BIGIT(num, index); 1709 while (bits > 0) 1710 { 1711 bits -= 1; 1712 pp += 1; 1713 if (mask & 1) 1714 { 1715 relocate_pure(&(*(pp))); 1716 } 1717 mask >>= 1; 1718 } 1719 } 1720 } 1721 } 1722 } 1723 } 1724 } 1725 } 1726 } 1727 } 1728 } 1729 } 1730 } 1731 } 1732 } 1733 } 1734 } 1735 } 1736 } 1737 } 1738 } 1739 } 1740 else 1741 { 1742 uptr len = CODEFREE(code); 1743 if ((CODETYPE(code)) & (code_flag_mutable_closure << code_flags_offset)) 1744 { 1745 SETCLOSCODE(p, code); 1746 { 1747 uptr idx, p_len = len; 1748 ptr *p_p = &CLOSIT(p, 0); 1749 for (idx = 0; idx < p_len; idx++) 1750 { 1751 relocate_indirect((p_p[idx])); 1752 } 1753 } 1754 } 1755 else 1756 { 1757 SETCLOSCODE(p, code); 1758 { 1759 uptr idx, p_len = len; 1760 ptr *p_p = &CLOSIT(p, 0); 1761 for (idx = 0; idx < p_len; idx++) 1762 { 1763 relocate_pure(&(p_p[idx])); 1764 } 1765 } 1766 } 1767 } 1768 } 1769 else if (t == type_symbol) 1770 { 1771 relocate_indirect(INITSYMVAL(p)); 1772 { 1773 ptr val = INITSYMVAL(p); 1774 { 1775 ptr code = ((Sprocedurep(val)) 1776 ? (CLOSCODE(val)) 1777 : (SYMCODE(p))); 1778 relocate_pure(&code); 1779 INITSYMCODE(p, code); 1780 relocate_indirect(INITSYMPLIST(p)); 1781 relocate_indirect(INITSYMNAME(p)); 1782 relocate_indirect(INITSYMSPLIST(p)); 1783 relocate_indirect(INITSYMHASH(p)); 1784 } 1785 } 1786 } 1787 else if (t == type_flonum) 1788 { 1789 } 1790 else 1791 { 1792 S_error_abort("sweep-in-old: illegal type"); 1793 } 1794 } 1795 ASSERT_EMPTY_FLUSH_REMOTE(); 1796} 1797 1798static IGEN sweep_dirty_object(thread_gc *tgc, ptr p, IGEN youngest) 1799{ 1800 FLUSH_REMOTE_BLOCK 1801 { 1802 ITYPE t = TYPEBITS(p); 1803 if (t == type_typed_object) 1804 { 1805 ptr tf = TYPEFIELD(p); 1806 if (TYPEP(tf, mask_record, type_record)) 1807 { 1808 { 1809 ptr rtd = RECORDINSTTYPE(p); 1810 { 1811 ptr num = RECORDDESCMPM(rtd); 1812 ptr* pp = &(RECORDINSTIT(p, 0)); 1813 if (Sfixnump(num)) 1814 { 1815 { 1816 uptr mask = ((uptr)(UNFIX(num))) >> 1; 1817 while (mask != 0) 1818 { 1819 if (mask & 1) 1820 { 1821 relocate_dirty(&(*(pp)), youngest); 1822 } 1823 mask >>= 1; 1824 pp += 1; 1825 } 1826 } 1827 } 1828 else 1829 { 1830 { 1831 iptr index = (BIGLEN(num)) - 1; 1832 bigit mask = (BIGIT(num, index)) >> 1; 1833 INT bits = bigit_bits - 1; 1834 while (1) 1835 { 1836 do 1837 { 1838 if (mask & 1) 1839 { 1840 relocate_dirty(&(*(pp)), youngest); 1841 } 1842 mask >>= 1; 1843 pp += 1; 1844 bits -= 1; 1845 } 1846 while (bits > 0); 1847 if (index == 0) 1848 { 1849 break; 1850 } 1851 index -= 1; 1852 mask = BIGIT(num, index); 1853 bits = bigit_bits; 1854 } 1855 } 1856 } 1857 } 1858 } 1859 } 1860 else if (TYPEP(tf, mask_vector, type_vector)) 1861 { 1862 uptr len = Svector_length(p); 1863 { 1864 uptr idx, p_len = len; 1865 ptr *p_p = &INITVECTIT(p, 0); 1866 for (idx = 0; idx < p_len; idx++) 1867 { 1868 relocate_dirty(&(p_p[idx]), youngest); 1869 } 1870 } 1871 } 1872 else if (TYPEP(tf, mask_stencil_vector, type_stencil_vector)) 1873 { 1874 uptr len = Sstencil_vector_length(p); 1875 { 1876 uptr idx, p_len = len; 1877 ptr *p_p = &INITSTENVECTIT(p, 0); 1878 for (idx = 0; idx < p_len; idx++) 1879 { 1880 relocate_dirty(&(p_p[idx]), youngest); 1881 } 1882 } 1883 } 1884 else if (TYPEP(tf, mask_string, type_string)) 1885 { 1886 } 1887 else if (TYPEP(tf, mask_fxvector, type_fxvector)) 1888 { 1889 } 1890 else if (TYPEP(tf, mask_flvector, type_flvector)) 1891 { 1892 } 1893 else if (TYPEP(tf, mask_bytevector, type_bytevector)) 1894 { 1895 { 1896 ISPC p_at_spc = SPACE(p); 1897 if (p_at_spc == space_reference_array) 1898 { 1899 { 1900 uptr len = Sbytevector_reference_length(p); 1901 { 1902 uptr idx, p_len = len; 1903 ptr *p_p = (ptr*)&BVIT(p, 0); 1904 for (idx = 0; idx < p_len; idx++) 1905 { 1906 relocate_reference_dirty(&(p_p[idx]), youngest); 1907 } 1908 } 1909 } 1910 } 1911 else 1912 { 1913 } 1914 } 1915 } 1916 else if ((iptr)tf == type_tlc) 1917 { 1918 relocate_dirty(&INITTLCHT(p), youngest); 1919 relocate_dirty(&INITTLCKEYVAL(p), youngest); 1920 relocate_dirty(&INITTLCNEXT(p), youngest); 1921 } 1922 else if (TYPEP(tf, mask_box, type_box)) 1923 { 1924 relocate_dirty(&INITBOXREF(p), youngest); 1925 } 1926 else if ((iptr)tf == type_ratnum) 1927 { 1928 } 1929 else if ((iptr)tf == type_exactnum) 1930 { 1931 } 1932 else if ((iptr)tf == type_inexactnum) 1933 { 1934 } 1935 else if (TYPEP(tf, mask_bignum, type_bignum)) 1936 { 1937 } 1938 else if (TYPEP(tf, mask_port, type_port)) 1939 { 1940 relocate_dirty(&PORTHANDLER(p), youngest); 1941 if (((uptr)tf) & PORT_FLAG_OUTPUT) 1942 { 1943 iptr n = ((iptr)(PORTOLAST(p))) - ((iptr)(PORTOBUF(p))); 1944 relocate_dirty(&PORTOBUF(p), youngest); 1945 PORTOLAST(p) = (ptr)(((iptr)(PORTOBUF(p))) + n); 1946 } 1947 if (((uptr)tf) & PORT_FLAG_INPUT) 1948 { 1949 iptr n = ((iptr)(PORTILAST(p))) - ((iptr)(PORTIBUF(p))); 1950 relocate_dirty(&PORTIBUF(p), youngest); 1951 PORTILAST(p) = (ptr)(((iptr)(PORTIBUF(p))) + n); 1952 } 1953 relocate_dirty(&PORTINFO(p), youngest); 1954 relocate_dirty(&PORTNAME(p), youngest); 1955 } 1956 else if (TYPEP(tf, mask_code, type_code)) 1957 { 1958 } 1959 else if ((iptr)tf == type_thread) 1960 { 1961 } 1962 else if ((iptr)tf == type_rtd_counts) 1963 { 1964 } 1965 else if ((iptr)tf == type_phantom) 1966 { 1967 } 1968 else 1969 { 1970 S_error_abort("sweep: illegal typed object type"); 1971 } 1972 } 1973 else if (t == type_pair) 1974 { 1975 { 1976 ISPC p_at_spc = SPACE(p); 1977 if (p_at_spc < space_weakpair) 1978 { 1979 relocate_dirty(&INITCAR(p), youngest); 1980 relocate_dirty(&INITCDR(p), youngest); 1981 } 1982 else if (p_at_spc == space_ephemeron) 1983 { 1984 add_ephemeron_to_pending(tgc, p); 1985 } 1986 else if (p_at_spc == space_weakpair) 1987 { 1988 relocate_dirty(&INITCDR(p), youngest); 1989 } 1990 else 1991 { 1992 relocate_reference_dirty(&INITCAR(p), youngest); 1993 relocate_reference_dirty(&INITCDR(p), youngest); 1994 } 1995 } 1996 } 1997 else if (t == type_closure) 1998 { 1999 ptr code = CLOSCODE(p); 2000 { 2001 uptr len = CODEFREE(code); 2002 if ((CODETYPE(code)) & (code_flag_mutable_closure << code_flags_offset)) 2003 { 2004 { 2005 uptr idx, p_len = len; 2006 ptr *p_p = &CLOSIT(p, 0); 2007 for (idx = 0; idx < p_len; idx++) 2008 { 2009 relocate_dirty(&(p_p[idx]), youngest); 2010 } 2011 } 2012 } 2013 } 2014 } 2015 else if (t == type_symbol) 2016 { 2017 relocate_dirty(&INITSYMVAL(p), youngest); 2018 { 2019 ptr val = INITSYMVAL(p); 2020 { 2021 ptr code = ((Sprocedurep(val)) 2022 ? (CLOSCODE(val)) 2023 : (SYMCODE(p))); 2024 relocate_dirty(&code, youngest); 2025 INITSYMCODE(p, code); 2026 relocate_dirty(&INITSYMPLIST(p), youngest); 2027 relocate_dirty(&INITSYMNAME(p), youngest); 2028 relocate_dirty(&INITSYMSPLIST(p), youngest); 2029 relocate_dirty(&INITSYMHASH(p), youngest); 2030 } 2031 } 2032 } 2033 else if (t == type_flonum) 2034 { 2035 } 2036 else 2037 { 2038 S_error_abort("sweep: illegal type"); 2039 } 2040 } 2041 FLUSH_REMOTE(tgc, p); 2042 return youngest; 2043} 2044 2045static void sweep_record(thread_gc *tgc, ptr p, IGEN from_g) 2046{ 2047 FLUSH_REMOTE_BLOCK 2048 { 2049 relocate_pure(&RECORDINSTTYPE(p)); 2050 { 2051 ptr rtd = RECORDINSTTYPE(p); 2052 { 2053 uptr len = UNFIX((RECORDDESCSIZE(rtd))); 2054 { 2055 ptr num = RECORDDESCPM(rtd); 2056 ptr* pp = &(RECORDINSTIT(p, 0)); 2057 if (Sfixnump(num)) 2058 { 2059 { 2060 uptr mask = ((uptr)(UNFIX(num))) >> 1; 2061 if (mask == (((uptr)-1) >> 1)) 2062 { 2063 { 2064 ptr* ppend = ((ptr*)(TO_VOIDP((((uptr)(TO_PTR(pp))) + len)))) - 1; 2065 while (pp < ppend) 2066 { 2067 relocate_impure(&(*(pp)), from_g); 2068 pp += 1; 2069 } 2070 } 2071 } 2072 else 2073 { 2074 while (mask != 0) 2075 { 2076 if (mask & 1) 2077 { 2078 relocate_impure(&(*(pp)), from_g); 2079 } 2080 mask >>= 1; 2081 pp += 1; 2082 } 2083 } 2084 } 2085 } 2086 else 2087 { 2088 relocate_pure(&(RECORDDESCPM(rtd))); 2089 num = RECORDDESCPM(rtd); 2090 { 2091 iptr index = (BIGLEN(num)) - 1; 2092 bigit mask = (BIGIT(num, index)) >> 1; 2093 INT bits = bigit_bits - 1; 2094 while (1) 2095 { 2096 do 2097 { 2098 if (mask & 1) 2099 { 2100 relocate_impure(&(*(pp)), from_g); 2101 } 2102 mask >>= 1; 2103 pp += 1; 2104 bits -= 1; 2105 } 2106 while (bits > 0); 2107 if (index == 0) 2108 { 2109 break; 2110 } 2111 index -= 1; 2112 mask = BIGIT(num, index); 2113 bits = bigit_bits; 2114 } 2115 } 2116 } 2117 } 2118 } 2119 } 2120 } 2121 FLUSH_REMOTE(tgc, p); 2122} 2123 2124static IGEN sweep_dirty_record(thread_gc *tgc, ptr p, IGEN youngest) 2125{ 2126 FLUSH_REMOTE_BLOCK 2127 { 2128 { 2129 ptr rtd = RECORDINSTTYPE(p); 2130 { 2131 ptr num = RECORDDESCMPM(rtd); 2132 ptr* pp = &(RECORDINSTIT(p, 0)); 2133 if (Sfixnump(num)) 2134 { 2135 { 2136 uptr mask = ((uptr)(UNFIX(num))) >> 1; 2137 while (mask != 0) 2138 { 2139 if (mask & 1) 2140 { 2141 relocate_dirty(&(*(pp)), youngest); 2142 } 2143 mask >>= 1; 2144 pp += 1; 2145 } 2146 } 2147 } 2148 else 2149 { 2150 { 2151 iptr index = (BIGLEN(num)) - 1; 2152 bigit mask = (BIGIT(num, index)) >> 1; 2153 INT bits = bigit_bits - 1; 2154 while (1) 2155 { 2156 do 2157 { 2158 if (mask & 1) 2159 { 2160 relocate_dirty(&(*(pp)), youngest); 2161 } 2162 mask >>= 1; 2163 pp += 1; 2164 bits -= 1; 2165 } 2166 while (bits > 0); 2167 if (index == 0) 2168 { 2169 break; 2170 } 2171 index -= 1; 2172 mask = BIGIT(num, index); 2173 bits = bigit_bits; 2174 } 2175 } 2176 } 2177 } 2178 } 2179 } 2180 FLUSH_REMOTE(tgc, p); 2181 return youngest; 2182} 2183 2184static void sweep_symbol(thread_gc *tgc, ptr p, IGEN from_g) 2185{ 2186 FLUSH_REMOTE_BLOCK 2187 { 2188 { 2189 relocate_impure(&INITSYMVAL(p), from_g); 2190 { 2191 ptr val = INITSYMVAL(p); 2192 { 2193 ptr code = ((Sprocedurep(val)) 2194 ? (CLOSCODE(val)) 2195 : (SYMCODE(p))); 2196 relocate_pure(&code); 2197 INITSYMCODE(p, code); 2198 relocate_impure(&INITSYMPLIST(p), from_g); 2199 relocate_impure(&INITSYMNAME(p), from_g); 2200 relocate_impure(&INITSYMSPLIST(p), from_g); 2201 relocate_impure(&INITSYMHASH(p), from_g); 2202 } 2203 } 2204 } 2205 } 2206 FLUSH_REMOTE(tgc, p); 2207} 2208 2209static IGEN sweep_dirty_symbol(thread_gc *tgc, ptr p, IGEN youngest) 2210{ 2211 FLUSH_REMOTE_BLOCK 2212 { 2213 { 2214 relocate_dirty(&INITSYMVAL(p), youngest); 2215 { 2216 ptr val = INITSYMVAL(p); 2217 { 2218 ptr code = ((Sprocedurep(val)) 2219 ? (CLOSCODE(val)) 2220 : (SYMCODE(p))); 2221 relocate_dirty(&code, youngest); 2222 INITSYMCODE(p, code); 2223 relocate_dirty(&INITSYMPLIST(p), youngest); 2224 relocate_dirty(&INITSYMNAME(p), youngest); 2225 relocate_dirty(&INITSYMSPLIST(p), youngest); 2226 relocate_dirty(&INITSYMHASH(p), youngest); 2227 } 2228 } 2229 } 2230 } 2231 FLUSH_REMOTE(tgc, p); 2232 return youngest; 2233} 2234 2235static void sweep_thread(thread_gc *tgc, ptr p) 2236{ 2237 FLUSH_REMOTE_BLOCK 2238 { 2239 { 2240 ptr tc = (ptr)(THREADTC(p)); 2241 if (tc != ((ptr)0)) 2242 { 2243 { 2244 ptr old_stack = SCHEMESTACK(tc); 2245 if (OLDSPACE(old_stack)) 2246 { 2247 { 2248 iptr clength = ((uptr)(SFP(tc))) - ((uptr)old_stack); 2249 SCHEMESTACK(tc) = copy_stack(tgc, old_stack, &(SCHEMESTACKSIZE(tc)), clength + (sizeof(ptr))); 2250 SFP(tc) = (ptr)(((uptr)(SCHEMESTACK(tc))) + clength); 2251 ESP(tc) = (ptr)((((uptr)(SCHEMESTACK(tc))) + (SCHEMESTACKSIZE(tc))) - stack_slop); 2252 } 2253 } 2254 } 2255 STACKCACHE(tc) = Snil; 2256 relocate_pure(&(CCHAIN(tc))); 2257 relocate_pure(&(STACKLINK(tc))); 2258 relocate_pure(&(WINDERS(tc))); 2259 relocate_pure(&(ATTACHMENTS(tc))); 2260 CACHEDFRAME(tc) = Sfalse; 2261 { 2262 ptr xcp = FRAME(tc, 0); 2263 { 2264 iptr co = (ENTRYOFFSET(xcp)) + (((uptr)xcp) - ((uptr)(TO_PTR((ENTRYOFFSETADDR(xcp)))))); 2265 { 2266 ptr c_p = (ptr)(((uptr)xcp) - co); 2267 { 2268 seginfo* x_si = SegInfo((ptr_get_segment(c_p))); 2269 if (x_si -> old_space) 2270 { 2271 relocate_code(c_p, x_si); 2272 FRAME(tc, 0) = (ptr)(((uptr)c_p) + co); 2273 } 2274 { 2275 uptr base = (uptr)(SCHEMESTACK(tc)); 2276 { 2277 uptr fp = (uptr)(SFP(tc)); 2278 { 2279 uptr ret = (uptr)(FRAME(tc, 0)); 2280 while (fp != base) 2281 { 2282 if (fp < base) 2283 { 2284 S_error_abort("sweep_stack(gc): malformed stack"); 2285 } 2286 fp = fp - (ENTRYFRAMESIZE(ret)); 2287 { 2288 ptr* pp = (ptr*)(TO_VOIDP(fp)); 2289 iptr oldret = ret; 2290 ret = (iptr)(*(pp)); 2291 { 2292 ptr xcp = *(pp); 2293 { 2294 iptr co = (ENTRYOFFSET(xcp)) + (((uptr)xcp) - ((uptr)(TO_PTR((ENTRYOFFSETADDR(xcp)))))); 2295 { 2296 ptr c_p = (ptr)(((uptr)xcp) - co); 2297 { 2298 seginfo* x_si = SegInfo((ptr_get_segment(c_p))); 2299 if (x_si -> old_space) 2300 { 2301 relocate_code(c_p, x_si); 2302 *(pp) = (ptr)(((uptr)c_p) + co); 2303 } 2304 { 2305 ptr num = ENTRYLIVEMASK(oldret); 2306 if (Sfixnump(num)) 2307 { 2308 { 2309 uptr mask = UNFIX(num); 2310 while (mask != 0) 2311 { 2312 pp += 1; 2313 if (mask & 1) 2314 { 2315 relocate_pure(&(*(pp))); 2316 } 2317 mask >>= 1; 2318 } 2319 } 2320 } 2321 else 2322 { 2323 seginfo* n_si = SegInfo((ptr_get_segment(num))); 2324 if (!(n_si -> old_space)) 2325 { 2326 } 2327 else if (SEGMENT_IS_LOCAL(n_si, num)) 2328 { 2329 relocate_pure(&(*((ENTRYNONCOMPACTLIVEMASKADDR(oldret))))); 2330 num = ENTRYLIVEMASK(oldret); 2331 } 2332 else 2333 { 2334 RECORD_REMOTE(n_si); 2335 num = S_G.zero_length_bignum; 2336 } 2337 { 2338 iptr index = BIGLEN(num); 2339 while (index != 0) 2340 { 2341 index -= 1; 2342 { 2343 INT bits = bigit_bits; 2344 bigit mask = BIGIT(num, index); 2345 while (bits > 0) 2346 { 2347 bits -= 1; 2348 pp += 1; 2349 if (mask & 1) 2350 { 2351 relocate_pure(&(*(pp))); 2352 } 2353 mask >>= 1; 2354 } 2355 } 2356 } 2357 } 2358 } 2359 } 2360 } 2361 } 2362 } 2363 } 2364 } 2365 } 2366 U(tc) = 0; 2367 V(tc) = 0; 2368 W(tc) = 0; 2369 X(tc) = 0; 2370 Y(tc) = 0; 2371 relocate_pure(&(THREADNO(tc))); 2372 relocate_pure(&(CURRENTINPUT(tc))); 2373 relocate_pure(&(CURRENTOUTPUT(tc))); 2374 relocate_pure(&(CURRENTERROR(tc))); 2375 relocate_pure(&(SFD(tc))); 2376 relocate_pure(&(CURRENTMSO(tc))); 2377 relocate_pure(&(TARGETMACHINE(tc))); 2378 relocate_pure(&(FXLENGTHBV(tc))); 2379 relocate_pure(&(FXFIRSTBITSETBV(tc))); 2380 relocate_pure(&(COMPILEPROFILE(tc))); 2381 relocate_pure(&(SUBSETMODE(tc))); 2382 relocate_pure(&(DEFAULTRECORDEQUALPROCEDURE(tc))); 2383 relocate_pure(&(DEFAULTRECORDHASHPROCEDURE(tc))); 2384 relocate_pure(&(COMPRESSFORMAT(tc))); 2385 relocate_pure(&(COMPRESSLEVEL(tc))); 2386 relocate_pure(&(PARAMETERS(tc))); 2387 DSTBV(tc) = Sfalse; 2388 SRCBV(tc) = Sfalse; 2389 { 2390 INT i = 0; 2391 while (i < virtual_register_count) 2392 { 2393 relocate_pure(&(VIRTREG(tc, i))); 2394 i += 1; 2395 } 2396 } 2397 } 2398 } 2399 } 2400 } 2401 } 2402 } 2403 } 2404 } 2405 } 2406 } 2407 FLUSH_REMOTE(tgc, p); 2408} 2409 2410static void sweep_port(thread_gc *tgc, ptr p, IGEN from_g) 2411{ 2412 FLUSH_REMOTE_BLOCK 2413 { 2414 relocate_impure(&PORTHANDLER(p), from_g); 2415 if (((uptr)TYPEFIELD(p)) & PORT_FLAG_OUTPUT) 2416 { 2417 iptr n = ((iptr)(PORTOLAST(p))) - ((iptr)(PORTOBUF(p))); 2418 relocate_impure(&PORTOBUF(p), from_g); 2419 PORTOLAST(p) = (ptr)(((iptr)(PORTOBUF(p))) + n); 2420 } 2421 if (((uptr)TYPEFIELD(p)) & PORT_FLAG_INPUT) 2422 { 2423 iptr n = ((iptr)(PORTILAST(p))) - ((iptr)(PORTIBUF(p))); 2424 relocate_impure(&PORTIBUF(p), from_g); 2425 PORTILAST(p) = (ptr)(((iptr)(PORTIBUF(p))) + n); 2426 } 2427 relocate_impure(&PORTINFO(p), from_g); 2428 relocate_impure(&PORTNAME(p), from_g); 2429 } 2430 FLUSH_REMOTE(tgc, p); 2431} 2432 2433static IGEN sweep_dirty_port(thread_gc *tgc, ptr p, IGEN youngest) 2434{ 2435 FLUSH_REMOTE_BLOCK 2436 { 2437 relocate_dirty(&PORTHANDLER(p), youngest); 2438 if (((uptr)TYPEFIELD(p)) & PORT_FLAG_OUTPUT) 2439 { 2440 iptr n = ((iptr)(PORTOLAST(p))) - ((iptr)(PORTOBUF(p))); 2441 relocate_dirty(&PORTOBUF(p), youngest); 2442 PORTOLAST(p) = (ptr)(((iptr)(PORTOBUF(p))) + n); 2443 } 2444 if (((uptr)TYPEFIELD(p)) & PORT_FLAG_INPUT) 2445 { 2446 iptr n = ((iptr)(PORTILAST(p))) - ((iptr)(PORTIBUF(p))); 2447 relocate_dirty(&PORTIBUF(p), youngest); 2448 PORTILAST(p) = (ptr)(((iptr)(PORTIBUF(p))) + n); 2449 } 2450 relocate_dirty(&PORTINFO(p), youngest); 2451 relocate_dirty(&PORTNAME(p), youngest); 2452 } 2453 FLUSH_REMOTE(tgc, p); 2454 return youngest; 2455} 2456 2457static void sweep_continuation(thread_gc *tgc, ptr p, IGEN from_g) 2458{ 2459 FLUSH_REMOTE_BLOCK 2460 { 2461 { 2462 relocate_pure(&CONTWINDERS(p)); 2463 relocate_impure(&CONTATTACHMENTS(p), from_g); 2464 if ((CONTLENGTH(p)) == scaled_shot_1_shot_flag) 2465 { 2466 } 2467 else 2468 { 2469 ptr stk = CONTSTACK(p); 2470 { 2471 seginfo* s_si = NULL; 2472 if ((stk != ((ptr)0)) && ((s_si = (SegInfo((ptr_get_segment(stk))))), (s_si -> old_space))) 2473 { 2474 if (!(SEGMENT_IS_LOCAL(s_si, stk))) 2475 { 2476 RECORD_REMOTE(s_si); 2477 } 2478 else 2479 { 2480 CONTSTACK(p) = copy_stack(tgc, CONTSTACK(p), &(CONTLENGTH(p)), CONTCLENGTH(p)); 2481 } 2482 } 2483 relocate_pure(&CONTLINK(p)); 2484 { 2485 ptr xcp = CONTRET(p); 2486 { 2487 iptr co = (ENTRYOFFSET(xcp)) + (((uptr)xcp) - ((uptr)(TO_PTR((ENTRYOFFSETADDR(xcp)))))); 2488 { 2489 ptr c_p = (ptr)(((uptr)xcp) - co); 2490 { 2491 seginfo* x_si = SegInfo((ptr_get_segment(c_p))); 2492 if (x_si -> old_space) 2493 { 2494 relocate_code(c_p, x_si); 2495 CONTRET(p) = (ptr)(((uptr)c_p) + co); 2496 } 2497 { 2498 uptr stack = (uptr)(CONTSTACK(p)); 2499 { 2500 uptr base = stack; 2501 { 2502 uptr fp = stack + (CONTCLENGTH(p)); 2503 { 2504 uptr ret = (uptr)(CONTRET(p)); 2505 while (fp != base) 2506 { 2507 if (fp < base) 2508 { 2509 S_error_abort("sweep_stack(gc): malformed stack"); 2510 } 2511 fp = fp - (ENTRYFRAMESIZE(ret)); 2512 { 2513 ptr* pp = (ptr*)(TO_VOIDP(fp)); 2514 iptr oldret = ret; 2515 ret = (iptr)(*(pp)); 2516 { 2517 ptr xcp = *(pp); 2518 { 2519 iptr co = (ENTRYOFFSET(xcp)) + (((uptr)xcp) - ((uptr)(TO_PTR((ENTRYOFFSETADDR(xcp)))))); 2520 { 2521 ptr c_p = (ptr)(((uptr)xcp) - co); 2522 { 2523 seginfo* x_si = SegInfo((ptr_get_segment(c_p))); 2524 if (x_si -> old_space) 2525 { 2526 relocate_code(c_p, x_si); 2527 *(pp) = (ptr)(((uptr)c_p) + co); 2528 } 2529 { 2530 ptr num = ENTRYLIVEMASK(oldret); 2531 if (Sfixnump(num)) 2532 { 2533 { 2534 uptr mask = UNFIX(num); 2535 while (mask != 0) 2536 { 2537 pp += 1; 2538 if (mask & 1) 2539 { 2540 relocate_pure(&(*(pp))); 2541 } 2542 mask >>= 1; 2543 } 2544 } 2545 } 2546 else 2547 { 2548 seginfo* n_si = SegInfo((ptr_get_segment(num))); 2549 if (!(n_si -> old_space)) 2550 { 2551 } 2552 else if (SEGMENT_IS_LOCAL(n_si, num)) 2553 { 2554 relocate_pure(&(*((ENTRYNONCOMPACTLIVEMASKADDR(oldret))))); 2555 num = ENTRYLIVEMASK(oldret); 2556 } 2557 else 2558 { 2559 RECORD_REMOTE(n_si); 2560 num = S_G.zero_length_bignum; 2561 } 2562 { 2563 iptr index = BIGLEN(num); 2564 while (index != 0) 2565 { 2566 index -= 1; 2567 { 2568 INT bits = bigit_bits; 2569 bigit mask = BIGIT(num, index); 2570 while (bits > 0) 2571 { 2572 bits -= 1; 2573 pp += 1; 2574 if (mask & 1) 2575 { 2576 relocate_pure(&(*(pp))); 2577 } 2578 mask >>= 1; 2579 } 2580 } 2581 } 2582 } 2583 } 2584 } 2585 } 2586 } 2587 } 2588 } 2589 } 2590 } 2591 } 2592 } 2593 } 2594 } 2595 } 2596 } 2597 } 2598 } 2599 } 2600 } 2601 } 2602 } 2603 FLUSH_REMOTE(tgc, p); 2604} 2605 2606static void sweep_code_object(thread_gc *tgc, ptr p, IGEN from_g) 2607{ 2608 FLUSH_REMOTE_BLOCK 2609 { 2610 relocate_pure(&CODENAME(p)); 2611 relocate_pure(&CODEARITYMASK(p)); 2612 relocate_pure(&CODEINFO(p)); 2613 relocate_pure(&CODEPINFOS(p)); 2614 { 2615 ptr t = CODERELOC(p); 2616 { 2617 iptr m = (t 2618 ? (RELOCSIZE(t)) 2619 : 0); 2620 { 2621 ptr oldco = (t 2622 ? (RELOCCODE(t)) 2623 : 0); 2624 { 2625 iptr a = 0; 2626 { 2627 iptr n = 0; 2628 while (n < m) 2629 { 2630 { 2631 uptr entry = RELOCIT(t, n); 2632 uptr item_off = 0; 2633 uptr code_off = 0; 2634 n = n + 1; 2635 if (RELOC_EXTENDED_FORMAT(entry)) 2636 { 2637 item_off = RELOCIT(t, n); 2638 n = n + 1; 2639 code_off = RELOCIT(t, n); 2640 n = n + 1; 2641 } 2642 else 2643 { 2644 item_off = RELOC_ITEM_OFFSET(entry); 2645 code_off = RELOC_CODE_OFFSET(entry); 2646 } 2647 a = a + code_off; 2648 { 2649 ptr obj = S_get_code_obj(RELOC_TYPE(entry), oldco, a, item_off); 2650 relocate_pure(&obj); 2651 S_set_code_obj("gc", RELOC_TYPE(entry), p, a, obj, item_off); 2652 } 2653 } 2654 } 2655 if ((from_g == static_generation) && ((!S_G.retain_static_relocation) && (0 == ((CODETYPE(p)) & (code_flag_template << code_flags_offset))))) 2656 { 2657 CODERELOC(p) = (ptr)0; 2658 } 2659 else 2660 { 2661 { 2662 seginfo* t_si = SegInfo((ptr_get_segment(t))); 2663 if (t_si -> old_space) 2664 { 2665 if (SEGMENT_IS_LOCAL(t_si, t)) 2666 { 2667 n = size_reloc_table((RELOCSIZE(t))); 2668 if (t_si -> use_marks) 2669 { 2670 if (!(marked(t_si, t))) 2671 { 2672 mark_untyped_data_object(tgc, t, n, t_si); 2673 } 2674 } 2675 else 2676 { 2677 { 2678 ptr oldt = t; 2679 find_gc_room(tgc, space_data, from_g, type_untyped, n, t); 2680 memcpy_aligned(TO_VOIDP(t), TO_VOIDP(oldt), n); 2681 } 2682 } 2683 } 2684 else 2685 { 2686 RECORD_REMOTE(t_si); 2687 } 2688 } 2689 } 2690 RELOCCODE(t) = p; 2691 CODERELOC(p) = t; 2692 } 2693 S_record_code_mod(tgc -> tc, (uptr)(TO_PTR((&(CODEIT(p, 0))))), (uptr)(CODELEN(p))); 2694 } 2695 } 2696 } 2697 } 2698 } 2699 } 2700 FLUSH_REMOTE(tgc, p); 2701} 2702 2703static uptr size_object(ptr p) 2704{ 2705 ITYPE t = TYPEBITS(p); 2706 if (t == type_typed_object) 2707 { 2708 ptr tf = TYPEFIELD(p); 2709 if (TYPEP(tf, mask_record, type_record)) 2710 { 2711 { 2712 ptr rtd = RECORDINSTTYPE(p); 2713 { 2714 uptr len = UNFIX((RECORDDESCSIZE(rtd))); 2715 { 2716 uptr p_sz = size_record_inst(len); 2717 return p_sz; 2718 } 2719 } 2720 } 2721 } 2722 else if (TYPEP(tf, mask_vector, type_vector)) 2723 { 2724 uptr len = Svector_length(p); 2725 { 2726 uptr p_sz = size_vector(len); 2727 return p_sz; 2728 } 2729 } 2730 else if (TYPEP(tf, mask_stencil_vector, type_stencil_vector)) 2731 { 2732 uptr len = Sstencil_vector_length(p); 2733 { 2734 uptr p_sz = size_stencil_vector(len); 2735 return p_sz; 2736 } 2737 } 2738 else if (TYPEP(tf, mask_string, type_string)) 2739 { 2740 uptr sz = size_string((Sstring_length(p))); 2741 { 2742 uptr p_sz = sz; 2743 return p_sz; 2744 } 2745 } 2746 else if (TYPEP(tf, mask_fxvector, type_fxvector)) 2747 { 2748 uptr sz = size_fxvector((Sfxvector_length(p))); 2749 { 2750 uptr p_sz = sz; 2751 return p_sz; 2752 } 2753 } 2754 else if (TYPEP(tf, mask_flvector, type_flvector)) 2755 { 2756 uptr sz = size_flvector((Sflvector_length(p))); 2757 { 2758 uptr p_sz = sz; 2759 return p_sz; 2760 } 2761 } 2762 else if (TYPEP(tf, mask_bytevector, type_bytevector)) 2763 { 2764 { 2765 ISPC p_at_spc = SPACE(p); 2766 if (p_at_spc == space_reference_array) 2767 { 2768 uptr sz = size_bytevector((Sbytevector_length(p))); 2769 { 2770 uptr p_sz = sz; 2771 return p_sz; 2772 } 2773 } 2774 else 2775 { 2776 uptr sz = size_bytevector((Sbytevector_length(p))); 2777 { 2778 uptr p_sz = sz; 2779 return p_sz; 2780 } 2781 } 2782 } 2783 } 2784 else if ((iptr)tf == type_tlc) 2785 { 2786 uptr p_sz = size_tlc; 2787 return p_sz; 2788 } 2789 else if (TYPEP(tf, mask_box, type_box)) 2790 { 2791 uptr p_sz = size_box; 2792 return p_sz; 2793 } 2794 else if ((iptr)tf == type_ratnum) 2795 { 2796 uptr p_sz = size_ratnum; 2797 return p_sz; 2798 } 2799 else if ((iptr)tf == type_exactnum) 2800 { 2801 uptr p_sz = size_exactnum; 2802 return p_sz; 2803 } 2804 else if ((iptr)tf == type_inexactnum) 2805 { 2806 uptr p_sz = size_inexactnum; 2807 return p_sz; 2808 } 2809 else if (TYPEP(tf, mask_bignum, type_bignum)) 2810 { 2811 uptr sz = size_bignum((BIGLEN(p))); 2812 { 2813 uptr p_sz = sz; 2814 return p_sz; 2815 } 2816 } 2817 else if (TYPEP(tf, mask_port, type_port)) 2818 { 2819 uptr p_sz = size_port; 2820 return p_sz; 2821 } 2822 else if (TYPEP(tf, mask_code, type_code)) 2823 { 2824 uptr len = CODELEN(p); 2825 { 2826 uptr p_sz = size_code(len); 2827 return p_sz; 2828 } 2829 } 2830 else if ((iptr)tf == type_thread) 2831 { 2832 uptr p_sz = size_thread; 2833 return p_sz; 2834 } 2835 else if ((iptr)tf == type_rtd_counts) 2836 { 2837 uptr p_sz = size_rtd_counts; 2838 return p_sz; 2839 } 2840 else if ((iptr)tf == type_phantom) 2841 { 2842 uptr p_sz = size_phantom; 2843 return p_sz; 2844 } 2845 else 2846 { 2847 S_error_abort("size: illegal typed object type"); 2848 } 2849 } 2850 else if (t == type_pair) 2851 { 2852 { 2853 ISPC p_at_spc = SPACE(p); 2854 if (p_at_spc < space_weakpair) 2855 { 2856 uptr p_sz = size_pair; 2857 return p_sz; 2858 } 2859 else if (p_at_spc == space_ephemeron) 2860 { 2861 uptr p_sz = size_ephemeron; 2862 return p_sz; 2863 } 2864 else if (p_at_spc == space_weakpair) 2865 { 2866 uptr p_sz = size_pair; 2867 return p_sz; 2868 } 2869 else 2870 { 2871 S_error_abort("misplaced pair"); 2872 } 2873 } 2874 } 2875 else if (t == type_closure) 2876 { 2877 ptr code = CLOSCODE(p); 2878 if ((CODETYPE(code)) & (code_flag_continuation << code_flags_offset)) 2879 { 2880 uptr p_sz = size_continuation; 2881 return p_sz; 2882 } 2883 else 2884 { 2885 uptr len = CODEFREE(code); 2886 { 2887 uptr p_sz = size_closure(len); 2888 return p_sz; 2889 } 2890 } 2891 } 2892 else if (t == type_symbol) 2893 { 2894 uptr p_sz = size_symbol; 2895 return p_sz; 2896 } 2897 else if (t == type_flonum) 2898 { 2899 uptr p_sz = size_flonum; 2900 return p_sz; 2901 } 2902 else 2903 { 2904 S_error_abort("size: illegal type"); 2905 } 2906} 2907 2908static IGEN mark_object(thread_gc *tgc, ptr p, seginfo *si) 2909{ 2910 check_triggers(tgc, si); 2911 if (!si->marked_mask) { 2912 init_mask(tgc, si->marked_mask, si->generation, 0); 2913 } 2914 { 2915 ITYPE t = TYPEBITS(p); 2916 if (t == type_typed_object) 2917 { 2918 ptr tf = TYPEFIELD(p); 2919 if (TYPEP(tf, mask_record, type_record)) 2920 { 2921 /* Do not inspect the type or first field of the rtd, because 2922 it may have been overwritten for forwarding. */ 2923 { 2924 ptr rtd = RECORDINSTTYPE(p); 2925 { 2926 uptr len = UNFIX((RECORDDESCSIZE(rtd))); 2927 { 2928 uptr p_sz = size_record_inst(len); 2929 { 2930 uptr addr = (uptr)UNTYPE(p, type_typed_object); 2931 if (addr_get_segment(addr) == addr_get_segment(addr + p_sz - 1)) 2932 { 2933 si->marked_count += p_sz; 2934 { 2935 uptr offset = 0; 2936 while (offset < p_sz) { 2937 ptr mark_p = (ptr)((uptr)p + offset); 2938 si->marked_mask[segment_bitmap_byte(mark_p)] |= segment_bitmap_bit(mark_p); 2939 offset += byte_alignment; 2940 } 2941 } 2942 } 2943 else 2944 { 2945 uptr offset = 0; 2946 while (offset < p_sz) { 2947 ptr mark_p = (ptr)((uptr)p + offset); 2948 seginfo *mark_si = SegInfo(ptr_get_segment(mark_p)); 2949 if (!mark_si->marked_mask) { 2950 init_mask(tgc, mark_si->marked_mask, mark_si->generation, 0); 2951 } 2952 mark_si->marked_mask[segment_bitmap_byte(mark_p)] |= segment_bitmap_bit(mark_p); 2953 mark_si->marked_count += byte_alignment; 2954 offset += byte_alignment; 2955 } 2956 } 2957 } 2958 push_sweep(p); 2959 } 2960 } 2961 } 2962 } 2963 else if (TYPEP(tf, mask_vector, type_vector)) 2964 { 2965 uptr len = Svector_length(p); 2966 { 2967 uptr p_sz = size_vector(len); 2968 { 2969 uptr addr = (uptr)UNTYPE(p, type_typed_object); 2970 if (addr_get_segment(addr) == addr_get_segment(addr + p_sz - 1)) 2971 { 2972 si->marked_count += p_sz; 2973 { 2974 uptr offset = 0; 2975 while (offset < p_sz) { 2976 ptr mark_p = (ptr)((uptr)p + offset); 2977 si->marked_mask[segment_bitmap_byte(mark_p)] |= segment_bitmap_bit(mark_p); 2978 offset += byte_alignment; 2979 } 2980 } 2981 } 2982 else 2983 { 2984 uptr offset = 0; 2985 while (offset < p_sz) { 2986 ptr mark_p = (ptr)((uptr)p + offset); 2987 seginfo *mark_si = SegInfo(ptr_get_segment(mark_p)); 2988 if (!mark_si->marked_mask) { 2989 init_mask(tgc, mark_si->marked_mask, mark_si->generation, 0); 2990 } 2991 mark_si->marked_mask[segment_bitmap_byte(mark_p)] |= segment_bitmap_bit(mark_p); 2992 mark_si->marked_count += byte_alignment; 2993 offset += byte_alignment; 2994 } 2995 } 2996 } 2997 push_sweep(p); 2998 } 2999 } 3000 else if (TYPEP(tf, mask_stencil_vector, type_stencil_vector)) 3001 { 3002 uptr len = Sstencil_vector_length(p); 3003 { 3004 uptr p_sz = size_stencil_vector(len); 3005 si->marked_count += p_sz; 3006 { 3007 uptr offset = 0; 3008 while (offset < p_sz) { 3009 ptr mark_p = (ptr)((uptr)p + offset); 3010 si->marked_mask[segment_bitmap_byte(mark_p)] |= segment_bitmap_bit(mark_p); 3011 offset += byte_alignment; 3012 } 3013 } 3014 push_sweep(p); 3015 } 3016 } 3017 else if (TYPEP(tf, mask_string, type_string)) 3018 { 3019 uptr sz = size_string((Sstring_length(p))); 3020 { 3021 uptr p_sz = sz; 3022 si->marked_mask[segment_bitmap_byte(p)] |= segment_bitmap_bit(p); 3023 { 3024 uptr addr = (uptr)UNTYPE(p, type_typed_object); 3025 uptr seg = addr_get_segment(addr); 3026 uptr end_seg = addr_get_segment(addr + p_sz - 1); 3027 if (seg == end_seg) { 3028 si->marked_count += p_sz; 3029 } else { 3030 seginfo *mark_si; IGEN g; 3031 si->marked_count += ((uptr)build_ptr(seg+1,0)) - addr; 3032 seg++; 3033 while (seg < end_seg) { 3034 mark_si = SegInfo(seg); 3035 g = mark_si->generation; 3036 if (!fully_marked_mask[g]) init_fully_marked_mask(tgc, g); 3037 mark_si->marked_mask = fully_marked_mask[g]; 3038 mark_si->marked_count = bytes_per_segment; 3039 seg++; 3040 } 3041 mark_si = SegInfo(end_seg); 3042 { 3043 if (!mark_si->marked_mask) { 3044 init_mask(tgc, mark_si->marked_mask, mark_si->generation, 0); 3045 } 3046 /* no need to set a bit: it's enough to have made `marked_mask` non-NULL */ 3047 mark_si->marked_count += addr + p_sz - (uptr)build_ptr(end_seg,0); 3048 } 3049 } 3050 } 3051 } 3052 } 3053 else if (TYPEP(tf, mask_fxvector, type_fxvector)) 3054 { 3055 uptr sz = size_fxvector((Sfxvector_length(p))); 3056 { 3057 uptr p_sz = sz; 3058 si->marked_mask[segment_bitmap_byte(p)] |= segment_bitmap_bit(p); 3059 { 3060 uptr addr = (uptr)UNTYPE(p, type_typed_object); 3061 uptr seg = addr_get_segment(addr); 3062 uptr end_seg = addr_get_segment(addr + p_sz - 1); 3063 if (seg == end_seg) { 3064 si->marked_count += p_sz; 3065 } else { 3066 seginfo *mark_si; IGEN g; 3067 si->marked_count += ((uptr)build_ptr(seg+1,0)) - addr; 3068 seg++; 3069 while (seg < end_seg) { 3070 mark_si = SegInfo(seg); 3071 g = mark_si->generation; 3072 if (!fully_marked_mask[g]) init_fully_marked_mask(tgc, g); 3073 mark_si->marked_mask = fully_marked_mask[g]; 3074 mark_si->marked_count = bytes_per_segment; 3075 seg++; 3076 } 3077 mark_si = SegInfo(end_seg); 3078 { 3079 if (!mark_si->marked_mask) { 3080 init_mask(tgc, mark_si->marked_mask, mark_si->generation, 0); 3081 } 3082 /* no need to set a bit: it's enough to have made `marked_mask` non-NULL */ 3083 mark_si->marked_count += addr + p_sz - (uptr)build_ptr(end_seg,0); 3084 } 3085 } 3086 } 3087 } 3088 } 3089 else if (TYPEP(tf, mask_flvector, type_flvector)) 3090 { 3091 uptr sz = size_flvector((Sflvector_length(p))); 3092 { 3093 uptr p_sz = sz; 3094 si->marked_mask[segment_bitmap_byte(p)] |= segment_bitmap_bit(p); 3095 { 3096 uptr addr = (uptr)UNTYPE(p, type_typed_object); 3097 uptr seg = addr_get_segment(addr); 3098 uptr end_seg = addr_get_segment(addr + p_sz - 1); 3099 if (seg == end_seg) { 3100 si->marked_count += p_sz; 3101 } else { 3102 seginfo *mark_si; IGEN g; 3103 si->marked_count += ((uptr)build_ptr(seg+1,0)) - addr; 3104 seg++; 3105 while (seg < end_seg) { 3106 mark_si = SegInfo(seg); 3107 g = mark_si->generation; 3108 if (!fully_marked_mask[g]) init_fully_marked_mask(tgc, g); 3109 mark_si->marked_mask = fully_marked_mask[g]; 3110 mark_si->marked_count = bytes_per_segment; 3111 seg++; 3112 } 3113 mark_si = SegInfo(end_seg); 3114 { 3115 if (!mark_si->marked_mask) { 3116 init_mask(tgc, mark_si->marked_mask, mark_si->generation, 0); 3117 } 3118 /* no need to set a bit: it's enough to have made `marked_mask` non-NULL */ 3119 mark_si->marked_count += addr + p_sz - (uptr)build_ptr(end_seg,0); 3120 } 3121 } 3122 } 3123 } 3124 } 3125 else if (TYPEP(tf, mask_bytevector, type_bytevector)) 3126 { 3127 { 3128 ISPC p_at_spc = si->space; 3129 if (p_at_spc == space_reference_array) 3130 { 3131 uptr sz = size_bytevector((Sbytevector_length(p))); 3132 { 3133 uptr p_sz = sz; 3134 { 3135 uptr addr = (uptr)UNTYPE(p, type_typed_object); 3136 if (addr_get_segment(addr) == addr_get_segment(addr + p_sz - 1)) 3137 { 3138 si->marked_count += p_sz; 3139 { 3140 uptr offset = 0; 3141 while (offset < p_sz) { 3142 ptr mark_p = (ptr)((uptr)p + offset); 3143 si->marked_mask[segment_bitmap_byte(mark_p)] |= segment_bitmap_bit(mark_p); 3144 offset += byte_alignment; 3145 } 3146 } 3147 } 3148 else 3149 { 3150 uptr offset = 0; 3151 while (offset < p_sz) { 3152 ptr mark_p = (ptr)((uptr)p + offset); 3153 seginfo *mark_si = SegInfo(ptr_get_segment(mark_p)); 3154 if (!mark_si->marked_mask) { 3155 init_mask(tgc, mark_si->marked_mask, mark_si->generation, 0); 3156 } 3157 mark_si->marked_mask[segment_bitmap_byte(mark_p)] |= segment_bitmap_bit(mark_p); 3158 mark_si->marked_count += byte_alignment; 3159 offset += byte_alignment; 3160 } 3161 } 3162 } 3163 push_sweep(p); 3164 } 3165 } 3166 else 3167 { 3168 uptr sz = size_bytevector((Sbytevector_length(p))); 3169 { 3170 uptr p_sz = sz; 3171 si->marked_mask[segment_bitmap_byte(p)] |= segment_bitmap_bit(p); 3172 { 3173 uptr addr = (uptr)UNTYPE(p, type_typed_object); 3174 uptr seg = addr_get_segment(addr); 3175 uptr end_seg = addr_get_segment(addr + p_sz - 1); 3176 if (seg == end_seg) { 3177 si->marked_count += p_sz; 3178 } else { 3179 seginfo *mark_si; IGEN g; 3180 si->marked_count += ((uptr)build_ptr(seg+1,0)) - addr; 3181 seg++; 3182 while (seg < end_seg) { 3183 mark_si = SegInfo(seg); 3184 g = mark_si->generation; 3185 if (!fully_marked_mask[g]) init_fully_marked_mask(tgc, g); 3186 mark_si->marked_mask = fully_marked_mask[g]; 3187 mark_si->marked_count = bytes_per_segment; 3188 seg++; 3189 } 3190 mark_si = SegInfo(end_seg); 3191 { 3192 if (!mark_si->marked_mask) { 3193 init_mask(tgc, mark_si->marked_mask, mark_si->generation, 0); 3194 } 3195 /* no need to set a bit: it's enough to have made `marked_mask` non-NULL */ 3196 mark_si->marked_count += addr + p_sz - (uptr)build_ptr(end_seg,0); 3197 } 3198 } 3199 } 3200 } 3201 } 3202 } 3203 } 3204 else if ((iptr)tf == type_tlc) 3205 { 3206 uptr p_sz = size_tlc; 3207 si->marked_count += p_sz; 3208 { 3209 ptr mark_p = p; 3210 si->marked_mask[segment_bitmap_byte(mark_p)] |= segment_bitmap_bit(mark_p); 3211 mark_p = (ptr)((uptr)mark_p + byte_alignment); 3212 si->marked_mask[segment_bitmap_byte(mark_p)] |= segment_bitmap_bit(mark_p); 3213 } 3214 push_sweep(p); 3215 { 3216 ptr next = INITTLCNEXT(p); 3217 { 3218 ptr keyval = INITTLCKEYVAL(p); 3219 if ((next != Sfalse) && (OLDSPACE(keyval))) 3220 { 3221 GC_MUTEX_ACQUIRE(); 3222 tlcs_to_rehash = S_cons_in(tgc -> tc, space_new, 0, p, tlcs_to_rehash); 3223 GC_MUTEX_RELEASE(); 3224 } 3225 } 3226 } 3227 } 3228 else if (TYPEP(tf, mask_box, type_box)) 3229 { 3230 uptr p_sz = size_box; 3231 si->marked_mask[segment_bitmap_byte(p)] |= segment_bitmap_bit(p); 3232 si->marked_count += p_sz; 3233 push_sweep(p); 3234 } 3235 else if ((iptr)tf == type_ratnum) 3236 { 3237 uptr p_sz = size_ratnum; 3238 relocate_pure(&RATNUM(p)); 3239 relocate_pure(&RATDEN(p)); 3240 si->marked_count += p_sz; 3241 { 3242 ptr mark_p = p; 3243 si->marked_mask[segment_bitmap_byte(mark_p)] |= segment_bitmap_bit(mark_p); 3244 mark_p = (ptr)((uptr)mark_p + byte_alignment); 3245 si->marked_mask[segment_bitmap_byte(mark_p)] |= segment_bitmap_bit(mark_p); 3246 } 3247 push_sweep(p); 3248 } 3249 else if ((iptr)tf == type_exactnum) 3250 { 3251 uptr p_sz = size_exactnum; 3252 relocate_pure(&EXACTNUM_REAL_PART(p)); 3253 relocate_pure(&EXACTNUM_IMAG_PART(p)); 3254 si->marked_count += p_sz; 3255 { 3256 ptr mark_p = p; 3257 si->marked_mask[segment_bitmap_byte(mark_p)] |= segment_bitmap_bit(mark_p); 3258 mark_p = (ptr)((uptr)mark_p + byte_alignment); 3259 si->marked_mask[segment_bitmap_byte(mark_p)] |= segment_bitmap_bit(mark_p); 3260 } 3261 push_sweep(p); 3262 } 3263 else if ((iptr)tf == type_inexactnum) 3264 { 3265 uptr p_sz = size_inexactnum; 3266 si->marked_mask[segment_bitmap_byte(p)] |= segment_bitmap_bit(p); 3267 si->marked_count += p_sz; 3268 } 3269 else if (TYPEP(tf, mask_bignum, type_bignum)) 3270 { 3271 uptr sz = size_bignum((BIGLEN(p))); 3272 { 3273 uptr p_sz = sz; 3274 si->marked_mask[segment_bitmap_byte(p)] |= segment_bitmap_bit(p); 3275 { 3276 uptr addr = (uptr)UNTYPE(p, type_typed_object); 3277 uptr seg = addr_get_segment(addr); 3278 uptr end_seg = addr_get_segment(addr + p_sz - 1); 3279 if (seg == end_seg) { 3280 si->marked_count += p_sz; 3281 } else { 3282 seginfo *mark_si; IGEN g; 3283 si->marked_count += ((uptr)build_ptr(seg+1,0)) - addr; 3284 seg++; 3285 while (seg < end_seg) { 3286 mark_si = SegInfo(seg); 3287 g = mark_si->generation; 3288 if (!fully_marked_mask[g]) init_fully_marked_mask(tgc, g); 3289 mark_si->marked_mask = fully_marked_mask[g]; 3290 mark_si->marked_count = bytes_per_segment; 3291 seg++; 3292 } 3293 mark_si = SegInfo(end_seg); 3294 { 3295 if (!mark_si->marked_mask) { 3296 init_mask(tgc, mark_si->marked_mask, mark_si->generation, 0); 3297 } 3298 /* no need to set a bit: it's enough to have made `marked_mask` non-NULL */ 3299 mark_si->marked_count += addr + p_sz - (uptr)build_ptr(end_seg,0); 3300 } 3301 } 3302 } 3303 } 3304 } 3305 else if (TYPEP(tf, mask_port, type_port)) 3306 { 3307 uptr p_sz = size_port; 3308 si->marked_mask[segment_bitmap_byte(p)] |= segment_bitmap_bit(p); 3309 si->marked_count += p_sz; 3310 push_sweep(p); 3311 } 3312 else if (TYPEP(tf, mask_code, type_code)) 3313 { 3314 uptr len = CODELEN(p); 3315 { 3316 uptr p_sz = size_code(len); 3317 si->marked_mask[segment_bitmap_byte(p)] |= segment_bitmap_bit(p); 3318 { 3319 uptr addr = (uptr)UNTYPE(p, type_typed_object); 3320 uptr seg = addr_get_segment(addr); 3321 uptr end_seg = addr_get_segment(addr + p_sz - 1); 3322 if (seg == end_seg) { 3323 si->marked_count += p_sz; 3324 } else { 3325 seginfo *mark_si; IGEN g; 3326 si->marked_count += ((uptr)build_ptr(seg+1,0)) - addr; 3327 seg++; 3328 while (seg < end_seg) { 3329 mark_si = SegInfo(seg); 3330 g = mark_si->generation; 3331 if (!fully_marked_mask[g]) init_fully_marked_mask(tgc, g); 3332 mark_si->marked_mask = fully_marked_mask[g]; 3333 mark_si->marked_count = bytes_per_segment; 3334 seg++; 3335 } 3336 mark_si = SegInfo(end_seg); 3337 { 3338 if (!mark_si->marked_mask) { 3339 init_mask(tgc, mark_si->marked_mask, mark_si->generation, 0); 3340 } 3341 /* no need to set a bit: it's enough to have made `marked_mask` non-NULL */ 3342 mark_si->marked_count += addr + p_sz - (uptr)build_ptr(end_seg,0); 3343 } 3344 } 3345 } 3346 push_sweep(p); 3347 } 3348 } 3349 else if ((iptr)tf == type_thread) 3350 { 3351 uptr p_sz = size_thread; 3352 si->marked_mask[segment_bitmap_byte(p)] |= segment_bitmap_bit(p); 3353 si->marked_count += p_sz; 3354 push_sweep(p); 3355 } 3356 else if ((iptr)tf == type_rtd_counts) 3357 { 3358 uptr p_sz = size_rtd_counts; 3359 si->marked_mask[segment_bitmap_byte(p)] |= segment_bitmap_bit(p); 3360 si->marked_count += p_sz; 3361 } 3362 else if ((iptr)tf == type_phantom) 3363 { 3364 uptr p_sz = size_phantom; 3365 si->marked_mask[segment_bitmap_byte(p)] |= segment_bitmap_bit(p); 3366 si->marked_count += p_sz; 3367 GC_MUTEX_ACQUIRE(); 3368 (S_G.bytesof[TARGET_GENERATION(si)])[countof_phantom] += PHANTOMLEN(p); 3369 GC_MUTEX_RELEASE(); 3370 } 3371 else 3372 { 3373 S_error_abort("mark: illegal typed object type"); 3374 } 3375 } 3376 else if (t == type_pair) 3377 { 3378 { 3379 ISPC p_at_spc = si->space; 3380 if (p_at_spc < space_weakpair) 3381 { 3382 uptr p_sz = size_pair; 3383 si->marked_mask[segment_bitmap_byte(p)] |= segment_bitmap_bit(p); 3384 si->marked_count += p_sz; 3385 push_sweep(p); 3386 } 3387 else if (p_at_spc == space_ephemeron) 3388 { 3389 uptr p_sz = size_ephemeron; 3390 add_ephemeron_to_pending(tgc, p); 3391 si->marked_mask[segment_bitmap_byte(p)] |= segment_bitmap_bit(p); 3392 si->marked_count += p_sz; 3393 } 3394 else if (p_at_spc == space_weakpair) 3395 { 3396 uptr p_sz = size_pair; 3397 si->marked_mask[segment_bitmap_byte(p)] |= segment_bitmap_bit(p); 3398 si->marked_count += p_sz; 3399 push_sweep(p); 3400 } 3401 else 3402 { 3403 S_error_abort("misplaced pair"); 3404 } 3405 } 3406 } 3407 else if (t == type_closure) 3408 { 3409 ptr code = CLOSCODE(p); 3410 relocate_pure(&code); 3411 if ((CODETYPE(code)) & (code_flag_continuation << code_flags_offset)) 3412 { 3413 uptr p_sz = size_continuation; 3414 if ((CONTLENGTH(p)) == opportunistic_1_shot_flag) 3415 { 3416 CONTLENGTH(p) = CONTCLENGTH(p); 3417 GC_MUTEX_ACQUIRE(); 3418 conts_to_promote = S_cons_in(tgc -> tc, space_new, 0, p, conts_to_promote); 3419 GC_MUTEX_RELEASE(); 3420 } 3421 else 3422 { 3423 } 3424 si->marked_mask[segment_bitmap_byte(p)] |= segment_bitmap_bit(p); 3425 si->marked_count += p_sz; 3426 push_sweep(p); 3427 } 3428 else 3429 { 3430 uptr len = CODEFREE(code); 3431 { 3432 uptr p_sz = size_closure(len); 3433 { 3434 ISPC p_at_spc = si->space; 3435 if (p_at_spc == space_pure) 3436 { 3437 si->marked_mask[segment_bitmap_byte(p)] |= segment_bitmap_bit(p); 3438 { 3439 uptr addr = (uptr)UNTYPE(p, type_closure); 3440 uptr seg = addr_get_segment(addr); 3441 uptr end_seg = addr_get_segment(addr + p_sz - 1); 3442 if (seg == end_seg) { 3443 si->marked_count += p_sz; 3444 } else { 3445 seginfo *mark_si; IGEN g; 3446 si->marked_count += ((uptr)build_ptr(seg+1,0)) - addr; 3447 seg++; 3448 while (seg < end_seg) { 3449 mark_si = SegInfo(seg); 3450 g = mark_si->generation; 3451 if (!fully_marked_mask[g]) init_fully_marked_mask(tgc, g); 3452 mark_si->marked_mask = fully_marked_mask[g]; 3453 mark_si->marked_count = bytes_per_segment; 3454 seg++; 3455 } 3456 mark_si = SegInfo(end_seg); 3457 { 3458 if (!mark_si->marked_mask) { 3459 init_mask(tgc, mark_si->marked_mask, mark_si->generation, 0); 3460 } 3461 /* no need to set a bit: it's enough to have made `marked_mask` non-NULL */ 3462 mark_si->marked_count += addr + p_sz - (uptr)build_ptr(end_seg,0); 3463 } 3464 } 3465 } 3466 push_sweep(p); 3467 } 3468 else 3469 { 3470 { 3471 uptr addr = (uptr)UNTYPE(p, type_closure); 3472 if (addr_get_segment(addr) == addr_get_segment(addr + p_sz - 1)) 3473 { 3474 si->marked_count += p_sz; 3475 { 3476 uptr offset = 0; 3477 while (offset < p_sz) { 3478 ptr mark_p = (ptr)((uptr)p + offset); 3479 si->marked_mask[segment_bitmap_byte(mark_p)] |= segment_bitmap_bit(mark_p); 3480 offset += byte_alignment; 3481 } 3482 } 3483 } 3484 else 3485 { 3486 uptr offset = 0; 3487 while (offset < p_sz) { 3488 ptr mark_p = (ptr)((uptr)p + offset); 3489 seginfo *mark_si = SegInfo(ptr_get_segment(mark_p)); 3490 if (!mark_si->marked_mask) { 3491 init_mask(tgc, mark_si->marked_mask, mark_si->generation, 0); 3492 } 3493 mark_si->marked_mask[segment_bitmap_byte(mark_p)] |= segment_bitmap_bit(mark_p); 3494 mark_si->marked_count += byte_alignment; 3495 offset += byte_alignment; 3496 } 3497 } 3498 } 3499 push_sweep(p); 3500 } 3501 } 3502 } 3503 } 3504 } 3505 else if (t == type_symbol) 3506 { 3507 uptr p_sz = size_symbol; 3508 si->marked_mask[segment_bitmap_byte(p)] |= segment_bitmap_bit(p); 3509 si->marked_count += p_sz; 3510 push_sweep(p); 3511 } 3512 else if (t == type_flonum) 3513 { 3514 uptr p_sz = size_flonum; 3515 si->marked_mask[segment_bitmap_byte(p)] |= segment_bitmap_bit(p); 3516 si->marked_count += p_sz; 3517 } 3518 else 3519 { 3520 S_error_abort("mark: illegal type"); 3521 } 3522 } 3523 tgc->sweep_change = SWEEP_CHANGE_PROGRESS; 3524 ADD_BACKREFERENCE(p, si->generation); 3525 return si->generation; 3526} 3527 3528static IBOOL object_directly_refers_to_self(ptr p) 3529{ 3530 { 3531 ITYPE t = TYPEBITS(p); 3532 if (t == type_typed_object) 3533 { 3534 ptr tf = TYPEFIELD(p); 3535 if (TYPEP(tf, mask_record, type_record)) 3536 { 3537 { 3538 ptr rtd = RECORDINSTTYPE(p); 3539 { 3540 uptr len = UNFIX((RECORDDESCSIZE(rtd))); 3541 { 3542 ptr num = RECORDDESCPM(rtd); 3543 ptr* pp = &(RECORDINSTIT(p, 0)); 3544 if (Sfixnump(num)) 3545 { 3546 { 3547 uptr mask = ((uptr)(UNFIX(num))) >> 1; 3548 if (mask == (((uptr)-1) >> 1)) 3549 { 3550 { 3551 ptr* ppend = ((ptr*)(TO_VOIDP((((uptr)(TO_PTR(pp))) + len)))) - 1; 3552 while (pp < ppend) 3553 { 3554 if (p == *(pp)) return 1; 3555 pp += 1; 3556 } 3557 } 3558 } 3559 else 3560 { 3561 while (mask != 0) 3562 { 3563 if (mask & 1) 3564 { 3565 if (p == *(pp)) return 1; 3566 } 3567 mask >>= 1; 3568 pp += 1; 3569 } 3570 } 3571 } 3572 } 3573 else 3574 { 3575 if (p == RECORDDESCPM(rtd)) return 1; 3576 num = RECORDDESCPM(rtd); 3577 { 3578 iptr index = (BIGLEN(num)) - 1; 3579 bigit mask = (BIGIT(num, index)) >> 1; 3580 INT bits = bigit_bits - 1; 3581 while (1) 3582 { 3583 do 3584 { 3585 if (mask & 1) 3586 { 3587 if (p == *(pp)) return 1; 3588 } 3589 mask >>= 1; 3590 pp += 1; 3591 bits -= 1; 3592 } 3593 while (bits > 0); 3594 if (index == 0) 3595 { 3596 break; 3597 } 3598 index -= 1; 3599 mask = BIGIT(num, index); 3600 bits = bigit_bits; 3601 } 3602 } 3603 } 3604 } 3605 } 3606 } 3607 } 3608 else if (TYPEP(tf, mask_vector, type_vector)) 3609 { 3610 uptr len = Svector_length(p); 3611 { 3612 uptr idx, p_len = len; 3613 ptr *p_p = &INITVECTIT(p, 0); 3614 for (idx = 0; idx < p_len; idx++) 3615 { 3616 if (p == p_p[idx]) return 1; 3617 } 3618 } 3619 } 3620 else if (TYPEP(tf, mask_stencil_vector, type_stencil_vector)) 3621 { 3622 uptr len = Sstencil_vector_length(p); 3623 { 3624 uptr idx, p_len = len; 3625 ptr *p_p = &INITSTENVECTIT(p, 0); 3626 for (idx = 0; idx < p_len; idx++) 3627 { 3628 if (p == p_p[idx]) return 1; 3629 } 3630 } 3631 } 3632 else if (TYPEP(tf, mask_string, type_string)) 3633 { 3634 } 3635 else if (TYPEP(tf, mask_fxvector, type_fxvector)) 3636 { 3637 } 3638 else if (TYPEP(tf, mask_flvector, type_flvector)) 3639 { 3640 } 3641 else if (TYPEP(tf, mask_bytevector, type_bytevector)) 3642 { 3643 { 3644 ISPC p_at_spc = SPACE(p); 3645 if (p_at_spc == space_reference_array) 3646 { 3647 { 3648 uptr len = Sbytevector_reference_length(p); 3649 { 3650 uptr idx, p_len = len; 3651 ptr *p_p = (ptr*)&BVIT(p, 0); 3652 for (idx = 0; idx < p_len; idx++) 3653 { 3654 if (p == S_maybe_reference_to_object(p_p[idx])) return 1; 3655 } 3656 } 3657 } 3658 } 3659 else 3660 { 3661 } 3662 } 3663 } 3664 else if ((iptr)tf == type_tlc) 3665 { 3666 } 3667 else if (TYPEP(tf, mask_box, type_box)) 3668 { 3669 if (p == INITBOXREF(p)) return 1; 3670 } 3671 else if ((iptr)tf == type_ratnum) 3672 { 3673 } 3674 else if ((iptr)tf == type_exactnum) 3675 { 3676 } 3677 else if ((iptr)tf == type_inexactnum) 3678 { 3679 } 3680 else if (TYPEP(tf, mask_bignum, type_bignum)) 3681 { 3682 } 3683 else if (TYPEP(tf, mask_port, type_port)) 3684 { 3685 if (p == PORTINFO(p)) return 1; 3686 } 3687 else if (TYPEP(tf, mask_code, type_code)) 3688 { 3689 { 3690 ptr t = CODERELOC(p); 3691 { 3692 iptr m = (t 3693 ? (RELOCSIZE(t)) 3694 : 0); 3695 { 3696 ptr oldco = (t 3697 ? (RELOCCODE(t)) 3698 : 0); 3699 { 3700 iptr a = 0; 3701 { 3702 iptr n = 0; 3703 while (n < m) 3704 { 3705 { 3706 uptr entry = RELOCIT(t, n); 3707 uptr item_off = 0; 3708 uptr code_off = 0; 3709 n = n + 1; 3710 if (RELOC_EXTENDED_FORMAT(entry)) 3711 { 3712 item_off = RELOCIT(t, n); 3713 n = n + 1; 3714 code_off = RELOCIT(t, n); 3715 n = n + 1; 3716 } 3717 else 3718 { 3719 item_off = RELOC_ITEM_OFFSET(entry); 3720 code_off = RELOC_CODE_OFFSET(entry); 3721 } 3722 a = a + code_off; 3723 { 3724 ptr obj = S_get_code_obj(RELOC_TYPE(entry), oldco, a, item_off); 3725 if (p == obj) return 1; 3726 } 3727 } 3728 } 3729 } 3730 } 3731 } 3732 } 3733 } 3734 } 3735 else if ((iptr)tf == type_thread) 3736 { 3737 } 3738 else if ((iptr)tf == type_rtd_counts) 3739 { 3740 } 3741 else if ((iptr)tf == type_phantom) 3742 { 3743 } 3744 else 3745 { 3746 S_error_abort("self-test: illegal typed object type"); 3747 } 3748 } 3749 else if (t == type_pair) 3750 { 3751 { 3752 ISPC p_at_spc = SPACE(p); 3753 if (p_at_spc < space_weakpair) 3754 { 3755 if (p == INITCAR(p)) return 1; 3756 if (p == INITCDR(p)) return 1; 3757 } 3758 else if (p_at_spc == space_ephemeron) 3759 { 3760 } 3761 else if (p_at_spc == space_weakpair) 3762 { 3763 if (p == INITCDR(p)) return 1; 3764 } 3765 else 3766 { 3767 S_error_abort("misplaced pair"); 3768 } 3769 } 3770 } 3771 else if (t == type_closure) 3772 { 3773 ptr code = CLOSCODE(p); 3774 if (p == code) return 1; 3775 if ((CODETYPE(code)) & (code_flag_continuation << code_flags_offset)) 3776 { 3777 } 3778 else 3779 { 3780 uptr len = CODEFREE(code); 3781 { 3782 uptr idx, p_len = len; 3783 ptr *p_p = &CLOSIT(p, 0); 3784 for (idx = 0; idx < p_len; idx++) 3785 { 3786 if (p == p_p[idx]) return 1; 3787 } 3788 } 3789 } 3790 } 3791 else if (t == type_symbol) 3792 { 3793 } 3794 else if (t == type_flonum) 3795 { 3796 } 3797 else 3798 { 3799 S_error_abort("self-test: illegal type"); 3800 } 3801 } 3802 return 0; 3803} 3804 3805static void mark_untyped_data_object(thread_gc *tgc, ptr p, uptr p_sz, seginfo *si) 3806{ 3807 if (!si->marked_mask) { 3808 init_mask(tgc, si->marked_mask, si->generation, 0); 3809 } 3810 si->marked_mask[segment_bitmap_byte(p)] |= segment_bitmap_bit(p); 3811 { 3812 uptr addr = (uptr)p; 3813 uptr seg = addr_get_segment(addr); 3814 uptr end_seg = addr_get_segment(addr + p_sz - 1); 3815 if (seg == end_seg) { 3816 si->marked_count += p_sz; 3817 } else { 3818 seginfo *mark_si; IGEN g; 3819 si->marked_count += ((uptr)build_ptr(seg+1,0)) - addr; 3820 seg++; 3821 while (seg < end_seg) { 3822 mark_si = SegInfo(seg); 3823 g = mark_si->generation; 3824 if (!fully_marked_mask[g]) init_fully_marked_mask(tgc, g); 3825 mark_si->marked_mask = fully_marked_mask[g]; 3826 mark_si->marked_count = bytes_per_segment; 3827 seg++; 3828 } 3829 mark_si = SegInfo(end_seg); 3830 { 3831 if (!mark_si->marked_mask) { 3832 init_mask(tgc, mark_si->marked_mask, mark_si->generation, 0); 3833 } 3834 /* no need to set a bit: it's enough to have made `marked_mask` non-NULL */ 3835 mark_si->marked_count += addr + p_sz - (uptr)build_ptr(end_seg,0); 3836 } 3837 } 3838 } 3839} 3840 3841