I have found and (I believe) fixed a nasty bug in
storage.c:dropScriptsFrom(). Basically, the problem is with the
following code fragment:
for (i=INSTMIN; i<instHw; i++) {
List ds = inst(i).dicts;
List dn = NIL;
while (nonNull(ds)) {
List temp = tl(ds);
if (hd(ds)<nameHw) {
tl(ds) = dn;
dn = ds;
}
ds = temp;
}
inst(i).dicts = rev(dn);
}
In the above fragment, hd(ds) is a Cell representing a heap-allocated
dictionary object (i.e., a negative number); nameHw is a "name" (a
positive number). Thus, the test always succeeds, and dictionaries
are always kept in these lists.
My first attempt at a fix was to merely discard all dictionaries from
the instances, under the assumption that this was merely a cache, and
that the dictionaries would get regenerated as needed (with some loss
of sharing); however, this failed miserably. Evidently this data
structure is what holds on to the dictionaries for garbage collection;
when I discarded all dictionaries, they got garbage collected out from
under the code.
Thus, I needed a way to discard only "new" dictionaries. I couldn't
see any way to tell the age of a dictionary in the current
implementation, so I added one; now there is a counter which counts
the dictionaries as they are allocated, and the current value of the
counter is stored in the dictionary (at the end).
I've appended my patch.
Carl Witty
[EMAIL PROTECTED]
diff -x *.o -x *~ -ur hugs-orig/src/storage.c hugs/src/storage.c
--- hugs-orig/src/storage.c Tue Oct 28 04:39:12 1997
+++ hugs/src/storage.c Tue Oct 28 05:18:11 1997
@@ -773,10 +773,20 @@
static Class classHw; /* next unused class */
static List classes; /* list of classes in current scope */
static Inst instHw; /* next unused instance record */
+static Int dictHw; /* next unused dictionary number */
struct strClass DEFTABLE(tabClass,NUM_CLASSES); /* table of class records */
struct strInst far *tabInst; /* (pointer to) table of instances */
+Cell newDict(len) /* create a new dictionary */
+Int len; {
+ Cell dict = flatAlloc(DICTCELL, len+1);
+
+ flatSet(dict, len+1, mkInt(dictHw++));
+
+ return dict;
+}
+
Class newClass(t) /* add new class to class table */
Text t; {
if (classHw-CLASSMIN >= NUM_CLASSES) {
@@ -1051,6 +1061,7 @@
Name nameHw;
Class classHw;
Inst instHw;
+ Int dictHw;
#if TREX
Ext extHw;
#endif
@@ -1102,6 +1113,7 @@
scripts[scriptHw].nameHw = nameHw;
scripts[scriptHw].classHw = classHw;
scripts[scriptHw].instHw = instHw;
+ scripts[scriptHw].dictHw = dictHw;
#if TREX
scripts[scriptHw].extHw = extHw;
#endif
@@ -1189,6 +1201,7 @@
nameHw = scripts[sno].nameHw;
classHw = scripts[sno].classHw;
instHw = scripts[sno].instHw;
+ dictHw = scripts[sno].dictHw;
#if TREX
extHw = scripts[sno].extHw;
#endif
@@ -1247,7 +1260,8 @@
while (nonNull(ds)) {
List temp = tl(ds);
- if (hd(ds)<nameHw) {
+ Cell d = hd(ds);
+ if (intOf(dictGet(d,flatLen(d)))<dictHw) {
tl(ds) = dn;
dn = ds;
}
@@ -2771,6 +2785,8 @@
classHw = CLASSMIN;
instHw = INSTMIN;
+
+ dictHw = 0;
tabInst = (struct strInst far *)
farCalloc(NUM_INSTS,sizeof(struct strInst));
diff -x *.o -x *~ -ur hugs-orig/src/storage.h hugs/src/storage.h
--- hugs-orig/src/storage.h Thu Jul 17 13:52:59 1997
+++ hugs/src/storage.h Tue Oct 28 05:04:18 1997
@@ -616,7 +616,7 @@
#define dictOf(c) flatOf(c)
#define dictGet(d,i) flatGet(d,i)
#define dictSet(d,i,e) flatSet(d,i,e)
-#define newDict(l) flatAlloc(DICTCELL,l)
+extern Cell newDict Args((Int));
#define dictMembersStart(cl) (1)
#define dictSupersStart(cl) (dictMembersStart(cl) + cclass(cl).numMembers)
