rts: More const correct-ness fixes
authorErik de Castro Lopo <erikd@mega-nerd.com>
Tue, 17 May 2016 20:33:03 +0000 (06:33 +1000)
committerErik de Castro Lopo <erikd@mega-nerd.com>
Tue, 17 May 2016 20:33:03 +0000 (06:33 +1000)
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

21 files changed:
includes/rts/storage/ClosureMacros.h
includes/rts/storage/InfoTables.h
rts/CheckUnload.c
rts/Hash.c
rts/Hash.h
rts/Hpc.c
rts/Printer.c
rts/Printer.h
rts/ProfHeap.c
rts/Profiling.c
rts/RaiseAsync.c
rts/RetainerProfile.c
rts/RtsAPI.c
rts/STM.c
rts/Schedule.c
rts/Stable.c
rts/ThreadPaused.c
rts/sm/Compact.c
rts/sm/Sanity.c
rts/sm/Sanity.h
rts/sm/Scav.c

index 5ed6928..4ebec0f 100644 (file)
@@ -81,19 +81,35 @@ INLINE_HEADER StgThunkInfoTable *itbl_to_thunk_itbl(const StgInfoTable *i) {retu
 INLINE_HEADER StgConInfoTable *itbl_to_con_itbl(const StgInfoTable *i) {return (StgConInfoTable *)i;}
 #endif
 
-EXTERN_INLINE StgInfoTable *get_itbl(const StgClosure *c);
-EXTERN_INLINE StgInfoTable *get_itbl(const StgClosure *c) {return INFO_PTR_TO_STRUCT(c->header.info);}
+EXTERN_INLINE const StgInfoTable *get_itbl(const StgClosure *c);
+EXTERN_INLINE const StgInfoTable *get_itbl(const StgClosure *c)
+{
+   return INFO_PTR_TO_STRUCT(c->header.info);
+}
 
-EXTERN_INLINE StgRetInfoTable *get_ret_itbl(const StgClosure *c);
-EXTERN_INLINE StgRetInfoTable *get_ret_itbl(const StgClosure *c) {return RET_INFO_PTR_TO_STRUCT(c->header.info);}
+EXTERN_INLINE const StgRetInfoTable *get_ret_itbl(const StgClosure *c);
+EXTERN_INLINE const StgRetInfoTable *get_ret_itbl(const StgClosure *c)
+{
+   return RET_INFO_PTR_TO_STRUCT(c->header.info);
+}
 
-INLINE_HEADER StgFunInfoTable *get_fun_itbl(const StgClosure *c) {return FUN_INFO_PTR_TO_STRUCT(c->header.info);}
+INLINE_HEADER const StgFunInfoTable *get_fun_itbl(const StgClosure *c)
+{
+   return FUN_INFO_PTR_TO_STRUCT(c->header.info);
+}
 
-INLINE_HEADER StgThunkInfoTable *get_thunk_itbl(const StgClosure *c) {return THUNK_INFO_PTR_TO_STRUCT(c->header.info);}
+INLINE_HEADER const StgThunkInfoTable *get_thunk_itbl(const StgClosure *c)
+{
+   return THUNK_INFO_PTR_TO_STRUCT(c->header.info);
+}
 
-INLINE_HEADER StgConInfoTable *get_con_itbl(const StgClosure *c) {return CON_INFO_PTR_TO_STRUCT((c)->header.info);}
+INLINE_HEADER const StgConInfoTable *get_con_itbl(const StgClosure *c)
+{
+   return CON_INFO_PTR_TO_STRUCT((c)->header.info);
+}
 
-INLINE_HEADER StgHalfWord GET_TAG(const StgClosure *con) {
+INLINE_HEADER StgHalfWord GET_TAG(const StgClosure *con)
+{
     return get_itbl(con)->srt_bitmap;
 }
 
@@ -200,11 +216,17 @@ GET_CLOSURE_TAG(const StgClosure * p)
 }
 
 static inline StgClosure *
-UNTAG_CLOSURE(const StgClosure * p)
+UNTAG_CLOSURE(StgClosure * p)
 {
     return (StgClosure*)((StgWord)p & ~TAG_MASK);
 }
 
+static inline const StgClosure *
+UNTAG_CONST_CLOSURE(const StgClosure * p)
+{
+    return (const StgClosure*)((StgWord)p & ~TAG_MASK);
+}
+
 static inline StgClosure *
 TAG_CLOSURE(StgWord tag,StgClosure * p)
 {
@@ -249,7 +271,8 @@ INLINE_HEADER rtsBool LOOKS_LIKE_INFO_PTR (StgWord p)
 
 INLINE_HEADER rtsBool LOOKS_LIKE_CLOSURE_PTR (const void *p)
 {
-    return LOOKS_LIKE_INFO_PTR((StgWord)(UNTAG_CLOSURE((StgClosure *)(p)))->header.info);
+    return LOOKS_LIKE_INFO_PTR((StgWord)
+            (UNTAG_CONST_CLOSURE((const StgClosure *)(p)))->header.info);
 }
 
 /* -----------------------------------------------------------------------------
@@ -337,9 +360,10 @@ EXTERN_INLINE StgWord bco_sizeW ( StgBCO *bco )
  *
  * (Also for 'closure_sizeW' below)
  */
-EXTERN_INLINE uint32_t closure_sizeW_ (const StgClosure *p, StgInfoTable *info);
 EXTERN_INLINE uint32_t
-closure_sizeW_ (const StgClosure *p, StgInfoTable *info)
+closure_sizeW_ (const StgClosure *p, const StgInfoTable *info);
+EXTERN_INLINE uint32_t
+closure_sizeW_ (const StgClosure *p, const StgInfoTable *info)
 {
     switch (info->type) {
     case THUNK_0_1:
@@ -412,7 +436,7 @@ EXTERN_INLINE uint32_t closure_sizeW (const StgClosure *p)
 EXTERN_INLINE StgWord stack_frame_sizeW( StgClosure *frame );
 EXTERN_INLINE StgWord stack_frame_sizeW( StgClosure *frame )
 {
-    StgRetInfoTable *info;
+    const StgRetInfoTable *info;
 
     info = get_ret_itbl(frame);
     switch (info->i.type) {
index b165be2..fb14ac5 100644 (file)
@@ -73,7 +73,8 @@ typedef struct {
 
 extern StgWord16 closure_flags[];
 
-#define closureFlags(c)         (closure_flags[get_itbl(UNTAG_CLOSURE(c))->type])
+#define closureFlags(c)         (closure_flags[get_itbl \
+                                    (UNTAG_CONST_CLOSURE(c))->type])
 
 #define closure_HNF(c)          (  closureFlags(c) & _HNF)
 #define closure_BITMAP(c)       (  closureFlags(c) & _BTM)
@@ -343,9 +344,10 @@ typedef struct StgConInfoTable_ {
  * info must be a StgConInfoTable*.
  */
 #ifdef TABLES_NEXT_TO_CODE
-#define GET_CON_DESC(info) ((char *)((StgWord)((info)+1) + (info->con_desc)))
+#define GET_CON_DESC(info) \
+            ((const char *)((StgWord)((info)+1) + (info->con_desc)))
 #else
-#define GET_CON_DESC(info) ((info)->con_desc)
+#define GET_CON_DESC(info) ((const char *)(info)->con_desc)
 #endif
 
 /*
index bb51638..d303315 100644 (file)
@@ -38,7 +38,7 @@
 // object as referenced so that it won't get unloaded in this round.
 //
 
-static void checkAddress (HashTable *addrs, void *addr)
+static void checkAddress (HashTable *addrs, const void *addr)
 {
     ObjectCode *oc;
     int i;
@@ -73,7 +73,7 @@ static void searchStackChunk (HashTable *addrs, StgPtr sp, StgPtr stack_end)
         switch (info->i.type) {
         case RET_SMALL:
         case RET_BIG:
-            checkAddress(addrs, (void*)info);
+            checkAddress(addrs, (const void*)info);
             break;
 
         default:
@@ -88,7 +88,7 @@ static void searchStackChunk (HashTable *addrs, StgPtr sp, StgPtr stack_end)
 static void searchHeapBlocks (HashTable *addrs, bdescr *bd)
 {
     StgPtr p;
-    StgInfoTable *info;
+    const StgInfoTable *info;
     uint32_t size;
     rtsBool prim;
 
index b0939c4..1b193e3 100644 (file)
@@ -29,7 +29,7 @@
 /* Linked list of (key, data) pairs for separate chaining */
 typedef struct hashlist {
     StgWord key;
-    void *data;
+    const void *data;
     struct hashlist *next;  /* Next cell in bucket chain (same hash value) */
 } HashList;
 
@@ -200,7 +200,7 @@ lookupHashTable(const HashTable *table, StgWord key)
 
     for (hl = table->dir[segment][index]; hl != NULL; hl = hl->next)
         if (table->compare(hl->key, key))
-            return hl->data;
+            return (void *) hl->data;
 
     /* It's not there */
     return NULL;
@@ -274,7 +274,7 @@ freeHashList (HashTable *table, HashList *hl)
 }
 
 void
-insertHashTable(HashTable *table, StgWord key, void *data)
+insertHashTable(HashTable *table, StgWord key, const void *data)
 {
     int bucket;
     int segment;
@@ -323,7 +323,7 @@ removeHashTable(HashTable *table, StgWord key, void *data)
                 prev->next = hl->next;
             freeHashList(table,hl);
             table->kcount--;
-            return hl->data;
+            return (void *) hl->data;
         }
         prev = hl;
     }
@@ -357,7 +357,7 @@ freeHashTable(HashTable *table, void (*freeDataFun)(void *) )
             for (hl = table->dir[segment][index]; hl != NULL; hl = next) {
                 next = hl->next;
                 if (freeDataFun != NULL)
-                    (*freeDataFun)(hl->data);
+                    (*freeDataFun)((void *) hl->data);
             }
             index--;
         }
index c2dfc26..2d0c558 100644 (file)
 
 typedef struct hashtable HashTable; /* abstract */
 
-/* Hash table access where the keys are StgWords */
+/* Hash table access where the keys are StgWords.
+ * Values are passed into the hash table and stored as `const void *` values,
+ * but when the value is looked up or removed, the value is returned without the
+ * `const` so that calling function can mutate what the pointer points to if it
+ * needs to.
+ */
 HashTable * allocHashTable    ( void );
+void        insertHashTable ( HashTable *table, StgWord key, const void *data );
 void *      lookupHashTable ( const HashTable *table, StgWord key );
-void        insertHashTable ( HashTable *table, StgWord key, void *data );
 void *      removeHashTable ( HashTable *table, StgWord key, void *data );
 
 int keyCountHashTable (HashTable *table);
index b222816..70bf57b 100644 (file)
--- a/rts/Hpc.c
+++ b/rts/Hpc.c
@@ -106,7 +106,8 @@ static StgWord64 expectWord64(void) {
 static void
 readTix(void) {
   unsigned int i;
-  HpcModuleInfo *tmpModule, *lookup;
+  HpcModuleInfo *tmpModule;
+  const HpcModuleInfo *lookup;
 
   ws();
   expect('T');
index b4400da..c33e341 100644 (file)
@@ -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]);
 }
index 31185aa..bd2db35 100644 (file)
 extern void        printPtr        ( StgPtr p );
 extern void        printObj        ( StgClosure *obj );
 
-extern char *      closure_type_names[];
+extern const char *  closure_type_names[];
 
-void               info_hdr_type   ( StgClosure *closure, char *res );
-char  *            info_type       ( StgClosure *closure );
-char  *            info_type_by_ip ( StgInfoTable *ip );
-char  *            info_update_frame ( StgClosure *closure );
+void               info_hdr_type   ( const StgClosure *closure, char *res );
+const char  *      info_type       ( const StgClosure *closure );
+const char  *      info_type_by_ip ( const StgInfoTable *ip );
+const char  *      info_update_frame ( const StgClosure *closure );
 
 #ifdef DEBUG
-extern void        prettyPrintClosure (StgClosure *obj);
-extern void        printClosure    ( StgClosure *obj );
+extern void        prettyPrintClosure (const StgClosure *obj);
+extern void        printClosure    ( const StgClosure *obj );
 extern void        printStackChunk ( StgPtr sp, StgPtr spLim );
 extern void        printTSO        ( StgTSO *tso );
 
@@ -31,7 +31,7 @@ extern void DEBUG_LoadSymbols( char *name );
 
 extern const char *lookupGHCName( void *addr );
 
-extern char *what_next_strs[];
+extern const char *what_next_strs[];
 #endif
 
 #include "EndPrivate.h"
index e98704d..9557648 100644 (file)
@@ -48,7 +48,7 @@ static uint32_t max_era;
  * lag/drag/void counters for each identity.
  * -------------------------------------------------------------------------- */
 typedef struct _counter {
-    void *identity;
+    const void *identity;
     union {
         ssize_t resid;
         struct {
@@ -103,7 +103,7 @@ static rtsBool closureSatisfiesConstraints( const StgClosure* p );
  * the band to which this closure's heap space is attributed in the
  * heap profile.
  * ------------------------------------------------------------------------- */
-static void *
+static const void *
 closureIdentity( const StgClosure *p )
 {
     switch (RtsFlags.ProfFlags.doHeapProfile) {
@@ -128,7 +128,7 @@ closureIdentity( const StgClosure *p )
 #else
     case HEAP_BY_CLOSURE_TYPE:
     {
-        StgInfoTable *info;
+        const StgInfoTable *info;
         info = get_itbl(p);
         switch (info->type) {
         case CONSTR:
@@ -183,7 +183,7 @@ doingRetainerProfiling( void )
 void
 LDV_recordDead( const StgClosure *c, uint32_t size )
 {
-    void *id;
+    const void *id;
     uint32_t t;
     counter *ctr;
 
@@ -221,7 +221,7 @@ LDV_recordDead( const StgClosure *c, uint32_t size )
                     censuses[t+1].drag_total += size;
                     censuses[era].drag_total -= size;
                 } else {
-                    void *id;
+                    const void *id;
                     id = closureIdentity(c);
                     ctr = lookupHashTable(censuses[t+1].hash, (StgWord)id);
                     ASSERT( ctr != NULL );
@@ -843,7 +843,7 @@ static void heapProfObject(Census *census, StgClosure *p, size_t size,
 #endif
                            )
 {
-    void *identity;
+    const void *identity;
     size_t real_size;
     counter *ctr;
 
@@ -871,7 +871,7 @@ static void heapProfObject(Census *census, StgClosure *p, size_t size,
                     identity = closureIdentity((StgClosure *)p);
 
                     if (identity != NULL) {
-                        ctr = lookupHashTable( census->hash, (StgWord)identity );
+                        ctr = lookupHashTable(census->hash, (StgWord)identity);
                         if (ctr != NULL) {
 #ifdef PROFILING
                             if (RtsFlags.ProfFlags.bioSelector != NULL) {
@@ -920,7 +920,7 @@ static void
 heapCensusChain( Census *census, bdescr *bd )
 {
     StgPtr p;
-    StgInfoTable *info;
+    const StgInfoTable *info;
     size_t size;
     rtsBool prim;
 
@@ -953,7 +953,7 @@ heapCensusChain( Census *census, bdescr *bd )
         }
 
         while (p < bd->free) {
-            info = get_itbl((StgClosure *)p);
+            info = get_itbl((const StgClosure *)p);
             prim = rtsFalse;
 
             switch (info->type) {
index f6430ae..a4fc281 100644 (file)
@@ -1107,9 +1107,9 @@ fprintCCS_stderr (CostCentreStack *ccs, StgClosure *exception, StgTSO *tso)
     const uint32_t MAX_DEPTH = 10; // don't print gigantic chains of stacks
 
     {
-        char *desc;
-        StgInfoTable *info;
-        info = get_itbl(UNTAG_CLOSURE(exception));
+        const char *desc;
+        const StgInfoTable *info;
+        info = get_itbl(UNTAG_CONST_CLOSURE(exception));
         switch (info->type) {
         case CONSTR:
         case CONSTR_1_0:
index f55a4c2..c67aa4c 100644 (file)
@@ -778,7 +778,7 @@ StgTSO *
 raiseAsync(Capability *cap, StgTSO *tso, StgClosure *exception,
            rtsBool stop_at_atomically, StgUpdateFrame *stop_here)
 {
-    StgRetInfoTable *info;
+    const StgRetInfoTable *info;
     StgPtr sp, frame;
     StgClosure *updatee;
     uint32_t i;
index 7c3b9da..3fe0f8b 100644 (file)
@@ -1362,7 +1362,7 @@ retainStack( StgClosure *c, retainer c_child_r,
             StgFunInfoTable *fun_info;
 
             retainClosure(ret_fun->fun, c, c_child_r);
-            fun_info = get_fun_itbl(UNTAG_CLOSURE(ret_fun->fun));
+            fun_info = get_fun_itbl(UNTAG_CONST_CLOSURE(ret_fun->fun));
 
             p = (P_)&ret_fun->payload;
             switch (fun_info->f.fun_type) {
index c64d8af..dbade8f 100644 (file)
@@ -363,9 +363,9 @@ rts_getFunPtr (HaskellObj p)
 HsBool
 rts_getBool (HaskellObj p)
 {
-    StgInfoTable *info;
+    const StgInfoTable *info;
 
-    info = get_itbl((StgClosure *)UNTAG_CLOSURE(p));
+    info = get_itbl((const StgClosure *)UNTAG_CONST_CLOSURE(p));
     if (info->srt_bitmap == 0) { // srt_bitmap is the constructor tag
         return 0;
     } else {
index 7437491..9cd0833 100644 (file)
--- a/rts/STM.c
+++ b/rts/STM.c
@@ -353,7 +353,7 @@ static void unlock_inv(StgAtomicInvariant *inv) {
 
 static StgBool watcher_is_tso(StgTVarWatchQueue *q) {
   StgClosure *c = q -> closure;
-  StgInfoTable *info = get_itbl(c);
+  const StgInfoTable *info = get_itbl(c);
   return (info -> type) == TSO;
 }
 
index 0db9ff8..8a08e35 100644 (file)
@@ -2790,7 +2790,7 @@ raiseExceptionHelper (StgRegTable *reg, StgTSO *tso, StgClosure *exception)
     Capability *cap = regTableToCapability(reg);
     StgThunk *raise_closure = NULL;
     StgPtr p, next;
-    StgRetInfoTable *info;
+    const StgRetInfoTable *info;
     //
     // This closure represents the expression 'raise# E' where E
     // is the exception raise.  It is used to overwrite all the
@@ -2899,12 +2899,12 @@ raiseExceptionHelper (StgRegTable *reg, StgTSO *tso, StgClosure *exception)
 StgWord
 findRetryFrameHelper (Capability *cap, StgTSO *tso)
 {
-  StgPtr           p, next;
-  StgRetInfoTable *info;
+  const StgRetInfoTable *info;
+  StgPtr    p, next;
 
   p = tso->stackobj->sp;
   while (1) {
-    info = get_ret_itbl((StgClosure *)p);
+    info = get_ret_itbl((const StgClosure *)p);
     next = p + stack_frame_sizeW((StgClosure *)p);
     switch (info->i.type) {
 
index 2c9480a..9f34072 100644 (file)
@@ -377,7 +377,7 @@ StgWord
 lookupStableName (StgPtr p)
 {
   StgWord sn;
-  void* sn_tmp;
+  const void* sn_tmp;
 
   stableLock();
 
index f58a51e..e9b297b 100644 (file)
@@ -192,7 +192,7 @@ void
 threadPaused(Capability *cap, StgTSO *tso)
 {
     StgClosure *frame;
-    StgRetInfoTable *info;
+    const StgRetInfoTable *info;
     const StgInfoTable *bh_info;
     const StgInfoTable *cur_bh_info USED_IF_THREADS;
     StgClosure *bh;
index 4ded5bf..ec178e9 100644 (file)
@@ -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;
index 2abe56b..62d53e0 100644 (file)
@@ -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);
index f302bc2..273efe2 100644 (file)
@@ -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);
 
index 7a799d6..18a30d3 100644 (file)
@@ -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));