[project @ 1999-04-27 10:59:29 by sewardj]

[ghc-hetmet.git] / ghc / includes / ClosureMacros.h

diff --git a/ghc/includes/ClosureMacros.h b/ghc/includes/ClosureMacros.h
index c99caaa..4f170ca 100644 (file)
--- a/ghc/includes/ClosureMacros.h
+++ b/ghc/includes/ClosureMacros.h
@@ -1,5 +1,5 @@
 /* ----------------------------------------------------------------------------
- * $Id: ClosureMacros.h,v 1.4 1999/02/05 16:02:20 simonm Exp $
+ * $Id: ClosureMacros.h,v 1.12 1999/04/27 10:59:30 sewardj Exp $
  *
  * (c) The GHC Team, 1998-1999
  *
@@ -73,7 +73,7 @@ static __inline__ StgFunPtr get_entry(const StgInfoTable *itbl) {
 #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 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);
@@ -98,13 +98,50 @@ static __inline__ StgFunPtr get_entry(const StgInfoTable *itbl) {
  * _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;
 
 #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)
 
+#ifdef HAVE_WIN32_DLL_SUPPORT
+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.
+ */
+#ifdef HAVE_WIN32_DLL_SUPPORT
+#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 LOOKS_LIKE_STATIC_CLOSURE(r) (((*(((unsigned long *)(r))-1)) == 0) || IS_CHARLIKE_CLOSURE(r) || IS_INTLIKE_CLOSURE(r) || IS_BOOL_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.
    
@@ -129,11 +166,13 @@ extern StgFun DATA_SECTION_END_MARKER_DECL;
 #define LOOKS_LIKE_GHC_INFO(info) IS_CODE_PTR(info)
 #else
 /* otherwise we have entry pointers 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
+#  define LOOKS_LIKE_GHC_INFO(info) IS_CODE_PTR(info)
+# endif
 #endif
 
-#define LOOKS_LIKE_STATIC(r) IS_DATA_PTR(r)
-
 /* -----------------------------------------------------------------------------
    Macros for calculating how big a closure will be (used during allocation)
    -------------------------------------------------------------------------- */
@@ -279,6 +318,14 @@ SET_STATIC_HDR(PrelBase_CZh_closure,PrelBase_CZh_info,costCentreStack,const);
 #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])))
@@ -319,6 +366,8 @@ SET_STATIC_HDR(PrelBase_CZh_closure,PrelBase_CZh_info,costCentreStack,const);
 #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 */