[project @ 1999-11-01 14:20:18 by sof]

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

diff --git a/ghc/interpreter/storage.c b/ghc/interpreter/storage.c
index f581fd1..72e9a19 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.10 $
- * $Date: 1999/10/15 21:40:57 $
+ * $Revision: 1.14 $
+ * $Date: 1999/10/26 17:27:43 $
  * ------------------------------------------------------------------------*/
 
 #include "prelude.h"
@@ -135,6 +135,28 @@ Text t; {                               /* generated internally            */
     return (t<0 || t>=NUM_TEXT);
 }
 
+#define MAX_FIXLIT 100
+Text fixLitText(t)                /* fix literal text that might include \ */
+Text t; {
+    String   s = textToStr(t);
+    char     p[MAX_FIXLIT];
+    Int      i;
+    for(i = 0;i < MAX_FIXLIT-2 && *s;s++) {
+      p[i++] = *s;
+      if (*s == '\\') {
+       p[i++] = '\\';
+      } 
+    }
+    if (i < MAX_FIXLIT-2) {
+      p[i] = 0;
+    } else {
+       ERRMSG(0) "storage space exhausted for internal literal string"
+       EEND;
+    }
+    return (findText(p));
+}
+#undef MAX_FIXLIT
+
 static Int local hash(s)                /* Simple hash function on strings */
 String s; {
     int v, j = 3;
@@ -297,10 +319,13 @@ Tycon tc; {
 
 static Void local hashTycon(tc)         /* Insert Tycon into hash table    */
 Tycon tc; {
-    Text  t = tycon(tc).text;
-    Int   h = tHash(t);
-    tycon(tc).nextTyconHash = tyconHash[h];
-    tyconHash[h]            = tc;
+  assert(isTycon(tc));
+   if (1) {
+     Text  t = tycon(tc).text;
+     Int   h = tHash(t);
+     tycon(tc).nextTyconHash = tyconHash[h];
+     tyconHash[h]            = tc;
+   }
 }
 
 Tycon findQualTycon(id) /*locate (possibly qualified) Tycon in tycon table */
@@ -324,7 +349,7 @@ Cell id; {
         }
         default : internal("findQualTycon2");
     }
-    return 0; /* NOTREACHED */
+    return NIL; /* NOTREACHED */
 }
 
 Tycon addPrimTycon(t,kind,ar,what,defn) /* add new primitive type constr   */
@@ -413,6 +438,7 @@ Cell parent; {
     name(nameHw).inlineMe     = FALSE;
     name(nameHw).simplified   = FALSE;
     name(nameHw).isDBuilder   = FALSE;
+    name(nameHw).callconv     = NIL;
     name(nameHw).type         = NIL;
     name(nameHw).primop       = 0;
     name(nameHw).mod          = currentModule;
@@ -688,11 +714,11 @@ Text t; {
     cclass(classHw).arity     = 0;
     cclass(classHw).kinds     = NIL;
     cclass(classHw).head      = NIL;
+    cclass(classHw).fds       = NIL;
     cclass(classHw).dcon      = NIL;
     cclass(classHw).supers    = NIL;
     cclass(classHw).dsels     = NIL;
     cclass(classHw).members   = NIL;
-    cclass(classHw).dbuild    = NIL;
     cclass(classHw).defaults  = NIL;
     cclass(classHw).instances = NIL;
     classes=cons(classHw,classes);
@@ -933,7 +959,7 @@ Cell c; {
         case CONIDCELL : return findModule(textOf(c));
         default        : internal("findModid");
     }
-    assert(0); return 0; /* NOTREACHED */
+    return NIL;/*NOTUSED*/
 }
 
 static local Module findQualifier(t)    /* locate Module in import list   */
@@ -954,6 +980,7 @@ printf ( "findQualifier %s\n", textToStr(t));
 Void setCurrModule(m)              /* set lookup tables for current module */
 Module m; {
     Int i;
+    assert(isModule(m));
     if (m!=currentModule) {
         currentModule = m; /* This is the only assignment to currentModule */
         for (i=0; i<TYCONHSZ; ++i)
@@ -1402,11 +1429,14 @@ Cell c; {                               /* cells reachable from given root */
         }
     }
 
+    /* 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)) || fst(c)>=BCSTAG) {
+       STACK_CHECK
         markSnd(c);
     }
 
@@ -1732,6 +1762,14 @@ Int  depth; {
         case CONOPCELL:
                 Printf("{id %s}",textToStr(textOf(c)));
                 break;
+#if IPARAM
+         case IPCELL :
+             Printf("{ip %s}",textToStr(textOf(c)));
+             break;
+         case IPVAR :
+             Printf("?%s",textToStr(textOf(c)));
+             break;
+#endif
         case QUALIDENT:
                 Printf("{qid %s.%s}",textToStr(qmodOf(c)),textToStr(qtextOf(c)));
                 break;
@@ -2403,6 +2441,7 @@ Int what; {
                        for (i=CLASSMIN; i<classHw; ++i) {
                            mark(cclass(i).head);
                            mark(cclass(i).kinds);
+                          mark(cclass(i).fds);
                            mark(cclass(i).dsels);
                            mark(cclass(i).supers);
                            mark(cclass(i).members);