[project @ 2000-02-25 17:35:11 by sewardj]

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

diff --git a/ghc/interpreter/storage.c b/ghc/interpreter/storage.c
index 193613e..cf50bf4 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.41 $
- * $Date: 2000/02/08 15:32:30 $
+ * $Revision: 1.46 $
+ * $Date: 2000/02/25 10:53:54 $
  * ------------------------------------------------------------------------*/
 
 #include "prelude.h"
@@ -768,7 +768,10 @@ void* getHugs_AsmObject_for ( char* s )
    Name   n = NIL;
    for (n = NAMEMIN; n < nameHw; n++)
       if (name(n).text == t) break;
-   if (n == nameHw) internal("getHugs_AsmObject_for(1)");
+   if (n == nameHw) {
+      fprintf ( stderr, "can't find `%s' in ...\n", s );
+      internal("getHugs_AsmObject_for(1)");
+   }
    v = name(n).stgVar;
    if (!isStgVar(v) || !isPtr(stgVarInfo(v)))
       internal("getHugs_AsmObject_for(2)");
@@ -1643,12 +1646,13 @@ String f; {                             /* of status for later restoration  */
 }
 
 Bool isPreludeScript() {                /* Test whether this is the Prelude*/
-    return (scriptHw==0);
+    return (scriptHw < N_PRELUDE_SCRIPTS /*==0*/ );
 }
 
 Bool moduleThisScript(m)                /* Test if given module is defined */
 Module m; {                             /* in current script file          */
-    return scriptHw<1 || m>=scripts[scriptHw-1].moduleHw;
+    return scriptHw < 1
+           || m>=scripts[scriptHw-1].moduleHw;
 }
 
 Module lastModule() {              /* Return module in current script file */
@@ -2440,8 +2444,10 @@ Int n; {
            : pair(INTCELL,n);
 }
 
-#if SIZEOF_INTP == SIZEOF_INT
+#if SIZEOF_VOID_P == SIZEOF_INT
+
 typedef union {Int i; Ptr p;} IntOrPtr;
+
 Cell mkPtr(p)
 Ptr p;
 {
@@ -2458,6 +2464,7 @@ Cell c;
     x.i = snd(c);
     return x.p;
 }
+
 Cell mkCPtr(p)
 Ptr p;
 {
@@ -2474,8 +2481,11 @@ Cell c;
     x.i = snd(c);
     return x.p;
 }
-#elif SIZEOF_INTP == 2*SIZEOF_INT
+
+#elif SIZEOF_VOID_P == 2*SIZEOF_INT
+
 typedef union {struct {Int i1; Int i2;} i; Ptr p;} IntOrPtr;
+
 Cell mkPtr(p)
 Ptr p;
 {
@@ -2493,23 +2503,32 @@ Cell c;
     x.i.i2 = intOf(snd(snd(c)));
     return x.p;
 }
-#else
-#warning "type Addr not supported on this architecture - don't use it"
-Cell mkPtr(p)
+
+Cell mkCPtr(p)
 Ptr p;
 {
-    ERRMSG(0) "mkPtr: type Addr not supported on this architecture"
-    EEND;
+    IntOrPtr x;
+    x.p = p;
+    return pair(CPTRCELL,pair(mkInt(x.i.i1),mkInt(x.i.i2)));
 }
 
-Ptr ptrOf(c)
+Ptr cptrOf(c)
 Cell c;
 {
-    ERRMSG(0) "ptrOf: type Addr not supported on this architecture"
-    EEND;
+    IntOrPtr x;
+    assert(fst(c) == CPTRCELL);
+    x.i.i1 = intOf(fst(snd(c)));
+    x.i.i2 = intOf(snd(snd(c)));
+    return x.p;
 }
+
+#else
+
+#error "Can't implement mkPtr/ptrOf on this architecture."
+
 #endif
 
+
 String stringNegate( s )
 String s;
 {
@@ -2942,6 +2961,11 @@ static String maybeTyconStr ( Tycon t )
    if (isTycon(t)) return textToStr(tycon(t).text); else return "??";
 }
 
+static String maybeClassStr ( Class c )
+{
+   if (isClass(c)) return textToStr(cclass(c).text); else return "??";
+}
+
 static String maybeText ( Text t )
 {
    if (isNull(t)) return "(nil)";
@@ -2963,8 +2987,7 @@ void dumpTycon ( Int t )
    printf ( "{\n" );
    printf ( "    text: %s\n",     textToStr(tycon(t).text) );
    printf ( "    line: %d\n",     tycon(t).line );
-   printf ( "     mod: %d %s\n",  tycon(t).mod, 
-                                  maybeModuleStr(tycon(t).mod));
+   printf ( "     mod: %s\n",     maybeModuleStr(tycon(t).mod));
    printf ( "   tuple: %d\n",     tycon(t).tuple);
    printf ( "   arity: %d\n",     tycon(t).arity);
    printf ( "    kind: ");        print100(tycon(t).kind);
@@ -2990,8 +3013,7 @@ void dumpName ( Int n )
    printf ( "{\n" );
    printf ( "    text: %s\n",     textToStr(name(n).text) );
    printf ( "    line: %d\n",     name(n).line );
-   printf ( "     mod: %d %s\n",  name(n).mod, 
-                                  maybeModuleStr(name(n).mod));
+   printf ( "     mod: %s\n",     maybeModuleStr(name(n).mod));
    printf ( "  syntax: %d\n",     name(n).syntax );
    printf ( "  parent: %d\n",     name(n).parent );
    printf ( "   arity: %d\n",     name(n).arity );
@@ -3017,8 +3039,7 @@ void dumpClass ( Int c )
    printf ( "{\n" );
    printf ( "    text: %s\n",     textToStr(cclass(c).text) );
    printf ( "    line: %d\n",     cclass(c).line );
-   printf ( "     mod: %d %s\n",  cclass(c).mod, 
-                                  maybeModuleStr(cclass(c).mod));
+   printf ( "     mod: %s\n",     maybeModuleStr(cclass(c).mod));
    printf ( "   arity: %d\n",     cclass(c).arity );
    printf ( "   level: %d\n",     cclass(c).level );
    printf ( "   kinds: ");        print100( cclass(c).kinds );
@@ -3045,7 +3066,15 @@ void dumpInst ( Int i )
       return;
    }
    printf ( "{\n" );
-//   printf ( "    text: %s\n",     textToStr(cclass(c)).text) );
+   printf ( "   class: %s\n",     maybeClassStr(inst(i).c) );
+   printf ( "    line: %d\n",     inst(i).line );
+   printf ( "     mod: %s\n",     maybeModuleStr(inst(i).mod));
+   printf ( "   kinds: ");        print100( inst(i).kinds );
+   printf ( "    head: ");        print100( inst(i).head );
+   printf ( "   specs: ");        print100( inst(i).specifics );
+   printf ( "  #specs: %d\n",     inst(i).numSpecifics );
+   printf ( "   impls: ");        print100( inst(i).implements );
+   printf ( " builder: %s\n",     maybeNameStr( inst(i).builder ) );
    printf ( "}\n" );
 }