X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fincludes%2FClosureMacros.h;h=b1ac095257d86b6ede52e9f3634cdc86a86e9548;hb=f016aea1357b8ce5a4f3cd866b32761cfd25f841;hp=6d0bb6e4808a46bd3c18b7888b231dacb6733c93;hpb=eb407ca1d21a43ff86ad731868f71e994afafe78;p=ghc-hetmet.git

diff --git a/ghc/includes/ClosureMacros.h b/ghc/includes/ClosureMacros.h
index 6d0bb6e..b1ac095 100644
--- a/ghc/includes/ClosureMacros.h
+++ b/ghc/includes/ClosureMacros.h
@@ -1,5 +1,5 @@
 /* ----------------------------------------------------------------------------
- * $Id: ClosureMacros.h,v 1.15 1999/05/11 16:47:39 keithw Exp $
+ * $Id: ClosureMacros.h,v 1.21 2000/03/17 14:37:21 simonmar Exp $
  *
  * (c) The GHC Team, 1998-1999
  *
@@ -59,24 +59,22 @@
 #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))
 
-#if USE_MINIINTERPRETER
-#define INIT_ENTRY(e)    entry : (F_)(e)
-#define GET_ENTRY(c)     ((c)->header.info->entry)
-#define ENTRY_CODE(info) (stgCast(StgInfoTable*,info)->entry)
-#define INFO_PTR_TO_STRUCT(info) (info)
-#define get_itbl(c)      ((c)->header.info)
-static __inline__ StgFunPtr get_entry(const StgInfoTable *itbl) {
-    return itbl->entry;
-}
-#else
+#ifdef TABLES_NEXT_TO_CODE
 #define INIT_ENTRY(e)    code : {}
-#define GET_ENTRY(c)     stgCast(StgFunPtr,((c)->header.info))
 #define ENTRY_CODE(info) (info)
 #define INFO_PTR_TO_STRUCT(info) ((StgInfoTable *)(info) - 1)
-#define get_itbl(c)      (stgCast(StgInfoTable*,(c)->header.info) -1)
 static __inline__ StgFunPtr get_entry(const StgInfoTable *itbl) {
-    return stgCast(StgFunPtr,itbl+1);
+    return (StgFunPtr)(itbl+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;
 }
 #endif
 
@@ -102,9 +100,22 @@ extern StgFun start;
 extern void* TEXT_SECTION_END_MARKER_DECL;
 extern void* DATA_SECTION_END_MARKER_DECL;
 
+#ifdef INTERPRETER
+/* Take into account code sections in dynamically loaded object files. */
+#define IS_CODE_PTR(p) (  ((P_)(p) < (P_)&TEXT_SECTION_END_MARKER) \
+                       || is_dynamically_loaded_code_or_rodata_ptr(p) )
+#define IS_DATA_PTR(p) ( ((P_)(p) >= (P_)&TEXT_SECTION_END_MARKER && \
+                          (P_)(p) < (P_)&DATA_SECTION_END_MARKER) \
+                       || is_dynamically_loaded_rwdata_ptr(p) )
+#define IS_USER_PTR(p) ( ((P_)(p) >= (P_)&DATA_SECTION_END_MARKER) \
+                       && is_not_dynamically_loaded_ptr(p) )
+#else
 #define IS_CODE_PTR(p) ((P_)(p) < (P_)&TEXT_SECTION_END_MARKER)
 #define IS_DATA_PTR(p) ((P_)(p) >= (P_)&TEXT_SECTION_END_MARKER && (P_)(p) < (P_)&DATA_SECTION_END_MARKER)
 #define IS_USER_PTR(p) ((P_)(p) >= (P_)&DATA_SECTION_END_MARKER)
+#endif
+
+
 
 #ifdef HAVE_WIN32_DLL_SUPPORT
 extern int is_heap_alloced(const void* x);
@@ -131,8 +142,8 @@ extern int is_heap_alloced(const void* x);
 #define LOOKS_LIKE_STATIC(r) (!(HEAP_ALLOCED(r)))
 
 /* Tiresome predicates needed to check for pointers into the closure tables */
