/* ----------------------------------------------------------------------------
- * $Id: ClosureMacros.h,v 1.2 1998/12/02 13:20:58 simonm Exp $
+ * $Id: ClosureMacros.h,v 1.26 2000/10/06 15:38:06 simonmar Exp $
+ *
+ * (c) The GHC Team, 1998-1999
*
* Macros for building and manipulating closures
*
#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)
+#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 itbl->entry;
+ return (StgFunPtr)(itbl+1);
}
#else
-#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) (stgCast(StgInfoTable*,info) - 1)
-#define get_itbl(c) (stgCast(StgInfoTable*,(c)->header.info) -1)
+#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 stgCast(StgFunPtr,itbl+1);
+ return itbl->entry;
}
#endif
* _end } end of read-write data space
*/
extern StgFun start;
-extern StgFun TEXT_SECTION_END_MARKER_DECL;
-extern StgFun DATA_SECTION_END_MARKER_DECL;
+extern void* TEXT_SECTION_END_MARKER_DECL;
+extern void* DATA_SECTION_END_MARKER_DECL;
+
+#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((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((char *)p) )
+#define IS_USER_PTR(p) ( ((P_)(p) >= (P_)&DATA_SECTION_END_MARKER) \
+ && 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)
#define IS_USER_PTR(p) ((P_)(p) >= (P_)&DATA_SECTION_END_MARKER)
+#endif
+
+
+#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)
+#endif
+
+/* When working with Win32 DLLs, static closures are identified by
+ being prefixed with a zero word. This is needed so that we can
+ distinguish between pointers to static closures and (reversed!)
+ info tables.
+
+ This 'scheme' breaks down for closure tables such as CHARLIKE,
+ so we catch these separately.
+
+ LOOKS_LIKE_STATIC_CLOSURE()
+ - discriminates between static closures and info tbls
+ (needed by LOOKS_LIKE_GHC_INFO() below - [Win32 DLLs only.])
+ LOOKS_LIKE_STATIC()
+ - distinguishes between static and heap allocated data.
+ */
+#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 + \
+ (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
+#define LOOKS_LIKE_STATIC(r) IS_DATA_PTR(r)
+#define LOOKS_LIKE_STATIC_CLOSURE(r) IS_DATA_PTR(r)
+#endif
+
/* -----------------------------------------------------------------------------
Macros for distinguishing infotables from closures.
approximations. This absolutely has to be fixed.
-------------------------------------------------------------------------- */
-#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))
+#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
#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 USE_MINIINTERPRETER
-/* in the mininterpreter, we put infotables on closures */
-#define LOOKS_LIKE_GHC_INFO(info) IS_CODE_PTR(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
-/* otherwise we have entry pointers on closures */
-#define LOOKS_LIKE_GHC_INFO(info) IS_CODE_PTR(info)
+# define LOOKS_LIKE_GHC_INFO(info) IS_CODE_PTR(info)
#endif
-#define LOOKS_LIKE_STATIC(r) IS_DATA_PTR(r)
-
/* -----------------------------------------------------------------------------
Macros for calculating how big a closure will be (used during allocation)
-------------------------------------------------------------------------- */
* 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 arr_ptrs_sizeW( StgArrPtrs* x )
-{ return sizeofW(StgArrPtrs) + x->ptrs; }
+
+static __inline__ StgOffset mut_arr_ptrs_sizeW( StgMutArrPtrs* x )
+{ return sizeofW(StgMutArrPtrs) + x->ptrs; }
static __inline__ StgWord bco_sizeW( StgBCO* bco )
{ return BCO_sizeW(bco->n_ptrs,bco->n_words,bco->n_instrs); }
#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)
#define SET_STATIC_PAR_HDR(stuff)
#endif
-#ifdef TICKY
-#define SET_TICKY_HDR(c,stuff) (c)->header.ticky.updated = stuff
-#define SET_STATIC_TICKY_HDR(stuff) ticky : { updated : stuff }
+#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 } */
#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); \
}
-/* works for all ARR_WORDS, ARR_PTRS variants (at the moment...) */
-
-#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])))
-#define STATIC_LINK2(info,p) \
- (*stgCast(StgClosure**,&((p)->payload[info->layout.payload.ptrs + \
+
+/* 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])
+
+#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])
/* -----------------------------------------------------------------------------
- Payload access
+ Closure Tables (for enumerated data types)
-------------------------------------------------------------------------- */
-#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))))
+#define CLOSURE_TBL(lbl) const StgClosure *lbl[] = {
/* -----------------------------------------------------------------------------
CONSTRs.
#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(StgNat8*, ((bco)->payload+(bco)->n_ptrs+(bco)->n_words))[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; }
#endif /* CLOSUREMACROS_H */
projects / ghc-hetmet.git / blobdiff