src/lstcore/lst_memory.c

   1 /*
   2  * The memory management and garbage collection module
   3  *
   4  * ---------------------------------------------------------------
   5  * Little Smalltalk, Version 5
   6  *
   7  * Copyright (C) 1987-2005 by Timothy A. Budd
   8  * Copyright (C) 2007 by Charles R. Childers
   9  * Copyright (C) 2005-2007 by Danny Reinhold
  10  * Copyright (C) 2010 by Ketmar // Vampire Avalon
  11  *
  12  * ============================================================================
  13  * This license applies to the virtual machine and to the initial image of
  14  * the Little Smalltalk system and to all files in the Little Smalltalk
  15  * packages except the files explicitly licensed with another license(s).
  16  * ============================================================================
  17  * Permission is hereby granted, free of charge, to any person obtaining a copy
  18  * of this software and associated documentation files (the "Software"), to deal
  19  * in the Software without restriction, including without limitation the rights
  20  * to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
  21  * copies of the Software, and to permit persons to whom the Software is
  22  * furnished to do so, subject to the following conditions:
  23  *
  24  * The above copyright notice and this permission notice shall be included in
  25  * all copies or substantial portions of the Software.
  26  *
  27  * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
  28  * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
  29  * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
  30  * AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
  31  * LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
  32  * FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
  33  * DEALINGS IN THE SOFTWARE.
  34  */
  35 /* Uses baker two-space garbage collection algorithm */
  36 #include "lst_dpname.c"
  37
  38 /*#define GC_TIMINGS*/
  39
  40
  41 /* WARNING! LST_MEM_ALIGN MUST BE POWER OF 2! */
  42 #define LST_MEM_ALIGN  2
  43 #if LST_MEM_ALIGN != 1
  44 # define lstAlignAddr(n)  ((void *)(((uintptr_t)n+(LST_MEM_ALIGN-1))&(~(LST_MEM_ALIGN-1))))
  45 #else
  46 # define lstAlignAddr(n)  ((void *)n)
  47 #endif
  48
  49 static const char *imgSign = LST_IMAGE_SIGNATURE;
  50
  51
  52 unsigned int lstGCCount = 0;
  53
  54 typedef struct {
  55   unsigned char *realStart; /* can be unaligned */
  56   unsigned char *start; /* starting address */
  57   unsigned char *end;   /* first byte after the end */
  58   unsigned char *cur;   /* current free */
  59 } LstMemSpace;
  60
  61 #define STATIC_SPACE  2
  62 /* 0 and 1: dynamic; 2: static */
  63 static LstMemSpace memSpaces[3];
  64 static LstMemSpace *curSpace;
  65 static int curSpaceNo; /* to avoid checks */
  66
  67 static LstFinLink *finListHead = NULL; /* list of objects with finalizers */
  68 static LstFinLink *aliveFinListHead = NULL; /* list of alive objects with finalizers */
  69
  70 static LstFinLink *stFinListHead = NULL; /* list of all known st-finalizable objects */
  71 static LstFinLink *stAliveFinListHead = NULL; /* st-finalizable objects, alive */
  72
  73 static LstFinLink *stWeakListHead = NULL; /* list of all known weak objects */
  74 static LstFinLink *stAliveWeakListHead = NULL; /* weak objects, alive */
  75
  76 static int lstGCSpecialLock = 0;
  77 /*
  78  * what we will do with 'st-finalized' is this:
  79  *   a) include them in list (to faster scanning);
  80  *   b) after GC cycle, create new process group for each
  81  *      object that must be finalized (if it has 'finalize' method);
  82  *   c) that's all (well, not such easy, but...)
  83  * so interpreter will execute all finalizers in the normal sheduling process
  84  * (and 'finalizable' object will be kept alive either until it's process
  85  * group is alive, or if it anchors itself in some way)
  86  */
  87
  88 /*
  89  * roots for memory access
  90  * used as bases for garbage collection algorithm
  91  */
  92 lstObject *lstRootStack[LST_ROOTSTACK_LIMIT];
  93 LstUInt lstRootTop = 0;
  94
  95 /* 4096 should be more than enough to recompile the whole image */
  96 #define STATICROOTLIMIT  4096
  97 static lstObject **staticRoots[STATICROOTLIMIT];
  98 static LstUInt staticRootTop = 0;
  99
 100
 101 lstObject **lstTempStack[LST_TS_LIMIT];
 102 int lstTempSP = 0;
 103
 104 /* test to see if a pointer is in dynamic memory area or not */
 105 #define LST_IS_STATIC(x) \
 106   ((const unsigned char *)(x) >= memSpaces[STATIC_SPACE].start && \
 107    (const unsigned char *)(x) < memSpaces[STATIC_SPACE].end)
 108
 109
 110 static void allocMemSpace (LstMemSpace *spc, int size) {
 111   if (spc->start) {
 112     unsigned char *n = realloc(spc->start, size);
 113     if (!n) free(spc->start);
 114     spc->start = n ? n : malloc(size);
 115   } else {
 116     spc->start = malloc(size);
 117   }
 118   spc->realStart = spc->start;
 119   spc->start = lstAlignAddr(spc->start);
 120   spc->end = spc->start+size;
 121   spc->cur = spc->start;
 122 }
 123
 124
 125 typedef struct {
 126   lstObject *obj;
 127   const char *mname;
 128 } LstObjToFinInfo;
 129 static LstObjToFinInfo *objToFin = NULL;
 130 static int objToFinSize = 0;
 131 static int objToFinUsed = 0;
 132
 133
 134 static void addToFin (lstObject *obj, const char *mname) {
 135   if (objToFinUsed >= objToFinSize) {
 136     if (objToFinSize >= 100000) lstFatal("too many objects to finalize", 0x29a);
 137     int newSz = objToFinSize+1024;
 138     LstObjToFinInfo *n = realloc(objToFin, sizeof(LstObjToFinInfo)*newSz);
 139     if (!n) lstFatal("out of memory to finalize info", 0x29a);
 140     objToFin = n;
 141     objToFinSize = newSz;
 142   }
 143   objToFin[objToFinUsed].obj = obj;
 144   objToFin[objToFinUsed].mname = mname;
 145   ++objToFinUsed;
 146 }
 147
 148
 149 /* initialize the memory management system */
 150 void lstMemoryInit (int staticsz, int dynamicsz) {
 151   /* allocate the memory areas */
 152   memset(memSpaces, sizeof(memSpaces), 0);
 153   allocMemSpace(&memSpaces[0], dynamicsz);
 154   allocMemSpace(&memSpaces[1], dynamicsz);
 155   allocMemSpace(&memSpaces[2], staticsz);
 156   if (!memSpaces[0].start || !memSpaces[1].start || !memSpaces[2].start) lstFatal("not enough memory for space allocations\n", 0);
 157   lstRootTop = 0;
 158   staticRootTop = 0;
 159   lstTempSP = 0;
 160   lstExecUserBreak = 0;
 161   lstSuspended = 0;
 162   finGroupCount = 0;
 163   runOnlyFins = 0;
 164   curSpaceNo = 1;
 165   curSpace = &memSpaces[curSpaceNo];
 166   finListHead = stFinListHead = stWeakListHead = NULL;
 167   ehList = NULL;
 168   rsFree = NULL;
 169   lstGCSpecialLock = 0;
 170   objToFinUsed = 0;
 171   /* allocate 'main' process group; this group is for sheduler, for example */
 172   /* note that this group should be ALWAYS alive */
 173   runGroups = curGroup = calloc(1, sizeof(LstRunGroup));
 174   lstFlushMethodCache();
 175 }
 176
 177
 178 void lstMemoryDeinit (void) {
 179   /*fprintf(stderr, "staticRootTop: %d\n", staticRootTop);*/
 180   /* finalize all unfinalized objects */
 181   while (finListHead) {
 182     LstFinLink *n = finListHead->next;
 183     if (finListHead->fin) finListHead->fin(finListHead->obj, finListHead->udata);
 184     free(finListHead);
 185     finListHead = n;
 186   }
 187   /* free all st-finalizable objects */
 188   while (stFinListHead) {
 189     LstFinLink *n = stFinListHead->next;
 190     free(stFinListHead);
 191     stFinListHead = n;
 192   }
 193   while (stWeakListHead) {
 194     LstFinLink *n = stWeakListHead->next;
 195     free(stWeakListHead);
 196     stWeakListHead = n;
 197   }
 198   /* free groups and other structures */
 199   while (ehList) {
 200     LstEventHandler *n = ehList->next;
 201     free(ehList);
 202     ehList = n;
 203   }
 204   while (runGroups) {
 205     LstRunGroup *n = runGroups->next;
 206     LstRunContext *ctx = runGroups->group;
 207     while (ctx) {
 208       LstRunContext *p = ctx->prev;
 209       free(ctx);
 210       ctx = p;
 211     }
 212     free(runGroups);
 213     runGroups = n;
 214   }
 215   while (rsFree) {
 216     LstRunContext *p = rsFree->prev;
 217     free(rsFree);
 218     rsFree = p;
 219   }
 220   if (objToFin) free(objToFin); objToFin = NULL;
 221   objToFinSize = 0;
 222   lstRootTop = 0;
 223   staticRootTop = 0;
 224   curSpace = NULL;
 225   free(memSpaces[2].realStart);
 226   free(memSpaces[1].realStart);
 227   free(memSpaces[0].realStart);
 228 }
 229
 230
 231 static inline void lstRemoveFromFList (LstFinLink **head, LstFinLink *item) {
 232   if (item->prev) item->prev->next = item->next; else *head = item->next;
 233   if (item->next) item->next->prev = item->prev;
 234 }
 235
 236
 237 static inline void lstAddToFList (LstFinLink **head, LstFinLink *item) {
 238   item->prev = NULL;
 239   if ((item->next = *head)) item->next->prev = item;
 240   *head = item;
 241 }
 242
 243
 244 /*
 245  * garbage collector
 246  * this is a classic Cheney two-finger collector
 247  */
 248
 249 /* curSpace and curSpaceNo should be set to the new space */
 250 /* copy object to the new space, return new address */
 251 static lstObject *gcMoveObject (lstObject *o) {
 252   lstObject *res;
 253   unsigned char *next;
 254   int size;
 255   if (!o || LST_IS_SMALLINT(o)) return o; /* use as-is */
 256   if (LST_IS_MOVED(o)) return o->stclass; /* already relocated */
 257   if (LST_IS_STATIC(o)) return o; /* static object, use as-is */
 258   if (o->fin) {
 259     /* move to 'alive with finalizers' list */
 260     if (LST_IS_STFIN(o)) {
 261       dprintf("STFIN!\n");
 262       lstRemoveFromFList(&stFinListHead, o->fin);
 263       lstAddToFList(&stAliveFinListHead, o->fin);
 264     } else if (LST_IS_WEAK(o)) {
 265       dprintf("STWEAK!\n");
 266       lstRemoveFromFList(&stWeakListHead, o->fin);
 267       lstAddToFList(&stAliveWeakListHead, o->fin);
 268     } else {
 269       /*dprintf("CFIN!\n");*/
 270       lstRemoveFromFList(&finListHead, o->fin);
 271       lstAddToFList(&aliveFinListHead, o->fin);
 272     }
 273   }
 274   /* copy object to another space and setup redirection pointer */
 275   size = LST_SIZE(o);
 276   res = (lstObject *)curSpace->cur;
 277   memcpy(res, o, sizeof(lstObject));
 278   if (o->fin) o->fin->obj = res; /* fix finowner */
 279   /* setup redirection pointer */
 280   LST_MARK_MOVED(o);
 281   o->stclass = res;
 282   next = curSpace->cur+sizeof(lstObject);
 283   if (!LST_IS_BYTES(o)) size *= LST_BYTES_PER_WORD; else ++size; /* byte objects are always has 0 as the last item */
 284   if (size > 0) memcpy(&res->data, &o->data, size);
 285   next += size;
 286   curSpace->cur = lstAlignAddr(next);
 287   return res;
 288 }
 289
 290
 291 /* return Process object */
 292 static lstObject *lstCreateMethodCall (lstObject *obj, const char *mname) {
 293   lstObject *method = lstFindMethod(obj->stclass, mname);
 294   if (!method) lstFatal("no #finalize or #mourn method found for object", 0x29a);
 295   lstObject *process = lstAllocInstance(lstProcessSize, lstProcessClass);
 296   lstObject *context = lstAllocInstance(lstContextSize, lstContextClass);
 297   process->data[lstIVcontextInProcess] = context;
 298   process->data[lstIVrunningInProcess] = lstTrueObj;
 299   /***/
 300   context->data[lstIVmethodInContext] = method;
 301   /* build arguments array */
 302   lstObject *args = lstAllocInstance(1, lstArrayClass);
 303   args->data[0] = obj; /* self */
 304   context->data[lstIVargumentsInContext] = args;
 305   context->data[lstIVtemporariesInContext] = lstAllocInstance(lstIntValue(method->data[lstIVtemporarySizeInMethod]), lstArrayClass);
 306   context->data[lstIVstackInContext] = lstAllocInstance(lstIntValue(method->data[lstIVstackSizeInMethod]), lstArrayClass);
 307   context->data[lstIVbytePointerInContext] = lstNewInt(0);
 308   context->data[lstIVstackTopInContext] = lstNewInt(0);
 309   context->data[lstIVpreviousContextInContext] = lstNilObj;
 310   context->data[lstIVprocOwnerInContext] = process;
 311   return process;
 312 }
 313
 314
 315 /*
 316 static int lstIsKindOfForGC (const lstObject *obj, const lstObject *aclass) {
 317   const lstObject *pclass = obj;
 318   int stC = 0;
 319   if (!obj || !aclass) return 0;
 320   if (obj == aclass) return 1;
 321   if (LST_IS_SMALLINT(obj)) {
 322     if (LST_IS_SMALLINT(aclass)) return 1;
 323     obj = lstSmallIntClass;
 324   } else {
 325     if (LST_IS_SMALLINT(aclass)) aclass = lstSmallIntClass;
 326     if (!LST_IS_SMALLINT(obj)
 327     obj = obj->stclass;
 328   }
 329   while (obj && obj != lstNilObj) {
 330     if (obj == aclass) return 1;
 331     obj = obj->data[lstIVparentClassInClass];
 332     if (stC) { if (pclass && pclass != lstNilObj) pclass = pclass->data[lstIVparentClassInClass]; }
 333     else if (pclass == obj) return 0;
 334     stC ^= 1;
 335   }
 336   return 0;
 337 }
 338 */
 339
 340
 341 /* res>0: at least one object is dead */
 342 static int processWeakData (lstObject *o) {
 343   int hitCount = 0;
 344   int size = LST_SIZE(o);
 345   while (--size >= 0) {
 346     lstObject *d = o->data[size];
 347     if (LST_IS_SMALLINT(d) || LST_IS_STATIC(d)) continue; /* nothing to fix */
 348     if (LST_IS_MOVED(d)) {
 349       /* object is alive */
 350       o->data[size] = d->stclass;
 351     } else {
 352       /* do not throw out numbers */
 353       /*FIXME: we can have infinite loop here */
 354       lstObject *cls = d->stclass;
 355       while (cls && cls != lstNilObj) {
 356         while (LST_IS_MOVED(cls)) cls = cls->stclass;
 357         if (cls == lstNumberClass) {
 358           /* save the number */
 359           o->data[size] = gcMoveObject(d);
 360           continue;
 361         }
 362         cls = cls->data[lstIVparentClassInClass];
 363       }
 364       /* object is dead; add #mourn call for it and replace link to nil */
 365       dprintf("found someone to mourn\n");
 366       ++hitCount;
 367       gcMoveObject(d);
 368       o->data[size] = lstNilObj;
 369     }
 370   }
 371   return hitCount;
 372 }
 373
 374
 375 #ifdef GC_TIMINGS
 376 # ifndef LST_ON_WINDOWS
 377 #  include <signal.h>
 378 #  include <time.h>
 379 # else
 380 #  include <windows.h>
 381 # endif
 382 static uint64_t getTicksMS (void) {
 383 #ifndef _WIN32
 384   uint64_t res;
 385   struct timespec ts;
 386   clock_gettime(CLOCK_MONOTONIC, &ts);
 387   res = ((uint64_t)ts.tv_sec)*100000UL;
 388   res += ((uint64_t)ts.tv_nsec)/10000UL; //1000000000
 389   return res;
 390 #else
 391   return GetTickCount()*100;
 392 #endif
 393 }
 394 #endif
 395
 396
 397 #define GC_KEEP_METHOD_CACHE
 398
 399 /* garbage collection entry point */
 400 void lstGC (void) {
 401   LstFinLink *weakAlive = NULL;
 402   int f;
 403 #ifdef GC_TIMINGS
 404   uint64_t gcTime = getTicksMS();
 405 #endif
 406 #ifdef DEBUG
 407   int saved = 0;
 408 #endif
 409   if (curSpace->cur == curSpace->start) return; /* nothing to do */
 410   if (lstGCSpecialLock) lstFatal("out of memory for finalizer groups", lstGCSpecialLock);
 411   lstGCCount++;
 412   objToFinUsed = 0;
 413   aliveFinListHead = stAliveFinListHead = stAliveWeakListHead = NULL;
 414   /* first change spaces */
 415   unsigned char *scanPtr;
 416   curSpaceNo ^= 1;
 417   curSpace = &memSpaces[curSpaceNo];
 418   curSpace->cur = curSpace->start;
 419   /* move all roots */
 420   for (f = 0; f < lstRootTop; ++f) lstRootStack[f] = gcMoveObject(lstRootStack[f]);
 421   for (f = 0; f < staticRootTop; ++f) (*staticRoots[f]) = gcMoveObject(*staticRoots[f]);
 422   for (f = 0; f < lstTempSP; ++f) (*lstTempStack[f]) = gcMoveObject(*lstTempStack[f]);
 423   /* the following are mostly static, but who knows... */
 424   for (f = 0; clInfo[f].name; ++f) (*(clInfo[f].eptr)) = gcMoveObject(*(clInfo[f].eptr));
 425   for (f = 0; epInfo[f].name; ++f) (*(epInfo[f].eptr)) = gcMoveObject(*(epInfo[f].eptr));
 426   lstNilObj = gcMoveObject(lstNilObj);
 427   lstTrueObj = gcMoveObject(lstTrueObj);
 428   lstFalseObj = gcMoveObject(lstFalseObj);
 429   lstGlobalObj = gcMoveObject(lstGlobalObj);
 430   lstBadMethodSym = gcMoveObject(lstBadMethodSym);
 431   for (f = 0; f < LST_MAX_BIN_MSG; ++f) lstBinMsgs[f] = gcMoveObject(lstBinMsgs[f]);
 432   /* mark process groups */
 433   {
 434     LstRunGroup *grp;
 435     for (grp = runGroups; grp; grp = grp->next) {
 436       LstRunContext *ctx;
 437       for (ctx = grp->group; ctx; ctx = ctx->prev) ctx->process = gcMoveObject(ctx->process);
 438     }
 439   }
 440 #ifdef GC_KEEP_METHOD_CACHE
 441   /* fix method cache; this have some sense, as many method calls are stdlib calls */
 442   /* when we'll do generational GC, this will have even better impact on cache hits */
 443   /* note that this is completely safe: SendMessage will do the necessary checks */
 444   for (f = 0; f < MTD_CACHE_SIZE+MTD_CACHE_EXTRA; ++f) {
 445     if (cache[f].name) {
 446       /* fix method */
 447       cache[f].name = gcMoveObject(cache[f].name);
 448       cache[f].stclass = gcMoveObject(cache[f].stclass);
 449       cache[f].method = gcMoveObject(cache[f].method);
 450       if (cache[f].analyzed == 1 && cache[f].ivarNum < 0) cache[f].mConst = gcMoveObject(cache[f].mConst);
 451       cache[f].badHits = MTD_BAD_HIT_MAX-2;
 452     }
 453   }
 454 #endif
 455 #ifdef INLINE_SOME_METHODS
 456   lstMetaCharClass = gcMoveObject(lstMetaCharClass);
 457   {
 458     int f;
 459     for (f = 0; lstInlineMethodList[f].name; ++f) {
 460       (*lstInlineMethodList[f].method) = gcMoveObject((*lstInlineMethodList[f].method));
 461     }
 462   }
 463 #endif
 464   /* now walk thru the objects, fix pointers, move other objects, etc.
 465    * note that curSpace->cur will grow in the process */
 466   scanPtr = curSpace->start;
 467 scanAgain:
 468   while (scanPtr < curSpace->cur) {
 469     lstObject *o = (lstObject *)scanPtr;
 470     scanPtr += sizeof(lstObject);
 471     /* fix class */
 472     o->stclass = gcMoveObject(o->stclass);
 473     int size = LST_SIZE(o);
 474     if (LST_IS_BYTES(o)) {
 475       /* nothing to scan here */
 476       scanPtr += size+1; /* skip zero byte too */
 477     } else {
 478       /* process object data, if this is not weak object */
 479       scanPtr += size*LST_BYTES_PER_WORD;
 480       if (!LST_IS_WEAK(o)) while (--size >= 0) o->data[size] = gcMoveObject(o->data[size]);
 481     }
 482     scanPtr = lstAlignAddr(scanPtr);
 483 #ifdef DEBUG
 484     ++saved;
 485 #endif
 486   }
 487   /* process weak objects */
 488   int wasWLHit = 0;
 489   /* alive weak objects */
 490   /* save 'em to another accumulation list */
 491   if (stAliveWeakListHead) {
 492     lstAddToFList(&weakAlive, stAliveWeakListHead);
 493     while (stAliveWeakListHead) {
 494       lstObject *o = stAliveWeakListHead->obj;
 495       assert(o->fin == stAliveWeakListHead);
 496       stAliveWeakListHead = stAliveWeakListHead->next;
 497       if (processWeakData(o)) {
 498         ++wasWLHit;
 499         addToFin(o, "mourn");
 500       }
 501     }
 502   }
 503   if (wasWLHit) goto scanAgain;
 504   /* process ST finalizers, if any */
 505   if (stFinListHead) {
 506     dprintf("FOUND SOME ST-FINALIZERS!\n");
 507     while (stFinListHead) {
 508       lstObject *o = stFinListHead->obj;
 509       assert(o->fin == stFinListHead);
 510       LstFinLink *n = stFinListHead->next;
 511       free(stFinListHead);
 512       stFinListHead = n;
 513       /* now remove the flag and create new process group */
 514       LST_RESET_STFIN(o);
 515       o->fin = NULL; /* it is already freed */
 516       o = gcMoveObject(o);
 517       dprintf("FINOBJ: %p\n", o);
 518       addToFin(o, "finalize");
 519     }
 520     /* scan new space to save ST-F anchors; no need to rescan process groups though */
 521     goto scanAgain;
 522   }
 523   stFinListHead = stAliveFinListHead;
 524   /* dead weak objects */
 525   while (stWeakListHead) {
 526     lstObject *o = stWeakListHead->obj;
 527     assert(o->fin == stWeakListHead);
 528     LstFinLink *n = stWeakListHead->next;
 529     free(stWeakListHead);
 530     stWeakListHead = n;
 531   }
 532   stWeakListHead = weakAlive;
 533   /* here we can process C finalizers, if any */
 534   while (finListHead) {
 535     LstFinLink *n = finListHead->next;
 536     if (finListHead->fin) finListHead->fin(finListHead->obj, finListHead->udata);
 537     free(finListHead);
 538     finListHead = n;
 539   }
 540   finListHead = aliveFinListHead; /* 'alive' list becomes the current one */
 541   /* now check if we have something to mourn/finalize */
 542   ++lstGCSpecialLock;
 543   for (f = 0; f < objToFinUsed; ++f) {
 544     dprintf("FOUND some finalizing obj(%p) method(#%s)\n", objToFin[f].obj, objToFin[f].mname);
 545     lstCreateFinalizePGroup(lstCreateMethodCall(objToFin[f].obj, objToFin[f].mname));
 546 #ifdef DEBUG
 547     /*lstDebugFlag = 1;*/
 548 #endif
 549   }
 550   --lstGCSpecialLock;
 551   /* invalidate method cache */
 552 #ifndef GC_KEEP_METHOD_CACHE
 553   lstFlushMethodCache();
 554 #endif
 555   //if (lstMemoryPointer < lstMemoryBase) lstFatal("insufficient memory after garbage collection", sz);
 556 /*
 557 #ifdef DEBUG
 558  dprintf("GC: %d objects alive; %u bytes used\n", saved, (uintptr_t)curSpace->cur-(uintptr_t)curSpace->start);
 559 #endif
 560 */
 561 #ifdef GC_TIMINGS
 562   gcTime = getTicksMS()-gcTime;
 563   fprintf(stderr, "GC TIME: %u\n", (uint32_t)gcTime);
 564 #endif
 565 }
 566
 567
 568 typedef struct {
 569   char clname[258];
 570   char mtname[258];
 571   int callCount;
 572 } LstCallInfo;
 573
 574 static LstCallInfo *cinfo = NULL;
 575 static int cinfoUsed = 0;
 576
 577 static void lstProcessSpace (int num) {
 578   LstMemSpace *curSpace = &memSpaces[num];
 579   unsigned char *scanPtr = curSpace->start;
 580   while (scanPtr < curSpace->cur) {
 581     lstObject *o = (lstObject *)scanPtr;
 582     if (LST_CLASS(o) == lstMethodClass) {
 583       lstObject *op = o->data[lstIVinvokeCountInMethod];
 584       int cc = lstIntValue(op);
 585       if (cc > 0) {
 586         cinfo = realloc(cinfo, sizeof(LstCallInfo)*(cinfoUsed+1));
 587         lstGetString(cinfo[cinfoUsed].mtname, sizeof(cinfo[cinfoUsed].mtname), o->data[lstIVnameInMethod]);
 588         op = o->data[lstIVclassInMethod];
 589         lstGetString(cinfo[cinfoUsed].clname, sizeof(cinfo[cinfoUsed].clname), op->data[lstIVnameInClass]);
 590         cinfo[cinfoUsed].callCount = cc;
 591         ++cinfoUsed;
 592       }
 593     }
 594     scanPtr += sizeof(lstObject);
 595     int size = LST_SIZE(o);
 596     if (LST_IS_BYTES(o)) {
 597       scanPtr += size+1;
 598     } else {
 599       scanPtr += size*LST_BYTES_PER_WORD;
 600     }
 601     scanPtr = lstAlignAddr(scanPtr);
 602   }
 603 }
 604
 605
 606 void lstShowCalledMethods (void) {
 607   int f;
 608   int xcmp (const void *i0, const void *i1) {
 609     const LstCallInfo *l0 = (const LstCallInfo *)i0;
 610     const LstCallInfo *l1 = (const LstCallInfo *)i1;
 611     return l1->callCount-l0->callCount;
 612   }
 613   lstGC(); /* compact objects */
 614   lstProcessSpace(2); /* static */
 615   lstProcessSpace(curSpaceNo); /* dynamic */
 616   if (cinfoUsed > 0) {
 617     qsort(cinfo, cinfoUsed, sizeof(LstCallInfo), xcmp);
 618     for (f = 0; f < cinfoUsed; ++f) {
 619       fprintf(stderr, "[%s>>%s]: %d\n", cinfo[f].clname, cinfo[f].mtname, cinfo[f].callCount);
 620     }
 621     free(cinfo);
 622     cinfo = NULL;
 623     cinfoUsed = 0;
 624   }
 625 }
 626
 627
 628 #define STATIC_ALLOC \
 629   lstObject *res = (lstObject *)memSpaces[STATIC_SPACE].cur; \
 630   unsigned char *next = memSpaces[STATIC_SPACE].cur; \
 631   next += realSz; \
 632   next = lstAlignAddr(next); \
 633   if (next > memSpaces[STATIC_SPACE].end) lstFatal("insufficient static memory", sz); \
 634   memSpaces[STATIC_SPACE].cur = next; \
 635   LST_SETSIZE(res, sz); \
 636   res->fin = 0; \
 637   res->objFlags = 0;
 638
 639 /*
 640  * static allocation -- tries to allocate values in an area
 641  * that will not be subject to garbage collection
 642 */
 643 lstByteObject *lstStaticAllocBin (int sz) {
 644   int realSz = sz+sizeof(lstObject)+1;
 645   STATIC_ALLOC
 646   LST_SETBIN(res);
 647   lstBytePtr(res)[sz] = '\0';
 648   return (lstByteObject *)res;
 649 }
 650
 651
 652 lstObject *lstStaticAlloc (int sz) {
 653   int realSz = sz*LST_BYTES_PER_WORD+sizeof(lstObject);
 654   STATIC_ALLOC
 655   return res;
 656 }
 657
 658
 659 #define DYNAMIC_ALLOC \
 660   lstObject *res = (lstObject *)curSpace->cur; \
 661   unsigned char *next = curSpace->cur; \
 662   next += realSz; \
 663   next = lstAlignAddr(next); \
 664   if (next > curSpace->end) { \
 665     lstGC(); \
 666     res = (lstObject *)curSpace->cur; \
 667     next = curSpace->cur; \
 668     next += realSz; \
 669     next = lstAlignAddr(next); \
 670     if (next > curSpace->end) lstFatal("insufficient memory", sz); \
 671   } \
 672   curSpace->cur = next; \
 673   LST_SETSIZE(res, sz); \
 674   res->fin = 0; \
 675   res->objFlags = 0;
 676
 677
 678 lstByteObject *lstMemAllocBin (int sz) {
 679   int realSz = sz+sizeof(lstObject)+1;
 680   DYNAMIC_ALLOC
 681   LST_SETBIN(res);
 682   lstBytePtr(res)[sz] = '\0';
 683   return (lstByteObject *)res;
 684 }
 685
 686
 687 lstObject *lstMemAlloc (int sz) {
 688   int realSz = sz*LST_BYTES_PER_WORD+sizeof(lstObject);
 689   DYNAMIC_ALLOC
 690   return res;
 691 }
 692
 693
 694 #include "lst_imagerw.c"
 695
 696
 697 /*
 698  * Add another object root off a static object
 699  *
 700  * Static objects, in general, do not get garbage collected.
 701  * When a static object is discovered adding a reference to a
 702  * non-static object, we link on the reference to our staticRoot
 703  * table so we can give it proper treatment during garbage collection.
 704  */
 705 void lstAddStaticRoot (lstObject **objp) {
 706   int f, rfree = -1;
 707   for (f = 0; f < staticRootTop; ++f) {
 708     if (objp == staticRoots[f]) return;
 709     if (rfree < 0 && !staticRoots[f]) rfree = f;
 710   }
 711   if (rfree < 0) {
 712     if (staticRootTop >= STATICROOTLIMIT) lstFatal("lstAddStaticRoot: too many static references", (intptr_t)objp);
 713     rfree = staticRootTop++;
 714   }
 715   staticRoots[rfree] = objp;
 716 }
 717
 718
 719 void lstWriteBarrier (lstObject **dest, lstObject *src) {
 720   if (LST_IS_STATIC(dest) && !LST_IS_SMALLINT(src) && !LST_IS_STATIC(src)) {
 721     int f, rfree = -1;
 722     for (f = 0; f < staticRootTop; ++f) {
 723       if (staticRoots[f] == dest) goto doit; /* let TEH GOTO be here! */
 724       if (rfree < 0 && !staticRoots[f]) rfree = f;
 725     }
 726     if (rfree < 0) {
 727       if (staticRootTop >= STATICROOTLIMIT) lstFatal("lstWriteBarrier: too many static references", (intptr_t)dest);
 728       rfree = staticRootTop++;
 729     }
 730     staticRoots[rfree] = dest;
 731   }
 732 doit:
 733   *dest = src;
 734 }
 735
 736
 737 /* fix an OOP if needed, based on values to be exchanged */
 738 static void map (lstObject **oop, lstObject *a1, lstObject *a2, int size) {
 739   int x;
 740   lstObject *oo = *oop;
 741   for (x = 0; x < size; ++x) {
 742     if (a1->data[x] == oo) {
 743       *oop = a2->data[x];
 744       return;
 745     }
 746     if (a2->data[x] == oo) {
 747       *oop = a1->data[x];
 748       return;
 749     }
 750   }
 751 }
 752
 753
 754 /* traverse an object space */
 755 static void walk (lstObject *base, lstObject *top, lstObject *array1, lstObject *array2, LstUInt size) {
 756   lstObject *op, *opnext;
 757   LstUInt x, sz;
 758   for (op = base; op < top; op = opnext) {
 759     /* re-map the class pointer, in case that's the object which has been remapped */
 760     map(&op->stclass, array1, array2, size);
 761     /* skip our argument arrays, since otherwise things get rather circular */
 762     sz = LST_SIZE(op);
 763     if (op == array1 || op == array2) {
 764       unsigned char *t = (unsigned char *)op;
 765       t += sz*LST_BYTES_PER_WORD+sizeof(lstObject);
 766       opnext = lstAlignAddr(t);
 767       continue;
 768     }
 769     /* don't have to worry about instance variables if it's a binary format */
 770     if (LST_IS_BYTES(op)) {
 771       LstUInt realSize = sz+sizeof(lstObject)+1;
 772       unsigned char *t = (unsigned char *)op;
 773       t += realSize;
 774       opnext = lstAlignAddr(t);
 775       continue;
 776     }
 777     /* for each instance variable slot, fix up the pointer if needed */
 778     for (x = 0; x < sz; ++x) map(&op->data[x], array1, array2, size);
 779     /* walk past this object */
 780     {
 781       LstUInt realSize = sz*LST_BYTES_PER_WORD+sizeof(lstObject);
 782       unsigned char *t = (unsigned char *)op;
 783       t += realSize;
 784       opnext = lstAlignAddr(t);
 785     }
 786   }
 787 }
 788
 789
 790 /*
 791  * Bulk exchange of object identities
 792  *
 793  * For each index to array1/array2, all references in current object
 794  * memory are modified so that references to the object in array1[]
 795  * become references to the corresponding object in array2[].  References
 796  * to the object in array2[] similarly become references to the
 797  * object in array1[].
 798  */
 799 void lstSwapObjects (lstObject *array1, lstObject *array2, LstUInt size) {
 800   LstUInt x;
 801   /* Convert our memory spaces */
 802   walk((lstObject *)curSpace->start, (lstObject *)curSpace->cur, array1, array2, size);
 803   walk((lstObject *)memSpaces[STATIC_SPACE].start, (lstObject *)memSpaces[STATIC_SPACE].cur, array1, array2, size);
 804   /* Fix up the root pointers, too */
 805   for (x = 0; x < lstRootTop; x++) map(&lstRootStack[x], array1, array2, size);
 806   for (x = 0; x < staticRootTop; x++) map(staticRoots[x], array1, array2, size);
 807 }
 808
 809
 810 /*
 811  * Implement replaceFrom:to:with:startingAt: as a primitive
 812  *
 813  * Return 1 if we couldn't do it, 0 on success.
 814  * This routine has distinct code paths for plain old byte type arrays,
 815  * and for arrays of lstObject pointers; the latter must handle the
 816  * special case of static pointers. It looks hairy (and it is), but
 817  * it's still much faster than executing the block move in Smalltalk
 818  * VM opcodes.
 819  */
 820 int lstBulkReplace (lstObject *dest, lstObject *aFrom, lstObject *aTo, lstObject *aWith, lstObject *startAt) {
 821   LstUInt irepStart, istart, istop, count;
 822   /* we only handle simple 31-bit integer indices; map the values onto 0-based C array type values */
 823   if (!LST_IS_SMALLINT(startAt) || !LST_IS_SMALLINT(aFrom) || !LST_IS_SMALLINT(aTo)) return 1;
 824   if (LST_IS_SMALLINT(dest) || LST_IS_SMALLINT(aWith)) return 1;
 825   irepStart = lstIntValue(startAt)-1;
 826   istart = lstIntValue(aFrom)-1;
 827   istop = lstIntValue(aTo)-1;
 828   count = (istop-istart)+1;
 829   /* defend against goofy negative indices */
 830   if (count <= 0) return 0;
 831   if (irepStart < 0 || istart < 0 || istop < 0) return 1;
 832   /* range check */
 833   if (LST_SIZE(dest) < istop || LST_SIZE(aWith) < irepStart+count) return 1;
 834   /* if both source and dest are binary, just copy some bytes */
 835   if (LST_IS_BYTES(aWith) && LST_IS_BYTES(dest)) {
 836     memmove(lstBytePtr(dest)+istart, lstBytePtr(aWith)+irepStart, count);
 837     return 0;
 838   }
 839   /* fail if only one of objects is binary */
 840   if (LST_IS_BYTES(aWith) || LST_IS_BYTES(dest)) return 1;
 841   /* if we're fiddling pointers between static and dynamic memory, register roots */
 842   /* note that moving from static to dynamic is ok, but the reverse needs some housekeeping */
 843   if (LST_IS_STATIC(dest) && !LST_IS_STATIC(aWith)) {
 844     LstUInt f;
 845     /*fprintf(stderr, "!!!: count=%u\n", count);*/
 846     for (f = 0; f < count; ++f) lstAddStaticRoot(&dest->data[istart+f]);
 847   }
 848   /* copy object pointer fields */
 849   memmove(&dest->data[istart], &aWith->data[irepStart], LST_BYTES_PER_WORD*count);
 850   return 0;
 851 }
 852
 853
 854 lstObject *lstNewString (const char *str) {
 855   int l = str ? strlen(str) : 0;
 856   lstByteObject *strobj = lstMemAllocBin(l);
 857   strobj->stclass = lstStringClass;
 858   if (l > 0) memcpy(lstBytePtr(strobj), str, l);
 859   lstBytePtr(strobj)[l] = '\0';
 860   return (lstObject *)strobj;
 861 }
 862
 863
 864 int lstGetString (char *buf, int bufsize, const lstObject *str) {
 865   int fsize = LST_SIZE(str), csz = fsize;
 866   if (csz > bufsize-1) csz = bufsize-1;
 867   if (buf && csz > 0) memcpy(buf, &str->data, csz);
 868   if (csz >= 0) buf[csz] = '\0'; /* put null terminator at end */
 869   if (fsize > bufsize-1) return fsize+1;
 870   return 0; /* ok */
 871 }
 872
 873
 874 char *lstGetStringPtr (const lstObject *str) {
 875   return (char *)(lstBytePtr(str));
 876 }
 877
 878
 879 lstObject *lstNewBinary (const void *p, LstUInt l) {
 880   lstByteObject *bobj = lstMemAllocBin(l);
 881   bobj->stclass = lstByteArrayClass;
 882   if (l > 0) {
 883     if (p) memcpy(lstBytePtr(bobj), p, l); else memset(lstBytePtr(bobj), 0, l);
 884   }
 885   return (lstObject *)bobj;
 886 }
 887
 888
 889 lstObject *lstNewBCode (const void *p, LstUInt l) {
 890   lstByteObject *bobj = lstMemAllocBin(l);
 891   bobj->stclass = lstByteCodeClass;
 892   if (l > 0) {
 893     if (p) memcpy(lstBytePtr(bobj), p, l); else memset(lstBytePtr(bobj), 0, l);
 894   }
 895   return (lstObject *)bobj;
 896 }
 897
 898
 899 lstObject *lstAllocInstance (int size, lstObject *cl) {
 900   int f;
 901   if (size < 0) return NULL;
 902   lstRootStack[lstRootTop++] = cl;
 903   lstObject *obj = lstMemAlloc(size);
 904   obj->stclass = lstRootStack[--lstRootTop];
 905   for (f = 0; f < size; ++f) obj->data[f] = lstNilObj;
 906   return obj;
 907 }
 908
 909
 910 /* create new Integer (64-bit) */
 911 lstObject *lstNewLongInt (LstLInt val) {
 912   lstByteObject *res = lstMemAllocBin(sizeof(LstLInt));
 913   res->stclass = lstIntegerClass;
 914   memcpy(lstBytePtr(res), &val, sizeof(val));
 915   return (lstObject *)res;
 916 }
 917
 918
 919 lstObject *lstNewFloat (LstFloat val) {
 920   lstByteObject *res = lstMemAllocBin(sizeof(LstFloat));
 921   res->stclass = lstFloatClass;
 922   memcpy(lstBytePtr(res), &val, sizeof(val));
 923   return (lstObject *)res;
 924 }
 925
 926
 927 lstObject *lstNewArray (int size) {
 928   if (size < 0) return NULL;
 929   return lstAllocInstance(size, lstArrayClass);
 930 }
 931
 932
 933 static int symbolBareCmp (const char *left, int leftsize, const char *right, int rightsize) {
 934   int minsize = leftsize;
 935   int i;
 936   if (rightsize < minsize) minsize = rightsize;
 937   if (minsize > 0) {
 938     if ((i = memcmp(left, right, minsize))) return i;
 939   }
 940   return leftsize-rightsize;
 941 }
 942
 943
 944 /*
 945 static int symbolCmp (const lstObject *s0, const lstObject *s1) {
 946   return symbolBareCmp((const char *)lstBytePtr(s0), LST_SIZE(s0), (const char *)lstBytePtr(s1), LST_SIZE(s1));
 947 }
 948 */
 949
 950
 951 lstObject *lstDictFind (const lstObject *dict, const char *name) {
 952   /* binary search */
 953   const lstObject *keys = dict->data[0];
 954   int l = 0, h = LST_SIZE(keys)-1, nlen = strlen(name);
 955   while (l <= h) {
 956     int mid = (l+h)/2;
 957     const lstObject *key = keys->data[mid];
 958     int res = symbolBareCmp(name, nlen, (char *)lstBytePtr(key), LST_SIZE(key));
 959     if (res == 0) return dict->data[1]->data[mid];
 960     if (res < 0) h = mid-1; else l = mid+1;
 961   }
 962   return NULL;
 963 }
 964
 965
 966 int lstIsKindOf (const lstObject *obj, const lstObject *aclass) {
 967   const lstObject *pclass = obj;
 968   int stC = 0;
 969   if (!obj || !aclass) return 0;
 970   if (obj == aclass) return 1;
 971   if (LST_IS_SMALLINT(obj)) {
 972     if (LST_IS_SMALLINT(aclass)) return 1;
 973     obj = lstSmallIntClass;
 974   } else {
 975     if (LST_IS_SMALLINT(aclass)) aclass = lstSmallIntClass;
 976     obj = obj->stclass;
 977   }
 978   while (obj && obj != lstNilObj) {
 979     /*printf(" : [%s]\n", lstBytePtr(obj->data[lstIVnameInClass]));*/
 980     if (obj == aclass) return 1;
 981     obj = obj->data[lstIVparentClassInClass];
 982     if (stC) { if (pclass && pclass != lstNilObj) pclass = pclass->data[lstIVparentClassInClass]; }
 983     else if (pclass == obj) return 0; /* avoid cycles */
 984     stC ^= 1;
 985   }
 986   return 0;
 987 }
 988
 989
 990 lstObject *lstFindGlobal (const char *name) {
 991   if (!name || !name[0]) return NULL;
 992   return lstDictFind(lstGlobalObj, name);
 993 }
 994
 995
 996 lstObject *lstFindMethod (lstObject *stclass, const char *method) {
 997   lstObject *dict, *res;
 998   /* scan upward through the class hierarchy */
 999   for (; stclass && stclass != lstNilObj; stclass = stclass->data[lstIVparentClassInClass]) {
1000     /* consider the Dictionary of methods for this Class */
1001 #if 0 & defined(DEBUG)
1002     {
1003       fprintf(stderr, "st=%p; u=%p; sz=%d\n", stclass, lstNilObj, LST_SIZE(stclass));
1004       fprintf(stderr, "  [%s]\n", lstGetStringPtr(stclass->data[lstIVnameInClass]));
1005     }
1006 #endif
1007 #ifdef DEBUG
1008     if (LST_IS_SMALLINT(stclass)) lstFatal("lookupMethod: looking in SmallInt instance", 0);
1009     if (LST_IS_BYTES(stclass)) lstFatal("lookupMethod: looking in binary object", 0);
1010     if (LST_SIZE(stclass) < lstClassSize) lstFatal("lookupMethod: looking in non-class object", 0);
1011 #endif
1012     dict = stclass->data[lstIVmethodsInClass];
1013 #ifdef DEBUG
1014     if (!dict) lstFatal("lookupMethod: NULL dictionary", 0);
1015     if (LST_IS_SMALLINT(dict)) lstFatal("lookupMethod: SmallInt dictionary", 0);
1016     if (dict->stclass != lstFindGlobal("Dictionary")) lstFatal("lookupMethod: method list is not a dictionary", 0);
1017 #endif
1018     res = lstDictFind(dict, method);
1019     if (res) return res;
1020   }
1021   return NULL;
1022 }
1023
1024
1025 lstObject *lstNewSymbol (const char *name) {
1026   lstObject *res = NULL;
1027   if (!name || !name[0]) return NULL;
1028   lstObject *str = lstNewString(name);
1029   if (lstRunMethodWithArg(lstNewSymMethod, NULL, str, &res, 1) != lstReturnReturned) return NULL;
1030   if (!res || res->stclass != lstSymbolClass) return NULL;
1031   return res;
1032 }
1033
1034
1035 int lstSetGlobal (const char *name, lstObject *val) {
1036   if (!name || !name[0]) return -2;
1037   lstRootStack[lstRootTop++] = val;
1038   lstObject *aa = lstNewArray(2);
1039   lstRootStack[lstRootTop++] = aa;
1040   lstRootStack[lstRootTop-1]->data[0] = lstNewString(name);
1041   lstRootStack[lstRootTop-1]->data[1] = lstRootStack[lstRootTop-2];
1042   aa = lstRootStack[--lstRootTop];
1043   --lstRootTop;
1044   if (lstRunMethodWithArg(lstSetGlobMethod, NULL, aa, NULL, 1) != lstReturnReturned) return -1;
1045   return 0;
1046 }
1047
1048
1049 void lstSetFinalizer (lstObject *o, LstFinalizerFn fn, void *udata) {
1050   if (LST_IS_SMALLINT(o) || LST_IS_STATIC(o)) return; /* note that static objects can't have finalizer */
1051   if (o->fin) {
1052     lstRemoveFromFList(&finListHead, o->fin);
1053   } else {
1054     o->fin = malloc(sizeof(LstFinLink));
1055   }
1056   o->fin->fin = fn;
1057   o->fin->udata = udata;
1058   o->fin->obj = o;
1059   lstAddToFList(&finListHead, o->fin);
1060 }
1061
1062
1063 void *lstGetUData (lstObject *o) {
1064   if (LST_IS_SMALLINT(o) || !o->fin) return NULL;
1065   return o->fin->udata;
1066 }
1067
1068
1069 lstObject *lstNewChar (int ch) {
1070   if (ch < 0 || ch > 255) return NULL;
1071   return lstCharClass->data[lstIVcharsInMetaChar]->data[ch];
1072 }