/* -----------------------------------------------------------------------------
- * $Id: StgMacros.h,v 1.48 2002/08/16 13:28:22 simonmar Exp $
+ * $Id: StgMacros.h,v 1.57 2003/11/12 17:27:04 sof Exp $
*
* (c) The GHC Team, 1998-1999
*
#define EXTFUN(f) extern StgFunPtr f(void)
#define EXTFUN_RTS(f) extern DLL_IMPORT_RTS StgFunPtr f(void)
#define FN_(f) F_ f(void)
-#define IFN_(f) static F_ f(void)
#define IF_(f) static F_ f(void)
#define EF_(f) extern F_ f(void)
#define EDF_(f) extern DLLIMPORT F_ f(void)
-#define EXTINFO_RTS extern DLL_IMPORT_RTS INFO_TBL_CONST StgInfoTable
+#define EXTINFO_RTS extern DLL_IMPORT_RTS const StgInfoTable
+#define ETI_RTS extern DLL_IMPORT_RTS const StgThunkInfoTable
+
+// Info tables as generated by the compiler are simply arrays of words.
+typedef StgWord StgWordArray[];
+
#define ED_ extern
#define EDD_ extern DLLIMPORT
#define ED_RO_ extern const
#define ID_ static
#define ID_RO_ static const
-#define EI_ extern INFO_TBL_CONST StgInfoTable
-#define EDI_ extern DLLIMPORT INFO_TBL_CONST StgInfoTable
-#define II_ static INFO_TBL_CONST StgInfoTable
+#define EI_ extern StgWordArray
+#define ERI_ extern const StgRetInfoTable
+#define II_ static StgWordArray
+#define IRI_ static const StgRetInfoTable
#define EC_ extern StgClosure
#define EDC_ extern DLLIMPORT StgClosure
#define IC_ static StgClosure
#define ICP_(x) static const StgClosure *(x)[]
/* -----------------------------------------------------------------------------
- Stack Tagging.
+ Entering
- For a block of non-pointer words on the stack, we precede the
- block with a small-integer tag giving the number of non-pointer
- words in the block.
+ It isn't safe to "enter" every closure. Functions in particular
+ have no entry code as such; their entry point contains the code to
+ apply the function.
-------------------------------------------------------------------------- */
-#define ARGTAG_MAX 16 /* probably arbitrary */
-#define ARG_TAG(n) (n)
-#define ARG_SIZE(n) (StgWord)n
-
-typedef enum {
- REALWORLD_TAG = 0,
- INT_TAG = sizeofW(StgInt),
- INT64_TAG = sizeofW(StgInt64),
- WORD_TAG = sizeofW(StgWord),
- ADDR_TAG = sizeofW(StgAddr),
- CHAR_TAG = sizeofW(StgChar),
- FLOAT_TAG = sizeofW(StgFloat),
- DOUBLE_TAG = sizeofW(StgDouble),
- STABLE_TAG = sizeofW(StgWord),
-} StackTag;
-
-static inline int IS_ARG_TAG( StgWord p );
-static inline int IS_ARG_TAG( StgWord p ) { return p <= ARGTAG_MAX; }
-
-/* -----------------------------------------------------------------------------
- Argument checks.
-
- If (Sp + <n_args>) > Su { JMP_(stg_update_PAP); }
-
- Sp points to the topmost used word on the stack, and Su points to
- the most recently pushed update frame.
-
- Remember that <n_args> must include any tagging of unboxed values.
-
- ARGS_CHK_LOAD_NODE is for top-level functions, whose entry
- convention doesn't require that Node is loaded with a pointer to
- the closure. Thus we must load node before calling stg_updatePAP if
- the argument check fails.
- -------------------------------------------------------------------------- */
-
-#define ARGS_CHK(n) \
- if ((P_)(Sp + (n)) > (P_)Su) { \
- JMP_(stg_update_PAP); \
- }
-
-#define ARGS_CHK_LOAD_NODE(n,closure) \
- if ((P_)(Sp + (n)) > (P_)Su) { \
- R1.p = (P_)closure; \
- JMP_(stg_update_PAP); \
- }
+#define ENTER() \
+ { \
+ again: \
+ switch (get_itbl(R1.cl)->type) { \
+ case IND: \
+ case IND_OLDGEN: \
+ case IND_PERM: \
+ case IND_OLDGEN_PERM: \
+ case IND_STATIC: \
+ R1.cl = ((StgInd *)R1.cl)->indirectee; \
+ goto again; \
+ case BCO: \
+ case FUN: \
+ case FUN_1_0: \
+ case FUN_0_1: \
+ case FUN_2_0: \
+ case FUN_1_1: \
+ case FUN_0_2: \
+ case FUN_STATIC: \
+ case PAP: \
+ JMP_(ENTRY_CODE(Sp[0])); \
+ default: \
+ JMP_(GET_ENTRY(R1.cl)); \
+ } \
+ }
/* -----------------------------------------------------------------------------
Heap/Stack Checks.
in the meantime.
------------------------------------------------------------------------- */
-#define STK_CHK(headroom,ret,r,layout,tag_assts) \
- if (Sp - headroom < SpLim) { \
- tag_assts \
- (r) = (P_)ret; \
- JMP_(stg_chk_##layout); \
+#define STK_CHK_FUN(headroom,assts) \
+ if (Sp - headroom < SpLim) { \
+ assts \
+ JMP_(stg_gc_fun); \
}
-
-#define HP_CHK(headroom,ret,r,layout,tag_assts) \
- DO_GRAN_ALLOCATE(headroom) \
- if ((Hp += headroom) > HpLim) { \
- HpAlloc = (headroom); \
- tag_assts \
- (r) = (P_)ret; \
- JMP_(stg_chk_##layout); \
- }
-#define HP_STK_CHK(stk_headroom,hp_headroom,ret,r,layout,tag_assts) \
- DO_GRAN_ALLOCATE(hp_headroom) \
- if ((Hp += hp_headroom) > HpLim || Sp - stk_headroom < SpLim) { \
- HpAlloc = (hp_headroom); \
- tag_assts \
- (r) = (P_)ret; \
- JMP_(stg_chk_##layout); \
- }
+#define HP_CHK_FUN(headroom,assts) \
+ DO_GRAN_ALLOCATE(headroom) \
+ if ((Hp += headroom) > HpLim) { \
+ HpAlloc = (headroom); \
+ assts \
+ JMP_(stg_gc_fun); \
+ }
+
+// When doing both a heap and a stack check, don't move the heap
+// pointer unless the stack check succeeds. Otherwise we might end up
+// with slop at the end of the current block, which can confuse the
+// LDV profiler.
+#define HP_STK_CHK_FUN(stk_headroom,hp_headroom,assts) \
+ DO_GRAN_ALLOCATE(hp_headroom) \
+ if (Sp - stk_headroom < SpLim || (Hp += hp_headroom) > HpLim) { \
+ HpAlloc = (hp_headroom); \
+ assts \
+ JMP_(stg_gc_fun); \
+ }
/* -----------------------------------------------------------------------------
A Heap Check in a case alternative are much simpler: everything is
HpLim points to the LAST WORD of valid allocation space.
-------------------------------------------------------------------------- */
-#define STK_CHK_NP(headroom,ptrs,tag_assts) \
- if ((Sp - (headroom)) < SpLim) { \
- tag_assts \
- JMP_(stg_gc_enter_##ptrs); \
+#define STK_CHK_NP(headroom,tag_assts) \
+ if ((Sp - (headroom)) < SpLim) { \
+ tag_assts \
+ JMP_(stg_gc_enter_1); \
}
-#define HP_CHK_NP(headroom,ptrs,tag_assts) \
- DO_GRAN_ALLOCATE(headroom) \
- if ((Hp += (headroom)) > HpLim) { \
- HpAlloc = (headroom); \
- tag_assts \
- JMP_(stg_gc_enter_##ptrs); \
+#define HP_CHK_NP(headroom,tag_assts) \
+ DO_GRAN_ALLOCATE(headroom) \
+ if ((Hp += (headroom)) > HpLim) { \
+ HpAlloc = (headroom); \
+ tag_assts \
+ JMP_(stg_gc_enter_1); \
}
-#define HP_CHK_SEQ_NP(headroom,ptrs,tag_assts) \
- DO_GRAN_ALLOCATE(headroom) \
- if ((Hp += (headroom)) > HpLim) { \
- HpAlloc = (headroom); \
- tag_assts \
- JMP_(stg_gc_seq_##ptrs); \
- }
-
-#define HP_STK_CHK_NP(stk_headroom, hp_headroom, ptrs, tag_assts) \
+// See comment on HP_STK_CHK_FUN above.
+#define HP_STK_CHK_NP(stk_headroom, hp_headroom, tag_assts) \
DO_GRAN_ALLOCATE(hp_headroom) \
- if ((Hp += (hp_headroom)) > HpLim || (Sp - (stk_headroom)) < SpLim) { \
+ if ((Sp - (stk_headroom)) < SpLim || (Hp += (hp_headroom)) > HpLim) { \
HpAlloc = (hp_headroom); \
tag_assts \
- JMP_(stg_gc_enter_##ptrs); \
+ JMP_(stg_gc_enter_1); \
}
#define GEN_HP_CHK_ALT(headroom,lbl,tag_assts) \
DO_GRAN_ALLOCATE(headroom) \
if ((Hp += (headroom)) > HpLim) { \
- EXTFUN_RTS(lbl); \
HpAlloc = (headroom); \
tag_assts \
JMP_(lbl); \
GEN_HP_CHK_ALT(headroom,stg_gc_f1,tag_assts);
#define HP_CHK_D1(headroom,tag_assts) \
GEN_HP_CHK_ALT(headroom,stg_gc_d1,tag_assts);
-
#define HP_CHK_L1(headroom,tag_assts) \
GEN_HP_CHK_ALT(headroom,stg_gc_l1,tag_assts);
-#define HP_CHK_UT_ALT(headroom, ptrs, nptrs, r, ret, tag_assts) \
- GEN_HP_CHK_ALT(headroom, stg_gc_ut_##ptrs##_##nptrs, \
- tag_assts r = (P_)ret;)
-
/* -----------------------------------------------------------------------------
Generic Heap checks.
- primitives (no SRT required).
- The stack layout is like this:
-
- DblReg1-2
- FltReg1-4
- R1-8
- return address
- liveness mask
- stg_gen_chk_info
-
- so the liveness mask depends on the size of an StgDouble (FltRegs
- and R<n> are guaranteed to be 1 word in size).
-
+ The stack frame layout for a RET_DYN is like this:
+
+ some pointers |-- GET_PTRS(liveness) words
+ some nonpointers |-- GET_NONPTRS(liveness) words
+
+ L1 \
+ D1-2 |-- RET_DYN_NONPTR_REGS_SIZE words
+ F1-4 /
+
+ R1-8 |-- RET_DYN_BITMAP_SIZE words
+
+ return address \
+ liveness mask |-- StgRetDyn structure
+ stg_gen_chk_info /
+
+ we assume that the size of a double is always 2 pointers (wasting a
+ word when it is only one pointer, but avoiding lots of #ifdefs).
+
+ NOTE: if you change the layout of RET_DYN stack frames, then you
+ might also need to adjust the value of RESERVED_STACK_WORDS in
+ Constants.h.
-------------------------------------------------------------------------- */
-/* VERY MAGIC CONSTANTS!
- * must agree with code in HeapStackCheck.c, stg_gen_chk
- */
-
-#if SIZEOF_DOUBLE > SIZEOF_VOID_P
-#define ALL_NON_PTRS 0xffff
-#else /* SIZEOF_DOUBLE == SIZEOF_VOID_P */
-#define ALL_NON_PTRS 0x3fff
+// VERY MAGIC CONSTANTS!
+// must agree with code in HeapStackCheck.c, stg_gen_chk, and
+// RESERVED_STACK_WORDS in Constants.h.
+//
+#define RET_DYN_BITMAP_SIZE 8
+#define RET_DYN_NONPTR_REGS_SIZE 10
+#define ALL_NON_PTRS 0xff
+
+// Sanity check that RESERVED_STACK_WORDS is reasonable. We can't
+// just derive RESERVED_STACK_WORDS because it's used in Haskell code
+// too.
+#if RESERVED_STACK_WORDS != (3 + RET_DYN_BITMAP_SIZE + RET_DYN_NONPTR_REGS_SIZE)
+#error RESERVED_STACK_WORDS may be wrong!
#endif
#define LIVENESS_MASK(ptr_regs) (ALL_NON_PTRS ^ (ptr_regs))
+// We can have up to 255 pointers and 255 nonpointers in the stack
+// frame.
+#define N_NONPTRS(n) ((n)<<16)
+#define N_PTRS(n) ((n)<<24)
+
+#define GET_NONPTRS(l) ((l)>>16 & 0xff)
+#define GET_PTRS(l) ((l)>>24 & 0xff)
+#define GET_LIVENESS(l) ((l) & 0xffff)
+
#define NO_PTRS 0
#define R1_PTR 1<<0
#define R2_PTR 1<<1
#define R7_PTR 1<<6
#define R8_PTR 1<<7
-#define HP_CHK_GEN(headroom,liveness,reentry,tag_assts) \
+#define HP_CHK_UNBX_TUPLE(headroom,liveness,code) \
if ((Hp += (headroom)) > HpLim ) { \
HpAlloc = (headroom); \
- tag_assts \
+ code \
R9.w = (W_)LIVENESS_MASK(liveness); \
- R10.w = (W_)reentry; \
- JMP_(stg_gen_chk); \
+ JMP_(stg_gc_ut); \
}
-#define HP_CHK_GEN_TICKY(headroom,liveness,reentry,tag_assts) \
- HP_CHK_GEN(headroom,liveness,reentry,tag_assts); \
+#define HP_CHK_GEN(headroom,liveness,reentry) \
+ if ((Hp += (headroom)) > HpLim ) { \
+ HpAlloc = (headroom); \
+ R9.w = (W_)LIVENESS_MASK(liveness); \
+ R10.w = (W_)reentry; \
+ JMP_(stg_gc_gen); \
+ }
+
+#define HP_CHK_GEN_TICKY(headroom,liveness,reentry) \
+ HP_CHK_GEN(headroom,liveness,reentry); \
TICK_ALLOC_HEAP_NOCTR(headroom)
-#define STK_CHK_GEN(headroom,liveness,reentry,tag_assts) \
+#define STK_CHK_GEN(headroom,liveness,reentry) \
if ((Sp - (headroom)) < SpLim) { \
- tag_assts \
R9.w = (W_)LIVENESS_MASK(liveness); \
R10.w = (W_)reentry; \
- JMP_(stg_gen_chk); \
+ JMP_(stg_gc_gen); \
}
#define MAYBE_GC(liveness,reentry) \
if (doYouWantToGC()) { \
R9.w = (W_)LIVENESS_MASK(liveness); \
R10.w = (W_)reentry; \
- JMP_(stg_gen_hp); \
+ JMP_(stg_gc_gen_hp); \
}
/* -----------------------------------------------------------------------------
We use a RET_DYN frame the same as for a dynamic heap check.
------------------------------------------------------------------------- */
-EXTINFO_RTS(stg_gen_chk_info);
-
/* -----------------------------------------------------------------------------
Vectored Returns
Return vectors are placed in *reverse order* immediately before the info
table for the return address. Hence the formula for computing the
- actual return address is (addr - sizeof(InfoTable) - tag - 1).
+ actual return address is (addr - sizeof(RetInfoTable) - tag - 1).
The extra subtraction of one word is because tags start at zero.
-------------------------------------------------------------------------- */
#ifdef TABLES_NEXT_TO_CODE
-#define RET_VEC(p,t) (*((P_)(p) - sizeofW(StgInfoTable) - t - 1))
+#define RET_VEC(p,t) (*((P_)(p) - sizeofW(StgRetInfoTable) - t - 1))
#else
-#define RET_VEC(p,t) (((StgInfoTable *)p)->vector[t])
+#define RET_VEC(p,t) (((StgRetInfoTable *)p)->vector[t])
#endif
/* -----------------------------------------------------------------------------
# else
// An object is replaced by a blackhole, so we fill the slop with zeros.
//
+// This looks like it can't work - we're overwriting the contents of
+// the THUNK with slop! Perhaps this never worked??? --SDM
+// The problem is that with eager-black-holing we currently perform
+// the black-holing operation at the *beginning* of the basic block,
+// when we still need the contents of the thunk.
+// Perhaps the thing to do is to overwrite it at the *end* of the
+// basic block, when we've already sucked out the thunk's contents? -- SLPJ
+//
// Todo: maybe use SET_HDR() and remove LDV_recordCreate()?
//
# define UPD_BH_UPDATABLE(info) \
# define UPD_BH_SINGLE_ENTRY(thunk) /* nothing */
#endif /* EAGER_BLACKHOLING */
-#define UPD_FRAME_UPDATEE(p) ((P_)(((StgUpdateFrame *)(p))->updatee))
-#define UPDATE_SU_FROM_UPD_FRAME(p) (Su=((StgUpdateFrame *)(p))->link)
-
/* -----------------------------------------------------------------------------
Moving Floats and Doubles
ASSIGN_FLT is for assigning a float to memory (usually the
stack/heap). The memory address is guaranteed to be
- StgWord aligned (currently == sizeof(long)).
+ StgWord aligned (currently == sizeof(void *)).
PK_FLT is for pulling a float out of memory. The memory is
guaranteed to be StgWord aligned.
-------------------------------------------------------------------------- */
-static inline void ASSIGN_FLT (W_ [], StgFloat);
-static inline StgFloat PK_FLT (W_ []);
+INLINE_HEADER void ASSIGN_FLT (W_ [], StgFloat);
+INLINE_HEADER StgFloat PK_FLT (W_ []);
#if ALIGNMENT_FLOAT <= ALIGNMENT_LONG
-static inline void ASSIGN_FLT(W_ p_dest[], StgFloat src) { *(StgFloat *)p_dest = src; }
-static inline StgFloat PK_FLT (W_ p_src[]) { return *(StgFloat *)p_src; }
+INLINE_HEADER void ASSIGN_FLT(W_ p_dest[], StgFloat src) { *(StgFloat *)p_dest = src; }
+INLINE_HEADER StgFloat PK_FLT (W_ p_src[]) { return *(StgFloat *)p_src; }
#else /* ALIGNMENT_FLOAT > ALIGNMENT_UNSIGNED_INT */
-static inline void ASSIGN_FLT(W_ p_dest[], StgFloat src)
+INLINE_HEADER void ASSIGN_FLT(W_ p_dest[], StgFloat src)
{
float_thing y;
y.f = src;
*p_dest = y.fu;
}
-static inline StgFloat PK_FLT(W_ p_src[])
+INLINE_HEADER StgFloat PK_FLT(W_ p_src[])
{
float_thing y;
y.fu = *p_src;
#if ALIGNMENT_DOUBLE <= ALIGNMENT_LONG
-static inline void ASSIGN_DBL (W_ [], StgDouble);
-static inline StgDouble PK_DBL (W_ []);
+INLINE_HEADER void ASSIGN_DBL (W_ [], StgDouble);
+INLINE_HEADER StgDouble PK_DBL (W_ []);
-static inline void ASSIGN_DBL(W_ p_dest[], StgDouble src) { *(StgDouble *)p_dest = src; }
-static inline StgDouble PK_DBL (W_ p_src[]) { return *(StgDouble *)p_src; }
+INLINE_HEADER void ASSIGN_DBL(W_ p_dest[], StgDouble src) { *(StgDouble *)p_dest = src; }
+INLINE_HEADER StgDouble PK_DBL (W_ p_src[]) { return *(StgDouble *)p_src; }
#else /* ALIGNMENT_DOUBLE > ALIGNMENT_LONG */
#else /* ! sparc_TARGET_ARCH */
-static inline void ASSIGN_DBL (W_ [], StgDouble);
-static inline StgDouble PK_DBL (W_ []);
+INLINE_HEADER void ASSIGN_DBL (W_ [], StgDouble);
+INLINE_HEADER StgDouble PK_DBL (W_ []);
typedef struct
{ StgWord dhi;
unpacked_double du;
} double_thing;
-static inline void ASSIGN_DBL(W_ p_dest[], StgDouble src)
+INLINE_HEADER void ASSIGN_DBL(W_ p_dest[], StgDouble src)
{
double_thing y;
y.d = src;
*(p_dest+1) = ((double_thing) src).du.dlo \
*/
-static inline StgDouble PK_DBL(W_ p_src[])
+INLINE_HEADER StgDouble PK_DBL(W_ p_src[])
{
double_thing y;
y.du.dhi = p_src[0];
unpacked_double_word wu;
} word64_thing;
-static inline void ASSIGN_Word64(W_ p_dest[], StgWord64 src)
+INLINE_HEADER void ASSIGN_Word64(W_ p_dest[], StgWord64 src)
{
word64_thing y;
y.w = src;
p_dest[1] = y.wu.dlo;
}
-static inline StgWord64 PK_Word64(W_ p_src[])
+INLINE_HEADER StgWord64 PK_Word64(W_ p_src[])
{
word64_thing y;
y.wu.dhi = p_src[0];
return(y.w);
}
-static inline void ASSIGN_Int64(W_ p_dest[], StgInt64 src)
+INLINE_HEADER void ASSIGN_Int64(W_ p_dest[], StgInt64 src)
{
int64_thing y;
y.i = src;
p_dest[1] = y.iu.dlo;
}
-static inline StgInt64 PK_Int64(W_ p_src[])
+INLINE_HEADER StgInt64 PK_Int64(W_ p_src[])
{
int64_thing y;
y.iu.dhi = p_src[0];
#elif SIZEOF_VOID_P == 8
-static inline void ASSIGN_Word64(W_ p_dest[], StgWord64 src)
+INLINE_HEADER void ASSIGN_Word64(W_ p_dest[], StgWord64 src)
{
p_dest[0] = src;
}
-static inline StgWord64 PK_Word64(W_ p_src[])
+INLINE_HEADER StgWord64 PK_Word64(W_ p_src[])
{
return p_src[0];
}
-static inline void ASSIGN_Int64(W_ p_dest[], StgInt64 src)
+INLINE_HEADER void ASSIGN_Int64(W_ p_dest[], StgInt64 src)
{
p_dest[0] = src;
}
-static inline StgInt64 PK_Int64(W_ p_src[])
+INLINE_HEADER StgInt64 PK_Int64(W_ p_src[])
{
return p_src[0];
}
extern DLL_IMPORT_RTS const StgPolyInfoTable stg_catch_frame_info;
/* -----------------------------------------------------------------------------
- Seq frames
-
- A seq frame is very like an update frame, except that it doesn't do
- an update...
- -------------------------------------------------------------------------- */
-
-extern DLL_IMPORT_RTS const StgPolyInfoTable stg_seq_frame_info;
-
-#define PUSH_SEQ_FRAME(sp) \
- { \
- StgSeqFrame *__frame; \
- TICK_SEQF_PUSHED(); \
- __frame = (StgSeqFrame *)(sp); \
- SET_HDR((StgClosure *)__frame,(StgInfoTable *)&stg_seq_frame_info,CCCS);\
- __frame->link = Su; \
- Su = (StgUpdateFrame *)__frame; \
- }
-
-/* -----------------------------------------------------------------------------
Split markers
-------------------------------------------------------------------------- */
#if defined(USE_SPLIT_MARKERS)
-#if defined(cygwin32_TARGET_OS) || defined(mingw32_TARGET_OS)
+#if defined(LEADING_UNDERSCORE)
#define __STG_SPLIT_MARKER __asm__("\n___stg_split_marker:");
#else
#define __STG_SPLIT_MARKER __asm__("\n__stg_split_marker:");
#if IN_STG_CODE
-static __inline__ void
+INLINE_HEADER void
SaveThreadState(void)
{
StgTSO *tso;
tso = CurrentTSO;
tso->sp = Sp;
- tso->su = Su;
CloseNursery(Hp);
#ifdef REG_CurrentTSO
#endif
}
-static __inline__ void
+INLINE_HEADER void
LoadThreadState (void)
{
StgTSO *tso;
tso = CurrentTSO;
Sp = tso->sp;
- Su = tso->su;
SpLim = (P_)&(tso->stack) + RESERVED_STACK_WORDS;
OpenNursery(Hp,HpLim);
projects / ghc-hetmet.git / blobdiff