2 * The memory management and garbage collection module
4 * ---------------------------------------------------------------
5 * Little Smalltalk, Version 5
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 // Invisible Vector
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:
24 * The above copyright notice and this permission notice shall be included in
25 * all copies or substantial portions of the Software.
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.
35 /* Uses baker two-space garbage collection algorithm */
36 #include "lst_dpname.c"
38 /*#define GC_TIMINGS*/
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))))
46 # define lstAlignAddr(n) ((void *)n)
49 static const char *imgSign
= LST_IMAGE_SIGNATURE
;
52 unsigned int lstGCCount
= 0;
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 */
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 */
67 static LstFinLink
*finListHead
= NULL
; /* list of objects with finalizers */
68 static LstFinLink
*aliveFinListHead
= NULL
; /* list of alive objects with finalizers */
70 static LstFinLink
*stFinListHead
= NULL
; /* list of all known st-finalizable objects */
71 static LstFinLink
*stAliveFinListHead
= NULL
; /* st-finalizable objects, alive */
73 static LstFinLink
*stWeakListHead
= NULL
; /* list of all known weak objects */
74 static LstFinLink
*stAliveWeakListHead
= NULL
; /* weak objects, alive */
76 static int lstGCSpecialLock
= 0;
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)
89 * roots for memory access
90 * used as bases for garbage collection algorithm
92 lstObject
*lstRootStack
[LST_ROOTSTACK_LIMIT
];
93 LstUInt lstRootTop
= 0;
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;
101 lstObject
**lstTempStack
[LST_TS_LIMIT
];
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)
110 static void allocMemSpace (LstMemSpace
*spc
, int size
) {
112 unsigned char *n
= realloc(spc
->start
, size
);
113 if (!n
) free(spc
->start
);
114 spc
->start
= n
? n
: malloc(size
);
116 spc
->start
= malloc(size
);
118 spc
->realStart
= spc
->start
;
119 spc
->start
= lstAlignAddr(spc
->start
);
120 spc
->end
= spc
->start
+size
;
121 spc
->cur
= spc
->start
;
129 static LstObjToFinInfo
*objToFin
= NULL
;
130 static int objToFinSize
= 0;
131 static int objToFinUsed
= 0;
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);
141 objToFinSize
= newSz
;
143 objToFin
[objToFinUsed
].obj
= obj
;
144 objToFin
[objToFinUsed
].mname
= mname
;
149 /* initialize the memory management system */
150 void lstMemoryInit (int staticsz
, int dynamicsz
) {
151 /* allocate the memory areas */
152 memset(memSpaces
, 0, sizeof(memSpaces
));
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);
160 lstExecUserBreak
= 0;
165 curSpace
= &memSpaces
[curSpaceNo
];
166 finListHead
= stFinListHead
= stWeakListHead
= NULL
;
169 lstGCSpecialLock
= 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();
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
);
187 /* free all st-finalizable objects */
188 while (stFinListHead
) {
189 LstFinLink
*n
= stFinListHead
->next
;
193 while (stWeakListHead
) {
194 LstFinLink
*n
= stWeakListHead
->next
;
195 free(stWeakListHead
);
198 /* free groups and other structures */
200 LstEventHandler
*n
= ehList
->next
;
205 LstRunGroup
*n
= runGroups
->next
;
206 LstRunContext
*ctx
= runGroups
->group
;
208 LstRunContext
*p
= ctx
->prev
;
216 LstRunContext
*p
= rsFree
->prev
;
220 if (objToFin
) free(objToFin
); objToFin
= NULL
;
225 free(memSpaces
[2].realStart
);
226 free(memSpaces
[1].realStart
);
227 free(memSpaces
[0].realStart
);
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
;
237 static inline void lstAddToFList (LstFinLink
**head
, LstFinLink
*item
) {
239 if ((item
->next
= *head
)) item
->next
->prev
= item
;
244 static inline int LST_IS_NEW (const lstObject
*o
) {
246 (const unsigned char *)o
>= curSpace
->start
&&
247 (const unsigned char *)o
< curSpace
->end
;
253 * this is a classic Cheney two-finger collector
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
) {
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 */
266 /*fprintf(stderr, "DOUBLE MOVING!\n");*/
267 /* *((char *)0) = 0; */
271 /* move to 'alive with finalizers' list */
272 if (LST_IS_STFIN(o
)) {
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
);
281 /*dprintf("CFIN!\n");*/
282 lstRemoveFromFList(&finListHead
, o
->fin
);
283 lstAddToFList(&aliveFinListHead
, o
->fin
);
286 /* copy object to another space and setup redirection pointer */
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 */
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
);
298 curSpace
->cur
= lstAlignAddr(next
);
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
;
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
;
328 static int lstIsKindOfForGC (const lstObject *obj, const lstObject *aclass) {
329 const lstObject *pclass = obj;
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;
337 if (LST_IS_SMALLINT(aclass)) aclass = lstSmallIntClass;
338 if (!LST_IS_SMALLINT(obj)
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;
353 /* res>0: at least one object is dead */
354 static int processWeakData (lstObject
*o
) {
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
;
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
);
374 cls
= cls
->data
[lstIVparentClassInClass
];
376 /* object is dead; add #mourn call for it and replace link to nil */
377 dprintf("found someone to mourn\n");
380 o
->data
[size
] = lstNilObj
;
388 # ifndef LST_ON_WINDOWS
392 # include <windows.h>
394 static uint64_t getTicksMS (void) {
398 clock_gettime(CLOCK_MONOTONIC
, &ts
);
399 res
= ((uint64_t)ts
.tv_sec
)*100000UL;
400 res
+= ((uint64_t)ts
.tv_nsec
)/10000UL; //1000000000
403 return GetTickCount()*100;
409 #define GC_KEEP_METHOD_CACHE
411 /* garbage collection entry point */
413 LstFinLink
*weakAlive
= NULL
;
416 uint64_t gcTime
= getTicksMS();
421 if (curSpace
->cur
== curSpace
->start
) return; /* nothing to do */
422 if (lstGCSpecialLock
) lstFatal("out of memory for finalizer groups", lstGCSpecialLock
);
425 aliveFinListHead
= stAliveFinListHead
= stAliveWeakListHead
= NULL
;
426 /* first change spaces */
427 unsigned char *scanPtr
;
429 curSpace
= &memSpaces
[curSpaceNo
];
430 curSpace
->cur
= curSpace
->start
;
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
);
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
));
447 /* mark process groups */
450 for (grp
= runGroups
; grp
; grp
= grp
->next
) {
452 for (ctx
= grp
->group
; ctx
; ctx
= ctx
->prev
) ctx
->process
= gcMoveObject(ctx
->process
);
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
) {
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;
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
);
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
;
483 while (scanPtr
< curSpace
->cur
) {
484 lstObject
*o
= (lstObject
*)scanPtr
;
485 scanPtr
+= sizeof(lstObject
);
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 */
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
]);
497 scanPtr
= lstAlignAddr(scanPtr
);
502 /* process weak objects */
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
)) {
514 addToFin(o
, "mourn");
518 if (wasWLHit
) goto scanAgain
;
519 /* process ST finalizers, if any */
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
;
528 /* now remove the flag and create new process group */
530 o
->fin
= NULL
; /* it is already freed */
532 dprintf("FINOBJ: %p\n", o
);
533 addToFin(o
, "finalize");
535 /* scan new space to save ST-F anchors; no need to rescan process groups though */
538 stFinListHead
= stAliveFinListHead
;
539 /* dead weak objects */
540 while (stWeakListHead
) {
542 lstObject
*o
= stWeakListHead
->obj
;
543 assert(o
->fin
== stWeakListHead
);
545 LstFinLink
*n
= stWeakListHead
->next
;
546 free(stWeakListHead
);
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
);
557 finListHead
= aliveFinListHead
; /* 'alive' list becomes the current one */
558 /* now check if we have something to mourn/finalize */
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
));
564 /*lstDebugFlag = 1;*/
568 /* invalidate method cache */
569 #ifndef GC_KEEP_METHOD_CACHE
570 lstFlushMethodCache();
574 dprintf("GC: %d objects alive; %u bytes used\n", saved, (uintptr_t)curSpace->cur-(uintptr_t)curSpace->start);
578 gcTime
= getTicksMS()-gcTime
;
579 fprintf(stderr
, "GC TIME: %u\n", (uint32_t)gcTime
);
590 static LstCallInfo
*cinfo
= NULL
;
591 static int cinfoUsed
= 0;
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
);
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
;
610 scanPtr
+= sizeof(lstObject
);
611 int size
= LST_SIZE(o
);
612 if (LST_IS_BYTES(o
)) {
615 scanPtr
+= size
*LST_BYTES_PER_WORD
;
617 scanPtr
= lstAlignAddr(scanPtr
);
622 void lstShowCalledMethods (void) {
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
;
629 lstGC(); /* compact objects */
630 lstProcessSpace(2); /* static */
631 lstProcessSpace(curSpaceNo
); /* dynamic */
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
);
644 #define STATIC_ALLOC \
645 lstObject *res = (lstObject *)memSpaces[STATIC_SPACE].cur; \
646 unsigned char *next = memSpaces[STATIC_SPACE].cur; \
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); \
656 * static allocation -- tries to allocate values in an area
657 * that will not be subject to garbage collection
659 lstByteObject
*lstStaticAllocBin (int sz
) {
660 int realSz
= sz
+sizeof(lstObject
)+1;
663 lstBytePtr(res
)[sz
] = '\0';
664 return (lstByteObject
*)res
;
668 lstObject
*lstStaticAlloc (int sz
) {
669 int realSz
= sz
*LST_BYTES_PER_WORD
+sizeof(lstObject
);
675 #define DYNAMIC_ALLOC \
676 lstObject *res = (lstObject *)curSpace->cur; \
677 unsigned char *next = curSpace->cur; \
679 next = lstAlignAddr(next); \
680 if (next > curSpace->end) { \
682 res = (lstObject *)curSpace->cur; \
683 next = curSpace->cur; \
685 next = lstAlignAddr(next); \
686 if (next > curSpace->end) lstFatal("insufficient memory", sz); \
688 curSpace->cur = next; \
689 LST_SETSIZE(res, sz); \
694 lstByteObject
*lstMemAllocBin (int sz
) {
695 int realSz
= sz
+sizeof(lstObject
)+1;
698 lstBytePtr(res
)[sz
] = '\0';
699 return (lstByteObject
*)res
;
703 lstObject
*lstMemAlloc (int sz
) {
704 int realSz
= sz
*LST_BYTES_PER_WORD
+sizeof(lstObject
);
710 #include "lst_imagerw.c"
714 * Add another object root off a static object
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.
721 void lstAddStaticRoot (lstObject
**objp
) {
723 for (f
= 0; f
< staticRootTop
; ++f
) {
724 if (objp
== staticRoots
[f
]) return;
725 if (rfree
< 0 && !staticRoots
[f
]) rfree
= f
;
728 if (staticRootTop
>= STATICROOTLIMIT
) lstFatal("lstAddStaticRoot: too many static references", (intptr_t)objp
);
729 rfree
= staticRootTop
++;
731 staticRoots
[rfree
] = objp
;
735 void lstWriteBarrier (lstObject
**dest
, lstObject
*src
) {
736 if (LST_IS_STATIC(dest
) && !LST_IS_SMALLINT(src
) && !LST_IS_STATIC(src
)) {
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
;
743 if (staticRootTop
>= STATICROOTLIMIT
) lstFatal("lstWriteBarrier: too many static references", (intptr_t)dest
);
744 rfree
= staticRootTop
++;
746 staticRoots
[rfree
] = dest
;
753 /* fix an OOP if needed, based on values to be exchanged */
754 static void map (lstObject
**oop
, lstObject
*a1
, lstObject
*a2
, int size
) {
756 lstObject
*oo
= *oop
;
757 for (x
= 0; x
< size
; ++x
) {
758 if (a1
->data
[x
] == oo
) {
762 if (a2
->data
[x
] == oo
) {
770 /* traverse an object space */
771 static void walk (lstObject
*base
, lstObject
*top
, lstObject
*array1
, lstObject
*array2
, LstUInt size
) {
772 lstObject
*op
, *opnext
;
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 */
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
);
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
;
790 opnext
= lstAlignAddr(t
);
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 */
797 LstUInt realSize
= sz
*LST_BYTES_PER_WORD
+sizeof(lstObject
);
798 unsigned char *t
= (unsigned char *)op
;
800 opnext
= lstAlignAddr(t
);
807 * Bulk exchange of object identities
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[].
815 void lstSwapObjects (lstObject
*array1
, lstObject
*array2
, LstUInt size
) {
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
);
827 * Implement replaceFrom:to:with:startingAt: as a primitive
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
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;
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
);
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
)) {
861 /*fprintf(stderr, "!!!: count=%u\n", count);*/
862 for (f
= 0; f
< count
; ++f
) lstAddStaticRoot(&dest
->data
[istart
+f
]);
864 /* copy object pointer fields */
865 memmove(&dest
->data
[istart
], &aWith
->data
[irepStart
], LST_BYTES_PER_WORD
*count
);
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
;
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;
890 char *lstGetStringPtr (const lstObject
*str
) {
891 return (char *)(lstBytePtr(str
));
895 lstObject
*lstNewBinary (const void *p
, LstUInt l
) {
896 lstByteObject
*bobj
= lstMemAllocBin(l
);
897 bobj
->stclass
= lstByteArrayClass
;
899 if (p
) memcpy(lstBytePtr(bobj
), p
, l
); else memset(lstBytePtr(bobj
), 0, l
);
901 return (lstObject
*)bobj
;
905 lstObject
*lstNewBCode (const void *p
, LstUInt l
) {
906 lstByteObject
*bobj
= lstMemAllocBin(l
);
907 bobj
->stclass
= lstByteCodeClass
;
909 if (p
) memcpy(lstBytePtr(bobj
), p
, l
); else memset(lstBytePtr(bobj
), 0, l
);
911 return (lstObject
*)bobj
;
915 lstObject
*lstAllocInstance (int size
, lstObject
*cl
) {
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
;
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
;
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
;
943 lstObject
*lstNewArray (int size
) {
944 if (size
< 0) return NULL
;
945 return lstAllocInstance(size
, lstArrayClass
);
949 static int symbolBareCmp (const char *left
, int leftsize
, const char *right
, int rightsize
) {
950 int minsize
= leftsize
;
952 if (rightsize
< minsize
) minsize
= rightsize
;
954 if ((i
= memcmp(left
, right
, minsize
))) return i
;
956 return leftsize
-rightsize
;
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));
967 lstObject
*lstDictFind (const lstObject
*dict
, const char *name
) {
969 const lstObject
*keys
= dict
->data
[0];
970 int l
= 0, h
= LST_SIZE(keys
)-1, nlen
= strlen(name
);
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;
982 int lstIsKindOf (const lstObject
*obj
, const lstObject
*aclass
) {
983 const lstObject
*pclass
= obj
;
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
;
991 if (LST_IS_SMALLINT(aclass
)) aclass
= lstSmallIntClass
;
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 */
1006 lstObject
*lstFindGlobal (const char *name
) {
1007 if (!name
|| !name
[0]) return NULL
;
1008 return lstDictFind(lstGlobalObj
, name
);
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)
1019 fprintf(stderr
, "st=%p; u=%p; sz=%d\n", stclass
, lstNilObj
, LST_SIZE(stclass
));
1020 fprintf(stderr
, " [%s]\n", lstGetStringPtr(stclass
->data
[lstIVnameInClass
]));
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);
1028 dict
= stclass
->data
[lstIVmethodsInClass
];
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);
1034 res
= lstDictFind(dict
, method
);
1035 if (res
) return res
;
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
;
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
];
1060 if (lstRunMethodWithArg(lstSetGlobMethod
, NULL
, aa
, NULL
, 1) != lstReturnReturned
) return -1;
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 */
1068 lstRemoveFromFList(&finListHead
, o
->fin
);
1070 o
->fin
= malloc(sizeof(LstFinLink
));
1073 o
->fin
->udata
= udata
;
1075 lstAddToFList(&finListHead
, o
->fin
);
1079 void *lstGetUData (lstObject
*o
) {
1080 if (LST_IS_SMALLINT(o
) || !o
->fin
) return NULL
;
1081 return o
->fin
->udata
;
1085 lstObject
*lstNewChar (int ch
) {
1086 if (ch
< 0 || ch
> 255) return NULL
;
1087 return lstCharClass
->data
[lstIVcharsInMetaChar
]->data
[ch
];