/* ----------------------------------------------------------------------------
- * $Id: ClosureMacros.h,v 1.8 1999/03/11 11:21:45 simonm Exp $
+ * $Id: ClosureMacros.h,v 1.20 1999/10/27 09:57:48 simonmar Exp $
*
* (c) The GHC Team, 1998-1999
*
#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
*/
extern StgFun start;
-extern StgWord TEXT_SECTION_END_MARKER_DECL[];
-extern StgWord DATA_SECTION_END_MARKER_DECL[];
-
+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);
#define LOOKS_LIKE_STATIC(r) (!(HEAP_ALLOCED(r)))
/* Tiresome predicates needed to check for pointers into the closure tables */
-#define IS_BOOL_CLOSURE(p) ( stgCast(StgPtr,p) >= stgCast(StgPtr,PrelBase_Bool_closure_tbl) && stgCast(char*,p) <= (stgCast(char*,PrelBase_Bool_closure_tbl) + 2 * sizeof(StgClosure)))
-#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) || IS_BOOL_CLOSURE(r))
+#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)
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
/* -----------------------------------------------------------------------------
#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)
#define STATIC_LINK(info,p) \
(*stgCast(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])
+
#define STATIC_LINK2(info,p) \
(*stgCast(StgClosure**,&((p)->payload[info->layout.payload.ptrs + \
info->layout.payload.nptrs + 1])))
#define INTLIKE_CLOSURE(n) ((P_)&INTLIKE_closure[(n)-MIN_INTLIKE])
/* -----------------------------------------------------------------------------
+ Closure Tables (for enumerated data types)
+ -------------------------------------------------------------------------- */
+
+#define CLOSURE_TBL(lbl) const StgClosure *lbl[] = {
+
+/* -----------------------------------------------------------------------------
Payload access
-------------------------------------------------------------------------- */
#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; }
#endif /* CLOSUREMACROS_H */