Enable two-step allocator on FreeBSD
[ghc.git] / rts / Printer.c
index b4400da..291f529 100644 (file)
 #include "rts/Bytecodes.h"  /* for InstrPtr */
 
 #include "sm/Storage.h"
+#include "sm/GCThread.h"
 #include "Hash.h"
 #include "Printer.h"
 #include "RtsUtils.h"
 
-#ifdef PROFILING
+#if defined(PROFILING)
 #include "Profiling.h"
 #endif
 
 #include <string.h>
 
-#ifdef DEBUG
+#if defined(DEBUG)
 
 #include "Disassembler.h"
 #include "Apply.h"
@@ -32,7 +33,7 @@
  * local function decls
  * ------------------------------------------------------------------------*/
 
-static void    printStdObjPayload( StgClosure *obj );
+static void    printStdObjPayload( const StgClosure *obj );
 
 /* --------------------------------------------------------------------------
  * Printer
@@ -57,17 +58,17 @@ void printObj( StgClosure *obj )
 }
 
 STATIC_INLINE void
-printStdObjHdr( StgClosure *obj, char* tag )
+printStdObjHdr( const StgClosure *obj, char* tag )
 {
     debugBelch("%s(",tag);
     printPtr((StgPtr)obj->header.info);
-#ifdef PROFILING
+#if defined(PROFILING)
     debugBelch(", %s", obj->header.prof.ccs->cc->label);
 #endif
 }
 
 static void
-printStdObjPayload( StgClosure *obj )
+printStdObjPayload( const StgClosure *obj )
 {
     StgWord i, j;
     const StgInfoTable* info;
@@ -108,11 +109,11 @@ printThunkObject( StgThunk *obj, char* tag )
 }
 
 void
-printClosure( StgClosure *obj )
+printClosure( const StgClosure *obj )
 {
-    obj = UNTAG_CLOSURE(obj);
+    const StgInfoTable *info;
 
-    StgInfoTable *info;
+    obj = UNTAG_CONST_CLOSURE(obj);
     info = get_itbl(obj);
 
     switch ( info->type ) {
@@ -122,11 +123,10 @@ printClosure( StgClosure *obj )
     case CONSTR:
     case CONSTR_1_0: case CONSTR_0_1:
     case CONSTR_1_1: case CONSTR_0_2: case CONSTR_2_0:
-    case CONSTR_STATIC:
-    case CONSTR_NOCAF_STATIC:
+    case CONSTR_NOCAF:
         {
             StgWord i, j;
-            StgConInfoTable *con_info = get_con_itbl (obj);
+            const StgConInfoTable *con_info = get_con_itbl (obj);
 
             debugBelch("%s(", GET_CON_DESC(con_info));
             for (i = 0; i < info->layout.payload.ptrs; ++i) {
@@ -147,7 +147,7 @@ printClosure( StgClosure *obj )
     case FUN_STATIC:
         debugBelch("FUN/%d(",(int)itbl_to_fun_itbl(info)->f.arity);
         printPtr((StgPtr)obj->header.info);
-#ifdef PROFILING
+#if defined(PROFILING)
         debugBelch(", %s", obj->header.prof.ccs->cc->label);
 #endif
         printStdObjPayload(obj);
@@ -170,7 +170,7 @@ printClosure( StgClosure *obj )
     case THUNK_1_1: case THUNK_0_2: case THUNK_2_0:
     case THUNK_STATIC:
             /* ToDo: will this work for THUNK_STATIC too? */
-#ifdef PROFILING
+#if defined(PROFILING)
             printThunkObject((StgThunk *)obj,GET_PROF_DESC(info));
 #else
             printThunkObject((StgThunk *)obj,"THUNK");
@@ -309,8 +309,8 @@ printClosure( StgClosure *obj )
         debugBelch("MUT_ARR_PTRS_DIRTY(size=%" FMT_Word ")\n", (W_)((StgMutArrPtrs *)obj)->ptrs);
         break;
 
-    case MUT_ARR_PTRS_FROZEN:
-        debugBelch("MUT_ARR_PTRS_FROZEN(size=%" FMT_Word ")\n", (W_)((StgMutArrPtrs *)obj)->ptrs);
+    case MUT_ARR_PTRS_FROZEN_CLEAN:
+        debugBelch("MUT_ARR_PTRS_FROZEN_CLEAN(size=%" FMT_Word ")\n", (W_)((StgMutArrPtrs *)obj)->ptrs);
         break;
 
     case SMALL_MUT_ARR_PTRS_CLEAN:
