+++ /dev/null
-/* ----------------------------------------------------------------------------
- *
- * (c) The GHC Team, 1998-2004
- *
- * Macros for building and manipulating closures
- *
- * -------------------------------------------------------------------------- */
-
-#ifndef CLOSUREMACROS_H
-#define CLOSUREMACROS_H
-
-/* Say whether the code comes before the heap; on mingwin this may not be the
- case, not because of another random MS pathology, but because the static
- program may reside in a DLL
-*/
-
-/* -----------------------------------------------------------------------------
- Info tables are slammed up against the entry code, and the label
- for the info table is at the *end* of the table itself. This
- inline function adjusts an info pointer to point to the beginning
- of the table, so we can use standard C structure indexing on it.
-
- Note: this works for SRT info tables as long as you don't want to
- access the SRT, since they are laid out the same with the SRT
- pointer as the first word in the table.
-
- NOTES ABOUT MANGLED C VS. MINI-INTERPRETER:
-
- A couple of definitions:
-
- "info pointer" The first word of the closure. Might point
- to either the end or the beginning of the
- info table, depending on whether we're using
- the mini interpretter or not. GET_INFO(c)
- retrieves the info pointer of a closure.
-
- "info table" The info table structure associated with a
- closure. This is always a pointer to the
- beginning of the structure, so we can
- use standard C structure indexing to pull out
- the fields. get_itbl(c) returns a pointer to
- the info table for closure c.
-
- An address of the form xxxx_info points to the end of the info
- table or the beginning of the info table depending on whether we're
- mangling or not respectively. So,
-
- c->header.info = xxx_info
-
- makes absolute sense, whether mangling or not.
-
- -------------------------------------------------------------------------- */
-
-#define SET_INFO(c,i) ((c)->header.info = (i))
-#define GET_INFO(c) ((c)->header.info)
-#define GET_ENTRY(c) (ENTRY_CODE(GET_INFO(c)))
-
-#define get_itbl(c) (INFO_PTR_TO_STRUCT((c)->header.info))
-#define get_ret_itbl(c) (RET_INFO_PTR_TO_STRUCT((c)->header.info))
-#define get_fun_itbl(c) (FUN_INFO_PTR_TO_STRUCT((c)->header.info))
-#define get_thunk_itbl(c) (THUNK_INFO_PTR_TO_STRUCT((c)->header.info))
-#define get_con_itbl(c) (CON_INFO_PTR_TO_STRUCT((c)->header.info))
-
-#define GET_TAG(con) (get_itbl(con)->srt_bitmap)
-
-#ifdef TABLES_NEXT_TO_CODE
-#define INFO_PTR_TO_STRUCT(info) ((StgInfoTable *)(info) - 1)
-#define RET_INFO_PTR_TO_STRUCT(info) ((StgRetInfoTable *)(info) - 1)
-#define FUN_INFO_PTR_TO_STRUCT(info) ((StgFunInfoTable *)(info) - 1)
-#define THUNK_INFO_PTR_TO_STRUCT(info) ((StgThunkInfoTable *)(info) - 1)
-#define CON_INFO_PTR_TO_STRUCT(info) ((StgConInfoTable *)(info) - 1)
-#define itbl_to_fun_itbl(i) ((StgFunInfoTable *)(((StgInfoTable *)(i) + 1)) - 1)
-#define itbl_to_ret_itbl(i) ((StgRetInfoTable *)(((StgInfoTable *)(i) + 1)) - 1)
-#define itbl_to_thunk_itbl(i) ((StgThunkInfoTable *)(((StgInfoTable *)(i) + 1)) - 1)
-#define itbl_to_con_itbl(i) ((StgConInfoTable *)(((StgInfoTable *)(i) + 1)) - 1)
-#else
-#define INFO_PTR_TO_STRUCT(info) ((StgInfoTable *)info)
-#define RET_INFO_PTR_TO_STRUCT(info) ((StgRetInfoTable *)info)
-#define FUN_INFO_PTR_TO_STRUCT(info) ((StgFunInfoTable *)info)
-#define THUNK_INFO_PTR_TO_STRUCT(info) ((StgThunkInfoTable *)info)
-#define CON_INFO_PTR_TO_STRUCT(info) ((StgConInfoTable *)info)
-#define itbl_to_fun_itbl(i) ((StgFunInfoTable *)(i))
-#define itbl_to_ret_itbl(i) ((StgRetInfoTable *)(i))
-#define itbl_to_thunk_itbl(i) ((StgThunkInfoTable *)(i))
-#define itbl_to_con_itbl(i) ((StgConInfoTable *)(i))
-#endif
-
-/* -----------------------------------------------------------------------------
- Macros for building closures
- -------------------------------------------------------------------------- */
-
-#ifdef PROFILING
-#ifdef DEBUG_RETAINER
-/*
- For the sake of debugging, we take the safest way for the moment. Actually, this
- is useful to check the sanity of heap before beginning retainer profiling.
- flip is defined in RetainerProfile.c, and declared as extern in RetainerProfile.h.
- Note: change those functions building Haskell objects from C datatypes, i.e.,
- all rts_mk???() functions in RtsAPI.c, as well.
- */
-#define SET_PROF_HDR(c,ccs_) \
- ((c)->header.prof.ccs = ccs_, (c)->header.prof.hp.rs = (retainerSet *)((StgWord)NULL | flip))
-#else
-/*
- For retainer profiling only: we do not have to set (c)->header.prof.hp.rs to
- NULL | flip (flip is defined in RetainerProfile.c) because even when flip
- is 1, rs is invalid and will be initialized to NULL | flip later when
- the closure *c is visited.
- */
-/*
-#define SET_PROF_HDR(c,ccs_) \
- ((c)->header.prof.ccs = ccs_, (c)->header.prof.hp.rs = NULL)
- */
-/*
- The following macro works for both retainer profiling and LDV profiling:
- for retainer profiling, ldvTime remains 0, so rs fields are initialized to 0.
- See the invariants on ldvTime.
- */
-#define SET_PROF_HDR(c,ccs_) \
- ((c)->header.prof.ccs = ccs_, \
- LDV_RECORD_CREATE((c)))
-#endif /* DEBUG_RETAINER */
-#define SET_STATIC_PROF_HDR(ccs_) \
- prof : { ccs : (CostCentreStack *)ccs_, hp : { rs : NULL } },
-#else
-#define SET_PROF_HDR(c,ccs)
-#define SET_STATIC_PROF_HDR(ccs)
-#endif
-
-#ifdef TICKY_TICKY
-#define SET_TICKY_HDR(c,stuff) /* old: (c)->header.ticky.updated = stuff */
-#define SET_STATIC_TICKY_HDR(stuff) /* old: ticky : { updated : stuff } */
-#else
-#define SET_TICKY_HDR(c,stuff)
-#define SET_STATIC_TICKY_HDR(stuff)
-#endif
-
-#define SET_HDR(c,_info,ccs) \
- { \
- (c)->header.info = _info; \
- SET_PROF_HDR((StgClosure *)(c),ccs); \
- SET_TICKY_HDR((StgClosure *)(c),0); \
- }
-
-#define SET_ARR_HDR(c,info,costCentreStack,n_words) \
- SET_HDR(c,info,costCentreStack); \
- (c)->words = n_words;
-
-/* -----------------------------------------------------------------------------
- How to get hold of the static link field for a static closure.
- -------------------------------------------------------------------------- */
-
-/* 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 + \
- info->layout.payload.nptrs + 1])))
-
-/* -----------------------------------------------------------------------------
- INTLIKE and CHARLIKE closures.
- -------------------------------------------------------------------------- */
-
-#define CHARLIKE_CLOSURE(n) ((P_)&stg_CHARLIKE_closure[(n)-MIN_CHARLIKE])
-#define INTLIKE_CLOSURE(n) ((P_)&stg_INTLIKE_closure[(n)-MIN_INTLIKE])
-
-#endif /* CLOSUREMACROS_H */
projects / ghc-hetmet.git / blobdiff