X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fincludes%2FClosureMacros.h;h=f40f6aace6d283f3ddfe74d39f255e824b13677a;hb=c137ecd7e6e83d0f9c39b15ccdb9f2355f243c91;hp=0690981adf8955edea39cb62933e0c7380d149b7;hpb=839930a03a9237d3a8c78745c6167f666fedada9;p=ghc-hetmet.git

diff --git a/ghc/includes/ClosureMacros.h b/ghc/includes/ClosureMacros.h
index 0690981..f40f6aa 100644
--- a/ghc/includes/ClosureMacros.h
+++ b/ghc/includes/ClosureMacros.h
@@ -1,7 +1,6 @@
 /* ----------------------------------------------------------------------------
- * $Id: ClosureMacros.h,v 1.32 2001/02/06 11:41:04 rrt Exp $
  *
- * (c) The GHC Team, 1998-1999
+ * (c) The GHC Team, 1998-2004
  *
  * Macros for building and manipulating closures
  *
@@ -52,26 +51,33 @@
  
    -------------------------------------------------------------------------- */
 
-#define INIT_INFO(i)  info : &(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))
+
+#define GET_TAG(con) (get_itbl(con)->srt_bitmap)
 
 #ifdef TABLES_NEXT_TO_CODE
-#define INIT_ENTRY(e)    code : {}
-#define ENTRY_CODE(info) (info)
 #define INFO_PTR_TO_STRUCT(info) ((StgInfoTable *)(info) - 1)
-static __inline__ StgFunPtr get_entry(const StgInfoTable *itbl) {
-    return (StgFunPtr)(itbl+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 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)
-static __inline__ StgFunPtr get_entry(const StgInfoTable *itbl) {
-    return itbl->entry;
-}
+#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 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 +85,38 @@ 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.
+ */
+#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)
@@ -109,9 +145,10 @@ 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)				\
+
+#define SET_HDR(c,_info,ccs)				\
    {							\
-	SET_INFO(c,info);				\
+	(c)->header.info = _info;			\
 	SET_GRAN_HDR((StgClosure *)(c),ThisPE);		\
 	SET_PAR_HDR((StgClosure *)(c),LOCAL_GA);	\
 	SET_PROF_HDR((StgClosure *)(c),ccs);		\
@@ -123,45 +160,29 @@ static __inline__ StgFunPtr get_entry(const StgInfoTable *itbl) {
    (c)->words = n_words;
 
 /* -----------------------------------------------------------------------------
-   Static closures are defined as follows:
-
-
-   SET_STATIC_HDR(PrelBase_CZh_closure,PrelBase_CZh_info,costCentreStack,closure_class,info_class);
-
-   The info argument must have type 'StgInfoTable' or
-   'StgSRTInfoTable', since we use '&' to get its address in the macro.
+   How to get hold of the static link field for a static closure.
    -------------------------------------------------------------------------- */
 
-#define SET_STATIC_HDR(label,info,costCentreStack,closure_class,info_class)	\
-   info_class info;								\
-   closure_class StgClosure label = {						\
-   STATIC_HDR(info,costCentreStack)
-
-#define STATIC_HDR(info,ccs)			\
-	header : {				\
-		INIT_INFO(info),		\
-		SET_STATIC_GRAN_HDR		\
-		SET_STATIC_PAR_HDR(LOCAL_GA)	\
-		SET_STATIC_PROF_HDR(ccs)	\
-		SET_STATIC_TICKY_HDR(0)		\
-	}
-
-/* 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[2])
-#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 +			\
@@ -174,17 +195,4 @@ static __inline__ StgFunPtr get_entry(const StgInfoTable *itbl) {
 #define CHARLIKE_CLOSURE(n) ((P_)&stg_CHARLIKE_closure[(n)-MIN_CHARLIKE])
 #define INTLIKE_CLOSURE(n)  ((P_)&stg_INTLIKE_closure[(n)-MIN_INTLIKE])
 
-/* -----------------------------------------------------------------------------
-   Closure Tables (for enumerated data types)
-   -------------------------------------------------------------------------- */
-
-#define CLOSURE_TBL(lbl) const StgClosure *lbl[] = {
-
-/* -----------------------------------------------------------------------------
-   CONSTRs.
-   -------------------------------------------------------------------------- */
-
-/* constructors don't have SRTs */
-#define GET_TAG(info) (INFO_PTR_TO_STRUCT(info)->srt_len)
-
 #endif /* CLOSUREMACROS_H */