rts: More const correct-ness fixes

In addition to more const-correctness fixes this patch fixes an
infelicity of the previous const-correctness patch (995cf0f356) which
left `UNTAG_CLOSURE` taking a `const StgClosure` pointer parameter
but returning a non-const pointer. Here we restore the original type
signature of `UNTAG_CLOSURE` and add a new function
`UNTAG_CONST_CLOSURE` which takes and returns a const `StgClosure`
pointer and uses that wherever possible.

Test Plan: Validate on Linux, OS X and Windows

Reviewers: Phyx, hsyl20, bgamari, austin, simonmar, trofi

Reviewed By: simonmar, trofi

Subscribers: thomie

Differential Revision: https://phabricator.haskell.org/D2231

1 files changed, 25 insertions, 24 deletions

diff --git a/rts/Printer.c b/rts/Printer.c
index b4400da5b9..c33e341d6f 100644
--- a/rts/Printer.c
+++ b/rts/Printer.c
@@ -32,7 +32,7 @@
  * local function decls
  * ------------------------------------------------------------------------*/
 
-static void    printStdObjPayload( StgClosure *obj );
+static void    printStdObjPayload( const StgClosure *obj );
 
 /* --------------------------------------------------------------------------
  * Printer
@@ -57,7 +57,7 @@ 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);
@@ -67,7 +67,7 @@ printStdObjHdr( StgClosure *obj, char* tag )
 }
 
 static void
-printStdObjPayload( StgClosure *obj )
+printStdObjPayload( const StgClosure *obj )
 {
     StgWord i, j;
     const StgInfoTable* info;
@@ -108,11 +108,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 ) {
@@ -126,7 +126,7 @@ printClosure( StgClosure *obj )
     case CONSTR_NOCAF_STATIC:
         {
             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) {
@@ -396,7 +396,8 @@ printClosure( StgClosure *obj )
 }
 
 // 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
@@ -546,7 +547,7 @@ printStackChunk( StgPtr sp, StgPtr spBottom )
 
         case RET_FUN:
         {
-            StgFunInfoTable *fun_info;
+            const StgFunInfoTable *fun_info;
             StgRetFun *ret_fun;
 
             ret_fun = (StgRetFun *)sp;
@@ -649,7 +650,7 @@ static rtsBool isReal( flagword flags STG_UNUSED, const char *name )
 #endif
 }
 
-extern void DEBUG_LoadSymbols( char *name )
+extern void DEBUG_LoadSymbols( const char *name )
 {
     bfd* abfd;
     char **matching;
@@ -725,7 +726,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
@@ -792,18 +793,17 @@ findPtr(P_ p, int follow)
    payload.
 */
 
-void prettyPrintClosure_ (StgClosure *);
+void prettyPrintClosure_ (const StgClosure *);
 
-void prettyPrintClosure (StgClosure *obj)
+void prettyPrintClosure (const StgClosure *obj)
 {
    prettyPrintClosure_ (obj);
    debugBelch ("\n");
 }
 
-void prettyPrintClosure_ (StgClosure *obj)
+void prettyPrintClosure_ (const StgClosure *obj)
 {
-    StgInfoTable *info;
-    StgConInfoTable *con_info;
+    const StgInfoTable *info;
 
     /* collapse any indirections */
     unsigned int type;
@@ -832,8 +832,9 @@ void prettyPrintClosure_ (StgClosure *obj)
         case CONSTR_STATIC:
         case CONSTR_NOCAF_STATIC:
         {
+           const StgConInfoTable *con_info;
+           const char *descriptor;
            uint32_t i;
-           char *descriptor;
 
            /* find the con_info for the constructor */
            con_info = get_con_itbl (obj);
@@ -863,7 +864,7 @@ void prettyPrintClosure_ (StgClosure *obj)
     }
 }
 
-char *what_next_strs[] = {
+const char *what_next_strs[] = {
   [0]               = "(unknown)",
   [ThreadRunGHC]    = "ThreadRunGHC",
   [ThreadInterpret] = "ThreadInterpret",
@@ -891,7 +892,7 @@ void printObj( StgClosure *obj )
    NOTE: must be kept in sync with the closure types in includes/ClosureTypes.h
    -------------------------------------------------------------------------- */
 
-char *closure_type_names[] = {
+const char *closure_type_names[] = {
  [INVALID_OBJECT]        = "INVALID_OBJECT",
  [CONSTR]                = "CONSTR",
  [CONSTR_1_0]            = "CONSTR_1_0",
@@ -954,17 +955,17 @@ char *closure_type_names[] = {
  [WHITEHOLE]             = "WHITEHOLE"
 };
 
-char *
-info_type(StgClosure *closure){
+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]);
 }