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