* included in the distribution.
*
* $RCSfile: storage.c,v $
- * $Revision: 1.64 $
- * $Date: 2000/04/06 00:01:27 $
+ * $Revision: 1.70 $
+ * $Date: 2000/04/12 09:37:19 $
* ------------------------------------------------------------------------*/
#include "hugsbasictypes.h"
#include "errors.h"
#include "object.h"
#include <setjmp.h>
+#include "Stg.h"
/*#define DEBUG_SHOWUSE*/
newTab[i].inUse = FALSE; \
newTab[i].nextFree = i-1+TAB_BASE_ADDR; \
} \
- if (debugStorageExtra) \
+ if (0 && debugStorageExtra) \
fprintf(stderr, "Expanding " #type_name \
"table to size %d\n", newSz ); \
newTab[tab_size].nextFree = TAB_BASE_ADDR-1; \
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 )
{
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");
+
+ /* 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;
}
+/* 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;
everybody(GCDONE);
#if defined(DEBUG_STORAGE) || defined(DEBUG_STORAGE_EXTRA)
- fprintf(stderr, "\n--- GC recovered %d\n",recovered );
+ /* fprintf(stderr, "\n--- GC recovered %d\n",recovered ); */
#endif
/* can only return if freeList is nonempty on return. */
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)) {
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 "??";