X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fincludes%2FClosureMacros.h;h=f40f6aace6d283f3ddfe74d39f255e824b13677a;hb=28a464a75e14cece5db40f2765a29348273ff2d2;hp=70470e93b51121ef0fe906a2cb118d1b2bb81c8d;hpb=db61851c5472bf565cd1da900b33d6e033fd743d;p=ghc-hetmet.git

diff --git a/ghc/includes/ClosureMacros.h b/ghc/includes/ClosureMacros.h
index 70470e9..f40f6aa 100644
--- a/ghc/includes/ClosureMacros.h
+++ b/ghc/includes/ClosureMacros.h
@@ -1,7 +1,6 @@
 /* ----------------------------------------------------------------------------
- * $Id: ClosureMacros.h,v 1.33 2001/11/22 14:25:11 simonmar 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
 
 /* -----------------------------------------------------------------------------
@@ -87,7 +93,6 @@ static __inline__ StgFunPtr get_entry(const StgInfoTable *itbl) {
   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
@@ -108,10 +113,10 @@ extern StgWord flip;
  */
 #define SET_PROF_HDR(c,ccs_)            \
         ((c)->header.prof.ccs = ccs_,   \
-        LDV_recordCreate((c)))
-#endif  // DEBUG_RETAINER
+        LDV_RECORD_CREATE((c)))
+#endif /* DEBUG_RETAINER */
 #define SET_STATIC_PROF_HDR(ccs_)       \
-        prof : { ccs : ccs_, hp : { rs : NULL } },
+        prof : { ccs : (CostCentreStack *)ccs_, hp : { rs : NULL } },
 #else
 #define SET_PROF_HDR(c,ccs)
 #define SET_STATIC_PROF_HDR(ccs)
@@ -141,9 +146,9 @@ extern StgWord flip;
 #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);		\
@@ -155,45 +160,29 @@ extern StgWord flip;
    (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 +			\
@@ -206,17 +195,4 @@ extern StgWord flip;
 #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 */