[project @ 1999-11-30 16:10:07 by lewie]

[ghc-hetmet.git] / ghc / rts / Printer.c

diff --git a/ghc/rts/Printer.c b/ghc/rts/Printer.c
index 092dab3..cbb20dd 100644 (file)
--- a/ghc/rts/Printer.c
+++ b/ghc/rts/Printer.c
@@ -1,6 +1,6 @@
 
 /* -----------------------------------------------------------------------------
- * $Id: Printer.c,v 1.11 1999/04/27 12:27:49 sewardj Exp $
+ * $Id: Printer.c,v 1.18 1999/11/29 18:59:46 sewardj Exp $
  *
  * Copyright (c) 1994-1999.
  *
@@ -9,6 +9,7 @@
  * ---------------------------------------------------------------------------*/
 
 #include "Rts.h"
+#include "Printer.h"
 
 #ifdef DEBUG
 
@@ -17,8 +18,6 @@
 #include "Bytecodes.h"  /* for InstrPtr */
 #include "Disassembler.h"
 
-#include "Printer.h"
-
 /* --------------------------------------------------------------------------
  * local function decls
  * ------------------------------------------------------------------------*/
@@ -54,7 +53,9 @@ char* lookupHugsItblName ( void* v )
 
 void printPtr( StgPtr p )
 {
+#ifdef INTERPRETER
     char* str;
+#endif
     const char *raw;
     if (lookupGHCName( p, &raw )) {
         printZcoded(raw);
@@ -179,6 +180,14 @@ void printClosure( StgClosure *obj )
             fprintf(stderr,")\n"); 
             break;
 
+    case SE_BLACKHOLE:
+            fprintf(stderr,"SE_BH\n"); 
+            break;
+
+    case SE_CAF_BLACKHOLE:
+            fprintf(stderr,"SE_CAF_BH\n"); 
+            break;
+
     case BLACKHOLE:
             fprintf(stderr,"BH\n"); 
             break;
@@ -290,7 +299,8 @@ void printClosure( StgClosure *obj )
         }
     default:
             //barf("printClosure %d",get_itbl(obj)->type);
-            fprintf(stderr, "*** printClosure: unknown type %d ****\n",get_itbl(obj)->type );
+            fprintf(stderr, "*** printClosure: unknown type %d ****\n",
+                    get_itbl(obj)->type );
             return;
     }
 }
@@ -300,53 +310,14 @@ StgPtr printStackObj( StgPtr sp )
     /*fprintf(stderr,"Stack[%d] = ", &stgStack[STACK_SIZE] - sp); */
 
     if (IS_ARG_TAG(*sp)) {
-
-#ifdef DEBUG_EXTRA
-        StackTag tag = (StackTag)*sp;
-        switch ( tag ) {
-        case ILLEGAL_TAG:
-                barf("printStackObj: ILLEGAL_TAG");
-                break;
-        case REALWORLD_TAG:
-                fprintf(stderr,"RealWorld#\n");
-                break;
-        case INT_TAG:
-                fprintf(stderr,"Int# %d\n", *(StgInt*)(sp+1));
-                break;
-        case INT64_TAG:
-                fprintf(stderr,"Int64# %lld\n", *(StgInt64*)(sp+1));
-                break;
-        case WORD_TAG:
-                fprintf(stderr,"Word# %d\n", *(StgWord*)(sp+1));
-                break;
-        case ADDR_TAG:
-                fprintf(stderr,"Addr# "); printPtr(*(StgAddr*)(sp+1)); fprintf(stderr,"\n");
-                break;
-        case CHAR_TAG:
-                fprintf(stderr,"Char# %d\n", *(StgChar*)(sp+1));
-                break;
-        case FLOAT_TAG:
-                fprintf(stderr,"Float# %f\n", PK_FLT(sp+1));
-                break;
-        case DOUBLE_TAG:
-                fprintf(stderr,"Double# %f\n", PK_DBL(sp+1));
-                break;
-        default:
-                barf("printStackObj: unrecognised ARGTAG %d",tag);
+        nat i;
+        StgWord tag = *sp++;
+        fprintf(stderr,"Tagged{");
+        for (i = 0; i < tag; i++) {
+            fprintf(stderr,"0x%x#", (unsigned)(*sp++));
+            if (i < tag-1) fprintf(stderr, ", ");
         }
-        sp += 1 + ARG_SIZE(tag);
-
-#else /* !DEBUG_EXTRA */
-       {
-           StgWord tag = *sp++;
-           nat i;
-           fprintf(stderr,"Tag: %d words\n", tag);
-           for (i = 0; i < tag; i++) {
-               fprintf(stderr,"Word# %d\n", *sp++);
-           }
-       }
-#endif
-
+        fprintf(stderr, "}\n");
     } else {
         StgClosure* c = (StgClosure*)(*sp);
         printPtr((StgPtr)*sp);
@@ -704,7 +675,10 @@ static void printZcoded( const char *raw )
  * Symbol table loading
  * ------------------------------------------------------------------------*/
 
-#ifdef HAVE_BFD_H
+/* Causing linking trouble on Win32 plats, so I'm
+   disabling this for now. 
+*/
+#if defined(HAVE_BFD_H) && !defined(_WIN32)
 
 #include <bfd.h>
 
@@ -723,6 +697,7 @@ static rtsBool isReal( flagword flags, const char *name )
         return rtsFalse;
     }
 #else
+    (void)flags;   /* keep gcc -Wall happy */
     if (*name == '\0'  || 
        (name[0] == 'g' && name[1] == 'c' && name[2] == 'c') ||
        (name[0] == 'c' && name[1] == 'c' && name[2] == '.')) {
@@ -809,6 +784,28 @@ extern void DEBUG_LoadSymbols( char *name )
 
 #endif /* HAVE_BFD_H */
 
+#include "StoragePriv.h"
+
+void
+findPtr(P_ p)
+{
+  nat s, g;
+  P_ q;
+  bdescr *bd;
+
+  for (g = 0; g < RtsFlags.GcFlags.generations; g++) {
+    for (s = 0; s < generations[g].n_steps; s++) {
+      for (bd = generations[g].steps[s].blocks; bd; bd = bd->link) {
+       for (q = bd->start; q < bd->free; q++) {
+         if (*q == (W_)p) {
+           printf("%p\n", q);
+         }
+       }
+      }
+    }
+  }
+}
+
 #else /* DEBUG */
 void printPtr( StgPtr p )
 {