lang/LangSource/GC.cpp

   1 /*
   2         SuperCollider real time audio synthesis system
   3     Copyright (c) 2002 James McCartney. All rights reserved.
   4         http://www.audiosynth.com
   5
   6     This program is free software; you can redistribute it and/or modify
   7     it under the terms of the GNU General Public License as published by
   8     the Free Software Foundation; either version 2 of the License, or
   9     (at your option) any later version.
  10
  11     This program is distributed in the hope that it will be useful,
  12     but WITHOUT ANY WARRANTY; without even the implied warranty of
  13     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14     GNU General Public License for more details.
  15
  16     You should have received a copy of the GNU General Public License
  17     along with this program; if not, write to the Free Software
  18     Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301  USA
  19 */
  20
  21
  22 #include "GC.h"
  23 #include "PyrKernel.h"
  24 #include "PyrObjectProto.h"
  25 #include "PyrSymbol.h"
  26 #include "InitAlloc.h"
  27 #include <string.h>
  28 #include <stdexcept>
  29
  30 #define PAUSETIMES 0
  31
  32
  33 double pauseBeginTime = 0.;
  34 double totalPauseTime = 0.;
  35 double maxPauseTime = 0.;
  36 double minPauseTime = 1e9;
  37 int pauseCount = 0;
  38 int numPausesGreaterThanOneMillisecond = 0;
  39 int maxPauseStackScans = 0;
  40 int maxPauseFlips = 0;
  41 int maxPauseScans = 0;
  42 int maxPausePartialScans = 0;
  43 int maxPauseNumToScan = 0;
  44 int maxPauseSlotsScanned = 0;
  45 int checkStackScans = 0;
  46 int checkFlips = 0;
  47 int checkNumToScan = 0;
  48 int checkScans = 0;
  49 int checkPartialScans = 0;
  50 int checkSlotsScanned = 0;
  51
  52 double elapsedTime();
  53
  54 inline void PyrGC::beginPause()
  55 {
  56         checkStackScans = mStackScans;
  57         checkFlips = mFlips;
  58         checkScans = mScans;
  59         checkNumToScan = mNumToScan;
  60         checkPartialScans = mNumPartialScans;
  61         checkSlotsScanned = mSlotsScanned;
  62         pauseBeginTime = elapsedTime();
  63 }
  64
  65 inline void PyrGC::endPause()
  66 {
  67         double pauseTime = elapsedTime() - pauseBeginTime;
  68         if (pauseTime > 0.001) numPausesGreaterThanOneMillisecond++;
  69         if (pauseTime > maxPauseTime) {
  70                 maxPauseTime = pauseTime;
  71                 maxPauseStackScans = mStackScans - checkStackScans;
  72                 maxPauseFlips = mFlips - checkFlips;
  73                 maxPauseScans = mScans - checkScans;
  74                 maxPauseNumToScan = checkNumToScan;
  75                 maxPausePartialScans = mNumPartialScans - checkPartialScans;
  76                 maxPauseSlotsScanned = mSlotsScanned - checkSlotsScanned;
  77         }
  78         if (pauseTime < minPauseTime) minPauseTime = pauseTime;
  79         totalPauseTime += pauseTime;
  80         pauseCount ++;
  81 }
  82
  83 void PyrGC::reportPause()
  84 {
  85         post("pauses %d\n", pauseCount);
  86         post("total pause time %g\n", totalPauseTime);
  87         post("num pauses > 1 ms  %d\n", numPausesGreaterThanOneMillisecond);
  88         post("avg pause time %g\n", totalPauseTime / pauseCount);
  89         post("min pause time %g\n", minPauseTime);
  90         post("max pause time %g\n", maxPauseTime);
  91         post("max pause scans %d\n", maxPauseScans);
  92         post("max pause partial obj scans %d\n", maxPausePartialScans);
  93         post("max pause num to scan %d\n", maxPauseNumToScan);
  94         post("max pause flips %d\n", maxPauseFlips);
  95         post("max pause stack scans %d\n", maxPauseStackScans);
  96         post("max pause slots scanned %d\n", maxPauseSlotsScanned);
  97
  98         pauseBeginTime = 0.;
  99         totalPauseTime = 0.;
 100         maxPauseTime = 0.;
 101         minPauseTime = 1e9;
 102         pauseCount = 0;
 103         numPausesGreaterThanOneMillisecond = 0;
 104 }
 105
 106 #if PAUSETIMES
 107
 108 #define BEGINPAUSE beginPause();
 109 #define ENDPAUSE endPause();
 110 #define REPORTPAUSE reportPause();
 111
 112 #else
 113
 114 #define BEGINPAUSE
 115 #define ENDPAUSE
 116 #define REPORTPAUSE
 117
 118 #endif
 119
 120 /*
 121
 122 ---
 123 list segments:
 124         black gray white free sweep
 125
 126 scan phase:
 127         clear list of new nonlocal reached objects.
 128                 when a non local object is reached, mark it, and put it on the list if not retained.
 129 sweep phase:
 130         send any new retained objects to other system
 131         send any no longer reatined objects to the other system.
 132         send this list to
 133         enqueue finalization messages
 134                 finalize: call finalize method, move from sweep area to free area
 135         list of nonlocal objects.
 136         list of nonlocal reached objects.
 137 */
 138
 139 void fatalerror(const char*str);
 140 void fatalerror(const char*str)
 141 {
 142         fputs(str, stderr);
 143         postfl(str);
 144         throw std::runtime_error(str);
 145         //exit(-1);
 146 }
 147
 148 inline int ScanSize(PyrObjectHdr *obj) { return obj->obj_format <= obj_slot ? obj->size : 0; }
 149
 150 void PyrGC::ScanSlots(PyrSlot *inSlots, long inNumToScan)
 151 {
 152         unsigned char whiteColor = mWhiteColor;
 153
 154         PyrSlot *slot = inSlots;
 155         PyrSlot *endslot = inSlots + inNumToScan;
 156         for (; slot < endslot; ++slot) {
 157                 if (IsObj(slot)) {
 158                         PyrObject *obj = slotRawObject(slot);
 159                         if (obj->gc_color == whiteColor) {
 160                                 ToGrey2(obj);
 161                         }
 162                 }
 163         }
 164         mSlotsScanned += inNumToScan;
 165 }
 166
 167 void GCSet::Init(int inGCSet)
 168 {
 169         mBlack.classptr = NULL;
 170         mBlack.obj_sizeclass = inGCSet;
 171         mBlack.size = 0;
 172         mBlack.gc_color = obj_gcmarker;
 173
 174         mWhite.classptr = NULL;
 175         mWhite.obj_sizeclass = inGCSet;
 176         mWhite.size = 0;
 177         mWhite.gc_color = obj_gcmarker;
 178
 179         mFree = &mBlack;
 180
 181         mBlack.next = &mWhite;
 182         mWhite.next  = &mBlack;
 183
 184         mBlack.prev = &mWhite;
 185         mWhite.prev = &mBlack;
 186
 187 }
 188
 189 void GCSet::MajorFlip()
 190 {
 191         // move all white items to beginning of free list
 192         mFree = mWhite.next;
 193         if (!PyrGC::IsMarker(mBlack.next)) {
 194                 // move all black items to white list
 195                 mWhite.next = mBlack.next;
 196                 mFree->prev = mWhite.prev;
 197                 mBlack.next->prev = &mWhite;
 198                 mWhite.prev->next = mFree;
 199
 200                 // black list empty
 201                 mBlack.next = &mWhite;
 202                 mWhite.prev = &mBlack;
 203         }
 204 }
 205
 206 void GCSet::MinorFlip()
 207 {
 208         // move all white items to beginning of free list
 209         mFree = mWhite.next;
 210 }
 211
 212 PyrProcess* newPyrProcess(VMGlobals *g, PyrClass *procclassobj);
 213
 214 PyrGC::PyrGC(VMGlobals *g, AllocPool *inPool, PyrClass *mainProcessClass, long poolSize)
 215 {
 216         mVMGlobals = g;
 217         mPool = inPool;
 218         //mCurSet = 0;
 219         mNumToScan = 0;
 220
 221         mFlips = 0;
 222         mCollects = 0;
 223         mAllocTotal = 0;
 224         mNumAllocs = 0;
 225         mScans = 0;
 226         mStackScans = 0;
 227         mNumPartialScans = 0;
 228         mSlotsScanned = 0;
 229
 230         mGreyColor = 3<<2;
 231         mBlackColor = 2<<2;
 232         mWhiteColor = 1<<2;
 233         mFreeColor = 0;
 234
 235         mRunning = false;
 236
 237         mCanSweep = false;
 238         mPartialScanObj = NULL;
 239         mPartialScanSlot = 0;
 240         mUncollectedAllocations = 0;
 241
 242         mGrey.classptr = NULL;
 243         mGrey.obj_sizeclass = 0;
 244         mGrey.size = 0;
 245         mGrey.gc_color = obj_gcmarker;
 246
 247         mGrey.prev = &mGrey;
 248         mGrey.next = &mGrey;
 249
 250         mNumGrey = 0;
 251
 252         mNewPool.Init(mPool, poolSize, poolSize, 9000);
 253
 254         // initialize treadmills
 255         for (int i=0; i<kNumGCSets; ++i) {
 256                 mSets[i].Init(i);
 257         }
 258         g->process = NULL; // initPyrThread checks to see if process has been started
 259         mProcess = newPyrProcess(g, mainProcessClass);
 260
 261         mStack = slotRawObject(&slotRawThread(&mProcess->mainThread)->stack);
 262         ToBlack(mStack);
 263         SetNil(&slotRawThread(&mProcess->mainThread)->stack);
 264
 265         mNumGrey = 0;
 266         ToGrey2(mProcess);
 267         g->sp = mStack->slots - 1;
 268         g->process = mProcess;
 269         mRunning = true;
 270
 271         SanityCheck();
 272         //assert(SanityCheck());
 273
 274 }
 275
 276 PyrObject *PyrGC::NewPermanent(size_t inNumBytes, long inFlags, long inFormat)
 277 {
 278         // obtain size info
 279         int32 alignedSize = (inNumBytes + kAlignMask) & ~kAlignMask; // 16 byte align
 280         int32 numSlots = alignedSize / sizeof(PyrSlot);
 281         numSlots = numSlots < 1 ? 1 : numSlots;
 282         int32 sizeclass = LOG2CEIL(numSlots);
 283         sizeclass = sc_min(sizeclass, kNumGCSizeClasses-1);
 284
 285         int32 allocSize = sizeof(PyrObjectHdr) + (sizeof(PyrSlot) << sizeclass);
 286
 287         // allocate permanent objects
 288         PyrObject* obj = (PyrObject*)pyr_pool_runtime->Alloc(allocSize);
 289
 290         obj->gc_color = obj_permanent;
 291         obj->next = obj->prev = NULL;
 292         obj->obj_sizeclass = sizeclass;
 293         obj->obj_format = inFormat;
 294         obj->obj_flags = inFlags;
 295         obj->size = 0;
 296         obj->classptr = class_object;
 297         return obj;
 298 }
 299
 300 void PyrGC::BecomePermanent(PyrObject *inObject)
 301 {
 302
 303         if (IsGrey(inObject)) mNumGrey--;
 304         DLRemove(inObject);
 305         inObject->gc_color = obj_permanent;
 306         inObject->obj_flags |= obj_immutable;
 307         inObject->next = inObject->prev = inObject;
 308 }
 309
 310 void PyrGC::BecomeImmutable(PyrObject *inObject)
 311 {
 312         inObject->obj_flags |= obj_immutable;
 313 }
 314
 315 void DumpBackTrace(VMGlobals *g);
 316
 317 PyrObject *PyrGC::New(size_t inNumBytes, long inFlags, long inFormat, bool inCollect)
 318 {
 319         PyrObject *obj = NULL;
 320
 321         if (inFlags & obj_permanent) {
 322                 return NewPermanent(inNumBytes, inFlags, inFormat);
 323         }
 324
 325 #ifdef GC_SANITYCHECK
 326         SanityCheck();
 327 #endif
 328
 329         // obtain size info
 330
 331         int32 alignedSize = (inNumBytes + kAlignMask) & ~kAlignMask; // 16 byte align
 332         int32 numSlots = alignedSize / sizeof(PyrSlot);
 333         numSlots = numSlots < 1 ? 1 : numSlots;
 334         int32 sizeclass = LOG2CEIL(numSlots);
 335         sizeclass = sc_min(sizeclass, kNumGCSizeClasses-1);
 336
 337         int32 credit = 1L << sizeclass;
 338         mAllocTotal += credit;
 339         mNumAllocs++;
 340
 341         mNumToScan += credit;
 342         obj = Allocate(inNumBytes, sizeclass, inCollect);
 343
 344         obj->obj_format = inFormat;
 345         obj->obj_flags = inFlags & 255;
 346         obj->size = 0;
 347         obj->classptr = class_object;
 348         obj->gc_color = mWhiteColor;
 349
 350 #ifdef GC_SANITYCHECK
 351         SanityCheck();
 352 #endif
 353         return obj;
 354 }
 355
 356
 357
 358 PyrObject *PyrGC::NewFrame(size_t inNumBytes, long inFlags, long inFormat, bool inAccount)
 359 {
 360         PyrObject *obj = NULL;
 361
 362 #ifdef GC_SANITYCHECK
 363         SanityCheck();
 364 #endif
 365
 366         // obtain size info
 367
 368         int32 alignedSize = (inNumBytes + kAlignMask) & ~kAlignMask; // 16 byte align
 369         int32 numSlots = alignedSize / sizeof(PyrSlot);
 370         numSlots = numSlots < 1 ? 1 : numSlots;
 371         int32 sizeclass = LOG2CEIL(numSlots);
 372         sizeclass = sc_min(sizeclass, kNumGCSizeClasses-1);
 373
 374         int32 credit = 1L << sizeclass;
 375         mAllocTotal += credit;
 376         mNumAllocs++;
 377         mNumToScan += credit;
 378
 379         obj = Allocate(inNumBytes, sizeclass, inAccount);
 380
 381         obj->obj_format = inFormat;
 382         obj->obj_flags = inFlags;
 383         obj->size = 0;
 384         obj->classptr = class_frame;
 385         obj->gc_color = mWhiteColor;
 386
 387 #ifdef GC_SANITYCHECK
 388         SanityCheck();
 389 #endif
 390         return obj;
 391 }
 392
 393 PyrObject *PyrGC::NewFinalizer(ObjFuncPtr finalizeFunc, PyrObject *inObject, bool inCollect)
 394 {
 395         PyrObject *obj = NULL;
 396
 397 #ifdef GC_SANITYCHECK
 398         SanityCheck();
 399 #endif
 400
 401         // obtain size info
 402
 403         int32 sizeclass = 1;
 404
 405         int32 credit = 1L << sizeclass;
 406         mNumToScan += credit;
 407         mAllocTotal += credit;
 408         mNumAllocs++;
 409
 410         if (inCollect && mNumToScan >= kScanThreshold) {
 411                 Collect();
 412         }
 413
 414         GCSet *gcs = mSets + kFinalizerSet;
 415
 416         obj = (PyrObject*)gcs->mFree;
 417         if (!IsMarker(obj)) {
 418                 // from free list
 419                 gcs->mFree = obj->next;
 420         } else {
 421                 if (sizeclass > kMaxPoolSet) {
 422                         SweepBigObjects();
 423                         int32 allocSize = sizeof(PyrObjectHdr) + (sizeof(PyrSlot) << sizeclass);
 424                         obj = (PyrObject*)mPool->Alloc(allocSize);
 425                 } else {
 426                         int32 allocSize = sizeof(PyrObjectHdr) + (sizeof(PyrSlot) << sizeclass);
 427                         obj = (PyrObject*)mNewPool.Alloc(allocSize);
 428                 }
 429                 if (!obj) {
 430                         post("Finalizer alloc failed.\n");
 431                         MEMFAILED;
 432                 }
 433                 DLInsertAfter(&gcs->mWhite, obj);
 434         }
 435
 436
 437         obj->obj_sizeclass = sizeclass;
 438         obj->obj_format = obj_slot;
 439         obj->obj_flags = 0;
 440         obj->size = 2;
 441         obj->classptr = class_finalizer;
 442         obj->gc_color = mWhiteColor;
 443
 444         SetPtr(obj->slots+0, (void*)finalizeFunc);
 445         SetObject(obj->slots+1, inObject);
 446
 447 #ifdef GC_SANITYCHECK
 448         SanityCheck();
 449 #endif
 450         return obj;
 451 }
 452
 453
 454 void PyrGC::SweepBigObjects()
 455 {
 456         if (!mCanSweep) return;
 457
 458         for (int i=kMaxPoolSet+1; i<kNumGCSizeClasses; ++i) {
 459                 GCSet *gcs = mSets + i;
 460                 PyrObjectHdr *obj = gcs->mFree;
 461
 462                 if (!IsMarker(obj)) {
 463                         // unlink chain of free objects
 464                         gcs->mFree = obj->prev->next = &gcs->mBlack;
 465                         gcs->mBlack.prev = obj->prev;
 466
 467                         do {
 468                                 PyrObjectHdr *nextobj = obj->next;
 469                                 void* ptr = (void*)obj;
 470                                 mPool->Free(ptr);
 471                                 obj = nextobj;
 472                         } while (!IsMarker(obj));
 473                 }
 474         }
 475         mCanSweep = false;
 476 }
 477
 478 void PyrGC::CompletePartialScan(PyrObject *obj)
 479 {
 480         if (mPartialScanObj == obj) {
 481                 int32 remain = obj->size - mPartialScanSlot;
 482                 ScanSlots(mPartialScanObj->slots + mPartialScanSlot, remain);
 483         }
 484 }
 485
 486 void PyrGC::DoPartialScan(int32 inObjSize)
 487 {
 488         int32 remain = inObjSize - mPartialScanSlot;
 489         mNumPartialScans++;
 490         if (remain <= 0) {
 491                 mPartialScanObj = NULL;
 492                 mNumToScan -= 4;
 493                 if (mNumToScan<0) mNumToScan = 0;
 494                 return;
 495         }
 496         int32 numtoscan = sc_min(remain, mNumToScan);
 497         ScanSlots(mPartialScanObj->slots + mPartialScanSlot, numtoscan);
 498
 499         if (numtoscan == remain) {
 500                 mPartialScanObj = NULL;
 501                 mNumToScan -= numtoscan + 4;
 502         } else {
 503                 mPartialScanSlot += numtoscan;
 504                 mNumToScan -= numtoscan;
 505         }
 506         if (mNumToScan < 0) mNumToScan = 0;
 507         //post("partial %5d xx %4d %2d %s\n", mScans, mNumToScan, mNumGrey);
 508         //post("partial %5d %2d %4d %2d %s\n", mScans, i, mNumToScan, mNumGrey, slotRawSymbol(&obj->classptr->name)->name);
 509 }
 510
 511 bool PyrGC::ScanOneObj()
 512 {
 513         // Find a set that has a grey object
 514         PyrObject* obj;
 515         obj = (PyrObject*)mGrey.next;
 516         if (IsMarker(obj)) {
 517                 if (mNumGrey) fatalerror("grey count error\n");
 518                 return false;
 519         }
 520
 521         /*if (!IsGrey(obj)) {
 522                 postfl("Object on grey list not grey  %d %d\n", obj->gc_color, mGreyColor);
 523                 fatalerror("C1");
 524         }*/
 525
 526         mScans++;
 527
 528         //post("-> scan %d %d %d\n", mNumGrey, IsGrey(obj), mNumToScan);
 529         // Found a grey object
 530         // move obj from grey to black
 531
 532         ToBlack(obj);
 533
 534         int32 size = ScanSize(obj);
 535         //post("<- scan %d %d %d %d\n", mNumGrey, IsGrey(obj), mNumToScan, size);
 536         if (size > mNumToScan + 32)
 537         {
 538                 mPartialScanObj = obj;
 539                 mPartialScanSlot = 0;
 540                 DoPartialScan(size);
 541         }
 542         else if (size > 0)
 543         {
 544                 ScanSlots(obj->slots, size);
 545                 mNumToScan -= 1L << obj->obj_sizeclass;
 546                 if (mNumToScan < 0) mNumToScan = 0;
 547         } else {
 548                 mNumToScan -= 1L << obj->obj_sizeclass;
 549                 if (mNumToScan < 0) mNumToScan = 0;
 550         }
 551         return true;
 552 }
 553
 554 void PyrGC::ScanStack()
 555 {
 556         // scan the stack
 557         PyrObject* obj = mStack;
 558
 559         VMGlobals *g = mVMGlobals;
 560
 561         PyrSlot* slot = obj->slots;
 562         int32 size = obj->size = g->sp - slot + 1;
 563
 564         ScanSlots(slot, size);
 565 }
 566
 567 void PyrGC::ScanFrames()
 568 {
 569         VMGlobals *g = mVMGlobals;
 570         PyrFrame* frame = g->frame;
 571         while (frame) {
 572 #if 1
 573                 // this is more incremental
 574                 if (IsWhite(frame)) {
 575                         ToGrey2(frame);
 576                 }
 577 #else
 578                 // this is more efficient
 579                 if (!IsBlack(frame)) {
 580                         ToBlack(frame);
 581                         int32 size = ScanSize(frame);
 582                         PyrSlot *slots = ((PyrObject*)frame)->slots;
 583                         ScanSlots(slots, size);
 584                 }
 585 #endif
 586                 frame = slotRawFrame(&frame->caller);
 587         }
 588 }
 589
 590 void PyrGC::Flip()
 591 {
 592 #ifdef GC_SANITYCHECK
 593         SanityCheck();
 594 #endif
 595
 596         ScanFinalizers();
 597
 598         GCSet *gcs = mSets;
 599         if ((mFlips & 3) == 0) {
 600                 // major flip
 601                 for (int i=0; i<kNumGCSets; ++i, ++gcs) {
 602                         gcs->MajorFlip();
 603                 }
 604
 605                 // advance colors
 606                 mBlackColor += 4;
 607                 mWhiteColor += 4;
 608                 mGreyColor += 4;
 609                 mFreeColor += 4;
 610         } else {
 611                 // minor flip
 612                 for (int i=0; i<kNumGCSets; ++i, ++gcs) {
 613                         gcs->MinorFlip();
 614                 }
 615         }
 616         // move root to grey area
 617         mNumGrey = 0;
 618         ToGrey2(mProcess);
 619
 620         ToBlack(mStack);
 621
 622         // reset counts
 623         mNumToScan = 0;
 624         mCanSweep = true;
 625
 626         mFlips++;
 627         //post("flips %d  collects %d   nalloc %d   alloc %d   grey %d\n", mFlips, mCollects, mNumAllocs, mAllocTotal, mNumGrey);
 628
 629 #ifdef GC_SANITYCHECK
 630         SanityCheck();
 631 #endif
 632 }
 633
 634
 635 void PyrGC::FullCollection()
 636 {
 637         Collect(100000000);     // collect space
 638         SweepBigObjects();
 639 }
 640
 641 void PyrGC::Collect(int32 inNumToScan)
 642 {
 643         mNumToScan = sc_max(mNumToScan, inNumToScan);
 644         Collect();      // collect space
 645 }
 646
 647 void PyrGC::Collect()
 648 {
 649         BEGINPAUSE
 650         bool stackScanned = false;
 651         mCollects++;
 652
 653 #ifdef GC_SANITYCHECK
 654         SanityCheck();
 655 #endif
 656
 657         if (mNumToScan > 0) {
 658                 //post("->Collect  ns %d  ng %d  s %d\n", mNumToScan, mNumGrey, mScans);
 659                 //DumpInfo();
 660                 mNumToScan += mNumToScan >> 3;
 661
 662                 //post("->Collect2  ns %d  ng %d  s %d\n", mNumToScan, mNumGrey, mScans);
 663                 //mCurSet = 0;
 664                 while (mNumToScan > 0) {
 665                         while (mNumToScan > 0 && (mNumGrey > 0 || mPartialScanObj)) {
 666                                 if (mPartialScanObj) {
 667                                         DoPartialScan(ScanSize(mPartialScanObj));
 668                                 } else {
 669                                         if (!ScanOneObj()) break;
 670                                 }
 671                         }
 672                         if (mNumGrey == 0 && mPartialScanObj == NULL) {
 673                                 if (!stackScanned) {
 674                                         stackScanned = true;
 675                                         mStackScans++;
 676                                         ScanStack();
 677                                         ScanFrames();
 678                                 }
 679                                 if (mNumGrey == 0 && mPartialScanObj == NULL && stackScanned) {
 680                                         Flip();
 681                                         break;
 682                                 }
 683                         }
 684                 }
 685                 //post("<-Collect  ns %d  ng %d  s %d\n", mNumToScan, mNumGrey, mScans);
 686                 //DumpInfo();
 687                 //post("size9:\n");
 688                 //TraceAnyPathToObjsOfSize(9);
 689                 //post("greys:\n");
 690                 //TraceAnyPathToAllGrey();
 691         }
 692         //post("mNumToScan %d\n", mNumToScan);
 693
 694         mUncollectedAllocations = 0;
 695 #ifdef GC_SANITYCHECK
 696         SanityCheck();
 697 #endif
 698         ENDPAUSE
 699 }
 700
 701
 702
 703 void PyrGC::Finalize(PyrObject *finalizer)
 704 {
 705         if (!IsPtr(finalizer->slots+0)) return;
 706         if (!IsObj(finalizer->slots+1)) return;
 707
 708         ObjFuncPtr func = (ObjFuncPtr)slotRawPtr(&finalizer->slots[0]);
 709         PyrObject *obj = slotRawObject(&finalizer->slots[1]);
 710         //post("FINALIZE %s %p\n", slotRawSymbol(&obj->classptr->name)->name, obj);
 711         (func)(mVMGlobals, obj);
 712
 713         SetNil(obj->slots+0);
 714         SetNil(obj->slots+1);
 715 }
 716
 717 void PyrGC::ScanFinalizers()
 718 {
 719         GCSet *gcs = &mSets[kFinalizerSet];
 720         PyrObjectHdr *obj = gcs->mWhite.next;
 721         PyrObjectHdr *firstFreeObj = gcs->mFree;
 722
 723         while (obj != firstFreeObj) {
 724                 Finalize((PyrObject*)obj);
 725                 obj = obj->next;
 726         }
 727 }
 728
 729 bool PyrGC::SanityCheck2()
 730 {
 731         int numgrey = 0;
 732         PyrObjectHdr *grey = mGrey.next;
 733         while (!IsMarker(grey)) {
 734                 numgrey++;
 735                 if (!IsGrey(grey)) {
 736                         postfl("sc Object on grey list not grey  %d %d   %d\n", grey->gc_color, mGreyColor, numgrey);
 737                         return false;
 738                 }
 739                 grey = grey->next;
 740         }
 741         //postfl("sc %d %d\n", mNumGrey, numgrey);
 742         return mNumGrey == numgrey;
 743 }
 744
 745 #ifdef SC_DARWIN
 746         #include <CoreServices/../Frameworks/CarbonCore.framework/Headers/MacTypes.h>
 747 #endif
 748
 749 bool PyrGC::SanityCheck()
 750 {
 751         if (!mRunning) return true;
 752
 753         //postfl("PyrGC::SanityCheck\n");
 754         bool res = LinkSanity() && ListSanity()
 755 //                      && SanityMarkObj((PyrObject*)mProcess,NULL,0) && SanityMarkObj(mStack,NULL,0)
 756 //                      && SanityClearObj((PyrObject*)mProcess,0) && SanityClearObj(mStack,0)
 757                         && SanityCheck2()
 758         ;
 759         //if (!res) DumpInfo();
 760         //if (!res) Debugger();
 761         return res;
 762 }
 763
 764 bool PyrGC::ListSanity()
 765 {
 766         bool found;
 767
 768         if (StackDepth() < 0) {
 769                 fprintf(stderr, "stack underflow %d\n", (int)StackDepth());
 770                 return false;
 771         }
 772
 773         //postfl("PyrGC::ListSanity\n");
 774         for (int i=0; i<kNumGCSets; ++i) {
 775                 PyrObjectHdr *obj;
 776                 GCSet* set = mSets + i;
 777
 778                 // check black marker
 779                 obj = &set->mBlack;
 780                 if (!IsMarker(obj)) {
 781                         //debugf("set %d black marker color wrong %d %p\n", i, obj->gc_color, obj);
 782                         fprintf(stderr, "set %d black marker color wrong %d %p\n", i, obj->gc_color, obj);
 783                         setPostFile(stderr);
 784                         DumpBackTrace(mVMGlobals);
 785                         dumpBadObject((PyrObject*)obj);
 786                         return false;
 787                 }
 788
 789                 // check white marker
 790                 obj = &set->mWhite;
 791                 if (!IsMarker(obj)) {
 792                         //debugf("set %d white marker color wrong %d %p\n", i, obj->gc_color, obj);
 793                         fprintf(stderr, "set %d white marker color wrong %d %p\n", i, obj->gc_color, obj);
 794                         setPostFile(stderr);
 795                         DumpBackTrace(mVMGlobals);
 796                         dumpBadObject((PyrObject*)obj);
 797                         return false;
 798                 }
 799
 800                 // check free pointer between white and black marker
 801                 if (set->mFree != &set->mBlack) {
 802                         obj = set->mWhite.next;
 803                         found = false;
 804                         while (!IsMarker(obj)) {
 805                                 if (obj == set->mFree) { found = true; break; }
 806                                 obj = obj->next;
 807                         }
 808                         if (!found) {
 809                                 //debugf("set %d free pointer not between white and black\n", i);
 810                                 fprintf(stderr, "set %d free pointer not between white and black\n", i);
 811                                 fprintf(stderr, "set->mFree %p\n", set->mFree);
 812                                 fprintf(stderr, "set->mWhite %p\n", &set->mWhite);
 813                                 fprintf(stderr, "set->mBlack %p\n", &set->mBlack);
 814                                 setPostFile(stderr);
 815                                 DumpBackTrace(mVMGlobals);
 816                                 dumpBadObject((PyrObject*)set->mFree);
 817
 818                                 fprintf(stderr, "black %d white %d grey %d\n", mBlackColor, mWhiteColor, mGreyColor);
 819
 820                                 obj = &set->mWhite;
 821                                 int count = 0;
 822                                 do {
 823                                         if (obj == set->mFree) fprintf(stderr, "%4d %p %3d %d FREE\n", count, obj, obj->gc_color, obj->obj_sizeclass);
 824                                         else if (obj == &set->mWhite) fprintf(stderr, "%4d %p %3d %d WHITE\n", count, obj, obj->gc_color, obj->obj_sizeclass);
 825                                         else if (obj == &set->mBlack) fprintf(stderr, "%4d %p %3d %d BLACK\n", count, obj, obj->gc_color, obj->obj_sizeclass);
 826                                         else fprintf(stderr, "%4d %p %3d %d\n", count, obj, obj->gc_color, obj->obj_sizeclass);
 827                                         obj = obj->next;
 828                                         count++;
 829                                 } while (obj != &set->mWhite);
 830
 831                                 return false;
 832                         }
 833                 }
 834
 835                 // scan black list
 836                 obj = set->mBlack.next;
 837                 while (!IsMarker(obj)) {
 838                         if (obj->gc_color != mBlackColor) {
 839                                 //debugf("set %d black list obj color wrong %d (%d, %d, %d) %p\n",
 840                                 //      i, obj->gc_color, mBlackColor, mGreyColor, mWhiteColor, obj);
 841                                 fprintf(stderr, "set %d black list obj color wrong %d (%d, %d, %d) %p\n",
 842                                         i, obj->gc_color, mBlackColor, mGreyColor, mWhiteColor, obj);
 843                                 setPostFile(stderr);
 844                                 DumpBackTrace(mVMGlobals);
 845                                 dumpBadObject((PyrObject*)obj);
 846                                 return false;
 847                         }
 848                         if (GetGCSet(obj) != set) {
 849                                 //debugf("set %d black obj gcset wrong %d %p\n", i, obj->obj_sizeclass, obj);
 850                                 fprintf(stderr, "set %d black obj gcset wrong %d %p\n", i, obj->obj_sizeclass, obj);
 851                                 setPostFile(stderr);
 852                                 dumpBadObject((PyrObject*)obj);
 853                                 return false;
 854                         }
 855                         if (obj->next->prev != obj) {
 856                                 fprintf(stderr, "set %d black obj->next->prev != obj\n", i);
 857                                 setPostFile(stderr);
 858                                 DumpBackTrace(mVMGlobals);
 859                                 dumpBadObject((PyrObject*)obj);
 860                         }
 861
 862                         // scan for refs to white.
 863                         if (!BlackToWhiteCheck((PyrObject*)obj)) return false;
 864
 865                         obj = obj->next;
 866                 }
 867
 868                 // scan white list
 869                 obj = set->mWhite.next;
 870                 while (obj != set->mFree) {
 871                         if (obj->gc_color != mWhiteColor) {
 872                                 //debugf("set %d white list obj color wrong %d (%d, %d, %d) %p\n",
 873                                 //      i, obj->gc_color, mBlackColor, mGreyColor, mWhiteColor, obj);
 874                                 //debugf("hmmm free %p  black %p\n", set->mFree, set->black);
 875                                 fprintf(stderr, "set %d white list obj color wrong %d (%d, %d, %d) %p\n",
 876                                         i, obj->gc_color, mBlackColor, mGreyColor, mWhiteColor, obj);
 877                                 fprintf(stderr, "hmmm free %p  black %p\n", set->mFree, &set->mBlack);
 878                                 setPostFile(stderr);
 879                                 DumpBackTrace(mVMGlobals);
 880                                 dumpBadObject((PyrObject*)obj);
 881                                 return false;
 882                         }
 883                         if (GetGCSet(obj) != set) {
 884                                 //debugf("set %d white obj gcset wrong %d %p\n", i, obj->obj_sizeclass, obj);
 885                                 fprintf(stderr, "set %d white obj gcset wrong %d %p\n", i, obj->obj_sizeclass, obj);
 886                                 setPostFile(stderr);
 887                                 DumpBackTrace(mVMGlobals);
 888                                 dumpBadObject((PyrObject*)obj);
 889                                 return false;
 890                         }
 891                         if (obj->next->prev != obj) {
 892                                 fprintf(stderr, "set %d white obj->next->prev != obj\n", i);
 893                                 setPostFile(stderr);
 894                                 DumpBackTrace(mVMGlobals);
 895                                 dumpBadObject((PyrObject*)obj);
 896                         }
 897                         obj = obj->next;
 898                 }
 899
 900                 // mark all free list items free
 901                 obj = set->mFree;
 902                 while (!IsMarker(obj)) {
 903                         /*if (obj->gc_color == mGreyColor) {
 904                                 //debugf("grey obj on free list\n");
 905                                 fprintf(stderr, "grey obj on free list\n");
 906                                 return false;
 907                         }*/
 908                         //post("FREE\n");
 909                         //dumpObject((PyrObject*)(PyrObject*)obj);
 910                         obj->gc_color = mFreeColor;
 911                         if (GetGCSet(obj) != set) {
 912                                 //debugf("set %d free obj gcset wrong %d %p\n", i, obj->obj_sizeclass, obj);
 913                                 fprintf(stderr, "set %d free obj gcset wrong %d %p\n", i, obj->obj_sizeclass, obj);
 914                                 //dumpObject((PyrObject*)obj);
 915                                 return false;
 916                         }
 917                         if (obj->next->prev != obj) {
 918                                 fprintf(stderr, "set %d free obj->next->prev != obj\n", i);
 919                                 //dumpObject((PyrObject*)obj);
 920                         }
 921                         obj = obj->next;
 922                 }
 923         }
 924
 925         int numgrey = 0;
 926         PyrObjectHdr *grey = mGrey.next;
 927         while (!IsMarker(grey)) {
 928                 numgrey++;
 929                 if (!IsGrey(grey)) {
 930                         fprintf(stderr, "sc Object on grey list not grey  %d %d   %d\n", grey->gc_color, mGreyColor, numgrey);
 931                         fprintf(stderr, "%p <- %p -> %p grey %p process %p\n", mGrey.prev, &mGrey, mGrey.next, grey, mProcess);
 932                         return false;
 933                 }
 934                 grey = grey->next;
 935         }
 936
 937         if (numgrey != mNumGrey) {
 938                 fprintf(stderr, "grey count off %d %d\n", numgrey, mNumGrey);
 939                 DumpInfo();
 940                 fprintf(stderr, ".");
 941                 return false;
 942         }
 943         return true;
 944 }
 945
 946 bool PyrGC::LinkSanity()
 947 {
 948         //postfl("PyrGC::LinkSanity\n");
 949         for (int i=0; i<kNumGCSets; ++i) {
 950                 GCSet* set = mSets + i;
 951
 952                 // scan entire loop
 953                 PyrObjectHdr* obj = &set->mBlack;
 954                 do {
 955                         if (obj->next->prev != obj) {
 956                                 fprintf(stderr, "set %d black obj->next->prev != obj\n", i);
 957                                 //dumpObject((PyrObject*)obj);
 958                                 return false;
 959                         }
 960                         if (obj->prev->next != obj) {
 961                                 fprintf(stderr, "set %d black obj->prev->next != obj\n", i);
 962                                 //dumpObject((PyrObject*)obj);
 963                                 return false;
 964                         }
 965                         obj = obj->next;
 966                 } while (obj != &set->mBlack);
 967         }
 968         return true;
 969 }
 970
 971 #define DUMPINSANITY 1
 972
 973 bool PyrGC::BlackToWhiteCheck(PyrObject *objA)
 974 {
 975         if (objA->obj_format > obj_slot) return true;
 976         // scan it
 977         int size = objA->size;
 978         if (size > 0) {
 979                 PyrSlot *slot = objA->slots;
 980                 for (int j=size; j--; ++slot) {
 981                         PyrObject * objB = NULL;
 982                         if (IsObj(slot) && slotRawObject(slot)) {
 983                                 objB = slotRawObject(slot);
 984                         }
 985                         if (objB && (unsigned long)objB < 100) {
 986                                 fprintf(stderr, "weird obj ptr\n");
 987                                 return false;
 988                         }
 989                         if (objB) {
 990                                 if (objA == mStack)
 991                                         continue;
 992
 993                                 if (objA->gc_color == mBlackColor && objA != mPartialScanObj) {
 994                                         if (objB->gc_color == mWhiteColor) {
 995                                                 if (objA->classptr == class_frame) {
 996                                                         // jmc: black stack frames pointing to white nodes can be ignore
 997                                                         PyrFrame * frameA = (PyrFrame*)objA;
 998                                                         PyrMethod * meth = slotRawMethod(&frameA->method);
 999                                                         PyrMethodRaw * methraw = METHRAW(meth);
1000                                                         if (methraw->needsHeapContext)
1001                                                                 continue;
1002                                                 }
1003 #if DUMPINSANITY
1004                                                 fprintf(stderr, "black frame to white ref %p %p\n", objA, objB);
1005                                                 dumpBadObject(objA);
1006                                                 dumpBadObject(objB);
1007                                                 fprintf(stderr, "\n");
1008 #endif
1009                                                 return false;
1010                                         }
1011                                 }
1012                         }
1013                 }
1014         }
1015         return true;
1016 }
1017
1018 bool PyrGC::SanityMarkObj(PyrObject *objA, PyrObject *fromObj, int level)
1019 {
1020         if (objA->IsPermanent()) return true;
1021         if (objA->IsMarked()) return true;
1022         if (objA->size > MAXINDEXSIZE(objA)) {
1023                 fprintf(stderr, "obj indexed size larger than max: %d > %d\n", objA->size, MAXINDEXSIZE(objA));
1024                 //dumpObject((PyrObject*)objA);
1025                 return false;
1026         }
1027
1028         objA->SetMark(); // mark it
1029         if (!BlackToWhiteCheck(objA))
1030                 return false;
1031
1032         if (objA->obj_format <= obj_slot) {
1033                 // scan it
1034                 int size = objA->size;
1035                 if (size > 0) {
1036                         PyrSlot *slot = objA->slots;
1037                         for (int j=size; j--; ++slot) {
1038                                 PyrObject * objB = NULL;
1039                                 int tag = GetTag(slot);
1040                                 if (tag == tagObj && slotRawObject(slot))
1041                                         objB = slotRawObject(slot);
1042
1043                                 if (objB) {
1044                                         /*
1045                                         if (level > 40) {
1046                                                 fprintf(stderr, "40 levels deep!\n");
1047                                                 dumpBadObject(objA);
1048                                                 dumpBadObject(objB);
1049                                                 return false;
1050                                         } */
1051                                         bool err = SanityMarkObj(objB, objA, level + 1);
1052                                         if (!err)
1053                                                 return false;
1054                                 }
1055                         }
1056                 }
1057         }
1058         return true;
1059 }
1060
1061 bool PyrGC::SanityClearObj(PyrObject *objA, int level)
1062 {
1063         if (!(objA->IsMarked())) return true;
1064         if (objA->IsPermanent()) return true;
1065         objA->ClearMark(); // unmark it
1066
1067         if (objA->obj_format <= obj_slot) {
1068                 // scan it
1069                 int size = objA->size;
1070                 if (size > 0) {
1071                         PyrSlot *slot = objA->slots;
1072                         for (int j=size; j--; ++slot) {
1073                                 PyrObject *objB = NULL;
1074                                 if (IsObj(slot) && slotRawObject(slot)) {
1075                                         objB = slotRawObject(slot);
1076                                 }
1077                                 if (objB) {
1078                                         /*if (level > 40) {
1079                                                 fprintf(stderr, "40 levels deep!\n");
1080                                                 dumpBadObject(objA);
1081                                                 //dumpObject((PyrObject*)objB);  //newPyrFrame
1082                                                 return errFailed;
1083                                         }*/
1084                                         bool err = SanityClearObj(objB, level+1);
1085                                         if (!err) return false;
1086                                 }
1087                         }
1088                 }
1089         }
1090         return true;
1091 }
1092
1093 void PyrGC::DumpInfo()
1094 {
1095         int i;
1096         PyrObjectHdr *obj;
1097         int numblack, numwhite, numfree, settotal, setsiztotal;
1098         int totblack, totgrey, totwhite, totfree, totref, total, siztotal;
1099
1100         REPORTPAUSE
1101         post("flips %d  collects %d   nalloc %d   alloc %d   grey %d\n", mFlips, mCollects, mNumAllocs, mAllocTotal, mNumGrey);
1102
1103         totblack = 0;
1104         totgrey = 0;
1105         totwhite = 0;
1106         totfree = 0;
1107         totref = 0;
1108         total = 0;
1109         siztotal = 0;
1110         for (i=0; i<kNumGCSizeClasses; ++i) {
1111                 GCSet *set = mSets + i;
1112
1113                 // scan black list
1114                 numblack = 0;
1115                 obj = set->mBlack.next;
1116                 while (!IsMarker(obj)) {
1117                         numblack++;
1118                         obj = obj->next;
1119                 }
1120
1121                 // scan white list
1122                 numwhite = 0;
1123                 obj = set->mWhite.next;
1124                 while (obj != set->mFree) {
1125                         numwhite++;
1126                         obj = obj->next;
1127                 }
1128
1129                 // scan free list
1130                 numfree = 0;
1131                 obj = set->mFree;
1132                 while (!IsMarker(obj)) {
1133                         numfree++;
1134                         obj = obj->next;
1135                 }
1136                 settotal = numblack + numwhite + numfree;
1137                 setsiztotal = settotal << (i + 3);
1138                 siztotal += setsiztotal;
1139                 totblack += numblack;
1140                 totwhite += numwhite;
1141                 totfree += numfree;
1142                 total += settotal;
1143                 if (settotal) {
1144                         post("%2d  bwf t sz: %6d %6d %6d   %6d   %8d\n", i,
1145                                 numblack, numwhite, numfree, settotal, setsiztotal);
1146                 }
1147         }
1148         post("tot bwf t sz: %6d %6d %6d   %6d   %8d\n",
1149                 totblack, totwhite, totfree, total, siztotal);
1150 }
1151
1152 void PyrGC::DumpGrey()
1153 {
1154
1155         // scan grey list
1156         PyrObjectHdr *obj = mGrey.next;
1157         while (!IsMarker(obj)) {
1158                 post("grey %s %d %d\n", slotRawSymbol(&obj->classptr->name)->name, obj->obj_sizeclass, obj->size);
1159                 obj = obj->next;
1160         }
1161 }
1162
1163 void PyrGC::DumpSet(int i)
1164 {
1165         GCSet *set = mSets + i;
1166
1167         // scan black list
1168         PyrObjectHdr *obj = set->mBlack.next;
1169         while (!IsMarker(obj)) {
1170                 post("black %s %d %d\n", slotRawSymbol(&obj->classptr->name)->name, obj->obj_sizeclass, obj->size);
1171                 obj = obj->next;
1172         }
1173
1174         // scan white list
1175         obj = set->mWhite.next;
1176         while (obj != set->mFree) {
1177                 post("white %s %d %d\n", slotRawSymbol(&obj->classptr->name)->name, obj->obj_sizeclass, obj->size);
1178                 obj = obj->next;
1179         }
1180
1181         // scan free list
1182         obj = set->mFree;
1183         while (!IsMarker(obj)) {
1184                 post("free %s %d %d\n", slotRawSymbol(&obj->classptr->name)->name, obj->obj_sizeclass, obj->size);
1185                 obj = obj->next;
1186         }
1187 }
1188
1189 void PyrGC::ClearMarks()
1190 {
1191         for (int i=0; i<kNumGCSets; ++i) {
1192                 GCSet *set = mSets + i;
1193
1194                 // scan black list
1195                 PyrObjectHdr *obj = set->mBlack.next;
1196                 while (!IsMarker(obj)) {
1197                         obj->ClearMark(); // unmark it
1198                         obj = obj->next;
1199                 }
1200
1201                 // scan grey list
1202                 obj = mGrey.next;
1203                 while (!IsMarker(obj)) {
1204                         obj->ClearMark(); // unmark it
1205                         obj = obj->next;
1206                 }
1207
1208                 // scan white list
1209                 obj = set->mWhite.next;
1210                 while (obj != set->mFree) {
1211                         obj->ClearMark(); // unmark it
1212                         obj = obj->next;
1213                 }
1214
1215                 // scan free list
1216                 obj = set->mFree;
1217                 while (!IsMarker(obj)) {
1218                         obj->ClearMark(); // unmark it
1219                         obj = obj->next;
1220                 }
1221         }
1222 }
1223
1224 void PyrGC::throwMemfailed(size_t inNumBytes)
1225 {
1226         post("alloc failed. size = %d\n", inNumBytes);
1227         MEMFAILED;
1228 }
1229
1230