[project @ 2003-06-27 18:28:31 by sof]
[ghc-hetmet.git] / ghc / includes / ClosureMacros.h
index 0690981..35140fc 100644 (file)
@@ -1,5 +1,5 @@
 /* ----------------------------------------------------------------------------
- * $Id: ClosureMacros.h,v 1.32 2001/02/06 11:41:04 rrt Exp $
+ * $Id: ClosureMacros.h,v 1.36 2003/05/14 09:14:01 simonmar Exp $
  *
  * (c) The GHC Team, 1998-1999
  *
  
    -------------------------------------------------------------------------- */
 
-#define INIT_INFO(i)  info : &(i)
+#define INIT_INFO(i)  info : (StgInfoTable *)&(i)
 #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))
+
 
 #ifdef TABLES_NEXT_TO_CODE
-#define INIT_ENTRY(e)    code : {}
+#define INIT_ENTRY(e)
 #define ENTRY_CODE(info) (info)
 #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)
 static __inline__ StgFunPtr get_entry(const StgInfoTable *itbl) {
     return (StgFunPtr)(itbl+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)
 #else
 #define INIT_ENTRY(e)    entry : (F_)(e)
 #define ENTRY_CODE(info) (((StgInfoTable *)info)->entry)
 #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)
 static __inline__ StgFunPtr get_entry(const StgInfoTable *itbl) {
     return itbl->entry;
 }
+#define itbl_to_fun_itbl(i) ((StgFunInfoTable *)(i))
+#define itbl_to_ret_itbl(i) ((StgRetInfoTable *)(i))
+#define itbl_to_thunk_itbl(i) ((StgThunkInfoTable *)(i))
 #endif
 
 /* -----------------------------------------------------------------------------
@@ -79,8 +96,39 @@ static __inline__ StgFunPtr get_entry(const StgInfoTable *itbl) {
    -------------------------------------------------------------------------- */
 
 #ifdef PROFILING
-#define SET_PROF_HDR(c,ccs_)           (c)->header.prof.ccs = ccs_
-#define SET_STATIC_PROF_HDR(ccs_)      prof : { ccs : ccs_ },
+#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.
+ */
+extern StgWord flip;
+#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_recordCreate((c)))
+#endif  // DEBUG_RETAINER
+#define SET_STATIC_PROF_HDR(ccs_)       \
+        prof : { ccs : ccs_, hp : { rs : NULL } },
 #else
 #define SET_PROF_HDR(c,ccs)
 #define SET_STATIC_PROF_HDR(ccs)
@@ -109,6 +157,7 @@ static __inline__ StgFunPtr get_entry(const StgInfoTable *itbl) {
 #define SET_TICKY_HDR(c,stuff)
 #define SET_STATIC_TICKY_HDR(stuff)
 #endif
+
 #define SET_HDR(c,info,ccs)                            \
    {                                                   \
        SET_INFO(c,info);                               \
@@ -185,6 +234,6 @@ static __inline__ StgFunPtr get_entry(const StgInfoTable *itbl) {
    -------------------------------------------------------------------------- */
 
 /* constructors don't have SRTs */
-#define GET_TAG(info) (INFO_PTR_TO_STRUCT(info)->srt_len)
+#define GET_TAG(info) (INFO_PTR_TO_STRUCT(info)->srt_bitmap)
 
 #endif /* CLOSUREMACROS_H */