Commit 33c029dd authored by Erik de Castro Lopo's avatar Erik de Castro Lopo

rts: More const correct-ness fixes

In addition to more const-correctness fixes this patch fixes an
infelicity of the previous const-correctness patch (995cf0f3) 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
parent 5d80d141
......@@ -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) {
......
......@@ -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
/*
......
......@@ -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;
......
......@@ -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--;
}
......
......@@ -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);
......
......@@ -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');
......
......@@ -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]);
}
......@@ -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"
......
......@@ -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) {
......
......@@ -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:
......
......@@ -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;
......
......@@ -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) {
......
......@@ -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 {
......
......@@ -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;
}
......
......@@ -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) {
......
......@@ -377,7 +377,7 @@ StgWord
lookupStableName (StgPtr p)
{
StgWord sn;
void* sn_tmp;
const void* sn_tmp;
stableLock();
......
......@@ -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;
......
......@@ -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;
......
......@@ -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);
......
......@@ -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);
......
......@@ -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 *<