[project @ 2000-04-12 09:37:19 by sewardj]

[ghc-hetmet.git] / ghc / interpreter / storage.c

diff --git a/ghc/interpreter/storage.c b/ghc/interpreter/storage.c
index 39e68ea..696e117 100644 (file)
--- a/ghc/interpreter/storage.c
+++ b/ghc/interpreter/storage.c
@@ -9,8 +9,8 @@
  * included in the distribution.
  *
  * $RCSfile: storage.c,v $
- * $Revision: 1.65 $
- * $Date: 2000/04/06 14:23:55 $
+ * $Revision: 1.70 $
+ * $Date: 2000/04/12 09:37:19 $
  * ------------------------------------------------------------------------*/
 
 #include "hugsbasictypes.h"
@@ -19,6 +19,7 @@
 #include "errors.h"
 #include "object.h"
 #include <setjmp.h>
+#include "Stg.h"
 
 /*#define DEBUG_SHOWUSE*/
 
@@ -1628,13 +1629,25 @@ Module newModule ( Text t )             /* add new module to module table  */
     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;
@@ -1828,6 +1841,31 @@ void* lookupOExtraTabName ( char* sym )
 }
 
 
+/* 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;
@@ -2200,7 +2238,7 @@ Void print ( Cell c, Int depth )
     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)) {
@@ -2686,6 +2724,7 @@ QualId qualidIsMember ( QualId q, List xs )
 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);
@@ -2963,6 +3002,27 @@ List args; {
  * 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 "??";