* included in the distribution.
*
* $RCSfile: storage.c,v $
- * $Revision: 1.52 $
- * $Date: 2000/03/22 18:14:23 $
+ * $Revision: 1.75 $
+ * $Date: 2000/05/09 17:38:19 $
* ------------------------------------------------------------------------*/
-#include "prelude.h"
+#include "hugsbasictypes.h"
#include "storage.h"
#include "connect.h"
#include "errors.h"
#include "object.h"
#include <setjmp.h>
+#include "Stg.h"
/*#define DEBUG_SHOWUSE*/
if (!isPair(v)) {
internal("identToStr");
}
- switch (fst(v)) {
+ switch (whatIs(v)) {
case VARIDCELL :
case VAROPCELL :
case CONIDCELL :
- case CONOPCELL : return text+textOf(v);
-
- case QUALIDENT : { Text pos = textHw;
- Text t = qmodOf(v);
- while (pos+1 < savedText && text[t]!=0) {
- text[pos++] = text[t++];
+ case CONOPCELL : return textToStr(textOf(v));
+
+ case QUALIDENT : { String qmod = textToStr(qmodOf(v));
+ String qtext = textToStr(qtextOf(v));
+ Text pos = textHw;
+
+ while (pos+1 < savedText && *qmod!=0) {
+ text[pos++] = *qmod++;
}
if (pos+1 < savedText) {
text[pos++] = '.';
}
- t = qtextOf(v);
- while (pos+1 < savedText && text[t]!=0) {
- text[pos++] = text[t++];
+ while (pos+1 < savedText && *qtext!=0) {
+ text[pos++] = *qtext++;
}
text[pos] = '\0';
return text+textHw;
* tycon, class, instance and module tables. Also, potentially, TREX Exts.
* ------------------------------------------------------------------------*/
+#ifdef DEBUG_STORAGE_EXTRA
+static Bool debugStorageExtra = TRUE;
+#else
+static Bool debugStorageExtra = FALSE;
+#endif
+
+
#define EXPANDABLE_SYMBOL_TABLE(type_name,struct_name, \
proc_name,free_proc_name, \
free_list,tab_name,tab_size,err_msg, \
assert(TAB_BASE_ADDR <= n); \
assert(n < TAB_BASE_ADDR+tab_size); \
assert(tab_name[n-TAB_BASE_ADDR].inUse); \
- tab_name[n-TAB_BASE_ADDR].inUse = FALSE; \
- /*tab_name[n-TAB_BASE_ADDR].nextFree = free_list; */ \
- /*free_list = n;*/ \
+ tab_name[n-TAB_BASE_ADDR].inUse = FALSE; \
+ if (!debugStorageExtra) { \
+ tab_name[n-TAB_BASE_ADDR].nextFree = free_list; \
+ free_list = n; \
+ } \
} \
\
type_name proc_name ( void ) \
newTab[i].inUse = FALSE; \
newTab[i].nextFree = i-1+TAB_BASE_ADDR; \
} \
- fprintf(stderr, "Expanding " #type_name \
- "table to size %d\n", newSz ); \
+ if (0 && debugStorageExtra) \
+ fprintf(stderr, "Expanding " #type_name \
+ "table to size %d\n", newSz ); \
newTab[tab_size].nextFree = TAB_BASE_ADDR-1; \
free_list = newSz-1+TAB_BASE_ADDR; \
tab_size = newSz; \
* ------------------------------------------------------------------------*/
#define TYCONHSZ 256 /* Size of Tycon hash table*/
- //#define tHash(x) (((x)-TEXT_BASE_ADDR)%TYCONHSZ)/* Tycon hash function */
+static Tycon tyconHash[TYCONHSZ]; /* Hash table storage */
+
static int tHash(Text x)
{
int r;
assert(r<TYCONHSZ);
return r;
}
-static Tycon tyconHash[TYCONHSZ]; /* Hash table storage */
-int RC_T ( int x )
+
+static int RC_T ( int x )
{
assert (x >= 0 && x < TYCONHSZ);
return x;
}
+
Tycon newTycon ( Text t ) /* add new tycon to tycon table */
{
Int h = tHash(t);
tycon(tc).tagToCon = NIL;
tycon(tc).itbl = NULL;
tycon(tc).arity = 0;
+ tycon(tc).closure = NIL;
module(currentModule).tycons = cons(tc,module(currentModule).tycons);
tycon(tc).nextTyconHash = tyconHash[RC_T(h)];
tyconHash[RC_T(h)] = tc;
Tycon findTycon(t) /* locate Tycon in tycon table */
Text t; {
Tycon tc = tyconHash[RC_T(tHash(t))];
-assert(isTycon(tc) || isTuple(tc) || isNull(tc));
+ assert(isTycon(tc) || isTuple(tc) || isNull(tc));
while (nonNull(tc) && tycon(tc).text!=t)
tc = tycon(tc).nextTyconHash;
return tc;
* ------------------------------------------------------------------------*/
#define NAMEHSZ 256 /* Size of Name hash table */
-//#define nHash(x) (((x)-TEXT_BASE_ADDR)%NAMEHSZ) /* hash fn :: Text->Int */
+static Name nameHash[NAMEHSZ]; /* Hash table storage */
+
static int nHash(Text x)
{
assert(isText(x) || inventedText(x));
if (x < 0) x = -x;
return x%NAMEHSZ;
}
-static Name nameHash[NAMEHSZ]; /* Hash table storage */
+
int RC_N ( int x )
{
assert (x >= 0 && x < NAMEHSZ);
return x;
}
+
void hashSanity ( void )
{
Int i, j;
name(nm).arity = 0;
name(nm).number = EXECNAME;
name(nm).defn = NIL;
- name(nm).stgVar = NIL;
+ name(nm).hasStrict = FALSE;
name(nm).callconv = NIL;
name(nm).type = NIL;
name(nm).primop = NULL;
name(nm).itbl = NULL;
+ name(nm).closure = NIL;
module(currentModule).names = cons(nm,module(currentModule).names);
name(nm).nextNameHash = nameHash[RC_N(h)];
- nameHash[RC_N(h)] = nm;
+ nameHash[RC_N(h)] = nm;
return nm;
}
Name findName(t) /* Locate name in name table */
Text t; {
Name n = nameHash[RC_N(nHash(t))];
-assert(isText(t));
-assert(isName(n) || isNull(n));
+ assert(isText(t) || isInventedVar(t) || isInventedDictVar(t));
+ assert(isName(n) || isNull(n));
while (nonNull(n) && name(n).text!=t)
n = name(n).nextNameHash;
return n;
}
-Name nameFromStgVar ( StgVar v )
-{
- Int n;
- for (n = NAME_BASE_ADDR;
- n < NAME_BASE_ADDR+tabNameSz; n++)
- if (tabName[n-NAME_BASE_ADDR].inUse)
- if (name(n).stgVar == v) return n;
- return NIL;
-}
-
-void* getHugs_AsmObject_for ( char* s )
+void* /* StgClosure* */ getHugs_BCO_cptr_for ( char* s )
{
- StgVar v;
Text t = findText(s);
Name n = NIL;
for (n = NAME_BASE_ADDR;
n < NAME_BASE_ADDR+tabNameSz; n++)
- if (tabName[n-NAME_BASE_ADDR].inUse)
- if (name(n).text == t) break;
+ if (tabName[n-NAME_BASE_ADDR].inUse && name(n).text == t)
+ break;
if (n == NAME_BASE_ADDR+tabNameSz) {
fprintf ( stderr, "can't find `%s' in ...\n", s );
- internal("getHugs_AsmObject_for(1)");
+ internal("getHugs_BCO_cptr_for(1)");
}
- v = name(n).stgVar;
- if (!isStgVar(v) || !isPtr(stgVarInfo(v)))
- internal("getHugs_AsmObject_for(2)");
- return ptrOf(stgVarInfo(v));
+ if (!isCPtr(name(n).closure))
+ internal("getHugs_BCO_cptr_for(2)");
+ return cptrOf(name(n).closure);
}
/* --------------------------------------------------------------------------
if (combined)
m = findFakeModule(findText(n==0 ? "PrelBase" : "PrelTup")); else
- m = findModule(findText("Prelude"));
+ m = findModule(findText("PrelPrim"));
setCurrModule(m);
k = STAR;
inst(in).kinds = NIL;
inst(in).head = NIL;
inst(in).specifics = NIL;
+ inst(in).numSpecifics = 0;
inst(in).implements = NIL;
inst(in).builder = NIL;
return in;
return xs;
}
+Int numQualifiers ( Type t )
+{
+ if (isPolyType(t)) t = monotypeOf(t);
+ if (isQualType(t))
+ return length ( fst(snd(t)) ); else
+ return 0;
+}
+
+
/* Purely for debugging. */
void locateSymbolByName ( Text t )
{
module(mod).classes = NIL;
module(mod).exports = NIL;
module(mod).qualImports = NIL;
+ module(mod).codeList = NIL;
module(mod).fake = FALSE;
module(mod).tree = NIL;
module(mod).completed = FALSE;
module(mod).lastStamp = 0; /* ???? */
- module(mod).fromSrc = TRUE;
+ module(mod).mode = NIL;
module(mod).srcExt = findText("");
module(mod).uses = NIL;
return mod;
}
+
+Bool nukeModule_needs_major_gc = TRUE;
+
void nukeModule ( Module m )
{
ObjectCode* oc;
ObjectCode* oc2;
Int i;
-assert(isModule(m));
-fprintf(stderr, "NUKEMODULE `%s'\n", textToStr(module(m).text));
+
+ if (!isModule(m)) internal("nukeModule");
+
+ /* fprintf ( stderr, "NUKE MODULE %s\n", textToStr(module(m).text) ); */
+
+ /* see comment in compiler.c about this,
+ and interaction with info tables */
+ if (nukeModule_needs_major_gc) {
+ /* fprintf ( stderr, "doing major GC in nukeModule\n"); */
+ /* performMajorGC(); */
+ nukeModule_needs_major_gc = FALSE;
+ }
+
oc = module(m).object;
while (oc) {
oc2 = oc->next;
for (i = NAME_BASE_ADDR; i < NAME_BASE_ADDR+tabNameSz; i++)
if (tabName[i-NAME_BASE_ADDR].inUse && name(i).mod == m) {
- if (name(i).itbl) free(name(i).itbl);
- name(i).itbl = NULL;
+ if (name(i).itbl &&
+ module(name(i).mod).mode == FM_SOURCE) {
+ free(name(i).itbl);
+ }
+ name(i).itbl = NULL;
+ name(i).closure = NIL;
freeName(i);
}
for (i = TYCON_BASE_ADDR; i < TYCON_BASE_ADDR+tabTyconSz; i++)
if (tabTycon[i-TYCON_BASE_ADDR].inUse && tycon(i).mod == m) {
- if (tycon(i).itbl) free(tycon(i).itbl);
+ if (tycon(i).itbl &&
+ module(tycon(i).mod).mode == FM_SOURCE) {
+ free(tycon(i).itbl);
+ }
tycon(i).itbl = NULL;
freeTycon(i);
}
Module m; {
Int i;
assert(isModule(m));
-fprintf(stderr, "SET CURR MODULE %s\n", textToStr(module(m).text));
+ /* fprintf(stderr, "SET CURR MODULE %s %d\n", textToStr(module(m).text),m); */
{List t;
for (t = module(m).names; nonNull(t); t=tl(t))
assert(isName(hd(t)));
hashSanity();
}
+void addToCodeList ( Module m, Cell c )
+{
+ assert(isName(c) || isTuple(c));
+ if (nonNull(getNameOrTupleClosure(c)))
+ module(m).codeList = cons ( c, module(m).codeList );
+ /* fprintf ( stderr, "addToCodeList %s %s\n",
+ textToStr(module(m).text),
+ textToStr( isTuple(c) ? tycon(c).text : name(c).text ) );
+ */
+}
+
+Cell getNameOrTupleClosure ( Cell c )
+{
+ if (isName(c)) return name(c).closure;
+ else if (isTuple(c)) return tycon(c).closure;
+ else internal("getNameOrTupleClosure");
+}
+
+void setNameOrTupleClosure ( Cell c, Cell closure )
+{
+ if (isName(c)) name(c).closure = closure;
+ else if (isTuple(c)) tycon(c).closure = closure;
+ else internal("setNameOrTupleClosure");
+}
+
+/* This function is used in ghc/rts/Assembler.c. */
+void* /* StgClosure* */ getNameOrTupleClosureCPtr ( Cell c )
+{
+ return cptrOf(getNameOrTupleClosure(c));
+}
+
+/* used in codegen.c */
+void setNameOrTupleClosureCPtr ( Cell c, void* /* StgClosure* */ cptr )
+{
+ if (isName(c)) name(c).closure = mkCPtr(cptr);
+ else if (isTuple(c)) tycon(c).closure = mkCPtr(cptr);
+ else internal("setNameOrTupleClosureCPtr");
+}
+
+
+
Name jrsFindQualName ( Text mn, Text sn )
{
Module m;
}
+/* Only call this if in dire straits; searches every object symtab
+ in the system -- so is therefore slow.
+*/
+void* lookupOTabNameAbsolutelyEverywhere ( char* sym )
+{
+ ObjectCode* oc;
+ Module m;
+ void* ad;
+ for (m = MODULE_BASE_ADDR;
+ m < MODULE_BASE_ADDR+tabModuleSz; m++) {
+ if (tabModule[m-MODULE_BASE_ADDR].inUse) {
+ if (module(m).object) {
+ ad = ocLookupSym ( module(m).object, sym );
+ if (ad) return ad;
+ }
+ for (oc = module(m).objectExtras; oc; oc=oc->next) {
+ ad = ocLookupSym ( oc, sym );
+ if (ad) return ad;
+ }
+ }
+ }
+ return NULL;
+}
+
+
OSectionKind lookupSection ( void* ad )
{
int i;
}
+/* Called by the evaluator's GC to tell Hugs to mark stuff in the
+ run-time heap.
+*/
+void markHugsObjects( void )
+{
+ Name nm;
+ Tycon tc;
+
+ for ( nm = NAME_BASE_ADDR;
+ nm < NAME_BASE_ADDR+tabNameSz; ++nm ) {
+ if (tabName[nm-NAME_BASE_ADDR].inUse) {
+ Cell cl = name(nm).closure;
+ if (nonNull(cl)) {
+ assert(isCPtr(cl));
+ snd(cl) = (Cell)MarkRoot ( (StgClosure*)(snd(cl)) );
+ }
+ }
+ }
+
+ for ( tc = TYCON_BASE_ADDR;
+ tc < TYCON_BASE_ADDR+tabTyconSz; ++tc ) {
+ if (tabTycon[tc-TYCON_BASE_ADDR].inUse) {
+ Cell cl = tycon(tc).closure;
+ if (nonNull(cl)) {
+ assert(isCPtr(cl));
+ snd(cl) = (Cell)MarkRoot ( (StgClosure*)(snd(cl)) );
+ }
+ }
+ }
+
+}
+
+
/* --------------------------------------------------------------------------
* Heap storage:
*
Int heapSize = DEFAULTHEAP; /* number of cells in heap */
Heap heapFst; /* array of fst component of pairs */
Heap heapSnd; /* array of snd component of pairs */
-#ifndef GLOBALfst
Heap heapTopFst;
-#endif
-#ifndef GLOBALsnd
Heap heapTopSnd;
-#endif
Bool consGC = TRUE; /* Set to FALSE to turn off gc from*/
/* C stack; use with extreme care! */
Long numCells;
+int numEnters;
Int numGcs; /* number of garbage collections */
Int cellsRecovered; /* number of cells recovered */
Cell pair(l,r) /* Allocate pair (l, r) from */
Cell l, r; { /* heap, garbage collecting first */
Cell c = freeList; /* if necessary ... */
-
if (isNull(c)) {
lsave = l;
rsave = r;
static Int *marks;
static Int marksSize;
-Cell markExpr(c) /* External interface to markCell */
-Cell c; {
- return isGenPair(c) ? markCell(c) : c;
-}
-
-static Cell local markCell(c) /* Traverse part of graph marking */
-Cell c; { /* cells reachable from given root */
- /* markCell(c) is only called if c */
- /* is a pair */
- { register int place = placeInSet(c);
- register int mask = maskInSet(c);
- if (marks[place]&mask)
- return c;
- else {
- marks[place] |= mask;
- recordMark();
- }
- }
-
- /* STACK_CHECK: Avoid stack overflows during recursive marking. */
- if (isGenPair(fst(c))) {
- STACK_CHECK
- fst(c) = markCell(fst(c));
- markSnd(c);
- }
- else if (isNull(fst(c)) || isTagPtr(fst(c))) {
- STACK_CHECK
- markSnd(c);
- }
-
- return c;
-}
-
-static Void local markSnd(c) /* Variant of markCell used to */
-Cell c; { /* update snd component of cell */
- Cell t; /* using tail recursion */
+void mark ( Cell root )
+{
+ Cell c;
+ Cell mstack[NUM_MSTACK];
+ Int msp = -1;
+ Int msp_max = -1;
-ma: t = c; /* Keep pointer to original pair */
- c = snd(c);
- if (!isPair(c))
- return;
+ mstack[++msp] = root;
- { register int place = placeInSet(c);
- register int mask = maskInSet(c);
- if (marks[place]&mask)
- return;
- else {
+ while (msp >= 0) {
+ if (msp > msp_max) msp_max = msp;
+ c = mstack[msp--];
+ if (!isGenPair(c)) continue;
+ if (fst(c)==FREECELL) continue;
+ {
+ register int place = placeInSet(c);
+ register int mask = maskInSet(c);
+ if (!(marks[place]&mask)) {
marks[place] |= mask;
- recordMark();
- }
- }
-
- if (isGenPair(fst(c))) {
- fst(c) = markCell(fst(c));
- goto ma;
- }
- else if (isNull(fst(c)) || isTagPtr(fst(c)))
- goto ma;
- return;
-}
-
-Void markWithoutMove(n) /* Garbage collect cell at n, as if*/
-Cell n; { /* it was a cell ref, but don't */
- /* move cell so we don't have */
- /* to modify the stored value of n */
- if (isGenPair(n)) {
- recordStackRoot();
- markCell(n);
- }
+ if (msp >= NUM_MSTACK-5) {
+ fprintf ( stderr,
+ "hugs: fatal stack overflow during GC. "
+ "Increase NUM_MSTACK.\n" );
+ exit(9);
+ }
+ mstack[++msp] = fst(c);
+ mstack[++msp] = snd(c);
+ }
+ }
+ }
+ // fprintf(stderr, "%d ",msp_max);
}
+
Void garbageCollect() { /* Run garbage collector ... */
- Bool breakStat = breakOn(FALSE); /* disable break checking */
+ /* disable break checking */
Int i,j;
register Int mask;
register Int place;
Int recovered;
jmp_buf regs; /* save registers on stack */
-fprintf ( stderr, "wa-hey! garbage collection! too difficult! bye!\n" );
-exit(0);
+ HugsBreakAction oldBrk
+ = setBreakAction ( HugsIgnoreBreak );
+
setjmp(regs);
gcStarted();
+
for (i=0; i<marksSize; ++i) /* initialise mark set to empty */
marks[i] = 0;
}
gcRecovered(recovered);
- breakOn(breakStat); /* restore break trapping if nec. */
+ setBreakAction ( oldBrk );
everybody(GCDONE);
+#if defined(DEBUG_STORAGE) || defined(DEBUG_STORAGE_EXTRA)
+ /* fprintf(stderr, "\n--- GC recovered %d\n",recovered ); */
+#endif
+
/* can only return if freeList is nonempty on return. */
if (recovered<minRecovery || isNull(freeList)) {
ERRMSG(0) "Garbage collection fails to reclaim sufficient space"
* Miscellaneous operations on heap cells:
* ------------------------------------------------------------------------*/
+/* Reordered 2 May 00 to have most common options first. */
Cell whatIs ( register Cell c )
{
if (isPair(c)) {
register Cell fstc = fst(c);
return isTag(fstc) ? fstc : AP;
}
+ if (isTycon(c)) return TYCON;
if (isOffset(c)) return OFFSET;
- if (isChar(c)) return CHARCELL;
- if (isInt(c)) return INTCELL;
if (isName(c)) return NAME;
- if (isTycon(c)) return TYCON;
+ if (isInt(c)) return INTCELL;
if (isTuple(c)) return TUPLE;
+ if (isSpec(c)) return c;
if (isClass(c)) return CLASS;
+ if (isChar(c)) return CHARCELL;
+ if (isNull(c)) return c;
if (isInst(c)) return INSTANCE;
if (isModule(c)) return MODULE;
if (isText(c)) return TEXTCELL;
if (isInventedVar(c)) return INVAR;
if (isInventedDictVar(c)) return INDVAR;
- if (isSpec(c)) return c;
- if (isNull(c)) return c;
fprintf ( stderr, "whatIs: unknown %d\n", c );
internal("whatIs");
}
-#if 0
-Cell whatIs(c) /* identify type of cell */
-register Cell c; {
- if (isPair(c)) {
- register Cell fstc = fst(c);
- return isTag(fstc) ? fstc : AP;
- }
- if (c<OFFMIN) return c;
-#if TREX
- if (isExt(c)) return EXT;
-#endif
- if (c>=INTMIN) return INTCELL;
-
- if (c>=NAMEMIN){if (c>=CLASSMIN) {if (c>=CHARMIN) return CHARCELL;
- else return CLASS;}
- else if (c>=INSTMIN) return INSTANCE;
- else return NAME;}
- else if (c>=MODMIN) {if (c>=TYCMIN) return isTuple(c) ? TUPLE : TYCON;
- else return MODULE;}
- else if (c>=OFFMIN) return OFFSET;
-#if TREX
- else return (c>=EXTMIN) ?
- EXT : TUPLE;
-#else
- else return TUPLE;
-#endif
-
-
-/* if (isPair(c)) {
- register Cell fstc = fst(c);
- return isTag(fstc) ? fstc : AP;
- }
- if (c>=INTMIN) return INTCELL;
- if (c>=CHARMIN) return CHARCELL;
- if (c>=CLASSMIN) return CLASS;
- if (c>=INSTMIN) return INSTANCE;
- if (c>=NAMEMIN) return NAME;
- if (c>=TYCMIN) return TYCON;
- if (c>=MODMIN) return MODULE;
- if (c>=OFFMIN) return OFFSET;
-#if TREX
- if (c>=EXTMIN) return EXT;
-#endif
- if (c>=TUPMIN) return TUPLE;
- return c;*/
-}
-#endif
-
/* A very, very simple printer.
* Output is uglier than from printExp - but the printer is more
else if (isTagNonPtr(c)) {
Printf("TagNP(%d)", c);
}
- else if (isSpec(c)) {
+ else if (isSpec(c) && c != STAR) {
Printf("TagS(%d)", c);
}
else if (isText(c)) {
case CHARCELL:
Printf("char('%c')", charOf(c));
break;
- case PTRCELL:
- Printf("ptr(%p)",ptrOf(c));
+ case STRCELL:
+ Printf("strcell(\"%s\")",textToStr(snd(c)));
+ break;
+ case MPTRCELL:
+ Printf("mptr(%p)",mptrOf(c));
+ break;
+ case CPTRCELL:
+ Printf("cptr(%p)",cptrOf(c));
+ break;
+ case ADDRCELL:
+ Printf("addr(%p)",addrOf(c));
break;
case CLASS:
Printf("class(%d)", c-CCLASS_BASE_ADDR);
typedef union {Int i; Ptr p;} IntOrPtr;
-Cell mkPtr(p)
+Cell mkAddr(p)
Ptr p;
{
IntOrPtr x;
x.p = p;
- return pair(PTRCELL,x.i);
+ return pair(ADDRCELL,x.i);
}
-Ptr ptrOf(c)
+Ptr addrOf(c)
Cell c;
{
IntOrPtr x;
- assert(fst(c) == PTRCELL);
+ assert(fst(c) == ADDRCELL);
+ x.i = snd(c);
+ return x.p;
+}
+
+Cell mkMPtr(p)
+Ptr p;
+{
+ IntOrPtr x;
+ x.p = p;
+ return pair(MPTRCELL,x.i);
+}
+
+Ptr mptrOf(c)
+Cell c;
+{
+ IntOrPtr x;
+ assert(fst(c) == MPTRCELL);
x.i = snd(c);
return x.p;
}
Cell varIsMember(t,xs) /* Test if variable is a member of */
Text t; /* given list of variables */
List xs; {
+ assert(isText(t) || isInventedVar(t) || isInventedDictVar(t));
for (; nonNull(xs); xs=tl(xs))
if (t==textOf(hd(xs)))
return hd(xs);
* debugging support
* ------------------------------------------------------------------------*/
+/* Given the address of an info table, find the constructor/tuple
+ that it belongs to, and return the name. Only needed for debugging.
+*/
+char* lookupHugsItblName ( void* v )
+{
+ int i;
+ for (i = TYCON_BASE_ADDR;
+ i < TYCON_BASE_ADDR+tabTyconSz; ++i) {
+ if (tabTycon[i-TYCON_BASE_ADDR].inUse
+ && tycon(i).itbl == v)
+ return textToStr(tycon(i).text);
+ }
+ for (i = NAME_BASE_ADDR;
+ i < NAME_BASE_ADDR+tabNameSz; ++i) {
+ if (tabName[i-NAME_BASE_ADDR].inUse
+ && name(i).itbl == v)
+ return textToStr(name(i).text);
+ }
+ return NULL;
+}
+
static String maybeModuleStr ( Module m )
{
if (isModule(m)) return textToStr(module(m).text); else return "??";
printf ( " number: %d\n", name(n).number );
printf ( " type: "); print100(name(n).type);
printf ( " defn: %d\n", name(n).defn );
- printf ( " stgVar: "); print100(name(n).stgVar);
printf ( " cconv: %d\n", name(n).callconv );
printf ( " primop: %p\n", name(n).primop );
printf ( " itbl: %p\n", name(n).itbl );
+ printf ( " closure: %d\n", name(n).closure );
printf ( " nextNH: %d\n", name(n).nextNameHash );
printf ( "}\n" );
}
i < NAME_BASE_ADDR+tabNameSz; ++i) {
if (tabName[i-NAME_BASE_ADDR].inUse) {
mark(name(i).parent);
- mark(name(i).defn);
- mark(name(i).stgVar);
mark(name(i).type);
+ mark(name(i).defn);
+ mark(name(i).closure);
}
}
end("Names", nameHw-NAMEMIN);
mark(module(i).classes);
mark(module(i).exports);
mark(module(i).qualImports);
+ mark(module(i).codeList);
+ mark(module(i).tree);
+ mark(module(i).uses);
mark(module(i).objectExtraNames);
}
}
for (i = TYCON_BASE_ADDR;
i < TYCON_BASE_ADDR+tabTyconSz; ++i) {
if (tabTycon[i-TYCON_BASE_ADDR].inUse) {
- mark(tycon(i).defn);
mark(tycon(i).kind);
mark(tycon(i).what);
+ mark(tycon(i).defn);
+ mark(tycon(i).closure);
}
}
end("Type constructors", tyconHw-TYCMIN);
start();
for (i = CCLASS_BASE_ADDR;
i < CCLASS_BASE_ADDR+tabClassSz; ++i) {
- if (tabModule[i-MODULE_BASE_ADDR].inUse) {
- mark(cclass(i).head);
+ if (tabClass[i-CCLASS_BASE_ADDR].inUse) {
mark(cclass(i).kinds);
mark(cclass(i).fds);
mark(cclass(i).xfds);
- mark(cclass(i).dsels);
+ mark(cclass(i).head);
mark(cclass(i).supers);
+ mark(cclass(i).dsels);
mark(cclass(i).members);
mark(cclass(i).defaults);
mark(cclass(i).instances);
for (i = INST_BASE_ADDR;
i < INST_BASE_ADDR+tabInstSz; ++i) {
if (tabInst[i-INST_BASE_ADDR].inUse) {
- mark(inst(i).head);
mark(inst(i).kinds);
+ mark(inst(i).head);
mark(inst(i).specifics);
mark(inst(i).implements);
}
projects / ghc-hetmet.git / blobdiff