/* ----------------------------------------------------------------------------
- * $Id: InfoTables.h,v 1.2 1998/12/02 13:21:10 simonm Exp $
+ * $Id: InfoTables.h,v 1.16 1999/06/25 09:13:37 simonmar Exp $
*
+ * (c) The GHC Team, 1998-1999
+ *
* Info Tables
*
* -------------------------------------------------------------------------- */
#endif /* DEBUG_CLOSURE */
-/* -----------------------------------------------------------------------------
- Closure Types
-
- If you add or delete any closure types, don't forget to update
- ClosureTypes.h for the native code generator. This is a temporary
- measure (I hope).
- -------------------------------------------------------------------------- */
-
-typedef enum {
-
- INVALID_OBJECT /* Object tag 0 raises an internal error */
- , CONSTR
- /* CONSTR_p_np */
- , CONSTR_INTLIKE
- , CONSTR_CHARLIKE
- , CONSTR_STATIC
- , CONSTR_NOCAF_STATIC
-
- , FUN
- , FUN_STATIC
-
- , THUNK
- /* THUNK_p_np */
- , THUNK_STATIC
- , THUNK_SELECTOR
-
- , BCO
- , AP_UPD
-
- , PAP /* should be called AP_NUPD */
-
- , IND
- , IND_OLDGEN
- , IND_PERM
- , IND_OLDGEN_PERM
- , IND_STATIC
-
- , CAF_UNENTERED
- , CAF_ENTERED
- , CAF_BLACKHOLE
-
- , RET_BCO
- , RET_SMALL
- , RET_VEC_SMALL
- , RET_BIG
- , RET_VEC_BIG
- , RET_DYN
- , UPDATE_FRAME
- , CATCH_FRAME
- , STOP_FRAME
- , SEQ_FRAME
-
- , BLACKHOLE
- , MVAR
-
- , ARR_WORDS
- , ARR_PTRS
-
- , MUT_ARR_WORDS
- , MUT_ARR_PTRS
- , MUT_ARR_PTRS_FROZEN
- , MUT_VAR
-
- , WEAK
- , FOREIGN
-
- , TSO
-
- , BLOCKED_FETCH
- , FETCH_ME
-
- , EVACUATED
-
- , N_CLOSURE_TYPES /* number of distinct closure types */
-
-} StgClosureType;
-
/* The type flags provide quick access to certain properties of a closure. */
#define _HNF (1<<0) /* head normal form? */
#define _UPT (1<<6) /* unpointed? */
#define _SRT (1<<7) /* has an SRT? */
-#define isSTATIC(flags) ((flags)&_STA)
-#define closure_STATIC(closure) ( get_itbl(closure)->flags & _STA)
-#define closure_SHOULD_SPARK(closure) (!(get_itbl(closure)->flags & _NS))
-#define closure_UNPOINTED(closure) ( get_itbl(closure)->flags & _UPT)
-
-/* HNF BTM NS STA THU MUT UPT SRT */
-
-#define FLAGS_CONSTR (_HNF| _NS )
-#define FLAGS_CONSTR_STATIC (_HNF| _NS|_STA )
-#define FLAGS_CONSTR_NOCAF_STATIC (_HNF| _NS|_STA )
-#define FLAGS_FUN (_HNF| _NS| _SRT )
-#define FLAGS_FUN_STATIC (_HNF| _NS|_STA| _SRT )
-#define FLAGS_THUNK ( _BTM| _THU| _SRT )
-#define FLAGS_THUNK_STATIC ( _BTM| _STA|_THU| _SRT )
-#define FLAGS_THUNK_SELECTOR ( _BTM| _THU| _SRT )
-#define FLAGS_BCO (_HNF| _NS )
-#define FLAGS_CAF_UNENTERED 0 /* Do we still use these? */
-#define FLAGS_CAF_ENTERED 0
-#define FLAGS_CAF_BLACKHOLE ( _BTM|_NS| _UPT )
-#define FLAGS_AP_UPD ( _BTM| _THU )
-#define FLAGS_PAP (_HNF| _NS )
-#define FLAGS_IND 0
-#define FLAGS_IND_OLDGEN 0
-#define FLAGS_IND_PERM 0
-#define FLAGS_IND_OLDGEN_PERM 0
-#define FLAGS_IND_STATIC ( _STA )
-#define FLAGS_EVACUATED 0
-#define FLAGS_ARR_WORDS (_HNF| _NS| _UPT )
-#define FLAGS_MUT_ARR_WORDS (_HNF| _NS| _MUT|_UPT )
-#define FLAGS_ARR_PTRS (_HNF| _NS| _UPT )
-#define FLAGS_MUT_ARR_PTRS (_HNF| _NS| _MUT|_UPT )
-#define FLAGS_MUT_ARR_PTRS_FROZEN (_HNF| _NS| _MUT|_UPT )
-#define FLAGS_MUT_VAR (_HNF| _NS| _MUT|_UPT )
-#define FLAGS_FOREIGN (_HNF| _NS| _UPT )
-#define FLAGS_WEAK (_HNF| _NS| _UPT )
-#define FLAGS_BLACKHOLE ( _BTM|_NS| _UPT )
-#define FLAGS_MVAR (_HNF| _NS| _UPT )
-#define FLAGS_FETCH_ME (_HNF| _NS )
-#define FLAGS_TSO 0
-#define FLAGS_RET_BCO ( _BTM )
-#define FLAGS_RET_SMALL ( _BTM| _SRT)
-#define FLAGS_RET_VEC_SMALL ( _BTM| _SRT)
-#define FLAGS_RET_BIG ( _SRT)
-#define FLAGS_RET_VEC_BIG ( _SRT)
-#define FLAGS_RET_DYN ( _SRT)
-#define FLAGS_CATCH_FRAME 0
-#define FLAGS_STOP_FRAME 0
-#define FLAGS_SEQ_FRAME 0
-#define FLAGS_UPDATE_FRAME 0
+#define isSTATIC(flags) ((flags) &_STA)
+#define isMUTABLE(flags) ((flags) &_MUT)
+#define isBITMAP(flags) ((flags) &_BTM)
+#define isTHUNK(flags) ((flags) &_THU)
+#define isUNPOINTED(flags) ((flags) &_UPT)
+#define hasSRT(flags) ((flags) &_SRT)
+
+extern StgWord16 closure_flags[];
+
+#define closureFlags(c) (closure_flags[get_itbl(c)->type])
+
+#define closure_STATIC(c) ( closureFlags(c) & _STA)
+#define closure_SHOULD_SPARK(c) (!(closureFlags(c) & _NS))
+#define closure_MUTABLE(c) ( closureFlags(c) & _MUT)
+#define closure_UNPOINTED(c) ( closureFlags(c) & _UPT)
+
/* -----------------------------------------------------------------------------
Info Tables
-------------------------------------------------------------------------- */
/* A large bitmap. Small 32-bit ones live in the info table, but sometimes
- * 32 bits isn't enough and we have to generate a larger one.
+ * 32 bits isn't enough and we have to generate a larger one. (sizes
+ * differ for 64-bit machines.
*/
typedef struct {
- StgNat32 size;
- StgNat32 bitmap[0];
+ StgWord size;
+ StgWord bitmap[0];
} StgLargeBitmap;
/*
* Stuff describing the closure layout. Well, actually, it might
- * contain the selector index for a THUNK_SELECTOR.
+ * contain the selector index for a THUNK_SELECTOR. If we're on a
+ * 64-bit architecture then we can enlarge some of these fields, since
+ * the union contains a pointer field.
*/
typedef union {
+#if SIZEOF_VOID_P == 8
+ struct {
+ StgWord32 ptrs; /* number of pointers */
+ StgWord32 nptrs; /* number of non-pointers */
+ } payload;
+#else
+ struct {
+ StgWord16 ptrs; /* number of pointers */
+ StgWord16 nptrs; /* number of non-pointers */
+ } payload;
- StgNat32 bitmap; /* bit pattern, 1 = pointer, 0 = non-pointer */
-
+ StgWord bitmap; /* bit pattern, 1 = pointer, 0 = non-pointer */
+ StgWord selector_offset; /* used in THUNK_SELECTORs */
StgLargeBitmap* large_bitmap; /* pointer to large bitmap structure */
- struct {
- StgNat16 ptrs; /* number of pointers */
- StgNat16 nptrs; /* number of non-pointers */
- } payload;
+#endif
- StgNat32 selector_offset; /* used in THUNK_SELECTORs */
-
} StgClosureInfo;
/*
typedef struct _StgInfoTable {
StgSRT *srt; /* pointer to the SRT table */
+#ifdef PAR
StgParInfo par;
- StgProfInfo prof;
+#endif
+#ifdef PROFILING
+ /* StgProfInfo prof; */
+#endif
+#ifdef DEBUG_CLOSURE
StgDebugInfo debug;
- StgClosureInfo layout; /* closure layout info */
- StgNat8 flags; /* } */
- StgClosureType type : 8; /* } These 4 elements fit into 32 bits */
- StgNat16 srt_len; /* } */
-#if USE_MINIINTERPRETER
- StgFunPtr (*vector)[];
- StgFunPtr entry;
+#endif
+ StgClosureInfo layout; /* closure layout info (pointer-sized) */
+#if SIZEOF_VOID_P == 8
+ StgWord32 type; /* } These 2 elements fit into 64 bits */
+ StgWord32 srt_len; /* } */
#else
+ StgWord type : 16; /* } These 2 elements fit into 32 bits */
+ StgWord srt_len : 16; /* } */
+#endif
+#ifdef TABLES_NEXT_TO_CODE
StgCode code[0];
+#else
+ StgFunPtr entry;
+ StgFunPtr vector[0];
#endif
} StgInfoTable;
+/* Info tables are read-only, therefore we uniformly declare them with
+ * C's const attribute. This isn't just a nice thing to do: it's
+ * necessary because the garbage collector has to distinguish between
+ * closure pointers and info table pointers when traversing the
+ * stack. We distinguish the two by checking whether the pointer is
+ * into text-space or not.
+ */
+
+#define INFO_TBL_CONST const
+
#endif /* INFOTABLES_H */
projects / ghc-hetmet.git / blobdiff