summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--includes/rts/storage/ClosureMacros.h50
-rw-r--r--includes/rts/storage/InfoTables.h8
-rw-r--r--rts/CheckUnload.c6
-rw-r--r--rts/Hash.c10
-rw-r--r--rts/Hash.h9
-rw-r--r--rts/Hpc.c3
-rw-r--r--rts/Printer.c49
-rw-r--r--rts/Printer.h16
-rw-r--r--rts/ProfHeap.c18
-rw-r--r--rts/Profiling.c6
-rw-r--r--rts/RaiseAsync.c2
-rw-r--r--rts/RetainerProfile.c2
-rw-r--r--rts/RtsAPI.c4
-rw-r--r--rts/STM.c2
-rw-r--r--rts/Schedule.c8
-rw-r--r--rts/Stable.c2
-rw-r--r--rts/ThreadPaused.c2
-rw-r--r--rts/sm/Compact.c9
-rw-r--r--rts/sm/Sanity.c21
-rw-r--r--rts/sm/Sanity.h2
-rw-r--r--rts/sm/Scav.c12
21 files changed, 138 insertions, 103 deletions
diff --git a/includes/rts/storage/ClosureMacros.h b/includes/rts/storage/ClosureMacros.h
index 5ed692871e..4ebec0f45f 100644
--- a/includes/rts/storage/ClosureMacros.h
+++ b/includes/rts/storage/ClosureMacros.h
@@ -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) {
diff --git a/includes/rts/storage/InfoTables.h b/includes/rts/storage/InfoTables.h
index b165be2245..fb14ac5821 100644
--- a/includes/rts/storage/InfoTables.h
+++ b/includes/rts/storage/InfoTables.h
@@ -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
/*
diff --git a/rts/CheckUnload.c b/rts/CheckUnload.c
index bb51638455..d303315981 100644
--- a/rts/CheckUnload.c
+++ b/rts/CheckUnload.c
@@ -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;
diff --git a/rts/Hash.c b/rts/Hash.c
index b0939c49bc..1b193e3247 100644
--- a/rts/Hash.c
+++ b/rts/Hash.c
@@ -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--;
}
diff --git a/rts/Hash.h b/rts/Hash.h
index c2dfc26d6d..2d0c5588c5 100644
--- a/rts/Hash.h
+++ b/rts/Hash.h
@@ -13,10 +13,15 @@
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);
diff --git a/rts/Hpc.c b/rts/Hpc.c
index b2228162f7..70bf57b396 100644
--- 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');
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]);
}
diff --git a/rts/Printer.h b/rts/Printer.h
index 31185aaf34..bd2db35aeb 100644
--- a/rts/Printer.h
+++ b/rts/Printer.h
@@ -14,16 +14,16 @@
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"
diff --git a/rts/ProfHeap.c b/rts/ProfHeap.c
index e98704d513..9557648fcc 100644
--- a/rts/ProfHeap.c
+++ b/rts/ProfHeap.c
@@ -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) {
diff --git a/rts/Profiling.c b/rts/Profiling.c
index f6430ae41a..a4fc281967 100644
--- a/rts/Profiling.c
+++ b/rts/Profiling.c
@@ -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:
diff --git a/rts/RaiseAsync.c b/rts/RaiseAsync.c
index f55a4c23de..c67aa4ce54 100644
--- a/rts/RaiseAsync.c
+++ b/rts/RaiseAsync.c
@@ -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;
diff --git a/rts/RetainerProfile.c b/rts/RetainerProfile.c
index 7c3b9dadce..3fe0f8bf9a 100644
--- a/rts/RetainerProfile.c
+++ b/rts/RetainerProfile.c
@@ -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) {
diff --git a/rts/RtsAPI.c b/rts/RtsAPI.c
index c64d8af2e4..dbade8f4f7 100644
--- a/rts/RtsAPI.c
+++ b/rts/RtsAPI.c
@@ -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 {
diff --git a/rts/STM.c b/rts/STM.c
index 7437491824..9cd0833550 100644
--- 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;
}
diff --git a/rts/Schedule.c b/rts/Schedule.c
index 0db9ff8e9b..8a08e35cc3 100644
--- a/rts/Schedule.c
+++ b/rts/Schedule.c
@@ -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) {
diff --git a/rts/Stable.c b/rts/Stable.c
index 2c9480a559..9f34072e61 100644
--- a/rts/Stable.c
+++ b/rts/Stable.c
@@ -377,7 +377,7 @@ StgWord
lookupStableName (StgPtr p)
{
StgWord sn;
- void* sn_tmp;
+ const void* sn_tmp;
stableLock();
diff --git a/rts/ThreadPaused.c b/rts/ThreadPaused.c
index f58a51ed8f..e9b297bfbb 100644
--- a/rts/ThreadPaused.c
+++ b/rts/ThreadPaused.c
@@ -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;
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));
View Lorry Controller Status