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 static inline int LST_IS_NEW (const lstObject *o) {
 245   return
 246     (const unsigned char *)o >= curSpace->start &&
 247     (const unsigned char *)o < curSpace->end;
 248 }
 249
 250
 251 /*
 252  * garbage collector
 253  * this is a classic Cheney two-finger collector
 254  */
 255
 256 /* curSpace and curSpaceNo should be set to the new space */
 257 /* copy object to the new space, return new address */
 258 static lstObject *gcMoveObject (lstObject *o) {
 259   lstObject *res;
 260   unsigned char *next;
 261   int size;
 262   if (!o || LST_IS_SMALLINT(o)) return o; /* use as-is */
 263   if (LST_IS_MOVED(o)) return o->stclass; /* already relocated */
 264   if (LST_IS_STATIC(o)) return o; /* static object, use as-is */
 265   if (LST_IS_NEW(o)) {
 266     /*fprintf(stderr, "DOUBLE MOVING!\n");*/
 267     /* *((char *)0) = 0; */
 268     return o;
 269   }
 270   if (o->fin) {
 271     /* move to 'alive with finalizers' list */
 272     if (LST_IS_STFIN(o)) {
 273       dprintf("STFIN!\n");
 274       lstRemoveFromFList(&stFinListHead, o->fin);
 275       lstAddToFList(&stAliveFinListHead, o->fin);
 276     } else if (LST_IS_WEAK(o)) {
 277       dprintf("STWEAK!\n");
 278       lstRemoveFromFList(&stWeakListHead, o->fin);
 279       lstAddToFList(&stAliveWeakListHead, o->fin);
 280     } else {
 281       /*dprintf("CFIN!\n");*/
 282       lstRemoveFromFList(&finListHead, o->fin);
 283       lstAddToFList(&aliveFinListHead, o->fin);
 284     }
 285   }
 286   /* copy object to another space and setup redirection pointer */
 287   size = LST_SIZE(o);
 288   res = (lstObject *)curSpace->cur;
 289   memcpy(res, o, sizeof(lstObject));
 290   if (o->fin) o->fin->obj = res; /* fix finowner */
 291   /* setup redirection pointer */
 292   LST_MARK_MOVED(o);
 293   o->stclass = res;
 294   next = curSpace->cur+sizeof(lstObject);
 295   if (!LST_IS_BYTES(o)) size *= LST_BYTES_PER_WORD; else ++size; /* byte objects are always has 0 as the last item */
 296   if (size > 0) memcpy(&res->data, &o->data, size);
 297   next += size;
 298   curSpace->cur = lstAlignAddr(next);
 299   return res;
 300 }
 301
 302
 303 /* return Process object */
 304 static lstObject *lstCreateMethodCall (lstObject *obj, const char *mname) {
 305   lstObject *method = lstFindMethod(obj->stclass, mname);
 306   if (!method) lstFatal("no #finalize or #mourn method found for object", 0x29a);
 307   lstObject *process = lstAllocInstance(lstProcessSize, lstProcessClass);
 308   lstObject *context = lstAllocInstance(lstContextSize, lstContextClass);
 309   process->data[lstIVcontextInProcess] = context;
 310   process->data[lstIVrunningInProcess] = lstTrueObj;
 311   /***/
 312   context->data[lstIVmethodInContext] = method;
 313   /* build arguments array */
 314   lstObject *args = lstAllocInstance(1, lstArrayClass);
 315   args->data[0] = obj; /* self */
 316   context->data[lstIVargumentsInContext] = args;
 317   context->data[lstIVtemporariesInContext] = lstAllocInstance(lstIntValue(method->data[lstIVtemporarySizeInMethod]), lstArrayClass);
 318   context->data[lstIVstackInContext] = lstAllocInstance(lstIntValue(method->data[lstIVstackSizeInMethod]), lstArrayClass);
 319   context->data[lstIVbytePointerInContext] = lstNewInt(0);
 320   context->data[lstIVstackTopInContext] = lstNewInt(0);
 321   context->data[lstIVpreviousContextInContext] = lstNilObj;
 322   context->data[lstIVprocOwnerInContext] = process;
 323   return process;
 324 }
 325
 326
 327 /*
 328 static int lstIsKindOfForGC (const lstObject *obj, const lstObject *aclass) {
 329   const lstObject *pclass = obj;
 330   int stC = 0;
 331   if (!obj || !aclass) return 0;
 332   if (obj == aclass) return 1;
 333   if (LST_IS_SMALLINT(obj)) {
 334     if (LST_IS_SMALLINT(aclass)) return 1;
 335     obj = lstSmallIntClass;
 336   } else {
 337     if (LST_IS_SMALLINT(aclass)) aclass = lstSmallIntClass;
 338     if (!LST_IS_SMALLINT(obj)
 339     obj = obj->stclass;
 340   }
 341   while (obj && obj != lstNilObj) {
 342     if (obj == aclass) return 1;
 343     obj = obj->data[lstIVparentClassInClass];
 344     if (stC) { if (pclass && pclass != lstNilObj) pclass = pclass->data[lstIVparentClassInClass]; }
 345     else if (pclass == obj) return 0;
 346     stC ^= 1;
 347   }
 348   return 0;
 349 }
 350 */
 351
 352
 353 /* res>0: at least one object is dead */
 354 static int processWeakData (lstObject *o) {
 355   int hitCount = 0;
 356   int size = LST_SIZE(o);
 357   while (--size >= 0) {
 358     lstObject *d = o->data[size];
 359     if (LST_IS_SMALLINT(d) || LST_IS_STATIC(d)) continue; /* nothing to fix */
 360     if (LST_IS_MOVED(d)) {
 361       /* object is alive */
 362       o->data[size] = d->stclass;
 363     } else {
 364       /* do not throw out numbers */
 365       /*FIXME: we can have infinite loop here */
 366       lstObject *cls = d->stclass;
 367       while (cls && cls != lstNilObj) {
 368         while (LST_IS_MOVED(cls)) cls = cls->stclass;
 369         if (cls == lstNumberClass) {
 370           /* save the number */
 371           o->data[size] = gcMoveObject(d);
 372           continue;
 373         }
 374         cls = cls->data[lstIVparentClassInClass];
 375       }
 376       /* object is dead; add #mourn call for it and replace link to nil */
 377       dprintf("found someone to mourn\n");
 378       ++hitCount;
 379       gcMoveObject(d);
 380       o->data[size] = lstNilObj;
 381     }
 382   }
 383   return hitCount;
 384 }
 385
 386
 387 #ifdef GC_TIMINGS
 388 # ifndef LST_ON_WINDOWS
 389 #  include <signal.h>
 390 #  include <time.h>
 391 # else
 392 #  include <windows.h>
 393 # endif
 394 static uint64_t getTicksMS (void) {
 395 #ifndef _WIN32
 396   uint64_t res;
 397   struct timespec ts;
 398   clock_gettime(CLOCK_MONOTONIC, &ts);
 399   res = ((uint64_t)ts.tv_sec)*100000UL;
 400   res += ((uint64_t)ts.tv_nsec)/10000UL; //1000000000
 401   return res;
 402 #else
 403   return GetTickCount()*100;
 404 #endif
 405 }
 406 #endif
 407
 408
 409 #define GC_KEEP_METHOD_CACHE
 410
 411 /* garbage collection entry point */
 412 void lstGC (void) {
 413   LstFinLink *weakAlive = NULL;
 414   int f;
 415 #ifdef GC_TIMINGS
 416   uint64_t gcTime = getTicksMS();
 417 #endif
 418 #ifdef DEBUG
 419   int saved = 0;
 420 #endif
 421   if (curSpace->cur == curSpace->start) return; /* nothing to do */
 422   if (lstGCSpecialLock) lstFatal("out of memory for finalizer groups", lstGCSpecialLock);
 423   lstGCCount++;
 424   objToFinUsed = 0;
 425   aliveFinListHead = stAliveFinListHead = stAliveWeakListHead = NULL;
 426   /* first change spaces */
 427   unsigned char *scanPtr;
 428   curSpaceNo ^= 1;
 429   curSpace = &memSpaces[curSpaceNo];
 430   curSpace->cur = curSpace->start;
 431
 432   /* move all roots */
 433   lstNilObj = gcMoveObject(lstNilObj);
 434   lstTrueObj = gcMoveObject(lstTrueObj);
 435   lstFalseObj = gcMoveObject(lstFalseObj);
 436   lstBadMethodSym = gcMoveObject(lstBadMethodSym);
 437   for (f = 0; f < LST_MAX_BIN_MSG; ++f) lstBinMsgs[f] = gcMoveObject(lstBinMsgs[f]);
 438   lstGlobalObj = gcMoveObject(lstGlobalObj);
 439
 440   for (f = 0; f < lstRootTop; ++f) lstRootStack[f] = gcMoveObject(lstRootStack[f]);
 441   for (f = 0; f < staticRootTop; ++f) (*staticRoots[f]) = gcMoveObject(*staticRoots[f]);
 442   for (f = 0; f < lstTempSP; ++f) (*lstTempStack[f]) = gcMoveObject(*lstTempStack[f]);
 443   /* the following are mostly static, but who knows... */
 444   for (f = 0; clInfo[f].name; ++f) (*(clInfo[f].eptr)) = gcMoveObject(*(clInfo[f].eptr));
 445   for (f = 0; epInfo[f].name; ++f) (*(epInfo[f].eptr)) = gcMoveObject(*(epInfo[f].eptr));
 446
 447   /* mark process groups */
 448   {
 449     LstRunGroup *grp;
 450     for (grp = runGroups; grp; grp = grp->next) {
 451       LstRunContext *ctx;
 452       for (ctx = grp->group; ctx; ctx = ctx->prev) ctx->process = gcMoveObject(ctx->process);
 453     }
 454   }
 455 #ifdef GC_KEEP_METHOD_CACHE
 456   /* fix method cache; this have some sense, as many method calls are stdlib calls */
 457   /* when we'll do generational GC, this will have even better impact on cache hits */
 458   /* note that this is completely safe: SendMessage will do the necessary checks */
 459   for (f = 0; f < MTD_CACHE_SIZE+MTD_CACHE_EXTRA; ++f) {
 460     if (cache[f].name) {
 461       /* fix method */
 462       cache[f].name = gcMoveObject(cache[f].name);
 463       cache[f].stclass = gcMoveObject(cache[f].stclass);
 464       cache[f].method = gcMoveObject(cache[f].method);
 465       if (cache[f].analyzed == 1 && cache[f].ivarNum < 0) cache[f].mConst = gcMoveObject(cache[f].mConst);
 466       cache[f].badHits = MTD_BAD_HIT_MAX-2;
 467     }
 468   }
 469 #endif
 470 #ifdef INLINE_SOME_METHODS
 471   lstMetaCharClass = gcMoveObject(lstMetaCharClass);
 472   for (f = 0; lstInlineMethodList[f].name; ++f) {
 473     //if (!LST_IS_NEW(*lstInlineMethodList[f].mtclass)) abort();
 474     //(*lstInlineMethodList[f].mtclass) = gcMoveObject(*lstInlineMethodList[f].mtclass);
 475     (*lstInlineMethodList[f].method) = gcMoveObject(*lstInlineMethodList[f].method);
 476   }
 477 #endif
 478
 479   /* now walk thru the objects, fix pointers, move other objects, etc.
 480    * note that curSpace->cur will grow in the process */
 481   scanPtr = curSpace->start;
 482 scanAgain:
 483   while (scanPtr < curSpace->cur) {
 484     lstObject *o = (lstObject *)scanPtr;
 485     scanPtr += sizeof(lstObject);
 486     /* fix class */
 487     o->stclass = gcMoveObject(o->stclass);
 488     int size = LST_SIZE(o);
 489     if (LST_IS_BYTES(o)) {
 490       /* nothing to scan here */
 491       scanPtr += size+1; /* skip zero byte too */
 492     } else {
 493       /* process object data, if this is not weak object */
 494       scanPtr += size*LST_BYTES_PER_WORD;
 495       if (!LST_IS_WEAK(o)) while (--size >= 0) o->data[size] = gcMoveObject(o->data[size]);
 496     }
 497     scanPtr = lstAlignAddr(scanPtr);
 498 #ifdef DEBUG
 499     ++saved;
 500 #endif
 501   }
 502   /* process weak objects */
 503   int wasWLHit = 0;
 504   /* alive weak objects */
 505   /* save 'em to another accumulation list */
 506   if (stAliveWeakListHead) {
 507     lstAddToFList(&weakAlive, stAliveWeakListHead);
 508     while (stAliveWeakListHead) {
 509       lstObject *o = stAliveWeakListHead->obj;
 510       assert(o->fin == stAliveWeakListHead);
 511       stAliveWeakListHead = stAliveWeakListHead->next;
 512       if (processWeakData(o)) {
 513         ++wasWLHit;
 514         addToFin(o, "mourn");
 515       }
 516     }
 517   }
 518   if (wasWLHit) goto scanAgain;
 519   /* process ST finalizers, if any */
 520   if (stFinListHead) {
 521     dprintf("FOUND SOME ST-FINALIZERS!\n");
 522     while (stFinListHead) {
 523       lstObject *o = stFinListHead->obj;
 524       assert(o->fin == stFinListHead);
 525       LstFinLink *n = stFinListHead->next;
 526       free(stFinListHead);
 527       stFinListHead = n;
 528       /* now remove the flag and create new process group */
 529       LST_RESET_STFIN(o);
 530       o->fin = NULL; /* it is already freed */
 531       o = gcMoveObject(o);
 532       dprintf("FINOBJ: %p\n", o);
 533       addToFin(o, "finalize");
 534     }
 535     /* scan new space to save ST-F anchors; no need to rescan process groups though */
 536     goto scanAgain;
 537   }
 538   stFinListHead = stAliveFinListHead;
 539   /* dead weak objects */
 540   while (stWeakListHead) {
 541 #ifndef NDEBUG
 542     lstObject *o = stWeakListHead->obj;
 543     assert(o->fin == stWeakListHead);
 544 #endif
 545     LstFinLink *n = stWeakListHead->next;
 546     free(stWeakListHead);
 547     stWeakListHead = n;
 548   }
 549   stWeakListHead = weakAlive;
 550   /* here we can process C finalizers, if any */
 551   while (finListHead) {
 552     LstFinLink *n = finListHead->next;
 553     if (finListHead->fin) finListHead->fin(finListHead->obj, finListHead->udata);
 554     free(finListHead);
 555     finListHead = n;
 556   }
 557   finListHead = aliveFinListHead; /* 'alive' list becomes the current one */
 558   /* now check if we have something to mourn/finalize */
 559   ++lstGCSpecialLock;
 560   for (f = 0; f < objToFinUsed; ++f) {
 561     dprintf("FOUND some finalizing obj(%p) method(#%s)\n", objToFin[f].obj, objToFin[f].mname);
 562     lstCreateFinalizePGroup(lstCreateMethodCall(objToFin[f].obj, objToFin[f].mname));
 563 #ifdef DEBUG
 564     /*lstDebugFlag = 1;*/
 565 #endif
 566   }
 567   --lstGCSpecialLock;
 568   /* invalidate method cache */
 569 #ifndef GC_KEEP_METHOD_CACHE
 570   lstFlushMethodCache();
 571 #endif
 572 /*
 573 #ifdef DEBUG
 574  dprintf("GC: %d objects alive; %u bytes used\n", saved, (uintptr_t)curSpace->cur-(uintptr_t)curSpace->start);
 575 #endif
 576 */
 577 #ifdef GC_TIMINGS
 578   gcTime = getTicksMS()-gcTime;
 579   fprintf(stderr, "GC TIME: %u\n", (uint32_t)gcTime);
 580 #endif
 581 }
 582
 583
 584 typedef struct {
 585   char clname[258];
 586   char mtname[258];
 587   int callCount;
 588 } LstCallInfo;
 589
 590 static LstCallInfo *cinfo = NULL;
 591 static int cinfoUsed = 0;
 592
 593 static void lstProcessSpace (int num) {
 594   LstMemSpace *curSpace = &memSpaces[num];
 595   unsigned char *scanPtr = curSpace->start;
 596   while (scanPtr < curSpace->cur) {
 597     lstObject *o = (lstObject *)scanPtr;
 598     if (LST_CLASS(o) == lstMethodClass) {
 599       lstObject *op = o->data[lstIVinvokeCountInMethod];
 600       int cc = lstIntValue(op);
 601       if (cc > 0) {
 602         cinfo = realloc(cinfo, sizeof(LstCallInfo)*(cinfoUsed+1));
 603         lstGetString(cinfo[cinfoUsed].mtname, sizeof(cinfo[cinfoUsed].mtname), o->data[lstIVnameInMethod]);
 604         op = o->data[lstIVclassInMethod];
 605         lstGetString(cinfo[cinfoUsed].clname, sizeof(cinfo[cinfoUsed].clname), op->data[lstIVnameInClass]);
 606         cinfo[cinfoUsed].callCount = cc;
 607         ++cinfoUsed;
 608       }
 609     }
 610     scanPtr += sizeof(lstObject);
 611     int size = LST_SIZE(o);
 612     if (LST_IS_BYTES(o)) {
 613       scanPtr += size+1;
 614     } else {
 615       scanPtr += size*LST_BYTES_PER_WORD;
 616     }
 617     scanPtr = lstAlignAddr(scanPtr);
 618   }
 619 }
 620
 621
 622 void lstShowCalledMethods (void) {
 623   int f;
 624   int xcmp (const void *i0, const void *i1) {
 625     const LstCallInfo *l0 = (const LstCallInfo *)i0;
 626     const LstCallInfo *l1 = (const LstCallInfo *)i1;
 627     return l1->callCount-l0->callCount;
 628   }
 629   lstGC(); /* compact objects */
 630   lstProcessSpace(2); /* static */
 631   lstProcessSpace(curSpaceNo); /* dynamic */
 632   if (cinfoUsed > 0) {
 633     qsort(cinfo, cinfoUsed, sizeof(LstCallInfo), xcmp);
 634     for (f = 0; f < cinfoUsed; ++f) {
 635       fprintf(stderr, "[%s>>%s]: %d\n", cinfo[f].clname, cinfo[f].mtname, cinfo[f].callCount);
 636     }
 637     free(cinfo);
 638     cinfo = NULL;
 639     cinfoUsed = 0;
 640   }
 641 }
 642
 643
 644 #define STATIC_ALLOC \
 645   lstObject *res = (lstObject *)memSpaces[STATIC_SPACE].cur; \
 646   unsigned char *next = memSpaces[STATIC_SPACE].cur; \
 647   next += realSz; \
 648   next = lstAlignAddr(next); \
 649   if (next > memSpaces[STATIC_SPACE].end) lstFatal("insufficient static memory", sz); \
 650   memSpaces[STATIC_SPACE].cur = next; \
 651   LST_SETSIZE(res, sz); \
 652   res->fin = 0; \
 653   res->objFlags = 0;
 654
 655 /*
 656  * static allocation -- tries to allocate values in an area
 657  * that will not be subject to garbage collection
 658 */
 659 lstByteObject *lstStaticAllocBin (int sz) {
 660   int realSz = sz+sizeof(lstObject)+1;
 661   STATIC_ALLOC
 662   LST_SETBIN(res);
 663   lstBytePtr(res)[sz] = '\0';
 664   return (lstByteObject *)res;
 665 }
 666
 667
 668 lstObject *lstStaticAlloc (int sz) {
 669   int realSz = sz*LST_BYTES_PER_WORD+sizeof(lstObject);
 670   STATIC_ALLOC
 671   return res;
 672 }
 673
 674
 675 #define DYNAMIC_ALLOC \
 676   lstObject *res = (lstObject *)curSpace->cur; \
 677   unsigned char *next = curSpace->cur; \
 678   next += realSz; \
 679   next = lstAlignAddr(next); \
 680   if (next > curSpace->end) { \
 681     lstGC(); \
 682     res = (lstObject *)curSpace->cur; \
 683     next = curSpace->cur; \
 684     next += realSz; \
 685     next = lstAlignAddr(next); \
 686     if (next > curSpace->end) lstFatal("insufficient memory", sz); \
 687   } \
 688   curSpace->cur = next; \
 689   LST_SETSIZE(res, sz); \
 690   res->fin = 0; \
 691   res->objFlags = 0;
 692
 693
 694 lstByteObject *lstMemAllocBin (int sz) {
 695   int realSz = sz+sizeof(lstObject)+1;
 696   DYNAMIC_ALLOC
 697   LST_SETBIN(res);
 698   lstBytePtr(res)[sz] = '\0';
 699   return (lstByteObject *)res;
 700 }
 701
 702
 703 lstObject *lstMemAlloc (int sz) {
 704   int realSz = sz*LST_BYTES_PER_WORD+sizeof(lstObject);
 705   DYNAMIC_ALLOC
 706   return res;
 707 }
 708
 709
 710 #include "lst_imagerw.c"
 711
 712
 713 /*
 714  * Add another object root off a static object
 715  *
 716  * Static objects, in general, do not get garbage collected.
 717  * When a static object is discovered adding a reference to a
 718  * non-static object, we link on the reference to our staticRoot
 719  * table so we can give it proper treatment during garbage collection.
 720  */
 721 void lstAddStaticRoot (lstObject **objp) {
 722   int f, rfree = -1;
 723   for (f = 0; f < staticRootTop; ++f) {
 724     if (objp == staticRoots[f]) return;
 725     if (rfree < 0 && !staticRoots[f]) rfree = f;
 726   }
 727   if (rfree < 0) {
 728     if (staticRootTop >= STATICROOTLIMIT) lstFatal("lstAddStaticRoot: too many static references", (intptr_t)objp);
 729     rfree = staticRootTop++;
 730   }
 731   staticRoots[rfree] = objp;
 732 }
 733
 734
 735 void lstWriteBarrier (lstObject **dest, lstObject *src) {
 736   if (LST_IS_STATIC(dest) && !LST_IS_SMALLINT(src) && !LST_IS_STATIC(src)) {
 737     int f, rfree = -1;
 738     for (f = 0; f < staticRootTop; ++f) {
 739       if (staticRoots[f] == dest) goto doit; /* let TEH GOTO be here! */
 740       if (rfree < 0 && !staticRoots[f]) rfree = f;
 741     }
 742     if (rfree < 0) {
 743       if (staticRootTop >= STATICROOTLIMIT) lstFatal("lstWriteBarrier: too many static references", (intptr_t)dest);
 744       rfree = staticRootTop++;
 745     }
 746     staticRoots[rfree] = dest;
 747   }
 748 doit:
 749   *dest = src;
 750 }
 751
 752
 753 /* fix an OOP if needed, based on values to be exchanged */
 754 static void map (lstObject **oop, lstObject *a1, lstObject *a2, int size) {
 755   int x;
 756   lstObject *oo = *oop;
 757   for (x = 0; x < size; ++x) {
 758     if (a1->data[x] == oo) {
 759       *oop = a2->data[x];
 760       return;
 761     }
 762     if (a2->data[x] == oo) {
 763       *oop = a1->data[x];
 764       return;
 765     }
 766   }
 767 }
 768
 769
 770 /* traverse an object space */
 771 static void walk (lstObject *base, lstObject *top, lstObject *array1, lstObject *array2, LstUInt size) {
 772   lstObject *op, *opnext;
 773   LstUInt x, sz;
 774   for (op = base; op < top; op = opnext) {
 775     /* re-map the class pointer, in case that's the object which has been remapped */
 776     map(&op->stclass, array1, array2, size);
 777     /* skip our argument arrays, since otherwise things get rather circular */
 778     sz = LST_SIZE(op);
 779     if (op == array1 || op == array2) {
 780       unsigned char *t = (unsigned char *)op;
 781       t += sz*LST_BYTES_PER_WORD+sizeof(lstObject);
 782       opnext = lstAlignAddr(t);
 783       continue;
 784     }
 785     /* don't have to worry about instance variables if it's a binary format */
 786     if (LST_IS_BYTES(op)) {
 787       LstUInt realSize = sz+sizeof(lstObject)+1;
 788       unsigned char *t = (unsigned char *)op;
 789       t += realSize;
 790       opnext = lstAlignAddr(t);
 791       continue;
 792     }
 793     /* for each instance variable slot, fix up the pointer if needed */
 794     for (x = 0; x < sz; ++x) map(&op->data[x], array1, array2, size);
 795     /* walk past this object */
 796     {
 797       LstUInt realSize = sz*LST_BYTES_PER_WORD+sizeof(lstObject);
 798       unsigned char *t = (unsigned char *)op;
 799       t += realSize;
 800       opnext = lstAlignAddr(t);
 801     }
 802   }
 803 }
 804
 805
 806 /*
 807  * Bulk exchange of object identities
 808  *
 809  * For each index to array1/array2, all references in current object
 810  * memory are modified so that references to the object in array1[]
 811  * become references to the corresponding object in array2[].  References
 812  * to the object in array2[] similarly become references to the
 813  * object in array1[].
 814  */
 815 void lstSwapObjects (lstObject *array1, lstObject *array2, LstUInt size) {
 816   LstUInt x;
 817   /* Convert our memory spaces */
 818   walk((lstObject *)curSpace->start, (lstObject *)curSpace->cur, array1, array2, size);
 819   walk((lstObject *)memSpaces[STATIC_SPACE].start, (lstObject *)memSpaces[STATIC_SPACE].cur, array1, array2, size);
 820   /* Fix up the root pointers, too */
 821   for (x = 0; x < lstRootTop; x++) map(&lstRootStack[x], array1, array2, size);
 822   for (x = 0; x < staticRootTop; x++) map(staticRoots[x], array1, array2, size);
 823 }
 824
 825
 826 /*
 827  * Implement replaceFrom:to:with:startingAt: as a primitive
 828  *
 829  * Return 1 if we couldn't do it, 0 on success.
 830  * This routine has distinct code paths for plain old byte type arrays,
 831  * and for arrays of lstObject pointers; the latter must handle the
 832  * special case of static pointers. It looks hairy (and it is), but
 833  * it's still much faster than executing the block move in Smalltalk
 834  * VM opcodes.
 835  */
 836 int lstBulkReplace (lstObject *dest, lstObject *aFrom, lstObject *aTo, lstObject *aWith, lstObject *startAt) {
 837   LstUInt irepStart, istart, istop, count;
 838   /* we only handle simple 31-bit integer indices; map the values onto 0-based C array type values */
 839   if (!LST_IS_SMALLINT(startAt) || !LST_IS_SMALLINT(aFrom) || !LST_IS_SMALLINT(aTo)) return 1;
 840   if (LST_IS_SMALLINT(dest) || LST_IS_SMALLINT(aWith)) return 1;
 841   irepStart = lstIntValue(startAt)-1;
 842   istart = lstIntValue(aFrom)-1;
 843   istop = lstIntValue(aTo)-1;
 844   count = (istop-istart)+1;
 845   /* defend against goofy negative indices */
 846   if (count <= 0) return 0;
 847   if (irepStart < 0 || istart < 0 || istop < 0) return 1;
 848   /* range check */
 849   if (LST_SIZE(dest) < istop || LST_SIZE(aWith) < irepStart+count) return 1;
 850   /* if both source and dest are binary, just copy some bytes */
 851   if (LST_IS_BYTES(aWith) && LST_IS_BYTES(dest)) {
 852     memmove(lstBytePtr(dest)+istart, lstBytePtr(aWith)+irepStart, count);
 853     return 0;
 854   }
 855   /* fail if only one of objects is binary */
 856   if (LST_IS_BYTES(aWith) || LST_IS_BYTES(dest)) return 1;
 857   /* if we're fiddling pointers between static and dynamic memory, register roots */
 858   /* note that moving from static to dynamic is ok, but the reverse needs some housekeeping */
 859   if (LST_IS_STATIC(dest) && !LST_IS_STATIC(aWith)) {
 860     LstUInt f;
 861     /*fprintf(stderr, "!!!: count=%u\n", count);*/
 862     for (f = 0; f < count; ++f) lstAddStaticRoot(&dest->data[istart+f]);
 863   }
 864   /* copy object pointer fields */
 865   memmove(&dest->data[istart], &aWith->data[irepStart], LST_BYTES_PER_WORD*count);
 866   return 0;
 867 }
 868
 869
 870 lstObject *lstNewString (const char *str) {
 871   int l = str ? strlen(str) : 0;
 872   lstByteObject *strobj = lstMemAllocBin(l);
 873   strobj->stclass = lstStringClass;
 874   if (l > 0) memcpy(lstBytePtr(strobj), str, l);
 875   lstBytePtr(strobj)[l] = '\0';
 876   return (lstObject *)strobj;
 877 }
 878
 879
 880 int lstGetString (char *buf, int bufsize, const lstObject *str) {
 881   int fsize = LST_SIZE(str), csz = fsize;
 882   if (csz > bufsize-1) csz = bufsize-1;
 883   if (buf && csz > 0) memcpy(buf, &str->data, csz);
 884   if (csz >= 0) buf[csz] = '\0'; /* put null terminator at end */
 885   if (fsize > bufsize-1) return fsize+1;
 886   return 0; /* ok */
 887 }
 888
 889
 890 char *lstGetStringPtr (const lstObject *str) {
 891   return (char *)(lstBytePtr(str));
 892 }
 893
 894
 895 lstObject *lstNewBinary (const void *p, LstUInt l) {
 896   lstByteObject *bobj = lstMemAllocBin(l);
 897   bobj->stclass = lstByteArrayClass;
 898   if (l > 0) {
 899     if (p) memcpy(lstBytePtr(bobj), p, l); else memset(lstBytePtr(bobj), 0, l);
 900   }
 901   return (lstObject *)bobj;
 902 }
 903
 904
 905 lstObject *lstNewBCode (const void *p, LstUInt l) {
 906   lstByteObject *bobj = lstMemAllocBin(l);
 907   bobj->stclass = lstByteCodeClass;
 908   if (l > 0) {
 909     if (p) memcpy(lstBytePtr(bobj), p, l); else memset(lstBytePtr(bobj), 0, l);
 910   }
 911   return (lstObject *)bobj;
 912 }
 913
 914
 915 lstObject *lstAllocInstance (int size, lstObject *cl) {
 916   int f;
 917   if (size < 0) return NULL;
 918   lstRootStack[lstRootTop++] = cl;
 919   lstObject *obj = lstMemAlloc(size);
 920   obj->stclass = lstRootStack[--lstRootTop];
 921   for (f = 0; f < size; ++f) obj->data[f] = lstNilObj;
 922   return obj;
 923 }
 924
 925
 926 /* create new Integer (64-bit) */
 927 lstObject *lstNewLongInt (LstLInt val) {
 928   lstByteObject *res = lstMemAllocBin(sizeof(LstLInt));
 929   res->stclass = lstIntegerClass;
 930   memcpy(lstBytePtr(res), &val, sizeof(val));
 931   return (lstObject *)res;
 932 }
 933
 934
 935 lstObject *lstNewFloat (LstFloat val) {
 936   lstByteObject *res = lstMemAllocBin(sizeof(LstFloat));
 937   res->stclass = lstFloatClass;
 938   memcpy(lstBytePtr(res), &val, sizeof(val));
 939   return (lstObject *)res;
 940 }
 941
 942
 943 lstObject *lstNewArray (int size) {
 944   if (size < 0) return NULL;
 945   return lstAllocInstance(size, lstArrayClass);
 946 }
 947
 948
 949 static int symbolBareCmp (const char *left, int leftsize, const char *right, int rightsize) {
 950   int minsize = leftsize;
 951   int i;
 952   if (rightsize < minsize) minsize = rightsize;
 953   if (minsize > 0) {
 954     if ((i = memcmp(left, right, minsize))) return i;
 955   }
 956   return leftsize-rightsize;
 957 }
 958
 959
 960 /*
 961 static int symbolCmp (const lstObject *s0, const lstObject *s1) {
 962   return symbolBareCmp((const char *)lstBytePtr(s0), LST_SIZE(s0), (const char *)lstBytePtr(s1), LST_SIZE(s1));
 963 }
 964 */
 965
 966
 967 lstObject *lstDictFind (const lstObject *dict, const char *name) {
 968   /* binary search */
 969   const lstObject *keys = dict->data[0];
 970   int l = 0, h = LST_SIZE(keys)-1, nlen = strlen(name);
 971   while (l <= h) {
 972     int mid = (l+h)/2;
 973     const lstObject *key = keys->data[mid];
 974     int res = symbolBareCmp(name, nlen, (char *)lstBytePtr(key), LST_SIZE(key));
 975     if (res == 0) return dict->data[1]->data[mid];
 976     if (res < 0) h = mid-1; else l = mid+1;
 977   }
 978   return NULL;
 979 }
 980
 981
 982 int lstIsKindOf (const lstObject *obj, const lstObject *aclass) {
 983   const lstObject *pclass = obj;
 984   int stC = 0;
 985   if (!obj || !aclass) return 0;
 986   if (obj == aclass) return 1;
 987   if (LST_IS_SMALLINT(obj)) {
 988     if (LST_IS_SMALLINT(aclass)) return 1;
 989     obj = lstSmallIntClass;
 990   } else {
 991     if (LST_IS_SMALLINT(aclass)) aclass = lstSmallIntClass;
 992     obj = obj->stclass;
 993   }
 994   while (obj && obj != lstNilObj) {
 995     /*printf(" : [%s]\n", lstBytePtr(obj->data[lstIVnameInClass]));*/
 996     if (obj == aclass) return 1;
 997     obj = obj->data[lstIVparentClassInClass];
 998     if (stC) { if (pclass && pclass != lstNilObj) pclass = pclass->data[lstIVparentClassInClass]; }
 999     else if (pclass == obj) return 0; /* avoid cycles */
1000     stC ^= 1;
1001   }
1002   return 0;
1003 }
1004
1005
1006 lstObject *lstFindGlobal (const char *name) {
1007   if (!name || !name[0]) return NULL;
1008   return lstDictFind(lstGlobalObj, name);
1009 }
1010
1011
1012 lstObject *lstFindMethod (lstObject *stclass, const char *method) {
1013   lstObject *dict, *res;
1014   /* scan upward through the class hierarchy */
1015   for (; stclass && stclass != lstNilObj; stclass = stclass->data[lstIVparentClassInClass]) {
1016     /* consider the Dictionary of methods for this Class */
1017 #if 0 & defined(DEBUG)
1018     {
1019       fprintf(stderr, "st=%p; u=%p; sz=%d\n", stclass, lstNilObj, LST_SIZE(stclass));
1020       fprintf(stderr, "  [%s]\n", lstGetStringPtr(stclass->data[lstIVnameInClass]));
1021     }
1022 #endif
1023 #ifdef DEBUG
1024     if (LST_IS_SMALLINT(stclass)) lstFatal("lookupMethod: looking in SmallInt instance", 0);
1025     if (LST_IS_BYTES(stclass)) lstFatal("lookupMethod: looking in binary object", 0);
1026     if (LST_SIZE(stclass) < lstClassSize) lstFatal("lookupMethod: looking in non-class object", 0);
1027 #endif
1028     dict = stclass->data[lstIVmethodsInClass];
1029 #ifdef DEBUG
1030     if (!dict) lstFatal("lookupMethod: NULL dictionary", 0);
1031     if (LST_IS_SMALLINT(dict)) lstFatal("lookupMethod: SmallInt dictionary", 0);
1032     if (dict->stclass != lstFindGlobal("Dictionary")) lstFatal("lookupMethod: method list is not a dictionary", 0);
1033 #endif
1034     res = lstDictFind(dict, method);
1035     if (res) return res;
1036   }
1037   return NULL;
1038 }
1039
1040
1041 lstObject *lstNewSymbol (const char *name) {
1042   lstObject *res = NULL;
1043   if (!name || !name[0]) return NULL;
1044   lstObject *str = lstNewString(name);
1045   if (lstRunMethodWithArg(lstNewSymMethod, NULL, str, &res, 1) != lstReturnReturned) return NULL;
1046   if (!res || res->stclass != lstSymbolClass) return NULL;
1047   return res;
1048 }
1049
1050
1051 int lstSetGlobal (const char *name, lstObject *val) {
1052   if (!name || !name[0]) return -2;
1053   lstRootStack[lstRootTop++] = val;
1054   lstObject *aa = lstNewArray(2);
1055   lstRootStack[lstRootTop++] = aa;
1056   lstRootStack[lstRootTop-1]->data[0] = lstNewString(name);
1057   lstRootStack[lstRootTop-1]->data[1] = lstRootStack[lstRootTop-2];
1058   aa = lstRootStack[--lstRootTop];
1059   --lstRootTop;
1060   if (lstRunMethodWithArg(lstSetGlobMethod, NULL, aa, NULL, 1) != lstReturnReturned) return -1;
1061   return 0;
1062 }
1063
1064
1065 void lstSetFinalizer (lstObject *o, LstFinalizerFn fn, void *udata) {
1066   if (LST_IS_SMALLINT(o) || LST_IS_STATIC(o)) return; /* note that static objects can't have finalizer */
1067   if (o->fin) {
1068     lstRemoveFromFList(&finListHead, o->fin);
1069   } else {
1070     o->fin = malloc(sizeof(LstFinLink));
1071   }
1072   o->fin->fin = fn;
1073   o->fin->udata = udata;
1074   o->fin->obj = o;
1075   lstAddToFList(&finListHead, o->fin);
1076 }
1077
1078
1079 void *lstGetUData (lstObject *o) {
1080   if (LST_IS_SMALLINT(o) || !o->fin) return NULL;
1081   return o->fin->udata;
1082 }
1083
1084
1085 lstObject *lstNewChar (int ch) {
1086   if (ch < 0 || ch > 255) return NULL;
1087   return lstCharClass->data[lstIVcharsInMetaChar]->data[ch];
1088 }