X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Finterpreter%2Fstorage.c;h=3551c2ea19b9a5593fa9ca1b1739362fd38f9368;hb=79609941480b832d00eeff5f143e4da4b735dd9e;hp=6995b10b31632b1fec998889621c3032bb27eb50;hpb=f0901617344ad6cb35b10eeaf7093f0e4f23dce9;p=ghc-hetmet.git

diff --git a/ghc/interpreter/storage.c b/ghc/interpreter/storage.c
index 6995b10..3551c2e 100644
--- a/ghc/interpreter/storage.c
+++ b/ghc/interpreter/storage.c
@@ -9,8 +9,8 @@
  * included in the distribution.
  *
  * $RCSfile: storage.c,v $
- * $Revision: 1.73 $
- * $Date: 2000/04/27 16:35:29 $
+ * $Revision: 1.77 $
+ * $Date: 2000/05/12 13:34:07 $
  * ------------------------------------------------------------------------*/
 
 #include "hugsbasictypes.h"
@@ -21,6 +21,13 @@
 #include <setjmp.h>
 #include "Stg.h"
 
+/* #include "Storage.h"
+   We'd like to, but Storage.h and storage.h look the same under
+   Cygwin, alas, causing compilation chaos.  So just copy what
+   we need to know, which is ...
+*/
+extern StgClosure* MarkRoot ( StgClosure* );
+
 /*#define DEBUG_SHOWUSE*/
 
 /* --------------------------------------------------------------------------
@@ -493,7 +500,7 @@ static Bool debugStorageExtra = FALSE;
          assert(n < TAB_BASE_ADDR+tab_size);                            \
          assert(tab_name[n-TAB_BASE_ADDR].inUse);                       \
          tab_name[n-TAB_BASE_ADDR].inUse = FALSE;                       \
-         if (!debugStorageExtra) {                                      \
+         if (1 || (!debugStorageExtra)) {                               \
             tab_name[n-TAB_BASE_ADDR].nextFree = free_list;             \
             free_list = n;                                              \
          }                                                              \
@@ -1947,7 +1954,7 @@ void markHugsObjects( void )
            Cell cl = name(nm).closure;
            if (nonNull(cl)) {
               assert(isCPtr(cl));
-              snd(cl) = MarkRoot ( snd(cl) );
+              snd(cl) = (Cell)MarkRoot ( (StgClosure*)(snd(cl)) );
 	   }
        }
     }
@@ -1958,7 +1965,7 @@ void markHugsObjects( void )
            Cell cl = tycon(tc).closure;
            if (nonNull(cl)) {
               assert(isCPtr(cl));
-              snd(cl) = MarkRoot ( snd(cl) );
+              snd(cl) = (Cell)MarkRoot ( (StgClosure*)(snd(cl)) );
 	   }
        }
     }
@@ -2220,79 +2227,32 @@ Cell c; {                               /* except that Cells refering to   */
  * 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