@@ -323,8 +323,8 @@ printClosure( StgClosure *obj )
                    (W_)((StgSmallMutArrPtrs *)obj)->ptrs);
         break;
 
-    case SMALL_MUT_ARR_PTRS_FROZEN:
-        debugBelch("SMALL_MUT_ARR_PTRS_FROZEN(size=%" FMT_Word ")\n",
+    case SMALL_MUT_ARR_PTRS_FROZEN_CLEAN:
+        debugBelch("SMALL_MUT_ARR_PTRS_FROZEN_CLEAN(size=%" FMT_Word ")\n",
                    (W_)((StgSmallMutArrPtrs *)obj)->ptrs);
         break;
 
@@ -332,7 +332,29 @@ printClosure( StgClosure *obj )
     case MVAR_DIRTY:
         {
           StgMVar* mv = (StgMVar*)obj;
-          debugBelch("MVAR(head=%p, tail=%p, value=%p)\n", mv->head, mv->tail, mv->value);
+
+          debugBelch("MVAR(head=");
+          if ((StgClosure*)mv->head == &stg_END_TSO_QUEUE_closure) {
+              debugBelch("END_TSO_QUEUE");
+          } else {
+              debugBelch("%p", mv->head);
+          }
+
+          debugBelch(", tail=");
+          if ((StgClosure*)mv->tail == &stg_END_TSO_QUEUE_closure) {
+              debugBelch("END_TSO_QUEUE");
+          } else {
+              debugBelch("%p", mv->tail);
+          }
+
+          debugBelch(", value=");
+          if ((StgClosure*)mv->value == &stg_END_TSO_QUEUE_closure) {
+              debugBelch("END_TSO_QUEUE");
+          } else {
+              debugBelch("%p", mv->value);
+          }
+          debugBelch(")\n");
+
           break;
         }
 
@@ -359,7 +381,7 @@ printClosure( StgClosure *obj )
 
     case WEAK:
             debugBelch("WEAK(");
-            debugBelch(" key=%p value=%p finalizer=%p",
+            debugBelch("key=%p value=%p finalizer=%p",
                     (StgPtr)(((StgWeak*)obj)->key),
                     (StgPtr)(((StgWeak*)obj)->value),
                     (StgPtr)(((StgWeak*)obj)->finalizer));
@@ -374,7 +396,7 @@ printClosure( StgClosure *obj )
       break;
 
     case STACK:
-      debugBelch("STACK");
+      debugBelch("STACK\n");
       break;
 
 #if 0
@@ -386,6 +408,15 @@ printClosure( StgClosure *obj )
       break;
 #endif
 
+    case COMPACT_NFDATA:
+        debugBelch("COMPACT_NFDATA(size=%" FMT_Word ")\n",
+                   (W_)((StgCompactNFData *)obj)->totalW * (W_)sizeof(W_));
+        break;
+
+    case TREC_CHUNK:
+        debugBelch("TREC_CHUNK\n");
+        break;
+
     default:
             //barf("printClosure %d",get_itbl(obj)->type);
             debugBelch("*** printClosure: unknown type %d ****\n",
@@ -395,8 +426,24 @@ printClosure( StgClosure *obj )
     }
 }
 
+void
+printMutableList(bdescr *bd)
+{
+    StgPtr p;
+
+    debugBelch("mutable list %p: ", bd);
+
+    for (; bd != NULL; bd = bd->link) {
+        for (p = bd->start; p < bd->free; p++) {
+            debugBelch("%p (%s), ", (void *)*p, info_type((StgClosure *)*p));
+        }
+    }
+    debugBelch("\n");
+}
+
 // If you know you have an UPDATE_FRAME, but want to know exactly which.
-char *info_update_frame(StgClosure *closure) {
+const char *info_update_frame(const StgClosure *closure)
+{
     // Note: We intentionally don't take the info table pointer as
     // an argument. As it will be confusing whether one should pass
     // it pointing to the code or struct members when compiling with
@@ -413,13 +460,6 @@ char *info_update_frame(StgClosure *closure) {
     }
 }
 
-/*
-void printGraph( StgClosure *obj )
-{
- printClosure(obj);
-}
-*/
-
 static void
 printSmallBitmap( StgPtr spBottom, StgPtr payload, StgWord bitmap,
                     uint32_t size )
@@ -514,12 +554,29 @@ printStackChunk( StgPtr sp, StgPtr spBottom )
                 debugBelch("stg_ap_ppppp_info\n" );
             } else if (c == (StgWord)&stg_ap_pppppp_info) {
                 debugBelch("stg_ap_pppppp_info\n" );
-#ifdef PROFILING
+            } else if (c == (StgWord)&stg_ret_v_info) {
+                debugBelch("stg_ret_v_info\n" );
+            } else if (c == (StgWord)&stg_ret_p_info) {
+                debugBelch("stg_ret_p_info\n" );
+            } else if (c == (StgWord)&stg_ret_n_info) {
+                debugBelch("stg_ret_n_info\n" );
+            } else if (c == (StgWord)&stg_ret_f_info) {
+                debugBelch("stg_ret_f_info\n" );
+            } else if (c == (StgWord)&stg_ret_d_info) {
+                debugBelch("stg_ret_d_info\n" );
+            } else if (c == (StgWord)&stg_ret_l_info) {
+                debugBelch("stg_ret_l_info\n" );
+#if defined(PROFILING)
             } else if (c == (StgWord)&stg_restore_cccs_info) {
                 debugBelch("stg_restore_cccs_info\n" );
                 fprintCCS(stderr, (CostCentreStack*)sp[1]);
                 debugBelch("\n" );
                 continue;
+            } else if (c == (StgWord)&stg_restore_cccs_eval_info) {
+                debugBelch("stg_restore_cccs_eval_info\n" );
+                fprintCCS(stderr, (CostCentreStack*)sp[1]);
+                debugBelch("\n" );
+                continue;
 #endif
             } else {
                 debugBelch("RET_SMALL (%p)\n", info);
@@ -546,7 +603,7 @@ printStackChunk( StgPtr sp, StgPtr spBottom )
 
         case RET_FUN:
         {
-            StgFunInfoTable *fun_info;
+            const StgFunInfoTable *fun_info;
             StgRetFun *ret_fun;
 
             ret_fun = (StgRetFun *)sp;
@@ -579,10 +636,14 @@ printStackChunk( StgPtr sp, StgPtr spBottom )
     }
 }
 
+static void printStack( StgStack *stack )
+{
+    printStackChunk( stack->sp, stack->stack + stack->stack_size );
+}
+
 void printTSO( StgTSO *tso )
 {
-    printStackChunk( tso->stackobj->sp,
-                     tso->stackobj->stack+tso->stackobj->stack_size);
+    printStack( tso->stackobj );
 }
 
 /* --------------------------------------------------------------------------
@@ -613,7 +674,7 @@ const char *lookupGHCName( void *addr )
 /* Causing linking trouble on Win32 plats, so I'm
    disabling this for now.
 */
-#ifdef USING_LIBBFD
+#if defined(USING_LIBBFD)
 #    define PACKAGE 1
 #    define PACKAGE_VERSION 1
 /* Those PACKAGE_* defines are workarounds for bfd:
@@ -629,7 +690,7 @@ const char *lookupGHCName( void *addr )
  * rubbish like the obj-splitting symbols
  */
 
-static rtsBool isReal( flagword flags STG_UNUSED, const char *name )
+static bool isReal( flagword flags STG_UNUSED, const char *name )
 {
 #if 0
     /* ToDo: make this work on BFD */
@@ -637,19 +698,19 @@ static rtsBool isReal( flagword flags STG_UNUSED, const char *name )
     if (tp == N_TEXT || tp == N_DATA) {
         return (name[0] == '_' && name[1] != '_');
     } else {
-        return rtsFalse;
+        return false;
     }
 #else
     if (*name == '\0'  ||
         (name[0] == 'g' && name[1] == 'c' && name[2] == 'c') ||
         (name[0] == 'c' && name[1] == 'c' && name[2] == '.')) {
-        return rtsFalse;
+        return false;
     }
-    return rtsTrue;
+    return true;
 #endif
 }
 
-extern void DEBUG_LoadSymbols( char *name )
+extern void DEBUG_LoadSymbols( const char *name )
 {
     bfd* abfd;
     char **matching;
@@ -707,7 +768,7 @@ extern void DEBUG_LoadSymbols( char *name )
 
 #else /* USING_LIBBFD */
 
-extern void DEBUG_LoadSymbols( char *name STG_UNUSED )
+extern void DEBUG_LoadSymbols( const char *name STG_UNUSED )
 {
   /* nothing, yet */
 }
@@ -725,7 +786,7 @@ findPtrBlocks (StgPtr p, bdescr *bd, StgPtr arr[], int arr_size, int i)
     for (; bd; bd = bd->link) {
         searched++;
         for (q = bd->start; q < bd->free; q++) {
-            if (UNTAG_CLOSURE((StgClosure*)*q) == (StgClosure *)p) {
+            if (UNTAG_CONST_CLOSURE((StgClosure*)*q) == (const StgClosure *)p) {
                 if (i < arr_size) {
                     for (r = bd->start; r < bd->free; r = end) {
                         // skip over zeroed-out slop
@@ -765,11 +826,16 @@ findPtr(P_ p, int follow)
   int i = 0;
   searched = 0;
 
+#if 0
+  // We can't search the nursery, because we don't know which blocks contain
+  // valid data, because the bd->free pointers in the nursery are only reset
+  // just before a block is used.
   for (n = 0; n < n_capabilities; n++) {
       bd = nurseries[i].blocks;
       i = findPtrBlocks(p,bd,arr,arr_size,i);
       if (i >= arr_size) return;
   }
+#endif
 
   for (g = 0; g < RtsFlags.GcFlags.generations; g++) {
       bd = generations[g].blocks;
@@ -777,6 +843,13 @@ findPtr(P_ p, int follow)
       bd = generations[g].large_objects;
       i = findPtrBlocks(p,bd,arr,arr_size,i);
       if (i >= arr_size) return;
+      for (n = 0; n < n_capabilities; n++) {
+          i = findPtrBlocks(p, gc_threads[n]->gens[g].part_list,
+                            arr, arr_size, i);
+          i = findPtrBlocks(p, gc_threads[n]->gens[g].todo_bd,
+                            arr, arr_size, i);
+      }
+      if (i >= arr_size) return;
   }
   if (follow && i == 1) {
       debugBelch("-->\n");
@@ -784,86 +857,7 @@ findPtr(P_ p, int follow)
   }
 }
 
-/* prettyPrintClosure() is for printing out a closure using the data constructor
-   names found in the info tables. Closures are printed in a fashion that resembles
-   their Haskell representation. Useful during debugging.
-
-   Todo: support for more closure types, and support for non pointer fields in the
-   payload.
-*/
-
-void prettyPrintClosure_ (StgClosure *);
-
-void prettyPrintClosure (StgClosure *obj)
-{
-   prettyPrintClosure_ (obj);
-   debugBelch ("\n");
-}
-
-void prettyPrintClosure_ (StgClosure *obj)
-{
-    StgInfoTable *info;
-    StgConInfoTable *con_info;
-
-    /* collapse any indirections */
-    unsigned int type;
-    type = get_itbl(obj)->type;
-
-    while (type == IND ||
-           type == IND_STATIC)
-    {
-      obj = ((StgInd *)obj)->indirectee;
-      type = get_itbl(obj)->type;
-    }
-
-    /* find the info table for this object */
-    info = get_itbl(obj);
-
-    /* determine what kind of object we have */
-    switch (info->type)
-    {
-        /* full applications of data constructors */
-        case CONSTR:
-        case CONSTR_1_0:
-        case CONSTR_0_1:
-        case CONSTR_1_1:
-        case CONSTR_0_2:
-        case CONSTR_2_0:
-        case CONSTR_STATIC:
-        case CONSTR_NOCAF_STATIC:
-        {
-           uint32_t i;
-           char *descriptor;
-
-           /* find the con_info for the constructor */
-           con_info = get_con_itbl (obj);
-
-           /* obtain the name of the constructor */
-           descriptor = GET_CON_DESC(con_info);
-
-           debugBelch ("(%s", descriptor);
-
-           /* process the payload of the closure */
-           /* we don't handle non pointers at the moment */
-           for (i = 0; i < info->layout.payload.ptrs; i++)
-           {
-              debugBelch (" ");
-              prettyPrintClosure_ ((StgClosure *) obj->payload[i]);
-           }
-           debugBelch (")");
-           break;
-        }
-
-        /* if it isn't a constructor then just print the closure type */
-        default:
-        {
-           debugBelch ("<%s>", info_type(obj));
-           break;
-        }
-    }
-}
-
-char *what_next_strs[] = {
+const char *what_next_strs[] = {
   [0]               = "(unknown)",
   [ThreadRunGHC]    = "ThreadRunGHC",
   [ThreadInterpret] = "ThreadInterpret",
@@ -888,10 +882,11 @@ void printObj( StgClosure *obj )
 /* -----------------------------------------------------------------------------
    Closure types
 
-   NOTE: must be kept in sync with the closure types in includes/ClosureTypes.h
+   NOTE: must be kept in sync with the closure types in
+   includes/rts/storage/ClosureTypes.h
    -------------------------------------------------------------------------- */
 
-char *closure_type_names[] = {
+const char *closure_type_names[] = {
  [INVALID_OBJECT]        = "INVALID_OBJECT",
  [CONSTR]                = "CONSTR",
  [CONSTR_1_0]            = "CONSTR_1_0",
@@ -899,8 +894,7 @@ char *closure_type_names[] = {
  [CONSTR_2_0]            = "CONSTR_2_0",
  [CONSTR_1_1]            = "CONSTR_1_1",
  [CONSTR_0_2]            = "CONSTR_0_2",
- [CONSTR_STATIC]         = "CONSTR_STATIC",
- [CONSTR_NOCAF_STATIC]   = "CONSTR_NOCAF_STATIC",
+ [CONSTR_NOCAF]          = "CONSTR_NOCAF",
  [FUN]                   = "FUN",
  [FUN_1_0]               = "FUN_1_0",
  [FUN_0_1]               = "FUN_0_1",
@@ -938,8 +932,8 @@ char *closure_type_names[] = {
  [ARR_WORDS]             = "ARR_WORDS",
  [MUT_ARR_PTRS_CLEAN]    = "MUT_ARR_PTRS_CLEAN",
  [MUT_ARR_PTRS_DIRTY]    = "MUT_ARR_PTRS_DIRTY",
- [MUT_ARR_PTRS_FROZEN0]  = "MUT_ARR_PTRS_FROZEN0",
- [MUT_ARR_PTRS_FROZEN]   = "MUT_ARR_PTRS_FROZEN",
+ [MUT_ARR_PTRS_FROZEN_DIRTY]  = "MUT_ARR_PTRS_FROZEN_DIRTY",
+ [MUT_ARR_PTRS_FROZEN_CLEAN]   = "MUT_ARR_PTRS_FROZEN_CLEAN",
  [MUT_VAR_CLEAN]         = "MUT_VAR_CLEAN",
  [MUT_VAR_DIRTY]         = "MUT_VAR_DIRTY",
  [WEAK]                  = "WEAK",
@@ -951,20 +945,29 @@ char *closure_type_names[] = {
  [ATOMICALLY_FRAME]      = "ATOMICALLY_FRAME",
  [CATCH_RETRY_FRAME]     = "CATCH_RETRY_FRAME",
  [CATCH_STM_FRAME]       = "CATCH_STM_FRAME",
- [WHITEHOLE]             = "WHITEHOLE"
+ [WHITEHOLE]             = "WHITEHOLE",
+ [SMALL_MUT_ARR_PTRS_CLEAN] = "SMALL_MUT_ARR_PTRS_CLEAN",
+ [SMALL_MUT_ARR_PTRS_DIRTY] = "SMALL_MUT_ARR_PTRS_DIRTY",
+ [SMALL_MUT_ARR_PTRS_FROZEN_DIRTY] = "SMALL_MUT_ARR_PTRS_FROZEN_DIRTY",
+ [SMALL_MUT_ARR_PTRS_FROZEN_CLEAN] = "SMALL_MUT_ARR_PTRS_FROZEN_CLEAN",
+ [COMPACT_NFDATA]        = "COMPACT_NFDATA"
 };
 
-char *
-info_type(StgClosure *closure){
+#if N_CLOSURE_TYPES != 64
+#error Closure types changed: update Printer.c!
+#endif
+
+const char *
+info_type(const StgClosure *closure){
   return closure_type_names[get_itbl(closure)->type];
 }
 
-char *
-info_type_by_ip(StgInfoTable *ip){
+const char *
+info_type_by_ip(const StgInfoTable *ip){
   return closure_type_names[ip->type];
 }
 
 void
-info_hdr_type(StgClosure *closure, char *res){
+info_hdr_type(const StgClosure *closure, char *res){
   strcpy(res,closure_type_names[get_itbl(closure)->type]);
 }