/* ----------------------------------------------------------------------------
- * $Id: ClosureMacros.h,v 1.20 1999/10/27 09:57:48 simonmar Exp $
+ * $Id: ClosureMacros.h,v 1.26 2000/10/06 15:38:06 simonmar Exp $
*
* (c) The GHC Team, 1998-1999
*
extern void* TEXT_SECTION_END_MARKER_DECL;
extern void* DATA_SECTION_END_MARKER_DECL;
-#ifdef INTERPRETER
+#if defined(INTERPRETER) || defined(GHCI)
/* 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) )
+ || is_dynamically_loaded_code_or_rodata_ptr((char *)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) )
+ || is_dynamically_loaded_rwdata_ptr((char *)p) )
#define IS_USER_PTR(p) ( ((P_)(p) >= (P_)&DATA_SECTION_END_MARKER) \
- && is_not_dynamically_loaded_ptr(p) )
+ && is_not_dynamically_loaded_ptr((char *)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)
#endif
-
-#ifdef HAVE_WIN32_DLL_SUPPORT
-extern int is_heap_alloced(const void* x);
-# define HEAP_ALLOCED(x) (is_heap_alloced(x))
+#ifdef ENABLE_WIN32_DLL_SUPPORT /* needed for mingw DietHEP */
+ extern int is_heap_alloced(const void* x);
+# define HEAP_ALLOCED(x) (is_heap_alloced(x))
#else
-# define HEAP_ALLOCED(x) IS_USER_PTR(x)
+# define HEAP_ALLOCED(x) IS_USER_PTR(x)
#endif
/* When working with Win32 DLLs, static closures are identified by
LOOKS_LIKE_STATIC()
- distinguishes between static and heap allocated data.
*/
-#ifdef HAVE_WIN32_DLL_SUPPORT
+#if defined(ENABLE_WIN32_DLL_SUPPORT) && !defined(INTERPRETER)
+ /* definitely do not enable for mingw DietHEP */
#define LOOKS_LIKE_STATIC(r) (!(HEAP_ALLOCED(r)))
/* Tiresome predicates needed to check for pointers into the closure tables */
-#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 IS_CHARLIKE_CLOSURE(p) \
+ ( (P_)(p) >= (P_)CHARLIKE_closure && \
+ (char*)(p) <= ((char*)CHARLIKE_closure + \
+ (MAX_CHARLIKE-MIN_CHARLIKE) * sizeof(StgIntCharlikeClosure)) )
+#define IS_INTLIKE_CLOSURE(p) \
+ ( (P_)(p) >= (P_)INTLIKE_closure && \
+ (char*)(p) <= ((char*)INTLIKE_closure + \
+ (MAX_INTLIKE-MIN_INTLIKE) * sizeof(StgIntCharlikeClosure)) )
#define LOOKS_LIKE_STATIC_CLOSURE(r) (((*(((unsigned long *)(r))-1)) == 0) || IS_CHARLIKE_CLOSURE(r) || IS_INTLIKE_CLOSURE(r))
#else
-------------------------------------------------------------------------- */
#ifdef INTERPRETER
-#ifdef USE_MINIINTERPRETER
-/* yoiks: one of the dreaded pointer equality tests */
-#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
+# ifdef USE_MINIINTERPRETER
+ /* yoiks: one of the dreaded pointer equality tests */
+# 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 */
+# define IS_HUGS_CONSTR_INFO(info) 0 /* ToDo: more than mildly bogus */
#endif
-#ifdef HAVE_WIN32_DLL_SUPPORT
-# define LOOKS_LIKE_GHC_INFO(info) (!HEAP_ALLOCED(info) && !LOOKS_LIKE_STATIC_CLOSURE(info))
+#ifdef ENABLE_WIN32_DLL_SUPPORT /* needed for mingw DietHEP */
+# 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)
+# define LOOKS_LIKE_GHC_INFO(info) IS_CODE_PTR(info)
#endif
/* -----------------------------------------------------------------------------
* 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; }
#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)
#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.
* 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.
#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])))
/* -----------------------------------------------------------------------------
INTLIKE and CHARLIKE closures.
-------------------------------------------------------------------------- */
-#define CHARLIKE_CLOSURE(n) ((P_)&CHARLIKE_closure[n])
+#define CHARLIKE_CLOSURE(n) ((P_)&CHARLIKE_closure[(n)-MIN_CHARLIKE])
#define INTLIKE_CLOSURE(n) ((P_)&INTLIKE_closure[(n)-MIN_INTLIKE])
/* -----------------------------------------------------------------------------
#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.
-------------------------------------------------------------------------- */
projects / ghc-hetmet.git / blobdiff