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

4 files changed, 23 insertions, 21 deletions

diff --git a/rts/sm/Compact.c b/rts/sm/Compact.c
index 4ded5bf92b..ec178e91ef 100644
--- a/rts/sm/Compact.c
+++ b/rts/sm/Compact.c
@@ -169,7 +169,8 @@ loop:
     case 1:
     {
         StgWord r = *(StgPtr)(q-1);
-        ASSERT(LOOKS_LIKE_INFO_PTR((StgWord)UNTAG_CLOSURE((StgClosure *)r)));
+        ASSERT(LOOKS_LIKE_INFO_PTR((StgWord)
+               UNTAG_CONST_CLOSURE((StgClosure *)r)));
         return r;
     }
     case 2:
@@ -539,7 +540,7 @@ update_fwd_large( bdescr *bd )
 
 // ToDo: too big to inline
 static /* STATIC_INLINE */ StgPtr
-thread_obj (StgInfoTable *info, StgPtr p)
+thread_obj (const StgInfoTable *info, StgPtr p)
 {
     switch (info->type) {
     case THUNK_0_1:
@@ -738,7 +739,7 @@ update_fwd( bdescr *blocks )
 {
     StgPtr p;
     bdescr *bd;
-    StgInfoTable *info;
+    const StgInfoTable *info;
 
     bd = blocks;
 
@@ -848,7 +849,7 @@ update_bkwd_compact( generation *gen )
     StgWord m;
 #endif
     bdescr *bd, *free_bd;
-    StgInfoTable *info;
+    const StgInfoTable *info;
     StgWord size;
     W_ free_blocks;
     StgWord iptr;
diff --git a/rts/sm/Sanity.c b/rts/sm/Sanity.c
index 2abe56b9bc..62d53e046d 100644
--- a/rts/sm/Sanity.c
+++ b/rts/sm/Sanity.c
@@ -83,7 +83,7 @@ checkClosureShallow( const StgClosure* p )
 {
     const StgClosure *q;
 
-    q = UNTAG_CLOSURE(p);
+    q = UNTAG_CONST_CLOSURE(p);
     ASSERT(LOOKS_LIKE_CLOSURE_PTR(q));
 
     /* Is it a static closure? */
@@ -137,11 +137,11 @@ checkStackFrame( StgPtr c )
 
     case RET_FUN:
     {
-        StgFunInfoTable *fun_info;
+        const StgFunInfoTable *fun_info;
         StgRetFun *ret_fun;
 
         ret_fun = (StgRetFun *)c;
-        fun_info = get_fun_itbl(UNTAG_CLOSURE(ret_fun->fun));
+        fun_info = get_fun_itbl(UNTAG_CONST_CLOSURE(ret_fun->fun));
         size = ret_fun->size;
         switch (fun_info->f.fun_type) {
         case ARG_GEN:
@@ -182,10 +182,10 @@ checkStackChunk( StgPtr sp, StgPtr stack_end )
 static void
 checkPAP (StgClosure *tagged_fun, StgClosure** payload, StgWord n_args)
 {
-    StgClosure *fun;
-    StgFunInfoTable *fun_info;
+    const StgClosure *fun;
+    const StgFunInfoTable *fun_info;
 
-    fun = UNTAG_CLOSURE(tagged_fun);
+    fun = UNTAG_CONST_CLOSURE(tagged_fun);
     ASSERT(LOOKS_LIKE_CLOSURE_PTR(fun));
     fun_info = get_fun_itbl(fun);
 
@@ -217,13 +217,13 @@ checkPAP (StgClosure *tagged_fun, StgClosure** payload, StgWord n_args)
 
 
 StgOffset
-checkClosure( StgClosure* p )
+checkClosure( const StgClosure* p )
 {
     const StgInfoTable *info;
 
     ASSERT(LOOKS_LIKE_CLOSURE_PTR(p));
 
-    p = UNTAG_CLOSURE(p);
+    p = UNTAG_CONST_CLOSURE(p);
     /* Is it a static closure (i.e. in the data segment)? */
     if (!HEAP_ALLOCED(p)) {
         ASSERT(closure_STATIC(p));
@@ -634,7 +634,7 @@ void
 checkStaticObjects ( StgClosure* static_objects )
 {
   StgClosure *p = static_objects;
-  StgInfoTable *info;
+  const StgInfoTable *info;
 
   while (p != END_OF_STATIC_OBJECT_LIST) {
     p = UNTAG_STATIC_LIST_PTR(p);
@@ -643,8 +643,9 @@ checkStaticObjects ( StgClosure* static_objects )
     switch (info->type) {
     case IND_STATIC:
       {
-        StgClosure *indirectee = UNTAG_CLOSURE(((StgIndStatic *)p)->indirectee);
+        const StgClosure *indirectee;
 
+        indirectee = UNTAG_CONST_CLOSURE(((StgIndStatic *)p)->indirectee);
         ASSERT(LOOKS_LIKE_CLOSURE_PTR(indirectee));
         ASSERT(LOOKS_LIKE_INFO_PTR((StgWord)indirectee->header.info));
         p = *IND_STATIC_LINK((StgClosure *)p);
diff --git a/rts/sm/Sanity.h b/rts/sm/Sanity.h
index f302bc22b1..273efe2dc9 100644
--- a/rts/sm/Sanity.h
+++ b/rts/sm/Sanity.h
@@ -31,7 +31,7 @@ void checkGlobalTSOList ( rtsBool checkTSOs );
 void checkStaticObjects ( StgClosure* static_objects );
 void checkStackChunk    ( StgPtr sp, StgPtr stack_end );
 StgOffset checkStackFrame ( StgPtr sp );
-StgOffset checkClosure  ( StgClosure* p );
+StgOffset checkClosure  ( const StgClosure* p );
 
 void checkRunQueue      (Capability *cap);
 
diff --git a/rts/sm/Scav.c b/rts/sm/Scav.c
index 7a799d6be6..18a30d3bdf 100644
--- a/rts/sm/Scav.c
+++ b/rts/sm/Scav.c
@@ -195,7 +195,7 @@ scavenge_small_bitmap (StgPtr p, StgWord size, StgWord bitmap)
    -------------------------------------------------------------------------- */
 
 STATIC_INLINE StgPtr
-scavenge_arg_block (StgFunInfoTable *fun_info, StgClosure **args)
+scavenge_arg_block (const StgFunInfoTable *fun_info, StgClosure **args)
 {
     StgPtr p;
     StgWord bitmap;
@@ -227,9 +227,9 @@ scavenge_PAP_payload (StgClosure *fun, StgClosure **payload, StgWord size)
 {
     StgPtr p;
     StgWord bitmap;
-    StgFunInfoTable *fun_info;
+    const StgFunInfoTable *fun_info;
 
-    fun_info = get_fun_itbl(UNTAG_CLOSURE(fun));
+    fun_info = get_fun_itbl(UNTAG_CONST_CLOSURE(fun));
     ASSERT(fun_info->i.type != PAP);
     p = (StgPtr)payload;
 
@@ -407,7 +407,7 @@ static GNUC_ATTR_HOT void
 scavenge_block (bdescr *bd)
 {
   StgPtr p, q;
-  StgInfoTable *info;
+  const StgInfoTable *info;
   rtsBool saved_eager_promotion;
   gen_workspace *ws;
 
@@ -847,7 +847,7 @@ static void
 scavenge_mark_stack(void)
 {
     StgPtr p, q;
-    StgInfoTable *info;
+    const StgInfoTable *info;
     rtsBool saved_eager_promotion;
 
     gct->evac_gen_no = oldest_gen->no;
@@ -1916,7 +1916,7 @@ scavenge_stack(StgPtr p, StgPtr stack_end)
     case RET_FUN:
     {
         StgRetFun *ret_fun = (StgRetFun *)p;
-        StgFunInfoTable *fun_info;
+        const StgFunInfoTable *fun_info;
 
         evacuate(&ret_fun->fun);
         fun_info = get_fun_itbl(UNTAG_CLOSURE(ret_fun->fun));