-#define IS_CHARLIKE_CLOSURE(p)  ( stgCast(StgPtr,p) >= stgCast(StgPtr,CHARLIKE_closure) && stgCast(char*,p) <= (stgCast(char*,CHARLIKE_closure) + 255 * sizeof(StgIntCharlikeClosure)))
-#define IS_INTLIKE_CLOSURE(p)  ( stgCast(StgPtr,p) >= stgCast(StgPtr,INTLIKE_closure) && stgCast(char*,p) <= (stgCast(char*,INTLIKE_closure) + 32 * sizeof(StgIntCharlikeClosure)))
+#define IS_CHARLIKE_CLOSURE(p)  ( (P_)(p) >= (P_)CHARLIKE_closure && (char*)(p) <= ((char*)CHARLIKE_closure + 255 * sizeof(StgIntCharlikeClosure)) )
+#define IS_INTLIKE_CLOSURE(p)  ( (P_)(p) >= (P_)INTLIKE_closure && (char*)(p) <= ((char*)INTLIKE_closure + 32 * sizeof(StgIntCharlikeClosure)) )
 
 #define LOOKS_LIKE_STATIC_CLOSURE(r) (((*(((unsigned long *)(r))-1)) == 0) || IS_CHARLIKE_CLOSURE(r) || IS_INTLIKE_CLOSURE(r))
 #else
@@ -153,23 +164,21 @@ extern int is_heap_alloced(const void* x);
    approximations.  This absolutely has to be fixed.
    -------------------------------------------------------------------------- */
 
+#ifdef INTERPRETER
 #ifdef USE_MINIINTERPRETER
 /* yoiks: one of the dreaded pointer equality tests */
-#define IS_HUGS_CONSTR_INFO(info) (stgCast(StgInfoTable*,info)->entry == stgCast(StgFunPtr,&Hugs_CONSTR_entry))
+#define IS_HUGS_CONSTR_INFO(info) (((StgInfoTable *)(info))->entry == (StgFunPtr)&Hugs_CONSTR_entry)
+#else
+#define IS_HUGS_CONSTR_INFO(info) 0 /* ToDo: more than mildly bogus */
+#endif
 #else
 #define IS_HUGS_CONSTR_INFO(info) 0 /* ToDo: more than mildly bogus */
 #endif
 
-#ifdef USE_MINIINTERPRETER
-/* in the mininterpreter, we put infotables on closures */
-#define LOOKS_LIKE_GHC_INFO(info) IS_CODE_PTR(info)
+#ifdef HAVE_WIN32_DLL_SUPPORT
+# define LOOKS_LIKE_GHC_INFO(info) (!HEAP_ALLOCED(info) && !LOOKS_LIKE_STATIC_CLOSURE(info))
 #else
-/* otherwise we have entry pointers on closures */
-# ifdef HAVE_WIN32_DLL_SUPPORT
-#  define LOOKS_LIKE_GHC_INFO(info) (!HEAP_ALLOCED(info) && !LOOKS_LIKE_STATIC_CLOSURE(info))
-# else
-#  define LOOKS_LIKE_GHC_INFO(info) IS_CODE_PTR(info)
-# endif
+# define LOOKS_LIKE_GHC_INFO(info) IS_CODE_PTR(info)
 #endif
 
 /* -----------------------------------------------------------------------------
@@ -204,28 +213,17 @@ static __inline__ StgOffset CAF_sizeW ( void )
  * Sizes of closures
  * ------------------------------------------------------------------------*/
 
-static __inline__ StgOffset size_fromITBL( const StgInfoTable* itbl ) 
-{ return sizeof(StgClosure) 
-       + sizeof(StgPtr)  * itbl->layout.payload.ptrs 
-       + sizeof(StgWord) * itbl->layout.payload.nptrs; }
-
 static __inline__ StgOffset sizeW_fromITBL( const StgInfoTable* itbl ) 
 { return sizeofW(StgClosure) 
        + sizeofW(StgPtr)  * itbl->layout.payload.ptrs 
        + sizeofW(StgWord) * itbl->layout.payload.nptrs; }
 
