/* -----------------------------------------------------------------------------
How to get hold of the static link field for a static closure.
-
- Note that we have to use (*cast(T*,&e)) instead of cast(T,e)
- because C won't let us take the address of a casted
- expression. Huh?
-------------------------------------------------------------------------- */
-#define STATIC_LINK(info,p) \
- (*(StgClosure**)(&((p)->payload[info->layout.payload.ptrs + \
- info->layout.payload.nptrs])))
-
-/* These macros are optimised versions of the above for certain
- * closure types. They *must* be equivalent to the generic
- * STATIC_LINK.
- */
-#define FUN_STATIC_LINK(p) ((p)->payload[0])
-#define THUNK_STATIC_LINK(p) ((p)->payload[1])
-#define IND_STATIC_LINK(p) ((p)->payload[1])
+/* These are hard-coded. */
+#define FUN_STATIC_LINK(p) (&(p)->payload[0])
+#define THUNK_STATIC_LINK(p) (&(p)->payload[1])
+#define IND_STATIC_LINK(p) (&(p)->payload[1])
+
+INLINE_HEADER StgClosure **
+STATIC_LINK(const StgInfoTable *info, StgClosure *p)
+{
+ switch (info->type) {
+ case THUNK_STATIC:
+ return THUNK_STATIC_LINK(p);
+ case FUN_STATIC:
+ return FUN_STATIC_LINK(p);
+ case IND_STATIC:
+ return IND_STATIC_LINK(p);
+ default:
+ return &(p)->payload[info->layout.payload.ptrs +
+ info->layout.payload.nptrs];
+ }
+}
#define STATIC_LINK2(info,p) \
(*(StgClosure**)(&((p)->payload[info->layout.payload.ptrs + \
} StgGranHeader;
/* -----------------------------------------------------------------------------
+ The SMP header
+
+ In SMP mode, we have an extra word of padding in a thunk's header.
+ (Note: thunks only; other closures do not have this padding word).
+ -------------------------------------------------------------------------- */
+
+typedef struct {
+ StgWord pad;
+} StgSMPThunkHeader;
+
+/* -----------------------------------------------------------------------------
The full fixed-size closure header
The size of the fixed header is the sum of the optional parts plus a single
-------------------------------------------------------------------------- */
typedef struct {
- const struct _StgInfoTable* info;
+ const struct _StgInfoTable* info;
#ifdef PROFILING
- StgProfHeader prof;
+ StgProfHeader prof;
#endif
#ifdef GRAN
- StgGranHeader gran;
+ StgGranHeader gran;
#endif
} StgHeader;
+/*
+ * In SMP mode, a thunk has a padding word to take the updated value.
+ * This is so that the update doesn't overwrite the payload, so we can
+ * avoid needing to lock the thunk during entry and update.
+ *
+ * Note: this doesn't apply to THUNK_STATICs, which have no payload.
+ */
+typedef struct {
+ const struct _StgInfoTable* info;
+#ifdef PROFILING
+ StgProfHeader prof;
+#endif
+#ifdef GRAN
+ StgGranHeader gran;
+#endif
+#ifdef SMP
+ StgSMPThunkHeader smp;
+#endif
+} StgThunkHeader;
+
/* -----------------------------------------------------------------------------
Closure Types
};
typedef struct {
- StgHeader header;
+ StgThunkHeader header;
+ struct StgClosure_ *payload[FLEXIBLE_ARRAY];
+} StgThunk;
+
+typedef struct {
+ StgThunkHeader header;
StgClosure *selectee;
} StgSelector;
StgClosure *payload[FLEXIBLE_ARRAY];
} StgPAP;
-/* AP closures have the same layout, for convenience */
-typedef StgPAP StgAP;
+typedef struct {
+ StgThunkHeader header;
+ StgHalfWord arity; /* zero if it is an AP */
+ StgHalfWord n_args;
+ StgClosure *fun; /* really points to a fun */
+ StgClosure *payload[FLEXIBLE_ARRAY];
+} StgAP;
typedef struct {
- StgHeader header;
+ StgThunkHeader header;
StgWord size; /* number of words in payload */
StgClosure *fun;
StgClosure *payload[FLEXIBLE_ARRAY]; /* contains a chunk of *stack* */
}
/* -----------------------------------------------------------------------------
+ Closure headers
+ -------------------------------------------------------------------------- */
+
+/*
+ * This is really ugly, since we don't do the rest of StgHeader this
+ * way. The problem is that values from DerivedConstants.h cannot be
+ * dependent on the way (SMP, PROF etc.). For SIZEOF_StgHeader we get
+ * the value from GHC, but it seems like too much trouble to do that
+ * for StgThunkHeader.
+ */
+#ifdef SMP
+#define SIZEOF_StgThunkHeader SIZEOF_StgHeader+SIZEOF_StgSMPThunkHeader
+#else
+#define SIZEOF_StgThunkHeader SIZEOF_StgHeader
+#endif
+
+#define StgThunk_payload(__ptr__,__ix__) \
+ W_[__ptr__+SIZEOF_StgThunkHeader+ WDS(__ix__)]
+
+/* -----------------------------------------------------------------------------
Closures
-------------------------------------------------------------------------- */
typedef signed short StgInt16;
typedef unsigned short StgWord16;
-
#if SIZEOF_UNSIGNED_INT == 4
typedef signed int StgInt32;
typedef unsigned int StgWord32;
INLINE_HEADER StgOffset PAP_sizeW ( nat n_args )
{ return sizeofW(StgPAP) + n_args; }
+INLINE_HEADER StgOffset AP_sizeW ( nat n_args )
+{ return sizeofW(StgAP) + n_args; }
+
INLINE_HEADER StgOffset AP_STACK_sizeW ( nat size )
{ return sizeofW(StgAP_STACK) + size; }
+ sizeofW(StgPtr) * itbl->layout.payload.ptrs
+ sizeofW(StgWord) * itbl->layout.payload.nptrs; }
+INLINE_HEADER StgOffset thunk_sizeW_fromITBL( const StgInfoTable* itbl )
+{ return sizeofW(StgThunk)
+ + sizeofW(StgPtr) * itbl->layout.payload.ptrs
+ + sizeofW(StgWord) * itbl->layout.payload.nptrs; }
+
INLINE_HEADER StgOffset ap_stack_sizeW( StgAP_STACK* x )
{ return AP_STACK_sizeW(x->size); }
+INLINE_HEADER StgOffset ap_sizeW( StgAP* x )
+{ return AP_sizeW(x->n_args); }
+
INLINE_HEADER StgOffset pap_sizeW( StgPAP* x )
{ return PAP_sizeW(x->n_args); }
struct_field_("StgHeader_ccs", StgHeader, prof.ccs);
struct_field_("StgHeader_ldvw", StgHeader, prof.hp.ldvw);
+ struct_size(StgSMPThunkHeader);
+
closure_payload(StgClosure,payload);
struct_field(StgEntCounter, allocs);
case FUN_1_0:
case FUN_0_1:
case CONSTR_1_0:
+ return copy(q,sizeofW(StgHeader)+1,stp);
+
case THUNK_1_0:
case THUNK_0_1:
- return copy(q,sizeofW(StgHeader)+1,stp);
+ return copy(q,sizeofW(StgThunk)+1,stp);
case THUNK_1_1:
case THUNK_0_2:
stp = bd->step;
}
#endif
- return copy(q,sizeofW(StgHeader)+2,stp);
+ return copy(q,sizeofW(StgThunk)+2,stp);
case FUN_1_1:
case FUN_0_2:
case THUNK_STATIC:
if (info->srt_bitmap != 0 && major_gc &&
- THUNK_STATIC_LINK((StgClosure *)q) == NULL) {
- THUNK_STATIC_LINK((StgClosure *)q) = static_objects;
+ *THUNK_STATIC_LINK((StgClosure *)q) == NULL) {
+ *THUNK_STATIC_LINK((StgClosure *)q) = static_objects;
static_objects = (StgClosure *)q;
}
return q;
case FUN_STATIC:
if (info->srt_bitmap != 0 && major_gc &&
- FUN_STATIC_LINK((StgClosure *)q) == NULL) {
- FUN_STATIC_LINK((StgClosure *)q) = static_objects;
+ *FUN_STATIC_LINK((StgClosure *)q) == NULL) {
+ *FUN_STATIC_LINK((StgClosure *)q) = static_objects;
static_objects = (StgClosure *)q;
}
return q;
*/
if (major_gc
&& ((StgIndStatic *)q)->saved_info == NULL
- && IND_STATIC_LINK((StgClosure *)q) == NULL) {
- IND_STATIC_LINK((StgClosure *)q) = static_objects;
+ && *IND_STATIC_LINK((StgClosure *)q) == NULL) {
+ *IND_STATIC_LINK((StgClosure *)q) = static_objects;
static_objects = (StgClosure *)q;
}
return q;
case CONSTR_STATIC:
- if (major_gc && STATIC_LINK(info,(StgClosure *)q) == NULL) {
- STATIC_LINK(info,(StgClosure *)q) = static_objects;
+ if (major_gc && *STATIC_LINK(info,(StgClosure *)q) == NULL) {
+ *STATIC_LINK(info,(StgClosure *)q) = static_objects;
static_objects = (StgClosure *)q;
}
return q;
barf("evacuate: stack frame at %p\n", q);
case PAP:
- case AP:
return copy(q,pap_sizeW((StgPAP*)q),stp);
+ case AP:
+ return copy(q,ap_sizeW((StgAP*)q),stp);
+
case AP_STACK:
return copy(q,ap_stack_sizeW((StgAP_STACK*)q),stp);
scavenge_srt((StgClosure **)GET_FUN_SRT(fun_info), fun_info->i.srt_bitmap);
}
-STATIC_INLINE void
-scavenge_ret_srt(const StgInfoTable *info)
-{
- StgRetInfoTable *ret_info;
-
- ret_info = itbl_to_ret_itbl(info);
- scavenge_srt((StgClosure **)GET_SRT(ret_info), ret_info->i.srt_bitmap);
-}
-
/* -----------------------------------------------------------------------------
Scavenge a TSO.
-------------------------------------------------------------------------- */
}
STATIC_INLINE StgPtr
-scavenge_PAP (StgPAP *pap)
+scavenge_PAP_payload (StgClosure *fun, StgClosure **payload, StgWord size)
{
StgPtr p;
- StgWord bitmap, size;
+ StgWord bitmap;
StgFunInfoTable *fun_info;
-
- pap->fun = evacuate(pap->fun);
- fun_info = get_fun_itbl(pap->fun);
+
+ fun_info = get_fun_itbl(fun);
ASSERT(fun_info->i.type != PAP);
-
- p = (StgPtr)pap->payload;
- size = pap->n_args;
+ p = (StgPtr)payload;
switch (fun_info->f.fun_type) {
case ARG_GEN:
p += size;
break;
case ARG_BCO:
- scavenge_large_bitmap((StgPtr)pap->payload, BCO_BITMAP(pap->fun), size);
+ scavenge_large_bitmap((StgPtr)payload, BCO_BITMAP(fun), size);
p += size;
break;
default:
bitmap = BITMAP_BITS(stg_arg_bitmaps[fun_info->f.fun_type]);
small_bitmap:
- size = pap->n_args;
while (size > 0) {
if ((bitmap & 1) == 0) {
*p = (StgWord)(StgPtr)evacuate((StgClosure *)*p);
return p;
}
+STATIC_INLINE StgPtr
+scavenge_PAP (StgPAP *pap)
+{
+ pap->fun = evacuate(pap->fun);
+ return scavenge_PAP_payload (pap->fun, pap->payload, pap->n_args);
+}
+
+STATIC_INLINE StgPtr
+scavenge_AP (StgAP *ap)
+{
+ ap->fun = evacuate(ap->fun);
+ return scavenge_PAP_payload (ap->fun, ap->payload, ap->n_args);
+}
+
/* -----------------------------------------------------------------------------
Scavenge a given step until there are no more objects in this step
to scavenge.
case THUNK_2_0:
scavenge_thunk_srt(info);
+ ((StgThunk *)p)->payload[1] = evacuate(((StgThunk *)p)->payload[1]);
+ ((StgThunk *)p)->payload[0] = evacuate(((StgThunk *)p)->payload[0]);
+ p += sizeofW(StgThunk) + 2;
+ break;
+
case CONSTR_2_0:
((StgClosure *)p)->payload[1] = evacuate(((StgClosure *)p)->payload[1]);
((StgClosure *)p)->payload[0] = evacuate(((StgClosure *)p)->payload[0]);
case THUNK_1_0:
scavenge_thunk_srt(info);
- ((StgClosure *)p)->payload[0] = evacuate(((StgClosure *)p)->payload[0]);
- p += sizeofW(StgHeader) + 1;
+ ((StgThunk *)p)->payload[0] = evacuate(((StgThunk *)p)->payload[0]);
+ p += sizeofW(StgThunk) + 1;
break;
case FUN_1_0:
case THUNK_0_1:
scavenge_thunk_srt(info);
- p += sizeofW(StgHeader) + 1;
+ p += sizeofW(StgThunk) + 1;
break;
case FUN_0_1:
case THUNK_0_2:
scavenge_thunk_srt(info);
- p += sizeofW(StgHeader) + 2;
+ p += sizeofW(StgThunk) + 2;
break;
case FUN_0_2:
case THUNK_1_1:
scavenge_thunk_srt(info);
- ((StgClosure *)p)->payload[0] = evacuate(((StgClosure *)p)->payload[0]);
- p += sizeofW(StgHeader) + 2;
+ ((StgThunk *)p)->payload[0] = evacuate(((StgThunk *)p)->payload[0]);
+ p += sizeofW(StgThunk) + 2;
break;
case FUN_1_1:
goto gen_obj;
case THUNK:
+ {
+ StgPtr end;
+
scavenge_thunk_srt(info);
- // fall through
+ end = (P_)((StgThunk *)p)->payload + info->layout.payload.ptrs;
+ for (p = (P_)((StgThunk *)p)->payload; p < end; p++) {
+ *p = (StgWord)(StgPtr)evacuate((StgClosure *)*p);
+ }
+ p += info->layout.payload.nptrs;
+ break;
+ }
gen_obj:
case CONSTR:
}
case PAP:
- case AP:
p = scavenge_PAP((StgPAP *)p);
break;
+ case AP:
+ p = scavenge_AP((StgAP *)p);
+ break;
+
case ARR_WORDS:
// nothing to follow
p += arr_words_sizeW((StgArrWords *)p);
case THUNK_2_0:
scavenge_thunk_srt(info);
+ ((StgThunk *)p)->payload[1] = evacuate(((StgThunk *)p)->payload[1]);
+ ((StgThunk *)p)->payload[0] = evacuate(((StgThunk *)p)->payload[0]);
+ break;
+
case CONSTR_2_0:
((StgClosure *)p)->payload[1] = evacuate(((StgClosure *)p)->payload[1]);
((StgClosure *)p)->payload[0] = evacuate(((StgClosure *)p)->payload[0]);
case THUNK_1_0:
case THUNK_1_1:
scavenge_thunk_srt(info);
+ ((StgThunk *)p)->payload[0] = evacuate(((StgThunk *)p)->payload[0]);
+ break;
+
case CONSTR_1_0:
case CONSTR_1_1:
((StgClosure *)p)->payload[0] = evacuate(((StgClosure *)p)->payload[0]);
goto gen_obj;
case THUNK:
+ {
+ StgPtr end;
+
scavenge_thunk_srt(info);
- // fall through
+ end = (P_)((StgThunk *)p)->payload + info->layout.payload.ptrs;
+ for (p = (P_)((StgThunk *)p)->payload; p < end; p++) {
+ *p = (StgWord)(StgPtr)evacuate((StgClosure *)*p);
+ }
+ break;
+ }
gen_obj:
case CONSTR:
}
case PAP:
- case AP:
scavenge_PAP((StgPAP *)p);
break;
+
+ case AP:
+ scavenge_AP((StgAP *)p);
+ break;
case MUT_ARR_PTRS:
// follow everything
break;
}
- case FUN:
- case FUN_1_0: // hardly worth specialising these guys
- case FUN_0_1:
- case FUN_1_1:
- case FUN_0_2:
- case FUN_2_0:
case THUNK:
case THUNK_1_0:
case THUNK_0_1:
case THUNK_1_1:
case THUNK_0_2:
case THUNK_2_0:
+ {
+ StgPtr q, end;
+
+ end = (StgPtr)((StgThunk *)p)->payload + info->layout.payload.ptrs;
+ for (q = (StgPtr)((StgThunk *)p)->payload; q < end; q++) {
+ *q = (StgWord)(StgPtr)evacuate((StgClosure *)*q);
+ }
+ break;
+ }
+
+ case FUN:
+ case FUN_1_0: // hardly worth specialising these guys
+ case FUN_0_1:
+ case FUN_1_1:
+ case FUN_0_2:
+ case FUN_2_0:
case CONSTR:
case CONSTR_1_0:
case CONSTR_0_1:
}
case PAP:
+ p = scavenge_AP((StgAP *)p);
+ break;
+
case AP:
p = scavenge_PAP((StgPAP *)p);
break;
/* Take this object *off* the static_objects list,
* and put it on the scavenged_static_objects list.
*/
- static_objects = STATIC_LINK(info,p);
- STATIC_LINK(info,p) = scavenged_static_objects;
+ static_objects = *STATIC_LINK(info,p);
+ *STATIC_LINK(info,p) = scavenged_static_objects;
scavenged_static_objects = p;
switch (info -> type) {
for (p = first_static; p != END_OF_STATIC_LIST; p = link) {
info = get_itbl(p);
- link = STATIC_LINK(info, p);
- STATIC_LINK(info,p) = NULL;
+ link = *STATIC_LINK(info, p);
+ *STATIC_LINK(info,p) = NULL;
}
}
obj_sizeW( StgClosure *p, StgInfoTable *info )
{
switch (info->type) {
+ case THUNK_0_1:
+ case THUNK_1_0:
+ return sizeofW(StgThunk) + 1;
case FUN_0_1:
case CONSTR_0_1:
case FUN_1_0:
case CONSTR_1_0:
- case THUNK_0_1:
- case THUNK_1_0:
return sizeofW(StgHeader) + 1;
case THUNK_0_2:
+ case THUNK_1_1:
+ case THUNK_2_0:
+ return sizeofW(StgThunk) + 2;
case FUN_0_2:
case CONSTR_0_2:
- case THUNK_1_1:
case FUN_1_1:
case CONSTR_1_1:
- case THUNK_2_0:
case FUN_2_0:
case CONSTR_2_0:
return sizeofW(StgHeader) + 2;
case IND_STATIC:
thread((StgPtr)&((StgInd *)p)->indirectee);
- p = IND_STATIC_LINK(p);
+ p = *IND_STATIC_LINK(p);
continue;
case THUNK_STATIC:
- p = THUNK_STATIC_LINK(p);
+ p = *THUNK_STATIC_LINK(p);
continue;
case FUN_STATIC:
- p = FUN_STATIC_LINK(p);
+ p = *FUN_STATIC_LINK(p);
continue;
case CONSTR_STATIC:
- p = STATIC_LINK(info,p);
+ p = *STATIC_LINK(info,p);
continue;
default:
}
STATIC_INLINE StgPtr
-thread_PAP (StgPAP *pap)
+thread_PAP_payload (StgClosure *fun, StgClosure **payload, StgWord size)
{
StgPtr p;
- StgWord bitmap, size;
+ StgWord bitmap;
StgFunInfoTable *fun_info;
-
- fun_info = itbl_to_fun_itbl(get_threaded_info((StgPtr)pap->fun));
+
+ fun_info = itbl_to_fun_itbl(get_threaded_info((StgPtr)fun));
ASSERT(fun_info->i.type != PAP);
- p = (StgPtr)pap->payload;
- size = pap->n_args;
+ p = (StgPtr)payload;
switch (fun_info->f.fun_type) {
case ARG_GEN:
p += size;
break;
case ARG_BCO:
- thread_large_bitmap((StgPtr)pap->payload, BCO_BITMAP(pap->fun), size);
+ thread_large_bitmap((StgPtr)payload, BCO_BITMAP(fun), size);
p += size;
break;
default:
bitmap = BITMAP_BITS(stg_arg_bitmaps[fun_info->f.fun_type]);
small_bitmap:
- size = pap->n_args;
while (size > 0) {
if ((bitmap & 1) == 0) {
thread(p);
break;
}
+ return p;
+}
+
+STATIC_INLINE StgPtr
+thread_PAP (StgPAP *pap)
+{
+ StgPtr p;
+ p = thread_PAP_payload(pap->fun, pap->payload, pap->n_args);
thread((StgPtr)&pap->fun);
return p;
}
+
+STATIC_INLINE StgPtr
+thread_AP (StgAP *ap)
+{
+ StgPtr p;
+ p = thread_PAP_payload(ap->fun, ap->payload, ap->n_args);
+ thread((StgPtr)&ap->fun);
+ return p;
+}
STATIC_INLINE StgPtr
thread_AP_STACK (StgAP_STACK *ap)
thread_obj (StgInfoTable *info, StgPtr p)
{
switch (info->type) {
+ case THUNK_0_1:
+ return p + sizeofW(StgThunk) + 1;
+
case FUN_0_1:
case CONSTR_0_1:
- case THUNK_0_1:
return p + sizeofW(StgHeader) + 1;
case FUN_1_0:
return p + sizeofW(StgHeader) + 1;
case THUNK_1_0:
- thread((StgPtr)&((StgClosure *)p)->payload[0]);
- return p + sizeofW(StgHeader) + 1;
+ thread((StgPtr)&((StgThunk *)p)->payload[0]);
+ return p + sizeofW(StgThunk) + 1;
case THUNK_0_2:
+ return p + sizeofW(StgThunk) + 2;
+
case FUN_0_2:
case CONSTR_0_2:
return p + sizeofW(StgHeader) + 2;
case THUNK_1_1:
+ thread((StgPtr)&((StgThunk *)p)->payload[0]);
+ return p + sizeofW(StgThunk) + 2;
+
case FUN_1_1:
case CONSTR_1_1:
thread((StgPtr)&((StgClosure *)p)->payload[0]);
return p + sizeofW(StgHeader) + 2;
case THUNK_2_0:
+ thread((StgPtr)&((StgThunk *)p)->payload[0]);
+ thread((StgPtr)&((StgThunk *)p)->payload[1]);
+ return p + sizeofW(StgThunk) + 2;
+
case FUN_2_0:
case CONSTR_2_0:
thread((StgPtr)&((StgClosure *)p)->payload[0]);
return p + bco_sizeW(bco);
}
- case FUN:
case THUNK:
+ {
+ StgPtr end;
+
+ end = (P_)((StgThunk *)p)->payload +
+ info->layout.payload.ptrs;
+ for (p = (P_)((StgThunk *)p)->payload; p < end; p++) {
+ thread(p);
+ }
+ return p + info->layout.payload.nptrs;
+ }
+
+ case FUN:
case CONSTR:
case FOREIGN:
case STABLE_NAME:
return thread_AP_STACK((StgAP_STACK *)p);
case PAP:
- case AP:
return thread_PAP((StgPAP *)p);
+
+ case AP:
+ return thread_AP((StgAP *)p);
case ARR_WORDS:
return p + arr_words_sizeW((StgArrWords *)p);
switch (info->type) {
case THUNK_1_0:
case THUNK_0_1:
+ nw = stg_max(MIN_UPD_SIZE,1);
+ break;
+
case THUNK_2_0:
case THUNK_1_1:
case THUNK_0_2:
case THUNK_SELECTOR:
- nw = MIN_UPD_SIZE;
+ nw = stg_max(MIN_UPD_SIZE,2);
break;
+
case THUNK:
- nw = info->layout.payload.ptrs + info->layout.payload.nptrs;
- if (nw < MIN_UPD_SIZE)
- nw = MIN_UPD_SIZE;
+ nw = stg_max(info->layout.payload.ptrs + info->layout.payload.nptrs,
+ MIN_UPD_SIZE);
break;
case AP:
- nw = sizeofW(StgPAP) - sizeofW(StgHeader) + ((StgPAP *)p)->n_args;
+ nw = sizeofW(StgAP) - sizeofW(StgThunkHeader) + ((StgPAP *)p)->n_args;
break;
case AP_STACK:
- nw = sizeofW(StgAP_STACK) - sizeofW(StgHeader)
+ nw = sizeofW(StgAP_STACK) - sizeofW(StgThunkHeader)
+ ((StgAP_STACK *)p)->size;
break;
case CAF_BLACKHOLE:
case THUNK_1_0:
case THUNK_0_1:
+ case THUNK_SELECTOR:
+ size = sizeofW(StgHeader) + stg_max(MIN_UPD_SIZE, 1);
+ break;
+
case THUNK_2_0:
case THUNK_1_1:
case THUNK_0_2:
- case THUNK_SELECTOR:
- size = sizeofW(StgHeader) + MIN_UPD_SIZE;
+ size = sizeofW(StgHeader) + stg_max(MIN_UPD_SIZE, 2);
break;
case AP:
+ size = ap_sizeW((StgAP *)c);
+ break;
+
case PAP:
size = pap_sizeW((StgPAP *)c);
break;
}
static void
+printThunkPayload( StgThunk *obj )
+{
+ StgWord i, j;
+ const StgInfoTable* info;
+
+ info = get_itbl(obj);
+ for (i = 0; i < info->layout.payload.ptrs; ++i) {
+ debugBelch(", ");
+ printPtr((StgPtr)obj->payload[i]);
+ }
+ for (j = 0; j < info->layout.payload.nptrs; ++j) {
+ debugBelch(", %pd#",obj->payload[i+j]);
+ }
+ debugBelch(")\n");
+}
+
+static void
printStdObject( StgClosure *obj, char* tag )
{
printStdObjHdr( obj, tag );
printStdObjPayload( obj );
}
+static void
+printThunkObject( StgThunk *obj, char* tag )
+{
+ printStdObjHdr( (StgClosure *)obj, tag );
+ printThunkPayload( obj );
+}
+
void
printClosure( StgClosure *obj )
{
case THUNK_STATIC:
/* ToDo: will this work for THUNK_STATIC too? */
#ifdef PROFILING
- printStdObject(obj,info->prof.closure_desc);
+ printThunkObject((StgThunk *)obj,info->prof.closure_desc);
#else
- printStdObject(obj,"THUNK");
+ printThunkObject((StgThunk *)obj,"THUNK");
#endif
break;
case AP:
{
- StgPAP* ap = stgCast(StgPAP*,obj);
+ StgAP* ap = stgCast(StgAP*,obj);
StgWord i;
debugBelch("AP("); printPtr((StgPtr)ap->fun);
for (i = 0; i < ap->n_args; ++i) {
switch (info->type) {
+ case THUNK:
+ size = thunk_sizeW_fromITBL(info);
+ break;
+
+ case THUNK_1_1:
+ case THUNK_0_2:
+ case THUNK_2_0:
+ size = sizeofW(StgHeader) + stg_max(MIN_UPD_SIZE,2);
+ break;
+
+ case THUNK_1_0:
+ case THUNK_0_1:
+ case THUNK_SELECTOR:
+ size = sizeofW(StgHeader) + stg_max(MIN_UPD_SIZE,1);
+ break;
+
case CONSTR:
case FUN:
- case THUNK:
case IND_PERM:
case IND_OLDGEN:
case IND_OLDGEN_PERM:
case FUN_1_1:
case FUN_0_2:
case FUN_2_0:
- case THUNK_1_1:
- case THUNK_0_2:
- case THUNK_2_0:
case CONSTR_1_0:
case CONSTR_0_1:
case CONSTR_1_1:
size = sizeW_fromITBL(info);
break;
- case THUNK_1_0: /* ToDo - shouldn't be here */
- case THUNK_0_1: /* " ditto " */
- case THUNK_SELECTOR:
- size = sizeofW(StgHeader) + MIN_UPD_SIZE;
+ case AP:
+ size = ap_sizeW((StgAP *)p);
break;
- case AP:
case PAP:
size = pap_sizeW((StgPAP *)p);
break;
case THUNK:
case THUNK_2_0:
- init_ptrs(&se.info, get_itbl(c)->layout.payload.ptrs, (StgPtr)c->payload);
+ init_ptrs(&se.info, get_itbl(c)->layout.payload.ptrs,
+ (StgPtr)((StgThunk *)c)->payload);
*first_child = find_ptrs(&se.info);
if (*first_child == NULL)
// no child from ptrs, so check SRT
case THUNK_1_0:
case THUNK_1_1:
- *first_child = c->payload[0];
+ *first_child = ((StgThunk *)c)->payload[0];
ASSERT(*first_child != NULL);
init_srt_thunk(&se.info, get_thunk_itbl(c));
break;
* ------------------------------------------------------------------------- */
static INLINE StgPtr
-retain_PAP (StgPAP *pap, retainer c_child_r)
+retain_PAP_payload (StgClosure *pap, retainer c_child_r, StgClosure *fun,
+ StgClosure** payload, StgWord n_args)
{
StgPtr p;
- StgWord bitmap, size;
+ StgWord bitmap;
StgFunInfoTable *fun_info;
- retainClosure(pap->fun, (StgClosure *)pap, c_child_r);
- fun_info = get_fun_itbl(pap->fun);
+ retainClosure(fun, pap, c_child_r);
+ fun_info = get_fun_itbl(fun);
ASSERT(fun_info->i.type != PAP);
- p = (StgPtr)pap->payload;
- size = pap->n_args;
+ p = (StgPtr)payload;
switch (fun_info->f.fun_type) {
case ARG_GEN:
bitmap = BITMAP_BITS(fun_info->f.b.bitmap);
- p = retain_small_bitmap(p, pap->n_args, bitmap,
- (StgClosure *)pap, c_child_r);
+ p = retain_small_bitmap(p, n_args, bitmap,
+ pap, c_child_r);
break;
case ARG_GEN_BIG:
retain_large_bitmap(p, GET_FUN_LARGE_BITMAP(fun_info),
- size, (StgClosure *)pap, c_child_r);
- p += size;
+ n_args, pap, c_child_r);
+ p += n_args;
break;
case ARG_BCO:
- retain_large_bitmap((StgPtr)pap->payload, BCO_BITMAP(pap->fun),
- size, (StgClosure *)pap, c_child_r);
- p += size;
+ retain_large_bitmap((StgPtr)payload, BCO_BITMAP(fun),
+ n_args, pap, c_child_r);
+ p += n_args;
break;
default:
bitmap = BITMAP_BITS(stg_arg_bitmaps[fun_info->f.fun_type]);
- p = retain_small_bitmap(p, pap->n_args, bitmap,
- (StgClosure *)pap, c_child_r);
+ p = retain_small_bitmap(p, n_args, bitmap, pap, c_child_r);
break;
}
return p;
goto loop;
case PAP:
+ {
+ StgPAP *pap = (StgPAP *)c;
+ retain_PAP_payload(c, c_child_r, pap->fun, pap->payload, pap->n_args);
+ goto loop;
+ }
+
case AP:
- retain_PAP((StgPAP *)c, c_child_r);
+ {
+ StgAP *ap = (StgAP *)c;
+ retain_PAP_payload(c, c_child_r, ap->fun, ap->payload, ap->n_args);
goto loop;
+ }
case AP_STACK:
retainClosure(((StgAP_STACK *)c)->fun, c, c_child_r);
// ASSERT( p == stack_end ); -- HWL
}
+static void
+checkPAP (StgClosure *fun, StgClosure** payload, StgWord n_args)
+{
+ StgClosure *p;
+ StgFunInfoTable *fun_info;
+
+ ASSERT(LOOKS_LIKE_CLOSURE_PTR(fun));
+ fun_info = get_fun_itbl(fun);
+
+ p = (StgClosure *)payload;
+ switch (fun_info->f.fun_type) {
+ case ARG_GEN:
+ checkSmallBitmap( (StgPtr)payload,
+ BITMAP_BITS(fun_info->f.b.bitmap), n_args );
+ break;
+ case ARG_GEN_BIG:
+ checkLargeBitmap( (StgPtr)payload,
+ GET_FUN_LARGE_BITMAP(fun_info),
+ n_args );
+ break;
+ case ARG_BCO:
+ checkLargeBitmap( (StgPtr)payload,
+ BCO_BITMAP(fun),
+ n_args );
+ break;
+ default:
+ checkSmallBitmap( (StgPtr)payload,
+ BITMAP_BITS(stg_arg_bitmaps[fun_info->f.fun_type]),
+ n_args );
+ break;
+ }
+}
+
+
StgOffset
checkClosure( StgClosure* p )
{
{
nat i;
for (i = 0; i < info->layout.payload.ptrs; i++) {
- ASSERT(LOOKS_LIKE_CLOSURE_PTR(p->payload[i]));
+ ASSERT(LOOKS_LIKE_CLOSURE_PTR(((StgThunk *)p)->payload[i]));
}
- return stg_max(sizeW_fromITBL(info), sizeofW(StgHeader) + MIN_UPD_SIZE);
+ return stg_max(sizeW_fromITBL(info), sizeofW(StgHeader)+MIN_UPD_SIZE);
}
case FUN:
case CATCH_STM_FRAME:
barf("checkClosure: stack frame");
- case AP: /* we can treat this as being the same as a PAP */
+ case AP:
+ {
+ StgAP* ap = (StgAP *)p;
+ checkPAP (ap->fun, ap->payload, ap->n_args);
+ return ap_sizeW(ap);
+ }
+
case PAP:
- {
- StgFunInfoTable *fun_info;
- StgPAP* pap = (StgPAP *)p;
-
- ASSERT(LOOKS_LIKE_CLOSURE_PTR(pap->fun));
- fun_info = get_fun_itbl(pap->fun);
-
- p = (StgClosure *)pap->payload;
- switch (fun_info->f.fun_type) {
- case ARG_GEN:
- checkSmallBitmap( (StgPtr)pap->payload,
- BITMAP_BITS(fun_info->f.b.bitmap), pap->n_args );
- break;
- case ARG_GEN_BIG:
- checkLargeBitmap( (StgPtr)pap->payload,
- GET_FUN_LARGE_BITMAP(fun_info),
- pap->n_args );
- break;
- case ARG_BCO:
- checkLargeBitmap( (StgPtr)pap->payload,
- BCO_BITMAP(pap->fun),
- pap->n_args );
- break;
- default:
- checkSmallBitmap( (StgPtr)pap->payload,
- BITMAP_BITS(stg_arg_bitmaps[fun_info->f.fun_type]),
- pap->n_args );
- break;
- }
- return pap_sizeW(pap);
- }
+ {
+ StgPAP* pap = (StgPAP *)p;
+ checkPAP (pap->fun, pap->payload, pap->n_args);
+ return pap_sizeW(pap);
+ }
case AP_STACK:
{
ASSERT(LOOKS_LIKE_CLOSURE_PTR(indirectee));
ASSERT(LOOKS_LIKE_INFO_PTR(indirectee->header.info));
- p = IND_STATIC_LINK((StgClosure *)p);
+ p = *IND_STATIC_LINK((StgClosure *)p);
break;
}
case THUNK_STATIC:
- p = THUNK_STATIC_LINK((StgClosure *)p);
+ p = *THUNK_STATIC_LINK((StgClosure *)p);
break;
case FUN_STATIC:
- p = FUN_STATIC_LINK((StgClosure *)p);
+ p = *FUN_STATIC_LINK((StgClosure *)p);
break;
case CONSTR_STATIC:
- p = STATIC_LINK(info,(StgClosure *)p);
+ p = *STATIC_LINK(info,(StgClosure *)p);
break;
default:
// fun field.
//
words = frame - sp - 1;
- ap = (StgAP_STACK *)allocate(PAP_sizeW(words));
+ ap = (StgAP_STACK *)allocate(AP_STACK_sizeW(words));
ap->size = words;
ap->fun = (StgClosure *)sp[0];
#define SELECTOR_CODE_UPD(offset) \
INFO_TABLE_RET(stg_sel_ret_##offset##_upd, RET_FRAMESIZE, RET_BITMAP, RET_SMALL) \
{ \
- R1 = StgClosure_payload(R1,offset); \
+ R1 = StgClosure_payload(R1,offset); \
GET_SAVED_CCCS; \
Sp = Sp + SIZEOF_StgHeader; \
ENTER(); \
ENTER_CCS_THUNK(R1); \
SAVE_CCCS(WITHUPD_FRAME_SIZE); \
W_[Sp-WITHUPD_FRAME_SIZE] = stg_sel_ret_##offset##_upd_info; \
- R1 = StgClosure_payload(R1,0); \
+ R1 = StgThunk_payload(R1,0); \
Sp = Sp - WITHUPD_FRAME_SIZE; \
jump %GET_ENTRY(R1); \
}
#define SELECTOR_CODE_NOUPD(offset) \
INFO_TABLE_RET(stg_sel_ret_##offset##_noupd, RET_FRAMESIZE, RET_BITMAP, RET_SMALL) \
{ \
- R1 = StgClosure_payload(R1,offset); \
+ R1 = StgClosure_payload(R1,offset); \
GET_SAVED_CCCS; \
Sp = Sp + SIZEOF_StgHeader; \
jump %GET_ENTRY(R1); \
UPD_BH_SINGLE_ENTRY(); \
LDV_ENTER(R1); \
TICK_UPDF_OMITTED(); \
- ENTER_CCS_THUNK(R1); \
+ ENTER_CCS_THUNK(R1); \
SAVE_CCCS(NOUPD_FRAME_SIZE); \
W_[Sp-NOUPD_FRAME_SIZE] = stg_sel_ret_##offset##_noupd_info; \
- R1 = StgClosure_payload(R1,0); \
+ R1 = StgThunk_payload(R1,0); \
Sp = Sp - NOUPD_FRAME_SIZE; \
jump %GET_ENTRY(R1); \
}
LDV_ENTER(R1);
ENTER_CCS_THUNK(R1);
PUSH_UPD_FRAME(Sp-SIZEOF_StgUpdateFrame,R1);
- R1 = StgClosure_payload(R1,0);
+ R1 = StgThunk_payload(R1,0);
Sp = Sp - SIZEOF_StgUpdateFrame;
Sp_adj(-1); // for stg_ap_0_ret
jump RET_LBL(stg_ap_0);
LDV_ENTER(R1);
ENTER_CCS_THUNK(R1);
PUSH_UPD_FRAME(Sp-SIZEOF_StgUpdateFrame,R1);
- W_[Sp-SIZEOF_StgUpdateFrame-WDS(1)] = StgClosure_payload(R1,1);
- R1 = StgClosure_payload(R1,0);
+ W_[Sp-SIZEOF_StgUpdateFrame-WDS(1)] = StgThunk_payload(R1,1);
+ R1 = StgThunk_payload(R1,0);
Sp = Sp - SIZEOF_StgUpdateFrame - WDS(1);
Sp_adj(-1); // for stg_ap_0_ret
TICK_UNKNOWN_CALL();
LDV_ENTER(R1);
ENTER_CCS_THUNK(R1);
PUSH_UPD_FRAME(Sp-SIZEOF_StgUpdateFrame,R1);
- W_[Sp-SIZEOF_StgUpdateFrame-WDS(1)] = StgClosure_payload(R1,2);
- W_[Sp-SIZEOF_StgUpdateFrame-WDS(2)] = StgClosure_payload(R1,1);
- R1 = StgClosure_payload(R1,0);
+ W_[Sp-SIZEOF_StgUpdateFrame-WDS(1)] = StgThunk_payload(R1,2);
+ W_[Sp-SIZEOF_StgUpdateFrame-WDS(2)] = StgThunk_payload(R1,1);
+ R1 = StgThunk_payload(R1,0);
Sp = Sp - SIZEOF_StgUpdateFrame - WDS(2);
Sp_adj(-1); // for stg_ap_0_ret
TICK_UNKNOWN_CALL();
LDV_ENTER(R1);
ENTER_CCS_THUNK(R1);
PUSH_UPD_FRAME(Sp-SIZEOF_StgUpdateFrame,R1);
- W_[Sp-SIZEOF_StgUpdateFrame-WDS(1)] = StgClosure_payload(R1,3);
- W_[Sp-SIZEOF_StgUpdateFrame-WDS(2)] = StgClosure_payload(R1,2);
- W_[Sp-SIZEOF_StgUpdateFrame-WDS(3)] = StgClosure_payload(R1,1);
- R1 = StgClosure_payload(R1,0);
+ W_[Sp-SIZEOF_StgUpdateFrame-WDS(1)] = StgThunk_payload(R1,3);
+ W_[Sp-SIZEOF_StgUpdateFrame-WDS(2)] = StgThunk_payload(R1,2);
+ W_[Sp-SIZEOF_StgUpdateFrame-WDS(3)] = StgThunk_payload(R1,1);
+ R1 = StgThunk_payload(R1,0);
Sp = Sp - SIZEOF_StgUpdateFrame - WDS(3);
Sp_adj(-1); // for stg_ap_0_ret
TICK_UNKNOWN_CALL();
LDV_ENTER(R1);
ENTER_CCS_THUNK(R1);
PUSH_UPD_FRAME(Sp-SIZEOF_StgUpdateFrame,R1);
- W_[Sp-SIZEOF_StgUpdateFrame-WDS(1)] = StgClosure_payload(R1,4);
- W_[Sp-SIZEOF_StgUpdateFrame-WDS(2)] = StgClosure_payload(R1,3);
- W_[Sp-SIZEOF_StgUpdateFrame-WDS(3)] = StgClosure_payload(R1,2);
- W_[Sp-SIZEOF_StgUpdateFrame-WDS(4)] = StgClosure_payload(R1,1);
- R1 = StgClosure_payload(R1,0);
+ W_[Sp-SIZEOF_StgUpdateFrame-WDS(1)] = StgThunk_payload(R1,4);
+ W_[Sp-SIZEOF_StgUpdateFrame-WDS(2)] = StgThunk_payload(R1,3);
+ W_[Sp-SIZEOF_StgUpdateFrame-WDS(3)] = StgThunk_payload(R1,2);
+ W_[Sp-SIZEOF_StgUpdateFrame-WDS(4)] = StgThunk_payload(R1,1);
+ R1 = StgThunk_payload(R1,0);
Sp = Sp - SIZEOF_StgUpdateFrame - WDS(4);
Sp_adj(-1); // for stg_ap_0_ret
TICK_UNKNOWN_CALL();
LDV_ENTER(R1);
ENTER_CCS_THUNK(R1);
PUSH_UPD_FRAME(Sp-SIZEOF_StgUpdateFrame,R1);
- W_[Sp-SIZEOF_StgUpdateFrame-WDS(1)] = StgClosure_payload(R1,5);
- W_[Sp-SIZEOF_StgUpdateFrame-WDS(2)] = StgClosure_payload(R1,4);
- W_[Sp-SIZEOF_StgUpdateFrame-WDS(3)] = StgClosure_payload(R1,3);
- W_[Sp-SIZEOF_StgUpdateFrame-WDS(4)] = StgClosure_payload(R1,2);
- W_[Sp-SIZEOF_StgUpdateFrame-WDS(5)] = StgClosure_payload(R1,1);
- R1 = StgClosure_payload(R1,0);
+ W_[Sp-SIZEOF_StgUpdateFrame-WDS(1)] = StgThunk_payload(R1,5);
+ W_[Sp-SIZEOF_StgUpdateFrame-WDS(2)] = StgThunk_payload(R1,4);
+ W_[Sp-SIZEOF_StgUpdateFrame-WDS(3)] = StgThunk_payload(R1,3);
+ W_[Sp-SIZEOF_StgUpdateFrame-WDS(4)] = StgThunk_payload(R1,2);
+ W_[Sp-SIZEOF_StgUpdateFrame-WDS(5)] = StgThunk_payload(R1,1);
+ R1 = StgThunk_payload(R1,0);
Sp = Sp - SIZEOF_StgUpdateFrame - WDS(5);
Sp_adj(-1); // for stg_ap_0_ret
TICK_UNKNOWN_CALL();
LDV_ENTER(R1);
ENTER_CCS_THUNK(R1);
PUSH_UPD_FRAME(Sp-SIZEOF_StgUpdateFrame,R1);
- W_[Sp-SIZEOF_StgUpdateFrame-WDS(1)] = StgClosure_payload(R1,6);
- W_[Sp-SIZEOF_StgUpdateFrame-WDS(2)] = StgClosure_payload(R1,5);
- W_[Sp-SIZEOF_StgUpdateFrame-WDS(3)] = StgClosure_payload(R1,4);
- W_[Sp-SIZEOF_StgUpdateFrame-WDS(4)] = StgClosure_payload(R1,3);
- W_[Sp-SIZEOF_StgUpdateFrame-WDS(5)] = StgClosure_payload(R1,2);
- W_[Sp-SIZEOF_StgUpdateFrame-WDS(6)] = StgClosure_payload(R1,1);
- R1 = StgClosure_payload(R1,0);
+ W_[Sp-SIZEOF_StgUpdateFrame-WDS(1)] = StgThunk_payload(R1,6);
+ W_[Sp-SIZEOF_StgUpdateFrame-WDS(2)] = StgThunk_payload(R1,5);
+ W_[Sp-SIZEOF_StgUpdateFrame-WDS(3)] = StgThunk_payload(R1,4);
+ W_[Sp-SIZEOF_StgUpdateFrame-WDS(4)] = StgThunk_payload(R1,3);
+ W_[Sp-SIZEOF_StgUpdateFrame-WDS(5)] = StgThunk_payload(R1,2);
+ W_[Sp-SIZEOF_StgUpdateFrame-WDS(6)] = StgThunk_payload(R1,1);
+ R1 = StgThunk_payload(R1,0);
Sp = Sp - SIZEOF_StgUpdateFrame - WDS(6);
Sp_adj(-1); // for stg_ap_0_ret
TICK_UNKNOWN_CALL();
projects / ghc-hetmet.git / commitdiff