Commit d308d910 authored by mnislaih's avatar mnislaih
Browse files

Two new prim ops to access the Info Table and Payload of a closure:

- infoPtr# :: a -> Addr#
- closurePayload# :: a -> (# Array b, ByteArr# #)

These prim ops provide the magic behind the ':print' command 
parent ed12b704
......@@ -1677,6 +1677,16 @@ primop NewBCOOp "newBCO#" GenPrimOp
has_side_effects = True
out_of_line = True
primop InfoPtrOp "infoPtr#" GenPrimOp
a -> Addr#
with
out_of_line = True
primop ClosurePayloadOp "closurePayload#" GenPrimOp
a -> (# Array# b, ByteArr# #)
with
out_of_line = True
------------------------------------------------------------------------
section "Coercion"
{{\tt unsafeCoerce\# :: a -> b} is not a primop, but is defined in MkId.lhs.}
......
......@@ -614,4 +614,7 @@ RTS_FUN(readTVarzh_fast);
RTS_FUN(writeTVarzh_fast);
RTS_FUN(checkzh_fast);
RTS_FUN(infoPtrzh_fast);
RTS_FUN(closurePayloadzh_fast);
#endif /* STGMISCCLOSURES_H */
......@@ -1961,6 +1961,55 @@ mkApUpd0zh_fast
RET_P(ap);
}
infoPtrzh_fast
{
/* args: R1 = closure to analyze */
MAYBE_GC(R1_PTR, infoPtrzh_fast);
W_ info;
info = %GET_STD_INFO(R1);
RET_N(info);
}
closurePayloadzh_fast
{
/* args: R1 = closure to analyze */
// TODO: Consider the absence of ptrs or nonptrs as a special case ?
MAYBE_GC(R1_PTR, closurePayloadzh_fast);
W_ info, ptrs, nptrs, p, ptrs_arr, nptrs_arr;
info = %GET_STD_INFO(R1);
ptrs = TO_W_(%INFO_PTRS(info));
nptrs = TO_W_(%INFO_NPTRS(info));
p = 0;
ALLOC_PRIM (SIZEOF_StgMutArrPtrs + WDS(ptrs), R1_PTR, closurePayloadzh_fast);
ptrs_arr = Hp - SIZEOF_StgMutArrPtrs - WDS(ptrs) + WDS(1);
SET_HDR(ptrs_arr, stg_MUT_ARR_PTRS_FROZEN_info, W_[CCCS]);
StgMutArrPtrs_ptrs(ptrs_arr) = ptrs;
for:
if(p < ptrs) {
W_[ptrs_arr + SIZEOF_StgMutArrPtrs + WDS(p)] = StgClosure_payload(R1,p);
p = p + 1;
goto for;
}
ALLOC_PRIM (SIZEOF_StgArrWords + WDS(nptrs), R1_PTR, closurePayloadzh_fast);
nptrs_arr = Hp - SIZEOF_StgArrWords - WDS(nptrs) + WDS(1);
SET_HDR(nptrs_arr, stg_ARR_WORDS_info, W_[CCCS]);
StgArrWords_words(nptrs_arr) = nptrs;
p = 0;
for2:
if(p < nptrs) {
W_[BYTE_ARR_CTS(nptrs_arr) + WDS(p)] = StgClosure_payload(R1, p+ptrs);
p = p + 1;
goto for2;
}
RET_PP(ptrs_arr, nptrs_arr);
}
/* -----------------------------------------------------------------------------
Thread I/O blocking primitives
-------------------------------------------------------------------------- */
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment