X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fincludes%2FClosureMacros.h;h=5ddb934148b59faae9916a85fb5f060a9b277080;hb=49bff3215bf3fe9ada24dac2cf80f97db4e597dd;hp=41d3fd8c4e7edebc6813a01816a4715e06571014;hpb=9ac55e08e159d7a4647ab01e7872e69dd762f275;p=ghc-hetmet.git

diff --git a/ghc/includes/ClosureMacros.h b/ghc/includes/ClosureMacros.h
index 41d3fd8..5ddb934 100644
--- a/ghc/includes/ClosureMacros.h
+++ b/ghc/includes/ClosureMacros.h
@@ -1,5 +1,5 @@
 /* ----------------------------------------------------------------------------
- * $Id: ClosureMacros.h,v 1.29 2000/12/04 12:31:20 simonmar Exp $
+ * $Id: ClosureMacros.h,v 1.37 2003/06/30 14:17:02 simonmar Exp $
  *
  * (c) The GHC Team, 1998-1999
  *
@@ -15,11 +15,6 @@
    program may reside in a DLL
 */
 
-#undef TEXT_BEFORE_HEAP
-#ifndef mingw32_TARGET_OS
-#define TEXT_BEFORE_HEAP 1
-#endif
-
 /* -----------------------------------------------------------------------------
    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
@@ -57,26 +52,43 @@
  
    -------------------------------------------------------------------------- */
 
-#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
 
 /* -----------------------------------------------------------------------------
@@ -84,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)
@@ -114,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);				\
@@ -131,7 +175,7 @@ static __inline__ StgFunPtr get_entry(const StgInfoTable *itbl) {
    Static closures are defined as follows:
 
 
-   SET_STATIC_HDR(PrelBase_CZh_closure,PrelBase_CZh_info,costCentreStack,const);
+   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.
@@ -163,6 +207,13 @@ static __inline__ StgFunPtr get_entry(const StgInfoTable *itbl) {
 /* These macros are optimised versions of the above for certain
  * closure types.  They *must* be equivalent to the generic
  * STATIC_LINK.
+ *
+ * You may be surprised that the STATIC_LINK field for a THUNK_STATIC
+ * is at offset 2; that's because a THUNK_STATIC always has two words
+ * of (non-ptr) padding, to make room for the IND_STATIC that is
+ * going to overwrite it.  It doesn't do any harm, because a
+ * THUNK_STATIC needs this extra word for the IND_STATIC's saved_info
+ * field anyhow.  Hmm, this is all rather delicate. --SDM
  */
 #define FUN_STATIC_LINK(p)   ((p)->payload[0])
 #define THUNK_STATIC_LINK(p) ((p)->payload[2])
@@ -190,24 +241,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)
-
-/* -----------------------------------------------------------------------------
-   BCOs.
-   -------------------------------------------------------------------------- */
-
-#define bcoConstPtr( bco, i )    (*stgCast(StgPtr*,       ((bco)->payload+(i))))
-#define bcoConstCPtr( bco, i )   (*stgCast(StgClosurePtr*,((bco)->payload+(i))))
-#define bcoConstInfoPtr( bco, i )(*stgCast(StgInfoTable**,((bco)->payload+(bco)->n_ptrs+i)))
-#define bcoConstInt( bco, i )    (*stgCast(StgInt*,       ((bco)->payload+(bco)->n_ptrs+i)))
-#define bcoConstInt64( bco, i )  (PK_Int64(stgCast(StgWord*,(bco)->payload+(bco)->n_ptrs+i)))
-#define bcoConstWord( bco, i )   (*stgCast(StgWord*,      ((bco)->payload+(bco)->n_ptrs+i)))
-#define bcoConstAddr( bco, i )   (*stgCast(StgAddr*,      ((bco)->payload+(bco)->n_ptrs+i)))
-#define bcoConstChar( bco, i )   (*stgCast(StgChar*,      ((bco)->payload+(bco)->n_ptrs+i)))
-#define bcoConstFloat( bco, i )  (PK_FLT(stgCast(StgWord*,(bco)->payload+(bco)->n_ptrs+i)))
-#define bcoConstDouble( bco, i ) (PK_DBL(stgCast(StgWord*,(bco)->payload+(bco)->n_ptrs+i)))
-#define bcoInstr( bco, i )       (stgCast(StgWord8*,      ((bco)->payload+(bco)->n_ptrs+(bco)->n_words))[i])
-static __inline__ StgInt bcoInstr16 ( StgBCO* bco, unsigned int i )
-{ StgInt x = (bcoInstr(bco,i) << 8) + bcoInstr(bco,i+1); return x; }
+#define GET_TAG(info) (INFO_PTR_TO_STRUCT(info)->srt_bitmap)
 
 #endif /* CLOSUREMACROS_H */