-static __inline__ StgOffset pap_size( StgPAP* x )
-{ return sizeof(StgPAP) 
-       + sizeof(StgWord)  * x->n_args; }
-
 static __inline__ StgOffset pap_sizeW( StgPAP* x )
 { return PAP_sizeW(x->n_args); }
 
-/* These two functions give the same result - but have slightly
- * different types. 
- */
 static __inline__ StgOffset arr_words_sizeW( StgArrWords* x )
 { return sizeofW(StgArrWords) + x->words; }
+
 static __inline__ StgOffset mut_arr_ptrs_sizeW( StgMutArrPtrs* x )
 { return sizeofW(StgMutArrPtrs) + x->ptrs; }
 
@@ -255,8 +253,6 @@ static __inline__ StgWord tso_sizeW ( StgTSO *tso )
 #define SET_STATIC_GRAN_HDR
 #endif
 
-/* there is no PAR header, as far as I can tell -- SDM */
-
 #ifdef PAR
 #define SET_PAR_HDR(c,stuff)
 #define SET_STATIC_PAR_HDR(stuff)
@@ -266,47 +262,47 @@ static __inline__ StgWord tso_sizeW ( StgTSO *tso )
 #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 } */
+#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) \
-   {					\
-	SET_INFO(c,info); 	                        \
+#define SET_HDR(c,info,ccs)				\
+   {							\
+	SET_INFO(c,info);				\
 	SET_GRAN_HDR((StgClosure *)(c),ThisPE);		\
 	SET_PAR_HDR((StgClosure *)(c),LOCAL_GA);	\
 	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); \
+#define SET_ARR_HDR(c,info,costCentreStack,n_words)	\
+   SET_HDR(c,info,costCentreStack);			\
    (c)->words = n_words;
 
 /* -----------------------------------------------------------------------------
    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,const);
 
    The info argument must have type 'StgInfoTable' or
    'StgSRTInfoTable', since we use '&' to get its address in the macro.
    -------------------------------------------------------------------------- */
 
-#define SET_STATIC_HDR(label,info,costCentreStack,closure_class,info_class) \
-   info_class info;                        \
-   closure_class StgClosure label = {                   \
+#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)       \
+#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.
@@ -314,9 +310,10 @@ SET_STATIC_HDR(PrelBase_CZh_closure,PrelBase_CZh_info,costCentreStack,const);
  * 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) \
-   (*stgCast(StgClosure**,&((p)->payload[info->layout.payload.ptrs + \
+#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.
@@ -325,8 +322,8 @@ SET_STATIC_HDR(PrelBase_CZh_closure,PrelBase_CZh_info,costCentreStack,const);
 #define THUNK_STATIC_LINK(p) ((p)->payload[2])
 #define IND_STATIC_LINK(p)   ((p)->payload[1])
 
-#define STATIC_LINK2(info,p) \
-   (*stgCast(StgClosure**,&((p)->payload[info->layout.payload.ptrs + \
+#define STATIC_LINK2(info,p)							\
+   (*(StgClosure**)(&((p)->payload[info->layout.payload.ptrs +			\
 					info->layout.payload.nptrs + 1])))
 
 /* -----------------------------------------------------------------------------
@@ -343,14 +340,6 @@ SET_STATIC_HDR(PrelBase_CZh_closure,PrelBase_CZh_info,costCentreStack,const);
 #define CLOSURE_TBL(lbl) const StgClosure *lbl[] = {
 
 /* -----------------------------------------------------------------------------
-   Payload access
-   -------------------------------------------------------------------------- */
-
-#define payloadPtr( c, i )    (*stgCast(StgPtr*,       ((c)->payload+(i))))
-#define payloadCPtr( c, i )   (*stgCast(StgClosure**,  ((c)->payload+(i))))
-#define payloadWord( c, i )   (*stgCast(StgWord*,      ((c)->payload+(i))))
-
-/* -----------------------------------------------------------------------------
    CONSTRs.
    -------------------------------------------------------------------------- */